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

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