aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman1995-01-09 22:16:23 +0000
committerRichard M. Stallman1995-01-09 22:16:23 +0000
commit4aa4849be305af4dc55f4863895a365d93edee70 (patch)
treef89b5a3a0f0bd194fd6f553cddf9227435245886
parente19bdc1471737b32c839b81daf1916556e13986c (diff)
downloademacs-4aa4849be305af4dc55f4863895a365d93edee70.tar.gz
emacs-4aa4849be305af4dc55f4863895a365d93edee70.zip
Better format of files-by-directory menus.
Split big menus into sub-menus. (msb-max-menu-items): Changed default value. This variable now depicts the maximum number of items in a sub-menu. (msb-display-most-recently-used): Changed default value. (mouse-select-buffer): Now handles several levels of sub-menus. New format on return value.
-rw-r--r--lisp/msb.el193
1 files changed, 116 insertions, 77 deletions
diff --git a/lisp/msb.el b/lisp/msb.el
index c4f0c900204..b02ac807788 100644
--- a/lisp/msb.el
+++ b/lisp/msb.el
@@ -3,6 +3,7 @@
3;; 3;;
4;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se> 4;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
5;; Created: 8 Oct 1993 5;; Created: 8 Oct 1993
6;; Lindberg's last update version: 3.27
6;; Keywords: mouse buffer menu 7;; Keywords: mouse buffer menu
7;; 8;;
8;; This program is free software; you can redistribute it and/or modify 9;; This program is free software; you can redistribute it and/or modify
@@ -51,7 +52,8 @@
51;; Also check out the variable `msb-display-invisible-buffers-p'. 52;; Also check out the variable `msb-display-invisible-buffers-p'.
52 53
53;; Known bugs: 54;; Known bugs:
54;; - `msb' does not work on a non-X-toolkit Emacs. 55;; - Files-by-directory
56;; + No possibility to show client/changed buffers separately
55;; Future enhancements: 57;; Future enhancements:
56;; - [Mattes] had a suggestion about sorting files by extension. 58;; - [Mattes] had a suggestion about sorting files by extension.
57;; I (Lars Lindberg) think this case could be solved if msb.el was 59;; I (Lars Lindberg) think this case could be solved if msb.el was
@@ -211,10 +213,9 @@ The separators will appear between all menus that have a sorting key that differ
211(defvar msb-files-by-directory-sort-key 0 213(defvar msb-files-by-directory-sort-key 0
212 "*The sort key for files sorted by directory") 214 "*The sort key for files sorted by directory")
213 215
214(defvar msb-max-menu-items 25 216(defvar msb-max-menu-items 15
215 "*The maximum number of items in a menu. 217 "*The maximum number of items in a menu.
216If this variable is set to 15 for instance, then the 15 latest used 218If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each.
217buffer that fits in a certain submenu will appear in that submenu.
218Nil means no limit.") 219Nil means no limit.")
219 220
220(defvar msb-max-file-menu-items 10 221(defvar msb-max-file-menu-items 10
@@ -224,15 +225,17 @@ When the menu is of type `file by directory', this is the maximum
224number of buffers that are clumped togehter from different 225number of buffers that are clumped togehter from different
225directories. 226directories.
226 227
228Set this to 1 if you want one menu per directory instead of clumping
229them together.
230
227If the value is not a number, then the value 10 is used.") 231If the value is not a number, then the value 10 is used.")
228 232
229(defvar msb-most-recently-used-sort-key -1010 233(defvar msb-most-recently-used-sort-key -1010
230 "*Where should the menu with the most recently used buffers be placed?") 234 "*Where should the menu with the most recently used buffers be placed?")
231 235
232(defvar msb-display-most-recently-used t 236(defvar msb-display-most-recently-used 15
233 "*How many buffers should be in the most-recently-used menu. 237 "*How many buffers should be in the most-recently-used menu.
234No buffers at all if less than 1 or nil. 238 No buffers at all if less than 1 or nil (or any non-number).")
235T means use the value of `msb-max-menu-items' in the way it is defined.")
236 239
237(defvar msb-most-recently-used-title "Most recently used (%d)" 240(defvar msb-most-recently-used-title "Most recently used (%d)"
238 "*The title for the most-recently-used menu.") 241 "*The title for the most-recently-used menu.")
@@ -252,6 +255,9 @@ names that starts with a space character.")
252The default function to call for handling the appearance of a menu 255The default function to call for handling the appearance of a menu
253item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH, 256item. It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
254where the latter is the max length of all buffer names. 257where the latter is the max length of all buffer names.
258
259The function should return the string to use in the menu.
260
255When the function is called, BUFFER is the current buffer. 261When the function is called, BUFFER is the current buffer.
256This function is called for items in the variable `msb-menu-cond' that 262This function is called for items in the variable `msb-menu-cond' that
257have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more 263have nil as ITEM-HANDLING-FUNCTION. See `msb-menu-cond' for more
@@ -331,7 +337,7 @@ error every time you do \\[msb].")
331(defvar msb--error nil) 337(defvar msb--error nil)
332 338
333;;; 339;;;
334;;; Some example function to be used for `msb-item-sort-function'. 340;;; Some example function to be used for `msb-item-handling-function'.
335;;; 341;;;
336(defun msb-item-handler (buffer &optional maxbuf) 342(defun msb-item-handler (buffer &optional maxbuf)
337 "Create one string item, concerning BUFFER, for the buffer menu. 343 "Create one string item, concerning BUFFER, for the buffer menu.
@@ -386,7 +392,7 @@ The `#' appears only version control file (SCCS/RCS)."
386 (or buffer-file-name ""))) 392 (or buffer-file-name "")))
387 393
388;;; 394;;;
389;;; Some example function to be used for `msb-item-handling-function'. 395;;; Some example function to be used for `msb-item-sort-function'.
390;;; 396;;;
391(defun msb-sort-by-name (item1 item2) 397(defun msb-sort-by-name (item1 item2)
392 "Sorts the items depending on their buffer-name 398 "Sorts the items depending on their buffer-name
@@ -417,10 +423,9 @@ See the function `mouse-select-buffer' and the variable
417 (interactive "e") 423 (interactive "e")
418 (let ((buffer (mouse-select-buffer event)) 424 (let ((buffer (mouse-select-buffer event))
419 (window (posn-window (event-start event)))) 425 (window (posn-window (event-start event))))
420 (cond 426 (when buffer
421 (buffer 427 (unless (framep window) (select-window window))
422 (or (framep window) (select-window window)) 428 (switch-to-buffer buffer)))
423 (switch-to-buffer (car (cdr buffer))))))
424 nil) 429 nil)
425 430
426;;; 431;;;
@@ -463,8 +468,6 @@ If the argument is left out or nil, then the current buffer is considered."
463 (lambda (item) 468 (lambda (item)
464 (cond 469 (cond
465 ((and path 470 ((and path
466 msb-max-menu-items
467 (< (length buffers) msb-max-menu-items)
468 (string= path (car item))) 471 (string= path (car item)))
469 (push (cdr item) buffers) 472 (push (cdr item) buffers)
470 nil) 473 nil)
@@ -507,10 +510,14 @@ If the argument is left out or nil, then the current buffer is considered."
507 (cond 510 (cond
508 ((> (length buffers) max-clumped-together) 511 ((> (length buffers) max-clumped-together)
509 (setq last-path (car first)) 512 (setq last-path (car first))
510 (when top-found-p 513 (setq first
511 (setq first (cons (concat (car first) "/...") 514 (cons (format (if top-found-p
512 (cdr first))) 515 "%s/... (%d)"
513 (setq top-found-p nil)) 516 "%s (%d)")
517 (car first)
518 (length (cdr first)))
519 (cdr first)))
520 (setq top-found-p nil)
514 (push first final-list) 521 (push first final-list)
515 (setq first (car rest) 522 (setq first (car rest)
516 rest (cdr rest)) 523 rest (cdr rest))
@@ -531,22 +538,27 @@ If the argument is left out or nil, then the current buffer is considered."
531 (string= path 538 (string= path
532 (substring last-path 0 (length path)))))) 539 (substring last-path 0 (length path))))))
533 540
534 (when top-found-p 541 (setq first
535 (setq first (cons (concat (car first) "/...") 542 (cons (format (if top-found-p
536 (cdr first))) 543 "%s/... (%d)"
537 (setq top-found-p nil)) 544 "%s (%d)")
545 (car first)
546 (length (cdr first)))
547 (cdr first)))
548 (setq top-found-p nil)
538 (push first final-list) 549 (push first final-list)
539 (setq first (car rest) 550 (setq first (car rest)
540 rest (cdr rest)) 551 rest (cdr rest))
541 (setq path (car first) 552 (setq path (car first)
542 buffers (cdr first))))))) 553 buffers (cdr first)))))))
543 (when top-found-p 554 (setq first
544 (setq first (cons (concat (car first) 555 (cons (format (if top-found-p
545 (if (string-match "/$" (car first)) 556 "%s/... (%d)"
546 "..." 557 "%s (%d)")
547 "/...")) 558 (car first)
548 (cdr first))) 559 (length (cdr first)))
549 (setq top-found-p nil)) 560 (cdr first)))
561 (setq top-found-p nil)
550 (push first final-list) 562 (push first final-list)
551 (nreverse final-list))) 563 (nreverse final-list)))
552 564
@@ -604,10 +616,7 @@ If the argument is left out or nil, then the current buffer is considered."
604 multi-flag)) 616 multi-flag))
605 (progn (when (eq result 'multi) 617 (progn (when (eq result 'multi)
606 (setq multi-flag t)) 618 (setq multi-flag t))
607 t) 619 t))
608 (or (not msb-max-menu-items)
609 (< (length (eval (aref fi 0)))
610 msb-max-menu-items)))
611 collect fi 620 collect fi
612 until (and result 621 until (and result
613 (not (eq result 'multi))))) 622 (not (eq result 'multi)))))
@@ -672,15 +681,9 @@ If the argument is left out or nil, then the current buffer is considered."
672;; Returns a list on the form ((TITLE . BUFFER-LIST)) for 681;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
673;; the most recently used buffers. 682;; the most recently used buffers.
674(defun msb--most-recently-used-menu (max-buffer-name-length) 683(defun msb--most-recently-used-menu (max-buffer-name-length)
675 (when (and msb-display-most-recently-used 684 (when (and (numberp msb-display-most-recently-used)
676 (or (not (numberp msb-display-most-recently-used)) 685 (> msb-display-most-recently-used 0))
677 (> msb-display-most-recently-used 0))) 686 (let* ((most-recently-used
678 (let* ((max-in-menu
679 (if (numberp msb-display-most-recently-used)
680 msb-display-most-recently-used
681 msb-max-menu-items))
682
683 (most-recently-used
684 (loop with n = 0 687 (loop with n = 0
685 for buffer in (cdr (buffer-list)) 688 for buffer in (cdr (buffer-list))
686 if (save-excursion 689 if (save-excursion
@@ -694,7 +697,7 @@ If the argument is left out or nil, then the current buffer is considered."
694 max-buffer-name-length) 697 max-buffer-name-length)
695 buffer)) 698 buffer))
696 and do (incf n) 699 and do (incf n)
697 until (and max-in-menu (>= n max-in-menu))))) 700 until (>= n msb-display-most-recently-used))))
698 (cons (if (stringp msb-most-recently-used-title) 701 (cons (if (stringp msb-most-recently-used-title)
699 (format msb-most-recently-used-title 702 (format msb-most-recently-used-title
700 (length most-recently-used)) 703 (length most-recently-used))
@@ -748,7 +751,11 @@ If the argument is left out or nil, then the current buffer is considered."
748 (sort 751 (sort
749 (mapcar (function 752 (mapcar (function
750 (lambda (buffer) 753 (lambda (buffer)
751 (cons (buffer-name buffer) 754 (cons (save-excursion
755 (set-buffer buffer)
756 (funcall msb-item-handling-function
757 buffer
758 max-buffer-name-length))
752 buffer))) 759 buffer)))
753 (cdr buffer-list)) 760 (cdr buffer-list))
754 (function 761 (function
@@ -756,15 +763,14 @@ If the argument is left out or nil, then the current buffer is considered."
756 (string< (car item1) (car item2))))))))) 763 (string< (car item1) (car item2)))))))))
757 (msb--choose-file-menu file-buffers)))) 764 (msb--choose-file-menu file-buffers))))
758 ;; Now make the menu - a list of (TITLE . BUFFER-LIST) 765 ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
759 (let* ((buffers (buffer-list)) 766 (let* (menu
760 menu
761 (most-recently-used 767 (most-recently-used
762 (msb--most-recently-used-menu max-buffer-name-length)) 768 (msb--most-recently-used-menu max-buffer-name-length))
763 (others (append file-buffers 769 (others (append file-buffers
764 (loop for elt 770 (loop for elt
765 across function-info-vector 771 across function-info-vector
766 for value = (msb--create-sort-item elt) 772 for value = (msb--create-sort-item elt)
767 if value collect value)))) 773 if value collect value))))
768 (setq menu 774 (setq menu
769 (mapcar 'cdr ;Remove the SORT-KEY 775 (mapcar 'cdr ;Remove the SORT-KEY
770 ;; Sort the menus - not the items. 776 ;; Sort the menus - not the items.
@@ -811,7 +817,7 @@ If the argument is left out or nil, then the current buffer is considered."
811 "Pop up several menus of buffers, for selection with the mouse. 817 "Pop up several menus of buffers, for selection with the mouse.
812Returns the selected buffer or nil if no buffer is selected. 818Returns the selected buffer or nil if no buffer is selected.
813 819
814The way the buffers are splitted is conveniently handled with the 820The way the buffers are split is conveniently handled with the
815variable `msb-menu-cond'." 821variable `msb-menu-cond'."
816 ;; Popup the menu and return the selected buffer. 822 ;; Popup the menu and return the selected buffer.
817 (when (or msb--error 823 (when (or msb--error
@@ -820,31 +826,33 @@ variable `msb-menu-cond'."
820 (frame-or-buffer-changed-p)) 826 (frame-or-buffer-changed-p))
821 (setq msb--error nil) 827 (setq msb--error nil)
822 (setq msb--last-buffer-menu (msb--create-buffer-menu))) 828 (setq msb--last-buffer-menu (msb--create-buffer-menu)))
823 (let ((position event)) 829 (let ((position event)
830 choice)
824 (when (and (fboundp 'posn-x-y) 831 (when (and (fboundp 'posn-x-y)
825 (fboundp 'posn-window)) 832 (fboundp 'posn-window))
826 (let ((posX (car (posn-x-y (event-start event)))) 833 (let ((posX (car (posn-x-y (event-start event))))
827 (posY (cdr (posn-x-y (event-start event)))) 834 (posY (cdr (posn-x-y (event-start event))))
828 (posWind (posn-window (event-start event))) 835 (posWind (posn-window (event-start event))))
829 name)
830 ;; adjust position 836 ;; adjust position
831 (setq posX (- posX (funcall msb-horizontal-shift-function)) 837 (setq posX (- posX (funcall msb-horizontal-shift-function))
832 position (list (list posX posY) posWind)))) 838 position (list (list posX posY) posWind))))
833 (setq name (x-popup-menu position msb--last-buffer-menu)) 839 (setq choice (x-popup-menu position msb--last-buffer-menu))
834 ;; If toggle bring up the
835 (cond 840 (cond
836 ((eq (car name) 'toggle) 841 ((eq (car choice) 'toggle)
837 (msb--toggle-menu-type) 842 ;; Bring up the menu again with type toggled.
838 (mouse-select-buffer event)) 843 (msb--toggle-menu-type)
839 ((and (numberp (car name)) 844 (mouse-select-buffer event))
840 (null (cdr name))) 845 ((and (numberp (car choice))
841 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car name) msb--last-buffer-menu)))) 846 (null (cdr choice)))
847 (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu))))
842 (mouse-select-buffer event))) 848 (mouse-select-buffer event)))
843 ((and (stringp (car name)) 849 ((while (numberp (car choice))
844 (null (cdr name))) 850 (setq choice (cdr choice))))
845 (cons nil name)) 851 ((and (stringp (car choice))
846 (t 852 (null (cdr choice)))
847 name)))) 853 (car choice))
854 (t
855 (error "Unknown form for buffer: %s" choice)))))
848 856
849;; Add separators 857;; Add separators
850(defun msb--add-separators (sorted-list) 858(defun msb--add-separators (sorted-list)
@@ -870,6 +878,37 @@ variable `msb-menu-cond'."
870 (list item))))) 878 (list item)))))
871 sorted-list))))) 879 sorted-list)))))
872 880
881(defun msb--split-menus-2 (list mcount result)
882 (cond
883 ((> (length list) msb-max-menu-items)
884 (let ((count 0)
885 sub-name
886 (tmp-list nil))
887 (while (< count msb-max-menu-items)
888 (push (pop list) tmp-list)
889 (incf count))
890 (setq tmp-list (nreverse tmp-list))
891 (setq sub-name (concat (car (car tmp-list)) "..."))
892 (push (append (list mcount sub-name
893 'keymap sub-name)
894 tmp-list)
895 result))
896 (msb--split-menus-2 list (1+ mcount) result))
897 ((null result)
898 list)
899 (t
900 (let (sub-name)
901 (setq sub-name (concat (car (car list)) "..."))
902 (push (append (list mcount sub-name
903 'keymap sub-name)
904 list)
905 result))
906 (nreverse result))))
907
908(defun msb--split-menus (list)
909 (msb--split-menus-2 list 0 nil))
910
911
873(defun msb--make-keymap-menu (raw-menu) 912(defun msb--make-keymap-menu (raw-menu)
874 (let ((end (cons '(nil) 'menu-bar-select-buffer)) 913 (let ((end (cons '(nil) 'menu-bar-select-buffer))
875 (mcount 0)) 914 (mcount 0))
@@ -880,15 +919,16 @@ variable `msb-menu-cond'."
880 ((eq 'separator sub-menu) 919 ((eq 'separator sub-menu)
881 (list 'separator "---")) 920 (list 'separator "---"))
882 (t 921 (t
883 (append (list (incf mcount) (car sub-menu) 922 (let ((buffers (mapcar (function
884 'keymap (car sub-menu)) 923 (lambda (item)
885 (mapcar (function 924 (let ((string (car item))
886 (lambda (item) 925 (buffer (cdr item)))
887 (let ((string (car item)) 926 (cons (buffer-name buffer)
888 (buffer (cdr item))) 927 (cons string end)))))
889 (cons (buffer-name buffer) 928 (cdr sub-menu))))
890 (cons string end))))) 929 (append (list (incf mcount) (car sub-menu)
891 (cdr sub-menu))))))) 930 'keymap (car sub-menu))
931 (msb--split-menus buffers)))))))
892 raw-menu))) 932 raw-menu)))
893 933
894(defun menu-bar-update-buffers (&optional arg) 934(defun menu-bar-update-buffers (&optional arg)
@@ -951,4 +991,3 @@ variable `msb-menu-cond'."
951(provide 'msb) 991(provide 'msb)
952(eval-after-load 'msb (run-hooks 'msb-after-load-hooks)) 992(eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
953;;; msb.el ends here 993;;; msb.el ends here
954