;; Author: K. Shane Hartman
;; Maintainer: FSF
;; Keywords: maint mail
+;; Package: emacs
;; This file is part of GNU Emacs.
: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
;; 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.")
(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)
(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))))
(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!")
(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))
;; 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")
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
'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