comparison lisp/packages/emacsbug.el @ 2:ac2d302a0011 r19-15b2

Import from CVS: tag r19-15b2
author cvs
date Mon, 13 Aug 2007 08:46:35 +0200
parents 376386a54a3c
children 8eaf7971accc
comparison
equal deleted inserted replaced
1:c0c6a60d29db 2:ac2d302a0011
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
20 ;; General Public License for more details. 20 ;; General Public License for more details.
21 21
22 ;; You should have received a copy of the GNU General Public License 22 ;; You should have received a copy of the GNU General Public License
23 ;; along with XEmacs; see the file COPYING. If not, write to the Free 23 ;; along with XEmacs; see the file COPYING. If not, write to the Free
24 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
25 ;; 02111-1307, USA.
25 26
26 ;;; Synched up with: FSF 19.30. 27 ;;; Synched up with: FSF 19.34.
27 28
28 ;;; Commentary: 29 ;;; Commentary:
29 30
30 ;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers 31 ;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers
31 ;; describing a problem. Here's how it's done... 32 ;; describing a problem. Here's how it's done...
36 ;; >> otherwise you can't use this file. It will only work on the 37 ;; >> otherwise you can't use this file. It will only work on the
37 ;; >> internet with this address. 38 ;; >> internet with this address.
38 39
39 (require 'sendmail) 40 (require 'sendmail)
40 41
41 (defvar bug-gnu-emacs "xemacs@cs.uiuc.edu" 42 ;; XEmacs: Screen for whether a beta version is running and redirect
42 "Address of site maintaining mailing list for GNU Emacs bugs.") 43 ;; reports to the beta list instead of the newsgroup. I don't think
44 ;; there's an XEmacs equivalent to system-configuration-options, but
45 ;; there should be. -sb
46 (defvar report-emacs-bug-pretest-address "xemacs-beta@xemacs.org"
47 "Address of mailing list for XEmacs beta bugs.")
48
49 (defvar bug-gnu-emacs "xemacs@xemacs.org"
50 "Address of site maintaining mailing list for XEmacs bugs.")
43 51
44 (defvar report-emacs-bug-orig-text nil 52 (defvar report-emacs-bug-orig-text nil
45 "The automatically-created initial text of bug report.") 53 "The automatically-created initial text of bug report.")
46 54
47 ;;;###autoload 55 ;;;###autoload
48 (defun report-emacs-bug (topic) 56 (defun report-xemacs-bug (topic)
49 "Report a bug in GNU Emacs. 57 "Report a bug in XEmacs.
50 Prompts for bug subject. Leaves you in a mail buffer." 58 Prompts for bug subject. Leaves you in a mail buffer."
51 (interactive "sBug Subject: ") 59 (interactive "sBug Subject: ")
52 (mail nil bug-gnu-emacs topic) 60 (if (mail nil
53 (goto-char (point-min)) 61 (if (string-match "\(beta[0-9]+\)" emacs-version)
54 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n")) 62 ;; If there are four numbers in emacs-version,
55 (insert "In " (emacs-version) "\n") 63 ;; this is a pretest version.
56 (if (and system-configuration-options 64 report-emacs-bug-pretest-address
57 (not (equal system-configuration-options ""))) 65 bug-gnu-emacs)
58 (insert "configured using `configure " 66 topic)
59 system-configuration-options "'\n")) 67 (let (user-point)
60 (insert "\n") 68 ;; The rest of this does not execute
61 ;; This is so the user has to type something 69 ;; if the user was asked to confirm and said no.
62 ;; in order to send easily. 70 (goto-char (point-min))
63 (use-local-map (nconc (make-sparse-keymap) (current-local-map))) 71 (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
64 (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info) 72 (insert "In " (emacs-version) "\n")
65 (with-output-to-temp-buffer "*Bug Help*" 73 (if (and (boundp 'system-configuration-options)
66 (princ (substitute-command-keys 74 system-configuration-options
67 "Type \\[mail-send-and-exit] to send the bug report.\n")) 75 (not (equal system-configuration-options "")))
68 (terpri) 76 (insert "configured using `configure "
69 (princ (substitute-command-keys 77 system-configuration-options "'\n"))
70 "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section 78 (insert "\n")
79 (insert "Please describe exactly what actions triggered the bug\n"
80 "and the precise symptoms of the bug:\n\n")
81 (setq user-point (point))
82 (insert "\n\n\n"
83 "Recent input:\n")
84 (let ((before-keys (point)))
85 ;; XEmacs:
86 (insert (key-description (recent-keys)))
87 ; (insert (mapconcat (lambda (key)
88 ; (if (or (integerp key)
89 ; (symbolp key)
90 ; (listp key))
91 ; (single-key-description key)
92 ; (prin1-to-string key nil)))
93 ; (recent-keys)
94 ; " "))
95 (save-restriction
96 (narrow-to-region before-keys (point))
97 (goto-char before-keys)
98 (while (progn (move-to-column 50) (not (eobp)))
99 (search-forward " " nil t)
100 (insert "\n"))))
101 (let ((message-buf (get-buffer " *Message-Log*")))
102 (if message-buf
103 (progn
104 (insert "\n\nRecent messages:\n")
105 (insert-buffer-substring message-buf
106 (save-excursion
107 (set-buffer message-buf)
108 (goto-char (point-max))
109 (forward-line -10)
110 (point))
111 (save-excursion
112 (set-buffer message-buf)
113 (point-max))))))
114 ;; This is so the user has to type something
115 ;; in order to send easily.
116 ;; XEmacs: FSF non-abstraction of data?
117 ;; (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
118 (use-local-map (current-local-map))
119 (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
120 (with-output-to-temp-buffer "*Bug Help*"
121 (princ (substitute-command-keys
122 "Type \\[mail-send-and-exit] to send the bug report.\n"))
123 (princ (substitute-command-keys
124 "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
125 (terpri)
126 (princ (substitute-command-keys
127 "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
71 about when and how to write a bug report, 128 about when and how to write a bug report,
72 and what information to supply so that the bug can be fixed. 129 and what information to supply so that the bug can be fixed.
73 Type SPC to scroll through this section and its subsections."))) 130 Type SPC to scroll through this section and its subsections.")))
74 ;; Make it less likely people will send empty messages. 131 ;; Make it less likely people will send empty messages.
75 (make-local-variable 'mail-send-hook) 132 (make-local-variable 'mail-send-hook)
76 (add-hook 'mail-send-hook 'report-emacs-bug-hook) 133 (add-hook 'mail-send-hook 'report-emacs-bug-hook)
77 (save-excursion 134 (save-excursion
78 (goto-char (point-max)) 135 (goto-char (point-max))
79 (skip-chars-backward " \t\n") 136 (skip-chars-backward " \t\n")
80 (make-local-variable 'report-emacs-bug-orig-text) 137 (make-local-variable 'report-emacs-bug-orig-text)
81 (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))) 138 (setq report-emacs-bug-orig-text
139 (buffer-substring (point-min) (point))))
140 (goto-char user-point))))
141
142 ;; ;;;###autoload
143 ;; (defalias 'report-emacs-bug 'report-xemacs-bug)
82 144
83 (defun report-emacs-bug-info () 145 (defun report-emacs-bug-info ()
84 "Go to the Info node on reporting Emacs bugs." 146 "Go to the Info node on reporting Emacs bugs."
85 (interactive) 147 (interactive)
86 (info) 148 (info)
87 (Info-directory) 149 (Info-directory)
88 (Info-menu "emacs") 150 (Info-menu "xemacs")
89 (Info-goto-node "Bugs")) 151 (Info-goto-node "Bugs"))
90 152
91 (defun report-emacs-bug-hook () 153 (defun report-emacs-bug-hook ()
92 (save-excursion 154 (save-excursion
93 (goto-char (point-max)) 155 (goto-char (point-max))