1 |
;;; buff-menu.el --- buffer menu main function and support functions |
;;; buff-menu.el --- buffer menu main function and support functions -*- coding:utf-8 -*- |
2 |
|
|
3 |
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003, |
;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 2000, 2001, 2002, 2003, |
4 |
;; 2004 Free Software Foundation, Inc. |
;; 2004 Free Software Foundation, Inc. |
190 |
(setq buffer-read-only t) |
(setq buffer-read-only t) |
191 |
(run-hooks 'buffer-menu-mode-hook)) |
(run-hooks 'buffer-menu-mode-hook)) |
192 |
|
|
193 |
|
;; This function exists so we can make the doc string of Buffer-menu-mode |
194 |
|
;; look nice. |
195 |
(defun Buffer-menu-revert () |
(defun Buffer-menu-revert () |
196 |
"Update the list of buffers." |
"Update the list of buffers." |
197 |
(interactive) |
(interactive) |
647 |
(let* ((old-buffer (current-buffer)) |
(let* ((old-buffer (current-buffer)) |
648 |
(standard-output standard-output) |
(standard-output standard-output) |
649 |
(mode-end (make-string (- Buffer-menu-mode-width 2) ? )) |
(mode-end (make-string (- Buffer-menu-mode-width 2) ? )) |
650 |
(header (concat " " (propertize "CRM " 'face 'fixed-pitch) |
(header (concat "CRM " |
651 |
(Buffer-menu-buffer+size |
(Buffer-menu-buffer+size |
652 |
(Buffer-menu-make-sort-button "Buffer" 2) |
(Buffer-menu-make-sort-button "Buffer" 2) |
653 |
(Buffer-menu-make-sort-button "Size" 3)) |
(Buffer-menu-make-sort-button "Size" 3)) |
662 |
(while (string-match "[ \t]+" header pos) |
(while (string-match "[ \t]+" header pos) |
663 |
(setq pos (match-end 0)) |
(setq pos (match-end 0)) |
664 |
(put-text-property (match-beginning 0) pos 'display |
(put-text-property (match-beginning 0) pos 'display |
665 |
;; Assume fixed-size chars |
;; Assume fixed-size chars in the buffer. |
666 |
(list 'space :align-to (1- pos)) |
(list 'space :align-to pos) |
667 |
header)))) |
header))) |
668 |
|
;; Try to better align the one-char headers. |
669 |
|
(put-text-property 0 3 'face 'fixed-pitch header) |
670 |
|
;; Add a "dummy" leading space to align the beginning of the header |
671 |
|
;; line with the beginning of the text (rather than with the left |
672 |
|
;; scrollbar or the left fringe). –-Stef |
673 |
|
(setq header (concat (propertize " " 'display '(space :align-to 0)) |
674 |
|
header)) |
675 |
|
) |
676 |
(with-current-buffer (get-buffer-create "*Buffer List*") |
(with-current-buffer (get-buffer-create "*Buffer List*") |
677 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
678 |
(erase-buffer) |
(erase-buffer) |
679 |
(setq standard-output (current-buffer)) |
(setq standard-output (current-buffer)) |
680 |
(unless Buffer-menu-use-header-line |
(unless Buffer-menu-use-header-line |
681 |
(insert header (propertize "---" 'face 'fixed-pitch) " ") |
(let ((underline (if (char-displayable-p ?—) ?— ?-))) |
682 |
(insert (Buffer-menu-buffer+size "------" "----")) |
(insert header |
683 |
(insert " ----" mode-end "----\n") |
(apply 'string |
684 |
(put-text-property 1 (point) 'intangible t)) |
(mapcar (lambda (c) |
685 |
|
(if (memq c '(?\n ?\ )) c underline)) |
686 |
|
header))))) |
687 |
(if buffer-list |
(if buffer-list |
688 |
(setq list buffer-list) |
(setq list buffer-list) |
689 |
;; Collect info for every buffer we're interested in. |
;; Collect info for every buffer we're interested in. |