* lisp/emacs-lisp/package.el (package-selected-packages): Fix doc
[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
a96731d7
AM
Artur Malabarba2015-05-16 09:52:53 +0100182(defvar tabulated-list--header-string nil
183 "Holds the header if `tabulated-list-use-header-line' is nil.
184Populated by `tabulated-list-init-header'.")
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800185(defvar tabulated-list--header-overlay nil)
186
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400187(defun tabulated-list-init-header ()
188 "Set up header line for the Tabulated List buffer."
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400189 ;; FIXME: Should share code with tabulated-list-print-col!
6632d361 Chong Yidong2012-05-06 16:32:37 +0800190 (let ((x (max tabulated-list-padding 0))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400191 (button-props `(help-echo "Click to sort by column"
192 mouse-face highlight
193 keymap ,tabulated-list-sort-button-map))
194 (cols nil))
e5f9458f Chong Yidong2012-05-07 00:45:46 +0800195 (push (propertize " " 'display `(space :align-to ,x)) cols)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400196 (dotimes (n (length tabulated-list-format))
197 (let* ((col (aref tabulated-list-format n))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800198 (label (nth 0 col))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400199 (width (nth 1 col))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800200 (props (nthcdr 3 col))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400201 (pad-right (or (plist-get props :pad-right) 1))
202 (right-align (plist-get props :right-align))
203 (next-x (+ x pad-right width)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400204 (push
205 (cond
206 ;; An unsortable column
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800207 ((not (nth 2 col))
208 (propertize label 'tabulated-list-column-name label))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400209 ;; The selected sort column
210 ((equal (car col) (car tabulated-list-sort-key))
211 (apply 'propertize
212 (concat label
213 (cond
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400214 ((> (+ 2 (length label)) width) "")
215 ((cdr tabulated-list-sort-key) " ▲")
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400216 (t " ▼")))
217 'face 'bold
1241b724 Chong Yidong2012-05-07 13:37:38 +0800218 'tabulated-list-column-name label
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400219 button-props))
220 ;; Unselected sortable column.
221 (t (apply 'propertize label
1241b724 Chong Yidong2012-05-07 13:37:38 +0800222 'tabulated-list-column-name label
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400223 button-props)))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800224 cols)
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400225 (when right-align
226 (let ((shift (- width (string-width (car cols)))))
227 (when (> shift 0)
228 (setq cols
229 (cons (car cols)
230 (cons (propertize (make-string shift ?\s)
231 'display
232 `(space :align-to ,(+ x shift)))
233 (cdr cols))))
234 (setq x (+ x shift)))))
18bb9e21 Juanma Barranquero2013-06-23 15:23:49 +0200235 (if (>= pad-right 0)
6632d361 Chong Yidong2012-05-06 16:32:37 +0800236 (push (propertize " "
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400237 'display `(space :align-to ,next-x)
6632d361 Chong Yidong2012-05-06 16:32:37 +0800238 'face 'fixed-pitch)
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400239 cols))
240 (setq x next-x)))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800241 (setq cols (apply 'concat (nreverse cols)))
242 (if tabulated-list-use-header-line
243 (setq header-line-format cols)
244 (setq header-line-format nil)
47199123 Juanma Barranquero2013-06-20 13:57:33 +0200245 (setq-local tabulated-list--header-string cols))))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800246
247(defun tabulated-list-print-fake-header ()
a96731d7
AM
Artur Malabarba2015-05-16 09:52:53 +0100248 "Insert a fake Tabulated List \"header line\" at the start of the buffer.
249Do nothing if `tabulated-list--header-string' is nil."
250 (when tabulated-list--header-string
251 (goto-char (point-min))
252 (let ((inhibit-read-only t))
253 (insert tabulated-list--header-string "\n")
254 (if tabulated-list--header-overlay
255 (move-overlay tabulated-list--header-overlay (point-min) (point))
256 (setq-local tabulated-list--header-overlay
257 (make-overlay (point-min) (point))))
258 (overlay-put tabulated-list--header-overlay 'face 'underline))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400259
260(defun tabulated-list-revert (&rest ignored)
261 "The `revert-buffer-function' for `tabulated-list-mode'.
262It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
263 (interactive)
264 (unless (derived-mode-p 'tabulated-list-mode)
265 (error "The current buffer is not in Tabulated List mode"))
266 (run-hooks 'tabulated-list-revert-hook)
267 (tabulated-list-print t))
268
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800269(defun tabulated-list--column-number (name)
270 (let ((len (length tabulated-list-format))
271 (n 0)
272 found)
273 (while (and (< n len) (null found))
274 (if (equal (car (aref tabulated-list-format n)) name)
275 (setq found n))
276 (setq n (1+ n)))
277 (or found
278 (error "No column named %s" name))))
279
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400280(defun tabulated-list-print (&optional remember-pos)
281 "Populate the current Tabulated List mode buffer.
282This sorts the `tabulated-list-entries' list if sorting is
283specified by `tabulated-list-sort-key'. It then erases the
284buffer and inserts the entries with `tabulated-list-printer'.
285
286Optional argument REMEMBER-POS, if non-nil, means to move point
287to the entry with the same ID element as the current line."
288 (let ((inhibit-read-only t)
2c070447 Chong Yidong2012-04-17 23:07:21 +0800289 (entries (if (functionp tabulated-list-entries)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400290 (funcall tabulated-list-entries)
291 tabulated-list-entries))
292 entry-id saved-pt saved-col)
293 (and remember-pos
294 (setq entry-id (tabulated-list-get-id))
295 (setq saved-col (current-column)))
296 (erase-buffer)
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800297 (unless tabulated-list-use-header-line
298 (tabulated-list-print-fake-header))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400299 ;; Sort the entries, if necessary.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800300 (when (and tabulated-list-sort-key
301 (car tabulated-list-sort-key))
302 (let* ((sort-column (car tabulated-list-sort-key))
303 (n (tabulated-list--column-number sort-column))
304 (sorter (nth 2 (aref tabulated-list-format n))))
305 ;; Is the specified column sortable?
306 (when sorter
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400307 (when (eq sorter t)
308 (setq sorter ; Default sorter checks column N:
e67a13ab
CY
Chong Yidong2011-04-06 17:55:08 -0400309 (lambda (A B)
310 (setq A (aref (cadr A) n))
311 (setq B (aref (cadr B) n))
312 (string< (if (stringp A) A (car A))
313 (if (stringp B) B (car B))))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400314 (setq entries (sort entries sorter))
315 (if (cdr tabulated-list-sort-key)
316 (setq entries (nreverse entries)))
2c070447 Chong Yidong2012-04-17 23:07:21 +0800317 (unless (functionp tabulated-list-entries)
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400318 (setq tabulated-list-entries entries)))))
319 ;; Print the resulting list.
320 (dolist (elt entries)
321 (and entry-id
322 (equal entry-id (car elt))
323 (setq saved-pt (point)))
324 (apply tabulated-list-printer elt))
325 (set-buffer-modified-p nil)
326 ;; If REMEMBER-POS was specified, move to the "old" location.
327 (if saved-pt
328 (progn (goto-char saved-pt)
3e26a4a2 Chong Yidong2011-08-10 15:03:56 -0400329 (move-to-column saved-col)
4a816020
ML
Mario Lang2014-06-06 02:39:22 +0200330 (when (eq (window-buffer) (current-buffer))
331 (recenter)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400332 (goto-char (point-min)))))
333
334(defun tabulated-list-print-entry (id cols)
335 "Insert a Tabulated List entry at point.
336This is the default `tabulated-list-printer' function. ID is a
337Lisp object identifying the entry to print, and COLS is a vector
338of column descriptors."
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800339 (let ((beg (point))
340 (x (max tabulated-list-padding 0))
341 (ncols (length tabulated-list-format))
342 (inhibit-read-only t))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400343 (if (> tabulated-list-padding 0)
344 (insert (make-string x ?\s)))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800345 (dotimes (n ncols)
346 (setq x (tabulated-list-print-col n (aref cols n) x)))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400347 (insert ?\n)
f4ad4293
AM
Artur Malabarba2015-04-30 02:27:10 +0100348 ;; Ever so slightly faster than calling `put-text-property' twice.
349 (add-text-properties
350 beg (point)
351 `(tabulated-list-id ,id tabulated-list-entry ,cols))))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800352
353(defun tabulated-list-print-col (n col-desc x)
354 "Insert a specified Tabulated List entry at point.
47199123 Juanma Barranquero2013-06-20 13:57:33 +0200355N is the column number, COL-DESC is a column descriptor (see
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800356`tabulated-list-entries'), and X is the column number at point.
357Return the column number after insertion."
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400358 ;; TODO: don't truncate to `width' if the next column is align-right
359 ;; and has some space left.
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800360 (let* ((format (aref tabulated-list-format n))
361 (name (nth 0 format))
362 (width (nth 1 format))
363 (props (nthcdr 3 format))
364 (pad-right (or (plist-get props :pad-right) 1))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400365 (right-align (plist-get props :right-align))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800366 (label (if (stringp col-desc) col-desc (car col-desc)))
f0809a9d Stefan Monnier2012-05-07 12:29:55 -0400367 (label-width (string-width label))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800368 (help-echo (concat (car format) ": " label))
369 (opoint (point))
370 (not-last-col (< (1+ n) (length tabulated-list-format))))
371 ;; Truncate labels if necessary (except last column).
372 (and not-last-col
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400373 (> label-width width)
374 (setq label (truncate-string-to-width label width nil nil t)
375 label-width width))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800376 (setq label (bidi-string-mark-left-to-right label))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400377 (when (and right-align (> width label-width))
378 (let ((shift (- width label-width)))
379 (insert (propertize (make-string shift ?\s)
380 'display `(space :align-to ,(+ x shift))))
381 (setq width (- width shift))
382 (setq x (+ x shift))))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800383 (if (stringp col-desc)
6b6d804b
JB
Jonas Bernoulli2013-02-15 18:50:44 -0800384 (insert (if (get-text-property 0 'help-echo label)
385 label
386 (propertize label 'help-echo help-echo)))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800387 (apply 'insert-text-button label (cdr col-desc)))
f0809a9d
SM
Stefan Monnier2012-05-07 12:29:55 -0400388 (let ((next-x (+ x pad-right width)))
389 ;; No need to append any spaces if this is the last column.
390 (when not-last-col
391 (when (> pad-right 0) (insert (make-string pad-right ?\s)))
392 (insert (propertize
393 (make-string (- next-x x label-width pad-right) ?\s)
394 'display `(space :align-to ,next-x))))
395 (put-text-property opoint (point) 'tabulated-list-column-name name)
396 next-x)))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800397
398(defun tabulated-list-delete-entry ()
399 "Delete the Tabulated List entry at point.
400Return a list (ID COLS), where ID is the ID of the deleted entry
401and COLS is a vector of its column descriptors. Move point to
402the beginning of the deleted entry. Return nil if there is no
403entry at point.
404
405This function only changes the buffer contents; it does not alter
406`tabulated-list-entries'."
407 ;; Assume that each entry occupies one line.
408 (let* ((id (tabulated-list-get-id))
409 (cols (tabulated-list-get-entry))
410 (inhibit-read-only t))
411 (when cols
412 (delete-region (line-beginning-position) (1+ (line-end-position)))
413 (list id cols))))
414
415(defun tabulated-list-set-col (col desc &optional change-entry-data)
416 "Change the Tabulated List entry at point, setting COL to DESC.
417COL is the column number to change, or the name of the column to change.
418DESC is the new column descriptor, which is inserted via
419`tabulated-list-print-col'.
420
421If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
422by setting the appropriate slot of the vector originally used to
423print this entry. If `tabulated-list-entries' has a list value,
424this is the vector stored within it."
425 (let* ((opoint (point))
426 (eol (line-end-position))
427 (pos (line-beginning-position))
428 (id (tabulated-list-get-id pos))
429 (entry (tabulated-list-get-entry pos))
430 (prop 'tabulated-list-column-name)
431 (inhibit-read-only t)
432 name)
433 (cond ((numberp col)
434 (setq name (car (aref tabulated-list-format col))))
435 ((stringp col)
436 (setq name col
437 col (tabulated-list--column-number col)))
438 (t
439 (error "Invalid column %s" col)))
440 (unless entry
441 (error "No Tabulated List entry at position %s" opoint))
442 (unless (equal (get-text-property pos prop) name)
443 (while (and (setq pos
444 (next-single-property-change pos prop nil eol))
445 (< pos eol)
446 (not (equal (get-text-property pos prop) name)))))
447 (when (< pos eol)
448 (delete-region pos (next-single-property-change pos prop nil eol))
449 (goto-char pos)
450 (tabulated-list-print-col col desc (current-column))
451 (if change-entry-data
452 (aset entry col desc))
453 (put-text-property pos (point) 'tabulated-list-id id)
454 (put-text-property pos (point) 'tabulated-list-entry entry)
455 (goto-char opoint))))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400456
457(defun tabulated-list-col-sort (&optional e)
458 "Sort Tabulated List entries by the column of the mouse click E."
459 (interactive "e")
460 (let* ((pos (event-start e))
1241b724 Chong Yidong2012-05-07 13:37:38 +0800461 (obj (posn-object pos)))
a83ec3c9 Chong Yidong2011-04-06 16:10:51 -0400462 (with-current-buffer (window-buffer (posn-window pos))
1241b724
CY
Chong Yidong2012-05-07 13:37:38 +0800463 (tabulated-list--sort-by-column-name
464 (get-text-property (if obj (cdr obj) (posn-point pos))
465 'tabulated-list-column-name
466 (car obj))))))
6632d361 Chong Yidong2012-05-06 16:32:37 +0800467
e5f9458f Chong Yidong2012-05-07 00:45:46 +0800468(defun tabulated-list-sort (&optional n)
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800469 "Sort Tabulated List entries by the column at point.
470With a numeric prefix argument N, sort the Nth column."
471 (interactive "P")
472 (let ((name (if n
473 (car (aref tabulated-list-format n))
474 (get-text-property (point)
475 'tabulated-list-column-name))))
476 (tabulated-list--sort-by-column-name name)))
477
478(defun tabulated-list--sort-by-column-name (name)
1241b724 Chong Yidong2012-05-07 13:37:38 +0800479 (when (and name (derived-mode-p 'tabulated-list-mode))
6632d361
CY
Chong Yidong2012-05-06 16:32:37 +0800480 ;; Flip the sort order on a second click.
481 (if (equal name (car tabulated-list-sort-key))
482 (setcdr tabulated-list-sort-key
483 (not (cdr tabulated-list-sort-key)))
484 (setq tabulated-list-sort-key (cons name nil)))
485 (tabulated-list-init-header)
486 (tabulated-list-print t)))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400487
488;;; The mode definition:
489
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400490(define-derived-mode tabulated-list-mode special-mode "Tabulated"
491 "Generic major mode for browsing a list of items.
492This mode is usually not used directly; instead, other major
493modes are derived from it, using `define-derived-mode'.
494
495In this major mode, the buffer is divided into multiple columns,
09e80d9f Paul Eggert2011-11-13 22:27:12 -0800496which are labeled using the header line. Each non-empty line
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400497belongs to one \"entry\", and the entries can be sorted according
498to their column values.
499
500An inheriting mode should usually do the following in their body:
501
502 - Set `tabulated-list-format', specifying the column format.
503 - Set `tabulated-list-revert-hook', if the buffer contents need
504 to be specially recomputed prior to `revert-buffer'.
505 - Maybe set a `tabulated-list-entries' function (see below).
506 - Maybe set `tabulated-list-printer' (see below).
507 - Maybe set `tabulated-list-padding'.
508 - Call `tabulated-list-init-header' to initialize `header-line-format'
509 according to `tabulated-list-format'.
510
511An inheriting mode is usually accompanied by a \"list-FOO\"
512command (e.g. `list-packages', `list-processes'). This command
513creates or switches to a buffer and enables the major mode in
514that buffer. If `tabulated-list-entries' is not a function, the
515command should initialize it to a list of entries for displaying.
516Finally, it should call `tabulated-list-print'.
517
518`tabulated-list-print' calls the printer function specified by
519`tabulated-list-printer', once for each entry. The default
520printer is `tabulated-list-print-entry', but a mode that keeps
521data in an ewoc may instead specify a printer function (e.g., one
522that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
523as the ewoc pretty-printer."
140ef50c
SM
Stefan Monnier2013-04-26 10:47:07 -0400524 (setq-local truncate-lines t)
525 (setq-local buffer-read-only t)
526 (setq-local buffer-undo-list t)
527 (setq-local revert-buffer-function #'tabulated-list-revert)
1d4795e8
EZ
Eli Zaretskii2014-10-14 22:29:47 +0300528 (setq-local glyphless-char-display tabulated-list-glyphless-char-display)
529 ;; Avoid messing up the entries' display just because the first
530 ;; column of the first entry happens to begin with a R2L letter.
531 (setq bidi-paragraph-direction 'left-to-right))
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400532
533(put 'tabulated-list-mode 'mode-class 'special)
534
535(provide 'tabulated-list)
536
537;; Local Variables:
538;; coding: utf-8
a83ec3c9
CY
Chong Yidong2011-04-06 16:10:51 -0400539;; End:
540
541;;; tabulated-list.el ends here