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-o 111)
|
||||
(define key-tab 9)
|
||||
|
||||
;;state of the upper window (Command-Window)
|
||||
(define command-buffer
|
||||
|
@ -244,13 +245,32 @@
|
|||
((command-buffer-in-command-mode?)
|
||||
(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)
|
||||
(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)
|
||||
(call-with-values
|
||||
(lambda ()
|
||||
(execute-command command))
|
||||
(find/init-plugin-for-result
|
||||
(eval-expression command)))
|
||||
(lambda (result plugin)
|
||||
(let ((new-entry
|
||||
(make-history-entry command '()
|
||||
|
@ -277,6 +297,10 @@
|
|||
((= ch key-control-x)
|
||||
(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)
|
||||
((= ch key-f7)
|
||||
(toggle-command/scheme-mode)
|
||||
|
@ -494,22 +518,21 @@
|
|||
(echo)
|
||||
ch))
|
||||
|
||||
(define (execute-command command)
|
||||
(let ((result (evaluate command)))
|
||||
(cond
|
||||
((determine-plugin-by-type result)
|
||||
=> (lambda (plugin)
|
||||
(values
|
||||
(post-message plugin
|
||||
(make-init-with-result-message
|
||||
result (buffer-num-cols command-buffer)))
|
||||
plugin)))
|
||||
(else
|
||||
(values
|
||||
(post-message standard-view-plugin
|
||||
(make-next-command-message
|
||||
command '() (buffer-num-cols command-buffer)))
|
||||
standard-view-plugin)))))
|
||||
(define (find/init-plugin-for-result result)
|
||||
(cond
|
||||
((determine-plugin-by-type result)
|
||||
=> (lambda (plugin)
|
||||
(values
|
||||
(post-message plugin
|
||||
(make-init-with-result-message
|
||||
result (buffer-num-cols command-buffer)))
|
||||
plugin)))
|
||||
(else
|
||||
(values
|
||||
(post-message standard-view-plugin
|
||||
(make-next-command-message
|
||||
"command" '() (buffer-num-cols command-buffer)))
|
||||
standard-view-plugin))))
|
||||
|
||||
;;Extracts the name of the function and its parameters
|
||||
(define extract-com-and-par
|
||||
|
@ -583,7 +606,7 @@
|
|||
(let ((string-port (open-input-string string)))
|
||||
(read string-port)))
|
||||
|
||||
(define evaluate
|
||||
(define eval-expression
|
||||
(let ((env (init-evaluation-environment 'nuit-eval)))
|
||||
(lambda (exp)
|
||||
(with-fatal-error-handler
|
||||
|
@ -821,7 +844,7 @@
|
|||
(define (standard-receiver-rec message)
|
||||
(cond
|
||||
((next-command-message? message)
|
||||
(let* ((result (evaluate (message-command-string message)))
|
||||
(let* ((result (eval-expression (message-command-string message)))
|
||||
(result-string (exp->string result))
|
||||
(width (next-command-message-width message))
|
||||
(text (layout-result-standard result-string result width))
|
||||
|
@ -846,4 +869,3 @@
|
|||
(define standard-view-plugin
|
||||
(make-view-plugin standard-receiver-rec
|
||||
(lambda (val) #t)))
|
||||
|
||||
|
|
|
@ -71,6 +71,14 @@
|
|||
layout)
|
||||
(files browse-list))
|
||||
|
||||
;;; standard command plugin
|
||||
|
||||
(define-structure standard-command-plugin
|
||||
(export standard-command-plugin)
|
||||
(open nuit-eval
|
||||
plugin)
|
||||
(files std-command))
|
||||
|
||||
;;; fs-objects
|
||||
|
||||
(define-interface fs-object-interface
|
||||
|
@ -88,7 +96,7 @@
|
|||
;;; package
|
||||
|
||||
(define-structure nuit-eval
|
||||
(export)
|
||||
(interface-of scheme-with-scsh)
|
||||
(open
|
||||
(modify scheme-with-scsh
|
||||
(rename (directory-files scsh-directory-files)))
|
||||
|
@ -200,7 +208,8 @@
|
|||
;; the following modules are plugins
|
||||
browse-list-plugin
|
||||
dirlist-view-plugin
|
||||
process-view-plugin)
|
||||
process-view-plugin
|
||||
standard-command-plugin)
|
||||
(files nuit-engine
|
||||
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