lisp/emacs-lisp/tabulated-list.el

   1 ;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2011-2017 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 <https://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 tabulated-list--near-rows)
 106
 107 (defvar-local tabulated-list-sort-key nil
 108   "Sort key for the current Tabulated List mode buffer.
 109 If nil, no additional sorting is performed.
 110 Otherwise, this should be a cons cell (NAME . FLIP).
 111 NAME is a string matching one of the column names in
 112 `tabulated-list-format' (the corresponding SORT entry in
 113 `tabulated-list-format' then specifies how to sort).  FLIP, if
 114 non-nil, means to invert the resulting sort.")
 115 (put 'tabulated-list-sort-key 'permanent-local t)
 116
 117 (defsubst tabulated-list-get-id (&optional pos)
 118   "Return the entry ID of the Tabulated List entry at POS.
 119 The value is an ID object from `tabulated-list-entries', or nil.
 120 POS, if omitted or nil, defaults to point."
 121   (get-text-property (or pos (point)) 'tabulated-list-id))
 122
 123 (defsubst tabulated-list-get-entry (&optional pos)
 124   "Return the Tabulated List entry at POS.
 125 The value is a vector of column descriptors, or nil if there is
 126 no entry at POS.  POS, if omitted or nil, defaults to point."
 127   (get-text-property (or pos (point)) 'tabulated-list-entry))
 128
 129 (defun tabulated-list-put-tag (tag &optional advance)
 130   "Put TAG in the padding area of the current line.
 131 TAG should be a string, with length <= `tabulated-list-padding'.
 132 If ADVANCE is non-nil, move forward by one line afterwards."
 133   (unless (stringp tag)
 134     (error "Invalid argument to `tabulated-list-put-tag'"))
 135   (unless (> tabulated-list-padding 0)
 136     (error "Unable to tag the current line"))
 137   (save-excursion
 138     (beginning-of-line)
 139     (when (tabulated-list-get-entry)
 140       (let ((beg (point))
 141             (inhibit-read-only t))
 142         (forward-char tabulated-list-padding)
 143         (insert-and-inherit
 144          (let ((width (string-width tag)))
 145            (if (<= width tabulated-list-padding)
 146                (concat tag
 147                        (make-string (- tabulated-list-padding width) ?\s))
 148              (truncate-string-to-width tag tabulated-list-padding))))
 149         (delete-region beg (+ beg tabulated-list-padding)))))
 150   (if advance
 151       (forward-line)))
 152
 153 (defvar tabulated-list-mode-map
 154   (let ((map (copy-keymap special-mode-map)))
 155     (set-keymap-parent map button-buffer-map)
 156     (define-key map "n" 'next-line)
 157     (define-key map "p" 'previous-line)
 158     (define-key map "S" 'tabulated-list-sort)
 159     (define-key map [follow-link] 'mouse-face)
 160     (define-key map [mouse-2] 'mouse-select-window)
 161     map)
 162   "Local keymap for `tabulated-list-mode' buffers.")
 163
 164 (defvar tabulated-list-sort-button-map
 165   (let ((map (make-sparse-keymap)))
 166     (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
 167     (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
 168     (define-key map [mouse-1] 'tabulated-list-col-sort)
 169     (define-key map [mouse-2] 'tabulated-list-col-sort)
 170     (define-key map "\C-m" 'tabulated-list-sort)
 171     (define-key map [follow-link] 'mouse-face)
 172     map)
 173   "Local keymap for `tabulated-list-mode' sort buttons.")
 174
 175 (defvar tabulated-list-glyphless-char-display
 176   (let ((table (make-char-table 'glyphless-char-display nil)))
 177     (set-char-table-parent table glyphless-char-display)
 178     ;; Some text terminals can't display the Unicode arrows; be safe.
 179     (aset table 9650 (cons nil "^"))
 180     (aset table 9660 (cons nil "v"))
 181     table)
 182   "The `glyphless-char-display' table in Tabulated List buffers.")
 183
 184 (defvar tabulated-list--header-string nil
 185   "Holds the header if `tabulated-list-use-header-line' is nil.
 186 Populated by `tabulated-list-init-header'.")
 187 (defvar tabulated-list--header-overlay nil)
 188
 189 (defun tabulated-list-line-number-width ()
 190   "Return the width taken by display-line-numbers in the current buffer."
 191   ;; line-number-display-width returns the value for the selected
 192   ;; window, which might not be the window in which the current buffer
 193   ;; is displayed.
 194   (if (not display-line-numbers)
 195            0
 196     (let ((cbuf-window (get-buffer-window (current-buffer) t)))
 197       (if (window-live-p cbuf-window)
 198           (with-selected-window cbuf-window
 199             (line-number-display-width 'columns))
 200         4))))
 201
 202 (defun tabulated-list-init-header ()
 203   "Set up header line for the Tabulated List buffer."
 204   ;; FIXME: Should share code with tabulated-list-print-col!
 205   (let ((x (max tabulated-list-padding 0))
 206         (button-props `(help-echo "Click to sort by column"
 207                         mouse-face header-line-highlight
 208                         keymap ,tabulated-list-sort-button-map))
 209         (cols nil))
 210     (if display-line-numbers
 211         (setq x (+ x (tabulated-list-line-number-width))))
 212     (push (propertize " " 'display `(space :align-to ,x)) cols)
 213     (dotimes (n (length tabulated-list-format))
 214       (let* ((col (aref tabulated-list-format n))
 215              (label (nth 0 col))
 216              (width (nth 1 col))
 217              (props (nthcdr 3 col))
 218              (pad-right (or (plist-get props :pad-right) 1))
 219              (right-align (plist-get props :right-align))
 220              (next-x (+ x pad-right width)))
 221         (push
 222          (cond
 223           ;; An unsortable column
 224           ((not (nth 2 col))
 225            (propertize label 'tabulated-list-column-name label))
 226           ;; The selected sort column
 227           ((equal (car col) (car tabulated-list-sort-key))
 228            (apply 'propertize
 229                   (concat label
 230                           (cond
 231                            ((> (+ 2 (length label)) width) "")
 232                            ((cdr tabulated-list-sort-key) " ▲")
 233                            (t " ▼")))
 234                   'face 'bold
 235                   'tabulated-list-column-name label
 236                   button-props))
 237           ;; Unselected sortable column.
 238           (t (apply 'propertize label
 239                     'tabulated-list-column-name label
 240                     button-props)))
 241          cols)
 242         (when right-align
 243           (let ((shift (- width (string-width (car cols)))))
 244             (when (> shift 0)
 245               (setq cols
 246                     (cons (car cols)
 247                           (cons (propertize (make-string shift ?\s)
 248                                             'display
 249                                             `(space :align-to ,(+ x shift)))
 250                                 (cdr cols))))
 251               (setq x (+ x shift)))))
 252         (if (>= pad-right 0)
 253             (push (propertize " "
 254                               'display `(space :align-to ,next-x)
 255                               'face 'fixed-pitch)
 256                   cols))
 257         (setq x next-x)))
 258     (setq cols (apply 'concat (nreverse cols)))
 259     (if tabulated-list-use-header-line
 260         (setq header-line-format cols)
 261       (setq header-line-format nil)
 262       (setq-local tabulated-list--header-string cols))))
 263
 264 (defun tabulated-list-print-fake-header ()
 265   "Insert a fake Tabulated List \"header line\" at the start of the buffer.
 266 Do nothing if `tabulated-list--header-string' is nil."
 267   (when tabulated-list--header-string
 268     (goto-char (point-min))
 269     (let ((inhibit-read-only t))
 270       (insert tabulated-list--header-string "\n")
 271       (if tabulated-list--header-overlay
 272           (move-overlay tabulated-list--header-overlay (point-min) (point))
 273         (setq-local tabulated-list--header-overlay
 274                     (make-overlay (point-min) (point))))
 275       (overlay-put tabulated-list--header-overlay 'face 'underline))))
 276
 277 (defsubst tabulated-list-header-overlay-p (&optional pos)
 278   "Return non-nil if there is a fake header.
 279 Optional arg POS is a buffer position where to look for a fake header;
 280 defaults to `point-min'."
 281   (overlays-at (or pos (point-min))))
 282
 283 (defun tabulated-list-revert (&rest ignored)
 284   "The `revert-buffer-function' for `tabulated-list-mode'.
 285 It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
 286   (interactive)
 287   (unless (derived-mode-p 'tabulated-list-mode)
 288     (error "The current buffer is not in Tabulated List mode"))
 289   (run-hooks 'tabulated-list-revert-hook)
 290   (tabulated-list-print t))
 291
 292 (defun tabulated-list--column-number (name)
 293   (let ((len (length tabulated-list-format))
 294         (n 0)
 295         found)
 296     (while (and (< n len) (null found))
 297       (if (equal (car (aref tabulated-list-format n)) name)
 298           (setq found n))
 299       (setq n (1+ n)))
 300     (or found
 301         (error "No column named %s" name))))
 302
 303 (defun tabulated-list--get-sorter ()
 304   "Return a sorting predicate for the current tabulated-list.
 305 Return nil if `tabulated-list-sort-key' specifies an unsortable
 306 column.  Negate the predicate that would be returned if
 307 `tabulated-list-sort-key' has a non-nil cdr."
 308   (when (and tabulated-list-sort-key
 309              (car tabulated-list-sort-key))
 310     (let* ((sort-column (car tabulated-list-sort-key))
 311            (n (tabulated-list--column-number sort-column))
 312            (sorter (nth 2 (aref tabulated-list-format n))))
 313       (when (eq sorter t); Default sorter checks column N:
 314         (setq sorter (lambda (A B)
 315                        (let ((a (aref (cadr A) n))
 316                              (b (aref (cadr B) n)))
 317                          (string< (if (stringp a) a (car a))
 318                                   (if (stringp b) b (car b)))))))
 319       ;; Reversed order.
 320       (if (cdr tabulated-list-sort-key)
 321           (lambda (a b) (not (funcall sorter a b)))
 322         sorter))))
 323
 324 (defsubst tabulated-list--col-local-max-widths (col)
 325    "Return maximum entry widths at column COL around current row.
 326 Check the current row, the previous one and the next row."
 327   (apply #'max (mapcar (lambda (x)
 328                          (let ((nt (elt x col)))
 329                            (string-width (if (stringp nt) nt (car nt)))))
 330                        tabulated-list--near-rows)))
 331
 332 (defun tabulated-list-print (&optional remember-pos update)
 333   "Populate the current Tabulated List mode buffer.
 334 This sorts the `tabulated-list-entries' list if sorting is
 335 specified by `tabulated-list-sort-key'.  It then erases the
 336 buffer and inserts the entries with `tabulated-list-printer'.
 337
 338 Optional argument REMEMBER-POS, if non-nil, means to move point
 339 to the entry with the same ID element as the current line and
 340 recenter window line accordingly.
 341
 342 Non-nil UPDATE argument means to use an alternative printing
 343 method which is faster if most entries haven't changed since the
 344 last print.  The only difference in outcome is that tags will not
 345 be removed from entries that haven't changed (see
 346 `tabulated-list-put-tag').  Don't use this immediately after
 347 changing `tabulated-list-sort-key'."
 348   (let ((inhibit-read-only t)
 349         (entries (if (functionp tabulated-list-entries)
 350                      (funcall tabulated-list-entries)
 351                    tabulated-list-entries))
 352         (sorter (tabulated-list--get-sorter))
 353         entry-id saved-pt saved-col window-line)
 354     (and remember-pos
 355          (setq entry-id (tabulated-list-get-id))
 356          (setq saved-col (current-column))
 357          (when (eq (window-buffer) (current-buffer))
 358            (setq window-line
 359                  (count-screen-lines (window-start) (point)))))
 360     ;; Sort the entries, if necessary.
 361     (when sorter
 362       (setq entries (sort entries sorter)))
 363     (unless (functionp tabulated-list-entries)
 364       (setq tabulated-list-entries entries))
 365     ;; Without a sorter, we have no way to just update.
 366     (when (and update (not sorter))
 367       (setq update nil))
 368     (if update (goto-char (point-min))
 369       ;; Redo the buffer, unless we're just updating.
 370       (erase-buffer)
 371       (unless tabulated-list-use-header-line
 372         (tabulated-list-print-fake-header)))
 373     ;; Finally, print the resulting list.
 374     (while entries
 375       (let* ((elt (car entries))
 376              (tabulated-list--near-rows
 377               (list
 378                (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt))
 379                (cadr elt)
 380                (or (cadr (cadr entries)) (cadr elt))))
 381              (id (car elt)))
 382         (and entry-id
 383              (equal entry-id id)
 384              (setq entry-id nil
 385                    saved-pt (point)))
 386         ;; If the buffer is empty, simply print each elt.
 387         (if (or (not update) (eobp))
 388             (apply tabulated-list-printer elt)
 389           (while (let ((local-id (tabulated-list-get-id)))
 390                    ;; If we find id, then nothing to update.
 391                    (cond ((equal id local-id)
 392                           (forward-line 1)
 393                           nil)
 394                          ;; If this entry sorts after id (or it's the
 395                          ;; end), then just insert id and move on.
 396                          ((or (not local-id)
 397                               (funcall sorter elt
 398                                        ;; FIXME: Might be faster if
 399                                        ;; don't construct this list.
 400                                        (list local-id (tabulated-list-get-entry))))
 401                           (apply tabulated-list-printer elt)
 402                           nil)
 403                          ;; We find an entry that sorts before id,
 404                          ;; it needs to be deleted.
 405                          (t t)))
 406             (let ((old (point)))
 407               (forward-line 1)
 408               (delete-region old (point))))))
 409       (setq entries (cdr entries)))
 410     (set-buffer-modified-p nil)
 411     ;; If REMEMBER-POS was specified, move to the "old" location.
 412     (if saved-pt
 413         (progn (goto-char saved-pt)
 414                (move-to-column saved-col)
 415                (when window-line
 416                  (recenter window-line)))
 417       (goto-char (point-min)))))
 418
 419 (defun tabulated-list-print-entry (id cols)
 420   "Insert a Tabulated List entry at point.
 421 This is the default `tabulated-list-printer' function.  ID is a
 422 Lisp object identifying the entry to print, and COLS is a vector
 423 of column descriptors."
 424   (let ((beg   (point))
 425         (x     (max tabulated-list-padding 0))
 426         (ncols (length tabulated-list-format))
 427         (inhibit-read-only t))
 428     (if (> tabulated-list-padding 0)
 429         (insert (make-string x ?\s)))
 430     (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
 431            (or (bound-and-true-p tabulated-list--near-rows)
 432                (list (or (tabulated-list-get-entry (point-at-bol 0))
 433                          cols)
 434                      cols))))
 435       (dotimes (n ncols)
 436         (setq x (tabulated-list-print-col n (aref cols n) x))))
 437     (insert ?\n)
 438     ;; Ever so slightly faster than calling `put-text-property' twice.
 439     (add-text-properties
 440      beg (point)
 441      `(tabulated-list-id ,id tabulated-list-entry ,cols))))
 442
 443 (defun tabulated-list-print-col (n col-desc x)
 444   "Insert a specified Tabulated List entry at point.
 445 N is the column number, COL-DESC is a column descriptor (see
 446 `tabulated-list-entries'), and X is the column number at point.
 447 Return the column number after insertion."
 448   (let* ((format    (aref tabulated-list-format n))
 449          (name      (nth 0 format))
 450          (width     (nth 1 format))
 451          (props     (nthcdr 3 format))
 452          (pad-right (or (plist-get props :pad-right) 1))
 453          (right-align (plist-get props :right-align))
 454          (label     (if (stringp col-desc) col-desc (car col-desc)))
 455          (label-width (string-width label))
 456          (help-echo (concat (car format) ": " label))
 457          (opoint (point))
 458          (not-last-col (< (1+ n) (length tabulated-list-format)))
 459           available-space)
 460     (when not-last-col
 461       (let* ((next-col-format (aref tabulated-list-format (1+ n)))
 462              (next-col-right-align (plist-get (nthcdr 3 next-col-format)
 463                                               :right-align))
 464              (next-col-width (nth 1 next-col-format)))
 465         (setq available-space
 466               (if (and (not right-align)
 467                        next-col-right-align)
 468                   (-
 469                    (+ width next-col-width)
 470                    (min next-col-width
 471                         (tabulated-list--col-local-max-widths (1+ n))))
 472                 width))))
 473     ;; Truncate labels if necessary (except last column).
 474     ;; Don't truncate to `width' if the next column is align-right
 475     ;; and has some space left, truncate to `available-space' instead.
 476     (when (and not-last-col
 477                (> label-width available-space)
 478                (setq label (truncate-string-to-width
 479                             label available-space nil nil t)
 480                      label-width available-space)))
 481     (setq label (bidi-string-mark-left-to-right label))
 482     (when (and right-align (> width label-width))
 483       (let ((shift (- width label-width)))
 484         (insert (propertize (make-string shift ?\s)
 485                             'display `(space :align-to ,(+ x shift))))
 486         (setq width (- width shift))
 487         (setq x (+ x shift))))
 488     (if (stringp col-desc)
 489         (insert (if (get-text-property 0 'help-echo label)
 490                     label
 491                   (propertize label 'help-echo help-echo)))
 492       (apply 'insert-text-button label (cdr col-desc)))
 493     (let ((next-x (+ x pad-right width)))
 494       ;; No need to append any spaces if this is the last column.
 495       (when not-last-col
 496         (when (> pad-right 0) (insert (make-string pad-right ?\s)))
 497         (insert (propertize
 498                  (make-string (- width (min width label-width)) ?\s)
 499                  'display `(space :align-to ,next-x))))
 500       (put-text-property opoint (point) 'tabulated-list-column-name name)
 501       next-x)))
 502
 503 (defun tabulated-list-delete-entry ()
 504   "Delete the Tabulated List entry at point.
 505 Return a list (ID COLS), where ID is the ID of the deleted entry
 506 and COLS is a vector of its column descriptors.  Move point to
 507 the beginning of the deleted entry.  Return nil if there is no
 508 entry at point.
 509
 510 This function only changes the buffer contents; it does not alter
 511 `tabulated-list-entries'."
 512   ;; Assume that each entry occupies one line.
 513   (let* ((id (tabulated-list-get-id))
 514          (cols (tabulated-list-get-entry))
 515          (inhibit-read-only t))
 516     (when cols
 517       (delete-region (line-beginning-position) (1+ (line-end-position)))
 518       (list id cols))))
 519
 520 (defun tabulated-list-set-col (col desc &optional change-entry-data)
 521   "Change the Tabulated List entry at point, setting COL to DESC.
 522 COL is the column number to change, or the name of the column to change.
 523 DESC is the new column descriptor, which is inserted via
 524 `tabulated-list-print-col'.
 525
 526 If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
 527 by setting the appropriate slot of the vector originally used to
 528 print this entry.  If `tabulated-list-entries' has a list value,
 529 this is the vector stored within it."
 530   (let* ((opoint (point))
 531          (eol    (line-end-position))
 532          (pos    (line-beginning-position))
 533          (id     (tabulated-list-get-id pos))
 534          (entry  (tabulated-list-get-entry pos))
 535          (prop 'tabulated-list-column-name)
 536          (inhibit-read-only t)
 537          name)
 538     (cond ((numberp col)
 539            (setq name (car (aref tabulated-list-format col))))
 540           ((stringp col)
 541            (setq name col
 542                  col (tabulated-list--column-number col)))
 543           (t
 544            (error "Invalid column %s" col)))
 545     (unless entry
 546       (error "No Tabulated List entry at position %s" opoint))
 547     (unless (equal (get-text-property pos prop) name)
 548       (while (and (setq pos
 549                         (next-single-property-change pos prop nil eol))
 550                   (< pos eol)
 551                   (not (equal (get-text-property pos prop) name)))))
 552     (when (< pos eol)
 553       (delete-region pos (next-single-property-change pos prop nil eol))
 554       (goto-char pos)
 555       (let ((tabulated-list--near-rows
 556              (list
 557               (tabulated-list-get-entry (point-at-bol 0))
 558               entry
 559               (or (tabulated-list-get-entry (point-at-bol 2)) entry))))
 560         (tabulated-list-print-col col desc (current-column)))
 561       (if change-entry-data
 562           (aset entry col desc))
 563       (put-text-property pos (point) 'tabulated-list-id id)
 564       (put-text-property pos (point) 'tabulated-list-entry entry)
 565       (goto-char opoint))))
 566
 567 (defun tabulated-list-col-sort (&optional e)
 568   "Sort Tabulated List entries by the column of the mouse click E."
 569   (interactive "e")
 570   (let* ((pos (event-start e))
 571          (obj (posn-object pos)))
 572     (with-current-buffer (window-buffer (posn-window pos))
 573       (tabulated-list--sort-by-column-name
 574        (get-text-property (if obj (cdr obj) (posn-point pos))
 575                           'tabulated-list-column-name
 576                           (car obj))))))
 577
 578 (defun tabulated-list-sort (&optional n)
 579   "Sort Tabulated List entries by the column at point.
 580 With a numeric prefix argument N, sort the Nth column."
 581   (interactive "P")
 582   (let ((name (if n
 583                   (car (aref tabulated-list-format n))
 584                 (get-text-property (point)
 585                                    'tabulated-list-column-name))))
 586     (if (nth 2 (assoc name (append tabulated-list-format nil)))
 587         (tabulated-list--sort-by-column-name name)
 588       (user-error "Cannot sort by %s" name))))
 589
 590 (defun tabulated-list--sort-by-column-name (name)
 591   (when (and name (derived-mode-p 'tabulated-list-mode))
 592     ;; Flip the sort order on a second click.
 593     (if (equal name (car tabulated-list-sort-key))
 594         (setcdr tabulated-list-sort-key
 595                 (not (cdr tabulated-list-sort-key)))
 596       (setq tabulated-list-sort-key (cons name nil)))
 597     (tabulated-list-init-header)
 598     (tabulated-list-print t)))
 599
 600 (defvar tabulated-list--current-lnum-width nil)
 601 (defun tabulated-list-watch-line-number-width (_window)
 602   (if display-line-numbers
 603       (let ((lnum-width (tabulated-list-line-number-width)))
 604         (when (not (= tabulated-list--current-lnum-width lnum-width))
 605           (setq-local tabulated-list--current-lnum-width lnum-width)
 606           (tabulated-list-init-header)))))
 607
 608 (defun tabulated-list-window-scroll-function (window _start)
 609   (if display-line-numbers
 610       (let ((lnum-width
 611              (with-selected-window window
 612                (line-number-display-width 'columns))))
 613         (when (not (= tabulated-list--current-lnum-width lnum-width))
 614           (setq-local tabulated-list--current-lnum-width lnum-width)
 615           (tabulated-list-init-header)))))
 616
 617 ;;; The mode definition:
 618
 619 (define-derived-mode tabulated-list-mode special-mode "Tabulated"
 620   "Generic major mode for browsing a list of items.
 621 This mode is usually not used directly; instead, other major
 622 modes are derived from it, using `define-derived-mode'.
 623
 624 In this major mode, the buffer is divided into multiple columns,
 625 which are labeled using the header line.  Each non-empty line
 626 belongs to one \"entry\", and the entries can be sorted according
 627 to their column values.
 628
 629 An inheriting mode should usually do the following in their body:
 630
 631  - Set `tabulated-list-format', specifying the column format.
 632  - Set `tabulated-list-revert-hook', if the buffer contents need
 633    to be specially recomputed prior to `revert-buffer'.
 634  - Maybe set a `tabulated-list-entries' function (see below).
 635  - Maybe set `tabulated-list-printer' (see below).
 636  - Maybe set `tabulated-list-padding'.
 637  - Call `tabulated-list-init-header' to initialize `header-line-format'
 638    according to `tabulated-list-format'.
 639
 640 An inheriting mode is usually accompanied by a \"list-FOO\"
 641 command (e.g. `list-packages', `list-processes').  This command
 642 creates or switches to a buffer and enables the major mode in
 643 that buffer.  If `tabulated-list-entries' is not a function, the
 644 command should initialize it to a list of entries for displaying.
 645 Finally, it should call `tabulated-list-print'.
 646
 647 `tabulated-list-print' calls the printer function specified by
 648 `tabulated-list-printer', once for each entry.  The default
 649 printer is `tabulated-list-print-entry', but a mode that keeps
 650 data in an ewoc may instead specify a printer function (e.g., one
 651 that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
 652 as the ewoc pretty-printer."
 653   (setq-local truncate-lines t)
 654   (setq-local buffer-undo-list t)
 655   (setq-local revert-buffer-function #'tabulated-list-revert)
 656   (setq-local glyphless-char-display tabulated-list-glyphless-char-display)
 657   ;; Avoid messing up the entries' display just because the first
 658   ;; column of the first entry happens to begin with a R2L letter.
 659   (setq bidi-paragraph-direction 'left-to-right)
 660   ;; This is for if/when they turn on display-line-numbers
 661   (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t)
 662   ;; This is for if/when they customize the line-number face or when
 663   ;; the line-number width needs to change due to scrolling.
 664   (setq-local tabulated-list--current-lnum-width 0)
 665   (add-hook 'pre-redisplay-functions
 666             #'tabulated-list-watch-line-number-width nil t)
 667   (add-hook 'window-scroll-functions
 668             #'tabulated-list-window-scroll-function nil t))
 669
 670 (put 'tabulated-list-mode 'mode-class 'special)
 671
 672 (provide 'tabulated-list)
 673
 674 ;;; tabulated-list.el ends here