basis/xmode/utilities/utilities.factor

   1 USING: accessors sequences assocs kernel quotations namespaces
   2 xml.data xml.traversal 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 : tag-init-form ( spec -- quot )
  10     {
  11         { [ dup quotation? ] [ [ object get tag get ] prepose ] }
  12         { [ dup length 2 = ] [
  13             first2 '[
  14                 tag get children>string
  15                 _ [ execute ] when* object get _ execute
  16             ]
  17         ] }
  18         { [ dup length 3 = ] [
  19             first3 '[
  20                 tag get _ attr
  21                 _ [ execute ] when* object get _ execute
  22             ]
  23         ] }
  24     } cond ;
  25
  26 : with-tag-initializer ( tag obj quot -- )
  27     [ object set tag set ] prepose with-scope ; inline
  28
  29 MACRO: (init-from-tag) ( specs -- )
  30     [ tag-init-form ] map concat [ ] like
  31     [ with-tag-initializer ] curry ;
  32
  33 : init-from-tag ( tag tuple specs -- tuple )
  34     over [ (init-from-tag) ] dip ; inline
  35
  36 SYMBOL: tag-handlers
  37 SYMBOL: tag-handler-word
  38
  39 : <TAGS:
  40     CREATE tag-handler-word set
  41     H{ } clone tag-handlers set ; parsing
  42
  43 : (TAG:) ( name quot -- ) swap tag-handlers get set-at ;
  44
  45 : TAG:
  46     scan parse-definition
  47     (TAG:) ; parsing
  48
  49 : TAGS>
  50     tag-handler-word get
  51     tag-handlers get >alist [ [ dup main>> ] dip case ] curry
  52     define ; parsing