2007-09-20 18:09:08 -04:00
|
|
|
! Copyright (C) 2005 Alex Chapman
|
2009-01-31 21:44:17 -05:00
|
|
|
! Copyright (C) 2006, 2009 Slava Pestov
|
2007-09-20 18:09:08 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2008-04-15 07:10:08 -04:00
|
|
|
USING: continuations sequences kernel namespaces debugger
|
2009-01-31 21:44:17 -05:00
|
|
|
combinators math quotations generic strings splitting accessors
|
2009-05-16 14:34:47 -04:00
|
|
|
assocs fry vocabs.parser parser parser.notes lexer io io.files
|
2009-05-19 19:53:12 -04:00
|
|
|
io.streams.string io.encodings.utf8 html.templates compiler.units ;
|
2008-05-23 20:16:21 -04:00
|
|
|
IN: html.templates.fhtml
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
! We use a custom lexer so that %> ends a token even if not
|
|
|
|
! followed by whitespace
|
2008-04-14 05:34:26 -04:00
|
|
|
TUPLE: template-lexer < lexer ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: <template-lexer> ( lines -- lexer )
|
2008-04-14 06:07:31 -04:00
|
|
|
template-lexer new-lexer ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
M: template-lexer skip-word
|
|
|
|
[
|
|
|
|
{
|
2009-08-13 20:21:44 -04:00
|
|
|
{ [ 2dup nth CHAR: " = ] [ drop 1 + ] }
|
2007-09-20 18:09:08 -04:00
|
|
|
{ [ 2dup swap tail-slice "%>" head? ] [ drop 2 + ] }
|
2008-04-11 13:55:57 -04:00
|
|
|
[ f skip ]
|
2007-09-20 18:09:08 -04:00
|
|
|
} cond
|
2008-03-20 20:54:25 -04:00
|
|
|
] change-lexer-column ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
DEFER: <% delimiter
|
|
|
|
|
|
|
|
: check-<% ( lexer -- col )
|
2008-04-14 05:34:26 -04:00
|
|
|
"<%" over line-text>> rot column>> start* ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: found-<% ( accum lexer col -- accum )
|
|
|
|
[
|
2008-04-14 05:34:26 -04:00
|
|
|
over line-text>>
|
2008-05-23 20:16:21 -04:00
|
|
|
[ column>> ] 2dip subseq parsed
|
2009-01-31 21:44:17 -05:00
|
|
|
\ write parsed
|
2008-04-14 05:34:26 -04:00
|
|
|
] 2keep 2 + >>column drop ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: still-looking ( accum lexer -- accum )
|
|
|
|
[
|
2008-04-14 05:34:26 -04:00
|
|
|
[ line-text>> ] [ column>> ] bi tail
|
2009-01-31 21:44:17 -05:00
|
|
|
parsed \ print parsed
|
2007-09-20 18:09:08 -04:00
|
|
|
] keep next-line ;
|
|
|
|
|
|
|
|
: parse-%> ( accum lexer -- accum )
|
|
|
|
dup still-parsing? [
|
|
|
|
dup check-<%
|
|
|
|
[ found-<% ] [ [ still-looking ] keep parse-%> ] if*
|
|
|
|
] [
|
|
|
|
drop
|
|
|
|
] if ;
|
|
|
|
|
2009-03-21 02:27:50 -04:00
|
|
|
SYNTAX: %> lexer get parse-%> ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: parse-template-lines ( lines -- quot )
|
|
|
|
<template-lexer> [
|
2008-06-25 04:25:08 -04:00
|
|
|
V{ } clone lexer get parse-%> f (parse-until) >quotation
|
|
|
|
] with-lexer ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
|
|
|
: parse-template ( string -- quot )
|
|
|
|
[
|
2009-05-19 19:53:12 -04:00
|
|
|
[
|
2008-05-23 20:16:21 -04:00
|
|
|
"quiet" on
|
|
|
|
parser-notes off
|
2009-05-15 00:23:06 -04:00
|
|
|
"html.templates.fhtml" use-vocab
|
2007-09-20 18:09:08 -04:00
|
|
|
string-lines parse-template-lines
|
2009-05-19 19:53:12 -04:00
|
|
|
] with-file-vocabs
|
|
|
|
] with-compilation-unit ;
|
2007-09-20 18:09:08 -04:00
|
|
|
|
2008-05-23 20:16:21 -04:00
|
|
|
: eval-template ( string -- )
|
2009-03-16 21:11:36 -04:00
|
|
|
parse-template call( -- ) ;
|
2007-10-09 04:40:04 -04:00
|
|
|
|
2008-04-15 07:10:08 -04:00
|
|
|
TUPLE: fhtml path ;
|
|
|
|
|
|
|
|
C: <fhtml> fhtml
|
|
|
|
|
2008-04-22 22:08:27 -04:00
|
|
|
M: fhtml call-template* ( filename -- )
|
2009-02-09 00:49:05 -05:00
|
|
|
[ path>> utf8 file-contents eval-template ] call( filename -- ) ;
|
2008-04-16 00:36:27 -04:00
|
|
|
|
|
|
|
INSTANCE: fhtml template
|