X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/08861c5cb87e91e83e5b0bf53cb53c1377434c8f..84eb0351d8be4811897c8cf62a69757ff5d14001:/lisp/bs.el diff --git a/lisp/bs.el b/lisp/bs.el index 75b1e4a4d4..1f90304f1d 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1,17 +1,16 @@ ;;; bs.el --- menu for selecting and displaying buffers -;; 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 ;; Maintainer: Olaf Sylvester ;; Keywords: convenience ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify +;; GNU Emacs is free software: you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 3, or (at your option) -;; any later version. +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. ;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -19,9 +18,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -45,14 +42,10 @@ ;;; 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: @@ -131,6 +124,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;; ---------------------------------------------------------------------- ;; Globals for customization ;; ---------------------------------------------------------------------- @@ -195,7 +190,7 @@ return a string representing the column's value." '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.") @@ -375,9 +370,7 @@ A value of `always' means to show buffer regardless of the configuration.") (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) @@ -577,10 +570,11 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." "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 () @@ -666,6 +660,7 @@ to show always. 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)) @@ -698,8 +693,9 @@ Refresh whole Buffer Selection Menu." (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)) @@ -816,11 +812,9 @@ Leave Buffer Selection Menu." (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. @@ -834,16 +828,12 @@ See `visit-tags-table'." (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))) @@ -971,21 +961,17 @@ Default is `bs--current-sort-function'." (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) @@ -1020,7 +1006,9 @@ If on top of buffer list go to last line." "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) @@ -1159,7 +1147,7 @@ and move point to current buffer." (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) @@ -1336,13 +1324,12 @@ ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." (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")) @@ -1354,8 +1341,7 @@ normally *buffer-selection*." (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 @@ -1477,8 +1463,22 @@ name of buffer 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