%a*file? , wildcards with parse demo

[rebol [ title: "%a*file? , wildcards with parse demo" file: %wildcards.r date: 27-Mar-2001 author: "volker" purpose: { compile *? -style wildcards to parse-expression. workaround for the find/match/case/any -bug. also usable for sub-expressions in parse-patterns } ] the-test: :do ;switch test on ;the-test: none wildcards: func [file /local before-tail fix-pending-thru kpt append-pattern ap pattern ] [ pattern: copy [] ap: append-pattern: func [p] [if none <> p [append pattern p]] kpt: fix-pending-thru: func [replacement] [ before-tail: back tail pattern if 'thru = before-tail/1 [ insert remove before-tail replacement ] ] parse to string! file [ any [ copy p to "*" (ap p kpt [] ap [thru]) skip | copy p to "?" (ap p kpt [] ap [skip]) skip ] copy p to end (ap p) ] kpt [to end] pattern ] matching-wildcard: func [file block /local pattern matching ] [ matching: copy [] pattern: wildcards file foreach f block [ if parse/case to string! f pattern [append matching f] ] matching ] ;------------------ the-test [ test: func [file] [ matching: matching-wildcard file test-cases not-matching: exclude/case test-cases matching ? file ? pattern ? matching ? not-matching print "" ] test-all: func [block] [ foreach pat block [test pat] ] test-cases: [%a %ab %aba %abc %ac %aB %AbC %And-So-On] ;test-cases: read %. ? test-cases test-all [ %* %a??b %a**b %a*?b %a?*b %? %abc %A* %C* %*C* %a*b*c %*a %*a* %*a*c* %ab* %*A*S*O* ] ] ]

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