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-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,8 +518,7 @@
(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)
@ -508,8 +531,8 @@
(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)))

View File

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

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