If the user enters a command in command mode, search for command
plugins and execute it. Added a standard command plugin (which always evaluates (directory-files) at the moment).
This commit is contained in:
parent
9a038dc356
commit
bbb6ad7a0e
|
@ -44,6 +44,7 @@
|
||||||
|
|
||||||
(define key-control-x 24)
|
(define key-control-x 24)
|
||||||
(define key-o 111)
|
(define key-o 111)
|
||||||
|
(define key-tab 9)
|
||||||
|
|
||||||
;;state of the upper window (Command-Window)
|
;;state of the upper window (Command-Window)
|
||||||
(define command-buffer
|
(define command-buffer
|
||||||
|
@ -244,13 +245,32 @@
|
||||||
((command-buffer-in-command-mode?)
|
((command-buffer-in-command-mode?)
|
||||||
(eval-command-in-command-mode command)))))
|
(eval-command-in-command-mode command)))))
|
||||||
|
|
||||||
|
(define (find-command-plugin command)
|
||||||
|
(or (find (lambda (p)
|
||||||
|
(string=? (command-plugin-command p) command))
|
||||||
|
(command-plugin-list))
|
||||||
|
standard-command-plugin))
|
||||||
|
|
||||||
(define (eval-command-in-command-mode command)
|
(define (eval-command-in-command-mode command)
|
||||||
(debug-message "eval-command-in-command-mode " command))
|
(let ((command-plugin (find-command-plugin command)))
|
||||||
|
(call-with-values
|
||||||
|
(lambda ()
|
||||||
|
(find/init-plugin-for-result
|
||||||
|
((command-plugin-evaluater command-plugin) command '())))
|
||||||
|
(lambda (result plugin)
|
||||||
|
(let ((new-entry
|
||||||
|
(make-history-entry command '()
|
||||||
|
result plugin)))
|
||||||
|
;; FIXME, use insert here
|
||||||
|
(append-to-history! new-entry)
|
||||||
|
(buffer-text-append-new-line! command-buffer)
|
||||||
|
(paint-result/command-buffer new-entry))))))
|
||||||
|
|
||||||
(define (eval-command-in-scheme-mode command)
|
(define (eval-command-in-scheme-mode command)
|
||||||
(call-with-values
|
(call-with-values
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(execute-command command))
|
(find/init-plugin-for-result
|
||||||
|
(eval-expression command)))
|
||||||
(lambda (result plugin)
|
(lambda (result plugin)
|
||||||
(let ((new-entry
|
(let ((new-entry
|
||||||
(make-history-entry command '()
|
(make-history-entry command '()
|
||||||
|
@ -277,6 +297,10 @@
|
||||||
((= ch key-control-x)
|
((= ch key-control-x)
|
||||||
(loop (wait-for-input) #t))
|
(loop (wait-for-input) #t))
|
||||||
|
|
||||||
|
((= ch key-tab)
|
||||||
|
(debug-message "Should do completion now")
|
||||||
|
(loop (wait-for-input) #f))
|
||||||
|
|
||||||
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
|
;; F7 toggle scheme-mode / command-mode (FIXME: find a better key)
|
||||||
((= ch key-f7)
|
((= ch key-f7)
|
||||||
(toggle-command/scheme-mode)
|
(toggle-command/scheme-mode)
|
||||||
|
@ -494,22 +518,21 @@
|
||||||
(echo)
|
(echo)
|
||||||
ch))
|
ch))
|
||||||
|
|
||||||
(define (execute-command command)
|
(define (find/init-plugin-for-result result)
|
||||||
(let ((result (evaluate command)))
|
(cond
|
||||||
(cond
|
((determine-plugin-by-type result)
|
||||||
((determine-plugin-by-type result)
|
=> (lambda (plugin)
|
||||||
=> (lambda (plugin)
|
(values
|
||||||
(values
|
(post-message plugin
|
||||||
(post-message plugin
|
(make-init-with-result-message
|
||||||
(make-init-with-result-message
|
result (buffer-num-cols command-buffer)))
|
||||||
result (buffer-num-cols command-buffer)))
|
plugin)))
|
||||||
plugin)))
|
(else
|
||||||
(else
|
(values
|
||||||
(values
|
(post-message standard-view-plugin
|
||||||
(post-message standard-view-plugin
|
(make-next-command-message
|
||||||
(make-next-command-message
|
"command" '() (buffer-num-cols command-buffer)))
|
||||||
command '() (buffer-num-cols command-buffer)))
|
standard-view-plugin))))
|
||||||
standard-view-plugin)))))
|
|
||||||
|
|
||||||
;;Extracts the name of the function and its parameters
|
;;Extracts the name of the function and its parameters
|
||||||
(define extract-com-and-par
|
(define extract-com-and-par
|
||||||
|
@ -583,7 +606,7 @@
|
||||||
(let ((string-port (open-input-string string)))
|
(let ((string-port (open-input-string string)))
|
||||||
(read string-port)))
|
(read string-port)))
|
||||||
|
|
||||||
(define evaluate
|
(define eval-expression
|
||||||
(let ((env (init-evaluation-environment 'nuit-eval)))
|
(let ((env (init-evaluation-environment 'nuit-eval)))
|
||||||
(lambda (exp)
|
(lambda (exp)
|
||||||
(with-fatal-error-handler
|
(with-fatal-error-handler
|
||||||
|
@ -821,7 +844,7 @@
|
||||||
(define (standard-receiver-rec message)
|
(define (standard-receiver-rec message)
|
||||||
(cond
|
(cond
|
||||||
((next-command-message? message)
|
((next-command-message? message)
|
||||||
(let* ((result (evaluate (message-command-string message)))
|
(let* ((result (eval-expression (message-command-string message)))
|
||||||
(result-string (exp->string result))
|
(result-string (exp->string result))
|
||||||
(width (next-command-message-width message))
|
(width (next-command-message-width message))
|
||||||
(text (layout-result-standard result-string result width))
|
(text (layout-result-standard result-string result width))
|
||||||
|
@ -846,4 +869,3 @@
|
||||||
(define standard-view-plugin
|
(define standard-view-plugin
|
||||||
(make-view-plugin standard-receiver-rec
|
(make-view-plugin standard-receiver-rec
|
||||||
(lambda (val) #t)))
|
(lambda (val) #t)))
|
||||||
|
|
||||||
|
|
|
@ -71,6 +71,14 @@
|
||||||
layout)
|
layout)
|
||||||
(files browse-list))
|
(files browse-list))
|
||||||
|
|
||||||
|
;;; standard command plugin
|
||||||
|
|
||||||
|
(define-structure standard-command-plugin
|
||||||
|
(export standard-command-plugin)
|
||||||
|
(open nuit-eval
|
||||||
|
plugin)
|
||||||
|
(files std-command))
|
||||||
|
|
||||||
;;; fs-objects
|
;;; fs-objects
|
||||||
|
|
||||||
(define-interface fs-object-interface
|
(define-interface fs-object-interface
|
||||||
|
@ -88,7 +96,7 @@
|
||||||
;;; package
|
;;; package
|
||||||
|
|
||||||
(define-structure nuit-eval
|
(define-structure nuit-eval
|
||||||
(export)
|
(interface-of scheme-with-scsh)
|
||||||
(open
|
(open
|
||||||
(modify scheme-with-scsh
|
(modify scheme-with-scsh
|
||||||
(rename (directory-files scsh-directory-files)))
|
(rename (directory-files scsh-directory-files)))
|
||||||
|
@ -200,7 +208,8 @@
|
||||||
;; the following modules are plugins
|
;; the following modules are plugins
|
||||||
browse-list-plugin
|
browse-list-plugin
|
||||||
dirlist-view-plugin
|
dirlist-view-plugin
|
||||||
process-view-plugin)
|
process-view-plugin
|
||||||
|
standard-command-plugin)
|
||||||
(files nuit-engine
|
(files nuit-engine
|
||||||
handle-fatal-error))
|
handle-fatal-error))
|
||||||
|
|
||||||
|
|
|
@ -0,0 +1,10 @@
|
||||||
|
(define (standard-command-plugin-completer command args)
|
||||||
|
#f)
|
||||||
|
|
||||||
|
(define (standard-command-plugin-evaluater command args)
|
||||||
|
(directory-files))
|
||||||
|
|
||||||
|
(define standard-command-plugin
|
||||||
|
(make-command-plugin #f
|
||||||
|
standard-command-plugin-completer
|
||||||
|
standard-command-plugin-evaluater))
|
Loading…
Reference in New Issue