Lines Matching +refs:bs +refs:next +refs:buffer
0 ;;; bs.el --- menu for selecting and displaying buffers
31 ;; The bs-package contains a main function bs-show for poping up a
32 ;; buffer in a way similar to `list-buffers' and `electric-buffer-list':
33 ;; The new buffer offers a Buffer Selection Menu for manipulating
34 ;; the buffer list and buffers.
39 ;; |. bs.el 14690 Emacs-Lisp /home/sun/sylvester/el/bs.e$|
49 ;; M-x bs-show
50 ;; for buffer selection or optional bind a key to main function `bs-show'
51 ;; (global-set-key "\C-x\C-b" 'bs-show) ;; or another key
54 ;; M-x bs-customize
59 ;; bs-show will generate a new buffer named *buffer-selection*, which shows
62 ;; function `bs-mode'. A current configuration describes which buffers appear
63 ;; in *buffer-selection*. See docstring of variable `bs-configurations' for
66 ;; The package bs combines the advantages of the Emacs functions
67 ;; `list-buffers' and `electric-buffer-list'.
74 ;; - goes to top of buffer list if you are on last line and press down.
75 ;; - goes to end of buffer list if you are on first line and press up.
76 ;; - Offer an alternative buffer list by prefix key C-u.
80 ;; This package offers two functions for buffer cycling. If you want to cycle
81 ;; through buffer list you can use `bs-cycle-next' or `bs-cycle-previous'.
83 ;; (global-set-key [(f9)] 'bs-cycle-previous)
84 ;; (global-set-key [(f10)] 'bs-cycle-next)
90 ;; the logical buffer list. If buffer list is sorted by size you
91 ;; won't be able to cycle to the smallest buffer.
95 ;; There is a customization group called `bs' in group `convenience'.
96 ;; Start customization by M-x bs-customize
101 ;; `bs-configurations' (see docstring for details).
103 ;; `bs-default-configuration' contains the name of default configuration.
107 ;; `bs-default-configuration' in customization group `bs'.
111 ;; You can define functions for sorting the buffer list.
114 ;; To define a new way of sorting, customize variable `bs-sort-functions'.
117 ;; by buffer name, by mode, by size, or by filename
119 ;; Configure buffer cycling
121 ;; When cycling through buffer list the functions for cycling will use
122 ;; the current configuration of bs to calculate the buffer list.
124 ;; the variable `bs-cycle-configuration-name'. You can customize this variable.
128 ;; configuration perhaps is "files" which ignores buffer *scratch*.
140 (defgroup bs nil
141 "Buffer Selection: Maintaining buffers by buffer menu."
143 :link '(emacs-commentary-link "bs")
147 (defgroup bs-appearance nil
148 "Buffer Selection appearance: Appearance of bs buffer menu."
149 :group 'bs)
151 (defcustom bs-attributes-list
152 '(("" 1 1 left bs--get-marked-string)
153 ("M" 1 1 left bs--get-modified-string)
154 ("R" 2 2 left bs--get-readonly-string)
155 ("Buffer" bs--get-name-length 10 left bs--get-name)
157 ("Size" 8 8 right bs--get-size-string)
159 ("Mode" 12 12 right bs--get-mode-name)
161 ("File" 12 12 left bs--get-file-name)
163 "*List specifying the layout of a Buffer Selection Menu buffer.
177 The function gets as parameter the buffer where we have started
178 buffer selection and the list of all buffers to show. The function must
180 :group 'bs-appearance
183 (defun bs--make-header-match-string ()
184 "Return a regexp matching the first line of a Buffer Selection Menu buffer."
186 (ele bs-attributes-list))
193 (defvar bs-mode-font-lock-keywords
195 (list (bs--make-header-match-string)
210 (defcustom bs-max-window-height 20
212 :group 'bs-appearance
215 (defvar bs-dont-show-regexp nil
217 A buffer whose name matches this regular expression will not be
218 included in the buffer list.")
220 (defvar bs-must-show-regexp nil
222 A buffer whose name matches this regular expression will be
223 included in the buffer list.
225 it is reset to nil. Use `bs-must-always-show-regexp' to specify buffers
228 (defcustom bs-must-always-show-regexp nil
230 A buffer whose name matches this regular expression will
232 :group 'bs
235 (defvar bs-dont-show-function nil
237 The function gets one argument - the buffer to test. The function must
238 return a value different from nil to ignore the buffer in
241 (defvar bs-must-show-function nil
243 The function gets one argument - the buffer to test.")
245 (defvar bs-buffer-sort-function nil
249 (defcustom bs-maximal-buffer-name-column 45
250 "*Maximum column width for buffer names.
251 The column for buffer names has dynamic width. The width depends on
253 width is bounded by `bs-maximal-buffer-name-column'.
254 See also `bs-minimal-buffer-name-column'."
255 :group 'bs-appearance
258 (defcustom bs-minimal-buffer-name-column 15
259 "*Minimum column width for buffer names.
260 The column for buffer names has dynamic width. The width depends on
262 width is bounded by `bs-minimal-buffer-name-column'.
263 See also `bs-maximal-buffer-name-column'."
264 :group 'bs-appearance
267 (defconst bs-header-lines-length 2
270 (defcustom bs-configurations
272 ("files" nil nil nil bs-visits-non-file bs-sort-buffer-interns-are-last)
273 ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file
274 bs-sort-buffer-interns-are-last)
275 ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last))
281 configuration variables `bs-must-show-regexp', `bs-must-show-function',
282 `bs-dont-show-regexp', `bs-dont-show-function' and `bs-buffer-sort-function'.
284 :group 'bs-appearance
287 (defcustom bs-default-configuration "files"
289 \\<bs-mode-map>
290 Will be changed using key \\[bs-select-next-configuration].
291 Must be a string used in `bs-configurations' for naming a configuration."
292 :group 'bs
295 (defcustom bs-alternative-configuration "all"
296 "*Name of configuration used when calling `bs-show' with \
298 Must be a string used in `bs-configurations' for naming a configuration."
299 :group 'bs
302 (defvar bs-current-configuration bs-default-configuration
304 Must be a string used in `bs-configurations' for naming a configuration.")
306 (defcustom bs-cycle-configuration-name nil
307 "*Name of configuration used when cycling through the buffer list.
308 A value of nil means to use current configuration `bs-default-configuration'.
309 Must be a string used in `bs-configurations' for naming a configuration."
310 :group 'bs
314 (defcustom bs-string-show-always "+"
315 "*String added in column 1 indicating a buffer will always be shown."
316 :group 'bs-appearance
319 (defcustom bs-string-show-never "-"
320 "*String added in column 1 indicating a buffer will never be shown."
321 :group 'bs-appearance
324 (defcustom bs-string-current "."
325 "*String added in column 1 indicating the current buffer."
326 :group 'bs-appearance
329 (defcustom bs-string-current-marked "#"
330 "*String added in column 1 indicating the current buffer when it is marked."
331 :group 'bs-appearance
334 (defcustom bs-string-marked ">"
335 "*String added in column 1 indicating a marked buffer."
336 :group 'bs-appearance
339 (defcustom bs-string-show-normally " "
340 "*String added in column 1 indicating a unmarked buffer."
341 :group 'bs-appearance
344 (defvar bs--name-entry-length 20
345 "Maximum length of all displayed buffer names.
352 (defvar bs-buffer-show-mark nil
353 "Flag for the current mode for showing this buffer.
354 A value of nil means buffer will be shown depending on the current
356 A value of `never' means to never show the buffer.
357 A value of `always' means to show buffer regardless of the configuration.")
359 (make-variable-buffer-local 'bs-buffer-show-mark)
366 (defun bs--sort-by-name (b1 b2)
367 "Compare buffers B1 and B2 by buffer name."
368 (string< (buffer-name b1)
369 (buffer-name b2)))
371 (defun bs--sort-by-filename (b1 b2)
373 (string< (or (buffer-file-name b1) "")
374 (or (buffer-file-name b2) "")))
376 (defun bs--sort-by-mode (b1 b2)
379 (string< (progn (set-buffer b1) (format "%s" mode-name))
380 (progn (set-buffer b2) (format "%s" mode-name)))))
382 (defun bs--sort-by-size (b1 b2)
383 "Compare buffers B1 and B2 by buffer size."
385 (< (progn (set-buffer b1) (buffer-size))
386 (progn (set-buffer b2) (buffer-size)))))
388 (defcustom bs-sort-functions
389 '(("by name" bs--sort-by-name "Buffer" region)
390 ("by size" bs--sort-by-size "Size" region)
391 ("by mode" bs--sort-by-mode "Mode" region)
392 ("by filename" bs--sort-by-filename "File" region)
395 You can add a new entry with a call to `bs-define-sort-function'.
398 FUNCTION nil means don't sort the buffer list. Otherwise the functions
404 :group 'bs
407 (defun bs-define-sort-function (name fun &optional regexp-for-sorting face)
408 "Define a new function for buffer sorting in Buffer Selection Menu.
410 A value of nil for FUN means don't sort the buffer list. Otherwise the
416 The new sort aspect will be inserted into list `bs-sort-functions'."
417 (let ((tupel (assoc name bs-sort-functions)))
420 (setq bs-sort-functions
422 bs-sort-functions)))))
424 (defvar bs--current-sort-function nil
425 "Description of the current function for sorting the buffer list.
426 This is an element of `bs-sort-functions'.")
428 (defcustom bs-default-sort-name "by nothing"
430 Must be \"by nothing\" or a string used in `bs-sort-functions' for
432 :group 'bs
436 (setq bs--current-sort-function
437 (assoc value bs-sort-functions))))
439 (defvar bs--buffer-coming-from nil
440 "The buffer in which the user started the current Buffer Selection Menu.")
442 (defvar bs--show-all nil
445 defined by current configuration `bs-current-configuration'.")
447 (defvar bs--window-config-coming-from nil
449 (make-variable-frame-local 'bs--window-config-coming-from)
451 (defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*"
453 A buffer whose name matches this regular expression will never be
454 included in the buffer list.")
456 (defvar bs-current-list nil
460 (defvar bs--marked-buffers nil
463 (defvar bs-mode-map
465 (define-key map " " 'bs-select)
466 (define-key map "f" 'bs-select)
467 (define-key map "v" 'bs-view)
468 (define-key map "!" 'bs-select-in-one-window)
469 (define-key map [mouse-2] 'bs-mouse-select) ;; for GNU EMACS
470 (define-key map [button2] 'bs-mouse-select) ;; for XEmacs
471 (define-key map "F" 'bs-select-other-frame)
478 (define-key map "o" 'bs-select-other-window)
479 (define-key map "\C-o" 'bs-tmp-select-other-window)
481 (define-key map [mouse-3] 'bs-mouse-select-other-frame)
483 (define-key map [button3] 'bs-mouse-select-other-frame)
484 (define-key map [up] 'bs-up)
485 (define-key map "n" 'bs-down)
486 (define-key map "p" 'bs-up)
487 (define-key map [down] 'bs-down)
488 (define-key map "\C-m" 'bs-select)
489 (define-key map "b" 'bs-bury-buffer)
490 (define-key map "s" 'bs-save)
491 (define-key map "S" 'bs-show-sorted)
492 (define-key map "a" 'bs-toggle-show-all)
493 (define-key map "d" 'bs-delete)
494 (define-key map "\C-d" 'bs-delete-backward)
495 (define-key map "k" 'bs-delete)
496 (define-key map "g" 'bs-refresh)
497 (define-key map "C" 'bs-set-configuration-and-refresh)
498 (define-key map "c" 'bs-select-next-configuration)
499 (define-key map "q" 'bs-kill)
500 ;; (define-key map "z" 'bs-kill)
501 (define-key map "\C-c\C-c" 'bs-kill)
502 (define-key map "\C-g" 'bs-abort)
503 (define-key map "\C-]" 'bs-abort)
504 (define-key map "%" 'bs-toggle-readonly)
505 (define-key map "~" 'bs-clear-modified)
506 (define-key map "M" 'bs-toggle-current-to-show)
507 (define-key map "+" 'bs-set-current-buffer-to-show-always)
508 ;;(define-key map "-" 'bs-set-current-buffer-to-show-never)
509 (define-key map "t" 'bs-visit-tags-table)
510 (define-key map "m" 'bs-mark-current)
511 (define-key map "u" 'bs-unmark-current)
514 (define-key map "?" 'bs-help)
516 "Keymap of `bs-mode'.")
522 (defun bs-buffer-list (&optional list sort-description)
525 The result list depends on the global variables `bs-dont-show-regexp',
526 `bs-must-show-regexp', `bs-dont-show-function', `bs-must-show-function'
527 and `bs-buffer-sort-function'.
529 a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'."
530 (setq sort-description (or sort-description bs--current-sort-function)
531 list (or list (buffer-list)))
534 (let* ((buffername (buffer-name (car list)))
535 (int-show-never (string-match bs--intern-show-never buffername))
536 (ext-show-never (and bs-dont-show-regexp
537 (string-match bs-dont-show-regexp
539 (extern-must-show (or (and bs-must-always-show-regexp
541 bs-must-always-show-regexp
543 (and bs-must-show-regexp
544 (string-match bs-must-show-regexp
546 (extern-show-never-from-fun (and bs-dont-show-function
547 (funcall bs-dont-show-function
549 (extern-must-show-from-fun (and bs-must-show-function
550 (funcall bs-must-show-function
552 (show-flag (buffer-local-value 'bs-buffer-show-mark (car list))))
554 (and (or bs--show-all (not (eq show-flag 'never)))
556 (or bs--show-all
565 ;; The current buffer which was the start point of bs should be an element
567 ;; buffer we started bs-show.
568 (if (and bs--buffer-coming-from
569 (buffer-live-p bs--buffer-coming-from)
570 (not (memq bs--buffer-coming-from result)))
571 (setq result (cons bs--buffer-coming-from result)))
577 (bs-buffer-sort result))))
579 (defun bs-buffer-sort (buffer-list)
580 "Sort buffers in BUFFER-LIST according to `bs-buffer-sort-function'."
581 (if bs-buffer-sort-function
582 (sort buffer-list bs-buffer-sort-function)
583 buffer-list))
585 (defun bs--redisplay (&optional keep-line-p sort-description)
588 SORT-DESCRIPTION is an element of `bs-sort-functions'."
590 (bs-show-in-buffer (bs-buffer-list nil sort-description))
595 (defun bs--goto-current-buffer ()
596 "Goto line which represents the current buffer;
597 actually the line which begins with character in `bs-string-current' or
598 `bs-string-current-marked'."
600 (regexp-quote bs-string-current)
602 (regexp-quote bs-string-current-marked)))
611 (defun bs--current-config-message ()
612 "Return a string describing the current `bs-mode' configuration."
613 (if bs--show-all
615 (format "Show buffer by configuration %S"
616 bs-current-configuration)))
618 (defun bs-mode ()
620 \\<bs-mode-map>
621 Aside from two header lines each line describes one buffer.
622 Move to a line representing the buffer you want to edit and select
623 buffer by \\[bs-select] or SPC. Abort buffer list with \\[bs-kill].
625 manipulating the buffer list and buffers.
628 \\[bs-select] or SPACE -- select current line's buffer and other marked buffers.
629 \\[bs-toggle-show-all] -- toggle between all buffers and a special subset.
630 \\[bs-select-other-window] -- select current line's buffer in other window.
631 \\[bs-tmp-select-other-window] -- make another window display that buffer and
633 \\[bs-mouse-select] -- select current line's buffer and other marked buffers.
634 \\[bs-save] -- save current line's buffer immediately.
635 \\[bs-delete] -- kill current line's buffer immediately.
636 \\[bs-toggle-readonly] -- toggle read-only status of current line's buffer.
637 \\[bs-clear-modified] -- clear modified-flag on that buffer.
638 \\[bs-mark-current] -- mark current line's buffer to be displayed.
639 \\[bs-unmark-current] -- unmark current line's buffer to be displayed.
640 \\[bs-show-sorted] -- display buffer list sorted by next sort aspect.
641 \\[bs-set-configuration-and-refresh] -- ask user for a configuration and \
643 \\[bs-select-next-configuration] -- select and apply next \
645 \\[bs-kill] -- leave Buffer Selection Menu without a selection.
646 \\[bs-toggle-current-to-show] -- toggle status of appearance.
647 \\[bs-set-current-buffer-to-show-always] -- mark current line's buffer \
649 \\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer.
650 \\[bs-help] -- display this help text."
653 (use-local-map bs-mode-map)
656 (buffer-disable-undo)
657 (setq major-mode 'bs-mode
659 buffer-read-only t
661 font-lock-defaults '(bs-mode-font-lock-keywords t)
663 (run-mode-hooks 'bs-mode-hook))
665 (defun bs--restore-window-config ()
667 (when bs--window-config-coming-from
668 (set-window-configuration bs--window-config-coming-from)
669 (setq bs--window-config-coming-from nil)))
671 (defun bs-kill ()
672 "Let buffer disappear and reset window-configuration."
674 (bury-buffer (current-buffer))
675 (bs--restore-window-config))
677 (defun bs-abort ()
681 (bs-kill))
683 (defun bs-set-configuration-and-refresh ()
687 (call-interactively 'bs-set-configuration)
688 (bs--redisplay t))
690 (defun bs-refresh ()
693 (bs--redisplay t))
695 (defun bs--set-window-height ()
696 "Change the height of the selected window to suit the current buffer list."
698 (fit-window-to-buffer (selected-window) bs-max-window-height)))
700 (defun bs--current-buffer ()
701 "Return buffer on current line.
702 Raise an error if not on a buffer line."
704 (let ((line (+ (- bs-header-lines-length)
708 (nth line bs-current-list)))
710 (defun bs--update-current-line ()
712 (let ((buffer (bs--current-buffer))
716 (bs--insert-one-entry buffer)
719 (defun bs-view ()
720 "View current line's buffer in View mode.
723 (view-buffer (bs--current-buffer)))
725 (defun bs-select ()
726 "Select current line's buffer and other marked buffers.
729 If there are marked buffers each marked buffer and the current line's buffer
733 (let ((buffer (bs--current-buffer)))
734 (bury-buffer (current-buffer))
735 (bs--restore-window-config)
736 (switch-to-buffer buffer)
737 (if bs--marked-buffers
739 (let* ((all (delq buffer bs--marked-buffers))
742 (switch-to-buffer buffer)
746 (switch-to-buffer (car all))
748 ;; goto window we have started bs.
751 (defun bs-select-other-window ()
752 "Select current line's buffer by `switch-to-buffer-other-window'.
757 (let ((buffer (bs--current-buffer)))
758 (bury-buffer (current-buffer))
759 (bs--restore-window-config)
760 (switch-to-buffer-other-window buffer)))
762 (defun bs-tmp-select-other-window ()
763 "Make the other window select this line's buffer.
766 (let ((buffer (bs--current-buffer)))
767 (display-buffer buffer t)))
769 (defun bs-select-other-frame ()
770 "Select current line's buffer in new created frame.
773 (let ((buffer (bs--current-buffer)))
774 (bury-buffer (current-buffer))
775 (bs--restore-window-config)
776 (switch-to-buffer-other-frame buffer)))
778 (defun bs-mouse-select-other-frame (event)
779 "Select selected line's buffer in new created frame.
784 (bs-select-other-frame))
786 (defun bs-mouse-select (event)
787 "Select buffer on mouse click EVENT.
788 Select buffer by `bs-select'."
791 (bs-select))
793 (defun bs-select-in-one-window ()
794 "Select current line's buffer in one window and delete other windows.
797 (bs-select)
800 (defun bs-bury-buffer ()
801 "Bury buffer on current line."
803 (bury-buffer (bs--current-buffer))
804 (bs--redisplay t))
806 (defun bs-save ()
807 "Save buffer on current line."
809 (let ((buffer (bs--current-buffer)))
811 (set-buffer buffer)
812 (save-buffer))
813 (bs--update-current-line)))
815 (defun bs-visit-tags-table ()
816 "Visit the tags table in the buffer on this line.
819 (let ((file (buffer-file-name (bs--current-buffer))))
822 (error "Specified buffer has no file"))))
824 (defun bs-toggle-current-to-show ()
825 "Toggle status of showing flag for buffer in current line."
827 (let ((buffer (bs--current-buffer))
830 (set-buffer buffer)
831 (setq res (cond ((null bs-buffer-show-mark)
833 ((eq bs-buffer-show-mark 'never)
836 (setq bs-buffer-show-mark res))
837 (bs--update-current-line)
838 (bs--set-window-height)
839 (bs--show-config-message res)))
841 (defun bs-set-current-buffer-to-show-always (&optional not-to-show-p)
842 "Toggle status of buffer on line to `always shown'.
844 With no prefix argument the buffer on current line is marked to show
848 (bs-set-current-buffer-to-show-never)
849 (bs--set-toggle-to-show (bs--current-buffer) 'always)))
851 (defun bs-set-current-buffer-to-show-never ()
852 "Toggle status of buffer on line to `never shown'."
854 (bs--set-toggle-to-show (bs--current-buffer) 'never))
856 (defun bs--set-toggle-to-show (buffer what)
857 "Set value `bs-buffer-show-mark' of buffer BUFFER to WHAT.
859 the status of buffer on current line."
860 (with-current-buffer buffer (setq bs-buffer-show-mark what))
861 (bs--update-current-line)
862 (bs--set-window-height)
863 (bs--show-config-message what))
865 (defun bs-mark-current (count)
873 (let ((buffer (bs--current-buffer)))
874 (if buffer
875 (setq bs--marked-buffers (cons buffer bs--marked-buffers)))
876 (bs--update-current-line)
877 (bs-down dir))
880 (defun bs-unmark-current (count)
888 (let ((buffer (bs--current-buffer)))
889 (if buffer
890 (setq bs--marked-buffers (delq buffer bs--marked-buffers)))
891 (bs--update-current-line)
892 (bs-down dir))
895 (defun bs--show-config-message (what)
898 (bs-message-without-log (cond ((null what)
901 "Mark buffer to never be shown.")
902 (t "Mark buffer to show always."))))
904 (defun bs-delete ()
905 "Kill buffer on current line."
907 (let ((current (bs--current-buffer))
909 (unless (kill-buffer current)
911 (setq bs-current-list (delq current bs-current-list))
921 (bs--set-window-height)))
923 (defun bs-delete-backward ()
924 "Like `bs-delete' but go to buffer in front of current."
927 (bs-delete)
929 (bs-up 1))))
931 (defun bs-show-sorted ()
932 "Show buffer list sorted by buffer name."
934 (setq bs--current-sort-function
935 (bs-next-config-aux (car bs--current-sort-function)
936 bs-sort-functions))
937 (bs--redisplay)
938 (bs--goto-current-buffer)
939 (bs-message-without-log "Sorted %s" (car bs--current-sort-function)))
941 (defun bs-apply-sort-faces (&optional sort-description)
943 SORT-DESCRIPTION is an element of `bs-sort-functions'.
944 Default is `bs--current-sort-function'."
946 bs--current-sort-function)))
958 (defun bs-toggle-show-all ()
961 (setq bs--show-all (not bs--show-all))
962 (bs--redisplay)
963 (bs--goto-current-buffer)
964 (bs-message-without-log "%s" (bs--current-config-message)))
966 (defun bs-toggle-readonly ()
967 "Toggle read-only status for buffer on current line.
970 (let ((buffer (bs--current-buffer)))
972 (set-buffer buffer)
974 (bs--update-current-line)))
976 (defun bs-clear-modified ()
977 "Set modified flag for buffer on current line to nil."
979 (let ((buffer (bs--current-buffer)))
981 (set-buffer buffer)
982 (set-buffer-modified-p nil)))
983 (bs--update-current-line))
985 (defun bs--nth-wrapper (count fun &rest args)
992 (defun bs-up (arg)
996 (bs--nth-wrapper (- arg) 'bs--down)
997 (bs--nth-wrapper arg 'bs--up)))
999 (defun bs--up ()
1001 If on top of buffer list go to last line."
1002 (if (> (count-lines 1 (point)) bs-header-lines-length)
1008 (defun bs-down (arg)
1012 (bs--nth-wrapper (- arg) 'bs--up)
1013 (bs--nth-wrapper arg 'bs--down)))
1015 (defun bs--down ()
1017 If at end of buffer list go to first line."
1019 (goto-line (1+ bs-header-lines-length))
1022 (defun bs-visits-non-file (buffer)
1026 (not (buffer-file-name buffer)))
1028 (defun bs-sort-buffer-interns-are-last (b1 b2)
1030 (string-match "^\\*" (buffer-name b2)))
1036 (defun bs-config-clear ()
1038 These variables are `bs-dont-show-regexp', `bs-must-show-regexp',
1039 `bs-dont-show-function', `bs-must-show-function' and
1040 `bs-buffer-sort-function'."
1041 (setq bs-dont-show-regexp nil
1042 bs-must-show-regexp nil
1043 bs-dont-show-function nil
1044 bs-must-show-function nil
1045 bs-buffer-sort-function nil))
1047 (defun bs-config--only-files ()
1049 (bs-config-clear)
1051 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last
1053 bs-dont-show-function 'bs-visits-non-file))
1055 (defun bs-config--files-and-scratch ()
1056 "Define a configuration for showing buffer *scratch* and file buffers."
1057 (bs-config-clear)
1059 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last
1061 bs-dont-show-function 'bs-visits-non-file
1062 ;; Show *scratch* buffer.
1063 bs-must-show-regexp "^\\*scratch\\*$"))
1065 (defun bs-config--all ()
1067 Reset all according variables by `bs-config-clear'."
1068 (bs-config-clear))
1070 (defun bs-config--all-intern-last ()
1073 (bs-config-clear)
1075 (setq bs-buffer-sort-function 'bs-sort-buffer-interns-are-last))
1077 (defun bs-set-configuration (name)
1078 "Set configuration to the one saved under string NAME in `bs-configurations'.
1082 bs-configurations
1085 (let ((list (assoc name bs-configurations)))
1088 (setq bs-current-configuration name
1089 bs-must-show-regexp (nth 1 list)
1090 bs-must-show-function (nth 2 list)
1091 bs-dont-show-regexp (nth 3 list)
1092 bs-dont-show-function (nth 4 list)
1093 bs-buffer-sort-function (nth 5 list))
1098 (bs-message-without-log "No bs-configuration named %S." name))))
1100 (defun bs-help ()
1101 "Help for `bs-show'."
1103 (describe-function 'bs-mode))
1105 (defun bs-next-config-aux (start-name list)
1106 "Get the next assoc after START-NAME in list LIST.
1120 (defun bs-next-config (name)
1121 "Return next configuration with respect to configuration with name NAME."
1122 (bs-next-config-aux name bs-configurations))
1124 (defun bs-select-next-configuration (&optional start-name)
1125 "Apply next configuration START-NAME and refresh buffer list.
1126 If START-NAME is nil the current configuration `bs-current-configuration'
1129 (let ((config (bs-next-config (or start-name bs-current-configuration))))
1130 (bs-set-configuration (car config))
1131 (setq bs-default-configuration bs-current-configuration)
1132 (bs--redisplay t)
1133 (bs--set-window-height)
1134 (bs-message-without-log "Selected configuration: %s" (car config))))
1136 (defun bs-show-in-buffer (list)
1137 "Display buffer list LIST in buffer *buffer-selection*.
1138 Select buffer *buffer-selection* and display buffers according to current
1139 configuration `bs-current-configuration'. Set window height, fontify buffer
1140 and move point to current buffer."
1141 (setq bs-current-list list)
1142 (switch-to-buffer (get-buffer-create "*buffer-selection*"))
1143 (bs-mode)
1146 (length (buffer-name entry))))
1149 (name-entry-length (min bs-maximal-buffer-name-column
1150 (max bs-minimal-buffer-name-column
1152 (erase-buffer)
1153 (setq bs--name-entry-length name-entry-length)
1154 (bs--show-header)
1156 (bs--insert-one-entry (car list))
1160 (bs--set-window-height)
1161 (bs--goto-current-buffer)
1162 (font-lock-fontify-buffer)
1163 (bs-apply-sort-faces)
1164 (set-buffer-modified-p nil)))
1166 (defun bs-next-buffer (&optional buffer-list sorting-p)
1167 "Return next buffer and buffer list for buffer cycling in BUFFER-LIST.
1169 If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as
1170 buffer list. The result is a cons of normally the second element of
1171 BUFFER-LIST and the buffer list used for buffer cycling."
1172 (let* ((bs--current-sort-function (if sorting-p
1173 bs--current-sort-function))
1174 (bs-buffer-list (or buffer-list (bs-buffer-list))))
1175 (cons (or (car (cdr bs-buffer-list))
1176 (car bs-buffer-list)
1177 (current-buffer))
1178 bs-buffer-list)))
1180 (defun bs-previous-buffer (&optional buffer-list sorting-p)
1181 "Return previous buffer and buffer list for buffer cycling in BUFFER-LIST.
1183 If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as
1184 buffer list. The result is a cons of last element of BUFFER-LIST and the
1185 buffer list used for buffer cycling."
1186 (let* ((bs--current-sort-function (if sorting-p
1187 bs--current-sort-function))
1188 (bs-buffer-list (or buffer-list (bs-buffer-list))))
1189 (cons (or (car (last bs-buffer-list))
1190 (current-buffer))
1191 bs-buffer-list)))
1193 (defun bs-message-without-log (&rest args)
1199 (defvar bs--cycle-list nil
1200 "Current buffer list used for cycling.")
1203 (defun bs-cycle-next ()
1204 "Select next buffer defined by buffer cycling.
1205 The buffers taking part in buffer cycling are defined
1206 by buffer configuration `bs-cycle-configuration-name'."
1208 (let ((bs--buffer-coming-from (current-buffer))
1209 (bs-dont-show-regexp bs-dont-show-regexp)
1210 (bs-must-show-regexp bs-must-show-regexp)
1211 (bs-dont-show-function bs-dont-show-function)
1212 (bs-must-show-function bs-must-show-function)
1213 (bs--show-all nil))
1214 (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration))
1215 (let ((bs-buffer-sort-function nil)
1216 (bs--current-sort-function nil))
1217 (let* ((tupel (bs-next-buffer (if (or (eq last-command
1218 'bs-cycle-next)
1220 'bs-cycle-previous))
1221 bs--cycle-list)))
1222 (next (car tupel))
1224 (setq bs--cycle-list (append (cdr cycle-list)
1226 (bury-buffer)
1227 (switch-to-buffer next)
1228 (bs-message-without-log "Next buffers: %s"
1229 (or (cdr bs--cycle-list)
1230 "this buffer"))))))
1233 (defun bs-cycle-previous ()
1234 "Select previous buffer defined by buffer cycling.
1235 The buffers taking part in buffer cycling are defined
1236 by buffer configuration `bs-cycle-configuration-name'."
1238 (let ((bs--buffer-coming-from (current-buffer))
1239 (bs-dont-show-regexp bs-dont-show-regexp)
1240 (bs-must-show-regexp bs-must-show-regexp)
1241 (bs-dont-show-function bs-dont-show-function)
1242 (bs-must-show-function bs-must-show-function)
1243 (bs--show-all nil))
1244 (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration))
1245 (let ((bs-buffer-sort-function nil)
1246 (bs--current-sort-function nil))
1247 (let* ((tupel (bs-previous-buffer (if (or (eq last-command
1248 'bs-cycle-next)
1250 'bs-cycle-previous))
1251 bs--cycle-list)))
1252 (prev-buffer (car tupel))
1254 (setq bs--cycle-list (append (last cycle-list)
1256 (switch-to-buffer prev-buffer)
1257 (bs-message-without-log "Previous buffers: %s"
1258 (or (reverse (cdr bs--cycle-list))
1259 "this buffer"))))))
1261 (defun bs--get-value (fun &optional args)
1271 (defun bs--get-marked-string (start-buffer all-buffers)
1272 "Return a string which describes whether current buffer is marked.
1273 START-BUFFER is the buffer where we started buffer selection.
1274 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu.
1275 The result string is one of `bs-string-current', `bs-string-current-marked',
1276 `bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or
1277 `bs-string-show-always'."
1278 (cond ;; current buffer is the buffer we started buffer selection.
1279 ((eq (current-buffer) start-buffer)
1280 (if (memq (current-buffer) bs--marked-buffers)
1281 bs-string-current-marked ; buffer is marked
1282 bs-string-current))
1283 ;; current buffer is marked
1284 ((memq (current-buffer) bs--marked-buffers)
1285 bs-string-marked)
1286 ;; current buffer hasn't a special mark.
1287 ((null bs-buffer-show-mark)
1288 bs-string-show-normally)
1289 ;; current buffer has a mark not to show itself.
1290 ((eq bs-buffer-show-mark 'never)
1291 bs-string-show-never)
1292 ;; otherwise current buffer is marked to show always.
1294 bs-string-show-always)))
1296 (defun bs--get-modified-string (start-buffer all-buffers)
1297 "Return a string which describes whether current buffer is modified.
1298 START-BUFFER is the buffer where we started buffer selection.
1299 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1300 (if (buffer-modified-p) "*" " "))
1302 (defun bs--get-readonly-string (start-buffer all-buffers)
1303 "Return a string which describes whether current buffer is read only.
1304 START-BUFFER is the buffer where we started buffer selection.
1305 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1306 (if buffer-read-only "%" " "))
1308 (defun bs--get-size-string (start-buffer all-buffers)
1309 "Return a string which describes the size of current buffer.
1310 START-BUFFER is the buffer where we started buffer selection.
1311 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1312 (int-to-string (buffer-size)))
1314 (defun bs--get-name (start-buffer all-buffers)
1315 "Return name of current buffer for Buffer Selection Menu.
1316 The name of current buffer gets additional text properties
1318 START-BUFFER is the buffer where we started buffer selection.
1319 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1320 (propertize (buffer-name)
1321 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"
1324 (defun bs--get-mode-name (start-buffer all-buffers)
1325 "Return the name of mode of current buffer for Buffer Selection Menu.
1326 START-BUFFER is the buffer where we started buffer selection.
1327 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1330 (defun bs--get-file-name (start-buffer all-buffers)
1332 This is the variable `buffer-file-name' of current buffer.
1335 START-BUFFER is the buffer where we started buffer selection.
1336 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1339 (or buffer-file-name ""))
1341 'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"))
1343 (defun bs--insert-one-entry (buffer)
1344 "Generate one entry for buffer BUFFER in Buffer Selection Menu.
1345 It goes over all columns described in `bs-attributes-list'
1346 and evaluates corresponding string. Inserts string in current buffer;
1347 normally *buffer-selection*."
1349 (columns bs-attributes-list)
1351 (apply-args (append (list bs--buffer-coming-from bs-current-list))))
1354 (set-buffer buffer)
1355 (let ((min (bs--get-value (nth 1 (car columns))))
1356 ;;(max (bs--get-value (nth 2 (car columns)))) refered no more
1361 (setq val (bs--get-value fun apply-args))
1362 (setq new-string (bs--format-aux val align (- min to-much)))
1371 (defun bs--format-aux (string align len)
1381 (defun bs--show-header ()
1382 "Insert header for Buffer Selection Menu in current buffer."
1385 (bs--create-header)))
1387 (defun bs--get-name-length ()
1388 "Return value of `bs--name-entry-length'."
1389 bs--name-entry-length)
1391 (defun bs--create-header ()
1394 (bs--format-aux (bs--get-value (car column))
1396 (bs--get-value (nth 1 column))))
1397 bs-attributes-list
1400 (let ((length (length (bs--get-value (car column)))))
1401 (bs--format-aux (make-string length ?-)
1403 (bs--get-value (nth 1 column)))))
1404 bs-attributes-list
1407 (defun bs--show-with-configuration (name &optional arg)
1408 "Display buffer list of configuration with name NAME.
1410 Unless current buffer is buffer *buffer-selection* we have to save
1411 the buffer we started Buffer Selection Menu and the current window
1412 configuration to restore buffer and window configuration after a
1413 selection. If there is already a window displaying *buffer-selection*
1417 for buffer selection."
1418 (bs-set-configuration name)
1419 (let ((bs--show-all (or bs--show-all arg)))
1420 (unless (string= "*buffer-selection*" (buffer-name))
1421 ;; Only when not in buffer *buffer-selection*
1422 ;; we have to set the buffer we started the command
1423 (setq bs--buffer-coming-from (current-buffer)))
1424 (let ((liste (bs-buffer-list))
1427 (string= (buffer-name (window-buffer w))
1428 "*buffer-selection*")))))
1432 (list (cons 'bs--window-config-coming-from
1437 (bs-show-in-buffer liste)
1438 (bs-message-without-log "%s" (bs--current-config-message)))))
1440 (defun bs--configuration-name-for-prefix-arg (prefix-arg)
1441 "Convert prefix argument PREFIX-ARG to a name of a buffer configuration.
1442 If PREFIX-ARG is nil return `bs-default-configuration'.
1443 If PREFIX-ARG is an integer return PREFIX-ARG element of `bs-configurations'.
1444 Otherwise return `bs-alternative-configuration'."
1447 bs-default-configuration)
1450 (if (and (< 0 prefix-arg) (<= prefix-arg (length bs-configurations)))
1451 (car (nth (1- prefix-arg) bs-configurations))
1452 bs-default-configuration))
1454 (t bs-alternative-configuration)))
1457 ;; Main function bs-customize and bs-show
1461 (defun bs-customize ()
1462 "Customization of group bs for Buffer Selection Menu."
1464 (customize-group "bs"))
1467 (defun bs-show (arg)
1468 "Make a menu of buffers so you can manipulate buffers or the buffer list.
1469 \\<bs-mode-map>
1471 manipulating buffer list and buffers itself.
1472 User can move with [up] or [down], select a buffer
1473 by \\[bs-select] or [SPC]\n
1474 Type \\[bs-kill] to leave Buffer Selection Menu without a selection.
1475 Type \\[bs-help] after invocation to get help on commands available.
1476 With prefix argument ARG show a different buffer list. Function
1477 `bs--configuration-name-for-prefix-arg' determine accordingly
1478 name of buffer configuration."
1480 (setq bs--marked-buffers nil)
1481 (bs--show-with-configuration (bs--configuration-name-for-prefix-arg arg)))
1483 ;; Now provide feature bs
1484 (provide 'bs)
1487 ;;; bs.el ends here