### Copyright (C) 2007 Deepayan Sarkar ### This file is made available under the terms of the GNU General ### Public License, version 2, or at your option, any later version, ### incorporated herein by reference. browseVignettes <- function(package = NULL, lib.loc = NULL, all = TRUE) { ## adapted from vignette() if (is.null(package)) package <- .packages(all.available = all, lib.loc) paths <- .find.package(package, lib.loc) paths <- paths[tools:::file_test("-d", file.path(paths, "doc"))] vignettes <- lapply(paths, function(dir) { tools::list_files_with_type(file.path(dir, "doc"), "vignette") }) names(vignettes) <- basename(paths) getVinfo <- function(db) { dir <- dirname(dirname(db[1])) entries <- NULL if (file.exists(INDEX <- file.path(dir, "Meta", "vignette.rds"))) entries <- .readRDS(INDEX) if (NROW(entries) > 0) { cbind(Dir = dir, File = basename(entries$File), Title = entries$Title, R = if (is.null(entries$R)) "" else entries$R, # FIXME: remember to simplify PDF = entries$PDF)[order(entries$Title), , drop=FALSE] } else NULL } vinfo <- lapply(vignettes[sapply(vignettes, length) > 0], getVinfo) attr(vinfo, "call") <- sys.call() attr(vinfo, "footer") <- if (all) "" else sprintf(gettext("Use %s \n to list the vignettes in all available packages."), "browseVignettes(all = TRUE)") class(vinfo) <- "vignetteInfo" return(vinfo) } print.vignetteInfo <- function(x, ...) { if (length(x) == 0) { message("No vignettes found by ", paste(deparse(attr(x, "call")), collapse=" ")) return() } oneLink <- function(s) { if (length(s) == 0) return(character(0)) title <- s[, "Title"] src <- file.path(s[, "Dir"], "doc", s[, "File"]) pdf <- ifelse(s[, "PDF"] != "", # or nzchar(s[, "PDF"]), file.path(s[, "Dir"], "doc", s[, "PDF"]), "") rcode <- ifelse(s[, "R"] != "", # or nzchar(s[, "R"]), file.path(s[, "Dir"], "doc", s[, "R"]), "") sprintf("
  • %s ( %s %s %s )
    • ", title, sprintf("LaTeX/Noweb", src), ifelse(rcode != "", # nzchar(rcode), sprintf("R code", rcode), ""), ifelse(pdf != "", # nzchar(pdf), sprintf("PDF", pdf), "")) } file <- sprintf("%s.html", tempfile("Rvig.")) sink(file) cat(" R Vignettes \n") cat(sprintf("

    Vignettes found by %s

    ", paste(deparse(attr(x, "call")), collapse=" "))) for (pkg in names(x)) { cat(sprintf("

    Vignettes in package %s

    \n", pkg)) cat("\n") } cat(sprintf("

    %s

    ", attr(x, "footer"))) cat("\n") sink() ## the first two don't work on Windows with browser=NULL. ## browseURL(URLencode(sprintf("file://%s", file))) ## browseURL(URLencode(file)) browseURL(sprintf("file://%s", file)) ## browseURL(file) } if (FALSE) { ## for experimentation print.vignetteInfo <- function(x, ...) { if (length(x) == 0) { message("No vignettes found by ", paste(deparse(attr(x, "call")), collapse=" ")) return() } oneLink <- function(s) { if (length(s) == 0) return(character(0)) title <- s[, "Title"] src <- file.path(s[, "Dir"], "doc", s[, "File"]) pdf <- ifelse(s[, "PDF"] != "", # or nzchar(s[, "PDF"]), file.path(s[, "Dir"], "doc", s[, "PDF"]), "") sprintf("%s ( %s %s );", title, sprintf("source", src), ifelse(pdf != "", # nzchar(pdf), sprintf("PDF", pdf), "")) } file <- sprintf("%s.html", tempfile("Rvig.")) sink(file) cat(" R Vignettes \n") cat(sprintf("

    Vignettes found by %s

    ", paste(deparse(attr(x, "call")), collapse=" "))) for (pkg in names(x)) { cat(sprintf("

    %s

    \n", pkg)) links <- oneLink(x[[pkg]]) cat(paste(links), collapse = "\n") } cat(sprintf("

    %s

    ", attr(x, "footer"))) cat("\n") sink() ## this first two don;t work on Windows with browser=NULL ## browseURL(URLencode(sprintf("file://%s", file))) ## browseURL(URLencode(file)) browseURL(sprintf("file://%s", file)) ## browseURL(file) } }