[REBOL] Re: %a*file? , wildcards with parse demo
From: d4marcus:dtek:chalmers:se at: 29-Mar-2001 20:38
Excellent! Exactly what I wanted. :-)
As usual with these things I decided to extend it a little, but only the
block-matching function so far. Eeventually it would be nice to use
patterns like [a-c]*[0-9]??.html or similar. Anyone willing to try? :-)
Oh well, anyway:
Rebol [
Title: "Wildcards / filter-contents"
File: %wildcards.r
Date: 29-Mar-2001
Author: ["Volker Nitsch" "Marcus Petersson"]
Purpose: {Compile *? -style wildcards to parse-expression.
workaround for the find/match/case/any -bug.
also usable for sub-expressions in parse-patterns}
]
wildcards: function [
"Translates ? and * wildcard expression to REBOL parse rule."
'pattern] [fpt ar rule p question star] [
rule: copy []
ar: func [p] [any [None? p append rule p]]
fpt: func [val /local bt] [all [not empty? bt: back tail rule
('thru = bt/1) insert remove back tail rule val]]
question: [copy p to "?" (ar p fpt [] ar [skip]) skip]
star: [copy p to "*" (ar p fpt [] ar [thru]) skip]
parse to-string pattern [any [star | question] copy p to end (ar p)]
fpt [to end] rule
]
filter-contents: func [
{Filters a multi-level block of to-stringable series or words
through either ?*-style patterns or REBOL parse rules.}
block [block!] "Block to filter"
'pattern "Pattern to match"
/except "Except..." 'nopat "Pattern to not match"
/tree "To filter a dir-tree-block"
'dirpattern "Dir pattern to match"
'dirnopat [any-type!] "Dir pattern to not match"
] [
any [dirpattern dirpattern: '*]
any [value? 'dirnopat dirnopat: None]
filter-contents! block reduce [tree :pattern :nopat :dirpattern :dirnopat]
]
filter-contents!: function [
"Main function of filter-contents"
block [block!] "Block to filter"
_p [block!] {Five items: 1. Are we matching a dir-tree-block? /
2. Pattern to match / 3. not match /
4. Dir pattern to match / 5. not match}
] [
matching filter nr
] [
nr: next _p
forall nr [any [block? nr/1 nr/1: wildcards nr/1]]
nr: either _p/1 [2] [1]
matching: copy/deep block
filter: function [f] [parsef1 match-dir] [
parsef1: func [_pat] [parse/case to-string f/1 _pat]
match-dir: does [either all [_p/1
any [not parsef1 _p/4 parsef1 _p/5]] [
remove/part f 2] [filter f/:nr f: skip f nr]]
until [either block? f/:nr [match-dir] [
either any [not parsef1 _p/2 parsef1 _p/3] [
remove f] [f: next f]] empty? f]]
filter matching
head matching
]
; example
filter-contents/except read %. *.r .*
;== [%shell.r %dir-utils.r %graphics.r %test.r %wildcards.r %tree-growing.r]
filter-contents/except [1 2 [3 4 [5] 6] 7 [8]] '* 5
;== [1 2 [3 4 [] 6] 7 [8]]
; a more verbose example
; >> a: tree-builder system/options/home
; == [%/home/Programming/Rebol/ [%Arkiv/ [%library.rip %rebol_2.2.0 %reb...
; >> tree-parser filter-contents a *.html
; == false
; >> tree-parser filter-contents/tree a *.html
; dir: /home/Programming/Rebol/
; dir: |-- Arkiv/
; dir: |-- Docs/
; dir: | |-- CGI/
; file: | | `-- cgi-basics.html
; dir: | |-- Core-guide/
; file: | | |-- users.html
; dir: | | `-- users/
; file: | | |-- expabout.html
; file: | | |-- expcondition.html
; file: | | |-- expevaluation.html .....
Marcus
------------------------------------
If you find that life spits on you
calm down and pretend it's raining
