#

[gnu-emacs] / lisp / uniquify.el

diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 5a8c31ca624a6ebcff7af800e5bc6a0ba36d48f2..e171de728a7f217b8665a514147d005e9310eb35 100644 (file)
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -70,6 +70,10 @@
 ;; Ignore non-file non-dired buffers. Colin Rafferty <craffert@ml.com> 3 Mar 97
 ;; Use last component, not "", for file name of directories.  mernst 27 Jun 97
 ;; Use directory-file-name; code cleanup.  mernst 6 Sep 97
+;; Add uniquify-ignore-buffers-re.
+;;  Andre Srinivasan <andre@visigenic.com> 9 Sep 97
+;; Add uniquify-list-buffers-directory-modes
+;;   Stefan Monnier <monnier@cs.yale.edu> 17 Nov 2000
 
 ;; Valuable feedback was provided by
 ;; Paul Smith <psmith@baynetworks.com>,
@@ -83,6 +87,7 @@
 ;;; Code:
 
 (provide 'uniquify)
+(eval-when-compile (require 'cl))
 
 ;;; User-visible variables
 
@@ -124,6 +129,14 @@ other buffer names are changed."
   :type 'boolean
   :group 'uniquify)
 
+(defcustom uniquify-ignore-buffers-re nil
+  "*Regular expression matching buffer names that should not be uniquified.
+For instance, set this to \"^draft-[0-9]+$\" to avoid having uniquify rename
+draft buffers even if `uniquify-after-kill-buffer-p' is non-nil and the
+visited file name isn't the same as that of the buffer."
+  :type '(choice (const :tag "Uniquify all buffers" nil) regexp)
+  :group 'uniquify)
+
 (defcustom uniquify-min-dir-content 0
   "*Minimum number of directory name components included in buffer name."
   :type 'integer
@@ -146,23 +159,24 @@ variable is ignored."
   :type 'boolean
   :group 'uniquify)
 
+(defvar uniquify-list-buffers-directory-modes '(dired-mode cvs-mode)
+  "List of modes for which uniquify should obey `list-buffers-directory'.
+That means that when `buffer-file-name' is set to nil, `list-buffers-directory'
+contains the name of the directory which the buffer is visiting.")
 
 ;;; Utilities
 
-(defmacro uniquify-push (item list)
-  (` (setq (, list) (cons (, item) (, list)))))
-
 ;; For directories, return the last component, not the empty string.
 (defun uniquify-file-name-nondirectory (file-name)
   (file-name-nondirectory (directory-file-name file-name)))
 
 ;; uniquify-fix-list data structure
 (defmacro uniquify-fix-item-base (a)
-  (` (car (, a))))
+  `(car ,a))
 (defmacro uniquify-fix-item-filename (a)
-  (` (car (cdr (, a)))))
+  `(car (cdr ,a)))
 (defmacro uniquify-fix-item-buffer (a)
-  (` (car (cdr (cdr (, a))))))
+  `(car (cdr (cdr ,a))))
 ;; Not a macro: passed to mapcar.
 (defun uniquify-fix-item-unrationalized-buffer (item)
   (or (car (cdr (cdr (cdr item)))) nil))       ;maybe better in the future
@@ -178,7 +192,7 @@ variable is ignored."
 ;;; Main entry point.
 
 (defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf)
-  "Makes file buffer names unique by adding segments from file name.
+  "Make file buffer names unique by adding segments from file name.
 If `uniquify-min-dir-content' > 0, always pulls that many
 file name elements.  Arguments cause only a subset of buffers to be renamed."
   (interactive)
@@ -196,13 +210,16 @@ file name elements.  Arguments cause only a subset of buffers to be renamed."
                      (uniquify-buffer-file-name buffer)))
               (rawname (and bfn (uniquify-file-name-nondirectory bfn)))
               (deserving (and rawname
+                              (not (and uniquify-ignore-buffers-re
+                                        (string-match uniquify-ignore-buffers-re
+                                                      (buffer-name buffer))))
                               (or (not newbuffile)
                                   (equal rawname
                                          (uniquify-file-name-nondirectory newbuffile))))))
          (if deserving
-             (uniquify-push (list rawname bfn buffer nil) fix-list)
-           (uniquify-push (list (buffer-name buffer))
-                          uniquify-non-file-buffer-names)))
+             (push (list rawname bfn buffer nil) fix-list)
+           (push (list (buffer-name buffer))
+                 uniquify-non-file-buffer-names)))
        (setq buffers (cdr buffers))))
     ;; selects buffers whose names may need changing, and others that
     ;; may conflict.
@@ -215,13 +232,12 @@ file name elements.  Arguments cause only a subset of buffers to be renamed."
 ;; uniquify's version of buffer-file-name; result never contains trailing slash
 (defun uniquify-buffer-file-name (buffer)
   "Return name of file BUFFER is visiting, or nil if none.
-Works on dired buffers and ordinary file-visiting buffers, but no others."
+Works on ordinary file-visiting buffers and buffers whose mode is mentioned
+in `uniquify-list-buffers-directory-modes', otherwise returns nil."
   (or (buffer-file-name buffer)
-      (and (featurep 'dired)
-      (save-excursion
-       (set-buffer buffer)
+      (with-current-buffer buffer
        (and
-        (eq major-mode 'dired-mode)    ; do nothing if not a dired buffer
+        (memq major-mode uniquify-list-buffers-directory-modes)
         (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this
             (and list-buffers-directory
                  (directory-file-name list-buffers-directory))
@@ -231,7 +247,7 @@ Works on dired buffers and ordinary file-visiting buffers, but no others."
                 (directory-file-name
                  (if (consp dired-directory)
                      (car dired-directory)
-                   dired-directory))))))))))
+                   dired-directory)))))))))
 
 ;; This examines the filename components in reverse order.
 (defun uniquify-filename-lessp (s1 s2)
@@ -260,7 +276,7 @@ Works on dired buffers and ordinary file-visiting buffers, but no others."
              (uniquify-rationalize-conflicting-sublist
               conflicting-sublist old-name depth)
              (setq conflicting-sublist nil)))
-       (uniquify-push item conflicting-sublist)
+       (push item conflicting-sublist)
        (setq old-name proposed-name))
       (setq fix-list (cdr fix-list)))
     (uniquify-rationalize-conflicting-sublist