From 6c53a61becc8c308ca798aab2fc85ab9d2ad906a Mon Sep 17 00:00:00 2001
From: jao <jao@gnu.org>
Date: Sat, 15 Oct 2022 05:42:34 +0100
Subject: module (i.e., library) awareness

---
 geiser-chez.el       | 11 ++++++-----
 src/geiser/geiser.ss | 49 ++++++++++++++++++++++++++++---------------------
 2 files changed, 34 insertions(+), 26 deletions(-)

diff --git a/geiser-chez.el b/geiser-chez.el
index 7443461..900767b 100644
--- a/geiser-chez.el
+++ b/geiser-chez.el
@@ -136,11 +136,13 @@ Return its local name."
 (defun geiser-chez--geiser-procedure (proc &rest args)
   "Transform PROC in string for a scheme procedure using ARGS."
   (cl-case proc
-    ((eval compile) (format "(geiser:eval '%s '%s)" (car args) (cadr args)))
+    ((eval compile)
+     (if (listp (cadr args))
+         (format "(geiser:ge:eval '%s '%s)" (car args) (cadr args))
+       (format "(geiser:eval '%s '%s)" (car args) (cadr args))))
     ((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)))))
+    (t (list (format "geiser:%s" proc) (mapconcat 'identity args " ")))))
 
 (defun geiser-chez--current-library ()
   "Find current library."
@@ -151,8 +153,7 @@ Return its local name."
 
 (defun geiser-chez--get-module (&optional module)
   "Find current module (libraries for Chez), or normalize MODULE."
-  (cond ((null module) :f)
-        ;; ((null module) (or (geiser-chez--current-library) :f))
+  (cond ((null module) (or (geiser-chez--current-library) :f))
         ((listp module) module)
         ((and (stringp module)
               (ignore-errors (car (geiser-syntax--read-from-string module)))))
diff --git a/src/geiser/geiser.ss b/src/geiser/geiser.ss
index e508ce2..8311dd5 100644
--- a/src/geiser/geiser.ss
+++ b/src/geiser/geiser.ss
@@ -11,6 +11,7 @@
 
 (library (geiser)
   (export geiser:eval
+          geiser:ge:eval
           geiser:completions
           geiser:module-completions
           geiser:autodoc
@@ -44,7 +45,7 @@
                 (debug-condition e) ; save the condition for the debugger
                 (k `((result "")
                      (output . ,(get-output-string output-string))
-                     (debug #t)
+                     (debug 1)
                      (error (key . condition)
                             (msg . ,(as-string (display-condition e)))))))
             (lambda ()
@@ -105,29 +106,30 @@
                   (map write-to-string
                        (environment-symbols (interaction-environment))))))
 
-  (define not-found (gensym))
+  (define current-library (make-parameter #f))
 
-  (define (module-env env)
-    (cond ((environment? env) env)
-          ((list? env) (environment env))
-          (else #f)))
+  (define (transitive-env . lib)
+    (let ((lib (if (null? lib) (current-library) (car lib))))
+      (and lib (apply environment lib (library-requirements lib)))))
 
-  (define current-environment (make-parameter #f module-env))
+  (define not-found (gensym))
 
-  (define (try-eval sym . env)
+  (define (try-eval sym)
     (call/cc
      (lambda (k)
        (with-exception-handler (lambda (e) (k not-found))
-         (let ((env (and (not (null? env)) (module-env (car env)))))
+         (let ((env (transitive-env)))
            (lambda () (if env (eval sym env) (eval sym))))))))
 
-  (define (geiser:eval module form)
+  (define (geiser:eval lib form)
     (call-with-result
      (lambda ()
-       (parameterize ((current-environment module))
-         (if (environment? (current-environment))
-             (eval form (current-environment))
-             (eval form))))))
+       (let ((env (transitive-env lib)))
+         (if env (eval form env) (eval form))))))
+
+  (define (geiser:ge:eval lib form)
+    (parameterize ([current-library lib])
+      (call-with-result (lambda () (eval form)))))
 
   (define (geiser:module-completions prefix . rest)
     (define (substring? s1 s2)
@@ -188,6 +190,11 @@
            (l (string-length s)))
       (if (<= l max-len) s (string-append (substring s 0 sub-len) sub-str))))
 
+  (define (known-symbol? id)
+    (memq id
+          (environment-symbols (or (transitive-env)
+                                   (interaction-environment)))))
+
   (define (id-autodoc id)
     (define (procedure-parameter-list id p)
       (and (procedure? p)
@@ -202,11 +209,11 @@
     (define (autodoc-arglist arglist) (autodoc-arglist* arglist '()))
     (define (signature as) `(,id ("args" ,@(map autodoc-arglist as))))
     (let ([binding (try-eval id)])
-      (if (not (eq? binding not-found))
-          (let ([as (procedure-parameter-list id binding)])
-            (if as (signature as) `(,id ("value" . ,(value->string binding)))))
-          (let ((s (symbol-signatures id)))
-            (if s (signature s) '())))))
+      (cond ((not (eq? binding not-found))
+             (let ([as (procedure-parameter-list id binding)])
+               (if as (signature as) `(,id ("value" . ,(value->string binding))))))
+            ((and (known-symbol? id) (symbol-signatures id)) => signature)
+            (else '()))))
 
   (define (geiser:autodoc ids)
     (cond ((null? ids) '())
@@ -214,8 +221,8 @@
           ((not (symbol? (car ids))) (geiser:autodoc (cdr ids)))
           (else (map id-autodoc ids))))
 
-  (define (geiser:symbol-location id . env)
-    (let* ([b (try-eval id (current-environment))]
+  (define (geiser:symbol-location id)
+    (let* ([b (try-eval id)]
            [c (and (not (eq? not-found b))
                    ((inspect/object b) 'code))])
       (if c
-- 
cgit v1.2.3