[REBOL] %a*file? , wildcards with parse demo

From: agem:crosswinds at: 27-Mar-2001 22:38

[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*
  ]
 ]
]

[1] · 2 · See whole thread