From c0fbaf7d07a0f3bad0528ca3078364aba3c42b80 Mon Sep 17 00:00:00 2001 From: mainzelm Date: Thu, 6 Apr 2006 13:25:03 +0000 Subject: [PATCH] Separate packages for config and command evaluation Evaluate config options --- scheme/config.scm | 2 +- scheme/eval-environment.scm | 17 ++++++++++++----- scheme/job.scm | 6 +++--- scheme/nuit-engine.scm | 14 +++++++++----- scheme/nuit-packages.scm | 13 +++++++++++-- scheme/std-command.scm | 2 +- 6 files changed, 37 insertions(+), 17 deletions(-) diff --git a/scheme/config.scm b/scheme/config.scm index 772ac2b..695b62f 100644 --- a/scheme/config.scm +++ b/scheme/config.scm @@ -30,7 +30,7 @@ (symbol? (cdar option.value)) (assoc (car option.value) *configuration*)) => (lambda (p) - (set-cdr! p (cdr option.value)))) + (set-cdr! p (eval-s-expr (cdr option.value) 'commander-s-config-eval)))) (else (error "Unknown option value or ill-formed option" option.value conf-file)))) diff --git a/scheme/eval-environment.scm b/scheme/eval-environment.scm index 2681772..a88c4f3 100644 --- a/scheme/eval-environment.scm +++ b/scheme/eval-environment.scm @@ -29,10 +29,17 @@ (let ((string-port (open-input-string string))) (read string-port))) -(define (eval-string str) - (eval (read-sexp-from-string str) - (evaluation-environment))) +(define (eval-string str . maybe-package-name) + (apply eval-s-expr (read-sexp-from-string str) maybe-package-name)) + +(define (eval-s-expr s-expr . maybe-package-name) + (let ((env (if (null? maybe-package-name) + (evaluation-environment) + (load-evaluation-environment (car maybe-package-name))))) + (eval s-expr env))) + +(define (eval-s-expr/command s-expr) + (let ((command-env (load-evaluation-environment 'nuit-eval))) + (eval s-expr command-env))) -(define (eval-s-expr s-expr) - (eval s-expr (evaluation-environment))) diff --git a/scheme/job.scm b/scheme/job.scm index fa8395f..744d939 100644 --- a/scheme/job.scm +++ b/scheme/job.scm @@ -307,7 +307,7 @@ (fork-pty-session (lambda () (handle-signal-default signal/ttou) - (eval-s-expr s-expr)))) + (eval-s-expr/command s-expr)))) (lambda (proc pty-in pty-out tty-name) (make-job-with-console s-expr proc pty-in pty-out @@ -342,7 +342,7 @@ (set-process-group child-pid) (set-tty-process-group (current-output-port) child-pid) (handle-signal-default signal/ttou) - (eval-s-expr s-expr)))))) + (eval-s-expr/command s-expr)))))) (let* ((job (make-job-sans-console s-expr proc)) (status (job-status job))) (set-tty-process-group (current-output-port) foreground-pgrp) @@ -367,7 +367,7 @@ (lambda () (set-process-group (pid) (pid)) (handle-signal-default signal/ttou) - (eval-s-expr s-expr))))) + (eval-s-expr/command s-expr))))) (let ((job (make-job-sans-console s-expr proc))) (release-lock paint-lock) job))) diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 5e11dc9..1da07a5 100644 --- a/scheme/nuit-engine.scm +++ b/scheme/nuit-engine.scm @@ -19,6 +19,7 @@ (define-option 'main 'switch-command-buffer-mode-key key-f7) (define-option 'main 'help-key (char->ascii #\?)) (define-option 'main 'quit-help-key (char->ascii #\q)) +(define-option 'main 'show-shell-key key-end) ;; mode of the command buffer (define-option 'main 'initial-command-mode 'command) @@ -457,6 +458,10 @@ (define (process-group-leader?) (= (process-group) (pid))) +;; config needs this to be initialized +(init-evaluation-environment! 'nuit-eval) + +;; there are top-level expressions accessing the configuration... (read-config-file!) ;; handle input @@ -471,8 +476,6 @@ (set! *command-buffer-mode* (config 'main 'initial-command-mode)) - (init-evaluation-environment! 'nuit-eval) - (clear) (if (not (process-group-leader?)) (become-session-leader)) @@ -560,7 +563,8 @@ (define (define-key! key handler) (vector-set! *key-map* key handler)) -(define-key! key-end ;; TODO does not work?!? + +(define-key! (config 'main 'show-shell-key) (lambda (ch) (show-shell-screen) (paint))) (define-key! key-f2 (lambda (ch) (paint))) @@ -879,8 +883,8 @@ (define header-line "Select completion") (define header-length (string-length header-line)) - (let* ((lines (min (- (LINES) 5) - (length completions))) + (let* ((lines (+ 2 (min (- (LINES) 5) + (length completions)))) (inner-width (min (apply max header-length (map string-length completions)) diff --git a/scheme/nuit-packages.scm b/scheme/nuit-packages.scm index 3dc6a73..93d7a97 100644 --- a/scheme/nuit-packages.scm +++ b/scheme/nuit-packages.scm @@ -545,6 +545,12 @@ pps) (files eval)) +(define-structure commander-s-config-eval (compound-interface + (interface-of scheme-with-scsh) + ncurses-interface) + (open scheme-with-scsh + ncurses)) + ;;; evaluation of Scheme expressions (define-interface eval-environment-interface @@ -554,7 +560,8 @@ evaluation-environment evaluation-environment-name eval-string - eval-s-expr)) + eval-s-expr + eval-s-expr/command)) (define-structure eval-environment eval-environment-interface (open scheme @@ -943,7 +950,9 @@ (define-structure configuration configuration-interface (open scheme-with-scsh signals - handle-fatal-error) + handle-fatal-error + + eval-environment) (files config)) ;;; modal window diff --git a/scheme/std-command.scm b/scheme/std-command.scm index 7064240..c64d644 100644 --- a/scheme/std-command.scm +++ b/scheme/std-command.scm @@ -98,7 +98,7 @@ (expanded (expand-command-line parsed)) (s-expr (compile-command-line expanded))) (debug-message "Compiled command " s-expr) - (eval-s-expr s-expr))) + (eval-s-expr/command s-expr))) (define standard-command-plugin (make-command-plugin #f