[nongnu] elpa/geiser-gambit 372aab5 04/34: marshall eval and load-file

[Philip Kaludercic]

branch: elpa/geiser-gambit
commit 372aab50dd2ccf5799382fab3450e9043eb4de90
Author: mathieu2em <math.per@hotmail.com>
Commit: mathieu2em <math.per@hotmail.com>

    marshall eval and load-file
---
 elisp/geiser-gambit.el          | 39 ++++++++++----------------
 scheme/gambit/geiser/gambit.scm | 61 ++++++++++++++++++++++++-----------------
 2 files changed, 50 insertions(+), 50 deletions(-)

diff --git a/elisp/geiser-gambit.el b/elisp/geiser-gambit.el
index 3287182..178d2be 100644
--- a/elisp/geiser-gambit.el
+++ b/elisp/geiser-gambit.el
@@ -32,7 +32,7 @@
 (eval-when-compile (require 'cl))
 
 (defconst geiser-gambit-builtin-keywords
-  '("##debug-repl"))
+  '("##debug-repl" "##import"))
 
 ;;; Customization
 
@@ -124,20 +124,9 @@ If `t', Geiser will use `next-error' to jump to the 
error's location."
 
 ;;; Evaluation support:
 (defun geiser-gambit--geiser-procedure (proc &rest args)
-  (let ((fmt
-         (case proc
-           ((eval compile)
-            (let ((form (mapconcat 'identity (cdr args) " ")))
-              (format ",geiser-eval %s %s" (or (car args) "#f") form)))
-           ((load-file compile-file)
-            (format ",geiser-load-file %s" (car args)))
-           ((no-values)
-            ",geiser-no-values")
-           (t
-            (let ((form (mapconcat 'identity args " ")))
-              (format "(geiser-%s %s)" proc form))))))
-    ;;(message fmt)
-    fmt))
+  (case proc
+    ((eval compile)
+     (let* ((form (mapconcat 
 
 (defconst geiser-gambit--module-re
   "( *module +\\(([^)]+)\\|[^ ]+\\)\\|( *define-library +\\(([^)]+)\\|[^ 
]+\\)")
@@ -299,15 +288,15 @@ If `t', Geiser will use `next-error' to jump to the 
error's location."
   (interactive)
   (geiser-connect 'gambit))
 
-;;(defun geiser-gambit--startup (remote)
-;;  (compilation-setup t)
-;;  (let ((geiser-log-verbose-p t)
-;;        (geiser-gambit-load-file (expand-file-name 
"gambit/geiser/gambit.scm" geiser-scheme-dir)))
-;;    (if geiser-gambit-compile-geiser-p
-;;      (geiser-eval--send/wait (format "(use utils)(compile-file 
\"%s\")(import geiser)"
-;;                                      geiser-gambit-load-file))
-;;      (geiser-eval--send/wait (format "(load \"%s\")"
-;;                                      geiser-gambit-load-file)))))
+(defun geiser-gambit--startup (remote)
+  (compilation-setup t)
+  (let ((geiser-log-verbose-p t)
+        (geiser-gambit-load-file (expand-file-name "gambit/geiser/gambit.scm" 
geiser-scheme-dir)))
+    (if geiser-gambit-compile-geiser-p
+      (geiser-eval--send/wait (format "(use utils)(compile-file \"%s\")(import 
geiser)"
+                                      geiser-gambit-load-file))
+      (geiser-eval--send/wait (format "(load \"%s\")"
+                                      geiser-gambit-load-file)))))
 
 ;;; Implementation definition:
 
@@ -317,7 +306,7 @@ If `t', Geiser will use `next-error' to jump to the error's 
location."
   (arglist geiser-gambit--parameters)
   (version-command geiser-gambit--version)
   (minimum-version geiser-gambit-minimum-version)
-;;  (repl-startup geiser-gambit--startup)
+  (repl-startup geiser-gambit--startup)
   (prompt-regexp geiser-gambit--prompt-regexp)
   (debugger-prompt-regexp geiser-gambit--debugger-prompt-regexp)
   (enter-debugger geiser-gambit--enter-debugger)
diff --git a/scheme/gambit/geiser/gambit.scm b/scheme/gambit/geiser/gambit.scm
index b63faa7..a33f7cc 100644
--- a/scheme/gambit/geiser/gambit.scm
+++ b/scheme/gambit/geiser/gambit.scm
@@ -1,12 +1,23 @@
 ;;;gambit.scm gambit geiser interaction
 
-(define (geiser-load-file file)
-  (let* ((file (if (symbol? file) (symbol->string file) file))
-         (found-file (geiser-find-file file)))
-    (call-with-result
-     (lambda ()
-       (when found-file
-         (load found-file))))))
+(define-macro (geiser:capture-output x . xs)
+  (let ((out (gensym))
+        (result (gensym)))
+    `(let* ((,out (open-output-string))
+            (,result (parameterize ((current-output-port ,out))
+                       ,(cons 'begin (cons x xs)))))
+       (write `((result ,(object->string ,result))
+                (out  ,(get-output-string ,out))))
+       (newline))))
+
+(define (geiser:load-file filename)
+  (geiser:capture-output (load filename)))
+
+(define (geiser:eval2 module form) ;; module is not yet supported in gambit
+  (geiser:capture-output (eval form)))
+
+(define-macro (geiser:eval module form . rest)
+  `(geiser:eval2 ,module ,(quote form)))
 
 (define (geiser:newline)
   (newline))
@@ -16,21 +27,21 @@
 
 ;; Spawn a server for remote repl access TODO make it works with remote repl
 
-(define (geiser-start-server . rest)
-  (let* ((listener (tcp-listen 0))
-         (port (tcp-listener-port listener)))
-    (define (remote-repl)
-        (receive (in out) (tcp-accept listener)
-          (current-input-port in)
-          (current-output-port out)
-          (current-error-port out)
-          
-          (repl)))
-    
-    (thread-start! (make-thread remote-repl))
-    
-    (write-to-log `(geiser-start-server . ,rest))
-    (write-to-log `(port ,port))
-
-    (write `(port ,port))
-    (newline)))
+;;(define (geiser-start-server . rest)
+;;  (let* ((listener (tcp-listen 0))
+;;         (port (tcp-listener-port listener)))
+;;    (define (remote-repl)
+;;        (receive (in out) (tcp-accept listener)
+;;          (current-input-port in)
+;;          (current-output-port out)
+;;          (current-error-port out)
+;;          
+;;          (repl)))
+;;    
+;;    (thread-start! (make-thread remote-repl))
+;;    
+;;    (write-to-log `(geiser-start-server . ,rest))
+;;    (write-to-log `(port ,port))
+;; 
+;;    (write `(port ,port))
+;;    (newline)))