Merge pull request #121 from jfisher-usgs/master

merge with upstream

Author: jfisher-usgs

NEWS.md

@@ -10,7 +10,9 @@
   fix parsing bug on identifying code blocks; tidy main header for each help topic;
   add `internal` argument, used to print help pages flagged with keyword `internal`;
   replace `hr` argument with `sep` argument;
-  add `replace_title` argument, used to replace the help-topic "title" with its "name".
+  add `title_to_name` argument, used to replace the help-topic "title" with its "name";
+  add `notrun` argument, used to remove `## Not run` comments;
+  include internal links for package by default.
 
 - In `Grid2Polygons`, add `check_validity` argument, used to check the validity of polygons.
 

R/ExtractAlongTransect.R

@@ -59,11 +59,12 @@
 #'           xlim = xlim, ylim = ylim, type = "n")
 #' cols <- GetColors(length(segs), scheme = "bright")
 #' for (i in seq_along(segs))
-#'   lines(segs[[i]]@data[, c("dist", "value")], col = cols[i])
+#'   lines(segs[[i]]@data[, c("dist", "value")],
+#'         col = cols[i], lwd = 2)
 #' coords <- sp::coordinates(transect)
 #' n <- length(transect)
 #' d <- cumsum(c(0, as.matrix(dist((coords)))[cbind(1:(n - 1), 2:n)]))
-#' abline(v = d, col = "green", lty = 2)
+#' abline(v = d, lty = 2)
 #' mtext(sprintf("(%d, %d)", coords[1, 1], coords[1, 2]),
 #'       line = -1, adj = 0, cex = 0.7)
 #' mtext(sprintf("(%d, %d)", coords[n, 1], coords[n, 2]),

R/PrintPackageHelp.R

@@ -1,24 +1,26 @@
 #' Print Package Help Documentation
 #'
-#' Print the HTML code associated with the help documentation of one or more add-on packages.
+#' Print the HTML code associated with the help documentation of one or more \R packages.
 #'
 #' @param pkg 'character' vector.
 #'   Package name(s)
 #' @param file 'connection' or 'character' string.
 #'   Names the file to append output to.
 #'   Prints to the standard output connection by default.
 #' @param internal 'logical' flag.
-#'   Whether to print help topics flagged with the keyword "internal".
+#'   Whether to print help topics flagged with the keyword \dQuote{internal}.
 #' @param toc 'logical' flag.
 #'   Whether to format level-2 headers (help-topic titles) using a Markdown syntax.
 #'   This is required when specifying the table-of-contents (toc) format option in R Markdown,
 #'   see \code{\link[rmarkdown:render]{rmarkdown::render}} function for details.
-#' @param replace_title 'logical' flag.
+#' @param title_to_name 'logical' flag.
 #'   Whether to replace the help-topic \dQuote{title} with its \dQuote{name}.
 #' @param sep 'character' string.
 #'   HTML to separate help topics, a horizontal line by default.
-#' @param links 'character' vector (experimental).
-#'   Names of packages searched when creating internal hyperlinks to help topics.
+#' @param notrun 'logical' flag.
+#'   Whether to inlcude \code{## Not run} comments in the Examples section of help documentation.
+#' @param links 'character' vector.
+#'   Names of packages searched (level 0) when creating internal hyperlinks to functions and datasets.
 #' @param ...
 #'   Not used
 #'
@@ -41,7 +43,8 @@
 #'     "---",
 #'     sep = "\n", file = "help-example.Rmd")
 #' PrintPackageHelp("inlmisc", file = "help-example.Rmd",
-#'                  toc = TRUE, replace_title = TRUE)
+#'                  toc = TRUE, title_to_name = TRUE,
+#'                  notrun = FALSE)
 #' rmarkdown::render("help-example.Rmd")
 #' url <- file.path("file:/", getwd(), "help-example.html")
 #' utils::browseURL(url)
@@ -50,14 +53,15 @@
 #' }
 #'
 
