X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9c8020a8df03dc67a56d7df15664dcf7ace54bf0..1cc3c18fd41142d2d7f9c2252c526ed45792a2ab:/lisp/bs.el diff --git a/lisp/bs.el b/lisp/bs.el index bb2dbae83c..96bad48cf2 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -1,17 +1,17 @@ ;;; bs.el --- menu for selecting and displaying buffers ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006, 2007 Free Software Foundation, Inc. +;; 2005, 2006, 2007, 2008, 2009 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 +19,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: @@ -131,6 +129,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;; ---------------------------------------------------------------------- ;; Globals for customization ;; ---------------------------------------------------------------------- @@ -369,15 +369,13 @@ A value of `always' means to show buffer regardless of the configuration.") (defun bs--sort-by-mode (b1 b2) "Compare buffers B1 and B2 by mode name." - (save-excursion - (string< (progn (set-buffer b1) (format "%s" mode-name)) - (progn (set-buffer b2) (format "%s" mode-name))))) + (save-current-buffer + (string< (progn (set-buffer b1) (format-mode-line mode-name nil nil b1)) + (progn (set-buffer b2) (format-mode-line mode-name nil nil b2))))) (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) @@ -612,7 +610,6 @@ Used from `window-size-change-functions'." (let ((win (get-buffer-window "*buffer-selection*" frame))) (when win (with-selected-window win - (bs-refresh) (bs--set-window-height))))) (defun bs--remove-hooks () @@ -622,6 +619,8 @@ Used from `window-size-change-functions'." (remove-hook 'kill-buffer-hook 'bs--remove-hooks t) (remove-hook 'change-major-mode-hook 'bs--remove-hooks t)) +(put 'bs-mode 'mode-class 'special) + (define-derived-mode bs-mode nil "Buffer-Selection-Menu" "Major mode for editing a subset of Emacs' buffers. \\ @@ -735,7 +734,7 @@ Leave Buffer Selection Menu." (defun bs-select () "Select current line's buffer and other marked buffers. If there are no marked buffers the window configuration before starting -Buffer Selectin Menu will be restored. +Buffer Selection Menu will be restored. If there are marked buffers each marked buffer and the current line's buffer will be selected in a window. Leave Buffer Selection Menu." @@ -759,7 +758,7 @@ Leave Buffer Selection Menu." (defun bs-select-other-window () "Select current line's buffer by `switch-to-buffer-other-window'. -The window configuration before starting Buffer Selectin Menu will be restored +The window configuration before starting Buffer Selection Menu will be restored unless there is no other window. In this case a new window will be created. Leave Buffer Selection Menu." (interactive) @@ -815,11 +814,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. @@ -833,16 +830,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))) @@ -970,21 +963,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) @@ -1330,7 +1319,7 @@ ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu." "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." - mode-name) + (format-mode-line mode-name nil nil start-buffer)) (defun bs--get-file-name (start-buffer all-buffers) "Return string for column 'File' in Buffer Selection Menu. @@ -1353,8 +1342,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 @@ -1476,8 +1464,23 @@ 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 +;; arch-tag: c0d9ab34-bf06-4368-ae9d-af88878e6802 ;;; bs.el ends here