;;; relisp.el --- library for ruby/elisp interaction

;; Copyright (C) 2009 <don@ohspite.net>

;; This file is part of Relisp.

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

;; Relisp 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 General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
;; 02110-1301 USA


;; TODO:
;; signal errors when ruby returns an error?


;;; first, some general string functions

(defun relisp-trim-leading-whitespace (str)
  "Remove leading whitespace characters from STR."
  (let ((s (if (symbolp str)(symbol-name str) str))
	(whitespace-regexp "\\( \\|\f\\|\t\\|\n\\)"))
    (save-excursion
      (while (and
	      (not (null (string-match (concat "^" whitespace-regexp) s)))
	      (> (length s) (string-match (concat "^" whitespace-regexp) s)))
	(setq s (replace-match "" t nil s))))
    s))

(defun relisp-trim-trailing-whitespace (str)
  "Remove trailing whitespace characters from STR."
  (let ((s (if (symbolp str)(symbol-name str) str))
	(whitespace-regexp "\\( \\|\f\\|\t\\|\n\\)"))
    (save-excursion
      (while (and
	      (not (null (string-match (concat whitespace-regexp "$") s)))
	      (> (length s) (string-match (concat whitespace-regexp "$") s)))
	(setq s (replace-match "" t nil s))))
    s))

(defun relisp-strip (str)
  "Remove leading and trailing whitespace from STR."
  (relisp-trim-leading-whitespace (relisp-trim-trailing-whitespace str)))

;;; now real stuff

(defvar relisp-slave-name "relisp-slave" "Name of the relisp ruby slave process.")
(defvar relisp-buffer-name "*Relisp*" "Name of the relisp output buffer.")

;; to prohibit free variable warnings
(defvar relisp-emacs-master-p t)
(defvar relisp-slave-process)
(defvar relisp-ruby-output)
(defvar relisp-begin-answer-code)
(defvar relisp-answer-code)
(defvar relisp-question-code)
(defvar relisp-command-code)
(defvar relisp-error-code)
(defvar relisp-ruby-return)
(defvar relisp-previous-result)

(defun relisp-log (text)
  "Insert TEXT at the end of `relisp-buffer-name', unless emacs is the slave."
  (save-excursion
    (when relisp-emacs-master-p
      (get-buffer-create relisp-buffer-name)
      (unless (string-match (relisp-endofmessage-regexp) (relisp-strip text))
	(set-buffer relisp-buffer-name)
	(goto-char (point-max))
	(insert text "\n")))))

(defun relisp-write-to-ruby (message)
  "Send MESSAGE to the ruby process."
  (if relisp-emacs-master-p
      (process-send-string relisp-slave-process (concat message "\n"))
    (message message)))

(defun relisp-read-from-ruby nil
  "Accept ruby input, stopping at a match to `relisp-endofmessage-regexp'."
  (if relisp-emacs-master-p
      (relisp-accept-slave-output)
    (relisp-accept-master-output)))
    
(defun relisp-accept-slave-output nil
  "Accept a full ruby message when ruby is the slave process."
  (while (and (relisp-slave-alive-p) 
	      (null (string-match (relisp-endofmessage-regexp)
				  relisp-ruby-output)))
    (accept-process-output))
  (let ((val relisp-ruby-output))
    (setq relisp-ruby-output "")
    val))

(defun relisp-accept-master-output nil
  "Accept a full ruby message when emacs is the slave process."
  (let ((output "") 
	(output-line ""))
    (while (null (string-match (relisp-endofmessage-regexp) output-line))
      (setq output-line (read-from-minibuffer ""))
      (setq output (concat output output-line)))
    output))

(defun relisp-endofmessage-regexp nil
  "Return a regexp that matches codes indicating a message termination."
  (concat "\\(" relisp-question-code 
	  "\\|" relisp-command-code 
	  "\\|" relisp-answer-code 
	  "\\|" relisp-error-code
	  "\\)" 
	  "[[:space:]]*"))

(defun relisp-receive-answer nil
  "Handle messages from emacs after ruby-eval or ruby-exec are called."
  (let ((message (relisp-read-from-ruby)))
    (while (or (string-match relisp-question-code message)
	       (string-match relisp-command-code  message))
      (if (string-match relisp-question-code message)
	  (relisp-answer-ruby message)
	(relisp-obey-ruby message))
      (setq message (relisp-read-from-ruby)))
    message))

