-USING: accessors sequences assocs kernel quotations namespaces
-xml.data xml.utilities combinators macros parser lexer words ;
+USING: combinators kernel namespaces quotations regexp sequences
+splitting xml.data xml.traversal ;
IN: xmode.utilities
-: implies >r not r> or ; inline
-
-: child-tags ( tag -- seq ) children>> [ tag? ] filter ;
-
-: map-find ( seq quot -- result elt )
- f -rot
- [ nip ] swap [ dup ] 3compose find
- >r [ drop f ] unless r> ; inline
+: implies ( x y -- z ) [ not ] dip or ; inline
: tag-init-form ( spec -- quot )
{
{ [ dup quotation? ] [ [ object get tag get ] prepose ] }
{ [ dup length 2 = ] [
- first2 [
- >r >r tag get children>string
- r> [ execute ] when* object get r> execute
- ] 2curry
+ first2 '[
+ tag get children>string
+ _ [ execute ] when* object get _ execute
+ ]
] }
{ [ dup length 3 = ] [
- first3 [
- >r >r tag get at
- r> [ execute ] when* object get r> execute
- ] 3curry
+ first3 '[
+ tag get _ attr
+ _ [ execute ] when* object get _ execute
+ ]
] }
} cond ;
: with-tag-initializer ( tag obj quot -- )
[ object set tag set ] prepose with-scope ; inline
-MACRO: (init-from-tag) ( specs -- )
+MACRO: (init-from-tag) ( specs -- quot )
[ tag-init-form ] map concat [ ] like
[ with-tag-initializer ] curry ;
: init-from-tag ( tag tuple specs -- tuple )
- over >r (init-from-tag) r> ; inline
-
-SYMBOL: tag-handlers
-SYMBOL: tag-handler-word
-
-: <TAGS:
- CREATE tag-handler-word set
- H{ } clone tag-handlers set ; parsing
-
-: (TAG:) ( name quot -- ) swap tag-handlers get set-at ;
-
-: TAG:
- scan parse-definition
- (TAG:) ; parsing
+ over [ (init-from-tag) ] dip ; inline
-: TAGS>
- tag-handler-word get
- tag-handlers get >alist [ >r dup main>> r> case ] curry
- define ; parsing
+: <?insensitive-regexp> ( string ? -- regexp )
+ ! handle Java style case-insensitive flags
+ "(?i)" pick subseq-start [ drop "(?i)" "" replace t ] when
+ "i" "" ? <optioned-regexp> ;