;;; 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 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Maintainer: FSF
;; Keywords: convenience
;; 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 2, 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:
;; 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.")
+ "Which column to sort the menu on.
+Use 2 to sort by buffer names, or 5 to sort by file names.
+A nil value means sort by visited order (the default).")
(defconst Buffer-menu-buffer-column 4)
-(defvar Buffer-menu-mode-map nil
- "Local keymap for `Buffer-menu-mode' buffers.")
-
(defvar Buffer-menu-files-only nil
"Non-nil if the current buffer-menu lists only file buffers.
This variable determines whether reverting the buffer lists only
(make-variable-buffer-local 'Buffer-menu-files-only)
-(if Buffer-menu-mode-map
- ()
- (setq Buffer-menu-mode-map (make-keymap))
- (suppress-keymap Buffer-menu-mode-map t)
- (define-key Buffer-menu-mode-map "q" 'quit-window)
- (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
- (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
- (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
- (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "e" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
- (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
- (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
- (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
- (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
- (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
- (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
- (define-key Buffer-menu-mode-map " " 'next-line)
- (define-key Buffer-menu-mode-map "n" 'next-line)
- (define-key Buffer-menu-mode-map "p" 'previous-line)
- (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
- (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
- (define-key Buffer-menu-mode-map "?" 'describe-mode)
- (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
- (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
- (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
- (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
- (define-key Buffer-menu-mode-map "b" 'Buffer-menu-bury)
- (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
- (define-key Buffer-menu-mode-map "V" 'Buffer-menu-view)
- (define-key Buffer-menu-mode-map "T" 'Buffer-menu-toggle-files-only)
- (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
- (define-key Buffer-menu-mode-map [follow-link] 'mouse-face)
-)
+(defvar Info-current-file) ;; from info.el
+(defvar Info-current-node) ;; from info.el
+
+(defvar Buffer-menu-mode-map
+ (let ((map (make-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 "f" 'Buffer-menu-this-window)
+ (define-key map "e" 'Buffer-menu-this-window)
+ (define-key map "\C-m" 'Buffer-menu-this-window)
+ (define-key map "o" 'Buffer-menu-other-window)
+ (define-key map "\C-o" 'Buffer-menu-switch-other-window)
+ (define-key map "s" 'Buffer-menu-save)
+ (define-key map "d" 'Buffer-menu-delete)
+ (define-key map "k" 'Buffer-menu-delete)
+ (define-key map "\C-d" 'Buffer-menu-delete-backwards)
+ (define-key map "\C-k" 'Buffer-menu-delete)
+ (define-key map "x" 'Buffer-menu-execute)
+ (define-key map " " 'next-line)
+ (define-key map "n" 'next-line)
+ (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)
+ 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)
-(defun Buffer-menu-mode ()
+(define-derived-mode Buffer-menu-mode nil "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-revert] -- 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."
- (kill-all-local-variables)
- (use-local-map Buffer-menu-mode-map)
- (setq major-mode 'Buffer-menu-mode)
- (setq mode-name "Buffer Menu")
(set (make-local-variable 'revert-buffer-function)
'Buffer-menu-revert-function)
(set (make-local-variable 'buffer-stale-function)
#'(lambda (&optional noconfirm) 'fast))
(setq truncate-lines t)
- (setq buffer-read-only t)
- (run-mode-hooks 'buffer-menu-mode-hook))
+ (setq buffer-read-only t))
;; This function exists so we can make the doc string of Buffer-menu-mode
;; look nice.
"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))))
"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))
(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))
(push (list buf m1 m2) l)))
(forward-line)))
(Buffer-menu-revert)
- (setq buffer-read-only)
(save-excursion
(Buffer-menu-beginning)
(while (not (eobp))
list desired-point)
(when Buffer-menu-use-header-line
(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)
+ ;; Turn whitespace chars in the header into stretch specs so
+ ;; they work regardless of the header-line face.
+ (while (string-match "[ \t\n]+" header pos)
(setq pos (match-end 0))
(put-text-property (match-beginning 0) pos 'display
;; Assume fixed-size chars in the buffer.
(put-text-property 0 3 'face 'fixed-pitch header)
;; Add a "dummy" leading space to align the beginning of the header
;; line with the beginning of the text (rather than with the left
- ;; scrollbar or the left fringe). –-Stef
+ ;; scrollbar or the left fringe). --Stef
(setq header (concat (propertize " " 'display '(space :align-to 0))
header)))
(with-current-buffer (get-buffer-create "*Buffer List*")
(erase-buffer)
(setq standard-output (current-buffer))
(unless Buffer-menu-use-header-line
- (let ((underline (if (char-displayable-p ?—) ?— ?-)))
+ ;; Use U+2014 (EM DASH) to underline if possible, else use ASCII
+ ;; (i.e. U+002D, HYPHEN-MINUS).
+ (let ((underline (if (char-displayable-p ?\u2014) ?\u2014 ?-)))
(insert header
(apply 'string
(mapcar (lambda (c)
?\s)))
(unless file
;; No visited file. Check local value of
- ;; list-buffers-directory.
- (when (and (boundp 'list-buffers-directory)
- list-buffers-directory)
- (setq file list-buffers-directory)))
+ ;; list-buffers-directory and, for Info buffers,
+ ;; Info-current-file.
+ (cond ((and (boundp 'list-buffers-directory)
+ list-buffers-directory)
+ (setq file list-buffers-directory))
+ ((eq major-mode 'Info-mode)
+ (setq file Info-current-file)
+ (cond
+ ((equal file "dir")
+ (setq file "*Info Directory*"))
+ ((eq file 'apropos)
+ (setq file "*Info Apropos*"))
+ ((eq file 'history)
+ (setq file "*Info History*"))
+ ((eq file 'toc)
+ (setq file "*Info TOC*"))
+ ((not (stringp file)) ;; avoid errors
+ (setq file nil))
+ (t
+ (setq file (concat "("
+ (file-name-nondirectory file)
+ ")"
+ Info-current-node)))))))
(push (list buffer bits name (buffer-size) mode file)
list))))))
;; Preserve the original buffer-list ordering, just in case.
;; Put the buffer name into a text property
;; so we don't have to extract it from the text.
;; This way we avoid problems with unusual buffer names.
- (Buffer-menu-buffer+size (nth 2 buffer)
- (int-to-string (nth 3 buffer))
- `(buffer-name ,(nth 2 buffer)
- buffer ,(car buffer)
- font-lock-face buffer-menu-buffer
- mouse-face highlight
- help-echo "mouse-2: select this buffer"))
- " "
+ (let ((name (nth 2 buffer))
+ (size (int-to-string (nth 3 buffer))))
+ (Buffer-menu-buffer+size name size
+ `(buffer-name ,name
+ buffer ,(car buffer)
+ font-lock-face buffer-menu-buffer
+ mouse-face highlight
+ 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)
(nth 4 buffer)))
HCoop / bpt / emacs.git / blobdiff