blob: 619d563e3ad4fdf99ba1103ab3f56775374510ef (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
;;; geiser-table.el -- table creation -*- lexical-binding: t; -*-
;; Copyright (C) 2009, 2010, 2012 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
;;; Code:
(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)
|
