(uniquify-get-proposed-name): Don't assume dirsep is /.

(uniquify-reverse-components): Remove.

1 files changed, 54 insertions, 72 deletions

diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index 72e3d7893bf..361fae2ea17 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -43,11 +43,6 @@
 ;; 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
@@ -259,59 +254,61 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 					      old-proposed depth)))
 
 (defun uniquify-get-proposed-name (base filename depth)
-  (let (index
-	(extra-string "")
-	(fn filename)
+  (assert (equal base (uniquify-file-name-nondirectory filename)))
+  (assert (equal (directory-file-name filename) filename))
+
+  ;; Distinguish directories by adding extra separator.
+  (if (and uniquify-trailing-separator-p
+	   (file-directory-p filename)
+	   (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) filename
+		(setq filename (file-name-directory filename))
+		(setq filename (directory-file-name filename)))
+      (let ((file (file-name-nondirectory filename)))
+	(setq n (1- n))
+	(push (if (zerop (length file)) ;nil or "".
+		  (prog1 "" (setq filename nil)) ;Could be `filename' iso "".
+		file)
+	      extra-string)))
+    (when (zerop n)
+      (if (and filename
+	       (setq filename (file-name-directory filename))
+	       (equal filename
+		      (file-name-directory (directory-file-name filename))))
+	  ;; 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 (string directory-sep-char)))
+     ((eq uniquify-buffer-name-style 'reverse)
+      (let ((dirsep (string directory-sep-char)))
+	(mapconcat 'identity
+		   (cons base (nreverse extra-string))
+		   (or uniquify-separator "\\"))))
+     ((eq uniquify-buffer-name-style 'forward)
+      (mapconcat 'identity (nconc extra-string (list base))
+		 (string directory-sep-char)))
+     ((eq uniquify-buffer-name-style 'post-forward)
+      (concat base (or uniquify-separator "|")
+	      (mapconcat 'identity extra-string (string directory-sep-char))))
+     ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
+      (concat base "<" (mapconcat 'identity extra-string
+				  (string directory-sep-char)) ">"))
+     (t (error "Bad value for uniquify-buffer-name-style: %s"
+	       uniquify-buffer-name-style)))))
 
 
 ;; Deal with conflicting-sublist, all of whose elements have identical
@@ -343,21 +340,6 @@ in `uniquify-list-buffers-directory-modes', otherwise returns nil."
 	(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)))
-
-
 ;;; Hooks from the rest of Emacs
 
 ;; The logical place to put all this code is in generate-new-buffer-name.