(define (standard-command-plugin-completer command args) #f) (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) (clear) (exit (if (null? args) 0 (string->number (car args))))))) (register-plugin! (make-command-plugin "jobs" (lambda (command prefix args arg-pos) '("running" "ready" "output" "waiting-for-input")) (lambda (command args) (append-map (lambda (arg) ;; #### warn if argument is unknown (cond ((assoc arg `(("running" . ,running-jobs) ("ready" . ,ready-jobs) ("output" . ,jobs-with-new-output) ("input" . ,jobs-waiting-for-input))) => (lambda (p) ((cdr p)))))) (delete-duplicates args))))) (register-plugin! (make-command-plugin "ftp" (lambda (command prefix args args-pos) (cond ((getenv "FTPHOSTS") => string-tokenize) (else '("ftp.gnu.org" "ftp.x.org")))) (lambda (command args) (run (,command ,@args)))))