add some common commands (in terms of command-plugins)
This commit is contained in:
parent
bbb6ad7a0e
commit
f8a30e3523
|
@ -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
|
||||
|
|
|
@ -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))
|
||||
|
|
|
@ -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))))
|
||||
|
||||
|
||||
|
|
Loading…
Reference in New Issue