geiser-table.el (4595B)
1 ;;; geiser-table.el -- table creation 2 3 ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz 4 5 ;; This program is free software; you can redistribute it and/or 6 ;; modify it under the terms of the Modified BSD License. You should 7 ;; have received a copy of the license along with this program. If 8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. 9 10 ;; Start date: Tue Jan 06, 2009 13:44 11 12 13 ;;; Code: 14 15 (defun geiser-table--col-widths (rows) 16 (let* ((col-no (length (car rows))) 17 (available (- (window-width) 2 (* 2 col-no))) 18 (widths) 19 (c 0)) 20 (while (< c col-no) 21 (let ((width 0) 22 (av-width (- available (* 5 (- col-no c))))) 23 (dolist (row rows) 24 (setq width 25 (min av-width 26 (max width (length (nth c row)))))) 27 (push width widths) 28 (setq available (- available width))) 29 (setq c (1+ c))) 30 (reverse widths))) 31 32 (defun geiser-table--pad-str (str width) 33 (let ((len (length str))) 34 (cond ((= len width) str) 35 ((> len width) (concat (substring str 0 (- width 3)) "...")) 36 (t (concat str (make-string (- width (length str)) ?\ )))))) 37 38 (defun geiser-table--str-lines (str width) 39 (if (<= (length str) width) 40 (list (geiser-table--pad-str str width)) 41 (with-temp-buffer 42 (let ((fill-column width)) 43 (insert str) 44 (fill-region (point-min) (point-max)) 45 (mapcar (lambda (s) (geiser-table--pad-str s width)) 46 (split-string (buffer-string) "\n")))))) 47 48 (defun geiser-table--pad-row (row) 49 (let* ((max-ln (apply 'max (mapcar 'length row))) 50 (result)) 51 (dolist (lines row) 52 (let ((ln (length lines))) 53 (if (= ln max-ln) (push lines result) 54 (let ((lines (reverse lines)) 55 (l 0) 56 (blank (make-string (length (car lines)) ?\ ))) 57 (while (< l ln) 58 (push blank lines) 59 (setq l (1+ l))) 60 (push (reverse lines) result))))) 61 (reverse result))) 62 63 (defun geiser-table--format-rows (rows widths) 64 (let ((col-no (length (car rows))) 65 (frows)) 66 (dolist (row rows) 67 (let ((c 0) (frow)) 68 (while (< c col-no) 69 (push (geiser-table--str-lines (nth c row) (nth c widths)) frow) 70 (setq c (1+ c))) 71 (push (geiser-table--pad-row (reverse frow)) frows))) 72 (reverse frows))) 73 74 (defvar geiser-table-corner-lt "┌") 75 (defvar geiser-table-corner-lb "└") 76 (defvar geiser-table-corner-rt "┐") 77 (defvar geiser-table-corner-rb "┘") 78 (defvar geiser-table-line "─") 79 (defvar geiser-table-tee-t "┬") 80 (defvar geiser-table-tee-b "┴") 81 (defvar geiser-table-tee-l "├") 82 (defvar geiser-table-tee-r "┤") 83 (defvar geiser-table-crux "┼") 84 (defvar geiser-table-sep "│") 85 86 (defun geiser-table--insert-line (widths first last sep) 87 (insert first geiser-table-line) 88 (dolist (w widths) 89 (while (> w 0) 90 (insert geiser-table-line) 91 (setq w (1- w))) 92 (insert geiser-table-line sep geiser-table-line)) 93 (delete-char -2) 94 (insert geiser-table-line last) 95 (newline)) 96 97 (defun geiser-table--insert-first-line (widths) 98 (geiser-table--insert-line widths 99 geiser-table-corner-lt 100 geiser-table-corner-rt 101 geiser-table-tee-t)) 102 103 (defun geiser-table--insert-middle-line (widths) 104 (geiser-table--insert-line widths 105 geiser-table-tee-l 106 geiser-table-tee-r 107 geiser-table-crux)) 108 109 (defun geiser-table--insert-last-line (widths) 110 (geiser-table--insert-line widths 111 geiser-table-corner-lb 112 geiser-table-corner-rb 113 geiser-table-tee-b)) 114 115 (defun geiser-table--insert-row (r) 116 (let ((ln (length (car r))) 117 (l 0)) 118 (while (< l ln) 119 (insert (concat geiser-table-sep " " 120 (mapconcat 'identity 121 (mapcar `(lambda (x) (nth ,l x)) r) 122 (concat " " geiser-table-sep " ")) 123 " " geiser-table-sep "\n")) 124 (setq l (1+ l))))) 125 126 (defun geiser-table--insert (rows) 127 (let* ((widths (geiser-table--col-widths rows)) 128 (rows (geiser-table--format-rows rows widths))) 129 (geiser-table--insert-first-line widths) 130 (dolist (r rows) 131 (geiser-table--insert-row r) 132 (geiser-table--insert-middle-line widths)) 133 (kill-line -1) 134 (geiser-table--insert-last-line widths))) 135 136 137 (provide 'geiser-table)