add some common commands (in terms of command-plugins)

scheme/layout.scm

@@ -13,7 +13,7 @@
 	  (loop (cons next-line new) rest-old)))))
 
 ;;the result is the "answer" of scsh
-(define (layout-result-standard result-str result width)
+(define (layout-result-standard result-str width)
   (reverse (seperate-line result-str width)))
 
 ;useful helpers

scheme/nuit-engine.scm

@@ -236,14 +236,14 @@
   (refresh-command-window))
 
 (define (handle-return-key)
-  (let ((command (last (buffer-text command-buffer))))
+  (let ((command-line (last (buffer-text command-buffer))))
     (cond
-     ((string=? command "")
+     ((string=? command-line "")
       (values))
      ((command-buffer-in-scheme-mode?)
-      (eval-command-in-scheme-mode command))
+      (eval-command-in-scheme-mode command-line))
      ((command-buffer-in-command-mode?)
-      (eval-command-in-command-mode command)))))
+      (eval-command-in-command-mode command-line)))))
 
 (define (find-command-plugin command)
   (or (find (lambda (p)
@@ -251,34 +251,42 @@
 	    (command-plugin-list))
       standard-command-plugin))
 
-(define (eval-command-in-command-mode command)
+(define (eval-command-in-command-mode command-line)
-  (let ((command-plugin (find-command-plugin command)))
+  (let* ((tokens (split-command-line command-line))
-    (call-with-values
+	 (command (car tokens))
-	(lambda ()
+	 (args (cdr tokens))
-	  (find/init-plugin-for-result
+	 (command-plugin (find-command-plugin command)))
-	   ((command-plugin-evaluater command-plugin) command '())))
+	(call-with-values
-      (lambda (result plugin)
+	    (lambda ()
-	(let ((new-entry
+	      (find/init-plugin-for-result
-	       (make-history-entry command '() 
+	       ((command-plugin-evaluater command-plugin) command args)))
-				   result plugin)))
+	  (lambda (result plugin)
-	  ;; FIXME, use insert here
+	    (let ((new-entry
-	  (append-to-history! new-entry)
+		   (make-history-entry command args
-	  (buffer-text-append-new-line! command-buffer)
+				       result plugin)))
-	  (paint-result/command-buffer new-entry))))))
+	      ;; 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-line)
   (call-with-values
       (lambda ()
 	(find/init-plugin-for-result
-	 (eval-expression command)))
+	 (eval-expression command-line)))
     (lambda (result plugin)
-      (let ((new-entry
+      (let* ((tokens (split-command-line command-line))
-	     (make-history-entry command '() 
+	     (command (car tokens))
-				 result plugin)))
+	     (args (cdr tokens))
+	     (new-entry
+	      (make-history-entry command args
+				  result plugin)))
 	;; FIXME, use insert here
 	(append-to-history! new-entry)
 	(buffer-text-append-new-line! command-buffer)
-	(paint-result/command-buffer new-entry)))))
+	  (paint-result/command-buffer new-entry)))))
+
+(define split-command-line string-tokenize)
 
 ;; handle input
 (define (run)
@@ -530,8 +538,8 @@
    (else 
     (values 
      (post-message standard-view-plugin
-		   (make-next-command-message
+		   (make-init-with-result-message
-		    "command" '() (buffer-num-cols command-buffer)))
+		    result (buffer-num-cols command-buffer)))
      standard-view-plugin))))
 
 ;;Extracts the name of the function and its parameters
@@ -843,11 +851,18 @@
 ;;Standard-Receiver:
 (define (standard-receiver-rec message)
   (cond 
+   ((init-with-result-message? message)
+    (make-standard-result-obj 
+     1 1 
+     (layout-result-standard 
+      (exp->string (init-with-result-message-result message))
+      (init-with-result-message-width message))
+     (init-with-result-message-result message)))
    ((next-command-message? 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))
+	   (text (layout-result-standard result-string width))
 	   (std-obj (make-standard-result-obj 1 1 text result)))
       std-obj))
    ((print-message? message)
@@ -856,8 +871,8 @@
 	   (pos-x (standard-result-obj-cur-pos-x model))
 	   (width (print-message-width message))
 	   (result (standard-result-obj-result model))
-	   (text (layout-result-standard (exp->string result)
+	   (text (layout-result-standard 
-					 result width))) 
+		  (exp->string result) width))) 
       (make-print-object pos-y pos-x text '() '())))
    ((key-pressed-message? message)
     (message-result-object message))

scheme/std-command.scm

@@ -8,3 +8,45 @@
   (make-command-plugin #f
 		       standard-command-plugin-completer
 		       standard-command-plugin-evaluater))
+
+;; some common commands
+
+(define no-completer (lambda args #f))
+
+(register-plugin!
+ (make-command-plugin "ls"
+		      no-completer
+ 		      (lambda (command args)
+ 			(directory-files))))
+
+(register-plugin!
+ (make-command-plugin "pwd"
+		      no-completer
+ 		      (lambda (command args)
+ 			(cwd))))
+
+(register-plugin!
+ (make-command-plugin "cd"
+		      no-completer
+ 		      (lambda (command args)
+ 			(chdir (car args)))))
+
+(register-plugin!
+ (make-command-plugin "setenv"
+		      no-completer
+ 		      (lambda (command args)
+ 			(setenv (car args) (cadr args)))))
+
+(register-plugin!
+ (make-command-plugin "getenv"
+		      no-completer
+		      (lambda (command args)
+			(getenv (car args)))))
+
+(register-plugin!
+ (make-command-plugin "printenv"
+		      no-completer
+ 		      (lambda (command args)
+ 			(env->alist))))
+
+