--- a/lisp/utils/uniquify.el	Mon Aug 13 08:51:58 2007 +0200
+++ b/lisp/utils/uniquify.el	Mon Aug 13 08:52:29 2007 +0200
@@ -1,10 +1,11 @@
 ;;; uniquify.el --- unique buffer names dependent on file name
 
-;; Copyright (c) 1989, 1995 Free Software Foundation, Inc.
+;; Copyright (c) 1989, 1995, 1996, 1997 Free Software Foundation, Inc.
 
 ;; Author: Dick King <king@reasoning.com>
 ;; Maintainer: Michael Ernst <mernst@theory.lcs.mit.edu>
 ;; Created: 15 May 86
+;; Time-stamp: <97/03/03 17:16:23 mernst>
 
 ;; This file is part of GNU Emacs.
 
@@ -19,9 +20,8 @@
 ;; GNU General Public License for more details.
 
 ;; 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.
+;; along with GNU Emacs; see the file COPYING.  If not, write to
+;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
 ;;; Commentary:
 
@@ -34,12 +34,17 @@
 ;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>).
 ;; Other buffer name styles are also available.
 
-;; To use this file, just load it.
+;; To use this file, just load it; or add (require 'uniquify) to your .emacs.
 ;; To disable it after loading, set variable uniquify-buffer-name-style to nil.
 ;; For other options, see "User-visible variables", below.
 
-;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs,
-;; and InfoDock is available from the maintainer.
+;; uniquify.el works under Emacs 18, Emacs 19, XEmacs, and InfoDock.
+
+;; 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.
+;;   (Surprisingly, there isn't one built in.)
 
 ;;; Change Log:
 
@@ -59,13 +64,17 @@
 ;;  uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets
 ;;  styles; remove uniquify-reverse-dir-content-p; add
 ;;  uniquify-trailing-separator-p.  mernst 4 Aug 95
+;; 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
 
 ;; Valuable feedback was provided by
 ;; Paul Smith <psmith@baynetworks.com>,
 ;; Alastair Burt <burt@dfki.uni-kl.de>,
 ;; Bob Weiner <weiner@footloose.sps.mot.com>,
 ;; Albert L. Ting <alt@vlibs.com>,
-;; gyro@reasoning.com.
+;; gyro@reasoning.com,
+;; Bryan O'Sullivan <bos@eng.sun.com>.
 
 
 ;;; Code:
@@ -148,8 +157,8 @@
       (while buffers
 	(let* ((buffer (car buffers))
 	       (bfn (if (eq buffer newbuf)
-			(and newbuffile
-			     (expand-file-name newbuffile))
+                        (and newbuffile
+                             (expand-file-name newbuffile))
 		      (uniquify-buffer-file-name buffer)))
 	       (rawname (and bfn (file-name-nondirectory bfn)))
 	       (deserving (and rawname
@@ -172,11 +181,23 @@
 ;; uniquify's version of buffer-file-name
 (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."
+Works on dired buffers as well as ordinary file-visiting buffers,
+but no others."
   (or (buffer-file-name buffer)
-      (save-excursion
-	(set-buffer buffer)
-	list-buffers-directory)))
+      (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
@@ -316,69 +337,149 @@
 
 ;;; Hooks from the rest of Emacs
 
-;; Emacs 19 (Emacs or XEmacs)
+(cond
+ ((string-match "^19" emacs-version)
+  ;; 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
+  ;; that is that generate-new-buffer-name takes a potential buffer name as
+  ;; its argument -- not other information, such as what file the buffer will
+  ;; visit.
 
-;; 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
-;; that is that generate-new-buffer-name takes a potential buffer name as
-;; its argument -- not other information, such as what file the buffer will
-;; visit.
+  ;; The below solution works because generate-new-buffer-name is called
+  ;; only by rename-buffer (which, as of 19.29, is never called from C) and
+  ;; 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
+  ;; 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))))))
 
-;; The below solution works because generate-new-buffer-name is called
-;; only by rename-buffer (which, as of 19.29, is never called from C) and
-;; 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
-;; sufficient.)
+  (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)))
+
+  ;; Buffer deletion
+  ;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
+  ;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
+  ;; That means that the kill-buffer-hook function cannot just delete the
+  ;; buffer -- it has to set something to do the rationalization *later*.
+  ;; It actually puts another function on `post-command-hook'.  This other
+  ;; function runs the rationalization and then removes itself from the hook.
+  ;; Is there a better way to accomplish this?
+  ;; (This ought to set some global variables so the work is done only for
+  ;; buffers with names similar to the deleted buffer.  -MDE)
 
-(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))))))
+  (cond
+   ((or (not (string-lessp emacs-version "19.28"))
+	(and (string-match "XEmacs" emacs-version)
+	     (not (string-lessp emacs-version "19.12"))))
+    ;; Emacs 19.28 or later, or XEmacs (19.12 or later; is that necessary?)
+    (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
+	       uniquify-after-kill-buffer-p)
+	  (add-hook 'post-command-hook
+		    'delayed-uniquify-rationalize-file-buffer-names)))
+    (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))
 
-(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)))
+    (add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names))
+   (t
+    ;; GNU Emacs 19.01 through 19.27
+    ;; Before version 19.28, {pre,post}-command-hook was unable to set itself.
+
+    (defvar uniquify-post-command-p nil
+      "Set to trigger re-rationalization of buffer names by function on
+`post-command-hook'.  Used by kill-buffer-rationalization mechanism.")
+
+    (defun uniquify-post-command-rerationalization ()
+      "Set variable so buffer names may be rationalized by `post-command-hook'.
 
-;; Buffer deletion
-;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
-;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
-;; That means that the kill-buffer-hook function cannot just delete the
-;; buffer -- it has to set something to do the rationalization *later*.
-;; It actually puts another function on `post-command-hook'.  This other
-;; function runs the rationalization and then removes itself from the hook.
-;; Is there a better way to accomplish this?
-;; (This ought to set some global variables so the work is done only for
-;; buffers with names similar to the deleted buffer.  -MDE)
+See variables `uniquify-post-command-p', `uniquify-buffer-name-style', and
+`uniquify-after-kill-buffer-p'."
+      (if (and uniquify-buffer-name-style
+	       uniquify-after-kill-buffer-p)
+	  (setq uniquify-post-command-p
+		;; Set the buffer name, so, once the delimiter character
+		;; is parameterized, we could selectively rationalize just
+		;; related buffer names.
+		(cons (buffer-name) uniquify-post-command-p))))
+    (defun uniquify-rationalize-after-buffer-kill ()
+      "Via `post-command-hook', rerationalize buffer names after kill-buffer.
+
+Checks `uniquify-post-command-p', which should be set by
+`uniquify-post-command-rerationalization' function on `kill-buffer-hook'."
+      (if uniquify-post-command-p
+	  (progn (if (and uniquify-buffer-name-style
+			  uniquify-after-kill-buffer-p)
+		     (uniquify-rationalize-file-buffer-names))
+		 (setq uniquify-post-command-p nil))))
+
+    (add-hook 'kill-buffer-hook 'uniquify-post-command-rerationalization)
+    (add-hook 'post-command-hook 'uniquify-rationalize-after-buffer-kill))
+  ))
+ (t
+  ;; Emacs 18: redefine create-file-buffer and dired-find-buffer.
 
-(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
-	   uniquify-after-kill-buffer-p)
-      (add-hook 'post-command-hook
-		'delayed-uniquify-rationalize-file-buffer-names)))
+  ;; Since advice.el can run in Emacs 18 as well as Emacs 19, we could use
+  ;; advice here, too, if it is available; but it's not worth it, since
+  ;; Emacs 18 is obsolescent anyway.
 
-(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))
+  (defun create-file-buffer (filename)	;from files.el
+    "Create a suitably named buffer for visiting FILENAME, and return it."
+    (let ((base (file-name-nondirectory filename)))
+      (if (string= base "")
+	  (setq base filename))
+      (if (and (get-buffer base)
+	       uniquify-ask-about-buffer-names-p)
+	  (get-buffer-create
+	   (let ((tem (read-string (format
+				    "Buffer name \"%s\" is in use; type a new name, or Return to clobber: "
+                                    base))))
+	     (if (equal tem "") base tem)))
+	(let ((buf (generate-new-buffer base)))
+	  (if uniquify-buffer-name-style
+	      (uniquify-rationalize-file-buffer-names filename buf))
+	  buf))))
 
-(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
+  (defun dired-find-buffer (dirname)	;from dired.el
+    (let ((blist (buffer-list))
+	  found)
+      (while blist
+	(save-excursion
+	  (set-buffer (car blist))
+	  (if (and (eq major-mode 'dired-mode)
+		   (equal dired-directory dirname))
+	      (setq found (car blist)
+		    blist nil)
+	    (setq blist (cdr blist)))))
+      (or found
+	  (progn (if (string-match "/$" dirname)
+		     (setq dirname (substring dirname 0 -1)))
+		 (create-file-buffer (if uniquify-buffer-name-style
+					 dirname
+				       (file-name-nondirectory dirname)))))))))
 
 ;;; uniquify.el ends here
-