basis/html/templates/chloe/chloe.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors assocs html.components html.forms
   4 html.templates html.templates.chloe.compiler
   5 html.templates.chloe.components html.templates.chloe.syntax
   6 io.encodings.utf8 io.files io.files.info kernel logging make
   7 math namespaces sequences splitting words xml xml.syntax ;
   8 IN: html.templates.chloe
   9
  10 TUPLE: chloe path ;
  11
  12 C: <chloe> chloe
  13
  14 CHLOE: chloe compile-children ;
  15
  16 CHLOE: title compile-children>string [ set-title ] [code] ;
  17
  18 CHLOE: write-title
  19     drop
  20     "head" tag-stack get member?
  21     "title" tag-stack get member? not and
  22     [ get-title [XML <title><-></title> XML] ]
  23     [ get-title ] ?
  24     [xml-code] ;
  25
  26 CHLOE: style
  27     dup "include" optional-attr [
  28         utf8 file-contents [ add-style ] [code-with]
  29     ] [
  30         compile-children>string [ add-style ] [code]
  31     ] ?if ;
  32
  33 CHLOE: write-style
  34     drop [
  35         get-style
  36         [XML <style type="text/css"> <-> </style> XML]
  37     ] [xml-code] ;
  38
  39 CHLOE: even
  40     [ "index" value even? swap when ] process-children ;
  41
  42 CHLOE: odd
  43     [ "index" value odd? swap when ] process-children ;
  44
  45 : (bind-tag) ( tag quot -- )
  46     [
  47         [ "name" required-attr compile-attr ] keep
  48     ] dip process-children ; inline
  49
  50 CHLOE: each [ with-each-value ] (bind-tag) ;
  51
  52 CHLOE: bind-each [ with-each-object ] (bind-tag) ;
  53
  54 CHLOE: bind [ with-form ] (bind-tag) ;
  55
  56 CHLOE: comment drop ;
  57
  58 CHLOE: call-next-template
  59     drop reset-buffer \ call-next-template , ;
  60
  61 CHLOE: validation-errors
  62     drop [ render-validation-errors ] [code] ;
  63
  64 : attr>word ( value -- word/f )
  65     ":" split1 swap lookup-word ;
  66
  67 : if>quot ( tag -- quot )
  68     [
  69         [ "code" optional-attr [ attr>word [ , ] [ f , ] if* ] [ t , ] if* ]
  70         [ "value" optional-attr [ , \ value , ] [ t , ] if* ]
  71         bi
  72         \ and ,
  73     ] [ ] make ;
  74
  75 CHLOE: if dup if>quot [ swap when ] append process-children ;
  76
  77 COMPONENT: label
  78 COMPONENT: link
  79 COMPONENT: inspector
  80 COMPONENT: comparison
  81 COMPONENT: html
  82 COMPONENT: hidden
  83 COMPONENT: farkup
  84 COMPONENT: field
  85 COMPONENT: textarea
  86 COMPONENT: password
  87 COMPONENT: choice
  88 COMPONENT: checkbox
  89 COMPONENT: code
  90 COMPONENT: xml
  91
  92 SYMBOL: template-cache
  93
  94 H{ } template-cache set-global
  95
  96 TUPLE: cached-template-state path last-modified quot ;
  97
  98 : load-template ( chloe -- cached-template )
  99     path>> ".xml" append
 100     [ ]
 101     [ file-info modified>> ]
 102     [ file>xml compile-template ] tri
 103     \ cached-template-state boa ;
 104
 105 \ load-template DEBUG add-input-logging
 106
 107 : cached-template ( chloe -- cached-template/f )
 108     template-cache get at* [
 109         [
 110             [ path>> file-info modified>> ]
 111             [ last-modified>> ]
 112             bi =
 113         ] keep and
 114     ] when ;
 115
 116 : template-quot ( chloe -- quot )
 117     dup cached-template [ ] [
 118         [ load-template dup ] keep
 119         template-cache get set-at
 120     ] ?if quot>> ;
 121
 122 : reset-cache ( -- )
 123     template-cache get clear-assoc ;
 124
 125 M: chloe call-template*
 126     template-quot call( -- ) ;
 127
 128 INSTANCE: chloe template