;;;; -*-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
;;;;---------------------------------------------------------------------------

(defconst SEND-PR-VERSION "@VERSION@")

;;;;---------------------------------------------------------------------------
;;;; 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.
;;;;---------------------------------------------------------------------------

;;; These may be changed during configuration/installation or by the individual
;;; user in his/her .emacs file.
;;;
(defconst DEFAULT-CATEGORY "")	; reading this file
(defconst DEFAULT-RELEASE  "@DEFAULT_RELEASE@")	; should not cause errors
(defvar gnats-default-category DEFAULT-CATEGORY
  "Default category to use when submitting Problem Reports.")
(defvar gnats-default-confidential "no"
  "Default confidential value to use when submitting Problem Reports.")
(defvar gnats-default-severity "serious"
  "Default severity to use then submitting Problem Reports.")
(defvar gnats-default-priority "medium"
  "Default priority to use then submitting Problem Reports.")
(defvar gnats-default-class "sw-bug"
  "Default class to use when submitting Problem Reports.")
(defvar gnats-default-release DEFAULT-RELEASE

  "Default release to use when submitting Problem Reports.")

;;; Ideally we would get all the following values from a central database
;;; during runtime instead of having them here in the code.
;;;
(defconst gnats-categories nil
  "List of GNATS categories; computed at runtime.")
(defconst gnats-confidential '(("yes") ("no"))
  "List of GNATS confidential values.")
(defconst gnats-severities '(("non-critical") ("serious") ("critical"))
  "List of GNATS severities.")
(defconst gnats-priorities '(("low") ("medium") ("high"))
  "List of GNATS priorities.")
(defconst gnats-classes '(("sw-bug") ("doc-bug") ("change-request") ("support"))
  "List of GNATS classes.")
(defconst gnats-releases nil
  "List of GNATS releases; computed at runtime..")
(defconst gnats-states 
  '(("open") ("analyzed") ("feedback") ("suspended") ("closed"))
  "List of GNATS states.")

(defconst gnats-state-following 
      '(("open"      "analyzed")
	("analyzed"  "feedback")
	("feedback"  "closed")
	("suspended" "analyzed"))
      "A list of states and possible following states (does not describe all possibilities).")

