misc/fuel/fuel-table.el

   1 ;;; fuel-table.el -- table creation -*- lexical-binding: t -*-
   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-cell (lines max-ln)
  50   (let* ((ln (length lines))
  51          (blank (make-string (length (car lines)) ?\ ))
  52          (n-extra (max (- max-ln ln) 0)))
  53     (append lines (make-list n-extra blank))))
  54
  55 (defun fuel-table--pad-row (row)
  56   (let* ((max-ln (apply 'max (mapcar 'length row)))
  57          (result))
  58     (dolist (lines row)
  59       (push (fuel-table--pad-cell lines max-ln) result))
  60     (reverse result)))
  61
  62 (defun fuel-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 (fuel-table--str-lines (nth c row) (nth c widths)) frow)
  69           (setq c (1+ c)))
  70         (push (fuel-table--pad-row (reverse frow)) frows)))
  71     (reverse frows)))
  72
  73 ;; These all need to be ascii to ensure the tables get rendered
  74 ;; properly no matter the font.
  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 \f
 138 (provide 'fuel-table)
 139
 140 ;;; fuel-table.el ends here