1 |
;;; msb.el --- customizable buffer-selection with multiple menus |
;;; msb.el --- customizable buffer-selection with multiple menus |
2 |
|
|
3 |
;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001 |
;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001, 2003 |
4 |
;; Free Software Foundation, Inc. |
;; Free Software Foundation, Inc. |
5 |
|
|
6 |
;; Author: Lars Lindberg <lars.lindberg@home.se> |
;; Author: Lars Lindberg <lars.lindberg@home.se> |
41 |
;; There are some constants for you to try here: |
;; There are some constants for you to try here: |
42 |
;; msb--few-menus |
;; msb--few-menus |
43 |
;; msb--very-many-menus (default) |
;; msb--very-many-menus (default) |
44 |
;; |
;; |
45 |
;; Look at the variable `msb-item-handling-function' for customization |
;; Look at the variable `msb-item-handling-function' for customization |
46 |
;; of the appearance of every menu item. Try for instance setting |
;; of the appearance of every menu item. Try for instance setting |
47 |
;; it to `msb-alon-item-handler'. |
;; it to `msb-alon-item-handler'. |
48 |
;; |
;; |
49 |
;; Look at the variable `msb-item-sort-function' for customization |
;; Look at the variable `msb-item-sort-function' for customization |
50 |
;; of sorting the menus. Set it to t for instance, which means no |
;; of sorting the menus. Set it to t for instance, which means no |
51 |
;; sorting - you will get latest used buffer first. |
;; sorting - you will get latest used buffer first. |
320 |
:type 'string |
:type 'string |
321 |
:set 'msb-custom-set |
:set 'msb-custom-set |
322 |
:group 'msb) |
:group 'msb) |
323 |
|
|
324 |
(defvar msb-horizontal-shift-function '(lambda () 0) |
(defvar msb-horizontal-shift-function '(lambda () 0) |
325 |
"*Function that specifies how many pixels to shift the top menu leftwards.") |
"*Function that specifies how many pixels to shift the top menu leftwards.") |
326 |
|
|
362 |
(const :tag "Oldest first" nil)) |
(const :tag "Oldest first" nil)) |
363 |
:set 'msb-custom-set |
:set 'msb-custom-set |
364 |
:group 'msb) |
:group 'msb) |
365 |
|
|
366 |
(defcustom msb-files-by-directory nil |
(defcustom msb-files-by-directory nil |
367 |
"*Non-nil means that files should be sorted by directory. |
"*Non-nil means that files should be sorted by directory. |
368 |
This is instead of the groups in `msb-menu-cond'." |
This is instead of the groups in `msb-menu-cond'." |
496 |
(file-name-directory (directory-file-name dir))) |
(file-name-directory (directory-file-name dir))) |
497 |
|
|
498 |
;; Create an alist with all buffers from LIST that lies under the same |
;; Create an alist with all buffers from LIST that lies under the same |
499 |
;; directory will be in the same item as the directory string. |
;; directory will be in the same item as the directory name. |
500 |
;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...) |
;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K BUFFER-K+1...)) ...) |
501 |
(defun msb--init-file-alist (list) |
(defun msb--init-file-alist (list) |
502 |
(let ((buffer-alist |
(let ((buffer-alist |
503 |
;; Make alist that looks like |
;; Make alist that looks like |
504 |
;; ((PATH-1 BUFFER-1) (PATH-2 BUFFER-2) ...) |
;; ((DIR-1 BUFFER-1) (DIR-2 BUFFER-2) ...) |
505 |
;; sorted on PATH-x |
;; sorted on DIR-x |
506 |
(sort |
(sort |
507 |
(apply #'nconc |
(apply #'nconc |
508 |
(mapcar |
(mapcar |
514 |
list)) |
list)) |
515 |
(lambda (item1 item2) |
(lambda (item1 item2) |
516 |
(string< (car item1) (car item2)))))) |
(string< (car item1) (car item2)))))) |
517 |
;; Now clump buffers together that have the same path |
;; Now clump buffers together that have the same directory name |
518 |
;; Make alist that looks like |
;; Make alist that looks like |
519 |
;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...) |
;; ((DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR2 . (BUFFER-K)) ...) |
520 |
(let ((path nil) |
(let ((dir nil) |
521 |
(buffers nil)) |
(buffers nil)) |
522 |
(nconc |
(nconc |
523 |
(apply |
(apply |
524 |
#'nconc |
#'nconc |
525 |
(mapcar (lambda (item) |
(mapcar (lambda (item) |
526 |
(cond |
(cond |
527 |
((equal path (car item)) |
((equal dir (car item)) |
528 |
;; The same path as earlier: Add to current list of |
;; The same dir as earlier: |
529 |
;; buffers. |
;; Add to current list of buffers. |
530 |
(push (cdr item) buffers) |
(push (cdr item) buffers) |
531 |
;; This item should not be added to list |
;; This item should not be added to list |
532 |
nil) |
nil) |
533 |
(t |
(t |
534 |
;; New path |
;; New dir |
535 |
(let ((result (and path (cons path buffers)))) |
(let ((result (and dir (cons dir buffers)))) |
536 |
(setq path (car item)) |
(setq dir (car item)) |
537 |
(setq buffers (list (cdr item))) |
(setq buffers (list (cdr item))) |
538 |
;; Add the last result the list. |
;; Add the last result the list. |
539 |
(and result (list result)))))) |
(and result (list result)))))) |
540 |
buffer-alist)) |
buffer-alist)) |
541 |
;; Add the last result to the list |
;; Add the last result to the list |
542 |
(list (cons path buffers)))))) |
(list (cons dir buffers)))))) |
543 |
|
|
544 |
(defun msb--format-title (top-found-p path number-of-items) |
(defun msb--format-title (top-found-p dir number-of-items) |
545 |
"Format a suitable title for the menu item." |
"Format a suitable title for the menu item." |
546 |
(format (if top-found-p "%s... (%d)" "%s (%d)") |
(format (if top-found-p "%s... (%d)" "%s (%d)") |
547 |
(abbreviate-file-name path) number-of-items)) |
(abbreviate-file-name dir) number-of-items)) |
548 |
|
|
549 |
;; Variables for debugging. |
;; Variables for debugging. |
550 |
(defvar msb--choose-file-menu-list) |
(defvar msb--choose-file-menu-list) |
559 |
msb-max-file-menu-items |
msb-max-file-menu-items |
560 |
10)) |
10)) |
561 |
(top-found-p nil) |
(top-found-p nil) |
562 |
(last-path nil) |
(last-dir nil) |
563 |
first rest path buffers old-path) |
first rest dir buffers old-dir) |
564 |
;; Prepare for looping over all items in buffer-alist |
;; Prepare for looping over all items in buffer-alist |
565 |
(setq first (car buffer-alist) |
(setq first (car buffer-alist) |
566 |
rest (cdr buffer-alist) |
rest (cdr buffer-alist) |
567 |
path (car first) |
dir (car first) |
568 |
buffers (cdr first)) |
buffers (cdr first)) |
569 |
(setq msb--choose-file-menu-list (copy-sequence rest)) |
(setq msb--choose-file-menu-list (copy-sequence rest)) |
570 |
;; This big loop tries to clump buffers together that have a |
;; This big loop tries to clump buffers together that have a |
571 |
;; similar name. Remember that buffer-alist is sorted based on the |
;; similar name. Remember that buffer-alist is sorted based on the |
572 |
;; path for the buffers. |
;; directory name of the buffers' visited files. |
573 |
(while rest |
(while rest |
574 |
(let ((found-p nil) |
(let ((found-p nil) |
575 |
(tmp-rest rest) |
(tmp-rest rest) |
576 |
result |
result |
577 |
new-path item) |
new-dir item) |
578 |
(setq item (car tmp-rest)) |
(setq item (car tmp-rest)) |
579 |
;; Clump together the "rest"-buffers that have a path that is |
;; Clump together the "rest"-buffers that have a dir that is |
580 |
;; a subpath of the current one. |
;; a subdir of the current one. |
581 |
(while (and tmp-rest |
(while (and tmp-rest |
582 |
(<= (length buffers) max-clumped-together) |
(<= (length buffers) max-clumped-together) |
583 |
(>= (length (car item)) (length path)) |
(>= (length (car item)) (length dir)) |
584 |
;; `completion-ignore-case' seems to default to t |
;; `completion-ignore-case' seems to default to t |
585 |
;; on the systems with case-insensitive file names. |
;; on the systems with case-insensitive file names. |
586 |
(eq t (compare-strings path 0 nil |
(eq t (compare-strings dir 0 nil |
587 |
(car item) 0 (length path) |
(car item) 0 (length dir) |
588 |
completion-ignore-case))) |
completion-ignore-case))) |
589 |
(setq found-p t) |
(setq found-p t) |
590 |
(setq buffers (append buffers (cdr item))) ;nconc is faster than append |
(setq buffers (append buffers (cdr item))) ;nconc is faster than append |
594 |
((> (length buffers) max-clumped-together) |
((> (length buffers) max-clumped-together) |
595 |
;; Oh, we failed. Too many buffers clumped together. |
;; Oh, we failed. Too many buffers clumped together. |
596 |
;; Just use the original ones for the result. |
;; Just use the original ones for the result. |
597 |
(setq last-path (car first)) |
(setq last-dir (car first)) |
598 |
(push (cons (msb--format-title top-found-p |
(push (cons (msb--format-title top-found-p |
599 |
(car first) |
(car first) |
600 |
(length (cdr first))) |
(length (cdr first))) |
603 |
(setq top-found-p nil) |
(setq top-found-p nil) |
604 |
(setq first (car rest) |
(setq first (car rest) |
605 |
rest (cdr rest) |
rest (cdr rest) |
606 |
path (car first) |
dir (car first) |
607 |
buffers (cdr first))) |
buffers (cdr first))) |
608 |
(t |
(t |
609 |
;; The first pass of clumping together worked out, go ahead |
;; The first pass of clumping together worked out, go ahead |
610 |
;; with this result. |
;; with this result. |
611 |
(when found-p |
(when found-p |
612 |
(setq top-found-p t) |
(setq top-found-p t) |
613 |
(setq first (cons path buffers) |
(setq first (cons dir buffers) |
614 |
rest tmp-rest)) |
rest tmp-rest)) |
615 |
;; Now see if we can clump more buffers together if we go up |
;; Now see if we can clump more buffers together if we go up |
616 |
;; one step in the file hierarchy. |
;; one step in the file hierarchy. |
617 |
;; If path isn't changed by msb--strip-dir, we are looking |
;; If dir isn't changed by msb--strip-dir, we are looking |
618 |
;; at the machine name component of an ange-ftp filename. |
;; at the machine name component of an ange-ftp filename. |
619 |
(setq old-path path) |
(setq old-dir dir) |
620 |
(setq path (msb--strip-dir path) |
(setq dir (msb--strip-dir dir) |
621 |
buffers (cdr first)) |
buffers (cdr first)) |
622 |
(if (equal old-path path) |
(if (equal old-dir dir) |
623 |
(setq last-path path)) |
(setq last-dir dir)) |
624 |
(when (and last-path |
(when (and last-dir |
625 |
(or (and (>= (length path) (length last-path)) |
(or (and (>= (length dir) (length last-dir)) |
626 |
(eq t (compare-strings |
(eq t (compare-strings |
627 |
last-path 0 nil path 0 |
last-dir 0 nil dir 0 |
628 |
(length last-path) |
(length last-dir) |
629 |
completion-ignore-case))) |
completion-ignore-case))) |
630 |
(and (< (length path) (length last-path)) |
(and (< (length dir) (length last-dir)) |
631 |
(eq t (compare-strings |
(eq t (compare-strings |
632 |
path 0 nil last-path 0 (length path) |
dir 0 nil last-dir 0 (length dir) |
633 |
completion-ignore-case))))) |
completion-ignore-case))))) |
634 |
;; We have reached the same place in the file hierarchy as |
;; We have reached the same place in the file hierarchy as |
635 |
;; the last result, so we should quit at this point and |
;; the last result, so we should quit at this point and |
642 |
(setq top-found-p nil) |
(setq top-found-p nil) |
643 |
(setq first (car rest) |
(setq first (car rest) |
644 |
rest (cdr rest) |
rest (cdr rest) |
645 |
path (car first) |
dir (car first) |
646 |
buffers (cdr first))))))) |
buffers (cdr first))))))) |
647 |
;; Now take care of the last item. |
;; Now take care of the last item. |
648 |
(when first |
(when first |
729 |
max-buffer-name-length) |
max-buffer-name-length) |
730 |
buffer) |
buffer) |
731 |
(eval list-symbol))))) |
(eval list-symbol))))) |
732 |
|
|
733 |
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) |
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length) |
734 |
"Select the appropriate menu for BUFFER." |
"Select the appropriate menu for BUFFER." |
735 |
;; This is all side-effects, folks! |
;; This is all side-effects, folks! |
1132 |
;; C-down-mouse-1). |
;; C-down-mouse-1). |
1133 |
(defvar msb-mode-map |
(defvar msb-mode-map |
1134 |
(let ((map (make-sparse-keymap "Msb"))) |
(let ((map (make-sparse-keymap "Msb"))) |
1135 |
(substitute-key-definition 'mouse-buffer-menu 'msb map global-map) |
(define-key map [remap mouse-buffer-menu] 'msb) |
1136 |
map)) |
map)) |
1137 |
|
|
1138 |
;;;###autoload |
;;;###autoload |