;;; 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.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
: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)
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)
(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.
\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
\\[Buffer-menu-2-window] -- select that buffer in one window,
together with buffer selected before this one in another window.
+\\[Buffer-menu-isearch-buffers] -- Do incremental search in the marked buffers.
+\\[Buffer-menu-isearch-buffers-regexp] -- Isearch for regexp in the marked buffers.
\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
\\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
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)
'Buffer-menu-revert-function)
(set (make-local-variable 'buffer-stale-function)
- #'(lambda (&optional noconfirm) 'fast))
+ (lambda (&optional _noconfirm) 'fast))
(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)
+(defun Buffer-menu-revert-function (_ignore1 _ignore2)
(or (eq buffer-undo-list t)
(setq buffer-undo-list nil))
;; We can not use save-excursion here. The buffer gets erased.
;; 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)
\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
"Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
(interactive)
(when (Buffer-menu-no-header)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(delete-char 1)
(insert ?>)
(forward-line 1))))
(when (Buffer-menu-no-header)
(let* ((buf (Buffer-menu-buffer t))
(mod (buffer-modified-p buf))
- (readonly (save-excursion (set-buffer buf) buffer-read-only))
- (buffer-read-only nil))
+ (readonly (with-current-buffer buf buffer-read-only))
+ (inhibit-read-only t))
(delete-char 3)
(insert (if readonly (if mod " %*" " % ") (if mod " *" " ")))))
(forward-line (if backup -1 1)))
Negative arg means delete backwards."
(interactive "p")
(when (Buffer-menu-no-header)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(if (or (null arg) (= arg 0))
(setq arg 1))
(while (> arg 0)
"Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
(interactive)
(when (Buffer-menu-no-header)
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(forward-char 2)
(delete-char 1)
(insert ?S)
(defun Buffer-menu-not-modified (&optional arg)
"Mark buffer on this line as unmodified (no changes to save)."
(interactive "P")
- (save-excursion
- (set-buffer (Buffer-menu-buffer t))
+ (with-current-buffer (Buffer-menu-buffer t)
(set-buffer-modified-p arg))
(save-excursion
(beginning-of-line)
(forward-char 2)
(if (= (char-after) (if arg ?\s ?*))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(delete-char 1)
(insert (if arg ?* ?\s))))))
(Buffer-menu-beginning)
(while (re-search-forward "^..S" nil t)
(let ((modp nil))
- (save-excursion
- (set-buffer (Buffer-menu-buffer t))
+ (with-current-buffer (Buffer-menu-buffer t)
(save-buffer)
(setq modp (buffer-modified-p)))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(delete-char -1)
(insert (if modp ?* ?\s))))))
(save-excursion
(Buffer-menu-beginning)
(let ((buff-menu-buffer (current-buffer))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(while (re-search-forward "^D" nil t)
(forward-char -1)
(let ((buf (Buffer-menu-buffer nil)))
(Buffer-menu-beginning)
(while (re-search-forward "^>" nil t)
(setq tem (Buffer-menu-buffer t))
- (let ((buffer-read-only nil))
+ (let ((inhibit-read-only t))
(delete-char -1)
(insert ?\s))
(or (eq tem buff) (memq tem others) (setq others (cons tem others))))
(other-window 1) ;back to the beginning!
)))
+(defun Buffer-menu-marked-buffers ()
+ "Return a list of buffers marked with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command."
+ (let (buffers)
+ (Buffer-menu-beginning)
+ (while (re-search-forward "^>" nil t)
+ (setq buffers (cons (Buffer-menu-buffer t) buffers)))
+ (nreverse buffers)))
+
+(defun Buffer-menu-isearch-buffers ()
+ "Search for a string through all marked buffers using Isearch."
+ (interactive)
+ (multi-isearch-buffers (Buffer-menu-marked-buffers)))
+
+(defun Buffer-menu-isearch-buffers-regexp ()
+ "Search for a regexp through all marked buffers using Isearch."
+ (interactive)
+ (multi-isearch-buffers-regexp (Buffer-menu-marked-buffers)))
\f
(defun Buffer-menu-visit-tags-table ()
"Select the buffer whose line you click on."
(interactive "e")
(let (buffer)
- (save-excursion
- (set-buffer (window-buffer (posn-window (event-end event))))
+ (with-current-buffer (window-buffer (posn-window (event-end event)))
(save-excursion
(goto-char (posn-point (event-end event)))
(setq buffer (Buffer-menu-buffer t))))
"Toggle read-only status of buffer on this line, perhaps via version control."
(interactive)
(let (char)
- (save-excursion
- (set-buffer (Buffer-menu-buffer t))
- (vc-toggle-read-only)
+ (with-current-buffer (Buffer-menu-buffer t)
+ (toggle-read-only)
(setq char (if buffer-read-only ?% ?\s)))
(save-excursion
(beginning-of-line)
(forward-char 1)
(if (/= (following-char) char)
- (let (buffer-read-only)
+ (let ((inhibit-read-only t))
(delete-char 1)
(insert char))))))
(beginning-of-line)
(bury-buffer (Buffer-menu-buffer t))
(let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
- (buffer-read-only nil))
+ (inhibit-read-only t))
(delete-region (point) (progn (forward-line -1) (point)))
(goto-char (point-max))
(insert line))
(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*'.
(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."
(if (< column 2) (setq column 2))
(if (> column 5) (setq column 5)))
(setq Buffer-menu-sort-column column)
- (let (buffer-read-only l buf m1 m2)
+ (let ((inhibit-read-only t) l buf m1 m2)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
(if (or m1 m2)
(push (list buf m1 m2) l)))
(forward-line)))
- (Buffer-menu-revert)
- (setq buffer-read-only)
+ (revert-buffer)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
(t
(setq file (concat "("
(file-name-nondirectory file)
- ")"
+ ") "
Info-current-node)))))))
(push (list buffer bits name (buffer-size) mode file)
list))))))
;; 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
(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
HCoop / bpt / emacs.git / blobdiff