; 
; irit.el - Definitions of IRIT mode for emacs editor.
; 
; Author:	Gershon Elber
; 		Computer Science Dept.
; 		University of Utah
; Date:	Tue May 14 1991
; Copyright (c) 1991, Gershon Elber
;
; This file defines an environment to run edit and execute IRIT programs.
; Such a program should have a '.irt' extension in order it to be in
; irit-mode major mode. Several new functions are provided to communicate
; between the editted file and the solid modeller:
;
; 1. send-line-to-irit - sends a single line to the solid modeller for
;    execution. A line is defined from current position to the next
;    semicolon ';'. If however several commands exists on the same line
;    they will all be send as one line.
;    Bounded to Meta-E by default.
; 2. send-region-to-irit - sends the region from the current mark (mark-marker)
;    to current position (point-marker) to the solid modeller. This function
;    is convenient for sending a large block of commands.
;    Bounded to Meta-R by default.
; 3. send-mini-buffer-to-irit - sends a line retrieved via the mini buffer to
;    the solid modeller for execution. The line is appended with a new line
;    and is echoed to the irit-solid-modeller buffer if irit-echo-program.
;    Bounded to Meta-S by default.
;
; Both functions checks for existance of a buffer named irit-solid-modeller
; and a process named "irit" hooked to it, and will restart a new process
; or buffer if none exists. The program to execute as process "irit" is
; defined by the irit-program constant below.
;

(defvar irit-program "irit"
  "*The executable to run for irit-solid-modeller buffer.")

(defvar irit-echo-program nil
  "*Control echo of executed commands to irit-solid-modeller buffer.")

