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