tabulated-list.el 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634
  1. ;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2011-2017 Free Software Foundation, Inc.
  3. ;; Author: Chong Yidong <cyd@stupidchicken.com>
  4. ;; Keywords: extensions, lisp
  5. ;; Version: 1.0
  6. ;; This file is part of GNU Emacs.
  7. ;; GNU Emacs is free software: you can redistribute it and/or modify
  8. ;; it under the terms of the GNU General Public License as published by
  9. ;; the Free Software Foundation, either version 3 of the License, or
  10. ;; (at your option) any later version.
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. ;; GNU General Public License for more details.
  15. ;; You should have received a copy of the GNU General Public License
  16. ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
  17. ;;; Commentary:
  18. ;; This file defines Tabulated List mode, a generic major mode for
  19. ;; displaying lists of tabulated data, intended for other major modes
  20. ;; to inherit from. It provides several utility routines, e.g. for
  21. ;; pretty-printing lines of tabulated data to fit into the appropriate
  22. ;; columns.
  23. ;; For usage information, see the documentation of `tabulated-list-mode'.
  24. ;; This package originated from Tom Tromey's Package Menu mode,
  25. ;; extended and generalized to be used by other modes.
  26. ;;; Code:
  27. ;; The reason `tabulated-list-format' and other variables are
  28. ;; permanent-local is to make it convenient to switch to a different
  29. ;; major mode, switch back, and have the original Tabulated List data
  30. ;; still valid. See, for example, ebuff-menu.el.
  31. (defvar-local tabulated-list-format nil
  32. "The format of the current Tabulated List mode buffer.
  33. This should be a vector of elements (NAME WIDTH SORT . PROPS),
  34. where:
  35. - NAME is a string describing the column.
  36. This is the label for the column in the header line.
  37. Different columns must have non-`equal' names.
  38. - WIDTH is the width to reserve for the column.
  39. For the final element, its numerical value is ignored.
  40. - SORT specifies how to sort entries by this column.
  41. If nil, this column cannot be used for sorting.
  42. If t, sort by comparing the string value printed in the column.
  43. Otherwise, it should be a predicate function suitable for
  44. `sort', accepting arguments with the same form as the elements
  45. of `tabulated-list-entries'.
  46. - PROPS is a plist of additional column properties.
  47. Currently supported properties are:
  48. - `:right-align': If non-nil, the column should be right-aligned.
  49. - `:pad-right': Number of additional padding spaces to the
  50. right of the column (defaults to 1 if omitted).")
  51. (put 'tabulated-list-format 'permanent-local t)
  52. (defvar-local tabulated-list-use-header-line t
  53. "Whether the Tabulated List buffer should use a header line.")
  54. (defvar-local tabulated-list-entries nil
  55. "Entries displayed in the current Tabulated List buffer.
  56. This should be either a function, or a list.
  57. If a list, each element has the form (ID [DESC1 ... DESCN]),
  58. where:
  59. - ID is nil, or a Lisp object uniquely identifying this entry,
  60. which is used to keep the cursor on the \"same\" entry when
  61. rearranging the list. Comparison is done with `equal'.
  62. - Each DESC is a column descriptor, one for each column
  63. specified in `tabulated-list-format'. A descriptor is either
  64. a string, which is printed as-is, or a list (LABEL . PROPS),
  65. which means to use `insert-text-button' to insert a text
  66. button with label LABEL and button properties PROPS.
  67. The string, or button label, must not contain any newline.
  68. If `tabulated-list-entries' is a function, it is called with no
  69. arguments and must return a list of the above form.")
  70. (put 'tabulated-list-entries 'permanent-local t)
  71. (defvar-local tabulated-list-padding 0
  72. "Number of characters preceding each Tabulated List mode entry.
  73. By default, lines are padded with spaces, but you can use the
  74. function `tabulated-list-put-tag' to change this.")
  75. (put 'tabulated-list-padding 'permanent-local t)
  76. (defvar tabulated-list-revert-hook nil
  77. "Hook run before reverting a Tabulated List buffer.
  78. This is commonly used to recompute `tabulated-list-entries'.")
  79. (defvar-local tabulated-list-printer 'tabulated-list-print-entry
  80. "Function for inserting a Tabulated List entry at point.
  81. It is called with two arguments, ID and COLS. ID is a Lisp
  82. object identifying the entry, and COLS is a vector of column
  83. descriptors, as documented in `tabulated-list-entries'.")
  84. (defvar tabulated-list--near-rows)
  85. (defvar-local tabulated-list-sort-key nil
  86. "Sort key for the current Tabulated List mode buffer.
  87. If nil, no additional sorting is performed.
  88. Otherwise, this should be a cons cell (NAME . FLIP).
  89. NAME is a string matching one of the column names in
  90. `tabulated-list-format' (the corresponding SORT entry in
  91. `tabulated-list-format' then specifies how to sort). FLIP, if
  92. non-nil, means to invert the resulting sort.")
  93. (put 'tabulated-list-sort-key 'permanent-local t)
  94. (defsubst tabulated-list-get-id (&optional pos)
  95. "Return the entry ID of the Tabulated List entry at POS.
  96. The value is an ID object from `tabulated-list-entries', or nil.
  97. POS, if omitted or nil, defaults to point."
  98. (get-text-property (or pos (point)) 'tabulated-list-id))
  99. (defsubst tabulated-list-get-entry (&optional pos)
  100. "Return the Tabulated List entry at POS.
  101. The value is a vector of column descriptors, or nil if there is
  102. no entry at POS. POS, if omitted or nil, defaults to point."
  103. (get-text-property (or pos (point)) 'tabulated-list-entry))
  104. (defun tabulated-list-put-tag (tag &optional advance)
  105. "Put TAG in the padding area of the current line.
  106. TAG should be a string, with length <= `tabulated-list-padding'.
  107. If ADVANCE is non-nil, move forward by one line afterwards."
  108. (unless (stringp tag)
  109. (error "Invalid argument to `tabulated-list-put-tag'"))
  110. (unless (> tabulated-list-padding 0)
  111. (error "Unable to tag the current line"))
  112. (save-excursion
  113. (beginning-of-line)
  114. (when (tabulated-list-get-entry)
  115. (let ((beg (point))
  116. (inhibit-read-only t))
  117. (forward-char tabulated-list-padding)
  118. (insert-and-inherit
  119. (let ((width (string-width tag)))
  120. (if (<= width tabulated-list-padding)
  121. (concat tag
  122. (make-string (- tabulated-list-padding width) ?\s))
  123. (truncate-string-to-width tag tabulated-list-padding))))
  124. (delete-region beg (+ beg tabulated-list-padding)))))
  125. (if advance
  126. (forward-line)))
  127. (defvar tabulated-list-mode-map
  128. (let ((map (copy-keymap special-mode-map)))
  129. (set-keymap-parent map button-buffer-map)
  130. (define-key map "n" 'next-line)
  131. (define-key map "p" 'previous-line)
  132. (define-key map "S" 'tabulated-list-sort)
  133. (define-key map [follow-link] 'mouse-face)
  134. (define-key map [mouse-2] 'mouse-select-window)
  135. map)
  136. "Local keymap for `tabulated-list-mode' buffers.")
  137. (defvar tabulated-list-sort-button-map
  138. (let ((map (make-sparse-keymap)))
  139. (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
  140. (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
  141. (define-key map [mouse-1] 'tabulated-list-col-sort)
  142. (define-key map [mouse-2] 'tabulated-list-col-sort)
  143. (define-key map "\C-m" 'tabulated-list-sort)
  144. (define-key map [follow-link] 'mouse-face)
  145. map)
  146. "Local keymap for `tabulated-list-mode' sort buttons.")
  147. (defvar tabulated-list-glyphless-char-display
  148. (let ((table (make-char-table 'glyphless-char-display nil)))
  149. (set-char-table-parent table glyphless-char-display)
  150. ;; Some text terminals can't display the Unicode arrows; be safe.
  151. (aset table 9650 (cons nil "^"))
  152. (aset table 9660 (cons nil "v"))
  153. table)
  154. "The `glyphless-char-display' table in Tabulated List buffers.")
  155. (defvar tabulated-list--header-string nil
  156. "Holds the header if `tabulated-list-use-header-line' is nil.
  157. Populated by `tabulated-list-init-header'.")
  158. (defvar tabulated-list--header-overlay nil)
  159. (defun tabulated-list-init-header ()
  160. "Set up header line for the Tabulated List buffer."
  161. ;; FIXME: Should share code with tabulated-list-print-col!
  162. (let ((x (max tabulated-list-padding 0))
  163. (button-props `(help-echo "Click to sort by column"
  164. mouse-face highlight
  165. keymap ,tabulated-list-sort-button-map))
  166. (cols nil))
  167. (push (propertize " " 'display `(space :align-to ,x)) cols)
  168. (dotimes (n (length tabulated-list-format))
  169. (let* ((col (aref tabulated-list-format n))
  170. (label (nth 0 col))
  171. (width (nth 1 col))
  172. (props (nthcdr 3 col))
  173. (pad-right (or (plist-get props :pad-right) 1))
  174. (right-align (plist-get props :right-align))
  175. (next-x (+ x pad-right width)))
  176. (push
  177. (cond
  178. ;; An unsortable column
  179. ((not (nth 2 col))
  180. (propertize label 'tabulated-list-column-name label))
  181. ;; The selected sort column
  182. ((equal (car col) (car tabulated-list-sort-key))
  183. (apply 'propertize
  184. (concat label
  185. (cond
  186. ((> (+ 2 (length label)) width) "")
  187. ((cdr tabulated-list-sort-key) " ▲")
  188. (t " ▼")))
  189. 'face 'bold
  190. 'tabulated-list-column-name label
  191. button-props))
  192. ;; Unselected sortable column.
  193. (t (apply 'propertize label
  194. 'tabulated-list-column-name label
  195. button-props)))
  196. cols)
  197. (when right-align
  198. (let ((shift (- width (string-width (car cols)))))
  199. (when (> shift 0)
  200. (setq cols
  201. (cons (car cols)
  202. (cons (propertize (make-string shift ?\s)
  203. 'display
  204. `(space :align-to ,(+ x shift)))
  205. (cdr cols))))
  206. (setq x (+ x shift)))))
  207. (if (>= pad-right 0)
  208. (push (propertize " "
  209. 'display `(space :align-to ,next-x)
  210. 'face 'fixed-pitch)
  211. cols))
  212. (setq x next-x)))
  213. (setq cols (apply 'concat (nreverse cols)))
  214. (if tabulated-list-use-header-line
  215. (setq header-line-format cols)
  216. (setq header-line-format nil)
  217. (setq-local tabulated-list--header-string cols))))
  218. (defun tabulated-list-print-fake-header ()
  219. "Insert a fake Tabulated List \"header line\" at the start of the buffer.
  220. Do nothing if `tabulated-list--header-string' is nil."
  221. (when tabulated-list--header-string
  222. (goto-char (point-min))
  223. (let ((inhibit-read-only t))
  224. (insert tabulated-list--header-string "\n")
  225. (if tabulated-list--header-overlay
  226. (move-overlay tabulated-list--header-overlay (point-min) (point))
  227. (setq-local tabulated-list--header-overlay
  228. (make-overlay (point-min) (point))))
  229. (overlay-put tabulated-list--header-overlay 'face 'underline))))
  230. (defsubst tabulated-list-header-overlay-p (&optional pos)
  231. "Return non-nil if there is a fake header.
  232. Optional arg POS is a buffer position where to look for a fake header;
  233. defaults to `point-min'."
  234. (overlays-at (or pos (point-min))))
  235. (defun tabulated-list-revert (&rest ignored)
  236. "The `revert-buffer-function' for `tabulated-list-mode'.
  237. It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
  238. (interactive)
  239. (unless (derived-mode-p 'tabulated-list-mode)
  240. (error "The current buffer is not in Tabulated List mode"))
  241. (run-hooks 'tabulated-list-revert-hook)
  242. (tabulated-list-print t))
  243. (defun tabulated-list--column-number (name)
  244. (let ((len (length tabulated-list-format))
  245. (n 0)
  246. found)
  247. (while (and (< n len) (null found))
  248. (if (equal (car (aref tabulated-list-format n)) name)
  249. (setq found n))
  250. (setq n (1+ n)))
  251. (or found
  252. (error "No column named %s" name))))
  253. (defun tabulated-list--get-sorter ()
  254. "Return a sorting predicate for the current tabulated-list.
  255. Return nil if `tabulated-list-sort-key' specifies an unsortable
  256. column. Negate the predicate that would be returned if
  257. `tabulated-list-sort-key' has a non-nil cdr."
  258. (when (and tabulated-list-sort-key
  259. (car tabulated-list-sort-key))
  260. (let* ((sort-column (car tabulated-list-sort-key))
  261. (n (tabulated-list--column-number sort-column))
  262. (sorter (nth 2 (aref tabulated-list-format n))))
  263. (when (eq sorter t); Default sorter checks column N:
  264. (setq sorter (lambda (A B)
  265. (let ((a (aref (cadr A) n))
  266. (b (aref (cadr B) n)))
  267. (string< (if (stringp a) a (car a))
  268. (if (stringp b) b (car b)))))))
  269. ;; Reversed order.
  270. (if (cdr tabulated-list-sort-key)
  271. (lambda (a b) (not (funcall sorter a b)))
  272. sorter))))
  273. (defsubst tabulated-list--col-local-max-widths (col)
  274. "Return maximum entry widths at column COL around current row.
  275. Check the current row, the previous one and the next row."
  276. (apply #'max (mapcar (lambda (x)
  277. (let ((nt (elt x col)))
  278. (string-width (if (stringp nt) nt (car nt)))))
  279. tabulated-list--near-rows)))
  280. (defun tabulated-list-print (&optional remember-pos update)
  281. "Populate the current Tabulated List mode buffer.
  282. This sorts the `tabulated-list-entries' list if sorting is
  283. specified by `tabulated-list-sort-key'. It then erases the
  284. buffer and inserts the entries with `tabulated-list-printer'.
  285. Optional argument REMEMBER-POS, if non-nil, means to move point
  286. to the entry with the same ID element as the current line and
  287. recenter window line accordingly.
  288. Non-nil UPDATE argument means to use an alternative printing
  289. method which is faster if most entries haven't changed since the
  290. last print. The only difference in outcome is that tags will not
  291. be removed from entries that haven't changed (see
  292. `tabulated-list-put-tag'). Don't use this immediately after
  293. changing `tabulated-list-sort-key'."
  294. (let ((inhibit-read-only t)
  295. (entries (if (functionp tabulated-list-entries)
  296. (funcall tabulated-list-entries)
  297. tabulated-list-entries))
  298. (sorter (tabulated-list--get-sorter))
  299. entry-id saved-pt saved-col window-line)
  300. (and remember-pos
  301. (setq entry-id (tabulated-list-get-id))
  302. (setq saved-col (current-column))
  303. (when (eq (window-buffer) (current-buffer))
  304. (setq window-line
  305. (count-screen-lines (window-start) (point)))))
  306. ;; Sort the entries, if necessary.
  307. (when sorter
  308. (setq entries (sort entries sorter)))
  309. (unless (functionp tabulated-list-entries)
  310. (setq tabulated-list-entries entries))
  311. ;; Without a sorter, we have no way to just update.
  312. (when (and update (not sorter))
  313. (setq update nil))
  314. (if update (goto-char (point-min))
  315. ;; Redo the buffer, unless we're just updating.
  316. (erase-buffer)
  317. (unless tabulated-list-use-header-line
  318. (tabulated-list-print-fake-header)))
  319. ;; Finally, print the resulting list.
  320. (while entries
  321. (let* ((elt (car entries))
  322. (tabulated-list--near-rows
  323. (list
  324. (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt))
  325. (cadr elt)
  326. (or (cadr (cadr entries)) (cadr elt))))
  327. (id (car elt)))
  328. (and entry-id
  329. (equal entry-id id)
  330. (setq entry-id nil
  331. saved-pt (point)))
  332. ;; If the buffer this empty, simply print each elt.
  333. (if (or (not update) (eobp))
  334. (apply tabulated-list-printer elt)
  335. (while (let ((local-id (tabulated-list-get-id)))
  336. ;; If we find id, then nothing to update.
  337. (cond ((equal id local-id)
  338. (forward-line 1)
  339. nil)
  340. ;; If this entry sorts after id (or it's the
  341. ;; end), then just insert id and move on.
  342. ((or (not local-id)
  343. (funcall sorter elt
  344. ;; FIXME: Might be faster if
  345. ;; don't construct this list.
  346. (list local-id (tabulated-list-get-entry))))
  347. (apply tabulated-list-printer elt)
  348. nil)
  349. ;; We find an entry that sorts before id,
  350. ;; it needs to be deleted.
  351. (t t)))
  352. (let ((old (point)))
  353. (forward-line 1)
  354. (delete-region old (point))))))
  355. (setq entries (cdr entries)))
  356. (set-buffer-modified-p nil)
  357. ;; If REMEMBER-POS was specified, move to the "old" location.
  358. (if saved-pt
  359. (progn (goto-char saved-pt)
  360. (move-to-column saved-col)
  361. (when window-line
  362. (recenter window-line)))
  363. (goto-char (point-min)))))
  364. (defun tabulated-list-print-entry (id cols)
  365. "Insert a Tabulated List entry at point.
  366. This is the default `tabulated-list-printer' function. ID is a
  367. Lisp object identifying the entry to print, and COLS is a vector
  368. of column descriptors."
  369. (let ((beg (point))
  370. (x (max tabulated-list-padding 0))
  371. (ncols (length tabulated-list-format))
  372. (inhibit-read-only t))
  373. (if (> tabulated-list-padding 0)
  374. (insert (make-string x ?\s)))
  375. (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
  376. (or (bound-and-true-p tabulated-list--near-rows)
  377. (list (or (tabulated-list-get-entry (point-at-bol 0))
  378. cols)
  379. cols))))
  380. (dotimes (n ncols)
  381. (setq x (tabulated-list-print-col n (aref cols n) x))))
  382. (insert ?\n)
  383. ;; Ever so slightly faster than calling `put-text-property' twice.
  384. (add-text-properties
  385. beg (point)
  386. `(tabulated-list-id ,id tabulated-list-entry ,cols))))
  387. (defun tabulated-list-print-col (n col-desc x)
  388. "Insert a specified Tabulated List entry at point.
  389. N is the column number, COL-DESC is a column descriptor (see
  390. `tabulated-list-entries'), and X is the column number at point.
  391. Return the column number after insertion."
  392. (let* ((format (aref tabulated-list-format n))
  393. (name (nth 0 format))
  394. (width (nth 1 format))
  395. (props (nthcdr 3 format))
  396. (pad-right (or (plist-get props :pad-right) 1))
  397. (right-align (plist-get props :right-align))
  398. (label (if (stringp col-desc) col-desc (car col-desc)))
  399. (label-width (string-width label))
  400. (help-echo (concat (car format) ": " label))
  401. (opoint (point))
  402. (not-last-col (< (1+ n) (length tabulated-list-format)))
  403. available-space)
  404. (when not-last-col
  405. (let* ((next-col-format (aref tabulated-list-format (1+ n)))
  406. (next-col-right-align (plist-get (nthcdr 3 next-col-format)
  407. :right-align))
  408. (next-col-width (nth 1 next-col-format)))
  409. (setq available-space
  410. (if (and (not right-align)
  411. next-col-right-align)
  412. (-
  413. (+ width next-col-width)
  414. (min next-col-width
  415. (tabulated-list--col-local-max-widths (1+ n))))
  416. width))))
  417. ;; Truncate labels if necessary (except last column).
  418. ;; Don't truncate to `width' if the next column is align-right
  419. ;; and has some space left, truncate to `available-space' instead.
  420. (when (and not-last-col
  421. (> label-width available-space)
  422. (setq label (truncate-string-to-width
  423. label available-space nil nil t)
  424. label-width available-space)))
  425. (setq label (bidi-string-mark-left-to-right label))
  426. (when (and right-align (> width label-width))
  427. (let ((shift (- width label-width)))
  428. (insert (propertize (make-string shift ?\s)
  429. 'display `(space :align-to ,(+ x shift))))
  430. (setq width (- width shift))
  431. (setq x (+ x shift))))
  432. (if (stringp col-desc)
  433. (insert (if (get-text-property 0 'help-echo label)
  434. label
  435. (propertize label 'help-echo help-echo)))
  436. (apply 'insert-text-button label (cdr col-desc)))
  437. (let ((next-x (+ x pad-right width)))
  438. ;; No need to append any spaces if this is the last column.
  439. (when not-last-col
  440. (when (> pad-right 0) (insert (make-string pad-right ?\s)))
  441. (insert (propertize
  442. (make-string (- width (min width label-width)) ?\s)
  443. 'display `(space :align-to ,next-x))))
  444. (put-text-property opoint (point) 'tabulated-list-column-name name)
  445. next-x)))
  446. (defun tabulated-list-delete-entry ()
  447. "Delete the Tabulated List entry at point.
  448. Return a list (ID COLS), where ID is the ID of the deleted entry
  449. and COLS is a vector of its column descriptors. Move point to
  450. the beginning of the deleted entry. Return nil if there is no
  451. entry at point.
  452. This function only changes the buffer contents; it does not alter
  453. `tabulated-list-entries'."
  454. ;; Assume that each entry occupies one line.
  455. (let* ((id (tabulated-list-get-id))
  456. (cols (tabulated-list-get-entry))
  457. (inhibit-read-only t))
  458. (when cols
  459. (delete-region (line-beginning-position) (1+ (line-end-position)))
  460. (list id cols))))
  461. (defun tabulated-list-set-col (col desc &optional change-entry-data)
  462. "Change the Tabulated List entry at point, setting COL to DESC.
  463. COL is the column number to change, or the name of the column to change.
  464. DESC is the new column descriptor, which is inserted via
  465. `tabulated-list-print-col'.
  466. If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
  467. by setting the appropriate slot of the vector originally used to
  468. print this entry. If `tabulated-list-entries' has a list value,
  469. this is the vector stored within it."
  470. (let* ((opoint (point))
  471. (eol (line-end-position))
  472. (pos (line-beginning-position))
  473. (id (tabulated-list-get-id pos))
  474. (entry (tabulated-list-get-entry pos))
  475. (prop 'tabulated-list-column-name)
  476. (inhibit-read-only t)
  477. name)
  478. (cond ((numberp col)
  479. (setq name (car (aref tabulated-list-format col))))
  480. ((stringp col)
  481. (setq name col
  482. col (tabulated-list--column-number col)))
  483. (t
  484. (error "Invalid column %s" col)))
  485. (unless entry
  486. (error "No Tabulated List entry at position %s" opoint))
  487. (unless (equal (get-text-property pos prop) name)
  488. (while (and (setq pos
  489. (next-single-property-change pos prop nil eol))
  490. (< pos eol)
  491. (not (equal (get-text-property pos prop) name)))))
  492. (when (< pos eol)
  493. (delete-region pos (next-single-property-change pos prop nil eol))
  494. (goto-char pos)
  495. (let ((tabulated-list--near-rows
  496. (list
  497. (tabulated-list-get-entry (point-at-bol 0))
  498. entry
  499. (or (tabulated-list-get-entry (point-at-bol 2)) entry))))
  500. (tabulated-list-print-col col desc (current-column)))
  501. (if change-entry-data
  502. (aset entry col desc))
  503. (put-text-property pos (point) 'tabulated-list-id id)
  504. (put-text-property pos (point) 'tabulated-list-entry entry)
  505. (goto-char opoint))))
  506. (defun tabulated-list-col-sort (&optional e)
  507. "Sort Tabulated List entries by the column of the mouse click E."
  508. (interactive "e")
  509. (let* ((pos (event-start e))
  510. (obj (posn-object pos)))
  511. (with-current-buffer (window-buffer (posn-window pos))
  512. (tabulated-list--sort-by-column-name
  513. (get-text-property (if obj (cdr obj) (posn-point pos))
  514. 'tabulated-list-column-name
  515. (car obj))))))
  516. (defun tabulated-list-sort (&optional n)
  517. "Sort Tabulated List entries by the column at point.
  518. With a numeric prefix argument N, sort the Nth column."
  519. (interactive "P")
  520. (let ((name (if n
  521. (car (aref tabulated-list-format n))
  522. (get-text-property (point)
  523. 'tabulated-list-column-name))))
  524. (if (nth 2 (assoc name (append tabulated-list-format nil)))
  525. (tabulated-list--sort-by-column-name name)
  526. (user-error "Cannot sort by %s" name))))
  527. (defun tabulated-list--sort-by-column-name (name)
  528. (when (and name (derived-mode-p 'tabulated-list-mode))
  529. ;; Flip the sort order on a second click.
  530. (if (equal name (car tabulated-list-sort-key))
  531. (setcdr tabulated-list-sort-key
  532. (not (cdr tabulated-list-sort-key)))
  533. (setq tabulated-list-sort-key (cons name nil)))
  534. (tabulated-list-init-header)
  535. (tabulated-list-print t)))
  536. ;;; The mode definition:
  537. (define-derived-mode tabulated-list-mode special-mode "Tabulated"
  538. "Generic major mode for browsing a list of items.
  539. This mode is usually not used directly; instead, other major
  540. modes are derived from it, using `define-derived-mode'.
  541. In this major mode, the buffer is divided into multiple columns,
  542. which are labeled using the header line. Each non-empty line
  543. belongs to one \"entry\", and the entries can be sorted according
  544. to their column values.
  545. An inheriting mode should usually do the following in their body:
  546. - Set `tabulated-list-format', specifying the column format.
  547. - Set `tabulated-list-revert-hook', if the buffer contents need
  548. to be specially recomputed prior to `revert-buffer'.
  549. - Maybe set a `tabulated-list-entries' function (see below).
  550. - Maybe set `tabulated-list-printer' (see below).
  551. - Maybe set `tabulated-list-padding'.
  552. - Call `tabulated-list-init-header' to initialize `header-line-format'
  553. according to `tabulated-list-format'.
  554. An inheriting mode is usually accompanied by a \"list-FOO\"
  555. command (e.g. `list-packages', `list-processes'). This command
  556. creates or switches to a buffer and enables the major mode in
  557. that buffer. If `tabulated-list-entries' is not a function, the
  558. command should initialize it to a list of entries for displaying.
  559. Finally, it should call `tabulated-list-print'.
  560. `tabulated-list-print' calls the printer function specified by
  561. `tabulated-list-printer', once for each entry. The default
  562. printer is `tabulated-list-print-entry', but a mode that keeps
  563. data in an ewoc may instead specify a printer function (e.g., one
  564. that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
  565. as the ewoc pretty-printer."
  566. (setq-local truncate-lines t)
  567. (setq-local buffer-undo-list t)
  568. (setq-local revert-buffer-function #'tabulated-list-revert)
  569. (setq-local glyphless-char-display tabulated-list-glyphless-char-display)
  570. ;; Avoid messing up the entries' display just because the first
  571. ;; column of the first entry happens to begin with a R2L letter.
  572. (setq bidi-paragraph-direction 'left-to-right))
  573. (put 'tabulated-list-mode 'mode-class 'special)
  574. (provide 'tabulated-list)
  575. ;;; tabulated-list.el ends here