Mercurial > hg > xemacs-beta
comparison lisp/buff-menu.el @ 771:943eaba38521
[xemacs-hg @ 2002-03-13 08:51:24 by ben]
The big ben-mule-21-5 check-in!
Various files were added and deleted. See CHANGES-ben-mule.
There are still some test suite failures. No crashes, though.
Many of the failures have to do with problems in the test suite itself
rather than in the actual code. I'll be addressing these in the next
day or so -- none of the test suite failures are at all critical.
Meanwhile I'll be trying to address the biggest issues -- i.e. build
or run failures, which will almost certainly happen on various platforms.
All comments should be sent to ben@xemacs.org -- use a Cc: if necessary
when sending to mailing lists. There will be pre- and post- tags,
something like
pre-ben-mule-21-5-merge-in, and
post-ben-mule-21-5-merge-in.
| author | ben |
|---|---|
| date | Wed, 13 Mar 2002 08:54:06 +0000 |
| parents | 0f4bdbb07414 |
| children | 79940b592197 |
comparison
equal
deleted
inserted
replaced
| 770:336a418893b5 | 771:943eaba38521 |
|---|---|
| 1 ;;; buff-menu.el --- buffer menu main function and support functions. | 1 ;;; buff-menu.el --- buffer menu/tab main function and support functions. |
| 2 | 2 |
| 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. | 3 ;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc. |
| 4 | 4 ;; Copyright (C) 1999, 2000 Andy Piper. |
| 5 ;; Maintainer: FSF | 5 ;; Copyright (C) 2000 Ben Wing. |
| 6 ;; Keywords: extensions, dumped | 6 |
| 7 ;; Maintainer: XEmacs Development Team | |
| 8 ;; Keywords: frames, extensions, internal, dumped | |
| 7 | 9 |
| 8 ;; This file is part of XEmacs. | 10 ;; This file is part of XEmacs. |
| 9 | 11 |
| 10 ;; XEmacs is free software; you can redistribute it and/or modify it | 12 ;; XEmacs is free software; you can redistribute it and/or modify it |
| 11 ;; under the terms of the GNU General Public License as published by | 13 ;; under the terms of the GNU General Public License as published by |
| 31 ;; Edit, delete, or change attributes of all currently active Emacs | 33 ;; Edit, delete, or change attributes of all currently active Emacs |
| 32 ;; buffers from a list summarizing their state. A good way to browse | 34 ;; buffers from a list summarizing their state. A good way to browse |
| 33 ;; any special or scratch buffers you have loaded, since you can't find | 35 ;; any special or scratch buffers you have loaded, since you can't find |
| 34 ;; them by filename. The single entry point is `Buffer-menu-mode', | 36 ;; them by filename. The single entry point is `Buffer-menu-mode', |
| 35 ;; normally bound to C-x C-b. | 37 ;; normally bound to C-x C-b. |
| 38 | |
| 39 ;; Also contains buffers-tab code, because it's used by | |
| 40 ;; switch-to-next-buffer and friends. | |
| 36 | 41 |
| 37 ;;; Change Log: | 42 ;;; Change Log: |
| 38 | 43 |
| 39 ;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993 | 44 ;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993 |
| 40 ;; | 45 ;; |
| 639 (defun buffers-menu-omit-invisible-buffers (buf) | 644 (defun buffers-menu-omit-invisible-buffers (buf) |
| 640 "For use as a value of `buffers-menu-omit-function'. | 645 "For use as a value of `buffers-menu-omit-function'. |
| 641 Omits normally invisible buffers (those whose name begins with a space)." | 646 Omits normally invisible buffers (those whose name begins with a space)." |
| 642 (not (null (string-match "\\` " (buffer-name buf))))) | 647 (not (null (string-match "\\` " (buffer-name buf))))) |
| 643 | 648 |
| 649 ;;; The Buffers tab | |
| 650 | |
| 651 ;; Some of this is taken from the buffer-menu stuff in menubar-items.el | |
| 652 | |
| 653 (defgroup buffers-tab nil | |
| 654 "Customization of `Buffers' tab." | |
| 655 :group 'gutter) | |
| 656 | |
| 657 (defcustom buffers-tab-max-size 6 | |
| 658 "*Maximum number of entries which may appear on the \"Buffers\" tab. | |
| 659 If this is 10, then only the ten most-recently-selected buffers will be | |
| 660 shown. If this is nil, then all buffers will be shown. Setting this to | |
| 661 a large number or nil will slow down tab responsiveness." | |
| 662 :type '(choice (const :tag "Show all" nil) | |
| 663 (integer 6)) | |
| 664 :group 'buffers-tab) | |
| 665 | |
| 666 (defcustom buffers-tab-switch-to-buffer-function 'buffers-tab-switch-to-buffer | |
| 667 "*The function to call to select a buffer from the buffers tab. | |
| 668 `switch-to-buffer' is a good choice, as is `pop-to-buffer'." | |
| 669 :type '(radio (function-item switch-to-buffer) | |
| 670 (function-item pop-to-buffer) | |
| 671 (function :tag "Other")) | |
| 672 :group 'buffers-tab) | |
| 673 | |
| 674 (defcustom buffers-tab-omit-function 'buffers-menu-omit-invisible-buffers | |
| 675 "*If non-nil, a function specifying the buffers to omit from the buffers tab. | |
| 676 This is passed a buffer and should return non-nil if the buffer should be | |
| 677 omitted. The default value `buffers-menu-omit-invisible-buffers' omits | |
| 678 buffers that are normally considered \"invisible\" (those whose name | |
| 679 begins with a space)." | |
| 680 :type '(choice (const :tag "None" nil) | |
| 681 function) | |
| 682 :group 'buffers-tab) | |
| 683 | |
| 684 (defcustom buffers-tab-selection-function 'select-buffers-tab-buffers-by-mode | |
| 685 "*If non-nil, a function specifying the buffers to select from the | |
| 686 buffers tab. This is passed two buffers and should return non-nil if | |
| 687 the second buffer should be selected. The default value | |
| 688 `select-buffers-tab-buffers-by-mode' groups buffers by major mode and | |
| 689 by `buffers-tab-grouping-regexp'." | |
| 690 | |
| 691 :type '(choice (const :tag "None" nil) | |
| 692 function) | |
| 693 :group 'buffers-tab) | |
| 694 | |
| 695 (defcustom buffers-tab-filter-functions (list buffers-tab-selection-function) | |
| 696 "*If non-nil, a list of functions specifying the buffers to select | |
| 697 from the buffers tab. | |
| 698 Each function in the list is passed two buffers, the buffer to | |
| 699 potentially select and the context buffer, and should return non-nil | |
| 700 if the first buffer should be selected. The default value groups | |
| 701 buffers by major mode and by `buffers-tab-grouping-regexp'." | |
| 702 | |
| 703 :type '(choice (const :tag "None" nil) | |
| 704 sexp) | |
| 705 :group 'buffers-tab) | |
| 706 | |
| 707 (defcustom buffers-tab-sort-function nil | |
| 708 "*If non-nil, a function specifying the buffers to select from the | |
| 709 buffers tab. This is passed the buffer list and returns the list in the | |
| 710 order desired for the tab widget. The default value `nil' leaves the | |
| 711 list in `buffer-list' order (usual most-recently-selected-first)." | |
| 712 | |
| 713 :type '(choice (const :tag "None" nil) | |
| 714 function) | |
| 715 :group 'buffers-tab) | |
| 716 | |
| 717 (make-face 'buffers-tab "Face for displaying the buffers tab.") | |
| 718 (set-face-parent 'buffers-tab 'default) | |
| 719 | |
| 720 (defcustom buffers-tab-face 'buffers-tab | |
| 721 "*Face to use for displaying the buffers tab." | |
| 722 :type 'face | |
| 723 :group 'buffers-tab) | |
| 724 | |
| 725 (defcustom buffers-tab-grouping-regexp | |
| 726 '("^\\(gnus-\\|message-mode\\|mime/viewer-mode\\)" | |
| 727 "^\\(emacs-lisp-\\|lisp-\\)") | |
| 728 "*If non-nil, a list of regular expressions for buffer grouping. | |
| 729 Each regular expression is applied to the current major-mode symbol | |
| 730 name and mode-name, if it matches then any other buffers that match | |
| 731 the same regular expression be added to the current group." | |
| 732 :type '(choice (const :tag "None" nil) | |
| 733 sexp) | |
| 734 :group 'buffers-tab) | |
| 735 | |
| 736 (defcustom buffers-tab-format-buffer-line-function 'format-buffers-tab-line | |
| 737 "*The function to call to return a string to represent a buffer in the | |
| 738 buffers tab. The function is passed a buffer and should return a | |
| 739 string. The default value `format-buffers-tab-line' just returns the | |
| 740 name of the buffer, optionally truncated to | |
| 741 `buffers-tab-max-buffer-line-length'. Also check out | |
| 742 `slow-format-buffers-menu-line' which returns a whole bunch of info | |
| 743 about a buffer." | |
| 744 :type 'function | |
| 745 :group 'buffers-tab) | |
| 746 | |
| 747 (defvar buffers-tab-default-buffer-line-length | |
| 748 (make-specifier-and-init 'generic '((global ((default) . 25))) t) | |
| 749 "*Maximum length of text which may appear in a \"Buffers\" tab. | |
| 750 This is a specifier, use set-specifier to modify it.") | |
| 751 | |
| 752 (defcustom buffers-tab-max-buffer-line-length | |
| 753 (specifier-instance buffers-tab-default-buffer-line-length) | |
| 754 "*Maximum length of text which may appear in a \"Buffers\" tab. | |
| 755 Buffer names over this length will be truncated with elipses. | |
| 756 If this is 0, then the full buffer name will be shown." | |
| 757 :type '(choice (const :tag "Show all" 0) | |
| 758 (integer 25)) | |
| 759 :group 'buffers-tab | |
| 760 :set #'(lambda (var val) | |
| 761 (set-specifier buffers-tab-default-buffer-line-length val) | |
| 762 (setq buffers-tab-max-buffer-line-length val))) | |
| 763 | |
| 764 (defun buffers-tab-switch-to-buffer (buffer) | |
| 765 "For use as a value for `buffers-tab-switch-to-buffer-function'." | |
| 766 (unless (eq (window-buffer) buffer) | |
| 767 ;; this used to add the norecord flag to both calls below. | |
| 768 ;; this is bogus because it is a pervasive assumption in XEmacs | |
| 769 ;; that the current buffer is at the front of the buffers list. | |
| 770 ;; for example, select an item and then do M-C-l | |
| 771 ;; (switch-to-other-buffer). Things get way confused. | |
| 772 (if (> (length (windows-of-buffer buffer)) 0) | |
| 773 (select-window (car (windows-of-buffer buffer))) | |
| 774 (switch-to-buffer buffer)))) | |
| 775 | |
| 776 (defun select-buffers-tab-buffers-by-mode (buffer-to-select buf1) | |
| 777 "For use as a value of `buffers-tab-selection-function'. | |
| 778 This selects buffers by major mode `buffers-tab-grouping-regexp'." | |
| 779 (let ((mode1 (symbol-name (symbol-value-in-buffer 'major-mode buf1))) | |
| 780 (mode2 (symbol-name (symbol-value-in-buffer 'major-mode | |
| 781 buffer-to-select))) | |
| 782 (modenm1 (symbol-value-in-buffer 'mode-name buf1)) | |
| 783 (modenm2 (symbol-value-in-buffer 'mode-name buffer-to-select))) | |
| 784 (cond ((or (eq mode1 mode2) | |
| 785 (eq modenm1 modenm2) | |
| 786 (and (string-match "^[^-]+-" mode1) | |
| 787 (string-match | |
| 788 (concat "^" (regexp-quote | |
| 789 (substring mode1 0 (match-end 0)))) | |
| 790 mode2)) | |
| 791 (and buffers-tab-grouping-regexp | |
| 792 (find-if #'(lambda (x) | |
| 793 (or | |
| 794 (and (string-match x mode1) | |
| 795 (string-match x mode2)) | |
| 796 (and (string-match x modenm1) | |
| 797 (string-match x modenm2)))) | |
| 798 buffers-tab-grouping-regexp))) | |
| 799 t) | |
| 800 (t nil)))) | |
| 801 | |
| 802 (defun format-buffers-tab-line (buffer) | |
| 803 "For use as a value of `buffers-tab-format-buffer-line-function'. | |
| 804 This just returns the buffer's name, optionally truncated." | |
| 805 (let ((len (specifier-instance buffers-tab-default-buffer-line-length))) | |
| 806 (if (and (> len 0) | |
| 807 (> (length (buffer-name buffer)) len)) | |
| 808 (if (string-match ".*<.>$" (buffer-name buffer)) | |
| 809 (concat (substring (buffer-name buffer) | |
| 810 0 (- len 6)) "..." | |
| 811 (substring (buffer-name buffer) -3)) | |
| 812 (concat (substring (buffer-name buffer) | |
| 813 0 (- len 3)) "...")) | |
| 814 (buffer-name buffer)))) | |
| 815 | |
| 816 (defsubst build-buffers-tab-internal (buffers) | |
| 817 (let ((selected t)) | |
| 818 (mapcar | |
| 819 #'(lambda (buffer) | |
| 820 (prog1 | |
| 821 (vector | |
| 822 (funcall buffers-tab-format-buffer-line-function | |
| 823 buffer) | |
| 824 (list buffers-tab-switch-to-buffer-function | |
| 825 (buffer-name buffer)) | |
| 826 :selected selected) | |
| 827 (when selected (setq selected nil)))) | |
| 828 buffers))) | |
| 829 | |
| 830 ;;; #### SJT would like this function to have a sort function list. I | |
| 831 ;;; don't see how this could work given that sorting is not | |
| 832 ;;; cumulative --andyp. | |
| 833 (defun buffers-tab-items (&optional in-deletion frame force-selection) | |
| 834 "Return a list of tab instantiators based on the current buffers list. | |
| 835 This function is used as the tab filter for the top-level buffers | |
| 836 \"Buffers\" tab. It dynamically creates a list of tab instantiators | |
| 837 to use as the contents of the tab. The contents and order of the list | |
| 838 is controlled by `buffers-tab-filter-functions' which by default | |
| 839 groups buffers according to major mode and removes invisible buffers. | |
| 840 You can control how many buffers will be shown by setting | |
| 841 `buffers-tab-max-size'. You can control the text of the tab items by | |
| 842 redefining the function `format-buffers-menu-line'." | |
| 843 (save-match-data | |
| 844 ;; NB it is too late if we run the omit function as part of the | |
| 845 ;; filter functions because we need to know which buffer is the | |
| 846 ;; context buffer before they get run. | |
| 847 (let* ((buffers (delete-if | |
| 848 buffers-tab-omit-function (buffer-list frame))) | |
| 849 (first-buf (car buffers))) | |
| 850 ;; maybe force the selected window | |
| 851 (when (and force-selection | |
| 852 (not in-deletion) | |
| 853 (not (eq first-buf (window-buffer (selected-window frame))))) | |
| 854 (setq buffers (cons (window-buffer (selected-window frame)) | |
| 855 (delq first-buf buffers)))) | |
| 856 ;; if we're in deletion ignore the current buffer | |
| 857 (when in-deletion | |
| 858 (setq buffers (delq (current-buffer) buffers)) | |
| 859 (setq first-buf (car buffers))) | |
| 860 ;; filter buffers | |
| 861 (when buffers-tab-filter-functions | |
| 862 (setq buffers | |
| 863 (delete-if | |
| 864 #'null | |
| 865 (mapcar #'(lambda (buf) | |
| 866 (let ((tmp-buf buf)) | |
| 867 (mapc #'(lambda (fun) | |
| 868 (unless (funcall fun buf first-buf) | |
| 869 (setq tmp-buf nil))) | |
| 870 buffers-tab-filter-functions) | |
| 871 tmp-buf)) | |
| 872 buffers)))) | |
| 873 ;; maybe shorten list of buffers | |
| 874 (and (integerp buffers-tab-max-size) | |
| 875 (> buffers-tab-max-size 1) | |
| 876 (> (length buffers) buffers-tab-max-size) | |
| 877 (setcdr (nthcdr (1- buffers-tab-max-size) buffers) nil)) | |
| 878 ;; sort buffers in group (default is most-recently-selected) | |
| 879 (when buffers-tab-sort-function | |
| 880 (setq buffers (funcall buffers-tab-sort-function buffers))) | |
| 881 ;; convert list of buffers to list of structures used by tab widget | |
| 882 (setq buffers (build-buffers-tab-internal buffers)) | |
| 883 buffers))) | |
| 884 | |
| 644 (provide 'buff-menu) | 885 (provide 'buff-menu) |
| 645 | 886 |
| 646 ;;; buff-menu.el ends here | 887 ;;; buff-menu.el ends here |