cgit.sxemacs.org Git - packages/blob - xemacs-packages/xwem/lisp/xwem-report.el

   1 ;;; xwem-report.el --- Generate a bug report   -*-Emacs-Lisp-*-
   2
   3 ;; Copyright (C) 2004,2005 by XWEM Org.
   4
   5 ;; Author: Steve Youngs <steve@xwem.org>
   6 ;; Created: 2004-12-05
   7 ;; Keywords: xwem
   8 ;; X-CVS: $Id: xwem-report.el,v 1.5 2005-04-04 19:54:15 lg Exp $
   9
  10 ;; This file is part of XWEM.
  11
  12 ;; XWEM is free software; you can redistribute it and/or modify it
  13 ;; under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; XWEM is distributed in the hope that it will be useful, but WITHOUT
  18 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  19 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public
  20 ;; License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with XEmacs; see the file COPYING.  If not, write to the Free
  24 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  25 ;; 02111-1307, USA.
  26
  27 ;;; Synched up with: Not in FSF
  28
  29 ;;; Commentary:
  30 ;;
  31 ;;  Bug reporter.
  32
  33 ;;; Code:
  34
  35 (require 'sendmail)
  36 (require 'shadow)
  37
  38 ;; To keep the byte-compiler from spewing out warnings.
  39 (eval-when-compile
  40   (defvar after-sep-pos)
  41   (defvar final-resting-place)
  42   (require 'xwem-version)
  43   (require 'xlib-version)
  44   (require 'font-lock)
  45   (require 'pp))
  46
  47
  48 ;;; Variables
  49
  50 (defcustom xwem-report-bug-send-init nil
  51   "*If non-nil, include the user's init.el file in the bug report."
  52   :group 'xwem-misc
  53   :type 'boolean)
  54
  55 ;;; Internal variables
  56
  57 (defconst xwem-report-salutations
  58   ["Dear bug team:"
  59    "Ciao bug team:"
  60    "Salut bug team:"
  61    "Guten Tag bug team:"
  62    "To whom it may concern:"
  63    "Fellow XWEM'ers:"
  64    "Yo bug team:"
  65    "G'day bug team:"
  66    "Greetings Earthlings:"]
  67   "A list of salutations used for `xwem-report-bug'.")
  68
  69 (defvar xwem-bug-address
  70   "XWEM Bugs <xwem-bugs@xwem.org>"
  71   "The address used for submitting bug reports.")
  72
  73 ;;; Functions
  74
  75 (defun xwem-report-pre-hook ()
  76   "Pre hook run by report-submit-bug-report."
  77   (mail-subject)
  78   (insert "[XWEM Bug] ")
  79   (mail-text))
  80
  81 (defun xwem-report-post-hook ()
  82   "Post hook run by report-submit-bug-report."
  83   (save-excursion
  84     (mail-subject)
  85     (font-lock-fontify-buffer)
  86     (let ((subj (read-string "Subject header: ")))
  87       (insert subj))))
  88
  89 ;; Stolen from Gnus.
  90 (defun xwem-report-debug ()
  91   "Go through the Xwem source files and report what variables have been changed.
  92 The source file has to be in the load path."
  93   (let ((files '("xwem-smartmods.el" "xwem-recover.el" "ixwem.el"
  94                  "xwem-battery.el" "xwem-time.el" "xwem-weather.el"
  95                  "xwem-framei.el" "xwem-worklog.el" "xwem-holer.el"
  96                  "xwem-osd.el" "xwem-tabbing.el" "xwem-selections.el"
  97                  "xwem-root.el" "xwem-report.el" "xwem-desktop.el"
  98                  "xwem-faces.el" "xwem-tray.el" "xwem-main.el" "xwem-sound.el"
  99                  "xwem-strokes.el" "xwem-edmacro.el" "xwem-clgen.el"
 100                  "xwem-launcher.el" "xwem-frame.el" "xwem-special.el"
 101                  "xwem-interactive.el" "xwem-transient.el" "xwem-keyboard.el"
 102                  "xwem-mouse.el" "xwem-misc.el" "xwem-focus.el"
 103                  "xwem-keymacro.el" "xwem-rooter.el" "xwem-rooticon.el"
 104                  "xwem-clients.el" "xwem-minibuffer.el" "xwem-register.el"
 105                  "xwem-clswi.el" "xwem-icons.el" "xwem-manage.el"
 106                  "xwem-netwm.el" "xwem-win.el" "xwem-theme.el"))
 107         (print-level 4)                 ; XXX
 108         (point (point))
 109         file expr olist sym)
 110     (message "Please wait while we snoop your variables...")
 111     (sit-for 0)
 112     ;; Go through all the files looking for non-default values for variables.
 113     (save-excursion
 114       (set-buffer (get-buffer-create " *xwem bug info*"))
 115       (while files
 116         (erase-buffer)
 117         (when (and (setq file (locate-library (pop files)))
 118                    (file-exists-p file))
 119           (insert-file-contents file)
 120           (goto-char (point-min))
 121           (if (not (re-search-forward "^;;* *Internal variables" nil t))
 122               (message "Malformed sources in file %s" file)
 123             (narrow-to-region (point-min) (point))
 124             (goto-char (point-min))
 125             (while (setq expr (ignore-errors (read (current-buffer))))
 126               (ignore-errors
 127                 (and (or (eq (car expr) 'defvar)
 128                          (eq (car expr) 'defcustom))
 129                      (stringp (nth 3 expr))
 130                      (or (not (boundp (nth 1 expr)))
 131                          (not (equal (eval (nth 2 expr))
 132                                      (symbol-value (nth 1 expr)))))
 133                      (push (nth 1 expr) olist)))))))
 134       (kill-buffer (current-buffer)))
 135     (when (setq olist (nreverse olist))
 136       (insert "\n"))
 137     (while olist
 138       (when (boundp (car olist))
 139         (condition-case ()
 140             (pp `(setq ,(car olist)
 141                        ,(if (or (consp (setq sym (symbol-value (car olist))))
 142                                 (and (symbolp sym)
 143                                      (not (or (eq sym nil)
 144                                               (eq sym t)))))
 145                             (list 'quote (symbol-value (car olist)))
 146                           (symbol-value (car olist))))
 147                 (current-buffer))
 148           (error
 149            (format "(setq %s 'whatever)\n" (car olist)))))
 150         ;(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
 151       (setq olist (cdr olist)))
 152     ;; Remove any control chars - they seem to cause trouble for some
 153     ;; mailers.  (Byte-compiled output from the stuff above.)
 154     (goto-char point)
 155     (while (re-search-forward "[\000-\010\013-\037\200-\237]" nil t)
 156       (replace-match (format "\\%03o" (string-to-char (match-string 0)))
 157                      t t))))
 158
 159 (defun xwem-bug-packages-list ()
 160   "Insert into the current buffer a list of installed packages."
 161   (let ((pkgs packages-package-list))
 162     (while pkgs
 163       (insert
 164        (format "(%s ver: %s upstream: %s)\n"
 165                (nth 0 (car pkgs))
 166                (nth 2 (car pkgs))
 167                (nth 4 (car pkgs))))
 168       (setq pkgs (cdr pkgs)))))
 169
 170 (eval-when-compile
 171   (autoload 'xwem-dpy "xwem-struct" nil nil 'macro)
 172   (require 'xlib-xc))
 173
 174 (defun xwem-prepare-report ()
 175   "Grabs the variables, features to include in bug report.
 176 Then put it all into a mail buffer, nicely formatted."
 177   (mail-to)
 178   (insert xwem-bug-address)
 179   (mail-text)
 180   (forward-line 1)
 181   (setq after-sep-pos (point))
 182   (setq final-resting-place (point-marker))
 183   (insert
 184    "\n\n"
 185    "===============================================================\n"
 186    "System info to help the XWEM boys and girls try to fix your bug:\n"
 187    "==============================================================="
 188    "\n\n")
 189   (insert (format "%s" xwem-version) "\n"
 190           (format "%s" xlib-version) "\n\n")
 191   ;; xdpyinfo
 192   (insert "Output from xdpyinfo:\n--------------------\n\n"
 193           (shell-command-to-string (concat "xdpyinfo -display "
 194                                            (X-Dpy-name (xwem-dpy))))
 195           "\n")
 196   ;; backtrace & messages buffers
 197   (let ((lisptrace (get-buffer "*Backtrace*"))
 198         (ctrace (get-buffer "*gdb-xemacs*"))
 199         (debug (get-buffer "*xwem-debug*"))
 200         (msgs (get-buffer " *xwem-messages*")))
 201     (when lisptrace
 202       (insert "Lisp Backtrace:\n--------------\n\n")
 203       (insert-buffer-substring lisptrace)
 204       (insert "\n\n"))
 205     (when ctrace
 206       (insert "C Backtrace:\n-----------\n\n")
 207       (insert-buffer-substring ctrace)
 208       (insert "\n\n"))
 209     (when debug
 210       (insert "xwem-debug buffer:\n-----------------\n\n")
 211       (insert-buffer-substring debug)
 212       (insert "\n\n"))
 213     (when msgs
 214       (insert "xwem-messages buffer:\n--------------------\n\n")
 215       (insert-buffer-substring msgs)
 216       (insert "\n\n")))
 217   ;; Insert all the XWEM vars that have been changed from default.
 218   ;; The actual work for this is done in `xwem-bug-debug', but it
 219   ;; needs to be called toward the end of this function.
 220   (insert "\n\nXWEM variables of note:\n----------------------\n")
 221   (when window-setup-hook
 222     (insert "\n\nwindow-setup-hook:")
 223     (cl-prettyprint (symbol-value 'window-setup-hook)))
 224   (when kill-emacs-hook
 225     (insert "\n\nkill-emacs-hook:")
 226     (cl-prettyprint (symbol-value 'kill-emacs-hook)))
 227   ;; Insert the output of 'describe-installation'.
 228   (insert "\n\n"
 229           (symbol-value 'Installation-string))
 230   ;; Load-path shadows can cause some grief.
 231   (flet ((append-message
 232            (&rest args) ())
 233          (clear-message
 234            (&optional label frame stdout-p no-restore)
 235            ()))
 236     (insert "\n\nLoad-Path Lisp Shadows:\n"
 237             "----------------------\n")
 238     (let ((before-shadows (point)))
 239       (insert
 240         (format "%s"
 241                 (find-emacs-lisp-shadows load-path)))
 242       (save-restriction
 243         (narrow-to-region before-shadows (point))
 244         (fill-paragraph t)
 245         (insert "\n"))))
 246   ;; Insert a list of installed packages.
 247   (insert "\n\nInstalled XEmacs Packages:\n"
 248           "-------------------------\n")
 249   (xwem-bug-packages-list)
 250   (insert "\n")
 251   ;; Insert a list of installed modules.
 252   (if (fboundp 'list-modules)
 253       (progn
 254         (insert "\n\nInstalled Modules:\n"
 255                 "-----------------\n")
 256         (let* ((mods (list-modules)))
 257           (while mods
 258             (cl-prettyprint (cdr (car mods)))
 259             (setq mods (cdr mods))))))
 260   ;; Insert a list of loaded features
 261   (let ((before-features (point)))
 262     (insert
 263      (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features)))
 264     (save-restriction
 265       (narrow-to-region before-features (point))
 266       (fill-paragraph t)
 267       (insert "\n\n")))
 268   ;; Insert the contents of the user's init file if it exists
 269   ;; and the user wants it sent.
 270   (if xwem-report-bug-send-init
 271       (if (file-readable-p user-init-file)
 272           (save-excursion
 273             (goto-char (point-max))
 274             (forward-line -3)
 275             (beginning-of-line)
 276             (insert "\n\nUser Init File:\n--------------\n\n")
 277             (insert-file-contents user-init-file))))
 278   (xwem-report-pre-hook)
 279   (xwem-report-post-hook)
 280   (mail-text)
 281   (insert
 282    (aref xwem-report-salutations
 283          (% (+ (% (random) 1000) 1000)
 284             (length xwem-report-salutations))) "\n")
 285   (re-search-forward "XWEM variables of note:" nil t)
 286   (forward-line 2)
 287   (xwem-report-debug)
 288   (goto-char final-resting-place)
 289   (forward-line 2)
 290   (set-marker final-resting-place nil)
 291   (message "Please enter your report.  Type C-c C-c to send, C-x k to abort."))
 292
 293 ;;;###autoload
 294 (defun xwem-report-bug (&optional no-confirm)
 295   "Submit a bug report for XWEM.
 296 Optional argument BLURB is a string that adds a preamble to the bug report.
 297 Optional argument NO-CONFIRM if 't' will not ask for confirmation."
 298   (interactive)
 299   (if (or no-confirm
 300           (y-or-n-p "Do you want to submit a bug report on XWEM? "))
 301       (progn
 302         (mail)
 303         (xwem-prepare-report))))
 304
 305 (provide 'xwem-report)
 306
 307 ;;; xwem-report.el ends here