Commit | Line | Data |
---|---|---|
48da7392 | 1 | ;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*- |
a83ec3c9 | 2 | |
ba318903 | 3 | ;; Copyright (C) 2011-2014 Free Software Foundation, Inc. |
a83ec3c9 CY |
4 | |
5 | ;; Author: Chong Yidong <cyd@stupidchicken.com> | |
6 | ;; Keywords: extensions, lisp | |
469bfed9 | 7 | ;; Version: 1.0 |
a83ec3c9 CY |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
267b82ff | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
a83ec3c9 | 12 | ;; it under the terms of the GNU General Public License as published by |
267b82ff GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
a83ec3c9 CY |
15 | |
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 |
26 | ;; 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 |
31 | |
32 | ;; For usage information, see the documentation of `tabulated-list-mode'. | |
33 | ||
6632d361 CY |
34 | ;; This package originated from Tom Tromey's Package Menu mode, |
35 | ;; extended and generalized to be used by other modes. | |
a83ec3c9 CY |
36 | |
37 | ;;; Code: | |
38 | ||
0ae03b6a CY |
39 | ;; 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 | 44 | (defvar-local tabulated-list-format nil |
a83ec3c9 | 45 | "The format of the current Tabulated List mode buffer. |
6632d361 CY |
46 | This should be a vector of elements (NAME WIDTH SORT . PROPS), |
47 | where: | |
a83ec3c9 | 48 | - NAME is a string describing the column. |
6632d361 CY |
49 | This is the label for the column in the header line. |
50 | Different columns must have non-`equal' names. | |
a83ec3c9 CY |
51 | - 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 |
58 | of `tabulated-list-entries'. |
59 | - PROPS is a plist of additional column properties. | |
60 | Currently supported properties are: | |
47199123 | 61 | - `:right-align': If non-nil, the column should be right-aligned. |
6632d361 CY |
62 | - `:pad-right': Number of additional padding spaces to the |
63 | right of the column (defaults to 1 if omitted).") | |
0ae03b6a | 64 | (put 'tabulated-list-format 'permanent-local t) |
a83ec3c9 | 65 | |
47199123 | 66 | (defvar-local tabulated-list-use-header-line t |
1241b724 | 67 | "Whether the Tabulated List buffer should use a header line.") |
1241b724 | 68 | |
47199123 | 69 | (defvar-local tabulated-list-entries nil |
a83ec3c9 CY |
70 | "Entries displayed in the current Tabulated List buffer. |
71 | This should be either a function, or a list. | |
72 | If a list, each element has the form (ID [DESC1 ... DESCN]), | |
73 | where: | |
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 | ||
85 | If `tabulated-list-entries' is a function, it is called with no | |
86 | arguments and must return a list of the above form.") | |
0ae03b6a | 87 | (put 'tabulated-list-entries 'permanent-local t) |
a83ec3c9 | 88 | |
47199123 | 89 | (defvar-local tabulated-list-padding 0 |
a83ec3c9 CY |
90 | "Number of characters preceding each Tabulated List mode entry. |
91 | By default, lines are padded with spaces, but you can use the | |
92 | function `tabulated-list-put-tag' to change this.") | |
0ae03b6a | 93 | (put 'tabulated-list-padding 'permanent-local t) |
a83ec3c9 CY |
94 | |
95 | (defvar tabulated-list-revert-hook nil | |
96 | "Hook run before reverting a Tabulated List buffer. | |
97 | This is commonly used to recompute `tabulated-list-entries'.") | |
98 | ||
47199123 | 99 | (defvar-local tabulated-list-printer 'tabulated-list-print-entry |
a83ec3c9 CY |
100 | "Function for inserting a Tabulated List entry at point. |
101 | It is called with two arguments, ID and COLS. ID is a Lisp | |
102 | object identifying the entry, and COLS is a vector of column | |
103 | descriptors, as documented in `tabulated-list-entries'.") | |
a83ec3c9 | 104 | |
47199123 | 105 | (defvar-local tabulated-list-sort-key nil |
a83ec3c9 CY |
106 | "Sort key for the current Tabulated List mode buffer. |
107 | If nil, no additional sorting is performed. | |
108 | Otherwise, this should be a cons cell (NAME . FLIP). | |
109 | NAME 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 | |
112 | non-nil, means to invert the resulting sort.") | |
0ae03b6a | 113 | (put 'tabulated-list-sort-key 'permanent-local t) |
a83ec3c9 | 114 | |
6632d361 CY |
115 | (defsubst tabulated-list-get-id (&optional pos) |
116 | "Return the entry ID of the Tabulated List entry at POS. | |
117 | The value is an ID object from `tabulated-list-entries', or nil. | |
a83ec3c9 CY |
118 | POS, if omitted or nil, defaults to point." |
119 | (get-text-property (or pos (point)) 'tabulated-list-id)) | |
120 | ||
6632d361 CY |
121 | (defsubst tabulated-list-get-entry (&optional pos) |
122 | "Return the Tabulated List entry at POS. | |
123 | The value is a vector of column descriptors, or nil if there is | |
124 | no entry at POS. POS, if omitted or nil, defaults to point." | |
125 | (get-text-property (or pos (point)) 'tabulated-list-entry)) | |
126 | ||
a83ec3c9 CY |
127 | (defun tabulated-list-put-tag (tag &optional advance) |
128 | "Put TAG in the padding area of the current line. | |
129 | TAG should be a string, with length <= `tabulated-list-padding'. | |
130 | If 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 | 137 | (when (tabulated-list-get-entry) |
a83ec3c9 CY |
138 | (let ((beg (point)) |
139 | (inhibit-read-only t)) | |
140 | (forward-char tabulated-list-padding) | |
141 | (insert-and-inherit | |
6632d361 CY |
142 | (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 |
147 | (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 | 156 | (define-key map "S" 'tabulated-list-sort) |
a83ec3c9 CY |
157 | (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 |
166 | (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 |
169 | (define-key map [follow-link] 'mouse-face) |
170 | map) | |
171 | "Local keymap for `tabulated-list-mode' sort buttons.") | |
172 | ||
16a43933 CY |
173 | (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 | 176 | ;; Some text terminals can't display the Unicode arrows; be safe. |
16a43933 CY |
177 | (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 |
182 | (defvar tabulated-list--header-string nil) |
183 | (defvar tabulated-list--header-overlay nil) | |
184 | ||
a83ec3c9 CY |
185 | (defun tabulated-list-init-header () |
186 | "Set up header line for the Tabulated List buffer." | |
f0809a9d | 187 | ;; FIXME: Should share code with tabulated-list-print-col! |
6632d361 | 188 | (let ((x (max tabulated-list-padding 0)) |
a83ec3c9 CY |
189 | (button-props `(help-echo "Click to sort by column" |
190 | mouse-face highlight | |
191 | keymap ,tabulated-list-sort-button-map)) | |
192 | (cols nil)) | |
e5f9458f | 193 | (push (propertize " " 'display `(space :align-to ,x)) cols) |
a83ec3c9 CY |
194 | (dotimes (n (length tabulated-list-format)) |
195 | (let* ((col (aref tabulated-list-format n)) | |
6632d361 | 196 | (label (nth 0 col)) |
a83ec3c9 | 197 | (width (nth 1 col)) |
6632d361 | 198 | (props (nthcdr 3 col)) |
f0809a9d SM |
199 | (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 |
202 | (push |
203 | (cond | |
204 | ;; An unsortable column | |
1241b724 CY |
205 | ((not (nth 2 col)) |
206 | (propertize label 'tabulated-list-column-name label)) | |
a83ec3c9 CY |
207 | ;; The selected sort column |
208 | ((equal (car col) (car tabulated-list-sort-key)) | |
209 | (apply 'propertize | |
210 | (concat label | |
211 | (cond | |
f0809a9d SM |
212 | ((> (+ 2 (length label)) width) "") |
213 | ((cdr tabulated-list-sort-key) " â–²") | |
a83ec3c9 CY |
214 | (t " â–¼"))) |
215 | 'face 'bold | |
1241b724 | 216 | 'tabulated-list-column-name label |
a83ec3c9 CY |
217 | button-props)) |
218 | ;; Unselected sortable column. | |
219 | (t (apply 'propertize label | |
1241b724 | 220 | 'tabulated-list-column-name label |
a83ec3c9 | 221 | button-props))) |
6632d361 | 222 | cols) |
f0809a9d SM |
223 | (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 | 233 | (if (>= pad-right 0) |
6632d361 | 234 | (push (propertize " " |
f0809a9d | 235 | 'display `(space :align-to ,next-x) |
6632d361 | 236 | 'face 'fixed-pitch) |
f0809a9d SM |
237 | cols)) |
238 | (setq x next-x))) | |
1241b724 CY |
239 | (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 | 243 | (setq-local tabulated-list--header-string cols)))) |
1241b724 CY |
244 | |
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 |
252 | (setq-local tabulated-list--header-overlay |
253 | (make-overlay (point-min) (point)))) | |
1241b724 | 254 | (overlay-put tabulated-list--header-overlay 'face 'underline))) |
a83ec3c9 CY |
255 | |
256 | (defun tabulated-list-revert (&rest ignored) | |
257 | "The `revert-buffer-function' for `tabulated-list-mode'. | |
258 | It 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 |
265 | (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 |
276 | (defun tabulated-list-print (&optional remember-pos) |
277 | "Populate the current Tabulated List mode buffer. | |
278 | This sorts the `tabulated-list-entries' list if sorting is | |
279 | specified by `tabulated-list-sort-key'. It then erases the | |
280 | buffer and inserts the entries with `tabulated-list-printer'. | |
281 | ||
282 | Optional argument REMEMBER-POS, if non-nil, means to move point | |
283 | to the entry with the same ID element as the current line." | |
284 | (let ((inhibit-read-only t) | |
2c070447 | 285 | (entries (if (functionp tabulated-list-entries) |
a83ec3c9 CY |
286 | (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 |
293 | (unless tabulated-list-use-header-line |
294 | (tabulated-list-print-fake-header)) | |
f0809a9d | 295 | ;; Sort the entries, if necessary. |
6632d361 CY |
296 | (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 |
303 | (when (eq sorter t) |
304 | (setq sorter ; Default sorter checks column N: | |
e67a13ab CY |
305 | (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 |
310 | (setq entries (sort entries sorter)) |
311 | (if (cdr tabulated-list-sort-key) | |
312 | (setq entries (nreverse entries))) | |
2c070447 | 313 | (unless (functionp tabulated-list-entries) |
a83ec3c9 CY |
314 | (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 | 325 | (move-to-column saved-col) |
4a816020 ML |
326 | (when (eq (window-buffer) (current-buffer)) |
327 | (recenter))) | |
a83ec3c9 CY |
328 | (goto-char (point-min))))) |
329 | ||
330 | (defun tabulated-list-print-entry (id cols) | |
331 | "Insert a Tabulated List entry at point. | |
332 | This is the default `tabulated-list-printer' function. ID is a | |
333 | Lisp object identifying the entry to print, and COLS is a vector | |
334 | of column descriptors." | |
6632d361 CY |
335 | (let ((beg (point)) |
336 | (x (max tabulated-list-padding 0)) | |
337 | (ncols (length tabulated-list-format)) | |
338 | (inhibit-read-only t)) | |
a83ec3c9 CY |
339 | (if (> tabulated-list-padding 0) |
340 | (insert (make-string x ?\s))) | |
6632d361 CY |
341 | (dotimes (n ncols) |
342 | (setq x (tabulated-list-print-col n (aref cols n) x))) | |
a83ec3c9 | 343 | (insert ?\n) |
6632d361 CY |
344 | (put-text-property beg (point) 'tabulated-list-id id) |
345 | (put-text-property beg (point) 'tabulated-list-entry cols))) | |
346 | ||
347 | (defun tabulated-list-print-col (n col-desc x) | |
348 | "Insert a specified Tabulated List entry at point. | |
47199123 | 349 | N is the column number, COL-DESC is a column descriptor (see |
6632d361 CY |
350 | `tabulated-list-entries'), and X is the column number at point. |
351 | Return the column number after insertion." | |
f0809a9d SM |
352 | ;; TODO: don't truncate to `width' if the next column is align-right |
353 | ;; and has some space left. | |
6632d361 CY |
354 | (let* ((format (aref tabulated-list-format n)) |
355 | (name (nth 0 format)) | |
356 | (width (nth 1 format)) | |
357 | (props (nthcdr 3 format)) | |
358 | (pad-right (or (plist-get props :pad-right) 1)) | |
f0809a9d | 359 | (right-align (plist-get props :right-align)) |
6632d361 | 360 | (label (if (stringp col-desc) col-desc (car col-desc))) |
f0809a9d | 361 | (label-width (string-width label)) |
6632d361 CY |
362 | (help-echo (concat (car format) ": " label)) |
363 | (opoint (point)) | |
364 | (not-last-col (< (1+ n) (length tabulated-list-format)))) | |
365 | ;; Truncate labels if necessary (except last column). | |
366 | (and not-last-col | |
f0809a9d SM |
367 | (> label-width width) |
368 | (setq label (truncate-string-to-width label width nil nil t) | |
369 | label-width width)) | |
6632d361 | 370 | (setq label (bidi-string-mark-left-to-right label)) |
f0809a9d SM |
371 | (when (and right-align (> width label-width)) |
372 | (let ((shift (- width label-width))) | |
373 | (insert (propertize (make-string shift ?\s) | |
374 | 'display `(space :align-to ,(+ x shift)))) | |
375 | (setq width (- width shift)) | |
376 | (setq x (+ x shift)))) | |
6632d361 | 377 | (if (stringp col-desc) |
6b6d804b JB |
378 | (insert (if (get-text-property 0 'help-echo label) |
379 | label | |
380 | (propertize label 'help-echo help-echo))) | |
6632d361 | 381 | (apply 'insert-text-button label (cdr col-desc))) |
f0809a9d SM |
382 | (let ((next-x (+ x pad-right width))) |
383 | ;; No need to append any spaces if this is the last column. | |
384 | (when not-last-col | |
385 | (when (> pad-right 0) (insert (make-string pad-right ?\s))) | |
386 | (insert (propertize | |
387 | (make-string (- next-x x label-width pad-right) ?\s) | |
388 | 'display `(space :align-to ,next-x)))) | |
389 | (put-text-property opoint (point) 'tabulated-list-column-name name) | |
390 | next-x))) | |
6632d361 CY |
391 | |
392 | (defun tabulated-list-delete-entry () | |
393 | "Delete the Tabulated List entry at point. | |
394 | Return a list (ID COLS), where ID is the ID of the deleted entry | |
395 | and COLS is a vector of its column descriptors. Move point to | |
396 | the beginning of the deleted entry. Return nil if there is no | |
397 | entry at point. | |
398 | ||
399 | This function only changes the buffer contents; it does not alter | |
400 | `tabulated-list-entries'." | |
401 | ;; Assume that each entry occupies one line. | |
402 | (let* ((id (tabulated-list-get-id)) | |
403 | (cols (tabulated-list-get-entry)) | |
404 | (inhibit-read-only t)) | |
405 | (when cols | |
406 | (delete-region (line-beginning-position) (1+ (line-end-position))) | |
407 | (list id cols)))) | |
408 | ||
409 | (defun tabulated-list-set-col (col desc &optional change-entry-data) | |
410 | "Change the Tabulated List entry at point, setting COL to DESC. | |
411 | COL is the column number to change, or the name of the column to change. | |
412 | DESC is the new column descriptor, which is inserted via | |
413 | `tabulated-list-print-col'. | |
414 | ||
415 | If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data | |
416 | by setting the appropriate slot of the vector originally used to | |
417 | print this entry. If `tabulated-list-entries' has a list value, | |
418 | this is the vector stored within it." | |
419 | (let* ((opoint (point)) | |
420 | (eol (line-end-position)) | |
421 | (pos (line-beginning-position)) | |
422 | (id (tabulated-list-get-id pos)) | |
423 | (entry (tabulated-list-get-entry pos)) | |
424 | (prop 'tabulated-list-column-name) | |
425 | (inhibit-read-only t) | |
426 | name) | |
427 | (cond ((numberp col) | |
428 | (setq name (car (aref tabulated-list-format col)))) | |
429 | ((stringp col) | |
430 | (setq name col | |
431 | col (tabulated-list--column-number col))) | |
432 | (t | |
433 | (error "Invalid column %s" col))) | |
434 | (unless entry | |
435 | (error "No Tabulated List entry at position %s" opoint)) | |
436 | (unless (equal (get-text-property pos prop) name) | |
437 | (while (and (setq pos | |
438 | (next-single-property-change pos prop nil eol)) | |
439 | (< pos eol) | |
440 | (not (equal (get-text-property pos prop) name))))) | |
441 | (when (< pos eol) | |
442 | (delete-region pos (next-single-property-change pos prop nil eol)) | |
443 | (goto-char pos) | |
444 | (tabulated-list-print-col col desc (current-column)) | |
445 | (if change-entry-data | |
446 | (aset entry col desc)) | |
447 | (put-text-property pos (point) 'tabulated-list-id id) | |
448 | (put-text-property pos (point) 'tabulated-list-entry entry) | |
449 | (goto-char opoint)))) | |
a83ec3c9 CY |
450 | |
451 | (defun tabulated-list-col-sort (&optional e) | |
452 | "Sort Tabulated List entries by the column of the mouse click E." | |
453 | (interactive "e") | |
454 | (let* ((pos (event-start e)) | |
1241b724 | 455 | (obj (posn-object pos))) |
a83ec3c9 | 456 | (with-current-buffer (window-buffer (posn-window pos)) |
1241b724 CY |
457 | (tabulated-list--sort-by-column-name |
458 | (get-text-property (if obj (cdr obj) (posn-point pos)) | |
459 | 'tabulated-list-column-name | |
460 | (car obj)))))) | |
6632d361 | 461 | |
e5f9458f | 462 | (defun tabulated-list-sort (&optional n) |
6632d361 CY |
463 | "Sort Tabulated List entries by the column at point. |
464 | With a numeric prefix argument N, sort the Nth column." | |
465 | (interactive "P") | |
466 | (let ((name (if n | |
467 | (car (aref tabulated-list-format n)) | |
468 | (get-text-property (point) | |
469 | 'tabulated-list-column-name)))) | |
470 | (tabulated-list--sort-by-column-name name))) | |
471 | ||
472 | (defun tabulated-list--sort-by-column-name (name) | |
1241b724 | 473 | (when (and name (derived-mode-p 'tabulated-list-mode)) |
6632d361 CY |
474 | ;; Flip the sort order on a second click. |
475 | (if (equal name (car tabulated-list-sort-key)) | |
476 | (setcdr tabulated-list-sort-key | |
477 | (not (cdr tabulated-list-sort-key))) | |
478 | (setq tabulated-list-sort-key (cons name nil))) | |
479 | (tabulated-list-init-header) | |
480 | (tabulated-list-print t))) | |
a83ec3c9 CY |
481 | |
482 | ;;; The mode definition: | |
483 | ||
a83ec3c9 CY |
484 | (define-derived-mode tabulated-list-mode special-mode "Tabulated" |
485 | "Generic major mode for browsing a list of items. | |
486 | This mode is usually not used directly; instead, other major | |
487 | modes are derived from it, using `define-derived-mode'. | |
488 | ||
489 | In this major mode, the buffer is divided into multiple columns, | |
09e80d9f | 490 | which are labeled using the header line. Each non-empty line |
a83ec3c9 CY |
491 | belongs to one \"entry\", and the entries can be sorted according |
492 | to their column values. | |
493 | ||
494 | An inheriting mode should usually do the following in their body: | |
495 | ||
496 | - Set `tabulated-list-format', specifying the column format. | |
497 | - Set `tabulated-list-revert-hook', if the buffer contents need | |
498 | to be specially recomputed prior to `revert-buffer'. | |
499 | - Maybe set a `tabulated-list-entries' function (see below). | |
500 | - Maybe set `tabulated-list-printer' (see below). | |
501 | - Maybe set `tabulated-list-padding'. | |
502 | - Call `tabulated-list-init-header' to initialize `header-line-format' | |
503 | according to `tabulated-list-format'. | |
504 | ||
505 | An inheriting mode is usually accompanied by a \"list-FOO\" | |
506 | command (e.g. `list-packages', `list-processes'). This command | |
507 | creates or switches to a buffer and enables the major mode in | |
508 | that buffer. If `tabulated-list-entries' is not a function, the | |
509 | command should initialize it to a list of entries for displaying. | |
510 | Finally, it should call `tabulated-list-print'. | |
511 | ||
512 | `tabulated-list-print' calls the printer function specified by | |
513 | `tabulated-list-printer', once for each entry. The default | |
514 | printer is `tabulated-list-print-entry', but a mode that keeps | |
515 | data in an ewoc may instead specify a printer function (e.g., one | |
516 | that calls `ewoc-enter-last'), with `tabulated-list-print-entry' | |
517 | as the ewoc pretty-printer." | |
140ef50c SM |
518 | (setq-local truncate-lines t) |
519 | (setq-local buffer-read-only t) | |
520 | (setq-local buffer-undo-list t) | |
521 | (setq-local revert-buffer-function #'tabulated-list-revert) | |
522 | (setq-local glyphless-char-display tabulated-list-glyphless-char-display)) | |
a83ec3c9 CY |
523 | |
524 | (put 'tabulated-list-mode 'mode-class 'special) | |
525 | ||
526 | (provide 'tabulated-list) | |
527 | ||
528 | ;; Local Variables: | |
529 | ;; coding: utf-8 | |
a83ec3c9 CY |
530 | ;; End: |
531 | ||
532 | ;;; tabulated-list.el ends here |