changeset 54580:f9e5bd96c71c

(Buffer-menu-sort, Buffer-menu-make-sort-button): New funs. (list-buffers-noselect): Use them. Adjust :align-to to new style.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 26 Mar 2004 15:22:03 +0000
parents 5133c27cc4f0
children 0a5e192bf05d
files lisp/buff-menu.el
diffstat 1 files changed, 49 insertions(+), 30 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/buff-menu.el	Fri Mar 26 15:20:20 2004 +0000
+++ b/lisp/buff-menu.el	Fri Mar 26 15:22:03 2004 +0000
@@ -1,6 +1,6 @@
 ;;; buff-menu.el --- buffer menu main function and support functions
 
-;; Copyright (C) 1985, 86, 87, 93, 94, 95, 2000, 2001, 2002, 2003
+;; Copyright (C) 1985, 86, 87, 93, 94, 95, 2000, 2001, 2002, 03, 2004
 ;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
@@ -47,22 +47,22 @@
 
 ;;; Code:
 
-;;;Trying to preserve the old window configuration works well in
-;;;simple scenarios, when you enter the buffer menu, use it, and exit it.
-;;;But it does strange things when you switch back to the buffer list buffer
-;;;with C-x b, later on, when the window configuration is different.
-;;;The choice seems to be, either restore the window configuration
-;;;in all cases, or in no cases.
-;;;I decided it was better not to restore the window config at all. -- rms.
+;;Trying to preserve the old window configuration works well in
+;;simple scenarios, when you enter the buffer menu, use it, and exit it.
+;;But it does strange things when you switch back to the buffer list buffer
+;;with C-x b, later on, when the window configuration is different.
+;;The choice seems to be, either restore the window configuration
+;;in all cases, or in no cases.
+;;I decided it was better not to restore the window config at all. -- rms.
 
-;;;But since then, I changed buffer-menu to use the selected window,
-;;;so q now once again goes back to the previous window configuration.
+;;But since then, I changed buffer-menu to use the selected window,
+;;so q now once again goes back to the previous window configuration.
 
-;;;(defvar Buffer-menu-window-config nil
-;;;  "Window configuration saved from entry to `buffer-menu'.")
+;;(defvar Buffer-menu-window-config nil
+;;  "Window configuration saved from entry to `buffer-menu'.")
 
-; Put buffer *Buffer List* into proper mode right away
-; so that from now on even list-buffers is enough to get a buffer menu.
+;; Put buffer *Buffer List* into proper mode right away
+;; so that from now on even list-buffers is enough to get a buffer menu.
 
 (defgroup Buffer-menu nil
   "Show a menu of all buffers in a buffer."
@@ -89,7 +89,7 @@
   :type 'number
   :group 'Buffer-menu)
 
-; This should get updated & resorted when you click on a column heading
+;; This should get updated & resorted when you click on a column heading
 (defvar Buffer-menu-sort-column nil
   "*2 for sorting by buffer names.  5 for sorting by file names.
 nil for default sorting by visited order.")
@@ -547,6 +547,29 @@
 		       ? )
 	  size))
 
+(defun Buffer-menu-sort (column)
+  "Sort the buffer menu by COLUMN."
+  (interactive "P")
+  (when column
+    (setq column (prefix-numeric-value column))
+    (if (< column 2) (setq column 2))
+    (if (> column 5) (setq column 5)))
+  (setq Buffer-menu-sort-column column)
+  (Buffer-menu-revert))
+
+(defun Buffer-menu-make-sort-button (name column)
+  (if (equal column Buffer-menu-sort-column) (setq column nil))
+  (propertize name
+	      'help-echo (if column
+			     (concat "mouse-2: sort by " (downcase name))
+			   "mouse-2: sort by visited order")
+	      'mouse-face 'highlight
+	      'keymap (let ((map (make-sparse-keymap)))
+			(define-key map [header-line mouse-2]
+			  `(lambda () (interactive)
+			     (Buffer-menu-sort ,column)))
+			map)))
+
 (defun list-buffers-noselect (&optional files-only)
   "Create and return a buffer with a list of names of existing buffers.
 The buffer is named `*Buffer List*'.
@@ -557,29 +580,25 @@
   (let* ((old-buffer (current-buffer))
 	 (standard-output standard-output)
 	 (mode-end (make-string (- Buffer-menu-mode-width 2) ? ))
-	 (header (concat (propertize "CRM " 'face 'fixed-pitch)
-			 (Buffer-menu-buffer+size "Buffer" "Size")
-			 "  Mode" mode-end "File\n"))
-	 list desired-point name file mode)
+	 (header (concat " " (propertize "CRM " 'face 'fixed-pitch)
+			 (Buffer-menu-buffer+size
+			  (Buffer-menu-make-sort-button "Buffer" 2)
+			  (Buffer-menu-make-sort-button "Size" 3))
+			 "  "
+			 (Buffer-menu-make-sort-button "Mode" 4) mode-end
+			 (Buffer-menu-make-sort-button "File" 5) "\n"))
+	 list desired-point name file)
     (when Buffer-menu-use-header-line
-      (let ((spaces
-	     (- (car (window-inside-edges))
-		(car (window-edges))))
-	    (pos 0))
+      (let ((pos 0))
 	;; Turn spaces in the header into stretch specs so they work
 	;; regardless of the header-line face.
 	(while (string-match "[ \t]+" header pos)
 	  (setq pos (match-end 0))
 	  (put-text-property (match-beginning 0) pos 'display
 			     ;; Assume fixed-size chars
-			     (list 'space :align-to (+ spaces pos))
-			     header))
-	;; Add the leading space
-	(setq header (concat (propertize (make-string (floor spaces) ? )
-					 'display (list 'space :width spaces))
+			     (list 'space :align-to (1- pos))
 			     header))))
-    (save-excursion
-      (set-buffer (get-buffer-create "*Buffer List*"))
+    (with-current-buffer (get-buffer-create "*Buffer List*")
       (setq buffer-read-only nil)
       (erase-buffer)
       (setq standard-output (current-buffer))