basis/html/templates/fhtml/fhtml.factor

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