/misc/fuel/fuel-table.el

  1;;; fuel-table.el -- table creation
  2
  3;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
  4;; See http://factorcode.org/license.txt for BSD license.
  5
  6;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
  7;; Keywords: languages, fuel, factor
  8;; Start date: Tue Jan 06, 2009 13:44
  9
 10;;; Comentary:
 11
 12;; Utilities to insert ascii tables.
 13
 14;;; Code:
 15
 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)))
 32
 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)) ?\ ))))))
 38
 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"))))))
 48
 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)))
 63
 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)))
 74
 75(defvar fuel-table-corner-lt "┌")
 76(defvar fuel-table-corner-lb "└")
 77(defvar fuel-table-corner-rt "┐")
 78(defvar fuel-table-corner-rb "┘")
 79(defvar fuel-table-line "─")
 80(defvar fuel-table-tee-t "┬")
 81(defvar fuel-table-tee-b "┴")
 82(defvar fuel-table-tee-l "├")
 83(defvar fuel-table-tee-r "┤")
 84(defvar fuel-table-crux "┼")
 85(defvar fuel-table-sep "│")
 86
 87(defun fuel-table--insert-line (widths first last sep)
 88  (insert first fuel-table-line)
 89  (dolist (w widths)
 90    (while (> w 0)
 91      (insert fuel-table-line)
 92      (setq w (1- w)))
 93    (insert fuel-table-line sep fuel-table-line))
 94  (delete-char -2)
 95  (insert fuel-table-line last)
 96  (newline))
 97
 98(defun fuel-table--insert-first-line (widths)
 99  (fuel-table--insert-line widths
100                           fuel-table-corner-lt
101                           fuel-table-corner-rt
102                           fuel-table-tee-t))
103
104(defun fuel-table--insert-middle-line (widths)
105  (fuel-table--insert-line widths
106                           fuel-table-tee-l
107                           fuel-table-tee-r
108                           fuel-table-crux))
109
110(defun fuel-table--insert-last-line (widths)
111  (fuel-table--insert-line widths
112                           fuel-table-corner-lb
113                           fuel-table-corner-rb
114                           fuel-table-tee-b))
115
116(defun fuel-table--insert-row (r)
117  (let ((ln (length (car r)))
118        (l 0))
119    (while (< l ln)
120      (insert (concat fuel-table-sep " "
121                      (mapconcat 'identity
122                                 (mapcar `(lambda (x) (nth ,l x)) r)
123                                 (concat " " fuel-table-sep " "))
124                      "  " fuel-table-sep "\n"))
125      (setq l (1+ l)))))
126
127(defun fuel-table--insert (rows)
128  (let* ((widths (fuel-table--col-widths rows))
129         (rows (fuel-table--format-rows rows widths)))
130    (fuel-table--insert-first-line widths)
131    (dolist (r rows)
132      (fuel-table--insert-row r)
133      (fuel-table--insert-middle-line widths))
134    (kill-line -1)
135    (fuel-table--insert-last-line widths)))
136
137
138(provide 'fuel-table)
139;;; fuel-table.el ends here