cgit.sxemacs.org Git - packages/blob - xemacs-packages/gnats/gnats.el

   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   "*Specifies 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 Responsible 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 support) 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                      (format " *%s-%d" 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
1023                         (concat (format  "--host=%s" gnats:network-server) args)
1024                        args
1025                        )
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