basis/xmode/utilities/utilities.factor

   1 USING: accessors sequences assocs kernel quotations namespaces
   2 xml.data xml.utilities combinators macros parser lexer words fry ;
   3 IN: xmode.utilities
   4
   5 : implies ( x y -- z ) [ not ] dip or ; inline
   6
   7 : child-tags ( tag -- seq ) children>> [ tag? ] filter ;
   8
   9 : map-find ( seq quot -- result elt )
  10     [ f ] 2dip
  11     '[ nip @ dup ] find
  12     [ [ drop f ] unless ] dip ; inline
  13
  14 : tag-init-form ( spec -- quot )
  15     {
  16         { [ dup quotation? ] [ [ object get tag get ] prepose ] }
  17         { [ dup length 2 = ] [
  18             first2 '[
  19                 tag get children>string
  20                 _ [ execute ] when* object get _ execute
  21             ]
  22         ] }
  23         { [ dup length 3 = ] [
  24             first3 '[
  25                 tag get _ attr
  26                 _ [ execute ] when* object get _ execute
  27             ]
  28         ] }
  29     } cond ;
  30
  31 : with-tag-initializer ( tag obj quot -- )
  32     [ object set tag set ] prepose with-scope ; inline
  33
  34 MACRO: (init-from-tag) ( specs -- )
  35     [ tag-init-form ] map concat [ ] like
  36     [ with-tag-initializer ] curry ;
  37
  38 : init-from-tag ( tag tuple specs -- tuple )
  39     over [ (init-from-tag) ] dip ; inline
  40
  41 SYMBOL: tag-handlers
  42 SYMBOL: tag-handler-word
  43
  44 : <TAGS:
  45     CREATE tag-handler-word set
  46     H{ } clone tag-handlers set ; parsing
  47
  48 : (TAG:) ( name quot -- ) swap tag-handlers get set-at ;
  49
  50 : TAG:
  51     scan parse-definition
  52     (TAG:) ; parsing
  53
  54 : TAGS>
  55     tag-handler-word get
  56     tag-handlers get >alist [ [ dup main>> ] dip case ] curry
  57     define ; parsing