Mercurial > hg > xemacs-beta

comparison lisp/ilisp/ilisp-bug.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children b82b59fe008d
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; -*- Mode: Emacs-Lisp -*-
2
3 ;;; ilisp-bug.el --
4
5 ;;; This file is part of ILISP.
6 ;;; Version: 5.7
7 ;;;
8 ;;; Copyright (C) 1990, 1991, 1992, 1993 Chris McConnell
9 ;;; 1993, 1994 Ivan Vasquez
10 ;;; 1994, 1995 Marco Antoniotti and Rick Busdiecker
11 ;;;
12 ;;; Other authors' names for which this Copyright notice also holds
13 ;;; may appear later in this file.
14 ;;;
15 ;;; Send mail to 'ilisp-request@lehman.com' to be included in the
16 ;;; ILISP mailing list. 'ilisp@lehman.com' is the general ILISP
17 ;;; mailing list were bugs and improvements are discussed.
18 ;;;
19 ;;; ILISP is freely redistributable under the terms found in the file
20 ;;; COPYING.
21
22
23 ;;;
24 ;;; ILISP bug stuff.
25 ;;;
26
27 ;;;
28 ;;;%Bugs
29 (defun ilisp-bug ()
30 "Generate an ilisp bug report."
31 (interactive)
32 (let ((buffer
33 (if (y-or-n-p
34 (format "Is %s the buffer where the error occurred? "
35 (buffer-name (current-buffer))))
36 (current-buffer))))
37 (if (or (not buffer) (not (mail)))
38 (progn
39 (message
40 (if buffer
41 "Can't send bug report until mail buffer is empty."
42 "Switch to the buffer where the error occurred."))
43 (beep))
44 (insert ilisp-bugs-to)
45 (search-forward (concat "\n" mail-header-separator "\n"))
46 (insert "\nYour problem: \n\n")
47 (insert "Type C-c C-c to send\n")
48 (insert "======= Emacs state below: for office use only =======\n")
49 (forward-line 1)
50 (insert (emacs-version))
51 (insert
52 (format "\nWindow System: %s %s" window-system window-system-version))
53 (let ((mode (save-excursion (set-buffer buffer) major-mode))
54 (match "popper-\\|completer-")
55 (val-buffer buffer)
56 string)
57 (if (or (memq mode lisp-source-modes) (memq mode ilisp-modes))
58 (progn
59 (setq match (concat "ilisp-\\|comint-\\|lisp-" match)
60 val-buffer (save-excursion (set-buffer buffer)
61 (or (ilisp-buffer) buffer)))
62 (mapcar (function (lambda (dialect)
63 (setq match (concat (format "%s-\\|" (car dialect))
64 match))))
65 ilisp-dialects)
66 (save-excursion
67 (set-buffer buffer)
68 (let ((point (point))
69 (start (lisp-defun-begin))
70 (end (lisp-end-defun-text t)))
71 (setq string
72 (format "
73 Mode: %s
74 Start: %s
75 End: %s
76 Point: %s
77 Point-max: %s
78 Code: %s"
79 major-mode start end point (point-max)
80 (buffer-substring start end)))))
81 (insert string)))
82 (mapatoms
83 (function (lambda (symbol)
84 (if (and (boundp symbol)
85 (string-match match (format "%s" symbol))
86 (not (eq symbol 'ilisp-documentation)))
87 (let ((val (save-excursion
88 (set-buffer val-buffer)
89 (symbol-value symbol))))
90 (if val
91 (insert (format "\n%s: %s" symbol val))))))))
92 (insert (format "\nLossage: %s" (key-description (recent-keys))))
93 (if (and (or (memq mode lisp-source-modes)
94 (memq mode ilisp-modes))
95 (ilisp-buffer)
96 (memq 'clisp (ilisp-value 'ilisp-dialect t))
97 (not (cdr (ilisp-value 'comint-send-queue))))
98 (progn
99 (insert (format "\nLISP: %s"
100 (comint-remove-whitespace
101 (car (comint-send
102 (save-excursion
103 (set-buffer buffer)
104 (ilisp-process))
105 "(lisp-implementation-version)"
106 t t 'version)))))
107 (insert (format "\n*FEATURES*: %s"
108 (comint-remove-whitespace
109 (car (comint-send
110 (save-excursion
111 (set-buffer buffer)
112 (ilisp-process))
113 "(let ((*print-length* nil)
114 (*print-level* nil))
115 (print *features*)
116 nil)"
117 t t 'version)))))))
118 (insert ?\n)
119 (goto-char (point-min))
120 (re-search-forward "^Subject")
121 (end-of-line)
122 (message "Send with sendmail or your favorite mail program.")))))
123