aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorArtur Malabarba2015-05-24 22:57:24 +0100
committerArtur Malabarba2015-05-24 23:45:46 +0100
commitd38350984e557aa492139ffecb9c1a910e763145 (patch)
tree5044c94c52a5775d5dbe5ccccd06a35fd5040c64
parent675c90a3b4c469e2e54e513b6f427ba4ec285ef5 (diff)
downloademacs-d38350984e557aa492139ffecb9c1a910e763145.tar.gz
emacs-d38350984e557aa492139ffecb9c1a910e763145.zip
* 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'.
-rw-r--r--lisp/emacs-lisp/tabulated-list.el57
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'."
277 (or found 277 (or found
278 (error "No column named %s" name)))) 278 (error "No column named %s" name))))
279 279
280(defun tabulated-list--get-sorter ()
281 "Return a sorting predicate for the current tabulated-list.
282Return nil if `tabulated-list-sort-key' specifies an unsortable
283column. Negate the predicate that would be returned if
284`tabulated-list-sort-key' has a non-nil cdr."
285 (when (and tabulated-list-sort-key
286 (car tabulated-list-sort-key))
287 (let* ((sort-column (car tabulated-list-sort-key))
288 (n (tabulated-list--column-number sort-column))
289 (sorter (nth 2 (aref tabulated-list-format n))))
290 (when (eq sorter t); Default sorter checks column N:
291 (setq sorter (lambda (A B)
292 (let ((a (aref (cadr A) n))
293 (b (aref (cadr B) n)))
294 (string< (if (stringp a) a (car a))
295 (if (stringp b) b (car b)))))))
296 ;; Reversed order.
297 (if (cdr tabulated-list-sort-key)
298 (lambda (a b) (not (funcall sorter a b)))
299 sorter))))
300
280(defun tabulated-list-print (&optional remember-pos) 301(defun tabulated-list-print (&optional remember-pos)
281 "Populate the current Tabulated List mode buffer. 302 "Populate the current Tabulated List mode buffer.
282This sorts the `tabulated-list-entries' list if sorting is 303This sorts the `tabulated-list-entries' list if sorting is
@@ -284,39 +305,27 @@ specified by `tabulated-list-sort-key'. It then erases the
284buffer and inserts the entries with `tabulated-list-printer'. 305buffer and inserts the entries with `tabulated-list-printer'.
285 306
286Optional argument REMEMBER-POS, if non-nil, means to move point 307Optional argument REMEMBER-POS, if non-nil, means to move point
287to the entry with the same ID element as the current line." 308to the entry with the same ID element as the current line and
309recenter window line accordingly."
288 (let ((inhibit-read-only t) 310 (let ((inhibit-read-only t)
289 (entries (if (functionp tabulated-list-entries) 311 (entries (if (functionp tabulated-list-entries)
290 (funcall tabulated-list-entries) 312 (funcall tabulated-list-entries)
291 tabulated-list-entries)) 313 tabulated-list-entries))
292 entry-id saved-pt saved-col) 314 (sorter (tabulated-list--get-sorter))
315 entry-id saved-pt saved-col window-line)
293 (and remember-pos 316 (and remember-pos
317 (when (eq (window-buffer) (current-buffer))
318 (setq window-line
319 (count-screen-lines (window-start) (point))))
294 (setq entry-id (tabulated-list-get-id)) 320 (setq entry-id (tabulated-list-get-id))
295 (setq saved-col (current-column))) 321 (setq saved-col (current-column)))
296 (erase-buffer) 322 (erase-buffer)
297 (unless tabulated-list-use-header-line 323 (unless tabulated-list-use-header-line
298 (tabulated-list-print-fake-header)) 324 (tabulated-list-print-fake-header))
299 ;; Sort the entries, if necessary. 325 ;; Sort the entries, if necessary.
300 (when (and tabulated-list-sort-key 326 (setq entries (sort entries sorter))
301 (car tabulated-list-sort-key)) 327 (unless (functionp tabulated-list-entries)
302 (let* ((sort-column (car tabulated-list-sort-key)) 328 (setq tabulated-list-entries entries))
303 (n (tabulated-list--column-number sort-column))
304 (sorter (nth 2 (aref tabulated-list-format n))))
305 ;; Is the specified column sortable?
306 (when sorter
307 (when (eq sorter t)
308 (setq sorter ; Default sorter checks column N:
309 (lambda (A B)
310 (setq A (aref (cadr A) n))
311 (setq B (aref (cadr B) n))
312 (string< (if (stringp A) A (car A))
313 (if (stringp B) B (car B))))))
314 (setq entries (sort entries sorter))
315 (if (cdr tabulated-list-sort-key)
316 (setq entries (nreverse entries)))
317 (unless (functionp tabulated-list-entries)
318 (setq tabulated-list-entries entries)))))
319 ;; Print the resulting list.
320 (dolist (elt entries) 329 (dolist (elt entries)
321 (and entry-id 330 (and entry-id
322 (equal entry-id (car elt)) 331 (equal entry-id (car elt))
@@ -327,8 +336,8 @@ to the entry with the same ID element as the current line."
327 (if saved-pt 336 (if saved-pt
328 (progn (goto-char saved-pt) 337 (progn (goto-char saved-pt)
329 (move-to-column saved-col) 338 (move-to-column saved-col)
330 (when (eq (window-buffer) (current-buffer)) 339 (when window-line
331 (recenter))) 340 (recenter window-line)))
332 (goto-char (point-min))))) 341 (goto-char (point-min)))))
333 342
334(defun tabulated-list-print-entry (id cols) 343(defun tabulated-list-print-entry (id cols)