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: Thu, 13 Jul 2023 15:52:54 +0000 (UTC) Message-ID: <87mszzkduy.fsf@catern.com> References: <87h6tpn8d5.fsf@catern.com> <87edotn7sx.fsf@catern.com> <87edlhm6wq.fsf@catern.com> <87o7kklf9c.fsf@catern.com> <83r0pf9b7d.fsf@gnu.org> <83fs5v8tsw.fsf@gnu.org> <83edlf89qp.fsf@gnu.org> <83v8eq7j3i.fsf@gnu.org> <83pm4y79dw.fsf@gnu.org> <83y1jl5jrq.fsf@gnu.org> <83o7kg5s9o.fsf@gnu.org> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="21379"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: sbaugh@janestreet.com, monnier@iro.umontreal.ca, 62732@debbugs.gnu.org To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Jul 13 17:54:21 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 1qJye4-0005FC-Gq for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 13 Jul 2023 17:54:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1qJydn-0004zf-I1; Thu, 13 Jul 2023 11:54:03 -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 1qJydm-0004zH-HN for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2023 11:54:02 -0400 Original-Received: from [2001:470:142:5::43] (helo=debbugs.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1qJydm-00034F-9d for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2023 11:54:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1qJydl-0001Wb-M9 for bug-gnu-emacs@gnu.org; Thu, 13 Jul 2023 11:54: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: Thu, 13 Jul 2023 15:54: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.16892635835794 (code B ref 62732); Thu, 13 Jul 2023 15:54:01 +0000 Original-Received: (at 62732) by debbugs.gnu.org; 13 Jul 2023 15:53:03 +0000 Original-Received: from localhost ([127.0.0.1]:40624 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qJyco-0001VN-TR for submit@debbugs.gnu.org; Thu, 13 Jul 2023 11:53:03 -0400 Original-Received: from s.wrqvwxzv.outbound-mail.sendgrid.net ([149.72.154.232]:56420) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1qJycl-0001Uq-Gx for 62732@debbugs.gnu.org; Thu, 13 Jul 2023 11:53:01 -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: cc:content-type:from:subject:to; s=s1; bh=RI6NGXYLZKTTSPDI88D0//A4eN5G9DeWw4aie8nduu4=; b=A3SDDQWHEUD+DIU/rvQkgnS7vsh2Fx/QRWgya7ejWfPfvLwE5F+a+eSgUBeTRFsUtkA1 nWiCNP1Jd8dzHtEyvuj1MP7FcV0f2+mscJD/9dy10zuNl6ZfU17urZiB6HyAcg9EyKqXKR 7GoQvxmL+rlgbS5/en6XgBXQOtYM+zd6IfgpwNQ64Wd7xC2V6YOGKX3vbsRp62d2xyUerq m2Vvr34KqyS2F1plpruvtj+vRYleGXiST9OfLkgZ+YIOM1Xm6ikQMEWj2cO5liNJMFmetI zDW6/5NvDkJxVXqfF4fc56iGc8dc0nVe0kvHqJgP0FrnBC5Erzt4cSROgVW1B87Q== Original-Received: by filterdrecv-66949dbc98-fl57f with SMTP id filterdrecv-66949dbc98-fl57f-1-64B01DD5-46 2023-07-13 15:52:53.951187742 +0000 UTC m=+1603060.932133059 Original-Received: from earth.catern.com (unknown) by geopod-ismtpd-27 (SG) with ESMTP id P0n59xcxROO-yv_TnRdaUQ Thu, 13 Jul 2023 15:52:53.864 +0000 (UTC) X-Comment: SPF check N/A for local connections - client-ip=::1; helo=localhost; envelope-from=sbaugh@catern.com; receiver=gnu.org Original-Received: from localhost (localhost [IPv6:::1]) by earth.catern.com (Postfix) with ESMTPSA id 5EED66009C; Thu, 13 Jul 2023 11:52:53 -0400 (EDT) In-Reply-To: <83o7kg5s9o.fsf@gnu.org> (Eli Zaretskii's message of "Thu, 13 Jul 2023 07:50:43 +0300") X-SG-EID: ZgbRq7gjGrt0q/Pjvxk7wM0yQFRdOkTJAtEbkjCkHbKvBGMA+vX4QcKaH0JOXNkBPTOp4MzTbLTQ2U7UFm6M8hCLsuXcP16Bmxohn3klLenuNRf/nN1HICSRPVAKOjwCn2M4kU/WggWGMGK7WqypJ7dglvXIzmtgDQCuIPcVYYOmMrhCasWdtJRe7QEXPOZ2XqKUA2qxZz9YfLXE9g9pxA== 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:265025 Archived-At: --=-=-= Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit Eli Zaretskii writes: >> Cc: sbaugh@janestreet.com, 62732@debbugs.gnu.org, sbaugh@catern.com >> Date: Wed, 12 Jul 2023 16:42:01 +0300 >> From: Eli Zaretskii >> >> > I can see 3 ways to provide this info: >> > >> > 1- use `file-directory-p`. >> > 2- add a boolean `directory` argument to `create-file-buffer`. >> > 3- use the presence of a trailing directory separator in the filename. >> > >> > Those 3 are very close to each other, in practice, so we're pretty much >> > in bikeshed territory. >> > >> > My preference is (3) first, (2) second, and (1) last. >> >> I prefer (1), because it avoids requesting the callers to remember to >> ensure that every directory ends in a slash. > > So how about compromising on a variant of (2): we add an optional > DIRECTORY-P argument, and if FILENAME doesn't end in a slash, but > DIRECTORY-P is non-nil, create-file-buffer will append a slash? Okay, so like this? BTW, would you be okay with moving uniquify-trailing-separator-p into dired, as I described in my other recent email? Then create-file-buffer wouldn't need to check it, which would simplify its docstring slightly; instead dired would just decide whether to pass a directory name or file name based on uniquify-trailing-separator-p. Since I'm changing this area anyway, now would be the time to make that change, as a nice cleanup which Stefan also likes. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Don-t-recalculate-the-buffer-basename-inside-uniquif.patch >From 023b8e7a715374e59a5456075b98d1422659cfe6 Mon Sep 17 00:00:00 2001 From: Spencer Baugh 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. (bug#62732) * 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 | 25 ++++--- lisp/uniquify.el | 39 ++++------- test/lisp/uniquify-tests.el | 129 ++++++++++++++++++++++++++++++++++++ 4 files changed, 158 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..f1b3b6be4f4 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2062,22 +2062,29 @@ 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) "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 (file-name-nondirectory (directory-file-name filename))) + (lastname (cond + ((not (and uniquify-trailing-separator-p (directory-name-p filename))) + lastname) + ((eq uniquify-buffer-name-style 'forward) + (file-name-as-directory lastname)) + ((eq uniquify-buffer-name-style 'reverse) + (concat (or uniquify-separator "\\") lastname)) + (t 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 + +;; 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-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 --=-=-=--