diff options
author | Lars Ingebrigtsen <larsi@gnus.org> | 2022-02-19 14:21:10 +0100 |
---|---|---|
committer | Lars Ingebrigtsen <larsi@gnus.org> | 2022-02-19 14:21:19 +0100 |
commit | d98b6fbba208e2f9e4d84b22507d6827a0925ca3 (patch) | |
tree | f1b5bcde663d84ba332a2ccaf6bd5b5e66fd4b2c /lisp | |
parent | babfb064c48e621ab7ad43b380ed1fdb0a6904a8 (diff) | |
download | emacs-d98b6fbba208e2f9e4d84b22507d6827a0925ca3.tar.gz emacs-d98b6fbba208e2f9e4d84b22507d6827a0925ca3.tar.bz2 emacs-d98b6fbba208e2f9e4d84b22507d6827a0925ca3.zip |
Add column sorting order indicators to vtable
* lisp/emacs-lisp/vtable.el (vtable--indicator): New function.
(vtable--insert-header-line): Use it to display sorting order
indicators.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/emacs-lisp/vtable.el | 38 |
1 files changed, 29 insertions, 9 deletions
diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 9107c4439c0..08849860307 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -474,21 +474,41 @@ This also updates the displayed table." (when (eq direction 'descend) (setcar cache (nreverse (car cache))))))) +(defun vtable--indicator (table index) + (let ((order (car (last (vtable-sort-by table))))) + (if (eq index (car order)) + ;; We're sorting by this column last, so return an indicator. + (catch 'found + (dolist (candidate (nth (if (eq (cdr order) 'ascend) + 1 + 0) + '((?▼ ?v) + (?▲ ?^)))) + (when (char-displayable-p candidate) + (throw 'found (string candidate))))) + ""))) + (defun vtable--insert-header-line (table widths spacer) ;; Insert the header directly into the buffer. - (let ((start (point))) + (let* ((start (point))) (seq-do-indexed (lambda (column index) - (let ((name (propertize - (vtable-column-name column) - 'face (list 'header-line (vtable-face table)))) - (start (point)) - displayed) + (let* ((name (propertize + (vtable-column-name column) + 'face (list 'header-line (vtable-face table)))) + (start (point)) + (indicator (vtable--indicator table index)) + (indicator-width (string-pixel-width indicator)) + displayed) (insert (setq displayed - (if (> (string-pixel-width name) (elt widths index)) - (vtable--limit-string name (elt widths index)) - name)) + (concat + (if (> (string-pixel-width name) + (- (elt widths index) indicator-width)) + (vtable--limit-string + name (- (elt widths index) indicator-width)) + name) + indicator)) (propertize " " 'display (list 'space :width (list (+ (- (elt widths index) |