;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; 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, or (at your option)
-;; any later version.
+;; 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
;;; Code:
+;; 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 tabulated-list-format nil
"The format of the current Tabulated List mode buffer.
This should be a vector of elements (NAME WIDTH SORT . PROPS),
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).")
(make-variable-buffer-local 'tabulated-list-format)
+(put 'tabulated-list-format 'permanent-local t)
+
+(defvar tabulated-list-use-header-line t
+ "Whether the Tabulated List buffer should use a header line.")
+(make-variable-buffer-local 'tabulated-list-use-header-line)
(defvar tabulated-list-entries nil
"Entries displayed in the current Tabulated List buffer.
If `tabulated-list-entries' is a function, it is called with no
arguments and must return a list of the above form.")
(make-variable-buffer-local 'tabulated-list-entries)
+(put 'tabulated-list-entries 'permanent-local t)
(defvar 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.")
(make-variable-buffer-local 'tabulated-list-padding)
+(put 'tabulated-list-padding 'permanent-local t)
(defvar tabulated-list-revert-hook nil
"Hook run before reverting a Tabulated List buffer.
`tabulated-list-format' then specifies how to sort). FLIP, if
non-nil, means to invert the resulting sort.")
(make-variable-buffer-local 'tabulated-list-sort-key)
+(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.
(set-keymap-parent map button-buffer-map)
(define-key map "n" 'next-line)
(define-key map "p" 'previous-line)
- (define-key map "S" 'tabulated-list-sort-column)
+ (define-key map "S" 'tabulated-list-sort)
(define-key map [follow-link] 'mouse-face)
(define-key map [mouse-2] 'mouse-select-window)
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.")
table)
"The `glyphless-char-display' table in Tabulated List buffers.")
+(defvar tabulated-list--header-string nil)
+(defvar tabulated-list--header-overlay nil)
+
(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 highlight
keymap ,tabulated-list-sort-button-map))
(cols nil))
- (if (> tabulated-list-padding 0)
- (push (propertize " " 'display `(space :align-to ,x)) cols))
+ (push (propertize " " 'display `(space :align-to ,x)) cols)
(dotimes (n (length tabulated-list-format))
(let* ((col (aref tabulated-list-format n))
(label (nth 0 col))
(width (nth 1 col))
(props (nthcdr 3 col))
- (pad-right (or (plist-get props :pad-right) 1)))
- (setq x (+ x pad-right width))
- (and (<= tabulated-list-padding 0)
- (= n 0)
- (setq label (concat " " label)))
+ (pad-right (or (plist-get props :pad-right) 1))
+ (right-align (plist-get props :right-align))
+ (next-x (+ x pad-right width)))
(push
(cond
;; An unsortable column
- ((not (nth 2 col)) label)
+ ((not (nth 2 col))
+ (propertize label 'tabulated-list-column-name label))
;; The selected sort column
((equal (car col) (car tabulated-list-sort-key))
(apply 'propertize
(concat label
(cond
- ((> (+ 2 (length label)) width)
- "")
- ((cdr tabulated-list-sort-key)
- " ▲")
+ ((> (+ 2 (length label)) width) "")
+ ((cdr tabulated-list-sort-key) " ▲")
(t " ▼")))
'face 'bold
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
button-props))
;; Unselected sortable column.
(t (apply 'propertize label
- 'tabulated-list-column-name (car col)
+ 'tabulated-list-column-name label
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 ,(+ x shift)))
+ (cdr cols))))
+ (setq x (+ x shift)))))
(if (> pad-right 0)
(push (propertize " "
- 'display `(space :align-to ,x)
+ 'display `(space :align-to ,next-x)
'face 'fixed-pitch)
- cols))))
- (setq header-line-format (mapconcat 'identity (nreverse cols) ""))))
+ cols))
+ (setq x next-x)))
+ (setq cols (apply 'concat (nreverse cols)))
+ (if tabulated-list-use-header-line
+ (setq header-line-format cols)
+ (setq header-line-format nil)
+ (set (make-local-variable 'tabulated-list--header-string) cols))))
+
+(defun tabulated-list-print-fake-header ()
+ "Insert a fake Tabulated List \"header line\" at the start of the buffer."
+ (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))
+ (set (make-local-variable 'tabulated-list--header-overlay)
+ (make-overlay (point-min) (point))))
+ (overlay-put tabulated-list--header-overlay 'face 'underline)))
(defun tabulated-list-revert (&rest ignored)
"The `revert-buffer-function' for `tabulated-list-mode'.
(setq entry-id (tabulated-list-get-id))
(setq saved-col (current-column)))
(erase-buffer)
- ;; Sort the buffers, if necessary.
+ (unless tabulated-list-use-header-line
+ (tabulated-list-print-fake-header))
+ ;; Sort the entries, if necessary.
(when (and tabulated-list-sort-key
(car tabulated-list-sort-key))
(let* ((sort-column (car tabulated-list-sort-key))
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."
+ ;; TODO: don't truncate to `width' if the next column is align-right
+ ;; and has some space left.
(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 (if (stringp col-desc) col-desc (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))))
;; Truncate labels if necessary (except last column).
(and not-last-col
- (> (string-width label) width)
- (setq label (truncate-string-to-width label width nil nil t)))
+ (> label-width width)
+ (setq label (truncate-string-to-width label width nil nil t)
+ label-width width))
(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))))
(if (stringp col-desc)
(insert (propertize label 'help-echo help-echo))
(apply 'insert-text-button label (cdr col-desc)))
- (setq x (+ x pad-right width))
- ;; No need to append any spaces if this is the last column.
- (if not-last-col
- (indent-to x pad-right))
- (put-text-property opoint (point) 'tabulated-list-column-name name)
- x))
+ (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 (- next-x x label-width pad-right) ?\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.
"Sort Tabulated List entries by the column of the mouse click E."
(interactive "e")
(let* ((pos (event-start e))
- (obj (posn-object pos))
- (name (get-text-property (if obj (cdr obj) (posn-point pos))
- 'tabulated-list-column-name
- (car obj))))
+ (obj (posn-object pos)))
(with-current-buffer (window-buffer (posn-window pos))
- (tabulated-list--sort-by-column-name name))))
+ (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-column (&optional n)
+(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."
(interactive "P")
(tabulated-list--sort-by-column-name name)))
(defun tabulated-list--sort-by-column-name (name)
- (when (derived-mode-p 'tabulated-list-mode)
+ (when (and name (derived-mode-p 'tabulated-list-mode))
;; Flip the sort order on a second click.
(if (equal name (car tabulated-list-sort-key))
(setcdr tabulated-list-sort-key
;;; The mode definition:
-;;;###autoload
(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
HCoop / bpt / emacs.git / blobdiff