xref: /freebsd-10.0-release/gnu/usr.bin/send-pr/send-pr-el.in

;;;; -*-emacs-lisp-*-
;;;;---------------------------------------------------------------------------
;;;;    EMACS interface for send-pr (by Heinz G. Seidl, hgs@cygnus.com)
;;;;    Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
;;;;
;;;;    This file is part of the Problem Report Management System (GNATS)
;;;;    Copyright 1992, 1993 Cygnus Support
;;;;
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public
;;;;    License as published by the Free Software Foundation; either
;;;;    version 2 of the License, or (at your option) any later version.
;;;;
;;;;    This program is distributed in the hope that it will be useful,
;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;;    General Public License for more details.
;;;;
;;;;    You should have received a copy of the GNU Library General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;;
;;;;---------------------------------------------------------------------------
;;;;
;;;;    This file contains the EMACS interface to the Problem Report Management
;;;;	System (GNATS):
;;;;
;;;;		- The `send-pr' command and the `send-pr-mode' for sending 
;;;;              Problem Reports (PRs).
;;;;
;;;;    For more information about how to send a PR see send-pr(1).
;;;;
;;;;---------------------------------------------------------------------------
;;;;
;;;;	Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
;;;;	site/release specific strings during the configuration/installation
;;;;	process.
;;;;
;;;;    Install this file in your EMACS library directory.
;;;;
;;;;---------------------------------------------------------------------------
;;;;
;;;; $FreeBSD: head/gnu/usr.bin/send-pr/send-pr-el.in 60882 2000-05-24 14:40:25Z steve $

