Download
(require 'bs)
(defun bs-ext-set-keys (symb val)
"Set the key-bindings for the different configurations.
This function is used for setting the keys after saving the customization buffer for `bs-ext-config-keys'.
If called in other code then SYMB should be 'bs-ext-config-keys and val should be bs-ext-config-keys."
(loop for (key . name) in val
do (define-key bs-mode-map (read-kbd-macro key)
`(lambda nil (interactive) (bs--show-with-configuration ,name))))
(set-default symb val))
(defcustom bs-ext-config-keys nil
"Alist of (KEY . CONFIG) pairs.
CONFIG is the name of a configuration listed in `bs-configurations', and KEY is a key that loads that config when pressed
in the *buffer-selection* buffer."
:type '(alist :key-type (string :tag "Key"
:help-echo (lambda (w) (concat "The key to press to load this configuration. Must not be one of the following (already used) keys:\n"
(mapconcat 'identity (loop for key being the key-codes of bs-mode-map
collect (single-key-description key)) " ")))
:match (lambda (w key)
(or (member key (mapcar 'car bs-ext-config-keys))
(not (member key (loop for key being the key-codes of bs-mode-map
collect (single-key-description key)))))))
:value-type (string :tag "Config name"
:help-echo (lambda (w)
(concat "The name of the configuration to load. Must be one of the following:\n"
(mapconcat 'car bs-configurations " ")))
:match (lambda (w config) (member config (mapcar 'car bs-configurations)))))
:set 'bs-ext-set-keys
:group 'bs)
(defun bs-ext-prev-config-aux (start-name list)
"Get the previous assoc before START-NAME in list LIST.
Will return the last if START-NAME is at start."
(let ((assocs list)
(length (length list))
pos)
(while (and assocs (not pos))
(when (string= (car (car assocs)) start-name)
(setq pos (- length (length assocs))))
(setq assocs (cdr assocs)))
(if (eq pos 0)
(nth (1- length) list)
(nth (1- pos) list))))
(defun bs-ext-prev-config (name)
"Return previous configuration with respect to configuration with name NAME."
(bs-ext-prev-config-aux name bs-configurations))
(defun bs-ext-select-previous-configuration (&optional start-name)
"Apply previous configuration to START-NAME and refresh buffer list.
If START-NAME is nil the current configuration `bs-current-configuration'
will be used."
(interactive)
(let ((config (bs-ext-prev-config (or start-name bs-current-configuration))))
(bs-set-configuration (car config))
(setq bs-default-configuration bs-current-configuration)
(bs--redisplay t)
(bs--set-window-height)
(bs-message-without-log "Selected configuration: %s" (car config))))
(defun bs-ext-select-next-configuration (&optional start-name)
"Apply next configuration START-NAME and refresh buffer list.
If START-NAME is nil the current configuration `bs-current-configuration'
will be used."
(interactive)
(let ((config (bs-next-config (or start-name bs-current-configuration))))
(bs-set-configuration (car config))
(setq bs-default-configuration bs-current-configuration)
(bs--redisplay t)
(bs--set-window-height)
(bs-message-without-log "Selected configuration: %s" (car config))))
(defvar bs-ext-regexp ".*"
"Regexp with which to match buffer names for buffer show `regexp' configuration.")
(defvar bs-ext-regexp-history '()
"History list for use in aleblanc/bs-set-regexp.")
(defun bs-ext-set-regexp (regexp)
"Set the value of bs-ext-regexp - a regexp to match buffer names for the regexp configuration."
(interactive (list (read-string "Regexp to match buffer names: " nil 'bs-ext-regexp-history)))
(setq bs-ext-regexp regexp)
(add-to-list 'bs-ext-regexp-history 'regexp))
(defvar bs-ext-regexp-config '("regexp" nil
(lambda (buf) (string-match bs-ext-regexp (buffer-name buf)))
nil
(lambda (buf) (not (string-match bs-ext-regexp (buffer-name buf))))
nil)
"Buffer selection configuration for matching buffer names by regular expressions.")
(defvar bs-ext-mode-line-format
'("%e" "%e"
#("-" 0 1
(help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display"))
mode-line-mule-info mode-line-client mode-line-modified mode-line-remote mode-line-frame-identification mode-line-buffer-identification
#(" " 0 3
(help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display"))
mode-line-position
#(" " 0 2
(help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display"))
"Press ? for help, q to quit"
(global-mode-string
("" global-mode-string
#(" " 0 1
(help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display"))))
(:eval
(unless
(display-graphic-p)
#("-%-" 0 3
(help-echo "mouse-1: Select (drag to resize)\nmouse-2: Make current window occupy the whole frame\nmouse-3: Remove current window from display")))))
"The `mode-line-format' for the *buffer-selection* buffer.")
(defun bs-ext-limit-by-regexp nil
(interactive)
(call-interactively 'bs-ext-set-regexp)
(if (not (assoc "regexp" bs-configurations))
(add-to-list 'bs-configurations bs-ext-regexp-config))
(bs--show-with-configuration "regexp"))
(define-key bs-mode-map (kbd "<left>") 'bs-ext-select-previous-configuration)
(define-key bs-mode-map (kbd "<right>") 'bs-ext-select-next-configuration)
(define-key bs-mode-map (kbd "x") 'bs-delete)
(define-key bs-mode-map (kbd "/") 'bs-ext-limit-by-regexp)
(define-key bs-mode-map (kbd "?") 'bs-ext-help)
(if (featurep 'color-moccur)
(define-key bs-mode-map (kbd "M-O") 'bs-ext-moccur-marked-buffers))
(bs-ext-set-keys 'bs-ext-config-keys bs-ext-config-keys)
(defcustom bs-ext-show-configs-header t
"Whether or not to show the configs header line."
:type 'boolean
:group 'bs)
(add-hook 'bs-mode-hook
(lambda nil
(setq mode-line-format bs-ext-mode-line-format
header-line-format (if bs-ext-show-configs-header
(mapconcat (lambda (conf)
(let* ((name (car conf))
(key (car (rassoc name bs-ext-config-keys)))
(item (if key (concat name "(" key ")")
(if (equal name "regexp") "regexp(/)"
name))))
(if (equal name bs-current-configuration)
(propertize item 'face font-lock-comment-face)
item)))
bs-configurations " ")))))
(defvar bs-ext-help nil
"Major mode for editing a subset of Emacs' buffers.
\\<bs-mode-map>
Aside from two header lines each line describes one buffer.
Move to a line representing the buffer you want to edit and select
buffer by \\[bs-select] or SPC. Abort buffer list with \\[bs-kill].
There are many key commands similar to `Buffer-menu-mode' for
manipulating the buffer list and buffers.
For faster navigation each digit key is a digit argument.
Different configurations are displayed in the header line. These can
be navigated using \\[bs-ext-select-previous-configuration] and \\[bs-ext-select-next-configuration],
or by pressing the associated shortcut keys displayed in brackets after
the config names (see `bs-ext-config-keys').
\\[bs-select] or SPACE -- select current line's buffer and other marked buffers.
\\[bs-toggle-show-all] -- toggle between all buffers and a special subset.
\\[bs-select-other-window] -- select current line's buffer in other window.
\\[bs-tmp-select-other-window] -- make another window display that buffer and
remain in Buffer Selection Menu.
\\[bs-mouse-select] -- select current line's buffer and other marked buffers.
\\[bs-save] -- save current line's buffer immediately.
\\[bs-delete] -- kill current line's buffer immediately.
\\[bs-toggle-readonly] -- toggle read-only status of current line's buffer.
\\[bs-clear-modified] -- clear modified-flag on that buffer.
\\[bs-mark-current] -- mark current line's buffer to be displayed.
\\[bs-unmark-current] -- unmark current line's buffer to be displayed.
\\[bs-show-sorted] -- display buffer list sorted by next sort aspect.
\\[bs-set-configuration-and-refresh] -- ask user for a configuration and \
apply selected configuration.
\\[bs-ext-select-next-configuration] -- select and apply next \
available Buffer Selection Menu configuration.
\\[bs-ext-select-previous-configuration] -- select and apply previous \
available Buffer Selection Menu configuration.
\\[bs-ext-limit-by-regexp] -- display buffers with names matching regexp (prompt).
\\[bs-kill] -- leave Buffer Selection Menu without a selection.
\\[bs-toggle-current-to-show] -- toggle status of appearance.
\\[bs-set-current-buffer-to-show-always] -- mark current line's buffer \
to show always.
\\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer.
\\[bs-ext-moccur-marked-buffers] -- run multi-occur/moccur on marked buffers
\\[bs-help] -- display this help text.")
(defun bs-ext-help ()
"Help for `bs-show'."
(interactive)
(describe-variable 'bs-ext-help))
(defun bs-ext-moccur-marked-buffers (regexp buffers)
"Apply `moccur' on marked buffers."
(interactive (list (read-regexp "List lines matching regexp") bs--marked-buffers))
(if (featurep 'color-moccur)
(progn
(moccur-kill-buffer t)
(moccur-search regexp t bs--marked-buffers))
(multi-occur buffers regexp)
(bs-kill)
(switch-to-buffer "*Occur*")))
(provide 'bs-ext)