]> code.delx.au - gnu-emacs/blobdiff - lisp/uniquify.el
(ediff-files, ediff-files3, ediff-merge-files)
[gnu-emacs] / lisp / uniquify.el
index e3b7874de0a44168cec6da0a1ffba8b75db5a24c..24b49a983ad7fd6c6ecf1551a7776b840694f6a1 100644 (file)
@@ -1,9 +1,11 @@
 ;;; uniquify.el --- unique buffer names dependent on file name
 
-;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc.
+;; Copyright (C) 1989, 1995, 1996, 1997, 2001, 2002, 2003,
+;;   2004, 2005, 2006 Free Software Foundation, Inc.
 
 ;; Author: Dick King <king@reasoning.com>
 ;; Maintainer: FSF
+;; Keywords: files
 ;; Created: 15 May 86
 
 ;; This file is part of GNU Emacs.
@@ -20,8 +22,8 @@
 
 ;; 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:
 
 ;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs,
 ;; and InfoDock is available from the maintainer.
 
-;; 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.
-;;   (Surprisingly, there isn't one built in.)
-
 ;;; Change Log:
 
 ;; Originally by Dick King <king@reasoning.com> 15 May 86
-;; Converted for Emacs 18 by Stephen Gildea <gildea@lcs.mit.edu>
+;; Converted for Emacs 18 by Stephen Gildea <gildea@stop.mail-abuse.org>
 ;; Make uniquify-min-dir-content 0 truly non-invasive.  gildea 23 May 89
 ;; Some cleanup.  uniquify-min-dir-content default 0.  gildea 01 Jun 89
 ;; Don't rename to "".  Michael Ernst <mernst@theory.lcs.mit.edu> 15 Jun 94
@@ -74,7 +71,7 @@
 ;;  Andre Srinivasan <andre@visigenic.com> 9 Sep 97
 ;; Add uniquify-list-buffers-directory-modes
 ;;   Stefan Monnier <monnier@cs.yale.edu> 17 Nov 2000
-;; Cleanup of uniquify-*-lessp reduced consing when using lots of buffers
+;; Algorithm and data structure changed to reduce consing with lots of buffers
 ;;   Francesco Potortì <pot@gnu.org> (ideas by rms and monnier) 2001-07-18
 
 ;; Valuable feedback was provided by
 
 ;;; Code:
 
-(provide 'uniquify)
 (eval-when-compile (require 'cl))
 
 ;;; User-visible variables
 
 (defgroup uniquify nil
-  "Unique buffer names dependent on file name"
+  "Unique buffer names dependent on file name."
   :group 'applications)
 
 
@@ -117,10 +113,8 @@ would have the following buffer names in the various styles:
   :require 'uniquify
   :group 'uniquify)
 
-(defcustom uniquify-after-kill-buffer-p nil
-  "*If non-nil, rerationalize buffer names after a buffer has been killed.
-This can be dangerous if Emacs Lisp code is keeping track of buffers by their
-names (rather than keeping pointers to the buffers themselves)."
+(defcustom uniquify-after-kill-buffer-p t
+  "If non-nil, rerationalize buffer names after a buffer has been killed."
   :type 'boolean
   :group 'uniquify)
 
@@ -131,6 +125,7 @@ other buffer names are changed."
   :type 'boolean
   :group 'uniquify)
 
+;; The default value matches certain Gnus buffers.
 (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
@@ -161,6 +156,16 @@ variable is ignored."
   :type 'boolean
   :group 'uniquify)
 
+(defcustom uniquify-strip-common-suffix
+  ;; Using it when uniquify-min-dir-content>0 doesn't make much sense.
+  (eq 0 uniquify-min-dir-content)
+  "If non-nil, strip common directory suffixes of conflicting files.
+E.g. if you open /a1/b/c/d and /a2/b/c/d, the buffer names will say
+\"d|a1\" and \"d|a2\" instead of \"d|a1/b/c\" and \"d|a2/b/c\".
+This can be handy when you have deep parallel hierarchies."
+  :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'
@@ -168,196 +173,241 @@ contains the name of the directory which the buffer is visiting.")
 
 ;;; Utilities
 
-;; 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
-(defalias 'uniquify-fix-item-base 'car)
-(defalias 'uniquify-fix-item-filename 'cadr)
-(defsubst uniquify-fix-item-buffer (x) (car (cdr (cdr x))))
-(defsubst uniquify-fix-item-min-proposed (x) (nth 3 x))
+(defstruct (uniquify-item
+           (:constructor nil) (:copier nil)
+           (:constructor uniquify-make-item
+            (base dirname buffer &optional proposed)))
+  base dirname buffer proposed)
 
 ;; Internal variables used free
-(defvar uniquify-non-file-buffer-names nil)
 (defvar uniquify-possibly-resolvable nil)
 
+(defvar uniquify-managed nil
+  "Non-nil if the name of this buffer is managed by uniquify.
+It actually holds the list of `uniquify-item's corresponding to the conflict.")
+(make-variable-buffer-local 'uniquify-managed)
+(put 'uniquify-managed 'permanent-local t)
+
 ;;; Main entry point.
 
-(defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf)
+(defun uniquify-rationalize-file-buffer-names (base dirname newbuf)
   "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)
-  (let (fix-list
-       uniquify-non-file-buffer-names
-       (newbuffile-nd (and newbuffile
-                           (uniquify-file-name-nondirectory newbuffile))))
-    (dolist (buffer (buffer-list))
-      (let* ((bfn (if (eq buffer newbuf)
-                     (and newbuffile
-                          (expand-file-name
-                           (if (file-directory-p newbuffile)
-                               (directory-file-name newbuffile)
-                             newbuffile)))
-                   (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 newbuffile-nd))))
-            (min-proposed (if deserving
-                              (uniquify-get-proposed-name
-                               rawname bfn uniquify-min-dir-content))))
-       (if deserving
-           (push (list rawname bfn buffer min-proposed) fix-list)
-         (push (list (buffer-name buffer)) uniquify-non-file-buffer-names))))
-    ;; selects buffers whose names may need changing, and others that
-    ;; may conflict.
-    (setq fix-list
-         (sort fix-list 'uniquify-item-lessp))
-    ;; bringing conflicting names together
-    (uniquify-rationalize-a-list fix-list uniquify-min-dir-content)))
+file name elements.
+Arguments BASE, DIRNAME, and NEWBUF specify the new buffer that causes
+this rationalization."
+  (interactive
+   (list (if uniquify-managed
+            (uniquify-item-base (car uniquify-managed)) (buffer-name))
+        (uniquify-buffer-file-name (current-buffer))
+        (current-buffer)))
+  ;; Make sure we don't get confused by outdated uniquify-managed info in
+  ;; this buffer.
+  (with-current-buffer newbuf (setq uniquify-managed nil))
+  (when dirname
+    (setq dirname (expand-file-name (directory-file-name dirname)))
+    (let ((fix-list (list (uniquify-make-item base dirname newbuf)))
+         items)
+      (dolist (buffer (buffer-list))
+       (when (and (not (and uniquify-ignore-buffers-re
+                            (string-match uniquify-ignore-buffers-re
+                                          (buffer-name buffer))))
+                  ;; Only try to rename buffers we actually manage.
+                  (setq items (buffer-local-value 'uniquify-managed buffer))
+                  (equal base (uniquify-item-base (car items)))
+                  ;; Don't re-add stuff we already have.  Actually this
+                  ;; whole `and' test should only match at most once.
+                  (not (memq (car items) fix-list)))
+         (unless (cdr items)
+           ;; If there was no conflict, the buffer-name is equal to the
+           ;; base-name and we may have missed a rename-buffer because
+           ;; of code like in set-visited-file-name:
+           ;; (or (string= new-name (buffer-name)) (rename-buffer new-name t))
+           ;; So we need to refresh the dirname of the uniquify-item.
+           (setf (uniquify-item-dirname (car items))
+                 (uniquify-buffer-file-name
+                  (uniquify-item-buffer (car items))))
+           ;; This shouldn't happen, but maybe there's no dirname any more.
+           (unless (uniquify-item-dirname (car items))
+             (with-current-buffer (uniquify-item-buffer (car items))
+               (setq uniquify-managed nil))
+             (setq items nil)))
+         (setq fix-list (append fix-list items))))
+      ;; selects buffers whose names may need changing, and others that
+      ;; may conflict, then bring conflicting names together
+      (uniquify-rationalize fix-list))))
 
 ;; 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.
+  "Return name of directory, file BUFFER is visiting, or nil if none.
 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)
-      (with-current-buffer buffer
-       (and
-        (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))
-          ;; 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-item-lessp (item1 item2)
-  (string-lessp (uniquify-fix-item-min-proposed item1)
-               (uniquify-fix-item-min-proposed item2)))
-
-(defun uniquify-rationalize-a-list (fix-list depth)
-  (let (conflicting-sublist    ; all elements have the same proposed name
-       (old-name "")
-       proposed-name)
+  (with-current-buffer buffer
+    (let ((filename
+          (or buffer-file-name
+              (if (memq major-mode uniquify-list-buffers-directory-modes)
+                  list-buffers-directory))))
+      (when filename
+       (directory-file-name
+        (file-name-directory
+         (expand-file-name
+          (directory-file-name filename))))))))
+
+(defun uniquify-rerationalize-w/o-cb (fix-list)
+  "Re-rationalize the buffers in FIX-LIST, but ignoring current-buffer."
+  (let ((new-fix-list nil))
     (dolist (item fix-list)
-      (setq proposed-name
-           (if (= depth uniquify-min-dir-content)
-               (uniquify-fix-item-min-proposed item)
-             (uniquify-get-proposed-name (uniquify-fix-item-base item)
-                                         (uniquify-fix-item-filename item)
-                                         depth)))
-      (unless (equal proposed-name old-name)
+      (let ((buf (uniquify-item-buffer item)))
+       (unless (or (eq buf (current-buffer)) (not (buffer-live-p buf)))
+         (push item new-fix-list))))
+    (when new-fix-list
+      (uniquify-rationalize new-fix-list))))
+
+(defun uniquify-rationalize (fix-list)
+  ;; Set up uniquify to re-rationalize after killing/renaming
+  ;; if there is a conflict.
+  (dolist (item fix-list)
+    (with-current-buffer (uniquify-item-buffer item)
+      ;; Refresh the dirnames and proposed names.
+      (setf (uniquify-item-proposed item)
+           (uniquify-get-proposed-name (uniquify-item-base item)
+                                       (uniquify-item-dirname item)))
+      (setq uniquify-managed fix-list)))
+  ;; Strip any shared last directory names of the dirname.
+  (when (and (cdr fix-list) uniquify-strip-common-suffix)
+    (let ((strip t))
+      (while (let* ((base (file-name-nondirectory
+                          (uniquify-item-dirname (car fix-list))))
+                   (items fix-list))
+              (when (> (length base) 0)
+                (while (and strip items)
+                  (unless (equal base (file-name-nondirectory
+                                       (uniquify-item-dirname (pop items))))
+                    (setq strip nil)))
+                strip))
+       ;; It's all the same => strip.
+       (dolist (item (prog1 fix-list (setq fix-list nil)))
+         ;; Create new items because the old ones are kept (with the true
+         ;; `dirname') for later rerationalizing.
+         (push (uniquify-make-item (uniquify-item-base item)
+                                   (let ((f (file-name-directory
+                                             (uniquify-item-dirname item))))
+                                     (and f (directory-file-name f)))
+                                   (uniquify-item-buffer item)
+                                   (uniquify-item-proposed item))
+               fix-list)))))
+  ;; If uniquify-min-dir-content is 0, this will end up just
+  ;; passing fix-list to uniquify-rationalize-conflicting-sublist.
+  (uniquify-rationalize-a-list fix-list))
+
+(defun uniquify-item-greaterp (item1 item2)
+  (string-lessp (uniquify-item-proposed item2)
+               (uniquify-item-proposed item1)))
+
+(defun uniquify-rationalize-a-list (fix-list &optional depth)
+  (unless depth (setq depth uniquify-min-dir-content))
+  (let (conflicting-sublist    ; all elements have the same proposed name
+       (old-proposed "")
+       proposed)
+    ;; Divide fix-list into items with same proposed names and pass them
+    ;; to uniquify-rationalize-conflicting-sublist.
+    (dolist (item (sort fix-list 'uniquify-item-greaterp))
+      (setq proposed (uniquify-item-proposed item))
+      (unless (equal proposed old-proposed)
        (uniquify-rationalize-conflicting-sublist conflicting-sublist
-                                                 old-name depth)
+                                                 old-proposed depth)
        (setq conflicting-sublist nil))
       (push item conflicting-sublist)
-      (setq old-name proposed-name))
-    (uniquify-rationalize-conflicting-sublist
-     conflicting-sublist old-name depth)))
-
-(defun uniquify-get-proposed-name (base filename depth)
-  (let (index
-       (extra-string "")
-       (fn filename)
+      (setq old-proposed proposed))
+    (uniquify-rationalize-conflicting-sublist conflicting-sublist
+                                             old-proposed depth)))
+
+(defun uniquify-get-proposed-name (base dirname &optional depth)
+  (unless depth (setq depth uniquify-min-dir-content))
+  (assert (equal (directory-file-name dirname) dirname))  ;No trailing slash.
+
+  ;; Distinguish directories by adding extra separator.
+  (if (and uniquify-trailing-separator-p
+          (file-directory-p (expand-file-name base dirname))
+          (not (string-equal base "")))
+      (cond ((eq uniquify-buffer-name-style 'forward)
+            (setq base (file-name-as-directory base)))
+           ;; (setq base (concat base "/")))
+           ((eq uniquify-buffer-name-style 'reverse)
+            (setq base (concat (or uniquify-separator "\\") base)))))
+
+  (let ((extra-string nil)
        (n depth))
-    (while (and (> n 0)
-               (setq index (string-match
-                            (concat "\\(^\\|/[^/]*\\)/"
-                                    (regexp-quote extra-string)
-                                    (regexp-quote base)
-                                    "\\'")
-                            fn)))
-      (setq extra-string (substring fn
-                                   (if (zerop index) 0 (1+ index))
-                                   ;; (- (length base)) fails for base = "".
-                                   ;; Equivalently, we could have used
-                                   ;; (apply 'substring ...
-                                   ;;        (and (not (string= "" base))
-                                   ;;             (list (- (length base)))))
-                                   (- (length fn) (length base)))
-           n (1- n)))
-    (if (zerop n) (setq uniquify-possibly-resolvable t))
-
-
-    ;; Distinguish directories by adding extra separator.
-    (if (and uniquify-trailing-separator-p
-            (file-directory-p fn)
-            (not (string-equal base "")))
-       (cond ((eq uniquify-buffer-name-style 'forward)
-              (setq base (concat base "/")))
-             ((eq uniquify-buffer-name-style 'reverse)
-              (setq base (concat (or uniquify-separator "\\") base)))))
-
-    ;; Trim trailing separator on directory part
-    (if (and (not (string-equal extra-string ""))
-            (or (eq uniquify-buffer-name-style 'post-forward)
-                (eq uniquify-buffer-name-style 'post-forward-angle-brackets)))
-       (setq extra-string (substring extra-string 0
-                                     (- (length extra-string) 1))))
-
-    (cond ((string-equal extra-string "")
-          base)
-         ((string-equal base "")
-          extra-string)
-         ((eq uniquify-buffer-name-style 'forward)
-          (concat extra-string base))
-         ((eq uniquify-buffer-name-style 'reverse)
-          (concat base (uniquify-reverse-components extra-string)))
-         ((eq uniquify-buffer-name-style 'post-forward)
-          (concat base (or uniquify-separator "|") extra-string))
-         ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
-          (concat base "<" extra-string ">"))
-         (t (error "Bad value for uniquify-buffer-name-style: %s"
-                   uniquify-buffer-name-style)))))
+    (while (and (> n 0) dirname)
+      (let ((file (file-name-nondirectory dirname)))
+       (when (setq dirname (file-name-directory dirname))
+         (setq dirname (directory-file-name dirname)))
+       (setq n (1- n))
+       (push (if (zerop (length file)) ;nil or "".
+                 (prog1 "" (setq dirname nil)) ;Could be `dirname' iso "".
+               file)
+             extra-string)))
+    (when (zerop n)
+      (if (and dirname extra-string
+              (equal dirname (file-name-directory dirname)))
+         ;; We're just before the root.  Let's add the leading / already.
+         ;; With "/a/b"+"/c/d/b" this leads to "/a/b" and "d/b" but with
+         ;; "/a/b"+"/c/a/b" this leads to "/a/b" and "a/b".
+         (push "" extra-string))
+      (setq uniquify-possibly-resolvable t))
+
+    (cond
+     ((null extra-string) base)
+     ((string-equal base "") ;Happens for dired buffers on the root directory.
+      (mapconcat 'identity extra-string "/"))
+     ((eq uniquify-buffer-name-style 'reverse)
+      (mapconcat 'identity
+                (cons base (nreverse extra-string))
+                (or uniquify-separator "\\")))
+     ((eq uniquify-buffer-name-style 'forward)
+      (mapconcat 'identity (nconc extra-string (list base))
+                "/"))
+     ((eq uniquify-buffer-name-style 'post-forward)
+      (concat base (or uniquify-separator "|")
+             (mapconcat 'identity extra-string "/")))
+     ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
+      (concat base "<" (mapconcat 'identity extra-string "/")
+             ">"))
+     (t (error "Bad value for uniquify-buffer-name-style: %s"
+              uniquify-buffer-name-style)))))
 
 
 ;; 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))
-          (not (assoc old-name uniquify-non-file-buffer-names))
-          (or (and (not (string= old-name ""))
-                   (uniquify-rename-buffer (car conflicting-sublist) old-name))
-              t))
-      (when uniquify-possibly-resolvable
-       (setq uniquify-possibly-resolvable nil)
-       (uniquify-rationalize-a-list conflicting-sublist (1+ depth)))))
+(defun uniquify-rationalize-conflicting-sublist (conf-list old-name depth)
+  (when conf-list
+    (if (or (cdr conf-list)
+           ;; Check that the proposed name doesn't conflict with some
+           ;; existing buffer.
+           (let ((buf (get-buffer old-name)))
+             (and buf (not (eq buf (uniquify-item-buffer (car conf-list)))))))
+       (when uniquify-possibly-resolvable
+         (setq uniquify-possibly-resolvable nil
+               depth (1+ depth))
+         (dolist (item conf-list)
+           (setf (uniquify-item-proposed item)
+                 (uniquify-get-proposed-name
+                  (uniquify-item-base item)
+                  (uniquify-item-dirname item)
+                  depth)))
+         (uniquify-rationalize-a-list conf-list depth))
+      (unless (string= old-name "")
+       (uniquify-rename-buffer (car conf-list) old-name)))))
 
-(defun uniquify-rename-buffer (item newname)
-  (let ((buffer (uniquify-fix-item-buffer item)))
-    (if (not (equal newname (buffer-name buffer)))
-       (let ((unset (current-buffer))
-             ;; avoid hooks on rename-buffer
-             (uniquify-buffer-name-style nil))
-         (set-buffer buffer)
-         (rename-buffer newname)
-         (set-buffer unset)))))
-
-(defun uniquify-reverse-components (instring)
-  (let ((sofar '())
-       (cursor 0)
-       (len (length instring))
-       (sep (or uniquify-separator "\\")))
-    (while (< cursor len)
-      (if (= (aref instring cursor) ?/)
-          (setq sofar (cons sep sofar)
-                cursor (1+ cursor))
-        (let ((first-slash (or (string-match "/" instring cursor) len)))
-          (setq sofar (cons (substring instring cursor first-slash) sofar)
-                cursor first-slash))))
-    (apply (function concat) sofar)))
 
+(defun uniquify-rename-buffer (item newname)
+  (let ((buffer (uniquify-item-buffer item)))
+    (unless (equal newname (buffer-name buffer))
+      (with-current-buffer buffer
+       (let ((uniquify-buffer-name-style nil)) ;Avoid hooks on rename-buffer.
+         ;; Pass the `unique' arg, so the advice doesn't mark it as unmanaged.
+         (rename-buffer newname t))))))
 
 ;;; Hooks from the rest of Emacs
 
@@ -373,27 +423,30 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 ;; generate-new-buffer, which is called only by Lisp functions
 ;; create-file-buffer and rename-uniquely.  Rename-uniquely generally
 ;; isn't used for buffers visiting files, so it's sufficient to hook
-;; rename-buffer and create-file-buffer.  (Setting find-file-hooks isn't
+;; rename-buffer and create-file-buffer.  (Setting find-file-hook isn't
 ;; sufficient.)
 
 (defadvice rename-buffer (after rename-buffer-uniquify activate)
   "Uniquify buffer names with parts of directory name."
-  (if (and uniquify-buffer-name-style
-          ;; UNIQUE argument
-          (ad-get-arg 1))
-      (progn
-       (if uniquify-after-kill-buffer-p
-           ;; call with no argument; rationalize vs. old name as well as new
-           (uniquify-rationalize-file-buffer-names)
-         ;; call with argument: rationalize vs. new name only
-         (uniquify-rationalize-file-buffer-names
-          (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
-       (setq ad-return-value (buffer-name (current-buffer))))))
+  (uniquify-maybe-rerationalize-w/o-cb)
+  (if (null (ad-get-arg 1))            ; no UNIQUE argument.
+      ;; Mark this buffer so it won't be renamed by uniquify.
+      (setq uniquify-managed nil)
+    (when uniquify-buffer-name-style
+      ;; Rerationalize w.r.t the new name.
+      (uniquify-rationalize-file-buffer-names
+       (ad-get-arg 0)
+       (uniquify-buffer-file-name (current-buffer))
+       (current-buffer))
+      (setq ad-return-value (buffer-name (current-buffer))))))
 
 (defadvice create-file-buffer (after create-file-buffer-uniquify activate)
   "Uniquify buffer names with parts of directory name."
   (if uniquify-buffer-name-style
-      (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
+      (let ((filename (expand-file-name (directory-file-name (ad-get-arg 0)))))
+       (uniquify-rationalize-file-buffer-names
+        (file-name-nondirectory filename)
+        (file-name-directory filename) ad-return-value))))
 
 ;; Buffer deletion
 ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
@@ -406,21 +459,19 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 ;; (This ought to set some global variables so the work is done only for
 ;; buffers with names similar to the deleted buffer.  -MDE)
 
-(defun delay-uniquify-rationalize-file-buffer-names ()
-  "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
-For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
-  (if (and uniquify-buffer-name-style
+(defun uniquify-maybe-rerationalize-w/o-cb ()
+  "Re-rationalize buffer names, ignoring current buffer.
+For use on `kill-buffer-hook'."
+  (if (and (cdr uniquify-managed)
+          uniquify-buffer-name-style
           uniquify-after-kill-buffer-p)
-      (add-hook 'post-command-hook
-               'delayed-uniquify-rationalize-file-buffer-names)))
+      (uniquify-rerationalize-w/o-cb uniquify-managed)))
 
-(defun delayed-uniquify-rationalize-file-buffer-names ()
-  "Rerationalize buffer names and remove self from `post-command-hook'.
-See also `delay-rationalize-file-buffer-names' for hook setter."
-  (uniquify-rationalize-file-buffer-names)
-  (remove-hook 'post-command-hook
-              'delayed-uniquify-rationalize-file-buffer-names))
+;; Ideally we'd like to add it buffer-locally, but that doesn't work
+;; because kill-buffer-hook is not permanent-local :-(
+(add-hook 'kill-buffer-hook 'uniquify-maybe-rerationalize-w/o-cb)
 
-(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
+(provide 'uniquify)
 
+;; arch-tag: e763faa3-56c9-4903-8eb8-26e1c45a0065
 ;;; uniquify.el ends here