Separate packages for config and command evaluation
Evaluate config options
This commit is contained in:
parent
c82a228790
commit
c0fbaf7d07
|
@ -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))))
|
||||
|
|
|
@ -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)))
|
||||
|
||||
|
|
|
@ -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)))
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue