diff options
| author | Artur Malabarba | 2015-05-24 22:57:24 +0100 |
|---|---|---|
| committer | Artur Malabarba | 2015-05-24 23:45:46 +0100 |
| commit | d38350984e557aa492139ffecb9c1a910e763145 (patch) | |
| tree | 5044c94c52a5775d5dbe5ccccd06a35fd5040c64 | |
| parent | 675c90a3b4c469e2e54e513b6f427ba4ec285ef5 (diff) | |
| download | emacs-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.el | 57 |
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. | ||
| 282 | Return nil if `tabulated-list-sort-key' specifies an unsortable | ||
| 283 | column. 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. |
| 282 | This sorts the `tabulated-list-entries' list if sorting is | 303 | This sorts the `tabulated-list-entries' list if sorting is |
| @@ -284,39 +305,27 @@ specified by `tabulated-list-sort-key'. It then erases the | |||
| 284 | buffer and inserts the entries with `tabulated-list-printer'. | 305 | buffer and inserts the entries with `tabulated-list-printer'. |
| 285 | 306 | ||
| 286 | Optional argument REMEMBER-POS, if non-nil, means to move point | 307 | Optional argument REMEMBER-POS, if non-nil, means to move point |
| 287 | to the entry with the same ID element as the current line." | 308 | to the entry with the same ID element as the current line and |
| 309 | recenter 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) |