cgit.sxemacs.org Git - packages/blob - xemacs-packages/net-utils/xemacsbug.el

   1 ;;; xemacsbug.el --- command to report XEmacs bugs to appropriate mailing list.
   2
   3 ;; Copyright (C) 2001 Free Software Foundation, Inc.
   4 ;; Copyright (C) 2001 Steve Youngs <youngs@xemacs.org>
   5
   6 ;; Author: Steve Youngs <youngs@xemacs.org>
   7 ;; Based on 'emacsbug.el' by: K. Shane Hartman
   8
   9 ;; Maintainer: XEmacs Development Team
  10 ;; Keywords: maint mail bugs
  11
  12 ;; Not fully installed because it can work only on Internet hosts.
  13 ;; This file is part of XEmacs.
  14
  15 ;; XEmacs 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 ;; XEmacs 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 XEmacs; 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 ;;; Synched up with: Not synched.
  31
  32 ;;; Commentary:
  33
  34 ;; `M-x report-xemacs-bug ' starts an email note to the XEmacs maintainers
  35 ;; describing a problem.  Here's how it's done...
  36
  37 ;;; Code:
  38
  39 (require 'sendmail)
  40 (require 'shadow)
  41
  42 (eval-when-compile
  43   (defvar mh-before-send-letter-hook)
  44   (defvar xemacs-betaname)
  45   (defvar sxemacs-betaname))
  46
  47 (defgroup xemacsbug nil
  48   "Sending XEmacs bug reports."
  49   :group 'maint
  50   :group 'mail)
  51
  52 ;; >> These should be addresses which are accessible to your machine,
  53 ;; >> otherwise you can't use this file.  It will only work on the
  54 ;; >> internet with this address.
  55
  56 (defcustom report-xemacs-bug-address "XEmacs Beta <xemacs-beta@xemacs.org>"
  57   "*Address of mailing list for XEmacs bugs."
  58   :group 'xemacsbug
  59   :type 'string)
  60
  61 (defcustom report-xemacs-bug-extra-headers nil
  62   "*An alist of mail-header value pairs for XEamcs bugs.
  63
  64 It takes the format (HEADER . VALUE) where both HEADER and VALUE are
  65 strings. See `compose-mail'."
  66   :group 'xemacsbug
  67   :type '(repeat
  68           (cons (string :tag "Header")
  69                 (string :tag "Value"))))
  70
  71 (defcustom report-xemacs-bug-beta-address "XEmacs Beta <xemacs-beta@xemacs.org>"
  72   "*Address of mailing list for XEmacs beta bugs."
  73   :group 'xemacsbug
  74   :type 'string)
  75
  76 (defcustom report-xemacs-bug-beta-extra-headers nil
  77   "*An alist of mail-header value pairs for XEmacs beta bugs.
  78
  79 It takes the format (HEADER . VALUE) where both HEADER and VALUE are
  80 strings. See `compose-mail'."
  81   :group 'xemacsbug
  82   :type '(repeat
  83           (cons (string :tag "Header")
  84                 (string :tag "Value"))))
  85
  86 (defvar report-xemacs-bug-orig-text nil
  87   "The automatically-created initial text of bug report.")
  88
  89 (defcustom report-xemacs-bug-no-confirmation nil
  90   "*If non-nil, suppress the confirmations asked for the sake of novice users."
  91   :group 'xemacsbug
  92   :type 'boolean)
  93
  94 (defcustom report-xemacs-bug-no-explanations nil
  95   "*If non-nil, suppress the explanations given for the sake of novice users."
  96   :group 'xemacsbug
  97   :type 'boolean)
  98
  99 (defcustom report-xemacs-bug-send-init nil
 100   "*If non-nil, include the user's init.el file in the bug report."
 101   :group 'xemacsbug
 102   :type 'boolean)
 103
 104 (defconst report-xemacs-bug-help
 105 "\nThis bug report will be sent to the XEmacs Development Team,
 106 not to your local site managers!!
 107
 108 The working language of XEmacs development is English.  Bug reports in
 109 English will be dealt with most promptly and most effectively.  However, the
 110 XEmacs maintainers as a group speak most of the major Western languages and
 111 Japanese, so if communicating in English is a problem for you, please feel
 112 free to report your bug using one of those other languages.
 113
 114 Please describe as succinctly as possible:
 115 \t- What happened.
 116 \t- What you thought should have happened.
 117 \t- Precisely what you were doing at the time.
 118
 119 Also include a reliable recipe for triggering the bug, as well as
 120 any C and lisp back-traces that you may have.
 121 \(setq stack-trace-on-error t\), or \(setq debug-on-error t\) if you
 122 are familiar with the debugger, to get a lisp back-trace.
 123 To get a core file for the C back-trace on a GNU/Linux system do
 124 'ulimit -c unlimited' in the shell prior to starting XEmacs.
 125
 126 Type \\[report-xemacs-bug-info] to visit in Info the XEmacs Manual section
 127 about when and how to write a bug report,
 128 and what information to supply so that the bug can be fixed.
 129 Type SPC to scroll through this section and its subsections.
 130
 131 You are very welcome to scan through the bug report and remove any
 132 potentially sensitive data.
 133
 134 Turn off this help buffer permanently by adding:
 135
 136 \t \(setq report-xemacs-bug-no-explanations t\)
 137
 138 To your ~/.xemacs/init.el")
 139
 140 (defun report-xemacs-bug-help ()
 141   "Display the help buffer for `report-xemacs-bug'."
 142   (with-electric-help
 143    (lambda ()
 144      (define-key (current-local-map) "\C-c\C-i" 'report-xemacs-bug-info)
 145      (princ (substitute-command-keys report-xemacs-bug-help)) nil)
 146    "*Bug Help*"))
 147
 148 (defun report-xemacs-bug-packages-list ()
 149   "Insert into the current buffer a list of installed packages."
 150   (let ((pkgs packages-package-list))
 151     (while pkgs
 152       (insert
 153        (format "(%s ver: %s upstream: %s)\n"
 154                (nth 0 (car pkgs))
 155                (nth 2 (car pkgs))
 156                (nth 4 (car pkgs))))
 157       (setq pkgs (cdr pkgs)))))
 158
 159 (defvar xemacs-default-composefunc-dont-nag nil)
 160
 161 ;;;###autoload
 162 (defun report-xemacs-bug (topic &optional recent-keys)
 163   "Report a bug in XEmacs.
 164 Prompts for bug subject.  Leaves you in a mail buffer."
 165   ;; This strange form ensures that (recent-keys) is the value before
 166   ;; the bug subject string is read.
 167   (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
 168   (let ((xemacs-default-composefunc-dont-nag t)
 169         user-point)
 170     (setq topic (concat "[Bug: " emacs-program-version "] " topic))
 171     (if xemacs-betaname
 172           (compose-mail report-xemacs-bug-beta-address
 173                         topic
 174                         report-xemacs-bug-beta-extra-headers)
 175       (compose-mail report-xemacs-bug-address
 176                     topic
 177                     report-xemacs-bug-extra-headers))
 178     ;; The rest of this does not execute
 179     ;; if the user was asked to confirm and said no.
 180     (goto-char (point-min))
 181     (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
 182     (forward-line 1)
 183     (insert "================================================================\n")
 184     (insert "Dear Bug Team!\n\n")
 185     (setq user-point (point))
 186     (insert "\n\n================================================================\n
 187 System Info to help track down your bug:
 188 ---------------------------------------\n\n")
 189     ;; Insert the output of 'describe-installation'.
 190     (insert (symbol-value 'Installation-string))
 191     ;; Load-path shadows can cause some grief.
 192     (flet ((append-message
 193              (&rest args) ())
 194            (clear-message
 195              (&optional label frame stdout-p no-restore)
 196              ()))
 197       (insert "\n\nLoad-Path Lisp Shadows:\n"
 198               "----------------------\n")
 199       (let ((before-shadows (point)))
 200         (insert
 201           (format "%s"
 202                   (find-emacs-lisp-shadows load-path)))
 203         (save-restriction
 204           (narrow-to-region before-shadows (point))
 205           (fill-paragraph t)
 206           (insert "\n"))))
 207
 208     (insert "\n\Internationalization Settings:\n"
 209             "-------------------------\n")
 210
 211     (when (featurep 'mule)
 212       (insert "\nEnvironment:\n\n")
 213       (mapcar
 214        (lambda (var)
 215          (insert (format "  Value of %-12s: %s\n"
 216                          var (getenv var))))
 217        '("LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES"
 218          "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG"))
 219
 220       (insert "\n")
 221
 222       (insert "Lisp locale settings:\n\n")
 223
 224       (dolist (sym '(current-language-environment
 225                      default-buffer-file-coding-system
 226                      default-process-coding-system
 227                      (current-locale)
 228                      keyboard-coding-system
 229                      terminal-coding-system))
 230         (insert (format "  %-34s=> %S\n" sym
 231                         (if (consp sym)
 232                             (if (fboundp (car sym))
 233                                 (eval sym)
 234                               [not available])
 235                           (if (boundp sym)
 236                               (symbol-value sym)
 237                             [not available])))))
 238
 239       (insert (format "  %-34s=>\n" "(coding-priority-list)"))
 240       (let ((before-coding-priority (point))
 241             (fill-prefix "    "))
 242         (insert (format "    %S" (coding-priority-list)))
 243         (save-restriction
 244           (narrow-to-region before-coding-priority (point))
 245           (fill-paragraph nil)
 246           (insert "\n")))
 247
 248       (insert "\n")
 249
 250       (insert "Coding system aliases:\n\n")
 251
 252       (dolist (alias '(native file-name
 253                        mswindows-multibyte-system-default))
 254         (insert (if (not (coding-system-alias-p alias))
 255                     (format "  '%-35s is not a coding system alias\n"
 256                             alias)
 257                   (format "  '%-35s is aliased to %S\n"
 258                           alias
 259                           (coding-system-aliasee alias))))))
 260
 261     ;; Insert a list of installed packages.
 262     (insert "\n\nInstalled XEmacs Packages:\n"
 263             "-------------------------\n")
 264     (report-xemacs-bug-packages-list)
 265     (insert "\n")
 266     ;; Insert a list of installed modules.
 267     (if (fboundp 'list-modules)
 268         (progn
 269           (insert "\n\nInstalled Modules:\n"
 270                   "-----------------\n")
 271             (let* ((mods (list-modules)))
 272               (while mods
 273                 (cl-prettyprint (cdr (car mods)))
 274                 (setq mods (cdr mods))))))
 275     ;; Insert a list of loaded features
 276     (let ((before-features (point)))
 277       (insert
 278        (format "\n\nFeatures:\n--------\n\n%s" (symbol-value 'features)))
 279       (save-restriction
 280         (narrow-to-region before-features (point))
 281         (fill-paragraph t)
 282         (insert "\n")))
 283     ;; Insert recent keystrokes.
 284     (insert "\n\n"
 285             "Recent keystrokes:\n-----------------\n\n")
 286     (let ((before-keys (point)))
 287       (insert (key-description recent-keys))
 288       (save-restriction
 289         (narrow-to-region before-keys (point))
 290         (goto-char before-keys)
 291         (while (progn (move-to-column 50) (not (eobp)))
 292           (search-forward " " nil t)
 293           (insert "\n"))))
 294     ;; Insert recent minibuffer messages.
 295     (insert "\n\n\nRecent messages (most recent first):\n"
 296             "-----------------------------------\n")
 297     (let ((standard-output (current-buffer)))
 298       (print-recent-messages 20)
 299       (insert "\n"))
 300     ;; Insert the contents of the user's init file if it exists.
 301     (if report-xemacs-bug-send-init
 302       (if (file-readable-p user-init-file)
 303           (save-excursion
 304             (goto-char (point-max))
 305             (beginning-of-line)
 306             (insert "\n\nUser Init File:\n--------------\n\n")
 307             (insert-file-contents user-init-file))))
 308     ;; This is so the user has to type something
 309     ;; in order to send easily.
 310     (use-local-map (let ((map (make-sparse-keymap)))
 311                      (set-keymap-parents map (current-local-map))
 312                      map))
 313     (define-key (current-local-map) "\C-c\C-i" 'report-xemacs-bug-info)
 314     ;; Make it less likely people will send empty messages.
 315     (cond
 316      ((eq mail-user-agent 'sendmail-user-agent)
 317       (make-local-variable 'mail-send-hook)
 318       (add-hook 'mail-send-hook 'report-xemacs-bug-hook))
 319      ((eq mail-user-agent 'message-user-agent)
 320       (make-local-variable 'message-send-hook)
 321       (add-hook 'message-send-hook 'report-xemacs-bug-hook))
 322      ((eq mail-user-agent 'mh-e-user-agent)
 323       (make-local-variable 'mh-before-send-letter-hook)
 324       (add-hook 'mh-before-send-letter-hook 'report-xemacs-bug-hook))
 325      (t
 326       (make-local-variable 'mail-send-hook)
 327       (add-hook 'mail-send-hook 'report-xemacs-bug-hook)))
 328     (save-excursion
 329       (goto-char (point-max))
 330       (skip-chars-backward " \t\n")
 331       (make-local-variable 'report-xemacs-bug-orig-text)
 332       (setq report-xemacs-bug-orig-text (buffer-substring (point-min) (point))))
 333     (goto-char user-point))
 334   (delete-other-windows)
 335   (unless report-xemacs-bug-no-explanations
 336     (report-xemacs-bug-help)
 337     (cond
 338      ((eq mail-user-agent 'sendmail-user-agent)
 339       (message (substitute-command-keys
 340                 "Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
 341      ((eq mail-user-agent 'message-user-agent)
 342       (message (substitute-command-keys
 343                 "Type \\[message-send-and-exit] to send the bug report, \\[kill-buffer] to cancel.")))
 344      ((eq mail-user-agent 'mh-e-user-agent)
 345       (message (substitute-command-keys
 346                 "Type \\[mh-send-letter] to send the bug report, \\[kill-buffer] to cancel.")))
 347      (t
 348       (message (substitute-command-keys
 349                 "Type \\[mail-send-and-exit] to send the bug report, \\[kill-buffer] to cancel."))))))
 350
 351
 352 ;; For backwards compatibility
 353 ;;;###autoload
 354 (defalias 'report-emacs-bug 'report-xemacs-bug)
 355
 356 (defun report-xemacs-bug-info ()
 357   "Go to the Info node on reporting XEmacs bugs."
 358   (interactive)
 359   (Info-goto-node "(xemacs)Bugs"))
 360
 361 (defun report-xemacs-bug-hook ()
 362   "Hook run before sending a bug report."
 363   (save-excursion
 364     (goto-char (point-max))
 365     (skip-chars-backward " \t\n")
 366     (if (and (= (- (point) (point-min))
 367                 (length report-xemacs-bug-orig-text))
 368              (equal (buffer-substring (point-min) (point))
 369                     report-xemacs-bug-orig-text))
 370         (error "No text entered in bug report"))
 371
 372     ;; The last warning for novice users.
 373     (if (or report-xemacs-bug-no-confirmation
 374             (yes-or-no-p
 375              "Send this bug report to the XEmacs maintainers? "))
 376         ;; Just send the current mail.
 377         nil
 378       (goto-char (point-min))
 379       (let* ((top (point)))
 380         (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
 381         (save-restriction
 382           (narrow-to-region top (point))
 383           (goto-char (point-min))
 384           (if (re-search-forward "^To: " (eobp) t)
 385               (let ((pos (point)))
 386                 (end-of-line)
 387                 (delete-region pos (point))))
 388           (goto-char (point-min))
 389           (if (re-search-forward "^Cc: " (eobp) t)
 390               (let ((pos (point)))
 391                 (end-of-line)
 392                 (delete-region pos (point))))))
 393       (cond
 394        ((eq mail-user-agent 'sendmail-user-agent)
 395         (kill-local-variable 'mail-send-hook))
 396        ((eq mail-user-agent 'message-user-agent)
 397         (kill-local-variable 'message-send-hook))
 398        ((eq mail-user-agent 'mh-e-user-agent)
 399         (kill-local-variable 'mh-before-send-letter-hook))
 400        (t
 401         (kill-local-variable 'mail-send-hook)))
 402       (unless report-xemacs-bug-no-explanations
 403         (with-electric-help
 404          (lambda ()
 405            (insert "\n
 406 You invoked the command M-x report-xemacs-bug,
 407 but you decided not to mail the bug report to the XEmacs maintainers.
 408
 409 If you want to mail it to someone else instead,
 410 please insert the proper e-mail address after \"To: \",
 411 and send the mail again.") nil) "*Bug Help*"))
 412       (error "Sending Bug Report Cancelled"))))
 413
 414 (provide 'xemacsbug)
 415
 416 ;;; xemacsbug.el ends here