diff options
| -rw-r--r-- | elisp/geiser-table.el | 137 |
1 files changed, 137 insertions, 0 deletions
diff --git a/elisp/geiser-table.el b/elisp/geiser-table.el new file mode 100644 index 0000000..e4d4f43 --- /dev/null +++ b/elisp/geiser-table.el @@ -0,0 +1,137 @@ +;;; geiser-table.el -- table creation + +;; Copyright (C) 2009, 2010 Jose Antonio Ortega Ruiz + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the Modified BSD License. You should +;; have received a copy of the license along with this program. If +;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. + +;; Start date: Tue Jan 06, 2009 13:44 + + + +(defun geiser-table--col-widths (rows) + (let* ((col-no (length (car rows))) + (available (- (window-width) 2 (* 2 col-no))) + (widths) + (c 0)) + (while (< c col-no) + (let ((width 0) + (av-width (- available (* 5 (- col-no c))))) + (dolist (row rows) + (setq width + (min av-width + (max width (length (nth c row)))))) + (push width widths) + (setq available (- available width))) + (setq c (1+ c))) + (reverse widths))) + +(defun geiser-table--pad-str (str width) + (let ((len (length str))) + (cond ((= len width) str) + ((> len width) (concat (substring str 0 (- width 3)) "...")) + (t (concat str (make-string (- width (length str)) ?\ )))))) + +(defun geiser-table--str-lines (str width) + (if (<= (length str) width) + (list (geiser-table--pad-str str width)) + (with-temp-buffer + (let ((fill-column width)) + (insert str) + (fill-region (point-min) (point-max)) + (mapcar '(lambda (s) (geiser-table--pad-str s width)) + (split-string (buffer-string) "\n")))))) + +(defun geiser-table--pad-row (row) + (let* ((max-ln (apply 'max (mapcar 'length row))) + (result)) + (dolist (lines row) + (let ((ln (length lines))) + (if (= ln max-ln) (push lines result) + (let ((lines (reverse lines)) + (l 0) + (blank (make-string (length (car lines)) ?\ ))) + (while (< l ln) + (push blank lines) + (setq l (1+ l))) + (push (reverse lines) result))))) + (reverse result))) + +(defun geiser-table--format-rows (rows widths) + (let ((col-no (length (car rows))) + (frows)) + (dolist (row rows) + (let ((c 0) (frow)) + (while (< c col-no) + (push (geiser-table--str-lines (nth c row) (nth c widths)) frow) + (setq c (1+ c))) + (push (geiser-table--pad-row (reverse frow)) frows))) + (reverse frows))) + +(defvar geiser-table-corner-lt "┌") +(defvar geiser-table-corner-lb "└") +(defvar geiser-table-corner-rt "┐") +(defvar geiser-table-corner-rb "┘") +(defvar geiser-table-line "─") +(defvar geiser-table-tee-t "┬") +(defvar geiser-table-tee-b "┴") +(defvar geiser-table-tee-l "├") +(defvar geiser-table-tee-r "┤") +(defvar geiser-table-crux "┼") +(defvar geiser-table-sep "│") + +(defun geiser-table--insert-line (widths first last sep) + (insert first geiser-table-line) + (dolist (w widths) + (while (> w 0) + (insert geiser-table-line) + (setq w (1- w))) + (insert geiser-table-line sep geiser-table-line)) + (delete-char -2) + (insert geiser-table-line last) + (newline)) + +(defun geiser-table--insert-first-line (widths) + (geiser-table--insert-line widths + geiser-table-corner-lt + geiser-table-corner-rt + geiser-table-tee-t)) + +(defun geiser-table--insert-middle-line (widths) + (geiser-table--insert-line widths + geiser-table-tee-l + geiser-table-tee-r + geiser-table-crux)) + +(defun geiser-table--insert-last-line (widths) + (geiser-table--insert-line widths + geiser-table-corner-lb + geiser-table-corner-rb + geiser-table-tee-b)) + +(defun geiser-table--insert-row (r) + (let ((ln (length (car r))) + (l 0)) + (while (< l ln) + (insert (concat geiser-table-sep " " + (mapconcat 'identity + (mapcar `(lambda (x) (nth ,l x)) r) + (concat " " geiser-table-sep " ")) + " " geiser-table-sep "\n")) + (setq l (1+ l))))) + +(defun geiser-table--insert (rows) + (let* ((widths (geiser-table--col-widths rows)) + (rows (geiser-table--format-rows rows widths))) + (geiser-table--insert-first-line widths) + (dolist (r rows) + (geiser-table--insert-row r) + (geiser-table--insert-middle-line widths)) + (kill-line -1) + (geiser-table--insert-last-line widths))) + + +(provide 'geiser-table) +;;; geiser-table.el ends here |