diff options
| -rw-r--r-- | elisp/geiser-gambit.el | 39 | ||||
| -rw-r--r-- | 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))) |