summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--elisp/geiser-table.el137
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