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

[sbaugh]

Simplified and combined the previous two patches, now with a nice commit
message and changelog.  Also, stopped moving this functionality into
dired, that's not really necessary.

Most of this change is tests, and most of the remainder is moving the
uniquify-trailing-separator-p code without changes from uniquify.el into
create-file-buffer.  Hopefully it is fairly easy to review.

>From ebd49cb05f5c0db643e4a616bad23565eef53b75 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@catern.com>
Date: Sun, 9 Apr 2023 08:10:52 -0400
Subject: [PATCH] Don't recalculate the buffer basename inside uniquify

Previously, uniquify--create-file-buffer-advice would use the filename
of the buffer to calculate what the buffer's basename should be.  Now
that gets passed in from create-file-buffer, which lets us fix several
bugs:

1. Before this patch, if a buffer happened to be named the same thing
as directory in its default-directory, the buffer would get renamed
with a directory separator according to uniquify-trailing-separator-p.

2. Buffers with a leading space should get a leading |, as described
by create-file-buffer's docstring; before this patch, uniquify would
remove that leading |.

* lisp/dired.el (dired-internal-noselect): Pass t to
create-file-buffer for the new directory argument.
* lisp/files.el (create-file-buffer): Add a new directory argument to
handle uniquify-trailing-separator-p, and pass the desired basename to
uniquify directly.
* lisp/uniquify.el (uniquify-item):
(uniquify-rationalize-file-buffer-names, uniquify-rationalize,
uniquify-get-proposed-name, uniquify-rationalize-conflicting-sublist):
Remove uniquify-trailing-separator-p handling.
(uniquify--create-file-buffer-advice): Take new basename argument and
use it, instead of recalculating the basename from the filename.
---
 lisp/dired.el               |   2 +-
 lisp/files.el               |  26 +++++---
 lisp/uniquify.el            |  32 +++-------
 test/lisp/uniquify-tests.el | 118 ++++++++++++++++++++++++++++++++++++
 4 files changed, 146 insertions(+), 32 deletions(-)
 create mode 100644 test/lisp/uniquify-tests.el

diff --git a/lisp/dired.el b/lisp/dired.el
index 4a4ecc901c4..62ff98c5279 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 (directory-file-name dirname) t)))
     (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..ada3d19442f 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2062,22 +2062,32 @@ 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)
