#' Build home page
#'
#' First looks for `index.Rmd` or `README.Rmd`, then
#' `index.md` or `README.md`. If none are found, falls back to the
#' description field in `DESCRIPTION`.
#'
#' @section YAML config:
#' To tweak the home page, you need a section called `home`.
#'
#' The sidebar will default to containing five sections: links,
#' code license, citation rules, developers, and dev status.
#' You can override this ordering or suppress some sections by
#' adding a subsection called `sections`, which should contain a
#' list of section name elements:
#'
#' \preformatted{
#' home:
#' sections:
#' - links
#' - license
#' - citation
#' - authors
#' - dev_status
#' }
#'
#' The default links are, in order: CRAN / Bioconductor package
#' download links; GitHub / BitBucket repo links (generated by
#' inspecting the `URL` fields of the `DESCRIPTION` file); bug
#' report links (generated by inspecting the `BugReports` field
#' of the `DESCRIPTION` file); and any custom links you provide.
#'
#' You can change the order of the links or suppress some
#' by adding a subsection called `link_order`, which should
#' consists of a list of section name elements:
#'
#' \preformatted{
#' home:
#' link_order:
#' - repo
#' - github
#' - bug_report
#' - custom
#' }
#'
#' You can add additional links with a subsection called
#' `links`, which should contain a list of `text` + `href`
#' elements:
#'
#' \preformatted{
#' home:
#' links:
#' - text: Link text
#' href: http://website.com
#' }
#'
#' The code license section is generated by reading the
#' `LICENSE` field of the `DESCRIPTION` file. Standard
#' licenses are automatically linked.
#'
#' The citation section is generated by reading the
#' `inst/CITATION` file from the package.
#'
#' The "developers" list is by default populated by the maintainer
#' ("cre"), authors ("aut"), and funder ("fnd") but you can
#' override this with a section called `roles_include`, which
#' should contain a list of members:
#'
#' \preformatted{
#' roles_include:
#' - cre
#' - aut
#' - fnd
#' }
#'
#' This section must be in the base level of the YML file, not
#' a subsection under `home`: this is because in addition to
#' populating the "developers" list, these names also populate
#' the page footer developer list.
#'
#' Dev status is populated by pulling any badges from the home
#' page contents into the sidebar.
#'
#' @inheritParams build_articles
#' @export
build_home <- function(pkg = ".", path = "docs", depth = 0L, encoding = "UTF-8") {
old <- set_pkgdown_env("true")
on.exit(set_pkgdown_env(old))
pkg <- as_pkgdown(pkg)
path <- rel_path(path, pkg$path)
data <- data_home(pkg)
rule("Building home")
scoped_package_context(pkg$package, pkg$topic_index, pkg$article_index)
scoped_file_context(depth = depth)
# Copy license file, if present
license_path <- file.path(pkg$path, "LICENSE")
if (file.exists(license_path)) {
render_page(pkg, "license",
data = list(
pagetitle = "License",
license = read_file(license_path)
),
path = file.path(path, "LICENSE.html")
)
}
# Build authors page
if (has_citation(pkg$path)) {
build_citation_authors(pkg, path = path, depth = depth)
} else {
build_authors(pkg, path = path, depth = depth)
}
if (is.null(data$path)) {
data$index <- pkg$desc$get("Description")[[1]]
render_page(pkg, "home", data, out_path(path, "index.html"), depth = depth)
} else {
file_name <- tools::file_path_sans_ext(basename(data$path))
file_ext <- tools::file_ext(data$path)
if (file_ext == "md") {
data$index <- markdown(path = data$path, depth = 0L)
render_page(pkg, "home", data, out_path(path, "index.html"), depth = depth)
} else if (file_ext == "Rmd") {
if (identical(file_name, "README")) {
# Render once so that .md is up to date
message("Updating ", file_name, ".md")
callr::r_safe(
function(input, encoding) {
rmarkdown::render(
input,
output_options = list(html_preview = FALSE),
quiet = TRUE,
encoding = encoding
)
},
args = list(
input = data$path,
encoding = encoding
)
)
}
input <- file.path(path, basename(data$path))
file.copy(data$path, input)
on.exit(unlink(input))
render_rmd(pkg, input, "index.html",
depth = depth,
data = data,
toc = FALSE,
strip_header = TRUE,
encoding = encoding
)
}
}
update_homepage_html(
out_path(path, "index.html"),
isTRUE(pkg$meta$home$strip_header)
)
invisible()
}
update_homepage_html <- function(path, strip_header = FALSE) {
html <- xml2::read_html(path, encoding = "UTF-8")
tweak_homepage_html(html, strip_header = strip_header)
xml2::write_html(html, path, format = FALSE)
path
}
data_home <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
path <- find_first_existing(pkg$path,
c("index.Rmd", "README.Rmd", "index.md", "README.md")
)
print_yaml(list(
pagetitle = pkg$desc$get("Title")[[1]],
sidebar = data_home_sidebar(pkg),
path = path
))
}
data_home_sidebar <- function(pkg = ".") {
if (!is.null(pkg$meta$home$sidebar))
return(pkg$meta$home$sidebar)
sections <- pkg$meta$home$sections %||% c("links", "license",
"citation", "authors",
"dev_status")
map_func <- list(links = data_home_sidebar_links,
license = data_home_sidebar_license,
citation = data_home_sidebar_citation,
authors = data_home_sidebar_authors,
dev_status = data_home_sidebar_dev_status)
sections <- sections[sections %in% ls(map_func)]
map_func[sections] %>%
purrr::map(do.call,
list(pkg = pkg)) %>%
unlist() %>%
paste0(collapse = "\n")
}
data_home_sidebar_license <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
paste0(
'<div id="sidebar_license">\n',
"<h2>License</h2>\n",
"<p>", autolink_license(pkg$desc$get("License")[[1]]), "</p>\n",
"</div>"
)
}
data_home_sidebar_links <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
link_order <- pkg$meta$home$link_order %||% c("repo", "github",
"bug_report", "custom")
map_func <- list(repo = data_link_repo,
github = data_link_github,
bug_report = data_link_bug_report,
custom = data_link_meta)
link_order <- link_order[link_order %in% ls(map_func)]
links <- map_func[link_order] %>%
purrr::map(do.call,
list(pkg = pkg)) %>%
unlist()
paste0(
'<div id="sidebar_links">\n',
list_with_heading(links, "Links"),
'\n</div>'
)
}
list_with_heading <- function(bullets, heading) {
if (length(bullets) == 0)
return(character())
paste0(
"<h2>", heading, "</h2>",
"<ul class='list-unstyled'>\n",
paste0("<li>", bullets, "</li>\n", collapse = ""),
"</ul>\n"
)
}
data_link_meta <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
links <- pkg$meta$home$links
if (length(links) == 0)
return(character())
links %>%
purrr::transpose() %>%
purrr::pmap_chr(link_url)
}
data_link_github <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
urls <- pkg$desc$get("URL") %>%
strsplit(",\\s+") %>%
`[[`(1)
github <- grepl("github\\.com", urls)
if (!any(github))
return(character())
link_url(paste0("Help develop ", pkg$package), urls[which(github)[[1]]])
}
data_link_bug_report <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
bug_reports <- pkg$desc$get("BugReports")[[1]]
if (is.na(bug_reports))
return(character())
link_url("Report a bug", bug_reports)
}
data_link_repo <- function(pkg = ".") {
pkg <- as_pkgdown(pkg)
name <- pkg$desc$get("Package")[[1]]
repo_result <- repo_url(name)
if (is.null(repo_result))
return(list())
if (names(repo_result) == "CRAN")
repo_link <- paste0("https://cran.r-project.org/package=", name)
else if (names(repo_result) == "BIOC")
repo_link <- paste0("https://www.bioconductor.org/packages/", name)
else
stop("Package link not supported")
link_url(
paste0("Download from ", names(repo_result)),
repo_link
)
}
data_home_sidebar_dev_status <- function(pkg = ".") {
paste0(
'<div id="sidebar_dev_status">\n',
'</div>'
)
}
cran_mirror <- function() {
cran <- as.list(getOption("repos"))[["CRAN"]]
if (is.null(cran) || identical(cran, "@CRAN@")) {
"https://cran.rstudio.com"
} else {
cran
}
}
bioc_mirror <- function() {
if (requireNamespace("BiocInstaller", quietly = TRUE)) {
bioc <- BiocInstaller::biocinstallRepos()[["BioCsoft"]]
} else {
bioc <- "https://bioconductor.org/packages/release/bioc"
}
bioc
}
repo_url <- function(pkg, cran = cran_mirror(), bioc = bioc_mirror()) {
bioc_pkgs <- utils::available.packages(contriburl = paste0(bioc, "/src/contrib"))
cran_pkgs <- utils::available.packages(contriburl = paste0(cran, "/src/contrib"))
avail <- if (pkg %in% rownames(cran_pkgs)) {
c(CRAN = paste0(cran, "/web/packages/", pkg, "/index.html"))
} else if (pkg %in% rownames(bioc_pkgs)) {
c(BIOC = paste0(bioc, "/html/", pkg, ".html"))
} else { NULL }
return(avail)
}
link_url <- function(text, href) {
paste0("<a href='", href, "'>", text, "</a>")
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.