12382Spaul;;;; -*-emacs-lisp-*-
22382Spaul;;;;---------------------------------------------------------------------------
367908Ssteve;;;;    EMACS interface for send-pr (by Heinz G. Seidl)
42382Spaul;;;;    Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
52382Spaul;;;;
62382Spaul;;;;    This file is part of the Problem Report Management System (GNATS)
767908Ssteve;;;;    Copyright 1992, 1993, 1997 Cygnus Support
82382Spaul;;;;
92382Spaul;;;;    This program is free software; you can redistribute it and/or
102382Spaul;;;;    modify it under the terms of the GNU General Public
112382Spaul;;;;    License as published by the Free Software Foundation; either
122382Spaul;;;;    version 2 of the License, or (at your option) any later version.
132382Spaul;;;;
142382Spaul;;;;    This program is distributed in the hope that it will be useful,
152382Spaul;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
162382Spaul;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
172382Spaul;;;;    General Public License for more details.
182382Spaul;;;;
192382Spaul;;;;    You should have received a copy of the GNU Library General Public
202382Spaul;;;;    License along with this program; if not, write to the Free
212382Spaul;;;;    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
222382Spaul;;;;
232382Spaul;;;;---------------------------------------------------------------------------
242382Spaul;;;;
252382Spaul;;;;    This file contains the EMACS interface to the Problem Report Management
262382Spaul;;;;	System (GNATS):
272382Spaul;;;;
282382Spaul;;;;		- The `send-pr' command and the `send-pr-mode' for sending 
292382Spaul;;;;              Problem Reports (PRs).
302382Spaul;;;;
312382Spaul;;;;    For more information about how to send a PR see send-pr(1).
322382Spaul;;;;
332382Spaul;;;;---------------------------------------------------------------------------
342382Spaul;;;;
352382Spaul;;;;	Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
362382Spaul;;;;	site/release specific strings during the configuration/installation
372382Spaul;;;;	process.
382382Spaul;;;;
392382Spaul;;;;    Install this file in your EMACS library directory.
402382Spaul;;;;
412382Spaul;;;;---------------------------------------------------------------------------
4259366Ssteve;;;;
4359366Ssteve;;;; $FreeBSD$
442382Spaul
452382Spaul(provide 'send-pr)
462382Spaul
472382Spaul;;;;---------------------------------------------------------------------------
482382Spaul;;;; Customization: put the following forms into your default.el file
492382Spaul;;;; (or into your .emacs)
502382Spaul;;;;---------------------------------------------------------------------------
512382Spaul
522382Spaul;(autoload 'send-pr-mode "send-pr"
532382Spaul;	  "Major mode for sending problem reports." t)
542382Spaul
552382Spaul;(autoload 'send-pr "send-pr"
562382Spaul;	  	  "Command to create and send a problem report." t)
572382Spaul
582382Spaul;;;;---------------------------------------------------------------------------
592382Spaul;;;; End of Customization Section
602382Spaul;;;;---------------------------------------------------------------------------
612382Spaul
622382Spaul(autoload 'server-buffer-done "server")
632382Spaul(defvar server-buffer-clients nil)
642382Spaul(defvar mail-self-blind nil)
652382Spaul(defvar mail-default-reply-to nil)
662382Spaul
6767908Ssteve(defconst send-pr::version "3.113")
682382Spaul
692382Spaul(defvar gnats:root "/home/gnats"
702382Spaul  "*The top of the tree containing the GNATS database.")
712382Spaul
722382Spaul;;;;---------------------------------------------------------------------------
732382Spaul;;;; hooks
742382Spaul;;;;---------------------------------------------------------------------------
752382Spaul
762382Spaul(defvar text-mode-hook nil)   ; we define it here in case it's not defined
772382Spaul(defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")
782382Spaul
792382Spaul;;;;---------------------------------------------------------------------------
802382Spaul;;;; Domains and default values for (some of) the Problem Report fields;
812382Spaul;;;; constants and definitions.
822382Spaul;;;;---------------------------------------------------------------------------
832382Spaul
842382Spaul(defconst gnats::emacs-19p
852382Spaul  (not (or (and (boundp 'epoch::version) epoch::version)
862382Spaul	   (string-lessp emacs-version "19")))
872382Spaul  "Is this emacs v19?")
882382Spaul
8967908Ssteve;;; This has to be here rather than at the bottom of this file with
9067908Ssteve;;; the other utility functions because it is used by
9167908Ssteve;;; gnats::get-config, which is called when send-pr.el is being
9267908Ssteve;;; loaded (see the "defconst" below), before the whole file has been
9367908Ssteve;;; loaded.
9467908Ssteve
9567908Ssteve(defun gnats::find-safe-default-directory (&optional buffer)
9667908Ssteve"If the directory referred to by `default-directory' for the current
9767908Sstevebuffer (or for optional argument BUFFER) does not exist, set it to the home
9867908Sstevedirectory of the current user if that exists, or to `/'.
9967908Ssteve
10067908SsteveReturns the final value of default-directory in the buffer."
10167908Ssteve  (let ((homedir (expand-file-name "~/")))
10267908Ssteve    (save-excursion
10367908Ssteve      (if buffer (set-buffer buffer))
10467908Ssteve      (if (not (file-exists-p default-directory))
10567908Ssteve	  (if (file-exists-p homedir)
10667908Ssteve	      (setq default-directory homedir)
10767908Ssteve	    (setq default-directory "/")))
10867908Ssteve      default-directory)))
10967908Ssteve
1102382Spaul;;; These may be changed during configuration/installation or by the individual
1112382Spaul;;; user in his/her .emacs file.
1122382Spaul;;;
1132382Spaul(defun gnats::get-config (var)
1142382Spaul  (let ((shell-file-name "/bin/sh")
1152382Spaul	(buf (generate-new-buffer " *GNATS config*"))
1162382Spaul	ret)
1172382Spaul    (save-excursion
1182382Spaul      (set-buffer buf)
11967908Ssteve      (shell-command-on-region
12067908Ssteve       (point-min) (point-max)
12167908Ssteve       (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t)
12267908Ssteve      (goto-char (point-min))
12367908Ssteve      ; We have to use get-buffer, since shell-command-on-region will wipe
12467908Ssteve      ; out the buffer if there's no output from the command.
12567908Ssteve      (if (or (not (get-buffer "*Shell Command Output*"))
12667908Ssteve	      (looking-at "^\\.:\\|/bin/sh:\\|\n"))
1272382Spaul	  (setq ret nil)
1282382Spaul	(setq ret (buffer-substring (point-min) (- (point-max) 1)))))
12967908Ssteve    (if (and ret (string-equal ret "")) (setq ret nil))
1302382Spaul    (kill-buffer buf)
1312382Spaul    ret))
1322382Spaul
1332382Spaul;; const because it must match the script's value
1342382Spaul(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@")
1352382Spaul  "*Where the `gnats' subdirectory containing category lists lives.")
1362382Spaul
1372382Spaul(defvar send-pr::sites nil
1382382Spaul  "List of GNATS support sites; computed at runtime.")
1392382Spaul(defvar send-pr:default-site
1402382Spaul  (or (gnats::get-config "GNATS_SITE") "freefall")
1412382Spaul  "Default site to send bugs to.")
1422382Spaul(defvar send-pr:::site send-pr:default-site
1432382Spaul  "The site to which a problem report is currently being submitted, or NIL
1442382Spaulif using the default site (buffer local).")
1452382Spaul
1462382Spaul(defvar send-pr:::categories nil
1472382Spaul  "Buffer local list of available categories, derived at runtime from
1482382Spaulsend-pr:::site and send-pr::category-alist.")
1492382Spaul(defvar send-pr::category-alist nil
1502382Spaul  "Alist of GNATS support sites and the categories supported at each; computed
1512382Spaulat runtime.")
1522382Spaul
1532382Spaul;;; Ideally we would get all the following values from a central database
1542382Spaul;;; during runtime instead of having them here in the code.
1552382Spaul;;;
1562382Spaul(defconst send-pr::fields
1572382Spaul  (` (("Category" send-pr::set-categories
1582382Spaul       (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
15967909Ssteve      ("Class" (("sw-bug") ("doc-bug") ("change-request") ("update") ("maintainer-update"))
16067908Ssteve       (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum)
1612382Spaul      ("Confidential" (("yes") ("no"))
1622382Spaul       (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
1632382Spaul      ("Severity" (("non-critical") ("serious") ("critical"))
1642382Spaul       (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
1652382Spaul      ("Priority" (("low") ("medium") ("high"))
1662382Spaul       (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
1672382Spaul      ("Release" nil
1682382Spaul       (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@"))
1692382Spaul       text)
1702382Spaul      ("Submitter-Id" nil
17167908Ssteve       (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) text)
1722382Spaul      ("Synopsis" nil nil text
1732382Spaul       (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
1742382Spaul  "AList, keyed on the name of the field, of:
1752382Spaul1) The field name.
1762382Spaul2) The list of completions.  This can be a list, a function to call, or nil.
1772382Spaul3) The default value.
1782382Spaul4) The type of the field.
1792382Spaul5) A sub-function to call when changed.")
1802382Spaul
1812382Spaul(defvar gnats::fields nil)
1822382Spaul
1832382Spaul(defmacro gnats::push (i l)
1842382Spaul  (` (setq (, l) (cons (,@ (list i l))))))
1852382Spaul
1862382Spaul(defun send-pr::set-categories (&optional arg)
1872382Spaul  "Get the list of categories for the current site out of
1882382Spaulsend-pr::category-alist if there or from send-pr if not.  With arg, force
1892382Spaulupdate."
1902382Spaul  ;;
1912382Spaul  (let ((entry (assoc send-pr:::site send-pr::category-alist)))
1922382Spaul    (or (and entry (null arg))
1932382Spaul	(let ((oldpr (getenv "GNATS_ROOT")) cats)
1942382Spaul	  (send-pr::set-sites arg)
1952382Spaul	  (setenv "GNATS_ROOT" gnats:root)
1962382Spaul	  (setq cats (gnats::get-value-from-shell
1972382Spaul		      "send-pr" "-CL" send-pr:::site))
1982382Spaul	  (setenv "GNATS_ROOT" oldpr)
1992382Spaul	  (if entry (setcdr entry cats)
2002382Spaul	    (setq entry (cons send-pr:::site cats))
2012382Spaul	    (gnats::push entry send-pr::category-alist))))
2022382Spaul    (setq send-pr:::categories (cdr entry))))
2032382Spaul
2042382Spaul(defun send-pr::set-sites (&optional arg)
2052382Spaul  "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
2062382Spaulit to send-pr::sites.  With arg, force update."
2072382Spaul  (or (and (null arg) send-pr::sites)
2082382Spaul      (progn
2092382Spaul	(setq send-pr::sites nil)
2102382Spaul	(mapcar
2112382Spaul	 (function
2122382Spaul	  (lambda (file)
2132382Spaul	    (or (memq t (mapcar (function (lambda (x) (string= x file)))
2142382Spaul				'("." ".." "pr-edit" "pr-addr")))
2152382Spaul		(not (file-readable-p file))
2162382Spaul		(gnats::push (list (file-name-nondirectory file))
2172382Spaul			    send-pr::sites))))
2182382Spaul	 (directory-files (format "%s/gnats" send-pr:datadir) t))
2192382Spaul	(setq send-pr::sites (reverse send-pr::sites)))))
2202382Spaul
2212382Spaul(defconst send-pr::pr-buffer-name "*send-pr*"
2222382Spaul  "Name of the temporary buffer, where the problem report gets composed.")
2232382Spaul
2242382Spaul(defconst send-pr::err-buffer-name "*send-pr-error*"
2252382Spaul  "Name of the temporary buffer, where send-pr error messages appear.")
2262382Spaul
2272382Spaul(defvar send-pr:::err-buffer nil
2282382Spaul  "The error buffer used by the current PR buffer.")
2292382Spaul
23067908Ssteve(defvar send-pr:::spawn-to-send nil
23167908Ssteve  "Whether or not send-pr-mode should spawn a send-pr process to send the PR.")
23267908Ssteve
2332382Spaul(defconst gnats::indent 17 "Indent for formatting the value.")
2342382Spaul
2352382Spaul;;;;---------------------------------------------------------------------------
2362382Spaul;;;; `send-pr' - command for creating and sending of problem reports
2372382Spaul;;;;---------------------------------------------------------------------------
2382382Spaul
2392382Spaul(fset 'send-pr 'send-pr:send-pr)
2402382Spaul(defun send-pr:send-pr (&optional site)
2412382Spaul  "Create a buffer and read in the result of `send-pr -P'.
2422382SpaulWhen finished with editing the problem report use \\[send-pr:submit-pr]
2432382Spaulto send the PR with `send-pr -b -f -'."
2442382Spaul  ;;
2452382Spaul  (interactive
2462382Spaul   (if current-prefix-arg
2472382Spaul       (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
2482382Spaul			      send-pr:default-site))))
2492382Spaul  (or site (setq site send-pr:default-site))
2502382Spaul  (let ((buf (get-buffer send-pr::pr-buffer-name)))
2512382Spaul    (if (or (not buf)
2522382Spaul	    (progn (switch-to-buffer buf)
2532382Spaul		   (cond ((or (not (buffer-modified-p buf))
2542382Spaul			      (y-or-n-p "Erase previous problem report? "))
2552382Spaul			  (erase-buffer) t)
2562382Spaul			 (t nil))))
2572382Spaul	(send-pr::start-up site))))
2582382Spaul
2592382Spaul(defun send-pr::start-up (site)
2602382Spaul  (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
2612382Spaul  (setq default-directory (expand-file-name "~/"))
2622382Spaul  (auto-save-mode auto-save-default)
2632382Spaul  (let ((oldpr (getenv "GNATS_ROOT"))
2642382Spaul	(case-fold-search nil))
2652382Spaul    (setenv "GNATS_ROOT" gnats:root)
26667908Ssteve    (send-pr::insert-template site)
2672382Spaul    (setenv "GNATS_ROOT" oldpr)
26867908Ssteve    (goto-char (point-min))
2692382Spaul    (if (looking-at "send-pr:")
2702382Spaul	(cond ((looking-at "send-pr: .* does not have a categories list")
2712382Spaul	       (setq send-pr::sites nil)
2722382Spaul	       (error "send-pr: the GNATS site %s does not have a categories list" site))
2732382Spaul	      (t (error (buffer-substring (point-min) (point-max)))))
2742382Spaul      (save-excursion
2752382Spaul	;; Clear cruft inserted by bdamaged .cshrcs
27667908Ssteve	(goto-char 1)
2772382Spaul	(re-search-forward "^SEND-PR:")
2782382Spaul	(delete-region 1 (match-beginning 0)))))
2792382Spaul  (set-buffer-modified-p nil)
2802382Spaul  (send-pr:send-pr-mode)
2812382Spaul  (setq send-pr:::site site)
28267908Ssteve  (setq send-pr:::spawn-to-send t)
2832382Spaul  (send-pr::set-categories)
2842382Spaul  (if (null send-pr:::categories)
2852382Spaul      (progn
2862382Spaul	(and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
2872382Spaul	(kill-buffer nil)
2882382Spaul	(message "send-pr: no categories found"))
28967908Ssteve    (or (stringp mail-default-reply-to)
29067908Ssteve	(setq mail-default-reply-to (getenv "REPLYTO")))
2912382Spaul    (and mail-default-reply-to
2922382Spaul	 (gnats::set-mail-field "Reply-To" mail-default-reply-to))
2932382Spaul    (and mail-self-blind
2942382Spaul	 (gnats::set-mail-field "BCC" (user-login-name)))
2952382Spaul    (mapcar 'send-pr::maybe-change-field send-pr::fields)
2962382Spaul    (gnats::position-on-field "Description")
2972382Spaul    (message (substitute-command-keys
2982382Spaul	      "To send the problem report use: \\[send-pr:submit-pr]"))))
2992382Spaul
30067908Ssteve(defvar send-pr::template-alist nil
30167908Ssteve  "An alist containing the output of send-pr -P <sitename> for various sites.")
30267908Ssteve
30367908Ssteve(defun send-pr::insert-template (site)
30467908Ssteve  (let ((elt (assoc site send-pr::template-alist)))
30567908Ssteve    (if elt
30667908Ssteve	(save-excursion (insert (cdr elt)))
30767908Ssteve      (call-process "send-pr" nil t nil "-P" site)
30867908Ssteve      (save-excursion
30967908Ssteve	(setq send-pr::template-alist
31067908Ssteve	      (cons (cons site (buffer-substring (point-min) (point-max)))
31167908Ssteve		    send-pr::template-alist))))))
31267908Ssteve
3132382Spaul(fset 'do-send-pr 'send-pr:submit-pr)	;backward compat
3142382Spaul(defun send-pr:submit-pr ()
3152382Spaul  "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
3162382Spaulbuffer was loaded with emacsclient, in which case save the buffer and exit."
3172382Spaul  ;;
3182382Spaul  (interactive)
3192382Spaul  (cond
3202382Spaul   ((and (boundp 'server-buffer-clients)
3212382Spaul	 server-buffer-clients)
3222382Spaul    (let ((buffer (current-buffer))
3232382Spaul	  (version-control nil) (buffer-backed-up nil))
3242382Spaul      (save-buffer buffer)
3252382Spaul      (kill-buffer buffer)
3262382Spaul      (server-buffer-done buffer)))
32767908Ssteve   (send-pr:::spawn-to-send
32867908Ssteve    (if (or (buffer-modified-p)
32967908Ssteve	    (not send-pr:::sent)
33067908Ssteve	    (y-or-n-p "PR already sent; resend? "))
33167908Ssteve	(progn
33267908Ssteve	  (or (and send-pr:::err-buffer
33367908Ssteve		   (buffer-name send-pr:::err-buffer))
33467908Ssteve	      (setq send-pr:::err-buffer
33567908Ssteve		    (get-buffer-create send-pr::err-buffer-name)))
33667908Ssteve	  (let ((err-buffer send-pr:::err-buffer) mesg ok)
33767908Ssteve	    (save-excursion (set-buffer err-buffer) (erase-buffer))
33867908Ssteve	    (message "running send-pr...")
33967908Ssteve	    (let ((oldpr (getenv "GNATS_ROOT")))
34067908Ssteve	      (setenv "GNATS_ROOT" gnats:root)
34167908Ssteve	      ;; ensure that a final newline is present:
34267908Ssteve	      (if (not (equal (char-after (1- (point-max))) ?\n))
34367908Ssteve		  (save-excursion (goto-char (point-max))
34467908Ssteve				  (insert ?\n)))
34567908Ssteve	      (call-process-region (point-min) (point-max) "send-pr"
34667908Ssteve				   nil err-buffer nil send-pr:::site
34767908Ssteve				   "-b" "-f" "-")
34867908Ssteve	      (setenv "GNATS_ROOT" oldpr))
34967908Ssteve	    (message "running send-pr...done")
35067908Ssteve	    ;; stupidly we cannot check the return value in EMACS 18.57,
35167908Ssteve	    ;; thus we need this kluge to find out whether send-pr succeeded.
35267908Ssteve	    (if (save-excursion
35367908Ssteve		  (set-buffer err-buffer)
35467908Ssteve		  (goto-char (point-min))
35567908Ssteve		  (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
35667908Ssteve		  (search-forward "problem report sent" nil t))
35767908Ssteve		(progn (message mesg)
35867908Ssteve		       (kill-buffer err-buffer)
35967908Ssteve		       (delete-auto-save-file-if-necessary)
36067908Ssteve		       (set-buffer-modified-p nil)
36167908Ssteve		       (setq send-pr:::sent t)
36267908Ssteve		       (bury-buffer))
36367908Ssteve	      (pop-to-buffer err-buffer))
36467908Ssteve	    ))))
3652382Spaul   (t
36667908Ssteve    (save-buffer)
36767908Ssteve    (message "Exit emacs to send the PR."))))
3682382Spaul   
3692382Spaul;;;;---------------------------------------------------------------------------
3702382Spaul;;;; send-pr:send-pr-mode mode
3712382Spaul;;;;---------------------------------------------------------------------------
3722382Spaul
3732382Spaul(defvar send-pr-mode-map
3742382Spaul  (let ((map (make-sparse-keymap)))
3752382Spaul    (define-key map "\C-c\C-c" 'send-pr:submit-pr)
3762382Spaul    (define-key map "\C-c\C-f" 'gnats:change-field)
3772382Spaul    (define-key map "\M-n" 'gnats:next-field)
3782382Spaul    (define-key map "\M-p" 'gnats:previous-field)
3792382Spaul    (define-key map "\C-\M-f" 'gnats:forward-field)
3802382Spaul    (define-key map "\C-\M-b" 'gnats:backward-field)
3812382Spaul    map)
3822382Spaul  "Keymap for send-pr mode.")
3832382Spaul
3842382Spaul(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
3852382Spaul(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
3862382Spaul(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")
3872382Spaul
3882382Spaul(fset 'send-pr-mode 'send-pr:send-pr-mode)
3892382Spaul(defun send-pr:send-pr-mode ()
3902382Spaul  "Major mode for submitting problem reports.
3912382SpaulFor information about the form see gnats(1) and send-pr(1).
3922382SpaulSpecial commands: \\{send-pr-mode-map}
3932382SpaulTurning on send-pr-mode calls the value of the variable send-pr-mode-hook,
3942382Spaulif it is not nil."
3952382Spaul  (interactive)
3962382Spaul  (gnats::patch-exec-path)
3972382Spaul  (put 'send-pr:send-pr-mode 'mode-class 'special)
3982382Spaul  (kill-all-local-variables)
3992382Spaul  (setq major-mode 'send-pr:send-pr-mode)
4002382Spaul  (setq mode-name "send-pr")
4012382Spaul  (use-local-map send-pr-mode-map)
4022382Spaul  (set-syntax-table text-mode-syntax-table)
4032382Spaul  (setq local-abbrev-table text-mode-abbrev-table)
4042382Spaul  (setq buffer-offer-save t)
4052382Spaul  (make-local-variable 'send-pr:::site)
4062382Spaul  (make-local-variable 'send-pr:::categories)
4072382Spaul  (make-local-variable 'send-pr:::err-buffer)
40867908Ssteve  (make-local-variable 'send-pr:::spawn-to-send)
40967908Ssteve  (make-local-variable 'send-pr:::sent)
41067908Ssteve  (setq send-pr:::sent nil)
4112382Spaul  (make-local-variable 'paragraph-separate)
4122382Spaul  (setq paragraph-separate (concat (default-value 'paragraph-separate)
4132382Spaul				   "\\|" gnats::keyword "[ \t\n\f]*$"))
4142382Spaul  (make-local-variable 'paragraph-start)
4152382Spaul  (setq paragraph-start (concat (default-value 'paragraph-start)
4162382Spaul				"\\|" gnats::keyword))
4172382Spaul  (run-hooks 'send-pr-mode-hook)
4182382Spaul  t)
4192382Spaul
4202382Spaul;;;;---------------------------------------------------------------------------
4212382Spaul;;;; Functions to read and replace field values.
4222382Spaul;;;;---------------------------------------------------------------------------
4232382Spaul
42467908Ssteve(defun gnats::position-on-field (field &optional quiet)
4252382Spaul  (goto-char (point-min))
4262382Spaul  (if (not (re-search-forward (concat "^>" field ":") nil t))
42767908Ssteve      (if quiet
42867908Ssteve	  nil
42967908Ssteve	(error "Field `>%s:' not found." field))
4302382Spaul    (re-search-forward "[ \t\n\f]*")
4312382Spaul    (if (looking-at gnats::keyword)
4322382Spaul	(backward-char 1))
4332382Spaul    t))
4342382Spaul
4352382Spaul(defun gnats::mail-position-on-field (field)
4362382Spaul  (let (end
4372382Spaul	(case-fold-search t))
4382382Spaul    (goto-char (point-min))
4392382Spaul    (re-search-forward "^$")
4402382Spaul    (setq end (match-beginning 0))
4412382Spaul    (goto-char (point-min))
4422382Spaul    (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
4432382Spaul	(insert field ": \n")
4442382Spaul      (re-search-forward "[ \t\n\f]*"))
4452382Spaul    (skip-chars-backward "\n")
4462382Spaul    t))
4472382Spaul
4482382Spaul(defun gnats::field-contents (field &optional elem move)
4492382Spaul  (let (pos)
4502382Spaul    (unwind-protect
4512382Spaul	(save-excursion
45267908Ssteve	  (if (not (gnats::position-on-field field t))
4532382Spaul	      nil
4542382Spaul	    (setq pos (point-marker))
4552382Spaul	    (if (or (looking-at "<.*>$") (eolp))
4562382Spaul		t
4572382Spaul	      (looking-at ".*$")	; to set match-{beginning,end}
4582382Spaul	      (gnats::nth-word 
4592382Spaul	       (buffer-substring (match-beginning 0) (match-end 0))
4602382Spaul	       elem))))
4612382Spaul      (and move pos (goto-char pos)))))
4622382Spaul
4632382Spaul(defun gnats::functionp (thing)
4642382Spaul  (or (and (symbolp thing) (fboundp thing))
4652382Spaul      (and (listp thing) (eq (car thing) 'lambda))))
4662382Spaul
4672382Spaul(defun gnats::field-values (field)
4682382Spaul  "Return the possible (known) values for field FIELD."
4692382Spaul  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
4702382Spaul		   send-pr::fields))
4712382Spaul	 (thing (elt (assoc field fields) 1)))
4722382Spaul    (cond ((gnats::functionp thing) (funcall thing))
4732382Spaul	  ((listp thing) thing)
4742382Spaul	  (t (error "ACK")))))
4752382Spaul
4762382Spaul(defun gnats::field-default (field)
4772382Spaul  "Return the default value for field FIELD."
4782382Spaul  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
4792382Spaul		   send-pr::fields))
4802382Spaul	 (thing (elt (assoc field fields) 2)))
4812382Spaul    (cond ((stringp thing) thing)
4822382Spaul	  ((null thing) "")
4832382Spaul	  ((numberp thing) (car (elt (gnats::field-values field) thing)))
4842382Spaul	  ((gnats::functionp thing)
4852382Spaul	   (funcall thing (gnats::field-contents field)))
4862382Spaul	  ((eq thing t) (gnats::field-contents field))
4872382Spaul	  (t (error "ACK")))))
4882382Spaul
4892382Spaul(defun gnats::field-type (field)
4902382Spaul  "Return the type of field FIELD."
4912382Spaul  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
4922382Spaul		   send-pr::fields))
4932382Spaul	 (thing (elt (assoc field fields) 3)))
4942382Spaul    thing))
4952382Spaul
4962382Spaul(defun gnats::field-action (field)
4972382Spaul  "Return the extra handling function for field FIELD."
4982382Spaul  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
4992382Spaul		   send-pr::fields))
5002382Spaul	 (thing (elt (assoc field fields) 4)))
5012382Spaul    (cond ((null thing) 'ignore)
5022382Spaul	  ((gnats::functionp thing) thing)
5032382Spaul	  (t (error "ACK")))))
5042382Spaul
5052382Spaul;;;;---------------------------------------------------------------------------
5062382Spaul;;;; Point movement functions
5072382Spaul;;;;---------------------------------------------------------------------------
5082382Spaul
5092382Spaul(or (fboundp 'defsubst) (fset 'defsubst 'defun))
5102382Spaul
5112382Spaul(defun send-pr::maybe-change-field (field)
5122382Spaul  (setq field (car field))
5132382Spaul  (let ((thing (gnats::field-contents field)))
5142382Spaul    (and thing (eq t thing)
5152382Spaul	 (not (eq 'multi-text (gnats::field-type field)))
5162382Spaul	 (gnats:change-field field))))
5172382Spaul    
5182382Spaul(defun gnats:change-field (&optional field default)
5192382Spaul  "Change the value of the field containing the cursor.  With arg, ask the
5202382Spauluser for the field to change.  From a program, the function takes optional
5212382Spaularguments of the field to change and the default value to use."
5222382Spaul  (interactive)
5232382Spaul  (or field current-prefix-arg (setq field (gnats::current-field)))
5242382Spaul  (or field
5252382Spaul      (setq field
5262382Spaul	    (completing-read "Field: "
5272382Spaul			     (if (eq major-mode 'gnats:gnats-mode)
5282382Spaul				 gnats::fields
5292382Spaul			       send-pr::fields)
5302382Spaul			     nil t)))
5312382Spaul  (gnats::position-on-field field)
5322382Spaul  (sit-for 0)
5332382Spaul  (let* ((old (gnats::field-contents field))
5342382Spaul	 new)
5352382Spaul    (if (null old)
5362382Spaul	(error "ACK")
53767908Ssteve      (if (or (interactive-p) t)
53867908Ssteve	  (let ((prompt (concat ">" field ": "))
53967908Ssteve		(domain (gnats::field-values field))
54067908Ssteve		(type (gnats::field-type field)))
54167908Ssteve	    (or default (setq default (gnats::field-default field)))
54267908Ssteve	    (setq new
54367908Ssteve		  (if (eq type 'enum)
5442382Spaul		      (completing-read prompt domain nil t 
5452382Spaul				       (if gnats::emacs-19p (cons default 0)
5462382Spaul					 default))
5472382Spaul		    (read-string prompt (if gnats::emacs-19p (cons default 1)
54867908Ssteve					  default)))))
54967908Ssteve	(setq new default))
55067908Ssteve      (gnats::set-field field new)
55167908Ssteve      (funcall (gnats::field-action field) field old new)
55267908Ssteve      new)))
5532382Spaul
5542382Spaul(defun gnats::set-field (field value)
5552382Spaul  (save-excursion
5562382Spaul    (gnats::position-on-field field)
5572382Spaul    (delete-horizontal-space)
5582382Spaul    (looking-at ".*$")
5592382Spaul    (replace-match
5602382Spaul     (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
5612382Spaul
5622382Spaul(defun gnats::set-mail-field (field value)
5632382Spaul  (save-excursion
5642382Spaul    (gnats::mail-position-on-field field)
5652382Spaul    (delete-horizontal-space)
5662382Spaul    (looking-at ".*$")
5672382Spaul    (replace-match (concat " " value) t)))
5682382Spaul  
5692382Spaul(defun gnats::before-keyword (&optional where)
5702382Spaul  "Returns t if point is in some white space before a keyword.
5712382SpaulIf where is nil, then point is not changed; if where is t then point is moved
5722382Spaulto the beginning of the keyword, otherwise it is moved to the beginning
5732382Spaulof the white space it was in."
5742382Spaul  ;;
5752382Spaul  (if (looking-at gnats::before-keyword)
5762382Spaul      (prog1 t
5772382Spaul	(cond  ((eq where t)
5782382Spaul		(re-search-forward "^>") (backward-char))
5792382Spaul	       ((not (eq where nil))
5802382Spaul		(re-search-backward "[^ \t\n\f]") (forward-char))))
5812382Spaul       nil))
5822382Spaul
5832382Spaul(defun gnats::after-keyword (&optional where)
5842382Spaul  "Returns t if point is in some white space after a keyword.
5852382SpaulIf where is nil, then point is not changed; if where is t then point is moved
5862382Spaulto the beginning of the keyword, otherwise it is moved to the end of the white
5872382Spaulspace it was in."
5882382Spaul  ;;
5892382Spaul  (if (gnats::looking-after gnats::after-keyword)
5902382Spaul      (prog1 t
5912382Spaul	(cond  ((eq where t)
5922382Spaul		(re-search-backward "^>"))
5932382Spaul	       ((not (eq where nil))
5942382Spaul		(re-search-forward "[^ \t\n\f]") (backward-char))))
5952382Spaul       nil))
5962382Spaul
5972382Spaul(defun gnats::in-keyword (&optional where)
5982382Spaul  "Returns t if point is within a keyword.
5992382SpaulIf where is nil, then point is not changed; if where is t then point is moved
6002382Spaulto the beginning of the keyword."
6012382Spaul  ;;
6022382Spaul  (let ((old-point (point-marker)))
6032382Spaul    (beginning-of-line)
6042382Spaul    (cond ((and (looking-at gnats::keyword)
6052382Spaul	       (< old-point (match-end 0)))
6062382Spaul	   (prog1 t
6072382Spaul	     (if (eq where t) 
6082382Spaul		 t
6092382Spaul	       (goto-char old-point))))
6102382Spaul	  (t (goto-char old-point)
6112382Spaul	     nil))))
6122382Spaul
6132382Spaul(defun gnats::forward-bofield ()
6142382Spaul  "Moves point to the beginning of a field. Assumes that point is in the
6152382Spaulkeyword." 
6162382Spaul  ;;
6172382Spaul  (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
6182382Spaul      (backward-char)
6192382Spaul    t))
6202382Spaul
6212382Spaul(defun gnats::backward-eofield ()
6222382Spaul  "Moves point to the end of a field. Assumes point is in the keyword."
6232382Spaul  ;;
6242382Spaul  (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
6252382Spaul      (forward-char)
6262382Spaul    t))
6272382Spaul
6282382Spaul(defun gnats::forward-eofield ()
6292382Spaul  "Moves point to the end of a field. Assumes that point is in the field." 
6302382Spaul  ;;
6312382Spaul  ;; look for the next field
6322382Spaul  (if (re-search-forward gnats::keyword (point-max) '-) 
6332382Spaul      (progn (beginning-of-line) (gnats::backward-eofield))
6342382Spaul  (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
6352382Spaul  (forward-char)))
6362382Spaul
6372382Spaul(defun gnats::backward-bofield ()
6382382Spaul  "Moves point to the beginning of a field. Assumes that point is in the
6392382Spaulfield." 
6402382Spaul  ;;
6412382Spaul  ;;look for previous field
6422382Spaul  (if (re-search-backward gnats::keyword (point-min) '-)
6432382Spaul      (gnats::forward-bofield)
6442382Spaul    t))
6452382Spaul
6462382Spaul
6472382Spaul(defun gnats:forward-field ()
6482382Spaul  "Move point forward to the end of the field or to the beginning of the next
6492382Spaulfield."
6502382Spaul  ;;
6512382Spaul  (interactive)
6522382Spaul  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
6532382Spaul	  (gnats::after-keyword t))
6542382Spaul	(gnats::forward-bofield)
6552382Spaul    (gnats::forward-eofield)))
6562382Spaul
6572382Spaul(defun gnats:backward-field ()
6582382Spaul  "Move point backward to the beginning/end of a field."
6592382Spaul  ;;
6602382Spaul  (interactive)
6612382Spaul  (backward-char)
6622382Spaul  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
6632382Spaul	  (gnats::after-keyword t))
6642382Spaul      (gnats::backward-eofield)
6652382Spaul    (gnats::backward-bofield)))
6662382Spaul
6672382Spaul(defun gnats:next-field ()
6682382Spaul  "Move point to the beginning of the next field."
6692382Spaul  ;;
6702382Spaul  (interactive)
6712382Spaul  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
6722382Spaul	  (gnats::after-keyword t))
6732382Spaul      (gnats::forward-bofield)
6742382Spaul    (if (re-search-forward gnats::keyword (point-max) '-)
6752382Spaul	(gnats::forward-bofield)
6762382Spaul      t)))
6772382Spaul
6782382Spaul(defun gnats:previous-field ()
6792382Spaul  "Move point to the beginning of the previous field."
6802382Spaul  ;;
6812382Spaul  (interactive)
6822382Spaul  (backward-char)
6832382Spaul  (if (or (gnats::after-keyword t) (gnats::in-keyword t)
6842382Spaul	  (gnats::before-keyword t))
6852382Spaul      (progn (re-search-backward gnats::keyword (point-min) '-)
6862382Spaul	     (gnats::forward-bofield))
6872382Spaul    (gnats::backward-bofield)))
6882382Spaul
6892382Spaul(defun gnats:beginning-of-field ()
6902382Spaul  "Move point to the beginning of the current field."
6912382Spaul  (interactive)
6922382Spaul  (cond ((gnats::in-keyword t)
6932382Spaul	 (gnats::forward-bofield))
6942382Spaul	((gnats::after-keyword 0))
6952382Spaul	(t
6962382Spaul	 (gnats::backward-bofield))))
6972382Spaul
6982382Spaul(defun gnats::current-field ()
6992382Spaul  (save-excursion
7002382Spaul    (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
7012382Spaul	       (looking-at gnats::keyword))
7022382Spaul	      ((re-search-backward gnats::keyword nil t)))
7032382Spaul	(buffer-substring (match-beginning 1) (match-end 1))
7042382Spaul      nil)))
7052382Spaul
7062382Spaul;;;;---------------------------------------------------------------------------
7072382Spaul;;;; Support functions
7082382Spaul;;;;---------------------------------------------------------------------------
7092382Spaul
7102382Spaul(defun gnats::looking-after (regex)
7112382Spaul  "Returns t if point is after regex."
7122382Spaul  ;;
7132382Spaul  (let* ((old-point (point))
7142382Spaul	 (start (if (eobp)
7152382Spaul		   old-point
7162382Spaul		 (forward-char) (point))))
7172382Spaul    (cond ((re-search-backward regex (point-min) t)
7182382Spaul	   (goto-char old-point)
7192382Spaul	   (cond ((eq (match-end 0) start)
7202382Spaul		  t))))))
7212382Spaul
7222382Spaul(defun gnats::nth-word (string &optional elem)
7232382Spaul  "Returns the elem-th word of the string.
7242382SpaulIf elem is nil, then the first wort is returned, if elem is 0 then
7252382Spaulthe whole string is returned."
7262382Spaul   ;;
7272382Spaul  (if (integerp elem)
7282382Spaul      (cond ((eq elem 0) string)
7292382Spaul	    ((eq elem 1) (gnats::first-word string))
7302382Spaul	    ((equal string "") "")
7312382Spaul	    ((>= elem 2) 
7322382Spaul	     (let ((i 0) (value ""))
7332382Spaul	       (setq string		; strip leading blanks
7342382Spaul		     (substring string (or (string-match "[^ \t]" string) 0)))
7352382Spaul	       (while (< i elem)
7362382Spaul		 (setq value 
7372382Spaul		       (substring string 0 
7382382Spaul				  (string-match "[ \t]*$\\|[ \t]+" string)))
7392382Spaul		 (setq string 
7402382Spaul		       (substring string (match-end 0)))
7412382Spaul		 (setq i (+ i 1)))
7422382Spaul	       value)))
7432382Spaul    (gnats::first-word string)))
7442382Spaul
7452382Spaul(defun gnats::first-word (string)
7462382Spaul  (setq string 
7472382Spaul	(substring string (or (string-match "[^ \t]" string) 0)))
7482382Spaul  (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
7492382Spaul
7502382Spaul;;;;---------------------------------------------------------------------------
7512382Spaul
7522382Spaul(defun gnats::patch-exec-path ()
7532382Spaul  ;;
7542382Spaul  "Replaces `//' by `/' in `exec-path'."
7552382Spaul  ;;
7562382Spaul  ;(make-local-variable 'exec-path)
7572382Spaul  (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
7582382Spaul	(ret))
7592382Spaul    (setq exec-path (save-excursion (set-buffer err-buffer)
7602382Spaul				    (prin1 exec-path err-buffer)
7612382Spaul				    (goto-char (point-min))
76267908Ssteve				    (while (search-forward "//" nil t)
76367908Ssteve				      (replace-match "/" nil t))
7642382Spaul				    (goto-char (point-min))
7652382Spaul				    (setq ret (read err-buffer))
7662382Spaul				    (kill-buffer err-buffer)
7672382Spaul				    ret
7682382Spaul				    ))))
7692382Spaul
7702382Spaul(defun gnats::get-value-from-shell (&rest command)
7712382Spaul  "Execute shell command to get a list of valid values for `variable'."
7722382Spaul  ;;
7732382Spaul  (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
7742382Spaul    (save-excursion
7752382Spaul      (set-buffer err-buffer)
7762382Spaul      (unwind-protect
7772382Spaul	  (condition-case var
7782382Spaul	      (progn
7792382Spaul		(apply 'call-process
7802382Spaul		       (car command) nil err-buffer nil (cdr command))
7812382Spaul		(goto-char (point-min))
7822382Spaul		(if (looking-at "[-a-z]+: ")
7832382Spaul		    (error (buffer-substring (point-min) (point-max))))
7842382Spaul		(read err-buffer))
7852382Spaul	    (error nil))
7862382Spaul	(kill-buffer err-buffer)))))
7872382Spaul
7882382Spaul(or (fboundp 'setenv)
7892382Spaul    (defun setenv (variable &optional value)
7902382Spaul      "Set the value of the environment variable named VARIABLE to VALUE.
7912382SpaulVARIABLE should be a string.  VALUE is optional; if not provided or is
7922382Spaul`nil', the environment variable VARIABLE will be removed.  
7932382SpaulThis function works by modifying `process-environment'."
7942382Spaul      (interactive "sSet environment variable: \nsSet %s to value: ")
7952382Spaul      (if (string-match "=" variable)
7962382Spaul	  (error "Environment variable name `%s' contains `='" variable)
7972382Spaul	(let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
7982382Spaul	      (case-fold-search nil)
7992382Spaul	      (scan process-environment))
8002382Spaul	  (while scan
8012382Spaul	    (cond
8022382Spaul	     ((string-match pattern (car scan))
8032382Spaul	      (if (eq nil value)
8042382Spaul		  (setq process-environment (delq (car scan)
8052382Spaul						  process-environment))
8062382Spaul		(setcar scan (concat variable "=" value)))
8072382Spaul	      (setq scan nil))
8082382Spaul	     ((null (setq scan (cdr scan)))
8092382Spaul	      (setq process-environment
8102382Spaul		    (cons (concat variable "=" value)
8112382Spaul			  process-environment)))))))))
8122382Spaul
8132382Spaul;;;; end of send-pr.el
814