(provide 'send-pr)

;;;;---------------------------------------------------------------------------
;;;; Customization: put the following forms into your default.el file
;;;; (or into your .emacs)
;;;;---------------------------------------------------------------------------

;(autoload 'send-pr-mode "send-pr"
;	  "Major mode for sending problem reports." t)

;(autoload 'send-pr "send-pr"
;	  	  "Command to create and send a problem report." t)

;;;;---------------------------------------------------------------------------
;;;; End of Customization Section
;;;;---------------------------------------------------------------------------

(autoload 'server-buffer-done "server")
(defvar server-buffer-clients nil)
(defvar mail-self-blind nil)
(defvar mail-default-reply-to nil)

(defconst send-pr::version "3.2")

(defvar gnats:root "/home/gnats"
  "*The top of the tree containing the GNATS database.")

;;;;---------------------------------------------------------------------------
;;;; hooks
;;;;---------------------------------------------------------------------------

(defvar text-mode-hook nil)   ; we define it here in case it's not defined
(defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")

;;;;---------------------------------------------------------------------------
;;;; Domains and default values for (some of) the Problem Report fields;
;;;; constants and definitions.
;;;;---------------------------------------------------------------------------

(defconst gnats::emacs-19p
  (not (or (and (boundp 'epoch::version) epoch::version)
	   (string-lessp emacs-version "19")))
  "Is this emacs v19?")

;;; These may be changed during configuration/installation or by the individual
;;; user in his/her .emacs file.
;;;
(defun gnats::get-config (var)
  (let ((shell-file-name "/bin/sh")
	(buf (generate-new-buffer " *GNATS config*"))
	ret)
    (save-excursion
      (set-buffer buf)
      (shell-command (concat ". " gnats:root "/gnats-adm/config; echo $" var )
		     t)
      (if (looking-at "^\\.:\\|/bin/sh:\\|\n")
	  (setq ret nil)
	(setq ret (buffer-substring (point-min) (- (point-max) 1)))))
    (kill-buffer buf)
    ret))

;; const because it must match the script's value
(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@")
  "*Where the `gnats' subdirectory containing category lists lives.")

(defvar send-pr::sites nil
  "List of GNATS support sites; computed at runtime.")
(defvar send-pr:default-site
  (or (gnats::get-config "GNATS_SITE") "freefall")
  "Default site to send bugs to.")
(defvar send-pr:::site send-pr:default-site
  "The site to which a problem report is currently being submitted, or NIL
if using the default site (buffer local).")

(defvar send-pr:::categories nil
  "Buffer local list of available categories, derived at runtime from
send-pr:::site and send-pr::category-alist.")
(defvar send-pr::category-alist nil
  "Alist of GNATS support sites and the categories supported at each; computed
at runtime.")

;;; Ideally we would get all the following values from a central database
;;; during runtime instead of having them here in the code.
;;;
(defconst send-pr::fields
  (` (("Category" send-pr::set-categories
       (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
      ("Class" (("sw-bug") ("doc-bug") ("change-request"))
       (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 0)) enum)
      ("Confidential" (("yes") ("no"))
       (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
      ("Severity" (("non-critical") ("serious") ("critical"))
       (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
      ("Priority" (("low") ("medium") ("high"))
       (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
      ("Release" nil
       (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@"))
       text)
      ("Submitter-Id" nil
       (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown"))
       text)
      ("Synopsis" nil nil text
       (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
  "AList, keyed on the name of the field, of:
1) The field name.
2) The list of completions.  This can be a list, a function to call, or nil.
3) The default value.
4) The type of the field.
5) A sub-function to call when changed.")

(defvar gnats::fields nil)

(defmacro gnats::push (i l)
  (` (setq (, l) (cons (,@ (list i l))))))

(defun send-pr::set-categories (&optional arg)
  "Get the list of categories for the current site out of
send-pr::category-alist if there or from send-pr if not.  With arg, force
update."
  ;;
  (let ((entry (assoc send-pr:::site send-pr::category-alist)))
    (or (and entry (null arg))
	(let ((oldpr (getenv "GNATS_ROOT")) cats)
	  (send-pr::set-sites arg)
	  (setenv "GNATS_ROOT" gnats:root)
	  (setq cats (gnats::get-value-from-shell
		      "send-pr" "-CL" send-pr:::site))
	  (setenv "GNATS_ROOT" oldpr)
	  (if entry (setcdr entry cats)
	    (setq entry (cons send-pr:::site cats))
	    (gnats::push entry send-pr::category-alist))))
    (setq send-pr:::categories (cdr entry))))

(defun send-pr::set-sites (&optional arg)
  "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
it to send-pr::sites.  With arg, force update."
  (or (and (null arg) send-pr::sites)
      (progn
	(setq send-pr::sites nil)
	(mapcar
	 (function
	  (lambda (file)
	    (or (memq t (mapcar (function (lambda (x) (string= x file)))
				'("." ".." "pr-edit" "pr-addr")))
		(not (file-readable-p file))
		(gnats::push (list (file-name-nondirectory file))
			    send-pr::sites))))
	 (directory-files (format "%s/gnats" send-pr:datadir) t))
	(setq send-pr::sites (reverse send-pr::sites)))))

(defconst send-pr::pr-buffer-name "*send-pr*"
  "Name of the temporary buffer, where the problem report gets composed.")

(defconst send-pr::err-buffer-name "*send-pr-error*"
  "Name of the temporary buffer, where send-pr error messages appear.")

(defvar send-pr:::err-buffer nil
  "The error buffer used by the current PR buffer.")

(defconst gnats::indent 17 "Indent for formatting the value.")

;;;;---------------------------------------------------------------------------
;;;; `send-pr' - command for creating and sending of problem reports
;;;;---------------------------------------------------------------------------

(fset 'send-pr 'send-pr:send-pr)
(defun send-pr:send-pr (&optional site)
  "Create a buffer and read in the result of `send-pr -P'.
When finished with editing the problem report use \\[send-pr:submit-pr]
to send the PR with `send-pr -b -f -'."
  ;;
  (interactive
   (if current-prefix-arg
       (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
			      send-pr:default-site))))
  (or site (setq site send-pr:default-site))
  (let ((buf (get-buffer send-pr::pr-buffer-name)))
    (if (or (not buf)
	    (progn (switch-to-buffer buf)
		   (cond ((or (not (buffer-modified-p buf))
			      (y-or-n-p "Erase previous problem report? "))
			  (erase-buffer) t)
			 (t nil))))
	(send-pr::start-up site))))

(defun send-pr::start-up (site)
  (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
  (setq default-directory (expand-file-name "~/"))
  (auto-save-mode auto-save-default)
  (let ((oldpr (getenv "GNATS_ROOT"))
	(case-fold-search nil))
    (setenv "GNATS_ROOT" gnats:root)
    (shell-command (concat "send-pr -P " site) t)
    (setenv "GNATS_ROOT" oldpr)
    (if (looking-at "send-pr:")
	(cond ((looking-at "send-pr: .* does not have a categories list")
	       (setq send-pr::sites nil)
	       (error "send-pr: the GNATS site %s does not have a categories list" site))
	      (t (error (buffer-substring (point-min) (point-max)))))
      (save-excursion
	;; Clear cruft inserted by bdamaged .cshrcs
	(re-search-forward "^SEND-PR:")
	(delete-region 1 (match-beginning 0)))))
  (set-buffer-modified-p nil)
  (send-pr:send-pr-mode)
  (setq send-pr:::site site)
  (send-pr::set-categories)
  (if (null send-pr:::categories)
      (progn
	(and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
	(kill-buffer nil)
	(message "send-pr: no categories found"))
    (and mail-default-reply-to
	 (gnats::set-mail-field "Reply-To" mail-default-reply-to))
    (and mail-self-blind
	 (gnats::set-mail-field "BCC" (user-login-name)))
    (mapcar 'send-pr::maybe-change-field send-pr::fields)
    (gnats::position-on-field "Description")
    (message (substitute-command-keys
	      "To send the problem report use: \\[send-pr:submit-pr]"))))

(fset 'do-send-pr 'send-pr:submit-pr)	;backward compat
(defun send-pr:submit-pr ()
  "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
buffer was loaded with emacsclient, in which case save the buffer and exit."
  ;;
  (interactive)
  (cond
   ((and (boundp 'server-buffer-clients)
	 server-buffer-clients)
    (let ((buffer (current-buffer))
	  (version-control nil) (buffer-backed-up nil))
      (save-buffer buffer)
      (kill-buffer buffer)
      (server-buffer-done buffer)))
   (t
    (or (and send-pr:::err-buffer
	     (buffer-name send-pr:::err-buffer))
	(setq send-pr:::err-buffer
	      (get-buffer-create send-pr::err-buffer-name)))
    (let ((err-buffer send-pr:::err-buffer) mesg ok)
      (save-excursion (set-buffer err-buffer) (erase-buffer))
      (message "running send-pr...")
      (let ((oldpr (getenv "GNATS_ROOT")))
	(setenv "GNATS_ROOT" gnats:root)
	(call-process-region (point-min) (point-max) "send-pr"
			     nil err-buffer nil send-pr:::site
			     "-b" "-f" "-")
	(setenv "GNATS_ROOT" oldpr))
      (message "running send-pr...done")
      ;; stupidly we cannot check the return value in EMACS 18.57, thus we need
      ;; this kluge to find out whether send-pr succeeded.
      (if (save-excursion
	    (set-buffer err-buffer)
	    (goto-char (point-min))
	    (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
	    (search-forward "problem report sent" nil t))
	  (progn (message mesg)
		 (kill-buffer err-buffer)
		 (delete-auto-save-file-if-necessary)
		 (set-buffer-modified-p nil)
		 (bury-buffer))
	(pop-to-buffer err-buffer))
    ))))
   
;;;;---------------------------------------------------------------------------
;;;; send-pr:send-pr-mode mode
;;;;---------------------------------------------------------------------------

(defvar send-pr-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "\C-c\C-c" 'send-pr:submit-pr)
    (define-key map "\C-c\C-f" 'gnats:change-field)
    (define-key map "\M-n" 'gnats:next-field)
    (define-key map "\M-p" 'gnats:previous-field)
    (define-key map "\C-\M-f" 'gnats:forward-field)
    (define-key map "\C-\M-b" 'gnats:backward-field)
    map)
  "Keymap for send-pr mode.")

(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")

(fset 'send-pr-mode 'send-pr:send-pr-mode)
(defun send-pr:send-pr-mode ()
  "Major mode for submitting problem reports.
For information about the form see gnats(1) and send-pr(1).
Special commands: \\{send-pr-mode-map}
Turning on send-pr-mode calls the value of the variable send-pr-mode-hook,
if it is not nil."
  (interactive)
  (gnats::patch-exec-path)
  (put 'send-pr:send-pr-mode 'mode-class 'special)
  (kill-all-local-variables)
  (setq major-mode 'send-pr:send-pr-mode)
  (setq mode-name "send-pr")
  (use-local-map send-pr-mode-map)
  (set-syntax-table text-mode-syntax-table)
  (setq local-abbrev-table text-mode-abbrev-table)
  (setq buffer-offer-save t)
  (make-local-variable 'send-pr:::site)
  (make-local-variable 'send-pr:::categories)
  (make-local-variable 'send-pr:::err-buffer)
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate (concat (default-value 'paragraph-separate)
				   "\\|" gnats::keyword "[ \t\n\f]*$"))
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat (default-value 'paragraph-start)
				"\\|" gnats::keyword))
  (run-hooks 'send-pr-mode-hook)
  t)

;;;;---------------------------------------------------------------------------
;;;; Functions to read and replace field values.
;;;;---------------------------------------------------------------------------

(defun gnats::position-on-field (field)
  (goto-char (point-min))
  (if (not (re-search-forward (concat "^>" field ":") nil t))
      (error "Field `>%s:' not found." field)
    (re-search-forward "[ \t\n\f]*")
    (if (looking-at gnats::keyword)
	(backward-char 1))
    t))

(defun gnats::mail-position-on-field (field)
  (let (end
	(case-fold-search t))
    (goto-char (point-min))
    (re-search-forward "^$")
    (setq end (match-beginning 0))
    (goto-char (point-min))
    (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
	(insert field ": \n")
      (re-search-forward "[ \t\n\f]*"))
    (skip-chars-backward "\n")
    t))

(defun gnats::field-contents (field &optional elem move)
  (let (pos)
    (unwind-protect
	(save-excursion
	  (if (not (gnats::position-on-field field))
	      nil
	    (setq pos (point-marker))
	    (if (or (looking-at "<.*>$") (eolp))
		t
	      (looking-at ".*$")	; to set match-{beginning,end}
	      (gnats::nth-word 
	       (buffer-substring (match-beginning 0) (match-end 0))
	       elem))))
      (and move pos (goto-char pos)))))

(defun gnats::functionp (thing)
  (or (and (symbolp thing) (fboundp thing))
      (and (listp thing) (eq (car thing) 'lambda))))

(defun gnats::field-values (field)
  "Return the possible (known) values for field FIELD."
  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
		   send-pr::fields))
	 (thing (elt (assoc field fields) 1)))
    (cond ((gnats::functionp thing) (funcall thing))
	  ((listp thing) thing)
	  (t (error "ACK")))))

(defun gnats::field-default (field)
  "Return the default value for field FIELD."
  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
		   send-pr::fields))
	 (thing (elt (assoc field fields) 2)))
    (cond ((stringp thing) thing)
	  ((null thing) "")
	  ((numberp thing) (car (elt (gnats::field-values field) thing)))
	  ((gnats::functionp thing)
	   (funcall thing (gnats::field-contents field)))
	  ((eq thing t) (gnats::field-contents field))
	  (t (error "ACK")))))

(defun gnats::field-type (field)
  "Return the type of field FIELD."
  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
		   send-pr::fields))
	 (thing (elt (assoc field fields) 3)))
    thing))

