1 ;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
3 ;; Copyright (C) 2011-2012 Free Software Foundation, Inc.
5 ;; Author: Chong Yidong <cyd@stupidchicken.com>
6 ;; Keywords: extensions, lisp
8 ;; This file is part of GNU Emacs.
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)
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.
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/>.
25 ;; This file defines Tabulated List mode, a generic major mode for
26 ;; displaying lists of tabulated data, intended for other major modes
27 ;; to inherit from. It provides several utility routines, e.g. for
28 ;; pretty-printing lines of tabulated data to fit into the appropriate
31 ;; For usage information, see the documentation of `tabulated-list-mode'.
33 ;; This package originated from Tom Tromey's Package Menu mode,
34 ;; extended and generalized to be used by other modes.
38 (defvar tabulated-list-format nil
39 "The format of the current Tabulated List mode buffer.
40 This should be a vector of elements (NAME WIDTH SORT . PROPS),
42 - NAME is a string describing the column.
43 This is the label for the column in the header line.
44 Different columns must have non-`equal' names.
45 - WIDTH is the width to reserve for the column.
46 For the final element, its numerical value is ignored.
47 - SORT specifies how to sort entries by this column.
48 If nil, this column cannot be used for sorting.
49 If t, sort by comparing the string value printed in the column.
50 Otherwise, it should be a predicate function suitable for
51 `sort', accepting arguments with the same form as the elements
52 of `tabulated-list-entries'.
53 - PROPS is a plist of additional column properties.
54 Currently supported properties are:
55 - `:pad-right': Number of additional padding spaces to the
56 right of the column (defaults to 1 if omitted).")
57 (make-variable-buffer-local 'tabulated-list-format)
59 (defvar tabulated-list-use-header-line t
60 "Whether the Tabulated List buffer should use a header line.")
61 (make-variable-buffer-local 'tabulated-list-use-header-line)
63 (defvar tabulated-list-entries nil
64 "Entries displayed in the current Tabulated List buffer.
65 This should be either a function, or a list.
66 If a list, each element has the form (ID [DESC1 ... DESCN]),
68 - ID is nil, or a Lisp object uniquely identifying this entry,
69 which is used to keep the cursor on the \"same\" entry when
70 rearranging the list. Comparison is done with `equal'.
72 - Each DESC is a column descriptor, one for each column
73 specified in `tabulated-list-format'. A descriptor is either
74 a string, which is printed as-is, or a list (LABEL . PROPS),
75 which means to use `insert-text-button' to insert a text
76 button with label LABEL and button properties PROPS.
77 The string, or button label, must not contain any newline.
79 If `tabulated-list-entries' is a function, it is called with no
80 arguments and must return a list of the above form.")
81 (make-variable-buffer-local 'tabulated-list-entries)
83 (defvar tabulated-list-padding 0
84 "Number of characters preceding each Tabulated List mode entry.
85 By default, lines are padded with spaces, but you can use the
86 function `tabulated-list-put-tag' to change this.")
87 (make-variable-buffer-local 'tabulated-list-padding)
89 (defvar tabulated-list-revert-hook nil
90 "Hook run before reverting a Tabulated List buffer.
91 This is commonly used to recompute `tabulated-list-entries'.")
93 (defvar tabulated-list-printer 'tabulated-list-print-entry
94 "Function for inserting a Tabulated List entry at point.
95 It is called with two arguments, ID and COLS. ID is a Lisp
96 object identifying the entry, and COLS is a vector of column
97 descriptors, as documented in `tabulated-list-entries'.")
98 (make-variable-buffer-local 'tabulated-list-printer)
100 (defvar tabulated-list-sort-key nil
101 "Sort key for the current Tabulated List mode buffer.
102 If nil, no additional sorting is performed.
103 Otherwise, this should be a cons cell (NAME . FLIP).
104 NAME is a string matching one of the column names in
105 `tabulated-list-format' (the corresponding SORT entry in
106 `tabulated-list-format' then specifies how to sort). FLIP, if
107 non-nil, means to invert the resulting sort.")
108 (make-variable-buffer-local 'tabulated-list-sort-key)
110 (defsubst tabulated-list-get-id (&optional pos)
111 "Return the entry ID of the Tabulated List entry at POS.
112 The value is an ID object from `tabulated-list-entries', or nil.
113 POS, if omitted or nil, defaults to point."
114 (get-text-property (or pos (point)) 'tabulated-list-id))
116 (defsubst tabulated-list-get-entry (&optional pos)
117 "Return the Tabulated List entry at POS.
118 The value is a vector of column descriptors, or nil if there is
119 no entry at POS. POS, if omitted or nil, defaults to point."
120 (get-text-property (or pos (point)) 'tabulated-list-entry))
122 (defun tabulated-list-put-tag (tag &optional advance)
123 "Put TAG in the padding area of the current line.
124 TAG should be a string, with length <= `tabulated-list-padding'.
125 If ADVANCE is non-nil, move forward by one line afterwards."
126 (unless (stringp tag)
127 (error "Invalid argument to `tabulated-list-put-tag'"))
128 (unless (> tabulated-list-padding 0)
129 (error "Unable to tag the current line"))
132 (when (tabulated-list-get-entry)
134 (inhibit-read-only t))
135 (forward-char tabulated-list-padding)
137 (let ((width (string-width tag)))
138 (if (<= width tabulated-list-padding)
140 (make-string (- tabulated-list-padding width) ?\s))
141 (truncate-string-to-width tag tabulated-list-padding))))
142 (delete-region beg (+ beg tabulated-list-padding)))))
146 (defvar tabulated-list-mode-map
147 (let ((map (copy-keymap special-mode-map)))
148 (set-keymap-parent map button-buffer-map)
149 (define-key map "n" 'next-line)
150 (define-key map "p" 'previous-line)
151 (define-key map "S" 'tabulated-list-sort)
152 (define-key map [follow-link] 'mouse-face)
153 (define-key map [mouse-2] 'mouse-select-window)
155 "Local keymap for `tabulated-list-mode' buffers.")
157 (defvar tabulated-list-sort-button-map
158 (let ((map (make-sparse-keymap)))
159 (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
160 (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
161 (define-key map [mouse-1] 'tabulated-list-col-sort)
162 (define-key map [mouse-2] 'tabulated-list-col-sort)
163 (define-key map "\C-m" 'tabulated-list-sort)
164 (define-key map [follow-link] 'mouse-face)
166 "Local keymap for `tabulated-list-mode' sort buttons.")
168 (defvar tabulated-list-glyphless-char-display
169 (let ((table (make-char-table 'glyphless-char-display nil)))
170 (set-char-table-parent table glyphless-char-display)
171 ;; Some text terminals can't display the Unicode arrows; be safe.
172 (aset table 9650 (cons nil "^"))
173 (aset table 9660 (cons nil "v"))
175 "The `glyphless-char-display' table in Tabulated List buffers.")
177 (defvar tabulated-list--header-string nil)
178 (defvar tabulated-list--header-overlay nil)
180 (defun tabulated-list-init-header ()
181 "Set up header line for the Tabulated List buffer."
182 (let ((x (max tabulated-list-padding 0))
183 (button-props `(help-echo "Click to sort by column"
185 keymap ,tabulated-list-sort-button-map))
187 (push (propertize " " 'display `(space :align-to ,x)) cols)
188 (dotimes (n (length tabulated-list-format))
189 (let* ((col (aref tabulated-list-format n))
192 (props (nthcdr 3 col))
193 (pad-right (or (plist-get props :pad-right) 1)))
194 (setq x (+ x pad-right width))
197 ;; An unsortable column
199 (propertize label 'tabulated-list-column-name label))
200 ;; The selected sort column
201 ((equal (car col) (car tabulated-list-sort-key))
205 ((> (+ 2 (length label)) width)
207 ((cdr tabulated-list-sort-key)
211 'tabulated-list-column-name label
213 ;; Unselected sortable column.
214 (t (apply 'propertize label
215 'tabulated-list-column-name label
219 (push (propertize " "
220 'display `(space :align-to ,x)
223 (setq cols (apply 'concat (nreverse cols)))
224 (if tabulated-list-use-header-line
225 (setq header-line-format cols)
226 (setq header-line-format nil)
227 (set (make-local-variable 'tabulated-list--header-string) cols))))
229 (defun tabulated-list-print-fake-header ()
230 "Insert a fake Tabulated List \"header line\" at the start of the buffer."
231 (goto-char (point-min))
232 (let ((inhibit-read-only t))
233 (insert tabulated-list--header-string "\n")
234 (if tabulated-list--header-overlay
235 (move-overlay tabulated-list--header-overlay (point-min) (point))
236 (set (make-local-variable 'tabulated-list--header-overlay)
237 (make-overlay (point-min) (point))))
238 (overlay-put tabulated-list--header-overlay 'face 'underline)))
240 (defun tabulated-list-revert (&rest ignored)
241 "The `revert-buffer-function' for `tabulated-list-mode'.
242 It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
244 (unless (derived-mode-p 'tabulated-list-mode)
245 (error "The current buffer is not in Tabulated List mode"))
246 (run-hooks 'tabulated-list-revert-hook)
247 (tabulated-list-print t))
249 (defun tabulated-list--column-number (name)
250 (let ((len (length tabulated-list-format))
253 (while (and (< n len) (null found))
254 (if (equal (car (aref tabulated-list-format n)) name)
258 (error "No column named %s" name))))
260 (defun tabulated-list-print (&optional remember-pos)
261 "Populate the current Tabulated List mode buffer.
262 This sorts the `tabulated-list-entries' list if sorting is
263 specified by `tabulated-list-sort-key'. It then erases the
264 buffer and inserts the entries with `tabulated-list-printer'.
266 Optional argument REMEMBER-POS, if non-nil, means to move point
267 to the entry with the same ID element as the current line."
268 (let ((inhibit-read-only t)
269 (entries (if (functionp tabulated-list-entries)
270 (funcall tabulated-list-entries)
271 tabulated-list-entries))
272 entry-id saved-pt saved-col)
274 (setq entry-id (tabulated-list-get-id))
275 (setq saved-col (current-column)))
277 (unless tabulated-list-use-header-line
278 (tabulated-list-print-fake-header))
279 ;; Sort the buffers, if necessary.
280 (when (and tabulated-list-sort-key
281 (car tabulated-list-sort-key))
282 (let* ((sort-column (car tabulated-list-sort-key))
283 (n (tabulated-list--column-number sort-column))
284 (sorter (nth 2 (aref tabulated-list-format n))))
285 ;; Is the specified column sortable?
288 (setq sorter ; Default sorter checks column N:
290 (setq A (aref (cadr A) n))
291 (setq B (aref (cadr B) n))
292 (string< (if (stringp A) A (car A))
293 (if (stringp B) B (car B))))))
294 (setq entries (sort entries sorter))
295 (if (cdr tabulated-list-sort-key)
296 (setq entries (nreverse entries)))
297 (unless (functionp tabulated-list-entries)
298 (setq tabulated-list-entries entries)))))
299 ;; Print the resulting list.
300 (dolist (elt entries)
302 (equal entry-id (car elt))
303 (setq saved-pt (point)))
304 (apply tabulated-list-printer elt))
305 (set-buffer-modified-p nil)
306 ;; If REMEMBER-POS was specified, move to the "old" location.
308 (progn (goto-char saved-pt)
309 (move-to-column saved-col)
311 (goto-char (point-min)))))
313 (defun tabulated-list-print-entry (id cols)
314 "Insert a Tabulated List entry at point.
315 This is the default `tabulated-list-printer' function. ID is a
316 Lisp object identifying the entry to print, and COLS is a vector
317 of column descriptors."
319 (x (max tabulated-list-padding 0))
320 (ncols (length tabulated-list-format))
321 (inhibit-read-only t))
322 (if (> tabulated-list-padding 0)
323 (insert (make-string x ?\s)))
325 (setq x (tabulated-list-print-col n (aref cols n) x)))
327 (put-text-property beg (point) 'tabulated-list-id id)
328 (put-text-property beg (point) 'tabulated-list-entry cols)))
330 (defun tabulated-list-print-col (n col-desc x)
331 "Insert a specified Tabulated List entry at point.
332 N is the column number, COL-DESC is a column descriptor \(see
333 `tabulated-list-entries'), and X is the column number at point.
334 Return the column number after insertion."
335 (let* ((format (aref tabulated-list-format n))
336 (name (nth 0 format))
337 (width (nth 1 format))
338 (props (nthcdr 3 format))
339 (pad-right (or (plist-get props :pad-right) 1))
340 (label (if (stringp col-desc) col-desc (car col-desc)))
341 (help-echo (concat (car format) ": " label))
343 (not-last-col (< (1+ n) (length tabulated-list-format))))
344 ;; Truncate labels if necessary (except last column).
346 (> (string-width label) width)
347 (setq label (truncate-string-to-width label width nil nil t)))
348 (setq label (bidi-string-mark-left-to-right label))
349 (if (stringp col-desc)
350 (insert (propertize label 'help-echo help-echo))
351 (apply 'insert-text-button label (cdr col-desc)))
352 (setq x (+ x pad-right width))
353 ;; No need to append any spaces if this is the last column.
355 (indent-to x pad-right))
356 (put-text-property opoint (point) 'tabulated-list-column-name name)
359 (defun tabulated-list-delete-entry ()
360 "Delete the Tabulated List entry at point.
361 Return a list (ID COLS), where ID is the ID of the deleted entry
362 and COLS is a vector of its column descriptors. Move point to
363 the beginning of the deleted entry. Return nil if there is no
366 This function only changes the buffer contents; it does not alter
367 `tabulated-list-entries'."
368 ;; Assume that each entry occupies one line.
369 (let* ((id (tabulated-list-get-id))
370 (cols (tabulated-list-get-entry))
371 (inhibit-read-only t))
373 (delete-region (line-beginning-position) (1+ (line-end-position)))
376 (defun tabulated-list-set-col (col desc &optional change-entry-data)
377 "Change the Tabulated List entry at point, setting COL to DESC.
378 COL is the column number to change, or the name of the column to change.
379 DESC is the new column descriptor, which is inserted via
380 `tabulated-list-print-col'.
382 If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
383 by setting the appropriate slot of the vector originally used to
384 print this entry. If `tabulated-list-entries' has a list value,
385 this is the vector stored within it."
386 (let* ((opoint (point))
387 (eol (line-end-position))
388 (pos (line-beginning-position))
389 (id (tabulated-list-get-id pos))
390 (entry (tabulated-list-get-entry pos))
391 (prop 'tabulated-list-column-name)
392 (inhibit-read-only t)
395 (setq name (car (aref tabulated-list-format col))))
398 col (tabulated-list--column-number col)))
400 (error "Invalid column %s" col)))
402 (error "No Tabulated List entry at position %s" opoint))
403 (unless (equal (get-text-property pos prop) name)
404 (while (and (setq pos
405 (next-single-property-change pos prop nil eol))
407 (not (equal (get-text-property pos prop) name)))))
409 (delete-region pos (next-single-property-change pos prop nil eol))
411 (tabulated-list-print-col col desc (current-column))
412 (if change-entry-data
413 (aset entry col desc))
414 (put-text-property pos (point) 'tabulated-list-id id)
415 (put-text-property pos (point) 'tabulated-list-entry entry)
416 (goto-char opoint))))
418 (defun tabulated-list-col-sort (&optional e)
419 "Sort Tabulated List entries by the column of the mouse click E."
421 (let* ((pos (event-start e))
422 (obj (posn-object pos)))
423 (with-current-buffer (window-buffer (posn-window pos))
424 (tabulated-list--sort-by-column-name
425 (get-text-property (if obj (cdr obj) (posn-point pos))
426 'tabulated-list-column-name
429 (defun tabulated-list-sort (&optional n)
430 "Sort Tabulated List entries by the column at point.
431 With a numeric prefix argument N, sort the Nth column."
434 (car (aref tabulated-list-format n))
435 (get-text-property (point)
436 'tabulated-list-column-name))))
437 (tabulated-list--sort-by-column-name name)))
439 (defun tabulated-list--sort-by-column-name (name)
440 (when (and name (derived-mode-p 'tabulated-list-mode))
441 ;; Flip the sort order on a second click.
442 (if (equal name (car tabulated-list-sort-key))
443 (setcdr tabulated-list-sort-key
444 (not (cdr tabulated-list-sort-key)))
445 (setq tabulated-list-sort-key (cons name nil)))
446 (tabulated-list-init-header)
447 (tabulated-list-print t)))
449 ;;; The mode definition:
451 (define-derived-mode tabulated-list-mode special-mode "Tabulated"
452 "Generic major mode for browsing a list of items.
453 This mode is usually not used directly; instead, other major
454 modes are derived from it, using `define-derived-mode'.
456 In this major mode, the buffer is divided into multiple columns,
457 which are labeled using the header line. Each non-empty line
458 belongs to one \"entry\", and the entries can be sorted according
459 to their column values.
461 An inheriting mode should usually do the following in their body:
463 - Set `tabulated-list-format', specifying the column format.
464 - Set `tabulated-list-revert-hook', if the buffer contents need
465 to be specially recomputed prior to `revert-buffer'.
466 - Maybe set a `tabulated-list-entries' function (see below).
467 - Maybe set `tabulated-list-printer' (see below).
468 - Maybe set `tabulated-list-padding'.
469 - Call `tabulated-list-init-header' to initialize `header-line-format'
470 according to `tabulated-list-format'.
472 An inheriting mode is usually accompanied by a \"list-FOO\"
473 command (e.g. `list-packages', `list-processes'). This command
474 creates or switches to a buffer and enables the major mode in
475 that buffer. If `tabulated-list-entries' is not a function, the
476 command should initialize it to a list of entries for displaying.
477 Finally, it should call `tabulated-list-print'.
479 `tabulated-list-print' calls the printer function specified by
480 `tabulated-list-printer', once for each entry. The default
481 printer is `tabulated-list-print-entry', but a mode that keeps
482 data in an ewoc may instead specify a printer function (e.g., one
483 that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
484 as the ewoc pretty-printer."
485 (setq truncate-lines t)
486 (setq buffer-read-only t)
487 (set (make-local-variable 'revert-buffer-function)
488 'tabulated-list-revert)
489 (set (make-local-variable 'glyphless-char-display)
490 tabulated-list-glyphless-char-display))
492 (put 'tabulated-list-mode 'mode-class 'special)
494 (provide 'tabulated-list)
500 ;;; tabulated-list.el ends here