unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
From: sbaugh@catern.com
To: Stefan Monnier <monnier@iro.umontreal.ca>
Cc: 62732@debbugs.gnu.org
Subject: bug#62732: 29.0.60; uniquify-trailing-separator-p affects any buffer whose name matches a dir in CWD
Date: Mon, 10 Jul 2023 01:36:00 +0000 (UTC)	[thread overview]
Message-ID: <87o7kklf9c.fsf@catern.com> (raw)
In-Reply-To: <jwvilatvz9y.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Sun, 09 Jul 2023 12:15:58 -0400")

[-- Attachment #1: Type: text/plain, Size: 298 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:
>> 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:
>
> Now you're talking!  :-)
> LGTM!  Thank you very much,

Great!  Here's that as a complete patch again.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Don-t-recalculate-the-buffer-basename-inside-uniquif.patch --]
[-- Type: text/x-patch, Size: 14210 bytes --]

From 46804cd388d3ca05c0ad2054a0fcf3aba80b651c Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@catern.com>
Date: Sun, 9 Jul 2023 10:24:33 -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 a directory name to
create-file-buffer.
* lisp/files.el (create-file-buffer): Do uniquify-trailing-separator-p
handling if passed a directory filename.
* 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            |  39 ++++-------
 test/lisp/uniquify-tests.el | 129 ++++++++++++++++++++++++++++++++++++
 4 files changed, 159 insertions(+), 37 deletions(-)
 create mode 100644 test/lisp/uniquify-tests.el

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))))))
 \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)
   "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..d1ca455b673 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,15 +478,14 @@ 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)
-       (file-name-directory filename)
-       buf))))
+    (uniquify-rationalize-file-buffer-names
+     basename
+     (file-name-directory (expand-file-name (directory-file-name filename)))
+     buf)))
 
 (defun uniquify-unload-function ()
   "Unload the uniquify library."
diff --git a/test/lisp/uniquify-tests.el b/test/lisp/uniquify-tests.el
new file mode 100644
index 00000000000..abd61fa3504
--- /dev/null
+++ b/test/lisp/uniquify-tests.el
@@ -0,0 +1,129 @@
+;;; 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-separator-ignored ()
+  "If uniquify-buffer-name-style isn't forward or reverse,
+uniquify-trailing-separator-p is ignored"
+  (let ((uniquify-buffer-name-style 'post-forward-angle-brackets)
+        (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.41.0


  reply	other threads:[~2023-07-10  1:36 UTC|newest]

Thread overview: 44+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2023-04-09  1:37 bug#62732: 29.0.60; uniquify-trailing-separator-p affects any buffer whose name matches a dir in CWD sbaugh
2023-04-09  1:49 ` sbaugh
2023-04-09 12:13   ` sbaugh
2023-04-21 20:59     ` sbaugh
2023-05-05  6:06       ` Eli Zaretskii
2023-07-03 18:54         ` sbaugh
2023-07-03 19:19           ` Eli Zaretskii
2023-05-05 20:30     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-08 17:48       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-09 14:49         ` sbaugh
2023-05-05 20:13   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-05 20:37     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-05-05 21:14     ` Spencer Baugh
2023-07-09 15:38     ` sbaugh
2023-07-09 16:15       ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-10  1:36         ` sbaugh [this message]
2023-07-10  2:04           ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-10  2:55             ` sbaugh
2023-07-10  3:38               ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-10 12:57             ` Eli Zaretskii
2023-07-10 12:56           ` Eli Zaretskii
2023-07-10 13:39             ` Spencer Baugh
2023-07-10 14:25               ` Eli Zaretskii
2023-07-10 16:53             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-10 19:12               ` Eli Zaretskii
2023-07-10 19:18                 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-11  2:25                   ` Eli Zaretskii
2023-07-11  2:55                     ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-11 12:01                       ` Eli Zaretskii
2023-07-11 12:31                         ` Spencer Baugh
2023-07-11 15:31                           ` Eli Zaretskii
2023-07-12 13:04                             ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-12 13:42                               ` Eli Zaretskii
2023-07-12 13:57                                 ` Spencer Baugh
2023-07-12 19:43                                   ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-07-13  4:50                                 ` Eli Zaretskii
2023-07-13 15:52                                   ` sbaugh
2023-07-13 16:02                                     ` Eli Zaretskii
2023-07-13 16:21                                       ` sbaugh
2023-07-17  5:03                                         ` Michael Heerdegen
2023-07-17 11:35                                           ` Eli Zaretskii
2023-07-18  4:13                                             ` Michael Heerdegen
2023-07-18 11:12                                               ` Eli Zaretskii
2023-07-13 21:51                                 ` Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.gnu.org/software/emacs/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=87o7kklf9c.fsf@catern.com \
    --to=sbaugh@catern.com \
    --cc=62732@debbugs.gnu.org \
    --cc=monnier@iro.umontreal.ca \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line before the message body.
Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).