X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/4302ef50105ec50802937d1a0154b27260cfffda..89dac01fd8a668f13d467fe22bdb413d53f5a937:/lisp/mail/reporter.el diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index f941a29afd..c1d5839bab 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el @@ -1,13 +1,11 @@ ;;; reporter.el --- customizable bug reporting of lisp programs -;; Copyright (C) 1993, 1994 Free Software Foundation, Inc. +;; Copyright (C) 1993,1994,1995,1996,1997,1998 Free Software Foundation, Inc. -;; Author: 1993 Barry A. Warsaw -;; 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. @@ -28,16 +26,24 @@ ;;; 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: @@ -56,47 +62,21 @@ ;; ;; ... ;; '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: -;; 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.") @@ -113,28 +93,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 + (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) + +;; 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) @@ -142,17 +122,25 @@ composed.") (setq reporter-status-count (1+ reporter-status-count))) +;; 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 @@ -174,14 +162,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 @@ -216,32 +204,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") @@ -283,141 +272,127 @@ composed.") )) -(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)) + ;;;###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 - ;; Normally *mail* is directed to appear in the same window, - ;; but we don't want that to happen here. - (let (same-window-buffer-names - same-window-regexps) - (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) - ;; If mailbuf did not get made visible before, - ;; make it visible now. - (let (same-window-buffer-names - same-window-regexps) + ;; 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. - (display-buffer reporter-eval-buffer)) + ;; 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 @@ -432,5 +407,4 @@ composed.") (provide 'reporter) - ;;; reporter.el ends here