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: Sun, 09 Jul 2023 15:38:46 +0000 (UTC) [thread overview]
Message-ID: <87edlhm6wq.fsf@catern.com> (raw)
In-Reply-To: <jwvy1m2sfto.fsf-monnier+emacs@gnu.org> (Stefan Monnier's message of "Fri, 05 May 2023 16:13:52 -0400")
Stefan Monnier <monnier@iro.umontreal.ca> 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))))))
\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..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))))
next prev parent reply other threads:[~2023-07-09 15:38 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 [this message]
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
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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87edlhm6wq.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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.