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

This commit is contained in:
eknauel 2005-05-23 16:03:26 +00:00
parent bbb6ad7a0e
commit f8a30e3523
3 changed files with 87 additions and 30 deletions

View File

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

View File

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

View File

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