Package: emacs;
Reported by: sbaugh <at> catern.com
Date: Sun, 9 Apr 2023 01:38:02 UTC
Severity: normal
Found in version 29.0.60
Done: Stefan Monnier <monnier <at> iro.umontreal.ca>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: sbaugh <at> catern.com To: 62732 <at> debbugs.gnu.org Subject: bug#62732: 29.0.60; uniquify-trailing-separator-p affects any buffer whose name matches a dir in CWD Date: Sun, 09 Apr 2023 01:49:51 +0000 (UTC)
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.
Also, this approach is in line with other simplifications of uniquify
that I'd like to make (as part of implementing bug#62621).
Also, now there are tests for uniquify.
diff --git a/lisp/dired.el b/lisp/dired.el
index 4a4ecc901c4..12629dbbd87 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -490,6 +490,17 @@ dired-guess-shell-znew-switches
(string :tag "Switches"))
:version "29.1")
+(defcustom dired-trailing-separator nil
+ "If non-nil, add a file name separator to dired buffer names.
+For example, \"dir/\" instead of \"dir\".
+
+Normally the separator is added at the end and matches the
+platform convention for path separators. If
+`uniquify-buffer-name-style' is `reverse', add the separator at
+the beginning, and use `uniquify-separator' for the separator."
+ :type 'boolean
+ :group 'dired)
+
;;; Internal variables
@@ -1285,6 +1296,19 @@ dired--align-all-files
(insert-char ?\s distance 'inherit))
(forward-line)))))))
+(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)))))))
+
(defun dired-internal-noselect (dir-or-list &optional switches mode)
;; If DIR-OR-LIST is a string and there is an existing dired buffer
;; for it, just leave buffer as it is (don't even call dired-revert).
@@ -1306,7 +1330,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 (dired--create-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..75495ab608e 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2062,22 +2062,27 @@ 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 basename)
"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 BASENAME is non-nil, it will be used as the buffer name.
+FILENAME will only be used to rename the buffer according to
+`uniquify-buffer-name-style' to get an unused name.
+"
(let* ((lastname (file-name-nondirectory filename))
(lastname (if (string= lastname "")
filename lastname))
- (buf (generate-new-buffer (if (string-prefix-p " " lastname)
+ (buf (generate-new-buffer (or basename (if (string-prefix-p " " lastname)
(concat "|" lastname)
- lastname))))
- (uniquify--create-file-buffer-advice buf filename)
+ lastname)))))
+ (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..6c0f5468faa 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -147,12 +147,14 @@ uniquify-separator
file name components (default \"\\\")."
:type '(choice (const nil) string))
-(defcustom uniquify-trailing-separator-p nil
- "If non-nil, add a file name separator to dired buffer names.
-If `uniquify-buffer-name-style' is `forward', add the separator at the end;
-if it is `reverse', add the separator at the beginning; otherwise, this
-variable is ignored."
- :type 'boolean)
+(defvaralias
+ 'uniquify-trailing-separator-p
+ 'dired-trailing-separator)
+
+(make-obsolete-variable
+ 'uniquify-trailing-separator-p
+ 'dired-trailing-separator
+ "30.1")
(defcustom uniquify-strip-common-suffix
;; Using it when uniquify-min-dir-content>0 doesn't make much sense.
@@ -174,8 +176,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 +213,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 +294,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 +317,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 +345,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 +410,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 +480,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
+ (or basename (file-name-nondirectory filename))
+ (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..70f7125cbe9
--- /dev/null
+++ b/test/lisp/uniquify-tests.el
@@ -0,0 +1,111 @@
+;;; uniquify-tests.el --- Tests for uniquify -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Spencer Baugh <sbaugh <at> 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))))
+
+(provide 'uniquify-tests)
+;;; uniquify-tests.el ends here
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.