branch: elpa/geiser-stklos
commit 9db60a7e751c97e30dd528e2a96ff19575b618d2
Author: Jeronimo Pellegrini <j...@aleph0.info>
Commit: Jeronimo Pellegrini <j...@aleph0.info>
General enhancements (no user-perceptible changes)
---
geiser-stklos.el | 50 +++++++++++++++++++++++++++++-----------
geiser.stk | 70 +++++++++++++++++++++++++++++++++-----------------------
2 files changed, 79 insertions(+), 41 deletions(-)
diff --git a/geiser-stklos.el b/geiser-stklos.el
index a2fe50b..cf051ed 100644
--- a/geiser-stklos.el
+++ b/geiser-stklos.el
@@ -9,7 +9,7 @@
;; Keywords: languages, stklos, scheme, geiser
;; Package-Requires: ((emacs "24.4") (geiser "0.16"))
;; SPDX-License-Identifier: BSD-3-Clause
-;; Version: 1.3
+;; Version: 1.4
;; This file is not part of GNU Emacs.
@@ -17,7 +17,7 @@
;;; Commentary:
;;
-;; Geiser, STklos and Geisr-STklos
+;; Geiser, STklos and Geiser-STklos
;; ───────────────────────────────
;;
;; Geiser (https://www.nongnu.org/geiser/) is a collection of Emacs
@@ -40,7 +40,7 @@
;; * macroexpansion
;; * symbol completion
;; * listing of module exported symbols
-;; * autodoc (signature of procedurs and values of symbols are displayed in
the minibuffer
+;; * autodoc (signature of procedures and values of symbols are displayed in
the minibuffer
;; when the mouse hovers over their names)
;; * symbol documentation (docstrings for procedures, and values of variables)
;;
@@ -127,6 +127,20 @@ option."
:type 'boolean
:group 'geiser-stklos)
+;; (geiser-custom--defcustom geiser-stklos-log-file
+;; nil
+;; "Name of the file where the STklos part of the system will log its
+;; actions."
+;; :type 'string
+;; :group 'geiser-stklos)
+
+;; (geiser-custom--defcustom geiser-emacs-log-buffer
+;; '*geiser-log*
+;; "Name of the Emacs buffer where the Emacs Lisp part of the system
+;; will log its actions."
+;; :type 'symbol
+;; :group 'geiser-stklos)
+
;;; REPL support:
@@ -167,23 +181,32 @@ This function uses `geiser-stklos-init-file' if it
exists."
"Translates symbols into Scheme procedure calls from geiser.stk.
Argument PROC is the procedure to be called.
Optional argument ARGS are the arguments to the procedure."
+ ;; Adapted from Geiser-Gauche
(cl-case proc
+ ((autodoc symbol-location completions)
+ (format "(eval '(geiser:%s %s {{cur-module}}) (find-module 'GEISER))"
+ proc (mapconcat #'identity args " ")))
+
((eval compile)
- (let ((form (mapconcat #'identity (cdr args) " "))
- (module (cond ((string-equal "'()" (car args))
- "'()")
- ((and (car args))
- (concat "'" (car args)))
- (t
- "#f"))))
+ (let ((module (if (car args) (concat "'" (car args)) "#f"))
+ (form (mapconcat #'identity (cdr args) " ")))
(format "((in-module GEISER geiser:eval) %s '%s)" module form)))
+ ;; ;; The {{cur-module}} cookie is replaced by the current module for
+ ;; ;; commands that need it
+ ;; (replace-regexp-in-string
+ ;; "{{cur-module}}"
+ ;; (if (string= module "'#f")
+ ;; (format "'%s" (geiser-stklos--get-module))
+ ;; module)
+ ;; (format "(eval '(geiser:eval %s '%s) (find-module 'GEISER))"
module form))))
((load-file compile-file)
(format "((in-module GEISER geiser:load-file) %s)" (car args)))
((no-values)
"((in-module GEISER geiser:no-values))")
+ ;; The rest of the commands are all evaluated in the geiser module
(t
(let ((form (mapconcat #'identity args " ")))
- (format "(geiser:%s %s)" proc form)))))
+ (format "((in-module GEISER geiser:%s) %s)" proc form)))))
;;; Modules
@@ -295,7 +318,7 @@ if a closing match is not found."
;; This will possibly fail:
;;
;; - with false negative, if the buffer is running STklos
-;; but th euser is in not in the stklos module, AND
+;; but the user is in not in the stklos module, AND
;; the user was not in the stklos module recently, so
;; there are no "stklos" strings in the buffer.
;;
@@ -336,7 +359,8 @@ Argument BINARY is a string containing the binary name."
(defun geiser-stklos--startup (_remote)
"Hook for startup. The argument is ignored."
(let ((geiser-log-verbose-p t))
- (compilation-setup t)))
+ (compilation-setup t)
+ (geiser:eval "GEISER" geiser:set-log-file geiser-stklos-log-file)))
(defconst geiser-stklos-builtin-keywords
diff --git a/geiser.stk b/geiser.stk
index 549d962..84b6add 100644
--- a/geiser.stk
+++ b/geiser.stk
@@ -21,7 +21,21 @@
geiser:module-exports
geiser:symbol-documentation
geiser:autodoc
- geiser:no-values)
+ geiser:no-values
+ geiser:set-log-file)
+
+
+(define geiser-log-file #f)
+
+;; Opens the Geiser log file
+(define (geiser:set-log-file name)
+ (when (string? name)
+ (set! geiser-log-file (open-output-file name))))
+
+(define (geiser-format port . rest)
+ (when (output-port? port)
+ (apply format (cons port rest))
+ (flush-output-port port)))
;; executes thunk, with all its output (standar and error) redirected
;; to a string.
@@ -50,8 +64,8 @@
;; => ((result "1" "2" "3") (output . "OK"))
;;
(define (call-with-result thunk)
- (let* ((result (if #f #f))
- (output (if #f #f)))
+ (let* ((result #void)
+ (output #void))
(set! output
(with-handler (lambda (exn)
@@ -65,40 +79,40 @@
(cond
((list? result)
(map (lambda (v) (with-all-output-to-string (lambda () (write
v)))) result))
- ((eq? result (if #f #t))
- ;; '())
- (list output))
- (else
- (list (with-all-output-to-string (lambda () (write result)))))))
+ ((eq? result #void)
+ (list output))
+ (else
+ (list (with-all-output-to-string (lambda () (write result)))))))
(let ((out-form
`((result ,@result)
(output . ,output))))
(write out-form)
- (write-to-log '[[RESPONSE]])
- (write-to-log out-form))
+ (geiser-format geiser-log-file "call-with-result response: ~s~%"
out-form))
(newline)))
-;; to log forms, uncomment the following line and the
-;; lines that were commented out in the write-to-log
-;; procedure below:
-;; (define log (open-output-file "geiser-log.txt"))
-
-(define (write-to-log form)
-;; (write form log)
-;; (newline log)
- (values))
;; evaluates form inside a module.
;; the result is in the same format as call-with-result.
;;
-;; Example:
+;; Examples:
+;;
;; (geiser:eval #f '(begin (display "OK") (values 1 2 3)))
;; => ((result "1" "2" "3") (output . "OK"))
;;
+;;
+;; (define-module a
+;; (export b)
+;; (define b -2))
+;;
+;; (geiser:eval 'a 'b)
+;; => ((result "-2") (output . ""))
+;;
(define (geiser:eval module-name form . rest)
-
+ (geiser-format geiser-log-file "_________________~%")
+ (geiser-format geiser-log-file "geiser:eval form: ~s~%" form)
+
;; All calls start at toplevel
(let ((module (or (and (symbol? module-name )
(find-module module-name))
@@ -108,12 +122,13 @@
(else
(write `((error (key . ,(error-object-message err)))))))
(lambda () (eval form module)))))
-
- (write-to-log form)
- (call-with-result thunk))))
+ (let ((ret (call-with-result thunk)))
+ (geiser-format geiser-log-file "geiser:eval return: ~s~%" ret)
+ ret))))
-;; Load a file
+;; Load a file in STklos
+;;
(define (geiser:load-file file)
(let* ((file (if (symbol? file) (symbol->string file) file))
(found-file (geiser-find-file file)))
@@ -132,8 +147,6 @@
(define (geiser:macroexpand form . rest)
(format "~S" (macro-expand form)))
-
-
;; do not use string-index, because the native STklos version
;; is different from that in SRFI-13, and we can't tell in advance
;; what's the correct way to call it...
@@ -145,6 +158,7 @@
(string-ref name i)))
(name-match-with-start? prefix name (+ 1 i)))
(else #f)))
+
(define (name-match? prefix name) (name-match-with-start? prefix name 0))
;; Geiser calls this procedure when it wants to complete
@@ -298,7 +312,7 @@
;; nullify-last-cdr! turns improper lists into proper lists by removing
;; the last element and putting '() in its place.
;;
-;; *** The lists MUST BE MUTABLE! (hence the user of
+;; *** The lists MUST BE MUTABLE! (hence the use of
;; "list-copy" in the examples below ***
;;
;; (define a (list-copy '(1 2 . 3)))
