(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)) ;; Parse options for ls command using args-fold (SRFI 37) ;; We don't care for options that format the output. (define defaults-ls-options '((long . #t) (dot-files? . #t) (sort-by-mtime . #f) (reverse-sort . #f))) (define (parse-ls-arguments args) (let* ((on/off-option-processor (lambda (name) (lambda (option arg-name arg ops) (cons (cons name #t) ops)))) (long-option (option '(#\l) #f #f (on/off-option-processor 'long))) (dotfiles-option (option '(#\a) #f #f (on/off-option-processor 'dot-files?))) (sort-mtime-option (option '(#\t) #f #f (on/off-option-processor 'sort-by-mtime))) (reverse-sort-option (option '(#\r) #f #f (on/off-option-processor 'reverse-sort)))) (let ((given-args (args-fold args (list long-option dotfiles-option sort-mtime-option reverse-sort-option) (lambda (option name args operands) (error "Unknown ls option" name)) cons '()))) (map (lambda (p) (or (assoc (car p) given-args) p)) defaults-ls-options)))) (register-plugin! (make-command-plugin "ls" no-completer (lambda (command args) (let* ((options (parse-ls-arguments args)) (set? (lambda (opt) (cdr (assoc opt options)))) (sort (if (set? 'sort-by-mtime) (lambda (lst) (list-sort (lambda (f g) (< (file-info:mtime (fs-object-info f)) (file-info:mtime (fs-object-info g)))) lst)) (lambda (lst) (list-sort (lambda (f g) (stringalist)))) (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" "stopped" "output" "waiting-for-input")) (lambda (command args) (let ((selectors `(("running" . ,running-jobs) ("ready" . ,ready-jobs) ("stopped" . ,stopped-jobs) ("output" . ,jobs-with-new-output) ("input" . ,jobs-waiting-for-input)))) (append-map (lambda (arg) (cond ((assoc arg selectors) => (lambda (p) ((cdr p)))))) (if (null? args) (map car selectors) (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/fg (,command ,@args)))))