Convert consecutive FSF copyright years to ranges.
[bpt/emacs.git] / lisp / buff-menu.el
index e3150e4..1e92c08 100644 (file)
@@ -1,10 +1,11 @@
 ;;; 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.
+;; Copyright (C) 1985-1987, 1993-1995, 2000-2011
+;;   Free Software Foundation, Inc.
 
 ;; Maintainer: FSF
 ;; Keywords: convenience
+;; Package: emacs
 
 ;; This file is part of GNU Emacs.
 
@@ -68,7 +69,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)
 
@@ -111,16 +112,22 @@ A nil value means sort by visited order (the default).")
 This variable determines whether reverting the buffer lists only
 file buffers.  It affects both manual reverting and reverting by
 Auto Revert Mode.")
-
 (make-variable-buffer-local 'Buffer-menu-files-only)
 
+(defvar Buffer-menu--buffers nil
+  "If non-nil, list of buffers shown in the current buffer-menu.
+This variable determines whether reverting the buffer lists only
+this buffers.  It affects both manual reverting and reverting by
+Auto Revert Mode.")
+(make-variable-buffer-local 'Buffer-menu--buffers)
+
 (defvar Info-current-file) ;; from info.el
 (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 +147,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 +258,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)
@@ -200,12 +268,8 @@ Letters do not insert themselves; instead, they are commands.
   (setq truncate-lines t)
   (setq buffer-read-only t))
 
-;; 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))
+(define-obsolete-variable-alias 'buffer-menu-mode-hook
+  'Buffer-menu-mode-hook "23.1")
 
 (defun Buffer-menu-revert-function (ignore1 ignore2)
   (or (eq buffer-undo-list t)
@@ -224,7 +288,7 @@ Letters do not insert themselves; instead, they are commands.
     ;; interactively current buffer is correctly identified with a `.'
     ;; by `list-buffers-noselect'.
     (with-current-buffer (window-buffer)
-      (list-buffers-noselect Buffer-menu-files-only))
+      (list-buffers-noselect Buffer-menu-files-only Buffer-menu--buffers))
     (if oline
        (while (setq prop (next-single-property-change prop 'buffer))
          (when (eq (get-text-property prop 'buffer) oline)
@@ -245,9 +309,7 @@ negative ARG, display other buffers as well."
 \f
 (defun Buffer-menu-buffer (error-if-non-existent-p)
   "Return buffer described by this line of buffer menu."
-  (let* ((where (save-excursion
-                 (beginning-of-line)
-                 (+ (point) Buffer-menu-buffer-column)))
+  (let* ((where (+ (line-beginning-position) Buffer-menu-buffer-column))
         (name (and (not (eobp)) (get-text-property where 'buffer-name)))
         (buf (and (not (eobp)) (get-text-property where 'buffer))))
     (if name
@@ -581,8 +643,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*'.
@@ -593,33 +657,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 (> (+ (length name) (length 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 (substring name 0
-                                  (- Buffer-menu-buffer+size-width
-                                     (max (length size) 3)
-                                     (match-end 0)
-                                     (- (match-beginning 0))
-                                     2))
-                       ":"             ; narrow ellipsis
-                       (match-string 0 name))
-             (concat (substring name 0
-                                (- Buffer-menu-buffer+size-width
-                                   (max (length size) 3)
-                                   2))
-                     ":")))            ; 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
-                         (length name)
-                         (length 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."
@@ -641,7 +711,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))
@@ -825,21 +895,22 @@ 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)
                                                   2))
                                            name
                                          "mouse-2: select this buffer"))))
-                 "  "
-               (if (> (length (nth 4 buffer)) Buffer-menu-mode-width)
-                   (substring (nth 4 buffer) 0 Buffer-menu-mode-width)
+               "  "
+               (if (> (string-width (nth 4 buffer)) Buffer-menu-mode-width)
+                   (truncate-string-to-width (nth 4 buffer)
+                                             Buffer-menu-mode-width)
                  (nth 4 buffer)))
        (when (nth 5 buffer)
          (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
@@ -854,8 +925,8 @@ For more information, see the function `buffer-menu'."
       (and desired-point
           (goto-char desired-point))
       (setq Buffer-menu-files-only files-only)
+      (setq Buffer-menu--buffers buffer-list)
       (set-buffer-modified-p nil)
       (current-buffer))))
 
-;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6
 ;;; buff-menu.el ends here