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