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 (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"))))
  90
  91 \f
  92 (provide 'fuel-table)
  93 ;;; fuel-table.el ends here