basis/html/templates/fhtml/fhtml.factor

   1 ! Copyright (C) 2005 Alex Chapman
   2 ! Copyright (C) 2006, 2008 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
   6 accessors assocs fry
   7 parser lexer io io.files io.streams.string io.encodings.utf8
   8 html.elements
   9 html.templates ;
  10 IN: html.templates.fhtml
  11
  12 ! We use a custom lexer so that %> ends a token even if not
  13 ! followed by whitespace
  14 TUPLE: template-lexer < lexer ;
  15
  16 : <template-lexer> ( lines -- lexer )
  17     template-lexer new-lexer ;
  18
  19 M: template-lexer skip-word
  20     [
  21         {
  22             { [ 2dup nth CHAR: " = ] [ drop 1+ ] }
  23             { [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
  24             [ f skip ]
  25         } cond
  26     ] change-lexer-column ;
  27
  28 DEFER: <% delimiter
  29
  30 : check-<% ( lexer -- col )
  31     "<%" over line-text>> rot column>> start* ;
  32
  33 : found-<% ( accum lexer col -- accum )
  34     [
  35         over line-text>>
  36         [ column>> ] 2dip subseq parsed
  37         \ write-html parsed
  38     ] 2keep 2 + >>column drop ;
  39
  40 : still-looking ( accum lexer -- accum )
  41     [
  42         [ line-text>> ] [ column>> ] bi tail
  43         parsed \ print-html parsed
  44     ] keep next-line ;
  45
  46 : parse-%> ( accum lexer -- accum )
  47     dup still-parsing? [
  48         dup check-<%
  49         [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
  50     ] [
  51         drop
  52     ] if ;
  53
  54 : %> lexer get parse-%> ; parsing
  55
  56 : parse-template-lines ( lines -- quot )
  57     <template-lexer> [
  58         V{ } clone lexer get parse-%> f (parse-until) >quotation
  59     ] with-lexer ;
  60
  61 : parse-template ( string -- quot )
  62     [
  63         "quiet" on
  64         parser-notes off
  65         "html.templates.fhtml" use+
  66         string-lines parse-template-lines
  67     ] with-file-vocabs ;
  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 ] assert-depth ;
  78
  79 INSTANCE: fhtml template