\ Path: tunews.univie.ac.at!aconews-feed.univie.ac.at!newsfeed.wu-wien.ac.at!newsfeed.utanet.at!news2.volia.net!postnews.google.com!news4.google.com!border1.nntp.dca.giganews.com!nntp.giganews.com!local01.nntp.dca.giganews.com!nntp.scarlet.biz!news.scarlet.biz.POSTED!not-for-mail \ NNTP-Posting-Date: Mon, 16 Oct 2006 02:07:35 -0500 \ Reply-To: "Charles Melice" \ From: "Charles Melice" \ Newsgroups: comp.lang.forth \ References: <34833508133561@frunobulax.edu> \ Subject: Re: A small wildcard matching algorithm \ Date: Mon, 16 Oct 2006 09:07:18 +0200 \ X-Priority: 3 \ X-MSMail-Priority: Normal \ X-Newsreader: Microsoft Outlook Express 6.00.2900.2869 \ X-RFC2646: Format=Flowed; Original \ X-MimeOLE: Produced By Microsoft MimeOLE V6.00.2900.2962 \ Message-ID: \ Lines: 125 \ NNTP-Posting-Host: 83.134.16.146 \ X-Trace: sv3-4Ol8DP8lWDtErm19zHe8DOHbyMfu3PvMikR6/lYGPH+ud80cvZUVk6x5iLnLy3IC0PwKCbKJzhyM7w/!RREzswSgtaxqV6ijC9UaLR8T/I71eq5pbdABJmrWZ8ENVfxO3Uur5oX7J+U5Wqw9WmpV+QbB5eA= \ X-Complaints-To: abuse@scarlet.be \ X-DMCA-Complaints-To: abuse@scarlet.biz \ X-Abuse-and-DMCA-Info: Please be sure to forward a copy of ALL headers \ X-Abuse-and-DMCA-Info: Otherwise we will be unable to process your complaint properly \ X-Postfilter: 1.3.32 \ Xref: tunews.univie.ac.at comp.lang.forth:121181 \ "Marcel Hendrix" a écrit dans le message de news: \ 34833508133561@frunobulax.edu... \ > "Charles Melice" writes Re: A small wildcard \ > matching algorithm \ >> \ A small wildcard matching algorithm. \ >> \ Converted from Jack Handy "wildcmp" C source. \ >> \ see https://secure.codeproject.com/string/wildcmp.asp \ > \ > Neat! Especially the poem. \ Thank to have verified the code. \ Here is a rectified version. \ -- \ Charles \ _____________________________________ \ A small wildcard matching algorithm. \ Converted from Jack Handy "wildcmp" C source. \ see https://secure.codeproject.com/string/wildcmp.asp \ WILDCARD-MATCH ( text ntext wild nwild -- flag ) ( : TRY-IT s" blah.jpg" s" bl?h.*" WILDCARD-MATCH if ." we have a match!" else ." no match" then ; ) : andif s" dup if drop " evaluate ; immediate : orif s" dup 0= if drop " evaluate ; immediate : Char>Upper ( x -- C ) dup [char] a [char] z char+ within if bl - then ; \ ------- char * constant '*' char ? constant '?' : up2 ( a b -- B A ) Char>Upper swap Char>Upper ; : Ci ( a n i -- c ) tuck > if chars + c@ else 2drop 0 then ; : textCi ( -- C ) s" text nt it Ci" evaluate ; immediate : wildCi ( -- C ) s" wild nw iw Ci" evaluate ; immediate : WILDCARD-MATCH ( text nt wild nw -- flag ) 0 0 0 0 locals| iw it pw pt nw wild nt text | begin textCi andif wildCi '*' <> then while textCi wildCi up2 <> andif wildCi '?' <> then if false exit then 1 chars dup +to it +to iw repeat begin textCi while wildCi '*' = if 1 chars +to iw wildCi 0= if true exit then iw to pw it char+ to pt else wildCi textCi up2 = orif wildCi '?' = then if 1 chars dup +to it +to iw else pw to iw pt to it 1 chars +to pt then then repeat begin wildCi '*' = while 1 chars +to iw repeat wildCi 0= ; \ * TESTS * \ funny but bad. :noname ; value xt-chain : chain: ( -- ) :noname xt-chain compile, ; : ;chain ( -- ) postpone ; to xt-chain ; immediate 2variable str-wild : check ( a n -- ) 2dup str-wild 2@ wildcard-match if type cr else 2drop then ; : t" ( "str" -- ) chain: postpone s" postpone check postpone ;chain ; t" In the winter, we shall travel in a little pink railway carriage" t" With blue cushions." t" We shall be comfortable. A nest of mad kisses lies in wait" t" In each soft corner." t" You will close your eyes, so as not to see, through the glass," t" The evening shadows pulling faces." t" Those snarling monsters, a population" t" Of black devils and black wolves." t" Then you'll feel your cheek scratched..." t" A little kiss, like a crazy spider," t" Will run round your neck..." t" And you'll say to me : 'Find it !' bending your head" t" - And we'll take a long time to find that creature" t" - Which travels a lot..." t" Arthur Rimbaud" : test ( a n -- ) cr str-wild 2! xt-chain execute ; \ s" *e?i*" test \ The evening shadows pulling faces. \ Of black devils and black wolves \ s" *ss*" test \ We shall be comfortable. A nest of mad kisses lies in wait \ You will close your eyes, so as not to see, through the glass, \ A little kiss, like a crazy spider, \ s" *in*so*" test \ In each soft corner