elisp/geiser-table.el

   1 ;;; geiser-table.el -- table creation
   2
   3 ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
   4
   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>.
   9
  10 ;; Start date: Tue Jan 06, 2009 13:44
  11
  12 \f
  13
  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)))
  30
  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)) ?\ ))))))
  36
  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"))))))
  46
  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)))
  61
  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)))
  72
  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 "│")
  84
  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))
  95
  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))
 101
 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))
 107
 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))
 113
 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)))))
 124
 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)))
 134
 135 \f
 136 (provide 'geiser-table)