Subject: bug#62732: 29.0.60; uniquify-trailing-separator-p affects any buffer whose name matches a dir in CWD

From: [email-masked]
Date: Sun, 09 Jul 2023 15:38:46 +0000 (UTC)

Stefan Monnier <[email-masked]> writes:

>> This patch takes the approach of pulling uniquify-trailing-separator-p
>> out of uniquify and putting it into dired; now the trailing separator is
>> specified when the dired buffer is created.  This is incidentally also
>> vastly more efficient: The old way did n² filesystem accesses which is
>> not something we should be doing on every buffer creation/rename.
>
> It's indeed a better approach, thanks.
> I'm a bit annoyed at the need to add an argument to `create-file-buffer`
> and I wonder if we could avoid that by replacing:
>
>> +(defun dired--create-buffer (dirname)
>> +  "Create a buffer with an appropriate name for visiting this directory.
>> +
>> +Obeys `dired-trailing-separator'."
>> +  (let* ((filename (directory-file-name dirname))
>> +         (base (file-name-nondirectory filename)))
>> +    (create-file-buffer filename
>> +                        (if dired-trailing-separator
>> +                            (cond ((eq uniquify-buffer-name-style 'forward)
>> +	                           (file-name-as-directory base))
>> +	                          ((eq uniquify-buffer-name-style 'reverse)
>> +	                           (concat (or uniquify-separator "\\") base)))))))
>
> with
>
>     (defun dired--create-buffer (dirname)
>       "Create a buffer with an appropriate name for visiting this directory.
>     Obeys `dired-trailing-separator'."
>       (let* ((filename (directory-file-name dirname)))
>         (create-file-buffer (if dired-trailing-separator
>                                 (file-name-as-directory filename)
>                               filename))))
>
> or even just
>
>     (defun dired--create-buffer (dirname)
>       "Create a buffer with an appropriate name for visiting this directory."
>       (create-file-buffer (file-name-as-directory dirname)))
>
> and then do the rest inside `uniquify.el`.

This inspired me to do something not exactly this but which also gets
rid of the new argument to create-file-buffer.  How about this:

diff --git a/lisp/dired.el b/lisp/dired.el
index d14cf47ffd5..3c9e6e40f9b 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -1306,7 +1306,7 @@ dired-internal-noselect
 	 ;; Note that buffer already is in dired-mode, if found.
 	 (new-buffer-p (null buffer)))
     (or buffer
-        (setq buffer (create-file-buffer (directory-file-name dirname))))
+        (setq buffer (create-file-buffer dirname)))
     (set-buffer buffer)
     (if (not new-buffer-p)		; existing buffer ...
 	(cond (switches			; ... but new switches
diff --git a/lisp/files.el b/lisp/files.el
index d325729bf4d..4b5a877d1e3 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2062,22 +2062,30 @@ find-alternate-file
 	  (kill-buffer obuf))))))
 
 ;; FIXME we really need to fold the uniquify stuff in here by default,
