From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: sbaugh@catern.com Newsgroups: gmane.emacs.bugs 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) Message-ID: <87edlhm6wq.fsf@catern.com> References: <87h6tpn8d5.fsf@catern.com> <87edotn7sx.fsf@catern.com> Mime-Version: 1.0 Content-Type: text/plain; charset=iso-8859-1 Content-Transfer-Encoding: quoted-printable Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="20936"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 62732@debbugs.gnu.org To: Stefan Monnier Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Jul 09 17:39:24 2023 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1qIWVP-0005Cf-Ph for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 09 Jul 2023 17:39:24 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qIWV7-0003w0-11; Sun, 09 Jul 2023 11:39:05 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1qIWV5-0003vl-0X for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2023 11:39:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qIWV4-0001bd-7h for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2023 11:39:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qIWV3-0002sL-NT for bug-gnu-emacs@gnu.org; Sun, 09 Jul 2023 11:39:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: sbaugh@catern.com Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 09 Jul 2023 15:39:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62732 X-GNU-PR-Package: emacs Original-Received: via spool by 62732-submit@debbugs.gnu.org id=B62732.168891713711041 (code B ref 62732); Sun, 09 Jul 2023 15:39:01 +0000 Original-Received: (at 62732) by debbugs.gnu.org; 9 Jul 2023 15:38:57 +0000 Original-Received: from localhost ([127.0.0.1]:46989 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qIWUy-0002s0-Ux for submit@debbugs.gnu.org; Sun, 09 Jul 2023 11:38:57 -0400 Original-Received: from s.wrqvtzvf.outbound-mail.sendgrid.net ([149.72.126.143]:38976) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qIWUu-0002rf-PZ for 62732@debbugs.gnu.org; Sun, 09 Jul 2023 11:38:56 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=catern.com; h=from:subject:in-reply-to:references:mime-version:to:cc:content-type: content-transfer-encoding:cc:content-type:from:subject:to; s=s1; bh=jUsELwxdb7ddXHKLHU44T2BC/UZcaHYLVAdGJJBxRWg=; b=mf9YNOTOMGBNU/JVaITHoyyuBNMHr9Jiv1zOjUcbV5U29yzSJrtJ8Mjo8m41RpnSy4YU 3Slgq3JrsRXE0P2sZAAx2TMTVgP01krV+n+6kx8tgGQ4bBLtXfohnyoHF2ZPeZWDA0q5wB dzvO8H2V6ztzvLh8UTMKFaWbh02G8rXNcW0OtlVwrdrHVF4RKSSvnkgQW54nJMVHCsvujN ErA9l13Wis2uFk4xeRmMRpee2XUgXaEPMBFQpyuGJAUMMUyUjP2dG4jltXwxzPbfHmJfdI asqz9yUAwGFUFkqcnacR7VVxQD6U8bsn/xVDSPTUo92WFUv7Mz0rC9ulDYrMAgFg== Original-Received: by filterdrecv-84b96456cb-6l8hp with SMTP id filterdrecv-84b96456cb-6l8hp-1-64AAD486-F 2023-07-09 15:38:46.347736046 +0000 UTC m=+5155216.943145572 Original-Received: from earth.catern.com (unknown) by geopod-ismtpd-24 (SG) with ESMTP id JpByjBsfRamGnQsc9YE1xQ Sun, 09 Jul 2023 15:38:46.175 +0000 (UTC) X-Comment: SPF check N/A for local connections - client-ip=::1; helo=localhost; envelope-from=sbaugh@catern.com; receiver=iro.umontreal.ca Original-Received: from localhost (localhost [IPv6:::1]) by earth.catern.com (Postfix) with ESMTPSA id ACD266016A; Sun, 9 Jul 2023 11:38:45 -0400 (EDT) In-Reply-To: (Stefan Monnier's message of "Fri, 05 May 2023 16:13:52 -0400") X-SG-EID: ZgbRq7gjGrt0q/Pjvxk7wM0yQFRdOkTJAtEbkjCkHbLYDRRWAdCrwe/rlQ+y3ROIrtmltgL6XTJQdwvTGbkD5n3jYbclNPoTB4Wob1WKe30+PoSLPrNx90Y58B2hFcaQK1ZRNEzRwfw68GL9x0P4rMoPYVds7aI8O8MWHqovZ0ZBtWbPCSPPbDcNV1p8Twe6KPvA8FF/bzoUvf+0DjwXsA== X-Entity-ID: d/0VcHixlS0t7iB1YKCv4Q== X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:264841 Archived-At: Stefan Monnier 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=B2 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 'forw= ard) >> + (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 directo= ry. > 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 directo= ry." > (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)))))) =0C ;; 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. =20 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=3D 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 filena= me)) + (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)) =20 (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) =20 ;; 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 it= em))) + 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))) =20 -(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 s= lash. =20 - ;; 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=3D old-name "") (uniquify-rename-buffer (car conf-list) old-name))))) @@ -492,13 +478,13 @@ uniquify--rename-buffer-advice =20 =20 ;; (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)))) =20