From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Eli Zaretskii 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: Fri, 05 May 2023 09:06:35 +0300 Message-ID: <837ctnjor8.fsf@gnu.org> References: <87h6tpn8d5.fsf@catern.com> <87edotn7sx.fsf@catern.com> <87a5zhmexh.fsf@catern.com> <87leilkl3i.fsf@catern.com> Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="9173"; mail-complaints-to="usenet@ciao.gmane.io" Cc: 62732@debbugs.gnu.org To: sbaugh@catern.com, Stefan Monnier , Lars Ingebrigtsen Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri May 05 08:06:27 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 1puoaI-00027B-MW for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 05 May 2023 08:06:27 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1puoZw-0003y5-3G; Fri, 05 May 2023 02:06:04 -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 1puoZu-0003xp-Oe for bug-gnu-emacs@gnu.org; Fri, 05 May 2023 02:06:02 -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 1puoZu-0005It-Dz for bug-gnu-emacs@gnu.org; Fri, 05 May 2023 02:06:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1puoZu-00070B-8V for bug-gnu-emacs@gnu.org; Fri, 05 May 2023 02:06:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Eli Zaretskii Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 05 May 2023 06:06:02 +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.168326675226896 (code B ref 62732); Fri, 05 May 2023 06:06:02 +0000 Original-Received: (at 62732) by debbugs.gnu.org; 5 May 2023 06:05:52 +0000 Original-Received: from localhost ([127.0.0.1]:52963 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1puoZj-0006zj-AU for submit@debbugs.gnu.org; Fri, 05 May 2023 02:05:52 -0400 Original-Received: from eggs.gnu.org ([209.51.188.92]:46602) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1puoZh-0006zU-7T for 62732@debbugs.gnu.org; Fri, 05 May 2023 02:05:50 -0400 Original-Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1puoZb-0005AU-Mo; Fri, 05 May 2023 02:05:43 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=oiq+tBT7Yv991Gd48NVMTUaQUQT7tOy6HwObSbU8/as=; b=TJsWMR/fiRr4 Trhh9Nv9dwn0faf6yTAXEy4Fhn8n2kgLSSm/hLpPWFBPG72wR+Pjxr2pPMuhnjSw9aebZj8/Qt7Ws HVRdtazRWg2TShMt08GPyVrfvuFn8CnZ+erdNqXMp1pQAbDX3XQnwBPNYfAyt7RD1ak0Yf3zetW3K eOfqUhylpoLbSs/B0SSViyy/XEbrwvY/Q3SD2j4RSZowT8ffrRNhBlTa1MG2nXz0KJKlst+hoEoTI 9GuqYS9ylRCOJwiDefTpcITIrt4PicVwEGUb7/u6+gWLYB6lAMYjRP51OQXJ78gXlhQBZ8reqGJm5 +BCpAjyL0EmtQYEGCOga1A==; Original-Received: from [87.69.77.57] (helo=home-c4e4a596f7) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1puoZb-0008AH-5o; Fri, 05 May 2023 02:05:43 -0400 In-Reply-To: <87leilkl3i.fsf@catern.com> (sbaugh@catern.com) 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:261064 Archived-At: 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 > 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)))))) > > ;; 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 > + > +;; 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 . > + > +;;; 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" "z")) > + (push (find-file-noselect "a/b/d/z") bufs) > + (names-are '("z" "z" "z")) > + (push (find-file-noselect "e/b/z") bufs) > + (names-are '("z" "z" "z" "z")) > + ;; buffers without a buffer-file-name don't get uniquified by uniquify > + (push (generate-new-buffer "z") bufs) > + (names-are '("z" "z" "z" "z" "z")) > + ;; but they do get uniquified by the C code which uses > + (push (generate-new-buffer "z") bufs) > + (names-are '("z<2>" "z" "z" "z" "z" "z")) > + (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" "z<2>" "z" "z" "z" "z" "z") 'nosave) > + ;; somewhat confusing behavior results if a buffer is renamed to match an already-uniquified buffer > + (rename-buffer "z" t) > + (names-are '("z" "z<2>" "z" "z" "z" "z" "z") '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 >