unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 7d815a3cedc30587d5b62f44d16ffb578988b27c 35337 bytes (raw)
name: lisp/emacs-lisp/tabulated-list.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
 
;;; tabulated-list.el --- generic major mode for tabulated lists -*- lexical-binding: t -*-

;; Copyright (C) 2011-2022 Free Software Foundation, Inc.

;; Author: Chong Yidong <cyd@stupidchicken.com>
;; Keywords: extensions, lisp
;; Version: 1.0

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This file defines Tabulated List mode, a generic major mode for
;; displaying lists of tabulated data, intended for other major modes
;; to inherit from.  It provides several utility routines, e.g. for
;; pretty-printing lines of tabulated data to fit into the appropriate
;; columns.

;; For usage information, see the documentation of `tabulated-list-mode'.

;; This package originated from Tom Tromey's Package Menu mode,
;; extended and generalized to be used by other modes.

;;; Code:

(eval-when-compile (require 'cl-lib))

(defgroup tabulated-list nil
  "Tabulated-list customization group."
  :group 'convenience
  :group 'display)

(defcustom tabulated-list-gui-sort-indicator-asc ?▼
  "Indicator for columns sorted in ascending order, for GUI frames.
See `tabulated-list-tty-sort-indicator-asc' for the indicator used on
text-mode frames."
  :group 'tabulated-list
  :type 'character
  :version "27.1")

(defcustom tabulated-list-gui-sort-indicator-desc ?▲
  "Indicator for columns sorted in descending order, for GUI frames.
See `tabulated-list-tty-sort-indicator-desc' for the indicator used on
text-mode frames."
  :group 'tabulated-list
  :type 'character
  :version "27.1")

(defcustom tabulated-list-tty-sort-indicator-asc ?v
  "Indicator for columns sorted in ascending order, for text-mode frames.
See `tabulated-list-gui-sort-indicator-asc' for the indicator used on GUI
frames."
  :group 'tabulated-list
  :type 'character
  :version "27.1")

