From f8a30e3523b7484134bb7617deecdd0f5b2b58ec Mon Sep 17 00:00:00 2001 From: eknauel Date: Mon, 23 May 2005 16:03:26 +0000 Subject: [PATCH] add some common commands (in terms of command-plugins) --- scheme/layout.scm | 2 +- scheme/nuit-engine.scm | 73 +++++++++++++++++++++++++----------------- scheme/std-command.scm | 42 ++++++++++++++++++++++++ 3 files changed, 87 insertions(+), 30 deletions(-) diff --git a/scheme/layout.scm b/scheme/layout.scm index efac7af..2af75f0 100644 --- a/scheme/layout.scm +++ b/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 diff --git a/scheme/nuit-engine.scm b/scheme/nuit-engine.scm index 1c93ce5..a21c3c0 100644 --- a/scheme/nuit-engine.scm +++ b/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) - (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-command-mode command-line) + (let* ((tokens (split-command-line command-line)) + (command (car tokens)) + (args (cdr tokens)) + (command-plugin (find-command-plugin command))) + (call-with-values + (lambda () + (find/init-plugin-for-result + ((command-plugin-evaluater command-plugin) command args))) + (lambda (result plugin) + (let ((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)))))) -(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 - (make-history-entry command '() - result plugin))) + (let* ((tokens (split-command-line command-line)) + (command (car tokens)) + (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 - "command" '() (buffer-num-cols command-buffer))) + (make-init-with-result-message + 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) - result width))) + (text (layout-result-standard + (exp->string result) width))) (make-print-object pos-y pos-x text '() '()))) ((key-pressed-message? message) (message-result-object message)) diff --git a/scheme/std-command.scm b/scheme/std-command.scm index 70e142e..fa670a1 100644 --- a/scheme/std-command.scm +++ b/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)))) + +