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 ;;;;---------------------------------------------------------------------------
47 ;;;;---------------------------------------------------------------------------
48 ;;;; Customization: put the following forms into your default.el file
49 ;;;; (or into your .emacs)
50 ;;;;---------------------------------------------------------------------------
52 ;(autoload 'send-pr-mode "send-pr"
53 ; "Major mode for sending problem reports." t)
55 ;(autoload 'send-pr "send-pr"
56 ; "Command to create and send a problem report." t)
58 ;;;;---------------------------------------------------------------------------
59 ;;;; End of Customization Section
60 ;;;;---------------------------------------------------------------------------
62 (autoload 'server-buffer-done "server")
63 (defvar server-buffer-clients nil)
64 (defvar mail-self-blind nil)
65 (defvar mail-default-reply-to nil)
67 (defconst send-pr::version "3.113")
69 (defvar gnats:root "/home/gnats"
70 "*The top of the tree containing the GNATS database.")
72 ;;;;---------------------------------------------------------------------------
74 ;;;;---------------------------------------------------------------------------
76 (defvar text-mode-hook nil) ; we define it here in case it's not defined
77 (defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.")
79 ;;;;---------------------------------------------------------------------------
80 ;;;; Domains and default values for (some of) the Problem Report fields;
81 ;;;; constants and definitions.
82 ;;;;---------------------------------------------------------------------------
84 (defconst gnats::emacs-19p
85 (not (or (and (boundp 'epoch::version) epoch::version)
86 (string-lessp emacs-version "19")))
89 ;;; This has to be here rather than at the bottom of this file with
90 ;;; the other utility functions because it is used by
91 ;;; gnats::get-config, which is called when send-pr.el is being
92 ;;; loaded (see the "defconst" below), before the whole file has been
95 (defun gnats::find-safe-default-directory (&optional buffer)
96 "If the directory referred to by `default-directory' for the current
97 buffer (or for optional argument BUFFER) does not exist, set it to the home
98 directory of the current user if that exists, or to `/'.
100 Returns the final value of default-directory in the buffer."
101 (let ((homedir (expand-file-name "~/")))
103 (if buffer (set-buffer buffer))
104 (if (not (file-exists-p default-directory))
105 (if (file-exists-p homedir)
106 (setq default-directory homedir)
107 (setq default-directory "/")))
110 ;;; These may be changed during configuration/installation or by the individual
111 ;;; user in his/her .emacs file.
113 (defun gnats::get-config (var)
114 (let ((shell-file-name "/bin/sh")
115 (buf (generate-new-buffer " *GNATS config*"))
119 (shell-command-on-region
120 (point-min) (point-max)
121 (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t)
122 (goto-char (point-min))
123 ; We have to use get-buffer, since shell-command-on-region will wipe
124 ; out the buffer if there's no output from the command.
125 (if (or (not (get-buffer "*Shell Command Output*"))
126 (looking-at "^\\.:\\|/bin/sh:\\|\n"))
128 (setq ret (buffer-substring (point-min) (- (point-max) 1)))))
129 (if (and ret (string-equal ret "")) (setq ret nil))
133 ;; const because it must match the script's value
134 (defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@")
135 "*Where the `gnats' subdirectory containing category lists lives.")
137 (defvar send-pr::sites nil
138 "List of GNATS support sites; computed at runtime.")
139 (defvar send-pr:default-site
140 (or (gnats::get-config "GNATS_SITE") "freefall")
141 "Default site to send bugs to.")
142 (defvar send-pr:::site send-pr:default-site
143 "The site to which a problem report is currently being submitted, or NIL
144 if using the default site (buffer local).")
146 (defvar send-pr:::categories nil
147 "Buffer local list of available categories, derived at runtime from
148 send-pr:::site and send-pr::category-alist.")
149 (defvar send-pr::category-alist nil
150 "Alist of GNATS support sites and the categories supported at each; computed
153 ;;; Ideally we would get all the following values from a central database
154 ;;; during runtime instead of having them here in the code.
156 (defconst send-pr::fields
157 (` (("Category" send-pr::set-categories
158 (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum)
159 ("Class" (("sw-bug") ("doc-bug") ("change-request") ("update") ("maintainer-update"))
160 (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum)
161 ("Confidential" (("yes") ("no"))
162 (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum)
163 ("Severity" (("non-critical") ("serious") ("critical"))
164 (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum)
165 ("Priority" (("low") ("medium") ("high"))
166 (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum)
168 (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@"))
171 (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) text)
172 ("Synopsis" nil nil text
173 (lambda (a b c) (gnats::set-mail-field "Subject" c)))))
174 "AList, keyed on the name of the field, of:
176 2) The list of completions. This can be a list, a function to call, or nil.
177 3) The default value.
178 4) The type of the field.
179 5) A sub-function to call when changed.")
181 (defvar gnats::fields nil)
183 (defmacro gnats::push (i l)
184 (` (setq (, l) (cons (,@ (list i l))))))
186 (defun send-pr::set-categories (&optional arg)
187 "Get the list of categories for the current site out of
188 send-pr::category-alist if there or from send-pr if not. With arg, force
191 (let ((entry (assoc send-pr:::site send-pr::category-alist)))
192 (or (and entry (null arg))
193 (let ((oldpr (getenv "GNATS_ROOT")) cats)
194 (send-pr::set-sites arg)
195 (setenv "GNATS_ROOT" gnats:root)
196 (setq cats (gnats::get-value-from-shell
197 "send-pr" "-CL" send-pr:::site))
198 (setenv "GNATS_ROOT" oldpr)
199 (if entry (setcdr entry cats)
200 (setq entry (cons send-pr:::site cats))
201 (gnats::push entry send-pr::category-alist))))
202 (setq send-pr:::categories (cdr entry))))
204 (defun send-pr::set-sites (&optional arg)
205 "Get the list of sites (by listing the contents of DATADIR/gnats) and assign
206 it to send-pr::sites. With arg, force update."
207 (or (and (null arg) send-pr::sites)
209 (setq send-pr::sites nil)
213 (or (memq t (mapcar (function (lambda (x) (string= x file)))
214 '("." ".." "pr-edit" "pr-addr")))
215 (not (file-readable-p file))
216 (gnats::push (list (file-name-nondirectory file))
218 (directory-files (format "%s/gnats" send-pr:datadir) t))
219 (setq send-pr::sites (reverse send-pr::sites)))))
221 (defconst send-pr::pr-buffer-name "*send-pr*"
222 "Name of the temporary buffer, where the problem report gets composed.")
224 (defconst send-pr::err-buffer-name "*send-pr-error*"
225 "Name of the temporary buffer, where send-pr error messages appear.")
227 (defvar send-pr:::err-buffer nil
228 "The error buffer used by the current PR buffer.")
230 (defvar send-pr:::spawn-to-send nil
231 "Whether or not send-pr-mode should spawn a send-pr process to send the PR.")
233 (defconst gnats::indent 17 "Indent for formatting the value.")
235 ;;;;---------------------------------------------------------------------------
236 ;;;; `send-pr' - command for creating and sending of problem reports
237 ;;;;---------------------------------------------------------------------------
239 (fset 'send-pr 'send-pr:send-pr)
240 (defun send-pr:send-pr (&optional site)
241 "Create a buffer and read in the result of `send-pr -P'.
242 When finished with editing the problem report use \\[send-pr:submit-pr]
243 to send the PR with `send-pr -b -f -'."
246 (if current-prefix-arg
247 (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t
248 send-pr:default-site))))
249 (or site (setq site send-pr:default-site))
250 (let ((buf (get-buffer send-pr::pr-buffer-name)))
252 (progn (switch-to-buffer buf)
253 (cond ((or (not (buffer-modified-p buf))
254 (y-or-n-p "Erase previous problem report? "))
257 (send-pr::start-up site))))
259 (defun send-pr::start-up (site)
260 (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name))
261 (setq default-directory (expand-file-name "~/"))
262 (auto-save-mode auto-save-default)
263 (let ((oldpr (getenv "GNATS_ROOT"))
264 (case-fold-search nil))
265 (setenv "GNATS_ROOT" gnats:root)
266 (send-pr::insert-template site)
267 (setenv "GNATS_ROOT" oldpr)
268 (goto-char (point-min))
269 (if (looking-at "send-pr:")
270 (cond ((looking-at "send-pr: .* does not have a categories list")
271 (setq send-pr::sites nil)
272 (error "send-pr: the GNATS site %s does not have a categories list" site))
273 (t (error (buffer-substring (point-min) (point-max)))))
275 ;; Clear cruft inserted by bdamaged .cshrcs
277 (re-search-forward "^SEND-PR:")
278 (delete-region 1 (match-beginning 0)))))
279 (set-buffer-modified-p nil)
280 (send-pr:send-pr-mode)
281 (setq send-pr:::site site)
282 (setq send-pr:::spawn-to-send t)
283 (send-pr::set-categories)
284 (if (null send-pr:::categories)
286 (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer))
288 (message "send-pr: no categories found"))
289 (or (stringp mail-default-reply-to)
290 (setq mail-default-reply-to (getenv "REPLYTO")))
291 (and mail-default-reply-to
292 (gnats::set-mail-field "Reply-To" mail-default-reply-to))
294 (gnats::set-mail-field "BCC" (user-login-name)))
295 (mapcar 'send-pr::maybe-change-field send-pr::fields)
296 (gnats::position-on-field "Description")
297 (message (substitute-command-keys
298 "To send the problem report use: \\[send-pr:submit-pr]"))))
300 (defvar send-pr::template-alist nil
301 "An alist containing the output of send-pr -P <sitename> for various sites.")
303 (defun send-pr::insert-template (site)
304 (let ((elt (assoc site send-pr::template-alist)))
306 (save-excursion (insert (cdr elt)))
307 (call-process "send-pr" nil t nil "-P" site)
309 (setq send-pr::template-alist
310 (cons (cons site (buffer-substring (point-min) (point-max)))
311 send-pr::template-alist))))))
313 (fset 'do-send-pr 'send-pr:submit-pr) ;backward compat
314 (defun send-pr:submit-pr ()
315 "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this
316 buffer was loaded with emacsclient, in which case save the buffer and exit."
320 ((and (boundp 'server-buffer-clients)
321 server-buffer-clients)
322 (let ((buffer (current-buffer))
323 (version-control nil) (buffer-backed-up nil))
326 (server-buffer-done buffer)))
327 (send-pr:::spawn-to-send
328 (if (or (buffer-modified-p)
330 (y-or-n-p "PR already sent; resend? "))
332 (or (and send-pr:::err-buffer
333 (buffer-name send-pr:::err-buffer))
334 (setq send-pr:::err-buffer
335 (get-buffer-create send-pr::err-buffer-name)))
336 (let ((err-buffer send-pr:::err-buffer) mesg ok)
337 (save-excursion (set-buffer err-buffer) (erase-buffer))
338 (message "running send-pr...")
339 (let ((oldpr (getenv "GNATS_ROOT")))
340 (setenv "GNATS_ROOT" gnats:root)
341 ;; ensure that a final newline is present:
342 (if (not (equal (char-after (1- (point-max))) ?\n))
343 (save-excursion (goto-char (point-max))
345 (call-process-region (point-min) (point-max) "send-pr"
346 nil err-buffer nil send-pr:::site
348 (setenv "GNATS_ROOT" oldpr))
349 (message "running send-pr...done")
350 ;; stupidly we cannot check the return value in EMACS 18.57,
351 ;; thus we need this kluge to find out whether send-pr succeeded.
353 (set-buffer err-buffer)
354 (goto-char (point-min))
355 (setq mesg (buffer-substring (point-min) (- (point-max) 1)))
356 (search-forward "problem report sent" nil t))
357 (progn (message mesg)
358 (kill-buffer err-buffer)
359 (delete-auto-save-file-if-necessary)
360 (set-buffer-modified-p nil)
361 (setq send-pr:::sent t)
363 (pop-to-buffer err-buffer))
367 (message "Exit emacs to send the PR."))))
369 ;;;;---------------------------------------------------------------------------
370 ;;;; send-pr:send-pr-mode mode
371 ;;;;---------------------------------------------------------------------------
373 (defvar send-pr-mode-map
374 (let ((map (make-sparse-keymap)))
375 (define-key map "\C-c\C-c" 'send-pr:submit-pr)
376 (define-key map "\C-c\C-f" 'gnats:change-field)
377 (define-key map "\M-n" 'gnats:next-field)
378 (define-key map "\M-p" 'gnats:previous-field)
379 (define-key map "\C-\M-f" 'gnats:forward-field)
380 (define-key map "\C-\M-b" 'gnats:backward-field)
382 "Keymap for send-pr mode.")
384 (defconst gnats::keyword "^>\\([-a-zA-Z]+\\):")
385 (defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):")
386 (defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+")
388 (fset 'send-pr-mode 'send-pr:send-pr-mode)
389 (defun send-pr:send-pr-mode ()
390 "Major mode for submitting problem reports.
391 For information about the form see gnats(1) and send-pr(1).
392 Special commands: \\{send-pr-mode-map}
393 Turning on send-pr-mode calls the value of the variable send-pr-mode-hook,
396 (gnats::patch-exec-path)
397 (put 'send-pr:send-pr-mode 'mode-class 'special)
398 (kill-all-local-variables)
399 (setq major-mode 'send-pr:send-pr-mode)
400 (setq mode-name "send-pr")
401 (use-local-map send-pr-mode-map)
402 (set-syntax-table text-mode-syntax-table)
403 (setq local-abbrev-table text-mode-abbrev-table)
404 (setq buffer-offer-save t)
405 (make-local-variable 'send-pr:::site)
406 (make-local-variable 'send-pr:::categories)
407 (make-local-variable 'send-pr:::err-buffer)
408 (make-local-variable 'send-pr:::spawn-to-send)
409 (make-local-variable 'send-pr:::sent)
410 (setq send-pr:::sent nil)
411 (make-local-variable 'paragraph-separate)
412 (setq paragraph-separate (concat (default-value 'paragraph-separate)
413 "\\|" gnats::keyword "[ \t\n\f]*$"))
414 (make-local-variable 'paragraph-start)
415 (setq paragraph-start (concat (default-value 'paragraph-start)
416 "\\|" gnats::keyword))
417 (run-hooks 'send-pr-mode-hook)
420 ;;;;---------------------------------------------------------------------------
421 ;;;; Functions to read and replace field values.
422 ;;;;---------------------------------------------------------------------------
424 (defun gnats::position-on-field (field &optional quiet)
425 (goto-char (point-min))
426 (if (not (re-search-forward (concat "^>" field ":") nil t))
429 (error "Field `>%s:' not found." field))
430 (re-search-forward "[ \t\n\f]*")
431 (if (looking-at gnats::keyword)
435 (defun gnats::mail-position-on-field (field)
437 (case-fold-search t))
438 (goto-char (point-min))
439 (re-search-forward "^$")
440 (setq end (match-beginning 0))
441 (goto-char (point-min))
442 (if (not (re-search-forward (concat "^" field ":") end 'go-to-end))
443 (insert field ": \n")
444 (re-search-forward "[ \t\n\f]*"))
445 (skip-chars-backward "\n")
448 (defun gnats::field-contents (field &optional elem move)
452 (if (not (gnats::position-on-field field t))
454 (setq pos (point-marker))
455 (if (or (looking-at "<.*>$") (eolp))
457 (looking-at ".*$") ; to set match-{beginning,end}
459 (buffer-substring (match-beginning 0) (match-end 0))
461 (and move pos (goto-char pos)))))
463 (defun gnats::functionp (thing)
464 (or (and (symbolp thing) (fboundp thing))
465 (and (listp thing) (eq (car thing) 'lambda))))
467 (defun gnats::field-values (field)
468 "Return the possible (known) values for field FIELD."
469 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
471 (thing (elt (assoc field fields) 1)))
472 (cond ((gnats::functionp thing) (funcall thing))
473 ((listp thing) thing)
476 (defun gnats::field-default (field)
477 "Return the default value for field FIELD."
478 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
480 (thing (elt (assoc field fields) 2)))
481 (cond ((stringp thing) thing)
483 ((numberp thing) (car (elt (gnats::field-values field) thing)))
484 ((gnats::functionp thing)
485 (funcall thing (gnats::field-contents field)))
486 ((eq thing t) (gnats::field-contents field))
489 (defun gnats::field-type (field)
490 "Return the type of field FIELD."
491 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
493 (thing (elt (assoc field fields) 3)))
496 (defun gnats::field-action (field)
497 "Return the extra handling function for field FIELD."
498 (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields
500 (thing (elt (assoc field fields) 4)))
501 (cond ((null thing) 'ignore)
502 ((gnats::functionp thing) thing)
505 ;;;;---------------------------------------------------------------------------
506 ;;;; Point movement functions
507 ;;;;---------------------------------------------------------------------------
509 (or (fboundp 'defsubst) (fset 'defsubst 'defun))
511 (defun send-pr::maybe-change-field (field)
512 (setq field (car field))
513 (let ((thing (gnats::field-contents field)))
514 (and thing (eq t thing)
515 (not (eq 'multi-text (gnats::field-type field)))
516 (gnats:change-field field))))
518 (defun gnats:change-field (&optional field default)
519 "Change the value of the field containing the cursor. With arg, ask the
520 user for the field to change. From a program, the function takes optional
521 arguments of the field to change and the default value to use."
523 (or field current-prefix-arg (setq field (gnats::current-field)))
526 (completing-read "Field: "
527 (if (eq major-mode 'gnats:gnats-mode)
531 (gnats::position-on-field field)
533 (let* ((old (gnats::field-contents field))
537 (if (or (interactive-p) t)
538 (let ((prompt (concat ">" field ": "))
539 (domain (gnats::field-values field))
540 (type (gnats::field-type field)))
541 (or default (setq default (gnats::field-default field)))
544 (completing-read prompt domain nil t
545 (if gnats::emacs-19p (cons default 0)
547 (read-string prompt (if gnats::emacs-19p (cons default 1)
550 (gnats::set-field field new)
551 (funcall (gnats::field-action field) field old new)
554 (defun gnats::set-field (field value)
556 (gnats::position-on-field field)
557 (delete-horizontal-space)
560 (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t)))
562 (defun gnats::set-mail-field (field value)
564 (gnats::mail-position-on-field field)
565 (delete-horizontal-space)
567 (replace-match (concat " " value) t)))
569 (defun gnats::before-keyword (&optional where)
570 "Returns t if point is in some white space before a keyword.
571 If where is nil, then point is not changed; if where is t then point is moved
572 to the beginning of the keyword, otherwise it is moved to the beginning
573 of the white space it was in."
575 (if (looking-at gnats::before-keyword)
578 (re-search-forward "^>") (backward-char))
579 ((not (eq where nil))
580 (re-search-backward "[^ \t\n\f]") (forward-char))))
583 (defun gnats::after-keyword (&optional where)
584 "Returns t if point is in some white space after a keyword.
585 If where is nil, then point is not changed; if where is t then point is moved
586 to the beginning of the keyword, otherwise it is moved to the end of the white
589 (if (gnats::looking-after gnats::after-keyword)
592 (re-search-backward "^>"))
593 ((not (eq where nil))
594 (re-search-forward "[^ \t\n\f]") (backward-char))))
597 (defun gnats::in-keyword (&optional where)
598 "Returns t if point is within a keyword.
599 If where is nil, then point is not changed; if where is t then point is moved
600 to the beginning of the keyword."
602 (let ((old-point (point-marker)))
604 (cond ((and (looking-at gnats::keyword)
605 (< old-point (match-end 0)))
609 (goto-char old-point))))
610 (t (goto-char old-point)
613 (defun gnats::forward-bofield ()
614 "Moves point to the beginning of a field. Assumes that point is in the
617 (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-)
621 (defun gnats::backward-eofield ()
622 "Moves point to the end of a field. Assumes point is in the keyword."
624 (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-)
628 (defun gnats::forward-eofield ()
629 "Moves point to the end of a field. Assumes that point is in the field."
631 ;; look for the next field
632 (if (re-search-forward gnats::keyword (point-max) '-)
633 (progn (beginning-of-line) (gnats::backward-eofield))
634 (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-)
637 (defun gnats::backward-bofield ()
638 "Moves point to the beginning of a field. Assumes that point is in the
641 ;;look for previous field
642 (if (re-search-backward gnats::keyword (point-min) '-)
643 (gnats::forward-bofield)
647 (defun gnats:forward-field ()
648 "Move point forward to the end of the field or to the beginning of the next
652 (if (or (gnats::before-keyword t) (gnats::in-keyword t)
653 (gnats::after-keyword t))
654 (gnats::forward-bofield)
655 (gnats::forward-eofield)))
657 (defun gnats:backward-field ()
658 "Move point backward to the beginning/end of a field."
662 (if (or (gnats::before-keyword t) (gnats::in-keyword t)
663 (gnats::after-keyword t))
664 (gnats::backward-eofield)
665 (gnats::backward-bofield)))
667 (defun gnats:next-field ()
668 "Move point to the beginning of the next field."
671 (if (or (gnats::before-keyword t) (gnats::in-keyword t)
672 (gnats::after-keyword t))
673 (gnats::forward-bofield)
674 (if (re-search-forward gnats::keyword (point-max) '-)
675 (gnats::forward-bofield)
678 (defun gnats:previous-field ()
679 "Move point to the beginning of the previous field."
683 (if (or (gnats::after-keyword t) (gnats::in-keyword t)
684 (gnats::before-keyword t))
685 (progn (re-search-backward gnats::keyword (point-min) '-)
686 (gnats::forward-bofield))
687 (gnats::backward-bofield)))
689 (defun gnats:beginning-of-field ()
690 "Move point to the beginning of the current field."
692 (cond ((gnats::in-keyword t)
693 (gnats::forward-bofield))
694 ((gnats::after-keyword 0))
696 (gnats::backward-bofield))))
698 (defun gnats::current-field ()
700 (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t))
701 (looking-at gnats::keyword))
702 ((re-search-backward gnats::keyword nil t)))
703 (buffer-substring (match-beginning 1) (match-end 1))
706 ;;;;---------------------------------------------------------------------------
707 ;;;; Support functions
708 ;;;;---------------------------------------------------------------------------
710 (defun gnats::looking-after (regex)
711 "Returns t if point is after regex."
713 (let* ((old-point (point))
716 (forward-char) (point))))
717 (cond ((re-search-backward regex (point-min) t)
718 (goto-char old-point)
719 (cond ((eq (match-end 0) start)
722 (defun gnats::nth-word (string &optional elem)
723 "Returns the elem-th word of the string.
724 If elem is nil, then the first wort is returned, if elem is 0 then
725 the whole string is returned."
728 (cond ((eq elem 0) string)
729 ((eq elem 1) (gnats::first-word string))
730 ((equal string "") "")
732 (let ((i 0) (value ""))
733 (setq string ; strip leading blanks
734 (substring string (or (string-match "[^ \t]" string) 0)))
738 (string-match "[ \t]*$\\|[ \t]+" string)))
740 (substring string (match-end 0)))
743 (gnats::first-word string)))
745 (defun gnats::first-word (string)
747 (substring string (or (string-match "[^ \t]" string) 0)))
748 (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string)))
750 ;;;;---------------------------------------------------------------------------
752 (defun gnats::patch-exec-path ()
754 "Replaces `//' by `/' in `exec-path'."
756 ;(make-local-variable 'exec-path)
757 (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*"))
759 (setq exec-path (save-excursion (set-buffer err-buffer)
760 (prin1 exec-path err-buffer)
761 (goto-char (point-min))
762 (while (search-forward "//" nil t)
763 (replace-match "/" nil t))
764 (goto-char (point-min))
765 (setq ret (read err-buffer))
766 (kill-buffer err-buffer)
770 (defun gnats::get-value-from-shell (&rest command)
771 "Execute shell command to get a list of valid values for `variable'."
773 (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*")))
775 (set-buffer err-buffer)
780 (car command) nil err-buffer nil (cdr command))
781 (goto-char (point-min))
782 (if (looking-at "[-a-z]+: ")
783 (error (buffer-substring (point-min) (point-max))))
786 (kill-buffer err-buffer)))))
788 (or (fboundp 'setenv)
789 (defun setenv (variable &optional value)
790 "Set the value of the environment variable named VARIABLE to VALUE.
791 VARIABLE should be a string. VALUE is optional; if not provided or is
792 `nil', the environment variable VARIABLE will be removed.
793 This function works by modifying `process-environment'."
794 (interactive "sSet environment variable: \nsSet %s to value: ")
795 (if (string-match "=" variable)
796 (error "Environment variable name `%s' contains `='" variable)
797 (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
798 (case-fold-search nil)
799 (scan process-environment))
802 ((string-match pattern (car scan))
804 (setq process-environment (delq (car scan)
805 process-environment))
806 (setcar scan (concat variable "=" value)))
808 ((null (setq scan (cdr scan)))
809 (setq process-environment
810 (cons (concat variable "=" value)
811 process-environment)))))))))
813 ;;;; end of send-pr.el