X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/def83929f36e56c9c7d8e1446013d21c0dc86dc0..640ad75b3c4549394eec314b3305ca576d185965:/lisp/uniquify.el

diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 20291d55b8..24b49a983a 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -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:
 
@@ -42,15 +44,10 @@
 ;; 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,6 +71,8 @@
 ;;  Andre Srinivasan <andre@visigenic.com> 9 Sep 97
 ;; Add uniquify-list-buffers-directory-modes
 ;;   Stefan Monnier <monnier@cs.yale.edu> 17 Nov 2000
+;; 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
 ;; Paul Smith <psmith@baynetworks.com>,
@@ -86,13 +85,12 @@
 
 ;;; 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)
 
 
@@ -115,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)
 
@@ -129,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
@@ -159,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'
@@ -166,216 +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
-(defmacro uniquify-fix-item-base (a)
-  `(car ,a))
-(defmacro uniquify-fix-item-filename (a)
-  `(car (cdr ,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
-
-(defun uniquify-fix-item-filename-lessp (fixlist1 fixlist2)
-  (uniquify-filename-lessp (uniquify-fix-item-filename fixlist1)
-			   (uniquify-fix-item-filename fixlist2)))
+(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)
-    (let ((buffers (buffer-list)))
-      (while buffers
-	(let* ((buffer (car buffers))
-	       (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
-					  (uniquify-file-name-nondirectory newbuffile))))))
-	  (if deserving
-	      (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.
-    (setq fix-list
-	  (sort fix-list 'uniquify-fix-item-filename-lessp))
-    ;; bringing conflicting names together
-    (uniquify-rationalize-a-list fix-list uniquify-min-dir-content)
-    (mapcar 'uniquify-fix-item-unrationalized-buffer fix-list)))
+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)))))))))
-
-;; This examines the filename components in reverse order.
-(defun uniquify-filename-lessp (s1 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)
-		  (let ((s1d (file-name-directory s1))
-			(s2d (file-name-directory s2)))
-		    (and (not (<= (length s2d) 1))
-			 (or (<= (length s1d) 1)
-			     (uniquify-filename-lessp
-			      (substring s1d 0 -1)
-			      (substring s2d 0 -1))))))))))
-
-(defun uniquify-rationalize-a-list (fix-list depth)
+  (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)
+      (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-name "")
-	proposed-name uniquify-possibly-resolvable)
-    (while fix-list
-      (let ((item (car fix-list)))
-	(setq proposed-name (uniquify-get-proposed-name item depth))
-	(if (not (equal proposed-name old-name))
-	    (progn
-	      (uniquify-rationalize-conflicting-sublist
-	       conflicting-sublist old-name depth)
-	      (setq conflicting-sublist nil)))
-	(push item conflicting-sublist)
-	(setq old-name proposed-name))
-      (setq fix-list (cdr fix-list)))
-    (uniquify-rationalize-conflicting-sublist
-     conflicting-sublist old-name depth)))
-
-(defun uniquify-get-proposed-name (item depth)
-  (let (index
-	(extra-string "")
-	(n depth)
-	(base (uniquify-fix-item-base item))
-	(fn (uniquify-fix-item-filename item)))
-    (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)))))
+	(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-proposed depth)
+	(setq conflicting-sublist nil))
+      (push item conflicting-sublist)
+      (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) 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))
-      (if uniquify-possibly-resolvable
-	  (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))))
-  (rplaca (nthcdr 3 item) t))
-
-(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
 
@@ -391,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.
@@ -424,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