cgit.sxemacs.org Git - sxemacs/blob - lisp/issue-tracker.el

   1 ;; issue-tracker.el --- SXEmacs Bug Reporting/Tracking
   2
   3 ;; Copyright (C) 2005 Steve Youngs
   4
   5 ;; Author:        Steve Youngs <steve@sxemacs.org>
   6 ;; Maintainer:    Steve Youngs <steve@sxemacs.org>
   7 ;; Created:       <2005-01-10>
   8 ;; Homepage:      http://www.sxemacs.org/
   9 ;; Keywords:      bugs issues
  10
  11 ;; This file is part of SXEmacs.
  12
  13 ;; Redistribution and use in source and binary forms, with or without
  14 ;; modification, are permitted provided that the following conditions
  15 ;; are met:
  16 ;;
  17 ;; 1. Redistributions of source code must retain the above copyright
  18 ;;    notice, this list of conditions and the following disclaimer.
  19 ;;
  20 ;; 2. Redistributions in binary form must reproduce the above copyright
  21 ;;    notice, this list of conditions and the following disclaimer in the
  22 ;;    documentation and/or other materials provided with the distribution.
  23 ;;
  24 ;; 3. Neither the name of the author nor the names of any contributors
  25 ;;    may be used to endorse or promote products derived from this
  26 ;;    software without specific prior written permission.
  27 ;;
  28 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  29 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  30 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  31 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  32 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  33 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  34 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  35 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  36 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  37 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  38 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  39
  40 ;;; Commentary:
  41 ;;
  42 ;;    This will hopefully turn into an interface to the SXEmacs issue
  43 ;;    tracker.  For now, it is basically a clone of xemacsbug with a
  44 ;;    couple of things changed to suit SXEmacs conditions.
  45
  46 ;;; Todo:
  47 ;;
  48 ;;    Interface to our issue tracker.
  49
  50 ;;; Code:
  51 (require 'shadow)
  52 (require 'info)
  53 (require 'view-less)
  54
  55 (eval-when-compile
  56   (defvar mh-before-send-letter-hook))
  57
  58 (defgroup sxemacsbug nil
  59   "Sending SXEmacs bug reports."
  60   :group 'maint
  61   :group 'mail)
  62
  63 ;; >> These should be addresses which are accessible to your machine,
  64 ;; >> otherwise you can't use this file.  It will only work on the
  65 ;; >> internet with this address.
  66
  67 (defcustom report-sxemacs-bug-address "SXEmacs Devel <sxemacs-devel@sxemacs.org>"
  68   "*Address of mailing list for SXEmacs bugs."
  69   :group 'sxemacsbug
  70   :type 'string)
  71
  72 (defcustom report-sxemacs-bug-extra-headers nil
  73   "*An alist of mail-header value pairs for SXEmacs bugs.
  74
  75 It takes the format (HEADER . VALUE) where both HEADER and VALUE are
  76 strings. See `compose-mail'."
  77   :group 'sxemacsbug
  78   :type '(repeat
  79           (cons (string :tag "Header")
  80                 (string :tag "Value"))))
  81
  82 (defcustom report-sxemacs-bug-beta-address "SXEmacs Devel <sxemacs-devel@sxemacs.org>"
  83   "*Address of mailing list for SXEmacs beta bugs."
  84   :group 'sxemacsbug
  85   :type 'string)
  86
  87 (defcustom report-sxemacs-bug-beta-extra-headers nil
  88   "*An alist of mail-header value pairs for SXEmacs beta bugs.
  89
  90 It takes the format (HEADER . VALUE) where both HEADER and VALUE are
  91 strings. See `compose-mail'."
  92   :group 'sxemacsbug
  93   :type '(repeat
  94           (cons (string :tag "Header")
  95                 (string :tag "Value"))))
  96
  97 (defvar report-sxemacs-bug-orig-text nil
  98   "The automatically-created initial text of bug report.")
  99
 100 (defcustom report-sxemacs-bug-no-confirmation nil
 101   "*If non-nil, suppress the confirmations asked for the sake of novice users."
 102   :group 'sxemacsbug
 103   :type 'boolean)
 104
 105 (defcustom report-sxemacs-bug-no-explanations nil
 106   "*If non-nil, suppress the explanations given for the sake of novice users."
 107   :group 'sxemacsbug
 108   :type 'boolean)
 109
 110 (defcustom report-sxemacs-bug-send-init nil
 111   "*If non-nil, include the user's init.el file in the bug report."
 112   :group 'sxemacsbug
 113   :type 'boolean)
 114
 115 (defconst report-sxemacs-bug-help
 116 "\nThis bug report will be sent to the SXEmacs Development Team,
 117 not to your local site managers!!
 118
 119 Please write in English, because the SXEmacs maintainers do not have
 120 translators to read other languages for them.
 121
 122 Please describe as succinctly as possible:
 123 \t- What happened.
 124 \t- What you thought should have happened.
 125 \t- Precisely what you were doing at the time.
 126
 127 Also include a reliable recipe for triggering the bug, as well as
 128 any C and lisp back-traces that you may have.
 129 \(setq stack-trace-on-error t\), or \(setq debug-on-error t\) if you
 130 are familiar with the debugger, to get a lisp back-trace.
 131 To get a core file for the C back-trace on a GNU/Linux system do
 132 'ulimit -c unlimited' in the shell prior to starting SXEmacs.
 133
 134 Type \\[report-sxemacs-bug-info] to visit in Info the SXEmacs Manual section
 135 about when and how to write a bug report,
 136 and what information to supply so that the bug can be fixed.
 137 Type SPC to scroll through this section and its subsections.
 138
 139 You are very welcome to scan through the bug report and remove any
 140 potentially sensitive data.
 141
 142 Turn off this help buffer permanently by adding:
 143
 144 \t \(setq report-sxemacs-bug-no-explanations t\)
 145
 146 To your ~/.sxemacs/init.el")
 147
 148 (defun report-sxemacs-bug-help ()
 149   "Display the help buffer for `report-sxemacs-bug'."
 150   (declare-fboundp
 151    (with-electric-help
 152     #'(lambda ()
 153         (define-key (current-local-map) "\C-c\C-i" 'report-sxemacs-bug-info)
 154         (princ (substitute-command-keys report-sxemacs-bug-help)) nil) "*Bug Help*")))
 155
 156 (defun report-sxemacs-bug-packages-list ()
 157   "Insert into the current buffer a list of installed packages."
 158   (let ((pkgs packages-package-list))
 159     (while pkgs
 160       (insert
 161        (format "(%s ver: %s upstream: %s)\n"
 162                (nth 0 (car pkgs))
 163                (nth 2 (car pkgs))
 164                (nth 4 (car pkgs))))
 165       (setq pkgs (cdr pkgs)))))
 166
 167 (defun report-sxemacs-bug-via-email (topic &optional recent-keys)
 168   "Report a bug in SXEmacs.
 169 Prompts for bug subject.  Leaves you in a mail buffer."
 170   ;; This strange form ensures that (recent-keys) is the value before
 171   ;; the bug subject string is read.
 172   (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
 173   (let (user-point)
 174     (setq topic (concat "[Bug: " emacs-program-version "] " topic))
 175     (if sxemacs-betaname
 176           (compose-mail report-sxemacs-bug-beta-address
 177                         topic
 178                         report-sxemacs-bug-beta-extra-headers)
 179       (compose-mail report-sxemacs-bug-address
 180                     topic
 181                     report-sxemacs-bug-extra-headers))
 182     ;; The rest of this does not execute
 183     ;; if the user was asked to confirm and said no.
 184     (goto-char (point-min))
 185     (re-search-forward "^--text follows this line--$")
 186     (forward-line 1)
 187     (insert "================================================================\n")
 188     (insert "Dear Bug Team!\n\n")
 189     (setq user-point (point))
 190     (insert "\n\n================================================================\n
 191 System Info to help track down your bug:
 192 ---------------------------------------\n\n")
 193     ;; Insert the output of 'describe-installation'.
 194     (insert (symbol-value 'Installation-string))
 195     ;; Load-path shadows can cause some grief.
 196     (flet ((append-message
 197              (&rest args) ())
 198            (clear-message
 199              (&optional label frame stdout-p no-restore)
 200              ()))
 201       (insert "\n\nLoad-Path Lisp Shadows:\n"
 202               "----------------------\n")
 203       (let ((before-shadows (point)))
 204         (insert
 205           (format "%s"
 206                   (find-emacs-lisp-shadows load-path)))
 207         (save-restriction
 208           (narrow-to-region before-shadows (point))
 209           (fill-paragraph t)
 210           (insert "\n"))))
 211     ;; Insert a list of installed packages.
 212     (insert "\n\nInstalled SXEmacs Packages:\n"
 213             "--------------------------\n")
 214     (report-sxemacs-bug-packages-list)
 215     (insert "\n")
 216     ;; Insert a list of installed modules.
 217     (if (fboundp 'list-modules)
 218         (progn
 219           (insert "\n\nInstalled Modules:\n"
 220                   "-----------------\n")
 221             (let* ((mods (list-modules)))
 222               (while mods
 223                 (cl-prettyprint (cdr (car mods)))
 224                 (setq mods (cdr mods))))))
 225     ;; Insert a list of loaded features
 226     (let ((before-features (point)))
 227       (insert
 228        (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features)))
 229       (save-restriction
 230         (narrow-to-region before-features (point))
 231         (fill-paragraph t)
 232         (insert "\n")))
 233     ;; Insert recent keystrokes.
 234     (insert "\n\n"
 235             "Recent keystrokes:\n-----------------\n\n")
 236     (let ((before-keys (point)))
 237       (insert (key-description recent-keys))
 238       (save-restriction
 239         (narrow-to-region before-keys (point))
 240         (goto-char before-keys)
 241         (while (progn (move-to-column 50) (not (eobp)))
 242           (search-forward " " nil t)
 243           (insert "\n"))))
 244     ;; Insert recent minibuffer messages.
 245     (insert "\n\n\nRecent messages (most recent first):\n"
 246             "-----------------------------------\n")
 247     (let ((standard-output (current-buffer)))
 248       (print-recent-messages 20)
 249       (insert "\n"))
 250     ;; Insert the contents of the user's init file if it exists.
 251     (if report-sxemacs-bug-send-init
 252       (if (file-readable-p user-init-file)
 253           (save-excursion
 254             (goto-char (point-max))
 255             (beginning-of-line)
 256             (insert "\n\nUser Init File:\n--------------\n\n")
 257             (insert-file-contents user-init-file))))
 258     ;; This is so the user has to type something
 259     ;; in order to send easily.
 260     (use-local-map (let ((map (make-sparse-keymap)))
 261                      (set-keymap-parents map (current-local-map))
 262                      map))
 263     (define-key (current-local-map) "\C-c\C-i" 'report-sxemacs-bug-info)
 264     ;; Make it less likely people will send empty messages.
 265     (cond
 266      ((eq mail-user-agent 'sendmail-user-agent)
 267       (make-local-variable 'mail-send-hook)
 268       (add-hook 'mail-send-hook 'report-sxemacs-bug-hook))
 269      ((eq mail-user-agent 'message-user-agent)
 270       (make-local-variable 'message-send-hook)
 271       (add-hook 'message-send-hook 'report-sxemacs-bug-hook))
 272      ((eq mail-user-agent 'mh-e-user-agent)
 273       (make-local-variable 'mh-before-send-letter-hook)
 274       (add-hook 'mh-before-send-letter-hook 'report-sxemacs-bug-hook))
 275      (t
 276       (make-local-variable 'mail-send-hook)
 277       (add-hook 'mail-send-hook 'report-sxemacs-bug-hook)))
 278     (save-excursion
 279       (goto-char (point-max))
 280       (skip-chars-backward " \t\n")
 281       (make-local-variable 'report-sxemacs-bug-orig-text)
 282       (setq report-sxemacs-bug-orig-text (buffer-substring (point-min) (point))))
 283     (goto-char user-point))
 284   (delete-other-windows)
 285   (unless report-sxemacs-bug-no-explanations
 286     (report-sxemacs-bug-help)
 287     (cond
 288      ((eq mail-user-agent 'sendmail-user-agent)
 289       (message (substitute-command-keys
 290                 "Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
 291      ((eq mail-user-agent 'message-user-agent)
 292       (message (substitute-command-keys
 293                 "Type \\[message-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
 294      ((eq mail-user-agent 'mh-e-user-agent)
 295       (message (substitute-command-keys
 296                 "Type \\[mh-send-letter] to send the bug report, \\[kill-buffer] to cancel.")))
 297      (t
 298       (message (substitute-command-keys
 299                 "Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel."))))))
 300
 301 (defun report-sxemacs-bug-info ()
 302   "Go to the Info node on reporting SXEmacs bugs."
 303   (interactive)
 304   (Info-goto-node "(xemacs)Bugs"))
 305
 306 (defun report-sxemacs-bug-hook ()
 307   "Hook run before sending a bug report."
 308   (save-excursion
 309     (goto-char (point-max))
 310     (skip-chars-backward " \t\n")
 311     (if (and (= (- (point) (point-min))
 312                 (length report-sxemacs-bug-orig-text))
 313              (equal (buffer-substring (point-min) (point))
 314                     report-sxemacs-bug-orig-text))
 315         (error "No text entered in bug report"))
 316
 317     ;; The last warning for novice users.
 318     (if (or report-sxemacs-bug-no-confirmation
 319             (yes-or-no-p
 320              "Send this bug report to the SXEmacs maintainers? "))
 321         ;; Just send the current mail.
 322         nil
 323       (goto-char (point-min))
 324       (let* ((top (point)))
 325         (re-search-forward "^--text follows this line--$")
 326         (save-restriction
 327           (narrow-to-region top (point))
 328           (goto-char (point-min))
 329           (if (re-search-forward "^To: " (eobp) t)
 330               (let ((pos (point)))
 331                 (end-of-line)
 332                 (delete-region pos (point))))
 333           (goto-char (point-min))
 334           (if (re-search-forward "^Cc: " (eobp) t)
 335               (let ((pos (point)))
 336                 (end-of-line)
 337                 (delete-region pos (point))))))
 338       (cond
 339        ((eq mail-user-agent 'sendmail-user-agent)
 340         (kill-local-variable 'mail-send-hook))
 341        ((eq mail-user-agent 'message-user-agent)
 342         (kill-local-variable 'message-send-hook))
 343        ((eq mail-user-agent 'mh-e-user-agent)
 344         (kill-local-variable 'mh-before-send-letter-hook))
 345        (t
 346         (kill-local-variable 'mail-send-hook)))
 347       (unless report-sxemacs-bug-no-explanations
 348         (declare-fboundp
 349          (with-electric-help
 350           #'(lambda ()
 351               (insert "\n
 352 You invoked the command M-x report-sxemacs-bug,
 353 but you decided not to mail the bug report to the SXEmacs maintainers.
 354
 355 If you want to mail it to someone else instead,
 356 please insert the proper e-mail address after \"To: \",
 357 and send the mail again.") nil) "*Bug Help*")))
 358       (error "Sending Bug Report Cancelled"))))
 359
 360 (defun report-sxemacs-backtraces ()
 361   "Save C and lisp backtrace buffers to files.
 362
 363 This is a convenience for reporting SXEmacs issues at
 364 http://issues.sxemacs.org/.  Returns t if any backtrace buffers are
 365 found and saved, nil otherwise."
 366   (let ((ctrace (or (get-buffer (concat "*gdb-sxemacs-"
 367                                         emacs-program-version
 368                                         "*"))
 369                     (get-buffer "*gdb-sxemacs*")))
 370         (ltrace (get-buffer "*Backtrace*")))
 371     (when ctrace
 372       (save-excursion
 373         (set-buffer ctrace)
 374         (write-region (point-min) (point-max)
 375                       (expand-file-name "c-backtrace"
 376                                         (temp-directory)))))
 377     (when ltrace
 378       (save-excursion
 379         (set-buffer ltrace)
 380         (write-region (point-min) (point-max)
 381                       (expand-file-name "lisp-backtrace"
 382                                         (temp-directory)))))
 383     (and (or ctrace ltrace) t)))
 384
 385 (defun report-sxemacs-save-installation ()
 386   "Save `Installation-string' to file.
 387
 388 This is a convenience for reporting SXEmacs issues at
 389 http://issues.sxemacs.org/.  Returns t on success, nil otherwise."
 390   (let ((file (expand-file-name "Installation" (temp-directory)))
 391         (str (and (boundp 'Installation-string)
 392                   (stringp Installation-string)
 393                   Installation-string)))
 394     (if str
 395         (progn
 396           (with-temp-buffer
 397             (insert str)
 398             (write-region (point-min) (point-max) file))
 399           t)
 400       nil)))
 401
 402 (defconst report-sxemacs-bugzilla-notrace
 403   "Thank you very much for taking the time to report a problem with SXEmacs
 404 ========================================================================
 405
 406 Unfortunately we haven't been able to find any backtraces that could
 407 help us track your problem down.  Please try very hard to produce a
 408 backtrace.  One way you can do this is...
 409
 410 If you are not familar with SXEmacs debugging and/or gdb, you can simply
 411 `M-: \(setq stack-trace-on-error t\)' or `stack-trace-on-signal'.  Then
 412 you just reproduce the bug/problem and a *Backtrace* buffer should pop
 413 up.  Once you have a backtrace, run `M-x report-sxemacs-bug' again and
 414 it will be automatically saved to a file so you can attach it to your
 415 bug at http://issues.sxemacs.org/.
 416
 417 OK, that was for a lisp backtrace, but don't forget a C trace as well.
 418 Sometimes they are just as useful, if not more so, as the lisp trace.
 419 If you have the XEmacs package \"debug\" installed, the commands `M-x
 420 gdb' and `M-x gdb-with-core' are very useful.  It runs gdb inside a
 421 SXEmacs buffer.  If `report-sxemacs-bug' finds a gdb buffer, it will
 422 be saved to a file for you to attach to your bug also.
 423
 424 For some useful tips on debugging SXEmacs with gdb, see Q2.1.2, and
 425 Q2.1.15 of the FAQ \(`C-h F'\).
 426
 427 "
 428   "Message to user trying to report bugs without traces.")
 429
 430 (defconst report-sxemacs-bugzilla-instructions
 431   "Thank you very much for reporting a problem with SXEmacs
 432 ========================================================
 433
 434 SXEmacs bug and issue tracking is handled by our BugZilla installation
 435 at http://issues.sxemacs.org/.  To complete your report, you will have
 436 to submit the bug/issue there.
 437
 438 Look in: `%s'
 439 for files named `Installation', `c-backtrace', and `lisp-backtrace' and
 440 attach those to your bug.  They will help us greatly in finding/fixing
 441 your bug.
 442
 443 When you fill in the description of your bug, please give as much
 444 information as possible.  Especially include specific steps required
 445 to reproduce the bug.  If none of the SXEmacs developers can reproduce
 446 your bug it will be very difficult to track down or fix.  Ideally, the
 447 instructions for reproducing the bug should start with:
 448
 449   \"Step 1 -- sxemacs -no-autoloads\" or \"sxemacs -vanilla\"
 450
 451 This will reduce the likelihood of local settings being the cause of your bug.
 452
 453 Once you have submitted your bug, you should hear from somebody within
 454 24 to 48 hours.  If you don't, please give us a reminder on the SXEmacs
 455 Devel <sxemacs-devel@sxemacs.org> mailing list.
 456
 457 "
 458   "Bug reporting instructions.")
 459
 460 (defun report-sxemacs-bugzilla-instructions ()
 461   "Display issue reporting instructions."
 462   (let ((blurb (format report-sxemacs-bugzilla-instructions (temp-directory))))
 463     (report-sxemacs-save-installation)
 464     (with-displaying-help-buffer
 465      (lambda ()
 466        (princ blurb))
 467      "Reporting Bugs")))
 468
 469 ;;;###autoload
 470 (defun report-sxemacs-bug ()
 471   "SXEmacs bug reporter."
 472   (interactive)
 473   (if (report-sxemacs-backtraces)
 474       (report-sxemacs-bugzilla-instructions)
 475     (window-configuration-to-register ?S)
 476     (with-output-to-temp-buffer "Reporting Bugs"
 477       (set-buffer standard-output)
 478       (insert report-sxemacs-bugzilla-notrace)
 479       (toggle-read-only 1)
 480       (pop-to-buffer (get-buffer "Reporting Bugs"))
 481       (view-minor-mode
 482        nil #'(lambda (&rest not-used-buffer)
 483                (kill-buffer (get-buffer "Reporting Bugs"))
 484                (jump-to-register ?S)
 485                (when (y-or-n-p "No traces found, continue with issue report anyway? ")
 486                  (report-sxemacs-bugzilla-instructions)))))))
 487
 488 ;;;###autoload
 489 (ignore-errors
 490   (load "xemacsbug" nil 'nomessage)
 491   (eval-after-load "xemacsbug"
 492     (defalias 'report-xemacs-bug 'report-sxemacs-bug)
 493     (defalias 'report-emacs-bug 'report-sxemacs-bug)))
 494
 495 (provide 'issue-tracker)
 496 ;;; issue-tracker.el ends here