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 Apr 2023 01:49:51 +0000 (UTC) Message-ID: <87edotn7sx.fsf@catern.com> References: <87h6tpn8d5.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="5104"; 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 Sun Apr 09 03:50: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 1plKCC-00017y-Hf for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 09 Apr 2023 03:50:21 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1plKBx-0004hg-2w; Sat, 08 Apr 2023 21:50: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 1plKBu-0004hD-Hb for bug-gnu-emacs@gnu.org; Sat, 08 Apr 2023 21:50: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 1plKBu-0001BF-95 for bug-gnu-emacs@gnu.org; Sat, 08 Apr 2023 21:50:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1plKBt-0008Mw-Su for bug-gnu-emacs@gnu.org; Sat, 08 Apr 2023 21:50: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 Apr 2023 01:50: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.168100500032159 (code B ref 62732); Sun, 09 Apr 2023 01:50:01 +0000 Original-Received: (at 62732) by debbugs.gnu.org; 9 Apr 2023 01:50:00 +0000 Original-Received: from localhost ([127.0.0.1]:59948 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1plKBs-0008Mc-12 for submit@debbugs.gnu.org; Sat, 08 Apr 2023 21:50:00 -0400 Original-Received: from s.wrqvwxzv.outbound-mail.sendgrid.net ([149.72.154.232]:24018) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1plKBp-0008MM-Ad for 62732@debbugs.gnu.org; Sat, 08 Apr 2023 21:49:58 -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: content-transfer-encoding:cc:content-type:from:subject:to; s=s1; bh=xMxMGrGAiL1j3d7N/4OFC79q0UFdtvIw8UBYKcavgq0=; b=XSmv+47lGB7d/6dP/NluY9dhOFBHT5db1oBiK/ZY8gqb3GdZpxdhpIQ5y3QvjZQwuRO+ QTl6cISDI+4Z2LmnwSSM/IBm6Ml3bbeNy0IDEYxcnUIR/wO/D6CdGjCAYKoFfXKadSIQhw OO46jmN7UjiOqdV4bSHRfpMy8BOex2ZehVDNZN1e45gtLl4I0m8LQo4FfN/2XxvspEqrmU eleudXHHpfvdfCptpIrzWXu+Pamix1oX6kr9FPzPPmhX3HG8uZ4OM/wleOciAS6H6bO13H K5uIucEhxnXDIffpL5/Ea7VcaEIKzOLSMBb9Tnr5Tu5h8+5agKtW4LsAfDP6M9NQ== Original-Received: by filterdrecv-7946957d94-7d6jw with SMTP id filterdrecv-7946957d94-7d6jw-1-643219BF-3 2023-04-09 01:49:51.209939843 +0000 UTC m=+3982687.670017880 Original-Received: from earth.catern.com (unknown) by geopod-ismtpd-18 (SG) with ESMTP id 7wIUmP5QT4OebarwdsCWAw for <62732@debbugs.gnu.org>; Sun, 09 Apr 2023 01:49:51.000 +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 9B27262A0E for <62732@debbugs.gnu.org>; Sat, 8 Apr 2023 21:49:50 -0400 (EDT) In-Reply-To: <87h6tpn8d5.fsf@catern.com> (sbaugh@catern.com's message of "Sun, 09 Apr 2023 01:37:43 +0000 (UTC)") X-SG-EID: ZgbRq7gjGrt0q/Pjvxk7wM0yQFRdOkTJAtEbkjCkHbIB2D2HNRtltp3TjkUXZmSfcKc/cQsPTSO/fdxeZOeeyqoulPfNxgCmVfay/bApcJShL++Q0ONcQYjY6kx2gcB/KiiwGTdwx3voz/KXkAuXrVSoPxjDG4Xmh+dN0VAi8zyx0acfWQUTBsfQ01ufdb3Zu2pi0e6jz4/612fhhOkMyA== 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:259505 Archived-At: 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. Also, this approach is in line with other simplifications of uniquify that I'd like to make (as part of implementing bug#62621). Also, now there are tests for uniquify. diff --git a/lisp/dired.el b/lisp/dired.el index 4a4ecc901c4..12629dbbd87 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -490,6 +490,17 @@ dired-guess-shell-znew-switches (string :tag "Switches")) :version "29.1") =20 +(defcustom dired-trailing-separator nil + "If non-nil, add a file name separator to dired buffer names. +For example, \"dir/\" instead of \"dir\". + +Normally the separator is added at the end and matches the +platform convention for path separators. If +`uniquify-buffer-name-style' is `reverse', add the separator at +the beginning, and use `uniquify-separator' for the separator." + :type 'boolean + :group 'dired) + =0C ;;; Internal variables =20 @@ -1285,6 +1296,19 @@ dired--align-all-files (insert-char ?\s distance 'inherit)) (forward-line))))))) =20 +(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)))))= )) + (defun dired-internal-noselect (dir-or-list &optional switches mode) ;; If DIR-OR-LIST is a string and there is an existing dired buffer ;; for it, just leave buffer as it is (don't even call dired-revert). @@ -1306,7 +1330,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 (dired--create-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..75495ab608e 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2062,22 +2062,27 @@ 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) +(defun create-file-buffer (filename &optional basename) "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." +this function prepends a \"|\" to the final result if necessary. + +If BASENAME is non-nil, it will be used as the buffer name. +FILENAME will only be used to rename the buffer according to +`uniquify-buffer-name-style' to get an unused name. +" (let* ((lastname (file-name-nondirectory filename)) (lastname (if (string=3D lastname "") filename lastname)) - (buf (generate-new-buffer (if (string-prefix-p " " lastname) + (buf (generate-new-buffer (or basename (if (string-prefix-p " " lastname= ) (concat "|" lastname) - lastname)))) - (uniquify--create-file-buffer-advice buf filename) + lastname))))) + (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..6c0f5468faa 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -147,12 +147,14 @@ uniquify-separator file name components (default \"\\\")." :type '(choice (const nil) string)) =20 -(defcustom uniquify-trailing-separator-p nil - "If non-nil, add a file name separator to dired buffer names. -If `uniquify-buffer-name-style' is `forward', add the separator at the end= ; -if it is `reverse', add the separator at the beginning; otherwise, this -variable is ignored." - :type 'boolean) +(defvaralias + 'uniquify-trailing-separator-p + 'dired-trailing-separator) + +(make-obsolete-variable + 'uniquify-trailing-separator-p + 'dired-trailing-separator + "30.1") =20 (defcustom uniquify-strip-common-suffix ;; Using it when uniquify-min-dir-content>0 doesn't make much sense. @@ -174,8 +176,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 +213,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 +294,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 +317,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 +345,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 +410,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,15 +480,14 @@ 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) - (file-name-directory filename) - buf)))) + (uniquify-rationalize-file-buffer-names + (or basename (file-name-nondirectory filename)) + (file-name-directory (expand-file-name (directory-file-name filename)= )) + buf))) =20 (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..70f7125cbe9 --- /dev/null +++ b/test/lisp/uniquify-tests.el @@ -0,0 +1,111 @@ +;;; 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 uniqui= fy + (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 nam= es 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") 'n= osave) + ;; somewhat confusing behavior results if a buffer is renamed to m= atch 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#4= 7132" + (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 buf= fer" + (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)))) + +(provide 'uniquify-tests) +;;; uniquify-tests.el ends here