diff options
| -rw-r--r-- | geiser/emacs.scm | 23 | ||||
| -rw-r--r-- | geiser/evaluation.scm | 18 |
2 files changed, 21 insertions, 20 deletions
diff --git a/geiser/emacs.scm b/geiser/emacs.scm index 54e5d34..9e3d410 100644 --- a/geiser/emacs.scm +++ b/geiser/emacs.scm @@ -13,6 +13,7 @@ #:use-module (ice-9 match) #:use-module (system repl command) #:use-module (system repl error-handling) + #:use-module (system repl server) #:use-module (geiser evaluation) #:use-module ((geiser modules) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser completion) :renamer (symbol-prefix-proc 'ge:)) @@ -26,8 +27,13 @@ No-op command used internally by Geiser." (values)) +(define-meta-command ((geiser-newline geiser) repl) + "geiser-newline +Meta-command used by Geiser to emit a new line." + (newline)) + (define-meta-command ((geiser-eval geiser) repl (mod form args) . rest) - "geiser-eval + "geiser-eval module form args () Meta-command used by Geiser to evaluate and compile code." (if (null? args) (call-with-error-handling @@ -36,12 +42,17 @@ Meta-command used by Geiser to evaluate and compile code." (ge:eval `(,proc ,@args) mod)))) (define-meta-command ((geiser-load-file geiser) repl file) - "geiser-load-file + "geiser-load-file file Meta-command used by Geiser to load and compile files." (call-with-error-handling (lambda () (ge:compile-file file)))) -(define-meta-command ((geiser-newline geiser) repl) - "geiser-newline -Meta-command used by Geiser to emit a new line." - (newline)) + +(define-meta-command ((geiser-start-server geiser) repl) + "geiser-start-server +Meta-command used by Geiser to start a REPL server." + (let* ((sock (make-tcp-server-socket #:port 0)) + (port (sockaddr:port (getsockname sock)))) + (spawn-server sock) + (write (list 'port port)) + (newline))) diff --git a/geiser/evaluation.scm b/geiser/evaluation.scm index ef082db..305ccfd 100644 --- a/geiser/evaluation.scm +++ b/geiser/evaluation.scm @@ -25,20 +25,6 @@ #:use-module (system vm program) #:use-module (ice-9 pretty-print)) -(define (handle-error stack . args) - (pmatch args - ((,key ,subr ,msg ,args . ,rest) - (display "Backtrace:\n") - (if (stack? stack) - (display-backtrace stack (current-output-port))) - (newline) - (display-error stack (current-output-port) subr msg args rest)) - (else (display (format "ERROR: ~a, args: ~a" (car args) (cdr args))))) - `(error (key . ,(car args)))) - -(define (write-result result output) - (write (list (cons 'result result) (cons 'output output))) - (newline)) (define compile-opts '()) (define compile-file-opts '()) @@ -62,6 +48,10 @@ (ge:set-warnings 'none) +(define (write-result result output) + (write (list (cons 'result result) (cons 'output output))) + (newline)) + (define (call-with-result thunk) (letrec* ((result #f) (output |