|
110
|
1 ;; gnats administration code
|
|
|
2 ;; display the pr's in a buffer,
|
|
|
3 ;; dired-style commands to edit & view them.
|
|
|
4
|
|
|
5 ;; this version is known to work in XEmacs.
|
|
|
6
|
|
|
7 ;; author: Roger Hayes, roger.hayes@sun.com
|
|
|
8
|
|
|
9 ;; copyright: You are welcome to use this software as you see fit.
|
|
|
10 ;; Neither the author nor his employer make any representation about
|
|
|
11 ;; the suitability of this software for any purpose whatsoever.
|
|
|
12
|
|
|
13 (defconst gnats-admin-copyright
|
|
|
14 "Copyright (c) 1996 Roger Hayes.
|
|
|
15
|
|
|
16 Permission to use, copy, modify and distribute this software and
|
|
|
17 documentation for any purpose and without fee is hereby granted in
|
|
|
18 perpetuity, provided that this COPYRIGHT AND LICENSE NOTICE appears in
|
|
|
19 its entirety in all copies of the software and supporting
|
|
|
20 documentation.
|
|
|
21
|
|
|
22 The names of the author or Sun Microsystems, Inc. shall not be used in
|
|
|
23 advertising or publicity pertaining to distribution of the software
|
|
|
24 and documentation without specific, written prior permission.
|
|
|
25
|
|
|
26 ANY USE OF THE SOFTWARE AND DOCUMENTATION SHALL BE GOVERNED BY
|
|
|
27 CALIFORNIA LAW. THE AUTHOR AND SUN MICROSYSTEMS, INC. MAKE NO
|
|
|
28 REPRESENTATIONS OR WARRANTIES ABOUT THE SUITABILITY OF THE SOFTWARE OR
|
|
|
29 DOCUMENTATION FOR ANY PURPOSE. THEY ARE PROVIDED *AS IS* WITHOUT
|
|
|
30 EXPRESS OR IMPLIED WARRANTY OF ANY KIND. THE AUTHOR AND SUN
|
|
|
31 MICROSYSTEMS, INC. SEVERALLY AND INDIVIDUALLY DISCLAIM ALL WARRANTIES
|
|
|
32 WITH REGARD TO THIS SOFTWARE AND DOCUMENTATION, INCLUDING THE
|
|
|
33 WARRANTIES OF MERCHANTABILITY, DESIGN, FITNESS FOR A PARTICULAR
|
|
|
34 PURPOSE AND NON-INFRINGEMENT OF THIRD PARTY RIGHTS. IN NO EVENT SHALL
|
|
|
35 THE AUTHOR OR SUN MICROSYSTEMS, INC. BE LIABLE FOR ANY SPECIAL,
|
|
|
36 INDIRECT, INCIDENTAL OR CONSEQUENTIAL DAMAGES, OR ANY DAMAGES
|
|
|
37 WHATSOEVER RESULTING FROM LOSS OF USE, DATA, OR PROFITS, WHETHER IN
|
|
|
38 ACTION ARISING OUT OF CONTRACT, NEGLIGENCE, PRODUCT LIABILITY, OR
|
|
|
39 OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
|
|
|
40 PERFORMANCE OF THIS SOFTWARE OR DOCUMENTATION."
|
|
|
41
|
|
|
42 "Copyright and disclaimer notice")
|
|
|
43
|
|
|
44 ;; magic words are highlighted using font-lock
|
|
|
45
|
|
|
46 ;; data structures: a pr is represented as an alist
|
|
|
47 ;; the list of known pr's is represented as a vector
|
|
|
48 ;; pr references are often done by number
|
|
|
49 ;; (pr N) takes either a number, and returns the pr assoc list,
|
|
|
50 ;; or the pr assoc list, returning the same.
|
|
|
51 ;; regions are tagged with the number of the pr; the indirection lets
|
|
|
52 ;; updates to pr's happen without disturbing the region.
|
|
|
53
|
|
|
54 (defvar pr-list nil "Vector of parsed problem reports.")
|
|
|
55
|
|
|
56 (require 'cl)
|
|
|
57
|
|
|
58 ;;; (require 'match-string)
|
|
|
59 ;;; inline match-string
|
|
|
60 (if (not (fboundp 'match-string))
|
|
|
61 (defun match-string (n &optional target)
|
|
|
62 "Return the text of the NTH match in optional TARGET."
|
|
|
63 (let* ((m-data (match-data))
|
|
|
64 (idx (* 2 n))
|
|
|
65 (m-beg (elt m-data idx))
|
|
|
66 (m-end (elt m-data (1+ idx))))
|
|
|
67 (cond
|
|
|
68 ((markerp m-beg)
|
|
|
69 (buffer-substring m-beg m-end))
|
|
|
70 ((integerp m-beg)
|
|
|
71 (substring target m-beg m-end))
|
|
|
72 (t
|
|
|
73 (error "Bad argument N to match-string"))))))
|
|
|
74
|
|
|
75 ;;; (require 'edit-expr)
|
|
|
76 ;; edit-expr -- pop up a buffer to edit an expression
|
|
|
77 (if (not (fboundp 'edit-expr))
|
|
|
78 (defun edit-expr (e &optional explain)
|
|
|
79 "Pop up a buffer to edit the EXPRESSION; return the edited value.
|
|
|
80 Buffer gets optional EXPLANATION."
|
|
|
81 (with-output-to-temp-buffer "*expr-buffer*"
|
|
|
82 (let ((buffer standard-output)
|
|
|
83 (val nil)
|
|
|
84 emark)
|
|
|
85
|
|
|
86 (save-excursion
|
|
|
87 (pop-to-buffer (buffer-name buffer))
|
|
|
88 (emacs-lisp-mode)
|
|
|
89 (delete-region (point-min) (point-max))
|
|
|
90 (insert (or explain ";; Edit this value"))
|
|
|
91 (insert "\n")
|
|
|
92 (setq emark (point-marker))
|
|
|
93 (prin1 e)
|
|
|
94 (goto-char emark)
|
|
|
95 (message "recursive edit -- M-C-c when done")
|
|
|
96 (recursive-edit)
|
|
|
97 (goto-char emark)
|
|
|
98 (setq val (read buffer)))
|
|
|
99 val))))
|
|
|
100
|
|
|
101 ;; (require 'regret) ;; creates regression tests in my environment [rh]
|
|
|
102
|
|
|
103 (provide 'gnats-admin)
|
|
|
104
|
|
|
105 ;; add stuff for font-lock; harmless if you don't use font-lock.
|
|
|
106 ;; beware -- font-lock uses the first match; hence longer words must
|
|
|
107 ;; precede shorter words, if they both match.
|
|
|
108 (defconst gnats-admin::font-lock-keywords
|
|
|
109 '(;; severity
|
|
|
110 ("non-critical" . non-critical)
|
|
|
111 ("critical" . critical)
|
|
|
112 ("serious" . serious)
|
|
|
113
|
|
|
114 ;; priority
|
|
|
115 ("high" . high)
|
|
|
116 ("medium" . medium)
|
|
|
117 ("low" . low)
|
|
|
118
|
|
|
119 ;; state
|
|
|
120 ("open" . open)
|
|
|
121 ("analyzed" . analyzed)
|
|
|
122 ("suspended" . suspended)
|
|
|
123 ("feedback" . feedback)
|
|
|
124 ("closed\\*" . closed*)
|
|
|
125 ("closed\\?" . closed?)
|
|
|
126 ("closed" . closed)
|
|
|
127
|
|
|
128 ;; class
|
|
|
129 ("sw-bug" . sw-bug)
|
|
|
130 ("doc-bug" . doc-bug)
|
|
|
131 ("support" . support)
|
|
|
132 ("change-request" . change-request)
|
|
|
133 ("mistaken" . mistaken)
|
|
|
134 ("duplicate" . duplicate)))
|
|
|
135
|
|
|
136 (defvar gnats-admin::popup-menu
|
|
|
137 '("Gnats-Admin"
|
|
|
138 ["Edit" 'gnats-admin:pr-edit t]
|
|
|
139 ["View" 'gnats-admin:pr-view t]
|
|
|
140 )
|
|
|
141 "Local popup menu.")
|
|
|
142
|
|
|
143 (defvar gnats-admin-query-hook nil
|
|
|
144 "Hooklist for post-query processing in gnats-admin mode.")
|
|
|
145 (defvar gnats-admin:query-list nil
|
|
|
146 "Results of one query -- may be altered by query hook to change results of query.")
|
|
|
147 (defvar gnats-admin-refresh-hook nil
|
|
|
148 "Hooklist for post-refresh processing in gnats-admin mode.
|
|
|
149 Run after a refresh -- gnats-admin::dirty-list may contain list of re-read pr numbers")
|
|
|
150
|
|
|
151 (defvar gnats-admin::selector nil
|
|
|
152 "Function of one argument that governs if a PR should be diplayed.")
|
|
|
153
|
|
|
154 (add-hook 'gnats-admin-refresh-hook
|
|
|
155 (function (lambda ()
|
|
|
156 (font-lock-fontify-buffer))))
|
|
|
157
|
|
|
158 ;;;
|
|
|
159 ;; first, how do we get & parse the pr's?
|
|
|
160 (defun gnats-admin::run-query ()
|
|
|
161 "Run a default query, setting pr-list to the result."
|
|
|
162 (setq pr-list (apply 'vector (gnats-admin::query)))
|
|
|
163 (length pr-list))
|
|
|
164
|
|
|
165 (defun trim (s)
|
|
|
166 "trim the leading & trailing blanks from a string"
|
|
|
167 (if (string-match "^\\s-*\\(\\S-.*\\S-\\|\\S-\\)\\s-*$" s)
|
|
|
168 (substring s (match-beginning 1) (match-end 1))
|
|
|
169 "")
|
|
|
170 )
|
|
|
171
|
|
|
172 ;; parse one pr -- moves point.
|
|
|
173 (defun gnats-admin::parse-pr ()
|
|
|
174 "parse one pr, moving point"
|
|
|
175 (let ((pr nil))
|
|
|
176 (let ((flv (make-vector 13 nil))
|
|
|
177 (lim 0)
|
|
|
178 (bol 0)
|
|
|
179 (index 0))
|
|
|
180 (end-of-line)
|
|
|
181 (setq lim (point))
|
|
|
182 (beginning-of-line)
|
|
|
183 (setq bol (point))
|
|
|
184 (while (and (< (point) lim)
|
|
|
185 (re-search-forward "\\([^|]*\\)|" lim t))
|
|
|
186 (aset flv index (trim (match-string 1)))
|
|
|
187 (setq index (1+ index)))
|
|
|
188 (if (not (= index 13))
|
|
|
189 (error "Bad PR inquiry: %s" (buffer-substring bol lim)))
|
|
|
190 (setq pr (gnats-admin::vec->pr flv)))
|
|
|
191 (if (not (bolp))
|
|
|
192 (forward-line 1))
|
|
|
193 pr))
|
|
|
194
|
|
|
195 (defun gnats-admin::query (&rest args)
|
|
|
196 (let ((prl (list))
|
|
|
197 (buf (get-buffer-create "**gnats-query*")))
|
|
|
198 (save-excursion
|
|
|
199 (set-buffer buf)
|
|
|
200 (delete-region (point-min) (point-max))
|
|
|
201 (message "Running query")
|
|
|
202 (setq args
|
|
|
203 (mapcar (function (lambda (x) (format "%s" x))) args))
|
|
|
204 (apply 'call-process "query-pr" nil t nil "--sql" args)
|
|
|
205 (message "Query completed")
|
|
|
206 ;; now parse the output
|
|
|
207 (goto-char (point-min))
|
|
|
208 (while (not (eobp))
|
|
|
209 (setq prl (cons (gnats-admin::parse-pr) prl)))
|
|
|
210 )
|
|
|
211 (message "Result parsed")
|
|
|
212 ;; lots of stuff to apply the proper hook
|
|
|
213 (setq gnats-admin:query-list prl)
|
|
|
214 (run-hooks 'gnats-admin-query-hook)
|
|
|
215 (setq prl gnats-admin:query-list)
|
|
|
216 (setq gnats-admin:query-list nil)
|
|
|
217 (nreverse prl)))
|
|
|
218
|
|
|
219 ;;
|
|
|
220 ;;
|
|
|
221 (defun gnats-admin::vec->pr (v)
|
|
|
222 "massage a 13-element vector into the internal pr representation.
|
|
|
223 fields are as described in query-pr documentation."
|
|
|
224 (if (not (and (vectorp v)
|
|
|
225 (= (length v) 13)))
|
|
|
226 (error "Not a valid PR intermediate form"))
|
|
|
227
|
|
|
228 ;;; 0 - pr number
|
|
|
229 (aset v 0 (read (aref v 0)))
|
|
|
230 ;;; 1 - category
|
|
|
231 (aset v 1 (read (aref v 1)))
|
|
|
232 ;;; 2 - synopsis
|
|
|
233 ; leave as string
|
|
|
234 ;;; 3 - confidential
|
|
|
235 (aset v 3 (if (equal "no" (aref v 3)) nil (aref v 3)))
|
|
|
236 ;;; 4 - severity
|
|
|
237 (let ((num (read (aref v 4))))
|
|
|
238 (aset v 4 (aref
|
|
|
239 [null critical serious non-critical]
|
|
|
240 num)))
|
|
|
241 ;;; 5 - priority
|
|
|
242 (let ((num (read (aref v 5))))
|
|
|
243 (aset v 5 (aref
|
|
|
244 [null high medium low]
|
|
|
245 num)))
|
|
|
246 ;;; 6 - responsible
|
|
|
247 ; leave as string
|
|
|
248 ;;; 7 - state
|
|
|
249 (let ((num (read (aref v 7))))
|
|
|
250 (aset v 7 (aref
|
|
|
251 [null open analyzed suspended feedback closed]
|
|
|
252 num)))
|
|
|
253 ;;; 8 - class
|
|
|
254 (let ((num (read (aref v 8))))
|
|
|
255 (aset v 8 (aref
|
|
|
256 [null sw-bug doc-bug support change-request mistaken duplicate]
|
|
|
257 num)))
|
|
|
258 ;;; 9 - submitter-id
|
|
|
259 ; leave as string
|
|
|
260 ;;; 10 - arrival-date
|
|
|
261 ; leave as string
|
|
|
262 ;;; 11 - originator
|
|
|
263 ; leave as string
|
|
|
264 ;;; 12 - release
|
|
|
265 ; leave as string
|
|
|
266
|
|
|
267 ;; the fields of v have been transformed; now map them into an alist
|
|
|
268 (do
|
|
|
269 ((vx 0 (1+ vx)) ; v index
|
|
|
270 (an ; field names (in order!)
|
|
|
271 (gnats-admin::pr-field-names)
|
|
|
272 (cdr an))
|
|
|
273 (al nil) ; assoc list
|
|
|
274 )
|
|
|
275 ((null an) (nreverse al)) ; <- here's where the result comes from
|
|
|
276 (setq al (cons (cons (car an) (aref v vx)) al))
|
|
|
277 ))
|
|
|
278
|
|
|
279 (defun gnats-admin::pr-get (pr field)
|
|
|
280 "Get, from PR, value of slot named FIELD (a symbol)."
|
|
|
281 (let ((p (assq field (gnats-admin:pr pr))))
|
|
|
282 (if p
|
|
|
283 (cdr p)
|
|
|
284 nil)))
|
|
|
285
|
|
|
286 (defun nset-assq (alist key val)
|
|
|
287 "destructively set key'v association in the alist to val. returns the original
|
|
|
288 list, unless it was null"
|
|
|
289 (let ((p (assq key alist)))
|
|
|
290 (if p
|
|
|
291 (progn
|
|
|
292 (setcdr p val)
|
|
|
293 alist)
|
|
|
294 (nconc alist (list (cons key val))))))
|
|
|
295
|
|
|
296 (defun gnats-admin::pr-set! (pr field val)
|
|
|
297 "Set, in PR, slot named FIELD to VAL. Slot name is a symbol."
|
|
|
298 (nset-assq pr field val))
|
|
|
299
|
|
|
300 ;; fast version of field name->index mapper
|
|
|
301 ;; also tests if a symbol is a field name present in sql report.
|
|
|
302 (defun gnats-admin::pr-field-index (feild)
|
|
|
303 (case feild
|
|
|
304 (Number 0)
|
|
|
305 (Category 1)
|
|
|
306 (Synopsis 2)
|
|
|
307 (Confidential 3)
|
|
|
308 (Severity 4)
|
|
|
309 (Priority 5)
|
|
|
310 (Responsible 6)
|
|
|
311 (State 7)
|
|
|
312 (Class 8)
|
|
|
313 (Submitter-Id 9)
|
|
|
314 (Arrival-Date 10)
|
|
|
315 (Originator 11)
|
|
|
316 (Release 12)))
|
|
|
317
|
|
|
318 ;; next is for completing-read
|
|
|
319 ;; order must be the same as indices
|
|
|
320 ;; content is (name index type width)
|
|
|
321 ;; width is field width, not counting space
|
|
|
322 (defconst gnats-admin::pr-field-alist
|
|
|
323 '(("Number" 0 integer 3)
|
|
|
324 ("Category" 1 symbol 15)
|
|
|
325 ("Synopsis" 2 string 80)
|
|
|
326 ("Confidential" 3 boolean 1)
|
|
|
327 ("Severity" 4 symbol 12)
|
|
|
328 ("Priority" 5 symbol 6)
|
|
|
329 ("Responsible" 6 string 7)
|
|
|
330 ("State" 7 symbol 8)
|
|
|
331 ("Class" 8 symbol 14)
|
|
|
332 ("Submitter-Id" 9 string 7)
|
|
|
333 ("Arrival-Date" 10 string 14)
|
|
|
334 ("Originator" 11 string 32)
|
|
|
335 ("Release" 12 string 48))
|
|
|
336 "Alist that maps field-name->(name index type width)")
|
|
|
337
|
|
|
338 (defun gnats-admin::pr-field-names ()
|
|
|
339 "List of symbols that are field keys in pr. Must be in order."
|
|
|
340 (mapcar (function (lambda (pr) (intern (car pr))))
|
|
|
341 gnats-admin::pr-field-alist))
|
|
|
342
|
|
|
343 ;; format control template for PR display
|
|
|
344 (defconst gnats-admin::pr-long-format
|
|
|
345 '((4 Category Class) (35 Priority Severity) (60 Responsible) (70 State ) nl
|
|
|
346 4 "Synopsis:" Synopsis
|
|
|
347 ))
|
|
|
348 (defconst gnats-admin::pr-short-format
|
|
|
349 '((4 Category Class) (35 Priority Severity) (60 Responsible) (70 State )))
|
|
|
350
|
|
|
351 (defvar gnats-admin::pr-format gnats-admin::pr-short-format
|
|
|
352 "Format list for printing a pr.")
|
|
|
353
|
|
|
354 ;; hook that sets extent etc for Lucid emacs
|
|
|
355 (defun gnats-admin::pr-display-hook (b e pr buf)
|
|
|
356 "Set extent around pr."
|
|
|
357 (let ((ext (make-extent b e buf)))
|
|
|
358 (set-extent-layout ext 'outside-margin)
|
|
|
359 (set-extent-property ext 'pr pr)
|
|
|
360 (set-extent-property ext 'start-open t)
|
|
|
361 (set-extent-property ext 'end-open t)
|
|
|
362 (set-extent-property ext 'highlight t)))
|
|
|
363
|
|
|
364 ;; gnats uses one face for each element of the enumerated fields,
|
|
|
365 ;; to give maximum flexibility in display.
|
|
|
366
|
|
|
367 ;;; symbol->(face foreground background) alist
|
|
|
368 (defvar gnats-admin::face-color
|
|
|
369 '((critical "firebrick" nil)
|
|
|
370 (serious "goldenrod" nil)
|
|
|
371 (non-critical "blue3" nil)
|
|
|
372
|
|
|
373 (high "firebrick" nil)
|
|
|
374 (medium "goldenrod" nil)
|
|
|
375 (low "blue3" nil)
|
|
|
376
|
|
|
377 (open "firebrick" nil)
|
|
|
378 (analyzed "goldenrod" nil)
|
|
|
379 (suspended "turquoise" nil)
|
|
|
380 (feedback "blue3" nil)
|
|
|
381 (closed "ForestGreen" nil)
|
|
|
382 (closed* "HotPink" nil)
|
|
|
383 (closed? "blue3" nil)
|
|
|
384
|
|
|
385 (sw-bug nil nil)
|
|
|
386 (doc-bug nil nil)
|
|
|
387 (support nil nil)
|
|
|
388 (change-request nil nil)
|
|
|
389 (mistaken nil nil)
|
|
|
390 (duplicate nil nil))
|
|
|
391 "Alist of font properties")
|
|
|
392
|
|
|
393 (defun gnats-admin::field-display (pr fld buf)
|
|
|
394 "Display value field on specified stream."
|
|
|
395 (let
|
|
|
396 ((fv (gnats-admin::pr-get pr fld)))
|
|
|
397 (princ fv buf)))
|
|
|
398
|
|
|
399 (defun gnats-admin::pr-print-func (f pr buf)
|
|
|
400 "Printer for pr. Depends on free variable pr-did-indent."
|
|
|
401 (cond
|
|
|
402 ((eq 'nl f)
|
|
|
403 (princ "\n " buf)
|
|
|
404 (setq pr-did-indent t))
|
|
|
405 ((listp f)
|
|
|
406 (do
|
|
|
407 ((fmt f (cdr fmt)))
|
|
|
408 ((null fmt))
|
|
|
409 (gnats-admin::pr-print-func (car fmt) pr buf)))
|
|
|
410 ((numberp f)
|
|
|
411 (indent-to-column f 1)
|
|
|
412 (setq pr-did-indent t))
|
|
|
413 ((symbolp f)
|
|
|
414 (if (not pr-did-indent)
|
|
|
415 (princ " " buf))
|
|
|
416 (gnats-admin::field-display pr f buf)
|
|
|
417 (setq pr-did-indent nil))
|
|
|
418 ((stringp f)
|
|
|
419 (if (not pr-did-indent)
|
|
|
420 (princ " " buf))
|
|
|
421 (princ f buf)
|
|
|
422 (setq pr-did-indent nil))
|
|
|
423 )
|
|
|
424 t)
|
|
|
425
|
|
|
426 (defun gnats-admin::display-pr (pr &optional buf)
|
|
|
427 ;; always print the number first
|
|
|
428 (if (not buf)
|
|
|
429 (setq buf (current-buffer)))
|
|
|
430 (let
|
|
|
431 ((b (point))
|
|
|
432 (buffer-read-only nil)
|
|
|
433 (pr-did-indent nil))
|
|
|
434 (princ (gnats-admin::pr-number pr) buf)
|
|
|
435 ;; now print according to the pr-format list
|
|
|
436 (do
|
|
|
437 ((fmt gnats-admin::pr-format (cdr fmt)))
|
|
|
438 ((null fmt))
|
|
|
439 (gnats-admin::pr-print-func (car fmt) pr buf))
|
|
|
440 (gnats-admin::pr-display-hook
|
|
|
441 b
|
|
|
442 (point)
|
|
|
443 (gnats-admin::pr-number pr)
|
|
|
444 buf)
|
|
|
445 (newline)))
|
|
|
446
|
|
|
447 (defun gnats-admin::pr-buffer-extent (pr)
|
|
|
448 "Find the extent for this PR."
|
|
|
449 (extent-at (1+ (gnats-admin::pr-buffer-begin pr))
|
|
|
450 (gnats-admin::pr-buffer pr)
|
|
|
451 'pr))
|
|
|
452
|
|
|
453 (defun gnats-admin::pr-reread (pr)
|
|
|
454 "Rerun query for one PR in the pr-list."
|
|
|
455 (let
|
|
|
456 ((num (gnats-admin::pr-number pr)))
|
|
|
457 (let
|
|
|
458 ((repl (gnats-admin::query num)))
|
|
|
459 (if (and (listp repl)
|
|
|
460 (= (length repl) 1)
|
|
|
461 (= (gnats-admin::pr-get (car repl) 'Number) num))
|
|
|
462 (gnats-admin::pr-replace! num (car repl))
|
|
|
463 (error "Query failed for pr %s" num)))
|
|
|
464 ))
|
|
|
465
|
|
|
466 (defun gnats-admin::selection (loprs)
|
|
|
467 "Return the elements of LOPRS (list of PR's) which satify PREDicate."
|
|
|
468 (let ((pred gnats-admin::selector))
|
|
|
469 (if (not pred)
|
|
|
470 loprs
|
|
|
471 ;; else use the common-lisp loop appropriate to the type of loprs
|
|
|
472 (cond
|
|
|
473 ((arrayp loprs)
|
|
|
474 (loop
|
|
|
475 for pr across loprs
|
|
|
476 if (apply pred pr '())
|
|
|
477 collect pr
|
|
|
478 ))
|
|
|
479 ((listp loprs)
|
|
|
480 (loop
|
|
|
481 for pr in loprs
|
|
|
482 if (apply pred pr '())
|
|
|
483 collect pr
|
|
|
484 ))
|
|
|
485 (t
|
|
|
486 (error "Bad type for PR collection")))
|
|
|
487 )))
|
|
|
488
|
|
|
489 (defun gnats-admin::selected? (pr)
|
|
|
490 "Test to see if one pr meets the selection criterion."
|
|
|
491 (or (null gnats-admin::selector)
|
|
|
492 (apply gnats-admin::selector pr '())))
|
|
|
493
|
|
|
494 (defun gnats-admin::pr-replace! (oldpr newpr)
|
|
|
495 "Replace the old pr with the new one"
|
|
|
496 (if (not (consp newpr))
|
|
|
497 (error "Replacement pr must be a full PR value"))
|
|
|
498 (let ((pr-num (gnats-admin::pr-number newpr)))
|
|
|
499 (if (not (= (gnats-admin::pr-number oldpr)
|
|
|
500 pr-num))
|
|
|
501 (error "Cannot replace PR with one of different number"))
|
|
|
502 (if (< (length pr-list) pr-num)
|
|
|
503 (setq pr-list
|
|
|
504 (vconcat pr-list (make-vector (- pr-num (length pr-list)) nil))))
|
|
|
505 (aset pr-list (1- pr-num) newpr)))
|
|
|
506
|
|
|
507 (defvar gnats-admin::dirty-list nil
|
|
|
508 "List of PRs which may be out of date and need refreshing.")
|
|
|
509
|
|
|
510 (defun gnats-admin:reset ()
|
|
|
511 "Reset the cached data for gnats-admin."
|
|
|
512 (setq pr-list nil)
|
|
|
513 (setq gnats-admin::dirty-list nil) ; it's everything now
|
|
|
514 )
|
|
|
515
|
|
|
516 (defun gnats-admin:regret ()
|
|
|
517 "Create or edit the regression test for the current problem report."
|
|
|
518 (interactive)
|
|
|
519 (let* ((pr (gnats-admin::pr-at (point)))
|
|
|
520 (num (gnats-admin::pr-number pr)))
|
|
|
521 (pr-regret num)))
|
|
|
522
|
|
|
523 (defun gnats-admin:refresh (&optional force)
|
|
|
524 (interactive "P")
|
|
|
525 (if force
|
|
|
526 (gnats-admin:reset))
|
|
|
527 (if (not pr-list)
|
|
|
528 (progn
|
|
|
529 (gnats-admin::run-query))
|
|
|
530 (progn
|
|
|
531 (mapc (function (lambda (p) (gnats-admin::pr-reread p)))
|
|
|
532 gnats-admin::dirty-list)))
|
|
|
533 (setq gnats-admin::dirty-list nil)
|
|
|
534 (set-buffer (gnats-admin::buffer))
|
|
|
535 (let ((standard-output (current-buffer))
|
|
|
536 (buffer-read-only nil)
|
|
|
537 (this-pr-num (gnats-admin::pr-num-at (point))))
|
|
|
538 ; is this overkill; could we save our extents unless force?
|
|
|
539 (if nil
|
|
|
540 (map-extents (function (lambda (ext data) (delete-extent ext) nil))
|
|
|
541 (current-buffer)))
|
|
|
542 (delete-region (point-min) (point-max))
|
|
|
543 (beginning-of-buffer)
|
|
|
544 (message "Redisplay")
|
|
|
545 (mapc (function (lambda (pr)
|
|
|
546 (if (gnats-admin::selected? pr)
|
|
|
547 (gnats-admin::display-pr pr))))
|
|
|
548 pr-list)
|
|
|
549 (message nil)
|
|
|
550 ;; catch search errors in case the current pr no longer exists--
|
|
|
551 ;; if so, go to end of buffer
|
|
|
552 (condition-case err
|
|
|
553 (if (numberp this-pr-num)
|
|
|
554 (gnats-admin:goto-pr this-pr-num))
|
|
|
555 (search-failed
|
|
|
556 (goto-char (point-max)))))
|
|
|
557 (run-hooks 'gnats-admin-refresh-hook)
|
|
|
558 t)
|
|
|
559
|
|
|
560 (defun gnats-admin::pr-number (pr)
|
|
|
561 "Get the number of this pr -- which can be either a pr datum or a number."
|
|
|
562 (or (and (numberp pr) pr)
|
|
|
563 (gnats-admin::pr-get pr 'Number)))
|
|
|
564
|
|
|
565 ;; this must not depend on pr-at, because that depends on this.
|
|
|
566 (defun gnats-admin::pr-num-at (pos)
|
|
|
567 "Find the pr number for the pr at POS"
|
|
|
568 (let*
|
|
|
569 ((ext (extent-at pos nil 'pr))
|
|
|
570 (pr-prop (and ext (extent-property ext 'pr))))
|
|
|
571 (if pr-prop
|
|
|
572 (gnats-admin::pr-number pr-prop)
|
|
|
573 (save-excursion
|
|
|
574 (goto-char pos)
|
|
|
575 (if (not (looking-at "^\\s-*[0-9]"))
|
|
|
576 (backward-paragraph))
|
|
|
577 (if (looking-at "\\s-*[0-9]+[^0-9]")
|
|
|
578 (read (match-string 0))
|
|
|
579 nil)))))
|
|
|
580
|
|
|
581 (defun gnats-admin::pr-by-number (num)
|
|
|
582 "Find the pr numbered N."
|
|
|
583 ;; first try the easy way
|
|
|
584 (let
|
|
|
585 ((pr (elt pr-list (1- num))))
|
|
|
586 (if (and pr (= num (gnats-admin::pr-number pr)))
|
|
|
587 pr
|
|
|
588 ;; easy way didnt work; scan the list
|
|
|
589 (loop
|
|
|
590 for prx across pr-list
|
|
|
591 if (= num (gnats-admin::pr-number prx))
|
|
|
592 return prx))))
|
|
|
593
|
|
|
594 ;; use face alist to set face colors
|
|
|
595 (defun gnats-admin::setup-faces ()
|
|
|
596 "Set up the faces for gnats admin mode."
|
|
|
597 (mapc
|
|
|
598 (function (lambda (l) (make-face (car l))))
|
|
|
599 gnats-admin::face-color)
|
|
|
600 (if (memq (device-class) '(color grayscale))
|
|
|
601 (mapc
|
|
|
602 (function (lambda (l)
|
|
|
603 (if (cadr l)
|
|
|
604 (set-face-foreground (car l) (cadr l)))
|
|
|
605 (if (caddr l)
|
|
|
606 (set-face-background (car l) (caddr l)))))
|
|
|
607 gnats-admin::face-color))
|
|
|
608 (setq font-lock-keywords gnats-admin::font-lock-keywords)
|
|
|
609 ;; this is too slow -- instead, do explicit fontification after modify
|
|
|
610 ; (turn-on-font-lock)
|
|
|
611 )
|
|
|
612
|
|
|
613 (defvar gnats-admin::pr-mark-glyph nil
|
|
|
614 "Glyph used to mark the current PR in display.")
|
|
|
615
|
|
|
616 (defun gnats-admin::buffer ()
|
|
|
617 "Find or create gnats admin buffer."
|
|
|
618 (or (get-buffer "*gnats*")
|
|
|
619 (let ((buf (get-buffer-create "*gnats*")))
|
|
|
620 (set-buffer buf)
|
|
|
621 (make-local-variable 'paragraph-start)
|
|
|
622 (make-local-variable 'paragraph-separate)
|
|
|
623 (setq paragraph-start "^\\(\\S-\\|[ \t\n]*$\\)")
|
|
|
624 (setq paragraph-separate "^[ \t\n]*$")
|
|
|
625 (setq buffer-read-only t)
|
|
|
626 (setq buffer-undo-list t) ; disable undo info
|
|
|
627 (setq gnats-admin::pr-mark-glyph (make-pixmap "target"))
|
|
|
628 (gnats-admin::setup-faces)
|
|
|
629 buf)
|
|
|
630 ))
|
|
|
631
|
|
|
632 (defun gnats-admin:pr (pr-or-num)
|
|
|
633 "If PR-OR-NUM is a pr, return it; if it's a number,
|
|
|
634 return the pr with that number."
|
|
|
635 (cond
|
|
|
636 ((numberp pr-or-num)
|
|
|
637 (gnats-admin::pr-by-number pr-or-num))
|
|
|
638 ((consp pr-or-num)
|
|
|
639 pr-or-num)
|
|
|
640 (t
|
|
|
641 (error "Not a valid PR: %s" pr-or-num))
|
|
|
642 ))
|
|
|
643
|
|
|
644 (defun gnats-admin::pr-at (pos)
|
|
|
645 "PR at POSITION"
|
|
|
646 (or
|
|
|
647 (let ((ext (extent-at pos nil 'pr)))
|
|
|
648 (if ext (extent-property ext 'pr)))
|
|
|
649 (gnats-admin::pr-num-at pos)))
|
|
|
650
|
|
|
651 ;; next should, ideally, run a 1-pr query then splice that into
|
|
|
652 ;; pr-list to update the current pr.
|
|
|
653 ;; however, there's a race condition with gnats; so put the edited
|
|
|
654 ;; pr on the dirty list to be inquired later.
|
|
|
655 (defun gnats-admin:pr-edit ()
|
|
|
656 (interactive)
|
|
|
657 (let*
|
|
|
658 ((pr (gnats-admin::pr-at (point)))
|
|
|
659 (num (gnats-admin::pr-number pr))
|
|
|
660 (num-str (format "%d" num)))
|
|
|
661 (pr-edit num-str)
|
|
|
662 (setq gnats-admin::dirty-list (cons pr gnats-admin::dirty-list))))
|
|
|
663
|
|
|
664 (defun gnats-admin:pr-view ()
|
|
|
665 (interactive)
|
|
|
666 (pr-view (format "%d" (gnats-admin::pr-num-at (point)))))
|
|
|
667 (defun gnats-admin:pr-synopsis ()
|
|
|
668 (interactive)
|
|
|
669 (let*
|
|
|
670 ((pr (gnats-admin::pr-at (point)))
|
|
|
671 (syn (gnats-admin::pr-get pr 'Synopsis)))
|
|
|
672 (message "Synopsis: %s" syn)))
|
|
|
673
|
|
|
674 (defun gnats-admin:pr-originator ()
|
|
|
675 (interactive)
|
|
|
676 (let*
|
|
|
677 ((pr (gnats-admin::pr-at (point)))
|
|
|
678 (syn (gnats-admin::pr-get pr 'Originator)))
|
|
|
679 (message "Originator: %s" syn)))
|
|
|
680
|
|
|
681 (defun gnats-admin:pr-field (fld)
|
|
|
682 "Show any pr field FLD of current pr."
|
|
|
683 (interactive
|
|
|
684 (list (completing-read "Field: " gnats-admin::pr-field-alist
|
|
|
685 nil t)))
|
|
|
686 (let*
|
|
|
687 ((pr (gnats-admin::pr-at (point)))
|
|
|
688 (val (gnats-admin::pr-get pr (intern fld))))
|
|
|
689 (message "%s: %s" fld val)))
|
|
|
690
|
|
|
691 (defvar gnats-admin::current-pr nil "Current pr")
|
|
|
692 (defun gnats-admin::highlight (pr)
|
|
|
693 "Hilight the current PR -- may unhilight the previous."
|
|
|
694 (condition-case err
|
|
|
695 (progn
|
|
|
696 (if gnats-admin::current-pr
|
|
|
697 (highlight-extent
|
|
|
698 (gnats-admin::pr-buffer-extent gnats-admin::current-pr)
|
|
|
699 nil))
|
|
|
700 (highlight-extent (gnats-admin::pr-buffer-extent pr) t)
|
|
|
701 (setq gnats-admin::current-pr pr))
|
|
|
702 (error (setq gnats-admin::current-pr nil))))
|
|
|
703
|
|
|
704 (defun gnats-admin::highlight-point ()
|
|
|
705 "Highlight the pr at point"
|
|
|
706 ;; make point visible
|
|
|
707 (or
|
|
|
708 (pos-visible-in-window-p)
|
|
|
709 (recenter '(t)))
|
|
|
710 (gnats-admin::highlight (gnats-admin::pr-at (point))))
|
|
|
711
|
|
|
712 (defun gnats-admin:next ()
|
|
|
713 "Next pr"
|
|
|
714 (interactive)
|
|
|
715 (forward-paragraph)
|
|
|
716 (gnats-admin::highlight-point))
|
|
|
717 (defun gnats-admin:prev ()
|
|
|
718 "Prev pr."
|
|
|
719 (interactive)
|
|
|
720 (backward-paragraph)
|
|
|
721 (gnats-admin::highlight-point))
|
|
|
722 (defun gnats-admin:this ()
|
|
|
723 "Activate pr at point."
|
|
|
724 (interactive)
|
|
|
725 (end-of-line)
|
|
|
726 (backward-paragraph)
|
|
|
727 (gnats-admin::highlight-point))
|
|
|
728
|
|
|
729 (defun gnats-admin:mouse-set (ev)
|
|
|
730 (interactive "e")
|
|
|
731 (mouse-set-point ev)
|
|
|
732 (gnats-admin::highlight-point))
|
|
|
733
|
|
|
734 (defun gnats-admin:mouse-synopsis (ev)
|
|
|
735 (interactive "e")
|
|
|
736 (gnats-admin:mouse-set ev)
|
|
|
737 (gnats-admin:pr-synopsis))
|
|
|
738
|
|
|
739 (defun gnats-admin:mouse-menu (ev)
|
|
|
740 (interactive "e")
|
|
|
741 (gnats-admin:mouse-set ev)
|
|
|
742 (popup-mode-menu))
|
|
|
743
|
|
|
744 (defun gnats-admin:refresh-this-pr ()
|
|
|
745 "Reread and refresh the display of the current PR."
|
|
|
746 (interactive)
|
|
|
747 (let* ((pr (gnats-admin::pr-at (point)))
|
|
|
748 (buffer-read-only nil)
|
|
|
749 (b (gnats-admin::pr-buffer-begin pr))
|
|
|
750 (e (gnats-admin::pr-buffer-end pr)))
|
|
|
751 (goto-char b)
|
|
|
752 (save-excursion
|
|
|
753 (gnats-admin::pr-buffer-delete pr)
|
|
|
754 (gnats-admin::pr-reread pr)
|
|
|
755 (gnats-admin::display-pr pr (current-buffer))
|
|
|
756 ;; had to dive pretty deep into font-lock to get this one...
|
|
|
757 (let ((font-lock-mode t))
|
|
|
758 (font-lock-after-change-function b e 1)))
|
|
|
759 (gnats-admin::highlight-point)))
|
|
|
760
|
|
|
761 (defun gnats-admin:goto-pr (n)
|
|
|
762 "Make pr number N the current pr."
|
|
|
763 (interactive "nPR: ")
|
|
|
764 (goto-char (gnats-admin::pr-n-pos n))
|
|
|
765 (gnats-admin::highlight-point))
|
|
|
766
|
|
|
767 (defun gnats-admin::pr-n-pos (n)
|
|
|
768 "Find the buffer position of pr numbered N in current buffer."
|
|
|
769 (save-excursion
|
|
|
770 (goto-char (point-min))
|
|
|
771 (let ((re (format "^%s\\s-" n)))
|
|
|
772 (re-search-forward re)
|
|
|
773 (point)
|
|
|
774 )))
|
|
|
775
|
|
|
776 (defun gnats-admin::pr-buffer-delete (pr)
|
|
|
777 "Delete the display of the PR."
|
|
|
778 (let* ((b (gnats-admin::pr-buffer-begin pr))
|
|
|
779 (e (gnats-admin::pr-buffer-end pr))
|
|
|
780 (mbuf (gnats-admin::pr-buffer pr))
|
|
|
781 (pr-ext (gnats-admin::pr-buffer-extent pr)))
|
|
|
782 (set-buffer mbuf)
|
|
|
783 (let ((buffer-read-only nil))
|
|
|
784 (delete-region b e)
|
|
|
785 (if (extentp pr-ext)
|
|
|
786 (delete-extent pr-ext)))
|
|
|
787 ))
|
|
|
788
|
|
|
789 (defun gnats-admin:quit ()
|
|
|
790 "Quit out of gnats admin mode."
|
|
|
791 (interactive)
|
|
|
792 (if (get-buffer "**gnats-query*")
|
|
|
793 (kill-buffer "**gnats-query*"))
|
|
|
794 (kill-buffer nil))
|
|
|
795
|
|
|
796 (defvar gnats-admin-mode-map nil "Key map for gnats admin mode.")
|
|
|
797
|
|
|
798 (defun gnats-admin::setup-keymap ()
|
|
|
799 (if (not (keymapp gnats-admin-mode-map))
|
|
|
800 (progn
|
|
|
801 (setq gnats-admin-mode-map (make-keymap))
|
|
|
802 (suppress-keymap gnats-admin-mode-map)
|
|
|
803 (define-key gnats-admin-mode-map "e" 'gnats-admin:pr-edit)
|
|
|
804 (define-key gnats-admin-mode-map "v" 'gnats-admin:pr-view)
|
|
|
805 (define-key gnats-admin-mode-map "s" 'gnats-admin:pr-synopsis)
|
|
|
806 (define-key gnats-admin-mode-map "o" 'gnats-admin:pr-originator)
|
|
|
807 (define-key gnats-admin-mode-map "f" 'gnats-admin:pr-field)
|
|
|
808 (define-key gnats-admin-mode-map "\C-l" 'gnats-admin:refresh)
|
|
|
809 (define-key gnats-admin-mode-map "n" 'gnats-admin:next)
|
|
|
810 (define-key gnats-admin-mode-map "p" 'gnats-admin:prev)
|
|
|
811 (define-key gnats-admin-mode-map " " 'gnats-admin:this)
|
|
|
812 (define-key gnats-admin-mode-map "q" 'gnats-admin:quit)
|
|
|
813 (define-key gnats-admin-mode-map "g" 'gnats-admin:goto-pr)
|
|
|
814 (define-key gnats-admin-mode-map "r" 'gnats-admin:refresh-this-pr)
|
|
|
815 (define-key gnats-admin-mode-map "S" 'gnats-admin:edit-selection)
|
|
|
816 (define-key gnats-admin-mode-map "R" 'gnats-admin:regret)
|
|
|
817 (define-key gnats-admin-mode-map 'button1 'gnats-admin:mouse-set)
|
|
|
818 (define-key gnats-admin-mode-map 'button2 'gnats-admin:mouse-synopsis)
|
|
|
819 (define-key gnats-admin-mode-map 'button3 'gnats-admin:mouse-menu)
|
|
|
820 ))
|
|
|
821 )
|
|
|
822
|
|
|
823 (defun gnats-admin-mode ()
|
|
|
824 "Major mode for looking at a summary of gnats reports.
|
|
|
825 Stomps to gnats admin buffer!
|
|
|
826 Commands: \\{gnats-admin-mode-map}."
|
|
|
827 (interactive)
|
|
|
828 (switch-to-buffer (gnats-admin::buffer))
|
|
|
829 (setq major-mode 'gnats-admin-mode)
|
|
|
830 (setq mode-name "Gnats Admin")
|
|
|
831 (gnats-admin::setup-keymap)
|
|
|
832 (use-local-map gnats-admin-mode-map)
|
|
|
833 (setq mode-popup-menu gnats-admin::popup-menu)
|
|
|
834 (gnats-admin:refresh)
|
|
|
835 )
|
|
|
836
|
|
|
837 (put 'gnats-admin-mode 'mode-class 'special)
|
|
|
838
|
|
|
839 (defvar gnats-admin::pr-mark-glyph nil "marker for current PR.")
|
|
|
840
|
|
|
841 (defun gnats-admin::pr-buffer (pr)
|
|
|
842 "The buffer in which this pr is displayed."
|
|
|
843 (gnats-admin::buffer))
|
|
|
844
|
|
|
845 (defun gnats-admin::pr-buffer-begin (pr)
|
|
|
846 "Return the position of beginning of this PR."
|
|
|
847 (let
|
|
|
848 ((pr-num (gnats-admin::pr-number pr)))
|
|
|
849 (save-excursion
|
|
|
850 (set-buffer (gnats-admin::pr-buffer pr))
|
|
|
851 ;; first try locally, then thru whole buffer
|
|
|
852 (or
|
|
|
853 (and (progn (backward-paragraph 1)
|
|
|
854 (re-search-forward (format "^%d " pr-num) nil t))
|
|
|
855 (progn
|
|
|
856 (beginning-of-line 1)
|
|
|
857 (point)))
|
|
|
858 (and (progn (goto-char (point-min))
|
|
|
859 (re-search-forward (format "^%d " pr-num) nil t))
|
|
|
860 (progn
|
|
|
861 (beginning-of-line 1)
|
|
|
862 (point)))))))
|
|
|
863
|
|
|
864 (defun gnats-admin::pr-buffer-end (pr)
|
|
|
865 "Return the position of the end of the PR."
|
|
|
866 (save-excursion
|
|
|
867 (set-buffer (gnats-admin::pr-buffer pr))
|
|
|
868 (goto-char (gnats-admin::pr-buffer-begin pr))
|
|
|
869 (forward-paragraph 1)
|
|
|
870 (point)))
|
|
|
871
|
|
|
872 (defun gnats-admin::unclosed (pr)
|
|
|
873 "A selector that chooses unclosed PR's."
|
|
|
874 (not (eq 'closed (gnats-admin::pr-get pr 'State))))
|
|
|
875
|
|
|
876 (defvar gnats-admin:selexpr nil
|
|
|
877 "Selection expression -- see eval-selexpr.")
|
|
|
878
|
|
|
879 (defun gnats-admin::eval-selexpr (pr)
|
|
|
880 "Evaluate the selection expression, in an environment with
|
|
|
881 pr bound to the pr, and the field names bound to their value."
|
|
|
882 (let
|
|
|
883 ((Number (gnats-admin::pr-get pr 'Number))
|
|
|
884 (Category (gnats-admin::pr-get pr 'Category))
|
|
|
885 (Synopsis (gnats-admin::pr-get pr 'Synopsis))
|
|
|
886 (Confidential (gnats-admin::pr-get pr 'Confidential))
|
|
|
887 (Severity (gnats-admin::pr-get pr 'Severity))
|
|
|
888 (Priority (gnats-admin::pr-get pr 'Priority))
|
|
|
889 (Responsible (gnats-admin::pr-get pr 'Responsible))
|
|
|
890 (State (gnats-admin::pr-get pr 'State))
|
|
|
891 (Class (gnats-admin::pr-get pr 'Class))
|
|
|
892 (Submitter-Id (gnats-admin::pr-get pr 'Submitter-Id))
|
|
|
893 (Arrival-Date (gnats-admin::pr-get pr 'Arrival-Date))
|
|
|
894 (Originator (gnats-admin::pr-get pr 'Originator))
|
|
|
895 (Release (gnats-admin::pr-get pr 'Release)))
|
|
|
896 (or (not gnats-admin:selexpr)
|
|
|
897 (eval gnats-admin:selexpr))))
|
|
|
898
|
|
|
899 (defun gnats-admin:edit-selection ()
|
|
|
900 "Edit the selection criteria."
|
|
|
901 (interactive)
|
|
|
902 (setq gnats-admin::selector 'gnats-admin::eval-selexpr)
|
|
|
903 (setq gnats-admin:selexpr
|
|
|
904 (edit-expr gnats-admin:selexpr
|
|
|
905 ";; Selection expression. This is evaluated with Number, Category, Synopsis,
|
|
|
906 ;; Confidential, Severity, Priority, Responsible, State, Class, Submitter-Id,
|
|
|
907 ;; Arrival-Date, Originator, and Release set from the PR; if it's a non-null
|
|
|
908 ;; expression that evaluates true, then that record is displayed. Free-form
|
|
|
909 ;; fields are strings, others are symbols or other atoms.
|
|
|
910 "
|
|
|
911 ))
|
|
|
912 (gnats-admin:refresh))
|
