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

[Eli Zaretskii <eliz@gnu.org>]

Stefan, Lars: any comments?

> From: sbaugh@catern.com
> Date: Fri, 21 Apr 2023 20:59:30 +0000 (UTC)
> 
> 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))))))
>  \f
>  ;; 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
>