]> code.delx.au - gnu-emacs/blobdiff - lisp/bs.el
(calc-embedded-make-info): Use `math-read-expr' when
[gnu-emacs] / lisp / bs.el
index 9fdc8922cc2bbe379709d4ba50a9d6220207a592..f095a98dc00cd9db1177e58ec7bc597336279c88 100644 (file)
@@ -1,6 +1,7 @@
 ;;; bs.el --- menu for selecting and displaying buffers
 
-;; Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006 Free Software Foundation, Inc.
 ;; Author: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
 ;; Maintainer: Olaf Sylvester <Olaf.Sylvester@netsurf.de>
 ;; Keywords: convenience
 
 ;; 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., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
 ;; Version: 1.17
-;; X-URL: http://home.netsurf.de/olaf.sylvester/emacs
+;; X-URL: http://www.geekware.de/software/emacs
 ;;
 ;; The bs-package contains a main function bs-show for poping up a
 ;; buffer in a way similar to `list-buffers' and `electric-buffer-list':
 
 ;;; Code:
 
+(defvar font-lock-verbose)
+
 ;; ----------------------------------------------------------------------
 ;; Globals for customization
 ;; ----------------------------------------------------------------------
   "Buffer Selection: Maintaining buffers by buffer menu."
   :version "21.1"
   :link '(emacs-commentary-link "bs")
