Use `string' before calling `insert'
[bpt/emacs.git] / lisp / uniquify.el
index 1eb2dfe..3099ff0 100644 (file)
@@ -3,7 +3,7 @@
 ;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc.
 
 ;; Author: Dick King <king@reasoning.com>
-;; Maintainer: Michael Ernst <mernst@theory.lcs.mit.edu>
+;; Maintainer: Michael Ernst <mernst@alum.mit.edu>
 ;; Created: 15 May 86
 
 ;; This file is part of GNU Emacs.
@@ -42,7 +42,6 @@
 ;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs,
 ;; and InfoDock is available from the maintainer.
 
-;; Doesn't correctly handle buffer names created by M-x write-file in Emacs 18.
 ;; Doesn't work under NT when backslash is used as a path separator (forward
 ;;   slash path separator works fine).  To fix, check system-type against
 ;;   'windows-nt, write a routine that breaks paths down into components.
 ;; Don't call expand-file-name on nil.  mernst 7 Jan 96
 ;; Check whether list-buffers-directory is bound.  mernst 11 Oct 96
 ;; 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
 
 ;; Valuable feedback was provided by
 ;; Paul Smith <psmith@baynetworks.com>,
@@ -104,8 +107,9 @@ would have the following buffer names in the various styles:
   :type '(radio (const forward)
                (const reverse)
                (const post-forward)
-               (const podt-forward-angle-brackets)
+               (const post-forward-angle-brackets)
                (const :tag "standard Emacs behavior (nil)" nil))
+  :require 'uniquify
   :group 'uniquify)
 
 (defcustom uniquify-after-kill-buffer-p nil
@@ -122,8 +126,16 @@ 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 parts of directory name included in buffer name."
+  "*Minimum number of directory name components included in buffer name."
   :type 'integer
   :group 'uniquify)
 
@@ -150,17 +162,24 @@ variable is ignored."
 (defmacro uniquify-push (item list)
   (` (setq (, list) (cons (, item) (, list)))))
 
-(defmacro uniquify-fix-list-base (a)
-  (` (car (, a))))
+;; 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)))
 
