diff options
| -rw-r--r-- | elisp/geiser-edit.el | 6 | ||||
| -rw-r--r-- | elisp/geiser-guile.el | 30 | ||||
| -rw-r--r-- | scheme/guile/geiser/emacs.scm | 55 | ||||
| -rw-r--r-- | scheme/guile/geiser/evaluation.scm | 17 |
4 files changed, 61 insertions, 47 deletions
diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index 4d61edc..8c34c28 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -205,10 +205,12 @@ With prefix, asks for the symbol to edit." (geiser-completion--read-symbol "Edit symbol: "))) (cmd `(:eval (:ge symbol-location ',symbol))) (marker (point-marker))) - (condition-case nil + (condition-case err (progn (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd)) (when marker (ring-insert find-tag-marker-ring marker))) - (error (geiser-edit-module-at-point))))) + (error (condition-case nil + (geiser-edit-module-at-point) + (error (error (error-message-string err)))))))) (defun geiser-pop-symbol-stack () "Pop back to where \\[geiser-edit-symbol-at-point] was last invoked." diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 1c39f14..f410674 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -113,28 +113,33 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Evaluation support: +(defsubst geiser-guile--linearize-args (args) + (mapconcat 'identity args " ")) (defun geiser-guile--geiser-procedure (proc &rest args) (case proc - ((eval compile) (format "((@ (geiser emacs) ge:compile) '%s '%s)" - (mapconcat 'identity (cdr args) " ") - (or (car args) "#f"))) - ((load-file compile-file) - (format "((@ (geiser emacs) ge:%s) %s)" proc (car args))) - ((no-values) "((@ (guile) values))") - (t (format "(apply (@ (geiser emacs) ge:%s) (list %s))" - proc (mapconcat 'identity args ""))))) + ((eval compile) (format ",geiser-eval %s %s%s" + (or (car args) "#f") + (geiser-guile--linearize-args (cdr args)) + (if (cddr args) "" " ()"))) + ((load-file compile-file) (format ",geiser-load-file %s" (car args))) + ((no-values) ",geiser-no-values") + (t (format "ge:%s (%s)" proc (geiser-guile--linearize-args args))))) (defconst geiser-guile--module-re "(define-module +\\(([^)]+)\\)") +(defconst geiser-guile--library-re + "(library +\\(([^)]+)\\)") + (defun geiser-guile--get-module (&optional module) (cond ((null module) (save-excursion (ignore-errors (while (not (zerop (geiser-syntax--nesting-level))) (backward-up-list))) - (if (re-search-backward geiser-guile--module-re nil t) + (if (or (re-search-backward geiser-guile--module-re nil t) + (looking-at geiser-guile--library-re)) (geiser-guile--get-module (match-string-no-properties 1)) :f))) ((listp module) module) @@ -174,7 +179,7 @@ This function uses `geiser-guile-init-file' if it exists." (if geiser-guile-debug-show-bt-p "bt" "fr")))) (compilation-forget-errors) (goto-char (point-max)) - (comint-send-string nil "((@ (geiser emacs) ge:newline))\n") + (comint-send-string nil ",geiser-newline\n") (comint-send-string nil ",error-message\n") (comint-send-string nil bt-cmd) (when geiser-guile-show-debug-help-p @@ -253,8 +258,9 @@ it spawn a server thread." `((,geiser-guile--path-rx 1 compilation-error-face))) (geiser-eval--send/wait - `(:scm ,(format "(set! %%load-path (cons %S %%load-path))" - (expand-file-name "guile/" geiser-scheme-dir)))) + (format "(set! %%load-path (cons %S %%load-path))" + (expand-file-name "guile/" geiser-scheme-dir))) + (geiser-eval--send/wait ",use (geiser emacs)") (geiser-guile-update-warning-level)) diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index af1a052..54e5d34 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -10,37 +10,38 @@ ;; Start date: Sun Feb 08, 2009 18:39 (define-module (geiser emacs) - #:re-export (ge:macroexpand - ge:compile-file - ge:load-file - ge:autodoc - ge:completions - ge:module-completions - ge:symbol-location - ge:generic-methods - ge:symbol-documentation - ge:module-exports - ge:module-location - ge:callers - ge:callees - ge:find-file) - #:export (ge:compile - ge:no-values - ge:newline) #:use-module (ice-9 match) + #:use-module (system repl command) + #:use-module (system repl error-handling) #:use-module (geiser evaluation) #:use-module ((geiser modules) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser completion) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser xref) :renamer (symbol-prefix-proc 'ge:)) #:use-module ((geiser doc) :renamer (symbol-prefix-proc 'ge:))) -(define (ge:no-values) (values)) -(define ge:newline newline) - -(define (ge:compile form mod) - (match form - (`((@ (geiser emacs) . ,_) . ,_) (compile/no-warns form mod)) - (_ (compile/warns form mod)))) - - -;;; emacs.scm ends here +(define this-module (resolve-module '(geiser emacs))) + +(define-meta-command ((geiser-no-values geiser) repl) + "geiser-no-values +No-op command used internally by Geiser." + (values)) + +(define-meta-command ((geiser-eval geiser) repl (mod form args) . rest) + "geiser-eval +Meta-command used by Geiser to evaluate and compile code." + (if (null? args) + (call-with-error-handling + (lambda () (ge:compile form mod))) + (let ((proc (eval form this-module))) + (ge:eval `(,proc ,@args) mod)))) + +(define-meta-command ((geiser-load-file geiser) repl file) + "geiser-load-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)) diff --git a/scheme/guile/geiser/evaluation.scm b/scheme/guile/geiser/evaluation.scm index 1cc21a7..ef082db 100644 --- a/scheme/guile/geiser/evaluation.scm +++ b/scheme/guile/geiser/evaluation.scm @@ -10,8 +10,8 @@ ;; Start date: Mon Mar 02, 2009 02:46 (define-module (geiser evaluation) - #:export (compile/warns - compile/no-warns + #:export (ge:compile + ge:eval ge:macroexpand ge:compile-file ge:load-file @@ -71,10 +71,7 @@ (set! result (thunk))))))) (write-result result output))) -(define (compile/no-warns form module) - (compile* form module '())) - -(define (compile/warns form module) +(define (ge:compile form module) (compile* form module compile-opts)) (define (compile* form module-name opts) @@ -92,6 +89,14 @@ (lambda vs (map object->string vs)))))) (call-with-result ev))) +(define (ge:eval form module-name) + (let* ((module (or (find-module module-name) (current-module))) + (ev (lambda () + (call-with-values + (lambda () (eval form module)) + (lambda vs (map object->string vs)))))) + (call-with-result ev))) + (define (ge:compile-file path) (call-with-result (lambda () |