* m/iris4d.h (UNEXEC): Move definition ...
[bpt/emacs.git] / lisp / buff-menu.el
index 7e94b8f..9ec7830 100644 (file)
@@ -1,7 +1,7 @@
 ;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*-
 
 ;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003,
-;;   2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: convenience
@@ -68,7 +68,7 @@
   :group 'convenience)
 
 (defcustom Buffer-menu-use-header-line t
-  "*Non-nil means to use an immovable header-line."
+  "Non-nil means to use an immovable header-line."
   :type 'boolean
   :group 'Buffer-menu)
 
 (put 'Buffer-menu-buffer 'face-alias 'buffer-menu-buffer)
 
 (defcustom Buffer-menu-buffer+size-width 26
-  "*How wide to jointly make the buffer name and size columns."
+  "How wide to jointly make the buffer name and size columns."
   :type 'number
   :group 'Buffer-menu)
 
 (defcustom Buffer-menu-mode-width 16
-  "*How wide to make the mode name column."
+  "How wide to make the mode name column."
   :type 'number
   :group 'Buffer-menu)
 
@@ -118,9 +118,9 @@ Auto Revert Mode.")
 (defvar Info-current-node) ;; from info.el
 
 (defvar Buffer-menu-mode-map
-  (let ((map (make-keymap)))
+  (let ((map (make-keymap))
+       (menu-map (make-sparse-keymap)))
     (suppress-keymap map t)
-    (define-key map "q" 'quit-window)
     (define-key map "v" 'Buffer-menu-select)
     (define-key map "2" 'Buffer-menu-2-window)
     (define-key map "1" 'Buffer-menu-1-window)
@@ -140,26 +140,87 @@ Auto Revert Mode.")
     (define-key map "p" 'previous-line)
     (define-key map "\177" 'Buffer-menu-backup-unmark)
     (define-key map "~" 'Buffer-menu-not-modified)
-    (define-key map "?" 'describe-mode)
     (define-key map "u" 'Buffer-menu-unmark)
     (define-key map "m" 'Buffer-menu-mark)
     (define-key map "t" 'Buffer-menu-visit-tags-table)
     (define-key map "%" 'Buffer-menu-toggle-read-only)
     (define-key map "b" 'Buffer-menu-bury)
-    (define-key map "g" 'Buffer-menu-revert)
     (define-key map "V" 'Buffer-menu-view)
     (define-key map "T" 'Buffer-menu-toggle-files-only)
     (define-key map [mouse-2] 'Buffer-menu-mouse-select)
     (define-key map [follow-link] 'mouse-face)
     (define-key map (kbd "M-s a C-s")   'Buffer-menu-isearch-buffers)
     (define-key map (kbd "M-s a M-C-s") 'Buffer-menu-isearch-buffers-regexp)
+    (define-key map [menu-bar Buffer-menu-mode] (cons (purecopy "Buffer-Menu") menu-map))
+    (define-key menu-map [quit]
+      `(menu-item ,(purecopy "Quit") quit-window
+                :help ,(purecopy "Remove the buffer menu from the display")))
+    (define-key menu-map [rev]
+      `(menu-item ,(purecopy "Refresh") revert-buffer
+                :help ,(purecopy "Refresh the *Buffer List* buffer contents")))
+    (define-key menu-map [s0] menu-bar-separator)
+    (define-key menu-map [tf]
+      `(menu-item ,(purecopy "Show only file buffers") Buffer-menu-toggle-files-only
+                 :button (:toggle . Buffer-menu-files-only)
+                 :help ,(purecopy "Toggle whether the current buffer-menu displays only file buffers")))
+    (define-key menu-map [s1] menu-bar-separator)
+    ;; FIXME: The "Select" entries could use better names...
+    (define-key menu-map [sel]
+      `(menu-item ,(purecopy "Select marked") Buffer-menu-select
+                :help ,(purecopy "Select this line's buffer; also display buffers marked with `>'")))
+    (define-key menu-map [bm2]
+      `(menu-item ,(purecopy "Select two") Buffer-menu-2-window
+                :help ,(purecopy "Select this line's buffer, with previous buffer in second window")))
+    (define-key menu-map [bm1]
+      `(menu-item ,(purecopy "Select current") Buffer-menu-1-window
+                :help ,(purecopy "Select this line's buffer, alone, in full frame")))
+    (define-key menu-map [ow]
+      `(menu-item ,(purecopy "Select in other window") Buffer-menu-other-window
+                :help ,(purecopy "Select this line's buffer in other window, leaving buffer menu visible")))
+    (define-key menu-map [tw]
+      `(menu-item ,(purecopy "Select in current window") Buffer-menu-this-window
+                :help ,(purecopy "Select this line's buffer in this window")))
+    (define-key menu-map [s2] menu-bar-separator)
+    (define-key menu-map [is]
+      `(menu-item ,(purecopy "Regexp Isearch marked buffers") Buffer-menu-isearch-buffers-regexp
+                :help ,(purecopy "Search for a regexp through all marked buffers using Isearch")))
+    (define-key menu-map [ir]
+      `(menu-item ,(purecopy "Isearch marked buffers") Buffer-menu-isearch-buffers
+                :help ,(purecopy "Search for a string through all marked buffers using Isearch")))
+    (define-key menu-map [s3] menu-bar-separator)
+    (define-key menu-map [by]
+      `(menu-item ,(purecopy "Bury") Buffer-menu-bury
+                :help ,(purecopy "Bury the buffer listed on this line")))
+    (define-key menu-map [vt]
+      `(menu-item ,(purecopy "Set unmodified") Buffer-menu-not-modified
+                :help ,(purecopy "Mark buffer on this line as unmodified (no changes to save)")))
+    (define-key menu-map [ex]
+      `(menu-item ,(purecopy "Execute") Buffer-menu-execute
+                :help ,(purecopy "Save and/or delete buffers marked with s or k commands")))
+    (define-key menu-map [s4] menu-bar-separator)
+    (define-key menu-map [delb]
+      `(menu-item ,(purecopy "Mark for delete and move backwards") Buffer-menu-delete-backwards
+                :help ,(purecopy "Mark buffer on this line to be deleted by x command and move up one line")))
+    (define-key menu-map [del]
+      `(menu-item ,(purecopy "Mark for delete") Buffer-menu-delete
+                :help ,(purecopy "Mark buffer on this line to be deleted by x command")))
+
+    (define-key menu-map [sv]
+      `(menu-item ,(purecopy "Mark for save") Buffer-menu-save
+                :help ,(purecopy "Mark buffer on this line to be saved by x command")))
+    (define-key menu-map [umk]
+      `(menu-item ,(purecopy "Unmark") Buffer-menu-unmark
+                :help ,(purecopy "Cancel all requested operations on buffer on this line and move down")))
+    (define-key menu-map [mk]
+      `(menu-item ,(purecopy "Mark") Buffer-menu-mark
+                :help ,(purecopy "Mark buffer on this line for being displayed by v command")))
     map)
   "Local keymap for `Buffer-menu-mode' buffers.")
 
 ;; Buffer Menu mode is suitable only for specially formatted data.
 (put 'Buffer-menu-mode 'mode-class 'special)
 
-(define-derived-mode Buffer-menu-mode nil "Buffer Menu"
+(define-derived-mode Buffer-menu-mode special-mode "Buffer Menu"
   "Major mode for editing a list of buffers.
 Each line describes one of the buffers in Emacs.
 Letters do not insert themselves; instead, they are commands.
@@ -190,7 +251,7 @@ Letters do not insert themselves; instead, they are commands.
   With prefix argument, also move up one line.
 \\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
 \\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
-\\[Buffer-menu-revert] -- update the list of buffers.
+\\[revert-buffer] -- update the list of buffers.
 \\[Buffer-menu-toggle-files-only] -- toggle whether the menu displays only file buffers.
 \\[Buffer-menu-bury] -- bury the buffer listed on this line."
   (set (make-local-variable 'revert-buffer-function)
@@ -203,13 +264,6 @@ Letters do not insert themselves; instead, they are commands.
 (define-obsolete-variable-alias 'buffer-menu-mode-hook
   'Buffer-menu-mode-hook "23.1")
 
-;; This function exists so we can make the doc string of Buffer-menu-mode
-;; look nice.
-(defun Buffer-menu-revert ()
-  "Update the list of buffers."
-  (interactive)
-  (revert-buffer))
-
 (defun Buffer-menu-revert-function (ignore1 ignore2)
   (or (eq buffer-undo-list t)
       (setq buffer-undo-list nil))
@@ -584,8 +638,10 @@ The current window remains selected."
   (view-buffer-other-window (Buffer-menu-buffer t)))
 \f
 
+;;;###autoload
 (define-key ctl-x-map "\C-b" 'list-buffers)
 
+;;;###autoload
 (defun list-buffers (&optional files-only)
   "Display a list of names of existing buffers.
 The list is displayed in a buffer named `*Buffer List*'.
@@ -596,36 +652,39 @@ For more information, see the function `buffer-menu'."
   (interactive "P")
   (display-buffer (list-buffers-noselect files-only)))
 
+(defconst Buffer-menu-short-ellipsis
+  ;; This file is preloaded, so we can't use char-displayable-p here
+  ;; because we don't know yet what display we're going to connect to.
+  ":" ;; (if (char-displayable-p ?…) "…" ":")
+  )
+
 (defun Buffer-menu-buffer+size (name size &optional name-props size-props)
-  (if (> (+ (string-width name) (string-width size) 2) Buffer-menu-buffer+size-width)
+  (if (> (+ (string-width name) (string-width size) 2)
+         Buffer-menu-buffer+size-width)
       (setq name
-           (if (string-match "<[0-9]+>$" name)
-               (concat (truncate-string-to-width name
-                                                 (- Buffer-menu-buffer+size-width
-                                                    (max (string-width size) 3)
-                                                    (string-width (match-string 0))
-                                                    2)
-                                                 0
-                                                 ?\s)
-                       ":"             ; narrow ellipsis
-                       (match-string 0 name))
-             (concat (truncate-string-to-width name
-                                               (- Buffer-menu-buffer+size-width
-                                                  (max (string-width size) 3)
-                                                  2)
-                                               0
-                                               ?\s)
-                     ":")))            ; narrow ellipsis
+            (let ((tail
+                   (if (string-match "<[0-9]+>$" name)
+                       (match-string 0 name)
+                     "")))
+              (concat (truncate-string-to-width
+                       name
+                       (- Buffer-menu-buffer+size-width
+                          (max (string-width size) 3)
+                          (string-width tail)
+                          2))
+                      Buffer-menu-short-ellipsis
+                      tail)))
     ;; Don't put properties on (buffer-name).
     (setq name (copy-sequence name)))
   (add-text-properties 0 (length name) name-props name)
   (add-text-properties 0 (length size) size-props size)
-  (concat name
-         (make-string (- Buffer-menu-buffer+size-width
-                         (string-width name)
-                         (string-width size))
-                      ?\s)
-         size))
+  (let ((name+space-width (- Buffer-menu-buffer+size-width
+                            (string-width size))))
+    (concat name
+           (propertize (make-string (- name+space-width (string-width name))
+                                    ?\s)
+                       'display `(space :align-to ,(+ 4 name+space-width)))
+           size)))
 
 (defun Buffer-menu-sort (column)
   "Sort the buffer menu by COLUMN."
@@ -647,7 +706,7 @@ For more information, see the function `buffer-menu'."
          (if (or m1 m2)
              (push (list buf m1 m2) l)))
        (forward-line)))
-    (Buffer-menu-revert)
+    (revert-buffer)
     (save-excursion
       (Buffer-menu-beginning)
       (while (not (eobp))
@@ -831,12 +890,12 @@ For more information, see the function `buffer-menu'."
                ;; This way we avoid problems with unusual buffer names.
                (let ((name (nth 2 buffer))
                      (size (int-to-string (nth 3 buffer))))
-                     (Buffer-menu-buffer+size name size
+                 (Buffer-menu-buffer+size name size
                         `(buffer-name ,name
                                       buffer ,(car buffer)
                                       font-lock-face buffer-menu-buffer
                                       mouse-face highlight
-                                      help-echo 
+                                      help-echo
                                       ,(if (>= (length name)
                                                (- Buffer-menu-buffer+size-width
                                                   (max (length size) 3)
@@ -846,9 +905,7 @@ For more information, see the function `buffer-menu'."
                "  "
                (if (> (string-width (nth 4 buffer)) Buffer-menu-mode-width)
                    (truncate-string-to-width (nth 4 buffer)
-                                             Buffer-menu-mode-width
-                                             0
-                                             ?\s)
+                                             Buffer-menu-mode-width)
                  (nth 4 buffer)))
        (when (nth 5 buffer)
          (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width