;;; cat interactive / editing mode 
;;; the other side of the tunnel is emacs.cat

;; TODO: derive this from a lisp mode

(require 'newcomment)


(defun cat-comint-name () "cat")

;; buffer and interaction
(defun cat-buffer ()
  "get cat buffer"
  (get-buffer (concat "*" (cat-comint-name) "*")))

(defun cat-interpreter () 
  "mzscheme"
  )


(defun make-cat-comint ()
  (make-comint "cat" "~/brood/go"))

(defun run-cat () (interactive)
   (let ((b (or (cat-buffer) 
		(make-cat-comint))))
     (switch-to-buffer b)
     (or (get-buffer-process b) 
	 (make-cat-comint))
     (cat-interaction-mode)))



(defun cat-process () (interactive)
  "Get current cat process. If there is none, try to spawn one."
  (let ((process (get-buffer-process (cat-buffer))))
    (if process process
      (progn
	(cat-start-process)
	(get-buffer-process (cat-buffer))))))





;; SEND (invisible)

(defun cat-command-string (command)
  "Send a string directly to the process."
  (process-send-string (cat-process) 
		       (concat command "\n")))

(defun cat-command-list (lst)
  (cat-command-string
   (concat
    (with-output-to-string (print lst))
    " run")))

(defun cat-send-region ()
  "Send region to CAT interaction buffer."
  (interactive)
  (cat-command-string
   (buffer-substring (mark) (point))))



;; SEND (visible)

;; string sending
(defun cat-send-string (command)
  "Send a string to the CAT interaction buffer."
  (save-excursion
    (set-buffer (cat-buffer))
    (comint-kill-input)
    (insert command)
    (comint-send-input)))






;; RECEIVE

; output filter storage
(defvar cat-output "")
(defvar cat-emacs-id "emacs:")


; interpret a line of cat output
; and eval expressions in "emacs:<exp>"
(defun cat-check-line (str)
  (if (string-match (concat "^" cat-emacs-id) str)
      (eval (car
	     (read-from-string 
	      (substring str (length cat-emacs-id)))))
    (comint-output-filter (cat-process) str)))
    

; sync variable
(defvar cat-waiting nil)

; check cat-output and process line by line
(defun cat-check-transaction ()

  ;; 1. check whole lines: if command, do eval, else send to buffer
  (while (string-match "^.*\n" cat-output)
    (let* ((p    (match-end 0))
	   (head (substring cat-output 0 p))
	   (tail (substring cat-output p (length cat-output))))
      (set-variable 'cat-output tail)
      (cat-check-line head)))

  ;; 2. check partial lines: if no command, flush to buffer anyway
  (if (and (length cat-output)
	   (not (string-match "^emacs:"  cat-output)))
      (progn
	(comint-output-filter (cat-process) cat-output)
	(set-variable 'cat-output ""))))

  


; filter: pass to accumulate
(defun cat-output-filter (proc string)
  (set-variable 'cat-output (concat cat-output string))
  (cat-check-transaction)
  (set-variable 'cat-waiting nil))


;; COMMAND COMPLETION

(defun cat-wait-for-command ()
  (set-variable 'cat-waiting 1)
  (while cat-waiting
    (accept-process-output (cat-process) 1 1)))

(defun cat-complete ()
  "Perform completion on the cat symbol preceding point."
  (interactive)
  (save-excursion
    (let ((word (word-before-point)))
      (message (concat "completing: " word))
      (cat-command-list `(,word wordlist emacs-complete-reply))
      (cat-wait-for-command))))

(defun cat-help-word-at-point ()
  "Print documentation string of word under point in minibuffer."
  (interactive)
  (let ((word (word-at-point)))
    (cat-command-list `(,word emacs-help))))


(defun cat-complete-answer (word lst)
  (if (eq 'sole 
	  (comint-dynamic-simple-complete word lst))
      (let ((cbuf (get-buffer "*Completions*")))
	(if cbuf (kill-buffer cbuf)))))

;; DOCUMENTATION




;; MODES

; see http://two-wugs.net/emacs/mode-tutorial.html
(defvar cat-mode-hook nil)


(defconst cat-font-lock-keywords
  (list
;;    '("\\W:\\W" . font-lock-keyword-face)
;;    '("\\W;\\W" . font-lock-keyword-face)
;;    '("\\Wfor\\W" . font-lock-keyword-face)
;;    '("\\Wnext\\W" . font-lock-keyword-face)
   ))



(defvar cat-syntax-table (make-syntax-table))

(defun cat-init-syntax-table (table)

  ;; start with a clean sheet.
  (let ((character 0))
    (while (< character 255)
      (modify-syntax-entry character "w" table)
      (setq character (+ 1 character))))

  ;; whitespace
  (modify-syntax-entry ?\  " " table)
  (modify-syntax-entry ?\t " " table)

  ;; comment
  (modify-syntax-entry ?\; "<" table)
  (modify-syntax-entry ?\n ">" table)
  (modify-syntax-entry ?\f ">" table)

  ;; string & escape
  (modify-syntax-entry ?\" "\"" table)
  (modify-syntax-entry ?\\ "\\" table)

  ;; list
  (modify-syntax-entry ?\( "()" table)
  (modify-syntax-entry ?\) ")(" table)

  )

(cat-init-syntax-table cat-syntax-table)



(defun cat-mode-shared ()
  ;; syntax table
  (set-syntax-table cat-syntax-table)

  ;; comment
  (make-local-variable 'comment-start)
  (setq comment-start "# ")

  ;; keywords
  (set (make-local-variable 
  	'font-lock-defaults) 
       '(cat-font-lock-keywords)))

  


;; interactive mode  
(define-derived-mode cat-interaction-mode comint-mode "CAT-interaction"
  "Packet Forth interaction mode"

  ;; shared stuff
  (cat-mode-shared))

(define-key cat-interaction-mode-map [M-tab] 'cat-complete)
(define-key cat-interaction-mode-map "\C-c\C-h" 'cat-help-word-at-point)

  

;; editing mode
(define-derived-mode cat-mode fundamental-mode "CAT"
  "Major mode for editing packet forth files."
;  (set (make-local-variable 'indent-line-function) '(cat-indent-line))

  ;; shared stuff
  (cat-mode-shared)

  ;; keymap
  (use-local-map cat-mode-map))
  
;; keymap
;(defvar cat-mode-map (make-sparse-keymap))
(set-keymap-parent cat-mode-map text-mode-map)

(define-key cat-mode-map [M-tab] 'cat-complete)
(define-key cat-mode-map "\C-c\C-h" 'cat-help-word-at-point)





(add-to-list 'auto-mode-alist '("\\.cat\\'" . cat-mode))






;; TESTING

(defun cat-test () (interactive) (message (definition-at-point)))
(global-set-key [M-f9] 'cat-test)



(provide 'cat)