home *** CD-ROM | disk | FTP | other *** search
;;;; -*-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 
