From 7fe12503929dd8557a6daee1ad33d91ceef9293b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 30 Oct 2010 22:46:12 +0200 Subject: Guile: using meta-commands to talk with Guile --- elisp/geiser-guile.el | 31 +++++++++++++++--------- scheme/guile/geiser/emacs.scm | 48 +++++++++++++++++--------------------- scheme/guile/geiser/evaluation.scm | 17 +++++++++----- 3 files changed, 52 insertions(+), 44 deletions(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 3e1c03f..e07fb1b 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -113,17 +113,25 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Evaluation support: +(defun geiser-guile--linearize (str) + (if (string-match "\n" str) + (with-temp-buffer + (insert str) + (subst-char-in-region (point-min) (point-max) ?\n ? t) + (buffer-string)) + str)) + +(defsubst geiser-guile--linearize-args (args) + (mapconcat 'geiser-guile--linearize 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" + (or (car args) "#f") + (geiser-guile--linearize-args (cdr 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 +\\(([^)]+)\\)") @@ -247,9 +255,10 @@ it spawn a server thread." (font-lock-add-keywords nil `((,geiser-guile--path-rx 1 compilation-error-face))) - (geiser-eval--send/result - `(:scm ,(format "(set! %%load-path (cons %S %%load-path))" - (expand-file-name "guile/" geiser-scheme-dir)))) + (geiser-eval--send/wait + (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..c3696f8 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -10,37 +10,31 @@ ;; 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 (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) + "geiser-eval +Meta-command used by Geiser to evaluate and compile code." + (display form) (newline) + (if (null? args) + (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." + (ge:compile-file file)) 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 () -- cgit v1.2.3 From 1edb6056df59a119296916a0d4a14b9887e4baa5 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 30 Oct 2010 22:51:45 +0200 Subject: Guile: recognizing R6RS libraries as modules --- elisp/geiser-guile.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index e07fb1b..51de947 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -134,7 +134,7 @@ This function uses `geiser-guile-init-file' if it exists." (t (format "ge:%s %s" proc (geiser-guile--linearize-args args))))) (defconst geiser-guile--module-re - "(define-module +\\(([^)]+)\\)") + "(\\(?:define-module\\|library\\) +\\(([^)]+)\\)") (defun geiser-guile--get-module (&optional module) (cond ((null module) -- cgit v1.2.3 From 35e1b306eb7df8449d05d07596c62281bcee7736 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 30 Oct 2010 23:48:18 +0200 Subject: Guile: really support R6RS libs --- elisp/geiser-guile.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 51de947..c406d88 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -134,7 +134,10 @@ This function uses `geiser-guile-init-file' if it exists." (t (format "ge:%s %s" proc (geiser-guile--linearize-args args))))) (defconst geiser-guile--module-re - "(\\(?:define-module\\|library\\) +\\(([^)]+)\\)") + "(define-module +\\(([^)]+)\\)") + +(defconst geiser-guile--library-re + "(library +\\(([^)]+)\\)") (defun geiser-guile--get-module (&optional module) (cond ((null module) @@ -142,7 +145,8 @@ This function uses `geiser-guile-init-file' if it exists." (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) -- cgit v1.2.3 From 32592d3fd04db3a9facd9061d20c6ff7da2ce8f8 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sat, 30 Oct 2010 23:49:06 +0200 Subject: Guile: debug leftover deleted --- scheme/guile/geiser/emacs.scm | 1 - 1 file changed, 1 deletion(-) diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index c3696f8..ba6b100 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -28,7 +28,6 @@ No-op command used internally by Geiser." (define-meta-command ((geiser-eval geiser) repl mod form . args) "geiser-eval Meta-command used by Geiser to evaluate and compile code." - (display form) (newline) (if (null? args) (ge:compile form mod) (let ((proc (eval form this-module))) -- cgit v1.2.3 From e0dca7b01b40b3548f03298a16dee252f310a567 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 31 Oct 2010 01:46:29 +0200 Subject: Guile: reactivating the debugger during evaluation --- elisp/geiser-guile.el | 2 +- scheme/guile/geiser/emacs.scm | 12 ++++++++++-- 2 files changed, 11 insertions(+), 3 deletions(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index c406d88..8f8d7af 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -185,7 +185,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 diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index ba6b100..73c02d0 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -12,6 +12,7 @@ (define-module (geiser emacs) #: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:)) @@ -29,11 +30,18 @@ No-op command used internally by Geiser." "geiser-eval Meta-command used by Geiser to evaluate and compile code." (if (null? args) - (ge:compile form mod) + (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." - (ge:compile-file file)) + (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)) -- cgit v1.2.3 From 41c403b1b18bbf8b780dbf06f9445a43b602803b Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 31 Oct 2010 02:04:40 +0100 Subject: Fix for geiser-edit-module --- elisp/geiser-edit.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-edit.el b/elisp/geiser-edit.el index cebcb47..e8e439c 100644 --- a/elisp/geiser-edit.el +++ b/elisp/geiser-edit.el @@ -218,7 +218,7 @@ With prefix, asks for the symbol to edit." (defun geiser-edit-module (module &optional method) "Asks for a module and opens it in a new buffer." (interactive (list (geiser-completion--read-module))) - (let ((cmd `(:eval (:ge module-location (:module ,module))))) + (let ((cmd `(:eval (:ge module-location '(:module ,module))))) (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method))) -- cgit v1.2.3 From 52f219c47fc5aa1831735823530c83bb34056aef Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 31 Oct 2010 02:34:30 +0100 Subject: Autodoc: fix for improper macro arglists scanning --- scheme/guile/geiser/doc.scm | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/scheme/guile/geiser/doc.scm b/scheme/guile/geiser/doc.scm index 4722238..f5471b5 100644 --- a/scheme/guile/geiser/doc.scm +++ b/scheme/guile/geiser/doc.scm @@ -87,12 +87,14 @@ (else #f)))) (define (macro-args tf) + (define* (collect args #:optional (req '())) + (cond ((null? args) (arglist->args `(,(reverse req) #f #f r #f))) + ((symbol? args) (arglist->args `(,(reverse req) #f #f r ,args))) + ((and (pair? args) (symbol? (car args))) + (collect (cdr args) (cons (car args) req))) + (else #f))) (let* ((pats (procedure-property tf 'patterns)) - (args (and pats (filter identity - (map (lambda (p) - (and (every symbol? p) - (list (cons 'required p)))) - pats))))) + (args (and pats (filter-map collect pats)))) (or (and args (not (null? args)) args) default-macro-args))) (define (arity->args art) -- cgit v1.2.3 From 449a5c9a05feed4f743d98172f78b250c6258d7a Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Sun, 31 Oct 2010 02:42:04 +0100 Subject: Fix for geiser-doc-module --- elisp/geiser-doc.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/elisp/geiser-doc.el b/elisp/geiser-doc.el index 3096a3d..7d42ce5 100644 --- a/elisp/geiser-doc.el +++ b/elisp/geiser-doc.el @@ -225,7 +225,7 @@ help (e.g. browse an HTML page) implementing this method.") (defun geiser-doc--get-module-exports (module) (geiser-eval--send/result - `(:eval (:ge module-exports (:module ,module))))) + `(:eval (:ge module-exports '(:module ,module))))) (defun geiser-doc-symbol (symbol &optional module impl) (let ((module (or module (geiser-eval--get-module))) -- cgit v1.2.3 From 83b1e75799d56b33dbbcb56b3bc5f8741e3f4cd4 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 1 Nov 2010 00:03:31 +0100 Subject: Guile: suppress embedded comments when sending multi-line sexps --- elisp/geiser-guile.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 8f8d7af..3f8aa4b 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -116,7 +116,14 @@ This function uses `geiser-guile-init-file' if it exists." (defun geiser-guile--linearize (str) (if (string-match "\n" str) (with-temp-buffer + (set-syntax-table scheme-mode-syntax-table) (insert str) + (goto-char (point-min)) + (let ((kill-whole-line nil)) + (while (> (skip-syntax-forward "^<") 0) + (let ((p (point))) + (end-of-line) + (kill-region p (point))))) (subst-char-in-region (point-min) (point-max) ?\n ? t) (buffer-string)) str)) -- cgit v1.2.3 From 375e6549f8662d1316b24a8211d0507430f941c5 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 1 Nov 2010 00:19:23 +0100 Subject: Guile: shorten a bit more multi-line sexps sent to REPL --- elisp/geiser-guile.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 3f8aa4b..363c061 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -124,7 +124,9 @@ This function uses `geiser-guile-init-file' if it exists." (let ((p (point))) (end-of-line) (kill-region p (point))))) - (subst-char-in-region (point-min) (point-max) ?\n ? t) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r][ \t\n\r]+" nil t) + (replace-match " " nil nil)) (buffer-string)) str)) -- cgit v1.2.3 From e3edc4db496c012da1cf4d406b94bd752ea79622 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 1 Nov 2010 00:43:10 +0100 Subject: Guile: fix for the argument shortening algorithm --- elisp/geiser-guile.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index 363c061..f0d090d 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -125,8 +125,8 @@ This function uses `geiser-guile-init-file' if it exists." (end-of-line) (kill-region p (point))))) (goto-char (point-min)) - (while (re-search-forward "[ \t\n\r][ \t\n\r]+" nil t) - (replace-match " " nil nil)) + (while (search-forward-regexp "\n[ \t\r\n]*" nil t) + (replace-match " ")) (buffer-string)) str)) -- cgit v1.2.3 From ea42746970657bc05b31c462a01df21d079e4a9e Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 1 Nov 2010 01:45:58 +0100 Subject: Guile: better meta-command args handling --- elisp/geiser-guile.el | 26 +++++--------------------- scheme/guile/geiser/emacs.scm | 2 +- 2 files changed, 6 insertions(+), 22 deletions(-) diff --git a/elisp/geiser-guile.el b/elisp/geiser-guile.el index f0d090d..93d1237 100644 --- a/elisp/geiser-guile.el +++ b/elisp/geiser-guile.el @@ -113,34 +113,18 @@ This function uses `geiser-guile-init-file' if it exists." ;;; Evaluation support: -(defun geiser-guile--linearize (str) - (if (string-match "\n" str) - (with-temp-buffer - (set-syntax-table scheme-mode-syntax-table) - (insert str) - (goto-char (point-min)) - (let ((kill-whole-line nil)) - (while (> (skip-syntax-forward "^<") 0) - (let ((p (point))) - (end-of-line) - (kill-region p (point))))) - (goto-char (point-min)) - (while (search-forward-regexp "\n[ \t\r\n]*" nil t) - (replace-match " ")) - (buffer-string)) - str)) - (defsubst geiser-guile--linearize-args (args) - (mapconcat 'geiser-guile--linearize args " ")) + (mapconcat 'identity args " ")) (defun geiser-guile--geiser-procedure (proc &rest args) (case proc - ((eval compile) (format ",geiser-eval %s %s" + ((eval compile) (format ",geiser-eval %s %s%s" (or (car args) "#f") - (geiser-guile--linearize-args (cdr args)))) + (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))))) + (t (format "ge:%s (%s)" proc (geiser-guile--linearize-args args))))) (defconst geiser-guile--module-re "(define-module +\\(([^)]+)\\)") diff --git a/scheme/guile/geiser/emacs.scm b/scheme/guile/geiser/emacs.scm index 73c02d0..54e5d34 100644 --- a/scheme/guile/geiser/emacs.scm +++ b/scheme/guile/geiser/emacs.scm @@ -26,7 +26,7 @@ No-op command used internally by Geiser." (values)) -(define-meta-command ((geiser-eval geiser) repl mod form . args) +(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) -- cgit v1.2.3 From d830e14a4010284b4085d9942bfd856b0360d793 Mon Sep 17 00:00:00 2001 From: Jose Antonio Ortega Ruiz Date: Mon, 1 Nov 2010 05:16:55 +0100 Subject: Better error message for edit-symbol-at-point --- elisp/geiser-edit.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 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." -- cgit v1.2.3