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:
eknauel 2005-05-23 14:52:03 +00:00
parent 9a038dc356
commit bbb6ad7a0e
3 changed files with 64 additions and 23 deletions

View File

@ -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,8 +518,7 @@
(echo)
ch))
(define (execute-command command)
(let ((result (evaluate command)))
(define (find/init-plugin-for-result result)
(cond
((determine-plugin-by-type result)
=> (lambda (plugin)
@ -508,8 +531,8 @@
(values
(post-message standard-view-plugin
(make-next-command-message
command '() (buffer-num-cols command-buffer)))
standard-view-plugin)))))
"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)))

View File

@ -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))

10
scheme/std-command.scm Normal file
View File

@ -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))