diff options
author | paul <paul@FreeBSD.org> | 1994-08-29 04:02:54 +0000 |
---|---|---|
committer | paul <paul@FreeBSD.org> | 1994-08-29 04:02:54 +0000 |
commit | 35b3792d9b70a151726002f967ee492dd3df1f03 (patch) | |
tree | aa4612cf100ba70c79f862b5c7e93e7e965d917c /gnu/usr.bin/send-pr/send-pr-el.in | |
parent | 0cbac02301f6d25c2151a7c6b1797f69d19bd9c7 (diff) | |
download | FreeBSD-src-35b3792d9b70a151726002f967ee492dd3df1f03.zip FreeBSD-src-35b3792d9b70a151726002f967ee492dd3df1f03.tar.gz |
Added send-pr for sending in bug reports.
Reviewed by:
Submitted by:
Diffstat (limited to 'gnu/usr.bin/send-pr/send-pr-el.in')
-rw-r--r-- | gnu/usr.bin/send-pr/send-pr-el.in | 744 |
1 files changed, 744 insertions, 0 deletions
diff --git a/gnu/usr.bin/send-pr/send-pr-el.in b/gnu/usr.bin/send-pr/send-pr-el.in new file mode 100644 index 0000000..036b4e7 --- /dev/null +++ b/gnu/usr.bin/send-pr/send-pr-el.in @@ -0,0 +1,744 @@ +;;;; -*-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. +;;;; +;;;;--------------------------------------------------------------------------- + +(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") ("support")) + (, (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 |