X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/165c38c5341f86437e496624cc87e42973156a3e..671c30d8972e94e190c074e146a83c4296f44385:/lisp/mail/reporter.el diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index aabae37e22..6e609a1f36 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el @@ -1,194 +1,412 @@ ;;; reporter.el --- customizable bug reporting of lisp programs -;; Author: 1993 Barry A. Warsaw, Century Computing Inc. -;; Maintainer: bwarsaw@cen.com +;; Copyright (C) 1993,1994,1995,1996,1997,1998 Free Software Foundation, Inc. + +;; Author: 1993-1998 Barry A. Warsaw +;; Maintainer: FSF ;; Created: 19-Apr-1993 -;; Version: 1.18 -;; Last Modified: 1993/05/22 00:29:49 -;; Keywords: bug reports lisp +;; Keywords: maint mail tools -;; Copyright (C) 1993 Free Software Foundation, Inc. +;; This file is part of GNU Emacs. -;; This file is not yet part of GNU Emacs. -;; -;; This program is free software; you can redistribute it and/or modify +;; 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 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. -;; + ;; You should have received a copy of the GNU General Public License -;; along with this program; if not, write to the Free Software -;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -;; Introduction -;; ============ -;; This program is for lisp package authors and is 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 -;; 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 -;; on its configuration variables. +;; 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. + +;;; Commentary: + +;; 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: ;; -;; (defconst mypkg-version "9.801") -;; (defconst mypkg-maintainer-address "mypkg-help@foo.com") -;; (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)))) - -;; 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 - -;; LCD Archive Entry: -;; reporter|Barry A. Warsaw|warsaw@cen.com| -;; Customizable bug reporting of lisp programs.| -;; 1993/05/22 00:29:49|1.18|~/misc/reporter.el.Z| +;;(defconst mypkg-version "9.801") +;;(defconst mypkg-maintainer-address "mypkg-help@foo.com") +;;(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))) ;;; Code: -;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -;; user defined variables +;; 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. 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 before calling +`reporter-submit-bug-report'. Note that this variable is not +buffer-local so you should never just `setq' it.") + +(defvar reporter-dont-compact-list nil + "Interface variable controlling compacting of list values. +When non-nil, this must be a list of variable symbols. When a +variable containing a list value is formatted in the bug report mail +buffer, it normally is compacted so that its value fits one the fewest +number of lines. If the variable's symbol appears in this list, its +value is printed in a more verbose style, specifically, one elemental +sexp per line. + +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 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.") -(defvar reporter-mailer 'mail - "*Mail package to use to generate bug report buffer.") +(defvar reporter-initial-text nil + "The automatically created initial text of a bug report.") +(make-variable-buffer-local 'reporter-initial-text) -;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ -;; end of user defined variables -(defun reporter-dump-variable (varsym) - "Pretty-print the value of the variable in symbol VARSYM." - (let ((val (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"))) +;; status feedback to the user +(defvar reporter-status-message nil) +(defvar reporter-status-count nil) + +(defun reporter-update-status () + "Periodically output a status message." + (if (zerop (% reporter-status-count 10)) + (progn + (message reporter-status-message) + (setq reporter-status-message (concat reporter-status-message ".")))) + (setq reporter-status-count (1+ reporter-status-count))) + + +;; dumping/pretty printing of values +(defun reporter-beautify-list (maxwidth compact-p) + "Pretty print a list." + (reporter-update-status) + (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 move + (setq here (point)) + ;; 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 + (goto-char linebreak) + (newline-and-indent) + (setq linebreak nil)) + (goto-char here) + (setq indent-p (reporter-beautify-list maxwidth compact-p)) + (goto-char here) + (forward-sexp 1) + (if indent-p + (newline-and-indent)) + t) + (if compact-p + (setq linebreak (point)) + (newline-and-indent)) + )) + t) + (error indent-enclosing-p)))) + +(defun reporter-lisp-indent (indent-point state) + "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." + (reporter-update-status) + (condition-case nil + (let ((val (save-excursion + (set-buffer reporter-eval-buffer) + (symbol-value varsym))) + (sym (symbol-name varsym)) + (print-escape-newlines t) + (maxwidth (1- (window-width))) + (here (point))) + (insert " " sym " " + (cond + ((memq val '(t nil)) "") + ((listp val) "'") + ((symbolp val) "'") + (t "")) + (prin1-to-string val)) + (lisp-indent-line) + ;; clean up lists, but only if the line as printed was long + ;; enough to wrap + (if (and val ;nil is a list, but short + (listp val) + (<= maxwidth (current-column))) + (save-excursion + (let ((compact-p (not (memq varsym reporter-dont-compact-list))) + (lisp-indent-function 'reporter-lisp-indent)) + (goto-char here) + (reporter-beautify-list maxwidth compact-p)))) + (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. +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 +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) + (lisp-indent-line) + (insert ")\n")) + (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-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. +"Begin submitting a bug report via email. -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 salutation. +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. -The mailer used is described in the variable `reporter-mailer'." +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. - (let ((curbuf (current-buffer)) - (mailbuf (progn (call-interactively reporter-mailer) - (current-buffer)))) +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 (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 curbuf) - (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 - (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))))) - (mail-position-on-field "to") - (insert address) - (mail-position-on-field "subject") - (insert "Report on package " pkgname) - (re-search-forward mail-header-separator (point-max) 'move) - (forward-line 1) - (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? - (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)) + (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 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)) )) -;; this is useful +(defun reporter-bug-hook () + "Prohibit sending mail if empty bug report." + (let ((after-sep-pos + (save-excursion + (rfc822-goto-eoh) + (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) +;;; arch-tag: 33612ff4-fbbc-4be2-b183-560ce9e0199b ;;; reporter.el ends here