Merge branch 'master' of git://factorcode.org/git/factor
[factor/jcg.git] / misc / fuel / fuel-table.el
bloba00b21bf2fd6242127a76bca91898c6dd65a003d
1 ;;; fuel-table.el -- table creation
3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Tue Jan 06, 2009 13:44
10 ;;; Comentary:
12 ;; Utilities to insert ascii tables.
14 ;;; Code:
16 (defun fuel-table--col-widths (rows)
17 (let* ((col-no (length (car rows)))
18 (available (- (window-width) 2 (* 2 col-no)))
19 (widths)
20 (c 0))
21 (while (< c col-no)
22 (let ((width 0)
23 (av-width (- available (* 5 (- col-no c)))))
24 (dolist (row rows)
25 (setq width
26 (min av-width
27 (max width (length (nth c row))))))
28 (push width widths)
29 (setq available (- available width)))
30 (setq c (1+ c)))
31 (reverse widths)))
33 (defun fuel-table--pad-str (str width)
34 (let ((len (length str)))
35 (cond ((= len width) str)
36 ((> len width) (concat (substring str 0 (- width 3)) "..."))
37 (t (concat str (make-string (- width (length str)) ?\ ))))))
39 (defun fuel-table--str-lines (str width)
40 (if (<= (length str) width)
41 (list (fuel-table--pad-str str width))
42 (with-temp-buffer
43 (let ((fill-column width))
44 (insert str)
45 (fill-region (point-min) (point-max))
46 (mapcar '(lambda (s) (fuel-table--pad-str s width))
47 (split-string (buffer-string) "\n"))))))
49 (defun fuel-table--pad-row (row)
50 (let* ((max-ln (apply 'max (mapcar 'length row)))
51 (result))
52 (dolist (lines row)
53 (let ((ln (length lines)))
54 (if (= ln max-ln) (push lines result)
55 (let ((lines (reverse lines))
56 (l 0)
57 (blank (make-string (length (car lines)) ?\ )))
58 (while (< l ln)
59 (push blank lines)
60 (setq l (1+ l)))
61 (push (reverse lines) result)))))
62 (reverse result)))
64 (defun fuel-table--format-rows (rows widths)
65 (let ((col-no (length (car rows)))
66 (frows))
67 (dolist (row rows)
68 (let ((c 0) (frow))
69 (while (< c col-no)
70 (push (fuel-table--str-lines (nth c row) (nth c widths)) frow)
71 (setq c (1+ c)))
72 (push (fuel-table--pad-row (reverse frow)) frows)))
73 (reverse frows)))
75 (defun fuel-table--insert (rows)
76 (let* ((widths (fuel-table--col-widths rows))
77 (rows (fuel-table--format-rows rows widths))
78 (ls (concat "+" (mapconcat (lambda (n) (make-string n ?-)) widths "-+") "-+")))
79 (insert ls "\n")
80 (dolist (r rows)
81 (let ((ln (length (car r)))
82 (l 0))
83 (while (< l ln)
84 (insert (concat "|" (mapconcat 'identity
85 (mapcar `(lambda (x) (nth ,l x)) r)
86 " |")
87 " |\n"))
88 (setq l (1+ l))))
89 (insert ls "\n"))))
92 (provide 'fuel-table)
93 ;;; fuel-table.el ends here