(binhex): New custom group.
[bpt/emacs.git] / lisp / mail / emacsbug.el
index bb88c44..dab87e0 100644 (file)
@@ -1,7 +1,7 @@
 ;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list
 
 ;; Copyright (C) 1985, 1994, 1997, 1998, 2000, 2001, 2002, 2003,
-;;   2004, 2005 Free Software Foundation, Inc.
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: K. Shane Hartman
 ;; Maintainer: FSF
@@ -12,7 +12,7 @@
 
 ;; GNU Emacs is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -56,9 +56,6 @@
 (defvar report-emacs-bug-orig-text nil
   "The automatically-created initial text of bug report.")
 
-(defvar report-emacs-bug-text-prompt nil
-  "The automatically-created initial prompt of bug report.")
-
 (defcustom report-emacs-bug-no-confirmation nil
   "*If non-nil, suppress the confirmations asked for the sake of novice users."
   :group 'emacsbug
@@ -76,17 +73,31 @@ Prompts for bug subject.  Leaves you in a mail buffer."
   ;; This strange form ensures that (recent-keys) is the value before
   ;; the bug subject string is read.
   (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
-  ;; If there are four numbers in emacs-version, this is a pretest
-  ;; version.
-  (let ((pretest-p (string-match "\\..*\\..*\\." emacs-version))
-       (from-buffer (current-buffer))
-       user-point prompt-beg-point message-end-point)
+  ;; The syntax `version;' is preferred to `[version]' because the
+  ;; latter could be mistakenly stripped by mailing software.
+  (if (eq system-type 'ms-dos)
+      (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.
+        (prompt-properties '(field emacsbug-prompt
+                                   intangible but-helpful
+                                   rear-nonsticky t))
+        user-point message-end-point)
     (setq message-end-point
          (with-current-buffer (get-buffer-create "*Messages*")
            (point-max-marker)))
-    (compose-mail (if pretest-p
-                     report-emacs-bug-pretest-address
-                   report-emacs-bug-address)
+    (compose-mail reporting-address
                  topic)
     ;; The rest of this does not execute
     ;; if the user was asked to confirm and said no.
@@ -97,13 +108,13 @@ Prompts for bug subject.  Leaves you in a mail buffer."
       (delete-region (point) (point-max))
       (insert signature)
       (backward-char (length signature)))
-    (setq prompt-beg-point (point))
     (unless report-emacs-bug-no-explanations
       ;; Insert warnings for novice users.
-      (insert "This bug report will be sent to the Free Software Foundation,\n")
-      (let ((pos (point)))
-       (insert "not to your local site managers!")
-       (put-text-property pos (point) 'face 'highlight))
+      (when (string-match "@gnu\\.org^" reporting-address)
+       (insert "This bug report will be sent to the Free Software Foundation,\n")
+       (let ((pos (point)))
+         (insert "not to your local site managers!")
+         (put-text-property pos (point) 'face 'highlight)))
       (insert "\nPlease write in ")
       (let ((pos (point)))
        (insert "English")
@@ -111,35 +122,35 @@ 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 bug report will be posted to the %s mailing list"
-                     (if pretest-p
-                         report-emacs-bug-pretest-address
-                       report-emacs-bug-address)))
+                     reporting-address))
       (if pretest-p
          (insert ".\n\n")
        (insert ",\nand to the gnu.emacs.bug news group.\n\n")))
 
     (insert "Please describe exactly what actions triggered the bug\n"
-           "and the precise symptoms of the bug:")
-    (setq report-emacs-bug-text-prompt
-         (buffer-substring prompt-beg-point (point)))
+           "and the precise symptoms of the bug:\n\n")
+    (add-text-properties (point) (save-excursion (mail-text) (point))
+                         prompt-properties)
 
-    (insert "\n\n")
     (setq user-point (point))
     (insert "\n\n")
 
-    (insert "If emacs crashed, and you have the emacs process in the gdb debugger,\n"
+    (insert "If Emacs crashed, and you have the Emacs process in the gdb debugger,\n"
            "please include the output from the following gdb commands:\n"
            "    `bt full' and `xbacktrace'.\n")
 
     (let ((debug-file (expand-file-name "DEBUG" data-directory)))
       (if (file-readable-p debug-file)
-       (insert "If you would like to further debug the crash, please read the file\n"
-               debug-file " for instructions.\n")))
+         (insert "If you would like to further debug the crash, please read the file\n"
+                 debug-file " for instructions.\n")))
+    (add-text-properties (1+ user-point) (point) prompt-properties)
 
     (insert "\n\nIn " (emacs-version) "\n")
     (if (fboundp 'x-server-vendor)
        (condition-case nil
-           (insert "X server distributor `" (x-server-vendor) "', version "
+            ;; This is used not only for X11 but also W32 and others.
+           (insert "Windowing system distributor `" (x-server-vendor)
+                    "', version "
                    (mapconcat 'number-to-string (x-server-version) ".") "\n")
          (error t)))
     (if (and system-configuration-options
@@ -147,7 +158,7 @@ usually do not have translators to read other languages for them.\n\n")
        (insert "configured using `configure "
                system-configuration-options "'\n\n"))
     (insert "Important settings:\n")
-    (mapcar
+    (mapc
      '(lambda (var)
        (insert (format "  value of $%s: %s\n" var (getenv var))))
      '("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
@@ -218,6 +229,9 @@ Type SPC to scroll through this section and its subsections."))))
       (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))
     (goto-char user-point)))
 
+(declare-function Info-menu "../info" (menu-item &optional fork))
+(declare-function Info-goto-node "../info" (nodename &optional fork))
+
 (defun report-emacs-bug-info ()
   "Go to the Info node on reporting Emacs bugs."
   (interactive)
@@ -274,10 +288,12 @@ and send the mail again using \\[mail-send-and-exit].")))
 
     ;; Unclutter
     (mail-text)
-    (if (looking-at report-emacs-bug-text-prompt)
-       (replace-match "Symptoms:"))))
+    (let ((pos (1- (point))))
+      (while (setq pos (text-property-any pos (point-max)
+                                          'field 'emacsbug-prompt))
+        (delete-region pos (field-end (1+ pos)))))))
 
 (provide 'emacsbug)
 
-;;; arch-tag: 248b6523-c3b5-4fec-9a3f-0411fafa7d49
+;; arch-tag: 248b6523-c3b5-4fec-9a3f-0411fafa7d49
 ;;; emacsbug.el ends here