(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.")
(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 "3.34"
"Reporter version number.")
(defvar reporter-initial-text nil
"The automatically created initial text of a bug report.")
(make-variable-buffer-local 'reporter-initial-text)
(defvar reporter-status-message nil)
(defvar reporter-status-count nil)
(defun reporter-update-status ()
(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)))
(defun reporter-beautify-list (maxwidth compact-p)
(reporter-update-status)
(let ((move t)
linebreak indent-enclosing-p indent-p here)
(condition-case nil (progn
(down-list 1)
(setq indent-enclosing-p t)
(while move
(setq here (point))
(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)
(save-excursion
(goto-char (1+ (nth 1 state)))
(current-column)))
(defun reporter-dump-variable (varsym mailbuf)
(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)
(if (and val (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)
(let ((buffer (current-buffer)))
(set-buffer buffer)
(insert "Emacs : " (emacs-version) "\n")
(and pkgname
(insert "Package: " pkgname "\n"))
(run-hooks 'pre-hooks)
(if (not varlist)
nil
(insert "\ncurrent state:\n==============\n")
(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 ()
(let* ((agent mail-user-agent)
(compose (get mail-user-agent 'composefunc)))
(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))
(defun reporter-submit-bug-report
(address pkgname varlist &optional pre-hooks post-hooks salutation)
(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)
(require 'sendmail)
(let (same-window-buffer-names same-window-regexps)
(pop-to-buffer mailbuf)
(and pop-up-windows (display-buffer reporter-eval-buffer)))
(goto-char (point-min))
(mail-position-on-field "to")
(insert address)
(if (and reporter-prompt-for-summary-p problem pkgname)
(progn
(mail-position-on-field "subject")
(insert pkgname "; " problem)))
(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-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))
(progn
(make-variable-buffer-local hookvar)
(add-hook hookvar 'reporter-bug-hook)))
(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")) (abortkey (if abortkey-whereis
(key-description abortkey-whereis)
"M-x kill-buffer")) )
(message "Please enter your report. Type %s to send, %s to abort."
sendkey abortkey))
))
(defun reporter-bug-hook ()
(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)