commander-s/scheme/std-command.scm

95 lines
2.4 KiB
Scheme

;; ,open let-opt
(define (wait-for-key . optionals)
(let-optionals optionals
((tty-port (current-input-port)))
(let* ((old (tty-info tty-port))
(copy (copy-tty-info old)))
(set-tty-info:local-flags
copy
(bitwise-and (tty-info:local-flags copy)
(bitwise-not ttyl/canonical)))
(set-tty-info:min copy 1)
(set-tty-info:time copy 0)
(set-tty-info/now tty-port copy)
(let ((c (read-char tty-port)))
(set-tty-info/now tty-port old)
c))))
(define (standard-command-plugin-completer command args)
#f)
(define (show-shell-screen)
(def-prog-mode)
(endwin)
(display "Press any key to return to scsh-nuit...")
(wait-for-key))
(define (standard-command-plugin-evaluater command args)
(def-prog-mode)
(endwin)
(let ((status (run (,command ,@args))))
(display "Press any key to return to scsh-nuit...")
(wait-for-key)
status))
(define standard-command-plugin
(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 "ps"
no-completer
(lambda (command args)
(pps))))
(register-plugin!
(make-command-plugin "pwd"
no-completer
(lambda (command args)
(cwd))))
(register-plugin!
(make-command-plugin "cd"
no-completer
(lambda (command args)
(chdir (resolve-file-name (if (null? args)
"~"
(car args))))
(cwd))))
(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))))
(register-plugin!
(make-command-plugin "exit"
no-completer
(lambda (command args)
(exit (if (null? args)
0
(string->number (car args)))))))