basis/html/templates/fhtml/fhtml.factor

   1 ! Copyright (C) 2005 Alex Chapman
   2 ! Copyright (C) 2006, 2010 Slava Pestov
   3 ! See http://factorcode.org/license.txt for BSD license.
   4 USING: accessors combinators compiler.units html.templates io
   5 io.encodings.utf8 io.files kernel lexer math namespaces parser
   6 parser.notes quotations sequences splitting vocabs.parser ;
   7 IN: html.templates.fhtml
   8
   9 ! We use a custom lexer so that %> ends a token even if not
  10 ! followed by whitespace
  11 TUPLE: template-lexer < lexer ;
  12
  13 : <template-lexer> ( lines -- lexer )
  14     template-lexer new-lexer ;
  15
  16 M: template-lexer skip-word
  17     [
  18         {
  19             { [ 2dup nth CHAR: \" = ] [ drop 1 + ] }
  20             { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
  21             [ f skip ]
  22         } cond
  23     ] change-lexer-column ;
  24
  25 DEFER: <% delimiter
  26
  27 : check-<% ( lexer -- col )
  28     "<%" swap [ line-text>> ] [ column>> ] bi subseq-start-from ;
  29
  30 : found-<% ( accum lexer col -- accum )
  31     [
  32         over line-text>>
  33         [ column>> ] 2dip subseq suffix!
  34         \ write suffix!
  35     ] 2keep 2 + >>column drop ;
  36
  37 : still-looking ( accum lexer -- accum )
  38     [
  39         [ line-text>> ] [ column>> ] bi tail
  40         suffix! \ print suffix!
  41     ] keep next-line ;
  42
  43 : parse-%> ( accum lexer -- accum )
  44     dup still-parsing? [
  45         dup check-<%
  46         [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
  47     ] [
  48         drop
  49     ] if ;
  50
  51 SYNTAX: %> lexer get parse-%> ;
  52
  53 : parse-template-lines ( lines -- quot )
  54     <template-lexer> [
  55         V{ } clone lexer get parse-%> f (parse-until) >quotation
  56     ] with-lexer ;
  57
  58 : parse-template ( string -- quot )
  59     [
  60         [
  61             parser-quiet? on
  62             "html.templates.fhtml" use-vocab
  63             string-lines parse-template-lines
  64         ] with-file-vocabs
  65     ] with-compilation-unit ;
  66
  67 : eval-template ( string -- )
  68     parse-template call( -- ) ;
  69
  70 TUPLE: fhtml path ;
  71
  72 C: <fhtml> fhtml
  73
  74 M: fhtml call-template*
  75     path>> utf8 file-contents eval-template ;
  76
  77 INSTANCE: fhtml template