comparison lisp/mail/emacsbug.el @ 107412:dcd02d810e03

Minor simplifications for emacsbug.el. * mail/emacsbug.el (report-emacs-bug-pretest-address): Make it an obsolete alias for report-emacs-bug-address. (message-strip-special-text-properties): Declare. (report-emacs-bug): Remove test for a pretest bug address. Combine message-mode-specific code.
author Glenn Morris <rgm@gnu.org>
date Wed, 17 Mar 2010 23:18:47 -0700
parents b92c3979701c
children ea341a06439f
comparison
equal deleted inserted replaced
107411:f96fe531e7a6 107412:dcd02d810e03
35 (defgroup emacsbug nil 35 (defgroup emacsbug nil
36 "Sending Emacs bug reports." 36 "Sending Emacs bug reports."
37 :group 'maint 37 :group 'maint
38 :group 'mail) 38 :group 'mail)
39 39
40 (define-obsolete-variable-alias 'report-emacs-bug-pretest-address
41 'report-emacs-bug-address "24.1")
42
40 (defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org" 43 (defcustom report-emacs-bug-address "bug-gnu-emacs@gnu.org"
41 "Address of mailing list for GNU Emacs bugs." 44 "Address of mailing list for GNU Emacs bugs."
42 :group 'emacsbug 45 :group 'emacsbug
43 :type 'string) 46 :type 'string)
44 47
45 (defcustom report-emacs-bug-pretest-address "bug-gnu-emacs@gnu.org"
46 "Address of mailing list for GNU Emacs pretest bugs."
47 :group 'emacsbug
48 :type 'string
49 :version "23.2") ; emacs-pretest-bug -> bug-gnu-emacs
50
51 (defcustom report-emacs-bug-no-confirmation nil 48 (defcustom report-emacs-bug-no-confirmation nil
52 "If non-nil, suppress the confirmations asked for the sake of novice users." 49 "If non-nil, suppress the confirmations asked for the sake of novice users."
53 :group 'emacsbug 50 :group 'emacsbug
54 :type 'boolean) 51 :type 'boolean)
55 52
73 (make-variable-buffer-local 'report-emacs-bug-send-hook) 70 (make-variable-buffer-local 'report-emacs-bug-send-hook)
74 71
75 (declare-function x-server-vendor "xfns.c" (&optional terminal)) 72 (declare-function x-server-vendor "xfns.c" (&optional terminal))
76 (declare-function x-server-version "xfns.c" (&optional terminal)) 73 (declare-function x-server-version "xfns.c" (&optional terminal))
77 (declare-function message-sort-headers "message" ()) 74 (declare-function message-sort-headers "message" ())
75 (defvar message-strip-special-text-properties)
78 76
79 ;;;###autoload 77 ;;;###autoload
80 (defun report-emacs-bug (topic &optional recent-keys) 78 (defun report-emacs-bug (topic &optional recent-keys)
81 "Report a bug in GNU Emacs. 79 "Report a bug in GNU Emacs.
82 Prompts for bug subject. Leaves you in a mail buffer." 80 Prompts for bug subject. Leaves you in a mail buffer."
87 ;; latter could be mistakenly stripped by mailing software. 85 ;; latter could be mistakenly stripped by mailing software.
88 (if (eq system-type 'ms-dos) 86 (if (eq system-type 'ms-dos)
89 (setq topic (concat emacs-version "; " topic)) 87 (setq topic (concat emacs-version "; " topic))
90 (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version) 88 (when (string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
91 (setq topic (concat (match-string 1 emacs-version) "; " topic)))) 89 (setq topic (concat (match-string 1 emacs-version) "; " topic))))
92 ;; If there are four numbers in emacs-version (three for MS-DOS), 90 (let ((from-buffer (current-buffer))
93 ;; this is a pretest version. 91 ;; Put these properties on semantically-void text.
94 (let* ((pretest-p (string-match (if (eq system-type 'ms-dos) 92 ;; report-emacs-bug-hook deletes these regions before sending.
95 "\\..*\\." 93 (prompt-properties '(field emacsbug-prompt
96 "\\..*\\..*\\.") 94 intangible but-helpful
97 emacs-version)) 95 rear-nonsticky t))
98 (from-buffer (current-buffer)) 96 user-point message-end-point)
99 (reporting-address (if pretest-p
100 report-emacs-bug-pretest-address
101 report-emacs-bug-address))
102 ;; Put these properties on semantically-void text.
103 ;; report-emacs-bug-hook deletes these regions before sending.
104 (prompt-properties '(field emacsbug-prompt
105 intangible but-helpful
106 rear-nonsticky t))
107 user-point message-end-point)
108 (setq message-end-point 97 (setq message-end-point
109 (with-current-buffer (get-buffer-create "*Messages*") 98 (with-current-buffer (get-buffer-create "*Messages*")
110 (point-max-marker))) 99 (point-max-marker)))
111 (compose-mail reporting-address topic) 100 (compose-mail report-emacs-bug-address topic)
112 ;; The rest of this does not execute if the user was asked to 101 ;; The rest of this does not execute if the user was asked to
113 ;; confirm and said no. 102 ;; confirm and said no.
114 ;; Message-mode sorts the headers before sending. We sort now so 103 (when (eq major-mode 'message-mode)
115 ;; that report-emacs-bug-orig-text remains valid. (Bug#5178) 104 ;; Message-mode sorts the headers before sending. We sort now so
116 (if (eq major-mode 'message-mode) 105 ;; that report-emacs-bug-orig-text remains valid. (Bug#5178)
117 (message-sort-headers)) 106 (message-sort-headers)
107 ;; Stop message-mode stealing the properties we will add.
108 (set (make-local-variable 'message-strip-special-text-properties) nil))
118 (rfc822-goto-eoh) 109 (rfc822-goto-eoh)
119 (forward-line 1) 110 (forward-line 1)
120 (let ((signature (buffer-substring (point) (point-max)))) 111 (let ((signature (buffer-substring (point) (point-max))))
121 (delete-region (point) (point-max)) 112 (delete-region (point) (point-max))
122 (insert signature) 113 (insert signature)
123 (backward-char (length signature))) 114 (backward-char (length signature)))
124 (unless report-emacs-bug-no-explanations 115 (unless report-emacs-bug-no-explanations
125 ;; Insert warnings for novice users. 116 ;; Insert warnings for novice users.
126 (when (string-match "@gnu\\.org$" reporting-address) 117 (when (string-match "@gnu\\.org$" report-emacs-bug-address)
127 (insert "This bug report will be sent to the Free Software Foundation,\n") 118 (insert "This bug report will be sent to the Free Software Foundation,\n")
128 (let ((pos (point))) 119 (let ((pos (point)))
129 (insert "not to your local site managers!") 120 (insert "not to your local site managers!")
130 (overlay-put (make-overlay pos (point)) 'face 'highlight))) 121 (overlay-put (make-overlay pos (point)) 'face 'highlight)))
131 (insert "\nPlease write in ") 122 (insert "\nPlease write in ")
133 (insert "English") 124 (insert "English")
134 (overlay-put (make-overlay pos (point)) 'face 'highlight)) 125 (overlay-put (make-overlay pos (point)) 'face 'highlight))
135 (insert " if possible, because the Emacs maintainers 126 (insert " if possible, because the Emacs maintainers
136 usually do not have translators to read other languages for them.\n\n") 127 usually do not have translators to read other languages for them.\n\n")
137 (insert (format "Your bug report will be posted to the %s mailing list" 128 (insert (format "Your bug report will be posted to the %s mailing list"
138 reporting-address)) 129 report-emacs-bug-address))
139 ;; Nowadays all bug reports end up there.
140 ;;; (if pretest-p (insert ".\n\n")
141 (insert ",\nand to the gnu.emacs.bug news group.\n\n")) 130 (insert ",\nand to the gnu.emacs.bug news group.\n\n"))
142 131
143 (insert "Please describe exactly what actions triggered the bug\n" 132 (insert "Please describe exactly what actions triggered the bug\n"
144 "and the precise symptoms of the bug. If you can, give\n" 133 "and the precise symptoms of the bug. If you can, give\n"
145 "a recipe starting from `emacs -Q':\n\n") 134 "a recipe starting from `emacs -Q':\n\n")
146 ;; Stop message-mode stealing the properties we are about to add.
147 (if (boundp 'message-strip-special-text-properties)
148 (set (make-local-variable 'message-strip-special-text-properties) nil))
149 (add-text-properties (save-excursion 135 (add-text-properties (save-excursion
150 (rfc822-goto-eoh) 136 (rfc822-goto-eoh)
151 (line-beginning-position 2)) 137 (line-beginning-position 2))
152 (point) 138 (point)
153 prompt-properties) 139 prompt-properties)