R/newPage.R
In hwriter5: hwriter5: Writing HTML5 from R

newPage <- function(filename, dirname = NULL, title = filename,
                    doctype = "<!DOCTYPE html>\n",
                    html.attributes = "lang='en'",
                    link.javascript = NULL,
                    mathjaxconfig = NULL, mathjax = "default",
                    meta.attributes = "charset='utf-8'",
                    link.css = NULL, css = NULL,
                    head = NULL, head.attributes = NULL,
                    body.attributes = NULL, indent = "  ",
                    contentsOnly = FALSE)
{
  ## today <- format(strptime(date(), "%a %b %d %H:%M:%S %Y"), "%B %d, %Y")

  ## Create equation numbers and list for labels
  ## Set up new environment for equation list and equation number counter
  hwriterEquation <- numeric(0)
  hwriterEquationList <- character(0)
  hwriteLatex <- function(ltx, page = NULL, equationStyle = NULL, ...)
  {
    ## cat is used to write to files,
    ## deal with output to standard output
    if (is.null(page)) page = ""
    ## count: add a (#)
    ## label: add before: Equation (#): label
    if (! is(ltx, "latex")) ltx <- as.latex(ltx)
    if (ltx$inline){
      ## inline: directly there in the text
      ## (can't be counted or labeled)
      cat(paste0("\\(", ltx$alt,"\\)"),
          file = page, append = TRUE, sep = " ")
    } else {
      if (is.null(equationStyle)){
        equationStyle <- defaultEquationStyle
        cat(equationStyle, file = page, append = TRUE)
      }
      ## not inline: will be within a table to center it
      if (ltx$count) {
        ## update counter hwriterEquation
        hwriterEquation <- hwriterEquation + 1
        ## deal with label
        if (is.null(ltx$label)){
          hwriterEquationList[hwriterEquation] <- paste0("eq:", hwriterEquation)
          eqnLabel <- paste("eq:", eqnNum, sep = "")
        } else {
          hwriterEquationList[hwriterEquation] <- paste0("eq:", ltx$label)
          eqnLabel <- paste0("eq:", ltx$label)
        }
        ## write out equation as table with equation number
        cat(paste0("\\n<center><table class='equationdisplay'>\\n",
                  "<tr>\\n",
                  "<td='equation'>\\n ",
                  ">\\[", ltx$alt, "\\]</td>\\n",
                  "<td class='equation' id = '",
                    eqnLabel,"'>(", eqnNum,")</td>\\n",
                  "</tr>\\n",
                  "</table>\\n",
                  "</center>\\n",
                  ),
            file = page, append = TRUE)
      } else {
        cat(paste("<center>\\n",
                  "<table class='equationdisplay'>\\n",
                  "<tr>\\n",
                  "<td class='equation'>\\n",
                  "\\[", ltx$alt, "\\]\\n",
                  "</td>\\n",
                  "</tr>\\n",
                  "</table>\\n",
                  "</center>\\n",
                  sep = ""),
            file = page, append = TRUE)
      }
    }
  }

  if (!is.null(dirname)) {
    if (!file.exists(dirname)){
      dir.create(dirname, recursive = TRUE, showWarnings = FALSE)
    }
    filename <- file.path(dirname, filename)
  }
  page <- file(filename, "wt")

  if (!contentsOnly) {
    if (!is.null(link.javascript)){
      link.javascript <- paste(hmakeTag("script", type = "text/javascript",
                                        src = link.javascript),
                               collapse = "\n")
    }
    if (!is.null(mathjaxconfig)){
      if (mathjaxconfig == "default") {
        mathJaxConfig  <- defaultMathJaxConfig
      } else {
        mathJaxConfig <- mathjaxconfig
      }
      mathjaxconfig <- paste(hmakeTag("script",
                                      type = "text/x-mathjax-config",
                                      data = mathJaxConfig, indent = indent,
                                      newline = TRUE),
                             collapse = "\n")
      mathjaxconfig <- paste0(indent, mathjaxconfig)
      mathjaxconfig <- sub("</script>", paste0("\n", indent, "</script>"),
                           mathjaxconfig, fixed = TRUE)
    }
    if (!is.null(mathjax)){
      if (mathjax == "default") {
        mathJaxSource  <- defaultMathJax
      } else {
        mathJaxSource <- mathjax
      }
      mathjax <- paste(hmakeTag("script", type = "text/javascript",
                                src = mathJaxSource, indent = indent,
                                newline = TRUE),
                       collapse = "\n")
      mathjax <- paste0(indent, mathjax)
    }
    if (!is.null(link.css)){
      link.css <- paste(hmakeTag("link", rel = "stylesheet",
                                 type = "text/css", href = link.css,
                                 indent = indent, newline = TRUE),
                        collapse = "\n")
    }
    if (!is.null(css)){
      css <- paste0(indent,
                    paste(hmakeTag("style", css, indent = indent,
                                   newline = TRUE),
                          collapse = "\n"),
                    "\n")
      ## required by HTML5 validator or maybe not
      ##css <- sub("<style", "<style scoped", css, fixed = TRUE)
      css <- sub("</style>", paste0("\n", indent, "</style>"), css,
                 fixed = TRUE)
    }
    head <- paste(hmakeTag("title", title, indent = indent, newline = FALSE),
                  head, link.javascript,
                  mathjaxconfig, mathjax, link.css, css, sep = "\n")
    head <- do.call(hmakeTag,
                    c(list("head", head, indent = indent, newline = TRUE),
                      head.attributes))
    head <- gsub("(\n)+", "\n", head)
    head <- sub("</head>", paste0(indent, "</head>\n", indent), head,
                fixed = TRUE)
    bodyStart <- do.call(hmakeTag, c(list("body", NULL, indent = indent,
                                          newline = TRUE),
                                     body.attributes))
    bodyStart <- substr(bodyStart, 1, regexpr("</body>", bodyStart) - 1)
    hwrite(paste0(doctype, "<html ", html.attributes, ">\n  ",
                  head, bodyStart), page)
  } else {
    if (!is.null(link.css)){
      link.css <- paste(hmakeTag("link", rel = "stylesheet",
                                 type = "text/css", href = link.css,
                                 indent = indent, newline = TRUE),
                        collapse = "\n")
    }
    if (!is.null(css)){
      css <- paste0(indent,
                    paste(hmakeTag("style", css, indent = indent,
                                   newline = TRUE),
                          collapse = "\n"),
                    "\n")
      ## required by HTML5 validator or maybe not
      ##css <- sub("<style", "<style scoped", css, fixed = TRUE)
      css <- sub("</style>", paste0("\n", indent, "</style>"), css,
                 fixed = TRUE)
    }
    head <- paste(link.css, css, collapse = "\n")
    head <- gsub("(\n)+", "\n", head)
    hwrite(head, page)
  }
  list(p = page, hwriteLatex = hwriteLatex)
}