12382Spaul;;;; -*-emacs-lisp-*- 22382Spaul;;;;--------------------------------------------------------------------------- 367908Ssteve;;;; EMACS interface for send-pr (by Heinz G. Seidl) 42382Spaul;;;; Slightly hacked by Brendan Kehoe (brendan@cygnus.com). 52382Spaul;;;; 62382Spaul;;;; This file is part of the Problem Report Management System (GNATS) 767908Ssteve;;;; Copyright 1992, 1993, 1997 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$ 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 6767908Ssteve(defconst send-pr::version "3.113") 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 8967908Ssteve;;; This has to be here rather than at the bottom of this file with 9067908Ssteve;;; the other utility functions because it is used by 9167908Ssteve;;; gnats::get-config, which is called when send-pr.el is being 9267908Ssteve;;; loaded (see the "defconst" below), before the whole file has been 9367908Ssteve;;; loaded. 9467908Ssteve 9567908Ssteve(defun gnats::find-safe-default-directory (&optional buffer) 9667908Ssteve"If the directory referred to by `default-directory' for the current 9767908Sstevebuffer (or for optional argument BUFFER) does not exist, set it to the home 9867908Sstevedirectory of the current user if that exists, or to `/'. 9967908Ssteve 10067908SsteveReturns the final value of default-directory in the buffer." 10167908Ssteve (let ((homedir (expand-file-name "~/"))) 10267908Ssteve (save-excursion 10367908Ssteve (if buffer (set-buffer buffer)) 10467908Ssteve (if (not (file-exists-p default-directory)) 10567908Ssteve (if (file-exists-p homedir) 10667908Ssteve (setq default-directory homedir) 10767908Ssteve (setq default-directory "/"))) 10867908Ssteve default-directory))) 10967908Ssteve 1102382Spaul;;; These may be changed during configuration/installation or by the individual 1112382Spaul;;; user in his/her .emacs file. 1122382Spaul;;; 1132382Spaul(defun gnats::get-config (var) 1142382Spaul (let ((shell-file-name "/bin/sh") 1152382Spaul (buf (generate-new-buffer " *GNATS config*")) 1162382Spaul ret) 1172382Spaul (save-excursion 1182382Spaul (set-buffer buf) 11967908Ssteve (shell-command-on-region 12067908Ssteve (point-min) (point-max) 12167908Ssteve (concat ". " gnats:root "/gnats-adm/config; echo $" var ) t) 12267908Ssteve (goto-char (point-min)) 12367908Ssteve ; We have to use get-buffer, since shell-command-on-region will wipe 12467908Ssteve ; out the buffer if there's no output from the command. 12567908Ssteve (if (or (not (get-buffer "*Shell Command Output*")) 12667908Ssteve (looking-at "^\\.:\\|/bin/sh:\\|\n")) 1272382Spaul (setq ret nil) 1282382Spaul (setq ret (buffer-substring (point-min) (- (point-max) 1))))) 12967908Ssteve (if (and ret (string-equal ret "")) (setq ret nil)) 1302382Spaul (kill-buffer buf) 1312382Spaul ret)) 1322382Spaul 1332382Spaul;; const because it must match the script's value 1342382Spaul(defconst send-pr:datadir (or (gnats::get-config "DATADIR") "@DATADIR@") 1352382Spaul "*Where the `gnats' subdirectory containing category lists lives.") 1362382Spaul 1372382Spaul(defvar send-pr::sites nil 1382382Spaul "List of GNATS support sites; computed at runtime.") 1392382Spaul(defvar send-pr:default-site 1402382Spaul (or (gnats::get-config "GNATS_SITE") "freefall") 1412382Spaul "Default site to send bugs to.") 1422382Spaul(defvar send-pr:::site send-pr:default-site 1432382Spaul "The site to which a problem report is currently being submitted, or NIL 1442382Spaulif using the default site (buffer local).") 1452382Spaul 1462382Spaul(defvar send-pr:::categories nil 1472382Spaul "Buffer local list of available categories, derived at runtime from 1482382Spaulsend-pr:::site and send-pr::category-alist.") 1492382Spaul(defvar send-pr::category-alist nil 1502382Spaul "Alist of GNATS support sites and the categories supported at each; computed 1512382Spaulat runtime.") 1522382Spaul 1532382Spaul;;; Ideally we would get all the following values from a central database 1542382Spaul;;; during runtime instead of having them here in the code. 1552382Spaul;;; 1562382Spaul(defconst send-pr::fields 1572382Spaul (` (("Category" send-pr::set-categories 1582382Spaul (, (or (gnats::get-config "DEFAULT_CATEGORY") nil)) enum) 15967909Ssteve ("Class" (("sw-bug") ("doc-bug") ("change-request") ("update") ("maintainer-update")) 16067908Ssteve (, (or (gnats::get-config "DEFAULT_CLASS") 0)) enum) 1612382Spaul ("Confidential" (("yes") ("no")) 1622382Spaul (, (or (gnats::get-config "DEFAULT_CONFIDENTIAL") 1)) enum) 1632382Spaul ("Severity" (("non-critical") ("serious") ("critical")) 1642382Spaul (, (or (gnats::get-config "DEFAULT_SEVERITY") 1)) enum) 1652382Spaul ("Priority" (("low") ("medium") ("high")) 1662382Spaul (, (or (gnats::get-config "DEFAULT_PRIORITY") 1)) enum) 1672382Spaul ("Release" nil 1682382Spaul (, (or (gnats::get-config "DEFAULT_RELEASE") "@DEFAULT_RELEASE@")) 1692382Spaul text) 1702382Spaul ("Submitter-Id" nil 17167908Ssteve (, (or (gnats::get-config "DEFAULT_SUBMITTER") "unknown")) text) 1722382Spaul ("Synopsis" nil nil text 1732382Spaul (lambda (a b c) (gnats::set-mail-field "Subject" c))))) 1742382Spaul "AList, keyed on the name of the field, of: 1752382Spaul1) The field name. 1762382Spaul2) The list of completions. This can be a list, a function to call, or nil. 1772382Spaul3) The default value. 1782382Spaul4) The type of the field. 1792382Spaul5) A sub-function to call when changed.") 1802382Spaul 1812382Spaul(defvar gnats::fields nil) 1822382Spaul 1832382Spaul(defmacro gnats::push (i l) 1842382Spaul (` (setq (, l) (cons (,@ (list i l)))))) 1852382Spaul 1862382Spaul(defun send-pr::set-categories (&optional arg) 1872382Spaul "Get the list of categories for the current site out of 1882382Spaulsend-pr::category-alist if there or from send-pr if not. With arg, force 1892382Spaulupdate." 1902382Spaul ;; 1912382Spaul (let ((entry (assoc send-pr:::site send-pr::category-alist))) 1922382Spaul (or (and entry (null arg)) 1932382Spaul (let ((oldpr (getenv "GNATS_ROOT")) cats) 1942382Spaul (send-pr::set-sites arg) 1952382Spaul (setenv "GNATS_ROOT" gnats:root) 1962382Spaul (setq cats (gnats::get-value-from-shell 1972382Spaul "send-pr" "-CL" send-pr:::site)) 1982382Spaul (setenv "GNATS_ROOT" oldpr) 1992382Spaul (if entry (setcdr entry cats) 2002382Spaul (setq entry (cons send-pr:::site cats)) 2012382Spaul (gnats::push entry send-pr::category-alist)))) 2022382Spaul (setq send-pr:::categories (cdr entry)))) 2032382Spaul 2042382Spaul(defun send-pr::set-sites (&optional arg) 2052382Spaul "Get the list of sites (by listing the contents of DATADIR/gnats) and assign 2062382Spaulit to send-pr::sites. With arg, force update." 2072382Spaul (or (and (null arg) send-pr::sites) 2082382Spaul (progn 2092382Spaul (setq send-pr::sites nil) 2102382Spaul (mapcar 2112382Spaul (function 2122382Spaul (lambda (file) 2132382Spaul (or (memq t (mapcar (function (lambda (x) (string= x file))) 2142382Spaul '("." ".." "pr-edit" "pr-addr"))) 2152382Spaul (not (file-readable-p file)) 2162382Spaul (gnats::push (list (file-name-nondirectory file)) 2172382Spaul send-pr::sites)))) 2182382Spaul (directory-files (format "%s/gnats" send-pr:datadir) t)) 2192382Spaul (setq send-pr::sites (reverse send-pr::sites))))) 2202382Spaul 2212382Spaul(defconst send-pr::pr-buffer-name "*send-pr*" 2222382Spaul "Name of the temporary buffer, where the problem report gets composed.") 2232382Spaul 2242382Spaul(defconst send-pr::err-buffer-name "*send-pr-error*" 2252382Spaul "Name of the temporary buffer, where send-pr error messages appear.") 2262382Spaul 2272382Spaul(defvar send-pr:::err-buffer nil 2282382Spaul "The error buffer used by the current PR buffer.") 2292382Spaul 23067908Ssteve(defvar send-pr:::spawn-to-send nil 23167908Ssteve "Whether or not send-pr-mode should spawn a send-pr process to send the PR.") 23267908Ssteve 2332382Spaul(defconst gnats::indent 17 "Indent for formatting the value.") 2342382Spaul 2352382Spaul;;;;--------------------------------------------------------------------------- 2362382Spaul;;;; `send-pr' - command for creating and sending of problem reports 2372382Spaul;;;;--------------------------------------------------------------------------- 2382382Spaul 2392382Spaul(fset 'send-pr 'send-pr:send-pr) 2402382Spaul(defun send-pr:send-pr (&optional site) 2412382Spaul "Create a buffer and read in the result of `send-pr -P'. 2422382SpaulWhen finished with editing the problem report use \\[send-pr:submit-pr] 2432382Spaulto send the PR with `send-pr -b -f -'." 2442382Spaul ;; 2452382Spaul (interactive 2462382Spaul (if current-prefix-arg 2472382Spaul (list (completing-read "Site: " (send-pr::set-sites 'recheck) nil t 2482382Spaul send-pr:default-site)))) 2492382Spaul (or site (setq site send-pr:default-site)) 2502382Spaul (let ((buf (get-buffer send-pr::pr-buffer-name))) 2512382Spaul (if (or (not buf) 2522382Spaul (progn (switch-to-buffer buf) 2532382Spaul (cond ((or (not (buffer-modified-p buf)) 2542382Spaul (y-or-n-p "Erase previous problem report? ")) 2552382Spaul (erase-buffer) t) 2562382Spaul (t nil)))) 2572382Spaul (send-pr::start-up site)))) 2582382Spaul 2592382Spaul(defun send-pr::start-up (site) 2602382Spaul (switch-to-buffer (get-buffer-create send-pr::pr-buffer-name)) 2612382Spaul (setq default-directory (expand-file-name "~/")) 2622382Spaul (auto-save-mode auto-save-default) 2632382Spaul (let ((oldpr (getenv "GNATS_ROOT")) 2642382Spaul (case-fold-search nil)) 2652382Spaul (setenv "GNATS_ROOT" gnats:root) 26667908Ssteve (send-pr::insert-template site) 2672382Spaul (setenv "GNATS_ROOT" oldpr) 26867908Ssteve (goto-char (point-min)) 2692382Spaul (if (looking-at "send-pr:") 2702382Spaul (cond ((looking-at "send-pr: .* does not have a categories list") 2712382Spaul (setq send-pr::sites nil) 2722382Spaul (error "send-pr: the GNATS site %s does not have a categories list" site)) 2732382Spaul (t (error (buffer-substring (point-min) (point-max))))) 2742382Spaul (save-excursion 2752382Spaul ;; Clear cruft inserted by bdamaged .cshrcs 27667908Ssteve (goto-char 1) 2772382Spaul (re-search-forward "^SEND-PR:") 2782382Spaul (delete-region 1 (match-beginning 0))))) 2792382Spaul (set-buffer-modified-p nil) 2802382Spaul (send-pr:send-pr-mode) 2812382Spaul (setq send-pr:::site site) 28267908Ssteve (setq send-pr:::spawn-to-send t) 2832382Spaul (send-pr::set-categories) 2842382Spaul (if (null send-pr:::categories) 2852382Spaul (progn 2862382Spaul (and send-pr:::err-buffer (kill-buffer send-pr:::err-buffer)) 2872382Spaul (kill-buffer nil) 2882382Spaul (message "send-pr: no categories found")) 28967908Ssteve (or (stringp mail-default-reply-to) 29067908Ssteve (setq mail-default-reply-to (getenv "REPLYTO"))) 2912382Spaul (and mail-default-reply-to 2922382Spaul (gnats::set-mail-field "Reply-To" mail-default-reply-to)) 2932382Spaul (and mail-self-blind 2942382Spaul (gnats::set-mail-field "BCC" (user-login-name))) 2952382Spaul (mapcar 'send-pr::maybe-change-field send-pr::fields) 2962382Spaul (gnats::position-on-field "Description") 2972382Spaul (message (substitute-command-keys 2982382Spaul "To send the problem report use: \\[send-pr:submit-pr]")))) 2992382Spaul 30067908Ssteve(defvar send-pr::template-alist nil 30167908Ssteve "An alist containing the output of send-pr -P <sitename> for various sites.") 30267908Ssteve 30367908Ssteve(defun send-pr::insert-template (site) 30467908Ssteve (let ((elt (assoc site send-pr::template-alist))) 30567908Ssteve (if elt 30667908Ssteve (save-excursion (insert (cdr elt))) 30767908Ssteve (call-process "send-pr" nil t nil "-P" site) 30867908Ssteve (save-excursion 30967908Ssteve (setq send-pr::template-alist 31067908Ssteve (cons (cons site (buffer-substring (point-min) (point-max))) 31167908Ssteve send-pr::template-alist)))))) 31267908Ssteve 3132382Spaul(fset 'do-send-pr 'send-pr:submit-pr) ;backward compat 3142382Spaul(defun send-pr:submit-pr () 3152382Spaul "Pipe the contents of the buffer *send-pr* to `send-pr -f -.' unless this 3162382Spaulbuffer was loaded with emacsclient, in which case save the buffer and exit." 3172382Spaul ;; 3182382Spaul (interactive) 3192382Spaul (cond 3202382Spaul ((and (boundp 'server-buffer-clients) 3212382Spaul server-buffer-clients) 3222382Spaul (let ((buffer (current-buffer)) 3232382Spaul (version-control nil) (buffer-backed-up nil)) 3242382Spaul (save-buffer buffer) 3252382Spaul (kill-buffer buffer) 3262382Spaul (server-buffer-done buffer))) 32767908Ssteve (send-pr:::spawn-to-send 32867908Ssteve (if (or (buffer-modified-p) 32967908Ssteve (not send-pr:::sent) 33067908Ssteve (y-or-n-p "PR already sent; resend? ")) 33167908Ssteve (progn 33267908Ssteve (or (and send-pr:::err-buffer 33367908Ssteve (buffer-name send-pr:::err-buffer)) 33467908Ssteve (setq send-pr:::err-buffer 33567908Ssteve (get-buffer-create send-pr::err-buffer-name))) 33667908Ssteve (let ((err-buffer send-pr:::err-buffer) mesg ok) 33767908Ssteve (save-excursion (set-buffer err-buffer) (erase-buffer)) 33867908Ssteve (message "running send-pr...") 33967908Ssteve (let ((oldpr (getenv "GNATS_ROOT"))) 34067908Ssteve (setenv "GNATS_ROOT" gnats:root) 34167908Ssteve ;; ensure that a final newline is present: 34267908Ssteve (if (not (equal (char-after (1- (point-max))) ?\n)) 34367908Ssteve (save-excursion (goto-char (point-max)) 34467908Ssteve (insert ?\n))) 34567908Ssteve (call-process-region (point-min) (point-max) "send-pr" 34667908Ssteve nil err-buffer nil send-pr:::site 34767908Ssteve "-b" "-f" "-") 34867908Ssteve (setenv "GNATS_ROOT" oldpr)) 34967908Ssteve (message "running send-pr...done") 35067908Ssteve ;; stupidly we cannot check the return value in EMACS 18.57, 35167908Ssteve ;; thus we need this kluge to find out whether send-pr succeeded. 35267908Ssteve (if (save-excursion 35367908Ssteve (set-buffer err-buffer) 35467908Ssteve (goto-char (point-min)) 35567908Ssteve (setq mesg (buffer-substring (point-min) (- (point-max) 1))) 35667908Ssteve (search-forward "problem report sent" nil t)) 35767908Ssteve (progn (message mesg) 35867908Ssteve (kill-buffer err-buffer) 35967908Ssteve (delete-auto-save-file-if-necessary) 36067908Ssteve (set-buffer-modified-p nil) 36167908Ssteve (setq send-pr:::sent t) 36267908Ssteve (bury-buffer)) 36367908Ssteve (pop-to-buffer err-buffer)) 36467908Ssteve )))) 3652382Spaul (t 36667908Ssteve (save-buffer) 36767908Ssteve (message "Exit emacs to send the PR.")))) 3682382Spaul 3692382Spaul;;;;--------------------------------------------------------------------------- 3702382Spaul;;;; send-pr:send-pr-mode mode 3712382Spaul;;;;--------------------------------------------------------------------------- 3722382Spaul 3732382Spaul(defvar send-pr-mode-map 3742382Spaul (let ((map (make-sparse-keymap))) 3752382Spaul (define-key map "\C-c\C-c" 'send-pr:submit-pr) 3762382Spaul (define-key map "\C-c\C-f" 'gnats:change-field) 3772382Spaul (define-key map "\M-n" 'gnats:next-field) 3782382Spaul (define-key map "\M-p" 'gnats:previous-field) 3792382Spaul (define-key map "\C-\M-f" 'gnats:forward-field) 3802382Spaul (define-key map "\C-\M-b" 'gnats:backward-field) 3812382Spaul map) 3822382Spaul "Keymap for send-pr mode.") 3832382Spaul 3842382Spaul(defconst gnats::keyword "^>\\([-a-zA-Z]+\\):") 3852382Spaul(defconst gnats::before-keyword "[ \t\n\f]*[\n\f]+>\\([-a-zA-Z]+\\):") 3862382Spaul(defconst gnats::after-keyword "^>\\([-a-zA-Z]+\\):[ \t\n\f]+") 3872382Spaul 3882382Spaul(fset 'send-pr-mode 'send-pr:send-pr-mode) 3892382Spaul(defun send-pr:send-pr-mode () 3902382Spaul "Major mode for submitting problem reports. 3912382SpaulFor information about the form see gnats(1) and send-pr(1). 3922382SpaulSpecial commands: \\{send-pr-mode-map} 3932382SpaulTurning on send-pr-mode calls the value of the variable send-pr-mode-hook, 3942382Spaulif it is not nil." 3952382Spaul (interactive) 3962382Spaul (gnats::patch-exec-path) 3972382Spaul (put 'send-pr:send-pr-mode 'mode-class 'special) 3982382Spaul (kill-all-local-variables) 3992382Spaul (setq major-mode 'send-pr:send-pr-mode) 4002382Spaul (setq mode-name "send-pr") 4012382Spaul (use-local-map send-pr-mode-map) 4022382Spaul (set-syntax-table text-mode-syntax-table) 4032382Spaul (setq local-abbrev-table text-mode-abbrev-table) 4042382Spaul (setq buffer-offer-save t) 4052382Spaul (make-local-variable 'send-pr:::site) 4062382Spaul (make-local-variable 'send-pr:::categories) 4072382Spaul (make-local-variable 'send-pr:::err-buffer) 40867908Ssteve (make-local-variable 'send-pr:::spawn-to-send) 40967908Ssteve (make-local-variable 'send-pr:::sent) 41067908Ssteve (setq send-pr:::sent nil) 4112382Spaul (make-local-variable 'paragraph-separate) 4122382Spaul (setq paragraph-separate (concat (default-value 'paragraph-separate) 4132382Spaul "\\|" gnats::keyword "[ \t\n\f]*$")) 4142382Spaul (make-local-variable 'paragraph-start) 4152382Spaul (setq paragraph-start (concat (default-value 'paragraph-start) 4162382Spaul "\\|" gnats::keyword)) 4172382Spaul (run-hooks 'send-pr-mode-hook) 4182382Spaul t) 4192382Spaul 4202382Spaul;;;;--------------------------------------------------------------------------- 4212382Spaul;;;; Functions to read and replace field values. 4222382Spaul;;;;--------------------------------------------------------------------------- 4232382Spaul 42467908Ssteve(defun gnats::position-on-field (field &optional quiet) 4252382Spaul (goto-char (point-min)) 4262382Spaul (if (not (re-search-forward (concat "^>" field ":") nil t)) 42767908Ssteve (if quiet 42867908Ssteve nil 42967908Ssteve (error "Field `>%s:' not found." field)) 4302382Spaul (re-search-forward "[ \t\n\f]*") 4312382Spaul (if (looking-at gnats::keyword) 4322382Spaul (backward-char 1)) 4332382Spaul t)) 4342382Spaul 4352382Spaul(defun gnats::mail-position-on-field (field) 4362382Spaul (let (end 4372382Spaul (case-fold-search t)) 4382382Spaul (goto-char (point-min)) 4392382Spaul (re-search-forward "^$") 4402382Spaul (setq end (match-beginning 0)) 4412382Spaul (goto-char (point-min)) 4422382Spaul (if (not (re-search-forward (concat "^" field ":") end 'go-to-end)) 4432382Spaul (insert field ": \n") 4442382Spaul (re-search-forward "[ \t\n\f]*")) 4452382Spaul (skip-chars-backward "\n") 4462382Spaul t)) 4472382Spaul 4482382Spaul(defun gnats::field-contents (field &optional elem move) 4492382Spaul (let (pos) 4502382Spaul (unwind-protect 4512382Spaul (save-excursion 45267908Ssteve (if (not (gnats::position-on-field field t)) 4532382Spaul nil 4542382Spaul (setq pos (point-marker)) 4552382Spaul (if (or (looking-at "<.*>$") (eolp)) 4562382Spaul t 4572382Spaul (looking-at ".*$") ; to set match-{beginning,end} 4582382Spaul (gnats::nth-word 4592382Spaul (buffer-substring (match-beginning 0) (match-end 0)) 4602382Spaul elem)))) 4612382Spaul (and move pos (goto-char pos))))) 4622382Spaul 4632382Spaul(defun gnats::functionp (thing) 4642382Spaul (or (and (symbolp thing) (fboundp thing)) 4652382Spaul (and (listp thing) (eq (car thing) 'lambda)))) 4662382Spaul 4672382Spaul(defun gnats::field-values (field) 4682382Spaul "Return the possible (known) values for field FIELD." 4692382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4702382Spaul send-pr::fields)) 4712382Spaul (thing (elt (assoc field fields) 1))) 4722382Spaul (cond ((gnats::functionp thing) (funcall thing)) 4732382Spaul ((listp thing) thing) 4742382Spaul (t (error "ACK"))))) 4752382Spaul 4762382Spaul(defun gnats::field-default (field) 4772382Spaul "Return the default value for field FIELD." 4782382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4792382Spaul send-pr::fields)) 4802382Spaul (thing (elt (assoc field fields) 2))) 4812382Spaul (cond ((stringp thing) thing) 4822382Spaul ((null thing) "") 4832382Spaul ((numberp thing) (car (elt (gnats::field-values field) thing))) 4842382Spaul ((gnats::functionp thing) 4852382Spaul (funcall thing (gnats::field-contents field))) 4862382Spaul ((eq thing t) (gnats::field-contents field)) 4872382Spaul (t (error "ACK"))))) 4882382Spaul 4892382Spaul(defun gnats::field-type (field) 4902382Spaul "Return the type of field FIELD." 4912382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4922382Spaul send-pr::fields)) 4932382Spaul (thing (elt (assoc field fields) 3))) 4942382Spaul thing)) 4952382Spaul 4962382Spaul(defun gnats::field-action (field) 4972382Spaul "Return the extra handling function for field FIELD." 4982382Spaul (let* ((fields (if (eq major-mode 'gnats:gnats-mode) gnats::fields 4992382Spaul send-pr::fields)) 5002382Spaul (thing (elt (assoc field fields) 4))) 5012382Spaul (cond ((null thing) 'ignore) 5022382Spaul ((gnats::functionp thing) thing) 5032382Spaul (t (error "ACK"))))) 5042382Spaul 5052382Spaul;;;;--------------------------------------------------------------------------- 5062382Spaul;;;; Point movement functions 5072382Spaul;;;;--------------------------------------------------------------------------- 5082382Spaul 5092382Spaul(or (fboundp 'defsubst) (fset 'defsubst 'defun)) 5102382Spaul 5112382Spaul(defun send-pr::maybe-change-field (field) 5122382Spaul (setq field (car field)) 5132382Spaul (let ((thing (gnats::field-contents field))) 5142382Spaul (and thing (eq t thing) 5152382Spaul (not (eq 'multi-text (gnats::field-type field))) 5162382Spaul (gnats:change-field field)))) 5172382Spaul 5182382Spaul(defun gnats:change-field (&optional field default) 5192382Spaul "Change the value of the field containing the cursor. With arg, ask the 5202382Spauluser for the field to change. From a program, the function takes optional 5212382Spaularguments of the field to change and the default value to use." 5222382Spaul (interactive) 5232382Spaul (or field current-prefix-arg (setq field (gnats::current-field))) 5242382Spaul (or field 5252382Spaul (setq field 5262382Spaul (completing-read "Field: " 5272382Spaul (if (eq major-mode 'gnats:gnats-mode) 5282382Spaul gnats::fields 5292382Spaul send-pr::fields) 5302382Spaul nil t))) 5312382Spaul (gnats::position-on-field field) 5322382Spaul (sit-for 0) 5332382Spaul (let* ((old (gnats::field-contents field)) 5342382Spaul new) 5352382Spaul (if (null old) 5362382Spaul (error "ACK") 53767908Ssteve (if (or (interactive-p) t) 53867908Ssteve (let ((prompt (concat ">" field ": ")) 53967908Ssteve (domain (gnats::field-values field)) 54067908Ssteve (type (gnats::field-type field))) 54167908Ssteve (or default (setq default (gnats::field-default field))) 54267908Ssteve (setq new 54367908Ssteve (if (eq type 'enum) 5442382Spaul (completing-read prompt domain nil t 5452382Spaul (if gnats::emacs-19p (cons default 0) 5462382Spaul default)) 5472382Spaul (read-string prompt (if gnats::emacs-19p (cons default 1) 54867908Ssteve default))))) 54967908Ssteve (setq new default)) 55067908Ssteve (gnats::set-field field new) 55167908Ssteve (funcall (gnats::field-action field) field old new) 55267908Ssteve new))) 5532382Spaul 5542382Spaul(defun gnats::set-field (field value) 5552382Spaul (save-excursion 5562382Spaul (gnats::position-on-field field) 5572382Spaul (delete-horizontal-space) 5582382Spaul (looking-at ".*$") 5592382Spaul (replace-match 5602382Spaul (concat (make-string (- gnats::indent (length field) 2) ?\40 ) value) t))) 5612382Spaul 5622382Spaul(defun gnats::set-mail-field (field value) 5632382Spaul (save-excursion 5642382Spaul (gnats::mail-position-on-field field) 5652382Spaul (delete-horizontal-space) 5662382Spaul (looking-at ".*$") 5672382Spaul (replace-match (concat " " value) t))) 5682382Spaul 5692382Spaul(defun gnats::before-keyword (&optional where) 5702382Spaul "Returns t if point is in some white space before a keyword. 5712382SpaulIf where is nil, then point is not changed; if where is t then point is moved 5722382Spaulto the beginning of the keyword, otherwise it is moved to the beginning 5732382Spaulof the white space it was in." 5742382Spaul ;; 5752382Spaul (if (looking-at gnats::before-keyword) 5762382Spaul (prog1 t 5772382Spaul (cond ((eq where t) 5782382Spaul (re-search-forward "^>") (backward-char)) 5792382Spaul ((not (eq where nil)) 5802382Spaul (re-search-backward "[^ \t\n\f]") (forward-char)))) 5812382Spaul nil)) 5822382Spaul 5832382Spaul(defun gnats::after-keyword (&optional where) 5842382Spaul "Returns t if point is in some white space after a keyword. 5852382SpaulIf where is nil, then point is not changed; if where is t then point is moved 5862382Spaulto the beginning of the keyword, otherwise it is moved to the end of the white 5872382Spaulspace it was in." 5882382Spaul ;; 5892382Spaul (if (gnats::looking-after gnats::after-keyword) 5902382Spaul (prog1 t 5912382Spaul (cond ((eq where t) 5922382Spaul (re-search-backward "^>")) 5932382Spaul ((not (eq where nil)) 5942382Spaul (re-search-forward "[^ \t\n\f]") (backward-char)))) 5952382Spaul nil)) 5962382Spaul 5972382Spaul(defun gnats::in-keyword (&optional where) 5982382Spaul "Returns t if point is within a keyword. 5992382SpaulIf where is nil, then point is not changed; if where is t then point is moved 6002382Spaulto the beginning of the keyword." 6012382Spaul ;; 6022382Spaul (let ((old-point (point-marker))) 6032382Spaul (beginning-of-line) 6042382Spaul (cond ((and (looking-at gnats::keyword) 6052382Spaul (< old-point (match-end 0))) 6062382Spaul (prog1 t 6072382Spaul (if (eq where t) 6082382Spaul t 6092382Spaul (goto-char old-point)))) 6102382Spaul (t (goto-char old-point) 6112382Spaul nil)))) 6122382Spaul 6132382Spaul(defun gnats::forward-bofield () 6142382Spaul "Moves point to the beginning of a field. Assumes that point is in the 6152382Spaulkeyword." 6162382Spaul ;; 6172382Spaul (if (re-search-forward "[ \t\n\f]+[^ \t\n\f]" (point-max) '-) 6182382Spaul (backward-char) 6192382Spaul t)) 6202382Spaul 6212382Spaul(defun gnats::backward-eofield () 6222382Spaul "Moves point to the end of a field. Assumes point is in the keyword." 6232382Spaul ;; 6242382Spaul (if (re-search-backward "[^ \t\n\f][ \t\n\f]+" (point-min) '-) 6252382Spaul (forward-char) 6262382Spaul t)) 6272382Spaul 6282382Spaul(defun gnats::forward-eofield () 6292382Spaul "Moves point to the end of a field. Assumes that point is in the field." 6302382Spaul ;; 6312382Spaul ;; look for the next field 6322382Spaul (if (re-search-forward gnats::keyword (point-max) '-) 6332382Spaul (progn (beginning-of-line) (gnats::backward-eofield)) 6342382Spaul (re-search-backward "[^ \t\n\f][ \t\n\f]*" (point-min) '-) 6352382Spaul (forward-char))) 6362382Spaul 6372382Spaul(defun gnats::backward-bofield () 6382382Spaul "Moves point to the beginning of a field. Assumes that point is in the 6392382Spaulfield." 6402382Spaul ;; 6412382Spaul ;;look for previous field 6422382Spaul (if (re-search-backward gnats::keyword (point-min) '-) 6432382Spaul (gnats::forward-bofield) 6442382Spaul t)) 6452382Spaul 6462382Spaul 6472382Spaul(defun gnats:forward-field () 6482382Spaul "Move point forward to the end of the field or to the beginning of the next 6492382Spaulfield." 6502382Spaul ;; 6512382Spaul (interactive) 6522382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 6532382Spaul (gnats::after-keyword t)) 6542382Spaul (gnats::forward-bofield) 6552382Spaul (gnats::forward-eofield))) 6562382Spaul 6572382Spaul(defun gnats:backward-field () 6582382Spaul "Move point backward to the beginning/end of a field." 6592382Spaul ;; 6602382Spaul (interactive) 6612382Spaul (backward-char) 6622382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 6632382Spaul (gnats::after-keyword t)) 6642382Spaul (gnats::backward-eofield) 6652382Spaul (gnats::backward-bofield))) 6662382Spaul 6672382Spaul(defun gnats:next-field () 6682382Spaul "Move point to the beginning of the next field." 6692382Spaul ;; 6702382Spaul (interactive) 6712382Spaul (if (or (gnats::before-keyword t) (gnats::in-keyword t) 6722382Spaul (gnats::after-keyword t)) 6732382Spaul (gnats::forward-bofield) 6742382Spaul (if (re-search-forward gnats::keyword (point-max) '-) 6752382Spaul (gnats::forward-bofield) 6762382Spaul t))) 6772382Spaul 6782382Spaul(defun gnats:previous-field () 6792382Spaul "Move point to the beginning of the previous field." 6802382Spaul ;; 6812382Spaul (interactive) 6822382Spaul (backward-char) 6832382Spaul (if (or (gnats::after-keyword t) (gnats::in-keyword t) 6842382Spaul (gnats::before-keyword t)) 6852382Spaul (progn (re-search-backward gnats::keyword (point-min) '-) 6862382Spaul (gnats::forward-bofield)) 6872382Spaul (gnats::backward-bofield))) 6882382Spaul 6892382Spaul(defun gnats:beginning-of-field () 6902382Spaul "Move point to the beginning of the current field." 6912382Spaul (interactive) 6922382Spaul (cond ((gnats::in-keyword t) 6932382Spaul (gnats::forward-bofield)) 6942382Spaul ((gnats::after-keyword 0)) 6952382Spaul (t 6962382Spaul (gnats::backward-bofield)))) 6972382Spaul 6982382Spaul(defun gnats::current-field () 6992382Spaul (save-excursion 7002382Spaul (if (cond ((or (gnats::in-keyword t) (gnats::after-keyword t)) 7012382Spaul (looking-at gnats::keyword)) 7022382Spaul ((re-search-backward gnats::keyword nil t))) 7032382Spaul (buffer-substring (match-beginning 1) (match-end 1)) 7042382Spaul nil))) 7052382Spaul 7062382Spaul;;;;--------------------------------------------------------------------------- 7072382Spaul;;;; Support functions 7082382Spaul;;;;--------------------------------------------------------------------------- 7092382Spaul 7102382Spaul(defun gnats::looking-after (regex) 7112382Spaul "Returns t if point is after regex." 7122382Spaul ;; 7132382Spaul (let* ((old-point (point)) 7142382Spaul (start (if (eobp) 7152382Spaul old-point 7162382Spaul (forward-char) (point)))) 7172382Spaul (cond ((re-search-backward regex (point-min) t) 7182382Spaul (goto-char old-point) 7192382Spaul (cond ((eq (match-end 0) start) 7202382Spaul t)))))) 7212382Spaul 7222382Spaul(defun gnats::nth-word (string &optional elem) 7232382Spaul "Returns the elem-th word of the string. 7242382SpaulIf elem is nil, then the first wort is returned, if elem is 0 then 7252382Spaulthe whole string is returned." 7262382Spaul ;; 7272382Spaul (if (integerp elem) 7282382Spaul (cond ((eq elem 0) string) 7292382Spaul ((eq elem 1) (gnats::first-word string)) 7302382Spaul ((equal string "") "") 7312382Spaul ((>= elem 2) 7322382Spaul (let ((i 0) (value "")) 7332382Spaul (setq string ; strip leading blanks 7342382Spaul (substring string (or (string-match "[^ \t]" string) 0))) 7352382Spaul (while (< i elem) 7362382Spaul (setq value 7372382Spaul (substring string 0 7382382Spaul (string-match "[ \t]*$\\|[ \t]+" string))) 7392382Spaul (setq string 7402382Spaul (substring string (match-end 0))) 7412382Spaul (setq i (+ i 1))) 7422382Spaul value))) 7432382Spaul (gnats::first-word string))) 7442382Spaul 7452382Spaul(defun gnats::first-word (string) 7462382Spaul (setq string 7472382Spaul (substring string (or (string-match "[^ \t]" string) 0))) 7482382Spaul (substring string 0 (string-match "[ \t]*$\\|[ \t]+" string))) 7492382Spaul 7502382Spaul;;;;--------------------------------------------------------------------------- 7512382Spaul 7522382Spaul(defun gnats::patch-exec-path () 7532382Spaul ;; 7542382Spaul "Replaces `//' by `/' in `exec-path'." 7552382Spaul ;; 7562382Spaul ;(make-local-variable 'exec-path) 7572382Spaul (let ((err-buffer (get-buffer-create " *gnats::patch-exec-path*")) 7582382Spaul (ret)) 7592382Spaul (setq exec-path (save-excursion (set-buffer err-buffer) 7602382Spaul (prin1 exec-path err-buffer) 7612382Spaul (goto-char (point-min)) 76267908Ssteve (while (search-forward "//" nil t) 76367908Ssteve (replace-match "/" nil t)) 7642382Spaul (goto-char (point-min)) 7652382Spaul (setq ret (read err-buffer)) 7662382Spaul (kill-buffer err-buffer) 7672382Spaul ret 7682382Spaul )))) 7692382Spaul 7702382Spaul(defun gnats::get-value-from-shell (&rest command) 7712382Spaul "Execute shell command to get a list of valid values for `variable'." 7722382Spaul ;; 7732382Spaul (let ((err-buffer (get-buffer-create " *gnats::get-value-from-shell*"))) 7742382Spaul (save-excursion 7752382Spaul (set-buffer err-buffer) 7762382Spaul (unwind-protect 7772382Spaul (condition-case var 7782382Spaul (progn 7792382Spaul (apply 'call-process 7802382Spaul (car command) nil err-buffer nil (cdr command)) 7812382Spaul (goto-char (point-min)) 7822382Spaul (if (looking-at "[-a-z]+: ") 7832382Spaul (error (buffer-substring (point-min) (point-max)))) 7842382Spaul (read err-buffer)) 7852382Spaul (error nil)) 7862382Spaul (kill-buffer err-buffer))))) 7872382Spaul 7882382Spaul(or (fboundp 'setenv) 7892382Spaul (defun setenv (variable &optional value) 7902382Spaul "Set the value of the environment variable named VARIABLE to VALUE. 7912382SpaulVARIABLE should be a string. VALUE is optional; if not provided or is 7922382Spaul`nil', the environment variable VARIABLE will be removed. 7932382SpaulThis function works by modifying `process-environment'." 7942382Spaul (interactive "sSet environment variable: \nsSet %s to value: ") 7952382Spaul (if (string-match "=" variable) 7962382Spaul (error "Environment variable name `%s' contains `='" variable) 7972382Spaul (let ((pattern (concat "\\`" (regexp-quote (concat variable "=")))) 7982382Spaul (case-fold-search nil) 7992382Spaul (scan process-environment)) 8002382Spaul (while scan 8012382Spaul (cond 8022382Spaul ((string-match pattern (car scan)) 8032382Spaul (if (eq nil value) 8042382Spaul (setq process-environment (delq (car scan) 8052382Spaul process-environment)) 8062382Spaul (setcar scan (concat variable "=" value))) 8072382Spaul (setq scan nil)) 8082382Spaul ((null (setq scan (cdr scan))) 8092382Spaul (setq process-environment 8102382Spaul (cons (concat variable "=" value) 8112382Spaul process-environment))))))))) 8122382Spaul 8132382Spaul;;;; end of send-pr.el 814