basis/html/templates/templates.factor

   1 ! Copyright (C) 2008 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors kernel fry io io.encodings.utf8 io.files
   4 debugger prettyprint continuations namespaces boxes sequences
   5 arrays strings html io.streams.string
   6 quotations xml.data xml.writer xml.syntax ;
   7 IN: html.templates
   8
   9 MIXIN: template
  10
  11 GENERIC: call-template* ( template -- )
  12
  13 M: string call-template* write ;
  14
  15 M: callable call-template* call ;
  16
  17 M: xml call-template* write-xml ;
  18
  19 M: object call-template* output-stream get stream-copy ;
  20
  21 ERROR: template-error template error ;
  22
  23 M: template-error error.
  24     "Error while processing template " write
  25     [ template>> short. ":" print nl ]
  26     [ error>> error. ]
  27     bi ;
  28
  29 : call-template ( template -- )
  30     [ call-template* ] [ \ template-error boa rethrow ] recover ;
  31
  32 SYMBOL: title
  33
  34 : set-title ( string -- )
  35     title get >box ;
  36
  37 : write-title ( -- )
  38     title get value>> write ;
  39
  40 SYMBOL: style
  41
  42 : add-style ( string -- )
  43     "\n" style get push-all
  44          style get push-all ;
  45
  46 : write-style ( -- )
  47     style get >string write ;
  48
  49 SYMBOL: atom-feeds
  50
  51 : add-atom-feed ( title url -- )
  52     2array atom-feeds get push ;
  53
  54 : write-atom-feeds ( -- )
  55     atom-feeds get [
  56         first2 [XML
  57             <link
  58                 rel="alternate"
  59                 type="application/atom+xml"
  60                 title=<->
  61                 href=<->/>
  62         XML] write-xml
  63     ] each ;
  64
  65 SYMBOL: nested-template?
  66
  67 SYMBOL: next-template
  68
  69 : call-next-template ( -- )
  70     next-template get write ;
  71
  72 M: f call-template* drop call-next-template ;
  73
  74 : with-boilerplate ( child master -- )
  75     [
  76         title [ <box> or ] change
  77         style [ SBUF" " clone or ] change
  78         atom-feeds [ V{ } like ] change
  79
  80         [
  81             [
  82                 nested-template? on
  83                 call-template
  84             ] with-string-writer
  85             next-template set
  86         ]
  87         [ call-template ]
  88         bi*
  89     ] with-scope ; inline
  90
  91 : template-convert ( template output -- )
  92     utf8 [ call-template ] with-file-writer ;