From d98b6fbba208e2f9e4d84b22507d6827a0925ca3 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 19 Feb 2022 14:21:10 +0100
Subject: [PATCH] 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.
---
 doc/misc/vtable.texi      |  2 --
 lisp/emacs-lisp/vtable.el | 38 +++++++++++++++++++++++++++++---------
 2 files changed, 29 insertions(+), 11 deletions(-)

diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi
index 5c010a1f79c..71c021da28e 100644
--- a/doc/misc/vtable.texi
+++ b/doc/misc/vtable.texi
@@ -517,5 +517,3 @@ Return the column name of the @var{index}th column in @var{table}.
 @printindex cp
 
 @bye
-
-@c todo up/down markers
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)
-- 
2.39.5