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






-- 
To unsubscribe from this list, please send an email to
[EMAIL PROTECTED] with "unsubscribe" in the 
subject, without the quotes.

Reply via email to