R/html_e2m.R
In exams.forge: Support for Compiling Examination Tasks using the 'exams' Package

Documented in html_e2m

#' @title HTML `exams.forge`
#' @rdname html_e2m
#' @aliases toHTML_XML
#' @description Creates an HTML page with all the contents of the XML tags whose names match \code{pattern}.\cr\cr
#' The default is to show the contents of all XML tags. The HTML page is stored in the HTML file \code{name}.\cr\cr
#' The default \code{name=NULL} creates a temporary file. If the name does not end in \code{.html}, then a \code{.html} is appended.
#'
#' If \code{browseURL=TRUE} (default) then the HTML page will be displayed in the browser.
#'
#' If necessary the contents of XML tags are concatenated with \code{"\n"}.
#' For single XML tags this can be changed, e.g. \code{merge=list("questionlist"="<br>"} leads to the XML tag
#' \code{<questionlist>...</questionlist>)} \code{"<br>"} being used ,instead of the \code{"\n"}.
#' @seealso The aim is similar to \code{exams:::exams:::browse_exercise}, however, \code{html_e2m} takes the information form
#' the XML file generated by the \code{exams.forge} package.
#'
#' @param exam list: returns a list from \code{exams.forge}
#' @param name character: name of the HTML file (default: \code{NULL})
#' @param pattern character: string containing a regular expression to match the list elements (default: \code{.})
#' @param mathjax logical: should MathJax be loaded? (default: \code{TRUE})
#' @param browseURL logical: should the generated HTML be shown? (default: \code{TRUE})
#' @param overwrite logical: should the HTML file be overwritten (if it exists)? (default: \code{FALSE})
#' @param header integer: at which level of the list a \code{<h2>...</h2>} element should be included? (default: \code{2})
#' @param merge list: should elements with \code{.XXXXnn} at the end be merged? (default: \code{list('questionlist'="<br>")})
#' @param png logical: if a entry ends with \code{.png} then the function will try to embed the PNG in the output
#'
#' @return Invisibly, the names of listed elements in the HTML file.
#' @importFrom utils browseURL
#' @importFrom base64enc base64encode
#' @export
#'
#' @examples
#' if (interactive()) {
#'   resexams <- readRDS(system.file("xml", "klausur-test.rds", package="exams.moodle"))
#'   html_e2m(resexams) # opens HTML file into browser
#' }
html_e2m <- function(exam, name=NULL, pattern=".", mathjax=TRUE, browseURL=TRUE, overwrite=FALSE,
                     header=2, merge=list('questionlist'="<br>"), png=TRUE) {
  if (is.null(name)) name <- tempfile()
  if (!endsWith(name, ".html")) name <- paste0(name, ".html")

  lst  <- unlist(exam)
  nlst <- names(lst)
  if (!is.null(merge)) {
    nlst  <- gsub('[0-9]+$', '', nlst)
    index <- structure(1:length(nlst), names=nlst)
    plst  <- names(merge)
    lst   <- tapply(index, nlst, function(ind) {
      if (length(ind)<2) return(lst[ind])
      for (i in 1:length(plst)) {
        if (grepl(plst[i], nlst[ind[1]])) {
          return(paste0(lst[ind], collapse=merge[[i]]))
        }
      }
      paste0(lst[ind], collapse="\n")
    })
    nlst  <- names(lst)
  }
  elem <- grepl(pattern, nlst)
  stopifnot(sum(elem)>0)
  lst  <- lst[elem]
  nlst <- names(lst)
  slst <- strsplit(nlst, '.', fixed=TRUE)
  # create html
  ret  <- '<!DOCTYPE html><html><head>'
  if (mathjax) {
    ret  <- c(ret, '<script type="text/javascript" src="http://cdn.mathjax.org/mathjax/latest/MathJax.js?config=TeX-AMS-MML_HTMLorMML"></script>')
  }
  ret <- c(ret, '</head><body>')
  if (header>0) lastheader <- rep('', header)
  for (i in 1:length(lst)) {
    if (header>0) {
      if (any(lastheader!=slst[[i]][1:header])) {
        if (i>1) ret <- c(ret, "</table>")
        lastheader <- slst[[i]][1:header]
        ret <- c(ret, sprintf('<h2>%s</h2>', paste(lastheader, collapse=" ")))
        ret <- c(ret, '<table width="100%">')
      }
    }
    img <- ''
    if (png && !is.na(lst[i]) && endsWith(lst[i], ".png")) {
      if (file.exists(lst[i])) img <- sprintf('<br><img src="data:image/png;base64,%s"></body>', base64encode(lst[i]))
    }
    ret <- c(ret, sprintf('<tr><td><div id="%s" width="100%%">%s%s</div></td>', nlst[i], lst[i], img))
    if (header>0) slst[[i]] <- slst[[i]][-(1:header)]
    ret <- c(ret, sprintf('<td style="text-align:right;background-color: grey;">%s</td></tr>',
                          paste0(slst[[i]], collapse=" "))
    )
  }
  ret <- c(ret, "</table></body></html>")
  if (all(!endsWith(name, c(".html", ".htm")))) name <- paste0(name, '_xml.html')
  if (!file.exists(name) | overwrite) {
    writeLines(ret, name)
    if (browseURL) browseURL(name)
  }
  invisible(nlst)
}

#' @rdname html_e2m
#' @export
# toHTML.XML <- function(...){
#  html_e2m(...)}
toHTML_XML <- html_e2m