# File src/library/utils/R/browseVignettes.R # Part of the R package, http://www.R-project.org # # Copyright (C) 1995-2013 The R Core Team # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # A copy of the GNU General Public License is available at # http://www.r-project.org/Licenses/ browseVignettes <- function(package = NULL, lib.loc = NULL, all = TRUE) { vinfo <- tools:::getVignetteInfo(package, lib.loc, all) pkgs <- unique(vinfo[, "Package"]) db <- lapply(pkgs, function(p) vinfo[vinfo[,"Package"] == p,,drop=FALSE]) names(db) <- pkgs attr(db, "call") <- sys.call() attr(db, "footer") <- if (all) "" else sprintf(gettext("Use %s \n to list the vignettes in all available packages."), "browseVignettes(all = TRUE)") class(db) <- "browseVignettes" return(db) } print.browseVignettes <- function(x, ...) { if (length(x) == 0L) { message(gettextf("No vignettes found by %s", paste(deparse(attr(x, "call")), collapse=" ")), domain = NA) return(invisible(x)) } oneLink <- function(s) { if (length(s) == 0L) return(character(0L)) title <- s[, "Title"] if (tools:::httpdPort > 0L) prefix <- sprintf("/library/%s/doc", pkg) else prefix <- sprintf("file://%s/doc", s[, "Dir"]) src <- s[, "File"] pdf <- s[, "PDF"] rcode <- s[, "R"] pdfext <- sub("^.*\\.", "", pdf) sprintf("
  • %s - \n %s \n %s \n %s \n
    • \n", title, ifelse(nzchar(pdf), sprintf("%s ", prefix, pdf, toupper(pdfext)), ""), sprintf("source ", prefix, src), ifelse(nzchar(rcode), sprintf("R code ", prefix, rcode), "")) } if (tools:::httpdPort == 0L) tools::startDynamicHelp() file <- tempfile("Rvig.", fileext=".html") sink(file) if (tools:::httpdPort > 0) css_file <- "/doc/html/R.css" else css_file <- file.path(R.home("doc"), "html", "R.css") cat(sprintf(" R Vignettes \n", css_file)) cat(sprintf("

    Vignettes found by %s

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

    Vignettes in package %s

    \n", pkg)) cat("\n") } cat("
    ") 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)) if (tools:::httpdPort > 0L) browseURL(sprintf("http://127.0.0.1:%d/session/%s", tools:::httpdPort, basename(file))) else browseURL(sprintf("file://%s", file)) ## browseURL(file) invisible(x) }