lisp/mail/reporter.el

   1 ;;; reporter.el --- customizable bug reporting of lisp programs
   2
   3 ;; Copyright (C) 1993 1994 Barry A. Warsaw
   4 ;; Copyright (C) 1993 1994 Free Software Foundation, Inc.
   5
   6 ;; Author: 1993 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
   7 ;; Maintainer:      bwarsaw@cnri.reston.va.us
   8 ;; Created:         19-Apr-1993
   9 ;; Version:         2.21
  10 ;; Last Modified:   1994/11/29 16:13:50
  11 ;; Keywords: bug reports lisp
  12
  13 ;; This file is part of GNU Emacs.
  14
  15 ;; GNU Emacs is free software; you can redistribute it and/or modify
  16 ;; it under the terms of the GNU General Public License as published by
  17 ;; the Free Software Foundation; either version 2, or (at your option)
  18 ;; any later version.
  19
  20 ;; GNU Emacs is distributed in the hope that it will be useful,
  21 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  22 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23 ;; GNU General Public License for more details.
  24
  25 ;; You should have received a copy of the GNU General Public License
  26 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  27 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  28 ;; Boston, MA 02111-1307, USA.
  29
  30 ;;; Commentary:
  31
  32 ;; Introduction
  33 ;; ============
  34 ;; This program is for lisp package authors and can be used to ease
  35 ;; reporting of bugs.  When invoked, reporter-submit-bug-report will
  36 ;; set up a mail buffer with the appropriate bug report address,
  37 ;; including a lisp expression the maintainer of the package can eval
  38 ;; to completely reproduce the environment in which the bug was
  39 ;; observed (e.g. by using eval-last-sexp). This package proved
  40 ;; especially useful during my development of cc-mode.el, which is
  41 ;; highly dependent on its configuration variables.
  42 ;;
  43 ;; Do a "C-h f reporter-submit-bug-report" for more information.
  44 ;; Here's an example usage:
  45 ;;
  46 ;;(defconst mypkg-version "9.801")
  47 ;;(defconst mypkg-maintainer-address "mypkg-help@foo.com")
  48 ;;(defun mypkg-submit-bug-report ()
  49 ;;  "Submit via mail a bug report on mypkg"
  50 ;;  (interactive)
  51 ;;  (require 'reporter)
  52 ;;  (reporter-submit-bug-report
  53 ;;   mypkg-maintainer-address
  54 ;;   (concat "mypkg.el " mypkg-version)
  55 ;;   (list 'mypkg-variable-1
  56 ;;         'mypkg-variable-2
  57 ;;         ;; ...
  58 ;;         'mypkg-variable-last)))
  59
  60 ;; Mailing List
  61 ;; ============
  62 ;; I've set up a mailing list to report bugs or suggest enhancements,
  63 ;; etc. This list's intended audience is elisp package authors who are
  64 ;; using reporter and want to stay current with releases. Here are the
  65 ;; relevant addresses:
  66 ;;
  67 ;; Administrivia: reporter-request@anthem.nlm.nih.gov
  68 ;; Submissions:   reporter@anthem.nlm.nih.gov
  69
  70 ;; Packages that currently use reporter are: cc-mode, supercite, elp,
  71 ;; tcl, ediff, crypt, vm, edebug, archie, and efs.  If you know of
  72 ;; others, please email me!
  73
  74 ;; LCD Archive Entry:
  75 ;; reporter|Barry A. Warsaw|bwarsaw@cnri.reston.va.us|
  76 ;; Customizable bug reporting of lisp programs.|
  77 ;; 1994/11/29 16:13:50|2.21|~/misc/reporter.el.Z|
  78
  79 ;;; Code:
  80
  81 \f
  82 ;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
  83 ;; user defined variables
  84
  85 (defvar reporter-mailer '(vm-mail reporter-mail)
  86   "*Mail package to use to generate bug report buffer.
  87 This can either be a function symbol or a list of function symbols.
  88 If a list, it tries to use each specified mailer in order until an
  89 existing one is found.
  90
  91 MH-E users may want to use `mh-smail'.")
  92
  93 (defvar reporter-prompt-for-summary-p nil
  94   "Interface variable controlling prompting for problem summary.
  95 When non-nil, `reporter-submit-bug-report' prompts the user for a
  96 brief summary of the problem, and puts this summary on the Subject:
  97 line.
  98
  99 Default behavior is to not prompt (i.e. nil). If you want reporter to
 100 prompt, you should `let' bind this variable to t before calling
 101 `reporter-submit-bug-report'.  Note that this variable is not
 102 buffer-local so you should never just `setq' it.")
 103
 104 (defvar reporter-dont-compact-list nil
 105   "Interface variable controlling compacting of list values.
 106 When non-nil, this must be a list of variable symbols.  When a
 107 variable containing a list value is formatted in the bug report mail
 108 buffer, it normally is compacted so that its value fits one the fewest
 109 number of lines.  If the variable's symbol appears in this list, its
 110 value is printed in a more verbose style, specifically, one elemental
 111 sexp per line.
 112
 113 Note that this variable is not buffer-local so you should never just
 114 `setq' it.  If you want to changes its default value, you should `let'
 115 bind it.")
 116
 117 ;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
 118 ;; end of user defined variables
 119
 120 (defvar reporter-eval-buffer nil
 121   "Buffer to retrieve variable's value from.
 122 This is necessary to properly support the printing of buffer-local
 123 variables.  Current buffer will always be the mail buffer being
 124 composed.")
 125
 126 (defconst reporter-version "2.21"
 127   "Reporter version number.")
 128
 129 (defvar reporter-initial-text nil
 130   "The automatically created initial text of a bug report.")
 131 (make-variable-buffer-local 'reporter-initial-text)
 132
 133 \f
 134 (defvar reporter-status-message nil)
 135 (defvar reporter-status-count nil)
 136
 137 (defun reporter-update-status ()
 138   ;; periodically output a status message
 139   (if (zerop (% reporter-status-count 10))
 140       (progn
 141         (message reporter-status-message)
 142         (setq reporter-status-message (concat reporter-status-message "."))))
 143   (setq reporter-status-count (1+ reporter-status-count)))
 144
 145 \f
 146 (defun reporter-beautify-list (maxwidth compact-p)
 147   ;; pretty print a list
 148   (reporter-update-status)
 149   (let (linebreak indent-enclosing-p indent-p here)
 150     (condition-case nil                 ;loop exit
 151         (progn
 152           (down-list 1)
 153           (setq indent-enclosing-p t)
 154           (while t
 155             (setq here (point))
 156             (forward-sexp 1)
 157             (if (<= maxwidth (current-column))
 158                 (if linebreak
 159                     (progn
 160                       (goto-char linebreak)
 161                       (newline-and-indent)
 162                       (setq linebreak nil))
 163                   (goto-char here)
 164                   (setq indent-p (reporter-beautify-list maxwidth compact-p))
 165                   (goto-char here)
 166                   (forward-sexp 1)
 167                   (if indent-p
 168                       (newline-and-indent))
 169                   t)
 170               (if compact-p
 171                   (setq linebreak (point))
 172                 (newline-and-indent))
 173               ))
 174           t)
 175       (error indent-enclosing-p))))
 176
 177 (defun reporter-lisp-indent (indent-point state)
 178   ;; a better lisp indentation style for bug reporting
 179   (save-excursion
 180     (goto-char (1+ (nth 1 state)))
 181     (current-column)))
 182
 183 (defun reporter-dump-variable (varsym mailbuf)
 184   ;; Pretty-print the value of the variable in symbol VARSYM.  MAILBUF
 185   ;; is the mail buffer being composed
 186   (reporter-update-status)
 187   (condition-case nil
 188       (let ((val (save-excursion
 189                    (set-buffer reporter-eval-buffer)
 190                    (symbol-value varsym)))
 191             (sym (symbol-name varsym))
 192             (print-escape-newlines t)
 193             (maxwidth (1- (window-width)))
 194             (here (point)))
 195         (insert "     " sym " "
 196                 (cond
 197                  ((memq val '(t nil)) "")
 198                  ((listp val) "'")
 199                  ((symbolp val) "'")
 200                  (t ""))
 201                 (prin1-to-string val))
 202         (lisp-indent-line)
 203         ;; clean up lists, but only if the line as printed was long
 204         ;; enough to wrap
 205         (if (and val                    ;nil is a list, but short
 206                  (listp val)
 207                  (<= maxwidth (current-column)))
 208             (save-excursion
 209               (let ((compact-p (not (memq varsym reporter-dont-compact-list)))
 210                     (lisp-indent-function 'reporter-lisp-indent))
 211                 (goto-char here)
 212                 (reporter-beautify-list maxwidth compact-p))))
 213         (insert "\n"))
 214     (void-variable
 215      (save-excursion
 216        (set-buffer mailbuf)
 217        (mail-position-on-field "X-Reporter-Void-Vars-Found")
 218        (end-of-line)
 219        (insert (symbol-name varsym) " ")))
 220     (error (error))))
 221
 222 (defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
 223   ;; Dump the state of the mode specific variables.
 224   ;; PKGNAME contains the name of the mode as it will appear in the bug
 225   ;; report (you must explicitly concat any version numbers).
 226
 227   ;; VARLIST is the list of variables to dump.  Each element in
 228   ;; VARLIST can be a variable symbol, or a cons cell.  If a symbol,
 229   ;; this will be passed to `reporter-dump-variable' for insertion
 230   ;; into the mail buffer.  If a cons cell, the car must be a variable
 231   ;; symbol and the cdr must be a function which will be `funcall'd
 232   ;; with arguments the symbol and the mail buffer being composed. Use
 233   ;; this to write your own custom variable value printers for
 234   ;; specific variables.
 235
 236   ;; Note that the global variable `reporter-eval-buffer' will be bound to
 237   ;; the buffer in which `reporter-submit-bug-report' was invoked.  If you
 238   ;; want to print the value of a buffer local variable, you should wrap
 239   ;; the `eval' call in your custom printer inside a `set-buffer' (and
 240   ;; probably a `save-excursion'). `reporter-dump-variable' handles this
 241   ;; properly.
 242
 243   ;; PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but
 244   ;; before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
 245   ;; dumped.
 246   (let ((buffer (current-buffer)))
 247     (set-buffer buffer)
 248     (insert "Emacs  : " (emacs-version) "\n")
 249     (and pkgname
 250          (insert "Package: " pkgname "\n"))
 251     (run-hooks 'pre-hooks)
 252     (if (not varlist)
 253         nil
 254       (insert "\ncurrent state:\n==============\n")
 255       ;; create an emacs-lisp-mode buffer to contain the output, which
 256       ;; we'll later insert into the mail buffer
 257       (condition-case fault
 258           (let ((mailbuf (current-buffer))
 259                 (elbuf (get-buffer-create " *tmp-reporter-buffer*")))
 260             (save-excursion
 261               (set-buffer elbuf)
 262               (emacs-lisp-mode)
 263               (erase-buffer)
 264               (insert "(setq\n")
 265               (lisp-indent-line)
 266               (mapcar
 267                (function
 268                 (lambda (varsym-or-cons-cell)
 269                   (let ((varsym (or (car-safe varsym-or-cons-cell)
 270                                     varsym-or-cons-cell))
 271                         (printer (or (cdr-safe varsym-or-cons-cell)
 272                                      'reporter-dump-variable)))
 273                     (funcall printer varsym mailbuf)
 274                     )))
 275                varlist)
 276               (lisp-indent-line)
 277               (insert ")\n"))
 278             (insert-buffer elbuf))
 279         (error
 280          (insert "State could not be dumped due to the following error:\n\n"
 281                  (format "%s" fault)
 282                  "\n\nYou should still send this bug report."))))
 283     (run-hooks 'post-hooks)
 284     ))
 285
 286 \f
 287 (defun reporter-calculate-separator ()
 288   ;; returns the string regexp matching the mail separator
 289   (save-excursion
 290     (re-search-forward
 291      (concat
 292       "^\\("                            ;beginning of line
 293       (mapconcat
 294        'identity
 295        (list "[\t ]*"                   ;simple SMTP form
 296              "-+"                       ;mh-e form
 297              (regexp-quote
 298               mail-header-separator))   ;sendmail.el form
 299        "\\|")                           ;or them together
 300       "\\)$")                           ;end of line
 301      nil
 302      'move)                             ;search for and move
 303     (buffer-substring (match-beginning 0) (match-end 0))))
 304
 305 ;; Serves as an interface to `mail',
 306 ;; but when the user says "no" to discarding an unset message,
 307 ;; it gives an error.
 308 (defun reporter-mail (&rest args)
 309   (interactive "P")
 310   (or (apply 'mail args)
 311       (error "Bug report aborted")))
 312
 313 ;;;###autoload
 314 (defun reporter-submit-bug-report
 315   (address pkgname varlist &optional pre-hooks post-hooks salutation)
 316   ;; Submit a bug report via mail.
 317
 318   ;; ADDRESS is the email address for the package's maintainer. PKGNAME is
 319   ;; the name of the mode (you must explicitly concat any version numbers).
 320   ;; VARLIST is the list of variables to dump (see `reporter-dump-state'
 321   ;; for details). Optional PRE-HOOKS and POST-HOOKS are passed to
 322   ;; `reporter-dump-state'. Optional SALUTATION is inserted at the top of the
 323   ;; mail buffer, and point is left after the salutation.
 324
 325   ;; This function will prompt for a summary if
 326   ;; reporter-prompt-for-summary-p is non-nil.
 327
 328   ;; The mailer used is described in the variable `reporter-mailer'.
 329   (let ((reporter-eval-buffer (current-buffer))
 330         final-resting-place
 331         after-sep-pos
 332         (reporter-status-message "Formatting bug report buffer...")
 333         (reporter-status-count 0)
 334         (problem (and reporter-prompt-for-summary-p
 335                       (read-string "(Very) brief summary of problem: ")))
 336         (mailbuf
 337          (progn
 338            (call-interactively
 339             (if (nlistp reporter-mailer)
 340                 reporter-mailer
 341               (let ((mlist reporter-mailer)
 342                     (mailer nil))
 343                 (while mlist
 344                   (if (commandp (car mlist))
 345                       (setq mailer (car mlist)
 346                             mlist nil)
 347                     (setq mlist (cdr mlist))))
 348                 (if (not mailer)
 349                     (error
 350                      "Variable `%s' does not contain a command for mailing"
 351                      "reporter-mailer"))
 352                 mailer)))
 353            (current-buffer))))
 354     (require 'sendmail)
 355     (pop-to-buffer reporter-eval-buffer)
 356     (pop-to-buffer mailbuf)
 357     (goto-char (point-min))
 358     ;; different mailers use different separators, some may not even
 359     ;; use m-h-s, but sendmail.el stuff must have m-h-s bound.
 360     (let ((mail-header-separator (reporter-calculate-separator)))
 361       (mail-position-on-field "to")
 362       (insert address)
 363       ;; insert problem summary if available
 364       (if (and reporter-prompt-for-summary-p problem pkgname)
 365           (progn
 366             (mail-position-on-field "subject")
 367             (insert pkgname "; " problem)))
 368       ;; move point to the body of the message
 369       (mail-text)
 370       (forward-line 1)
 371       (setq after-sep-pos (point))
 372       (and salutation (insert "\n" salutation "\n\n"))
 373       (unwind-protect
 374           (progn
 375             (setq final-resting-place (point-marker))
 376             (insert "\n\n")
 377             (reporter-dump-state pkgname varlist pre-hooks post-hooks)
 378             (goto-char final-resting-place))
 379         (set-marker final-resting-place nil)))
 380
 381     ;; save initial text and set up the `no-empty-submission' hook.
 382     ;; This only works for mailers that support mail-send-hook,
 383     ;; e.g. sendmail.el
 384     (if (fboundp 'add-hook)
 385         (progn
 386           (save-excursion
 387             (goto-char (point-max))
 388             (skip-chars-backward " \t\n")
 389             (setq reporter-initial-text
 390                   (buffer-substring after-sep-pos (point))))
 391           (make-variable-buffer-local 'mail-send-hook)
 392           (add-hook 'mail-send-hook 'reporter-bug-hook)))
 393
 394     ;; minibuf message
 395     ;; C-c C-c can't be generalized because they don't always run
 396     ;; mail-send-and-exit. E.g. vm-mail-send-and-exit.  I don't want
 397     ;; to hard code these.
 398     (let* ((sendkey "C-c C-c")
 399            (killkey-whereis (where-is-internal 'kill-buffer nil t))
 400            (killkey (if killkey-whereis
 401                         (key-description killkey-whereis)
 402                       "M-x kill-buffer")))
 403       (message "Please type in your report. Hit %s to send, %s to abort."
 404                sendkey killkey))
 405     ))
 406
 407 (defun reporter-bug-hook ()
 408   ;; prohibit sending mail if empty bug report
 409   (let ((after-sep-pos
 410          (save-excursion
 411            (beginning-of-buffer)
 412            (re-search-forward (reporter-calculate-separator) (point-max) 'move)
 413            (forward-line 1)
 414            (point))))
 415     (save-excursion
 416       (goto-char (point-max))
 417       (skip-chars-backward " \t\n")
 418       (if (and (= (- (point) after-sep-pos)
 419                   (length reporter-initial-text))
 420                (string= (buffer-substring after-sep-pos (point))
 421                         reporter-initial-text))
 422           (error "Empty bug report cannot be sent"))
 423       )))
 424
 425 \f
 426 (provide 'reporter)
 427
 428 ;;; reporter.el ends here