cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ilisp-bug.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ilisp-bug.el --
   4 ;;; ILISP bug stuff.
   5 ;;;
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ilisp-bug.el,v 1.3 2001-07-02 09:40:45 youngs Exp $
  13
  14
  15 (defun ilisp-bug ()
  16   "Generate an ilisp bug report."
  17   (interactive)
  18   (let ((buffer
  19          (if (y-or-n-p
  20               (format "Is %s the buffer where the error occurred? "
  21                       (buffer-name (current-buffer))))
  22              (current-buffer))))
  23     (if (or (not buffer)
  24             ;; (not (mail))
  25             (not (ignore-errors
  26                    (progn (compose-mail) t)))
  27                                         ; 19990615 Marco Antoniotti
  28                                         ; Somebody complained that
  29                                         ; MAIL does not use the mail
  30                                         ; agent chosen by the
  31                                         ; user. Here is an attempt to
  32                                         ; fix this.
  33                                         ;
  34                                         ; 19990912 Hannu Koivisto
  35                                         ; the IGNORE-ERRORS may
  36                                         ; alleviate some quirks in the
  37                                         ; COMPOSE-MAIL call.
  38                                         ; cf. <ilisp@cons.org> post of
  39                                         ; 19990908 for details.
  40             )
  41         (progn
  42           (message
  43            (if buffer
  44                "Can't send bug report until mail buffer is empty."
  45                "Switch to the buffer where the error occurred."))
  46           (beep))
  47       (insert ilisp-bugs-to)
  48       (search-forward (concat "\n" mail-header-separator "\n"))
  49       (insert "\nYour problem: \n\n")
  50       (insert "Type C-c C-c to send\n")
  51       (insert "======= Emacs state below: for office use only =======\n")
  52       (forward-line 1)
  53       (insert (emacs-version))
  54       (insert
  55        (if (string-match "XEmacs" emacs-version)
  56            (format "\nWindow System: %s" (console-type) ) ;; XEmacs has no window-system-version
  57          (format "\nWindow System: %s %s" window-system window-system-version) ) )
  58       (let ((mode (save-excursion (set-buffer buffer) major-mode))
  59             (match "popper-\\|completer-")
  60             (val-buffer buffer)
  61             string)
  62         (if (or (memq mode lisp-source-modes) (memq mode ilisp-modes))
  63             (progn
  64               (setq match (concat "ilisp-\\|comint-\\|lisp-" match)
  65                     val-buffer (save-excursion (set-buffer buffer)
  66                                                (or (ilisp-buffer) buffer)))
  67               (mapcar (function (lambda (dialect)
  68                                   (setq match (concat (format "%s-\\|" (car dialect))
  69                                                       match))))
  70                       ilisp-dialects)
  71               (save-excursion
  72                 (set-buffer buffer)
  73                 (let ((point (point))
  74                       (start (lisp-defun-begin))
  75                       (end (lisp-end-defun-text t)))
  76                   (setq string
  77                         (format "
  78 Mode: %s
  79 Start: %s
  80 End: %s
  81 Point: %s
  82 Point-max: %s
  83 Code: %s"
  84                                 major-mode start end point (point-max)
  85                                 (buffer-substring start end)))))
  86               (insert string)))
  87         (mapatoms
  88          (function (lambda (symbol)
  89                      (if (and (boundp symbol)
  90                               (string-match match (format "%s" symbol))
  91                               (not (eq symbol 'ilisp-documentation)))
  92                          (let ((val (save-excursion
  93                                       (set-buffer val-buffer)
  94                                       (symbol-value symbol))))
  95                            (if val
  96                                (insert (format "\n%s: %s" symbol val))))))))
  97         (insert (format "\nLossage: %s" (key-description (recent-keys))))
  98         (if (and (or (memq mode lisp-source-modes)
  99                      (memq mode ilisp-modes))
 100                  (ilisp-buffer)
 101                  (memq 'clisp (ilisp-value 'ilisp-dialect t))
 102                  (not (cdr (ilisp-value 'comint-send-queue))))
 103             (progn
 104               (insert (format "\nLISP: %s"
 105                               (comint-remove-whitespace
 106                                (car (comint-send
 107                                      (save-excursion
 108                                        (set-buffer buffer)
 109                                        (ilisp-process))
 110                                      "(lisp-implementation-version)"
 111                                      t t 'version)))))
 112               (insert (format "\n*FEATURES*: %s"
 113                               (comint-remove-whitespace
 114                                (car (comint-send
 115                                      (save-excursion
 116                                        (set-buffer buffer)
 117                                        (ilisp-process))
 118                                      "(let ((*print-length* nil)
 119                                        (*print-level* nil))
 120                                    (print *features*)
 121                                    nil)"
 122                                      t t 'version)))))))
 123         (insert ?\n)
 124         (goto-char (point-min))
 125         (re-search-forward "^Subject")
 126         (end-of-line)
 127         (message "Send with sendmail or your favorite mail program.")))))
 128
 129 ;;; end of file -- ilisp-bug.el --