;; ,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 (contains-glob-enumerator? arg) (if-match (regexp-search (rx (: (submatch (* any)) ("{[") (* any) (submatch (* any)) ("]}"))) arg) (whole-arg submatch-before submatch-after) (not (or (string-suffix? "\\" submatch-before) (string-suffix? "\\" submatch-after))) #f)) (define (contains-glob-wildcard? arg) (if-match (regexp-search (rx (: (submatch (* any)) ("*?"))) arg) (whole-arg submatch-before) (not (string-suffix? "\\" submatch-before)) #f)) (define (contains-glob-expression? arg) (or (contains-glob-wildcard? arg) (contains-glob-enumerator? arg))) (define (glob-argument arg) (let ((files (glob arg))) (if (null? files) (error "no files match this glob expression" arg (cwd)) files))) (define (expand-command-argument arg) (let ((expanded (expand-file-name arg))) (cond ((contains-glob-expression? arg) (glob-argument expanded)) (else (list expanded))))) (define (expand-argument-list args) (fold-right (lambda (arg expanded) (append (expand-command-argument arg) expanded)) '() args)) (define (standard-command-plugin-evaluater command args) (def-prog-mode) (endwin) (newline) (let ((status (run (,command ,@(expand-argument-list args))))) (newline) (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) (if (null? args) (directory-files (cwd)) (let ((arg (file-name->fs-object (expand-file-name (car args) (cwd))))) (if (file-info-directory? (fs-object-info arg)) (directory-files (fs-object-complete-path arg)) arg)))))) (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)))))))