Merge pull request #62 from datacamp/fix/package_view

Fix/package view

.gitignore

@@ -1,6 +1,7 @@
 .Rproj.user
 .Rhistory
 .RData
+.DS_Store
 Rdocumentation.Rproj
 doc/
 doc/*

NAMESPACE

@@ -3,16 +3,15 @@
 export("?")
 export(check_package)
 export(disable_autoload)
-export(disable_override)
+export(disable_rdocs)
 export(enable_autoload)
-export(enable_override)
+export(enable_rdocs)
 export(get_package_from_URL)
 export(help)
 export(help.search)
 export(hideViewer)
 export(install_package)
 export(makeDefault)
-export(view_help)
 importFrom(githubinstall,githubinstall)
 importFrom(httr,GET)
 importFrom(httr,POST)

R/overrides.R

@@ -12,87 +12,56 @@
 #' @importFrom proto proto
 #' @importFrom utils help
 help <- function(...) {
-  mc <- match.call(utils::help)
-  topic <- as.character(mc$topic)
-  package <- as.character(mc$package)
-  paths <- tryCatch({
-    utils::help(...)  
-  }, error = function(e) {
-    if (grepl("there is no package called", e$message)) {
-      return(character(0))
+  with_override({
+    mc <- match.call(utils::help)
+    package <- as.character(mc$package)
+    topic <- as.character(mc$topic)
+
+    if (length(topic) == 0 && length(package) != 0) {
+      body <- get_find_package_body(package)
+      view_help(body)
     } else {
-      stop(e)
-    }
-  })
-  tryCatch({
-    if (!isTRUE(is_override())) {
-      stop("rdocs not active")
+      paths <- tryCatch({
+        utils::help(...)
+      }, error = function(e) {
+        if (grepl("there is no package called", e$message)) {
+          return(character(0))
+        } else {
+          stop(e)
+        }
+      })
+      body <- get_help_body(paths, package, topic)
+      view_help(body)
     }
-    get_help(paths, package, topic)
-  }, error = function(e) {
-    paths
-  })
+  }, alternative = utils::help(...))
 }
 
 #' @rdname documentation
 #' @export
 `?` <- function(...){
-  paths <- utils::`?`(...)
-  tryCatch({
-    if (!isTRUE(is_override())) {
-      stop("rdocs not active")
-    }
-    get_help(paths)
-  }, error = function(e) {
-    paths
-  })
+  with_override({
+    paths <- utils::`?`(...)
+    body <- get_help_body(paths)
+    view_help(body)
+  }, alternative = utils::`?`(...))
 }
 
 #' @rdname documentation
 #' @export
 #' @importFrom utils help.search
 help.search <- function(...) {
-  paths <- utils::help.search(...)
+  with_override({
+    paths <- utils::help.search(...)
+    body <- get_help_search_body(paths)
+    view_help(body)
+  }, alternative = utils::help.search())
+}
+
+with_override <- function(code, alternative) {
   tryCatch({
-    if (!isTRUE(is_override())) {
-      stop("rdocs not active")
-    }
-    get_help_search(paths)
+    stopifnot(isTRUE(rdocs_active()))
+    force(code)
   }, error = function(e) {
-    paths
+    force(alternative)
   })
-}
-
-get_help_search <- function(paths) {
-  lut <- c(alias = "aliases", concept = "concept", keyword = "keywords", name = "name", title = "title")
-  body <- paths
-  body$fields <- concat(lut[body$fields])
-  body$matching_titles <- concat(unique(body$matches$Topic))
-  body$matching_packages <- concat(unique(body$matches$Package))
-  body$called_function <- "help_search"
-  body[c("lib.loc", "matches", "types", "package")] <- NULL
-  view_help(body)
-}
-
-get_help <- function(paths, package = "", topic = "") {
-  if (!length(paths)) {
-    # no documentation found locally, use specified package and topic names
-    packages <- if (length(package) == 0) "" else package
-    topic_names <- ""
-    topic <- if (length(topic) == 0) "" else topic
-  } else {
-    # documentation was found
-    split <- strsplit(paths, "/")
-    packages <- sapply(split, function(x) return(x[length(x)-2]))
-    topic_names <- sapply(split, tail, n = 1)
-    topic <- attr(paths, "topic")
-  }
-  body <- list(packages = concat(packages),
-               topic_names = concat(topic_names),
-               topic = topic,
-               called_function = "help")
-  view_help(body)
-}
-
-
-
+}

R/settings.R

@@ -0,0 +1,79 @@
+#' Settings
+#' 
+#' Automatically load RDocumentation and make it active, so that it overrides the default 
+#' documentation?
+#' 
+#' When you load in the RDocumentation package, you'll be prompted to autoload 
+#' the package whenever you start R. When RDocumentation is loaded, it will automatically
+#' override the default help functionality with documentation from RDocumentation.org.
+#' 
+#' The autoloading is done by modyfing the .RProfile file that is in your working directory.
+#' 
+#' With \code{enable_autoload} and \code{disable_autoload} you can update the
+#' .RProfile file to enable or disable the automatic loading of RDocumentation
+#' when you start R. With \code{enable_rdocs} and \code{disable_rdocs} you can enable or 
+#' disable the overriding of the default help viewer.
+#' 
+#' @name defaults
+
+#' @export
+#' @rdname defaults
+enable_autoload <- function(){
+  add_to_profile(autoload_line, autoload_line_old)
+  return (invisible())
+}
+
+#' @export
+#' @rdname defaults
+makeDefault <- enable_autoload # for backwards compatibility
+
+#' @export
+#' @rdname defaults
+disable_autoload <- function() {
+  remove_from_profile(autoload_line, autoload_line_old)
+}
+
+is_autoload <- function() {
+  is_in_profile(c(autoload_line, autoload_line_old))
+}
+
+ask_questions <- function() {
+  if (interactive()) {
+    if (!is_autoload()) {
+      ask_autoload()
+    }
+  }
+}
+
+ask_autoload <- function() {
+  msg <- "Do you want to automatically load RDocumentation when you start R? [y|n] "
+  if (says_yes(msg)) {
+    enable_autoload()
+    message(paste("Congratulations!",
+                  "R will now use RDocumentation to display your help files.",
+                  "If you're offline, R will just display your local documentation.",
+                  "To avoid automatically loading the RDocumentation package, use disable_autoload().", 
+                  "If you don't want the ? and help functionality to show RDocumentation pages, use disable_override().",
+                  sep = "\n"))
+  } else {
+    disable_autoload()
+  }
+}
+
+## Whether or not to enable RDocs
+
+#' @export
+#' @rdname defaults
+enable_rdocs <- function() {
+  options(rdocs_active = TRUE)
+}
+
+#' @export
+#' @rdname defaults
+disable_rdocs <- function() {
+  options(rdocs_active = FALSE)
+}
+
+rdocs_active <- function() {
+  getOption("rdocs_active", default = FALSE)
+}