#key type regexpr
TRIPLE <- "^\\{(.+)\\}"
AMPERSAND <- "^&(.+)"
SECTION <- "\\#([ A-z0-9.]+)"
INVERTEDSECTION <- "\\^([ A-z0-9.]+)"
ENDSECTION <- "/([ A-z0-9.]+)"
PARTIAL <- ">\\s*(.+?)\\s*"
COMMENT <- "!.+?"
DELIM <- "=\\s*(.+?)\\s*="
STANDALONE <- "[#/^][A-z0-9]+"
#keytypes
keytypes <- c("", "{}", "&", "#", "^", "/", ">")
# current parsing code is not a clean parsing state machine!
# This is partly due to that this would be clumsy in R,
# It's on my list to do the parsing in C (would be significantly faster)
parseTemplate <- function(template, partials=new.env(), debug=FALSE, strict=TRUE){
#TODO add delimiter switching
delim <- tag2delim()
template <- paste(template, collapse="\n")
template <- replace_delim_tags(template)
template <- removeComments(template, delim)
template <- inlinePartial(template, delim)
template <- inlineStandAlone2(template, delim, STANDALONE)
# template <- inlineStandAlone(template, delim, ENDSECTION)
# template <- inlineStandAlone(template, delim, SECTION)
# template <- inlineStandAlone(template, delim, INVERTEDSECTION)
KEY <- delimit("(.+?)", delim)
text <- strsplit(template, KEY)[[1]]
text <- literal_tags(text)
key <- getKeyInfo(template, KEY)
n <- nrow(key)
render <- list()
#default rendering method
render[1:n] <- list(renderHTML)
#literal rendering
literal <- key$type %in% c("{}", "&")
render[literal] <- list(renderText)
# parse sections and inverted sections
exclude <- logical(n)
insection <- integer(n)
stack <- 0L
for (i in seq_along(key$key)){
h <- stack[1]
insection[i] <- h
type <- key$type[i]
if(type %in% c("#", "^")){
# section and inverted section
stack <- c(i, stack)
} else if (type == "/"){
#end section
stack <- stack[-1]
if (key$key[h]!=key$key[i]){
stop("Template contains unbalanced closing tag. Found: '/", key$key[i], "' but expected: '/", key$key[h],"'")
}
# make a section or inverted section
idx <- which(h==insection)
kidx <- idx[-length(idx)]
renderFUN <- if (key$type[h] == "#") section
else inverted
render[h] <- list(renderFUN( text[idx]
, key$key[kidx]
, render[kidx]
)
)
} else if (type == ">"){
#partial
indent <- sub(">([ \t]*).+","\\1", key$rawkey[i])
render[i] <- list(partial(key$key[i], partials, indent))
}
}
if (length(stack) > 1){
stop("Template does not close the following tags: ", key$rawkey[stack])
}
exclude <- insection > 0
keys <- key$key[!exclude]
texts <- text[c(!exclude, TRUE)[seq_along(text)]] # only select text that is needed
renders <- render[!exclude]
compiled <- function(data=list(), context=list(data)){
values <- lapply(keys, resolve, context=context, strict=strict)
keyinfo <- key
renderTemplate( values=values
, context=context
, texts=texts
, renders=renders
, debug=debug
)
}
class(compiled) <- "template"
compiled
}
getKeyInfo <- function(template, KEY){
first <- gregexpr(KEY, template)[[1]]
last <- attr(first, "match.length") + first - 1
keys <- substring(template, first, last)
keys <- gsub(KEY, "\\1", keys)
key <- data.frame(rawkey=keys, first=first, last=last, stringsAsFactors=FALSE)
# keys should not contain white space, (triple and ampersand may contain surrounding whitespace
key$key <- gsub("\\s", "", key$rawkey)
key$type <- factor("", levels=keytypes)
key$type[grep(TRIPLE, key$rawkey)] <- "{}"
key$type[grep(AMPERSAND, key$rawkey)] <- "&"
key$type[grep(SECTION, key$rawkey)] <- "#"
key$type[grep(INVERTEDSECTION, key$rawkey)] <- "^"
key$type[grep(ENDSECTION, key$rawkey)] <- "/"
key$type[grep(PARTIAL, key$rawkey)] <- ">"
key$key <- gsub(TRIPLE, "\\1",key$key)
key$key <- gsub(AMPERSAND, "\\1",key$key)
key$key <- gsub(SECTION, "\\1",key$key)
key$key <- gsub(INVERTEDSECTION, "\\1",key$key)
key$key <- gsub(ENDSECTION, "\\1",key$key)
key$key <- gsub(PARTIAL, "\\1",key$key)
key
}
inlineStandAlone2 <- function(text, delim, keyregexp){
# remove groups from regexp
keyregexp <- gsub("\\(|\\)","",keyregexp)
dKEY <- delimit(keyregexp, delim)
re <- paste("(?<=\n|^)([ \t]*)(",dKEY,")\\s*?(\n|$)", sep="")
rex <- gregexpr(re, text, perl=T)
rex1 <- gregexpr(dKEY, text)
gsub(re, "\\2", text, perl=T)
}
inlineStandAlone <- function(text, delim, keyregexp){
# remove groups from regexp
keyregexp <- gsub("\\(|\\)","",keyregexp)
dKEY <- delimit(keyregexp, delim)
re <- paste("(^|\n)([ \t]*)(",dKEY,")\\s*?(\n|$)", sep="")
rex <- regexpr(re, text)
gsub(re, "\\1\\3", text)
}
removeComments <- function(text, delim){
text <- inlineStandAlone(text, delim, COMMENT)
#remove inline comments
dCOMMENT <- paste(delim[1],COMMENT, delim[2], sep="")
gsub(dCOMMENT, "", text)
}
inlinePartial <- function(text, delim){
dKEY <- paste(delim[1],PARTIAL, delim[2], sep="")
text <- gsub(dKEY, "{{>\\1}}", text)
re <- paste("(^|\n)([ \t]*)",dKEY,"\\s*?(\n|$)", sep="")
rep <- paste("\\1\\2", delim[1],">\\2\\3",delim[2], sep="")
gsub(re, rep, text)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.