diff --git a/scheme/job.scm b/scheme/job.scm index 58a3d88..a2245f3 100644 --- a/scheme/job.scm +++ b/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 \ No newline at end of file diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 1c904e7..0bc1442 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -230,24 +230,43 @@ (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 () - (let ((viewer - (find/init-plugin-for-result - (eval-string command-line)))) - (let ((new-entry - (make-history-entry command-line '() viewer))) - ;; #### shouldn't we use some kind of insertion here? - (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)))))) + (if (scheme-command-line? command-line) + (process-scheme-command command-line) + (let ((viewer + (find/init-plugin-for-result + (eval-string command-line)))) + (let ((new-entry + (make-history-entry command-line '() viewer))) + ;; #### shouldn't we use some kind of insertion here? + (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))))))) ;; #### crufty, and a very dumb idea (define split-command-line string-tokenize) @@ -319,7 +338,9 @@ (init-windows!) (read-config-file!) (set! *command-buffer-mode* (config 'main 'initial-command-mode)) - + + (set-evaluation-package! 'nuit-eval) + (clear) (if (not (process-group-leader?)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 507c456..878afaa 100644 --- a/scheme/nuit-packages.scm +++ b/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