diff options
Diffstat (limited to 'lisp/mail/emacsbug.el')
| -rw-r--r-- | lisp/mail/emacsbug.el | 211 |
1 files changed, 166 insertions, 45 deletions
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 926d3e91af5..4bcfd2f1192 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -7,6 +7,7 @@ ;; Author: K. Shane Hartman ;; Maintainer: FSF ;; Keywords: maint mail +;; Package: emacs ;; This file is part of GNU Emacs. @@ -37,17 +38,14 @@ :group 'maint :group 'mail) +(define-obsolete-variable-alias 'report-emacs-bug-pretest-address + 'report-emacs-bug-address "24.1") + (defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org" "Address of mailing list for GNU Emacs bugs." :group 'emacsbug :type 'string) -(defcustom report-emacs-bug-pretest-address "bug-gnu-emacs@gnu.org" - "Address of mailing list for GNU Emacs pretest bugs." - :group 'emacsbug - :type 'string - :version "23.2") ; emacs-pretest-bug -> bug-gnu-emacs - (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." :group 'emacsbug @@ -60,6 +58,9 @@ ;; User options end here. +(defvar report-emacs-bug-tracker-url "http://debbugs.gnu.org/cgi/" + "Base URL of the GNU bugtracker. +Used for querying duplicates and linking to existing bugs.") (defvar report-emacs-bug-orig-text nil "The automatically-created initial text of the bug report.") @@ -75,6 +76,52 @@ (declare-function x-server-vendor "xfns.c" (&optional terminal)) (declare-function x-server-version "xfns.c" (&optional terminal)) (declare-function message-sort-headers "message" ()) +(defvar message-strip-special-text-properties) + +(defun report-emacs-bug-can-use-xdg-email () + "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4." + (and (getenv "DISPLAY") + (executable-find "xdg-email") + (or (getenv "GNOME_DESKTOP_SESSION_ID") + ;; GNOME_DESKTOP_SESSION_ID is deprecated, check on Dbus also. + (condition-case nil + (eq 0 (call-process + "dbus-send" nil nil nil + "--dest=org.gnome.SessionManager" + "--print-reply" + "/org/gnome/SessionManager" + "org.gnome.SessionManager.CanShutdown")) + (error nil)) + (equal (getenv "KDE_FULL_SESSION") "true") + (condition-case nil + (eq 0 (call-process + "/bin/sh" nil nil nil + "-c" + "xprop -root _DT_SAVE_MODE|grep xfce4")) + (error nil))))) + +(defun report-emacs-bug-insert-to-mailer () + (interactive) + (save-excursion + (let* ((to (progn + (goto-char (point-min)) + (forward-line) + (and (looking-at "^To: \\(.*\\)") + (match-string-no-properties 1)))) + (subject (progn + (forward-line) + (and (looking-at "^Subject: \\(.*\\)") + (match-string-no-properties 1)))) + (body (progn + (forward-line 2) + (if (> (point-max) (point)) + (buffer-substring-no-properties (point) (point-max)))))) + (if (and to subject body) + (start-process "xdg-email" nil "xdg-email" + "--subject" subject + "--body" body + (concat "mailto:" to)) + (error "Subject, To or body not found"))))) ;;;###autoload (defun report-emacs-bug (topic &optional recent-keys) @@ -89,32 +136,26 @@ Prompts for bug subject. Leaves you in a mail buffer." (setq topic (concat emacs-version "; " topic)) (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) (setq topic (concat (match-string 1 emacs-version) "; " topic)))) - ;; If there are four numbers in emacs-version (three for MS-DOS), - ;; this is a pretest version. - (let* ((pretest-p (string-match (if (eq system-type 'ms-dos) - "\\..*\\." - "\\..*\\..*\\.") - emacs-version)) - (from-buffer (current-buffer)) - (reporting-address (if pretest-p - report-emacs-bug-pretest-address - report-emacs-bug-address)) - ;; Put these properties on semantically-void text. - ;; report-emacs-bug-hook deletes these regions before sending. - (prompt-properties '(field emacsbug-prompt - intangible but-helpful - rear-nonsticky t)) - user-point message-end-point) + (let ((from-buffer (current-buffer)) + ;; Put these properties on semantically-void text. + ;; report-emacs-bug-hook deletes these regions before sending. + (prompt-properties '(field emacsbug-prompt + intangible but-helpful + rear-nonsticky t)) + (can-xdg-email (report-emacs-bug-can-use-xdg-email)) + user-point message-end-point) (setq message-end-point (with-current-buffer (get-buffer-create "*Messages*") (point-max-marker))) - (compose-mail reporting-address topic) + (compose-mail report-emacs-bug-address topic) ;; The rest of this does not execute if the user was asked to ;; confirm and said no. - ;; Message-mode sorts the headers before sending. We sort now so - ;; that report-emacs-bug-orig-text remains valid. (Bug#5178) - (if (eq major-mode 'message-mode) - (message-sort-headers)) + (when (eq major-mode 'message-mode) + ;; Message-mode sorts the headers before sending. We sort now so + ;; that report-emacs-bug-orig-text remains valid. (Bug#5178) + (message-sort-headers) + ;; Stop message-mode stealing the properties we will add. + (set (make-local-variable 'message-strip-special-text-properties) nil)) (rfc822-goto-eoh) (forward-line 1) (let ((signature (buffer-substring (point) (point-max)))) @@ -123,7 +164,7 @@ Prompts for bug subject. Leaves you in a mail buffer." (backward-char (length signature))) (unless report-emacs-bug-no-explanations ;; Insert warnings for novice users. - (when (string-match "@gnu\\.org$" reporting-address) + (when (string-match "@gnu\\.org$" report-emacs-bug-address) (insert "This bug report will be sent to the Free Software Foundation,\n") (let ((pos (point))) (insert "not to your local site managers!") @@ -135,17 +176,12 @@ Prompts for bug subject. Leaves you in a mail buffer." (insert " if possible, because the Emacs maintainers usually do not have translators to read other languages for them.\n\n") (insert (format "Your report will be posted to the %s mailing list" - reporting-address)) - ;; Nowadays all bug reports end up there. -;;; (if pretest-p (insert ".\n\n") - (insert "\nand the gnu.emacs.bug news group, and at http://debbugs.gnu.org.\n\n")) + report-emacs-bug-address)) + (insert "\nand the gnu.emacs.bug news group, and at http://debbugs.gnu.org.\n\n")) (insert "Please describe exactly what actions triggered the bug\n" "and the precise symptoms of the bug. If you can, give\n" "a recipe starting from `emacs -Q':\n\n") - ;; Stop message-mode stealing the properties we are about to add. - (if (boundp 'message-strip-special-text-properties) - (set (make-local-variable 'message-strip-special-text-properties) nil)) (add-text-properties (save-excursion (rfc822-goto-eoh) (line-beginning-position 2)) @@ -240,16 +276,14 @@ usually do not have translators to read other languages for them.\n\n") ;; This is so the user has to type something in order to send easily. (use-local-map (nconc (make-sparse-keymap) (current-local-map))) (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info) - ;; Could test major-mode instead. - (cond ((memq mail-user-agent '(message-user-agent gnus-user-agent)) - (setq report-emacs-bug-send-command "message-send-and-exit" - report-emacs-bug-send-hook 'message-send-hook)) - ((eq mail-user-agent 'sendmail-user-agent) - (setq report-emacs-bug-send-command "mail-send-and-exit" - report-emacs-bug-send-hook 'mail-send-hook)) - ((eq mail-user-agent 'mh-e-user-agent) - (setq report-emacs-bug-send-command "mh-send-letter" - report-emacs-bug-send-hook 'mh-before-send-letter-hook))) + (if can-xdg-email + (define-key (current-local-map) "\C-cm" + 'report-emacs-bug-insert-to-mailer)) + (setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc) + report-emacs-bug-send-hook (get mail-user-agent 'hookvar)) + (if report-emacs-bug-send-command + (setq report-emacs-bug-send-command + (symbol-name report-emacs-bug-send-command))) (unless report-emacs-bug-no-explanations (with-output-to-temp-buffer "*Bug Help*" (princ "While in the mail buffer:\n\n") @@ -259,6 +293,9 @@ usually do not have translators to read other languages for them.\n\n") report-emacs-bug-send-command)))) (princ (substitute-command-keys " Type \\[kill-buffer] RET to cancel (don't send it).\n")) + (if can-xdg-email + (princ (substitute-command-keys + " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n"))) (terpri) (princ (substitute-command-keys " Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section @@ -335,6 +372,90 @@ and send the mail again%s." 'field 'emacsbug-prompt)) (delete-region pos (field-end (1+ pos))))))) + +;; Querying the bug database + +(defvar report-emacs-bug-bug-alist nil) +(make-variable-buffer-local 'report-emacs-bug-bug-alist) +(defvar report-emacs-bug-choice-widget nil) +(make-variable-buffer-local 'report-emacs-bug-choice-widget) + +(defun report-emacs-bug-create-existing-bugs-buffer (bugs keywords) + (switch-to-buffer (get-buffer-create "*Existing Emacs Bugs*")) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (setq report-emacs-bug-bug-alist bugs) + (widget-insert (propertize (concat "Already known bugs (" + keywords "):\n\n") + 'face 'bold)) + (if bugs + (setq report-emacs-bug-choice-widget + (apply 'widget-create 'radio-button-choice + :value (caar bugs) + (let (items) + (dolist (bug bugs) + (push (list + 'url-link + :format (concat "Bug#" (number-to-string (nth 2 bug)) + ": " (cadr bug) "\n %[%v%]\n") + ;; FIXME: Why is only the link of the + ;; active item clickable? + (car bug)) + items)) + (nreverse items)))) + (widget-insert "No bugs maching your keywords found.\n")) + (widget-insert "\n") + (widget-create 'push-button + :notify (lambda (&rest ignore) + ;; TODO: Do something! + (message "Reporting new bug!")) + "Report new bug") + (when bugs + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (let ((val (widget-value report-emacs-bug-choice-widget))) + ;; TODO: Do something! + (message "Appending to bug %s!" + (nth 2 (assoc val report-emacs-bug-bug-alist))))) + "Append to chosen bug")) + (widget-insert " ") + (widget-create 'push-button + :notify (lambda (&rest ignore) + (kill-buffer)) + "Quit reporting bug") + (widget-insert "\n")) + (use-local-map widget-keymap) + (widget-setup) + (goto-char (point-min))) + +(defun report-emacs-bug-parse-query-results (status keywords) + (goto-char (point-min)) + (let (buglist) + (while (re-search-forward "<a href=\"bugreport\\.cgi\\?bug=\\([[:digit:]]+\\)\">\\([^<]+\\)</a>" nil t) + (let ((number (match-string 1)) + (subject (match-string 2))) + (when (not (string-match "^#" subject)) + (push (list + ;; first the bug URL + (concat report-emacs-bug-tracker-url + "bugreport.cgi?bug=" number) + ;; then the subject and number + subject (string-to-number number)) + buglist)))) + (report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords))) + +(defun report-emacs-bug-query-existing-bugs (keywords) + "Query for KEYWORDS at `report-emacs-bug-tracker-url', and return the result. +The result is an alist with items of the form (URL SUBJECT NO)." + (interactive "sBug keywords (comma separated): ") + (url-retrieve (concat report-emacs-bug-tracker-url + "pkgreport.cgi?include=subject%3A" + (replace-regexp-in-string "[[:space:]]+" "+" keywords) + ";package=emacs") + 'report-emacs-bug-parse-query-results (list keywords))) + (provide 'emacsbug) ;;; emacsbug.el ends here |