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)
  51   "Report a bug in GNU Emacs.
  52 Prompts for bug subject.  Leaves you in a mail buffer."
  53   (interactive "sBug Subject: ")
  54   (if (mail nil
  55             (if (string-match "\\..*\\..*\\." emacs-version)
  56                 ;; If there are four numbers in emacs-version,
  57                 ;; this is a pretest version.
  58                 report-emacs-bug-pretest-address
  59               bug-gnu-emacs)
  60             topic)
  61       (let (user-point)
  62         ;; The rest of this does not execute
  63         ;; if the user was asked to confirm and said no.
  64         (goto-char (point-min))
  65         (re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
  66         (insert "In " (emacs-version) "\n")
  67         (if (and system-configuration-options
  68                  (not (equal system-configuration-options "")))
  69             (insert "configured using `configure "
  70                     system-configuration-options "'\n"))
  71         (insert "\n")
  72         (insert "Please describe exactly what actions triggered the bug\n"
  73                 "and the precise symptoms of the bug:\n\n")
  74         (setq user-point (point))
  75         (insert "\n\n\n"
  76                 "Recent input:\n")
  77         (let ((before-keys (point)))
  78           (insert (mapconcat (lambda (key)
  79                                (if (or (integerp key)
  80                                        (symbolp key)
  81                                        (listp key))
  82                                    (single-key-description key)
  83                                  (prin1-to-string key nil)))
  84                              (recent-keys)
  85                              " "))
  86           (save-restriction
  87             (narrow-to-region before-keys (point))
  88             (goto-char before-keys)
  89             (while (progn (move-to-column 50) (not (eobp)))
  90               (search-forward " " nil t)
  91               (insert "\n"))))
  92         (let ((message-buf (get-buffer "*Messages*")))
  93           (if message-buf
  94               (progn
  95                 (insert "\n\nRecent messages:\n")
  96                 (insert-buffer-substring message-buf
  97                                          (save-excursion
  98                                            (set-buffer message-buf)
  99                                            (goto-char (point-max))
 100                                            (forward-line -10)
 101                                            (point))
 102                                          (save-excursion
 103                                            (set-buffer message-buf)
 104                                            (point-max))))))
 105         ;; This is so the user has to type something
 106         ;; in order to send easily.
 107         (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
 108         (define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
 109         (with-output-to-temp-buffer "*Bug Help*"
 110           (princ (substitute-command-keys
 111                   "Type \\[mail-send-and-exit] to send the bug report.\n"))
 112           (princ (substitute-command-keys
 113                   "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
 114           (terpri)
 115           (princ (substitute-command-keys
 116                   "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
 117 about when and how to write a bug report,
 118 and what information to supply so that the bug can be fixed.
 119 Type SPC to scroll through this section and its subsections.")))
 120         ;; Make it less likely people will send empty messages.
 121         (make-local-variable 'mail-send-hook)
 122         (add-hook 'mail-send-hook 'report-emacs-bug-hook)
 123         (save-excursion
 124           (goto-char (point-max))
 125           (skip-chars-backward " \t\n")
 126           (make-local-variable 'report-emacs-bug-orig-text)
 127           (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))
 128         (goto-char user-point))))
 129
 130 (defun report-emacs-bug-info ()
 131   "Go to the Info node on reporting Emacs bugs."
 132   (interactive)
 133   (info)
 134   (Info-directory)
 135   (Info-menu "emacs")
 136   (Info-goto-node "Bugs"))
 137
 138 (defun report-emacs-bug-hook ()
 139   (save-excursion
 140     (goto-char (point-max))
 141     (skip-chars-backward " \t\n")
 142     (if (and (= (- (point) (point-min))
 143                 (length report-emacs-bug-orig-text))
 144              (equal (buffer-substring (point-min) (point))
 145                     report-emacs-bug-orig-text))
 146         (error "No text entered in bug report"))))
 147
 148 (provide 'emacsbug)
 149
 150 ;;; emacsbug.el ends here