-PrintPackageHelp <- function(pkg, file="", internal=FALSE,
-                             toc=FALSE, replace_title=FALSE,
-                             sep="<hr>", links=NULL, ...) {
+PrintPackageHelp <- function(pkg, file="", internal=FALSE, toc=FALSE,
+                             title_to_name=FALSE, notrun=TRUE, sep="<hr>",
+                             links=pkg, ...) {
 
   checkmate::assertCharacter(pkg, unique=TRUE)
   checkmate::assertFlag(internal)
   checkmate::assertFlag(toc)
-  checkmate::assertFlag(replace_title)
+  checkmate::assertFlag(title_to_name)
+  checkmate::assertFlag(notrun)
   checkmate::assertString(sep, null.ok=TRUE)
   checkmate::assertCharacter(links, unique=TRUE, null.ok=TRUE)
 
@@ -88,42 +92,65 @@ PrintPackageHelp <- function(pkg, file="", internal=FALSE,
   # identify links
   if (!is.null(links)) {
     d <- .GetHelpMeta(links)
-    links <- paste0("#", d$name)
+    links <- paste0("#", tolower(gsub(" ", "-", d$name)))
     names(links) <- d$name
   }
 
   # loop through help items
   for (i in seq_along(rd)) {
 
     # convert rd to html
-    htm <- utils::capture.output(tools::Rd2HTML(rd[[i]],
-                                                no_links=is.null(links),
-                                                Links=links,
-                                                Links2=links))
+    htm <- utils::capture.output({
+      suppressWarnings(tools::Rd2HTML(rd[[i]],
+                                      no_links=is.null(links),
+                                      Links=links,
+                                      Links2=links))
+    })
 
-    # update level-2 header (title of help documentation)
-    idx <- pmatch("<h2>", htm)
+    # remove broken internal links
+    pattern <- "<a href=\\\"\\.\\./\\.\\./.*\\\">.*</a>"
+    for (j in grep(pattern, htm)) {
+      repeat {
+        st <- htm[j]
+        re <- regexpr(pattern, st)
+        if (re == -1) break
+        st <- substr(st, re, re + attr(re, "match") - 1L)
+        st <- sub("<a.*\">", "", sub("</a>", "", st))
+        htm[j] <- sub(pattern, st, htm[j])
+      }
+    }
+
+    # substitute level-2 header (title of help documentation)
+    idx <- grep("<h2>", htm)
     ti <- gsub("<.*?>", "", htm[idx])
     nm <- names(rd)[i]
+    id <- tolower(gsub(" ", "-", nm))
     if (toc) {
-      if (replace_title)
-        txt <- sprintf("\n## %s\n\n*%s*", nm, ti)
+      if (title_to_name)
+        txt <- sprintf("\n## %s {#%s}\n\n*%s*", nm, id, ti)
       else
-        txt <- sprintf("\n## %s {#%s}", ti, nm)
+        txt <- sprintf("\n## %s {#%s}", ti, id)
       cat(txt, file=file, sep="\n\n", append=TRUE)
-    } else if (replace_title) {
-      htm[idx] <- sprintf("<h2>%s</h2>\n\n<em>%s</em>\n", nm, ti)
+    } else if (title_to_name) {
+      htm[idx] <- sprintf("<h2 id=\"%s\">%s</h2>\n\n<em>%s</em>\n",
+                          id, nm, ti)
     }
 
     # remove extraneous lines at beginning and end of help page
     htm <- htm[-c(seq_len(idx - !toc), length(htm))]
 
+    # remove 'not run' commented lines
+    if (!notrun) {
+      idx <- which(htm %in% c("## Not run: ", "## End(Not run)"))
+      if (length(idx) > 0) htm <- htm[-idx]
+    }
+
     # edit code-chunk tags to use syntax highlighting
     htm_trim <- trimws(htm)
     htm[htm_trim == "</pre>"] <- "</code></pre>"
     idx <- which(htm_trim == "<pre>")
-    htm[idx + 1L] <- sprintf("<pre class=\"lang-r\"><code class=\"lang-r\">%s",
-                             htm[idx + 1L])
+    fmt <- "<pre class=\"lang-r\"><code class=\"lang-r\">%s"
+    htm[idx + 1L] <- sprintf(fmt, htm[idx + 1L])
     htm[idx] <- ""
 
     # remove empty lines everywhere but in examples section
@@ -149,11 +176,13 @@ PrintPackageHelp <- function(pkg, file="", internal=FALSE,
       src <- sub("..", system.file(package=meta$package[i]), src)
       for (f in src) checkmate::assertFileExists(f, access="r")
       uri <- vapply(src, function(f) knitr::image_uri(f), "")
-      htm[is] <- sprintf("<p><img src=\"%s\" alt=\"%s\" />", uri, basename(src))
+      fmt <- "<p><img src=\"%s\" alt=\"%s\" />"
+      htm[is] <- sprintf(fmt, uri, basename(src))
     }
 
     # add seperator
-    if (!is.null(sep) && i < nrow(meta)) htm <- c(htm, sprintf("\n%s\n", sep))
+    if (!is.null(sep) && i < nrow(meta))
+      htm <- c(htm, sprintf("\n%s\n", sep))
 
     # preserve html
     htm <- htmltools::htmlPreserve(htm)
@@ -194,9 +223,10 @@ PrintPackageHelp <- function(pkg, file="", internal=FALSE,
     stop(gettextf("invalid %s argument", sQuote("file")), domain=NA)
   pkgname <- basename(dirpath)
   rddb <- file.path(path, pkgname)
-  if (!file.exists(paste0(rddb, ".rdx")))
-    stop(gettextf("package %s exists but was not installed under R >= 2.10.0 so help cannot be accessed",
-                  sQuote(pkgname)), domain=NA)
+  if (!file.exists(paste0(rddb, ".rdx"))) {
+    fmt <- "package %s exists but was not installed under R >= 2.10.0 so help cannot be accessed"
+    stop(gettextf(fmt, sQuote(pkgname)), domain=NA)
+  }
   .FetchRdDB(rddb, basename(file))
 }
 

R/PrintTable.R

@@ -85,6 +85,7 @@
 #' \dontrun{
 #' sink("table-example.tex")
 #' cat("\\documentclass{article}",
+#'     "\\usepackage{geometry}",
 #'     "\\usepackage[labelsep = period, labelfont = bf]{caption}",
 #'     "\\usepackage{siunitx}",
 #'     "\\sisetup{input-ignore = {,}, input-decimal-markers = {.},",
@@ -122,7 +123,7 @@
 #' PrintTable(d, colheadings, align)
 #' cat("\\end{document}\n")
 #' sink()
-#' tools::texi2pdf("table-example.tex", clean = TRUE)  # requires TeX
+#' tinytex::pdflatex("table-example.tex")  # requires TeX
 #' system("open table-example.pdf")
 #'
 #' file.remove("table-example.tex", "table-example.pdf")

R/usgs_article.R

@@ -15,6 +15,14 @@
 #'
 #' @examples
 #' \dontrun{
+#' # install LaTeX distribution
+#' if (Sys.which("pdflatex") == "" && !tinytex:::is_tinytex())
+#'   tinytex::install_tinytex()
+#'
+#' # install LaTeX packages
+#' if (tinytex:::is_tinytex())
+#'   inlmisc:::InstallLatexPackages()
+#'
 #' rmarkdown::draft("myarticle.Rmd",
 #'                  template = "usgs_article",
 #'                  package = "inlmisc")
@@ -113,3 +121,12 @@ usgs_article <- function(...) {
 
   base
 }
+
+
+# install required LaTeX packages into TinyTeX
+InstallLatexPackages <- function() {
+  file <- system.file("misc", "latex-packages.txt", package="inlmisc")
+  pkgs <- readLines(file)
+  pkgs <- pkgs[!pkgs %in% tinytex::tl_pkgs()]
+  tinytex::tlmgr_install(pkgs)
+}

inst/misc/latex-packages.txt

@@ -0,0 +1,20 @@
+biblatex
+enumitem
+fancyhdr
+footmisc
+listofitems
+logreq
+makecell
+ms
+multirow
+psnfss
+ragged2e
+readarray
+rsfs
+sectsty
+siunitx
+symbol
+tocloft
+verbatimbox
+xcolor
+xpatch

inst/misc/preamble.tex

@@ -16,7 +16,7 @@
 
 
 % Layout
-\usepackage[tmargin=1.00in, bmargin=0.67in, lmargin=0.58in, rmargin=0.75in]{geometry}  % define margins
+\usepackage[tmargin=1.000in, bmargin=0.667in, lmargin=0.750in, rmargin=0.583in]{geometry}  % define margins
 \usepackage[pdftex]{lscape}  % place selected parts of a document in landscape
 
 
@@ -113,8 +113,8 @@
 \DeclareFieldFormat{title}{#1}
 \DeclareFieldFormat[article,thesis,report,incollection,inproceedings,misc]{title}{#1}
 \DeclareFieldFormat[incollection,inproceedings]{booktitle}{#1}
-\DeclareNameAlias{sortname}{last-first}
-\DeclareNameAlias{default}{last-first}
+\DeclareNameAlias{sortname}{family-given}
+\DeclareNameAlias{default}{family-given}
 \DefineBibliographyStrings{english}{pagetotal={p\adddot}, pagetotals={p\adddot}}
 \DefineBibliographyStrings{english}{references={References Cited}}
 \renewcommand*{\newunitpunct}{\addcomma\space}

inst/rmarkdown/templates/usgs_article/skeleton/usgs.sty

@@ -22,7 +22,7 @@
 
 % Layout -----------------------------------------------------------------------
 
-\RequirePackage[tmargin=1.00in, bmargin=0.67in, lmargin=0.58in, rmargin=0.75in]{geometry}  % define margins
+\RequirePackage[tmargin=1.000in, bmargin=0.667in, lmargin=0.750in, rmargin=0.583in]{geometry}  % define margins
 \RequirePackage[pdftex]{lscape}  % place selected parts of a document in landscape
 
 % Headers ----------------------------------------------------------------------