(defvar irit-mode-map nil "")
(if irit-mode-map
    ()
  (setq irit-mode-map (make-sparse-keymap))
  (define-key irit-mode-map "\M-s" 'send-mini-buffer-to-irit)
  (define-key irit-mode-map "\M-e" 'send-line-to-irit)
  (define-key irit-mode-map "\M-r" 'send-region-to-irit))

(define-key c-mode-map "\M-o" 'make-irit-c-function)
(define-key c-mode-map "\M-p" 'overwrite-mode)

;;;
;;; Define the irit-mode
;;;
(defun irit-mode ()
  "Major mode for editing and executing IRIT files.

see send-line-to-irit and send-region-to-irit for more."
  (interactive)
  (use-local-map irit-mode-map)
  (setq major-mode 'irit-mode)
  (setq mode-name "Irit")
  (run-hooks 'irit-mode-hook))

;;;
;;; Define send-min-buffer-to-irit - send one line prompt for at the mini
;;; buffer, to the irit buffer.
;;;
(defun send-mini-buffer-to-irit ()
  "Sends one line of code from mini-buffer to the IRIT program.

The IRIT solid modeller buffer name is irit-solid-modeller and the 
process name is 'irit'. If none exists, a new one is created.

The name of the irit program program to execute is stored in irit-program
and may be changed."
  (interactive)
  (if (equal major-mode 'irit-mode)
    (progn
      (make-irit-buffer)     ; In case we should start a new one.
      (let* ((crnt-buffer (buffer-name))
	     (string-copy (read-from-minibuffer "Irit> ")))
	(switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
	(end-of-buffer)
	(if irit-echo-program
	  (insert string-copy))
	(if (not (pos-visible-in-window-p))
	  (recenter 3))
	(process-send-string "irit" string-copy)
	(process-send-string "irit" "\n")
	(switch-to-buffer-other-window (get-buffer crnt-buffer))))
    (message "Should be invoked in irit-mode only.")))
;;;
;;; Define send-line-to-irit - send from current cursor position to next
;;; semicolon detected.
;;;
(defun send-line-to-irit ()
  "Sends one line of code from current buffer to the IRIT program.

Use to execute a line in the IRIT solid modeller. A line is anything
that is terminated by a semicolon, but is at least one line of text so
multiple commands per line (with several semicolons) are still
considered a single line.

The IRIT solid modeller buffer name is irit-solid-modeller and the 
process name is 'irit'. If none exists, a new one is created.

The name of the irit program program to execute is stored in irit-program
and may be changed."
  (interactive)
  (if (equal major-mode 'irit-mode)
    (progn
      (make-irit-buffer)        ; In case we should start a new one.
      (beginning-of-line)
      (let ((start-mark (point-marker)))
	(search-forward ";")
	(let ((end-one-mark (point-marker)))
	  (goto-char start-mark)
	  (beginning-of-line)
	  (next-line 1)
	  (let* ((crnt-buffer (buffer-name))
	         (end-two-mark (point-marker))
	         (end-max-mark (max end-one-mark end-two-mark))
		 (string-copy (buffer-substring start-mark end-max-mark)))
	    (switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
	    (end-of-buffer)
	    (if irit-echo-program
	      (insert string-copy))
	    (set-marker (process-mark (get-process "irit")) (point-marker))
	    (if (not (pos-visible-in-window-p))
	      (recenter 3))
	    (switch-to-buffer-other-window (get-buffer crnt-buffer))
	    (process-send-region "irit" start-mark end-max-mark)
	    (goto-char end-max-mark)
	    (if (equal "\n" (buffer-substring (point-marker)
					      (+ 1 (point-marker))))
	      (process-send-string "irit" "\n"))  
	    (if (> end-one-mark end-two-mark)
	      (forward-char 1))))))
    (message "Should be invoked in irit-mode only.")))

;;;
;;; Define send-region-to-irit - send from current cursor position to
;;; current marker.
;;;
(defun send-region-to-irit ()
  "Sends a region of code from current buffer to the IRIT program.

When this function is invoked on an IRIT file it send the region from current
point to current mark to the irit solid modeller.

The IRIT solid modeller buffer name is irit-solid-modeller and the
process name is 'irit'. If none exists, a new one is created.

The name of the irit program program to execute is stored in irit-program
and may be changed."
  (interactive)
  (if (equal major-mode 'irit-mode)
    (progn
      (make-irit-buffer)     ; In case we should start a new one.
      (copy-region-as-kill (mark-marker) (point-marker))
      (let ((crnt-buffer (buffer-name)))
	(switch-to-buffer-other-window (get-buffer "irit-solid-modeller"))
	(end-of-buffer)
	(if irit-echo-program
	  (yank))
	(set-marker (process-mark (get-process "irit")) (point-marker))
	(if (not (pos-visible-in-window-p))
	  (recenter 3))
	(switch-to-buffer-other-window (get-buffer crnt-buffer))
	(process-send-region "irit" (mark-marker) (point-marker))))
    (message "Should be invoked in irit-mode only.")))

;;;
;;; Switch to "irit-solid-modeller" buffer if exists. If not, creates one and
;;; execute the program defined by irit-program.
;;;
(defun make-irit-buffer ()
  "Switch to irit-solid-modeller buffer or create one if none exists"
  (interactive)
  (if (not (get-process "irit"))
    (start-process "irit" "irit-solid-modeller" irit-program)))

;;;
;;; Autoload irit-mode on any file with irt extension. 
;;;
(setq auto-mode-alist (append '(("\\.irt$" . irit-mode))
			      auto-mode-alist))

;;;
;;; Gets a single function's parameter containing both type andname and
;;; isolate the parametr's name out of it.
;;;
(defun make-irit-c-isolate-var-name (type-and-name)
  (let* ((match1 (string-match "[^\* 	]+" type-and-name))
	 (match2 (string-match "[\[ 	]+" type-and-name match1))
	 (match3 (string-match "[^\* 	]+" type-and-name match2))
	 (match4 (string-match "[\[ 	]+" type-and-name match3)))
    (if match3
      (substring type-and-name match3 (if match4
					match4
					(length type-and-name)))
      (substring type-and-name match1 (if match2
					match2
					(length type-and-name))))))

;;;
;;; Given a whole describing the arguments, split it into the individual
;;; parameters by searching for commas and close parenthesis.
;;;
(defun make-irit-c-func-parse-args (args)
  (if (string-match "([ 	]*void[ 	]*)" args)
    nil
    (let ((match (string-match "[,)]" args)))
      (if match
	(cons (make-irit-c-isolate-var-name (substring args 1 match))
	      (make-irit-c-func-parse-args
	                     (substring args (+ match 1) (length args))))))))

;;;
;;; Insert a list describing the arguments into the current buffer.
;;;
(defun make-irit-c-func-ins-params (args term-ch)
  (if args
    (progn
      (insert (concat "*   " (car args)))
      (insert-char ?: 1)
      (insert-char ?  (- 72 (length (car args))))
      (insert term-ch)
      (make-irit-c-func-ins-params (cdr args) term-ch))))

;;;
;;; Filters out trailing spaces if it is not a pointer (no *)
;;;
(defun make-irit-c-func-retval (retval)
  (let* ((match1 (string-match "*+" retval))
	 (match2 (string-match "[ 	]+" retval)))
    (if match1
      retval
      (if match2
        (substring retval 0 match2)
	retval))))

;;;
;;; Make a skeleton header for an IRIT C source function.
;;;
(defun make-irit-c-function ()
  "Creates a sketelon for a C function for the IRIT solid modeler C code"
  (interactive)
  (if (equal major-mode 'c-mode)
    (progn
      (let* ((func-proto (read-from-minibuffer "Function Prototype: "))
	     (match1 (string-match "[ 	]+" func-proto))
	     (match2 (string-match "[^* 	]+" func-proto match1))
	     (match3 (string-match "[ 	]+" func-proto match2))
	     (match4 (string-match "[^* 	]+" func-proto match3))
	     (match5 (string-match "(" func-proto))
	     (ret-val (if (and match3 (< match3 match5))
			(make-irit-c-func-retval (substring func-proto match2
							              match4))
			(make-irit-c-func-retval (substring func-proto 0
                                                                      match2))))
	     (term-ch (if (string-match "static" (substring func-proto 0 match1))
			"*\n"
			"M\n"))
	     (func-name (if (and match3 (< match3 match5))
			  (substring func-proto match4 match5)
			  (substring func-proto match2 match5)))
	     (args (make-irit-c-func-parse-args
		    (substring func-proto match5 (length func-proto)))))
        (insert "/*****************************************************************************\n")
        (insert (concat "* DESCRIPTION:                                                               " term-ch))
        (insert (concat "*                                                                            " term-ch))
        (insert (concat "*                                                                            " term-ch))
        (insert "*                                                                            *\n")
        (insert (concat "* PARAMETERS:                                                                " term-ch))
	(if args
	  (make-irit-c-func-ins-params args term-ch)
	  (insert (concat "*   None                                                                     " term-ch)))
        (insert "*                                                                            *\n")
        (insert (concat "* RETURN VALUE:                                                              " term-ch))
	(insert (concat "*   " ret-val ))
	(if (string-match "void" ret-val)
	  (insert-char ?  (- 73 (length ret-val)))
	  (progn
	    (insert-char ?: 1)
	    (insert-char ?  (- 72 (length ret-val)))))
	(insert term-ch)
        (insert (concat "*                                                                            " term-ch))
        (insert "*                                                                            *\n")
	(if (not (string-match "static" (substring func-proto 0 match1)))
	  (progn
	    (insert (concat "* KEYWORDS:                                                                  " term-ch))
	    (insert (concat "*   " func-name))
	    (insert-char ?  (- 73 (length func-name)))
	    (insert term-ch)))
        (insert (concat "*                                                                            " term-ch))
        (insert "*****************************************************************************/\n")
	(insert (concat func-proto "\n{\n}\n\n"))))
    (message "Should be invoked in C-mode only.")))
