From: Artur Malabarba Date: Sun, 24 May 2015 21:57:24 +0000 (+0100) Subject: * lisp/emacs-lisp/tabulated-list.el: Improve printing X-Git-Tag: emacs-25.0.90~1986 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d38350984e557aa492139ffecb9c1a910e763145;p=emacs.git * 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 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)