diff 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
line wrap: on
line diff
--- a/lisp/packages/emacsbug.el	Mon Aug 13 08:45:53 2007 +0200
+++ b/lisp/packages/emacsbug.el	Mon Aug 13 08:46:35 2007 +0200
@@ -21,9 +21,10 @@
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
-;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
 
-;;; Synched up with: FSF 19.30.
+;;; Synched up with: FSF 19.34.
  
 ;;; Commentary:
 
@@ -38,54 +39,115 @@
 
 (require 'sendmail)
 
-(defvar bug-gnu-emacs "xemacs@cs.uiuc.edu"
-  "Address of site maintaining mailing list for GNU Emacs bugs.")
+;; XEmacs:  Screen for whether a beta version is running and redirect
+;; reports to the beta list instead of the newsgroup.  I don't think
+;; there's an XEmacs equivalent to system-configuration-options, but
+;; there should be.  -sb
+(defvar report-emacs-bug-pretest-address "xemacs-beta@xemacs.org"
+  "Address of mailing list for XEmacs beta bugs.")
+
+(defvar bug-gnu-emacs "xemacs@xemacs.org"
+  "Address of site maintaining mailing list for XEmacs bugs.")
 
 (defvar report-emacs-bug-orig-text nil
   "The automatically-created initial text of bug report.")
 
 ;;;###autoload
-(defun report-emacs-bug (topic)
-  "Report a bug in GNU Emacs.
+(defun report-xemacs-bug (topic)
+  "Report a bug in XEmacs.
 Prompts for bug subject.  Leaves you in a mail buffer."
   (interactive "sBug Subject: ")
-  (mail nil bug-gnu-emacs topic)
-  (goto-char (point-min))
-  (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
-  (insert "In " (emacs-version) "\n")
-  (if (and system-configuration-options
-	   (not (equal system-configuration-options "")))
-      (insert "configured using `configure "
-	      system-configuration-options "'\n"))
-  (insert "\n")
-  ;; 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)
-  (with-output-to-temp-buffer "*Bug Help*"
-    (princ (substitute-command-keys
-	    "Type \\[mail-send-and-exit] to send the bug report.\n"))
-    (terpri)
-    (princ (substitute-command-keys
-	    "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
+  (if (mail nil
+	    (if (string-match "\(beta[0-9]+\)" emacs-version)
+		;; If there are four numbers in emacs-version,
+		;; this is a pretest version.
+		report-emacs-bug-pretest-address
+	      bug-gnu-emacs)
+	    topic)
+      (let (user-point)
+	;; The rest of this does not execute
+	;; if the user was asked to confirm and said no.
+	(goto-char (point-min))
+	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
+	(insert "In " (emacs-version) "\n")
+	(if (and (boundp 'system-configuration-options)
+		 system-configuration-options
+		 (not (equal system-configuration-options "")))
+	    (insert "configured using `configure "
+		    system-configuration-options "'\n"))
+	(insert "\n")
+	(insert "Please describe exactly what actions triggered the bug\n"
+		"and the precise symptoms of the bug:\n\n") 
+	(setq user-point (point))
+	(insert "\n\n\n"
+		"Recent input:\n")
+	(let ((before-keys (point)))
+	  ;; XEmacs:
+	  (insert (key-description (recent-keys)))
+;	  (insert (mapconcat (lambda (key)
+;			       (if (or (integerp key)
+;				       (symbolp key)
+;				       (listp key))
+;				   (single-key-description key)
+;				 (prin1-to-string key nil)))
+;			     (recent-keys)
+;			     " "))
+	  (save-restriction
+	    (narrow-to-region before-keys (point))
+	    (goto-char before-keys)
+	    (while (progn (move-to-column 50) (not (eobp)))
+	      (search-forward " " nil t)
+	      (insert "\n"))))
+	(let ((message-buf (get-buffer " *Message-Log*")))
+	  (if message-buf
+	      (progn
+		(insert "\n\nRecent messages:\n")
+		(insert-buffer-substring message-buf
+					 (save-excursion
+					   (set-buffer message-buf)
+					   (goto-char (point-max))
+					   (forward-line -10)
+					   (point))
+					 (save-excursion
+					   (set-buffer message-buf)
+					   (point-max))))))
+	;; This is so the user has to type something
+	;; in order to send easily.
+	;; XEmacs:  FSF non-abstraction of data?
+	;; (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
+	(use-local-map (current-local-map))
+	(define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
+	(with-output-to-temp-buffer "*Bug Help*"
+	  (princ (substitute-command-keys
+		  "Type \\[mail-send-and-exit] to send the bug report.\n"))
+	  (princ (substitute-command-keys
+		  "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
+	  (terpri)
+	  (princ (substitute-command-keys
+		  "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
 about when and how to write a bug report,
 and what information to supply so that the bug can be fixed.
 Type SPC to scroll through this section and its subsections.")))
-  ;; Make it less likely people will send empty messages.
-  (make-local-variable 'mail-send-hook)
-  (add-hook 'mail-send-hook 'report-emacs-bug-hook)
-  (save-excursion
-    (goto-char (point-max))
-    (skip-chars-backward " \t\n")
-    (make-local-variable 'report-emacs-bug-orig-text)
-    (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point)))))
+	;; Make it less likely people will send empty messages.
+	(make-local-variable 'mail-send-hook)
+	(add-hook 'mail-send-hook 'report-emacs-bug-hook)
+	(save-excursion
+	  (goto-char (point-max))
+	  (skip-chars-backward " \t\n")
+	  (make-local-variable 'report-emacs-bug-orig-text)
+	  (setq report-emacs-bug-orig-text
+		(buffer-substring (point-min) (point))))
+	(goto-char user-point))))
+
+;; ;;;###autoload
+;; (defalias 'report-emacs-bug 'report-xemacs-bug)
 
 (defun report-emacs-bug-info ()
   "Go to the Info node on reporting Emacs bugs."
   (interactive)
   (info)
   (Info-directory)
-  (Info-menu "emacs")
+  (Info-menu "xemacs")
   (Info-goto-node "Bugs"))
 
 (defun report-emacs-bug-hook ()