2 ;;;;---------------------------------------------------------------------------
3 ;;;; EMACS interface for send-pr (by Heinz G. Seidl)
4 ;;;; Slightly hacked by Brendan Kehoe (brendan@cygnus.com).
6 ;;;; This file is part of the Problem Report Management System (GNATS)
7 ;;;; Copyright 1992, 1993, 1997 Cygnus Support
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.
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.
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.
23 ;;;;---------------------------------------------------------------------------
25 ;;;; This file contains the EMACS interface to the Problem Report Management
28 ;;;; - The `send-pr' command and the `send-pr-mode' for sending
29 ;;;; Problem Reports (PRs).
31 ;;;; For more information about how to send a PR see send-pr(1).
33 ;;;;---------------------------------------------------------------------------
35 ;;;; Configuration: the symbol `DEFAULT-RELEASE' can be replaced by
36 ;;;; site/release specific strings during the configuration/installation
39 ;;;; Install this file in your EMACS library directory.
41 ;;;;---------------------------------------------------------------------------
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 $
48 ;;;;---------------------------------------------------------------------------
49 ;;;; Customization: put the following forms into your default.el file
50 ;;;; (or into your .emacs)
51 ;;;;---------------------------------------------------------------------------
53 ;(autoload 'send-pr-mode "send-pr"
54 ; "Major mode for sending problem reports." t)
56 ;(autoload 'send-pr "send-pr"
57 ; "Command to create and send a problem report." t)
59 ;;;;---------------------------------------------------------------------------
60 ;;;; End of Customization Section
61 ;;;;---------------------------------------------------------------------------
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)
68 (defconst send-pr::version "3.113")
70 (defvar gnats:root "/home/gnats"
71 "*The top of the tree containing the GNATS database.")
73 ;;;;---------------------------------------------------------------------------
75 ;;;;---------------------------------------------------------------------------
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.")
80 ;;;;---------------------------------------------------------------------------
81 ;;;; Domains and default values for (some of) the Problem Report fields;
82 ;;;; constants and definitions.
83 ;;;;---------------------------------------------------------------------------
85 (defconst gnats::emacs-19p
86 (not (or (and (boundp 'epoch::version) epoch::version)
87 (string-lessp emacs-version "19")))
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
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 `/'.
101 Returns the final value of default-directory in the buffer."
102 (let ((homedir (expand-file-name "~/")))
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 "/")))
111 ;;; These may be changed during configuration/installation or by the individual
112 ;;; user in his/her .emacs file.
114 (defun gnats::get-config (var)
115 (let ((shell-file-name "/bin/sh")
116 (buf (generate-new-buffer " *GNATS config*"))
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"))
129 (setq ret (buffer-substring (point-min) (- (point-max) 1)))))
130 (if (and ret (string-equal ret "")) (setq ret nil))
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.")
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).")
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
154 ;;; Ideally we would get all the following values from a central database
155 ;;; during runtime instead of having them here in the code.
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)
169 (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@"))
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:
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.")
182 (defvar gnats::fields nil)
184 (defmacro gnats::push (i l)
185 (` (setq (, l) (cons (,@ (list i l))))))
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
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))))
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)
210 (setq send-pr::sites nil)
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))
219 (directory-files (format "%s/gnats" send-pr:datadir) t))
220 (setq send-pr::sites (reverse send-pr::sites)))))
222 (defconst send-pr::pr-buffer-name "*send-pr*"
223 "Name of the temporary buffer, where the problem report gets composed.")
225 (defconst send-pr::err-buffer-name "*send-pr-error*"
226 "Name of the temporary buffer, where send-pr error messages appear.")
228 (defvar send-pr:::err-buffer nil
229 "The error buffer used by the current PR buffer.")
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.")
234 (defconst gnats::indent 17 "Indent for formatting the value.")
236 ;;;;---------------------------------------------------------------------------
237 ;;;; `send-pr' - command for creating and sending of problem reports
238 ;;;;---------------------------------------------------------------------------
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 -'."
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)))
253 (progn (switch-to-buffer buf)
254 (cond ((or (not (buffer-modified-p buf))
255 (y-or-n-p "Erase previous problem report? "))
258 (send-pr::start-up site))))
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)))))
276 ;; Clear cruft inserted by bdamaged .cshrcs
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)
287 (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
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))
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]"))))
301 (defvar send-pr::template-alist nil
302 "An alist containing the output of send-pr -P <sitename> for various sites.")
304 (defun send-pr::insert-template (site)
305 (let ((elt (assoc site send-pr::template-alist)))
307 (save-excursion (insert (cdr elt)))
308 (call-process "send-pr" nil t nil "-P" site)
310 (setq send-pr::template-alist
311 (cons (cons site (buffer-substring (point-min) (point-max)))
312 send-pr::template-alist))))))
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."
321 ((and (boundp 'server-buffer-clients)
322 server-buffer-clients)
323 (let ((buffer (current-buffer))
324 (version-control nil) (buffer-backed-up nil))
327 (server-buffer-done buffer)))
328 (send-pr:::spawn-to-send
329 (if (or (buffer-modified-p)
331 (y-or-n-p "PR already sent; resend? "))
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))
346 (call-process-region (point-min) (point-max) "send-pr"
347 nil err-buffer nil send-pr:::site
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.
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)
364 (pop-to-buffer err-buffer))
368 (message "Exit emacs to send the PR."))))
370 ;;;;---------------------------------------------------------------------------
371 ;;;; send-pr:send-pr-mode mode
372 ;;;;---------------------------------------------------------------------------
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)
383 "Keymap for send-pr mode.")
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]+")
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,
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)
421 ;;;;---------------------------------------------------------------------------
422 ;;;; Functions to read and replace field values.
423 ;;;;---------------------------------------------------------------------------
425 (defun gnats::position-on-field (field &optional quiet)
426 (goto-char (point-min))
427 (if (not (re-search-forward (concat "^>" field ":") nil t))
430 (error "Field `>%s:' not found." field))
431 (re-search-forward "[ \t\n\f]*")
432 (if (looking-at gnats::keyword)
436 (defun gnats::mail-position-on-field (field)
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")
449 (defun gnats::field-contents (field &optional elem move)
453 (if (not (gnats::position-on-field field t))
455 (setq pos (point-marker))
456 (if (or (looking-at "<.*>$") (eolp))
458 (looking-at ".*$") ; to set match-{beginning,end}
460 (buffer-substring (match-beginning 0) (match-end 0))
462 (and move pos (goto-char pos)))))
464 (defun gnats::functionp (thing)
465 (or (and (symbolp thing) (fboundp thing))
466 (and (listp thing) (eq (car thing) 'lambda))))
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
472 (thing (elt (assoc field fields) 1)))
473 (cond ((gnats::functionp thing) (funcall thing))
474 ((listp thing) thing)
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
481 (thing (elt (assoc field fields) 2)))
482 (cond ((stringp thing) 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))
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
494 (thing (elt (assoc field fields) 3)))
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
501 (thing (elt (assoc field fields) 4)))
502 (cond ((null thing) 'ignore)
503 ((gnats::functionp thing) thing)
506 ;;;;---------------------------------------------------------------------------
507 ;;;; Point movement functions
508 ;;;;---------------------------------------------------------------------------
510 (or (fboundp 'defsubst) (fset 'defsubst 'defun))
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))))
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."
524 (or field current-prefix-arg (setq field (gnats::current-field)))
527 (completing-read "Field: "
528 (if (eq major-mode 'gnats:gnats-mode)
532 (gnats::position-on-field field)
534 (let* ((old (gnats::field-contents field))
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)))
545 (completing-read prompt domain nil t
546 (if gnats::emacs-19p (cons default 0)
548 (read-string prompt (if gnats::emacs-19p (cons default 1)
551 (gnats::set-field field new)
552 (funcall (gnats::field-action field) field old new)
555 (defun gnats::set-field (field value)
557 (gnats::position-on-field field)
558 (delete-horizontal-space)
561 (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
563 (defun gnats::set-mail-field (field value)
565 (gnats::mail-position-on-field field)
566 (delete-horizontal-space)
568 (replace-match (concat " " value) t)))
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."
576 (if (looking-at gnats::before-keyword)
579 (re-search-forward "^>") (backward-char))
580 ((not (eq where nil))
581 (re-search-backward "[^ \t\n\f]") (forward-char))))
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
590 (if (gnats::looking-after gnats::after-keyword)
593 (re-search-backward "^>"))
594 ((not (eq where nil))
595 (re-search-forward "[^ \t\n\f]") (backward-char))))
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."
603 (let ((old-point (point-marker)))
605 (cond ((and (looking-at gnats::keyword)
606 (< old-point (match-end 0)))
610 (goto-char old-point))))
611 (t (goto-char old-point)
614 (defun gnats::forward-bofield ()
615 "Moves point to the beginning of a field. Assumes that point is in the
618 (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
622 (defun gnats::backward-eofield ()
623 "Moves point to the end of a field. Assumes point is in the keyword."
625 (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
629 (defun gnats::forward-eofield ()
630 "Moves point to the end of a field. Assumes that point is in the field."
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) '-)
638 (defun gnats::backward-bofield ()
639 "Moves point to the beginning of a field. Assumes that point is in the
642 ;;look for previous field
643 (if (re-search-backward gnats::keyword (point-min) '-)
644 (gnats::forward-bofield)
648 (defun gnats:forward-field ()
649 "Move point forward to the end of the field or to the beginning of the next
653 (if (or (gnats::before-keyword t) (gnats::in-keyword t)
654 (gnats::after-keyword t))
655 (gnats::forward-bofield)
656 (gnats::forward-eofield)))
658 (defun gnats:backward-field ()
659 "Move point backward to the beginning/end of a field."
663 (if (or (gnats::before-keyword t) (gnats::in-keyword t)
664 (gnats::after-keyword t))
665 (gnats::backward-eofield)
666 (gnats::backward-bofield)))
668 (defun gnats:next-field ()
669 "Move point to the beginning of the next field."
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)
679 (defun gnats:previous-field ()
680 "Move point to the beginning of the previous field."
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)))
690 (defun gnats:beginning-of-field ()
691 "Move point to the beginning of the current field."
693 (cond ((gnats::in-keyword t)
694 (gnats::forward-bofield))
695 ((gnats::after-keyword 0))
697 (gnats::backward-bofield))))
699 (defun gnats::current-field ()
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))
707 ;;;;---------------------------------------------------------------------------
708 ;;;; Support functions
709 ;;;;---------------------------------------------------------------------------
711 (defun gnats::looking-after (regex)
712 "Returns t if point is after regex."
714 (let* ((old-point (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)
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."
729 (cond ((eq elem 0) string)
730 ((eq elem 1) (gnats::first-word string))
731 ((equal string "") "")
733 (let ((i 0) (value ""))
734 (setq string ; strip leading blanks
735 (substring string (or (string-match "[^ \t]" string) 0)))
739 (string-match "[ \t]*$\\|[ \t]+" string)))
741 (substring string (match-end 0)))
744 (gnats::first-word string)))
746 (defun gnats::first-word (string)
748 (substring string (or (string-match "[^ \t]" string) 0)))
749 (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
751 ;;;;---------------------------------------------------------------------------
753 (defun gnats::patch-exec-path ()
755 "Replaces `//' by `/' in `exec-path'."
757 ;(make-local-variable 'exec-path)
758 (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
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)
771 (defun gnats::get-value-from-shell (&rest command)
772 "Execute shell command to get a list of valid values for `variable'."
774 (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
776 (set-buffer err-buffer)
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))))
787 (kill-buffer err-buffer)))))
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))
803 ((string-match pattern (car scan))
805 (setq process-environment (delq (car scan)
806 process-environment))
807 (setcar scan (concat variable "=" value)))
809 ((null (setq scan (cdr scan)))
810 (setq process-environment
811 (cons (concat variable "=" value)
812 process-environment)))))))))
814 ;;;; end of send-pr.el