(defun gnats::field-action (field)
  "Return the extra handling function for field FIELD."
  (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
		   send-pr::fields))
	 (thing (elt (assoc field fields) 4)))
    (cond ((null thing) 'ignore)
	  ((gnats::functionp thing) thing)
	  (t (error "ACK")))))

;;;;---------------------------------------------------------------------------
;;;; Point movement functions
;;;;---------------------------------------------------------------------------

(or (fboundp 'defsubst) (fset 'defsubst 'defun))

(defun send-pr::maybe-change-field (field)
  (setq field (car field))
  (let ((thing (gnats::field-contents field)))
    (and thing (eq t thing)
	 (not (eq 'multi-text (gnats::field-type field)))
	 (gnats:change-field field))))
    
(defun gnats:change-field (&optional field default)
  "Change the value of the field containing the cursor.  With arg, ask the
user for the field to change.  From a program, the function takes optional
arguments of the field to change and the default value to use."
  (interactive)
  (or field current-prefix-arg (setq field (gnats::current-field)))
  (or field
      (setq field
	    (completing-read "Field: "
			     (if (eq major-mode 'gnats:gnats-mode)
				 gnats::fields
			       send-pr::fields)
			     nil t)))
  (gnats::position-on-field field)
  (sit-for 0)
  (let* ((old (gnats::field-contents field))
	 new)
    (if (null old)
	(error "ACK")
      (let ((prompt (concat ">" field ": "))
	    (domain (gnats::field-values field))
	    (type (gnats::field-type field))
	    (action (gnats::field-action field)))
	(or default (setq default (gnats::field-default field)))
	(setq new (if (eq type 'enum)
		      (completing-read prompt domain nil t 
				       (if gnats::emacs-19p (cons default 0)
					 default))
		    (read-string prompt (if gnats::emacs-19p (cons default 1)
					  default))))
	(gnats::set-field field new)
	(funcall action field old new)
	new))))

(defun gnats::set-field (field value)
  (save-excursion
    (gnats::position-on-field field)
    (delete-horizontal-space)
    (looking-at ".*$")
    (replace-match
     (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))

(defun gnats::set-mail-field (field value)
  (save-excursion
    (gnats::mail-position-on-field field)
    (delete-horizontal-space)
    (looking-at ".*$")
    (replace-match (concat " " value) t)))
  
(defun gnats::before-keyword (&optional where)
  "Returns t if point is in some white space before a keyword.
If where is nil, then point is not changed; if where is t then point is moved
to the beginning of the keyword, otherwise it is moved to the beginning
of the white space it was in."
  ;;
  (if (looking-at gnats::before-keyword)
      (prog1 t
	(cond  ((eq where t)
		(re-search-forward "^>") (backward-char))
	       ((not (eq where nil))
		(re-search-backward "[^ \t\n\f]") (forward-char))))
       nil))

(defun gnats::after-keyword (&optional where)
  "Returns t if point is in some white space after a keyword.
If where is nil, then point is not changed; if where is t then point is moved
to the beginning of the keyword, otherwise it is moved to the end of the white
space it was in."
  ;;
  (if (gnats::looking-after gnats::after-keyword)
      (prog1 t
	(cond  ((eq where t)
		(re-search-backward "^>"))
	       ((not (eq where nil))
		(re-search-forward "[^ \t\n\f]") (backward-char))))
       nil))

(defun gnats::in-keyword (&optional where)
  "Returns t if point is within a keyword.
If where is nil, then point is not changed; if where is t then point is moved
to the beginning of the keyword."
  ;;
  (let ((old-point (point-marker)))
    (beginning-of-line)
    (cond ((and (looking-at gnats::keyword)
	       (< old-point (match-end 0)))
	   (prog1 t
	     (if (eq where t) 
		 t
	       (goto-char old-point))))
	  (t (goto-char old-point)
	     nil))))

(defun gnats::forward-bofield ()
  "Moves point to the beginning of a field. Assumes that point is in the
keyword." 
  ;;
  (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
      (backward-char)
    t))

(defun gnats::backward-eofield ()
  "Moves point to the end of a field. Assumes point is in the keyword."
  ;;
  (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
      (forward-char)
    t))

(defun gnats::forward-eofield ()
  "Moves point to the end of a field. Assumes that point is in the field." 
  ;;
  ;; look for the next field
  (if (re-search-forward gnats::keyword (point-max) '-) 
      (progn (beginning-of-line) (gnats::backward-eofield))
  (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
  (forward-char)))

(defun gnats::backward-bofield ()
  "Moves point to the beginning of a field. Assumes that point is in the
field." 
  ;;
  ;;look for previous field
  (if (re-search-backward gnats::keyword (point-min) '-)
      (gnats::forward-bofield)
    t))


(defun gnats:forward-field ()
  "Move point forward to the end of the field or to the beginning of the next
field."
  ;;
  (interactive)
  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
	  (gnats::after-keyword t))
	(gnats::forward-bofield)
    (gnats::forward-eofield)))

(defun gnats:backward-field ()
  "Move point backward to the beginning/end of a field."
  ;;
  (interactive)
  (backward-char)
  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
	  (gnats::after-keyword t))
      (gnats::backward-eofield)
    (gnats::backward-bofield)))

(defun gnats:next-field ()
  "Move point to the beginning of the next field."
  ;;
  (interactive)
  (if (or (gnats::before-keyword t) (gnats::in-keyword t)
	  (gnats::after-keyword t))
      (gnats::forward-bofield)
    (if (re-search-forward gnats::keyword (point-max) '-)
	(gnats::forward-bofield)
      t)))

(defun gnats:previous-field ()
  "Move point to the beginning of the previous field."
  ;;
  (interactive)
  (backward-char)
  (if (or (gnats::after-keyword t) (gnats::in-keyword t)
	  (gnats::before-keyword t))
      (progn (re-search-backward gnats::keyword (point-min) '-)
	     (gnats::forward-bofield))
    (gnats::backward-bofield)))

(defun gnats:beginning-of-field ()
  "Move point to the beginning of the current field."
  (interactive)
  (cond ((gnats::in-keyword t)
	 (gnats::forward-bofield))
	((gnats::after-keyword 0))
	(t
	 (gnats::backward-bofield))))

(defun gnats::current-field ()
  (save-excursion
    (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
	       (looking-at gnats::keyword))
	      ((re-search-backward gnats::keyword nil t)))
	(buffer-substring (match-beginning 1) (match-end 1))
      nil)))

;;;;---------------------------------------------------------------------------
;;;; Support functions
;;;;---------------------------------------------------------------------------

(defun gnats::looking-after (regex)
  "Returns t if point is after regex."
  ;;
  (let* ((old-point (point))
	 (start (if (eobp)
		   old-point
		 (forward-char) (point))))
    (cond ((re-search-backward regex (point-min) t)
	   (goto-char old-point)
	   (cond ((eq (match-end 0) start)
		  t))))))

(defun gnats::nth-word (string &optional elem)
  "Returns the elem-th word of the string.
If elem is nil, then the first wort is returned, if elem is 0 then
the whole string is returned."
   ;;
  (if (integerp elem)
      (cond ((eq elem 0) string)
	    ((eq elem 1) (gnats::first-word string))
	    ((equal string "") "")
	    ((>= elem 2) 
	     (let ((i 0) (value ""))
	       (setq string		; strip leading blanks
		     (substring string (or (string-match "[^ \t]" string) 0)))
	       (while (< i elem)
		 (setq value 
		       (substring string 0 
				  (string-match "[ \t]*$\\|[ \t]+" string)))
		 (setq string 
		       (substring string (match-end 0)))
		 (setq i (+ i 1)))
	       value)))
    (gnats::first-word string)))

(defun gnats::first-word (string)
  (setq string 
	(substring string (or (string-match "[^ \t]" string) 0)))
  (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))

;;;;---------------------------------------------------------------------------

(defun gnats::patch-exec-path ()
  ;;
  "Replaces `//' by `/' in `exec-path'."
  ;;
  ;(make-local-variable 'exec-path)
  (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
	(ret))
    (setq exec-path (save-excursion (set-buffer err-buffer)
				    (prin1 exec-path err-buffer)
				    (goto-char (point-min))
				    (replace-string "//" "/")
				    (goto-char (point-min))
				    (setq ret (read err-buffer))
				    (kill-buffer err-buffer)
				    ret
				    ))))

(defun gnats::get-value-from-shell (&rest command)
  "Execute shell command to get a list of valid values for `variable'."
  ;;
  (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
    (save-excursion
      (set-buffer err-buffer)
      (unwind-protect
	  (condition-case var
	      (progn
		(apply 'call-process
		       (car command) nil err-buffer nil (cdr command))
		(goto-char (point-min))
		(if (looking-at "[-a-z]+: ")
		    (error (buffer-substring (point-min) (point-max))))
		(read err-buffer))
	    (error nil))
	(kill-buffer err-buffer)))))

(or (fboundp 'setenv)
    (defun setenv (variable &optional value)
      "Set the value of the environment variable named VARIABLE to VALUE.
VARIABLE should be a string.  VALUE is optional; if not provided or is
`nil', the environment variable VARIABLE will be removed.  
This function works by modifying `process-environment'."
      (interactive "sSet environment variable: \nsSet %s to value: ")
      (if (string-match "=" variable)
	  (error "Environment variable name `%s' contains `='" variable)
	(let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
	      (case-fold-search nil)
	      (scan process-environment))
	  (while scan
	    (cond
	     ((string-match pattern (car scan))
	      (if (eq nil value)
		  (setq process-environment (delq (car scan)
						  process-environment))
		(setcar scan (concat variable "=" value)))
	      (setq scan nil))
	     ((null (setq scan (cdr scan)))
	      (setq process-environment
		    (cons (concat variable "=" value)
			  process-environment)))))))))

;;;; end of send-pr.el