extra/html/templates/chloe/syntax/syntax.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 IN: html.templates.chloe.syntax
   4 USING: accessors kernel sequences combinators kernel namespaces
   5 classes.tuple assocs splitting words arrays memoize parser lexer
   6 io io.files io.encodings.utf8 io.streams.string
   7 unicode.case tuple-syntax mirrors fry math urls
   8 multiline xml xml.data xml.writer xml.utilities
   9 html.elements
  10 html.components
  11 html.templates ;
  12
  13 SYMBOL: tags
  14
  15 tags global [ H{ } clone or ] change-at
  16
  17 : define-chloe-tag ( name quot -- ) swap tags get set-at ;
  18
  19 : CHLOE:
  20     scan parse-definition define-chloe-tag ; parsing
  21
  22 : chloe-ns "http://factorcode.org/chloe/1.0" ; inline
  23
  24 MEMO: chloe-name ( string -- name )
  25     name new
  26         swap >>main
  27         chloe-ns >>url ;
  28
  29 : required-attr ( tag name -- value )
  30     dup chloe-name rot at*
  31     [ nip ] [ drop " attribute is required" append throw ] if ;
  32
  33 : optional-attr ( tag name -- value )
  34     chloe-name swap at ;
  35
  36 : singleton-component-tag ( tag class -- )
  37     [ "name" required-attr ] dip render ;
  38
  39 : CHLOE-SINGLETON:
  40     scan-word
  41     [ name>> ] [ '[ , singleton-component-tag ] ] bi
  42     define-chloe-tag ;
  43     parsing
  44
  45 : attrs>slots ( tag tuple -- )
  46     [ attrs>> ] [ <mirror> ] bi*
  47     '[
  48         swap main>> dup "name" =
  49         [ 2drop ] [ , set-at ] if
  50     ] assoc-each ;
  51
  52 : tuple-component-tag ( tag class -- )
  53     [ drop "name" required-attr ]
  54     [ new [ attrs>slots ] keep ]
  55     2bi render ;
  56
  57 : CHLOE-TUPLE:
  58     scan-word
  59     [ name>> ] [ '[ , tuple-component-tag ] ] bi
  60     define-chloe-tag ;
  61     parsing