gnu/usr.bin/send-pr/send-pr-el.in

   1 ;;;; -*-emacs-lisp-*-
   2 ;;;;---------------------------------------------------------------------------
   3 ;;;;    EMACS interface for send-pr (by Heinz G. Seidl)
   4 ;;;;    Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
   5 ;;;;
   6 ;;;;    This file is part of the Problem Report Management System (GNATS)
   7 ;;;;    Copyright 1992, 1993, 1997 Cygnus Support
   8 ;;;;
   9 ;;;;    This program is free software; you can redistribute it and/or
  10 ;;;;    modify it under the terms of the GNU General Public
  11 ;;;;    License as published by the Free Software Foundation; either
  12 ;;;;    version 2 of the License, or (at your option) any later version.
  13 ;;;;
  14 ;;;;    This program 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 GNU
  17 ;;;;    General Public License for more details.
  18 ;;;;
  19 ;;;;    You should have received a copy of the GNU Library General Public
  20 ;;;;    License along with this program; if not, write to the Free
  21 ;;;;    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  22 ;;;;
  23 ;;;;---------------------------------------------------------------------------
  24 ;;;;
  25 ;;;;    This file contains the EMACS interface to the Problem Report Management
  26 ;;;;    System (GNATS):
  27 ;;;;
  28 ;;;;            - The `send-pr' command and the `send-pr-mode' for sending
  29 ;;;;              Problem Reports (PRs).
  30 ;;;;
  31 ;;;;    For more information about how to send a PR see send-pr(1).
  32 ;;;;
  33 ;;;;---------------------------------------------------------------------------
  34 ;;;;
  35 ;;;;    Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
  36 ;;;;    site/release specific strings during the configuration/installation
  37 ;;;;    process.
  38 ;;;;
  39 ;;;;    Install this file in your EMACS library directory.
  40 ;;;;
  41 ;;;;---------------------------------------------------------------------------
  42 ;;;;
  43 ;;;; $FreeBSD: src/gnu/usr.bin/send-pr/send-pr-el.in,v 1.3.6.3 2001/03/05 10:44:04 kris Exp $
  44 ;;;; $DragonFly: src/gnu/usr.bin/send-pr/Attic/send-pr-el.in,v 1.2 2003/06/17 04:25:48 dillon Exp $
  45
  46 (provide 'send-pr)
  47
  48 ;;;;---------------------------------------------------------------------------
  49 ;;;; Customization: put the following forms into your default.el file
  50 ;;;; (or into your .emacs)
  51 ;;;;---------------------------------------------------------------------------
  52
  53 ;(autoload 'send-pr-mode "send-pr"
  54 ;         "Major mode for sending problem reports." t)
  55
  56 ;(autoload 'send-pr "send-pr"
  57 ;                 "Command to create and send a problem report." t)
  58
  59 ;;;;---------------------------------------------------------------------------
  60 ;;;; End of Customization Section
  61 ;;;;---------------------------------------------------------------------------
  62
  63 (autoload 'server-buffer-done "server")
  64 (defvar server-buffer-clients nil)
  65 (defvar mail-self-blind nil)
  66 (defvar mail-default-reply-to nil)
  67
  68 (defconst send-pr::version "3.113")
  69
  70 (defvar gnats:root "/home/gnats"
  71   "*The top of the tree containing the GNATS database.")
  72
  73 ;;;;---------------------------------------------------------------------------
  74 ;;;; hooks
  75 ;;;;---------------------------------------------------------------------------
  76
  77 (defvar text-mode-hook nil)   ; we define it here in case it's not defined
  78 (defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")
  79
  80 ;;;;---------------------------------------------------------------------------
  81 ;;;; Domains and default values for (some of) the Problem Report fields;
  82 ;;;; constants and definitions.
  83 ;;;;---------------------------------------------------------------------------
  84
  85 (defconst gnats::emacs-19p
  86   (not (or (and (boundp 'epoch::version) epoch::version)
  87            (string-lessp emacs-version "19")))
  88   "Is this emacs v19?")
  89
  90 ;;; This has to be here rather than at the bottom of this file with
  91 ;;; the other utility functions because it is used by
  92 ;;; gnats::get-config, which is called when send-pr.el is being
  93 ;;; loaded (see the "defconst" below), before the whole file has been
  94 ;;; loaded.
  95
  96 (defun gnats::find-safe-default-directory (&optional buffer)
  97 "If the directory referred to by `default-directory' for the current
  98 buffer (or for optional argument BUFFER) does not exist, set it to the home
  99 directory of the current user if that exists, or to `/'.
 100
 101 Returns the final value of default-directory in the buffer."
 102   (let ((homedir (expand-file-name "~/")))
 103     (save-excursion
 104       (if buffer (set-buffer buffer))
 105       (if (not (file-exists-p default-directory))
 106           (if (file-exists-p homedir)
 107               (setq default-directory homedir)
 108             (setq default-directory "/")))
 109       default-directory)))
 110
 111 ;;; These may be changed during configuration/installation or by the individual
 112 ;;; user in his/her .emacs file.
 113 ;;;
 114 (defun gnats::get-config (var)
 115   (let ((shell-file-name "/bin/sh")
 116         (buf (generate-new-buffer " *GNATS config*"))
 117         ret)
 118     (save-excursion
 119       (set-buffer buf)
 120       (shell-command-on-region
 121        (point-min) (point-max)
 122        (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t)
 123       (goto-char (point-min))
 124       ; We have to use get-buffer, since shell-command-on-region will wipe
 125       ; out the buffer if there's no output from the command.
 126       (if (or (not (get-buffer "*Shell Command Output*"))
 127               (looking-at "^\\.:\\|/bin/sh:\\|\n"))
 128           (setq ret nil)
 129         (setq ret (buffer-substring (point-min) (- (point-max) 1)))))
 130     (if (and ret (string-equal ret "")) (setq ret nil))
 131     (kill-buffer buf)
 132     ret))
 133
 134 ;; const because it must match the script's value
 135 (defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@")
 136   "*Where the `gnats' subdirectory containing category lists lives.")
 137
 138 (defvar send-pr::sites nil
 139   "List of GNATS support sites; computed at runtime.")
 140 (defvar send-pr:default-site
 141   (or (gnats::get-config "GNATS_SITE") "freefall")
 142   "Default site to send bugs to.")
 143 (defvar send-pr:::site send-pr:default-site
 144   "The site to which a problem report is currently being submitted, or NIL
 145 if using the default site (buffer local).")
 146
 147 (defvar send-pr:::categories nil
 148   "Buffer local list of available categories, derived at runtime from
 149 send-pr:::site and send-pr::category-alist.")
 150 (defvar send-pr::category-alist nil
 151   "Alist of GNATS support sites and the categories supported at each; computed
 152 at runtime.")
 153
 154 ;;; Ideally we would get all the following values from a central database
 155 ;;; during runtime instead of having them here in the code.
 156 ;;;
 157 (defconst send-pr::fields
 158   (` (("Category" send-pr::set-categories
 159        (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
 160       ("Class" (("sw-bug") ("doc-bug") ("change-request") ("update") ("maintainer-update"))
 161        (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum)
 162       ("Confidential" (("yes") ("no"))
 163        (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
 164       ("Severity" (("non-critical") ("serious") ("critical"))
 165        (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
 166       ("Priority" (("low") ("medium") ("high"))
 167        (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
 168       ("Release" nil
 169        (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@"))
 170        text)
 171       ("Submitter-Id" nil
 172        (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) text)
 173       ("Synopsis" nil nil text
 174        (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
 175   "AList, keyed on the name of the field, of:
 176 1) The field name.
 177 2) The list of completions.  This can be a list, a function to call, or nil.
 178 3) The default value.
 179 4) The type of the field.
 180 5) A sub-function to call when changed.")
 181
 182 (defvar gnats::fields nil)
 183
 184 (defmacro gnats::push (i l)
 185   (` (setq (, l) (cons (,@ (list i l))))))
 186
 187 (defun send-pr::set-categories (&optional arg)
 188   "Get the list of categories for the current site out of
 189 send-pr::category-alist if there or from send-pr if not.  With arg, force
 190 update."
 191   ;;
 192   (let ((entry (assoc send-pr:::site send-pr::category-alist)))
 193     (or (and entry (null arg))
 194         (let ((oldpr (getenv "GNATS_ROOT")) cats)
 195           (send-pr::set-sites arg)
 196           (setenv "GNATS_ROOT" gnats:root)
 197           (setq cats (gnats::get-value-from-shell
 198                       "send-pr" "-CL" send-pr:::site))
 199           (setenv "GNATS_ROOT" oldpr)
 200           (if entry (setcdr entry cats)
 201             (setq entry (cons send-pr:::site cats))
 202             (gnats::push entry send-pr::category-alist))))
 203     (setq send-pr:::categories (cdr entry))))
 204
 205 (defun send-pr::set-sites (&optional arg)
 206   "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
 207 it to send-pr::sites.  With arg, force update."
 208   (or (and (null arg) send-pr::sites)
 209       (progn
 210         (setq send-pr::sites nil)
 211         (mapcar
 212          (function
 213           (lambda (file)
 214             (or (memq t (mapcar (function (lambda (x) (string= x file)))
 215                                 '("." ".." "pr-edit" "pr-addr")))
 216                 (not (file-readable-p file))
 217                 (gnats::push (list (file-name-nondirectory file))
 218                             send-pr::sites))))
 219          (directory-files (format "%s/gnats" send-pr:datadir) t))
 220         (setq send-pr::sites (reverse send-pr::sites)))))
 221
 222 (defconst send-pr::pr-buffer-name "*send-pr*"
 223   "Name of the temporary buffer, where the problem report gets composed.")
 224
 225 (defconst send-pr::err-buffer-name "*send-pr-error*"
 226   "Name of the temporary buffer, where send-pr error messages appear.")
 227
 228 (defvar send-pr:::err-buffer nil
 229   "The error buffer used by the current PR buffer.")
 230
 231 (defvar send-pr:::spawn-to-send nil
 232   "Whether or not send-pr-mode should spawn a send-pr process to send the PR.")
 233
 234 (defconst gnats::indent 17 "Indent for formatting the value.")
 235
 236 ;;;;---------------------------------------------------------------------------
 237 ;;;; `send-pr' - command for creating and sending of problem reports
 238 ;;;;---------------------------------------------------------------------------
 239
 240 (fset 'send-pr 'send-pr:send-pr)
 241 (defun send-pr:send-pr (&optional site)
 242   "Create a buffer and read in the result of `send-pr -P'.
 243 When finished with editing the problem report use \\[send-pr:submit-pr]
 244 to send the PR with `send-pr -b -f -'."
 245   ;;
 246   (interactive
 247    (if current-prefix-arg
 248        (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
 249                               send-pr:default-site))))
 250   (or site (setq site send-pr:default-site))
 251   (let ((buf (get-buffer send-pr::pr-buffer-name)))
 252     (if (or (not buf)
 253             (progn (switch-to-buffer buf)
 254                    (cond ((or (not (buffer-modified-p buf))
 255                               (y-or-n-p "Erase previous problem report? "))
 256                           (erase-buffer) t)
 257                          (t nil))))
 258         (send-pr::start-up site))))
 259
 260 (defun send-pr::start-up (site)
 261   (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
 262   (setq default-directory (expand-file-name "~/"))
 263   (auto-save-mode auto-save-default)
 264   (let ((oldpr (getenv "GNATS_ROOT"))
 265         (case-fold-search nil))
 266     (setenv "GNATS_ROOT" gnats:root)
 267     (send-pr::insert-template site)
 268     (setenv "GNATS_ROOT" oldpr)
 269     (goto-char (point-min))
 270     (if (looking-at "send-pr:")
 271         (cond ((looking-at "send-pr: .* does not have a categories list")
 272                (setq send-pr::sites nil)
 273                (error "send-pr: the GNATS site %s does not have a categories list" site))
 274               (t (error (buffer-substring (point-min) (point-max)))))
 275       (save-excursion
 276         ;; Clear cruft inserted by bdamaged .cshrcs
 277         (goto-char 1)
 278         (re-search-forward "^SEND-PR:")
 279         (delete-region 1 (match-beginning 0)))))
 280   (set-buffer-modified-p nil)
 281   (send-pr:send-pr-mode)
 282   (setq send-pr:::site site)
 283   (setq send-pr:::spawn-to-send t)
 284   (send-pr::set-categories)
 285   (if (null send-pr:::categories)
 286       (progn
 287         (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
 288         (kill-buffer nil)
 289         (message "send-pr: no categories found"))
 290     (or (stringp mail-default-reply-to)
 291         (setq mail-default-reply-to (getenv "REPLYTO")))
 292     (and mail-default-reply-to
 293          (gnats::set-mail-field "Reply-To" mail-default-reply-to))
 294     (and mail-self-blind
 295          (gnats::set-mail-field "BCC" (user-login-name)))
 296     (mapcar 'send-pr::maybe-change-field send-pr::fields)
 297     (gnats::position-on-field "Description")
 298     (message (substitute-command-keys
 299               "To send the problem report use: \\[send-pr:submit-pr]"))))
 300
 301 (defvar send-pr::template-alist nil
 302   "An alist containing the output of send-pr -P <sitename> for various sites.")
 303
 304 (defun send-pr::insert-template (site)
 305   (let ((elt (assoc site send-pr::template-alist)))
 306     (if elt
 307         (save-excursion (insert (cdr elt)))
 308       (call-process "send-pr" nil t nil "-P" site)
 309       (save-excursion
 310         (setq send-pr::template-alist
 311               (cons (cons site (buffer-substring (point-min) (point-max)))
 312                     send-pr::template-alist))))))
 313
 314 (fset 'do-send-pr 'send-pr:submit-pr)   ;backward compat
 315 (defun send-pr:submit-pr ()
 316   "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
 317 buffer was loaded with emacsclient, in which case save the buffer and exit."
 318   ;;
 319   (interactive)
 320   (cond
 321    ((and (boundp 'server-buffer-clients)
 322          server-buffer-clients)
 323     (let ((buffer (current-buffer))
 324           (version-control nil) (buffer-backed-up nil))
 325       (save-buffer buffer)
 326       (kill-buffer buffer)
 327       (server-buffer-done buffer)))
 328    (send-pr:::spawn-to-send
 329     (if (or (buffer-modified-p)
 330             (not send-pr:::sent)
 331             (y-or-n-p "PR already sent; resend? "))
 332         (progn
 333           (or (and send-pr:::err-buffer
 334                    (buffer-name send-pr:::err-buffer))
 335               (setq send-pr:::err-buffer
 336                     (get-buffer-create send-pr::err-buffer-name)))
 337           (let ((err-buffer send-pr:::err-buffer) mesg ok)
 338             (save-excursion (set-buffer err-buffer) (erase-buffer))
 339             (message "running send-pr...")
 340             (let ((oldpr (getenv "GNATS_ROOT")))
 341               (setenv "GNATS_ROOT" gnats:root)
 342               ;; ensure that a final newline is present:
 343               (if (not (equal (char-after (1- (point-max))) ?\n))
 344                   (save-excursion (goto-char (point-max))
 345                                   (insert ?\n)))
 346               (call-process-region (point-min) (point-max) "send-pr"
 347                                    nil err-buffer nil send-pr:::site
 348                                    "-b" "-f" "-")
 349               (setenv "GNATS_ROOT" oldpr))
 350             (message "running send-pr...done")
 351             ;; stupidly we cannot check the return value in EMACS 18.57,
 352             ;; thus we need this kluge to find out whether send-pr succeeded.
 353             (if (save-excursion
 354                   (set-buffer err-buffer)
 355                   (goto-char (point-min))
 356                   (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
 357                   (search-forward "problem report sent" nil t))
 358                 (progn (message mesg)
 359                        (kill-buffer err-buffer)
 360                        (delete-auto-save-file-if-necessary)
 361                        (set-buffer-modified-p nil)
 362                        (setq send-pr:::sent t)
 363                        (bury-buffer))
 364               (pop-to-buffer err-buffer))
 365             ))))
 366    (t
 367     (save-buffer)
 368     (message "Exit emacs to send the PR."))))
 369
 370 ;;;;---------------------------------------------------------------------------
 371 ;;;; send-pr:send-pr-mode mode
 372 ;;;;---------------------------------------------------------------------------
 373
 374 (defvar send-pr-mode-map
 375   (let ((map (make-sparse-keymap)))
 376     (define-key map "\C-c\C-c" 'send-pr:submit-pr)
 377     (define-key map "\C-c\C-f" 'gnats:change-field)
 378     (define-key map "\M-n" 'gnats:next-field)
 379     (define-key map "\M-p" 'gnats:previous-field)
 380     (define-key map "\C-\M-f" 'gnats:forward-field)
 381     (define-key map "\C-\M-b" 'gnats:backward-field)
 382     map)
 383   "Keymap for send-pr mode.")
 384
 385 (defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
 386 (defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
 387 (defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")
 388
 389 (fset 'send-pr-mode 'send-pr:send-pr-mode)
 390 (defun send-pr:send-pr-mode ()
 391   "Major mode for submitting problem reports.
 392 For information about the form see gnats(1) and send-pr(1).
 393 Special commands: \\{send-pr-mode-map}
 394 Turning on send-pr-mode calls the value of the variable send-pr-mode-hook,
 395 if it is not nil."
 396   (interactive)
 397   (gnats::patch-exec-path)
 398   (put 'send-pr:send-pr-mode 'mode-class 'special)
 399   (kill-all-local-variables)
 400   (setq major-mode 'send-pr:send-pr-mode)
 401   (setq mode-name "send-pr")
 402   (use-local-map send-pr-mode-map)
 403   (set-syntax-table text-mode-syntax-table)
 404   (setq local-abbrev-table text-mode-abbrev-table)
 405   (setq buffer-offer-save t)
 406   (make-local-variable 'send-pr:::site)
 407   (make-local-variable 'send-pr:::categories)
 408   (make-local-variable 'send-pr:::err-buffer)
 409   (make-local-variable 'send-pr:::spawn-to-send)
 410   (make-local-variable 'send-pr:::sent)
 411   (setq send-pr:::sent nil)
 412   (make-local-variable 'paragraph-separate)
 413   (setq paragraph-separate (concat (default-value 'paragraph-separate)
 414                                    "\\|" gnats::keyword "[ \t\n\f]*$"))
 415   (make-local-variable 'paragraph-start)
 416   (setq paragraph-start (concat (default-value 'paragraph-start)
 417                                 "\\|" gnats::keyword))
 418   (run-hooks 'send-pr-mode-hook)
 419   t)
 420
 421 ;;;;---------------------------------------------------------------------------
 422 ;;;; Functions to read and replace field values.
 423 ;;;;---------------------------------------------------------------------------
 424
 425 (defun gnats::position-on-field (field &optional quiet)
 426   (goto-char (point-min))
 427   (if (not (re-search-forward (concat "^>" field ":") nil t))
 428       (if quiet
 429           nil
 430         (error "Field `>%s:' not found." field))
 431     (re-search-forward "[ \t\n\f]*")
 432     (if (looking-at gnats::keyword)
 433         (backward-char 1))
 434     t))
 435
 436 (defun gnats::mail-position-on-field (field)
 437   (let (end
 438         (case-fold-search t))
 439     (goto-char (point-min))
 440     (re-search-forward "^$")
 441     (setq end (match-beginning 0))
 442     (goto-char (point-min))
 443     (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
 444         (insert field ": \n")
 445       (re-search-forward "[ \t\n\f]*"))
 446     (skip-chars-backward "\n")
 447     t))
 448
 449 (defun gnats::field-contents (field &optional elem move)
 450   (let (pos)
 451     (unwind-protect
 452         (save-excursion
 453           (if (not (gnats::position-on-field field t))
 454               nil
 455             (setq pos (point-marker))
 456             (if (or (looking-at "<.*>$") (eolp))
 457                 t
 458               (looking-at ".*$")        ; to set match-{beginning,end}
 459               (gnats::nth-word
 460                (buffer-substring (match-beginning 0) (match-end 0))
 461                elem))))
 462       (and move pos (goto-char pos)))))
 463
 464 (defun gnats::functionp (thing)
 465   (or (and (symbolp thing) (fboundp thing))
 466       (and (listp thing) (eq (car thing) 'lambda))))
 467
 468 (defun gnats::field-values (field)
 469   "Return the possible (known) values for field FIELD."
 470   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
 471                    send-pr::fields))
 472          (thing (elt (assoc field fields) 1)))
 473     (cond ((gnats::functionp thing) (funcall thing))
 474           ((listp thing) thing)
 475           (t (error "ACK")))))
 476
 477 (defun gnats::field-default (field)
 478   "Return the default value for field FIELD."
 479   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
 480                    send-pr::fields))
 481          (thing (elt (assoc field fields) 2)))
 482     (cond ((stringp thing) thing)
 483           ((null thing) "")
 484           ((numberp thing) (car (elt (gnats::field-values field) thing)))
 485           ((gnats::functionp thing)
 486            (funcall thing (gnats::field-contents field)))
 487           ((eq thing t) (gnats::field-contents field))
 488           (t (error "ACK")))))
 489
 490 (defun gnats::field-type (field)
 491   "Return the type of field FIELD."
 492   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
 493                    send-pr::fields))
 494          (thing (elt (assoc field fields) 3)))
 495     thing))
 496
 497 (defun gnats::field-action (field)
 498   "Return the extra handling function for field FIELD."
 499   (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
 500                    send-pr::fields))
 501          (thing (elt (assoc field fields) 4)))
 502     (cond ((null thing) 'ignore)
 503           ((gnats::functionp thing) thing)
 504           (t (error "ACK")))))
 505
 506 ;;;;---------------------------------------------------------------------------
 507 ;;;; Point movement functions
 508 ;;;;---------------------------------------------------------------------------
 509
 510 (or (fboundp 'defsubst) (fset 'defsubst 'defun))
 511
 512 (defun send-pr::maybe-change-field (field)
 513   (setq field (car field))
 514   (let ((thing (gnats::field-contents field)))
 515     (and thing (eq t thing)
 516          (not (eq 'multi-text (gnats::field-type field)))
 517          (gnats:change-field field))))
 518
 519 (defun gnats:change-field (&optional field default)
 520   "Change the value of the field containing the cursor.  With arg, ask the
 521 user for the field to change.  From a program, the function takes optional
 522 arguments of the field to change and the default value to use."
 523   (interactive)
 524   (or field current-prefix-arg (setq field (gnats::current-field)))
 525   (or field
 526       (setq field
 527             (completing-read "Field: "
 528                              (if (eq major-mode 'gnats:gnats-mode)
 529                                  gnats::fields
 530                                send-pr::fields)
 531                              nil t)))
 532   (gnats::position-on-field field)
 533   (sit-for 0)
 534   (let* ((old (gnats::field-contents field))
 535          new)
 536     (if (null old)
 537         (error "ACK")
 538       (if (or (interactive-p) t)
 539           (let ((prompt (concat ">" field ": "))
 540                 (domain (gnats::field-values field))
 541                 (type (gnats::field-type field)))
 542             (or default (setq default (gnats::field-default field)))
 543             (setq new
 544                   (if (eq type 'enum)
 545                       (completing-read prompt domain nil t
 546                                        (if gnats::emacs-19p (cons default 0)
 547                                          default))
 548                     (read-string prompt (if gnats::emacs-19p (cons default 1)
 549                                           default)))))
 550         (setq new default))
 551       (gnats::set-field field new)
 552       (funcall (gnats::field-action field) field old new)
 553       new)))
 554
 555 (defun gnats::set-field (field value)
 556   (save-excursion
 557     (gnats::position-on-field field)
 558     (delete-horizontal-space)
 559     (looking-at ".*$")
 560     (replace-match
 561      (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
 562
 563 (defun gnats::set-mail-field (field value)
 564   (save-excursion
 565     (gnats::mail-position-on-field field)
 566     (delete-horizontal-space)
 567     (looking-at ".*$")
 568     (replace-match (concat " " value) t)))
 569
 570 (defun gnats::before-keyword (&optional where)
 571   "Returns t if point is in some white space before a keyword.
 572 If where is nil, then point is not changed; if where is t then point is moved
 573 to the beginning of the keyword, otherwise it is moved to the beginning
 574 of the white space it was in."
 575   ;;
 576   (if (looking-at gnats::before-keyword)
 577       (prog1 t
 578         (cond  ((eq where t)
 579                 (re-search-forward "^>") (backward-char))
 580                ((not (eq where nil))
 581                 (re-search-backward "[^ \t\n\f]") (forward-char))))
 582        nil))
 583
 584 (defun gnats::after-keyword (&optional where)
 585   "Returns t if point is in some white space after a keyword.
 586 If where is nil, then point is not changed; if where is t then point is moved
 587 to the beginning of the keyword, otherwise it is moved to the end of the white
 588 space it was in."
 589   ;;
 590   (if (gnats::looking-after gnats::after-keyword)
 591       (prog1 t
 592         (cond  ((eq where t)
 593                 (re-search-backward "^>"))
 594                ((not (eq where nil))
 595                 (re-search-forward "[^ \t\n\f]") (backward-char))))
 596        nil))
 597
 598 (defun gnats::in-keyword (&optional where)
 599   "Returns t if point is within a keyword.
 600 If where is nil, then point is not changed; if where is t then point is moved
 601 to the beginning of the keyword."
 602   ;;
 603   (let ((old-point (point-marker)))
 604     (beginning-of-line)
 605     (cond ((and (looking-at gnats::keyword)
 606                (< old-point (match-end 0)))
 607            (prog1 t
 608              (if (eq where t)
 609                  t
 610                (goto-char old-point))))
 611           (t (goto-char old-point)
 612              nil))))
 613
 614 (defun gnats::forward-bofield ()
 615   "Moves point to the beginning of a field. Assumes that point is in the
 616 keyword."
 617   ;;
 618   (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
 619       (backward-char)
 620     t))
 621
 622 (defun gnats::backward-eofield ()
 623   "Moves point to the end of a field. Assumes point is in the keyword."
 624   ;;
 625   (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
 626       (forward-char)
 627     t))
 628
 629 (defun gnats::forward-eofield ()
 630   "Moves point to the end of a field. Assumes that point is in the field."
 631   ;;
 632   ;; look for the next field
 633   (if (re-search-forward gnats::keyword (point-max) '-)
 634       (progn (beginning-of-line) (gnats::backward-eofield))
 635   (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
 636   (forward-char)))
 637
 638 (defun gnats::backward-bofield ()
 639   "Moves point to the beginning of a field. Assumes that point is in the
 640 field."
 641   ;;
 642   ;;look for previous field
 643   (if (re-search-backward gnats::keyword (point-min) '-)
 644       (gnats::forward-bofield)
 645     t))
 646
 647
 648 (defun gnats:forward-field ()
 649   "Move point forward to the end of the field or to the beginning of the next
 650 field."
 651   ;;
 652   (interactive)
 653   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
 654           (gnats::after-keyword t))
 655         (gnats::forward-bofield)
 656     (gnats::forward-eofield)))
 657
 658 (defun gnats:backward-field ()
 659   "Move point backward to the beginning/end of a field."
 660   ;;
 661   (interactive)
 662   (backward-char)
 663   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
 664           (gnats::after-keyword t))
 665       (gnats::backward-eofield)
 666     (gnats::backward-bofield)))
 667
 668 (defun gnats:next-field ()
 669   "Move point to the beginning of the next field."
 670   ;;
 671   (interactive)
 672   (if (or (gnats::before-keyword t) (gnats::in-keyword t)
 673           (gnats::after-keyword t))
 674       (gnats::forward-bofield)
 675     (if (re-search-forward gnats::keyword (point-max) '-)
 676         (gnats::forward-bofield)
 677       t)))
 678
 679 (defun gnats:previous-field ()
 680   "Move point to the beginning of the previous field."
 681   ;;
 682   (interactive)
 683   (backward-char)
 684   (if (or (gnats::after-keyword t) (gnats::in-keyword t)
 685           (gnats::before-keyword t))
 686       (progn (re-search-backward gnats::keyword (point-min) '-)
 687              (gnats::forward-bofield))
 688     (gnats::backward-bofield)))
 689
 690 (defun gnats:beginning-of-field ()
 691   "Move point to the beginning of the current field."
 692   (interactive)
 693   (cond ((gnats::in-keyword t)
 694          (gnats::forward-bofield))
 695         ((gnats::after-keyword 0))
 696         (t
 697          (gnats::backward-bofield))))
 698
 699 (defun gnats::current-field ()
 700   (save-excursion
 701     (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
 702                (looking-at gnats::keyword))
 703               ((re-search-backward gnats::keyword nil t)))
 704         (buffer-substring (match-beginning 1) (match-end 1))
 705       nil)))
 706
 707 ;;;;---------------------------------------------------------------------------
 708 ;;;; Support functions
 709 ;;;;---------------------------------------------------------------------------
 710
 711 (defun gnats::looking-after (regex)
 712   "Returns t if point is after regex."
 713   ;;
 714   (let* ((old-point (point))
 715          (start (if (eobp)
 716                    old-point
 717                  (forward-char) (point))))
 718     (cond ((re-search-backward regex (point-min) t)
 719            (goto-char old-point)
 720            (cond ((eq (match-end 0) start)
 721                   t))))))
 722
 723 (defun gnats::nth-word (string &optional elem)
 724   "Returns the elem-th word of the string.
 725 If elem is nil, then the first wort is returned, if elem is 0 then
 726 the whole string is returned."
 727    ;;
 728   (if (integerp elem)
 729       (cond ((eq elem 0) string)
 730             ((eq elem 1) (gnats::first-word string))
 731             ((equal string "") "")
 732             ((>= elem 2)
 733              (let ((i 0) (value ""))
 734                (setq string             ; strip leading blanks
 735                      (substring string (or (string-match "[^ \t]" string) 0)))
 736                (while (< i elem)
 737                  (setq value
 738                        (substring string 0
 739                                   (string-match "[ \t]*$\\|[ \t]+" string)))
 740                  (setq string
 741                        (substring string (match-end 0)))
 742                  (setq i (+ i 1)))
 743                value)))
 744     (gnats::first-word string)))
 745
 746 (defun gnats::first-word (string)
 747   (setq string
 748         (substring string (or (string-match "[^ \t]" string) 0)))
 749   (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
 750
 751 ;;;;---------------------------------------------------------------------------
 752
 753 (defun gnats::patch-exec-path ()
 754   ;;
 755   "Replaces `//' by `/' in `exec-path'."
 756   ;;
 757   ;(make-local-variable 'exec-path)
 758   (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
 759         (ret))
 760     (setq exec-path (save-excursion (set-buffer err-buffer)
 761                                     (prin1 exec-path err-buffer)
 762                                     (goto-char (point-min))
 763                                     (while (search-forward "//" nil t)
 764                                       (replace-match "/" nil t))
 765                                     (goto-char (point-min))
 766                                     (setq ret (read err-buffer))
 767                                     (kill-buffer err-buffer)
 768                                     ret
 769                                     ))))
 770
 771 (defun gnats::get-value-from-shell (&rest command)
 772   "Execute shell command to get a list of valid values for `variable'."
 773   ;;
 774   (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
 775     (save-excursion
 776       (set-buffer err-buffer)
 777       (unwind-protect
 778           (condition-case var
 779               (progn
 780                 (apply 'call-process
 781                        (car command) nil err-buffer nil (cdr command))
 782                 (goto-char (point-min))
 783                 (if (looking-at "[-a-z]+: ")
 784                     (error (buffer-substring (point-min) (point-max))))
 785                 (read err-buffer))
 786             (error nil))
 787         (kill-buffer err-buffer)))))
 788
 789 (or (fboundp 'setenv)
 790     (defun setenv (variable &optional value)
 791       "Set the value of the environment variable named VARIABLE to VALUE.
 792 VARIABLE should be a string.  VALUE is optional; if not provided or is
 793 `nil', the environment variable VARIABLE will be removed.
 794 This function works by modifying `process-environment'."
 795       (interactive "sSet environment variable: \nsSet %s to value: ")
 796       (if (string-match "=" variable)
 797           (error "Environment variable name `%s' contains `='" variable)
 798         (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
 799               (case-fold-search nil)
 800               (scan process-environment))
 801           (while scan
 802             (cond
 803              ((string-match pattern (car scan))
 804               (if (eq nil value)
 805                   (setq process-environment (delq (car scan)
 806                                                   process-environment))
 807                 (setcar scan (concat variable "=" value)))
 808               (setq scan nil))
 809              ((null (setq scan (cdr scan)))
 810               (setq process-environment
 811                     (cons (concat variable "=" value)
 812                           process-environment)))))))))
 813
 814 ;;;; end of send-pr.el