scsh-conservatory
/
scsh-0.6
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

+ Preseve quotation of [],? and * while processing braces. 

+ Unquote constant patterns before file existence check.
This commit is contained in:
mainzelm 2004-02-09 12:16:02 +00:00
parent 6ad71da933
commit e603ebb626
1 changed files with 27 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
scsh/glob.scm
View File

@ -69,7 +69,7 @@
(cond ((string=? pat "") (values '() #t))
((constant-glob? pat)
(values (cons pat '()) #f)) ; Don't check filesys.
(values (cons (glob-unquote pat) '()) #f)) ; Don't check filesys.
(else (let* ((dots? (char=? #\. (string-ref pat 0))) ; Match dot files?
(candidates (maybe-directory-files fname dots?))
@ -249,12 +249,16 @@
(parse-comma-sequence pattern (+ i 1))
(lp i (cross-append prefixes pats) '()))))
((#\\)
(let ((i (+ i 1)))
(if (= i pattern-len)
(let ((next-i (+ i 1)))
(if (= next-i pattern-len)
(error "Dangling escape char in glob pattern" pattern)
(lp (+ i 1)
prefixes
(cons (string-ref pattern i) pat)))))
(if (memv (string-ref pattern next-i) '(#\{, #\,, #\},#\\))
(lp (+ next-i 1)
prefixes
(cons (string-ref pattern next-i) pat))
(lp (+ i 1)
prefixes
(cons (string-ref pattern i) pat))))))
((#\,)
(if comma-terminates?
(values (finish prefixes pat) i)
@ -313,4 +317,21 @@
(cons #\\ result)
result))))))
(define (glob-unquote string)
(let ((len (string-length string)))
(let lp ((i 0)
(result '()))
(if (= i len)
(list->string (reverse result))
(let* ((c (string-ref string i)))
(if (char=? c #\\)
(let ((next-i (+ i 1)))
(if (= next-i len)
(error "Dangling escape char in glob pattern" string)
(let ((quoted (string-ref string next-i)))
(lp (+ i 2)
(cons quoted result)))))
(lp (+ i 1)
(cons c result))))))))