(defcustom tabulated-list-tty-sort-indicator-desc ?^
  "Indicator for columns sorted in ascending order, for text-mode frames.
See `tabulated-list-gui-sort-indicator-asc' for the indicator used on GUI
frames."
  :group 'tabulated-list
  :type 'character
  :version "27.1")

(defface tabulated-list-fake-header
  '((t :overline t :underline t :weight bold))
  "Face used on fake header lines."
  :version "27.1")

;; The reason `tabulated-list-format' and other variables are
;; permanent-local is to make it convenient to switch to a different
;; major mode, switch back, and have the original Tabulated List data
;; still valid.  See, for example, ebuff-menu.el.

(defvar-local tabulated-list-format nil
  "The format of the current Tabulated List mode buffer.
This should be a vector of elements (NAME WIDTH SORT . PROPS),
where:
 - NAME is a string describing the column.
   This is the label for the column in the header line.
   Different columns must have non-`equal' names.
 - WIDTH is the width to reserve for the column.
   For the final element, its numerical value is ignored.
 - SORT specifies how to sort entries by this column.
   If nil, this column cannot be used for sorting.
   If t, sort by comparing the string value printed in the column.
   Otherwise, it should be a predicate function suitable for
   `sort', accepting arguments with the same form as the elements
   of `tabulated-list-entries'.
 - PROPS is a plist of additional column properties.
   Currently supported properties are:
   - `:right-align': If non-nil, the column should be right-aligned.
   - `:pad-right': Number of additional padding spaces to the
     right of the column (defaults to 1 if omitted).")
(put 'tabulated-list-format 'permanent-local t)

(defvar-local tabulated-list-use-header-line t
  "Whether the Tabulated List buffer should use a header line.")

(defvar-local tabulated-list-entries nil
  "Entries displayed in the current Tabulated List buffer.
This should be either a function, or a list.
If a list, each element has the form (ID [DESC1 ... DESCN]),
where:

 - ID is nil, or a Lisp object uniquely identifying this entry,
   which is used to keep the cursor on the \"same\" entry when
   rearranging the list.  Comparison is done with `equal'.

 - Each DESC is a column descriptor, one for each column
   specified in `tabulated-list-format'.  The descriptor DESC is
   one of:

    - A string, which is printed as-is, and must not contain any
      newlines.

    - An image descriptor (a list), which is used to insert an
      image (see Info node `(elisp) Image Descriptors').

    - A list (LABEL . PROPS), which means to use
      `insert-text-button' to insert a text button with label
      LABEL and button properties PROPS.  LABEL must not contain
      any newlines.

If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(put 'tabulated-list-entries 'permanent-local t)

(defvar-local tabulated-list-padding 0
  "Number of characters preceding each Tabulated List mode entry.
By default, lines are padded with spaces, but you can use the
function `tabulated-list-put-tag' to change this.")
(put 'tabulated-list-padding 'permanent-local t)

(defvar tabulated-list-revert-hook nil
  "Hook run before reverting a Tabulated List buffer.
This is commonly used to recompute `tabulated-list-entries'.")

(defvar-local tabulated-list-printer 'tabulated-list-print-entry
  "Function for inserting a Tabulated List entry at point.
It is called with two arguments, ID and COLS.  ID is a Lisp
object identifying the entry, and COLS is a vector of column
descriptors, as documented in `tabulated-list-entries'.")

(defvar tabulated-list--near-rows)

(defvar-local tabulated-list-sort-key nil
  "Sort key for the current Tabulated List mode buffer.
If nil, no additional sorting is performed.
Otherwise, this should be a cons cell (NAME . FLIP).
NAME is a string matching one of the column names in
`tabulated-list-format' (the corresponding SORT entry in
`tabulated-list-format' then specifies how to sort).  FLIP, if
non-nil, means to invert the resulting sort.")
(put 'tabulated-list-sort-key 'permanent-local t)

(defsubst tabulated-list-get-id (&optional pos)
  "Return the entry ID of the Tabulated List entry at POS.
The value is an ID object from `tabulated-list-entries', or nil.
POS, if omitted or nil, defaults to point."
  (get-text-property (or pos (point)) 'tabulated-list-id))

(defsubst tabulated-list-get-entry (&optional pos)
  "Return the Tabulated List entry at POS.
The value is a vector of column descriptors, or nil if there is
no entry at POS.  POS, if omitted or nil, defaults to point."
  (get-text-property (or pos (point)) 'tabulated-list-entry))

(defun tabulated-list-put-tag (tag &optional advance)
  "Put TAG in the padding area of the current line.
TAG should be a string, with length <= `tabulated-list-padding'.
If ADVANCE is non-nil, move forward by one line afterwards."
  (unless (stringp tag)
    (error "Invalid argument to `tabulated-list-put-tag'"))
  (unless (> tabulated-list-padding 0)
    (error "Unable to tag the current line"))
  (save-excursion
    (beginning-of-line)
    (when (tabulated-list-get-entry)
      (let ((beg (point))
	    (inhibit-read-only t))
	(forward-char tabulated-list-padding)
	(insert-and-inherit
	 (let ((width (string-width tag)))
	   (if (<= width tabulated-list-padding)
	       (concat tag
		       (make-string (- tabulated-list-padding width) ?\s))
	     (truncate-string-to-width tag tabulated-list-padding))))
	(delete-region beg (+ beg tabulated-list-padding)))))
  (if advance
      (forward-line)))

(defun tabulated-list-clear-all-tags ()
  "Clear all tags from the padding area in the current buffer."
  (unless (> tabulated-list-padding 0)
    (error "There can be no tags in current buffer"))
  (save-excursion
    (goto-char (point-min))
    (let ((inhibit-read-only t)
          ;; Match non-space in the first n characters.
          (re (format "^ \\{0,%d\\}[^ ]" (1- tabulated-list-padding)))
          (empty (make-string tabulated-list-padding ? )))
      (while (re-search-forward re nil 'noerror)
        (tabulated-list-put-tag empty)))))

(defvar tabulated-list-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map (make-composed-keymap
                            button-buffer-map
                            special-mode-map))
    (define-key map "n" 'next-line)
    (define-key map "p" 'previous-line)
    (define-key map (kbd "M-<left>") 'tabulated-list-previous-column)
    (define-key map (kbd "M-<right>") 'tabulated-list-next-column)
    (define-key map "S" 'tabulated-list-sort)
    (define-key map "}" 'tabulated-list-widen-current-column)
    (define-key map "{" 'tabulated-list-narrow-current-column)
    (define-key map [follow-link] 'mouse-face)
    (define-key map [mouse-2] 'mouse-select-window)
    map)
  "Local keymap for `tabulated-list-mode' buffers.")

(defvar tabulated-list-sort-button-map
  (let ((map (make-sparse-keymap)))
    (define-key map [header-line mouse-1] 'tabulated-list-col-sort)
    (define-key map [header-line mouse-2] 'tabulated-list-col-sort)
    (define-key map [mouse-1] 'tabulated-list-col-sort)
    (define-key map [mouse-2] 'tabulated-list-col-sort)
    (define-key map "\C-m" 'tabulated-list-sort)
    (define-key map [follow-link] 'mouse-face)
    map)
  "Local keymap for `tabulated-list-mode' sort buttons.")

(defun tabulated-list-make-glyphless-char-display-table ()
  "Make the `glyphless-char-display' table used for text-mode frames.
This table is used for displaying the sorting indicators, see
variables `tabulated-list-tty-sort-indicator-asc' and
`tabulated-list-tty-sort-indicator-desc' for more information."
  (let ((table (make-char-table 'glyphless-char-display nil)))
    (set-char-table-parent table glyphless-char-display)
    (aset table
          tabulated-list-gui-sort-indicator-desc
          (cons nil (char-to-string tabulated-list-tty-sort-indicator-desc)))
    (aset table
          tabulated-list-gui-sort-indicator-asc
          (cons nil (char-to-string tabulated-list-tty-sort-indicator-asc)))
    table))

(defvar tabulated-list--header-string nil
  "Holds the header if `tabulated-list-use-header-line' is nil.
Populated by `tabulated-list-init-header'.")
(defvar tabulated-list--header-overlay nil)

(define-obsolete-function-alias 'tabulated-list-line-number-width
  'header-line-indent--line-number-width "29.1")
(define-obsolete-function-alias 'tabulated-list-watch-line-number-width
  'header-line-indent--watch-line-number-width "29.1")
(define-obsolete-function-alias 'tabulated-list-watch-line-number-width
  'header-line-indent--watch-line-number-width "29.1")
(define-obsolete-function-alias 'tabulated-list-window-scroll-function
  'header-line-indent--window-scroll-function "29.1")

(defun tabulated-list-init-header ()
  "Set up header line for the Tabulated List buffer."
  ;; FIXME: Should share code with tabulated-list-print-col!
  (let* ((x (max tabulated-list-padding 0))
	 (button-props `(help-echo "Click to sort by column"
			           mouse-face header-line-highlight
			           keymap ,tabulated-list-sort-button-map))
         (len (length tabulated-list-format))
         ;; Pre-compute width for available-space compution.
         (hcols (mapcar #'car tabulated-list-format))
         (tabulated-list--near-rows (list hcols hcols))
	 (cols nil))
    (push (propertize " " 'display
                      `(space :align-to (+ header-line-indent-width ,x)))
          cols)
    (dotimes (n len)
      (let* ((col (aref tabulated-list-format n))
             (not-last-col (< n (1- len)))
	     (label (nth 0 col))
             (lablen (length label))
             (pname label)
	     (width (nth 1 col))
	     (props (nthcdr 3 col))
	     (pad-right (or (plist-get props :pad-right) 1))
             (right-align (plist-get props :right-align))
             (next-x (+ x pad-right width))
             (available-space
              (and not-last-col
                   (if right-align
                       width
                     (tabulated-list--available-space width n)))))
        (when (and (>= lablen 3)
                   not-last-col
                   (> lablen available-space))
          (setq label (truncate-string-to-width label available-space
                                                nil nil t)))
	(push
	 (cond
	  ;; An unsortable column
	  ((not (nth 2 col))
	   (propertize label 'tabulated-list-column-name pname))
	  ;; The selected sort column
	  ((equal (car col) (car tabulated-list-sort-key))
	   (apply 'propertize
                  (concat label
                          (cond
                           ((and (< lablen 3) not-last-col) "")
                           ((cdr tabulated-list-sort-key)
                            (format " %c"
                                    tabulated-list-gui-sort-indicator-desc))
                           (t (format " %c"
                                      tabulated-list-gui-sort-indicator-asc))))
                  'face 'bold
                  'tabulated-list-column-name pname
                  button-props))
	  ;; Unselected sortable column.
	  (t (apply 'propertize label
		    'tabulated-list-column-name pname
		    button-props)))
	 cols)
        (when right-align
          (let ((shift (- width (string-width (car cols)))))
            (when (> shift 0)
              (setq cols
                    (cons (car cols)
                          (cons
                           (propertize
                            (make-string shift ?\s)
                            'display
                            `(space :align-to
                                    (+ header-line-indent-width ,(+ x shift))))
                           (cdr cols))))
              (setq x (+ x shift)))))
	(if (>= pad-right 0)
	    (push (propertize
                   " "
		   'display `(space :align-to
                                    (+ header-line-indent-width ,next-x))
		   'face 'fixed-pitch)
		  cols))
        (setq x next-x)))
    (setq cols (apply 'concat (nreverse cols)))
    (if tabulated-list-use-header-line
	(setq header-line-format (list "" 'header-line-indent cols))
      (setq-local tabulated-list--header-string cols))))

(defun tabulated-list-print-fake-header ()
  "Insert a fake Tabulated List \"header line\" at the start of the buffer.
Do nothing if `tabulated-list--header-string' is nil."
  (when tabulated-list--header-string
    (goto-char (point-min))
    (let ((inhibit-read-only t))
      (insert tabulated-list--header-string "\n")
      (if tabulated-list--header-overlay
          (move-overlay tabulated-list--header-overlay (point-min) (point))
        (setq-local tabulated-list--header-overlay
                    (make-overlay (point-min) (point))))
      (overlay-put tabulated-list--header-overlay
                   'face 'tabulated-list-fake-header))))

(defsubst tabulated-list-header-overlay-p (&optional pos)
  "Return non-nil if there is a fake header.
Optional arg POS is a buffer position where to look for a fake header;
defaults to `point-min'."
  (overlays-at (or pos (point-min))))

(defun tabulated-list-revert (&rest ignored)
  "The `revert-buffer-function' for `tabulated-list-mode'.
It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
  (interactive)
  (unless (derived-mode-p 'tabulated-list-mode)
    (error "The current buffer is not in Tabulated List mode"))
  (run-hooks 'tabulated-list-revert-hook)
  (tabulated-list-print t))

(defun tabulated-list--column-number (name)
  (let ((len (length tabulated-list-format))
	(n 0)
	found)
    (while (and (< n len) (null found))
      (if (equal (car (aref tabulated-list-format n)) name)
	  (setq found n))
      (setq n (1+ n)))
    (or found
	(error "No column named %s" name))))

(defun tabulated-list--get-sorter ()
  "Return a sorting predicate for the current tabulated-list.
Return nil if `tabulated-list-sort-key' specifies an unsortable
column.  Negate the predicate that would be returned if
`tabulated-list-sort-key' has a non-nil cdr."
  (when (and tabulated-list-sort-key
             (car tabulated-list-sort-key))
    (let* ((sort-column (car tabulated-list-sort-key))
           (n (tabulated-list--column-number sort-column))
           (sorter (nth 2 (aref tabulated-list-format n))))
      (when (eq sorter t); Default sorter checks column N:
        (setq sorter (lambda (A B)
                       (let ((a (aref (cadr A) n))
                             (b (aref (cadr B) n)))
                         (string< (if (stringp a) a (car a))
                                  (if (stringp b) b (car b)))))))
      ;; Reversed order.
      (if (cdr tabulated-list-sort-key)
          (lambda (a b) (funcall sorter b a))
        sorter))))

(defsubst tabulated-list--col-local-max-widths (col)
   "Return maximum entry widths at column COL around current row.
Check the current row, the previous one and the next row."
  (apply #'max (mapcar (lambda (x)
                         (let ((nt (elt x col)))
                           (string-width (if (stringp nt) nt (car nt)))))
                       tabulated-list--near-rows)))

(defun tabulated-list-print (&optional remember-pos update)
  "Populate the current Tabulated List mode buffer.
This sorts the `tabulated-list-entries' list if sorting is
specified by `tabulated-list-sort-key'.  It then erases the
buffer and inserts the entries with `tabulated-list-printer'.

Optional argument REMEMBER-POS, if non-nil, means to move point
to the entry with the same ID element as the current line.

Non-nil UPDATE argument means to use an alternative printing
method which is faster if most entries haven't changed since the
last print.  The only difference in outcome is that tags will not
be removed from entries that haven't changed (see
`tabulated-list-put-tag').  Don't use this immediately after
changing `tabulated-list-sort-key'."
  (let ((inhibit-read-only t)
	(entries (if (functionp tabulated-list-entries)
		     (funcall tabulated-list-entries)
		   tabulated-list-entries))
        (sorter (tabulated-list--get-sorter))
        entry-id saved-pt saved-col)
    (and remember-pos
	 (setq entry-id (tabulated-list-get-id))
	 (setq saved-col (current-column)))
    ;; Sort the entries, if necessary.
    (when sorter
      (setq entries (sort entries sorter)))
    (unless (functionp tabulated-list-entries)
      (setq tabulated-list-entries entries))
    ;; Without a sorter, we have no way to just update.
    (when (and update (not sorter))
      (setq update nil))
    (if update (goto-char (point-min))
      ;; Redo the buffer, unless we're just updating.
      (erase-buffer)
      (unless tabulated-list-use-header-line
        (tabulated-list-print-fake-header)))
    ;; Finally, print the resulting list.
    (while entries
      (let* ((elt (car entries))
             (tabulated-list--near-rows
              (list
               (or (tabulated-list-get-entry (point-at-bol 0)) (cadr elt))
               (cadr elt)
               (or (cadr (cadr entries)) (cadr elt))))
             (id (car elt)))
        (and entry-id
             (equal entry-id id)
             (setq entry-id nil
                   saved-pt (point)))
        ;; If the buffer is empty, simply print each elt.
        (if (or (not update) (eobp))
            (apply tabulated-list-printer elt)
          (while (let ((local-id (tabulated-list-get-id)))
                   ;; If we find id, then nothing to update.
                   (cond ((equal id local-id)
                          (forward-line 1)
                          nil)
                         ;; If this entry sorts after id (or it's the
                         ;; end), then just insert id and move on.
                         ((or (not local-id)
                              (funcall sorter elt
                                       ;; FIXME: Might be faster if
                                       ;; don't construct this list.
                                       (list local-id (tabulated-list-get-entry))))
                          (apply tabulated-list-printer elt)
                          nil)
                         ;; We find an entry that sorts before id,
                         ;; it needs to be deleted.
                         (t t)))
            (let ((old (point)))
              (forward-line 1)
              (delete-region old (point))))))
      (setq entries (cdr entries)))
    (when update
      (delete-region (point) (point-max)))
    (set-buffer-modified-p nil)
    ;; If REMEMBER-POS was specified, move to the "old" location.
    (if saved-pt
	(progn (goto-char saved-pt)
	       (move-to-column saved-col))
      (goto-char (point-min)))))

(defun tabulated-list-print-entry (id cols)
  "Insert a Tabulated List entry at point.
This is the default `tabulated-list-printer' function.  ID is a
Lisp object identifying the entry to print, and COLS is a vector
of column descriptors."
  (let ((beg   (point))
	(x     (max tabulated-list-padding 0))
	(ncols (length tabulated-list-format))
	(inhibit-read-only t))
    (if (> tabulated-list-padding 0)
	(insert (make-string x ?\s)))
    (let ((tabulated-list--near-rows ; Bind it if not bound yet (Bug#25506).
           (or (bound-and-true-p tabulated-list--near-rows)
               (list (or (tabulated-list-get-entry (point-at-bol 0))
                         cols)
                     cols))))
      (dotimes (n ncols)
        (setq x (tabulated-list-print-col n (aref cols n) x))))
    (insert ?\n)
    ;; Ever so slightly faster than calling `put-text-property' twice.
    (add-text-properties
     beg (point)
     `(tabulated-list-id ,id tabulated-list-entry ,cols))))

(defun tabulated-list--available-space (width n)
  (let* ((next-col-format (aref tabulated-list-format (1+ n)))
         (next-col-right-align (plist-get (nthcdr 3 next-col-format)
                                          :right-align))
         (next-col-width (nth 1 next-col-format)))
    (if next-col-right-align
        (- (+ width next-col-width)
           (min next-col-width
                (tabulated-list--col-local-max-widths (1+ n))))
      width)))

(defun tabulated-list-print-col (n col-desc x)
  "Insert a specified Tabulated List entry at point.
N is the column number, COL-DESC is a column descriptor (see
`tabulated-list-entries'), and X is the column number at point.
Return the column number after insertion."
  (let* ((format    (aref tabulated-list-format n))
	 (name      (nth 0 format))
	 (width     (nth 1 format))
	 (props     (nthcdr 3 format))
	 (pad-right (or (plist-get props :pad-right) 1))
         (right-align (plist-get props :right-align))
         (label (cond ((stringp col-desc) col-desc)
                      ((eq (car col-desc) 'image) " ")
                      (t (car col-desc))))
         (label-width (string-width label))
	 (help-echo (concat (car format) ": " label))
	 (opoint (point))
	 (not-last-col (< (1+ n) (length tabulated-list-format)))
	 (available-space (and not-last-col
                               (if right-align
                                   width
                                 (tabulated-list--available-space width n)))))
    ;; Truncate labels if necessary (except last column).
    ;; Don't truncate to `width' if the next column is align-right
    ;; and has some space left, truncate to `available-space' instead.
    (when (and not-last-col
	       (> label-width available-space))
      (setq label (truncate-string-to-width
		   label available-space nil nil t t)
	    label-width available-space))
    (setq label (bidi-string-mark-left-to-right label))
    (when (and right-align (> width label-width))
      (let ((shift (- width label-width)))
        (insert (propertize (make-string shift ?\s)
                            'display `(space :align-to ,(+ x shift))))
        (setq width (- width shift))
        (setq x (+ x shift))))
    (cond ((stringp col-desc)
           (insert (if (get-text-property 0 'help-echo label)
                       label
                     (propertize label 'help-echo help-echo))))
          ((eq (car col-desc) 'image)
           (insert (propertize " "
                               'display col-desc
                               'help-echo help-echo)))
          ((apply 'insert-text-button label (cdr col-desc))))
    (let ((next-x (+ x pad-right width)))
      ;; No need to append any spaces if this is the last column.
      (when not-last-col
        (when (> pad-right 0) (insert (make-string pad-right ?\s)))
        (insert (propertize
                 (make-string (- width (min width label-width)) ?\s)
                 'display `(space :align-to ,next-x))))
      (put-text-property opoint (point) 'tabulated-list-column-name name)
      next-x)))

(defun tabulated-list-delete-entry ()
  "Delete the Tabulated List entry at point.
Return a list (ID COLS), where ID is the ID of the deleted entry
and COLS is a vector of its column descriptors.  Move point to
the beginning of the deleted entry.  Return nil if there is no
entry at point.

This function only changes the buffer contents; it does not alter
`tabulated-list-entries'."
  ;; Assume that each entry occupies one line.
  (let* ((id (tabulated-list-get-id))
	 (cols (tabulated-list-get-entry))
	 (inhibit-read-only t))
    (when cols
      (delete-region (line-beginning-position) (1+ (line-end-position)))
      (list id cols))))

(defun tabulated-list-set-col (col desc &optional change-entry-data)
  "Change the Tabulated List entry at point, setting COL to DESC.
COL is the column number to change, or the name of the column to change.
DESC is the new column descriptor, which is inserted via
`tabulated-list-print-col'.

If CHANGE-ENTRY-DATA is non-nil, modify the underlying entry data
by setting the appropriate slot of the vector originally used to
print this entry.  If `tabulated-list-entries' has a list value,
this is the vector stored within it."
  (let* ((opoint (point))
	 (eol    (line-end-position))
	 (pos    (line-beginning-position))
	 (id     (tabulated-list-get-id pos))
	 (entry  (tabulated-list-get-entry pos))
	 (prop 'tabulated-list-column-name)
	 (inhibit-read-only t)
	 name)
    (cond ((numberp col)
	   (setq name (car (aref tabulated-list-format col))))
	  ((stringp col)
	   (setq name col
		 col (tabulated-list--column-number col)))
	  (t
	   (error "Invalid column %s" col)))
    (unless entry
      (error "No Tabulated List entry at position %s" opoint))
    (unless (equal (get-text-property pos prop) name)
      (while (and (setq pos
			(next-single-property-change pos prop nil eol))
		  (< pos eol)
		  (not (equal (get-text-property pos prop) name)))))
    (when (< pos eol)
      (delete-region pos (next-single-property-change pos prop nil eol))
      (goto-char pos)
      (let ((tabulated-list--near-rows
             (list
              (tabulated-list-get-entry (point-at-bol 0))
              entry
              (or (tabulated-list-get-entry (point-at-bol 2)) entry))))
        (tabulated-list-print-col col desc (current-column)))
      (if change-entry-data
	  (aset entry col desc))
      (put-text-property pos (point) 'tabulated-list-id id)
      (put-text-property pos (point) 'tabulated-list-entry entry)
      (goto-char opoint))))

(defun tabulated-list-col-sort (&optional e)
  "Sort Tabulated List entries by the column of the mouse click E."
  (interactive "e")
  (let* ((pos (event-start e))
	 (obj (posn-object pos)))
    (with-current-buffer (window-buffer (posn-window pos))
      (tabulated-list--sort-by-column-name
       (get-text-property (if obj (cdr obj) (posn-point pos))
			  'tabulated-list-column-name
			  (car obj))))))

(defun tabulated-list-sort (&optional n)
  "Sort Tabulated List entries by the column at point.
With a numeric prefix argument N, sort the Nth column.

If the numeric prefix is -1, restore order the list was
originally displayed in."
  (interactive "P")
  (when (and n
             (or (>= n (length tabulated-list-format))
                 (< n -1)))
    (user-error "Invalid column number"))
  (if (equal n -1)
      ;; Restore original order.
      (progn
        (unless tabulated-list--original-order
          (error "Order is already in original order"))
        (setq tabulated-list-entries
              (sort tabulated-list-entries
                    (lambda (e1 e2)
                      (< (gethash e1 tabulated-list--original-order)
                         (gethash e2 tabulated-list--original-order)))))
        (setq tabulated-list-sort-key nil)
        (tabulated-list-init-header)
        (tabulated-list-print t))
    ;; Sort based on a column name.
    (let ((name (if n
		    (car (aref tabulated-list-format n))
		  (get-text-property (point)
				     'tabulated-list-column-name))))
      (if (nth 2 (assoc name (append tabulated-list-format nil)))
          (tabulated-list--sort-by-column-name name)
        (user-error "Cannot sort by %s" name)))))

(defun tabulated-list--sort-by-column-name (name)
  (when (and name (derived-mode-p 'tabulated-list-mode))
    (unless tabulated-list--original-order
      ;; Store the original order so that we can restore it later.
      (setq tabulated-list--original-order (make-hash-table))
      (cl-loop for elem in tabulated-list-entries
               for i from 0
               do (setf (gethash elem tabulated-list--original-order) i)))
    ;; Flip the sort order on a second click.
    (if (equal name (car tabulated-list-sort-key))
	(setcdr tabulated-list-sort-key
		(not (cdr tabulated-list-sort-key)))
      (setq tabulated-list-sort-key (cons name nil)))
    (tabulated-list-init-header)
    (tabulated-list-print t)))

(defun tabulated-list-widen-current-column (&optional n)
  "Widen the current tabulated-list column by N chars.
Interactively, N is the prefix numeric argument, and defaults to
1."
  (interactive "p")
  (let ((start (current-column))
        (entry (tabulated-list-get-entry))
        (nb-cols (length tabulated-list-format))
        (col-nb 0)
        (total-width 0)
        (found nil)
        col-width)
    (while (and (not found)
                (< col-nb nb-cols))
      (if (>= start
              (setq total-width
                    (+ total-width
                       (max (setq col-width
                                  (cadr (aref tabulated-list-format
                                              col-nb)))
                            (let ((desc (aref entry col-nb)))
                              (string-width (if (stringp desc)
                                                desc
                                              (car desc)))))
                       (or (plist-get (nthcdr 3 (aref tabulated-list-format
                                                      col-nb))
                                      :pad-right)
                           1))))
          (setq col-nb (1+ col-nb))
        (setq found t)
        ;; `tabulated-list-format' may be a constant (sharing list
        ;; structures), so copy it before mutating.
        (setq tabulated-list-format (copy-tree tabulated-list-format t))
        (setf (cadr (aref tabulated-list-format col-nb))
              (max 1 (+ col-width n)))
        (tabulated-list-print t)
        (tabulated-list-init-header)))))

(defun tabulated-list-narrow-current-column (&optional n)
  "Narrow the current tabulated list column by N chars.
Interactively, N is the prefix numeric argument, and defaults to
1."
  (interactive "p")
  (tabulated-list-widen-current-column (- n)))

(defun tabulated-list-next-column (&optional arg)
  "Go to the start of the next column after point on the current line.
If ARG is provided, move that many columns."
  (interactive "p")
  (dotimes (_ (or arg 1))
    (let ((next (or (next-single-property-change
                     (point) 'tabulated-list-column-name)
                    (point-max))))
      (when (<= next (line-end-position))
        (goto-char next)))))

(defun tabulated-list-previous-column (&optional arg)
  "Go to the start of the column point is in on the current line.
If ARG is provided, move that many columns."
  (interactive "p")
  (dotimes (_ (or arg 1))
    (let ((prev (or (previous-single-property-change
                     (point) 'tabulated-list-column-name)
                    1)))
      (unless (< prev (line-beginning-position))
        (goto-char prev)))))

;;; The mode definition:

(defvar tabulated-list--original-order nil)

(define-derived-mode tabulated-list-mode special-mode "Tabulated"
  "Generic major mode for browsing a list of items.
This mode is usually not used directly; instead, other major
modes are derived from it, using `define-derived-mode'.

In this major mode, the buffer is divided into multiple columns,
which are labeled using the header line.  Each non-empty line
belongs to one \"entry\", and the entries can be sorted according
to their column values.

An inheriting mode should usually do the following in their body:

 - Set `tabulated-list-format', specifying the column format.
 - Set `tabulated-list-revert-hook', if the buffer contents need
   to be specially recomputed prior to `revert-buffer'.
 - Maybe set a `tabulated-list-entries' function (see below).
 - Maybe set `tabulated-list-printer' (see below).
 - Maybe set `tabulated-list-padding'.
 - Call `tabulated-list-init-header' to initialize `header-line-format'
   according to `tabulated-list-format'.

An inheriting mode is usually accompanied by a \"list-FOO\"
command (e.g. `list-packages', `list-processes').  This command
creates or switches to a buffer and enables the major mode in
that buffer.  If `tabulated-list-entries' is not a function, the
command should initialize it to a list of entries for displaying.
Finally, it should call `tabulated-list-print'.

`tabulated-list-print' calls the printer function specified by
`tabulated-list-printer', once for each entry.  The default
printer is `tabulated-list-print-entry', but a mode that keeps
data in an ewoc may instead specify a printer function (e.g., one
that calls `ewoc-enter-last'), with `tabulated-list-print-entry'
as the ewoc pretty-printer."
  (setq-local truncate-lines t)
  (setq-local buffer-undo-list t)
  (setq-local revert-buffer-function #'tabulated-list-revert)
  (setq-local glyphless-char-display
              (tabulated-list-make-glyphless-char-display-table))
  (setq-local text-scale-remap-header-line t)
  (setq-local tabulated-list--original-order nil)
  ;; Avoid messing up the entries' display just because the first
  ;; column of the first entry happens to begin with a R2L letter.
  (setq bidi-paragraph-direction 'left-to-right)
  (header-line-indent-mode))

(put 'tabulated-list-mode 'mode-class 'special)

(provide 'tabulated-list)

;;; tabulated-list.el ends here

debug log:

solving 7d815a3ced ...
found 7d815a3ced in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).