NEWS entry since Diogo confirmed things work again
[geiser.git] / elisp / geiser-table.el
blobab7451d717e45c1b495fa5a75bb24b6048b1ace1
1 ;;; geiser-table.el -- table creation
3 ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
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>.
10 ;; Start date: Tue Jan 06, 2009 13:44
14 (defun geiser-table--col-widths (rows)
15 (let* ((col-no (length (car rows)))
16 (available (- (window-width) 2 (* 2 col-no)))
17 (widths)
18 (c 0))
19 (while (< c col-no)
20 (let ((width 0)
21 (av-width (- available (* 5 (- col-no c)))))
22 (dolist (row rows)
23 (setq width
24 (min av-width
25 (max width (length (nth c row))))))
26 (push width widths)
27 (setq available (- available width)))
28 (setq c (1+ c)))
29 (reverse widths)))
31 (defun geiser-table--pad-str (str width)
32 (let ((len (length str)))
33 (cond ((= len width) str)
34 ((> len width) (concat (substring str 0 (- width 3)) "..."))
35 (t (concat str (make-string (- width (length str)) ?\ ))))))
37 (defun geiser-table--str-lines (str width)
38 (if (<= (length str) width)
39 (list (geiser-table--pad-str str width))
40 (with-temp-buffer
41 (let ((fill-column width))
42 (insert str)
43 (fill-region (point-min) (point-max))
44 (mapcar (lambda (s) (geiser-table--pad-str s width))
45 (split-string (buffer-string) "\n"))))))
47 (defun geiser-table--pad-row (row)
48 (let* ((max-ln (apply 'max (mapcar 'length row)))
49 (result))
50 (dolist (lines row)
51 (let ((ln (length lines)))
52 (if (= ln max-ln) (push lines result)
53 (let ((lines (reverse lines))
54 (l 0)
55 (blank (make-string (length (car lines)) ?\ )))
56 (while (< l ln)
57 (push blank lines)
58 (setq l (1+ l)))
59 (push (reverse lines) result)))))
60 (reverse result)))
62 (defun geiser-table--format-rows (rows widths)
63 (let ((col-no (length (car rows)))
64 (frows))
65 (dolist (row rows)
66 (let ((c 0) (frow))
67 (while (< c col-no)
68 (push (geiser-table--str-lines (nth c row) (nth c widths)) frow)
69 (setq c (1+ c)))
70 (push (geiser-table--pad-row (reverse frow)) frows)))
71 (reverse frows)))
73 (defvar geiser-table-corner-lt "┌")
74 (defvar geiser-table-corner-lb "└")
75 (defvar geiser-table-corner-rt "┐")
76 (defvar geiser-table-corner-rb "┘")
77 (defvar geiser-table-line "─")
78 (defvar geiser-table-tee-t "┬")
79 (defvar geiser-table-tee-b "┴")
80 (defvar geiser-table-tee-l "├")
81 (defvar geiser-table-tee-r "┤")
82 (defvar geiser-table-crux "┼")
83 (defvar geiser-table-sep "│")
85 (defun geiser-table--insert-line (widths first last sep)
86 (insert first geiser-table-line)
87 (dolist (w widths)
88 (while (> w 0)
89 (insert geiser-table-line)
90 (setq w (1- w)))
91 (insert geiser-table-line sep geiser-table-line))
92 (delete-char -2)
93 (insert geiser-table-line last)
94 (newline))
96 (defun geiser-table--insert-first-line (widths)
97 (geiser-table--insert-line widths
98 geiser-table-corner-lt
99 geiser-table-corner-rt
100 geiser-table-tee-t))
102 (defun geiser-table--insert-middle-line (widths)
103 (geiser-table--insert-line widths
104 geiser-table-tee-l
105 geiser-table-tee-r
106 geiser-table-crux))
108 (defun geiser-table--insert-last-line (widths)
109 (geiser-table--insert-line widths
110 geiser-table-corner-lb
111 geiser-table-corner-rb
112 geiser-table-tee-b))
114 (defun geiser-table--insert-row (r)
115 (let ((ln (length (car r)))
116 (l 0))
117 (while (< l ln)
118 (insert (concat geiser-table-sep " "
119 (mapconcat 'identity
120 (mapcar `(lambda (x) (nth ,l x)) r)
121 (concat " " geiser-table-sep " "))
122 " " geiser-table-sep "\n"))
123 (setq l (1+ l)))))
125 (defun geiser-table--insert (rows)
126 (let* ((widths (geiser-table--col-widths rows))
127 (rows (geiser-table--format-rows rows widths)))
128 (geiser-table--insert-first-line widths)
129 (dolist (r rows)
130 (geiser-table--insert-row r)
131 (geiser-table--insert-middle-line widths))
132 (kill-line -1)
133 (geiser-table--insert-last-line widths)))
136 (provide 'geiser-table)