cgit.sxemacs.org Git - emchat/blob - emchat-report.el

   1 ;;; emchat-report.el --- Generate a bug report   -*-Emacs-Lisp-*-
   2
   3 ;; Copyright (C) 2001 - 2011 Steve Youngs
   4
   5 ;; Author:        Steve Youngs <steve@emchat.org>
   6 ;; Maintainer:    Steve Youngs <steve@emchat.org>
   7 ;; Keywords:      bug-report
   8
   9 ;; This file is part of EMchat.
  10
  11 ;; Redistribution and use in source and binary forms, with or without
  12 ;; modification, are permitted provided that the following conditions
  13 ;; are met:
  14 ;;
  15 ;; 1. Redistributions of source code must retain the above copyright
  16 ;;    notice, this list of conditions and the following disclaimer.
  17 ;;
  18 ;; 2. Redistributions in binary form must reproduce the above copyright
  19 ;;    notice, this list of conditions and the following disclaimer in the
  20 ;;    documentation and/or other materials provided with the distribution.
  21 ;;
  22 ;; 3. Neither the name of the author nor the names of any contributors
  23 ;;    may be used to endorse or promote products derived from this
  24 ;;    software without specific prior written permission.
  25 ;;
  26 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  27 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  28 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  29 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  30 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  31 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  32 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  33 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  34 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  35 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  36 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  37
  38 ;;; Commentary:
  39 ;; To submit a bug report use: M-x emchat-report-bug
  40 ;; To send general comments/questions use: M-x emchat-email-author
  41
  42 ;;; Code:
  43
  44 (autoload 'emchat-version "emchat"
  45   "Version of emchat you are currently using." t nil)
  46 (eval-when-compile
  47   (setq message-send-mail-function 'message-send-mail-with-sendmail))
  48 (require 'sendmail)
  49 (require 'shadow)
  50 (require 'gnus-msg)
  51 (require 'gnus-util)
  52 (require 'message)
  53
  54 ;; To keep the byte-compiler from spewing out warnings.
  55 (eval-when-compile
  56   (defvar after-sep-pos)
  57   (defvar final-resting-place)
  58   (defvar emchat-version)
  59   (require 'font-lock)
  60   (require 'yow)
  61   (require 'pp))
  62
  63
  64 ;;; Variables
  65
  66 (defcustom emchat-report-bug-send-init nil
  67   "*If non-nil, include the user's init.el file in the bug report."
  68   :group 'emchat-option
  69   :type 'boolean)
  70
  71 ;;; Internal variables
  72
  73 (defconst emchat-report-salutations
  74   ["Dear bug team:"
  75    "Ciao bug team:"
  76    "Salut bug team:"
  77    "Guten Tag bug team:"
  78    "To whom it may concern:"
  79    "Fellow EMchat'ers:"
  80    "Yo bug team:"
  81    "G'day bug team:"
  82    "Greetings Earthlings:"]
  83   "A list of salutations used for `emchat-report-bug'.")
  84
  85 (defvar emchat-bug-address
  86   "EMchat Bugs <emchat-bugs@emchat.org>"
  87   "The address used for submitting bug reports.")
  88
  89 (defvar emchat-report-blurb nil)
  90
  91 ;;; Functions
  92
  93 (defun emchat-report-pre-hook ()
  94   "Pre hook run by report-submit-bug-report."
  95   (message-goto-subject)
  96   (insert "EMchat bug: ")
  97   (if emchat-report-blurb
  98       (progn
  99         (mail-text)
 100         (insert "\n" emchat-report-blurb "\n"))))
 101
 102 (defun emchat-report-post-hook ()
 103   "Post hook run by report-submit-bug-report."
 104   (save-excursion
 105     (message-goto-subject)
 106     (font-lock-fontify-buffer)
 107     (let ((subj (read-string "Subject header: ")))
 108       (if (string-equal subj "")
 109           (subst-char-in-region
 110            (point)
 111            (progn
 112              (insert
 113               (if (or (fboundp 'yow) (load "yow" t t)) (yow) ""))
 114              (point))
 115            ?\n ?\ )
 116         (insert subj)))))
 117
 118 ;; Stolen from Gnus.
 119 (defun emchat-report-debug ()
 120   "Go through the EMchat source files and report what variables have been changed.
 121 The source file has to be in the load path."
 122   (let ((files '("emchat-buddy.el" "emchat-comm.el" "emchat-curl.el" "emchat-doctor.el"
 123                  "emchat-emphasis.el" "emchat-log.el" "emchat-meta.el" "emchat-report.el"
 124                  "emchat-status.el" "emchat-toolbar.el" "emchat-track.el" "emchat-wharf.el"
 125                  "emchat-world.el" "emchat-xwem.el" "emchat.el"))
 126         (point (point))
 127         file expr olist sym)
 128     (message "Please wait while we snoop your variables...")
 129     (sit-for 0)
 130     ;; Go through all the files looking for non-default values for variables.
 131     (save-excursion
 132       (set-buffer (get-buffer-create " *emchat bug info*"))
 133       (while files
 134         (erase-buffer)
 135         (when (and (setq file (locate-library (pop files)))
 136                    (file-exists-p file))
 137           (insert-file-contents file)
 138           (goto-char (point-min))
 139           (if (not (re-search-forward "^;;* *Internal variables" nil t))
 140               (message "Malformed sources in file %s" file)
 141             (narrow-to-region (point-min) (point))
 142             (goto-char (point-min))
 143             (while (setq expr (ignore-errors (read (current-buffer))))
 144               (ignore-errors
 145                 (and (or (eq (car expr) 'defvar)
 146                          (eq (car expr) 'defcustom))
 147                      (stringp (nth 3 expr))
 148                      (or (not (boundp (nth 1 expr)))
 149                          (not (equal (eval (nth 2 expr))
 150                                      (symbol-value (nth 1 expr)))))
 151                      (push (nth 1 expr) olist)))))))
 152       (kill-buffer (current-buffer)))
 153     (when (setq olist (nreverse olist))
 154       (insert "\n"))
 155     (while olist
 156       (when (boundp (car olist))
 157         (condition-case ()
 158             (pp `(setq ,(car olist)
 159                        ,(if (or (consp (setq sym (symbol-value (car olist))))
 160                                 (and (symbolp sym)
 161                                      (not (or (eq sym nil)
 162                                               (eq sym t)))))
 163                             (list 'quote (symbol-value (car olist)))
 164                           (symbol-value (car olist))))
 165                 (current-buffer))
 166           (error
 167            (format "(setq %s 'whatever)\n" (car olist)))))
 168         ;(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
 169       (setq olist (cdr olist)))
 170     ;; Remove any control chars - they seem to cause trouble for some
 171     ;; mailers.  (Byte-compiled output from the stuff above.)
 172     (goto-char point)
 173     (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
 174       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
 175                      t t))))
 176
 177 (defun emchat-prepare-report ()
 178   "Grabs the variables, features to include in bug report.
 179 Then put it all into a mail buffer, nicely formatted."
 180   (message-goto-to)
 181   (insert emchat-bug-address)
 182   (message-goto-body)
 183   (forward-line 1)
 184   (setq after-sep-pos (point))
 185   (setq final-resting-place (point-marker))
 186   (insert
 187    "\n\n"
 188    "===============================================================\n"
 189    "System info to help the EMchat boys and girls try to fix your bug:\n"
 190    "==============================================================="
 191    "\n\n")
 192   (emchat-version 1)
 193   ;; Insert all the EMchat vars that have been changed from default.
 194   ;; The actual work for this is done in `emchat-bug-debug', but it
 195   ;; needs to be called toward the end of this function.
 196   (insert "\n\nEMchat variables of note:\n----------------------\n")
 197   ;; Insert the output of 'describe-installation'.
 198   (insert "\n\n"
 199           (symbol-value 'Installation-string))
 200   ;; Load-path shadows can cause some grief.
 201   (flet ((append-message
 202            (&rest args) ())
 203          (clear-message
 204            (&optional label frame stdout-p no-restore)
 205            ()))
 206     (insert "\n\nLoad-Path Lisp Shadows:\n"
 207             "----------------------\n")
 208     (let ((before-shadows (point)))
 209       (insert
 210         (format "%s"
 211                 (find-emacs-lisp-shadows load-path)))
 212       (save-restriction
 213         (narrow-to-region before-shadows (point))
 214         (fill-paragraph t)
 215         (insert "\n"))))
 216   ;; Insert a list of installed packages.
 217   (insert "\n\nInstalled XEmacs Packages:\n"
 218           "-------------------------\n")
 219   (cl-prettyprint
 220    (symbol-value 'packages-package-list))
 221   (insert "\n")
 222   ;; Insert a list of loaded features
 223   (let ((before-features (point)))
 224     (insert
 225      (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features)))
 226     (save-restriction
 227       (narrow-to-region before-features (point))
 228       (fill-paragraph t)
 229       (insert "\n\n")))
 230   ;; Insert the contents of the user's init file if it exists
 231   ;; and the user wants it sent.
 232   (if emchat-report-bug-send-init
 233       (if (file-readable-p user-init-file)
 234           (save-excursion
 235             (message-goto-signature)
 236             (forward-line -3)
 237             (beginning-of-line)
 238             (insert "\n\nUser Init File:\n--------------\n\n")
 239             (insert-file-contents user-init-file))))
 240   (emchat-report-pre-hook)
 241   (emchat-report-post-hook)
 242   (mail-text)
 243   (insert
 244    (aref emchat-report-salutations
 245          (% (+ (% (random) 1000) 1000)
 246             (length emchat-report-salutations))) "\n")
 247   (re-search-forward "EMchat variables of note:" nil t)
 248   (forward-line 2)
 249   (emchat-report-debug)
 250   (goto-char final-resting-place)
 251   (set-marker final-resting-place nil)
 252   (message "Please enter your report.  Type C-c C-c to send, C-x k to abort."))
 253
 254 ;;;###autoload
 255 (defun emchat-report-bug (&optional blurb no-confirm)
 256   "Submit a bug report for emchat.
 257 Optional argument BLURB is a string that adds a preamble to the bug report.
 258 Optional argument NO-CONFIRM if 't' will not ask for confirmation.
 259
 260 If you have Gnus it will be used, otherwise the standard XEmacs mail
 261 command is used.
 262
 263 Yes, it's all part of a secret plot to make more people use
 264 the MUA of Gods.  Bwahahaha."
 265   (interactive)
 266   (if (or no-confirm
 267           (y-or-n-p "Do you want to submit a bug report on EMchat? "))
 268       (progn
 269         (setq emchat-report-blurb blurb)
 270         (if (featurep 'gnus)
 271             (progn
 272               (unless (gnus-alive-p)
 273                 (gnus))
 274               (gnus-group-mail 1)
 275               (emchat-prepare-report))
 276           (mail)
 277           (emchat-prepare-report)))))
 278
 279 ;;; email-author code
 280
 281 (defconst emchat-email-salutations
 282   ["Dear Steve,"
 283    "Ciao Steve,"
 284    "Guten Tag Steve,"
 285    "To whom it may concern:"
 286    "Bonjour Steve,"
 287    "Yo! EMchat Dude!"
 288    "G'day Steve,"
 289    "Hey Man,"
 290    "Greetings Earthling:"]
 291   "A list of salutations used for `emchat-email-author'.")
 292
 293 (defun emchat-prepare-email-author ()
 294   "Prepare the mail buffer for `emchat-email-author'."
 295   (message-goto-to)
 296   (insert "Steve Youngs <steve@emchat.org>")
 297   (message-goto-cc)
 298   (insert "EMchat Users <emchat-users@emchat.org>")
 299   (message-goto-subject)
 300   (let ((subj (read-string "Subject header: ")))
 301     (if (string-equal subj "")
 302         (subst-char-in-region
 303          (point)
 304          (progn
 305            (insert
 306             (if (or (fboundp 'yow) (load "yow" t t)) (yow) ""))
 307            (point))
 308          ?\n ?\ )
 309       (insert subj)))
 310   (message-goto-body)
 311   (emchat-version 1)
 312   (insert "\n\n"
 313           (aref emchat-email-salutations
 314                 (% (+ (% (random) 1000) 1000)
 315                    (length emchat-email-salutations))) "\n\n\n")
 316   (forward-line -1))
 317
 318 ;;;###autoload
 319 (defun emchat-email-author ()
 320   "Email comments or money to author.
 321
 322 Uses Gnus if available, otherwise standard mail command."
 323   (interactive)
 324   (if (y-or-n-p "Do you want to send comments to the EMchat author? ")
 325       (progn
 326         (if (featurep 'gnus)
 327             (progn
 328               (unless (gnus-alive-p)
 329                 (gnus))
 330               (gnus-group-mail 1)
 331               (emchat-prepare-email-author))
 332           (mail)
 333           (emchat-prepare-email-author)))))
 334
 335 (provide 'emchat-report)
 336
 337 ;;; emchat-report.el ends here