send-pr-el.in revision 59366
12382Spaul;;;; -*-emacs-lisp-*- 22382Spaul;;;;--------------------------------------------------------------------------- 32382Spaul;;;; EMACS interface for send-pr (by Heinz G. Seidl, hgs@cygnus.com) 42382Spaul;;;; Slightly hacked by Brendan Kehoe (brendan@cygnus.com). 52382Spaul;;;; 62382Spaul;;;; This file is part of the Problem Report Management System (GNATS) 72382Spaul;;;; Copyright 1992, 1993 Cygnus Support 82382Spaul;;;; 92382Spaul;;;; This program is free software; you can redistribute it and/or 102382Spaul;;;; modify it under the terms of the GNU General Public 112382Spaul;;;; License as published by the Free Software Foundation; either 122382Spaul;;;; version 2 of the License, or (at your option) any later version. 132382Spaul;;;; 142382Spaul;;;; This program is distributed in the hope that it will be useful, 152382Spaul;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 162382Spaul;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 172382Spaul;;;; General Public License for more details. 182382Spaul;;;; 192382Spaul;;;; You should have received a copy of the GNU Library General Public 202382Spaul;;;; License along with this program; if not, write to the Free 212382Spaul;;;; Software Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 222382Spaul;;;; 232382Spaul;;;;--------------------------------------------------------------------------- 242382Spaul;;;; 252382Spaul;;;; This file contains the EMACS interface to the Problem Report Management 262382Spaul;;;; System (GNATS): 272382Spaul;;;; 282382Spaul;;;; - The `send-pr' command and the `send-pr-mode' for sending 292382Spaul;;;; Problem Reports (PRs). 302382Spaul;;;; 312382Spaul;;;; For more information about how to send a PR see send-pr(1). 322382Spaul;;;; 332382Spaul;;;;--------------------------------------------------------------------------- 342382Spaul;;;; 352382Spaul;;;; Configuration: the symbol `DEFAULT-RELEASE' can be replaced by 362382Spaul;;;; site/release specific strings during the configuration/installation 372382Spaul;;;; process. 382382Spaul;;;; 392382Spaul;;;; Install this file in your EMACS library directory. 402382Spaul;;;; 412382Spaul;;;;--------------------------------------------------------------------------- 4259366Ssteve;;;; 4359366Ssteve;;;; $FreeBSD: head/gnu/usr.bin/send-pr/send-pr-el.in 59366 2000-04-18 15:03:34Z steve $ 442382Spaul 452382Spaul(provide 'send-pr) 462382Spaul 472382Spaul;;;;--------------------------------------------------------------------------- 482382Spaul;;;; Customization: put the following forms into your default.el file 492382Spaul;;;; (or into your .emacs) 502382Spaul;;;;--------------------------------------------------------------------------- 512382Spaul 522382Spaul;(autoload 'send-pr-mode "send-pr" 532382Spaul; "Major mode for sending problem reports." t) 542382Spaul 552382Spaul;(autoload 'send-pr "send-pr" 562382Spaul; "Command to create and send a problem report." t) 572382Spaul 582382Spaul;;;;--------------------------------------------------------------------------- 592382Spaul;;;; End of Customization Section 602382Spaul;;;;--------------------------------------------------------------------------- 612382Spaul 622382Spaul(autoload 'server-buffer-done "server") 632382Spaul(defvar server-buffer-clients nil) 642382Spaul(defvar mail-self-blind nil) 652382Spaul(defvar mail-default-reply-to nil) 662382Spaul 672382Spaul(defconst send-pr::version "3.2") 682382Spaul 692382Spaul(defvar gnats:root "/home/gnats" 702382Spaul "*The top of the tree containing the GNATS database.") 712382Spaul 722382Spaul;;;;--------------------------------------------------------------------------- 732382Spaul;;;; hooks 742382Spaul;;;;--------------------------------------------------------------------------- 752382Spaul 762382Spaul(defvar text-mode-hook nil) ; we define it here in case it's not defined 772382Spaul(defvar send-pr-mode-hook text-mode-hook "Called when send-pr is invoked.") 782382Spaul 792382Spaul;;;;--------------------------------------------------------------------------- 802382Spaul;;;; Domains and default values for (some of) the Problem Report fields; 812382Spaul;;;; constants and definitions. 822382Spaul;;;;--------------------------------------------------------------------------- 832382Spaul 842382Spaul(defconst gnats::emacs-19p 852382Spaul (not (or (and (boundp 'epoch::version) epoch::version) 862382Spaul (string-lessp emacs-version "19"))) 872382Spaul "Is this emacs v19?") 882382Spaul 892382Spaul;;; These may be changed during configuration/installation or by the individual 902382Spaul;;; user in his/her .emacs file. 912382Spaul;;; 922382Spaul(defun gnats::get-config (var) 932382Spaul (let ((shell-file-name "/bin/sh") 942382Spaul (buf (generate-new-buffer " *GNATS config*")) 952382Spaul ret) 962382Spaul (save-excursion 972382Spaul (set-buffer buf) 982382Spaul (shell-command (concat ". " gnats:root "/gnats-adm/config; echo $" var ) 992382Spaul t) 10024859Sjkh (if (looking-at "^\\.:\\|/bin/sh:\\|\n") 1012382Spaul (setq ret nil) 1022382Spaul (setq ret (buffer-substring (point-min) (- (point-max) 1))))) 1032382Spaul (kill-buffer buf) 1042382Spaul ret)) 1052382Spaul 1062382Spaul;; const because it must match the script's value 1072382Spaul(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@") 1082382Spaul "*Where the `gnats' subdirectory containing category lists lives.") 1092382Spaul 1102382Spaul(defvar send-pr::sites nil 1112382Spaul "List of GNATS support sites; computed at runtime.") 1122382Spaul(defvar send-pr:default-site 1132382Spaul (or (gnats::get-config "GNATS_SITE") "freefall") 1142382Spaul "Default site to send bugs to.") 1152382Spaul(defvar send-pr:::site send-pr:default-site 1162382Spaul "The site to which a problem report is currently being submitted, or NIL 1172382Spaulif using the default site (buffer local).") 1182382Spaul 1192382Spaul(defvar send-pr:::categories nil 1202382Spaul "Buffer local list of available categories, derived at runtime from 1212382Spaulsend-pr:::site and send-pr::category-alist.") 1222382Spaul(defvar send-pr::category-alist nil 1232382Spaul "Alist of GNATS support sites and the categories supported at each; computed 1242382Spaulat runtime.") 1252382Spaul 1262382Spaul;;; Ideally we would get all the following values from a central database 1272382Spaul;;; during runtime instead of having them here in the code. 1282382Spaul;;; 1292382Spaul(defconst send-pr::fields 1302382Spaul (` (("Category" send-pr::set-categories 1312382Spaul (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum) 13259366Ssteve ("Class" (("sw-bug") ("doc-bug") ("change-request") ("wish")) 1332382Spaul (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 0)) enum) 1342382Spaul ("Confidential" (("yes") ("no")) 1352382Spaul (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum) 1362382Spaul ("Severity" (("non-critical") ("serious") ("critical")) 1372382Spaul (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum) 1382382Spaul ("Priority" (("low") ("medium") ("high")) 1392382Spaul (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum) 1402382Spaul ("Release" nil 1412382Spaul (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@")) 1422382Spaul text) 1432382Spaul ("Submitter-Id" nil 1442382Spaul (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) 1452382Spaul text) 1462382Spaul ("Synopsis" nil nil text 1472382Spaul (lambda (a b c) (gnats::set-mail-field "Subject" c))))) 1482382Spaul "AList, keyed on the name of the field, of: 1492382Spaul1) The field name. 1502382Spaul2) The list of completions. This can be a list, a function to call, or nil. 1512382Spaul3) The default value. 1522382Spaul4) The type of the field. 1532382Spaul5) A sub-function to call when changed.") 1542382Spaul 1552382Spaul(defvar gnats::fields nil) 1562382Spaul 1572382Spaul(defmacro gnats::push (i l) 1582382Spaul (` (setq (, l) (cons (,@ (list i l)))))) 1592382Spaul 1602382Spaul(defun send-pr::set-categories (&optional arg) 1612382Spaul "Get the list of categories for the current site out of 1622382Spaulsend-pr::category-alist if there or from send-pr if not. With arg, force 1632382Spaulupdate." 1642382Spaul ;; 1652382Spaul (let ((entry (assoc send-pr:::site send-pr::category-alist))) 1662382Spaul (or (and entry (null arg)) 1672382Spaul (let ((oldpr (getenv "GNATS_ROOT")) cats) 1682382Spaul (send-pr::set-sites arg) 1692382Spaul (setenv "GNATS_ROOT" gnats:root) 1702382Spaul (setq cats (gnats::get-value-from-shell 1712382Spaul "send-pr" "-CL" send-pr:::site)) 1722382Spaul (setenv "GNATS_ROOT" oldpr) 1732382Spaul (if entry (setcdr entry cats) 1742382Spaul (setq entry (cons send-pr:::site cats)) 1752382Spaul (gnats::push entry send-pr::category-alist)))) 1762382Spaul (setq send-pr:::categories (cdr entry)))) 1772382Spaul 1782382Spaul(defun send-pr::set-sites (&optional arg) 1792382Spaul "Get the list of sites (by listing the contents of DATADIR/gnats) and assign 1802382Spaulit to send-pr::sites. With arg, force update." 1812382Spaul (or (and (null arg) send-pr::sites) 1822382Spaul (progn 1832382Spaul (setq send-pr::sites nil) 1842382Spaul (mapcar 1852382Spaul (function 1862382Spaul (lambda (file) 1872382Spaul (or (memq t (mapcar (function (lambda (x) (string= x file))) 1882382Spaul '("." ".." "pr-edit" "pr-addr"))) 1892382Spaul (not (file-readable-p file)) 1902382Spaul (gnats::push (list (file-name-nondirectory file)) 1912382Spaul send-pr::sites)))) 1922382Spaul (directory-files (format "%s/gnats" send-pr:datadir) t)) 1932382Spaul (setq send-pr::sites (reverse send-pr::sites))))) 1942382Spaul 1952382Spaul(defconst send-pr::pr-buffer-name "*send-pr*" 1962382Spaul "Name of the temporary buffer, where the problem report gets composed.") 1972382Spaul 1982382Spaul(defconst send-pr::err-buffer-name "*send-pr-error*" 1992382Spaul "Name of the temporary buffer, where send-pr error messages appear.") 2002382Spaul 2012382Spaul(defvar send-pr:::err-buffer nil 2022382Spaul "The error buffer used by the current PR buffer.") 2032382Spaul 2042382Spaul(defconst gnats::indent 17 "Indent for formatting the value.") 2052382Spaul 2062382Spaul;;;;--------------------------------------------------------------------------- 2072382Spaul;;;; `send-pr' - command for creating and sending of problem reports 2082382Spaul;;;;--------------------------------------------------------------------------- 2092382Spaul 2102382Spaul(fset 'send-pr 'send-pr:send-pr) 2112382Spaul(defun send-pr:send-pr (&optional site) 2122382Spaul "Create a buffer and read in the result of `send-pr -P'. 2132382SpaulWhen finished with editing the problem report use \\[send-pr:submit-pr] 2142382Spaulto send the PR with `send-pr -b -f -'." 2152382Spaul ;; 2162382Spaul (interactive 2172382Spaul (if current-prefix-arg 2182382Spaul (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t 2192382Spaul send-pr:default-site)))) 2202382Spaul (or site (setq site send-pr:default-site)) 2212382Spaul (let ((buf (get-buffer send-pr::pr-buffer-name))) 2222382Spaul (if (or (not buf) 2232382Spaul (progn (switch-to-buffer buf) 2242382Spaul (cond ((or (not (buffer-modified-p buf)) 2252382Spaul (y-or-n-p "Erase previous problem report? ")) 2262382Spaul (erase-buffer) t) 2272382Spaul (t nil)))) 2282382Spaul (send-pr::start-up site)))) 2292382Spaul 2302382Spaul(defun send-pr::start-up (site) 2312382Spaul (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name)) 2322382Spaul (setq default-directory (expand-file-name "~/")) 2332382Spaul (auto-save-mode auto-save-default) 2342382Spaul (let ((oldpr (getenv "GNATS_ROOT")) 2352382Spaul (case-fold-search nil)) 2362382Spaul (setenv "GNATS_ROOT" gnats:root) 2372382Spaul (shell-command (concat "send-pr -P " site) t) 2382382Spaul (setenv "GNATS_ROOT" oldpr) 2392382Spaul (if (looking-at "send-pr:") 2402382Spaul (cond ((looking-at "send-pr: .* does not have a categories list") 2412382Spaul (setq send-pr::sites nil) 2422382Spaul (error "send-pr: the GNATS site %s does not have a categories list" site)) 2432382Spaul (t (error (buffer-substring (point-min) (point-max))))) 2442382Spaul (save-excursion 2452382Spaul ;; Clear cruft inserted by bdamaged .cshrcs 2462382Spaul (re-search-forward "^SEND-PR:") 2472382Spaul (delete-region 1 (match-beginning 0))))) 2482382Spaul (set-buffer-modified-p nil) 2492382Spaul (send-pr:send-pr-mode) 2502382Spaul (setq send-pr:::site site) 2512382Spaul (send-pr::set-categories) 2522382Spaul (if (null send-pr:::categories) 2532382Spaul (progn 2542382Spaul (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer)) 2552382Spaul (kill-buffer nil) 2562382Spaul (message "send-pr: no categories found")) 2572382Spaul (and mail-default-reply-to 2582382Spaul (gnats::set-mail-field "Reply-To" mail-default-reply-to)) 2592382Spaul (and mail-self-blind 2602382Spaul (gnats::set-mail-field "BCC" (user-login-name))) 2612382Spaul (mapcar 'send-pr::maybe-change-field send-pr::fields) 2622382Spaul (gnats::position-on-field "Description") 2632382Spaul (message (substitute-command-keys 2642382Spaul "To send the problem report use: \\[send-pr:submit-pr]")))) 2652382Spaul 2662382Spaul(fset 'do-send-pr 'send-pr:submit-pr) ;backward compat 2672382Spaul(defun send-pr:submit-pr () 2682382Spaul "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this 2692382Spaulbuffer was loaded with emacsclient, in which case save the buffer and exit." 2702382Spaul ;; 2712382Spaul (interactive) 2722382Spaul (cond 2732382Spaul ((and (boundp 'server-buffer-clients) 2742382Spaul server-buffer-clients) 2752382Spaul (let ((buffer (current-buffer)) 2762382Spaul (version-control nil) (buffer-backed-up nil)) 2772382Spaul (save-buffer buffer) 2782382Spaul (kill-buffer buffer) 2792382Spaul (server-buffer-done buffer))) 2802382Spaul (t 2812382Spaul (or (and send-pr:::err-buffer 2822382Spaul (buffer-name send-pr:::err-buffer)) 2832382Spaul (setq send-pr:::err-buffer 2842382Spaul (get-buffer-create send-pr::err-buffer-name))) 2852382Spaul (let ((err-buffer send-pr:::err-buffer) mesg ok) 2862382Spaul (save-excursion (set-buffer err-buffer) (erase-buffer)) 2872382Spaul (message "running send-pr...") 2882382Spaul (let ((oldpr (getenv "GNATS_ROOT"))) 2892382Spaul (setenv "GNATS_ROOT" gnats:root) 2902382Spaul (call-process-region (point-min) (point-max) "send-pr" 2912382Spaul nil err-buffer nil send-pr:::site 2922382Spaul "-b" "-f" "-") 2932382Spaul (setenv "GNATS_ROOT" oldpr)) 2942382Spaul (message "running send-pr...done") 2952382Spaul ;; stupidly we cannot check the return value in EMACS 18.57, thus we need 2962382Spaul ;; this kluge to find out whether send-pr succeeded. 2972382Spaul (if (save-excursion 2982382Spaul (set-buffer err-buffer) 2992382Spaul (goto-char (point-min)) 3002382Spaul (setq mesg (buffer-substring (point-min) (- (point-max) 1))) 3012382Spaul (search-forward "problem report sent" nil t)) 3022382Spaul (progn (message mesg) 3032382Spaul (kill-buffer err-buffer) 3042382Spaul (delete-auto-save-file-if-necessary) 3052382Spaul (set-buffer-modified-p nil) 3062382Spaul (bury-buffer)) 3072382Spaul (pop-to-buffer err-buffer)) 3082382Spaul )))) 3092382Spaul 3102382Spaul;;;;--------------------------------------------------------------------------- 3112382Spaul;;;; send-pr:send-pr-mode mode 3122382Spaul;;;;--------------------------------------------------------------------------- 3132382Spaul 3142382Spaul(defvar send-pr-mode-map 3152382Spaul (let ((map (make-sparse-keymap))) 3162382Spaul (define-key map "\C-c\C-c" 'send-pr:submit-pr) 3172382Spaul (define-key map "\C-c\C-f" 'gnats:change-field) 3182382Spaul (define-key map "\M-n" 'gnats:next-field) 3192382Spaul (define-key map "\M-p" 'gnats:previous-field) 3202382Spaul (define-key map "\C-\M-f" 'gnats:forward-field) 3212382Spaul (define-key map "\C-\M-b" 'gnats:backward-field) 3222382Spaul map) 3232382Spaul "Keymap for send-pr mode.") 3242382Spaul 3252382Spaul(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):") 3262382Spaul(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):") 3272382Spaul(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+") 3282382Spaul 3292382Spaul(fset 'send-pr-mode 'send-pr:send-pr-mode) 3302382Spaul(defun send-pr:send-pr-mode () 3312382Spaul "Major mode for submitting problem reports. 3322382SpaulFor information about the form see gnats(1) and send-pr(1). 3332382SpaulSpecial commands: \\{send-pr-mode-map} 3342382SpaulTurning on send-pr-mode calls the value of the variable send-pr-mode-hook, 3352382Spaulif it is not nil." 3362382Spaul (interactive) 3372382Spaul (gnats::patch-exec-path) 3382382Spaul (put 'send-pr:send-pr-mode 'mode-class 'special) 3392382Spaul (kill-all-local-variables) 3402382Spaul (setq major-mode 'send-pr:send-pr-mode) 3412382Spaul (setq mode-name "send-pr") 3422382Spaul (use-local-map send-pr-mode-map) 3432382Spaul (set-syntax-table text-mode-syntax-table) 3442382Spaul (setq local-abbrev-table text-mode-abbrev-table) 3452382Spaul (setq buffer-offer-save t) 3462382Spaul (make-local-variable 'send-pr:::site) 3472382Spaul (make-local-variable 'send-pr:::categories) 3482382Spaul (make-local-variable 'send-pr:::err-buffer) 3492382Spaul (make-local-variable 'paragraph-separate) 3502382Spaul (setq paragraph-separate (concat (default-value 'paragraph-separate) 3512382Spaul "\\|" gnats::keyword "[ \t\n\f]*$")) 3522382Spaul (make-local-variable 'paragraph-start) 3532382Spaul (setq paragraph-start (concat (default-value 'paragraph-start) 3542382Spaul "\\|" gnats::keyword)) 3552382Spaul (run-hooks 'send-pr-mode-hook) 3562382Spaul t) 3572382Spaul 3582382Spaul;;;;--------------------------------------------------------------------------- 3592382Spaul;;;; Functions to read and replace field values. 3602382Spaul;;;;--------------------------------------------------------------------------- 3612382Spaul 3622382Spaul(defun gnats::position-on-field (field) 3632382Spaul (goto-char (point-min)) 3642382Spaul (if (not (re-search-forward (concat "^>" field ":") nil t)) 3652382Spaul (error "Field `>%s:' not found." field) 3662382Spaul (re-search-forward "[ \t\n\f]*") 3672382Spaul (if (looking-at gnats::keyword) 3682382Spaul (backward-char 1)) 3692382Spaul t)) 3702382Spaul 3712382Spaul(defun gnats::mail-position-on-field (field) 3722382Spaul (let (end 3732382Spaul (case-fold-search t)) 3742382Spaul (goto-char (point-min)) 3752382Spaul (re-search-forward "^$") 3762382Spaul (setq end (match-beginning 0)) 3772382Spaul (goto-char (point-min)) 3782382Spaul (if (not (re-search-forward (concat "^" field ":") end 'go-to-end)) 3792382Spaul (insert field ": \n") 3802382Spaul (re-search-forward "[ \t\n\f]*")) 3812382Spaul (skip-chars-backward "\n") 3822382Spaul t)) 3832382Spaul 3842382Spaul(defun gnats::field-contents (field &optional elem move) 3852382Spaul (let (pos) 3862382Spaul (unwind-protect 3872382Spaul (save-excursion 3882382Spaul (if (not (gnats::position-on-field field)) 3892382Spaul nil 3902382Spaul (setq pos (point-marker)) 3912382Spaul (if (or (looking-at "<.*>$") (eolp)) 3922382Spaul t 3932382Spaul (looking-at ".*$") ; to set match-{beginning,end} 3942382Spaul (gnats::nth-word 3952382Spaul (buffer-substring (match-beginning 0) (match-end 0)) 3962382Spaul elem)))) 3972382Spaul (and move pos (goto-char pos))))) 3982382Spaul 3992382Spaul(defun gnats::functionp (thing) 4002382Spaul (or (and (symbolp thing) (fboundp thing)) 4012382Spaul (and (listp thing) (eq (car thing) 'lambda)))) 4022382Spaul 4032382Spaul(defun gnats::field-values (field) 4042382Spaul "Return the possible (known) values for field FIELD." 4052382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4062382Spaul send-pr::fields)) 4072382Spaul (thing (elt (assoc field fields) 1))) 4082382Spaul (cond ((gnats::functionp thing) (funcall thing)) 4092382Spaul ((listp thing) thing) 4102382Spaul (t (error "ACK"))))) 4112382Spaul 4122382Spaul(defun gnats::field-default (field) 4132382Spaul "Return the default value for field FIELD." 4142382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4152382Spaul send-pr::fields)) 4162382Spaul (thing (elt (assoc field fields) 2))) 4172382Spaul (cond ((stringp thing) thing) 4182382Spaul ((null thing) "") 4192382Spaul ((numberp thing) (car (elt (gnats::field-values field) thing))) 4202382Spaul ((gnats::functionp thing) 4212382Spaul (funcall thing (gnats::field-contents field))) 4222382Spaul ((eq thing t) (gnats::field-contents field)) 4232382Spaul (t (error "ACK"))))) 4242382Spaul 4252382Spaul(defun gnats::field-type (field) 4262382Spaul "Return the type of field FIELD." 4272382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4282382Spaul send-pr::fields)) 4292382Spaul (thing (elt (assoc field fields) 3))) 4302382Spaul thing)) 4312382Spaul 4322382Spaul(defun gnats::field-action (field) 4332382Spaul "Return the extra handling function for field FIELD." 4342382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4352382Spaul send-pr::fields)) 4362382Spaul (thing (elt (assoc field fields) 4))) 4372382Spaul (cond ((null thing) 'ignore) 4382382Spaul ((gnats::functionp thing) thing) 4392382Spaul (t (error "ACK"))))) 4402382Spaul 4412382Spaul;;;;--------------------------------------------------------------------------- 4422382Spaul;;;; Point movement functions 4432382Spaul;;;;--------------------------------------------------------------------------- 4442382Spaul 4452382Spaul(or (fboundp 'defsubst) (fset 'defsubst 'defun)) 4462382Spaul 4472382Spaul(defun send-pr::maybe-change-field (field) 4482382Spaul (setq field (car field)) 4492382Spaul (let ((thing (gnats::field-contents field))) 4502382Spaul (and thing (eq t thing) 4512382Spaul (not (eq 'multi-text (gnats::field-type field))) 4522382Spaul (gnats:change-field field)))) 4532382Spaul 4542382Spaul(defun gnats:change-field (&optional field default) 4552382Spaul "Change the value of the field containing the cursor. With arg, ask the 4562382Spauluser for the field to change. From a program, the function takes optional 4572382Spaularguments of the field to change and the default value to use." 4582382Spaul (interactive) 4592382Spaul (or field current-prefix-arg (setq field (gnats::current-field))) 4602382Spaul (or field 4612382Spaul (setq field 4622382Spaul (completing-read "Field: " 4632382Spaul (if (eq major-mode 'gnats:gnats-mode) 4642382Spaul gnats::fields 4652382Spaul send-pr::fields) 4662382Spaul nil t))) 4672382Spaul (gnats::position-on-field field) 4682382Spaul (sit-for 0) 4692382Spaul (let* ((old (gnats::field-contents field)) 4702382Spaul new) 4712382Spaul (if (null old) 4722382Spaul (error "ACK") 4732382Spaul (let ((prompt (concat ">" field ": ")) 4742382Spaul (domain (gnats::field-values field)) 4752382Spaul (type (gnats::field-type field)) 4762382Spaul (action (gnats::field-action field))) 4772382Spaul (or default (setq default (gnats::field-default field))) 4782382Spaul (setq new (if (eq type 'enum) 4792382Spaul (completing-read prompt domain nil t 4802382Spaul (if gnats::emacs-19p (cons default 0) 4812382Spaul default)) 4822382Spaul (read-string prompt (if gnats::emacs-19p (cons default 1) 4832382Spaul default)))) 4842382Spaul (gnats::set-field field new) 4852382Spaul (funcall action field old new) 4862382Spaul new)))) 4872382Spaul 4882382Spaul(defun gnats::set-field (field value) 4892382Spaul (save-excursion 4902382Spaul (gnats::position-on-field field) 4912382Spaul (delete-horizontal-space) 4922382Spaul (looking-at ".*$") 4932382Spaul (replace-match 4942382Spaul (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t))) 4952382Spaul 4962382Spaul(defun gnats::set-mail-field (field value) 4972382Spaul (save-excursion 4982382Spaul (gnats::mail-position-on-field field) 4992382Spaul (delete-horizontal-space) 5002382Spaul (looking-at ".*$") 5012382Spaul (replace-match (concat " " value) t))) 5022382Spaul 5032382Spaul(defun gnats::before-keyword (&optional where) 5042382Spaul "Returns t if point is in some white space before a keyword. 5052382SpaulIf where is nil, then point is not changed; if where is t then point is moved 5062382Spaulto the beginning of the keyword, otherwise it is moved to the beginning 5072382Spaulof the white space it was in." 5082382Spaul ;; 5092382Spaul (if (looking-at gnats::before-keyword) 5102382Spaul (prog1 t 5112382Spaul (cond ((eq where t) 5122382Spaul (re-search-forward "^>") (backward-char)) 5132382Spaul ((not (eq where nil)) 5142382Spaul (re-search-backward "[^ \t\n\f]") (forward-char)))) 5152382Spaul nil)) 5162382Spaul 5172382Spaul(defun gnats::after-keyword (&optional where) 5182382Spaul "Returns t if point is in some white space after a keyword. 5192382SpaulIf where is nil, then point is not changed; if where is t then point is moved 5202382Spaulto the beginning of the keyword, otherwise it is moved to the end of the white 5212382Spaulspace it was in." 5222382Spaul ;; 5232382Spaul (if (gnats::looking-after gnats::after-keyword) 5242382Spaul (prog1 t 5252382Spaul (cond ((eq where t) 5262382Spaul (re-search-backward "^>")) 5272382Spaul ((not (eq where nil)) 5282382Spaul (re-search-forward "[^ \t\n\f]") (backward-char)))) 5292382Spaul nil)) 5302382Spaul 5312382Spaul(defun gnats::in-keyword (&optional where) 5322382Spaul "Returns t if point is within a keyword. 5332382SpaulIf where is nil, then point is not changed; if where is t then point is moved 5342382Spaulto the beginning of the keyword." 5352382Spaul ;; 5362382Spaul (let ((old-point (point-marker))) 5372382Spaul (beginning-of-line) 5382382Spaul (cond ((and (looking-at gnats::keyword) 5392382Spaul (< old-point (match-end 0))) 5402382Spaul (prog1 t 5412382Spaul (if (eq where t) 5422382Spaul t 5432382Spaul (goto-char old-point)))) 5442382Spaul (t (goto-char old-point) 5452382Spaul nil)))) 5462382Spaul 5472382Spaul(defun gnats::forward-bofield () 5482382Spaul "Moves point to the beginning of a field. Assumes that point is in the 5492382Spaulkeyword." 5502382Spaul ;; 5512382Spaul (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-) 5522382Spaul (backward-char) 5532382Spaul t)) 5542382Spaul 5552382Spaul(defun gnats::backward-eofield () 5562382Spaul "Moves point to the end of a field. Assumes point is in the keyword." 5572382Spaul ;; 5582382Spaul (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-) 5592382Spaul (forward-char) 5602382Spaul t)) 5612382Spaul 5622382Spaul(defun gnats::forward-eofield () 5632382Spaul "Moves point to the end of a field. Assumes that point is in the field." 5642382Spaul ;; 5652382Spaul ;; look for the next field 5662382Spaul (if (re-search-forward gnats::keyword (point-max) '-) 5672382Spaul (progn (beginning-of-line) (gnats::backward-eofield)) 5682382Spaul (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-) 5692382Spaul (forward-char))) 5702382Spaul 5712382Spaul(defun gnats::backward-bofield () 5722382Spaul "Moves point to the beginning of a field. Assumes that point is in the 5732382Spaulfield." 5742382Spaul ;; 5752382Spaul ;;look for previous field 5762382Spaul (if (re-search-backward gnats::keyword (point-min) '-) 5772382Spaul (gnats::forward-bofield) 5782382Spaul t)) 5792382Spaul 5802382Spaul 5812382Spaul(defun gnats:forward-field () 5822382Spaul "Move point forward to the end of the field or to the beginning of the next 5832382Spaulfield." 5842382Spaul ;; 5852382Spaul (interactive) 5862382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 5872382Spaul (gnats::after-keyword t)) 5882382Spaul (gnats::forward-bofield) 5892382Spaul (gnats::forward-eofield))) 5902382Spaul 5912382Spaul(defun gnats:backward-field () 5922382Spaul "Move point backward to the beginning/end of a field." 5932382Spaul ;; 5942382Spaul (interactive) 5952382Spaul (backward-char) 5962382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 5972382Spaul (gnats::after-keyword t)) 5982382Spaul (gnats::backward-eofield) 5992382Spaul (gnats::backward-bofield))) 6002382Spaul 6012382Spaul(defun gnats:next-field () 6022382Spaul "Move point to the beginning of the next field." 6032382Spaul ;; 6042382Spaul (interactive) 6052382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 6062382Spaul (gnats::after-keyword t)) 6072382Spaul (gnats::forward-bofield) 6082382Spaul (if (re-search-forward gnats::keyword (point-max) '-) 6092382Spaul (gnats::forward-bofield) 6102382Spaul t))) 6112382Spaul 6122382Spaul(defun gnats:previous-field () 6132382Spaul "Move point to the beginning of the previous field." 6142382Spaul ;; 6152382Spaul (interactive) 6162382Spaul (backward-char) 6172382Spaul (if (or (gnats::after-keyword t) (gnats::in-keyword t) 6182382Spaul (gnats::before-keyword t)) 6192382Spaul (progn (re-search-backward gnats::keyword (point-min) '-) 6202382Spaul (gnats::forward-bofield)) 6212382Spaul (gnats::backward-bofield))) 6222382Spaul 6232382Spaul(defun gnats:beginning-of-field () 6242382Spaul "Move point to the beginning of the current field." 6252382Spaul (interactive) 6262382Spaul (cond ((gnats::in-keyword t) 6272382Spaul (gnats::forward-bofield)) 6282382Spaul ((gnats::after-keyword 0)) 6292382Spaul (t 6302382Spaul (gnats::backward-bofield)))) 6312382Spaul 6322382Spaul(defun gnats::current-field () 6332382Spaul (save-excursion 6342382Spaul (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t)) 6352382Spaul (looking-at gnats::keyword)) 6362382Spaul ((re-search-backward gnats::keyword nil t))) 6372382Spaul (buffer-substring (match-beginning 1) (match-end 1)) 6382382Spaul nil))) 6392382Spaul 6402382Spaul;;;;--------------------------------------------------------------------------- 6412382Spaul;;;; Support functions 6422382Spaul;;;;--------------------------------------------------------------------------- 6432382Spaul 6442382Spaul(defun gnats::looking-after (regex) 6452382Spaul "Returns t if point is after regex." 6462382Spaul ;; 6472382Spaul (let* ((old-point (point)) 6482382Spaul (start (if (eobp) 6492382Spaul old-point 6502382Spaul (forward-char) (point)))) 6512382Spaul (cond ((re-search-backward regex (point-min) t) 6522382Spaul (goto-char old-point) 6532382Spaul (cond ((eq (match-end 0) start) 6542382Spaul t)))))) 6552382Spaul 6562382Spaul(defun gnats::nth-word (string &optional elem) 6572382Spaul "Returns the elem-th word of the string. 6582382SpaulIf elem is nil, then the first wort is returned, if elem is 0 then 6592382Spaulthe whole string is returned." 6602382Spaul ;; 6612382Spaul (if (integerp elem) 6622382Spaul (cond ((eq elem 0) string) 6632382Spaul ((eq elem 1) (gnats::first-word string)) 6642382Spaul ((equal string "") "") 6652382Spaul ((>= elem 2) 6662382Spaul (let ((i 0) (value "")) 6672382Spaul (setq string ; strip leading blanks 6682382Spaul (substring string (or (string-match "[^ \t]" string) 0))) 6692382Spaul (while (< i elem) 6702382Spaul (setq value 6712382Spaul (substring string 0 6722382Spaul (string-match "[ \t]*$\\|[ \t]+" string))) 6732382Spaul (setq string 6742382Spaul (substring string (match-end 0))) 6752382Spaul (setq i (+ i 1))) 6762382Spaul value))) 6772382Spaul (gnats::first-word string))) 6782382Spaul 6792382Spaul(defun gnats::first-word (string) 6802382Spaul (setq string 6812382Spaul (substring string (or (string-match "[^ \t]" string) 0))) 6822382Spaul (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string))) 6832382Spaul 6842382Spaul;;;;--------------------------------------------------------------------------- 6852382Spaul 6862382Spaul(defun gnats::patch-exec-path () 6872382Spaul ;; 6882382Spaul "Replaces `//' by `/' in `exec-path'." 6892382Spaul ;; 6902382Spaul ;(make-local-variable 'exec-path) 6912382Spaul (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*")) 6922382Spaul (ret)) 6932382Spaul (setq exec-path (save-excursion (set-buffer err-buffer) 6942382Spaul (prin1 exec-path err-buffer) 6952382Spaul (goto-char (point-min)) 6962382Spaul (replace-string "//" "/") 6972382Spaul (goto-char (point-min)) 6982382Spaul (setq ret (read err-buffer)) 6992382Spaul (kill-buffer err-buffer) 7002382Spaul ret 7012382Spaul )))) 7022382Spaul 7032382Spaul(defun gnats::get-value-from-shell (&rest command) 7042382Spaul "Execute shell command to get a list of valid values for `variable'." 7052382Spaul ;; 7062382Spaul (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*"))) 7072382Spaul (save-excursion 7082382Spaul (set-buffer err-buffer) 7092382Spaul (unwind-protect 7102382Spaul (condition-case var 7112382Spaul (progn 7122382Spaul (apply 'call-process 7132382Spaul (car command) nil err-buffer nil (cdr command)) 7142382Spaul (goto-char (point-min)) 7152382Spaul (if (looking-at "[-a-z]+: ") 7162382Spaul (error (buffer-substring (point-min) (point-max)))) 7172382Spaul (read err-buffer)) 7182382Spaul (error nil)) 7192382Spaul (kill-buffer err-buffer))))) 7202382Spaul 7212382Spaul(or (fboundp 'setenv) 7222382Spaul (defun setenv (variable &optional value) 7232382Spaul "Set the value of the environment variable named VARIABLE to VALUE. 7242382SpaulVARIABLE should be a string. VALUE is optional; if not provided or is 7252382Spaul`nil', the environment variable VARIABLE will be removed. 7262382SpaulThis function works by modifying `process-environment'." 7272382Spaul (interactive "sSet environment variable: \nsSet %s to value: ") 7282382Spaul (if (string-match "=" variable) 7292382Spaul (error "Environment variable name `%s' contains `='" variable) 7302382Spaul (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) 7312382Spaul (case-fold-search nil) 7322382Spaul (scan process-environment)) 7332382Spaul (while scan 7342382Spaul (cond 7352382Spaul ((string-match pattern (car scan)) 7362382Spaul (if (eq nil value) 7372382Spaul (setq process-environment (delq (car scan) 7382382Spaul process-environment)) 7392382Spaul (setcar scan (concat variable "=" value))) 7402382Spaul (setq scan nil)) 7412382Spaul ((null (setq scan (cdr scan))) 7422382Spaul (setq process-environment 7432382Spaul (cons (concat variable "=" value) 7442382Spaul process-environment))))))))) 7452382Spaul 7462382Spaul;;;; end of send-pr.el 747