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 compiler.units html.templates io
   5 io.encodings.utf8 io.files kernel lexer lexer.private math
   6 namespaces parser parser.notes quotations sequences splitting
   7 vocabs.parser ;
   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         2dup swap tail-slice "%>" head?
  20         [ drop 2 + ] [ (skip-word) ] if
  21     ] change-lexer-column ;
  22
  23 DEFER: <% delimiter
  24
  25 : check-<% ( lexer -- col )
  26     "<%" swap [ line-text>> ] [ column>> ] bi subseq-start-from ;
  27
  28 : found-<% ( accum lexer col -- accum )
  29     [
  30         over line-text>>
  31         [ column>> ] 2dip subseq suffix!
  32         \ write suffix!
  33     ] 2keep 2 + >>column drop ;
  34
  35 : still-looking ( accum lexer -- accum )
  36     [
  37         [ line-text>> ] [ column>> ] bi tail
  38         suffix! \ print suffix!
  39     ] keep next-line ;
  40
  41 : parse-%> ( accum lexer -- accum )
  42     dup still-parsing? [
  43         dup check-<%
  44         [ found-<% ] [ [ still-looking ] keep parse-%> ] if*
  45     ] [
  46         drop
  47     ] if ;
  48
  49 SYNTAX: %> lexer get parse-%> ;
  50
  51 : parse-template-lines ( lines -- quot )
  52     <template-lexer> [
  53         V{ } clone lexer get parse-%> f (parse-until) >quotation
  54     ] with-lexer ;
  55
  56 : parse-template ( string -- quot )
  57     [
  58         [
  59             parser-quiet? on
  60             "html.templates.fhtml" use-vocab
  61             split-lines parse-template-lines
  62         ] with-file-vocabs
  63     ] with-compilation-unit ;
  64
  65 : eval-template ( string -- )
  66     parse-template call( -- ) ;
  67
  68 TUPLE: fhtml path ;
  69
  70 C: <fhtml> fhtml
  71
  72 M: fhtml call-template*
  73     path>> utf8 file-contents eval-template ;
  74
  75 INSTANCE: fhtml template