(defun ruby-exec (ruby-code)
  "Have ruby evaluate RUBY-CODE without returning the result.
Reads input from the minibuffer unless an argument is
given."
  (interactive "ruby> ")
  (let (message result)
    (if (and relisp-emacs-master-p (not (relisp-slave-alive-p)))
	(relisp-start-slave))
    (relisp-log (concat "lisp!> " ruby-code))
    (relisp-write-to-ruby (relisp-form-command ruby-code))
    (setq message (relisp-receive-answer))
    (setq relisp-ruby-return (relisp-strip (car (split-string message relisp-answer-code))))
    (relisp-log "")
    (setq result (if (string-match (concat "\n?" relisp-error-code "[[:space:]]*") relisp-ruby-return)
		     (concat "RUBY ERROR: " (replace-match "" nil t relisp-ruby-return))
		   nil))
    (if (and (interactive-p) (not (null result)))
	(message (prin1-to-string result)))
    result))

(defun ruby-eval (ruby-code)
  "Have ruby evaluate RUBY-CODE and return the result.
The result is an elisp object equivalent to the ruby result of
RUBY-CODE.  Reads input from the minibuffer unless an argument is
given."
  (interactive "ruby> ")
  (let (message result)
    (if (and relisp-emacs-master-p (not (relisp-slave-alive-p)))
	(relisp-start-slave))
    (relisp-log (concat "lisp?> " ruby-code))
    (relisp-write-to-ruby (relisp-form-question ruby-code))
    (setq message (relisp-receive-answer))
    (setq relisp-ruby-return (relisp-strip (car (split-string message relisp-answer-code))))
    (relisp-log (concat "ruby=> " relisp-ruby-return "\n"))
    (setq result (if (string-match (concat "\n?" relisp-error-code "[[:space:]]*") relisp-ruby-return)
		     (concat "RUBY ERROR: " (replace-match "" nil t relisp-ruby-return))
		   (eval (read (relisp-trim-trailing-whitespace relisp-ruby-return)))))
    (if (interactive-p) 
	(message (prin1-to-string result)))
    result))

(defun relisp-answer-ruby (question)
  "Evaluate the QUESTION from ruby and send ruby the result."
  (setq question (relisp-strip (car (split-string question relisp-question-code))))
  (relisp-log (concat "ruby?> " question))
  (setq question (read question))
  (condition-case error-description
      (progn 
	(set relisp-previous-result (eval question))
	(relisp-log (concat "lisp=> " (prin1-to-string (type-of (eval relisp-previous-result)))))
	(relisp-log (concat "    => " (prin1-to-string (eval relisp-previous-result))))
	(relisp-write-to-ruby relisp-begin-answer-code)
	(relisp-write-to-ruby (prin1-to-string (type-of (eval relisp-previous-result))))
	(relisp-write-to-ruby (relisp-form-answer (eval relisp-previous-result))))
    (error (relisp-write-to-ruby 
	    (relisp-form-error
	     (error-message-string error-description))))))

(defun relisp-obey-ruby (command)
  "Evaluate the COMMAND from ruby."
  (setq command (relisp-strip (car (split-string command relisp-command-code))))
  (relisp-log (concat "ruby!> " command))
  (setq command (read command))
  (condition-case error-description
      (progn
	(set relisp-previous-result (eval command))
	(relisp-write-to-ruby relisp-answer-code))
    (error (relisp-write-to-ruby 
	    (relisp-form-error
	     (error-message-string error-description))))))

(defun relisp-form-command (code)
  "Return a string that tells ruby to evaluate CODE."
  (unless (stringp code)
    (setq code (prin1-to-string code)))
  (concat code "\n" relisp-command-code))

(defun relisp-form-question (code)
  "Return a string that tells ruby to evaluate CODE and return the result."
  (unless (stringp code)
    (setq code (prin1-to-string code)))
  (concat code "\n" relisp-question-code))

(defun relisp-form-answer (code)
  "Return a string that tells ruby that CODE is the answer to its query."
  (setq code (prin1-to-string code))
  (concat code "\n" relisp-answer-code))