-  :link '(url-link "http://home.netsurf.de/olaf.sylvester/emacs")
+  :link '(url-link "http://www.geekware.de/software/emacs")
   :group 'convenience)
 
 (defgroup bs-appearance nil
   "*List specifying the layout of a Buffer Selection Menu buffer.
 Each entry specifies a column and is a list of the form of:
 \(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING)
-HEADER         : string for header for first line or a function
-  which calculates column title.
-MINIMUM-LENGTH : minimum width of column (number or name of function).
-  The function must return a positive integer.
-MAXIMUM-LENGTH : maximum width of column (number or name of function)
-                 (currently ignored)
-ALIGNMENT      : alignment of column: (`left' `right' `middle')
-FUN-OR-STRING  : Name of a function for calculating the value or
-a string for a constant value.
+
+HEADER         : String for header for first line or a function
+                 which calculates column title.
+MINIMUM-LENGTH : Minimum width of column (number or name of function).
+                 The function must return a positive integer.
+MAXIMUM-LENGTH : Maximum width of column (number or name of function)
+                 (currently ignored).
+ALIGNMENT      : Alignment of column (`left', `right', `middle').
+FUN-OR-STRING  : Name of a function for calculating the value or a
+                 string for a constant value.
+
 The function gets as parameter the buffer where we have started
 buffer selection and the list of all buffers to show.  The function must
 return a string representing the column's value."
   :group 'bs-appearance
   :type '(repeat sexp))
 
-(defvar bs--running-in-xemacs (string-match "XEmacs" (emacs-version))
-  "Non-nil when running under XEmacs.")
-
 (defun bs--make-header-match-string ()
   "Return a regexp matching the first line of a Buffer Selection Menu buffer."
   (let ((res "^\\(")
@@ -546,9 +548,7 @@ a special function.  SORT-DESCRIPTION is an element of `bs-sort-functions'."
             (extern-must-show-from-fun (and bs-must-show-function
                                             (funcall bs-must-show-function
                                                      (car list))))
-            (show-flag (save-excursion
-                         (set-buffer (car list))
-                         bs-buffer-show-mark)))
+            (show-flag (buffer-local-value 'bs-buffer-show-mark (car list))))
        (if (or (eq show-flag 'always)
                (and (or bs--show-all (not (eq show-flag 'never)))
                     (not int-show-never)
@@ -630,8 +630,8 @@ For faster navigation each digit key is a digit argument.
 \\[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 immediatly.
-\\[bs-delete] -- kill current line's buffer immediatly.
+\\[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.
@@ -652,13 +652,14 @@ to show always.
   (use-local-map bs-mode-map)
   (make-local-variable 'font-lock-defaults)
   (make-local-variable 'font-lock-verbose)
+  (buffer-disable-undo)
   (setq major-mode 'bs-mode
        mode-name "Buffer-Selection-Menu"
        buffer-read-only t
        truncate-lines t
        font-lock-defaults '(bs-mode-font-lock-keywords t)
        font-lock-verbose nil)
-  (run-hooks 'bs-mode-hook))
+  (run-mode-hooks 'bs-mode-hook))
 
 (defun bs-kill ()
   "Let buffer disappear and reset window-configuration."
@@ -698,12 +699,7 @@ Return nil if there is no such buffer."
 (defun bs--set-window-height ()
   "Change the height of the selected window to suit the current buffer list."
   (unless (one-window-p t)
-    (shrink-window (- (window-height (selected-window))
-                     ;; window-height in xemacs includes mode-line
-                     (+ (if bs--running-in-xemacs 3 1)
-                        bs-header-lines-length
-                        (min (length bs-current-list)
-                             bs-max-window-height))))))
+    (fit-window-to-buffer (selected-window) bs-max-window-height)))
 
 (defun bs--current-buffer ()
   "Return buffer on current line.
@@ -865,9 +861,7 @@ always.  Otherwise it is marked to show never."
   "Set value `bs-buffer-show-mark' of buffer BUFFER to WHAT.
 Redisplay current line and display a message describing
 the status of buffer on current line."
-  (save-excursion
-    (set-buffer buffer)
-    (setq bs-buffer-show-mark what))
+  (with-current-buffer buffer (setq bs-buffer-show-mark what))
   (bs--update-current-line)
   (bs--set-window-height)
   (bs--show-config-message what))
@@ -1010,13 +1004,11 @@ Uses function `vc-toggle-read-only'."
   "Move cursor vertically up one line.
 If on top of buffer list go to last line."
   (interactive "p")
-  (previous-line 1)
-  (if (<= (count-lines 1 (point)) (1- bs-header-lines-length))
-      (progn
-       (goto-char (point-max))
-       (beginning-of-line)
-       (recenter -1))
-    (beginning-of-line)))
+  (if (> (count-lines 1 (point)) bs-header-lines-length)
+      (forward-line -1)
+    (goto-char (point-max))
+    (beginning-of-line)
+    (recenter -1)))
 
 (defun bs-down (arg)
   "Move cursor vertically down ARG lines in Buffer Selection Menu."
@@ -1028,10 +1020,9 @@ If on top of buffer list go to last line."
 (defun bs--down ()
   "Move cursor vertically down one line.
 If at end of buffer list go to first line."
-  (let ((last (line-end-position)))
-    (if (eq last (point-max))
-       (goto-line (1+ bs-header-lines-length))
-      (next-line 1))))
+  (if (eq (line-end-position) (point-max))
+      (goto-line (1+ bs-header-lines-length))
+    (forward-line 1)))
 
 (defun bs-visits-non-file (buffer)
   "Return t or nil whether BUFFER visits no file.
@@ -1174,7 +1165,8 @@ and move point to current buffer."
     (bs--set-window-height)
     (bs--goto-current-buffer)
     (font-lock-fontify-buffer)
-    (bs-apply-sort-faces)))
+    (bs-apply-sort-faces)
+    (set-buffer-modified-p nil)))
 
 (defun bs-next-buffer (&optional buffer-list sorting-p)
   "Return next buffer and buffer list for buffer cycling in BUFFER-LIST.
@@ -1331,17 +1323,9 @@ The name of current buffer gets additional text properties
 for mouse highlighting.
 START-BUFFER is the buffer where we started buffer selection.
 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
-  (let ((name (copy-sequence (buffer-name))))
-    (add-text-properties
-     0 (length name)
-     '(mouse-face highlight
-       help-echo
-       "mouse-2: select this buffer, mouse-3: select in other frame")
-     name)
-    (if (< (length name) bs--name-entry-length)
-       (concat name
-               (make-string (- bs--name-entry-length (length name)) ? ))
-      name)))
+  (propertize (buffer-name)
+              '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)
   "Return the name of mode of current buffer for Buffer Selection Menu.
@@ -1356,16 +1340,11 @@ If current mode is `dired-mode' or `shell-mode' it returns the
 default directory.
 START-BUFFER is the buffer where we started buffer selection.
 ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
-  (let ((string (copy-sequence (if (member major-mode
-                                          '(shell-mode dired-mode))
-                                  default-directory
-                                (or buffer-file-name "")))))
-    (add-text-properties
-     0 (length string)
-     '(mouse-face highlight
-       help-echo "mouse-2: select this buffer, mouse-3: select in other frame")
-     string)
-    string))
+  (propertize (if (member major-mode '(shell-mode dired-mode))
+                  default-directory
+                (or buffer-file-name ""))
+              'mouse-face 'highlight
+              'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"))
 
 (defun bs--insert-one-entry (buffer)
   "Generate one entry for buffer BUFFER in Buffer Selection Menu.
@@ -1398,12 +1377,12 @@ normally *buffer-selection*."
 (defun bs--format-aux (string align len)
   "Generate a string with STRING with alignment ALIGN and length LEN.
 ALIGN is one of the symbols `left', `middle', or `right'."
-  (let ((length (length string)))
-    (if (>= length len)
-       string
-      (if (eq 'right align)
-         (concat (make-string (- len length) ? ) string)
-       (concat string (make-string (- len length) ? ))))))
+  (let* ((width (length string))
+         (len (max len width)))
+    (format (format "%%%s%ds" (if (eq align 'right) "" "-") len)
+            (if (eq align 'middle)
+                (concat (make-string (/ (- len width) 2) ?\s) string)
+              string))))
 
 (defun bs--show-header ()
   "Insert header for Buffer Selection Menu in current buffer."