745 lines
26 KiB
Plaintext
745 lines
26 KiB
Plaintext
|
;;;; -*-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
|