From 1241b724c80c73731c7e5710a98886b745a211a8 Mon Sep 17 00:00:00 2001 From: Chong Yidong Date: Mon, 7 May 2012 13:37:38 +0800 Subject: [PATCH] Restore Buffer-menu-use-header-line functionality. * lisp/emacs-lisp/tabulated-list.el: Add no-header-line alternative. (tabulated-list-use-header-line): New var. (tabulated-list-init-header): Use it. (tabulated-list-print-fake-header): New function. (tabulated-list-print): Use it. (tabulated-list-sort-button-map): Add non-header-line commands. (tabulated-list-init-header): Add column name property to basic labels as well. (tabulated-list-col-sort): Handle non-header-line button case. (tabulated-list--sort-by-column-name): Fix a corner case. * lisp/buff-menu.el (list-buffers--refresh): Handle Buffer-menu-use-header-line. --- lisp/ChangeLog | 16 +++++++++++ lisp/buff-menu.el | 1 + lisp/emacs-lisp/tabulated-list.el | 48 ++++++++++++++++++++++++------- 3 files changed, 55 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 149c43fc9a7..1db2fb1c715 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,19 @@ +2012-05-07 Chong Yidong + + * emacs-lisp/tabulated-list.el: Add no-header-line alternative. + (tabulated-list-use-header-line): New var. + (tabulated-list-init-header): Use it. + (tabulated-list-print-fake-header): New function. + (tabulated-list-print): Use it. + (tabulated-list-sort-button-map): Add non-header-line commands. + (tabulated-list-init-header): Add column name property to basic + labels as well. + (tabulated-list-col-sort): Handle non-header-line button case. + (tabulated-list--sort-by-column-name): Fix a corner case. + + * buff-menu.el (list-buffers--refresh): Handle + Buffer-menu-use-header-line. + 2012-05-06 Chong Yidong * buff-menu.el: Convert to Tabulated List mode. diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index e28c2c0f60b..4ea9dcea8b4 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -574,6 +574,7 @@ means list those buffers and no others." `("Size" ,size-width tabulated-list-entry-size->) `("Mode" ,Buffer-menu-mode-width t) '("File" 1 t)))) + (setq tabulated-list-use-header-line Buffer-menu-use-header-line) ;; Collect info for each buffer we're interested in. (let ((buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) diff --git a/lisp/emacs-lisp/tabulated-list.el b/lisp/emacs-lisp/tabulated-list.el index 4291f3aacc6..5471640e039 100644 --- a/lisp/emacs-lisp/tabulated-list.el +++ b/lisp/emacs-lisp/tabulated-list.el @@ -56,6 +56,10 @@ where: right of the column (defaults to 1 if omitted).") (make-variable-buffer-local 'tabulated-list-format) +(defvar tabulated-list-use-header-line t + "Whether the Tabulated List buffer should use a header line.") +(make-variable-buffer-local 'tabulated-list-use-header-line) + (defvar tabulated-list-entries nil "Entries displayed in the current Tabulated List buffer. This should be either a function, or a list. @@ -154,6 +158,9 @@ If ADVANCE is non-nil, move forward by one line afterwards." (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-1] 'tabulated-list-col-sort) (define-key map [header-line mouse-2] 'tabulated-list-col-sort) + (define-key map [mouse-1] 'tabulated-list-col-sort) + (define-key map [mouse-2] 'tabulated-list-col-sort) + (define-key map "\C-m" 'tabulated-list-sort) (define-key map [follow-link] 'mouse-face) map) "Local keymap for `tabulated-list-mode' sort buttons.") @@ -167,6 +174,9 @@ If ADVANCE is non-nil, move forward by one line afterwards." table) "The `glyphless-char-display' table in Tabulated List buffers.") +(defvar tabulated-list--header-string nil) +(defvar tabulated-list--header-overlay nil) + (defun tabulated-list-init-header () "Set up header line for the Tabulated List buffer." (let ((x (max tabulated-list-padding 0)) @@ -185,7 +195,8 @@ If ADVANCE is non-nil, move forward by one line afterwards." (push (cond ;; An unsortable column - ((not (nth 2 col)) label) + ((not (nth 2 col)) + (propertize label 'tabulated-list-column-name label)) ;; The selected sort column ((equal (car col) (car tabulated-list-sort-key)) (apply 'propertize @@ -197,11 +208,11 @@ If ADVANCE is non-nil, move forward by one line afterwards." " ▲") (t " ▼"))) 'face 'bold - 'tabulated-list-column-name (car col) + 'tabulated-list-column-name label button-props)) ;; Unselected sortable column. (t (apply 'propertize label - 'tabulated-list-column-name (car col) + 'tabulated-list-column-name label button-props))) cols) (if (> pad-right 0) @@ -209,7 +220,22 @@ If ADVANCE is non-nil, move forward by one line afterwards." 'display `(space :align-to ,x) 'face 'fixed-pitch) cols)))) - (setq header-line-format (mapconcat 'identity (nreverse cols) "")))) + (setq cols (apply 'concat (nreverse cols))) + (if tabulated-list-use-header-line + (setq header-line-format cols) + (setq header-line-format nil) + (set (make-local-variable 'tabulated-list--header-string) cols)))) + +(defun tabulated-list-print-fake-header () + "Insert a fake Tabulated List \"header line\" at the start of the buffer." + (goto-char (point-min)) + (let ((inhibit-read-only t)) + (insert tabulated-list--header-string "\n") + (if tabulated-list--header-overlay + (move-overlay tabulated-list--header-overlay (point-min) (point)) + (set (make-local-variable 'tabulated-list--header-overlay) + (make-overlay (point-min) (point)))) + (overlay-put tabulated-list--header-overlay 'face 'underline))) (defun tabulated-list-revert (&rest ignored) "The `revert-buffer-function' for `tabulated-list-mode'. @@ -248,6 +274,8 @@ to the entry with the same ID element as the current line." (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 buffers, if necessary. (when (and tabulated-list-sort-key (car tabulated-list-sort-key)) @@ -391,12 +419,12 @@ this is the vector stored within it." "Sort Tabulated List entries by the column of the mouse click E." (interactive "e") (let* ((pos (event-start e)) - (obj (posn-object pos)) - (name (get-text-property (if obj (cdr obj) (posn-point pos)) - 'tabulated-list-column-name - (car obj)))) + (obj (posn-object pos))) (with-current-buffer (window-buffer (posn-window pos)) - (tabulated-list--sort-by-column-name name)))) + (tabulated-list--sort-by-column-name + (get-text-property (if obj (cdr obj) (posn-point pos)) + 'tabulated-list-column-name + (car obj)))))) (defun tabulated-list-sort (&optional n) "Sort Tabulated List entries by the column at point. @@ -409,7 +437,7 @@ With a numeric prefix argument N, sort the Nth column." (tabulated-list--sort-by-column-name name))) (defun tabulated-list--sort-by-column-name (name) - (when (derived-mode-p 'tabulated-list-mode) + (when (and name (derived-mode-p 'tabulated-list-mode)) ;; Flip the sort order on a second click. (if (equal name (car tabulated-list-sort-key)) (setcdr tabulated-list-sort-key -- 2.39.2