HCoop
/
bpt
/
emacs.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Revision: miles@gnu.org--gnu-2005/emacs--unicode--0--patch-31
[bpt/emacs.git]
/
lisp
/
msb.el
diff --git
a/lisp/msb.el
b/lisp/msb.el
index
907bbbf
..
2ab7fe5
100644
(file)
--- a/
lisp/msb.el
+++ b/
lisp/msb.el
@@
-1,6
+1,6
@@
;;; msb.el --- customizable buffer-selection with multiple menus
;;; msb.el --- customizable buffer-selection with multiple menus
-;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001
+;; Copyright (C) 1993, 94, 95, 97, 98, 99, 2000, 2001
, 2003
;; Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
;; Free Software Foundation, Inc.
;; Author: Lars Lindberg <lars.lindberg@home.se>
@@
-41,11
+41,11
@@
;; There are some constants for you to try here:
;; msb--few-menus
;; msb--very-many-menus (default)
;; There are some constants for you to try here:
;; msb--few-menus
;; msb--very-many-menus (default)
-;;
+;;
;; Look at the variable `msb-item-handling-function' for customization
;; of the appearance of every menu item. Try for instance setting
;; it to `msb-alon-item-handler'.
;; Look at the variable `msb-item-handling-function' for customization
;; of the appearance of every menu item. Try for instance setting
;; it to `msb-alon-item-handler'.
-;;
+;;
;; Look at the variable `msb-item-sort-function' for customization
;; of sorting the menus. Set it to t for instance, which means no
;; sorting - you will get latest used buffer first.
;; Look at the variable `msb-item-sort-function' for customization
;; of sorting the menus. Set it to t for instance, which means no
;; sorting - you will get latest used buffer first.
@@
-320,7
+320,7
@@
No buffers at all if less than 1 or nil (or any non-number)."
:type 'string
:set 'msb-custom-set
:group 'msb)
:type 'string
:set 'msb-custom-set
:group 'msb)
-
+
(defvar msb-horizontal-shift-function '(lambda () 0)
"*Function that specifies how many pixels to shift the top menu leftwards.")
(defvar msb-horizontal-shift-function '(lambda () 0)
"*Function that specifies how many pixels to shift the top menu leftwards.")
@@
-362,7
+362,7
@@
Set this to nil or t if you don't want any sorting (faster)."
(const :tag "Oldest first" nil))
:set 'msb-custom-set
:group 'msb)
(const :tag "Oldest first" nil))
:set 'msb-custom-set
:group 'msb)
-
+
(defcustom msb-files-by-directory nil
"*Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
(defcustom msb-files-by-directory nil
"*Non-nil means that files should be sorted by directory.
This is instead of the groups in `msb-menu-cond'."
@@
-496,13
+496,13
@@
If the argument is left out or nil, then the current buffer is considered."
(file-name-directory (directory-file-name dir)))
;; Create an alist with all buffers from LIST that lies under the same
(file-name-directory (directory-file-name dir)))
;; Create an alist with all buffers from LIST that lies under the same
-;; directory will be in the same item as the directory
string
.
-;; ((
PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH
2 . (BUFFER-K BUFFER-K+1...)) ...)
+;; directory will be in the same item as the directory
name
.
+;; ((
DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR
2 . (BUFFER-K BUFFER-K+1...)) ...)
(defun msb--init-file-alist (list)
(let ((buffer-alist
;; Make alist that looks like
(defun msb--init-file-alist (list)
(let ((buffer-alist
;; Make alist that looks like
- ;; ((
PATH-1 BUFFER-1) (PATH
-2 BUFFER-2) ...)
- ;; sorted on
PATH
-x
+ ;; ((
DIR-1 BUFFER-1) (DIR
-2 BUFFER-2) ...)
+ ;; sorted on
DIR
-x
(sort
(apply #'nconc
(mapcar
(sort
(apply #'nconc
(mapcar
@@
-514,37
+514,37
@@
If the argument is left out or nil, then the current buffer is considered."
list))
(lambda (item1 item2)
(string< (car item1) (car item2))))))
list))
(lambda (item1 item2)
(string< (car item1) (car item2))))))
- ;; Now clump buffers together that have the same
path
+ ;; Now clump buffers together that have the same
directory name
;; Make alist that looks like
;; Make alist that looks like
- ;; ((
PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH
2 . (BUFFER-K)) ...)
- (let ((
path
nil)
+ ;; ((
DIR1 . (BUFFER-1 BUFFER-2 ...)) (DIR
2 . (BUFFER-K)) ...)
+ (let ((
dir
nil)
(buffers nil))
(nconc
(apply
#'nconc
(mapcar (lambda (item)
(cond
(buffers nil))
(nconc
(apply
#'nconc
(mapcar (lambda (item)
(cond
- ((equal
path
(car item))
- ;; The same
path as earlier: Add to current list of
- ;; buffers.
+ ((equal
dir
(car item))
+ ;; The same
dir as earlier:
+ ;;
Add to current list of
buffers.
(push (cdr item) buffers)
;; This item should not be added to list
nil)
(t
(push (cdr item) buffers)
;; This item should not be added to list
nil)
(t
- ;; New
path
- (let ((result (and
path (cons path
buffers))))
- (setq
path
(car item))
+ ;; New
dir
+ (let ((result (and
dir (cons dir
buffers))))
+ (setq
dir
(car item))
(setq buffers (list (cdr item)))
;; Add the last result the list.
(and result (list result))))))
buffer-alist))
;; Add the last result to the list
(setq buffers (list (cdr item)))
;; Add the last result the list.
(and result (list result))))))
buffer-alist))
;; Add the last result to the list
- (list (cons
path
buffers))))))
+ (list (cons
dir
buffers))))))
-(defun msb--format-title (top-found-p
path
number-of-items)
+(defun msb--format-title (top-found-p
dir
number-of-items)
"Format a suitable title for the menu item."
(format (if top-found-p "%s... (%d)" "%s (%d)")
"Format a suitable title for the menu item."
(format (if top-found-p "%s... (%d)" "%s (%d)")
- (abbreviate-file-name
path
) number-of-items))
+ (abbreviate-file-name
dir
) number-of-items))
;; Variables for debugging.
(defvar msb--choose-file-menu-list)
;; Variables for debugging.
(defvar msb--choose-file-menu-list)
@@
-559,32
+559,32
@@
If the argument is left out or nil, then the current buffer is considered."
msb-max-file-menu-items
10))
(top-found-p nil)
msb-max-file-menu-items
10))
(top-found-p nil)
- (last-
path
nil)
- first rest
path buffers old-path
)
+ (last-
dir
nil)
+ first rest
dir buffers old-dir
)
;; Prepare for looping over all items in buffer-alist
(setq first (car buffer-alist)
rest (cdr buffer-alist)
;; Prepare for looping over all items in buffer-alist
(setq first (car buffer-alist)
rest (cdr buffer-alist)
-
path
(car first)
+
dir
(car first)
buffers (cdr first))
(setq msb--choose-file-menu-list (copy-sequence rest))
;; This big loop tries to clump buffers together that have a
;; similar name. Remember that buffer-alist is sorted based on the
buffers (cdr first))
(setq msb--choose-file-menu-list (copy-sequence rest))
;; This big loop tries to clump buffers together that have a
;; similar name. Remember that buffer-alist is sorted based on the
- ;;
path for the buffer
s.
+ ;;
directory name of the buffers' visited file
s.
(while rest
(let ((found-p nil)
(tmp-rest rest)
result
(while rest
(let ((found-p nil)
(tmp-rest rest)
result
- new-
path
item)
+ new-
dir
item)
(setq item (car tmp-rest))
(setq item (car tmp-rest))
- ;; Clump together the "rest"-buffers that have a
path
that is
- ;; a sub
path
of the current one.
+ ;; Clump together the "rest"-buffers that have a
dir
that is
+ ;; a sub
dir
of the current one.
(while (and tmp-rest
(<= (length buffers) max-clumped-together)
(while (and tmp-rest
(<= (length buffers) max-clumped-together)
- (>= (length (car item)) (length
path
))
+ (>= (length (car item)) (length
dir
))
;; `completion-ignore-case' seems to default to t
;; on the systems with case-insensitive file names.
;; `completion-ignore-case' seems to default to t
;; on the systems with case-insensitive file names.
- (eq t (compare-strings
path
0 nil
- (car item) 0 (length
path
)
+ (eq t (compare-strings
dir
0 nil
+ (car item) 0 (length
dir
)
completion-ignore-case)))
(setq found-p t)
(setq buffers (append buffers (cdr item))) ;nconc is faster than append
completion-ignore-case)))
(setq found-p t)
(setq buffers (append buffers (cdr item))) ;nconc is faster than append
@@
-594,7
+594,7
@@
If the argument is left out or nil, then the current buffer is considered."
((> (length buffers) max-clumped-together)
;; Oh, we failed. Too many buffers clumped together.
;; Just use the original ones for the result.
((> (length buffers) max-clumped-together)
;; Oh, we failed. Too many buffers clumped together.
;; Just use the original ones for the result.
- (setq last-
path
(car first))
+ (setq last-
dir
(car first))
(push (cons (msb--format-title top-found-p
(car first)
(length (cdr first)))
(push (cons (msb--format-title top-found-p
(car first)
(length (cdr first)))
@@
-603,33
+603,33
@@
If the argument is left out or nil, then the current buffer is considered."
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
-
path
(car first)
+
dir
(car first)
buffers (cdr first)))
(t
;; The first pass of clumping together worked out, go ahead
;; with this result.
(when found-p
(setq top-found-p t)
buffers (cdr first)))
(t
;; The first pass of clumping together worked out, go ahead
;; with this result.
(when found-p
(setq top-found-p t)
- (setq first (cons
path
buffers)
+ (setq first (cons
dir
buffers)
rest tmp-rest))
;; Now see if we can clump more buffers together if we go up
;; one step in the file hierarchy.
rest tmp-rest))
;; Now see if we can clump more buffers together if we go up
;; one step in the file hierarchy.
- ;; If
path
isn't changed by msb--strip-dir, we are looking
+ ;; If
dir
isn't changed by msb--strip-dir, we are looking
;; at the machine name component of an ange-ftp filename.
;; at the machine name component of an ange-ftp filename.
- (setq old-
path path
)
- (setq
path (msb--strip-dir path
)
+ (setq old-
dir dir
)
+ (setq
dir (msb--strip-dir dir
)
buffers (cdr first))
buffers (cdr first))
- (if (equal old-
path path
)
- (setq last-
path path
))
- (when (and last-
path
- (or (and (>= (length
path) (length last-path
))
+ (if (equal old-
dir dir
)
+ (setq last-
dir dir
))
+ (when (and last-
dir
+ (or (and (>= (length
dir) (length last-dir
))
(eq t (compare-strings
(eq t (compare-strings
- last-
path 0 nil path
0
- (length last-
path
)
+ last-
dir 0 nil dir
0
+ (length last-
dir
)
completion-ignore-case)))
completion-ignore-case)))
- (and (< (length
path) (length last-path
))
+ (and (< (length
dir) (length last-dir
))
(eq t (compare-strings
(eq t (compare-strings
-
path 0 nil last-path 0 (length path
)
+
dir 0 nil last-dir 0 (length dir
)
completion-ignore-case)))))
;; We have reached the same place in the file hierarchy as
;; the last result, so we should quit at this point and
completion-ignore-case)))))
;; We have reached the same place in the file hierarchy as
;; the last result, so we should quit at this point and
@@
-642,7
+642,7
@@
If the argument is left out or nil, then the current buffer is considered."
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
(setq top-found-p nil)
(setq first (car rest)
rest (cdr rest)
-
path
(car first)
+
dir
(car first)
buffers (cdr first)))))))
;; Now take care of the last item.
(when first
buffers (cdr first)))))))
;; Now take care of the last item.
(when first
@@
-729,7
+729,7
@@
to the buffer-list variable in function-info."
max-buffer-name-length)
buffer)
(eval list-symbol)))))
max-buffer-name-length)
buffer)
(eval list-symbol)))))
-
+
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
;; This is all side-effects, folks!
(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
"Select the appropriate menu for BUFFER."
;; This is all side-effects, folks!
@@
-1114,9
+1114,8
@@
variable `msb-menu-cond'."
(mapcar
(lambda (frame)
(nconc
(mapcar
(lambda (frame)
(nconc
- (list frame
- (cdr (assq 'name
- (frame-parameters frame)))
+ (list (frame-parameter frame 'name)
+ (frame-parameter frame 'name)
(cons nil nil))
'menu-bar-select-frame))
frames)))))
(cons nil nil))
'menu-bar-select-frame))
frames)))))
@@
-1133,7
+1132,7
@@
variable `msb-menu-cond'."
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
;; C-down-mouse-1).
(defvar msb-mode-map
(let ((map (make-sparse-keymap "Msb")))
- (
substitute-key-definition 'mouse-buffer-menu 'msb map global-map
)
+ (
define-key map [remap mouse-buffer-menu] 'msb
)
map))
;;;###autoload
map))
;;;###autoload
@@
-1154,8
+1153,10
@@
different buffer menu using the function `msb'."
(defun msb-unload-hook ()
(msb-mode 0))
(defun msb-unload-hook ()
(msb-mode 0))
+(add-hook 'msb-unload-hook 'msb-unload-hook)
(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
(provide 'msb)
(eval-after-load "msb" '(run-hooks 'msb-after-load-hook 'msb-after-load-hooks))
+;;; arch-tag: 403f9e82-b92e-4e7a-a797-5d6d9b76da36
;;; msb.el ends here
;;; msb.el ends here