1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-03-13 18:31:31 -07:00

Improve 'package-report-bug' robustness

* lisp/emacs-lisp/package.el (package-maintainers): Add
fallbacks if a package doesn't list a single maintainer.
(package-report-bug): Check if "emacs-devel@gnu.org" is listed
as a maintainer, in which case the message is redirected to
bug-gnu-emacs@gnu.org and the X-Debbugs-CC header is set.

(Bug#80478)
This commit is contained in:
Philip Kaludercic 2026-02-27 17:36:44 +01:00
parent 24b922dec1
commit 4b253c39b1
No known key found for this signature in database

View file

@ -4825,8 +4825,9 @@ DESC must be a `package-desc' object."
browse-url-browser-function)))
(browse-url url))))
(declare-function ietf-drums-parse-address "ietf-drums"
(string &optional decode))
(declare-function ietf-drums-parse-addresses "ietf-drums" (string &optional rawp))
(declare-function ietf-drums-make-address "ietf-drums" (name address))
(declare-function mail-position-on-field "sendmail" (field &optional soft))
(defun package-maintainers (pkg-desc &optional no-error)
"Return an email address for the maintainers of PKG-DESC.
@ -4838,38 +4839,68 @@ will be signaled in that case."
(error "Invalid package description: %S" pkg-desc))
(let* ((name (package-desc-name pkg-desc))
(extras (package-desc-extras pkg-desc))
(maint (alist-get :maintainer extras)))
(unless (listp (cdr maint))
(setq maint (list maint)))
(maint (ensure-list
(or (and-let* ((list (cdr (assoc :maintainer extras))))
(if (consp (cdr list)) list (list list)))
(cdr (assoc :maintainers extras))
;; If no maintainers are listed, contact authors
;; instead (bug#80478)
(cdr (assoc :authors extras))))))
(cond
((and (null maint) (null no-error))
(user-error "Package `%s' has no explicit maintainer" name))
((and (not (progn
(require 'ietf-drums)
(ietf-drums-parse-address (cdar maint))))
((and (consp (car maint)) (stringp (cdar maint))
(not (any #'car maint))
(null no-error))
(user-error "Package `%s' has no maintainer address" name))
(t
(with-temp-buffer
(mapc #'package--print-email-button maint)
(replace-regexp-in-string
"\n" ", " (string-trim
(buffer-substring-no-properties
(point-min) (point-max)))))))))
(require 'ietf-drums)
(mapconcat (lambda (e)
(ietf-drums-make-address (car e) (cdr e)))
maint ", ")))))
;;;###autoload
(defun package-report-bug (desc)
"Prepare a message to send to the maintainers of a package.
DESC must be a `package-desc' object."
(interactive (list (package--query-desc package-alist)))
(let ((maint (package-maintainers desc))
(name (symbol-name (package-desc-name desc)))
(pkgdir (package-desc-dir desc))
vars)
(let* ((maint (package-maintainers desc 'no-error))
(pkgdir (package-desc-dir desc))
(main-maint (if (eq pkgdir 'builtin)
"bug-gnu-emacs@gnu.org"
"UNKNOWN-PACKAGE-MAINTAINER"))
(hook (let* ((addr (and maint (ietf-drums-parse-addresses maint)))
(devel (cl-find "emacs-devel@gnu.org" addr
:test #'string-equal-ignore-case
:key #'car)))
(lambda ()
(and-let* ((main (or devel (car addr)))
(others (prog1 (if (not devel)
(cdr addr)
;; We want to have bug reports for
;; Emacs packages sent to the bug
;; tracker, and not the emacs-devel.
(setcar devel "bug-gnu-emacs@gnu.org")
(delq devel addr))
(setq main-maint (car main)))))
(save-excursion
(mail-position-on-field (if devel "X-Debbugs-CC" "CC"))
(insert
(mapconcat (lambda (e)
(ietf-drums-make-address (cdr e) (car e)))
others ", "))))
(when devel
(save-excursion
;; Ensure an empty X-Debbugs-CC header if
;; addressing the Emacs developers.
(mail-position-on-field "X-Debbugs-CC"))))))
(name (symbol-name (package-desc-name desc)))
vars)
(when pkgdir
(dolist-with-progress-reporter (group custom-current-group-alist)
"Scanning for modified user options..."
(when (and (car group)
(when (and (car group) (not (eq pkgdir 'builtin))
(file-in-directory-p (car group) pkgdir))
(dolist (ent (get (cdr group) 'custom-group))
(when (and (custom-variable-p (car ent))
@ -4878,7 +4909,7 @@ DESC must be a `package-desc' object."
(default-toplevel-value (car ent)))))
(push (car ent) vars))))))
(dlet ((reporter-prompt-for-summary-p t))
(reporter-submit-bug-report maint name vars))))
(reporter-submit-bug-report main-maint name vars hook))))
;;;; Introspection