Implement globbing (the beginnings)
This commit is contained in:
parent
4a85644f58
commit
407de494d4
|
@ -107,11 +107,15 @@
|
||||||
|
|
||||||
(define-structure standard-command-plugin
|
(define-structure standard-command-plugin
|
||||||
(export standard-command-plugin show-shell-screen)
|
(export standard-command-plugin show-shell-screen)
|
||||||
(open nuit-eval
|
(open let-opt
|
||||||
let-opt
|
|
||||||
pps
|
|
||||||
ncurses
|
|
||||||
signals
|
signals
|
||||||
|
srfi-1
|
||||||
|
srfi-13
|
||||||
|
|
||||||
|
pps
|
||||||
|
nuit-eval
|
||||||
|
ncurses
|
||||||
|
tty-debug
|
||||||
plugin)
|
plugin)
|
||||||
(files std-command))
|
(files std-command))
|
||||||
|
|
||||||
|
@ -268,6 +272,19 @@
|
||||||
signals)
|
signals)
|
||||||
(files plugins))
|
(files plugins))
|
||||||
|
|
||||||
|
;;; focus table
|
||||||
|
|
||||||
|
(define-interface focus-table-interface
|
||||||
|
(export make-empty-focus-table
|
||||||
|
add-focus-object
|
||||||
|
get-focus-object))
|
||||||
|
|
||||||
|
(define-structure focus-table focus-table-interface
|
||||||
|
(open scheme
|
||||||
|
define-record-types
|
||||||
|
general-table)
|
||||||
|
(files focus))
|
||||||
|
|
||||||
;;; nuit
|
;;; nuit
|
||||||
|
|
||||||
(define-interface nuit-interface
|
(define-interface nuit-interface
|
||||||
|
|
|
@ -24,10 +24,52 @@
|
||||||
(display "Press any key to return to scsh-nuit...")
|
(display "Press any key to return to scsh-nuit...")
|
||||||
(wait-for-key))
|
(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)
|
(define (standard-command-plugin-evaluater command args)
|
||||||
(def-prog-mode)
|
(def-prog-mode)
|
||||||
(endwin)
|
(endwin)
|
||||||
(let ((status (run (,command ,@args))))
|
(newline)
|
||||||
|
(let ((status (run (,command ,@(expand-argument-list args)))))
|
||||||
|
(newline)
|
||||||
(display "Press any key to return to scsh-nuit...")
|
(display "Press any key to return to scsh-nuit...")
|
||||||
(wait-for-key)
|
(wait-for-key)
|
||||||
status))
|
status))
|
||||||
|
|
Loading…
Reference in New Issue