changeset 8280:2c26fd09c101

(reporter-dump-state, reporter-submit-bug-report): Don't print package name if pkgname is nil. Don't dump state if varlist is nil. (reporter-bug-hook, reporter-submit-bug-report) (reporter-calculate-separator, reporter-initial-text): New or modified functions and variables attempting to prohibit submission of empty bug reporters. (reporter-prompt-for-summary-p): Default value now nil. (reporter-dump-state): Make sure there's a final newline after the setq sexp. Pass mail buffer as second arg to print fcn. Use symbol-value to get varsym's value. (reporter-dump-variable): Handle long sexp's even after entering newline. Done by filling current line. Much better pretty printing of long lists!! Handle void variables. (reporter-version): New variable. (reporter-submit-bug-report-internal): Leave point after the salutation. (reporter-submit-bug-report): Prompt for a subject.

--- a/lisp/mail/reporter.el	Mon Jul 18 18:15:06 1994 +0000
+++ b/lisp/mail/reporter.el	Mon Jul 18 18:49:25 1994 +0000
@@ -3,11 +3,12 @@
 ;; Author: 1993 Barry A. Warsaw, Century Computing Inc. <[e-mail]>
 ;; Maintainer:      [e-mail]
 ;; Created:         19-Apr-1993
-;; Version:         1.23
-;; Last Modified:   1993/09/02 20:28:36
-;; Keywords: tools, mail, lisp, extensions
+;; Version:         2.12
+;; Last Modified:   1994/07/06 14:55:39
+;; Keywords: bug reports lisp
 
-;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Copyright (C) 1993 1994 Barry A. Warsaw
+;; Copyright (C) 1993 1994 Free Software Foundation, Inc.
 
 ;; This file is part of GNU Emacs.
 
@@ -25,34 +26,42 @@
 ;; along with GNU Emacs; see the file COPYING.  If not, write to
 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
 
+;;; Commentary:
+;;
 ;; Introduction
 ;; ============
-;; This program is for lisp package authors and is used to ease
+;; This program is for lisp package authors and can be used to ease
 ;; reporting of bugs.  When invoked, reporter-submit-bug-report will
 ;; set up a mail buffer with the appropriate bug report address,
-;; including a lisp expression the maintainer of the package can use
+;; including a lisp expression the maintainer of the package can eval
 ;; to completely reproduce the environment in which the bug was
-;; observed (e.g. by using eval-last-sexp). This package is especially
-;; useful for my development of c++-mode.el, which is highly dependent
+;; observed (e.g. by using eval-last-sexp). This package proved especially
+;; useful during my development of cc-mode.el, which is highly dependent
 ;; on its configuration variables.
 ;;
 ;; Do a "C-h f reporter-submit-bug-report" for more information.
 ;; Here's an example usage:
 ;;
