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. |
645 |
(let* ((old-buffer (current-buffer)) |
(let* ((old-buffer (current-buffer)) |
646 |
(standard-output standard-output) |
(standard-output standard-output) |
647 |
(mode-end (make-string (- Buffer-menu-mode-width 2) ? )) |
(mode-end (make-string (- Buffer-menu-mode-width 2) ? )) |
648 |
(header (concat (propertize "CRM " 'face 'fixed-pitch) |
(header (concat "CRM " |
649 |
(Buffer-menu-buffer+size |
(Buffer-menu-buffer+size |
650 |
(Buffer-menu-make-sort-button "Buffer" 2) |
(Buffer-menu-make-sort-button "Buffer" 2) |
651 |
(Buffer-menu-make-sort-button "Size" 3)) |
(Buffer-menu-make-sort-button "Size" 3)) |
660 |
(while (string-match "[ \t]+" header pos) |
(while (string-match "[ \t]+" header pos) |
661 |
(setq pos (match-end 0)) |
(setq pos (match-end 0)) |
662 |
(put-text-property (match-beginning 0) pos 'display |
(put-text-property (match-beginning 0) pos 'display |
663 |
;; Assume fixed-size chars |
;; Assume fixed-size chars in the buffer. |
664 |
(list 'space :align-to pos) |
(list 'space :align-to pos) |
665 |
header)))) |
header))) |
666 |
|
;; Try to better align the one-char headers. |
667 |
|
(put-text-property 0 3 'face 'fixed-pitch header) |
668 |
|
;; Add a "dummy" leading space to align the beginning of the header |
669 |
|
;; line with the beginning of the text (rather than with the left |
670 |
|
;; scrollbar or the left fringe). –-Stef |
671 |
|
(setq header (concat (propertize " " 'display '(space :align-to 0)) |
672 |
|
header)) |
673 |
|
) |
674 |
(with-current-buffer (get-buffer-create "*Buffer List*") |
(with-current-buffer (get-buffer-create "*Buffer List*") |
675 |
(setq buffer-read-only nil) |
(setq buffer-read-only nil) |
676 |
(erase-buffer) |
(erase-buffer) |
677 |
(setq standard-output (current-buffer)) |
(setq standard-output (current-buffer)) |
678 |
(unless Buffer-menu-use-header-line |
(unless Buffer-menu-use-header-line |
679 |
(insert header (propertize "---" 'face 'fixed-pitch) " ") |
(let ((underline (if (char-displayable-p ?—) ?— ?-))) |
680 |
(insert (Buffer-menu-buffer+size "------" "----")) |
(insert header |
681 |
(insert " ----" mode-end "----\n")) |
(apply 'string |
682 |
|
(mapcar (lambda (c) |
683 |
|
(if (memq c '(?\n ?\ )) c underline)) |
684 |
|
header))))) |
685 |
(if buffer-list |
(if buffer-list |
686 |
(setq list buffer-list) |
(setq list buffer-list) |
687 |
;; Collect info for every buffer we're interested in. |
;; Collect info for every buffer we're interested in. |