Minor declare-function improvement
[emacs.git] / lisp / emacs-lisp / tabulated-list.el
Commit [+]AuthorDateLineData
48da7392 Glenn Morris2012-01-25 22:30:49 -08001;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -04002
7e09ef09 Paul Eggert2015-01-01 14:26:41 -08003;; Copyright (C) 2011-2015 Free Software Foundation, Inc.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -04004
5;; Author: Chong Yidong <cyd@stupidchicken.com>
6;; Keywords: extensions, lisp
469bfed9 Yann Hodique2013-05-14 00:35:21 -07007;; Version: 1.0
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -04008
9;; This file is part of GNU Emacs.
10
267b82ff Glenn Morris2012-09-24 09:36:42 -070011;; GNU Emacs is free software: you can redistribute it and/or modify
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -040012;; it under the terms of the GNU General Public License as published by
267b82ff
GM
Glenn Morris2012-09-24 09:36:42 -070013;; the Free Software Foundation, either version 3 of the License, or
14;; (at your option) any later version.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040015
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
22;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23
24;;; Commentary:
25
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080026;; This file defines Tabulated List mode, a generic major mode for
27;; displaying lists of tabulated data, intended for other major modes
28;; to inherit from. It provides several utility routines, e.g. for
29;; pretty-printing lines of tabulated data to fit into the appropriate
30;; columns.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040031
32;; For usage information, see the documentation of `tabulated-list-mode'.
33
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080034;; This package originated from Tom Tromey's Package Menu mode,
35;; extended and generalized to be used by other modes.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040036
37;;; Code:
38
0ae03b6a
CY
Chong Yidong2012-05-13 22:23:45 +080039;; The reason `tabulated-list-format' and other variables are
40;; permanent-local is to make it convenient to switch to a different
41;; major mode, switch back, and have the original Tabulated List data
42;; still valid. See, for example, ebuff-menu.el.
43
47199123 Juanma Barranquero2013-06-20 13:57:33 +020044(defvar-local tabulated-list-format nil
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -040045 "The format of the current Tabulated List mode buffer.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080046This should be a vector of elements (NAME WIDTH SORT . PROPS),
47where:
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -040048 - NAME is a string describing the column.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080049 This is the label for the column in the header line.
50 Different columns must have non-`equal' names.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040051 - WIDTH is the width to reserve for the column.
52 For the final element, its numerical value is ignored.
53 - SORT specifies how to sort entries by this column.
54 If nil, this column cannot be used for sorting.
55 If t, sort by comparing the string value printed in the column.
56 Otherwise, it should be a predicate function suitable for
57 `sort', accepting arguments with the same form as the elements
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080058 of `tabulated-list-entries'.
59 - PROPS is a plist of additional column properties.
60 Currently supported properties are:
47199123 Juanma Barranquero2013-06-20 13:57:33 +020061 - `:right-align': If non-nil, the column should be right-aligned.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +080062 - `:pad-right': Number of additional padding spaces to the
63 right of the column (defaults to 1 if omitted).")
0ae03b6a Chong Yidong2012-05-13 22:23:45 +080064(put 'tabulated-list-format 'permanent-local t)
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -040065
47199123 Juanma Barranquero2013-06-20 13:57:33 +020066(defvar-local tabulated-list-use-header-line t
1241b724 Chong Yidong2012-05-07 13:37:38 +080067 "Whether the Tabulated List buffer should use a header line.")
1241b724 Chong Yidong2012-05-07 13:37:38 +080068
47199123 Juanma Barranquero2013-06-20 13:57:33 +020069(defvar-local tabulated-list-entries nil
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040070 "Entries displayed in the current Tabulated List buffer.
71This should be either a function, or a list.
72If a list, each element has the form (ID [DESC1 ... DESCN]),
73where:
74 - ID is nil, or a Lisp object uniquely identifying this entry,
75 which is used to keep the cursor on the \"same\" entry when
76 rearranging the list. Comparison is done with `equal'.
77
78 - Each DESC is a column descriptor, one for each column
79 specified in `tabulated-list-format'. A descriptor is either
80 a string, which is printed as-is, or a list (LABEL . PROPS),
81 which means to use `insert-text-button' to insert a text
82 button with label LABEL and button properties PROPS.
83 The string, or button label, must not contain any newline.
84
85If `tabulated-list-entries' is a function, it is called with no
86arguments and must return a list of the above form.")
0ae03b6a Chong Yidong2012-05-13 22:23:45 +080087(put 'tabulated-list-entries 'permanent-local t)
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -040088
47199123 Juanma Barranquero2013-06-20 13:57:33 +020089(defvar-local tabulated-list-padding 0
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040090 "Number of characters preceding each Tabulated List mode entry.
91By default, lines are padded with spaces, but you can use the
92function `tabulated-list-put-tag' to change this.")
0ae03b6a Chong Yidong2012-05-13 22:23:45 +080093(put 'tabulated-list-padding 'permanent-local t)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -040094
95(defvar tabulated-list-revert-hook nil
96 "Hook run before reverting a Tabulated List buffer.
97This is commonly used to recompute `tabulated-list-entries'.")
98
47199123 Juanma Barranquero2013-06-20 13:57:33 +020099(defvar-local tabulated-list-printer 'tabulated-list-print-entry
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400100 "Function for inserting a Tabulated List entry at point.
101It is called with two arguments, ID and COLS. ID is a Lisp
102object identifying the entry, and COLS is a vector of column
103descriptors, as documented in `tabulated-list-entries'.")
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400104
47199123 Juanma Barranquero2013-06-20 13:57:33 +0200105(defvar-local tabulated-list-sort-key nil
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400106 "Sort key for the current Tabulated List mode buffer.
107If nil, no additional sorting is performed.
108Otherwise, this should be a cons cell (NAME . FLIP).
109NAME is a string matching one of the column names in
110`tabulated-list-format' (the corresponding SORT entry in
111`tabulated-list-format' then specifies how to sort). FLIP, if
112non-nil, means to invert the resulting sort.")
0ae03b6a Chong Yidong2012-05-13 22:23:45 +0800113(put 'tabulated-list-sort-key 'permanent-local t)
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400114
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800115(defsubst tabulated-list-get-id (&optional pos)
116 "Return the entry ID of the Tabulated List entry at POS.
117The value is an ID object from `tabulated-list-entries', or nil.
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400118POS, if omitted or nil, defaults to point."
119 (get-text-property (or pos (point)) 'tabulated-list-id))
120
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800121(defsubst tabulated-list-get-entry (&optional pos)
122 "Return the Tabulated List entry at POS.
123The value is a vector of column descriptors, or nil if there is
124no entry at POS. POS, if omitted or nil, defaults to point."
125 (get-text-property (or pos (point)) 'tabulated-list-entry))
126
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400127(defun tabulated-list-put-tag (tag &optional advance)
128 "Put TAG in the padding area of the current line.
129TAG should be a string, with length <= `tabulated-list-padding'.
130If ADVANCE is non-nil, move forward by one line afterwards."
131 (unless (stringp tag)
132 (error "Invalid argument to `tabulated-list-put-tag'"))
133 (unless (> tabulated-list-padding 0)
134 (error "Unable to tag the current line"))
135 (save-excursion
136 (beginning-of-line)
6632d361 Chong Yidong2012-05-06 16:32:37 +0800137 (when (tabulated-list-get-entry)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400138 (let ((beg (point))
139 (inhibit-read-only t))
140 (forward-char tabulated-list-padding)
141 (insert-and-inherit
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800142 (let ((width (string-width tag)))
143 (if (<= width tabulated-list-padding)
144 (concat tag
145 (make-string (- tabulated-list-padding width) ?\s))
146 (truncate-string-to-width tag tabulated-list-padding))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400147 (delete-region beg (+ beg tabulated-list-padding)))))
148 (if advance
149 (forward-line)))
150
151(defvar tabulated-list-mode-map
152 (let ((map (copy-keymap special-mode-map)))
153 (set-keymap-parent map button-buffer-map)
154 (define-key map "n" 'next-line)
155 (define-key map "p" 'previous-line)
e5f9458f Chong Yidong2012-05-07 00:45:46 +0800156 (define-key map "S" 'tabulated-list-sort)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400157 (define-key map [follow-link] 'mouse-face)
158 (define-key map [mouse-2] 'mouse-select-window)
159 map)
160 "Local keymap for `tabulated-list-mode' buffers.")
161
162(defvar tabulated-list-sort-button-map
163 (let ((map (make-sparse-keymap)))
164 (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
165 (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800166 (define-key map [mouse-1] 'tabulated-list-col-sort)
167 (define-key map [mouse-2] 'tabulated-list-col-sort)
168 (define-key map "\C-m" 'tabulated-list-sort)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400169 (define-key map [follow-link] 'mouse-face)
170 map)
171 "Local keymap for `tabulated-list-mode' sort buttons.")
172
16a43933
CY
Chong Yidong2011-04-18 19:21:31 -0400173(defvar tabulated-list-glyphless-char-display
174 (let ((table (make-char-table 'glyphless-char-display nil)))
175 (set-char-table-parent table glyphless-char-display)
fe7a3057 Juanma Barranquero2011-11-20 20:35:27 +0100176 ;; Some text terminals can't display the Unicode arrows; be safe.
16a43933
CY
Chong Yidong2011-04-18 19:21:31 -0400177 (aset table 9650 (cons nil "^"))
178 (aset table 9660 (cons nil "v"))
179 table)
180 "The `glyphless-char-display' table in Tabulated List buffers.")
181
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800182(defvar tabulated-list--header-string nil)
183(defvar tabulated-list--header-overlay nil)
184
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400185(defun tabulated-list-init-header ()
186 "Set up header line for the Tabulated List buffer."
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400187 ;; FIXME: Should share code with tabulated-list-print-col!
6632d361 Chong Yidong2012-05-06 16:32:37 +0800188 (let ((x (max tabulated-list-padding 0))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400189 (button-props `(help-echo "Click to sort by column"
190 mouse-face highlight
191 keymap ,tabulated-list-sort-button-map))
192 (cols nil))
e5f9458f Chong Yidong2012-05-07 00:45:46 +0800193 (push (propertize " " 'display `(space :align-to ,x)) cols)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400194 (dotimes (n (length tabulated-list-format))
195 (let* ((col (aref tabulated-list-format n))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800196 (label (nth 0 col))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400197 (width (nth 1 col))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800198 (props (nthcdr 3 col))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400199 (pad-right (or (plist-get props :pad-right) 1))
200 (right-align (plist-get props :right-align))
201 (next-x (+ x pad-right width)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400202 (push
203 (cond
204 ;; An unsortable column
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800205 ((not (nth 2 col))
206 (propertize label 'tabulated-list-column-name label))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400207 ;; The selected sort column
208 ((equal (car col) (car tabulated-list-sort-key))
209 (apply 'propertize
210 (concat label
211 (cond
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400212 ((> (+ 2 (length label)) width) "")
213 ((cdr tabulated-list-sort-key) " ▲")
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400214 (t " ▼")))
215 'face 'bold
1241b724 Chong Yidong2012-05-07 13:37:38 +0800216 'tabulated-list-column-name label
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400217 button-props))
218 ;; Unselected sortable column.
219 (t (apply 'propertize label
1241b724 Chong Yidong2012-05-07 13:37:38 +0800220 'tabulated-list-column-name label
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400221 button-props)))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800222 cols)
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400223 (when right-align
224 (let ((shift (- width (string-width (car cols)))))
225 (when (> shift 0)
226 (setq cols
227 (cons (car cols)
228 (cons (propertize (make-string shift ?\s)
229 'display
230 `(space :align-to ,(+ x shift)))
231 (cdr cols))))
232 (setq x (+ x shift)))))
18bb9e21 Juanma Barranquero2013-06-23 15:23:49 +0200233 (if (>= pad-right 0)
6632d361 Chong Yidong2012-05-06 16:32:37 +0800234 (push (propertize " "
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400235 'display `(space :align-to ,next-x)
6632d361 Chong Yidong2012-05-06 16:32:37 +0800236 'face 'fixed-pitch)
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400237 cols))
238 (setq x next-x)))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800239 (setq cols (apply 'concat (nreverse cols)))
240 (if tabulated-list-use-header-line
241 (setq header-line-format cols)
242 (setq header-line-format nil)
47199123 Juanma Barranquero2013-06-20 13:57:33 +0200243 (setq-local tabulated-list--header-string cols))))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800244
245(defun tabulated-list-print-fake-header ()
246 "Insert a fake Tabulated List \"header line\" at the start of the buffer."
247 (goto-char (point-min))
248 (let ((inhibit-read-only t))
249 (insert tabulated-list--header-string "\n")
250 (if tabulated-list--header-overlay
251 (move-overlay tabulated-list--header-overlay (point-min) (point))
47199123
JB
Juanma Barranquero2013-06-20 13:57:33 +0200252 (setq-local tabulated-list--header-overlay
253 (make-overlay (point-min) (point))))
1241b724 Chong Yidong2012-05-07 13:37:38 +0800254 (overlay-put tabulated-list--header-overlay 'face 'underline)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400255
256(defun tabulated-list-revert (&rest ignored)
257 "The `revert-buffer-function' for `tabulated-list-mode'.
258It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
259 (interactive)
260 (unless (derived-mode-p 'tabulated-list-mode)
261 (error "The current buffer is not in Tabulated List mode"))
262 (run-hooks 'tabulated-list-revert-hook)
263 (tabulated-list-print t))
264
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800265(defun tabulated-list--column-number (name)
266 (let ((len (length tabulated-list-format))
267 (n 0)
268 found)
269 (while (and (< n len) (null found))
270 (if (equal (car (aref tabulated-list-format n)) name)
271 (setq found n))
272 (setq n (1+ n)))
273 (or found
274 (error "No column named %s" name))))
275
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400276(defun tabulated-list-print (&optional remember-pos)
277 "Populate the current Tabulated List mode buffer.
278This sorts the `tabulated-list-entries' list if sorting is
279specified by `tabulated-list-sort-key'. It then erases the
280buffer and inserts the entries with `tabulated-list-printer'.
281
282Optional argument REMEMBER-POS, if non-nil, means to move point
283to the entry with the same ID element as the current line."
284 (let ((inhibit-read-only t)
2c070447 Chong Yidong2012-04-17 23:07:21 +0800285 (entries (if (functionp tabulated-list-entries)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400286 (funcall tabulated-list-entries)
287 tabulated-list-entries))
288 entry-id saved-pt saved-col)
289 (and remember-pos
290 (setq entry-id (tabulated-list-get-id))
291 (setq saved-col (current-column)))
292 (erase-buffer)
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800293 (unless tabulated-list-use-header-line
294 (tabulated-list-print-fake-header))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400295 ;; Sort the entries, if necessary.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800296 (when (and tabulated-list-sort-key
297 (car tabulated-list-sort-key))
298 (let* ((sort-column (car tabulated-list-sort-key))
299 (n (tabulated-list--column-number sort-column))
300 (sorter (nth 2 (aref tabulated-list-format n))))
301 ;; Is the specified column sortable?
302 (when sorter
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400303 (when (eq sorter t)
304 (setq sorter ; Default sorter checks column N:
e67a13ab
CY
Chong Yidong2011-04-06 17:55:08 -0400305 (lambda (A B)
306 (setq A (aref (cadr A) n))
307 (setq B (aref (cadr B) n))
308 (string< (if (stringp A) A (car A))
309 (if (stringp B) B (car B))))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400310 (setq entries (sort entries sorter))
311 (if (cdr tabulated-list-sort-key)
312 (setq entries (nreverse entries)))
2c070447 Chong Yidong2012-04-17 23:07:21 +0800313 (unless (functionp tabulated-list-entries)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400314 (setq tabulated-list-entries entries)))))
315 ;; Print the resulting list.
316 (dolist (elt entries)
317 (and entry-id
318 (equal entry-id (car elt))
319 (setq saved-pt (point)))
320 (apply tabulated-list-printer elt))
321 (set-buffer-modified-p nil)
322 ;; If REMEMBER-POS was specified, move to the "old" location.
323 (if saved-pt
324 (progn (goto-char saved-pt)
3e26a4a2 Chong Yidong2011-08-10 15:03:56 -0400325 (move-to-column saved-col)
4a816020
ML
Mario Lang2014-06-06 02:39:22 +0200326 (when (eq (window-buffer) (current-buffer))
327 (recenter)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400328 (goto-char (point-min)))))
329
330(defun tabulated-list-print-entry (id cols)
331 "Insert a Tabulated List entry at point.
332This is the default `tabulated-list-printer' function. ID is a
333Lisp object identifying the entry to print, and COLS is a vector
334of column descriptors."
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800335 (let ((beg (point))
336 (x (max tabulated-list-padding 0))
337 (ncols (length tabulated-list-format))
338 (inhibit-read-only t))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400339 (if (> tabulated-list-padding 0)
340 (insert (make-string x ?\s)))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800341 (dotimes (n ncols)
342 (setq x (tabulated-list-print-col n (aref cols n) x)))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400343 (insert ?\n)
f4ad4293
AM
Artur Malabarba2015-04-30 02:27:10 +0100344 ;; Ever so slightly faster than calling `put-text-property' twice.
345 (add-text-properties
346 beg (point)
347 `(tabulated-list-id ,id tabulated-list-entry ,cols))))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800348
349(defun tabulated-list-print-col (n col-desc x)
350 "Insert a specified Tabulated List entry at point.
47199123 Juanma Barranquero2013-06-20 13:57:33 +0200351N is the column number, COL-DESC is a column descriptor (see
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800352`tabulated-list-entries'), and X is the column number at point.
353Return the column number after insertion."
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400354 ;; TODO: don't truncate to `width' if the next column is align-right
355 ;; and has some space left.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800356 (let* ((format (aref tabulated-list-format n))
357 (name (nth 0 format))
358 (width (nth 1 format))
359 (props (nthcdr 3 format))
360 (pad-right (or (plist-get props :pad-right) 1))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400361 (right-align (plist-get props :right-align))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800362 (label (if (stringp col-desc) col-desc (car col-desc)))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400363 (label-width (string-width label))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800364 (help-echo (concat (car format) ": " label))
365 (opoint (point))
366 (not-last-col (< (1+ n) (length tabulated-list-format))))
367 ;; Truncate labels if necessary (except last column).
368 (and not-last-col
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400369 (> label-width width)
370 (setq label (truncate-string-to-width label width nil nil t)
371 label-width width))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800372 (setq label (bidi-string-mark-left-to-right label))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400373 (when (and right-align (> width label-width))
374 (let ((shift (- width label-width)))
375 (insert (propertize (make-string shift ?\s)
376 'display `(space :align-to ,(+ x shift))))
377 (setq width (- width shift))
378 (setq x (+ x shift))))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800379 (if (stringp col-desc)
6b6d804b
JB
Jonas Bernoulli2013-02-15 18:50:44 -0800380 (insert (if (get-text-property 0 'help-echo label)
381 label
382 (propertize label 'help-echo help-echo)))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800383 (apply 'insert-text-button label (cdr col-desc)))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400384 (let ((next-x (+ x pad-right width)))
385 ;; No need to append any spaces if this is the last column.
386 (when not-last-col
387 (when (> pad-right 0) (insert (make-string pad-right ?\s)))
388 (insert (propertize
389 (make-string (- next-x x label-width pad-right) ?\s)
390 'display `(space :align-to ,next-x))))
391 (put-text-property opoint (point) 'tabulated-list-column-name name)
392 next-x)))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800393
394(defun tabulated-list-delete-entry ()
395 "Delete the Tabulated List entry at point.
396Return a list (ID COLS), where ID is the ID of the deleted entry
397and COLS is a vector of its column descriptors. Move point to
398the beginning of the deleted entry. Return nil if there is no
399entry at point.
400
401This function only changes the buffer contents; it does not alter
402`tabulated-list-entries'."
403 ;; Assume that each entry occupies one line.
404 (let* ((id (tabulated-list-get-id))
405 (cols (tabulated-list-get-entry))
406 (inhibit-read-only t))
407 (when cols
408 (delete-region (line-beginning-position) (1+ (line-end-position)))
409 (list id cols))))
410
411(defun tabulated-list-set-col (col desc &optional change-entry-data)
412 "Change the Tabulated List entry at point, setting COL to DESC.
413COL is the column number to change, or the name of the column to change.
414DESC is the new column descriptor, which is inserted via
415`tabulated-list-print-col'.
416
417If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
418by setting the appropriate slot of the vector originally used to
419print this entry. If `tabulated-list-entries' has a list value,
420this is the vector stored within it."
421 (let* ((opoint (point))
422 (eol (line-end-position))
423 (pos (line-beginning-position))
424 (id (tabulated-list-get-id pos))
425 (entry (tabulated-list-get-entry pos))
426 (prop 'tabulated-list-column-name)
427 (inhibit-read-only t)
428 name)
429 (cond ((numberp col)
430 (setq name (car (aref tabulated-list-format col))))
431 ((stringp col)
432 (setq name col
433 col (tabulated-list--column-number col)))
434 (t
435 (error "Invalid column %s" col)))
436 (unless entry
437 (error "No Tabulated List entry at position %s" opoint))
438 (unless (equal (get-text-property pos prop) name)
439 (while (and (setq pos
440 (next-single-property-change pos prop nil eol))
441 (< pos eol)
442 (not (equal (get-text-property pos prop) name)))))
443 (when (< pos eol)
444 (delete-region pos (next-single-property-change pos prop nil eol))
445 (goto-char pos)
446 (tabulated-list-print-col col desc (current-column))
447 (if change-entry-data
448 (aset entry col desc))
449 (put-text-property pos (point) 'tabulated-list-id id)
450 (put-text-property pos (point) 'tabulated-list-entry entry)
451 (goto-char opoint))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400452
453(defun tabulated-list-col-sort (&optional e)
454 "Sort Tabulated List entries by the column of the mouse click E."
455 (interactive "e")
456 (let* ((pos (event-start e))
1241b724 Chong Yidong2012-05-07 13:37:38 +0800457 (obj (posn-object pos)))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400458 (with-current-buffer (window-buffer (posn-window pos))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800459 (tabulated-list--sort-by-column-name
460 (get-text-property (if obj (cdr obj) (posn-point pos))
461 'tabulated-list-column-name
462 (car obj))))))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800463
e5f9458f Chong Yidong2012-05-07 00:45:46 +0800464(defun tabulated-list-sort (&optional n)
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800465 "Sort Tabulated List entries by the column at point.
466With a numeric prefix argument N, sort the Nth column."
467 (interactive "P")
468 (let ((name (if n
469 (car (aref tabulated-list-format n))
470 (get-text-property (point)
471 'tabulated-list-column-name))))
472 (tabulated-list--sort-by-column-name name)))
473
474(defun tabulated-list--sort-by-column-name (name)
1241b724 Chong Yidong2012-05-07 13:37:38 +0800475 (when (and name (derived-mode-p 'tabulated-list-mode))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800476 ;; Flip the sort order on a second click.
477 (if (equal name (car tabulated-list-sort-key))
478 (setcdr tabulated-list-sort-key
479 (not (cdr tabulated-list-sort-key)))
480 (setq tabulated-list-sort-key (cons name nil)))
481 (tabulated-list-init-header)
482 (tabulated-list-print t)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400483
484;;; The mode definition:
485
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400486(define-derived-mode tabulated-list-mode special-mode "Tabulated"
487 "Generic major mode for browsing a list of items.
488This mode is usually not used directly; instead, other major
489modes are derived from it, using `define-derived-mode'.
490
491In this major mode, the buffer is divided into multiple columns,
09e80d9f Paul Eggert2011-11-13 22:27:12 -0800492which are labeled using the header line. Each non-empty line
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400493belongs to one \"entry\", and the entries can be sorted according
494to their column values.
495
496An inheriting mode should usually do the following in their body:
497
498 - Set `tabulated-list-format', specifying the column format.
499 - Set `tabulated-list-revert-hook', if the buffer contents need
500 to be specially recomputed prior to `revert-buffer'.
501 - Maybe set a `tabulated-list-entries' function (see below).
502 - Maybe set `tabulated-list-printer' (see below).
503 - Maybe set `tabulated-list-padding'.
504 - Call `tabulated-list-init-header' to initialize `header-line-format'
505 according to `tabulated-list-format'.
506
507An inheriting mode is usually accompanied by a \"list-FOO\"
508command (e.g. `list-packages', `list-processes'). This command
509creates or switches to a buffer and enables the major mode in
510that buffer. If `tabulated-list-entries' is not a function, the
511command should initialize it to a list of entries for displaying.
512Finally, it should call `tabulated-list-print'.
513
514`tabulated-list-print' calls the printer function specified by
515`tabulated-list-printer', once for each entry. The default
516printer is `tabulated-list-print-entry', but a mode that keeps
517data in an ewoc may instead specify a printer function (e.g., one
518that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
519as the ewoc pretty-printer."
140ef50c
SM
Stefan Monnier2013-04-26 10:47:07 -0400520 (setq-local truncate-lines t)
521 (setq-local buffer-read-only t)
522 (setq-local buffer-undo-list t)
523 (setq-local revert-buffer-function #'tabulated-list-revert)
1d4795e8
EZ
Eli Zaretskii2014-10-14 22:29:47 +0300524 (setq-local glyphless-char-display tabulated-list-glyphless-char-display)
525 ;; Avoid messing up the entries' display just because the first
526 ;; column of the first entry happens to begin with a R2L letter.
527 (setq bidi-paragraph-direction 'left-to-right))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400528
529(put 'tabulated-list-mode 'mode-class 'special)
530
531(provide 'tabulated-list)
532
533;; Local Variables:
534;; coding: utf-8
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400535;; End:
536
537;;; tabulated-list.el ends here