# Code for creating an index vignette
#' Generate a vignette topical index.
#'
#' Read indexing tags from a set of R-Markdown vignettes and create
#' a new vignette with topic names and links to the tagged locations.
#'
#' The \code{vigindex} function does everything in one call; in ordinary package
#' development, using it with the default areguments will index all of the
#' package's vignettes and create an index source file named
#' \code{"vignette-topics.Rmd"}. If the user wants more control over the
#' process, they may call (in order): \code{compile_vi},
#' \code{add_navigation} (optionally), and \code{write_vi}.
#'
#' If the target file does not exist, one is created.
#' The user may edit the target file once created. The function looks
#' for a line of the form \code{<div class="vigindex" ...>}.
#' Everything after this \code{div}
#' line will be replaced by a new set of indexing information each time
#' \code{vigindex} is run. Everything before the \code{div} line is retained.
#'
#' @param dir character name of directory where vignettes are stored
#' @param vignettes character vector of names of files to index.
#' These files should contain tags for entries in the index; see
#' the section below on index tags.
#' @param target name to store the result (in the same directory).
#' If \code{target} already exists, it will be replaced,
#' except that the initial part of it will be kept as-is.
#' Also, \code{target} is excluded from being indexed,
#' even if it is listed in \code{vignettes}.
#' @param navigation character value determining whether links/anchors should be
#' added to assist in jumping to other places in the index. If \code{"none"},
#' no navigation is added; if \code{"fourths"}, navigation points are placed
#' at four roughly equally-spaced ponts in the index. If \code{"letters"},
#' they are placed at the beginning of each new beginning letter. If
#' \code{"auto"}, it is determined by the number of main entries.
#' @param ... additional arguments. In particular, extra arguments in
#' \code{vigindex} are passed to \code{write_vi}.
#' @return \code{vigindex} and \code{write_vi} return nothing, but the contents
#' of \code{target} are created or altered, and a message indicates when it is
#' complete.
#'
#' @export
#'
#' @section Index tags:
#' Indexing tags are placed within HTML comments in the vignette source
#' files, following a special format illustrated in the following example:
#' \preformatted{
#' ### Everything you want to know about owls {#owls}
#' <!-- @index **Birds**!Owls; `print.owls` -->
#' #' ... lines of text ...
#' #### Popular owls {#pop.owls}
#' <!-- @index birds!owls!!Screech; birds!owls!Great horned
#' Birds!Owls!Barred -->
#' ... lines of text ...
#' <!-- @index Raptors; birds!Owls!others@zzz -->
#' }
#' Entries on the same line are separated by \code{;}, and subentries are delineated
#' by \code{!}. Sorting is done without regard to capitalization or formatting,
#' but a different sorting key may be appended after an \code{@} symbol. Accordingly,
#' with the above examples, the first main entry will be \bold{Birds}
#' (in boldface and capitalized per its first appearance),
#' with a subentry for Owls, in turn with subentries for Barred, Great horned, Screech,
#' and others (last because of the \code{@zzz}). The next main entry will be
#' \code{print.owls}, and finally, Raptors.
#'
#' @section Links:
#' Links in the generated index will be to the latest anchor (of the
#' form \code{\{#anchor\}}) found
#' in the document, or to the top of the file if no anchors occur
#' before the index tag.
#'
#' See \code{vignette("example", package = "vigindex")} for examples and more
#' details.
#'
vigindex = function(dir = "vignettes",
vignettes = dir(dir, pattern = "*.Rmd"),
target = "vignette-topics.Rmd",
navigation = c("auto", "none", "fourths", "letters"),
...) {
tree = compile_vi(dir, vignettes, ...)
tree = add_navigation(tree, navigation, ...)
write_vi(tree, dir, target, ...)
}
#' @rdname vigindex
#' @export
#' @return \code{compile_vi} returns a tree structure with the compiled index.
#' It consists of a named \code{list} of nodes. The names serve as sorting
#' keys for the nodes. Each node is in turn a named list with three elements:
#' \code{text} is a vector of character strings for the entry and any
#' subentries. \code{link} is the character link to associate with the last
#' element of \code{text}. And \code{children} is a named list of nodes of the
#' same form as \code{tree}, containing any subsentries.
#'
compile_vi = function(dir = "vignettes",
vignettes = dir(dir, pattern = "*.Rmd")) {
tree = list()
for (vig in vignettes) {
n.ent = 0
cat(paste(vig, "..."))
buffer = scan(paste(dir, vig, sep = "/"), what = "", sep = "\n", quiet = TRUE)
entlist = find_vientries(buffer)
ext = substring(vig, regexpr("\\.", vig))
vig.html = sub(ext, ".html", vig)
for (ent in entlist) {
link = paste0(vig.html, ent$link)
for (stg in ent$entries) {
if (stg != "") {
ent = strsplit(gsub("\\\\!", "~ba~ng~", stg), "!")[[1]]
tree = insert_entry(tree, gsub("~ba~ng~", "!", ent), link)
n.ent = n.ent + 1
}
}
}
message(n.ent, " entries processed\n")
}
tree
}
#' @rdname vigindex
#' @return \code{add_navigation} returns an amended tree with entries for
#' navigation links.
#' @param tree An index tree such as is returned by \code{compile_vi};
#' see details under Value.
#' @export
add_navigation = function(tree, navigation = c("auto", "none", "fourths", "letters")) {
navigation = match.arg(navigation)
if (navigation == "auto") {
len = length(tree)
navigation = ifelse(len <=25, "none",
ifelse(len <= 125, "fourths", "letters"))
}
keys = sort(tolower(names(tree)))
ltrs = unique(substring(keys, 1, 1))
if (navigation == "fourths") {
findprev = function(chr)
max(1, which(ltrs == chr) - 1)
beg = keys[1 + as.integer(length(keys)*c(0, .25, .5, .75))]
beg = substring(beg, 1, 1)
end = ltrs[c(sapply(beg[-1], findprev), length(ltrs))]
begnav = paste0("[", toupper(beg), "--", toupper(end), "](#", beg, ")")
beghead = paste0("\n\n### ", toupper(beg), "--", toupper(end), " {#", beg, "}\n\n")
topnav = paste0("\n\n### Jump to: (",
paste(begnav, collapse = ") ("), ") {#topnav}\n\n@ ")
}
else if (navigation == "letters") {
beg = ltrs[ltrs %in% letters]
begnav = paste0("[", toupper(ltrs), "](#", ltrs, ")")
beghead = paste0("\n\n### ", toupper(ltrs), " {#", ltrs, "}\n\n")
topnav = paste("\n\n### Jump to: ",
paste(begnav, collapse = " "), " {#topnav}\n\n@ ")
}
if (navigation != "none") {
gototop = "\n\n[Back to top](#topnav)"
tree = insert_entry(tree, topnav)
tree = insert_entry(tree, paste0(beghead[1], "@", beg[1]))
for (i in (1 + seq_along(beghead[-1]))) {
tree = insert_entry(tree, paste0(gototop, beghead[i], "@", beg[i]))
}
tree = insert_entry(tree, paste0(gototop, "@zzzzz"))
}
tree
}
#' @rdname vigindex
#' @param taglines character vector of lines that are added to the
#' end of the index. If not supplied, it adds a promotional link for
#' the \pkg{vigindex} package.
#' @param style Additional text to place at the beginning of the index.
#' If missing, no additional visible text is added, but a standard
#' \code{<style> ... </style>} string is added that should make
#' the formatting more attractive (e.g., no bullets).
#' @export
write_vi = function(tree, dir = getwd("vignettes"),
target = "vignette-topics.Rmd", taglines, ...) {
targ.file = paste(dir, target, sep = "/")
cat("\nPreparing index file ...\n")
if (file.exists(targ.file))
buffer = scan(targ.file, what = "", sep = "\n",
blank.lines.skip = FALSE, quiet = TRUE)
else {
pkgname = rev(strsplit(getwd(), "/")[[1]])[1]
buffer = gsub("<pkgname>", pkgname, default_head)
}
top.end = grep("^<div class[ =\"']+vigindex", buffer) # Look for top of index
if (length(top.end) >= 1)
buffer = c(buffer[seq_len(top.end[1])], "")
else
buffer = c(buffer, "<div class=\"vigindex\">", "")
idx = vi_list2text(tree)
indent = as.integer(substring(idx, 1, 1)) + 1
prefix = sapply(0:8, function(i) paste(c(rep(" ", i), " * "), collapse = ""))
prefix[10] = ""
idx = paste0(prefix[indent], substring(idx, 2))
if (missing(taglines))
taglines = c("","","*Index generated by the [vigindex](https://github.com/rvlenth/vigindex) package.*")
buffer = c(buffer, idx, taglines)
writeLines(text = buffer, con = targ.file)
message("Vignette index file ", targ.file," is completed.")
invisible()
}
# Heading of vignette file if none provided
default_head = c("---", "title: \"Index of vignette topics\"",
"author: \"<pkgname> package\"",
"output: vigindex::html_vigindex",
"vignette: >",
" %\\VignetteIndexEntry{Index of vignette topics}",
" %\\VignetteEngine{knitr::rmarkdown}",
" %\\VignetteEncoding{UTF-8}", "---",
"<div class=\"vigindex\" id=\"Index follows this line; do not edit below\">")
# Create a new vignette-index entry
#
# Create a new object of class \code{vientry}, which has three components:
# \code{text}, \code{link}, and \code{children}
#
# @param text Character value. The text to display (may include markdown formatting)
# @param link Character value. The HTML link for this entry; use \code{NULL} if
# it is just a heading for subsequent child entries
# @param children A \code{\link{list}} of other \code{vientry} objects
vientry = function(text, link = character(0), children = list()) {
entry = list(text = text, link = link, children = children)
### we have no methods, so we won't give it a class
### class(entry) = "vientry"
entry
}
# Make a key for storing an index entry. Typically, we use the entry
# itself, but strip markdown styles like `text`, *text*, and **text**
# But we can manually set a key using text@key
# Note the key is used for sorting entries
# Returns a single space if otherwise it would be character(0)
make_key = function(text) {
text = trimws(text)
key = if (length(grep("@", text)) > 0)
substring(text, 1 + regexpr("@", text))
else
tolower(gsub("`||\\*", "", text))
rtn = ifelse(nchar(key) > 0, key, " ")
}
# insert an index entry use this like:
# main = insert_entry(main, tl, link)
insert_entry = function(parent, text_list, link = list()) {
txt = gsub("\\\\@", "~at~sign~", text_list[1])
key = make_key(txt)
txt = strsplit(txt, "@")[[1]][1] # strip any "@key" portion
txt = gsub("~at~sign~", "@", txt)
if(length(text_list) == 1) {
vi = vientry(txt, link)
if (key %in% names(parent)) { # add this link
parent[[key]]$link = c(parent[[key]]$link, link)
}
else { #add this new entry
parent[[key]] = vi
}
}
else {
if (!(key %in% names(parent))) { # create new entry if not present
parent[[key]] = vientry(text_list[1])
}
# in all cases, add to children of this entry
parent[[key]]$children = insert_entry(parent[[key]]$children, text_list[-1], link)
}
# return the updated tree
parent
}
# convert a list of vientries to a string vector
# 1st character of each is number of levels of indentation
# thus text to show is in substring(result, 2)
# and indent values are as.integer(substring(result, 1, 1))
# We reserve indent level 9 for navigation (entries that start with "\n")
vi_list2text = function(vi, indent = 0) {
stg = character(0)
vi = vi[order(tolower(names(vi)))]
for (ent in vi) {
if (length(ent$link) > 1)
ent = push_down_links(ent)
if (length(ent$link) == 0) {
if (startsWith(ent$text, "\n"))
stg = c(stg, paste0("9", ent$text))
else
stg = c(stg, paste0(indent, ent$text))
}
else if (length(ent$link) == 1)
stg = c(stg, paste0(indent, "[", ent$text, "](", ent$link, ")"))
else { # currently this won't happen since we push them down. But save just in case
nlks = paste0("[", seq_along(ent$link), "](", ent$link, ")")
links = paste0(indent, ent$text, ": ", paste(nlks, collapse = ", "))
stg = c(stg, links)
}
if(length(ent$children) > 0)
stg = c(stg, vi_list2text(ent$children, indent + 1))
}
stg
}
# Push down multiple links into subentries
push_down_links = function(entry) {
lnk = unique(entry$link)
if (length(lnk) < 2)
entry$link = lnk
else {
###txt = lapply(strsplit(lnk, "#"), function(.) sub(".html", "", .))
txt = sub(".html", "", lnk)
txt = paste0("in *", sub("#", ": ", txt), "*@", txt)
for (i in seq_along(lnk))
entry$children = insert_entry(entry$children, txt[[i]], lnk[i])
entry$link = list()
}
entry
}
# Find index entries in a buffer. These look like:
# <!-- @index entry1; entry2!subsentry2; ... -->
# (may continue over several lines)
find_vientries = function(buffer) {
ancloc = grep("*\\{[ ]*#[:alnum:]*[ ]*\\}*", buffer) # anchor locations
beg = grep("^<!-- @index", buffer) # beg of @index lines
end = grep(" -->", buffer) # comment ends
end = sapply(beg, function(.) end[end >= .][1]) # ends of index entries
# extract anchors
a = buffer[ancloc]
a = substring(a, 1 + regexpr("*\\{", a))
anchors = c("", trimws(gsub("\\}", "", a))) # append a blank starting value
ancloc = c(1, ancloc)
# extract index entries and associated anchors
lapply(seq_along(beg), function(i) {
ai = max(which(ancloc <= beg[i]))
text = paste(buffer[beg[i]:end[i]], collapse = "; ")
text = substring(text, 7 + regexpr("@index", text))
text = gsub("-->", "", text)
text = gsub("\\\\;", "~semi~colon~", text) # handle \;
entries = trimws(strsplit(text, ";")[[1]])
entries = gsub("~semi~colon~", ";", entries)
list(entries = entries, link = anchors[ai])
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.