Commit | Line | Data |
---|---|---|
a83ec3c9 CY |
1 | ;;; tabulated-list.el --- generic major mode for tabulated lists. |
2 | ||
3 | ;; Copyright (C) 2011 Free Software Foundation, Inc. | |
4 | ||
5 | ;; Author: Chong Yidong <cyd@stupidchicken.com> | |
6 | ;; Keywords: extensions, lisp | |
7 | ||
8 | ;; This file is part of GNU Emacs. | |
9 | ||
10 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
11 | ;; it under the terms of the GNU General Public License as published by | |
12 | ;; the Free Software Foundation; either version 3, or (at your option) | |
13 | ;; any later version. | |
14 | ||
15 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
16 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
17 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
18 | ;; GNU General Public License for more details. | |
19 | ||
20 | ;; You should have received a copy of the GNU General Public License | |
21 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. | |
22 | ||
23 | ;;; Commentary: | |
24 | ||
25 | ;; This file defines `tabulated-list-mode', a generic major mode for displaying | |
26 | ;; lists of tabulated data, intended for other major modes to inherit from. It | |
27 | ;; provides several utility routines, e.g. for pretty-printing lines of | |
28 | ;; tabulated data to fit into the appropriate columns. | |
29 | ||
30 | ;; For usage information, see the documentation of `tabulated-list-mode'. | |
31 | ||
32 | ;; This package originated from Tom Tromey's Package Menu mode, extended and | |
33 | ;; generalized to be used by other modes. | |
34 | ||
35 | ;;; Code: | |
36 | ||
37 | (defvar tabulated-list-format nil | |
38 | "The format of the current Tabulated List mode buffer. | |
39 | This should be a vector of elements (NAME WIDTH SORT), where: | |
40 | - NAME is a string describing the column. | |
41 | - WIDTH is the width to reserve for the column. | |
42 | For the final element, its numerical value is ignored. | |
43 | - SORT specifies how to sort entries by this column. | |
44 | If nil, this column cannot be used for sorting. | |
45 | If t, sort by comparing the string value printed in the column. | |
46 | Otherwise, it should be a predicate function suitable for | |
47 | `sort', accepting arguments with the same form as the elements | |
48 | of `tabulated-list-entries'.") | |
49 | (make-variable-buffer-local 'tabulated-list-format) | |
50 | ||
51 | (defvar tabulated-list-entries nil | |
52 | "Entries displayed in the current Tabulated List buffer. | |
53 | This should be either a function, or a list. | |
54 | If a list, each element has the form (ID [DESC1 ... DESCN]), | |
55 | where: | |
56 | - ID is nil, or a Lisp object uniquely identifying this entry, | |
57 | which is used to keep the cursor on the \"same\" entry when | |
58 | rearranging the list. Comparison is done with `equal'. | |
59 | ||
60 | - Each DESC is a column descriptor, one for each column | |
61 | specified in `tabulated-list-format'. A descriptor is either | |
62 | a string, which is printed as-is, or a list (LABEL . PROPS), | |
63 | which means to use `insert-text-button' to insert a text | |
64 | button with label LABEL and button properties PROPS. | |
65 | The string, or button label, must not contain any newline. | |
66 | ||
67 | If `tabulated-list-entries' is a function, it is called with no | |
68 | arguments and must return a list of the above form.") | |
69 | (make-variable-buffer-local 'tabulated-list-entries) | |
70 | ||
71 | (defvar tabulated-list-padding 0 | |
72 | "Number of characters preceding each Tabulated List mode entry. | |
73 | By default, lines are padded with spaces, but you can use the | |
74 | function `tabulated-list-put-tag' to change this.") | |
75 | (make-variable-buffer-local 'tabulated-list-padding) | |
76 | ||
77 | (defvar tabulated-list-revert-hook nil | |
78 | "Hook run before reverting a Tabulated List buffer. | |
79 | This is commonly used to recompute `tabulated-list-entries'.") | |
80 | ||
81 | (defvar tabulated-list-printer 'tabulated-list-print-entry | |
82 | "Function for inserting a Tabulated List entry at point. | |
83 | It is called with two arguments, ID and COLS. ID is a Lisp | |
84 | object identifying the entry, and COLS is a vector of column | |
85 | descriptors, as documented in `tabulated-list-entries'.") | |
86 | (make-variable-buffer-local 'tabulated-list-printer) | |
87 | ||
88 | (defvar tabulated-list-sort-key nil | |
89 | "Sort key for the current Tabulated List mode buffer. | |
90 | If nil, no additional sorting is performed. | |
91 | Otherwise, this should be a cons cell (NAME . FLIP). | |
92 | NAME is a string matching one of the column names in | |
93 | `tabulated-list-format' (the corresponding SORT entry in | |
94 | `tabulated-list-format' then specifies how to sort). FLIP, if | |
95 | non-nil, means to invert the resulting sort.") | |
96 | (make-variable-buffer-local 'tabulated-list-sort-key) | |
97 | ||
98 | (defun tabulated-list-get-id (&optional pos) | |
99 | "Obtain the entry ID of the Tabulated List mode entry at POS. | |
100 | This is an ID object from `tabulated-list-entries', or nil. | |
101 | POS, if omitted or nil, defaults to point." | |
102 | (get-text-property (or pos (point)) 'tabulated-list-id)) | |
103 | ||
104 | (defun tabulated-list-put-tag (tag &optional advance) | |
105 | "Put TAG in the padding area of the current line. | |
106 | TAG should be a string, with length <= `tabulated-list-padding'. | |
107 | If ADVANCE is non-nil, move forward by one line afterwards." | |
108 | (unless (stringp tag) | |
109 | (error "Invalid argument to `tabulated-list-put-tag'")) | |
110 | (unless (> tabulated-list-padding 0) | |
111 | (error "Unable to tag the current line")) | |
112 | (save-excursion | |
113 | (beginning-of-line) | |
114 | (when (get-text-property (point) 'tabulated-list-id) | |
115 | (let ((beg (point)) | |
116 | (inhibit-read-only t)) | |
117 | (forward-char tabulated-list-padding) | |
118 | (insert-and-inherit | |
119 | (if (<= (length tag) tabulated-list-padding) | |
120 | (concat tag | |
121 | (make-string (- tabulated-list-padding (length tag)) | |
122 | ?\s)) | |
123 | (substring tag 0 tabulated-list-padding))) | |
124 | (delete-region beg (+ beg tabulated-list-padding))))) | |
125 | (if advance | |
126 | (forward-line))) | |
127 | ||
128 | (defvar tabulated-list-mode-map | |
129 | (let ((map (copy-keymap special-mode-map))) | |
130 | (set-keymap-parent map button-buffer-map) | |
131 | (define-key map "n" 'next-line) | |
132 | (define-key map "p" 'previous-line) | |
133 | (define-key map [follow-link] 'mouse-face) | |
134 | (define-key map [mouse-2] 'mouse-select-window) | |
135 | map) | |
136 | "Local keymap for `tabulated-list-mode' buffers.") | |
137 | ||
138 | (defvar tabulated-list-sort-button-map | |
139 | (let ((map (make-sparse-keymap))) | |
140 | (define-key map [header-line mouse-1] 'tabulated-list-col-sort) | |
141 | (define-key map [header-line mouse-2] 'tabulated-list-col-sort) | |
142 | (define-key map [follow-link] 'mouse-face) | |
143 | map) | |
144 | "Local keymap for `tabulated-list-mode' sort buttons.") | |
145 | ||
16a43933 CY |
146 | (defvar tabulated-list-glyphless-char-display |
147 | (let ((table (make-char-table 'glyphless-char-display nil))) | |
148 | (set-char-table-parent table glyphless-char-display) | |
fe7a3057 | 149 | ;; Some text terminals can't display the Unicode arrows; be safe. |
16a43933 CY |
150 | (aset table 9650 (cons nil "^")) |
151 | (aset table 9660 (cons nil "v")) | |
152 | table) | |
153 | "The `glyphless-char-display' table in Tabulated List buffers.") | |
154 | ||
a83ec3c9 CY |
155 | (defun tabulated-list-init-header () |
156 | "Set up header line for the Tabulated List buffer." | |
157 | (let ((x tabulated-list-padding) | |
158 | (button-props `(help-echo "Click to sort by column" | |
159 | mouse-face highlight | |
160 | keymap ,tabulated-list-sort-button-map)) | |
161 | (cols nil)) | |
162 | (if (> tabulated-list-padding 0) | |
163 | (push (propertize " " 'display `(space :align-to ,x)) cols)) | |
164 | (dotimes (n (length tabulated-list-format)) | |
165 | (let* ((col (aref tabulated-list-format n)) | |
166 | (width (nth 1 col)) | |
167 | (label (car col))) | |
168 | (setq x (+ x 1 width)) | |
169 | (and (<= tabulated-list-padding 0) | |
170 | (= n 0) | |
171 | (setq label (concat " " label))) | |
172 | (push | |
173 | (cond | |
174 | ;; An unsortable column | |
175 | ((not (nth 2 col)) label) | |
176 | ;; The selected sort column | |
177 | ((equal (car col) (car tabulated-list-sort-key)) | |
178 | (apply 'propertize | |
179 | (concat label | |
180 | (cond | |
181 | ((> (+ 2 (length label)) width) | |
182 | "") | |
183 | ((cdr tabulated-list-sort-key) | |
184 | " ▲") | |
185 | (t " ▼"))) | |
186 | 'face 'bold | |
187 | 'tabulated-list-column-name (car col) | |
188 | button-props)) | |
189 | ;; Unselected sortable column. | |
190 | (t (apply 'propertize label | |
191 | 'tabulated-list-column-name (car col) | |
192 | button-props))) | |
193 | cols)) | |
194 | (push (propertize " " | |
195 | 'display (list 'space :align-to x) | |
196 | 'face 'fixed-pitch) | |
197 | cols)) | |
198 | (setq header-line-format (mapconcat 'identity (nreverse cols) "")))) | |
199 | ||
200 | (defun tabulated-list-revert (&rest ignored) | |
201 | "The `revert-buffer-function' for `tabulated-list-mode'. | |
202 | It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'." | |
203 | (interactive) | |
204 | (unless (derived-mode-p 'tabulated-list-mode) | |
205 | (error "The current buffer is not in Tabulated List mode")) | |
206 | (run-hooks 'tabulated-list-revert-hook) | |
207 | (tabulated-list-print t)) | |
208 | ||
209 | (defun tabulated-list-print (&optional remember-pos) | |
210 | "Populate the current Tabulated List mode buffer. | |
211 | This sorts the `tabulated-list-entries' list if sorting is | |
212 | specified by `tabulated-list-sort-key'. It then erases the | |
213 | buffer and inserts the entries with `tabulated-list-printer'. | |
214 | ||
215 | Optional argument REMEMBER-POS, if non-nil, means to move point | |
216 | to the entry with the same ID element as the current line." | |
217 | (let ((inhibit-read-only t) | |
218 | (entries (if (functionp 'tabulated-list-entries) | |
219 | (funcall tabulated-list-entries) | |
220 | tabulated-list-entries)) | |
221 | entry-id saved-pt saved-col) | |
222 | (and remember-pos | |
223 | (setq entry-id (tabulated-list-get-id)) | |
224 | (setq saved-col (current-column))) | |
225 | (erase-buffer) | |
226 | ;; Sort the buffers, if necessary. | |
227 | (when tabulated-list-sort-key | |
228 | (let ((sort-column (car tabulated-list-sort-key)) | |
229 | (len (length tabulated-list-format)) | |
230 | (n 0) | |
231 | sorter) | |
232 | ;; Which column is to be sorted? | |
233 | (while (and (< n len) | |
234 | (not (equal (car (aref tabulated-list-format n)) | |
235 | sort-column))) | |
236 | (setq n (1+ n))) | |
237 | (when (< n len) | |
238 | (setq sorter (nth 2 (aref tabulated-list-format n))) | |
239 | (when (eq sorter t) | |
240 | (setq sorter ; Default sorter checks column N: | |
e67a13ab CY |
241 | (lambda (A B) |
242 | (setq A (aref (cadr A) n)) | |
243 | (setq B (aref (cadr B) n)) | |
244 | (string< (if (stringp A) A (car A)) | |
245 | (if (stringp B) B (car B)))))) | |
a83ec3c9 CY |
246 | (setq entries (sort entries sorter)) |
247 | (if (cdr tabulated-list-sort-key) | |
248 | (setq entries (nreverse entries))) | |
249 | (unless (functionp 'tabulated-list-entries) | |
250 | (setq tabulated-list-entries entries))))) | |
251 | ;; Print the resulting list. | |
252 | (dolist (elt entries) | |
253 | (and entry-id | |
254 | (equal entry-id (car elt)) | |
255 | (setq saved-pt (point))) | |
256 | (apply tabulated-list-printer elt)) | |
257 | (set-buffer-modified-p nil) | |
258 | ;; If REMEMBER-POS was specified, move to the "old" location. | |
259 | (if saved-pt | |
260 | (progn (goto-char saved-pt) | |
3e26a4a2 CY |
261 | (move-to-column saved-col) |
262 | (recenter)) | |
a83ec3c9 CY |
263 | (goto-char (point-min))))) |
264 | ||
265 | (defun tabulated-list-print-entry (id cols) | |
266 | "Insert a Tabulated List entry at point. | |
267 | This is the default `tabulated-list-printer' function. ID is a | |
268 | Lisp object identifying the entry to print, and COLS is a vector | |
269 | of column descriptors." | |
270 | (let ((beg (point)) | |
271 | (x (max tabulated-list-padding 0)) | |
272 | (len (length tabulated-list-format))) | |
273 | (if (> tabulated-list-padding 0) | |
274 | (insert (make-string x ?\s))) | |
275 | (dotimes (n len) | |
276 | (let* ((format (aref tabulated-list-format n)) | |
277 | (desc (aref cols n)) | |
278 | (width (nth 1 format)) | |
279 | (label (if (stringp desc) desc (car desc))) | |
280 | (help-echo (concat (car format) ": " label))) | |
281 | ;; Truncate labels if necessary. | |
282 | (and (> width 6) | |
283 | (> (length label) width) | |
37f1c930 | 284 | (setq label (concat (substring label 0 (- width 3)) |
a83ec3c9 | 285 | "..."))) |
f635daa1 | 286 | (setq label (bidi-string-mark-left-to-right label)) |
a83ec3c9 CY |
287 | (if (stringp desc) |
288 | (insert (propertize label 'help-echo help-echo)) | |
289 | (apply 'insert-text-button label (cdr desc))) | |
290 | (setq x (+ x 1 width))) | |
291 | ;; No need to append any spaces if this is the last column. | |
292 | (if (< (1+ n) len) | |
293 | (indent-to x 1))) | |
294 | (insert ?\n) | |
295 | (put-text-property beg (point) 'tabulated-list-id id))) | |
296 | ||
297 | (defun tabulated-list-col-sort (&optional e) | |
298 | "Sort Tabulated List entries by the column of the mouse click E." | |
299 | (interactive "e") | |
300 | (let* ((pos (event-start e)) | |
301 | (obj (posn-object pos)) | |
302 | (name (get-text-property (if obj (cdr obj) (posn-point pos)) | |
303 | 'tabulated-list-column-name | |
304 | (car obj)))) | |
305 | (with-current-buffer (window-buffer (posn-window pos)) | |
306 | (when (derived-mode-p 'tabulated-list-mode) | |
307 | ;; Flip the sort order on a second click. | |
308 | (if (equal name (car tabulated-list-sort-key)) | |
309 | (setcdr tabulated-list-sort-key | |
310 | (not (cdr tabulated-list-sort-key))) | |
311 | (setq tabulated-list-sort-key (cons name nil))) | |
312 | (tabulated-list-init-header) | |
313 | (tabulated-list-print t))))) | |
314 | ||
315 | ;;; The mode definition: | |
316 | ||
317 | ;;;###autoload | |
318 | (define-derived-mode tabulated-list-mode special-mode "Tabulated" | |
319 | "Generic major mode for browsing a list of items. | |
320 | This mode is usually not used directly; instead, other major | |
321 | modes are derived from it, using `define-derived-mode'. | |
322 | ||
323 | In this major mode, the buffer is divided into multiple columns, | |
09e80d9f | 324 | which are labeled using the header line. Each non-empty line |
a83ec3c9 CY |
325 | belongs to one \"entry\", and the entries can be sorted according |
326 | to their column values. | |
327 | ||
328 | An inheriting mode should usually do the following in their body: | |
329 | ||
330 | - Set `tabulated-list-format', specifying the column format. | |
331 | - Set `tabulated-list-revert-hook', if the buffer contents need | |
332 | to be specially recomputed prior to `revert-buffer'. | |
333 | - Maybe set a `tabulated-list-entries' function (see below). | |
334 | - Maybe set `tabulated-list-printer' (see below). | |
335 | - Maybe set `tabulated-list-padding'. | |
336 | - Call `tabulated-list-init-header' to initialize `header-line-format' | |
337 | according to `tabulated-list-format'. | |
338 | ||
339 | An inheriting mode is usually accompanied by a \"list-FOO\" | |
340 | command (e.g. `list-packages', `list-processes'). This command | |
341 | creates or switches to a buffer and enables the major mode in | |
342 | that buffer. If `tabulated-list-entries' is not a function, the | |
343 | command should initialize it to a list of entries for displaying. | |
344 | Finally, it should call `tabulated-list-print'. | |
345 | ||
346 | `tabulated-list-print' calls the printer function specified by | |
347 | `tabulated-list-printer', once for each entry. The default | |
348 | printer is `tabulated-list-print-entry', but a mode that keeps | |
349 | data in an ewoc may instead specify a printer function (e.g., one | |
350 | that calls `ewoc-enter-last'), with `tabulated-list-print-entry' | |
351 | as the ewoc pretty-printer." | |
352 | (setq truncate-lines t) | |
353 | (setq buffer-read-only t) | |
354 | (set (make-local-variable 'revert-buffer-function) | |
16a43933 CY |
355 | 'tabulated-list-revert) |
356 | (set (make-local-variable 'glyphless-char-display) | |
357 | tabulated-list-glyphless-char-display)) | |
a83ec3c9 CY |
358 | |
359 | (put 'tabulated-list-mode 'mode-class 'special) | |
360 | ||
361 | (provide 'tabulated-list) | |
362 | ||
363 | ;; Local Variables: | |
364 | ;; coding: utf-8 | |
365 | ;; lexical-binding: t | |
366 | ;; End: | |
367 | ||
368 | ;;; tabulated-list.el ends here |