-(defmacro uniquify-fix-list-filename (a)
+;; uniquify-fix-list data structure
+(defmacro uniquify-fix-item-base (a)
+  (` (car (, a))))
+(defmacro uniquify-fix-item-filename (a)
   (` (car (cdr (, a)))))
-
-(defmacro uniquify-fix-list-buffer (a)
+(defmacro uniquify-fix-item-buffer (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
 
-(defmacro uniquify-cadddr (a)
-  (` (car (cdr (cdr (cdr (, a)))))))
+(defun uniquify-fix-item-filename-lessp (fixlist1 fixlist2)
+  (uniquify-filename-lessp (uniquify-fix-item-filename fixlist1)
+                          (uniquify-fix-item-filename fixlist2)))
 
 ;; Internal variables used free
 (defvar uniquify-non-file-buffer-names nil)
@@ -174,20 +193,25 @@ If `uniquify-min-dir-content' > 0, always pulls that many
 file name elements.  Arguments cause only a subset of buffers to be renamed."
   (interactive)
   (let (fix-list
-       uniquify-non-file-buffer-names
-       (depth uniquify-min-dir-content))
+       uniquify-non-file-buffer-names)
     (let ((buffers (buffer-list)))
       (while buffers
        (let* ((buffer (car buffers))
               (bfn (if (eq buffer newbuf)
-                       (and newbuffile
-                            (expand-file-name newbuffile))
+                        (and newbuffile
+                            (expand-file-name
+                             (if (file-directory-p newbuffile)
+                                 (directory-file-name newbuffile)
+                              newbuffile)))
                      (uniquify-buffer-file-name buffer)))
-              (rawname (and bfn (file-name-nondirectory bfn)))
+              (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
-                                         (file-name-nondirectory newbuffile))))))
+                                         (uniquify-file-name-nondirectory newbuffile))))))
          (if deserving
              (uniquify-push (list rawname bfn buffer nil) fix-list)
            (uniquify-push (list (buffer-name buffer))
@@ -196,40 +220,36 @@ file name elements.  Arguments cause only a subset of buffers to be renamed."
     ;; selects buffers whose names may need changing, and others that
     ;; may conflict.
     (setq fix-list
-         (sort fix-list 'uniquify-fix-list-filename-lessp))
+         (sort fix-list 'uniquify-fix-item-filename-lessp))
     ;; bringing conflicting names together
-    (uniquify-rationalize-a-list fix-list depth)
-    (mapcar 'uniquify-unrationalized-buffer fix-list)))
+    (uniquify-rationalize-a-list fix-list uniquify-min-dir-content)
+    (mapcar 'uniquify-fix-item-unrationalized-buffer fix-list)))
 
-;; uniquify's version of buffer-file-name
+;; 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 as well as ordinary file-visiting buffers,
-but no others."
+Works on dired buffers and ordinary file-visiting buffers, but no others."
   (or (buffer-file-name buffer)
       (and (featurep 'dired)
       (save-excursion
        (set-buffer buffer)
-            (and
-             (eq major-mode 'dired-mode) ; do nothing if not a dired buffer
-             (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this
-                 list-buffers-directory
-               ;; don't use default-directory if dired-directory is nil
-               (and dired-directory
-                    (expand-file-name
-                     (directory-file-name
-                      (if (consp dired-directory)
-                          (car dired-directory)
-                        dired-directory))))))))))
-
-(defun uniquify-fix-list-filename-lessp (fixlist1 fixlist2)
-  (uniquify-filename-lessp
-   (uniquify-fix-list-filename fixlist1) (uniquify-fix-list-filename fixlist2)))
+       (and
+        (eq major-mode 'dired-mode)    ; do nothing if not a dired buffer
+        (if (boundp 'list-buffers-directory) ; XEmacs mightn't define this
+            (and list-buffers-directory
+                 (directory-file-name list-buffers-directory))
+          ;; don't use default-directory if dired-directory is nil
+          (and dired-directory
+               (expand-file-name
+                (directory-file-name
+                 (if (consp dired-directory)
+                     (car dired-directory)
+                   dired-directory))))))))))
 
 ;; This examines the filename components in reverse order.
 (defun uniquify-filename-lessp (s1 s2)
-  (let ((s1f (file-name-nondirectory s1))
-       (s2f (file-name-nondirectory s2)))
+  (let ((s1f (uniquify-file-name-nondirectory s1))
+       (s2f (uniquify-file-name-nondirectory s2)))
     (and (not (equal s2f ""))
         (or (string-lessp s1f s2f)
             (and (equal s1f s2f)
@@ -241,12 +261,8 @@ but no others."
                              (substring s1d 0 -1)
                              (substring s2d 0 -1))))))))))
 
-;; Was named do-the-buffers-you-couldnt-rationalize
-(defun uniquify-unrationalized-buffer (item)
-  (or (uniquify-cadddr item) nil))     ;maybe better in the future
-
 (defun uniquify-rationalize-a-list (fix-list depth)
-  (let (conflicting-sublist
+  (let (conflicting-sublist    ; all elements have the same proposed name
        (old-name "")
        proposed-name uniquify-possibly-resolvable)
     (while fix-list
@@ -267,8 +283,8 @@ but no others."
   (let (index
        (extra-string "")
        (n depth)
-       (base (uniquify-fix-list-base item))
-       (fn (uniquify-fix-list-filename item)))
+       (base (uniquify-fix-item-base item))
+       (fn (uniquify-fix-item-filename item)))
     (while (and (> n 0)
                (setq index (string-match
                             (concat "\\(^\\|/[^/]*\\)/"
@@ -320,8 +336,8 @@ but no others."
                    uniquify-buffer-name-style)))))
 
 
-;; Deal with conflicting-sublist, which is set by uniquify-rationalize-a-list.
-;; This is only called by uniquify-rationalize-a-list.
+;; Deal with conflicting-sublist, all of whose elements have identical
+;; "base" components.
 (defun uniquify-rationalize-conflicting-sublist (conflicting-sublist old-name depth)
   (or (null conflicting-sublist)
       (and (null (cdr conflicting-sublist))
@@ -333,7 +349,7 @@ but no others."
          (uniquify-rationalize-a-list conflicting-sublist (1+ depth)))))
 
 (defun uniquify-rename-buffer (item newname)
-  (let ((buffer (uniquify-fix-list-buffer item)))
+  (let ((buffer (uniquify-fix-item-buffer item)))
     (if (not (equal newname (buffer-name buffer)))
        (let ((unset (current-buffer))
              ;; avoid hooks on rename-buffer
@@ -360,8 +376,6 @@ but no others."
 
 ;;; Hooks from the rest of Emacs
 
-;; Emacs 19 (Emacs or XEmacs)
-
 ;; The logical place to put all this code is in generate-new-buffer-name.
 ;; It's written in C, so we would add a generate-new-buffer-name-function
 ;; which, if non-nil, would be called instead of the C.  One problem with
@@ -413,9 +427,7 @@ For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
   (if (and uniquify-buffer-name-style
           uniquify-after-kill-buffer-p)
       (add-hook 'post-command-hook
-               'delayed-uniquify-rationalize-file-buffer-names)
-    (remove-hook 'kill-buffer-hook
-                'delay-uniquify-rationalize-file-buffer-names)))
+               'delayed-uniquify-rationalize-file-buffer-names)))
 
 (defun delayed-uniquify-rationalize-file-buffer-names ()
   "Rerationalize buffer names and remove self from `post-command-hook'.