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: Fri, 21 Apr 2023 20:59:30 +0000 (UTC) Message-ID: <87leilkl3i.fsf@catern.com> References: <87h6tpn8d5.fsf@catern.com> <87edotn7sx.fsf@catern.com> <87a5zhmexh.fsf@catern.com> 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="34935"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) To: 62732@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Fri Apr 21 23:00:22 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 1ppxrf-0008ut-Ov for geb-bug-gnu-emacs@m.gmane-mx.org; Fri, 21 Apr 2023 23:00:20 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ppxrT-0003la-11; Fri, 21 Apr 2023 17:00:07 -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 1ppxrQ-0003lI-EH for bug-gnu-emacs@gnu.org; Fri, 21 Apr 2023 17:00:04 -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 1ppxrP-0006At-RW for bug-gnu-emacs@gnu.org; Fri, 21 Apr 2023 17:00:04 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ppxrP-00058H-Co for bug-gnu-emacs@gnu.org; Fri, 21 Apr 2023 17:00:03 -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: Fri, 21 Apr 2023 21:00:03 +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.168211078019639 (code B ref 62732); Fri, 21 Apr 2023 21:00:03 +0000 Original-Received: (at 62732) by debbugs.gnu.org; 21 Apr 2023 20:59:40 +0000 Original-Received: from localhost ([127.0.0.1]:41278 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ppxr1-00056g-Oz for submit@debbugs.gnu.org; Fri, 21 Apr 2023 16:59:40 -0400 Original-Received: from s.wrqvtzvf.outbound-mail.sendgrid.net ([149.72.126.143]:28982) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ppxqy-00056P-5g for 62732@debbugs.gnu.org; Fri, 21 Apr 2023 16:59:38 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=catern.com; h=from:subject:in-reply-to:references:mime-version:to:content-type:cc: content-type:from:subject:to; s=s1; bh=nkVGh2Gt6JU0yRYvhSpiUTWgAOyAbShXStLritVK+QI=; b=N+WLK09VHVx4wc+BRvVPyNyhq08l/bBPbClsgtyQBR9jIl3igqv3grKGlz0XV6GAkl61 wzcY9delzUKuz/37nQvRR/BG9UBxsE+ZlKMRdwhYZ3BMDqFapbPmgb4u3ULzqeL4yanei7 ES53aOfDxDDNfrNGOj+GMdZE8+qo7DkxYarb6LIJu82GbOJAT0qbL3IAQwSlq0VGY2t7J5 w0H5g+CIDBewjID2PXxl2kGst20bvIF7JGDRnImAzaa/VOhJ8R1utkQVnFIUhgUn5R3Lxz z4QqPBj4oqRdT52QsCOjyYrWnSFbdV9NO0Bs+fpUuInJtXu7jgjvYlpoUrXL7zqg== Original-Received: by filterdrecv-7946957d94-d4bhm with SMTP id filterdrecv-7946957d94-d4bhm-1-6442F932-2 2023-04-21 20:59:30.056140684 +0000 UTC m=+5088463.725224881 Original-Received: from earth.catern.com (unknown) by geopod-ismtpd-23 (SG) with ESMTP id hwTauytyThee53fyBrSUuA for <62732@debbugs.gnu.org>; Fri, 21 Apr 2023 20:59:29.855 +0000 (UTC) X-Comment: SPF check N/A for local connections - client-ip=::1; helo=localhost; envelope-from=sbaugh@catern.com; receiver= Original-Received: from localhost (localhost [IPv6:::1]) by earth.catern.com (Postfix) with ESMTPSA id 4C67760044 for <62732@debbugs.gnu.org>; Fri, 21 Apr 2023 16:59:29 -0400 (EDT) In-Reply-To: <87a5zhmexh.fsf@catern.com> (sbaugh@catern.com's message of "Sun, 09 Apr 2023 12:13:31 +0000 (UTC)") X-SG-EID: ZgbRq7gjGrt0q/Pjvxk7wM0yQFRdOkTJAtEbkjCkHbKUChhXOPgLxgIoL6nH2xwgfcWI6K6qvsJpoGwbCQoMy22MkfZqsgmS8MKLlMf/f78ZevwWLAZOXOagRSDPVvKJYvM7BllNU1ZBLMs3dcSWAemyasbHCp1To7wxpxMPUS/yHbWTLjedrq+KTKtBGnANVysXSgaCPrZbyoNBQhEFjw== 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:260416 Archived-At: --=-=-= Content-Type: text/plain; charset=us-ascii Content-Transfer-Encoding: 7bit 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. --=-=-= Content-Type: text/x-patch Content-Disposition: inline; filename=0001-Don-t-recalculate-the-buffer-basename-inside-uniquif.patch >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 --=-=-=--