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