diff options
Diffstat (limited to 'glob.scm')
| -rw-r--r-- | glob.scm | 136 |
1 files changed, 115 insertions, 21 deletions
@@ -8,7 +8,7 @@ ;1. Any copy made of this software must include this copyright notice ;in full. ; -;2. I have made no warrantee or representation that the operation of +;2. I have made no warranty or representation that the operation of ;this software will be error-free, and I am under no obligation to ;provide any services, by way of maintenance, update, or otherwise. ; @@ -17,6 +17,10 @@ ;promotional, or sales literature without prior written consent in ;each case. +;;@code{(require 'filename)} or @code{(require 'glob)} +;;@ftindex filename +;;@ftindex glob + (define (glob:pattern->tokens pat) (cond ((string? pat) @@ -187,31 +191,87 @@ (else (loop (cdr inds) (cdr wild?) lits res))))))))) +;;@body +;;Returns a predicate which returns a non-false value if its string argument +;;matches (the string) @var{pattern}, false otherwise. Filename matching +;;is like +;;@cindex glob +;;@dfn{glob} expansion described the bash manpage, except that names +;;beginning with @samp{.} are matched and @samp{/} characters are not +;;treated specially. +;; +;;These functions interpret the following characters specially in +;;@var{pattern} strings: +;;@table @samp +;;@item * +;;Matches any string, including the null string. +;;@item ? +;;Matches any single character. +;;@item [@dots{}] +;;Matches any one of the enclosed characters. A pair of characters +;;separated by a minus sign (-) denotes a range; any character lexically +;;between those two characters, inclusive, is matched. If the first +;;character following the @samp{[} is a @samp{!} or a @samp{^} then any +;;character not enclosed is matched. A @samp{-} or @samp{]} may be +;;matched by including it as the first or last character in the set. +;;@end table +(define (filename:match?? pattern) + (glob:make-matcher pattern char=? char<=?)) +(define (filename:match-ci?? pattern) + (glob:make-matcher pattern char-ci=? char-ci<=?)) -(define (glob:match?? pat) - (glob:make-matcher pat char=? char<=?)) -(define (glob:match-ci?? pat) - (glob:make-matcher pat char-ci=? char-ci<=?)) -(define filename:match?? glob:match??) -(define filename:match-ci?? glob:match-ci??) -(define (glob:substitute?? pat templ) - (cond ((procedure? templ) - (glob:caller-with-matches pat templ char=? char<=?)) - ((string? templ) - (glob:make-substituter pat templ char=? char<=?)) +;;@args pattern template +;;Returns a function transforming a single string argument according to +;;glob patterns @var{pattern} and @var{template}. @var{pattern} and +;;@var{template} must have the same number of wildcard specifications, +;;which need not be identical. @var{pattern} and @var{template} may have +;;a different number of literal sections. If an argument to the function +;;matches @var{pattern} in the sense of @code{filename:match??} then it +;;returns a copy of @var{template} in which each wildcard specification is +;;replaced by the part of the argument matched by the corresponding +;;wildcard specification in @var{pattern}. A @code{*} wildcard matches +;;the longest leftmost string possible. If the argument does not match +;;@var{pattern} then false is returned. +;; +;;@var{template} may be a function accepting the same number of string +;;arguments as there are wildcard specifications in @var{pattern}. In +;;the case of a match the result of applying @var{template} to a list +;;of the substrings matched by wildcard specifications will be returned, +;;otherwise @var{template} will not be called and @code{#f} will be returned. +(define (filename:substitute?? pattern template) + (cond ((procedure? template) + (glob:caller-with-matches pattern template char=? char<=?)) + ((string? template) + (glob:make-substituter pattern template char=? char<=?)) (else - (slib:error 'glob:substitute "bad second argument" templ)))) -(define (glob:substitute-ci?? pat templ) - (cond ((procedure? templ) - (glob:caller-with-matches pat templ char-ci=? char-ci<=?)) - ((string? templ) - (glob:make-substituter pat templ char-ci=? char-ci<=?)) + (slib:error 'filename:substitute?? "bad second argument" template)))) +(define (filename:substitute-ci?? pattern template) + (cond ((procedure? template) + (glob:caller-with-matches pattern template char-ci=? char-ci<=?)) + ((string? template) + (glob:make-substituter pattern template char-ci=? char-ci<=?)) (else - (slib:error 'glob:substitute "bad second argument" templ)))) -(define filename:substitute?? glob:substitute??) -(define filename:substitute-ci?? glob:substitute-ci??) + (slib:error 'filename:substitute-ci?? "bad second argument" template)))) + +;;@example +;;((filename:substitute?? "scm_[0-9]*.html" "scm5c4_??.htm") +;; "scm_10.html") +;;@result{} "scm5c4_10.htm" +;;((filename:substitute?? "??" "beg?mid?end") "AZ") +;;@result{} "begAmidZend" +;;((filename:substitute?? "*na*" "?NA?") "banana") +;;@result{} "banaNA" +;;((filename:substitute?? "?*?" (lambda (s1 s2 s3) (string-append s3 s1))) +;; "ABZ") +;;@result{} "ZA" +;;@end example +;;@body +;;@var{str} can be a string or a list of strings. Returns a new string +;;(or strings) similar to @code{str} but with the suffix string @var{old} +;;removed and the suffix string @var{new} appended. If the end of +;;@var{str} does not match @var{old}, an error is signaled. (define (replace-suffix str old new) (let* ((f (glob:make-substituter (list "*" old) (list "*" new) char=? char<=?)) @@ -222,3 +282,37 @@ (if (pair? str) (map g str) (g str)))) + +;;@example +;;(replace-suffix "/usr/local/lib/slib/batch.scm" ".scm" ".c") +;;@result{} "/usr/local/lib/slib/batch.c" +;;@end example + +;;@args proc k +;;@args proc +;;Calls @1 with @2 arguments, strings returned by successive calls to +;;@code{tmpnam}. +;;If @1 returns, then any files named by the arguments to @1 are +;;deleted automatically and the value(s) yielded by the @1 is(are) +;;returned. @2 may be ommited, in which case it defaults to @code{1}. +;; +;;@args proc suffix1 ... +;;Calls @1 with strings returned by successive calls to @code{tmpnam}, +;;each with the corresponding @var{suffix} string appended. +;;If @1 returns, then any files named by the arguments to @1 are +;;deleted automatically and the value(s) yielded by the @1 is(are) +;;returned. +(define (call-with-tmpnam proc . suffi) + (define (do-call paths) + (let ((ans (apply proc paths))) + (for-each (lambda (path) (if (file-exists? path) (delete-file path))) + paths) + ans)) + (cond ((null? suffi) (do-call (list (tmpnam)))) + ((and (= 1 (length suffi)) (number? (car suffi))) + (do ((cnt (if (null? suffi) 0 (+ -1 (car suffi))) (+ -1 cnt)) + (paths '() (cons (tmpnam) paths))) + ((negative? cnt) + (do-call paths)))) + (else (do-call (map (lambda (suffix) (string-append (tmpnam) suffix)) + suffi))))) |