;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2011
+;; Copyright (C) 1985, 1994, 1997-1998, 2000-2012
;; Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;;; Code:
-(require 'url-util)
+(require 'sendmail)
+(require 'message)
(defgroup emacsbug nil
"Sending Emacs bug reports."
(defvar message-strip-special-text-properties)
(defun report-emacs-bug-can-use-osx-open ()
- "Check if OSX open can be used to insert bug report into mailer"
+ "Return non-nil if the OS X \"open\" command is available for mailing."
(and (featurep 'ns)
(equal (executable-find "open") "/usr/bin/open")
(memq system-type '(darwin))))
+;; FIXME this duplicates much of the logic from browse-url-can-use-xdg-open.
(defun report-emacs-bug-can-use-xdg-email ()
- "Check if xdg-email can be used, i.e. we are on Gnome, KDE or xfce4."
+ "Return non-nil if the \"xdg-email\" command can be used.
+xdg-email is a desktop utility that calls your preferred mail client.
+This requires you to be running either Gnome, KDE, or Xfce4."
(and (getenv "DISPLAY")
(executable-find "xdg-email")
(or (getenv "GNOME_DESKTOP_SESSION_ID")
"org.gnome.SessionManager.CanShutdown"))
(error nil))
(equal (getenv "KDE_FULL_SESSION") "true")
+ ;; FIXME? browse-url-can-use-xdg-open also accepts LXDE.
+ ;; Is that no good here, or just overlooked?
(condition-case nil
(eq 0 (call-process
"/bin/sh" nil nil nil
"-c"
+ ;; FIXME use string-match rather than grep.
"xprop -root _DT_SAVE_MODE|grep xfce4"))
(error nil)))))
(defun report-emacs-bug-insert-to-mailer ()
+ "Send the message to your preferred mail client.
+This requires either the OS X \"open\" command, or the freedesktop
+\"xdg-email\" command to be available."
(interactive)
(save-excursion
+ ;; FIXME? use mail-fetch-field?
(let* ((to (progn
(goto-char (point-min))
(forward-line)
(if (and to subject body)
(if (report-emacs-bug-can-use-osx-open)
(start-process "/usr/bin/open" nil "open"
- (concat "mailto:" to
+ (concat "mailto:" to
"?subject=" (url-hexify-string subject)
"&body=" (url-hexify-string body)))
(start-process "xdg-email" nil "xdg-email"
;; 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))
+ intangible but-helpful
+ rear-nonsticky t))
(can-insert-mail (or (report-emacs-bug-can-use-xdg-email)
(report-emacs-bug-can-use-osx-open)))
user-point message-end-point)
(set (make-local-variable 'message-strip-special-text-properties) nil))
(rfc822-goto-eoh)
(forward-line 1)
- (let ((signature (buffer-substring (point) (point-max))))
+ ;; Move the mail signature to the proper place.
+ (let ((signature (buffer-substring (point) (point-max)))
+ (inhibit-read-only t))
(delete-region (point) (point-max))
(insert signature)
(backward-char (length signature)))
(unless report-emacs-bug-no-explanations
;; Insert warnings for novice users.
- (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!")
- (overlay-put (make-overlay pos (point)) 'face 'highlight)))
- (insert "\nPlease write in ")
- (let ((pos (point)))
- (insert "English")
- (overlay-put (make-overlay pos (point)) 'face 'highlight))
- (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"
- 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")
+ (if (not (equal "bug-gnu-emacs@gnu.org" report-emacs-bug-address))
+ (insert (format "The report will be sent to %s.\n\n"
+ report-emacs-bug-address))
+ (insert "This bug report will be sent to the ")
+ (insert-button
+ "Bug-GNU-Emacs"
+ 'face 'link
+ 'help-echo (concat "mouse-2, RET: Follow this link")
+ 'action (lambda (button)
+ (browse-url "http://lists.gnu.org/archive/html/bug-gnu-emacs/"))
+ 'follow-link t)
+ (insert " mailing list\nand the GNU bug tracker at ")
+ (insert-button
+ "debbugs.gnu.org"
+ 'face 'link
+ 'help-echo (concat "mouse-2, RET: Follow this link")
+ 'action (lambda (button)
+ (browse-url "http://debbugs.gnu.org/"))
+ 'follow-link t)
+
+ (insert ". Please check that
+the From: line contains a valid email address. After a delay of up
+to one day, you should receive an acknowledgement at that address.
+
+Please write in English if possible, as the Emacs maintainers
+usually do not have translators for other languages.\n\n")))
+
+ (insert "Please describe exactly what actions triggered the bug, and\n"
+ "the precise symptoms of the bug. If you can, give a recipe\n"
+ "starting from `emacs -Q':\n\n")
(add-text-properties (save-excursion
(rfc822-goto-eoh)
(line-beginning-position 2))
"', version "
(mapconcat 'number-to-string (x-server-version) ".") "\n")
(error t)))
- (if (and system-configuration-options
- (not (equal system-configuration-options "")))
- (insert "configured using `configure "
- system-configuration-options "'\n\n"))
+ (when (and system-configuration-options
+ (not (equal system-configuration-options "")))
+ (insert "Configured using:\n `configure "
+ system-configuration-options "'\n\n")
+ (fill-region (line-beginning-position -1) (point)))
(insert "Important settings:\n")
(mapc
- '(lambda (var)
- (insert (format " value of $%s: %s\n" var (getenv var))))
+ (lambda (var)
+ (insert (format " value of $%s: %s\n" var (getenv var))))
'("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
"LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS"))
(insert (format " locale-coding-system: %s\n" locale-coding-system))
(insert "\n"))
(insert "\n")
(insert "Load-path shadows:\n")
- (message "Checking for load-path shadows...")
- (let ((shadows (list-load-path-shadows t)))
- (message "Checking for load-path shadows...done")
+ (let* ((msg "Checking for load-path shadows...")
+ (result "done")
+ (shadows (progn (message "%s" msg)
+ (condition-case nil (list-load-path-shadows t)
+ (error
+ (setq result "error")
+ "Error during checking")))))
+ (message "%s%s" msg result)
(insert (if (zerop (length shadows))
"None found.\n"
shadows)))
" Type \\[kill-buffer] RET to cancel (don't send it).\n"))
(if can-insert-mail
(princ (substitute-command-keys
- " Type \\[report-emacs-bug-insert-to-mailer] to insert text to you preferred mail program.\n")))
+ " Type \\[report-emacs-bug-insert-to-mailer] to copy text to your preferred mail program.\n")))
(terpri)
(princ (substitute-command-keys
" Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
(interactive)
(info "(emacs)Bugs"))
+;; It's the default mail mode, so it seems OK to use its features.
+(autoload 'message-bogus-recipient-p "message")
+(defvar message-send-mail-function)
+
(defun report-emacs-bug-hook ()
"Do some checking before sending a bug report."
(save-excursion
(string-equal (buffer-substring-no-properties (point-min) (point))
report-emacs-bug-orig-text)
(error "No text entered in bug report"))
- ;; Check the buffer contents and reject non-English letters.
- ;; FIXME message-mode probably does this anyway.
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (unless (eobp)
- (if (or report-emacs-bug-no-confirmation
- (y-or-n-p "Convert non-ASCII letters to hexadecimal? "))
- (while (progn (skip-chars-forward "\0-\177")
- (not (eobp)))
- (let ((ch (following-char)))
- (delete-char 1)
- (insert (format "=%02x" ch))))))
-
- ;; The last warning for novice users.
+ ;; Warning for novice users.
(unless (or report-emacs-bug-no-confirmation
- (yes-or-no-p
- "Send this bug report to the Emacs maintainers? "))
+ (yes-or-no-p
+ "Send this bug report to the Emacs maintainers? "))
(goto-char (point-min))
(if (search-forward "To: ")
(delete-region (point) (line-end-position)))
report-emacs-bug-send-command)
"")))))
(error "M-x report-emacs-bug was cancelled, please read *Bug Help* buffer"))
-
+ ;; Query the user for the SMTP method, so that we can skip
+ ;; questions about From header validity if the user is going to
+ ;; use mailclient, anyway.
+ (when (or (and (derived-mode-p 'message-mode)
+ (eq message-send-mail-function 'sendmail-query-once))
+ (and (not (derived-mode-p 'message-mode))
+ (eq send-mail-function 'sendmail-query-once)))
+ (sendmail-query-user-about-smtp)
+ (when (derived-mode-p 'message-mode)
+ (setq message-send-mail-function (message-default-send-mail-function))))
+ (or report-emacs-bug-no-confirmation
+ ;; mailclient.el does not need a valid From
+ (if (derived-mode-p 'message-mode)
+ (eq message-send-mail-function 'message-send-mail-with-mailclient)
+ (eq send-mail-function 'mailclient-send-it))
+ ;; Not narrowing to the headers, but that's OK.
+ (let ((from (mail-fetch-field "From")))
+ (and (or (not from)
+ (message-bogus-recipient-p from)
+ ;; This is the default user-mail-address. On today's
+ ;; systems, it seems more likely to be wrong than right,
+ ;; since most people don't run their own mail server.
+ (string-match (format "\\<%s@%s\\>"
+ (regexp-quote (user-login-name))
+ (regexp-quote (system-name)))
+ from))
+ (not (yes-or-no-p
+ (format "Is `%s' really your email address? " from)))
+ (error "Please edit the From address and try again"))))
;; Delete the uninteresting text that was just to help fill out the report.
(rfc822-goto-eoh)
(forward-line 1)
(car bug))
items))
(nreverse items))))
- (widget-insert "No bugs maching your keywords found.\n"))
+ (widget-insert "No bugs matching your keywords found.\n"))
(widget-insert "\n")
(widget-create 'push-button
:notify (lambda (&rest ignore)
buglist))))
(report-emacs-bug-create-existing-bugs-buffer (nreverse buglist) keywords)))
+;;;###autoload
(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)."
HCoop / bpt / emacs.git / blobdiff