code.delx.au - gnu-emacs/blob - lisp/mail/emacsbug.el

   1 ;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list.
   2
   3 ;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
   4
   5 ;; Author: K. Shane Hartman
   6 ;; Maintainer: FSF
   7 ;; Keywords: maint
   8
   9 ;; Not fully installed because it can work only on Internet hosts.
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it 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 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers
  30 ;; describing a problem.  Here's how it's done...
  31
  32 ;;; Code:
  33
  34 ;; >> This should be an address which is accessible to your machine,
  35 ;; >> otherwise you can't use this file.  It will only work on the
  36 ;; >> internet with this address.
  37
  38 (require 'sendmail)
  39
  40 (defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu"
  41   "Address of mailing list for GNU Emacs bugs.")
  42
  43 (defvar report-emacs-bug-pretest-address "emacs-pretest-bug@gnu.ai.mit.edu"
  44   "Address of mailing list for GNU Emacs pretest bugs.")
  45
  46 (defvar report-emacs-bug-orig-text nil
  47   "The automatically-created initial text of bug report.")
  48
  49 ;;;###autoload
  50 (defun report-emacs-bug (topic &optional recent-keys)
  51   "Report a bug in GNU Emacs.
  52 Prompts for bug subject.  Leaves you in a mail buffer."
  53   ;; This strange form ensures that (recent-keys) is the value before
  54   ;; the bug subject string is read.
  55   (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
  56   (condition-case nil
  57       (let (user-point)
  58         (compose-mail (if (string-match "\\..*\\..*\\." emacs-version)
  59                           ;; If there are four numbers in emacs-version,
  60                           ;; this is a pretest version.
  61                           report-emacs-bug-pretest-address
  62                         bug-gnu-emacs)
  63                       topic)
  64         ;; The rest of this does not execute
  65         ;; if the user was asked to confirm and said no.
  66         (goto-char (point-min))
  67         (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
  68         (insert "In " (emacs-version) "\n")
  69         (if (and system-configuration-options
  70                  (not (equal system-configuration-options "")))
  71             (insert "configured using `configure "
  72                     system-configuration-options "'\n"))
  73         (insert "\n")
  74         (insert "Please describe exactly what actions triggered the bug\n"
  75                 "and the precise symptoms of the bug:\n\n")
  76         (setq user-point (point))
  77         (insert "\n\n\n"
  78                 "Recent input:\n")
  79         (let ((before-keys (point)))
  80           (insert (mapconcat (lambda (key)
  81                                (if (or (integerp key)
  82                                        (symbolp key)
  83                                        (listp key))
  84                                    (single-key-description key)
  85                                  (prin1-to-string key nil)))
  86                              (or recent-keys (recent-keys))
  87                              " "))
  88           (save-restriction
  89             (narrow-to-region before-keys (point))
  90             (goto-char before-keys)
  91             (while (progn (move-to-column 50) (not (eobp)))
  92               (search-forward " " nil t)
  93               (insert "\n"))))
  94         (let ((message-buf (get-buffer "*Messages*")))
  95           (if message-buf
  96               (progn
  97                 (insert "\n\nRecent messages:\n")
  98                 (insert-buffer-substring message-buf
  99                                          (save-excursion
 100                                            (set-buffer message-buf)
 101                                            (goto-char (point-max))
 102                                            (forward-line -10)
 103                                            (point))
 104                                          (save-excursion
 105                                            (set-buffer message-buf)
 106                                            (point-max))))))
 107         ;; This is so the user has to type something
 108         ;; in order to send easily.
 109         (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
 110         (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
 111         (with-output-to-temp-buffer "*Bug Help*"
 112           (princ (substitute-command-keys
 113                   "Type \\[mail-send-and-exit] to send the bug report.\n"))
 114           (princ (substitute-command-keys
 115                   "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
 116           (terpri)
 117           (princ (substitute-command-keys
 118                   "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
 119 about when and how to write a bug report,
 120 and what information to supply so that the bug can be fixed.
 121 Type SPC to scroll through this section and its subsections.")))
 122         ;; Make it less likely people will send empty messages.
 123         (make-local-variable 'mail-send-hook)
 124         (add-hook 'mail-send-hook 'report-emacs-bug-hook)
 125         (save-excursion
 126           (goto-char (point-max))
 127           (skip-chars-backward " \t\n")
 128           (make-local-variable 'report-emacs-bug-orig-text)
 129           (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))
 130         (goto-char user-point))
 131     (error nil)))
 132
 133 (defun report-emacs-bug-info ()
 134   "Go to the Info node on reporting Emacs bugs."
 135   (interactive)
 136   (info)
 137   (Info-directory)
 138   (Info-menu "emacs")
 139   (Info-goto-node "Bugs"))
 140
 141 (defun report-emacs-bug-hook ()
 142   (save-excursion
 143     (goto-char (point-max))
 144     (skip-chars-backward " \t\n")
 145     (if (and (= (- (point) (point-min))
 146                 (length report-emacs-bug-orig-text))
 147              (equal (buffer-substring (point-min) (point))
 148                     report-emacs-bug-orig-text))
 149         (error "No text entered in bug report"))))
 150
 151 (provide 'emacsbug)
 152
 153 ;;; emacsbug.el ends here