Mercurial > hg > xemacs-beta

comparison lisp/efs/efs-report.el @ 22:8fc7fe29b841 r19-15b94

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-15b94
author cvs
date Mon, 13 Aug 2007 08:50:29 +0200
parents
children 7e54bd776075 8619ce7e4c50
comparison
equal deleted inserted replaced
21:b88636d63495 22:8fc7fe29b841
1 ;; -*-Emacs-Lisp-*-
2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;
4 ;; File: efs-report.el
5 ;; Release: $efs release: 1.15 $
6 ;; Version: $Revision: 1.1 $
7 ;; RCS:
8 ;; Description: Function to report efs bugs in a usable way.
9 ;; Author: Andy Norman, Dawn
10 ;; Created: Tue May 18 08:34:45 1993
11 ;; Modified: Sun Nov 27 18:41:45 1994 by sandy on gandalf
12 ;; Language: Emacs-Lisp
13 ;;
14 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
15
16 (provide 'efs-report)
17 (require 'efs)
18 (autoload 'reporter-submit-bug-report "reporter")
19 (defvar reporter-version) ; For the byte-compiler
20
21 ;;; Variables
22
23 (defconst efs-report-version
24 (concat (substring "$efs release: 1.15 $" 14 -2)
25 "/"
26 (substring "$Revision: 1.1 $" 11 -2)))
27
28 (defconst efs-report-salutations
29 ["Dear bug team:"
30 "Ciao bug team:"
31 "Salut bug team:"
32 "Gruss bug team:"
33 "To whom it may concern:"
34 "Fellow efs'ers:"
35 "Greetings earthlings:"])
36
37 (defvar efs-bug-address "efs-bugs@cuckoo.hpl.hp.com")
38
39 (defconst efs-report-other-vars
40 ;; List of variables needed for efs-report, that aren't generated below.
41 '(efs-ftp-program-name
42 efs-ftp-program-args
43 efs-local-host-regexp
44 efs-ftp-local-host-regexp
45 efs-gateway-host
46 efs-gateway-type
47 reporter-version
48 features))
49
50 (defconst efs-report-avoid-vars
51 ;; List of variables we don't want to see.
52 '(efs-netrc-filename
53 efs-default-password
54 efs-default-account
55 efs-default-user))
56
57 ;; Dynamically bound. Used to pass data to hooks.
58 (defvar efs-report-default-host nil)
59 (defvar efs-report-default-user nil)
60 (defvar efs-report-blurb nil)
61
62 ;;; Functions
63
64 (defun efs-report-get-host-type-regexps ()
65 "Return a list of host type regexp's which are non-nil."
66 (let ((list efs-host-type-alist)
67 ent result)
68 (while (setq ent (car list))
69 (if (symbol-value (cdr ent))
70 (setq result (cons (cdr ent) result)))
71 (setq list (cdr list)))
72 result))
73
74 (defun efs-report-get-versions ()
75 ;; Return a list of efs versions variables.
76 (mapcar
77 'intern
78 (sort
79 (let (completion-ignore-case)
80 (all-completions
81 "efs-" obarray
82 (function
83 (lambda (sym)
84 (and (boundp sym)
85 (let ((name (symbol-name sym)))
86 (and (>= (length name) 8)
87 (string-equal (substring name -8) "-version"))))))))
88 'string-lessp)))
89
90 (defun efs-report-get-user-vars ()
91 ;; Return a list of efs user variables.
92 (mapcar
93 'intern
94 (sort
95 (let (completion-ignore-case)
96 (all-completions "efs-" obarray 'user-variable-p))
97 'string-lessp)))
98
99 (defun efs-report-pre-hook ()
100 ;; efs-report-default-host, efs-report-default-user, and
101 ;; efs-report-blurb are dynamically bound.
102 (save-excursion
103 (let ((end (progn (mail-position-on-field "subject") (point))))
104 (beginning-of-line)
105 (search-forward ":" end)
106 (delete-region (point) end)
107 (insert
108 " EFS "
109 (or (and (boundp 'efs-version) (string-match "/" efs-version)
110 (concat (substring efs-version 0 (match-beginning 0))
111 " "))
112 "")
113 "bug: ")))
114 (let ((host (read-string "Bug occurred for remote host: "
115 efs-report-default-host))
116 (user (read-string "Logged in as: "
117 efs-report-default-user))
118 buff-name)
119 (if (string-match "^ *$" host) (setq host nil))
120 (if (string-match "^ *$" user) (setq user nil))
121 (if host
122 (insert "\nefs believes that the host type of " host " is "
123 (symbol-name (efs-host-type host))
124 ".\n"))
125 (if efs-report-blurb
126 (insert "\n" efs-report-blurb "\n"))
127 (if (and host
128 user
129 (get-buffer (setq buff-name (efs-ftp-process-buffer host user)))
130 (save-window-excursion
131 (y-or-n-p
132 (progn
133 (with-output-to-temp-buffer "*Help*"
134 (princ
135 (format
136 "The contents of %s
137 will likely very useful for identifying any bugs.
138
139 You will be given a chance to edit out any sensitive information.
140 Passwords are never written into this buffer." buff-name)))
141 (format "Insert contents of %s? "
142 buff-name)))))
143 (let ((header-1 (concat "Contents of " buff-name ":"))
144 (header-2 "Please edit sensitive or irrelevant information."))
145 (insert "\n" header-1 "\n" header-2 "\n")
146 (insert-char ?= (max (length header-1) (length header-2)))
147 (insert "\n\n")
148 (insert-buffer-substring buff-name)
149 (insert "\n")))))
150
151 (defun efs-report-post-hook ()
152 ;; Post hook run by report-submit-bug-report.
153 (save-excursion
154 (mail-position-on-field "subject")
155 (let ((subj (read-string "Subject header: ")))
156 (if (string-equal subj "")
157 (subst-char-in-region
158 (point)
159 (progn
160 (insert
161 (if (or (fboundp 'yow) (load "yow" t t)) (yow) ""))
162 (point))
163 ?\n ?\ )
164 (insert subj)))))
165
166 (defun efs-report-bug (&optional default-host default-user blurb no-confirm)
167 "Submit a bug report for efs."
168 (interactive)
169 (let (;; reporter-confirm-p and reporter-package-abbrev appeared once
170 ;; as fluid vars in reporter.el. They aren't used any longer,
171 ;; but we let-bind them anyway in case the user has an old version
172 ;; of reporter.
173 (reporter-confirm-p nil)
174 (reporter-prompt-for-summary-p nil)
175 (reporter-package-abbrev "efs"))
176 ;; Look out for old reporter versions.
177 (or (boundp 'reporter-version)
178 (setq reporter-version
179 "Your version of reporter is obsolete. Please upgrade."))
180 (if (or no-confirm
181 (y-or-n-p "Do you want to submit a bug report on efs? "))
182 (let ((efs-report-default-host default-host)
183 (efs-report-default-user default-user)
184 (efs-report-blurb blurb)
185 (vars (nconc (efs-report-get-versions)
186 (efs-report-get-user-vars)
187 efs-report-other-vars
188 (efs-report-get-host-type-regexps)))
189 (avoids efs-report-avoid-vars)
190 path)
191 (cond
192 ((or efs-report-default-host efs-report-default-user))
193 (efs-process-host
194 (setq efs-report-default-host efs-process-host
195 efs-report-default-user efs-process-user))
196 ((setq path (or buffer-file-name
197 (and (eq major-mode 'dired-mode)
198 dired-directory)))
199 (let ((parsed (efs-ftp-path path)))
200 (setq efs-report-default-host (car parsed)
201 efs-report-default-user (nth 1 parsed)))))
202 (while avoids
203 (setq vars (delq (car avoids) vars))
204 (setq avoids (cdr avoids)))
205 (reporter-submit-bug-report
206 efs-bug-address
207 "efs"
208 vars
209 (function efs-report-pre-hook)
210 (function efs-report-post-hook)
211 (aref efs-report-salutations
212 (% (+ (% (random) 1000) 1000)
213 (length efs-report-salutations))))))))
214
215 ;;; end of efs-report.el