summaryrefslogtreecommitdiff
path: root/elisp/geiser-eval.el
diff options
context:
space:
mode:
authorJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-08 01:09:07 +0100
committerJose Antonio Ortega Ruiz <jao@gnu.org>2009-02-08 01:09:07 +0100
commit377d6d19debce5572052727323931f1b8306226b (patch)
tree1db58005a4fb2ee285ef6688fa40ca98da5578fd /elisp/geiser-eval.el
parent9b4016cd9bce8354ac3eede20345e83db8c65b94 (diff)
downloadgeiser-chez-377d6d19debce5572052727323931f1b8306226b.tar.gz
geiser-chez-377d6d19debce5572052727323931f1b8306226b.tar.bz2
Basic Guile/Emacs connection and evaluation working.
Diffstat (limited to 'elisp/geiser-eval.el')
-rw-r--r--elisp/geiser-eval.el112
1 files changed, 112 insertions, 0 deletions
diff --git a/elisp/geiser-eval.el b/elisp/geiser-eval.el
new file mode 100644
index 0000000..74c9b29
--- /dev/null
+++ b/elisp/geiser-eval.el
@@ -0,0 +1,112 @@
+;; geiser-eval.el -- sending scheme code for evaluation
+
+;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Start date: Sat Feb 07, 2009 22:35
+
+;; This file 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 3 of the License, or
+;; (at your option) any later version.
+
+;; This file 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, see <http://www.gnu.org/licenses/>.
+
+;;; Comentary:
+
+;; Functions, building on top of geiser-connection, to evaluate scheme
+;; code.
+
+;;; Code:
+
+(require 'geiser-connection)
+(require 'geiser-log)
+(require 'geiser-base)
+
+
+;;; Code formatting:
+
+(defun geiser-eval--scheme-str (code)
+ (cond ((null code) "'()")
+ ((eq code :f) "#f")
+ ((eq code :t) "#t")
+ ((listp code)
+ (cond ((eq (car code) :gs) (concat "((@ (geiser eval) eval-in) (quote "
+ (geiser-eval--scheme-str (nth 1 code))
+ ") "
+ (or (nth 2 code)
+ (geiser-eval--buffer-module))
+ ")"))
+ ((eq (car code) :scm) (cadr code))
+ (t (concat "(" (mapconcat 'geiser-eval--scheme-str code " ") ")"))))
+ (t (format "%S" code))))
+
+
+;;; Current module:
+
+(defun geiser-eval--buffer-module (&optional buffer)
+ (let ((buffer (or buffer (current-buffer))))
+ (with-current-buffer buffer
+ (save-excursion
+ (goto-char (point-min))
+ (if (re-search-forward "(define-module +\\(([^)]+)\\)" nil t)
+ (match-string-no-properties 1)
+ "#f")))))
+
+
+;;; Code sending:
+
+(defvar geiser-eval--default-proc-function nil)
+
+(defsubst geiser-eval--default-proc ()
+ (and geiser-eval--default-proc-function
+ (funcall geiser-eval--default-proc-function)))
+
+(defvar geiser-eval--proc nil)
+
+(defsubst geiser-eval--proc ()
+ (or geiser-eval--proc (geiser-eval--default-proc)))
+
+(defsubst geiser-eval--log (s)
+ (geiser-log--info "RETORT: %S" s)
+ s)
+
+(defsubst geiser-eval--code-str (code)
+ (if (stringp code) code (geiser-eval--scheme-str code)))
+
+(defvar geiser-eval--sync-retort nil)
+(defun geiser-eval--set-sync-retort (s)
+ (setq geiser-eval--sync-retort (geiser-eval--log s)))
+
+(defun geiser-eval--send/wait (code &optional timeout buffer)
+ (setq geiser-eval--sync-retort nil)
+ (geiser-con--send-string/wait (geiser-eval--proc)
+ (geiser-eval--code-str code)
+ 'geiser-eval--set-sync-retort
+ timeout
+ buffer)
+ geiser-eval--sync-retort)
+
+(defsubst geiser-eval--send (code cont &optional buffer)
+ (geiser-con--send-string (geiser-eval--proc)
+ (geiser-eval--code-str code)
+ `(lambda (s) (,cont (geiser-eval--log s)))
+ buffer))
+
+
+;;; Retort parsing:
+
+(defsubst geiser-eval--retort-p (ret)
+ (and (listp ret) (or (assoc 'error ret) (assoc 'result ret))))
+(defsubst geiser-eval--retort-error (ret) (cdr (assoc 'error ret)))
+(defsubst geiser-eval--retort-result (ret) (cdr (assoc 'result ret)))
+
+
+(provide 'geiser-eval)
+;;; geiser-eval.el ends here