Mercurial > hg > xemacs-beta
comparison lisp/gnats/gnats.el @ 110:fe104dbd9147 r20-1b7
Import from CVS: tag r20-1b7
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 09:19:45 +0200 |
| parents | |
| children | b980b6286996 |
comparison
equal
deleted
inserted
replaced
| 109:e183fc049578 | 110:fe104dbd9147 |
|---|---|
| 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) | |
| 1022 ; (if gnats:network-server (list "--host" gnats:network-server)) | |
| 1023 args | |
| 1024 )) | |
| 1025 | |
| 1026 ;; Only set up the sentinel if they want stuff done in the background. | |
| 1027 (if gnats:run-in-background | |
| 1028 (progn | |
| 1029 (set-process-sentinel proc sentinel) | |
| 1030 (message "%s PR %s in background." proc-action pr)) | |
| 1031 (message "%s PR %s..." proc-action pr)) | |
| 1032 (if proc-send-buffer | |
| 1033 (progn | |
| 1034 (set-buffer inbuf) | |
| 1035 (goto-char (point-min)) | |
| 1036 (process-send-region proc (point-min) (point-max)) | |
| 1037 (if (and (/= (point-min) (point-max)) | |
| 1038 (/= (char-after (- (point-max) 1)) ?\n)) | |
| 1039 (process-send-string proc "\n")) | |
| 1040 (process-send-eof proc))) | |
| 1041 ;; if they don't want it in the background, just sit and twiddle... | |
| 1042 (if (not gnats:run-in-background) | |
| 1043 (save-excursion | |
| 1044 (set-buffer (process-buffer proc)) | |
| 1045 (while (memq (process-status proc) '(run open)) | |
| 1046 (accept-process-output proc)) | |
| 1047 (funcall sentinel proc nil))))))) | |
| 1048 | |
| 1049 (defun gnats::handle-pr-edit (process event) | |
| 1050 (let ((buf (process-buffer process)) | |
| 1051 result pr newfile nbuf) | |
| 1052 (if (null (buffer-name buf)) ;; deleted buffer | |
| 1053 (set-process-buffer process nil) | |
| 1054 (save-excursion | |
| 1055 (set-buffer buf) | |
| 1056 (setq pr gnats:::current-pr) | |
| 1057 (setq result (process-exit-status process)) | |
| 1058 (and (/= 0 result) | |
| 1059 (goto-char (point-min)) | |
| 1060 (gnats::handle-results gnats:::current-pr result)) | |
| 1061 (setq nbuf (generate-new-buffer | |
| 1062 (concat "*edit-pr " gnats:::current-pr "*"))) | |
| 1063 (setq newfile gnats:::newfile) | |
| 1064 (set-buffer nbuf) | |
| 1065 (insert-file-contents newfile) | |
| 1066 (make-local-variable 'gnats:::backupname) | |
| 1067 (put 'gnats:::backupname 'permanent-local t) | |
| 1068 ;; we do this in gnats:gnats-mode for non-network | |
| 1069 (if gnats:network-server (setq gnats:::backupname newfile)) | |
| 1070 (set-buffer-modified-p nil) | |
| 1071 (setq buffer-undo-list nil) ;flush undo list | |
| 1072 (gnats:gnats-mode) | |
| 1073 (make-variable-buffer-local 'gnats:::current-pr) | |
| 1074 (setq gnats:::current-pr pr) | |
| 1075 (goto-char gnats:::start-of-PR-fields)) | |
| 1076 (message "Fetching PR %s done." pr) | |
| 1077 (if gnats:run-in-background | |
| 1078 (display-buffer nbuf 'not-this-window) | |
| 1079 (switch-to-buffer nbuf))))) | |
| 1080 | |
| 1081 (defun gnats::pr-edit-background (pr outfile args) | |
| 1082 (gnats::start-background pr 'edit 'gnats::handle-pr-edit outfile nil args)) | |
| 1083 | |
| 1084 (defun gnats::handle-check-pr (process event) | |
| 1085 (let ((buf (process-buffer process)) | |
| 1086 result pr) | |
| 1087 (if (null (buffer-name buf)) ;; deleted buffer | |
| 1088 (set-process-buffer process nil) | |
| 1089 (save-excursion | |
| 1090 (set-buffer buf) | |
| 1091 (setq result (process-exit-status process)) | |
| 1092 (and (/= 0 result) | |
| 1093 (goto-char (point-min)) | |
| 1094 (gnats::handle-results gnats:::current-pr result)) | |
| 1095 (message "Checked PR %s." gnats:::current-pr) | |
| 1096 (if gnats:::do-file-pr | |
| 1097 (progn | |
| 1098 (set-buffer gnats:::pr-buffer) | |
| 1099 (gnats::file-pr-background))))))) | |
| 1100 | |
| 1101 (defun gnats::check-pr-background (&optional filep) | |
| 1102 (gnats::start-background gnats:::current-pr 'check | |
| 1103 'gnats::handle-check-pr nil filep)) | |
| 1104 | |
| 1105 (defun gnats::finish-filing () | |
| 1106 (let (responsible user resp-change state-change buf) | |
| 1107 (if gnats:network-server (setq gnats:::pr-locked nil)) | |
| 1108 (setq buf (current-buffer)) | |
| 1109 (set-buffer-modified-p nil) | |
| 1110 (setq responsible (gnats::field-contents "Responsible") | |
| 1111 user (user-login-name) | |
| 1112 resp-change (cdr (assoc "Responsible" gnats:::audit-trail)) | |
| 1113 state-change (cdr (assoc "State" gnats:::audit-trail))) | |
| 1114 (if (or state-change | |
| 1115 resp-change | |
| 1116 (not (equal user responsible))) | |
| 1117 (gnats::mail-PR-changed user responsible | |
| 1118 resp-change state-change | |
| 1119 (gnats::get-header "X-GNATS-Notify"))) | |
| 1120 (gnats:unlock-buffer buf))) | |
| 1121 | |
| 1122 (defun gnats::handle-file-pr (process event) | |
| 1123 (let ((buf (process-buffer process)) | |
| 1124 result pr prbuf) | |
| 1125 (if (null (buffer-name buf)) ;; deleted buffer | |
| 1126 (set-process-buffer process nil) | |
| 1127 (save-excursion | |
| 1128 (set-buffer buf) | |
| 1129 (setq result (process-exit-status process)) | |
| 1130 (and (/= 0 result) | |
| 1131 (goto-char (point-min)) | |
| 1132 (gnats::handle-results gnats:::current-pr result)) | |
| 1133 (message "Filed PR %s." gnats:::current-pr) | |
| 1134 (set-buffer gnats:::pr-buffer) | |
| 1135 (gnats::finish-filing))))) | |
| 1136 | |
| 1137 (defun gnats::file-pr-background () | |
| 1138 (gnats::start-background gnats:::current-pr 'file 'gnats::handle-file-pr)) | |
| 1139 | |
| 1140 (defun gnats::lock (pr &optional outfile) | |
| 1141 (let ((lockl (list "--lock" | |
| 1142 (format "%s@%s" (user-login-name) (system-name)) | |
| 1143 "-p" | |
| 1144 (if (fboundp 'emacs-pid) | |
| 1145 (concat "emacs pid " (int-to-string (emacs-pid))) | |
| 1146 "emacs18") | |
| 1147 pr))) | |
| 1148 (if gnats:network-server | |
| 1149 (setq lockl (append lockl (list "-o" outfile "--get-lists" | |
| 1150 "--host" gnats:network-server)))) | |
| 1151 (gnats::pr-edit-background pr outfile lockl))) | |
| 1152 | |
| 1153 (fset 'unlock-pr 'gnats:unlock-pr) | |
| 1154 (fset 'gnats-unlock 'gnats:unlock-pr) ;backward compatibility | |
| 1155 (defun gnats::handle-unlock-pr (process event) | |
| 1156 (let ((buf (process-buffer process)) | |
| 1157 result pr newfile nbuf) | |
| 1158 (if (null (buffer-name buf)) ;; deleted buffer | |
| 1159 (set-process-buffer process nil) | |
| 1160 (save-excursion | |
| 1161 (set-buffer buf) | |
| 1162 (setq pr gnats:::current-pr) | |
| 1163 (setq result (process-exit-status process)) | |
| 1164 (and (/= 0 result) | |
| 1165 (goto-char (point-min)) | |
| 1166 (gnats::handle-results gnats:::current-pr result)) | |
| 1167 (message "PR %s unlocked." gnats:::current-pr))))) | |
| 1168 | |
| 1169 (defun gnats:unlock-pr-force (pr) | |
| 1170 (gnats::start-background pr 'unlock-force 'gnats::handle-unlock-pr)) | |
| 1171 | |
| 1172 (defun gnats:unlock-pr (pr) | |
| 1173 (interactive "sPR number: ") | |
| 1174 (gnats::start-background pr 'unlock 'gnats::handle-unlock-pr)) | |
| 1175 | |
| 1176 (defsubst gnats::buffer-major-mode (buffer) | |
| 1177 (save-excursion (set-buffer buffer) major-mode)) | |
| 1178 | |
| 1179 (defun gnats::unlock-all-buffers () | |
| 1180 (save-excursion | |
| 1181 (mapcar | |
| 1182 (function | |
| 1183 (lambda (buffer) | |
| 1184 (let ((gnats:run-in-background nil)) | |
| 1185 (if (and (eq (gnats::buffer-major-mode buffer) gnats::mode-name)) | |
| 1186 (progn (set-buffer buffer) | |
| 1187 (gnats:unlock-buffer-force buffer)))))) | |
| 1188 (buffer-list)))) | |
| 1189 | |
| 1190 (if gnats::emacs-19p | |
| 1191 ;; Emacs 19 has kill-buffer-hook, v18 doesn't. | |
| 1192 (defun gnats::kill-buffer-hook () | |
| 1193 "Unlock a GNATS buffer that is being killed." | |
| 1194 (gnats:unlock-buffer nil)) | |
| 1195 (defun gnats:kill-buffer (buf) | |
| 1196 "Safely kill a GNATS buffer." | |
| 1197 (interactive "bKill buffer: ") | |
| 1198 (if (equal buf (buffer-name)) | |
| 1199 (gnats:unlock-buffer (get-buffer buf))) | |
| 1200 (kill-buffer buf))) | |
| 1201 | |
| 1202 (defun gnats:unlock-buffer-force (&optional buf) | |
| 1203 "Force a buffer to be unlocked, even if it isn't." | |
| 1204 (interactive) | |
| 1205 (if (null buf) | |
| 1206 (setq buf (current-buffer)) | |
| 1207 (set-buffer buf)) | |
| 1208 (gnats:unlock-buffer buf t)) | |
| 1209 | |
| 1210 (defun gnats::delete-file (filename) | |
| 1211 (if (file-readable-p filename) (delete-file filename))) | |
| 1212 | |
| 1213 (defun gnats:unlock-buffer (&optional buf force) | |
| 1214 "Safely take a GNATS buffer out of gnats-mode." | |
| 1215 (interactive) | |
| 1216 (save-excursion | |
| 1217 (if (null buf) | |
| 1218 (setq buf (current-buffer)) | |
| 1219 (set-buffer buf)) | |
| 1220 (cond ((or force | |
| 1221 (not (buffer-modified-p buf)) | |
| 1222 (not gnats:::pr-locked) | |
| 1223 (y-or-n-p "Buffer modified; still unlock? ")) | |
| 1224 (if gnats:::pr-locked | |
| 1225 (gnats:unlock-pr-force gnats:::buffer-pr)) | |
| 1226 (if gnats:::pr-errors | |
| 1227 (kill-buffer gnats:::pr-errors)) | |
| 1228 (if gnats:::backupname | |
| 1229 (progn | |
| 1230 (gnats::delete-file gnats:::backupname) | |
| 1231 (if gnats:network-server | |
| 1232 (progn | |
| 1233 (gnats::delete-file (concat gnats:::backupname ".cat")) | |
| 1234 (gnats::delete-file (concat gnats:::backupname ".res")) | |
| 1235 (gnats::delete-file (concat gnats:::backupname ".sub")))))) | |
| 1236 (save-excursion | |
| 1237 (set-buffer buf) | |
| 1238 (let ((pr gnats:::buffer-pr)) | |
| 1239 (kill-all-local-variables) | |
| 1240 (text-mode) | |
| 1241 (make-local-variable 'gnats:::buffer-pr) | |
| 1242 (setq gnats:::buffer-pr pr) | |
| 1243 (use-local-map (copy-keymap (current-local-map))) | |
| 1244 (local-set-key | |
| 1245 "e" (function (lambda () (interactive) | |
| 1246 (gnats:edit-pr gnats:::buffer-pr)))) | |
| 1247 (set-visited-file-name nil) | |
| 1248 (setq buffer-read-only t) | |
| 1249 ;; When GNATS:KEEP-EDITED-BUFFERS is nil, we always put the | |
| 1250 ;; most recent PR in the *edited-pr* buffer. | |
| 1251 (or gnats:keep-edited-buffers | |
| 1252 (let ((old-buf (get-buffer (concat "*edited-pr*")))) | |
| 1253 (cond (old-buf | |
| 1254 (set-buffer old-buf) | |
| 1255 (set-buffer-modified-p nil) | |
| 1256 (kill-buffer old-buf))) | |
| 1257 (set-buffer buf) | |
| 1258 (rename-buffer (concat "*edited-pr*")))))) | |
| 1259 (and gnats:bury-edited-prs | |
| 1260 (if (get-buffer-window buf) | |
| 1261 (let ((win (selected-window))) | |
| 1262 (select-window (get-buffer-window buf)) | |
| 1263 (bury-buffer) | |
| 1264 (select-window win)) | |
| 1265 (bury-buffer buf)))) | |
| 1266 (t (error "PR unlock aborted."))))) | |
| 1267 | |
| 1268 (defun gnats::delete-backups (filename) | |
| 1269 (let ((l (file-name-all-completions | |
| 1270 (concat (file-name-nondirectory filename) ".~") | |
| 1271 (file-name-directory filename))) | |
| 1272 (dir (file-name-directory filename))) | |
| 1273 (while l | |
| 1274 (delete-file (concat dir (car l))) | |
| 1275 (setq l (cdr l))))) | |
| 1276 | |
| 1277 (defun gnats::reset-variables () | |
| 1278 (setq gnats::submitters nil | |
| 1279 gnats::responsibles nil | |
| 1280 gnats::categories nil)) | |
| 1281 | |
| 1282 (defun gnats::set-responsibles (&optional arg) | |
| 1283 (or (and (null arg) gnats::responsibles) | |
| 1284 (setq gnats::responsibles | |
| 1285 (gnats::get-list-from-file | |
| 1286 (if gnats:network-server | |
| 1287 "res" | |
| 1288 "responsible") "responsible"))) | |
| 1289 'gnats::try-responsible-completion) | |
| 1290 | |
| 1291 (defun gnats::try-responsible-completion (string predicate do-list) | |
| 1292 (let (entry) | |
| 1293 (and (not (assoc string gnats::responsibles)) | |
| 1294 (setq entry (gnats::real-pr-addr string)) | |
| 1295 (gnats::push entry gnats::responsibles))) | |
| 1296 (let* ((completion-ignore-case t)) | |
| 1297 (if do-list | |
| 1298 (all-completions string gnats::responsibles predicate) | |
| 1299 (try-completion string gnats::responsibles predicate)))) | |
| 1300 | |
| 1301 (defun gnats::set-categories (&optional arg) | |
| 1302 (or (and (null arg) gnats::categories) | |
| 1303 (setq gnats::categories | |
| 1304 (gnats::get-list-from-file | |
| 1305 (if gnats:network-server | |
| 1306 "cat" | |
| 1307 "categories") "categories")))) | |
| 1308 | |
| 1309 (defun gnats::set-submitters (&optional arg) | |
| 1310 (or (and (null arg) gnats::submitters) | |
| 1311 (setq gnats::submitters | |
| 1312 (gnats::get-list-from-file | |
| 1313 (if gnats:network-server | |
| 1314 "sub" | |
| 1315 "submitters") "submitters")))) | |
| 1316 | |
| 1317 (defun gnats::get-list (buffer) | |
| 1318 (let (result) | |
| 1319 (save-excursion | |
| 1320 (set-buffer buffer) | |
| 1321 (goto-char (point-min)) | |
| 1322 (while (re-search-forward "^[^#:]+" nil t) | |
| 1323 (gnats::push (list (gnats::bm 0)) result))) | |
| 1324 (reverse result))) | |
| 1325 | |
| 1326 (defun gnats::parse-line () | |
| 1327 (let ((end (progn (end-of-line) (point))) | |
| 1328 (p (match-beginning 0)) | |
| 1329 l) | |
| 1330 (goto-char p) | |
| 1331 (while (search-forward ":" end 'move) | |
| 1332 (gnats::push (buffer-substring p (match-beginning 0)) l) | |
| 1333 (skip-chars-forward " " end) | |
| 1334 (setq p (point))) | |
| 1335 (gnats::push (buffer-substring p end) l) | |
| 1336 (reverse l))) | |
| 1337 | |
| 1338 (defun gnats::get-alist (buffer) | |
| 1339 (let (result) | |
| 1340 (save-excursion | |
| 1341 (set-buffer buffer) | |
| 1342 (goto-char (point-min)) | |
| 1343 (while (re-search-forward "^[^#]" nil t) | |
| 1344 (gnats::push (gnats::parse-line) result))) | |
| 1345 (reverse result))) | |
| 1346 | |
| 1347 (defun gnats::get-list-from-file (filename desc) | |
| 1348 (let ((buf nil) | |
| 1349 (result nil)) | |
| 1350 (message "Parsing the %s file..." desc) | |
| 1351 (save-excursion | |
| 1352 (let ((bn gnats:::backupname)) | |
| 1353 (setq buf (get-buffer-create " *gnats-grok*")) | |
| 1354 (set-buffer buf) | |
| 1355 (setq buffer-read-only nil) | |
| 1356 (erase-buffer) | |
| 1357 (insert-file-contents | |
| 1358 (if gnats:network-server | |
| 1359 (concat bn "." filename) | |
| 1360 (format "%s/gnats-adm/%s" gnats:root filename))) | |
| 1361 (setq result (gnats::get-alist buf)) | |
| 1362 (kill-buffer buf)) | |
| 1363 (message "Parsing the %s file...done." desc) | |
| 1364 result))) | |
| 1365 | |
| 1366 (defun gnats::get-pr-category (number) | |
| 1367 "Return the category for the problem report NUMBER." | |
| 1368 (let ((buf nil) | |
| 1369 (result nil)) | |
| 1370 (save-excursion | |
| 1371 (setq buf (get-buffer-create " *gnats-index*")) | |
| 1372 (set-buffer buf) | |
| 1373 (setq buffer-read-only nil) | |
| 1374 (erase-buffer) | |
| 1375 (insert-file-contents (format "%s/gnats-adm/index" gnats:root)) | |
| 1376 (goto-char (point-min)) | |
| 1377 (setq result | |
| 1378 (catch 'res | |
| 1379 (while (search-forward (format "/%s:" number) nil t) | |
| 1380 (beginning-of-line) | |
| 1381 (if (looking-at (format "\\([^/]+\\)/%s:" number)) | |
| 1382 (throw 'res (gnats::bm 1)) | |
| 1383 (end-of-line))) | |
| 1384 nil)) | |
| 1385 (kill-buffer buf)) | |
| 1386 (or result (signal 'gnats::no-such-pr (list number))))) | |
| 1387 | |
| 1388 (defsubst gnats::has-slash (string) | |
| 1389 (memq t (mapcar (function (lambda (char) (= char ?/))) string))) | |
| 1390 | |
| 1391 (or (boundp 'view-hook) (setq view-hook nil)) | |
| 1392 | |
| 1393 ;;;###autoload | |
| 1394 (fset 'view-pr 'gnats:view-pr) | |
| 1395 ;;;###autoload | |
| 1396 (defun gnats:view-pr (&optional id) | |
| 1397 "Visit the problem report named by the string ID. While viewing, press | |
| 1398 'e' to edit the currently viewed PR." | |
| 1399 (interactive "sPR number: ") | |
| 1400 (let (pr category temp-name buffer) | |
| 1401 (if (string= id "") | |
| 1402 (message "view-pr: must specify a PR") | |
| 1403 (if (or (gnats::has-slash id) gnats:network-server) | |
| 1404 (setq pr id) | |
| 1405 (and (setq category (gnats::get-pr-category id)) | |
| 1406 (setq pr (format "%s/%s" category id)))) | |
| 1407 (let ((view-hook (default-value 'view-hook)) | |
| 1408 buf func) | |
| 1409 (if (and pr | |
| 1410 (or gnats:network-server | |
| 1411 (setq buf (get-buffer pr)) | |
| 1412 (file-exists-p (format "%s/%s" gnats:root pr)))) | |
| 1413 (if buf | |
| 1414 (save-excursion | |
| 1415 (set-buffer buf) | |
| 1416 (goto-char (point-min)) | |
| 1417 (view-buffer buf)) | |
| 1418 (setq func | |
| 1419 (function | |
| 1420 (lambda () | |
| 1421 (and gnats::emacs-19p (rename-buffer pr)) | |
| 1422 (setq mode-line-buffer-identification | |
| 1423 (format "Viewing %s" pr)) | |
| 1424 (make-local-variable 'gnats:::buffer-pr) | |
| 1425 (setq gnats:::buffer-pr pr) | |
| 1426 (use-local-map (copy-keymap (current-local-map))) | |
| 1427 (local-set-key | |
| 1428 "e" | |
| 1429 (function (lambda () (interactive) | |
| 1430 (gnats:edit-pr gnats:::buffer-pr))))))) | |
| 1431 (if (fboundp 'add-hook) | |
| 1432 (add-hook 'view-hook func) | |
| 1433 (setq view-hook func)) | |
| 1434 (if gnats:network-server | |
| 1435 (gnats:net-view-pr id buf) | |
| 1436 (view-file (format "%s/%s" gnats:root pr)))) | |
| 1437 (signal 'gnats::no-such-pr (list id))))))) | |
| 1438 | |
| 1439 (defun gnats:net-view-pr (id buf) | |
| 1440 "Use the network query to view problem report ID." | |
| 1441 (require 'view) | |
| 1442 (let ((result nil) | |
| 1443 (curr (current-buffer))) | |
| 1444 (unwind-protect | |
| 1445 (if (not buf) | |
| 1446 (progn | |
| 1447 ;; XXX fix this to include the category | |
| 1448 (setq buf (get-buffer-create (concat "*view-pr " id "*"))) | |
| 1449 (setq buffer-read-only nil))) | |
| 1450 (let ((command (append (list 'funcall) | |
| 1451 (list ''call-process) | |
| 1452 (list gnats:::nquery-pr nil buf nil) | |
| 1453 (list id "--full" "--host" | |
| 1454 gnats:network-server)))) | |
| 1455 (save-excursion | |
| 1456 (set-buffer buf) | |
| 1457 (erase-buffer)) | |
| 1458 (let ((default-directory (gnats::find-safe-default-directory))) | |
| 1459 (setq result (gnats::rw buf (eval command)))) | |
| 1460 (save-excursion | |
| 1461 (set-buffer buf) | |
| 1462 (and (/= 0 result) | |
| 1463 (goto-char (point-min)) | |
| 1464 (cond | |
| 1465 ((or (looking-at (concat gnats:::query-regexp " no PRs matched")) | |
| 1466 (looking-at (concat gnats:::query-regexp " couldn.t find PR.*"))) | |
| 1467 (signal 'gnats::no-such-pr nil)) | |
| 1468 (t (signal 'gnats::error | |
| 1469 (list (buffer-substring (point-min) | |
| 1470 (- (point-max) 1))))) | |
| 1471 )))) | |
| 1472 (switch-to-buffer buf) | |
| 1473 (if (fboundp 'view-mode-enter) | |
| 1474 (view-mode-enter curr 'kill-buffer) | |
| 1475 (view-mode curr 'kill-buffer)) | |
| 1476 (set-buffer-modified-p nil) | |
| 1477 (make-local-variable 'gnats:::buffer-pr) | |
| 1478 (if (not (gnats::has-slash id)) (gnats::rename-buffer)) | |
| 1479 (setq buffer-read-only t) | |
| 1480 (setq buffer-undo-list nil) ;flush undo list | |
| 1481 (goto-char (point-min))) | |
| 1482 (zerop result))) | |
| 1483 | |
| 1484 (fset 'change-gnats 'gnats:change-type) | |
| 1485 (fset 'gnats-change-type 'gnats:change-type) | |
| 1486 (defun gnats:change-type (type) | |
| 1487 "Change the GNATS database type in use." | |
| 1488 (interactive | |
| 1489 (list | |
| 1490 (progn | |
| 1491 (if (not gnats:::types) | |
| 1492 (error "Value of gnats:::types has to be non-nil.")) | |
| 1493 (let* ((completion-ignore-case t)) | |
| 1494 (completing-read "Use GNATS database type: " gnats:::types nil t))))) | |
| 1495 (let ((newlist (car (cdr (assoc type gnats:::types))))) | |
| 1496 (setq gnats:root (car newlist) | |
| 1497 gnats:libdir (car (cdr newlist)) | |
| 1498 gnats:::query-pr (car (cdr (cdr newlist))) | |
| 1499 gnats:::nquery-pr (car (cdr (cdr (cdr newlist)))) | |
| 1500 gnats:::query-regexp (car (cdr (cdr (cdr (cdr newlist))))) | |
| 1501 ) | |
| 1502 (gnats::reset-variables))) | |
| 1503 | |
| 1504 (defun gnats::find-pr-buffer (pr) | |
| 1505 "*Find the buffer currently editing PR, returning the buffer or nil." | |
| 1506 (if (gnats::has-slash pr) | |
| 1507 ;; return the buffer if it exists | |
| 1508 (get-buffer pr) | |
| 1509 (let (buflist buf | |
| 1510 (name (concat "/" pr "$"))) | |
| 1511 (setq buflist | |
| 1512 (delq nil | |
| 1513 (mapcar | |
| 1514 (function (lambda (buf) | |
| 1515 (if (string-match name (buffer-name buf)) | |
| 1516 buf))) | |
| 1517 (buffer-list)))) | |
| 1518 ;; If we found one---and only one---then sanity-check some things | |
| 1519 ;; about it before we try to use it. | |
| 1520 (if (eq (length buflist) 1) | |
| 1521 (progn | |
| 1522 (setq buf (car buflist)) | |
| 1523 (save-excursion | |
| 1524 (set-buffer buf) | |
| 1525 ;; We make sure that we have a value for the PR, it's in | |
| 1526 ;; the right mode, and that the buffer's writable. If so, | |
| 1527 ;; we'll return the buffer, otherwise the result of the if | |
| 1528 ;; gets kicked back up to return nil. | |
| 1529 (if (and gnats:::buffer-pr | |
| 1530 (eq major-mode 'gnats:gnats-mode) | |
| 1531 (eq buffer-read-only nil)) | |
| 1532 buf))))))) | |
| 1533 | |
| 1534 ;;;###autoload | |
| 1535 (fset 'edit-pr 'gnats:edit-pr) | |
| 1536 ;;;###autoload | |
| 1537 (defun gnats:edit-pr (&optional id) | |
| 1538 "Edit the problem report named by the string ID." | |
| 1539 (interactive "sPR number: ") | |
| 1540 (if (string= id "") | |
| 1541 (message "edit-pr: must specify a PR to edit") | |
| 1542 (let (pr category newfile | |
| 1543 (buf (gnats::find-pr-buffer id))) | |
| 1544 (if buf | |
| 1545 (progn | |
| 1546 (switch-to-buffer buf) | |
| 1547 (message "Already editing PR %s." id)) | |
| 1548 (progn | |
| 1549 (if (or (gnats::has-slash id) gnats:network-server) | |
| 1550 (setq pr id) | |
| 1551 (and (setq category (gnats::get-pr-category id)) | |
| 1552 (setq pr (format "%s/%s" category id))))) | |
| 1553 (if (and pr (or gnats:network-server | |
| 1554 (file-exists-p (format "%s/%s" gnats:root pr)))) | |
| 1555 (progn | |
| 1556 (setq newfile (if gnats:network-server | |
| 1557 (gnats::make-temp-name) | |
| 1558 (format "%s/%s" gnats:root pr))) | |
| 1559 (gnats::lock pr newfile)) | |
| 1560 (signal 'gnats::no-such-pr (list id))))))) | |
| 1561 | |
| 1562 (defvar gnats:query-pr-default-options nil | |
| 1563 "*Default options to pass to query-pr.") | |
| 1564 (defsubst gnats::query-pr-default-options () | |
| 1565 (or gnats:query-pr-default-options | |
| 1566 (if (not gnats:network-server) | |
| 1567 (concat " --directory=" gnats:root " --print-path ") | |
| 1568 ""))) | |
| 1569 | |
| 1570 ;;;###autoload | |
| 1571 (fset 'query-pr 'gnats:query-pr) | |
| 1572 ;;;###autoload | |
| 1573 (defun gnats:query-pr (options) | |
| 1574 "Run query-pr, with user-specified args, and collect output in a buffer. | |
| 1575 While query-pr runs asynchronously, you can use the \\[next-error] command | |
| 1576 to find the text that the hits refer to." | |
| 1577 (interactive | |
| 1578 (list (apply | |
| 1579 'read-from-minibuffer "Run query-pr (with args): " | |
| 1580 (if gnats::emacs-19p | |
| 1581 (list (cons (gnats::query-pr-default-options) 1) | |
| 1582 nil nil 'gnats::query-pr-history) | |
| 1583 (list (gnats::query-pr-default-options) nil nil))))) | |
| 1584 (require 'compile) | |
| 1585 (compile-internal (concat | |
| 1586 (if gnats:network-server | |
| 1587 (format (concat gnats:::nquery-pr " --host %s ") | |
| 1588 gnats:network-server) | |
| 1589 (concat gnats:::query-pr " ")) | |
| 1590 options) | |
| 1591 "No more query-pr hits" (concat gnats:::query-pr " "))) | |
| 1592 | |
| 1593 (defun gnats::tr (string from to) | |
| 1594 (let ((s (copy-sequence string)) | |
| 1595 (len (length string))) | |
| 1596 (while (>= (setq len (1- len)) 0) | |
| 1597 (if (eq (aref s len) (string-to-char from)) | |
| 1598 (aset s len (string-to-char to)))) | |
| 1599 s)) | |
| 1600 | |
| 1601 ;; Redefine so that buffers with, say, g++/1234 embedded in them can be | |
| 1602 ;; autosaved. This was mostly copied from the Emacs 19.19 version. | |
| 1603 (defun gnats::make-auto-save-file-name () | |
| 1604 "Return file name to use for auto-saves of current buffer. | |
| 1605 Does not consider `auto-save-visited-file-name' as that variable is checked | |
| 1606 before calling this function. You can redefine this for customization. | |
| 1607 See also `auto-save-file-name-p'." | |
| 1608 ; Since the user may have his own make-auto-save-file-name, try not to | |
| 1609 ; use our custom one unless we have to. | |
| 1610 (if (or (eq major-mode gnats::mode-name) | |
| 1611 ; Heuristic for noticing a mail buffer based on a PR | |
| 1612 (string-match " PR .*/" (buffer-name))) | |
| 1613 (if buffer-file-name | |
| 1614 (concat (file-name-directory buffer-file-name) | |
| 1615 "#" | |
| 1616 (file-name-nondirectory buffer-file-name) | |
| 1617 "#") | |
| 1618 ;; For non-file bfr, use bfr name and Emacs pid. | |
| 1619 (expand-file-name (format "#%s#%s#" | |
| 1620 (gnats::tr (buffer-name) "/" ":") | |
| 1621 (make-temp-name "")))) | |
| 1622 (gnats::real-make-auto-save-file-name))) | |
| 1623 | |
| 1624 (if (not (fboundp 'gnats::real-make-auto-save-file-name)) | |
| 1625 (progn (fset 'gnats::real-make-auto-save-file-name | |
| 1626 (symbol-function 'make-auto-save-file-name)) | |
| 1627 (fset 'make-auto-save-file-name 'gnats::make-auto-save-file-name))) | |
| 1628 | |
| 1629 (defun gnats::make-temp-name () | |
| 1630 (make-temp-name | |
| 1631 (concat (expand-file-name (file-name-as-directory gnats::tmpdir)) "gnats"))) | |
| 1632 | |
| 1633 ;; Below this is the GNATS summary mode I've written. Not quite 100% | |
| 1634 ;; integrated yet. | |
| 1635 | |
| 1636 ;; Temporary variables which are made buffer-local, but which the byte | |
| 1637 ;; compiler complaints about if the defvars aren't here. | |
| 1638 (defvar gnats:::PRs nil | |
| 1639 "List of problem reports to be summarized. This variable is buffer local.") | |
| 1640 (make-variable-buffer-local 'gnats:::PRs) | |
| 1641 (defvar gnats::options nil | |
| 1642 "Options used for nquery-pr in the current GNATS summary buffer. | |
| 1643 This variable is buffer local.") | |
| 1644 (make-variable-buffer-local 'gnats::options) | |
| 1645 | |
| 1646 ;; Note: "release" stays out of this list. The "release" field is | |
| 1647 ;; unrestricted; the customer could put any old junk in there, and | |
| 1648 ;; often does. | |
| 1649 (defvar gnats:::limited-fields '(category confidential severity priority responsible state class customer-id) | |
| 1650 "PR fields for which the possible values are limited in range.") | |
| 1651 | |
| 1652 (defvar gnats::summary-sort-function nil | |
| 1653 "Holds a function used to filter and sort PRs before displaying a report. | |
| 1654 This filtering does not affect the stored PR information, so an invocation | |
| 1655 of gnats:summary-redisplay after changing this variable will do the right thing.") | |
| 1656 | |
| 1657 (defun gnats:::prompt-for-pr-number (default) | |
| 1658 (let ((val (read-input (if default | |
| 1659 (format "PR number (default %d): " default) | |
| 1660 "PR number: ")))) | |
| 1661 (if (and default (string= val "")) | |
| 1662 default | |
| 1663 (setq val (string-to-number val)) | |
| 1664 (if (and (integerp val) | |
| 1665 (> val 0)) | |
| 1666 val | |
| 1667 (error "PR number must be a positive integer."))))) | |
| 1668 | |
| 1669 (defun gnats:summary-edit (num) | |
| 1670 "Edit the PR referenced by the current text, or get a PR number from user. | |
| 1671 If a numeric prefix is given, it is used as the PR number. | |
| 1672 If a non-numeric prefix is given, or the text at (point) doesn't have the | |
| 1673 gnats::pr-number property, the user is prompted for a PR number." | |
| 1674 (interactive (list | |
| 1675 (let ((x (get-text-property (point) 'gnats::pr-number))) | |
| 1676 (cond ((numberp current-prefix-arg) current-prefix-arg) | |
| 1677 (current-prefix-arg (gnats:::prompt-for-pr-number x)) | |
| 1678 (x x) | |
| 1679 (t (gnats:::prompt-for-pr-number nil)))))) | |
| 1680 (message "Editing PR %d..." num) | |
| 1681 (gnats:edit-pr (number-to-string num))) | |
| 1682 | |
| 1683 (defun gnats:summary-view (num) | |
| 1684 "View the PR referenced by the current text, or get a PR number from user. | |
| 1685 If a numeric prefix is given, it is used as the PR number. | |
| 1686 If a non-numeric prefix is given, or the text at (point) doesn't have the | |
| 1687 gnats::pr-number property, the user is prompted for a PR number." | |
| 1688 (interactive (list | |
| 1689 (let ((x (get-text-property (point) 'gnats::pr-number))) | |
| 1690 (cond ((numberp current-prefix-arg) current-prefix-arg) | |
| 1691 (current-prefix-arg (gnats:::prompt-for-pr-number x)) | |
| 1692 (x x) | |
| 1693 (t (gnats:::prompt-for-pr-number nil)))))) | |
| 1694 (message "Viewing PR %d..." num) | |
| 1695 (gnats:view-pr (number-to-string num))) | |
| 1696 | |
| 1697 (defun gnats:summary-quit nil | |
| 1698 "Quit GNATS summary mode." | |
| 1699 (interactive) | |
| 1700 (kill-buffer nil)) | |
| 1701 | |
| 1702 (defun gnats:summary-revert nil | |
| 1703 "Fetch PR data from server and rebuild the summary." | |
| 1704 (interactive) | |
| 1705 (gnats:summ-pr gnats::options)) | |
| 1706 | |
| 1707 ;; Fetch field value from a PR. | |
| 1708 (defsubst gnats:::fieldval (pr field) | |
| 1709 (let ((x (assq field pr))) | |
| 1710 (if x (cdr x) nil))) | |
| 1711 | |
| 1712 ;; Taken from gnus-parse-simple-format in (ding)Gnus 0.88. | |
| 1713 ;; Extended to handle width-1 fields more efficiently. | |
| 1714 ;; Extended to permit "*" to flag truncation. | |
| 1715 ;; Modified to call kqpr* functions instead of gnus-*. | |
| 1716 (defun gnats:::parse-summary-format (format spec-alist) | |
| 1717 ;; This function parses the FORMAT string with the help of the | |
| 1718 ;; SPEC-ALIST and returns a list that can be eval'ed to return the | |
| 1719 ;; string. The list will consist of the symbol `format', a format | |
| 1720 ;; specification string, and a list of forms depending on the | |
| 1721 ;; SPEC-ALIST. | |
| 1722 (let ((max-width 0) | |
| 1723 spec flist fstring b newspec max-width elem beg trunc-noisy) | |
| 1724 (save-excursion | |
| 1725 (set-buffer (get-buffer-create " *qpr work*")) | |
| 1726 (erase-buffer) | |
| 1727 (insert format) | |
| 1728 (goto-char (point-min)) | |
| 1729 (while (re-search-forward "%-?[0-9]*\\([,*]-?[0-9]*\\)*\\(.\\)\\(.\\)?" nil t) | |
| 1730 (setq spec (string-to-char (buffer-substring (match-beginning 2) | |
| 1731 (match-end 2)))) | |
| 1732 ;; First check if there are any specs that look anything like | |
| 1733 ;; "%12,12A", ie. with a "max width specification". These have | |
| 1734 ;; to be treated specially. | |
| 1735 (if (setq beg (match-beginning 1)) | |
| 1736 (setq max-width | |
| 1737 (string-to-int | |
| 1738 (buffer-substring (1+ (match-beginning 1)) (match-end 1))) | |
| 1739 trunc-noisy (= ?* (char-after beg))) | |
| 1740 (setq max-width 0) | |
| 1741 (setq beg (match-beginning 2)) | |
| 1742 (setq trunc-noisy nil)) | |
| 1743 ;; Find the specification from `spec-alist'. | |
| 1744 (if (not (setq elem (cdr (assq spec spec-alist)))) | |
| 1745 (setq elem '("*" ?s))) | |
| 1746 ;; Treat user defined format specifiers specially | |
| 1747 (and (eq (car elem) 'user-defined) | |
| 1748 (setq elem | |
| 1749 (list | |
| 1750 (list (intern (concat "gnats:user-format-function-" | |
| 1751 (buffer-substring | |
| 1752 (match-beginning 3) | |
| 1753 (match-end 3)))) | |
| 1754 'pr) | |
| 1755 ?s)) | |
| 1756 (delete-region (match-beginning 3) (match-end 3))) | |
| 1757 (if (not (zerop max-width)) | |
| 1758 (if (and (= max-width 1) | |
| 1759 (memq (car (cdr elem)) '(?c ?s))) | |
| 1760 (let ((el (car elem))) | |
| 1761 (cond ((= (car (cdr elem)) ?c) | |
| 1762 (setq newspec ?c) | |
| 1763 (setq flist (cons el flist))) | |
| 1764 ((= (car (cdr elem)) ?s) | |
| 1765 (setq newspec ?c) | |
| 1766 (setq flist (cons (list 'string-to-char el) flist))) | |
| 1767 (t | |
| 1768 (error "eep!")))) | |
| 1769 (let ((el (car elem))) | |
| 1770 (cond ((= (car (cdr elem)) ?c) | |
| 1771 (setq el (list 'char-to-string el))) | |
| 1772 ((= (car (cdr elem)) ?d) | |
| 1773 (numberp el) (setq el (list 'int-to-string el)))) | |
| 1774 (setq flist (cons (list 'gnats:::format-max-width | |
| 1775 el max-width trunc-noisy) | |
| 1776 flist)) | |
| 1777 (setq newspec ?s))) | |
| 1778 (setq flist (cons (car elem) flist)) | |
| 1779 (setq newspec (car (cdr elem)))) | |
| 1780 ;; Remove the old specification (and possibly a ",12" string). | |
| 1781 (delete-region beg (match-end 2)) | |
| 1782 ;; Insert the new specification. | |
| 1783 (goto-char beg) | |
| 1784 (insert newspec)) | |
| 1785 (setq fstring (buffer-substring 1 (point-max))) | |
| 1786 (kill-buffer nil)) | |
| 1787 (cons 'format (cons fstring (nreverse flist))))) | |
| 1788 | |
| 1789 ;; Try to keep this list similar to the command-line options for nquery-pr, | |
| 1790 ;; just to avoid confusing people. If there are differences, it won't break | |
| 1791 ;; anything. | |
| 1792 (defvar gnats::summary-format-alist | |
| 1793 (list (list ?r '(symbol-name (gnats:::fieldval pr 'responsible)) ?s) | |
| 1794 (list ?c '(symbol-name (gnats:::fieldval pr 'category)) ?s) | |
| 1795 (list ?C '(symbol-name (gnats:::fieldval pr 'confidential)) ?s) | |
| 1796 (list ?e '(symbol-name (gnats:::fieldval pr 'severity)) ?s) | |
| 1797 (list ?O '(gnats:::fieldval pr 'originator) ?s) | |
| 1798 (list ?p '(symbol-name (gnats:::fieldval pr 'priority)) ?s) | |
| 1799 (list ?L '(symbol-name (gnats:::fieldval pr 'class)) ?s) | |
| 1800 (list ?S '(symbol-name (gnats:::fieldval pr 'customer-id)) ?s) ; == submitter | |
| 1801 (list ?s '(symbol-name (gnats:::fieldval pr 'state)) ?s) | |
| 1802 | |
| 1803 (list ?n '(gnats:::fieldval pr 'number) ?d) | |
| 1804 (list ?R '(gnats:::fieldval pr 'release) ?s) | |
| 1805 (list ?j '(gnats:::fieldval pr 'synopsis) ?s) | |
| 1806 (list ?y '(gnats:::fieldval pr 'synopsis) ?s) | |
| 1807 (list ?u 'user-defined ?s) | |
| 1808 )) | |
| 1809 | |
| 1810 (defun gnats:::format-max-width (str len noisy) | |
| 1811 (if (> (length str) (if gnats::emacs-19p (abs len) len)) | |
| 1812 (if noisy | |
| 1813 (if (< len 0) | |
| 1814 (concat "*" (substring str (1+ len))) | |
| 1815 (concat (substring str 0 (- len 1)) "*")) | |
| 1816 (if (< len 0) | |
| 1817 (substring str len) | |
| 1818 (substring str 0 len))) | |
| 1819 str)) | |
| 1820 | |
| 1821 ;; Redisplay the summary in the current buffer. | |
| 1822 (defvar gnats::format-string | |
| 1823 "%5n %-4,4c %,1e%,1p %-8,8r %,2s %-10*10S %-10*-10R %j\n" | |
| 1824 "Format string for PR summary text. | |
| 1825 | |
| 1826 If you've used format strings in (ding)Gnus, this will be familiar. | |
| 1827 | |
| 1828 Most text is copied straight through verbatim. Use \"%\" to indicate a | |
| 1829 non-fixed field. | |
| 1830 | |
| 1831 It can be followed by a number, indicating minimum width, a separator character | |
| 1832 (\",\" or \"*\"), and another number, indicating maximum width. These fields | |
| 1833 are optional, except that the separator must be present if the maximum width is | |
| 1834 specified. Whitespace padding will be on the left unless the first number is | |
| 1835 negative. Truncation of the field will be done on the right, unless the second | |
| 1836 number is negative. If the separator character is \"*\", a \"*\" will be used | |
| 1837 to indicate that truncation has been done; otherwise, it will be done silently. | |
| 1838 | |
| 1839 After the \"%\" and optional width parameters, a letter is expected. Most of | |
| 1840 the letters are chosen to match the command-line options of `nquery-pr'. | |
| 1841 | |
| 1842 %r \"Responsible\" field. | |
| 1843 %c \"Category\" field. | |
| 1844 %C \"Confidential\" field. | |
| 1845 %e \"Severity\" field. | |
| 1846 %O \"Originator\" field. | |
| 1847 %p \"Priority\" field. | |
| 1848 %L \"Class\" field. | |
| 1849 %S \"Customer-id\" (\"submitter\") field. | |
| 1850 %s \"State\" field. | |
| 1851 %n \"Number\" field. | |
| 1852 %R \"Release\" field. | |
| 1853 %j, %y \"Synopsis\" field. (\"j\" as in \"subJect\") | |
| 1854 %u Special: The next character is examined, and the function | |
| 1855 gnats:user-format-function-<char> is invoked. One argument, the list | |
| 1856 of (FIELD . VALUE) pairs, is passed. | |
| 1857 | |
| 1858 Any newlines you wish to have used must be included in this string; no | |
| 1859 additional ones will be provided. | |
| 1860 | |
| 1861 If the value is not a string, it is assumed to be a function which can | |
| 1862 be funcalled to return a format string, to be interpreted as above.") | |
| 1863 | |
| 1864 (defun gnats:summary-redisplay nil | |
| 1865 "Redisplay summary of stored GNATS data. | |
| 1866 This is useful if you change your filtering criteria or format string but | |
| 1867 do not wish to update the GNATS data by contacting the server." | |
| 1868 (interactive) | |
| 1869 (let (prs | |
| 1870 (buffer-read-only nil) | |
| 1871 format-form fmt) | |
| 1872 ;; Do this early, so if we're in the wrong buffer we blow up without | |
| 1873 ;; trashing the user's data. | |
| 1874 (setq prs (if gnats::summary-sort-function | |
| 1875 (funcall gnats::summary-sort-function | |
| 1876 (apply 'list gnats:::PRs)) | |
| 1877 gnats:::PRs)) | |
| 1878 ;; No wrapping -- ick! | |
| 1879 (if gnats::emacs-19p | |
| 1880 (buffer-disable-undo) | |
| 1881 (buffer-flush-undo (current-buffer))) | |
| 1882 (erase-buffer) | |
| 1883 (setq fmt (if (stringp gnats::format-string) | |
| 1884 gnats::format-string | |
| 1885 (funcall gnats::format-string))) | |
| 1886 (setq format-form (gnats:::parse-summary-format fmt | |
| 1887 gnats::summary-format-alist)) | |
| 1888 (mapcar (function | |
| 1889 (lambda (pr) | |
| 1890 (let ((start (point))) | |
| 1891 (insert (eval format-form)) | |
| 1892 ;; Magic. | |
| 1893 (put-text-property start (point) 'gnats::pr-number | |
| 1894 (gnats:::fieldval pr 'number)) | |
| 1895 ))) | |
| 1896 prs) | |
| 1897 (goto-char (point-min)) | |
| 1898 (buffer-enable-undo) | |
| 1899 (set-buffer-modified-p nil) | |
| 1900 )) | |
| 1901 | |
| 1902 (defvar gnats-summary-mode-map | |
| 1903 (let ((map (copy-keymap text-mode-map))) | |
| 1904 (if gnats::emacs-19p (suppress-keymap map)) | |
| 1905 ;; basic mode stuff | |
| 1906 (define-key map "g" 'gnats:summary-revert) | |
| 1907 (define-key map "q" 'gnats:summary-quit) | |
| 1908 (define-key map "r" 'gnats:summary-redisplay) | |
| 1909 ;; do stuff to PRs | |
| 1910 (define-key map "e" 'gnats:summary-edit) | |
| 1911 (define-key map "v" 'gnats:summary-view) | |
| 1912 ;; navigation | |
| 1913 (define-key map "n" 'next-line) | |
| 1914 (define-key map "p" 'previous-line) | |
| 1915 map) | |
| 1916 "Keymap for GNATS summary mode.") | |
| 1917 | |
| 1918 (defun gnats-summary-mode nil | |
| 1919 "Major mode for problem report summary. | |
| 1920 | |
| 1921 You can use \\[gnats:summary-view] to view the PR specified by the | |
| 1922 current line, or \\[gnats:summary-edit] to edit it. Typing | |
| 1923 \\[gnats:summary-revert] will update the PR list. | |
| 1924 | |
| 1925 Special commands: | |
| 1926 \\{gnats-summary-mode-map} | |
| 1927 | |
| 1928 Entering GNATS summary mode will invoke any hooks listed in the variable | |
| 1929 gnats-summary-mode-hook. It will also use text-mode-hook, since the summary | |
| 1930 mode is built on top of text mode." | |
| 1931 (interactive) | |
| 1932 (text-mode) | |
| 1933 ; (make-local-variable 'gnats:::PRs) | |
| 1934 ; (make-local-variable 'gnats::options) | |
| 1935 (setq buffer-read-only t) | |
| 1936 (setq truncate-lines t) | |
| 1937 (setq major-mode 'gnats-summary-mode) | |
| 1938 (setq mode-name "GNATS Summary") | |
| 1939 (use-local-map gnats-summary-mode-map) | |
| 1940 (run-hooks 'gnats-summary-mode-hook) | |
| 1941 ) | |
| 1942 | |
| 1943 ;;;###autoload | |
| 1944 (fset 'summ-pr 'gnats:summ-pr) | |
| 1945 ;;;###autoload | |
| 1946 (defun gnats:summ-pr (options) | |
| 1947 "Run query-pr, with user-specified args, and display a pretty summary. | |
| 1948 Well, display a summary, at least." | |
| 1949 (interactive | |
| 1950 (list | |
| 1951 (if (not gnats::emacs-19p) | |
| 1952 (error "GNATS summary mode will only work with emacs 19.") | |
| 1953 (apply | |
| 1954 'read-from-minibuffer "Run query-pr (with args): " | |
| 1955 (if gnats::emacs-19p | |
| 1956 (list (cons (gnats::query-pr-default-options) 1) | |
| 1957 nil nil 'gnats::query-pr-history) | |
| 1958 (list (gnats::query-pr-default-options) nil nil)))))) | |
| 1959 (let ((buf (get-buffer-create "*gnats-summ-pr-temp*")) | |
| 1960 (prs nil) | |
| 1961 pr fieldname value p) | |
| 1962 ; (save-excursion | |
| 1963 (set-buffer buf) | |
| 1964 (if gnats::emacs-19p | |
| 1965 (buffer-disable-undo) | |
| 1966 (buffer-flush-undo buf)) | |
| 1967 (erase-buffer) | |
| 1968 ;; calling nquery-pr directly would be better, but I'd need a "split" | |
| 1969 ;; function of some sort to break apart the options string. | |
| 1970 (message "Fetching GNATS data...") | |
| 1971 (call-process "sh" nil buf nil "-c" | |
| 1972 (concat | |
| 1973 (if gnats:network-server | |
| 1974 (format (concat gnats:::nquery-pr " --host %s ") | |
| 1975 gnats:network-server) | |
| 1976 (concat gnats:::query-pr " ")) | |
| 1977 options)) | |
| 1978 ;; um, okay, how to i check for errors? | |
| 1979 (goto-char (point-min)) | |
| 1980 (setq pr nil) | |
| 1981 (while (looking-at "ld.so: warning:") | |
| 1982 (forward-line 1)) | |
| 1983 (while (not (eobp)) | |
| 1984 (while (looking-at ">\\([a-zA-Z-]+\\):") | |
| 1985 (setq fieldname (intern | |
| 1986 (downcase | |
| 1987 (buffer-substring (match-beginning 1) | |
| 1988 (match-end 1))))) | |
| 1989 (goto-char (match-end 0)) | |
| 1990 (while (looking-at "[ \t]") | |
| 1991 (forward-char 1)) | |
| 1992 (setq p (point)) | |
| 1993 (setq value (buffer-substring p (progn (end-of-line) (point)))) | |
| 1994 (cond ((eq fieldname 'number) | |
| 1995 (setq value (string-to-number value))) | |
| 1996 ((memq fieldname gnats:::limited-fields) | |
| 1997 (setq value (intern value)))) | |
| 1998 (setq pr (cons (cons fieldname value) pr)) | |
| 1999 (forward-char 1)) | |
| 2000 (if (looking-at "\n") | |
| 2001 (progn | |
| 2002 (setq prs (cons (nreverse pr) prs) | |
| 2003 pr nil) | |
| 2004 (forward-char 1))) | |
| 2005 ;; could be the result of --print-path | |
| 2006 (if (looking-at "/.*:0:$") | |
| 2007 (next-line 1)) | |
| 2008 (if (looking-at gnats:::query-regexp) | |
| 2009 ;; error message | |
| 2010 (progn | |
| 2011 (goto-char (match-end 0)) | |
| 2012 (while (looking-at "[ \t]") | |
| 2013 (forward-char 1)) | |
| 2014 (setq p (point)) | |
| 2015 (end-of-line) | |
| 2016 (setq value (buffer-substring p (point))) | |
| 2017 (error "Database query failed: %s" value))) | |
| 2018 ) | |
| 2019 (if pr | |
| 2020 (setq prs (cons (nreverse pr) prs))) | |
| 2021 (setq prs (nreverse prs)) | |
| 2022 | |
| 2023 ;; okay, now display it | |
| 2024 (pop-to-buffer (get-buffer-create "*gnats:summ-pr*")) | |
| 2025 (gnats-summary-mode) | |
| 2026 (setq gnats:::PRs prs) | |
| 2027 (setq gnats::options options) | |
| 2028 (gnats:summary-redisplay) | |
| 2029 (message "Fetching GNATS data...done.") | |
| 2030 ; ) | |
| 2031 (kill-buffer buf) | |
| 2032 )) | |
| 2033 | |
| 2034 ;;;; end of gnats.el |