(defun relisp-form-error (code)
  "Return a string that tells ruby that CODE is an error message."
  (setq code (prin1-to-string code))
  (concat code "\n" relisp-error-code))

(defun relisp-to-ruby (object)
  "Return a string that, when evaluated in ruby, results in OBJECT."
  (let ((var (ruby-eval "new_elisp_variable")))
    (set var object)
    (concat "elisp_eval('" (prin1-to-string var) "')")))

(defun relisp-get-constant nil
  "Return the next constant passed from ruby.
Intended to be called from relisp-get-constants."
  (if relisp-emacs-master-p
      (progn
	(relisp-write-to-ruby "(prompt)")
	(while (null (string-match "\n" relisp-ruby-output))
	  (accept-process-output))
	(let ((result (relisp-strip relisp-ruby-output)))
	  (setq relisp-ruby-output "")
	  result))
    (message "(prompt)")
    (read-from-minibuffer "")))

(defun relisp-get-constants nil
  "Sets all relisp constants shared between ruby and emacs.
Intended to be called from relisp-start-slave and
relisp-become-slave."
  (setq relisp-question-code     (relisp-get-constant))
  (setq relisp-command-code      (relisp-get-constant))
  (setq relisp-begin-answer-code (relisp-get-constant))
  (setq relisp-answer-code       (relisp-get-constant))
  (setq relisp-error-code        (relisp-get-constant))
  (setq relisp-previous-result   (read (relisp-get-constant))))

(defun relisp-start-slave nil
  "Start a ruby slave process to do emacs's bidding.
If `relisp-ruby-slave-path' is bound, then that file is read and
the Relisp::RubySlave object must be started there.  Otherwise
emacs starts a ruby process and starts a RubySlave on its own."
  (interactive)
  (setq relisp-emacs-master-p t)
  (relisp-stop-slave)
  (setq relisp-ruby-output "")
  (if (and (boundp 'relisp-ruby-slave-path) (file-exists-p relisp-ruby-slave-path))
      (setq relisp-slave-process (start-process relisp-slave-name nil "ruby" relisp-ruby-slave-path))
    (setq relisp-slave-process (start-process relisp-slave-name nil
					      "ruby" 
					      "-x"))
    (process-send-string relisp-slave-name 
			 (concat "#! ruby \n"
				 "$:.unshift File.join(File.dirname('" (symbol-file 'relisp-slave-name) "'), '../lib')\n"
				 "require 'rubygems'\n" 
				 "require 'relisp'\n" 
				 "Relisp::RubySlave.new.start\n"
				 "__END__\n")))
  (set-process-filter relisp-slave-process 'relisp-slave-output-filter)
  (relisp-get-constants)
  relisp-slave-process)

(defun relisp-become-slave nil
  "Convert the emacs process into a slave.  Only called by ruby."
  (setq relisp-emacs-master-p nil)
  ;; get constants
  (message "SEND CONSTANTS")
  (relisp-get-constants)
  (let (input input-line)
    (while t ;; loop is only a CL function, I guess
      (setq input "")
      (setq input-line "")
      (while (and (null (string-match relisp-question-code (relisp-strip input-line)))
		  (null (string-match relisp-command-code  (relisp-strip input-line))))
	(setq input-line (read-from-minibuffer ""))
	(setq input (concat input input-line)))
      (if (string-match relisp-question-code (relisp-strip input-line))
	  (relisp-answer-ruby input)
	(relisp-obey-ruby input)))))

(defun relisp-slave-output-filter (process output-line)
  "Listen to PROCESS and add each OUTPUT-LINE to `relisp-ruby-output'."
  (setq relisp-ruby-output (concat relisp-ruby-output output-line)))

(defun relisp-stop-slave nil
  "Kill the ruby slave process."
  (if (boundp 'relisp-slave-process)
      (delete-process relisp-slave-process)))

(defun relisp-slave-alive-p nil
  "Return t if the ruby slave is alive and well."
  (and (boundp 'relisp-slave-process) 
       (equal (process-status relisp-slave-process) 'run)
       (boundp 'relisp-question-code)
       (boundp 'relisp-error-code)))

(provide 'relisp)