* lisp/emacs-lisp/tabulated-list.el: Improve printing

(tabulated-list--get-sorter): New function.
(tabulated-list-print): Restore window-line when remember-pos is
passed and optimize away the `nreverse'.

diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 5d10b55d14c30a3742b09dd65160f7d651622693..9d55ab8f533eaa55fa610f7c4cddf0b143c212eb 100644 (file)
--- a/lisp/emacs-lisp/tabulated-list.el
+++ b/lisp/emacs-lisp/tabulated-list.el
@@ -277,6 +277,27 @@ It runs `tabulated-list-revert-hook', then calls `tabulated-list-print'."
     (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) (not (funcall sorter a b)))
+        sorter))))
+
 (defun tabulated-list-print (&optional remember-pos)
   "Populate the current Tabulated List mode buffer.
 This sorts the `tabulated-list-entries' list if sorting is
@@ -284,39 +305,27 @@ 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."
+to the entry with the same ID element as the current line and
+recenter window line accordingly."
   (let ((inhibit-read-only t)
        (entries (if (functionp tabulated-list-entries)
                     (funcall tabulated-list-entries)
                   tabulated-list-entries))
-       entry-id saved-pt saved-col)
+        (sorter (tabulated-list--get-sorter))
+       entry-id saved-pt saved-col window-line)
     (and remember-pos
+         (when (eq (window-buffer) (current-buffer))
+           (setq window-line
+                 (count-screen-lines (window-start) (point))))
         (setq entry-id (tabulated-list-get-id))
         (setq saved-col (current-column)))
     (erase-buffer)
     (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 (tabulated-list--column-number sort-column))
-            (sorter (nth 2 (aref tabulated-list-format n))))
-       ;; Is the specified column sortable?
-       (when sorter
-         (when (eq sorter t)
-           (setq sorter ; Default sorter checks column N:
-                 (lambda (A B)
-                   (setq A (aref (cadr A) n))
-                   (setq B (aref (cadr B) n))
-                   (string< (if (stringp A) A (car A))
-                            (if (stringp B) B (car B))))))
-         (setq entries (sort entries sorter))
-         (if (cdr tabulated-list-sort-key)
-             (setq entries (nreverse entries)))
-         (unless (functionp tabulated-list-entries)
-           (setq tabulated-list-entries entries)))))
-    ;; Print the resulting list.
+    (setq entries (sort entries sorter))
+    (unless (functionp tabulated-list-entries)
+      (setq tabulated-list-entries entries))
     (dolist (elt entries)
       (and entry-id
           (equal entry-id (car elt))
@@ -327,8 +336,8 @@ to the entry with the same ID element as the current line."
     (if saved-pt
        (progn (goto-char saved-pt)
               (move-to-column saved-col)
-              (when (eq (window-buffer) (current-buffer))
-                (recenter)))
+              (when window-line
+                 (recenter window-line)))
       (goto-char (point-min)))))
 
 (defun tabulated-list-print-entry (id cols)