Mercurial > hg > xemacs-beta

comparison lisp/gnats/gnats-admin.el @ 110:fe104dbd9147 r20-1b7

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-1b7
author cvs
date Mon, 13 Aug 2007 09:19:45 +0200
parents
children
comparison
equal deleted inserted replaced
109:e183fc049578 110:fe104dbd9147
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))