(defun gnats-set-categories ()
  ;;
  "Get the list of categories dynamically and assign it to gnats-categories."
  ;;
  (gnats-set-variable-from-shell 'gnats-categories "send-pr" "-CL"))

(defconst send-pr-buffer "*send-pr*"
  "Name of the temporary buffer, where the problem report gets composed.")

(defconst send-pr-err-buffer "*send-pr-error*"
  "Name of the temporary buffer, where send-pr error messages appear.")

(defconst gnats-indent 17 "Indent for formatting the value.")


;;;;---------------------------------------------------------------------------
;;;; `send-pr' - command for creating and sending of problem reports
;;;;---------------------------------------------------------------------------

(defun send-pr ()
  ;;
  "Create a buffer and read in the result of `send-pr -P'.
When finished with editing the problem report use \\[do-send-pr]
to send the PR with `send-pr -f -'."
  ;;
  (interactive)
  (if (get-buffer send-pr-buffer)
      (progn (switch-to-buffer send-pr-buffer)
	     (if (y-or-n-p "erase previous problem report? ")
		 (progn (erase-buffer)
			(send-pr-start-up))
	       t))
    (send-pr-start-up)))

(defun send-pr-start-up ()
  (set-buffer (get-buffer-create send-pr-buffer))
  (setq default-directory (expand-file-name "~/"))
  (auto-save-mode auto-save-default)
  (shell-command "send-pr -P" t)
  (set-buffer-modified-p nil)
  (if (null (send-pr-mode))
      (progn
	(kill-buffer (current-buffer))
	(kill-buffer (get-buffer send-pr-err-buffer)))
    (progn
      (switch-to-buffer send-pr-buffer)
      (gnats-completing-read-and-replace ">Category:" 
					gnats-categories gnats-default-category t)
      (gnats-completing-read-and-replace ">Confidential:" 
					gnats-confidential gnats-default-confidential t)
      (gnats-completing-read-and-replace ">Severity:"
					gnats-severities gnats-default-severity t)
      (gnats-completing-read-and-replace ">Priority:"
					gnats-priorities gnats-default-priority t)
      (gnats-completing-read-and-replace ">Class:"
					gnats-classes    gnats-default-class t)
      (gnats-completing-read-and-replace ">Release:"
					gnats-releases   gnats-default-release)
      (message
       (substitute-command-keys "To send the problem report use: \\[do-send-pr]"))
      (goto-char (point-min))
      (re-search-forward "^Subject:")
      (forward-char))))
 
(defun do-send-pr ()
  ;;
  "Pipe the contents of the buffer *send-pr* to `send-pr -f -.'"
  ;;
  (interactive)
  (let ((err-buffer (get-buffer-create send-pr-err-buffer))
	(ok nil))
    (save-excursion (set-buffer err-buffer) (erase-buffer))
    (message "starting send-pr ...")
    (call-process-region (point-min) (point-max)
			 "send-pr"
			 nil
			 err-buffer
			 nil
			 "-r" "-f" "-")
    ;; stupidly we cannot check the return value in EMACS 18.57, thus we need
    ;; this kluge to find out, whether send-pr succeeded.
    (save-excursion
      (set-buffer err-buffer)
      (goto-char (point-min))
      (if (re-search-forward "problem report sent to" nil t) (setq ok t))
      (if ok
	  (progn (message (buffer-substring (point-min) (- (point-max) 1)))
		 (if (bufferp err-buffer)
		     (kill-buffer err-buffer)))))
    (delete-auto-save-file-if-necessary)
    (set-buffer-modified-p nil)
    (if ok (bury-buffer) (pop-to-buffer err-buffer)))
  )

;;;;---------------------------------------------------------------------------
;;;; Functions to read and replace field values.
;;;;---------------------------------------------------------------------------

(defun gnats-completing-read-and-replace  
  (field domain &optional default require-match default-overwrites prompt)
  ;;
  "Reads a new value of a field and replaces the old one with it.
Searches for a enum- or string-field `field', gets it's value and let
one change the value with a new value from `domain'. `default' is the default
value for the completing read. If `require-match' is non-nil, the the new valuemust match the domein. If `default-overwrites' is non-nil, then `default'
is always used in the prompt. If `prompt' is non-nil, then it is used for the
prompt. Returns the new value."
  ;
  (let ((old-value (gnats-find-field field)))
    (if (eq old-value nil) 
	(error "gnats-completing-read-and-replace: no such field %s" field))
    (let* ((the-prompt 
	    (if prompt prompt (concat field " ")))
	   (the-default 
	    (if (or default-overwrites (eq old-value t)) default old-value))
	  (new-value 
	   (completing-read the-prompt domain nil require-match the-default)))
      (delete-horizontal-space)
      (looking-at ".*$")
      (replace-match 
       (concat (make-string (- gnats-indent (length field)) ?\40 ) new-value))
      new-value)))

(defun gnats-find-field (field &optional elem)
  ;;
  "Search for a enum- or string-field `field'.
Returns `nil', if field is not found, `t', if the value of the field is a 
comment or empty and otherwise the field value.
If elem is an integer, then the elem-th word of the field is returned.
Point is left at the beginning of the whole found field"
  ;;
  (goto-char (point-min))
  (if (re-search-forward (concat "^" field))
      (progn
	(forward-char 1)
	(re-search-forward "[ \t]*")
	(if (and (not (looking-at "<.*>$")) (not (eolp)))
	    (progn
	      (looking-at ".*$")	; to set match-{beginning,end}
	      (gnats-nth-word 
	       (buffer-substring (match-beginning 0) (match-end 0))
	       elem))
	      t))
	nil))

;;;;---------------------------------------------------------------------------
;;;; send-pr-mode mode
;;;;---------------------------------------------------------------------------

(defvar send-pr-mode-map nil "Keymap for send-pr mode.")

(defun 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)
  (gnats-set-categories)
  (if (null gnats-categories)
      nil
    (progn
      (put 'send-pr-mode 'mode-class 'special)
      (kill-all-local-variables)
      (setq major-mode '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)
      (run-hooks 'send-pr-mode-hook)
      t)))

(if send-pr-mode-map
    nil
  (setq send-pr-mode-map (make-sparse-keymap))
  (define-key send-pr-mode-map "\C-c\C-c" 'do-send-pr)
  (define-key send-pr-mode-map "\M-n" 'gnats-next-field)
  (define-key send-pr-mode-map "\M-p" 'gnats-previous-field)
  (define-key send-pr-mode-map "\C-\M-f" 'gnats-forward-field)
  (define-key send-pr-mode-map "\C-\M-b" 'gnats-backward-field)
)


;;;;---------------------------------------------------------------------------
;;;; Point movement functions
;;;;---------------------------------------------------------------------------

(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]+")


(defun gnats-before-keyword (&optional where)
  ;;
  "Returns t if point is in some white space before a keyword.
If were 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 were is nil, then point is not changed; if where is t then point is moved
to the end of the white space it was in, otherwise it is moved to the
beginning of the keyword."
  ;;
  (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 were 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)))
    (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." 
  ;;
  (if (re-search-forward gnats-keyword (point-max) '-) ; loook for the next field
      (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." 
  ;;
  (if (re-search-backward gnats-keyword (point-min) '-) ;look for previous field
      (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-before-keyword t) (gnats-in-keyword t) (gnats-after-keyword t))
      (progn (re-search-backward gnats-keyword (point-min) '-)
	     (gnats-forward-bofield))
    (gnats-backward-bofield)))


;;;;---------------------------------------------------------------------------
;;;; 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'.
Uses `send-pr-err-buffer'."
  ;;
  ;(make-local-variable 'exec-path)
  (let ((err-buffer (get-buffer-create send-pr-err-buffer))
	(ret))
    (setq exec-path (save-excursion 
		      (set-buffer err-buffer)
		      (erase-buffer)
		      (prin1 exec-path err-buffer)
		      (goto-char (point-min))
		      (replace-string "//" "/")
		      (goto-char (point-min))
		      (setq ret (read err-buffer))
		      (erase-buffer)
		      ret
		      ))))

(defun gnats-set-variable-from-shell (variable &rest command)
  ;;
  "Execute shell command to get a list of valid values for `variable'.
Uses `send-pr-err-buffer'."
  ;;
  (if (eq (symbol-value variable) nil)
      (let ((err-buffer (get-buffer-create send-pr-err-buffer)))
	(save-excursion
	  (set-buffer err-buffer)
	  (erase-buffer)
	  (condition-case var
	      (progn
		(apply 'call-process 
		       (append 
			(list (car command) nil err-buffer nil) (cdr command)))
		(goto-char (point-min))
		(set variable (read err-buffer)))
	    (setq variable nil))
	  (erase-buffer)))))


;;;; end of send-pr.el