-;; (defconst mypkg-version "9.801")
-;; (defconst mypkg-maintainer-address "[e-mail]")
-;; (defun mypkg-submit-bug-report ()
-;;   "Submit via mail a bug report on mypkg"
-;;   (interactive)
-;;   (require 'reporter)
-;;   (and (y-or-n-p "Do you really want to submit a report on mypkg? ")
-;;        (reporter-submit-bug-report
-;;          mypkg-maintainer-address
-;;          (concat "mypkg.el " mypkg-version)
-;;          (list 'mypkg-variable-1
-;;                'mypkg-variable-2
-;;                ;; ...
-;;                'mypkg-variable-last))))
+;;(defconst mypkg-version "9.801")
+;;(defconst mypkg-maintainer-address "[e-mail]")
+;;(defun mypkg-submit-bug-report ()
+;;  "Submit via mail a bug report on mypkg"
+;;  (interactive)
+;;  (require 'reporter)
+;;  (reporter-submit-bug-report
+;;   mypkg-maintainer-address
+;;   (concat "mypkg.el " mypkg-version)
+;;   (list 'mypkg-variable-1
+;;         'mypkg-variable-2
+;;         ;; ...
+;;         'mypkg-variable-last)))
+
+;; Major differences since version 1:
+;; ==================================
+;; * More robust in the face of void variables
+;; * New interface controlling variable reporter-prompt-for-summary-p
+;; * pretty-printing of lists!
+
 
 ;; Mailing List
 ;; ============
@@ -67,7 +76,7 @@
 ;; LCD Archive Entry:
 ;; reporter|Barry A. Warsaw|[e-mail]|
 ;; Customizable bug reporting of lisp programs.|
-;; 1993/09/02 20:28:36|1.23|~/misc/reporter.el.Z|
+;; 1994/07/06 14:55:39|2.12|~/misc/reporter.el.Z|
 
 ;;; Code:
 
@@ -81,6 +90,17 @@
 If a list, it tries to use each specified mailer in order until an
 existing one is found.")
 
+(defvar reporter-prompt-for-summary-p nil
+  "Interface variable controlling prompting for problem summary.
+When non-nil, `reporter-submit-bug-report' prompts the user for a
+brief summary of the problem, and puts this summary on the Subject:
+line.
+
+Default behavior is to not prompt (i.e. nil). If you want reporter to
+prompt, you should `let' bind this variable to t before calling
+`reporter-submit-bug-report'.  Note that this variable is not
+buffer-local so you should never just `setq' it.")
+
 
 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 ;; end of user defined variables
@@ -91,77 +111,176 @@
 variables.  Current buffer will always be the mail buffer being
 composed.")
 
+(defconst reporter-version "2.12"
+  "Reporter version number.")
+
+(defvar reporter-initial-text nil
+  "The automatically created initial text of a bug report.")
+(make-variable-buffer-local 'reporter-initial-text)
+
+
 
-(defun reporter-dump-variable (varsym)
-  "Pretty-print the value of the variable in symbol VARSYM."
-  (let ((val (save-excursion
-	       (set-buffer reporter-eval-buffer)
-	       (eval varsym)))
-	(sym (symbol-name varsym))
-	(print-escape-newlines t))
-    (insert "     " sym " "
-	    (cond
-	     ((memq val '(t nil)) "")
-	     ((listp val) "'")
-	     ((symbolp val) "'")
-	     (t ""))
-	    (prin1-to-string val)
-	    "\n")))
+(defun reporter-dump-variable (varsym mailbuf)
+  ;; Pretty-print the value of the variable in symbol VARSYM.  MAILBUF
+  ;; is the mail buffer being composed
+  (condition-case nil
+      (let ((val (save-excursion
+		   (set-buffer reporter-eval-buffer)
+		   (symbol-value varsym)))
+	    (sym (symbol-name varsym))
+	    (print-escape-newlines t)
+	    (here (point)))
+	(insert "     " sym " "
+		(cond
+		 ((memq val '(t nil)) "")
+		 ((listp val) "'")
+		 ((symbolp val) "'")
+		 (t ""))
+		(prin1-to-string val))
+	;; clean up lists, but only if the line as printed was long
+	;; enough to wrap
+	(if (and (listp val)
+		 (< (window-width) (current-column)))
+	    (save-excursion
+	      (goto-char here)
+	      ;; skip past the symbol name
+	      (down-list 1)
+	      (condition-case nil	; actual loop exit
+		  (while t
+		    (forward-sexp 1)
+		    (insert "\n")
+		    ;; if the sexp is longer than a single line then
+		    ;; fill it to fill-column
+		    (if (< (window-width)
+			   (save-excursion
+			     (forward-char -1)
+			     (current-column)))
+			(let (stop)
+			  (unwind-protect
+			      (setq stop (point-marker))
+			      (forward-line -1)
+			      (fill-region (point) (progn (end-of-line)
+							  (point)))
+			      ;; consume extra newline left by fill-region
+			      (delete-char 1)
+			      (goto-char stop))
+			  (set-marker stop nil)))
+		    (lisp-indent-line))
+		(error nil))))
+	(insert "\n"))
+    (void-variable
+     (save-excursion
+       (set-buffer mailbuf)
+       (mail-position-on-field "X-Reporter-Void-Vars-Found")
+       (end-of-line)
+       (insert (symbol-name varsym) " ")))
+    (error (error))))
 
 (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
-  "Dump the state of the mode specific variables.
-PKGNAME contains the name of the mode as it will appear in the bug
-report (you must explicitly concat any version numbers).
-
-VARLIST is the list of variables to dump.  Each element in VARLIST can
-be a variable symbol, or a cons cell.  If a symbol, this will be
-passed to `reporter-dump-variable' for insertion into the mail buffer.
-If a cons cell, the car must be a variable symbol and the cdr must be
-a function which will be `funcall'd with the symbol. Use this to write
-your own custom variable value printers for specific variables.
+  ;; Dump the state of the mode specific variables.
+  ;; PKGNAME contains the name of the mode as it will appear in the bug
+  ;; report (you must explicitly concat any version numbers).
 
-Note that the global variable `reporter-eval-buffer' will be bound to
-the buffer in which `reporter-submit-bug-report' was invoked.  If you
-want to print the value of a buffer local variable, you should wrap
-the `eval' call in your custom printer inside a `set-buffer' (and
-probably a `save-excursion'). `reporter-dump-variable' handles this
-properly.
+  ;; VARLIST is the list of variables to dump.  Each element in
+  ;; VARLIST can be a variable symbol, or a cons cell.  If a symbol,
+  ;; this will be passed to `reporter-dump-variable' for insertion
+  ;; into the mail buffer.  If a cons cell, the car must be a variable
+  ;; symbol and the cdr must be a function which will be `funcall'd
+  ;; with arguments the symbol and the mail buffer being composed. Use
+  ;; this to write your own custom variable value printers for
+  ;; specific variables.
 
-PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but
-before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
-dumped."
+  ;; Note that the global variable `reporter-eval-buffer' will be bound to
+  ;; the buffer in which `reporter-submit-bug-report' was invoked.  If you
+  ;; want to print the value of a buffer local variable, you should wrap
+  ;; the `eval' call in your custom printer inside a `set-buffer' (and
+  ;; probably a `save-excursion'). `reporter-dump-variable' handles this
+  ;; properly.
+
+  ;; PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but
+  ;; before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
+  ;; dumped.
   (let ((buffer (current-buffer)))
     (set-buffer buffer)
-    (insert "Emacs  : " (emacs-version) "\nPackage: " pkgname "\n")
+    (insert "Emacs  : " (emacs-version) "\n")
+    (and pkgname
+	 (insert "Package: " pkgname "\n"))
     (run-hooks 'pre-hooks)
-    (insert "\ncurrent state:\n==============\n(setq\n")
-    (mapcar
-     (function
-      (lambda (varsym-or-cons-cell)
-	(let ((varsym (or (car-safe varsym-or-cons-cell)
-			  varsym-or-cons-cell))
-	      (printer (or (cdr-safe varsym-or-cons-cell)
-			   'reporter-dump-variable)))
-	  (funcall printer varsym)
-	  )))
-     varlist)
-    (insert "     )\n")
+    (if (not varlist)
+	nil
+      (insert "\ncurrent state:\n==============\n")
+      ;; create an emacs-lisp-mode buffer to contain the output, which
+      ;; we'll later insert into the mail buffer
+      (condition-case fault
+	  (let ((mailbuf (current-buffer))
+		(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
+	    (save-excursion
+	      (set-buffer elbuf)
+	      (emacs-lisp-mode)
+	      (erase-buffer)
+	      (insert "(setq\n")
+	      (lisp-indent-line)
+	      (mapcar
+	       (function
+		(lambda (varsym-or-cons-cell)
+		  (let ((varsym (or (car-safe varsym-or-cons-cell)
+				    varsym-or-cons-cell))
+			(printer (or (cdr-safe varsym-or-cons-cell)
+				     'reporter-dump-variable)))
+		    (funcall printer varsym mailbuf)
+		    )))
+	       varlist)
+	      (insert ")\n")
+	      (beginning-of-defun)
+	      (indent-sexp))
+	    (insert-buffer elbuf))
+	(error
+	 (insert "State could not be dumped due to the following error:\n\n"
+		 (format "%s" fault)
+		 "\n\nYou should still send this bug report."))))
     (run-hooks 'post-hooks)
     ))
 
+
+(defun reporter-calculate-separator ()
+  ;; returns the string regexp matching the mail separator
+  (save-excursion
+    (re-search-forward
+     (concat
+      "^\\("				;beginning of line
+      (mapconcat
+       'identity
+       (list "[\t ]*"			;simple SMTP form
+	     "-+"			;mh-e form
+	     (regexp-quote 
+	      mail-header-separator))	;sendmail.el form
+       "\\|")				;or them together
+      "\\)$")				;end of line
+     nil
+     'move)				;search for and move
+    (buffer-substring (match-beginning 0) (match-end 0))))
+
+;;;###autoload
 (defun reporter-submit-bug-report
   (address pkgname varlist &optional pre-hooks post-hooks salutation)
-  "Submit a bug report via mail.
+  ;; Submit a bug report via mail.
+
+  ;; ADDRESS is the email address for the package's maintainer. PKGNAME is
+  ;; the name of the mode (you must explicitly concat any version numbers).
+  ;; VARLIST is the list of variables to dump (see `reporter-dump-state'
+  ;; for details). Optional PRE-HOOKS and POST-HOOKS are passed to
+  ;; `reporter-dump-state'. Optional SALUTATION is inserted at the top of the
+  ;; mail buffer, and point is left after the salutation.
 
-ADDRESS is the email address for the package's maintainer. PKGNAME is
-the name of the mode (you must explicitly concat any version numbers).
-VARLIST is the list of variables to dump (do a `\\[describe-function] reporter-dump-state'
-for details). Optional PRE-HOOKS and POST-HOOKS are passed to
-`reporter-dump-state'. Optional SALUTATION is inserted at the top of the
-mail buffer, and point is left after the saluation.
+  ;; This function will prompt for a summary if
+  ;; reporter-prompt-for-summary-p is non-nil.
 
-The mailer used is described in the variable `reporter-mailer'."
+  ;; The mailer used is described in the variable `reporter-mailer'.
   (let ((reporter-eval-buffer (current-buffer))
+	final-resting-place
+	after-sep-pos
+	(problem (and reporter-prompt-for-summary-p
+		      (read-string "(Very) brief summary of problem: ")))
 	(mailbuf
 	 (progn
 	   (call-interactively
@@ -186,34 +305,44 @@
     (goto-char (point-min))
     ;; different mailers use different separators, some may not even
     ;; use m-h-s, but sendmail.el stuff must have m-h-s bound.
-    (let ((mail-header-separator
-           (save-excursion
-             (re-search-forward
-              (concat
-               "^\\("			;beginning of line
-               (mapconcat
-                'identity
-                (list "[\t ]*"          ;simple SMTP form
-                      "-+"		;mh-e form
-		      (regexp-quote 
-		       mail-header-separator)) ;sendmail.el form
-                "\\|")			;or them together
-               "\\)$")			;end of line
-              nil
-              'move)			;search for and move
-             (buffer-substring (match-beginning 0) (match-end 0)))))
+    (let ((mail-header-separator (reporter-calculate-separator)))
       (mail-position-on-field "to")
       (insert address)
-      (mail-position-on-field "subject")
-      (insert "Report on package " pkgname)
+      ;; insert problem summary if available
+      (if (and reporter-prompt-for-summary-p problem pkgname)
+	  (progn
+	    (mail-position-on-field "subject")
+	    (insert pkgname "; " problem)))
       (re-search-forward mail-header-separator (point-max) 'move)
       (forward-line 1)
+      (setq after-sep-pos (point))
       (and salutation (insert "\n" salutation "\n\n"))
-      (set-mark (point))                ;user should see mark change
-      (insert "\n\n")
-      (reporter-dump-state pkgname varlist pre-hooks post-hooks)
-      (exchange-point-and-mark))
-    (let* ((sendkey "C-c C-c")		;can this be generalized like below?
+      (unwind-protect
+	  (progn
+	    (setq final-resting-place (point-marker))
+	    (insert "\n\n")
+	    (reporter-dump-state pkgname varlist pre-hooks post-hooks)
+	    (goto-char final-resting-place))
+	(set-marker final-resting-place nil)))
+
+    ;; save initial text and set up the `no-empty-submission' hook.
+    ;; This only works for mailers that support mail-send-hook,
+    ;; e.g. sendmail.el
+    (if (fboundp 'add-hook)
+	(progn
+	  (save-excursion
+	    (goto-char (point-max))
+	    (skip-chars-backward " \t\n")
+	    (setq reporter-initial-text
+		  (buffer-substring after-sep-pos (point))))
+	  (make-variable-buffer-local 'mail-send-hook)
+	  (add-hook 'mail-send-hook 'reporter-bug-hook)))
+
+    ;; minibuf message
+    ;; C-c C-c can't be generalized because they don't always run
+    ;; mail-send-and-exit. E.g. vm-mail-send-and-exit.  I don't want
+    ;; to hard code these.
+    (let* ((sendkey "C-c C-c")
 	   (killkey-whereis (where-is-internal 'kill-buffer nil t))
 	   (killkey (if killkey-whereis
 			(key-description killkey-whereis)
@@ -222,7 +351,25 @@
 	       sendkey killkey))
     ))
 
-;; this is useful
+(defun reporter-bug-hook ()
+  ;; prohibit sending mail if empty bug report
+  (let ((after-sep-pos
+	 (save-excursion
+	   (beginning-of-buffer)
+	   (re-search-forward (reporter-calculate-separator) (point-max) 'move)
+	   (forward-line 1)
+	   (point))))
+    (save-excursion
+      (goto-char (point-max))
+      (skip-chars-backward " \t\n")
+      (if (and (= (- (point) after-sep-pos)
+		  (length reporter-initial-text))
+	       (string= (buffer-substring after-sep-pos (point))
+			reporter-initial-text))
+	  (error "Empty bug report cannot be sent."))
+      )))
+
+
 (provide 'reporter)
 
 ;;; reporter.el ends here