]> git.eshelyaron.com Git - emacs.git/commitdiff
Add a generic bug reporting command for packages
authorPhilip Kaludercic <philipk@posteo.net>
Thu, 6 Oct 2022 19:45:36 +0000 (21:45 +0200)
committerPhilip Kaludercic <philipk@posteo.net>
Thu, 6 Oct 2022 20:03:15 +0000 (22:03 +0200)
* lisp/emacs-lisp/package.el (package-menu-mode-map): Bind
'package-report-bug'.
(package-report-bug): Add new command.

lisp/emacs-lisp/package.el

index 2de5056475dd869e9cf4e6ee896a8c86d5bcb999..e0fb4b057236567c32517b1dc7338541b3ac679a 100644 (file)
@@ -2964,6 +2964,7 @@ either a full name or nil, and EMAIL is a valid email address."
   "~"     #'package-menu-mark-obsolete-for-deletion
   "w"     #'package-browse-url
   "m"     #'package-contact-maintainer
+  "b"     #'package-report-bug
   "x"     #'package-menu-execute
   "h"     #'package-menu-quick-help
   "H"     #'package-menu-hide-package
@@ -4516,6 +4517,37 @@ DESC must be a `package-desc' object."
        (string-trim (substring-no-properties (buffer-string))))
      (format "[%s] %s" name subject))))
 
+(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))
+               package-menu-mode)
+  (unless desc
+    (user-error "Package must be non-nil"))
+  (let* ((extras (package-desc-extras desc))
+         (maint (alist-get :maintainer extras))
+         vars)
+    (unless maint
+      (user-error "Package %s has no explicit maintainer"
+                  (package-desc-name desc)))
+    (let ((check (apply-partially #'file-equal-p (package-desc-dir desc))))
+      (dolist-with-progress-reporter (group custom-current-group-alist)
+          "Scanning for modified user options..."
+        (dolist (ent (get (cdr group) 'custom-group))
+          (when (and (custom-variable-p (car ent))
+                     (boundp (car ent))
+                     (not (eq (custom--standard-value (car ent))
+                              (default-toplevel-value (car ent))))
+                     (locate-dominating-file (car group) check))
+            (push (car ent) vars)))))
+    (dlet ((reporter-prompt-for-summary-p t))
+      (reporter-submit-bug-report
+       (with-temp-buffer
+         (package--print-email-button maint)
+         (string-trim (substring-no-properties (buffer-string))))
+       (symbol-name (package-desc-name desc))
+       vars))))
+
 ;;;; Introspection
 
 (defun package-get-descriptor (pkg-name)