]> code.delx.au - gnu-emacs/blobdiff - lisp/mail/reporter.el
Merge from emacs--rel--22
[gnu-emacs] / lisp / mail / reporter.el
index 1b7d40a14c7bfc707c8bae3774fb76515b78b694..596c7ee9627785dd77aa840f90dad6585148280a 100644 (file)
@@ -1,20 +1,18 @@
 ;;; reporter.el --- customizable bug reporting of lisp programs
 
-;; Copyright (C) 1993 1994 Barry A. Warsaw
-;; Copyright (C) 1993 1994 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998, 2001, 2002, 2003,
+;;   2004, 2005, 2006, 2007 Free Software Foundation, Inc.
 
-;; Author: 1993 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
-;; Maintainer:      bwarsaw@cnri.reston.va.us
+;; Author:          1993-1998 Barry A. Warsaw
+;; Maintainer:      FSF
 ;; Created:         19-Apr-1993
-;; Version:         2.21
-;; Last Modified:   1994/11/29 16:13:50
-;; Keywords: bug reports lisp
+;; Keywords: maint mail tools
 
 ;; This file is part of GNU Emacs.
 
 ;; 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,
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 ;;; Commentary:
 
-;; Introduction
-;; ============
-;; 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 eval
-;; to completely reproduce the environment in which the bug was
-;; 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.
+;; End User Interface
+;; ==================
+;; The variable `mail-user-agent' contains a symbol indicating which
+;; Emacs mail package end users would like to use to compose outgoing
+;; mail.  See that variable for details (it is no longer defined in
+;; this file).
+
+;; Lisp Package Authors
+;; ====================
+;; reporter.el was written primarily for Emacs Lisp package authors so
+;; that their users can more easily report bugs.  When invoked,
+;; `reporter-submit-bug-report' will set up an outgoing mail buffer
+;; with the appropriate bug report address, including a lisp
+;; expression the maintainer of the package can evaluate to completely
+;; reproduce the environment in which the bug was observed (e.g. by
+;; using `eval-last-sexp').  This package proved especially useful
+;; during my development of CC Mode, 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:
 ;;         ;; ...
 ;;         'mypkg-variable-last)))
 
-;; Mailing List
-;; ============
-;; I've set up a mailing list to report bugs or suggest enhancements,
-;; etc. This list's intended audience is elisp package authors who are
-;; using reporter and want to stay current with releases. Here are the
-;; relevant addresses:
-;;
-;; Administrivia: reporter-request@anthem.nlm.nih.gov
-;; Submissions:   reporter@anthem.nlm.nih.gov
-
-;; Packages that currently use reporter are: cc-mode, supercite, elp,
-;; tcl, ediff, crypt, vm, edebug, archie, and efs.  If you know of
-;; others, please email me!
-
-;; LCD Archive Entry:
-;; reporter|Barry A. Warsaw|bwarsaw@cnri.reston.va.us|
-;; Customizable bug reporting of lisp programs.|
-;; 1994/11/29 16:13:50|2.21|~/misc/reporter.el.Z|
-
 ;;; Code:
 
 \f
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; user defined variables
-
-(defvar reporter-mailer '(vm-mail reporter-mail)
-  "*Mail package to use to generate bug report buffer.
-This can either be a function symbol or a list of function symbols.
-If a list, it tries to use each specified mailer in order until an
-existing one is found.
-
-MH-E users may want to use `mh-smail'.")
+;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
+;; Package author interface variables
 
 (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.
+line.  If this variable is a string, that string is used as the prompt
+string.
 
-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
+Default behavior is to not prompt (i.e. nil).  If you want reporter to
+prompt, you should `let' bind this variable before calling
 `reporter-submit-bug-report'.  Note that this variable is not
 buffer-local so you should never just `setq' it.")
 
@@ -114,28 +94,28 @@ Note that this variable is not buffer-local so you should never just
 `setq' it.  If you want to changes its default value, you should `let'
 bind it.")
 
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end of user defined variables
+;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+;; End of editable variables
 
+\f
 (defvar reporter-eval-buffer nil
   "Buffer to retrieve variable's value from.
 This is necessary to properly support the printing of buffer-local
 variables.  Current buffer will always be the mail buffer being
 composed.")
 
-(defconst reporter-version "2.21"
-  "Reporter version number.")
-
 (defvar reporter-initial-text nil
   "The automatically created initial text of a bug report.")
 (make-variable-buffer-local 'reporter-initial-text)
 
+
 \f
+;; status feedback to the user
 (defvar reporter-status-message nil)
 (defvar reporter-status-count nil)
 
 (defun reporter-update-status ()
-  ;; periodically output a status message
+  "Periodically output a status message."
   (if (zerop (% reporter-status-count 10))
       (progn
        (message reporter-status-message)
@@ -143,17 +123,25 @@ composed.")
   (setq reporter-status-count (1+ reporter-status-count)))
 
 \f
+;; dumping/pretty printing of values
 (defun reporter-beautify-list (maxwidth compact-p)
-  ;; pretty print a list
+  "Pretty print a list."
   (reporter-update-status)
-  (let (linebreak indent-enclosing-p indent-p here)
+  (let ((move t)
+       linebreak indent-enclosing-p indent-p here)
     (condition-case nil                        ;loop exit
        (progn
          (down-list 1)
          (setq indent-enclosing-p t)
-         (while t
+         (while move
            (setq here (point))
-           (forward-sexp 1)
+           ;; The following line is how we break out of the while
+           ;; loop, in one of two ways.  Either we've hit the end of
+           ;; the buffer, in which case scan-sexps returns nil, or
+           ;; we've crossed unbalanced parens and it will raise an
+           ;; error we're expecting to catch.
+           (setq move (scan-sexps (point) 1))
+           (goto-char move)
            (if (<= maxwidth (current-column))
                (if linebreak
                    (progn
@@ -175,14 +163,14 @@ composed.")
       (error indent-enclosing-p))))
 
 (defun reporter-lisp-indent (indent-point state)
-  ;; a better lisp indentation style for bug reporting
+  "A better lisp indentation style for bug reporting."
   (save-excursion
     (goto-char (1+ (nth 1 state)))
     (current-column)))
 
 (defun reporter-dump-variable (varsym mailbuf)
-  ;; Pretty-print the value of the variable in symbol VARSYM.  MAILBUF
-  ;; is the mail buffer being composed
+  "Pretty-print the value of the variable in symbol VARSYM.
+MAILBUF is the mail buffer being composed."
   (reporter-update-status)
   (condition-case nil
       (let ((val (save-excursion
@@ -217,32 +205,33 @@ composed.")
        (mail-position-on-field "X-Reporter-Void-Vars-Found")
        (end-of-line)
        (insert (symbol-name varsym) " ")))
-    (error (error ""))))
+    (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 arguments the symbol and the mail buffer being composed. Use
-  ;; this to write your own custom variable value printers for
-  ;; specific variables.
-
-  ;; 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.
+  "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 arguments the symbol and the mail buffer being composed.  Use
+this to write your own custom variable value printers for
+specific variables.
+
+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) "\n")
@@ -263,7 +252,7 @@ composed.")
              (erase-buffer)
              (insert "(setq\n")
              (lisp-indent-line)
-             (mapcar
+             (mapc
               (function
                (lambda (varsym-or-cons-cell)
                  (let ((varsym (or (car-safe varsym-or-cons-cell)
@@ -275,7 +264,7 @@ composed.")
               varlist)
              (lisp-indent-line)
              (insert ")\n"))
-           (insert-buffer elbuf))
+           (insert-buffer-substring elbuf))
        (error
         (insert "State could not be dumped due to the following error:\n\n"
                 (format "%s" fault)
@@ -284,132 +273,127 @@ composed.")
     ))
 
 \f
-(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))))
-
-;; Serves as an interface to `mail',
-;; but when the user says "no" to discarding an unset message,
-;; it gives an error.
-(defun reporter-mail (&rest args)
-  (interactive "P")
-  (or (apply 'mail args)
-      (error "Bug report aborted")))
+(defun reporter-compose-outgoing ()
+  "Compose the outgoing mail buffer.
+
+Return the selected paradigm, with the current buffer tacked onto the
+beginning of the list."
+  (let* ((agent mail-user-agent)
+        (compose (get mail-user-agent 'composefunc)))
+    ;; Sanity check.  If this fails then we'll try to use the SENDMAIL
+    ;; protocol, otherwise we must signal an error.
+    (if (not (and compose (functionp compose)))
+       (progn
+         (setq agent 'sendmail-user-agent
+               compose (get agent 'composefunc))
+         (if (not (and compose (functionp compose)))
+             (error "Could not find a valid `mail-user-agent'")
+           (ding)
+           (message "`%s' is an invalid `mail-user-agent'; using `sendmail-user-agent'"
+                    mail-user-agent)
+           )))
+    (funcall compose)
+    agent))
 
+\f
 ;;;###autoload
 (defun reporter-submit-bug-report
   (address pkgname varlist &optional pre-hooks post-hooks salutation)
-  ;; 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.
-
-  ;; 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'.
+"Begin submitting a bug report via email.
+
+ADDRESS is the email address for the package's maintainer.  PKGNAME is
+the name of the package (if you want to include version numbers,
+you must put them into PKGNAME before calling this function).
+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.
+
+VARLIST is the list of variables to dump (see `reporter-dump-state'
+for details).  The optional argument PRE-HOOKS and POST-HOOKS are
+passed to `reporter-dump-state'.  Optional argument SALUTATION is text
+to be inserted at the top of the mail buffer; in that case, point is
+left after that text.
+
+This function prompts for a summary if `reporter-prompt-for-summary-p'
+is non-nil.
+
+This function does not send a message; it uses the given information
+to initialize a message, which the user can then edit and finally send
+\(or decline to send).  The variable `mail-user-agent' controls which
+mail-sending package is used for editing and sending the message."
   (let ((reporter-eval-buffer (current-buffer))
        final-resting-place
        after-sep-pos
        (reporter-status-message "Formatting bug report buffer...")
        (reporter-status-count 0)
        (problem (and reporter-prompt-for-summary-p
-                     (read-string "(Very) brief summary of problem: ")))
-       (mailbuf
-        (progn
-          (call-interactively
-           (if (nlistp reporter-mailer)
-               reporter-mailer
-             (let ((mlist reporter-mailer)
-                   (mailer nil))
-               (while mlist
-                 (if (commandp (car mlist))
-                     (setq mailer (car mlist)
-                           mlist nil)
-                   (setq mlist (cdr mlist))))
-               (if (not mailer)
-                   (error
-                    "Variable `%s' does not contain a command for mailing"
-                    "reporter-mailer"))
-               mailer)))
-          (current-buffer))))
+                     (read-string (if (stringp reporter-prompt-for-summary-p)
+                                      reporter-prompt-for-summary-p
+                                    "(Very) brief summary of problem: "))))
+       (agent (reporter-compose-outgoing))
+       (mailbuf (current-buffer))
+       hookvar)
+    ;; do the work
     (require 'sendmail)
-    (pop-to-buffer reporter-eval-buffer)
-    (pop-to-buffer mailbuf)
+    ;; If mailbuf did not get made visible before, make it visible now.
+    (let (same-window-buffer-names same-window-regexps)
+      (pop-to-buffer mailbuf)
+      ;; Just in case the original buffer is not visible now, bring it
+      ;; back somewhere
+      (and pop-up-windows (display-buffer reporter-eval-buffer)))
     (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 (reporter-calculate-separator)))
-      (mail-position-on-field "to")
-      (insert address)
-      ;; insert problem summary if available
-      (if (and reporter-prompt-for-summary-p problem pkgname)
-         (progn
-           (mail-position-on-field "subject")
-           (insert pkgname "; " problem)))
-      ;; move point to the body of the message
-      (mail-text)
-      (forward-line 1)
-      (setq after-sep-pos (point))
-      (and salutation (insert "\n" salutation "\n\n"))
-      (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)))
+    (mail-position-on-field "to")
+    (insert address)
+    ;; insert problem summary if available
+    (if (and reporter-prompt-for-summary-p problem pkgname)
+       (progn
+         (mail-position-on-field "subject")
+         (insert pkgname "; " problem)))
+    ;; move point to the body of the message
+    (mail-text)
+    (forward-line 1)
+    (setq after-sep-pos (point))
+    (and salutation (insert "\n" salutation "\n\n"))
+    (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)
-                     "M-x kill-buffer")))
-      (message "Please type in your report. Hit %s to send, %s to abort."
-              sendkey killkey))
+    ;; This only works for mailers that support a pre-send hook, and
+    ;; for which the paradigm has a non-nil value for the `hookvar'
+    ;; key in its agent (i.e. sendmail.el's mail-send-hook).
+    (save-excursion
+      (goto-char (point-max))
+      (skip-chars-backward " \t\n")
+      (setq reporter-initial-text (buffer-substring after-sep-pos (point))))
+    (if (setq hookvar (get agent 'hookvar))
+       (add-hook hookvar 'reporter-bug-hook nil t))
+
+    ;; compose the minibuf message and display this.
+    (let* ((sendkey-whereis (where-is-internal
+                            (get agent 'sendfunc) nil t))
+          (abortkey-whereis (where-is-internal
+                             (get agent 'abortfunc) nil t))
+          (sendkey (if sendkey-whereis
+                       (key-description sendkey-whereis)
+                     "C-c C-c"))   ; TBD: BOGUS hardcode
+          (abortkey (if abortkey-whereis
+                        (key-description abortkey-whereis)
+                      "M-x kill-buffer"))  ; TBD: BOGUS hardcode
+          )
+      (message "Please enter your report.  Type %s to send, %s to abort."
+              sendkey abortkey))
     ))
 
 (defun reporter-bug-hook ()
-  ;; prohibit sending mail if empty bug report
+  "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)
+          (rfc822-goto-eoh)
           (forward-line 1)
           (point))))
     (save-excursion
@@ -425,4 +409,5 @@ composed.")
 \f
 (provide 'reporter)
 
+;;; arch-tag: 33612ff4-fbbc-4be2-b183-560ce9e0199b
 ;;; reporter.el ends here