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 ;;; Code:
  14
  15 (defun geiser-table--col-widths (rows)
  16   (let* ((col-no (length (car rows)))
  17          (available (- (window-width) 2 (* 2 col-no)))
  18          (widths)
  19          (c 0))
  20     (while (< c col-no)
  21       (let ((width 0)
  22             (av-width (- available (* 5 (- col-no c)))))
  23         (dolist (row rows)
  24           (setq width
  25                 (min av-width
  26                      (max width (length (nth c row))))))
  27         (push width widths)
  28         (setq available (- available width)))
  29       (setq c (1+ c)))
  30     (reverse widths)))
  31
  32 (defun geiser-table--pad-str (str width)
  33   (let ((len (length str)))
  34     (cond ((= len width) str)
  35           ((> len width) (concat (substring str 0 (- width 3)) "..."))
  36           (t (concat str (make-string (- width (length str)) ?\ ))))))
  37
  38 (defun geiser-table--str-lines (str width)
  39   (if (<= (length str) width)
  40       (list (geiser-table--pad-str str width))
  41     (with-temp-buffer
  42       (let ((fill-column width))
  43         (insert str)
  44         (fill-region (point-min) (point-max))
  45         (mapcar (lambda (s) (geiser-table--pad-str s width))
  46                 (split-string (buffer-string) "\n"))))))
  47
  48 (defun geiser-table--pad-row (row)
  49   (let* ((max-ln (apply 'max (mapcar 'length row)))
  50          (result))
  51     (dolist (lines row)
  52       (let ((ln (length lines)))
  53         (if (= ln max-ln) (push lines result)
  54           (let ((lines (reverse lines))
  55                 (l 0)
  56                 (blank (make-string (length (car lines)) ?\ )))
  57             (while (< l ln)
  58               (push blank lines)
  59               (setq l (1+ l)))
  60             (push (reverse lines) result)))))
  61     (reverse result)))
  62
  63 (defun geiser-table--format-rows (rows widths)
  64   (let ((col-no (length (car rows)))
  65         (frows))
  66     (dolist (row rows)
  67       (let ((c 0) (frow))
  68         (while (< c col-no)
  69           (push (geiser-table--str-lines (nth c row) (nth c widths)) frow)
  70           (setq c (1+ c)))
  71         (push (geiser-table--pad-row (reverse frow)) frows)))
  72     (reverse frows)))
  73
  74 (defvar geiser-table-corner-lt "┌")
  75 (defvar geiser-table-corner-lb "└")
  76 (defvar geiser-table-corner-rt "┐")
  77 (defvar geiser-table-corner-rb "┘")
  78 (defvar geiser-table-line "─")
  79 (defvar geiser-table-tee-t "┬")
  80 (defvar geiser-table-tee-b "┴")
  81 (defvar geiser-table-tee-l "├")
  82 (defvar geiser-table-tee-r "┤")
  83 (defvar geiser-table-crux "┼")
  84 (defvar geiser-table-sep "│")
  85
  86 (defun geiser-table--insert-line (widths first last sep)
  87   (insert first geiser-table-line)
  88   (dolist (w widths)
  89     (while (> w 0)
  90       (insert geiser-table-line)
  91       (setq w (1- w)))
  92     (insert geiser-table-line sep geiser-table-line))
  93   (delete-char -2)
  94   (insert geiser-table-line last)
  95   (newline))
  96
  97 (defun geiser-table--insert-first-line (widths)
  98   (geiser-table--insert-line widths
  99                              geiser-table-corner-lt
 100                              geiser-table-corner-rt
 101                              geiser-table-tee-t))
 102
 103 (defun geiser-table--insert-middle-line (widths)
 104   (geiser-table--insert-line widths
 105                              geiser-table-tee-l
 106                              geiser-table-tee-r
 107                              geiser-table-crux))
 108
 109 (defun geiser-table--insert-last-line (widths)
 110   (geiser-table--insert-line widths
 111                              geiser-table-corner-lb
 112                              geiser-table-corner-rb
 113                              geiser-table-tee-b))
 114
 115 (defun geiser-table--insert-row (r)
 116   (let ((ln (length (car r)))
 117         (l 0))
 118     (while (< l ln)
 119       (insert (concat geiser-table-sep " "
 120                       (mapconcat 'identity
 121                                  (mapcar `(lambda (x) (nth ,l x)) r)
 122                                  (concat " " geiser-table-sep " "))
 123                       "  " geiser-table-sep "\n"))
 124       (setq l (1+ l)))))
 125
 126 (defun geiser-table--insert (rows)
 127   (let* ((widths (geiser-table--col-widths rows))
 128          (rows (geiser-table--format-rows rows widths)))
 129     (geiser-table--insert-first-line widths)
 130     (dolist (r rows)
 131       (geiser-table--insert-row r)
 132       (geiser-table--insert-middle-line widths))
 133     (kill-line -1)
 134     (geiser-table--insert-last-line widths)))
 135
 136 \f
 137 (provide 'geiser-table)