procyberian/emacs
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
(tabulated-list--get-sorter): New function.
(tabulated-list-print): Restore window-line when remember-pos is
passed and optimize away the `nreverse'.
This commit is contained in:
Artur Malabarba 2015-05-24 22:57:24 +01:00
parent 675c90a3b4
commit d38350984e
1 changed files with 33 additions and 24 deletions
Download patch file Download diff file Expand all files Collapse all files

57
lisp/emacs-lisp/tabulated-list.el
View file

@ -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)