+(defun create-file-buffer (filename &optional directory)
   "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."
+this function prepends a \"|\" to the final result if necessary.
+
+If DIRECTORY is non-nil, a file name separator will be added to
+the buffer name according to `uniquify-trailing-separator-p'."
   (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)
+         (lastname (if (and directory 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)))
+                     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))))
 
diff --git a/test/lisp/uniquify-tests.el b/test/lisp/uniquify-tests.el
new file mode 100644
index 00000000000..89976add164
--- /dev/null
+++ b/test/lisp/uniquify-tests.el
@@ -0,0 +1,118 @@
+;;; uniquify-tests.el --- Tests for uniquify         -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Spencer Baugh <sbaugh@janestreet.com>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'ert)
+
+(ert-deftest uniquify-basic ()
+  (let (bufs old-names)
+    (cl-flet ((names-are (current-names &optional nosave)
+                (should (equal (mapcar #'buffer-name bufs) current-names))
+                (unless nosave (push current-names old-names))))
+      (should (eq (get-buffer "z") nil))
+      (push (find-file-noselect "a/b/z") bufs)
+      (names-are '("z"))
+      (push (find-file-noselect "a/b/c/z") bufs)
+      (names-are '("z<c>" "z<b>"))
+      (push (find-file-noselect "a/b/d/z") bufs)
+      (names-are '("z<d>" "z<c>" "z<b>"))
+      (push (find-file-noselect "e/b/z") bufs)
+      (names-are '("z<e/b>" "z<d>" "z<c>" "z<a/b>"))
+      ;; buffers without a buffer-file-name don't get uniquified by uniquify
+      (push (generate-new-buffer "z") bufs)
+      (names-are '("z" "z<e/b>" "z<d>" "z<c>" "z<a/b>"))
+      ;; but they do get uniquified by the C code which uses <n>
+      (push (generate-new-buffer "z") bufs)
+      (names-are '("z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>"))
+      (save-excursion
+        ;; uniquify will happily work with file-visiting buffers whose names 
don't match buffer-file-name
+        (find-file "f/y")
+        (push (current-buffer) bufs)
+        (rename-buffer "z" t)
+        (names-are '("z<f>" "z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>") 
'nosave)
+        ;; somewhat confusing behavior results if a buffer is renamed to match 
an already-uniquified buffer
+        (rename-buffer "z<a/b>" t)
+        (names-are '("z<a/b><f>" "z<2>" "z" "z<e/b>" "z<d>" "z<c>" "z<a/b>") 
'nosave))
+      (while bufs
+        (kill-buffer (pop bufs))
+        (names-are (pop old-names) 'nosave)))))
+
+(ert-deftest uniquify-dirs ()
+  "Check strip-common-suffix and trailing-separator-p work together; bug#47132"
+  (let* ((root (make-temp-file "emacs-uniquify-tests" 'dir))
+         (a-path (file-name-concat root "a/x/y/dir"))
+         (b-path (file-name-concat root "b/x/y/dir")))
+    (make-directory a-path 'parents)
+    (make-directory b-path 'parents)
+    (let ((uniquify-buffer-name-style 'forward)
+          (uniquify-strip-common-suffix t)
+          (uniquify-trailing-separator-p nil))
+      (let ((bufs (list (find-file-noselect a-path)
+                       (find-file-noselect b-path))))
+        (should (equal (mapcar #'buffer-name bufs)
+                       '("a/dir" "b/dir")))
+        (mapc #'kill-buffer bufs)))
+    (let ((uniquify-buffer-name-style 'forward)
+          (uniquify-strip-common-suffix nil)
+          (uniquify-trailing-separator-p t))
+      (let ((bufs (list (find-file-noselect a-path)
+                       (find-file-noselect b-path))))
+        (should (equal (mapcar #'buffer-name bufs)
+                       '("a/x/y/dir/" "b/x/y/dir/")))
+        (mapc #'kill-buffer bufs)))
+    (let ((uniquify-buffer-name-style 'forward)
+          (uniquify-strip-common-suffix t)
+          (uniquify-trailing-separator-p t))
+      (let ((bufs (list (find-file-noselect a-path)
+                       (find-file-noselect b-path))))
+        (should (equal (mapcar #'buffer-name bufs)
+                       '("a/dir/" "b/dir/")))
+        (mapc #'kill-buffer bufs)))))
+
+(ert-deftest uniquify-rename-to-dir ()
+  "Giving a buffer a name which matches a directory doesn't rename the buffer"
+  (let ((uniquify-buffer-name-style 'forward)
+        (uniquify-trailing-separator-p t))
+      (save-excursion
+        (find-file "../README")
+        (rename-buffer "lisp" t)
+        (should (equal (buffer-name) "lisp"))
+        (kill-buffer))))
+
+(ert-deftest uniquify-separator-style-reverse ()
+  (let ((uniquify-buffer-name-style 'reverse)
+        (uniquify-trailing-separator-p t))
+    (save-excursion
+      (should (file-directory-p "../lib-src"))
+      (find-file "../lib-src")
+      (should (equal (buffer-name) "\\lib-src"))
+      (kill-buffer))))
+
+(ert-deftest uniquify-space-prefix ()
+  "If a buffer starts with a space, | is added at the start"
+  (save-excursion
+    (find-file " foo")
+    (should (equal (buffer-name) "| foo"))
+    (kill-buffer)))
+
+(provide 'uniquify-tests)
+;;; uniquify-tests.el ends here
-- 
2.38.0