From: sbaugh@catern.com
To: Philip Kaludercic <philipk@posteo.net>
Cc: 64543@debbugs.gnu.org
Subject: bug#64543: [PATCH] package-report-bug: don't fail on custom groups defined by eval
Date: Wed, 12 Jul 2023 19:26:13 +0000 (UTC) [thread overview]
Message-ID: <87ttu9j5ii.fsf@catern.com> (raw)
In-Reply-To: <87edlfkg70.fsf@posteo.net> (Philip Kaludercic's message of "Mon, 10 Jul 2023 14:13:23 +0000")
[-- Attachment #1: Type: text/plain, Size: 1561 bytes --]
Philip Kaludercic <philipk@posteo.net> writes:
> sbaugh@catern.com writes:
>
> Thanks,
>
>> From: Spencer Baugh <sbaugh@catern.com>
>> Date: Sun, 9 Jul 2023 12:59:50 -0400
>> Subject: [PATCH] package-report-bug: don't fail on custom groups defined by
>> eval
>>
>> Previously we just assumed that the car of an element of
>> custom-current-group-alist was a filename. But actually it can be nil
>> if a custom group was defined by just evaling Lisp.
>
> Where is this behaviour documented? I couldn't reproduce it with a
> simple experiment.
To reproduce:
M-: (defgroup mygroup nil "my group") RET
I don't think it's documented anywhere? custom-current-group-alist is
not documented so this wouldn't be either.
>> * lisp/emacs-lisp/package.el (package-report-bug): Don't fail when a
>> custom group was defined by eval.
>> ---
>> lisp/emacs-lisp/package.el | 1 +
>> 1 file changed, 1 insertion(+)
>>
>> diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el
>> index 3e6acd9b388..f67e99e04b5 100644
>> --- a/lisp/emacs-lisp/package.el
>> +++ b/lisp/emacs-lisp/package.el
>> @@ -4642,6 +4642,7 @@ package-report-bug
>> (boundp (car ent))
>> (not (eq (custom--standard-value (car ent))
>> (default-toplevel-value (car ent))))
>> + (car group)
>
> If you are checking for (car group), when do this in the loop instead
> of wrapping the entire `dolist'?
Good point. I was just copying the last condition in the and. Lifted
them both out of the loop:
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Support-transforming-the-dirname-used-by-uniquify.patch --]
[-- Type: text/x-patch, Size: 5803 bytes --]
From 2873d4c482acfd1ced749d593fd512c408e0a578 Mon Sep 17 00:00:00 2001
From: Spencer Baugh <sbaugh@catern.com>
Date: Sun, 9 Jul 2023 22:21:03 -0400
Subject: [PATCH] Support transforming the dirname used by uniquify
By transforming the dirname, we can add additional information to use
during uniquifying. A basic one: uniquifying buffer names based on
the project name.
* lisp/progmodes/project.el (project-uniquify-dirname-transform): Add.
* lisp/uniquify.el (uniquify-dirname-transform-default)
(uniquify-dirname-transform): Add. (bug#62621)
(uniquify-rationalize-file-buffer-names, uniquify-buffer-file-name):
Use uniquify-dirname-transform.
* test/lisp/uniquify-tests.el (uniquify-home,
uniquify-project-transform): Add tests.
---
lisp/progmodes/project.el | 12 ++++++++++++
lisp/uniquify.el | 26 +++++++++++++++++++++-----
test/lisp/uniquify-tests.el | 33 +++++++++++++++++++++++++++++++++
3 files changed, 66 insertions(+), 5 deletions(-)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index d482cc24d70..78f9fb410c1 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -1835,5 +1835,17 @@ project-switch-project
(let ((project-current-directory-override dir))
(call-interactively command))))
+;;;###autoload
+(defun project-uniquify-dirname-transform (dirname)
+ "Include `project-name' in DIRNAME if in a project."
+ (if-let (proj (project-current nil dirname))
+ (let ((root (project-root proj)))
+ (expand-file-name
+ (file-name-concat
+ (file-name-directory root)
+ (project-name proj)
+ (file-relative-name dirname root))))
+ dirname))
+
(provide 'project)
;;; project.el ends here
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
index d1ca455b673..b2f28a10d51 100644
--- a/lisp/uniquify.el
+++ b/lisp/uniquify.el
@@ -168,6 +168,20 @@ uniquify-list-buffers-directory-modes
That means that when `buffer-file-name' is set to nil, `list-buffers-directory'
contains the name of the directory which the buffer is visiting.")
+(defun uniquify-dirname-transform-default (dirname)
+ "Simply return DIRNAME unchanged."
+ dirname)
+
+(defcustom uniquify-dirname-transform #'uniquify-dirname-transform-default
+ "A function to transform the dirname used to uniquify a buffer.
+
+It takes a single argument: the directory of the buffer. It
+should return a string filename (which does not need to actually
+exist in the filesystem) to use for uniquifying the buffer name."
+ :type '(choice (function-item uniquify-dirname-transform-default)
+ function)
+ :group 'uniquify)
+
;;; Utilities
;; uniquify-fix-list data structure
@@ -209,7 +223,8 @@ uniquify-rationalize-file-buffer-names
;; this buffer.
(with-current-buffer newbuf (setq uniquify-managed nil))
(when dirname
- (setq dirname (expand-file-name (directory-file-name dirname)))
+ (setq dirname (funcall uniquify-dirname-transform
+ (expand-file-name (directory-file-name dirname))))
(let ((fix-list (list (uniquify-make-item base dirname newbuf
nil)))
items)
@@ -268,10 +283,11 @@ uniquify-buffer-file-name
(if (memq major-mode uniquify-list-buffers-directory-modes)
list-buffers-directory))))
(when filename
- (directory-file-name
- (file-name-directory
- (expand-file-name
- (directory-file-name filename))))))))
+ (funcall uniquify-dirname-transform
+ (directory-file-name
+ (file-name-directory
+ (expand-file-name
+ (directory-file-name filename)))))))))
(defun uniquify-rerationalize-w/o-cb (fix-list)
"Re-rationalize the buffers in FIX-LIST, but ignoring `current-buffer'."
diff --git a/test/lisp/uniquify-tests.el b/test/lisp/uniquify-tests.el
index abd61fa3504..e533c4b644c 100644
--- a/test/lisp/uniquify-tests.el
+++ b/test/lisp/uniquify-tests.el
@@ -88,6 +88,21 @@ uniquify-dirs
'("a/dir/" "b/dir/")))
(mapc #'kill-buffer bufs)))))
+(ert-deftest uniquify-home ()
+ "uniquify works, albeit confusingly, in the presence of directories named \"~\""
+ (let (bufs)
+ (save-excursion
+ (push (find-file-noselect "~") bufs)
+ (push (find-file-noselect "./~") bufs)
+ (should (equal (mapcar #'buffer-name bufs)
+ '("~<test>" "~<>")))
+ (push (find-file-noselect "~/foo") bufs)
+ (push (find-file-noselect "./~/foo") bufs)
+ (should (equal (mapcar #'buffer-name bufs)
+ '("foo<~>" "foo</nonexistent>" "~<test>" "~<>")))
+ (while bufs
+ (kill-buffer (pop 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)
@@ -125,5 +140,23 @@ uniquify-space-prefix
(should (equal (buffer-name) "| foo"))
(kill-buffer)))
+(require 'project)
+(ert-deftest uniquify-project-transform ()
+ "`project-uniquify-dirname-transform' works"
+ (let ((uniquify-dirname-transform #'project-uniquify-dirname-transform)
+ (project-vc-name "foo1/bar")
+ bufs)
+ (save-excursion
+ (should (file-exists-p "../README"))
+ (push (find-file-noselect "../README") bufs)
+ (push (find-file-noselect "other/README") bufs)
+ (should (equal (mapcar #'buffer-name bufs)
+ '("README<other>" "README<bar>")))
+ (push (find-file-noselect "foo2/bar/README") bufs)
+ (should (equal (mapcar #'buffer-name bufs)
+ '("README<foo2/bar>" "README<other>" "README<foo1/bar>")))
+ (while bufs
+ (kill-buffer (pop bufs))))))
+
(provide 'uniquify-tests)
;;; uniquify-tests.el ends here
--
2.41.0
next prev parent reply other threads:[~2023-07-12 19:26 UTC|newest]
Thread overview: 16+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-09 17:08 bug#64543: [PATCH] package-report-bug: don't fail on custom groups defined by eval sbaugh
2023-07-10 14:13 ` Philip Kaludercic
2023-07-12 19:26 ` sbaugh [this message]
2023-07-12 19:48 ` Philip Kaludercic
2023-07-12 19:56 ` Spencer Baugh
2023-07-14 19:44 ` Philip Kaludercic
2023-07-15 5:49 ` Eli Zaretskii
2023-07-15 7:40 ` Philip Kaludercic
2023-07-15 8:57 ` Eli Zaretskii
2023-07-13 4:54 ` Eli Zaretskii
[not found] <c6bc281e-d6e5-4c5c-8315-157c6b089330@email.android.com>
2023-07-15 9:23 ` Eli Zaretskii
2023-07-15 10:05 ` Philip Kaludercic
2023-07-15 10:23 ` Eli Zaretskii
2023-07-15 23:33 ` Philip Kaludercic
2023-07-15 17:45 ` sbaugh
2023-07-16 12:33 ` Philip Kaludercic
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87ttu9j5ii.fsf@catern.com \
--to=sbaugh@catern.com \
--cc=64543@debbugs.gnu.org \
--cc=philipk@posteo.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).