-;; not using advice, and add it to the doc string.
 (defun create-file-buffer (filename)
   "Create a suitably named buffer for visiting FILENAME, and return it.
 FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name.
+otherwise the buffer is renamed according to
+`uniquify-buffer-name-style' to get an unused name.
 
 Emacs treats buffers whose names begin with a space as internal buffers.
 To avoid confusion when visiting a file whose name begins with a space,
 this function prepends a \"|\" to the final result if necessary."
-  (let* ((lastname (file-name-nondirectory filename))
-	 (lastname (if (string= lastname "")
-	               filename lastname))
-	 (buf (generate-new-buffer (if (string-prefix-p " " lastname)
-			               (concat "|" lastname)
-			             lastname))))
-    (uniquify--create-file-buffer-advice buf filename)
+  (let* ((lastname (if (directory-name-p filename)
+                       (file-name-nondirectory (directory-file-name filename))
+                     (file-name-nondirectory filename)))
+         (lastname (if (and (directory-name-p filename) uniquify-trailing-separator-p)
+                       (cond ((eq uniquify-buffer-name-style 'forward)
+	                      (file-name-as-directory lastname))
+	                     ((eq uniquify-buffer-name-style 'reverse)
+	                      (concat (or uniquify-separator "\\") lastname))
+                             (t lastname))
+                     lastname))
+         (basename (if (string-prefix-p " " lastname)
+		       (concat "|" lastname)
+		     lastname))
+	 (buf (generate-new-buffer basename)))
+    (uniquify--create-file-buffer-advice buf filename basename)
     buf))
 
 (defvar abbreviated-home-dir nil
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index dee9ecba2ea..bfb61eca16d 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -174,8 +174,8 @@ uniquify-list-buffers-directory-modes
 (cl-defstruct (uniquify-item
 	    (:constructor nil) (:copier nil)
 	    (:constructor uniquify-make-item
-	     (base dirname buffer &optional proposed original-dirname)))
-  base dirname buffer proposed original-dirname)
+	     (base dirname buffer &optional proposed)))
+  base dirname buffer proposed)
 
 ;; Internal variables used free
 (defvar uniquify-possibly-resolvable nil)
@@ -211,7 +211,7 @@ uniquify-rationalize-file-buffer-names
   (when dirname
     (setq dirname (expand-file-name (directory-file-name dirname)))
     (let ((fix-list (list (uniquify-make-item base dirname newbuf
-                                              nil dirname)))
+                                              nil)))
 	  items)
       (dolist (buffer (buffer-list))
 	(when (and (not (and uniquify-ignore-buffers-re
@@ -292,8 +292,7 @@ uniquify-rationalize
       (setf (uniquify-item-proposed item)
 	    (uniquify-get-proposed-name (uniquify-item-base item)
 					(uniquify-item-dirname item)
-                                        nil
-                                        (uniquify-item-original-dirname item)))
+                                        nil))
       (setq uniquify-managed fix-list)))
   ;; Strip any shared last directory names of the dirname.
   (when (and (cdr fix-list) uniquify-strip-common-suffix)
@@ -316,8 +315,7 @@ uniquify-rationalize
 					      (uniquify-item-dirname item))))
 				      (and f (directory-file-name f)))
 				    (uniquify-item-buffer item)
-				    (uniquify-item-proposed item)
-                                    (uniquify-item-original-dirname 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.
@@ -345,21 +343,10 @@ uniquify-rationalize-a-list
     (uniquify-rationalize-conflicting-sublist conflicting-sublist
 					      old-proposed depth)))
 
-(defun uniquify-get-proposed-name (base dirname &optional depth
-                                        original-dirname)
+(defun uniquify-get-proposed-name (base dirname &optional depth)
   (unless depth (setq depth uniquify-min-dir-content))
   (cl-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 original-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)
@@ -421,8 +408,7 @@ uniquify-rationalize-conflicting-sublist
 		  (uniquify-get-proposed-name
 		   (uniquify-item-base item)
 		   (uniquify-item-dirname item)
-		   depth
-                   (uniquify-item-original-dirname item))))
+		   depth)))
 	  (uniquify-rationalize-a-list conf-list depth))
       (unless (string= old-name "")
 	(uniquify-rename-buffer (car conf-list) old-name)))))
@@ -492,13 +478,13 @@ uniquify--rename-buffer-advice

 ;; (advice-add 'create-file-buffer :around #'uniquify--create-file-buffer-advice)
-(defun uniquify--create-file-buffer-advice (buf filename)
+(defun uniquify--create-file-buffer-advice (buf filename basename)
   ;; BEWARE: This is called directly from `files.el'!
   "Uniquify buffer names with parts of directory name."
   (when uniquify-buffer-name-style
     (let ((filename (expand-file-name (directory-file-name filename))))
       (uniquify-rationalize-file-buffer-names
-       (file-name-nondirectory filename)
+       basename
        (file-name-directory filename)
        buf))))