X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/1a4280fb4706f2b5d4f206585d88fcc924fb14a6..5553563924453df2e3c5bf011bf5b7527172b2f6:/lisp/buff-menu.el diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index 18b46dc8ec..d748fb86d6 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -1,6 +1,6 @@ -;;; buff-menu.el --- buffer menu main function and support functions. +;;; buff-menu.el --- buffer menu main function and support functions -;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. +;; Copyright (C) 1985, 86, 87, 93, 94, 95, 2000 Free Software Foundation, Inc. ;; Maintainer: FSF @@ -44,7 +44,7 @@ ;; Based on FSF code dating back to 1985. ;;; 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 @@ -158,15 +158,18 @@ Letters do not insert themselves; instead, they are commands. (let* ((where (save-excursion (beginning-of-line) (+ (point) Buffer-menu-buffer-column))) - (name (and (not (eobp)) (get-text-property where 'buffer-name)))) + (name (and (not (eobp)) (get-text-property where 'buffer-name))) + (buf (and (not (eobp)) (get-text-property where 'buffer)))) (if name (or (get-buffer name) + (and buf (buffer-name buf) buf) (if error-if-non-existent-p (error "No buffer named `%s'" name) nil)) + (or (and buf (buffer-name buf) buf) (if error-if-non-existent-p (error "No buffer on this line") - nil)))) + nil))))) (defun buffer-menu (&optional arg) "Make a menu of buffers so you can save, delete or select them. @@ -305,12 +308,12 @@ and then move up one line. Prefix arg means move that many lines." (let ((buf (Buffer-menu-buffer nil))) (or (eq buf nil) (eq buf buff-menu-buffer) - (save-excursion (kill-buffer buf)))) - (if (Buffer-menu-buffer nil) + (save-excursion (kill-buffer buf))) + (if (and buf (buffer-name buf)) (progn (delete-char 1) (insert ? )) (delete-region (point) (progn (forward-line 1) (point))) - (forward-char -1)))))) + (forward-char -1))))))) (defun Buffer-menu-select () "Select this line's buffer; also display buffers marked with `>'. @@ -319,7 +322,7 @@ This command deletes and replaces all the previously existing windows in the selected frame." (interactive) (let ((buff (Buffer-menu-buffer t)) - (menu (current-buffer)) + (menu (current-buffer)) (others ()) tem) (goto-char (point-min)) @@ -491,84 +494,77 @@ The R column contains a % for buffers that are read-only." ") ;; Record the column where buffer names start. (setq Buffer-menu-buffer-column 4) - (let ((bl (buffer-list))) - (while bl - (let* ((buffer (car bl)) - (name (buffer-name buffer)) - (file (buffer-file-name buffer)) - this-buffer-line-start - this-buffer-read-only - this-buffer-size - this-buffer-mode-name - this-buffer-directory) - (save-excursion - (set-buffer buffer) - (setq this-buffer-read-only buffer-read-only) - (setq this-buffer-size (buffer-size)) - (setq this-buffer-mode-name - (if (eq buffer standard-output) - "Buffer Menu" mode-name)) - (or file - ;; No visited file. Check local value of - ;; list-buffers-directory. - (if (and (boundp 'list-buffers-directory) - list-buffers-directory) - (setq this-buffer-directory list-buffers-directory)))) - (cond - ;; Don't mention internal buffers. - ((string= (substring name 0 1) " ")) - ;; Maybe don't mention buffers without files. - ((and files-only (not file))) - ;; Otherwise output info. - (t - (setq this-buffer-line-start (point)) - ;; Identify current buffer. - (if (eq buffer old-buffer) - (progn - (setq desired-point (point)) - (princ ".")) - (princ " ")) - ;; Identify modified buffers. - (princ (if (buffer-modified-p buffer) "*" " ")) - ;; Handle readonly status. The output buffer is special - ;; cased to appear readonly; it is actually made so at a later - ;; date. - (princ (if (or (eq buffer standard-output) - this-buffer-read-only) - "% " - " ")) - (princ name) - ;; 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. - (setq this-buffer-line-start - (+ this-buffer-line-start Buffer-menu-buffer-column)) - (let ((name-end (point))) - (indent-to 17 2) - (put-text-property this-buffer-line-start name-end - 'buffer-name name) - (put-text-property this-buffer-line-start name-end - 'mouse-face 'highlight)) - (let (size - mode - (excess (- (current-column) 17))) - (setq size (format "%8d" this-buffer-size)) - ;; Ack -- if looking at the *Buffer List* buffer, - ;; always use "Buffer Menu" mode. Otherwise the - ;; first time the buffer is created, the mode will be wrong. - (setq mode this-buffer-mode-name) - (while (and (> excess 0) (= (aref size 0) ?\ )) - (setq size (substring size 1)) - (setq excess (1- excess))) - (princ size) - (indent-to 27 1) - (princ mode)) - (indent-to 40 1) - (or file (setq file this-buffer-directory)) - (if file - (princ (abbreviate-file-name file))) - (princ "\n")))) - (setq bl (cdr bl)))) + (dolist (buffer (buffer-list)) + (let ((name (buffer-name buffer)) + (file (buffer-file-name buffer)) + this-buffer-line-start + this-buffer-read-only + (this-buffer-size (buffer-size buffer)) + this-buffer-mode-name + this-buffer-directory) + (with-current-buffer buffer + (setq this-buffer-read-only buffer-read-only + this-buffer-mode-name mode-name) + (unless file + ;; No visited file. Check local value of + ;; list-buffers-directory. + (when (and (boundp 'list-buffers-directory) + list-buffers-directory) + (setq this-buffer-directory list-buffers-directory)))) + (cond + ;; Don't mention internal buffers. + ((string= (substring name 0 1) " ")) + ;; Maybe don't mention buffers without files. + ((and files-only (not file))) + ((string= name "*Buffer List*")) + ;; Otherwise output info. + (t + (setq this-buffer-line-start (point)) + ;; Identify current buffer. + (if (eq buffer old-buffer) + (progn + (setq desired-point (point)) + (princ ".")) + (princ " ")) + ;; Identify modified buffers. + (princ (if (buffer-modified-p buffer) "*" " ")) + ;; Handle readonly status. The output buffer is special + ;; cased to appear readonly; it is actually made so at a + ;; later date. + (princ (if (or (eq buffer standard-output) + this-buffer-read-only) + "% " + " ")) + (princ name) + ;; 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. + (setq this-buffer-line-start + (+ this-buffer-line-start Buffer-menu-buffer-column)) + (let ((name-end (point))) + (indent-to 17 2) + (put-text-property this-buffer-line-start name-end + 'buffer-name name) + (put-text-property this-buffer-line-start (point) + 'buffer buffer) + (put-text-property this-buffer-line-start name-end + 'mouse-face 'highlight) + (put-text-property this-buffer-line-start name-end + 'help-echo "mouse-2: select this buffer")) + (let ((size (format "%8d" this-buffer-size)) + (mode this-buffer-mode-name) + (excess (- (current-column) 17))) + (while (and (> excess 0) (= (aref size 0) ?\ )) + (setq size (substring size 1) + excess (1- excess))) + (princ size) + (indent-to 27 1) + (princ mode)) + (indent-to 40 1) + (or file (setq file this-buffer-directory)) + (when file + (princ (abbreviate-file-name file))) + (princ "\n"))))) (Buffer-menu-mode) ;; DESIRED-POINT doesn't have to be set; it is not when the ;; current buffer is not displayed for some reason.