* 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'.

1 files changed, 33 insertions, 24 deletions

diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el
index 5d10b55d14c..9d55ab8f533 100644
--- 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)