|
110
|
1 ;;;; -*-emacs-lisp-*-
|
|
|
2 ;;;; EMACS interface for GNATS.
|
|
|
3 ;;;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
|
|
|
4 ;;;; Contributed by Brendan Kehoe (brendan@cygnus.com)
|
|
|
5 ;;;; based on an original version by Heinz G. Seidl (hgs@ide.com).
|
|
|
6 ;;;;
|
|
|
7 ;;;; This file is part of GNU GNATS.
|
|
|
8 ;;;;
|
|
|
9 ;;;; GNU GNATS is free software; you can redistribute it and/or modify
|
|
|
10 ;;;; it under the terms of the GNU General Public License as published by
|
|
|
11 ;;;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;;;; any later version.
|
|
|
13 ;;;;
|
|
|
14 ;;;; GNU GNATS is distributed in the hope that it will be useful,
|
|
|
15 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
17 ;;;; GNU General Public License for more details.
|
|
|
18 ;;;;
|
|
|
19 ;;;; You should have received a copy of the GNU General Public License
|
|
|
20 ;;;; along with GNU GNATS; see the file COPYING. If not, write to
|
|
|
21 ;;;; the Free Software Foundation, 59 Temple Place - Suite 330,
|
|
|
22 ;;;; Boston, MA 02111, USA. */
|
|
|
23
|
|
|
24 ;;;; This file provides `edit-pr', `view-pr' `query-pr', for changing and
|
|
|
25 ;;;; searching problem reports that are part of the GNATS database. See the
|
|
|
26 ;;;; gnats(1) man page or the GNATS documentation for further information.
|
|
|
27
|
|
|
28 (provide 'gnats)
|
|
|
29 (require 'send-pr) ;Shared stuff defined there
|
|
|
30
|
|
|
31 ;;;;---------------------------------------------------------------------------
|
|
|
32 ;;;; Customization: put the following forms into your default.el file
|
|
|
33 ;;;; (or into your .emacs) and the whole file into your EMACS library.
|
|
|
34 ;;;;---------------------------------------------------------------------------
|
|
|
35
|
|
|
36 ;(autoload 'edit-pr "gnats"
|
|
|
37 ; "Command to edit a problem report." t)
|
|
|
38
|
|
|
39 ;(autoload 'view-pr "gnats"
|
|
|
40 ; "Command to view a problem report." t)
|
|
|
41
|
|
|
42 ;(autoload 'gnats-mode "gnats"
|
|
|
43 ; "Major mode for editing of problem reports." t)
|
|
|
44
|
|
|
45 ;(autoload 'query-pr "gnats"
|
|
|
46 ; "Command to query information about problem reports." t)
|
|
|
47
|
|
|
48 ;(autoload 'summ-pr "gnats"
|
|
|
49 ; "Command to display a summary listing of problem reports." t)
|
|
|
50
|
|
|
51 ;;;;---------------------------------------------------------------------------
|
|
|
52 ;;;; To reply by mail within gnats-mode
|
|
|
53 ;;;;---------------------------------------------------------------------------
|
|
|
54
|
|
|
55 (defvar gnats-mailer 'mail
|
|
|
56 "*Specifiles either `mail' or `mhe' as mailer for GNATS")
|
|
|
57
|
|
|
58 ;; Provides mail reply and mail other window command using usual mail
|
|
|
59 ;; interface and mh-e interface.
|
|
|
60 ;;
|
|
|
61 ;; To use MAIL: set the variable
|
|
|
62 ;; `gnats-mailer' to `mail'
|
|
|
63 ;;
|
|
|
64 ;; To use MH-E: set the variable
|
|
|
65 ;; `gnats-mailer' to `mhe'
|
|
|
66
|
|
|
67 (autoload 'mail "sendmail")
|
|
|
68 (autoload 'mail-other-window "sendmail")
|
|
|
69 (autoload 'mail-fetch-field "mail-utils")
|
|
|
70 (autoload 'rmail-dont-reply-to "mail-utils")
|
|
|
71 (autoload 'mail-strip-quoted-names "mail-utils")
|
|
|
72 (autoload 'mail-send "sendmail")
|
|
|
73 (autoload 'mail-send-and-exit "sendmail")
|
|
|
74
|
|
|
75 (autoload 'mh-send "mh-e")
|
|
|
76 (autoload 'mh-send-other-window "mh-e")
|
|
|
77 (autoload 'mh-find-path "mh-e")
|
|
|
78 (autoload 'mh-get-field "mh-e")
|
|
|
79 (autoload 'mh-insert-fields "mh-e")
|
|
|
80 (defvar mh-show-buffer nil)
|
|
|
81 (defvar mh-sent-from-folder nil)
|
|
|
82 (defvar mh-sent-from-msg nil)
|
|
|
83
|
|
|
84 ;;; User options
|
|
|
85
|
|
|
86 (defvar gnats:keep-edited-buffers t
|
|
|
87 "*If non-nil, then PR buffers are kept with distinct names after
|
|
|
88 editing. Otherwise, only the the most recently edited PR is kept.")
|
|
|
89
|
|
|
90 (defvar gnats:keep-sent-messages 1
|
|
|
91 "*Non-nil value N causes GNATS to keep the last N messages sent from GNATS.
|
|
|
92 A value of 0 or nil causes GNATS never to keep such buffers. A value of t
|
|
|
93 causes GNATS to keep all such buffers.")
|
|
|
94
|
|
|
95 (defvar gnats:network-server nil
|
|
|
96 "*If non-nil, names the GNATS network server for remote queries and editing.")
|
|
|
97
|
|
|
98 (defvar gnats:run-in-background t
|
|
|
99 "*If non-nil, make GNATS programs run in the background allowing the emacs to continue to other things.")
|
|
|
100
|
|
|
101 (defvar gnats:bury-edited-prs t
|
|
|
102 "*If non-nil, then PR buffers are buried after editing. Otherwise, they are left at the top of the buffer list.")
|
|
|
103
|
|
|
104 ;;; emacs 19 uses compile-internal, emacs 18 uses compile1
|
|
|
105 (if gnats::emacs-19p
|
|
|
106 (autoload 'compile-internal "compile")
|
|
|
107 (autoload 'compile1 "compile")
|
|
|
108 (fset 'compile-internal 'compile1))
|
|
|
109
|
|
|
110 ;;; Misc constants.
|
|
|
111
|
|
|
112 ;;(defvar gnats:root "/usr/share/gnats/gnats-db"
|
|
|
113 ;; "*The top of the tree containing the GNATS database.")
|
|
|
114
|
|
|
115 (defvar gnats:libdir (or (gnats::get-config "LIBDIR") "/usr/lib")
|
|
|
116 "*Where the `gnats' subdirectory lives for things like pr-edit.")
|
|
|
117
|
|
|
118 (defvar gnats:addr (or (gnats::get-config "GNATS_ADDR") "bugs")
|
|
|
119 "*Where bug reports are sent.")
|
|
|
120
|
|
|
121 (defvar gnats::version
|
|
|
122 (concat "Version " (or (gnats::get-config "VERSION") "3.101")))
|
|
|
123
|
|
|
124 (defvar gnats::diffopt (or (gnats::get-config "DIFFOPT") "-u")
|
|
|
125 "How to get human-friendly output from diff(1).")
|
|
|
126
|
|
|
127 (defvar gnats::categories nil
|
|
|
128 "List of GNATS categories; computed at runtime.")
|
|
|
129
|
|
|
130 (defvar gnats::responsibles nil
|
|
|
131 "List of GNATS responsibles; Computed at runtime.")
|
|
|
132
|
|
|
133 (defvar gnats::submitters nil
|
|
|
134 "List of GNATS submitters; Computed at runtime.")
|
|
|
135
|
|
|
136 ;;;###autoload
|
|
|
137 (defvar gnats::mode-name nil
|
|
|
138 "Name of the GNATS mode.")
|
|
|
139
|
|
|
140 (defconst gnats::err-buffer "*gnats-error*"
|
|
|
141 "Name of the temporary buffer, where gnats error messages appear.")
|
|
|
142
|
|
|
143 ;;(defconst gnats::indent 17 "Indent for formatting the value.")
|
|
|
144
|
|
|
145 (defvar gnats:::pr-locked nil
|
|
|
146 "Buffer local flag representing whether the associated pr is locked.")
|
|
|
147
|
|
|
148 (defvar gnats:::pr-errors nil
|
|
|
149 "Buffer local buffer holding any errors from attempting to file this pr.")
|
|
|
150
|
|
|
151 (defvar gnats:::buffer-pr nil
|
|
|
152 "Buffer local name of this pr.")
|
|
|
153
|
|
|
154 (defvar gnats:::current-pr nil
|
|
|
155 "Buffer local value of the current pr.")
|
|
|
156
|
|
|
157 (defvar gnats:::do-file-pr nil
|
|
|
158 "Buffer local value; if T, file the current pr.")
|
|
|
159
|
|
|
160 (defvar gnats:::force nil
|
|
|
161 "Buffer local value; if T, ignore errors unlocking the current pr.")
|
|
|
162
|
|
|
163 (defvar gnats:::pr-buffer nil
|
|
|
164 "Buffer local value of the buffer containing the pr.")
|
|
|
165
|
|
|
166 (defvar gnats:::audit-trail nil
|
|
|
167 "Buffer local audit trail for the current pr.")
|
|
|
168
|
|
|
169 (defvar gnats:::backupname nil
|
|
|
170 "Buffer local name of the backup file for this pr.")
|
|
|
171
|
|
|
172 (defvar gnats:::start-of-PR-fields nil
|
|
|
173 "Buffer position of the beginning of the PR fields.")
|
|
|
174
|
|
|
175 (defvar gnats:::newfile nil
|
|
|
176 "File used to store the results of npr-edit.")
|
|
|
177
|
|
|
178 (defvar gnats:::query-pr "query-pr"
|
|
|
179 "The program name used to query problem reports.")
|
|
|
180
|
|
|
181 (defvar gnats:::nquery-pr "nquery-pr"
|
|
|
182 "The program name used to query problem reports over the network.")
|
|
|
183
|
|
|
184 (defvar gnats:::query-regexp "n?query-pr:"
|
|
|
185 "The regular expression to use to recognize a message from the query program.")
|
|
|
186
|
|
|
187 ;; For example:
|
|
|
188 ;; (setq gnats:::types '( ( "Games" ( "/gnats/games" "/usr/gamesdb/H-sun4/lib ")
|
|
|
189 ;; ( "Tools" ( "/usr/toolsdb" "/usr/local/lib" ))))
|
|
|
190 (defvar gnats:::types nil
|
|
|
191 "Alist of each type of GNATS database and its root and libdir settings.")
|
|
|
192
|
|
|
193 (defconst gnats::fields
|
|
|
194 (let (fields)
|
|
|
195 (setq
|
|
|
196 fields
|
|
|
197 ;; Duplicate send-pr::fields, don't just include it.
|
|
|
198 ;; is there a better way than this?
|
|
|
199 (append (read (prin1-to-string send-pr::fields))
|
|
|
200 '(("Arrival-Date" nil nil text)
|
|
|
201 ("Customer-Id")
|
|
|
202 ("Number" nil nil number)
|
|
|
203 ("Responsible" gnats::set-responsibles nil enum
|
|
|
204 gnats::update-audit-trail)
|
|
|
205 ("State"
|
|
|
206 (("open") ("analyzed") ("feedback") ("suspended") ("closed"))
|
|
|
207 (lambda (x) (or (cdr (assoc x gnats::state-following)) ""))
|
|
|
208 enum gnats::update-audit-trail))))
|
|
|
209 ;; (setf (second (assoc "Category" fields)) 'gnats::set-categories)
|
|
|
210 (setcar (cdr (assoc "Category" fields)) 'gnats::set-categories)
|
|
|
211 (setcdr (nthcdr 3 (assoc "Category" fields))
|
|
|
212 '(gnats::update-responsible))
|
|
|
213 (setcar (cdr (assoc "Class" fields))
|
|
|
214 '(("sw-bug") ("doc-bug") ("change-request") ("support")
|
|
|
215 ("mistaken") ("duplicate")))
|
|
|
216 (setcdr (assoc "Submitter-Id" fields) '(gnats::set-submitters t enum))
|
|
|
217 (setcdr (assoc "Customer-Id" fields) (cdr (assoc "Submitter-Id" fields)))
|
|
|
218 fields)
|
|
|
219 "AList of one-line PR fields and their possible values.")
|
|
|
220
|
|
|
221 (defconst gnats::state-following
|
|
|
222 '(("open" . "analyzed")
|
|
|
223 ("analyzed" . "feedback")
|
|
|
224 ("feedback" . "closed")
|
|
|
225 ("suspended" . "analyzed"))
|
|
|
226 "A list of states and possible following states (does not describe all
|
|
|
227 possibilities).")
|
|
|
228
|
|
|
229 (defvar gnats::query-pr-history nil
|
|
|
230 "Past arguments passed to the query-pr program.")
|
|
|
231
|
|
|
232 (defvar gnats::tmpdir (or (getenv "TMPDIR") "/tmp/")
|
|
|
233 "Directory to use for temporary files.")
|
|
|
234
|
|
|
235 ;;;;---------------------------------------------------------------------------
|
|
|
236 ;;;; hooks
|
|
|
237 ;;;;---------------------------------------------------------------------------
|
|
|
238
|
|
|
239 ;; we define it here in case it's not defined
|
|
|
240 (or (boundp 'text-mode-hook) (setq text-mode-hook nil))
|
|
|
241 (defvar gnats-mode-hook text-mode-hook "Called when gnats mode is switched on.")
|
|
|
242
|
|
|
243 ;;;;---------------------------------------------------------------------------
|
|
|
244 ;;;; Error conditions
|
|
|
245 ;;;;---------------------------------------------------------------------------
|
|
|
246
|
|
|
247 (put 'gnats::error 'error-conditions '(error gnats::error))
|
|
|
248 (put 'gnats::error 'error-message "GNATS error")
|
|
|
249
|
|
|
250 ;; pr-edit --check was unhappy
|
|
|
251 (put 'gnats::invalid-fields 'error-conditions
|
|
|
252 '(error gnats::error gnats::invalid-fields))
|
|
|
253 (put 'gnats::invalid-fields 'error-message "invalid fields in PR")
|
|
|
254 (put 'gnats::invalid-date 'error-conditions
|
|
|
255 '(error gnats::error gnats::invalid-date))
|
|
|
256 (put 'gnats::invalid-date 'error-message "invalid date value")
|
|
|
257
|
|
|
258 ;; pr-addr couldn't find an appropriate address
|
|
|
259 (put 'gnats::invalid-name 'error-conditions
|
|
|
260 '(error gnats::error gnats::invalid-name))
|
|
|
261 (put 'gnats::invalid-name 'error-message "could not find the requested address")
|
|
|
262
|
|
|
263 ;; what pr?
|
|
|
264 (put 'gnats::no-such-pr 'error-conditions '(error gnats::error gnats::no-such-pr))
|
|
|
265 (put 'gnats::no-such-pr 'error-message "PR does not exist")
|
|
|
266
|
|
|
267 ;;
|
|
|
268 (put 'gnats::no-such-category 'error-conditions
|
|
|
269 '(error gnats::error gnats::no-such-category))
|
|
|
270 (put 'gnats::no-such-category 'error-message "No such category")
|
|
|
271
|
|
|
272 ;; there is no lock on that pr
|
|
|
273 (put 'gnats::pr-not-locked 'error-conditions
|
|
|
274 '(error gnats::error gnats::pr-not-locked))
|
|
|
275 (put 'gnats::pr-not-locked 'error-message "No one is locking the PR")
|
|
|
276
|
|
|
277 ;; there is a lock on that pr
|
|
|
278 (put 'gnats::locked-pr 'error-conditions '(error gnats::error gnats::locked-pr))
|
|
|
279 (put 'gnats::locked-pr 'error-message "PR locked by")
|
|
|
280
|
|
|
281 ;; GNATS is locked
|
|
|
282 (put 'gnats::locked 'error-conditions '(error gnats::error gnats::locked))
|
|
|
283 (put 'gnats::locked 'error-message "GNATS is locked by another process---try again later.")
|
|
|
284
|
|
|
285 ;; We can't lock GNATS.
|
|
|
286 (put 'gnats::cannot-lock 'error-conditions '(error gnats::error gnats::locked))
|
|
|
287 (put 'gnats::cannot-lock 'error-message "cannot lock GNATS; try again later.")
|
|
|
288
|
|
|
289 ;;;;---------------------------------------------------------------------------
|
|
|
290 ;;;; GNATS mode
|
|
|
291 ;;;;---------------------------------------------------------------------------
|
|
|
292
|
|
|
293 (defvar gnats-mode-map
|
|
|
294 (let ((map (make-sparse-keymap)))
|
|
|
295 (define-key map "\M-n" 'gnats:next-field)
|
|
|
296 (define-key map "\M-p" 'gnats:previous-field)
|
|
|
297 (define-key map "\C-\M-b" 'gnats:backward-field)
|
|
|
298 (define-key map "\C-\M-f" 'gnats:forward-field)
|
|
|
299 (define-key map "\C-c\C-a" 'gnats:mail-reply)
|
|
|
300 (define-key map "\C-c\C-c" 'gnats:submit-pr)
|
|
|
301 (define-key map "\C-c\C-e" 'gnats:edit-pr)
|
|
|
302 (define-key map "\C-c\C-f" 'gnats:change-field)
|
|
|
303 (define-key map "\C-c\C-m" 'gnats:mail-other-window)
|
|
|
304 (define-key map "\C-c\C-q" 'gnats:unlock-buffer-force)
|
|
|
305 (define-key map "\C-c\C-r" 'gnats:responsible-change-from-to)
|
|
|
306 (define-key map "\C-c\C-s" 'gnats:state-change-from-to)
|
|
|
307 (define-key map "\C-c\C-t" 'gnats:category-change-from-to)
|
|
|
308 (define-key map "\C-c\C-u" 'gnats:unlock-pr)
|
|
|
309 (or gnats::emacs-19p
|
|
|
310 (define-key map "\C-xk" 'gnats:kill-buffer))
|
|
|
311 map)
|
|
|
312 "Keymap for gnats mode.")
|
|
|
313
|
|
|
314 (defsubst gnats::get-header (field)
|
|
|
315 "Fetch the contents of mail header FIELD."
|
|
|
316 (funcall (nth 4 (assoc gnats-mailer gnats::mail-functions)) field))
|
|
|
317
|
|
|
318 (defun gnats:submit-pr ()
|
|
|
319 "Save the current PR into the database and unlock it.
|
|
|
320
|
|
|
321 This function has no effect if the PR is not locked.
|
|
|
322
|
|
|
323 Three cases:
|
|
|
324 State change
|
|
|
325 Responsibility change
|
|
|
326 Other change (only interesting if the PR was changed by somebody
|
|
|
327 other than the Reponsible person)
|
|
|
328
|
|
|
329 State changes are sent to the originator
|
|
|
330 Responsibility changes are sent to the new responsible person
|
|
|
331 Other changes are sent to the responsible person."
|
|
|
332 ;;
|
|
|
333 (interactive)
|
|
|
334 (cond ((not (eq major-mode 'gnats:gnats-mode))
|
|
|
335 (error "edit-pr: not in GNATS mode."))
|
|
|
336 (gnats:::pr-locked
|
|
|
337 (gnats::check-pr-background t)
|
|
|
338 (if gnats:run-in-background (bury-buffer)))
|
|
|
339 ;; If not locked, do nothing
|
|
|
340 (t
|
|
|
341 (message "edit-pr: PR not locked."))))
|
|
|
342
|
|
|
343 ;;;###autoload
|
|
|
344 (setq gnats::mode-name 'gnats:gnats-mode)
|
|
|
345
|
|
|
346 (defun gnats::rename-buffer ()
|
|
|
347 (let ((category (gnats::field-contents "Category"))
|
|
|
348 (number (gnats::field-contents "Number"))
|
|
|
349 buf)
|
|
|
350 (setq gnats:::buffer-pr (format "%s/%s" category number))
|
|
|
351 (and (setq buf (get-buffer gnats:::buffer-pr))
|
|
|
352 (save-excursion
|
|
|
353 (set-buffer buf)
|
|
|
354 (set-buffer-modified-p nil)
|
|
|
355 (kill-buffer buf)))
|
|
|
356 (rename-buffer gnats:::buffer-pr)))
|
|
|
357
|
|
|
358 ;; FIXME allow re-lock of unlocked PR
|
|
|
359 ;; FIXME too many assumptions -- make more independent of edit-pr
|
|
|
360 ;;;###autoload
|
|
|
361 (fset 'gnats-mode gnats::mode-name)
|
|
|
362 ;;;###autoload
|
|
|
363 (defun gnats:gnats-mode ()
|
|
|
364 "Major mode for editing problem reports.
|
|
|
365 For information about the form see gnats(1) and pr_form(5).
|
|
|
366
|
|
|
367 When you are finished editing the buffer, type \\[gnats:submit-pr] to commit
|
|
|
368 your changes to the PR database. To abort the edit, type
|
|
|
369 \\[gnats:unlock-buffer].
|
|
|
370
|
|
|
371 Special commands:
|
|
|
372 \\{gnats-mode-map}
|
|
|
373 Turning on gnats-mode calls the value of the variable gnats-mode-hook,
|
|
|
374 if it is not nil."
|
|
|
375 (gnats::patch-exec-path) ;Why is this necessary? --jason
|
|
|
376 (gnats::set-categories)
|
|
|
377 (gnats::set-responsibles)
|
|
|
378 (gnats::set-submitters)
|
|
|
379 (put gnats::mode-name 'mode-class 'special)
|
|
|
380 (kill-all-local-variables)
|
|
|
381 (setq major-mode gnats::mode-name)
|
|
|
382 (setq mode-name "gnats")
|
|
|
383 (use-local-map gnats-mode-map)
|
|
|
384 (set-syntax-table text-mode-syntax-table)
|
|
|
385 (setq local-abbrev-table text-mode-abbrev-table)
|
|
|
386 (make-local-variable 'gnats:::start-of-PR-fields)
|
|
|
387 (make-local-variable 'gnats:::pr-errors)
|
|
|
388 (make-local-variable 'gnats:::buffer-pr)
|
|
|
389 (gnats::rename-buffer)
|
|
|
390
|
|
|
391 ;; we do this in gnats:edit-pr for the network version
|
|
|
392 (if (not gnats:network-server)
|
|
|
393 (progn
|
|
|
394 (setq gnats:::backupname (gnats::make-temp-name))
|
|
|
395 (copy-file (format "%s/%s" gnats:root gnats:::buffer-pr)
|
|
|
396 gnats:::backupname)))
|
|
|
397
|
|
|
398 ;; edit-pr locks it for us
|
|
|
399 (make-local-variable 'gnats:::pr-locked)
|
|
|
400 (setq gnats:::pr-locked t)
|
|
|
401
|
|
|
402 (cond (gnats::emacs-19p
|
|
|
403 (make-local-variable 'kill-buffer-hook)
|
|
|
404 (add-hook 'kill-buffer-hook 'gnats::kill-buffer-hook)))
|
|
|
405
|
|
|
406 ; If they do C-x C-c, unlock all of the PRs they've edited.
|
|
|
407 (if (fboundp 'add-hook)
|
|
|
408 (add-hook 'kill-emacs-hook 'gnats::unlock-all-buffers)
|
|
|
409 (setq kill-emacs-hook 'gnats::unlock-all-buffers))
|
|
|
410
|
|
|
411 (make-local-variable 'paragraph-separate)
|
|
|
412 (setq paragraph-separate (concat (default-value 'paragraph-separate)
|
|
|
413 "\\|" gnats::keyword "$"))
|
|
|
414 (make-local-variable 'paragraph-start)
|
|
|
415 (setq paragraph-start (concat (default-value 'paragraph-start)
|
|
|
416 "\\|" gnats::keyword))
|
|
|
417 (make-local-variable 'gnats:::audit-trail)
|
|
|
418 (goto-char (point-min))
|
|
|
419 (search-forward "\n>Number:")
|
|
|
420 (beginning-of-line)
|
|
|
421 (setq gnats:::start-of-PR-fields (point-marker))
|
|
|
422 (run-hooks 'gnats-mode-hook))
|
|
|
423
|
|
|
424 ;;;;---------------------------------------------------------------------------
|
|
|
425 ;;;; Mail customization
|
|
|
426 ;;;;---------------------------------------------------------------------------
|
|
|
427
|
|
|
428 (or (string-match mail-yank-ignored-headers "X-mode:")
|
|
|
429 (setq mail-yank-ignored-headers
|
|
|
430 (concat "^X-mode:" "\\|" mail-yank-ignored-headers)))
|
|
|
431
|
|
|
432 (defconst gnats::mail-functions
|
|
|
433 '((mail gnats::mail-other-window-using-mail
|
|
|
434 gnats::mail-reply-using-mail
|
|
|
435 gnats::mail-PR-changed-mail-setup
|
|
|
436 gnats::get-header-using-mail-fetch-field)
|
|
|
437 (mhe gnats::mail-other-window-using-mhe
|
|
|
438 gnats::mail-reply-using-mhe
|
|
|
439 gnats::mail-PR-changed-mhe-setup
|
|
|
440 gnats::get-header-using-mhe))
|
|
|
441 "An association list of mailers and the functions that use them.
|
|
|
442 The functions are supposed to implement, respectively:
|
|
|
443 gnats::mail-other-window
|
|
|
444 gnats::mail-reply
|
|
|
445 gnats::mail-PR-changed-setup
|
|
|
446 gnats::get-header")
|
|
|
447
|
|
|
448 ;;;;---------------------------------------------------------------------------
|
|
|
449 ;;;; Toplevel functions and vars, to reply with mail within gnats-mode
|
|
|
450 ;;;;---------------------------------------------------------------------------
|
|
|
451
|
|
|
452 (defun gnats:mail-other-window ()
|
|
|
453 "Compose mail in other window.
|
|
|
454 Customize the variable `gnats-mailer' to use another mailer."
|
|
|
455 ;;
|
|
|
456 (interactive)
|
|
|
457 (funcall (nth 1 (assoc gnats-mailer gnats::mail-functions))))
|
|
|
458
|
|
|
459 (defun gnats:mail-reply (&optional just-sender)
|
|
|
460 "Reply mail to PR Originator.
|
|
|
461 Customize the variable `gnats-mailer' to use another mailer.
|
|
|
462 If optional argument JUST-SENDER is non-nil, send response only to
|
|
|
463 original submitter of problem report."
|
|
|
464 ;;
|
|
|
465 (interactive "P")
|
|
|
466 (funcall (nth 2 (assoc gnats-mailer gnats::mail-functions)) just-sender))
|
|
|
467
|
|
|
468 ;;;; common (and suppport) functions
|
|
|
469
|
|
|
470 (defun gnats::isme (addr)
|
|
|
471 (setq addr (mail-strip-quoted-names addr))
|
|
|
472 (or (string= addr (user-login-name))
|
|
|
473 (string= addr (concat (user-login-name) "@" (system-name)))))
|
|
|
474
|
|
|
475 (defsubst gnats::mail-PR-changed-setup (to subject cc buffer)
|
|
|
476 (funcall (nth 3 (assoc gnats-mailer gnats::mail-functions))
|
|
|
477 to subject cc buffer))
|
|
|
478
|
|
|
479 (defun gnats::mail-PR-changed-mail-setup (to subject cc buffer)
|
|
|
480 (or (gnats::vmish-mail
|
|
|
481 (format "notification of changes to PR %s" gnats:::buffer-pr)
|
|
|
482 nil to subject nil cc buffer)
|
|
|
483 (error "Submit aborted; PR is still locked.")))
|
|
|
484
|
|
|
485 (defun gnats::mail-PR-changed-mhe-setup (to subject cc buffer)
|
|
|
486 (let ((config (current-window-configuration))
|
|
|
487 (pop-up-windows t)
|
|
|
488 draft)
|
|
|
489 (mh-find-path)
|
|
|
490 (let ((pop-up-windows t))
|
|
|
491 (mh-send-sub to (or cc "") subject config))
|
|
|
492 (switch-to-buffer (current-buffer))
|
|
|
493 (setq mh-sent-from-folder buffer
|
|
|
494 mh-sent-from-msg 1
|
|
|
495 mh-show-buffer buffer)))
|
|
|
496
|
|
|
497 (defun gnats::mail-PR-changed (user responsible resp-change state-change notify)
|
|
|
498 "- Send mail to the responsible person if the PR has been changed
|
|
|
499 by someone else
|
|
|
500 - Send mail to the originator when the state is changed.
|
|
|
501 - Send mail to old and new responsible people when the responsibility is
|
|
|
502 transferred.
|
|
|
503 `resp-change' is the list (old-resp new-resp start end)
|
|
|
504 - Send mail to any other parties in NOTIFY."
|
|
|
505 ;; This function is really ugly !
|
|
|
506 ;;
|
|
|
507 (let ((to nil)
|
|
|
508 (cc nil)
|
|
|
509 (subn nil) (subm nil)
|
|
|
510 (subject (gnats::get-reply-subject))
|
|
|
511 (buffer (current-buffer))
|
|
|
512 (pr-change (not (or resp-change state-change)))
|
|
|
513 (pr-backupname gnats:::backupname)
|
|
|
514 )
|
|
|
515 ;; Here we find out where to send the mail to
|
|
|
516 (let (to-resp to-new-resp to-submitter to-bugs resp-addr new-resp-addr)
|
|
|
517 (if pr-change (setq to-resp t to-bugs t)
|
|
|
518 (if resp-change (setq to-resp t to-new-resp t))
|
|
|
519 (if state-change (setq to-submitter t to-resp t)))
|
|
|
520 (cond (to-new-resp
|
|
|
521 (setq new-resp-addr (gnats::pr-addr (car resp-change)))
|
|
|
522 (if (gnats::isme new-resp-addr)
|
|
|
523 (setq to-new-resp nil))))
|
|
|
524 (cond (to-resp
|
|
|
525 (setq resp-addr (gnats::pr-addr responsible))
|
|
|
526 (if (gnats::isme resp-addr)
|
|
|
527 (setq to-resp nil))))
|
|
|
528 (cond (to-submitter
|
|
|
529 (setq cc to)
|
|
|
530 (setq to (list (gnats::get-reply-to)))))
|
|
|
531 (if to-resp (gnats::push resp-addr to))
|
|
|
532 (if to-new-resp (gnats::push new-resp-addr to))
|
|
|
533 (setq subm (or (gnats::field-contents "Customer-Id")
|
|
|
534 (gnats::field-contents "Submitter-Id")))
|
|
|
535 (if subm
|
|
|
536 (progn
|
|
|
537 (setq subn (nth 5 (assoc subm gnats::submitters)))
|
|
|
538 (if (not (string= subn ""))
|
|
|
539 (gnats::push subn cc))))
|
|
|
540 (if to-bugs (gnats::push gnats:addr cc))
|
|
|
541 (if notify (gnats::push notify cc))
|
|
|
542 (setq to (mapconcat 'identity to ", ")
|
|
|
543 cc (mapconcat 'identity cc ", "))
|
|
|
544 (if (string= cc "") (setq cc nil)))
|
|
|
545 (gnats::mail-PR-changed-setup to subject cc buffer)
|
|
|
546 ;; now we assume that the current buffer is the mail buffer
|
|
|
547 (goto-char (point-max))
|
|
|
548 (if pr-change
|
|
|
549 (progn
|
|
|
550 (insert
|
|
|
551 (format "\n\t`%s' made changes to this PR.\n\n" (user-full-name)))
|
|
|
552 (if (and pr-backupname (file-readable-p pr-backupname))
|
|
|
553 (let ((file (gnats::make-temp-name))
|
|
|
554 (default-directory (gnats::find-safe-default-directory)))
|
|
|
555 (save-excursion
|
|
|
556 (set-buffer buffer)
|
|
|
557 (write-region (point-min) (point-max) file))
|
|
|
558 (call-process "diff" nil t t gnats::diffopt
|
|
|
559 pr-backupname file)
|
|
|
560 (delete-file file))))
|
|
|
561 (if resp-change
|
|
|
562 (progn
|
|
|
563 (insert (format "\n\t`%s' changed the responsibility to `%s'.\n"
|
|
|
564 (user-full-name) responsible))
|
|
|
565 (insert-buffer-substring buffer
|
|
|
566 (nth 2 resp-change)
|
|
|
567 (nth 3 resp-change)))
|
|
|
568 (if state-change
|
|
|
569 (progn
|
|
|
570 (insert (format "\n\t`%s' changed the state to `%s'.\n"
|
|
|
571 (user-full-name) (nth 1 state-change)))
|
|
|
572 (insert-buffer-substring buffer
|
|
|
573 (nth 2 state-change)
|
|
|
574 (nth 3 state-change))))))
|
|
|
575 ))
|
|
|
576
|
|
|
577 (defsubst gnats::bm (num)
|
|
|
578 (buffer-substring (match-beginning num) (match-end num)))
|
|
|
579
|
|
|
580 (defun gnats::real-pr-addr (name)
|
|
|
581 (if (zerop (length name))
|
|
|
582 nil
|
|
|
583 (let ((buf (generate-new-buffer gnats::err-buffer)))
|
|
|
584 (unwind-protect
|
|
|
585 (save-excursion
|
|
|
586 (let ((default-directory (gnats::find-safe-default-directory)))
|
|
|
587 (call-process (format "%s/gnats/pr-addr" gnats:libdir)
|
|
|
588 nil buf nil "-F" name))
|
|
|
589 (set-buffer buf)
|
|
|
590 (goto-char (point-min))
|
|
|
591 (cond ((looking-at "pr-addr: could not find the requested address")
|
|
|
592 nil)
|
|
|
593 ((looking-at "^\\([^:]*\\):\\([^:]*\\):\\([^:]*\\)\n")
|
|
|
594 (list (gnats::bm 1) (gnats::bm 2) (gnats::bm 3)))
|
|
|
595 (t (signal 'gnats::error
|
|
|
596 (list (buffer-substring (point-min)
|
|
|
597 (1- (point-max))))))))
|
|
|
598 (kill-buffer buf)))))
|
|
|
599
|
|
|
600 (defun gnats::pr-addr (name)
|
|
|
601 "Find the e-mail address corresponding to maintainer NAME."
|
|
|
602 (let (entry addr)
|
|
|
603 (or (setq entry (assoc name gnats::responsibles))
|
|
|
604 (and (setq entry (gnats::real-pr-addr name))
|
|
|
605 (gnats::push entry gnats::responsibles))
|
|
|
606 (signal 'gnats::invalid-name (list name)))
|
|
|
607 (setq addr (if (zerop (length (nth 2 entry)))
|
|
|
608 name
|
|
|
609 (nth 2 entry)))
|
|
|
610 (if (zerop (length (nth 1 entry)))
|
|
|
611 addr
|
|
|
612 (concat (nth 1 entry) " <" addr ">"))))
|
|
|
613
|
|
|
614 (defun gnats::get-header-using-mail-fetch-field (field)
|
|
|
615 (save-excursion
|
|
|
616 (save-restriction
|
|
|
617 (goto-char (point-min))
|
|
|
618 (re-search-forward "^$" nil 'move)
|
|
|
619 (narrow-to-region (point-min) (point))
|
|
|
620 (mail-fetch-field field))))
|
|
|
621
|
|
|
622 (defun gnats::get-header-using-mhe (field)
|
|
|
623 (save-excursion
|
|
|
624 (let ((ret (mh-get-field (concat field ":"))))
|
|
|
625 (if (string= ret "")
|
|
|
626 nil
|
|
|
627 ret))))
|
|
|
628
|
|
|
629 (defun gnats::get-reply-to ()
|
|
|
630 (or (gnats::get-header "Reply-To")
|
|
|
631 (gnats::get-header "From")))
|
|
|
632
|
|
|
633 (defun gnats::get-reply-subject ()
|
|
|
634 (save-excursion
|
|
|
635 (save-restriction
|
|
|
636 (widen)
|
|
|
637 (let ((category (gnats::field-contents "Category"))
|
|
|
638 (number (gnats::field-contents "Number"))
|
|
|
639 (synopsis (gnats::field-contents "Synopsis" 0))
|
|
|
640 (subject))
|
|
|
641 (goto-char (point-min))
|
|
|
642 (narrow-to-region (point-min)
|
|
|
643 (progn (search-forward "\n\n" nil 'move)
|
|
|
644 (point-marker)))
|
|
|
645 (setq subject (mail-fetch-field "subject"))
|
|
|
646 (if (and synopsis (not (equal synopsis "")))
|
|
|
647 (format "Re: %s/%s: %s" category number synopsis)
|
|
|
648 (format "Re: %s/%s: %s" category number subject))))))
|
|
|
649
|
|
|
650 (defun gnats::make-in-reply-to-field (from date msg-id)
|
|
|
651 (concat
|
|
|
652 (substring from 0 (string-match " *at \\| *@ \\| *(\\| *<" from))
|
|
|
653 "'s message of " date
|
|
|
654 (if (not (equal msg-id ""))
|
|
|
655 (concat "\n " msg-id)
|
|
|
656 "")))
|
|
|
657
|
|
|
658 ;;;; Send mail using sendmail mail mode.
|
|
|
659
|
|
|
660 (defun gnats::mail-reply-using-mail (just-sender)
|
|
|
661 ;;
|
|
|
662 "Mail a reply to the originator of the PR.
|
|
|
663 Normally include CC: to all other recipients of original message;
|
|
|
664 argument means ignore them.
|
|
|
665 While composing the reply, use \\[mail-yank-original] to yank the
|
|
|
666 original message into it."
|
|
|
667 ;;
|
|
|
668 (let (from cc subject date to reply-to msg-id)
|
|
|
669 (save-excursion
|
|
|
670 (save-restriction
|
|
|
671 (widen)
|
|
|
672 (narrow-to-region (point-min) (progn (goto-char (point-min))
|
|
|
673 (search-forward "\n\n")
|
|
|
674 (- (point) 1)))
|
|
|
675 (setq from (mail-fetch-field "from" nil t)
|
|
|
676 subject (gnats::get-reply-subject)
|
|
|
677 reply-to (or (mail-fetch-field "reply-to" nil t)
|
|
|
678 from)
|
|
|
679 date (mail-fetch-field "date" nil t)
|
|
|
680 cc (cond (just-sender nil)
|
|
|
681 (t (mail-fetch-field "cc" nil t)))
|
|
|
682 to (or (mail-fetch-field "to" nil t)
|
|
|
683 (mail-fetch-field "apparently-to" nil t)
|
|
|
684 "")
|
|
|
685 msg-id (mail-fetch-field "message-id")
|
|
|
686 )))
|
|
|
687 (gnats::vmish-mail-other-window
|
|
|
688 (format "reply to PR %s" gnats:::buffer-pr)
|
|
|
689 nil (mail-strip-quoted-names reply-to) subject
|
|
|
690 (gnats::make-in-reply-to-field from date msg-id)
|
|
|
691 (if just-sender
|
|
|
692 nil
|
|
|
693 (let* ((cc-list (rmail-dont-reply-to (mail-strip-quoted-names
|
|
|
694 (if (null cc) to
|
|
|
695 (concat to ", " cc))))))
|
|
|
696 (if (string= cc-list "") nil cc-list)))
|
|
|
697 (current-buffer))))
|
|
|
698
|
|
|
699 (defun gnats::mail-other-window-using-mail ()
|
|
|
700 "Send mail in another window.
|
|
|
701 While composing the message, use \\[mail-yank-original] to yank the
|
|
|
702 original message into it."
|
|
|
703 (gnats::vmish-mail-other-window
|
|
|
704 (format "mail regarding PR %s" gnats:::buffer-pr)
|
|
|
705 nil nil (gnats::get-reply-subject) nil nil (current-buffer)))
|
|
|
706
|
|
|
707 ;; This must be done in two toplevel forms because of a 19.19 byte-compiler
|
|
|
708 ;; bug.
|
|
|
709 (defun gnats::generate-new-buffer-name (prefix)
|
|
|
710 (let ((name prefix) (n 1))
|
|
|
711 (while (get-buffer name)
|
|
|
712 (setq name (format "%s<%d>" prefix n))
|
|
|
713 (setq n (1+ n)))
|
|
|
714 name))
|
|
|
715
|
|
|
716 (if (fboundp 'generate-new-buffer-name)
|
|
|
717 (fset 'gnats::generate-new-buffer-name 'generate-new-buffer-name))
|
|
|
718
|
|
|
719 (defvar gnats::kept-mail-buffers nil
|
|
|
720 "Sent mail buffers waiting to be killed.")
|
|
|
721
|
|
|
722 (defun gnats::vmish-rename-after-send ()
|
|
|
723 (or (string-match "^sent " (buffer-name))
|
|
|
724 (rename-buffer (gnats::generate-new-buffer-name
|
|
|
725 (format "sent %s" (buffer-name)))))
|
|
|
726
|
|
|
727 ;; Mostly lifted from vm-reply.el 5.35
|
|
|
728 (setq gnats::kept-mail-buffers
|
|
|
729 (cons (current-buffer) gnats::kept-mail-buffers))
|
|
|
730 (if (not (eq gnats:keep-sent-messages t))
|
|
|
731 (let ((extras (nthcdr (or gnats:keep-sent-messages 0)
|
|
|
732 gnats::kept-mail-buffers)))
|
|
|
733 (mapcar (function (lambda (b) (and (buffer-name b) (kill-buffer b))))
|
|
|
734 extras)
|
|
|
735 (and gnats::kept-mail-buffers extras
|
|
|
736 (setcdr (memq (car extras) gnats::kept-mail-buffers) nil)))))
|
|
|
737
|
|
|
738 (if gnats::emacs-19p
|
|
|
739 (defun gnats::vmish-mail-bindings ())
|
|
|
740 (defun gnats::vmish-mail-send ()
|
|
|
741 (interactive)
|
|
|
742 (gnats::vmish-rename-after-send)
|
|
|
743 (mail-send))
|
|
|
744 (defun gnats::vmish-mail-send-and-exit (arg)
|
|
|
745 (interactive "P")
|
|
|
746 (gnats::vmish-rename-after-send)
|
|
|
747 (mail-send-and-exit arg))
|
|
|
748 (defun gnats::vmish-mail-bindings ()
|
|
|
749 (use-local-map (copy-keymap (current-local-map)))
|
|
|
750 (local-set-key "\C-c\C-s" 'gnats::vmish-mail-send)
|
|
|
751 (local-set-key "\C-c\C-c" 'gnats::vmish-mail-send-and-exit))
|
|
|
752 (defun string-to-number (str) (string-to-int str)))
|
|
|
753
|
|
|
754 ;; ignore 'free variable' warnings about buf.
|
|
|
755 (defsubst gnats::vmish-rename-mail-buffer (buf)
|
|
|
756 (save-excursion
|
|
|
757 (set-buffer buf)
|
|
|
758 (setq buf (gnats::generate-new-buffer-name "*not mail*"))
|
|
|
759 (rename-buffer buf)))
|
|
|
760
|
|
|
761 ;; ignore 'free variable' warnings about buf.
|
|
|
762 (defsubst gnats::vmish-restore-mail-buffer (buf)
|
|
|
763 (save-excursion
|
|
|
764 (let ((mbuf (get-buffer "*mail*")))
|
|
|
765 (cond (mbuf ;maybe left over from m-o-w failure
|
|
|
766 (set-buffer mbuf)
|
|
|
767 (set-buffer-modified-p nil)
|
|
|
768 (kill-buffer mbuf))))
|
|
|
769 (cond (buf
|
|
|
770 (set-buffer buf)
|
|
|
771 (rename-buffer "*mail*")))))
|
|
|
772
|
|
|
773 (defun gnats::vmish-mail-other-window
|
|
|
774 (&optional buffer-name noerase to subject in-reply-to cc replybuffer actions)
|
|
|
775 (let ((buf (get-buffer "*mail*")))
|
|
|
776 (if buf (gnats::vmish-rename-mail-buffer buf))
|
|
|
777 (or buffer-name (setq buffer-name "GNATS mail"))
|
|
|
778 (unwind-protect
|
|
|
779 (prog1
|
|
|
780 (if gnats::emacs-19p
|
|
|
781 (mail-other-window
|
|
|
782 noerase to subject in-reply-to cc replybuffer
|
|
|
783 (cons '(gnats::vmish-rename-after-send) actions))
|
|
|
784 (prog1
|
|
|
785 (mail-other-window noerase to subject in-reply-to
|
|
|
786 cc replybuffer)
|
|
|
787 (gnats::vmish-mail-bindings)))
|
|
|
788 (rename-buffer (gnats::generate-new-buffer-name buffer-name)))
|
|
|
789 (gnats::vmish-restore-mail-buffer buf))))
|
|
|
790
|
|
|
791 (defun gnats::vmish-mail
|
|
|
792 (&optional buffer-name noerase to subject in-reply-to cc replybuffer actions)
|
|
|
793 (let (buf (get-buffer "*mail*"))
|
|
|
794 (if buf (gnats::vmish-rename-mail-buffer buf))
|
|
|
795 (or buffer-name (setq buffer-name "GNATS mail"))
|
|
|
796 (unwind-protect
|
|
|
797 (prog1
|
|
|
798 (if gnats::emacs-19p
|
|
|
799 (mail noerase to subject in-reply-to cc replybuffer
|
|
|
800 (cons '(gnats::vmish-rename-after-send) actions))
|
|
|
801 (prog1
|
|
|
802 (mail noerase to subject in-reply-to cc replybuffer)
|
|
|
803 (gnats::vmish-mail-bindings)))
|
|
|
804 (rename-buffer (gnats::generate-new-buffer-name buffer-name)))
|
|
|
805 (gnats::vmish-restore-mail-buffer buf))))
|
|
|
806
|
|
|
807 ;;;; Send mail using mh-e.
|
|
|
808
|
|
|
809 (defun gnats::mail-other-window-using-mhe ()
|
|
|
810 "Compose mail other window using mh-e.
|
|
|
811 While composing the message, use \\[mh-yank-cur-msg] to yank the
|
|
|
812 original message into it."
|
|
|
813 (let ((subject (gnats::get-reply-subject)))
|
|
|
814 (setq mh-show-buffer (current-buffer))
|
|
|
815 (mh-find-path)
|
|
|
816 (mh-send-other-window "" "" subject)
|
|
|
817 (setq mh-sent-from-folder (current-buffer))
|
|
|
818 (setq mh-sent-from-msg 1)))
|
|
|
819
|
|
|
820
|
|
|
821 (defun gnats::mail-reply-using-mhe (just-sender)
|
|
|
822 "Compose reply mail using mh-e.
|
|
|
823 The command \\[mh-yank-cur-msg] yanks the original message into current buffer.
|
|
|
824 If optional argument JUST-SENDER is non-nil, send response only to
|
|
|
825 original submitter of problem report."
|
|
|
826 ;; First of all, prepare mhe mail buffer.
|
|
|
827 (let (from cc subject date to reply-to (buffer (current-buffer)) msg-id)
|
|
|
828 (save-restriction
|
|
|
829 (setq from (mh-get-field "From:")
|
|
|
830 subject (gnats::get-reply-subject)
|
|
|
831 reply-to (or (mh-get-field "Reply-To:") from)
|
|
|
832 to (or (mh-get-field "To:")
|
|
|
833 (mh-get-field "Apparently-To:")
|
|
|
834 "")
|
|
|
835 cc (mh-get-field "Cc:")
|
|
|
836 date (mh-get-field "Date:")
|
|
|
837 msg-id (mh-get-field "Message-Id:")
|
|
|
838 )
|
|
|
839 (setq mh-show-buffer buffer)
|
|
|
840 (mh-find-path)
|
|
|
841 (mh-send reply-to (or (and just-sender "")
|
|
|
842 (if (null cc) to
|
|
|
843 (concat to ", " cc)))
|
|
|
844 subject)
|
|
|
845 (save-excursion
|
|
|
846 (mh-insert-fields
|
|
|
847 "In-Reply-To:" (gnats::make-in-reply-to-field from date msg-id)))
|
|
|
848 (setq mh-sent-from-folder buffer)
|
|
|
849 (setq mh-sent-from-msg 1)
|
|
|
850 )))
|
|
|
851
|
|
|
852
|
|
|
853 ;;;;---------------------------------------------------------------------------
|
|
|
854 ;;;; Functions to change specific fields
|
|
|
855 ;;;;---------------------------------------------------------------------------
|
|
|
856
|
|
|
857 (defun gnats:state-change-from-to ()
|
|
|
858 "Change the value of the `>State:' field and update the audit trail."
|
|
|
859 (interactive)
|
|
|
860 (gnats:change-field "State"))
|
|
|
861
|
|
|
862 (defun gnats:responsible-change-from-to ()
|
|
|
863 "Change the value of the `>Responsible:' field and update the audit trail."
|
|
|
864 (interactive)
|
|
|
865 (gnats:change-field "Responsible"))
|
|
|
866
|
|
|
867 (defun gnats:category-change-from-to ()
|
|
|
868 "Change the value of the `>Category:' field and the responsible party."
|
|
|
869 (interactive)
|
|
|
870 (gnats:change-field "Category"))
|
|
|
871
|
|
|
872 (defun gnats::update-audit-trail (field old new)
|
|
|
873 (if (gnats::position-on-field "Audit-Trail")
|
|
|
874 (let (start end)
|
|
|
875 (gnats::forward-eofield)
|
|
|
876 (setq start (point-marker))
|
|
|
877 (if (eq old t) (setq old "????"))
|
|
|
878 (if (string= field "Responsible")
|
|
|
879 (insert (format "\n\n%s-Changed-From-To: %s->%s" field
|
|
|
880 (gnats::nth-word old)
|
|
|
881 (gnats::nth-word new)))
|
|
|
882 (insert (format "\n\n%s-Changed-From-To: %s-%s" field
|
|
|
883 (gnats::nth-word old)
|
|
|
884 (gnats::nth-word new))))
|
|
|
885 (insert (format "\n%s-Changed-By: %s" field (user-login-name)))
|
|
|
886 (insert (format "\n%s-Changed-When: %s" field (current-time-string)))
|
|
|
887 (insert (format "\n%s-Changed-Why:\n" field))
|
|
|
888 (save-excursion
|
|
|
889 (gnats::before-keyword t)
|
|
|
890 (setq end (point-marker)))
|
|
|
891 ;; here we record the changes in a assoc list
|
|
|
892 (setq gnats:::audit-trail (cons (list field
|
|
|
893 (gnats::nth-word old)
|
|
|
894 (gnats::nth-word new)
|
|
|
895 start end)
|
|
|
896 gnats:::audit-trail)))
|
|
|
897 (error "Field `>Audit-Trail:' missing.")))
|
|
|
898
|
|
|
899 (defun gnats::category-responsible (category)
|
|
|
900 (let ((entry (assoc category gnats::categories)))
|
|
|
901 (if entry
|
|
|
902 (nth 2 entry)
|
|
|
903 (signal 'gnats::no-such-category (list category)))))
|
|
|
904
|
|
|
905 (defun gnats::update-responsible (ignore1 ignore2 new)
|
|
|
906 "Modify the responsible field of the current PR to match the new category."
|
|
|
907 (and (y-or-n-p "Update the >Responsible: field? ")
|
|
|
908 (gnats:change-field "Responsible" (gnats::category-responsible new))))
|
|
|
909
|
|
|
910 ;;;;---------------------------------------------------------------------------
|
|
|
911
|
|
|
912 (defsubst gnats::rw (buf retval)
|
|
|
913 (or
|
|
|
914 retval ; call-process is broken under 19.19.2
|
|
|
915 (save-excursion (set-buffer buf) (buffer-size))))
|
|
|
916
|
|
|
917 (defun gnats::handle-results (pr exit-status)
|
|
|
918 "Handle the results of running pr-edit or npr-edit, giving a signal
|
|
|
919 if needed."
|
|
|
920 (cond
|
|
|
921 ((looking-at "n?pr-edit: cannot create lock file")
|
|
|
922 (signal 'gnats::cannot-lock nil))
|
|
|
923 ((looking-at "n?pr-edit: lock file exists")
|
|
|
924 (signal 'gnats::locked nil))
|
|
|
925 ((or (looking-at "n?pr-edit: no such PR")
|
|
|
926 (looking-at "n?pr-edit: couldn.t find PR.*"))
|
|
|
927 (signal 'gnats::no-such-pr nil))
|
|
|
928 ((looking-at "n?pr-edit: PR \\(.*\\) locked by \\(.*\\)")
|
|
|
929 (let* ((msg (gnats::bm 2))
|
|
|
930 (pr-path
|
|
|
931 (buffer-substring-no-properties (match-beginning 1) (match-end 1)))
|
|
|
932 (pr-name (progn (if (string-match gnats:root pr-path)
|
|
|
933 (substring pr-path (1+ (match-end 0)))
|
|
|
934 pr-path)))
|
|
|
935 (buf (get-buffer pr-name))
|
|
|
936 win)
|
|
|
937 (if buf
|
|
|
938 ;; If we're already editing the PR, just go to that
|
|
|
939 ;; buffer and be done with it.
|
|
|
940 (progn
|
|
|
941 (if (setq win (get-buffer-window buf))
|
|
|
942 (select-window win)
|
|
|
943 (switch-to-buffer buf))
|
|
|
944 (message "Already editing PR %s." pr-name))
|
|
|
945 ;; kick it to the next level
|
|
|
946 (signal 'gnats::locked-pr (list msg)))))
|
|
|
947 ((looking-at "n?pr-edit: PR is not locked")
|
|
|
948 (if (not gnats:::force) (signal 'gnats::pr-not-locked nil)
|
|
|
949 t))
|
|
|
950 ((looking-at "n?pr-edit: invalid fields")
|
|
|
951 (signal 'gnats::invalid-fields nil))
|
|
|
952 ((looking-at "n?pr-edit: cannot parse the date")
|
|
|
953 (signal 'gnats::invalid-date nil))
|
|
|
954 ((looking-at "n?pr-edit: lock file .* does not exist"))
|
|
|
955 (t (signal 'gnats::error
|
|
|
956 (list (if (eq (point-min) (point-max))
|
|
|
957 (format "unknown error (exit status %d)"
|
|
|
958 exit-status)
|
|
|
959 (buffer-substring (point-min) (- (point-max) 1))))))))
|
|
|
960
|
|
|
961 (if gnats::emacs-19p
|
|
|
962 (require 'env))
|
|
|
963 (defun gnats::start-background (pr proctype sentinel &optional outfile filep args)
|
|
|
964 (let ((buf (get-buffer-create gnats::err-buffer))
|
|
|
965 inbuf proc-name proc-action proc-send-buffer)
|
|
|
966 (save-excursion
|
|
|
967 (setq inbuf (current-buffer))
|
|
|
968 (set-buffer buf)
|
|
|
969 (erase-buffer)
|
|
|
970 (make-variable-buffer-local 'gnats:::force)
|
|
|
971 (setq gnats:::force nil)
|
|
|
972 (cond ((eq proctype 'check)
|
|
|
973 (progn
|
|
|
974 (setq proc-name "check-pr"
|
|
|
975 proc-action "Checking"
|
|
|
976 proc-send-buffer t)
|
|
|
977 (setq args (append (list "--check") args))
|
|
|
978 (make-variable-buffer-local 'gnats:::pr-buffer)
|
|
|
979 (setq gnats:::pr-buffer inbuf)
|
|
|
980 (make-variable-buffer-local 'gnats:::do-file-pr)
|
|
|
981 (setq gnats:::do-file-pr filep)))
|
|
|
982 ((eq proctype 'file)
|
|
|
983 (setq proc-name "file-pr"
|
|
|
984 proc-action "Filing"
|
|
|
985 proc-send-buffer t))
|
|
|
986 ((eq proctype 'unlock)
|
|
|
987 (progn
|
|
|
988 (setq proc-name "unlock-pr"
|
|
|
989 proc-action "Unlocking")
|
|
|
990 (make-variable-buffer-local 'gnats:::current-pr)
|
|
|
991 (setq gnats:::current-pr pr)
|
|
|
992 (setq args (append (list "--unlock" pr) args))))
|
|
|
993 ((eq proctype 'unlock-force)
|
|
|
994 (progn
|
|
|
995 (setq proc-name "unlock-pr"
|
|
|
996 proc-action "Unlocking"
|
|
|
997 gnats:::force t)
|
|
|
998 (make-variable-buffer-local 'gnats:::current-pr)
|
|
|
999 (setq gnats:::current-pr pr)
|
|
|
1000 (setq args (append (list "--unlock" pr) args))))
|
|
|
1001 ((eq proctype 'edit)
|
|
|
1002 (progn
|
|
|
1003 (setq proc-name "edit-pr"
|
|
|
1004 proc-action "Fetching")
|
|
|
1005 (make-variable-buffer-local 'gnats:::current-pr)
|
|
|
1006 (setq gnats:::current-pr pr)
|
|
|
1007 (make-variable-buffer-local 'gnats:::newfile)
|
|
|
1008 (setq gnats:::newfile outfile)))
|
|
|
1009 (t
|
|
|
1010 (error "Invalid PROCTYPE for background GNATS process.")))
|
|
|
1011 (let ((process-environment
|
|
|
1012 (if gnats::emacs-19p (copy-sequence process-environment)))
|
|
|
1013 proc)
|
|
|
1014 (setq proc
|
|
|
1015 (apply 'start-process
|
|
|
1016 (concat " *" proc-name "-" (random t))
|
|
|
1017 buf
|
|
|
1018 (format (if gnats:network-server
|
|
|
1019 "%s/gnats/npr-edit"
|
|
|
1020 "%s/gnats/pr-edit")
|
|
|
1021 gnats:libdir)
|
|
179
|
1022 (if gnats:network-server
|
|
|
1023 (concat (format "--host=%s" gnats:network-server) args)
|
|
|
1024 args
|
|
|
1025 )
|
|
110
|
1026 ))
|
|
|
1027
|
|
|
1028 ;; Only set up the sentinel if they want stuff done in the background.
|
|
|
1029 (if gnats:run-in-background
|
|
|
1030 (progn
|
|
|
1031 (set-process-sentinel proc sentinel)
|
|
|
1032 (message "%s PR %s in background." proc-action pr))
|
|
|
1033 (message "%s PR %s..." proc-action pr))
|
|
|
1034 (if proc-send-buffer
|
|
|
1035 (progn
|
|
|
1036 (set-buffer inbuf)
|
|
|
1037 (goto-char (point-min))
|
|
|
1038 (process-send-region proc (point-min) (point-max))
|
|
|
1039 (if (and (/= (point-min) (point-max))
|
|
|
1040 (/= (char-after (- (point-max) 1)) ?\n))
|
|
|
1041 (process-send-string proc "\n"))
|
|
|
1042 (process-send-eof proc)))
|
|
|
1043 ;; if they don't want it in the background, just sit and twiddle...
|
|
|
1044 (if (not gnats:run-in-background)
|
|
|
1045 (save-excursion
|
|
|
1046 (set-buffer (process-buffer proc))
|
|
|
1047 (while (memq (process-status proc) '(run open))
|
|
|
1048 (accept-process-output proc))
|
|
|
1049 (funcall sentinel proc nil)))))))
|
|
|
1050
|
|
|
1051 (defun gnats::handle-pr-edit (process event)
|
|
|
1052 (let ((buf (process-buffer process))
|
|
|
1053 result pr newfile nbuf)
|
|
|
1054 (if (null (buffer-name buf)) ;; deleted buffer
|
|
|
1055 (set-process-buffer process nil)
|
|
|
1056 (save-excursion
|
|
|
1057 (set-buffer buf)
|
|
|
1058 (setq pr gnats:::current-pr)
|
|
|
1059 (setq result (process-exit-status process))
|
|
|
1060 (and (/= 0 result)
|
|
|
1061 (goto-char (point-min))
|
|
|
1062 (gnats::handle-results gnats:::current-pr result))
|
|
|
1063 (setq nbuf (generate-new-buffer
|
|
|
1064 (concat "*edit-pr " gnats:::current-pr "*")))
|
|
|
1065 (setq newfile gnats:::newfile)
|
|
|
1066 (set-buffer nbuf)
|
|
|
1067 (insert-file-contents newfile)
|
|
|
1068 (make-local-variable 'gnats:::backupname)
|
|
|
1069 (put 'gnats:::backupname 'permanent-local t)
|
|
|
1070 ;; we do this in gnats:gnats-mode for non-network
|
|
|
1071 (if gnats:network-server (setq gnats:::backupname newfile))
|
|
|
1072 (set-buffer-modified-p nil)
|
|
|
1073 (setq buffer-undo-list nil) ;flush undo list
|
|
|
1074 (gnats:gnats-mode)
|
|
|
1075 (make-variable-buffer-local 'gnats:::current-pr)
|
|
|
1076 (setq gnats:::current-pr pr)
|
|
|
1077 (goto-char gnats:::start-of-PR-fields))
|
|
|
1078 (message "Fetching PR %s done." pr)
|
|
|
1079 (if gnats:run-in-background
|
|
|
1080 (display-buffer nbuf 'not-this-window)
|
|
|
1081 (switch-to-buffer nbuf)))))
|
|
|
1082
|
|
|
1083 (defun gnats::pr-edit-background (pr outfile args)
|
|
|
1084 (gnats::start-background pr 'edit 'gnats::handle-pr-edit outfile nil args))
|
|
|
1085
|
|
|
1086 (defun gnats::handle-check-pr (process event)
|
|
|
1087 (let ((buf (process-buffer process))
|
|
|
1088 result pr)
|
|
|
1089 (if (null (buffer-name buf)) ;; deleted buffer
|
|
|
1090 (set-process-buffer process nil)
|
|
|
1091 (save-excursion
|
|
|
1092 (set-buffer buf)
|
|
|
1093 (setq result (process-exit-status process))
|
|
|
1094 (and (/= 0 result)
|
|
|
1095 (goto-char (point-min))
|
|
|
1096 (gnats::handle-results gnats:::current-pr result))
|
|
|
1097 (message "Checked PR %s." gnats:::current-pr)
|
|
|
1098 (if gnats:::do-file-pr
|
|
|
1099 (progn
|
|
|
1100 (set-buffer gnats:::pr-buffer)
|
|
|
1101 (gnats::file-pr-background)))))))
|
|
|
1102
|
|
|
1103 (defun gnats::check-pr-background (&optional filep)
|
|
|
1104 (gnats::start-background gnats:::current-pr 'check
|
|
|
1105 'gnats::handle-check-pr nil filep))
|
|
|
1106
|
|
|
1107 (defun gnats::finish-filing ()
|
|
|
1108 (let (responsible user resp-change state-change buf)
|
|
|
1109 (if gnats:network-server (setq gnats:::pr-locked nil))
|
|
|
1110 (setq buf (current-buffer))
|
|
|
1111 (set-buffer-modified-p nil)
|
|
|
1112 (setq responsible (gnats::field-contents "Responsible")
|
|
|
1113 user (user-login-name)
|
|
|
1114 resp-change (cdr (assoc "Responsible" gnats:::audit-trail))
|
|
|
1115 state-change (cdr (assoc "State" gnats:::audit-trail)))
|
|
|
1116 (if (or state-change
|
|
|
1117 resp-change
|
|
|
1118 (not (equal user responsible)))
|
|
|
1119 (gnats::mail-PR-changed user responsible
|
|
|
1120 resp-change state-change
|
|
|
1121 (gnats::get-header "X-GNATS-Notify")))
|
|
|
1122 (gnats:unlock-buffer buf)))
|
|
|
1123
|
|
|
1124 (defun gnats::handle-file-pr (process event)
|
|
|
1125 (let ((buf (process-buffer process))
|
|
|
1126 result pr prbuf)
|
|
|
1127 (if (null (buffer-name buf)) ;; deleted buffer
|
|
|
1128 (set-process-buffer process nil)
|
|
|
1129 (save-excursion
|
|
|
1130 (set-buffer buf)
|
|
|
1131 (setq result (process-exit-status process))
|
|
|
1132 (and (/= 0 result)
|
|
|
1133 (goto-char (point-min))
|
|
|
1134 (gnats::handle-results gnats:::current-pr result))
|
|
|
1135 (message "Filed PR %s." gnats:::current-pr)
|
|
|
1136 (set-buffer gnats:::pr-buffer)
|
|
|
1137 (gnats::finish-filing)))))
|
|
|
1138
|
|
|
1139 (defun gnats::file-pr-background ()
|
|
|
1140 (gnats::start-background gnats:::current-pr 'file 'gnats::handle-file-pr))
|
|
|
1141
|
|
|
1142 (defun gnats::lock (pr &optional outfile)
|
|
|
1143 (let ((lockl (list "--lock"
|
|
|
1144 (format "%s@%s" (user-login-name) (system-name))
|
|
|
1145 "-p"
|
|
|
1146 (if (fboundp 'emacs-pid)
|
|
|
1147 (concat "emacs pid " (int-to-string (emacs-pid)))
|
|
|
1148 "emacs18")
|
|
|
1149 pr)))
|
|
|
1150 (if gnats:network-server
|
|
|
1151 (setq lockl (append lockl (list "-o" outfile "--get-lists"
|
|
|
1152 "--host" gnats:network-server))))
|
|
|
1153 (gnats::pr-edit-background pr outfile lockl)))
|
|
|
1154
|
|
|
1155 (fset 'unlock-pr 'gnats:unlock-pr)
|
|
|
1156 (fset 'gnats-unlock 'gnats:unlock-pr) ;backward compatibility
|
|
|
1157 (defun gnats::handle-unlock-pr (process event)
|
|
|
1158 (let ((buf (process-buffer process))
|
|
|
1159 result pr newfile nbuf)
|
|
|
1160 (if (null (buffer-name buf)) ;; deleted buffer
|
|
|
1161 (set-process-buffer process nil)
|
|
|
1162 (save-excursion
|
|
|
1163 (set-buffer buf)
|
|
|
1164 (setq pr gnats:::current-pr)
|
|
|
1165 (setq result (process-exit-status process))
|
|
|
1166 (and (/= 0 result)
|
|
|
1167 (goto-char (point-min))
|
|
|
1168 (gnats::handle-results gnats:::current-pr result))
|
|
|
1169 (message "PR %s unlocked." gnats:::current-pr)))))
|
|
|
1170
|
|
|
1171 (defun gnats:unlock-pr-force (pr)
|
|
|
1172 (gnats::start-background pr 'unlock-force 'gnats::handle-unlock-pr))
|
|
|
1173
|
|
|
1174 (defun gnats:unlock-pr (pr)
|
|
|
1175 (interactive "sPR number: ")
|
|
|
1176 (gnats::start-background pr 'unlock 'gnats::handle-unlock-pr))
|
|
|
1177
|
|
|
1178 (defsubst gnats::buffer-major-mode (buffer)
|
|
|
1179 (save-excursion (set-buffer buffer) major-mode))
|
|
|
1180
|
|
|
1181 (defun gnats::unlock-all-buffers ()
|
|
|
1182 (save-excursion
|
|
|
1183 (mapcar
|
|
|
1184 (function
|
|
|
1185 (lambda (buffer)
|
|
|
1186 (let ((gnats:run-in-background nil))
|
|
|
1187 (if (and (eq (gnats::buffer-major-mode buffer) gnats::mode-name))
|
|
|
1188 (progn (set-buffer buffer)
|
|
|
1189 (gnats:unlock-buffer-force buffer))))))
|
|
|
1190 (buffer-list))))
|
|
|
1191
|
|
|
1192 (if gnats::emacs-19p
|
|
|
1193 ;; Emacs 19 has kill-buffer-hook, v18 doesn't.
|
|
|
1194 (defun gnats::kill-buffer-hook ()
|
|
|
1195 "Unlock a GNATS buffer that is being killed."
|
|
|
1196 (gnats:unlock-buffer nil))
|
|
|
1197 (defun gnats:kill-buffer (buf)
|
|
|
1198 "Safely kill a GNATS buffer."
|
|
|
1199 (interactive "bKill buffer: ")
|
|
|
1200 (if (equal buf (buffer-name))
|
|
|
1201 (gnats:unlock-buffer (get-buffer buf)))
|
|
|
1202 (kill-buffer buf)))
|
|
|
1203
|
|
|
1204 (defun gnats:unlock-buffer-force (&optional buf)
|
|
|
1205 "Force a buffer to be unlocked, even if it isn't."
|
|
|
1206 (interactive)
|
|
|
1207 (if (null buf)
|
|
|
1208 (setq buf (current-buffer))
|
|
|
1209 (set-buffer buf))
|
|
|
1210 (gnats:unlock-buffer buf t))
|
|
|
1211
|
|
|
1212 (defun gnats::delete-file (filename)
|
|
|
1213 (if (file-readable-p filename) (delete-file filename)))
|
|
|
1214
|
|
|
1215 (defun gnats:unlock-buffer (&optional buf force)
|
|
|
1216 "Safely take a GNATS buffer out of gnats-mode."
|
|
|
1217 (interactive)
|
|
|
1218 (save-excursion
|
|
|
1219 (if (null buf)
|
|
|
1220 (setq buf (current-buffer))
|
|
|
1221 (set-buffer buf))
|
|
|
1222 (cond ((or force
|
|
|
1223 (not (buffer-modified-p buf))
|
|
|
1224 (not gnats:::pr-locked)
|
|
|
1225 (y-or-n-p "Buffer modified; still unlock? "))
|
|
|
1226 (if gnats:::pr-locked
|
|
|
1227 (gnats:unlock-pr-force gnats:::buffer-pr))
|
|
|
1228 (if gnats:::pr-errors
|
|
|
1229 (kill-buffer gnats:::pr-errors))
|
|
|
1230 (if gnats:::backupname
|
|
|
1231 (progn
|
|
|
1232 (gnats::delete-file gnats:::backupname)
|
|
|
1233 (if gnats:network-server
|
|
|
1234 (progn
|
|
|
1235 (gnats::delete-file (concat gnats:::backupname ".cat"))
|
|
|
1236 (gnats::delete-file (concat gnats:::backupname ".res"))
|
|
|
1237 (gnats::delete-file (concat gnats:::backupname ".sub"))))))
|
|
|
1238 (save-excursion
|
|
|
1239 (set-buffer buf)
|
|
|
1240 (let ((pr gnats:::buffer-pr))
|
|
|
1241 (kill-all-local-variables)
|
|
|
1242 (text-mode)
|
|
|
1243 (make-local-variable 'gnats:::buffer-pr)
|
|
|
1244 (setq gnats:::buffer-pr pr)
|
|
|
1245 (use-local-map (copy-keymap (current-local-map)))
|
|
|
1246 (local-set-key
|
|
|
1247 "e" (function (lambda () (interactive)
|
|
|
1248 (gnats:edit-pr gnats:::buffer-pr))))
|
|
|
1249 (set-visited-file-name nil)
|
|
|
1250 (setq buffer-read-only t)
|
|
|
1251 ;; When GNATS:KEEP-EDITED-BUFFERS is nil, we always put the
|
|
|
1252 ;; most recent PR in the *edited-pr* buffer.
|
|
|
1253 (or gnats:keep-edited-buffers
|
|
|
1254 (let ((old-buf (get-buffer (concat "*edited-pr*"))))
|
|
|
1255 (cond (old-buf
|
|
|
1256 (set-buffer old-buf)
|
|
|
1257 (set-buffer-modified-p nil)
|
|
|
1258 (kill-buffer old-buf)))
|
|
|
1259 (set-buffer buf)
|
|
|
1260 (rename-buffer (concat "*edited-pr*"))))))
|
|
|
1261 (and gnats:bury-edited-prs
|
|
|
1262 (if (get-buffer-window buf)
|
|
|
1263 (let ((win (selected-window)))
|
|
|
1264 (select-window (get-buffer-window buf))
|
|
|
1265 (bury-buffer)
|
|
|
1266 (select-window win))
|
|
|
1267 (bury-buffer buf))))
|
|
|
1268 (t (error "PR unlock aborted.")))))
|
|
|
1269
|
|
|
1270 (defun gnats::delete-backups (filename)
|
|
|
1271 (let ((l (file-name-all-completions
|
|
|
1272 (concat (file-name-nondirectory filename) ".~")
|
|
|
1273 (file-name-directory filename)))
|
|
|
1274 (dir (file-name-directory filename)))
|
|
|
1275 (while l
|
|
|
1276 (delete-file (concat dir (car l)))
|
|
|
1277 (setq l (cdr l)))))
|
|
|
1278
|
|
|
1279 (defun gnats::reset-variables ()
|
|
|
1280 (setq gnats::submitters nil
|
|
|
1281 gnats::responsibles nil
|
|
|
1282 gnats::categories nil))
|
|
|
1283
|
|
|
1284 (defun gnats::set-responsibles (&optional arg)
|
|
|
1285 (or (and (null arg) gnats::responsibles)
|
|
|
1286 (setq gnats::responsibles
|
|
|
1287 (gnats::get-list-from-file
|
|
|
1288 (if gnats:network-server
|
|
|
1289 "res"
|
|
|
1290 "responsible") "responsible")))
|
|
|
1291 'gnats::try-responsible-completion)
|
|
|
1292
|
|
|
1293 (defun gnats::try-responsible-completion (string predicate do-list)
|
|
|
1294 (let (entry)
|
|
|
1295 (and (not (assoc string gnats::responsibles))
|
|
|
1296 (setq entry (gnats::real-pr-addr string))
|
|
|
1297 (gnats::push entry gnats::responsibles)))
|
|
|
1298 (let* ((completion-ignore-case t))
|
|
|
1299 (if do-list
|
|
|
1300 (all-completions string gnats::responsibles predicate)
|
|
|
1301 (try-completion string gnats::responsibles predicate))))
|
|
|
1302
|
|
|
1303 (defun gnats::set-categories (&optional arg)
|
|
|
1304 (or (and (null arg) gnats::categories)
|
|
|
1305 (setq gnats::categories
|
|
|
1306 (gnats::get-list-from-file
|
|
|
1307 (if gnats:network-server
|
|
|
1308 "cat"
|
|
|
1309 "categories") "categories"))))
|
|
|
1310
|
|
|
1311 (defun gnats::set-submitters (&optional arg)
|
|
|
1312 (or (and (null arg) gnats::submitters)
|
|
|
1313 (setq gnats::submitters
|
|
|
1314 (gnats::get-list-from-file
|
|
|
1315 (if gnats:network-server
|
|
|
1316 "sub"
|
|
|
1317 "submitters") "submitters"))))
|
|
|
1318
|
|
|
1319 (defun gnats::get-list (buffer)
|
|
|
1320 (let (result)
|
|
|
1321 (save-excursion
|
|
|
1322 (set-buffer buffer)
|
|
|
1323 (goto-char (point-min))
|
|
|
1324 (while (re-search-forward "^[^#:]+" nil t)
|
|
|
1325 (gnats::push (list (gnats::bm 0)) result)))
|
|
|
1326 (reverse result)))
|
|
|
1327
|
|
|
1328 (defun gnats::parse-line ()
|
|
|
1329 (let ((end (progn (end-of-line) (point)))
|
|
|
1330 (p (match-beginning 0))
|
|
|
1331 l)
|
|
|
1332 (goto-char p)
|
|
|
1333 (while (search-forward ":" end 'move)
|
|
|
1334 (gnats::push (buffer-substring p (match-beginning 0)) l)
|
|
|
1335 (skip-chars-forward " " end)
|
|
|
1336 (setq p (point)))
|
|
|
1337 (gnats::push (buffer-substring p end) l)
|
|
|
1338 (reverse l)))
|
|
|
1339
|
|
|
1340 (defun gnats::get-alist (buffer)
|
|
|
1341 (let (result)
|
|
|
1342 (save-excursion
|
|
|
1343 (set-buffer buffer)
|
|
|
1344 (goto-char (point-min))
|
|
|
1345 (while (re-search-forward "^[^#]" nil t)
|
|
|
1346 (gnats::push (gnats::parse-line) result)))
|
|
|
1347 (reverse result)))
|
|
|
1348
|
|
|
1349 (defun gnats::get-list-from-file (filename desc)
|
|
|
1350 (let ((buf nil)
|
|
|
1351 (result nil))
|
|
|
1352 (message "Parsing the %s file..." desc)
|
|
|
1353 (save-excursion
|
|
|
1354 (let ((bn gnats:::backupname))
|
|
|
1355 (setq buf (get-buffer-create " *gnats-grok*"))
|
|
|
1356 (set-buffer buf)
|
|
|
1357 (setq buffer-read-only nil)
|
|
|
1358 (erase-buffer)
|
|
|
1359 (insert-file-contents
|
|
|
1360 (if gnats:network-server
|
|
|
1361 (concat bn "." filename)
|
|
|
1362 (format "%s/gnats-adm/%s" gnats:root filename)))
|
|
|
1363 (setq result (gnats::get-alist buf))
|
|
|
1364 (kill-buffer buf))
|
|
|
1365 (message "Parsing the %s file...done." desc)
|
|
|
1366 result)))
|
|
|
1367
|
|
|
1368 (defun gnats::get-pr-category (number)
|
|
|
1369 "Return the category for the problem report NUMBER."
|
|
|
1370 (let ((buf nil)
|
|
|
1371 (result nil))
|
|
|
1372 (save-excursion
|
|
|
1373 (setq buf (get-buffer-create " *gnats-index*"))
|
|
|
1374 (set-buffer buf)
|
|
|
1375 (setq buffer-read-only nil)
|
|
|
1376 (erase-buffer)
|
|
|
1377 (insert-file-contents (format "%s/gnats-adm/index" gnats:root))
|
|
|
1378 (goto-char (point-min))
|
|
|
1379 (setq result
|
|
|
1380 (catch 'res
|
|
|
1381 (while (search-forward (format "/%s:" number) nil t)
|
|
|
1382 (beginning-of-line)
|
|
|
1383 (if (looking-at (format "\\([^/]+\\)/%s:" number))
|
|
|
1384 (throw 'res (gnats::bm 1))
|
|
|
1385 (end-of-line)))
|
|
|
1386 nil))
|
|
|
1387 (kill-buffer buf))
|
|
|
1388 (or result (signal 'gnats::no-such-pr (list number)))))
|
|
|
1389
|
|
|
1390 (defsubst gnats::has-slash (string)
|
|
|
1391 (memq t (mapcar (function (lambda (char) (= char ?/))) string)))
|
|
|
1392
|
|
|
1393 (or (boundp 'view-hook) (setq view-hook nil))
|
|
|
1394
|
|
|
1395 ;;;###autoload
|
|
|
1396 (fset 'view-pr 'gnats:view-pr)
|
|
|
1397 ;;;###autoload
|
|
|
1398 (defun gnats:view-pr (&optional id)
|
|
|
1399 "Visit the problem report named by the string ID. While viewing, press
|
|
|
1400 'e' to edit the currently viewed PR."
|
|
|
1401 (interactive "sPR number: ")
|
|
|
1402 (let (pr category temp-name buffer)
|
|
|
1403 (if (string= id "")
|
|
|
1404 (message "view-pr: must specify a PR")
|
|
|
1405 (if (or (gnats::has-slash id) gnats:network-server)
|
|
|
1406 (setq pr id)
|
|
|
1407 (and (setq category (gnats::get-pr-category id))
|
|
|
1408 (setq pr (format "%s/%s" category id))))
|
|
|
1409 (let ((view-hook (default-value 'view-hook))
|
|
|
1410 buf func)
|
|
|
1411 (if (and pr
|
|
|
1412 (or gnats:network-server
|
|
|
1413 (setq buf (get-buffer pr))
|
|
|
1414 (file-exists-p (format "%s/%s" gnats:root pr))))
|
|
|
1415 (if buf
|
|
|
1416 (save-excursion
|
|
|
1417 (set-buffer buf)
|
|
|
1418 (goto-char (point-min))
|
|
|
1419 (view-buffer buf))
|
|
|
1420 (setq func
|
|
|
1421 (function
|
|
|
1422 (lambda ()
|
|
|
1423 (and gnats::emacs-19p (rename-buffer pr))
|
|
|
1424 (setq mode-line-buffer-identification
|
|
|
1425 (format "Viewing %s" pr))
|
|
|
1426 (make-local-variable 'gnats:::buffer-pr)
|
|
|
1427 (setq gnats:::buffer-pr pr)
|
|
|
1428 (use-local-map (copy-keymap (current-local-map)))
|
|
|
1429 (local-set-key
|
|
|
1430 "e"
|
|
|
1431 (function (lambda () (interactive)
|
|
|
1432 (gnats:edit-pr gnats:::buffer-pr)))))))
|
|
|
1433 (if (fboundp 'add-hook)
|
|
|
1434 (add-hook 'view-hook func)
|
|
|
1435 (setq view-hook func))
|
|
|
1436 (if gnats:network-server
|
|
|
1437 (gnats:net-view-pr id buf)
|
|
|
1438 (view-file (format "%s/%s" gnats:root pr))))
|
|
|
1439 (signal 'gnats::no-such-pr (list id)))))))
|
|
|
1440
|
|
|
1441 (defun gnats:net-view-pr (id buf)
|
|
|
1442 "Use the network query to view problem report ID."
|
|
|
1443 (require 'view)
|
|
|
1444 (let ((result nil)
|
|
|
1445 (curr (current-buffer)))
|
|
|
1446 (unwind-protect
|
|
|
1447 (if (not buf)
|
|
|
1448 (progn
|
|
|
1449 ;; XXX fix this to include the category
|
|
|
1450 (setq buf (get-buffer-create (concat "*view-pr " id "*")))
|
|
|
1451 (setq buffer-read-only nil)))
|
|
|
1452 (let ((command (append (list 'funcall)
|
|
|
1453 (list ''call-process)
|
|
|
1454 (list gnats:::nquery-pr nil buf nil)
|
|
|
1455 (list id "--full" "--host"
|
|
|
1456 gnats:network-server))))
|
|
|
1457 (save-excursion
|
|
|
1458 (set-buffer buf)
|
|
|
1459 (erase-buffer))
|
|
|
1460 (let ((default-directory (gnats::find-safe-default-directory)))
|
|
|
1461 (setq result (gnats::rw buf (eval command))))
|
|
|
1462 (save-excursion
|
|
|
1463 (set-buffer buf)
|
|
|
1464 (and (/= 0 result)
|
|
|
1465 (goto-char (point-min))
|
|
|
1466 (cond
|
|
|
1467 ((or (looking-at (concat gnats:::query-regexp " no PRs matched"))
|
|
|
1468 (looking-at (concat gnats:::query-regexp " couldn.t find PR.*")))
|
|
|
1469 (signal 'gnats::no-such-pr nil))
|
|
|
1470 (t (signal 'gnats::error
|
|
|
1471 (list (buffer-substring (point-min)
|
|
|
1472 (- (point-max) 1)))))
|
|
|
1473 ))))
|
|
|
1474 (switch-to-buffer buf)
|
|
|
1475 (if (fboundp 'view-mode-enter)
|
|
|
1476 (view-mode-enter curr 'kill-buffer)
|
|
|
1477 (view-mode curr 'kill-buffer))
|
|
|
1478 (set-buffer-modified-p nil)
|
|
|
1479 (make-local-variable 'gnats:::buffer-pr)
|
|
|
1480 (if (not (gnats::has-slash id)) (gnats::rename-buffer))
|
|
|
1481 (setq buffer-read-only t)
|
|
|
1482 (setq buffer-undo-list nil) ;flush undo list
|
|
|
1483 (goto-char (point-min)))
|
|
|
1484 (zerop result)))
|
|
|
1485
|
|
|
1486 (fset 'change-gnats 'gnats:change-type)
|
|
|
1487 (fset 'gnats-change-type 'gnats:change-type)
|
|
|
1488 (defun gnats:change-type (type)
|
|
|
1489 "Change the GNATS database type in use."
|
|
|
1490 (interactive
|
|
|
1491 (list
|
|
|
1492 (progn
|
|
|
1493 (if (not gnats:::types)
|
|
|
1494 (error "Value of gnats:::types has to be non-nil."))
|
|
|
1495 (let* ((completion-ignore-case t))
|
|
|
1496 (completing-read "Use GNATS database type: " gnats:::types nil t)))))
|
|
|
1497 (let ((newlist (car (cdr (assoc type gnats:::types)))))
|
|
|
1498 (setq gnats:root (car newlist)
|
|
|
1499 gnats:libdir (car (cdr newlist))
|
|
|
1500 gnats:::query-pr (car (cdr (cdr newlist)))
|
|
|
1501 gnats:::nquery-pr (car (cdr (cdr (cdr newlist))))
|
|
|
1502 gnats:::query-regexp (car (cdr (cdr (cdr (cdr newlist)))))
|
|
|
1503 )
|
|
|
1504 (gnats::reset-variables)))
|
|
|
1505
|
|
|
1506 (defun gnats::find-pr-buffer (pr)
|
|
|
1507 "*Find the buffer currently editing PR, returning the buffer or nil."
|
|
|
1508 (if (gnats::has-slash pr)
|
|
|
1509 ;; return the buffer if it exists
|
|
|
1510 (get-buffer pr)
|
|
|
1511 (let (buflist buf
|
|
|
1512 (name (concat "/" pr "$")))
|
|
|
1513 (setq buflist
|
|
|
1514 (delq nil
|
|
|
1515 (mapcar
|
|
|
1516 (function (lambda (buf)
|
|
|
1517 (if (string-match name (buffer-name buf))
|
|
|
1518 buf)))
|
|
|
1519 (buffer-list))))
|
|
|
1520 ;; If we found one---and only one---then sanity-check some things
|
|
|
1521 ;; about it before we try to use it.
|
|
|
1522 (if (eq (length buflist) 1)
|
|
|
1523 (progn
|
|
|
1524 (setq buf (car buflist))
|
|
|
1525 (save-excursion
|
|
|
1526 (set-buffer buf)
|
|
|
1527 ;; We make sure that we have a value for the PR, it's in
|
|
|
1528 ;; the right mode, and that the buffer's writable. If so,
|
|
|
1529 ;; we'll return the buffer, otherwise the result of the if
|
|
|
1530 ;; gets kicked back up to return nil.
|
|
|
1531 (if (and gnats:::buffer-pr
|
|
|
1532 (eq major-mode 'gnats:gnats-mode)
|
|
|
1533 (eq buffer-read-only nil))
|
|
|
1534 buf)))))))
|
|
|
1535
|
|
|
1536 ;;;###autoload
|
|
|
1537 (fset 'edit-pr 'gnats:edit-pr)
|
|
|
1538 ;;;###autoload
|
|
|
1539 (defun gnats:edit-pr (&optional id)
|
|
|
1540 "Edit the problem report named by the string ID."
|
|
|
1541 (interactive "sPR number: ")
|
|
|
1542 (if (string= id "")
|
|
|
1543 (message "edit-pr: must specify a PR to edit")
|
|
|
1544 (let (pr category newfile
|
|
|
1545 (buf (gnats::find-pr-buffer id)))
|
|
|
1546 (if buf
|
|
|
1547 (progn
|
|
|
1548 (switch-to-buffer buf)
|
|
|
1549 (message "Already editing PR %s." id))
|
|
|
1550 (progn
|
|
|
1551 (if (or (gnats::has-slash id) gnats:network-server)
|
|
|
1552 (setq pr id)
|
|
|
1553 (and (setq category (gnats::get-pr-category id))
|
|
|
1554 (setq pr (format "%s/%s" category id)))))
|
|
|
1555 (if (and pr (or gnats:network-server
|
|
|
1556 (file-exists-p (format "%s/%s" gnats:root pr))))
|
|
|
1557 (progn
|
|
|
1558 (setq newfile (if gnats:network-server
|
|
|
1559 (gnats::make-temp-name)
|
|
|
1560 (format "%s/%s" gnats:root pr)))
|
|
|
1561 (gnats::lock pr newfile))
|
|
|
1562 (signal 'gnats::no-such-pr (list id)))))))
|
|
|
1563
|
|
|
1564 (defvar gnats:query-pr-default-options nil
|
|
|
1565 "*Default options to pass to query-pr.")
|
|
|
1566 (defsubst gnats::query-pr-default-options ()
|
|
|
1567 (or gnats:query-pr-default-options
|
|
|
1568 (if (not gnats:network-server)
|
|
|
1569 (concat " --directory=" gnats:root " --print-path ")
|
|
|
1570 "")))
|
|
|
1571
|
|
|
1572 ;;;###autoload
|
|
|
1573 (fset 'query-pr 'gnats:query-pr)
|
|
|
1574 ;;;###autoload
|
|
|
1575 (defun gnats:query-pr (options)
|
|
|
1576 "Run query-pr, with user-specified args, and collect output in a buffer.
|
|
|
1577 While query-pr runs asynchronously, you can use the \\[next-error] command
|
|
|
1578 to find the text that the hits refer to."
|
|
|
1579 (interactive
|
|
|
1580 (list (apply
|
|
|
1581 'read-from-minibuffer "Run query-pr (with args): "
|
|
|
1582 (if gnats::emacs-19p
|
|
|
1583 (list (cons (gnats::query-pr-default-options) 1)
|
|
|
1584 nil nil 'gnats::query-pr-history)
|
|
|
1585 (list (gnats::query-pr-default-options) nil nil)))))
|
|
|
1586 (require 'compile)
|
|
|
1587 (compile-internal (concat
|
|
|
1588 (if gnats:network-server
|
|
|
1589 (format (concat gnats:::nquery-pr " --host %s ")
|
|
|
1590 gnats:network-server)
|
|
|
1591 (concat gnats:::query-pr " "))
|
|
|
1592 options)
|
|
|
1593 "No more query-pr hits" (concat gnats:::query-pr " ")))
|
|
|
1594
|
|
|
1595 (defun gnats::tr (string from to)
|
|
|
1596 (let ((s (copy-sequence string))
|
|
|
1597 (len (length string)))
|
|
|
1598 (while (>= (setq len (1- len)) 0)
|
|
|
1599 (if (eq (aref s len) (string-to-char from))
|
|
|
1600 (aset s len (string-to-char to))))
|
|
|
1601 s))
|
|
|
1602
|
|
|
1603 ;; Redefine so that buffers with, say, g++/1234 embedded in them can be
|
|
|
1604 ;; autosaved. This was mostly copied from the Emacs 19.19 version.
|
|
|
1605 (defun gnats::make-auto-save-file-name ()
|
|
|
1606 "Return file name to use for auto-saves of current buffer.
|
|
|
1607 Does not consider `auto-save-visited-file-name' as that variable is checked
|
|
|
1608 before calling this function. You can redefine this for customization.
|
|
|
1609 See also `auto-save-file-name-p'."
|
|
|
1610 ; Since the user may have his own make-auto-save-file-name, try not to
|
|
|
1611 ; use our custom one unless we have to.
|
|
|
1612 (if (or (eq major-mode gnats::mode-name)
|
|
|
1613 ; Heuristic for noticing a mail buffer based on a PR
|
|
|
1614 (string-match " PR .*/" (buffer-name)))
|
|
|
1615 (if buffer-file-name
|
|
|
1616 (concat (file-name-directory buffer-file-name)
|
|
|
1617 "#"
|
|
|
1618 (file-name-nondirectory buffer-file-name)
|
|
|
1619 "#")
|
|
|
1620 ;; For non-file bfr, use bfr name and Emacs pid.
|
|
|
1621 (expand-file-name (format "#%s#%s#"
|
|
|
1622 (gnats::tr (buffer-name) "/" ":")
|
|
|
1623 (make-temp-name ""))))
|
|
|
1624 (gnats::real-make-auto-save-file-name)))
|
|
|
1625
|
|
|
1626 (if (not (fboundp 'gnats::real-make-auto-save-file-name))
|
|
|
1627 (progn (fset 'gnats::real-make-auto-save-file-name
|
|
|
1628 (symbol-function 'make-auto-save-file-name))
|
|
|
1629 (fset 'make-auto-save-file-name 'gnats::make-auto-save-file-name)))
|
|
|
1630
|
|
|
1631 (defun gnats::make-temp-name ()
|
|
|
1632 (make-temp-name
|
|
|
1633 (concat (expand-file-name (file-name-as-directory gnats::tmpdir)) "gnats")))
|
|
|
1634
|
|
|
1635 ;; Below this is the GNATS summary mode I've written. Not quite 100%
|
|
|
1636 ;; integrated yet.
|
|
|
1637
|
|
|
1638 ;; Temporary variables which are made buffer-local, but which the byte
|
|
|
1639 ;; compiler complaints about if the defvars aren't here.
|
|
|
1640 (defvar gnats:::PRs nil
|
|
|
1641 "List of problem reports to be summarized. This variable is buffer local.")
|
|
|
1642 (make-variable-buffer-local 'gnats:::PRs)
|
|
|
1643 (defvar gnats::options nil
|
|
|
1644 "Options used for nquery-pr in the current GNATS summary buffer.
|
|
|
1645 This variable is buffer local.")
|
|
|
1646 (make-variable-buffer-local 'gnats::options)
|
|
|
1647
|
|
|
1648 ;; Note: "release" stays out of this list. The "release" field is
|
|
|
1649 ;; unrestricted; the customer could put any old junk in there, and
|
|
|
1650 ;; often does.
|
|
|
1651 (defvar gnats:::limited-fields '(category confidential severity priority responsible state class customer-id)
|
|
|
1652 "PR fields for which the possible values are limited in range.")
|
|
|
1653
|
|
|
1654 (defvar gnats::summary-sort-function nil
|
|
|
1655 "Holds a function used to filter and sort PRs before displaying a report.
|
|
|
1656 This filtering does not affect the stored PR information, so an invocation
|
|
|
1657 of gnats:summary-redisplay after changing this variable will do the right thing.")
|
|
|
1658
|
|
|
1659 (defun gnats:::prompt-for-pr-number (default)
|
|
|
1660 (let ((val (read-input (if default
|
|
|
1661 (format "PR number (default %d): " default)
|
|
|
1662 "PR number: "))))
|
|
|
1663 (if (and default (string= val ""))
|
|
|
1664 default
|
|
|
1665 (setq val (string-to-number val))
|
|
|
1666 (if (and (integerp val)
|
|
|
1667 (> val 0))
|
|
|
1668 val
|
|
|
1669 (error "PR number must be a positive integer.")))))
|
|
|
1670
|
|
|
1671 (defun gnats:summary-edit (num)
|
|
|
1672 "Edit the PR referenced by the current text, or get a PR number from user.
|
|
|
1673 If a numeric prefix is given, it is used as the PR number.
|
|
|
1674 If a non-numeric prefix is given, or the text at (point) doesn't have the
|
|
|
1675 gnats::pr-number property, the user is prompted for a PR number."
|
|
|
1676 (interactive (list
|
|
|
1677 (let ((x (get-text-property (point) 'gnats::pr-number)))
|
|
|
1678 (cond ((numberp current-prefix-arg) current-prefix-arg)
|
|
|
1679 (current-prefix-arg (gnats:::prompt-for-pr-number x))
|
|
|
1680 (x x)
|
|
|
1681 (t (gnats:::prompt-for-pr-number nil))))))
|
|
|
1682 (message "Editing PR %d..." num)
|
|
|
1683 (gnats:edit-pr (number-to-string num)))
|
|
|
1684
|
|
|
1685 (defun gnats:summary-view (num)
|
|
|
1686 "View the PR referenced by the current text, or get a PR number from user.
|
|
|
1687 If a numeric prefix is given, it is used as the PR number.
|
|
|
1688 If a non-numeric prefix is given, or the text at (point) doesn't have the
|
|
|
1689 gnats::pr-number property, the user is prompted for a PR number."
|
|
|
1690 (interactive (list
|
|
|
1691 (let ((x (get-text-property (point) 'gnats::pr-number)))
|
|
|
1692 (cond ((numberp current-prefix-arg) current-prefix-arg)
|
|
|
1693 (current-prefix-arg (gnats:::prompt-for-pr-number x))
|
|
|
1694 (x x)
|
|
|
1695 (t (gnats:::prompt-for-pr-number nil))))))
|
|
|
1696 (message "Viewing PR %d..." num)
|
|
|
1697 (gnats:view-pr (number-to-string num)))
|
|
|
1698
|
|
|
1699 (defun gnats:summary-quit nil
|
|
|
1700 "Quit GNATS summary mode."
|
|
|
1701 (interactive)
|
|
|
1702 (kill-buffer nil))
|
|
|
1703
|
|
|
1704 (defun gnats:summary-revert nil
|
|
|
1705 "Fetch PR data from server and rebuild the summary."
|
|
|
1706 (interactive)
|
|
|
1707 (gnats:summ-pr gnats::options))
|
|
|
1708
|
|
|
1709 ;; Fetch field value from a PR.
|
|
|
1710 (defsubst gnats:::fieldval (pr field)
|
|
|
1711 (let ((x (assq field pr)))
|
|
|
1712 (if x (cdr x) nil)))
|
|
|
1713
|
|
|
1714 ;; Taken from gnus-parse-simple-format in (ding)Gnus 0.88.
|
|
|
1715 ;; Extended to handle width-1 fields more efficiently.
|
|
|
1716 ;; Extended to permit "*" to flag truncation.
|
|
|
1717 ;; Modified to call kqpr* functions instead of gnus-*.
|
|
|
1718 (defun gnats:::parse-summary-format (format spec-alist)
|
|
|
1719 ;; This function parses the FORMAT string with the help of the
|
|
|
1720 ;; SPEC-ALIST and returns a list that can be eval'ed to return the
|
|
|
1721 ;; string. The list will consist of the symbol `format', a format
|
|
|
1722 ;; specification string, and a list of forms depending on the
|
|
|
1723 ;; SPEC-ALIST.
|
|
|
1724 (let ((max-width 0)
|
|
|
1725 spec flist fstring b newspec max-width elem beg trunc-noisy)
|
|
|
1726 (save-excursion
|
|
|
1727 (set-buffer (get-buffer-create " *qpr work*"))
|
|
|
1728 (erase-buffer)
|
|
|
1729 (insert format)
|
|
|
1730 (goto-char (point-min))
|
|
|
1731 (while (re-search-forward "%-?[0-9]*\\([,*]-?[0-9]*\\)*\\(.\\)\\(.\\)?" nil t)
|
|
|
1732 (setq spec (string-to-char (buffer-substring (match-beginning 2)
|
|
|
1733 (match-end 2))))
|
|
|
1734 ;; First check if there are any specs that look anything like
|
|
|
1735 ;; "%12,12A", ie. with a "max width specification". These have
|
|
|
1736 ;; to be treated specially.
|
|
|
1737 (if (setq beg (match-beginning 1))
|
|
|
1738 (setq max-width
|
|
|
1739 (string-to-int
|
|
|
1740 (buffer-substring (1+ (match-beginning 1)) (match-end 1)))
|
|
|
1741 trunc-noisy (= ?* (char-after beg)))
|
|
|
1742 (setq max-width 0)
|
|
|
1743 (setq beg (match-beginning 2))
|
|
|
1744 (setq trunc-noisy nil))
|
|
|
1745 ;; Find the specification from `spec-alist'.
|
|
|
1746 (if (not (setq elem (cdr (assq spec spec-alist))))
|
|
|
1747 (setq elem '("*" ?s)))
|
|
|
1748 ;; Treat user defined format specifiers specially
|
|
|
1749 (and (eq (car elem) 'user-defined)
|
|
|
1750 (setq elem
|
|
|
1751 (list
|
|
|
1752 (list (intern (concat "gnats:user-format-function-"
|
|
|
1753 (buffer-substring
|
|
|
1754 (match-beginning 3)
|
|
|
1755 (match-end 3))))
|
|
|
1756 'pr)
|
|
|
1757 ?s))
|
|
|
1758 (delete-region (match-beginning 3) (match-end 3)))
|
|
|
1759 (if (not (zerop max-width))
|
|
|
1760 (if (and (= max-width 1)
|
|
|
1761 (memq (car (cdr elem)) '(?c ?s)))
|
|
|
1762 (let ((el (car elem)))
|
|
|
1763 (cond ((= (car (cdr elem)) ?c)
|
|
|
1764 (setq newspec ?c)
|
|
|
1765 (setq flist (cons el flist)))
|
|
|
1766 ((= (car (cdr elem)) ?s)
|
|
|
1767 (setq newspec ?c)
|
|
|
1768 (setq flist (cons (list 'string-to-char el) flist)))
|
|
|
1769 (t
|
|
|
1770 (error "eep!"))))
|
|
|
1771 (let ((el (car elem)))
|
|
|
1772 (cond ((= (car (cdr elem)) ?c)
|
|
|
1773 (setq el (list 'char-to-string el)))
|
|
|
1774 ((= (car (cdr elem)) ?d)
|
|
|
1775 (numberp el) (setq el (list 'int-to-string el))))
|
|
|
1776 (setq flist (cons (list 'gnats:::format-max-width
|
|
|
1777 el max-width trunc-noisy)
|
|
|
1778 flist))
|
|
|
1779 (setq newspec ?s)))
|
|
|
1780 (setq flist (cons (car elem) flist))
|
|
|
1781 (setq newspec (car (cdr elem))))
|
|
|
1782 ;; Remove the old specification (and possibly a ",12" string).
|
|
|
1783 (delete-region beg (match-end 2))
|
|
|
1784 ;; Insert the new specification.
|
|
|
1785 (goto-char beg)
|
|
|
1786 (insert newspec))
|
|
|
1787 (setq fstring (buffer-substring 1 (point-max)))
|
|
|
1788 (kill-buffer nil))
|
|
|
1789 (cons 'format (cons fstring (nreverse flist)))))
|
|
|
1790
|
|
|
1791 ;; Try to keep this list similar to the command-line options for nquery-pr,
|
|
|
1792 ;; just to avoid confusing people. If there are differences, it won't break
|
|
|
1793 ;; anything.
|
|
|
1794 (defvar gnats::summary-format-alist
|
|
|
1795 (list (list ?r '(symbol-name (gnats:::fieldval pr 'responsible)) ?s)
|
|
|
1796 (list ?c '(symbol-name (gnats:::fieldval pr 'category)) ?s)
|
|
|
1797 (list ?C '(symbol-name (gnats:::fieldval pr 'confidential)) ?s)
|
|
|
1798 (list ?e '(symbol-name (gnats:::fieldval pr 'severity)) ?s)
|
|
|
1799 (list ?O '(gnats:::fieldval pr 'originator) ?s)
|
|
|
1800 (list ?p '(symbol-name (gnats:::fieldval pr 'priority)) ?s)
|
|
|
1801 (list ?L '(symbol-name (gnats:::fieldval pr 'class)) ?s)
|
|
|
1802 (list ?S '(symbol-name (gnats:::fieldval pr 'customer-id)) ?s) ; == submitter
|
|
|
1803 (list ?s '(symbol-name (gnats:::fieldval pr 'state)) ?s)
|
|
|
1804
|
|
|
1805 (list ?n '(gnats:::fieldval pr 'number) ?d)
|
|
|
1806 (list ?R '(gnats:::fieldval pr 'release) ?s)
|
|
|
1807 (list ?j '(gnats:::fieldval pr 'synopsis) ?s)
|
|
|
1808 (list ?y '(gnats:::fieldval pr 'synopsis) ?s)
|
|
|
1809 (list ?u 'user-defined ?s)
|
|
|
1810 ))
|
|
|
1811
|
|
|
1812 (defun gnats:::format-max-width (str len noisy)
|
|
|
1813 (if (> (length str) (if gnats::emacs-19p (abs len) len))
|
|
|
1814 (if noisy
|
|
|
1815 (if (< len 0)
|
|
|
1816 (concat "*" (substring str (1+ len)))
|
|
|
1817 (concat (substring str 0 (- len 1)) "*"))
|
|
|
1818 (if (< len 0)
|
|
|
1819 (substring str len)
|
|
|
1820 (substring str 0 len)))
|
|
|
1821 str))
|
|
|
1822
|
|
|
1823 ;; Redisplay the summary in the current buffer.
|
|
|
1824 (defvar gnats::format-string
|
|
|
1825 "%5n %-4,4c %,1e%,1p %-8,8r %,2s %-10*10S %-10*-10R %j\n"
|
|
|
1826 "Format string for PR summary text.
|
|
|
1827
|
|
|
1828 If you've used format strings in (ding)Gnus, this will be familiar.
|
|
|
1829
|
|
|
1830 Most text is copied straight through verbatim. Use \"%\" to indicate a
|
|
|
1831 non-fixed field.
|
|
|
1832
|
|
|
1833 It can be followed by a number, indicating minimum width, a separator character
|
|
|
1834 (\",\" or \"*\"), and another number, indicating maximum width. These fields
|
|
|
1835 are optional, except that the separator must be present if the maximum width is
|
|
|
1836 specified. Whitespace padding will be on the left unless the first number is
|
|
|
1837 negative. Truncation of the field will be done on the right, unless the second
|
|
|
1838 number is negative. If the separator character is \"*\", a \"*\" will be used
|
|
|
1839 to indicate that truncation has been done; otherwise, it will be done silently.
|
|
|
1840
|
|
|
1841 After the \"%\" and optional width parameters, a letter is expected. Most of
|
|
|
1842 the letters are chosen to match the command-line options of `nquery-pr'.
|
|
|
1843
|
|
|
1844 %r \"Responsible\" field.
|
|
|
1845 %c \"Category\" field.
|
|
|
1846 %C \"Confidential\" field.
|
|
|
1847 %e \"Severity\" field.
|
|
|
1848 %O \"Originator\" field.
|
|
|
1849 %p \"Priority\" field.
|
|
|
1850 %L \"Class\" field.
|
|
|
1851 %S \"Customer-id\" (\"submitter\") field.
|
|
|
1852 %s \"State\" field.
|
|
|
1853 %n \"Number\" field.
|
|
|
1854 %R \"Release\" field.
|
|
|
1855 %j, %y \"Synopsis\" field. (\"j\" as in \"subJect\")
|
|
|
1856 %u Special: The next character is examined, and the function
|
|
|
1857 gnats:user-format-function-<char> is invoked. One argument, the list
|
|
|
1858 of (FIELD . VALUE) pairs, is passed.
|
|
|
1859
|
|
|
1860 Any newlines you wish to have used must be included in this string; no
|
|
|
1861 additional ones will be provided.
|
|
|
1862
|
|
|
1863 If the value is not a string, it is assumed to be a function which can
|
|
|
1864 be funcalled to return a format string, to be interpreted as above.")
|
|
|
1865
|
|
|
1866 (defun gnats:summary-redisplay nil
|
|
|
1867 "Redisplay summary of stored GNATS data.
|
|
|
1868 This is useful if you change your filtering criteria or format string but
|
|
|
1869 do not wish to update the GNATS data by contacting the server."
|
|
|
1870 (interactive)
|
|
|
1871 (let (prs
|
|
|
1872 (buffer-read-only nil)
|
|
|
1873 format-form fmt)
|
|
|
1874 ;; Do this early, so if we're in the wrong buffer we blow up without
|
|
|
1875 ;; trashing the user's data.
|
|
|
1876 (setq prs (if gnats::summary-sort-function
|
|
|
1877 (funcall gnats::summary-sort-function
|
|
|
1878 (apply 'list gnats:::PRs))
|
|
|
1879 gnats:::PRs))
|
|
|
1880 ;; No wrapping -- ick!
|
|
|
1881 (if gnats::emacs-19p
|
|
|
1882 (buffer-disable-undo)
|
|
|
1883 (buffer-flush-undo (current-buffer)))
|
|
|
1884 (erase-buffer)
|
|
|
1885 (setq fmt (if (stringp gnats::format-string)
|
|
|
1886 gnats::format-string
|
|
|
1887 (funcall gnats::format-string)))
|
|
|
1888 (setq format-form (gnats:::parse-summary-format fmt
|
|
|
1889 gnats::summary-format-alist))
|
|
|
1890 (mapcar (function
|
|
|
1891 (lambda (pr)
|
|
|
1892 (let ((start (point)))
|
|
|
1893 (insert (eval format-form))
|
|
|
1894 ;; Magic.
|
|
|
1895 (put-text-property start (point) 'gnats::pr-number
|
|
|
1896 (gnats:::fieldval pr 'number))
|
|
|
1897 )))
|
|
|
1898 prs)
|
|
|
1899 (goto-char (point-min))
|
|
|
1900 (buffer-enable-undo)
|
|
|
1901 (set-buffer-modified-p nil)
|
|
|
1902 ))
|
|
|
1903
|
|
|
1904 (defvar gnats-summary-mode-map
|
|
|
1905 (let ((map (copy-keymap text-mode-map)))
|
|
|
1906 (if gnats::emacs-19p (suppress-keymap map))
|
|
|
1907 ;; basic mode stuff
|
|
|
1908 (define-key map "g" 'gnats:summary-revert)
|
|
|
1909 (define-key map "q" 'gnats:summary-quit)
|
|
|
1910 (define-key map "r" 'gnats:summary-redisplay)
|
|
|
1911 ;; do stuff to PRs
|
|
|
1912 (define-key map "e" 'gnats:summary-edit)
|
|
|
1913 (define-key map "v" 'gnats:summary-view)
|
|
|
1914 ;; navigation
|
|
|
1915 (define-key map "n" 'next-line)
|
|
|
1916 (define-key map "p" 'previous-line)
|
|
|
1917 map)
|
|
|
1918 "Keymap for GNATS summary mode.")
|
|
|
1919
|
|
|
1920 (defun gnats-summary-mode nil
|
|
|
1921 "Major mode for problem report summary.
|
|
|
1922
|
|
|
1923 You can use \\[gnats:summary-view] to view the PR specified by the
|
|
|
1924 current line, or \\[gnats:summary-edit] to edit it. Typing
|
|
|
1925 \\[gnats:summary-revert] will update the PR list.
|
|
|
1926
|
|
|
1927 Special commands:
|
|
|
1928 \\{gnats-summary-mode-map}
|
|
|
1929
|
|
|
1930 Entering GNATS summary mode will invoke any hooks listed in the variable
|
|
|
1931 gnats-summary-mode-hook. It will also use text-mode-hook, since the summary
|
|
|
1932 mode is built on top of text mode."
|
|
|
1933 (interactive)
|
|
|
1934 (text-mode)
|
|
|
1935 ; (make-local-variable 'gnats:::PRs)
|
|
|
1936 ; (make-local-variable 'gnats::options)
|
|
|
1937 (setq buffer-read-only t)
|
|
|
1938 (setq truncate-lines t)
|
|
|
1939 (setq major-mode 'gnats-summary-mode)
|
|
|
1940 (setq mode-name "GNATS Summary")
|
|
|
1941 (use-local-map gnats-summary-mode-map)
|
|
|
1942 (run-hooks 'gnats-summary-mode-hook)
|
|
|
1943 )
|
|
|
1944
|
|
|
1945 ;;;###autoload
|
|
|
1946 (fset 'summ-pr 'gnats:summ-pr)
|
|
|
1947 ;;;###autoload
|
|
|
1948 (defun gnats:summ-pr (options)
|
|
|
1949 "Run query-pr, with user-specified args, and display a pretty summary.
|
|
|
1950 Well, display a summary, at least."
|
|
|
1951 (interactive
|
|
|
1952 (list
|
|
|
1953 (if (not gnats::emacs-19p)
|
|
|
1954 (error "GNATS summary mode will only work with emacs 19.")
|
|
|
1955 (apply
|
|
|
1956 'read-from-minibuffer "Run query-pr (with args): "
|
|
|
1957 (if gnats::emacs-19p
|
|
|
1958 (list (cons (gnats::query-pr-default-options) 1)
|
|
|
1959 nil nil 'gnats::query-pr-history)
|
|
|
1960 (list (gnats::query-pr-default-options) nil nil))))))
|
|
|
1961 (let ((buf (get-buffer-create "*gnats-summ-pr-temp*"))
|
|
|
1962 (prs nil)
|
|
|
1963 pr fieldname value p)
|
|
|
1964 ; (save-excursion
|
|
|
1965 (set-buffer buf)
|
|
|
1966 (if gnats::emacs-19p
|
|
|
1967 (buffer-disable-undo)
|
|
|
1968 (buffer-flush-undo buf))
|
|
|
1969 (erase-buffer)
|
|
|
1970 ;; calling nquery-pr directly would be better, but I'd need a "split"
|
|
|
1971 ;; function of some sort to break apart the options string.
|
|
|
1972 (message "Fetching GNATS data...")
|
|
|
1973 (call-process "sh" nil buf nil "-c"
|
|
|
1974 (concat
|
|
|
1975 (if gnats:network-server
|
|
|
1976 (format (concat gnats:::nquery-pr " --host %s ")
|
|
|
1977 gnats:network-server)
|
|
|
1978 (concat gnats:::query-pr " "))
|
|
|
1979 options))
|
|
|
1980 ;; um, okay, how to i check for errors?
|
|
|
1981 (goto-char (point-min))
|
|
|
1982 (setq pr nil)
|
|
|
1983 (while (looking-at "ld.so: warning:")
|
|
|
1984 (forward-line 1))
|
|
|
1985 (while (not (eobp))
|
|
|
1986 (while (looking-at ">\\([a-zA-Z-]+\\):")
|
|
|
1987 (setq fieldname (intern
|
|
|
1988 (downcase
|
|
|
1989 (buffer-substring (match-beginning 1)
|
|
|
1990 (match-end 1)))))
|
|
|
1991 (goto-char (match-end 0))
|
|
|
1992 (while (looking-at "[ \t]")
|
|
|
1993 (forward-char 1))
|
|
|
1994 (setq p (point))
|
|
|
1995 (setq value (buffer-substring p (progn (end-of-line) (point))))
|
|
|
1996 (cond ((eq fieldname 'number)
|
|
|
1997 (setq value (string-to-number value)))
|
|
|
1998 ((memq fieldname gnats:::limited-fields)
|
|
|
1999 (setq value (intern value))))
|
|
|
2000 (setq pr (cons (cons fieldname value) pr))
|
|
|
2001 (forward-char 1))
|
|
|
2002 (if (looking-at "\n")
|
|
|
2003 (progn
|
|
|
2004 (setq prs (cons (nreverse pr) prs)
|
|
|
2005 pr nil)
|
|
|
2006 (forward-char 1)))
|
|
|
2007 ;; could be the result of --print-path
|
|
|
2008 (if (looking-at "/.*:0:$")
|
|
|
2009 (next-line 1))
|
|
|
2010 (if (looking-at gnats:::query-regexp)
|
|
|
2011 ;; error message
|
|
|
2012 (progn
|
|
|
2013 (goto-char (match-end 0))
|
|
|
2014 (while (looking-at "[ \t]")
|
|
|
2015 (forward-char 1))
|
|
|
2016 (setq p (point))
|
|
|
2017 (end-of-line)
|
|
|
2018 (setq value (buffer-substring p (point)))
|
|
|
2019 (error "Database query failed: %s" value)))
|
|
|
2020 )
|
|
|
2021 (if pr
|
|
|
2022 (setq prs (cons (nreverse pr) prs)))
|
|
|
2023 (setq prs (nreverse prs))
|
|
|
2024
|
|
|
2025 ;; okay, now display it
|
|
|
2026 (pop-to-buffer (get-buffer-create "*gnats:summ-pr*"))
|
|
|
2027 (gnats-summary-mode)
|
|
|
2028 (setq gnats:::PRs prs)
|
|
|
2029 (setq gnats::options options)
|
|
|
2030 (gnats:summary-redisplay)
|
|
|
2031 (message "Fetching GNATS data...done.")
|
|
|
2032 ; )
|
|
|
2033 (kill-buffer buf)
|
|
|
2034 ))
|
|
|
2035
|
|
|
2036 ;;;; end of gnats.el
|
