Factor out eval-environment, add some commands for Scheme mode

part of darcs patch Sun Sep 18 14:29:31 EEST 2005  Martin Gasbichler <gasbichl@informatik.uni-tuebingen.de>

scheme/job.scm

@@ -369,31 +369,4 @@
     ((_ epf)
      (run/bg* '(exec-epf epf)))))
 
-(define (init-evaluation-environment package)
-  (let ((structure (reify-structure package)))
-    (load-structure structure)
-    (rt-structure->environment structure)))
-
-(define *evaluation-environment* 
-  (delay (init-evaluation-environment 'nuit-eval)))
-
-(define (evaluation-environment) (force *evaluation-environment*))
-
-(define (read-sexp-from-string string)
-  (let ((string-port (open-input-string string)))
-    (read string-port)))
-
-(define (eval-string str)
-  (eval (read-sexp-from-string str)
-	(evaluation-environment)))
-;       (with-fatal-and-capturing-error-handler
-;        (lambda (condition raw-continuation continuation decline)
-; 	 raw-continuation)
-;        (lambda ()
-; 	 (eval (read-sexp-from-string exp) env))))))
-
-(define (eval-s-expr s-expr)
-  (debug-message "eval-s-expr " s-expr " " (pid))
-  (eval s-expr (evaluation-environment)))
-
 ;;; EOF

scheme/nuit-engine.scm

@@ -230,10 +230,29 @@
       (mvwaddstr win 5 0 (get-output-string string-port)))
     (refresh-result-window)))
 
+(define (process-scheme-command command-line)
+  (receive (command args) (split-scheme-command-line command-line)
+    (let* ((viewer
+            (find/init-plugin-for-result
+             (eval-scheme-command command args)))
+           (new-entry
+            (make-history-entry command args viewer)))
+      (append-to-history! new-entry)
+      (signal-result-buffer-object-change)
+      (obtain-lock paint-lock)
+      (paint-result-window new-entry)
+      (refresh-result-window)
+      (move-cursor (command-buffer) (result-buffer))
+      (refresh-command-window)
+      (release-lock paint-lock))))
+    
+
 (define (eval-command-in-scheme-mode command-line)
   (with-fatal-error-handler* 
    display-error-and-continue
    (lambda ()
+     (if (scheme-command-line? command-line)
+         (process-scheme-command command-line)
          (let ((viewer
                 (find/init-plugin-for-result
                  (eval-string command-line))))
@@ -247,7 +266,7 @@
              (refresh-result-window)
              (move-cursor (command-buffer) (result-buffer))
              (refresh-command-window)
-	 (release-lock paint-lock))))))
+             (release-lock paint-lock)))))))
 
 ;; #### crufty, and a very dumb idea
 (define split-command-line string-tokenize)
@@ -320,6 +339,8 @@
   (read-config-file!)
   (set! *command-buffer-mode* (config 'main 'initial-command-mode))
 
+  (set-evaluation-package! 'nuit-eval)
+
   (clear)
 
   (if (not (process-group-leader?))

scheme/nuit-packages.scm

@@ -418,6 +418,39 @@
    pps)
   (files eval))
 
+;;; evaluation of Scheme expressions
+
+(define-interface eval-environment-interface
+  (export
+   set-evaluation-package!
+   evaluation-environment
+   eval-string
+   eval-s-expr))
+
+(define-structure eval-environment eval-environment-interface
+  (open scheme
+        srfi-6
+
+        rt-modules)
+  (files eval-environment))
+
+(define-interface scheme-commands-interface
+  (export scheme-command-line?
+          split-scheme-command-line
+          eval-scheme-command))
+
+(define-structure scheme-commands scheme-commands-interface
+  (open scheme
+        srfi-8
+        srfi-13
+        srfi-23
+        environments
+        package-commands-internal
+        package-mutation
+        
+        eval-environment)
+  (files scheme-commands))
+
 ;;; nuit plug-in registration
 
 (define-interface plugin-interface
@@ -653,7 +686,7 @@
 	define-record-types
 	threads
 	srfi-1
-	srfi-6
+;	srfi-6
 	signals
 	locks
 	let-opt
@@ -661,8 +694,8 @@
 	rendezvous
 	rendezvous-channels
 	rendezvous-placeholders
-	rt-modules
 
+        eval-environment
 	initial-tty
 	ncurses
 	terminal-buffer
@@ -793,6 +826,7 @@
 	rt-modules
 	srfi-1
 	srfi-6
+        srfi-8
 	srfi-13
 	debugging
 	inspect-exception
@@ -831,6 +865,8 @@
 	run-jobs
 	run-jobs-internals
 	joblist
+        eval-environment
+        scheme-commands
 	;; the following modules are plugins
 	joblist-viewer
 	dirlist-view-plugin