vignette <- function(topic, package = NULL, lib.loc = NULL) { if(is.null(package)) package <- .packages(all.available = TRUE, lib.loc) paths <- .find.package(package, lib.loc) ## Find the directories with a 'doc' subdirectory *possibly* ## containing vignettes. 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") }) if(!missing(topic)) { topic <- topic[1] # Just making sure ... vignettes <- as.character(unlist(vignettes)) vidx <- (tools::file_path_sans_ext(basename(vignettes)) == topic) if(any(vidx)) { pdf <- sub("\\.[[:alpha:]]+$", ".pdf", vignettes) pidx <- tools::file_test("-f", pdf) ok <- vidx & pidx if(any(ok)){ idx <- min(which(ok)) if(sum(ok)>1){ ## ## Should really offer a menu to select from. warning(gettextf("vignette '%s' found more than once,\nusing the one found in '%s'", topic, dirname(pdf[idx])), call. = FALSE, domain = NA) ## } z <- list(file=vignettes[idx], pdf=pdf[idx]) } else{ z <- list(file=vignettes[vidx][1], pdf=character(0)) } z$topic <- topic class(z) <- "vignette" return(z) } else warning(gettextf("vignette '%s' *not* found", topic), call. = FALSE, domain = NA) } if(missing(topic)) { ## List all possible vignettes. vDB <- matrix(character(0), nr = 0, nc = 4) colnames(vDB) <- c("Dir", "File", "Title", "PDF") for(db in vignettes[sapply(vignettes, length) > 0]) { dir <- dirname(dirname(db[1])) entries <- NULL ## Check for new-style 'Meta/vignette.rds' ... if(file.exists(INDEX <- file.path(dir, "Meta", "vignette.rds"))) entries <- .readRDS(INDEX) if(NROW(entries) > 0) vDB <- rbind(vDB, cbind(dir, entries$File, entries$Title, entries$PDF)) } ## Now compute info on available PDFs ... title <- if(NROW(vDB) > 0) { paste(vDB[, "Title"], paste(rep.int("(source", NROW(vDB)), ifelse(vDB[, "PDF"] != "", ", pdf", ""), ")", sep = "")) } else character() ## ... and rewrite into the form used by packageIQR. db <- cbind(Package = basename(vDB[, "Dir"]), LibPath = dirname(vDB[, "Dir"]), Item = tools::file_path_sans_ext(basename(vDB[, "File"])), Title = title) y <- list(type = "vignette", title = "Vignettes", header = NULL, results = db, footer = NULL) class(y) <- "packageIQR" return(y) } } print.vignette <- function(x, ...){ if(length(x$pdf)){ ## ## Should really abstract this into a BioC style ## openPDF() along the lines of browseURL() ... if(.Platform$OS.type == "windows") shell.exec(x$pdf) else system(paste(getOption("pdfviewer"), x$pdf, "&")) ## } else { warning(gettextf("vignette '%s' has no PDF", x$topic), call. = FALSE, domain = NA) } } edit.vignette <- function(name, ...){ f <- paste(tempfile(name$topic), ".R", sep="") Stangle(name$file, output=f, quiet=TRUE) file.edit(file=f, ...) }