2008-08-27 20:27:06 -04:00
|
|
|
USING: accessors sequences assocs kernel quotations namespaces
|
2009-02-12 21:42:32 -05:00
|
|
|
xml.data xml.traversal combinators macros parser lexer words fry
|
|
|
|
regexp ;
|
2007-11-28 23:34:11 -05:00
|
|
|
IN: xmode.utilities
|
|
|
|
|
2008-12-15 21:31:55 -05:00
|
|
|
: implies ( x y -- z ) [ not ] dip or ; inline
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
: tag-init-form ( spec -- quot )
|
|
|
|
{
|
2008-04-26 00:17:08 -04:00
|
|
|
{ [ dup quotation? ] [ [ object get tag get ] prepose ] }
|
2007-11-28 23:34:11 -05:00
|
|
|
{ [ dup length 2 = ] [
|
2008-12-02 01:25:23 -05:00
|
|
|
first2 '[
|
|
|
|
tag get children>string
|
|
|
|
_ [ execute ] when* object get _ execute
|
|
|
|
]
|
2007-11-28 23:34:11 -05:00
|
|
|
] }
|
|
|
|
{ [ dup length 3 = ] [
|
2008-12-02 01:25:23 -05:00
|
|
|
first3 '[
|
2009-01-28 18:18:14 -05:00
|
|
|
tag get _ attr
|
2008-12-02 01:25:23 -05:00
|
|
|
_ [ execute ] when* object get _ execute
|
|
|
|
]
|
2007-11-28 23:34:11 -05:00
|
|
|
] }
|
|
|
|
} cond ;
|
|
|
|
|
|
|
|
: with-tag-initializer ( tag obj quot -- )
|
2008-04-26 00:17:08 -04:00
|
|
|
[ object set tag set ] prepose with-scope ; inline
|
2007-11-28 23:34:11 -05:00
|
|
|
|
|
|
|
MACRO: (init-from-tag) ( specs -- )
|
|
|
|
[ tag-init-form ] map concat [ ] like
|
|
|
|
[ with-tag-initializer ] curry ;
|
|
|
|
|
|
|
|
: init-from-tag ( tag tuple specs -- tuple )
|
2008-12-02 01:25:23 -05:00
|
|
|
over [ (init-from-tag) ] dip ; inline
|
2009-02-12 21:42:32 -05:00
|
|
|
|
|
|
|
: <?insensitive-regexp> ( string ? -- regexp )
|
|
|
|
"i" "" ? <optioned-regexp> ;
|