diff options
Diffstat (limited to 'lisp/emacs-lisp/tabulated-list.el')
| -rw-r--r-- | lisp/emacs-lisp/tabulated-list.el | 150 |
1 files changed, 66 insertions, 84 deletions
diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 13f610bd230..9868d8c4ec0 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -216,33 +216,28 @@ If ADVANCE is non-nil, move forward by one line afterwards." (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.") +(defvar-keymap tabulated-list-mode-map + :doc "Local keymap for `tabulated-list-mode' buffers." + :parent (make-composed-keymap button-buffer-map + special-mode-map) + "n" #'next-line + "p" #'previous-line + "M-<left>" #'tabulated-list-previous-column + "M-<right>" #'tabulated-list-next-column + "S" #'tabulated-list-sort + "}" #'tabulated-list-widen-current-column + "{" #'tabulated-list-narrow-current-column + "<follow-link>" 'mouse-face + "<mouse-2>" #'mouse-select-window) + +(defvar-keymap tabulated-list-sort-button-map + :doc "Local keymap for `tabulated-list-mode' sort buttons." + "<header-line> <mouse-1>" #'tabulated-list-col-sort + "<header-line> <mouse-2>" #'tabulated-list-col-sort + "<mouse-1>" #'tabulated-list-col-sort + "<mouse-2>" #'tabulated-list-col-sort + "RET" #'tabulated-list-sort + "<follow-link>" 'mouse-face) (defun tabulated-list-make-glyphless-char-display-table () "Make the `glyphless-char-display' table used for text-mode frames. @@ -264,18 +259,14 @@ variables `tabulated-list-tty-sort-indicator-asc' and Populated by `tabulated-list-init-header'.") (defvar tabulated-list--header-overlay nil) -(defun tabulated-list-line-number-width () - "Return the width taken by `display-line-numbers' in the current buffer." - ;; line-number-display-width returns the value for the selected - ;; window, which might not be the window in which the current buffer - ;; is displayed. - (if (not display-line-numbers) - 0 - (let ((cbuf-window (get-buffer-window (current-buffer) t))) - (if (window-live-p cbuf-window) - (with-selected-window cbuf-window - (line-number-display-width 'columns)) - 4)))) +(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." @@ -289,9 +280,9 @@ Populated by `tabulated-list-init-header'.") (hcols (mapcar #'car tabulated-list-format)) (tabulated-list--near-rows (list hcols hcols)) (cols nil)) - (if display-line-numbers - (setq x (+ x (tabulated-list-line-number-width)))) - (push (propertize " " 'display `(space :align-to ,x)) cols) + (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))) @@ -342,20 +333,25 @@ Populated by `tabulated-list-init-header'.") (when (> shift 0) (setq cols (cons (car cols) - (cons (propertize (make-string shift ?\s) - 'display - `(space :align-to ,(+ x shift))) - (cdr 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 ,next-x) - 'face 'fixed-pitch) + (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 cols) + (setq header-line-format (list "" 'header-line-indent cols)) (setq-local tabulated-list--header-string cols)))) (defun tabulated-list-print-fake-header () @@ -596,8 +592,7 @@ Return the column number after insertion." (when not-last-col (when (> pad-right 0) (insert (make-string pad-right ?\s))) (insert (propertize - ;; We need at least one space to align correctly. - (make-string (- width (min 1 width label-width)) ?\s) + (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))) @@ -732,6 +727,7 @@ 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) @@ -739,14 +735,25 @@ Interactively, N is the prefix numeric argument, and defaults to col-width) (while (and (not found) (< col-nb nb-cols)) - (if (> start - (setq total-width - (+ total-width - (setq col-width - (cadr (aref tabulated-list-format - col-nb)))))) + (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) @@ -759,23 +766,6 @@ Interactively, N is the prefix numeric argument, and defaults to (interactive "p") (tabulated-list-widen-current-column (- n))) -(defvar tabulated-list--current-lnum-width nil) -(defun tabulated-list-watch-line-number-width (_window) - (if display-line-numbers - (let ((lnum-width (tabulated-list-line-number-width))) - (when (not (= tabulated-list--current-lnum-width lnum-width)) - (setq-local tabulated-list--current-lnum-width lnum-width) - (tabulated-list-init-header))))) - -(defun tabulated-list-window-scroll-function (window _start) - (if display-line-numbers - (let ((lnum-width - (with-selected-window window - (line-number-display-width 'columns)))) - (when (not (= tabulated-list--current-lnum-width lnum-width)) - (setq-local tabulated-list--current-lnum-width lnum-width) - (tabulated-list-init-header))))) - (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." @@ -846,15 +836,7 @@ as the ewoc pretty-printer." ;; 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) - ;; This is for if/when they turn on display-line-numbers - (add-hook 'display-line-numbers-mode-hook #'tabulated-list-revert nil t) - ;; This is for if/when they customize the line-number face or when - ;; the line-number width needs to change due to scrolling. - (setq-local tabulated-list--current-lnum-width 0) - (add-hook 'pre-redisplay-functions - #'tabulated-list-watch-line-number-width nil t) - (add-hook 'window-scroll-functions - #'tabulated-list-window-scroll-function nil t)) + (header-line-indent-mode)) (put 'tabulated-list-mode 'mode-class 'special) |