-;;; bs.el --- menu for selecting and displaying buffers
+;;; bs.el --- menu for selecting and displaying buffers -*- lexical-binding: t -*-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 1998-2011 Free Software Foundation, Inc.
;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
;; Keywords: convenience
;;; Quick Installation und Customization:
-;; Use
+;; To display the bs menu, do
;; M-x bs-show
-;; for buffer selection or optional bind a key to main function `bs-show'
-;; (global-set-key "\C-x\C-b" 'bs-show) ;; or another key
-;;
-;; For customization use
-;; M-x bs-customize
-
+;; To customize its behavior, do
+;; M-x bs-customize
;;; More Commentary:
;;; Code:
+(eval-when-compile (require 'cl))
+
;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------
'font-lock-constant-face
'font-lock-comment-face))
;; Dired-Buffers
- '("^..\\(.*Dired by .*\\)$" 1 font-lock-function-name-face)
+ '("^..\\(.*Dired .*\\)$" 1 font-lock-function-name-face)
;; the star for modified buffers
'("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face))
"Default font lock expressions for Buffer Selection Menu.")
(defun bs--sort-by-size (b1 b2)
"Compare buffers B1 and B2 by buffer size."
- (save-excursion
- (< (progn (set-buffer b1) (buffer-size))
- (progn (set-buffer b2) (buffer-size)))))
+ (< (buffer-size b1) (buffer-size b2)))
(defcustom bs-sort-functions
'(("by name" bs--sort-by-name "Buffer" region)
"Redisplay whole Buffer Selection Menu.
If KEEP-LINE-P is non-nil the point will stay on current line.
SORT-DESCRIPTION is an element of `bs-sort-functions'."
- (let ((line (1+ (count-lines 1 (point)))))
+ (let ((line (count-lines 1 (point))))
(bs-show-in-buffer (bs-buffer-list nil sort-description))
(when keep-line-p
- (goto-line line))
+ (goto-char (point-min))
+ (forward-line line))
(beginning-of-line)))
(defun bs--goto-current-buffer ()
font-lock-global-modes '(not bs-mode)
font-lock-defaults '(bs-mode-font-lock-keywords t)
font-lock-verbose nil)
+ (set (make-local-variable 'revert-buffer-function) 'bs-refresh)
(add-hook 'window-size-change-functions 'bs--track-window-changes)
(add-hook 'kill-buffer-hook 'bs--remove-hooks nil t)
(add-hook 'change-major-mode-hook 'bs--remove-hooks nil t))
(call-interactively 'bs-set-configuration)
(bs--redisplay t))
-(defun bs-refresh ()
- "Refresh whole Buffer Selection Menu."
+(defun bs-refresh (&rest _ignored)
+ "Refresh whole Buffer Selection Menu.
+Arguments are IGNORED (for `revert-buffer')."
(interactive)
(bs--redisplay t))
(defun bs-save ()
"Save buffer on current line."
(interactive)
- (let ((buffer (bs--current-buffer)))
- (save-excursion
- (set-buffer buffer)
- (save-buffer))
- (bs--update-current-line)))
+ (with-current-buffer (bs--current-buffer)
+ (save-buffer))
+ (bs--update-current-line))
(defun bs-visit-tags-table ()
"Visit the tags table in the buffer on this line.
(defun bs-toggle-current-to-show ()
"Toggle status of showing flag for buffer in current line."
(interactive)
- (let ((buffer (bs--current-buffer))
- res)
- (save-excursion
- (set-buffer buffer)
- (setq res (cond ((null bs-buffer-show-mark)
- 'never)
- ((eq bs-buffer-show-mark 'never)
- 'always)
- (t nil)))
- (setq bs-buffer-show-mark res))
+ (let ((res
+ (with-current-buffer (bs--current-buffer)
+ (setq bs-buffer-show-mark (case bs-buffer-show-mark
+ ((nil) 'never)
+ ((never) 'always)
+ (t nil))))))
(bs--update-current-line)
(bs--set-window-height)
(bs--show-config-message res)))
(defun bs-toggle-readonly ()
"Toggle read-only status for buffer on current line.
-Uses function `vc-toggle-read-only'."
+Uses function `toggle-read-only'."
(interactive)
- (let ((buffer (bs--current-buffer)))
- (save-excursion
- (set-buffer buffer)
- (vc-toggle-read-only))
- (bs--update-current-line)))
+ (with-current-buffer (bs--current-buffer)
+ (toggle-read-only))
+ (bs--update-current-line))
(defun bs-clear-modified ()
"Set modified flag for buffer on current line to nil."
(interactive)
- (let ((buffer (bs--current-buffer)))
- (save-excursion
- (set-buffer buffer)
- (set-buffer-modified-p nil)))
+ (with-current-buffer (bs--current-buffer)
+ (set-buffer-modified-p nil))
(bs--update-current-line))
(defun bs--nth-wrapper (count fun &rest args)
"Move cursor vertically down one line.
If at end of buffer list go to first line."
(if (eq (line-end-position) (point-max))
- (goto-line (1+ bs-header-lines-length))
+ (progn
+ (goto-char (point-min))
+ (forward-line bs-header-lines-length))
(forward-line 1)))
(defun bs-visits-non-file (buffer)
A value of nil means BUFFER belongs to a file."
(not (buffer-file-name buffer)))
-(defun bs-sort-buffer-interns-are-last (b1 b2)
+(defun bs-sort-buffer-interns-are-last (_b1 b2)
"Function for sorting internal buffers at the end of all buffers."
(string-match-p "^\\*" (buffer-name b2)))
(dolist (buffer list)
(bs--insert-one-entry buffer)
(insert "\n"))
- (delete-backward-char 1)
+ (delete-char -1)
(bs--set-window-height)
(bs--goto-current-buffer)
(font-lock-fontify-buffer)
fun)
(t (apply fun args))))
-(defun bs--get-marked-string (start-buffer all-buffers)
+(defun bs--get-marked-string (start-buffer _all-buffers)
"Return a string which describes whether current buffer is marked.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu.
(t
bs-string-show-always)))
-(defun bs--get-modified-string (start-buffer all-buffers)
+(defun bs--get-modified-string (_start-buffer _all-buffers)
"Return a string which describes whether current buffer is modified.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
(if (buffer-modified-p) "*" " "))
-(defun bs--get-readonly-string (start-buffer all-buffers)
+(defun bs--get-readonly-string (_start-buffer _all-buffers)
"Return a string which describes whether current buffer is read only.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
(if buffer-read-only "%" " "))
-(defun bs--get-size-string (start-buffer all-buffers)
+(defun bs--get-size-string (_start-buffer _all-buffers)
"Return a string which describes the size of current buffer.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
(int-to-string (buffer-size)))
-(defun bs--get-name (start-buffer all-buffers)
+(defun bs--get-name (_start-buffer _all-buffers)
"Return name of current buffer for Buffer Selection Menu.
The name of current buffer gets additional text properties
for mouse highlighting.
'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"
'mouse-face 'highlight))
-(defun bs--get-mode-name (start-buffer all-buffers)
+(defun bs--get-mode-name (start-buffer _all-buffers)
"Return the name of mode of current buffer for Buffer Selection Menu.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
(format-mode-line mode-name nil nil start-buffer))
-(defun bs--get-file-name (start-buffer all-buffers)
+(defun bs--get-file-name (_start-buffer _all-buffers)
"Return string for column 'File' in Buffer Selection Menu.
This is the variable `buffer-file-name' of current buffer.
-If current mode is `dired-mode' or `shell-mode' it returns the
-default directory.
+If not visiting a file, `list-buffers-directory' is returned instead.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
- (propertize (if (member major-mode '(shell-mode dired-mode))
- default-directory
- (or buffer-file-name ""))
+ (propertize (or buffer-file-name
+ (bound-and-true-p list-buffers-directory)
+ "")
'mouse-face 'highlight
'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"))
(let ((string "")
(to-much 0)
(apply-args (append (list bs--buffer-coming-from bs-current-list))))
- (save-excursion
- (set-buffer buffer)
+ (with-current-buffer buffer
(dolist (column bs-attributes-list)
(let* ((min (bs--get-value (nth 1 column)))
(new-string (bs--format-aux (bs--get-value (nth 4 column) ; fun
(bs-show-in-buffer liste)
(bs-message-without-log "%s" (bs--current-config-message)))))
-(defun bs--configuration-name-for-prefix-arg (prefix-arg)
- "Convert prefix argument PREFIX-ARG to a name of a buffer configuration.
-If PREFIX-ARG is nil return `bs-default-configuration'.
-If PREFIX-ARG is an integer return PREFIX-ARG element of `bs-configurations'.
+(defun bs--configuration-name-for-prefix-arg (prefix)
+ "Convert prefix argument PREFIX to a name of a buffer configuration.
+If PREFIX is nil return `bs-default-configuration'.
+If PREFIX is an integer return PREFIX element of `bs-configurations'.
Otherwise return `bs-alternative-configuration'."
(cond ;; usually activation
- ((null prefix-arg)
+ ((null prefix)
bs-default-configuration)
;; call with integer as prefix argument
- ((integerp prefix-arg)
- (if (and (< 0 prefix-arg) (<= prefix-arg (length bs-configurations)))
- (car (nth (1- prefix-arg) bs-configurations))
+ ((integerp prefix)
+ (if (and (< 0 prefix) (<= prefix (length bs-configurations)))
+ (car (nth (1- prefix) bs-configurations))
bs-default-configuration))
;; call by prefix argument C-u
(t bs-alternative-configuration)))
(setq bs--marked-buffers nil)
(bs--show-with-configuration (bs--configuration-name-for-prefix-arg arg)))
+;; ----------------------------------------------------------------------
+;; Cleanup
+;; ----------------------------------------------------------------------
+
+(defun bs-unload-function ()
+ "Unload the Buffer Selection library."
+ (let ((bs-buf (get-buffer "*buffer-selection*")))
+ (when bs-buf
+ (with-current-buffer bs-buf
+ (when (eq major-mode 'bs-mode)
+ (bs-kill)
+ (kill-buffer bs-buf)))))
+ ;; continue standard unloading
+ nil)
+
;; Now provide feature bs
(provide 'bs)
-;; arch-tag: c0d9ab34-bf06-4368-ae9d-af88878e6802
;;; bs.el ends here
HCoop / bpt / emacs.git / blobdiff