.shrtcts.R

#' Restart RStudio
#'
#' @id 6
#' @interactive
usethis:::restart_rstudio

#' Go to Source File Location
#'
#' @description Navigate to current source file in Files pane
#' @id 1
function(path = NULL) {
  if (!rstudioapi::hasFun("executeCommand")) {
    return(invisible())
  }
  if (is.null(path)) {
    path <- rstudioapi::getSourceEditorContext()$path
  }
  if (path == "") {
    message("Current source file hasn't been saved yet")
    return(invisible())
  }
  if (fs::is_file(path)) {
    path <- fs::path_dir(path)
  }
  if (!fs::dir_exists(path)) {
    message("Directory does not exist: ", path)
    return(invisible())
  }
  owd <- setwd(path)
  later::later(function() {
    rstudioapi::executeCommand("goToWorkingDir")
    setwd(owd)
  })
}

#' Preview Markdown Selection
#'
#' @description Preview the selected markdown
#' @id 2
function() {
  ctx <- rstudioapi::getSourceEditorContext()
  if (!nzchar(ctx$selection[[1]]$text)) {
    message("Nothing selected")
    return(invisible())
  }
  text <- vapply(ctx$selection, `[[`, "", "text")
  tmprmd <- tempfile("md_preview_", fileext = ".Rmd")
  cat(text, file = tmprmd, sep = "\n\n")
  out <- rmarkdown::render(tmprmd, quiet = TRUE, output_format = rmarkdown::html_document(pandoc_args = c("--metadata", "pagetitle=preview")))
  rstudioapi::viewer(out)
}

#' Drake - Load Project
#'
#' @description Source "_drake.R"
#' @id 3
#' @interactive
function() {
  drake_src <- here::here("_drake.R")
  if (file.exists(drake_src)) {
    rstudioapi::sendToConsole(paste0("source(\"", drake_src, "\")"))
    rstudioapi::executeCommand("activateConsole")
  }
  else {
    message("_drake.R file not found: ", drake_src)
  }
}

#' Drake - Make
#'
#' @description Run make.R as an RStudio job
#' @id 4
function() {
  make <- here::here("make.R")
  if (file.exists(make)) {
    rstudioapi::jobRunScript(make)
  }
  else {
    message("Makefile does not exist: ", make)
  }
}

#' Drake - Loadd Targets for Function
#'
#' @description Load the targets used by the selected function
#' @id 5
function() {
  ctx <- rstudioapi::getSourceEditorContext()
  if (!nzchar(ctx$selection[[1]]$text)) {
    message("Nothing selected")
    return(invisible())
  }
  if (!exists("plan", envir = globalenv())) {
    stop("Please load a drake plan first.", call. = FALSE)
  }
  plan <- get("plan", globalenv())
  args <- names(formals(ctx$selection[[1]]$text))
  cache <- getOption("rstudio_drake_cache") %||% drake::drake_cache()
  cache <- drake:::decorate_storr(cache)
  targets <- intersect(args, plan$target)
  cat("loading targets:", paste(targets, collapse = ", "))
  drake::loadd(list = targets, envir = globalenv(), cache = cache)
}

#' New Temporary R Markdown Document
#'
#' @id 7
function() {
  tmp <- tempfile(fileext = ".Rmd")
  rmarkdown::draft(tmp, template = "github_document", package = "rmarkdown", edit = FALSE)
  rstudioapi::navigateToFile(tmp)
}

#' Send to Terminal
#'
#' @description Send current selection to the terminal
#' @id 8
function(command = NULL) {
  if (is.null(command)) {
    ctx <- rstudioapi::getSourceEditorContext()
    sel <- ctx$selection[[1]]$text
    command <- if (sel != "") {
      sel
    }
  }
  if (is.null(command)) {
    stop("Nothing selected", call. = FALSE)
  }
  term_list <- rstudioapi::terminalList()
  term_running <- vapply(term_list, rstudioapi::terminalRunning, logical(1))
  term_busy <- vapply(term_list, rstudioapi::terminalBusy, logical(1))
  if (length(term_list) == 1L && term_running[[1]]) {
    term_idx <- 1L
  }
  else {
    term_info <- lapply(term_list, rstudioapi::terminalContext)
    term_name <- vapply(term_info, `[[`, character(1), "caption")
    term_shell <- vapply(term_info, `[[`, character(1), "shell")
    term_busy <- c("", " (busy)")[term_busy + 1]
    term_order <- order(term_name)
    term_choices <- paste(sep = "", seq_along(term_list), ". ", term_name[term_order], ", ", term_shell[term_order], term_busy[term_order])
    term_choices <- paste(term_choices, collapse = "\n")
    term_choices <- paste("0. New Terminal", term_choices, sep = "\n")
    choice <- rstudioapi::showPrompt(title = "Choose a Terminal", message = paste("Which Terminal?", term_choices, sep = "\n\n"), default = 0)
    if (is.null(choice)) {
      stop("Canceled by user", call. = FALSE)
    }
    choice <- as.integer(choice)
    stopifnot(!is.na(choice))
    idx <- if (choice <= length(term_order) && choice != 0) {
      term_order[choice]
    }
  }
  if (!is.null(idx)) {
    rstudioapi::terminalActivate(term_list[[idx]])
    rstudioapi::terminalSend(term_list[[idx]], command)
  }
  else {
    rstudioapi::terminalExecute(command, show = TRUE)
  }
}

#' Download Latest RStudio Daily
#'
#' @id 9
#' @interactive
function() {
  ls <- xml2::read_html("https://dailies.rstudio.com/")
  ls <- rvest::html_nodes(ls, "#dir-rstudio li a")
  ls <- rvest::html_attr(ls, "href")
  urls <- paste0("https://dailies.rstudio.com/", ls)
  ls <- sub("rstudio/oss/", "", ls)
  ls <- sub("/$", "", ls)
  version <- rstudioapi::showPrompt(title = "Which version to download?", message = paste0("Choose your platform (RStudio Desktop)\n\n", paste0(sprintf("%2d. ", seq_along(ls)), ls, collapse = "\n")))
  url <- urls[as.integer(version)]
  x <- xml2::read_html(url)
  x <- rvest::html_node(x, "tr:nth-child(1) .filename")
  x <- rvest::html_node(x, "a")
  x <- rvest::html_attr(x, "href")
  outpath <- rstudioapi::selectDirectory(path = fs::path_home("Downloads"))
  if (is.null(outpath)) {
    message("Cancelled by user")
    return(invisible())
  }
  outpath <- file.path(outpath, basename(x))
  download.file(x, destfile = outpath)
  if (tolower(Sys.info()["sysname"]) == "darwin") {
    system(paste("open", outpath))
  }
  else {
    message("Downloaded to ", outpath)
  }
}

#' Preview pkgdown Documentation
#'
#' @description Builds pkgdown documentation in a session-specific temporary directory
#' @id 10
function() {
  tmpdir <- getOption("pkgdown_preview_dir", NULL)
  if (is.null(tmpdir)) {
    tmpdir <- tempfile()
    dir.create(tmpdir)
    options(pkgdown_preview_dir = tmpdir)
  }
  pkgdown::build_site(override = list(destination = tmpdir), devel = TRUE)
  invisible(file.path(tmpdir, "index.html"))
}

#' Random Names
#'
#' Provides random names from the Wikipedia list of most popular given names
function() {
  x <- readr::read_csv(
    "https://gist.github.com/gadenbuie/0ae29b5c9c0170d300a03a53c31091c1/raw/popular_world_names.csv",
    col_types = readr::cols(
      gender = readr::col_character(),
      region = readr::col_character(),
      year = readr::col_character(),
      number = readr::col_double(),
      name = readr::col_character()
    )
  )
  x <- split(x, x$gender)
  x <- lapply(x, function(z) z[sample(seq_len(nrow(z)), 5), ])
  x <- do.call(rbind, x)
  print(x)
}

#' Create issue from reprex
#'
#' Creates an issue from the selected or copied reprex.
#'
#' @shortcut Cmd+Ctrl+Shift+R
#' @interactive
create_issue_from_reprex <- function(input = NULL, repo = NULL) {
  if (is.null(repo)) {
    repo_guess <- tryCatch(
      usethis:::target_repo_spec("source", FALSE),
      error = function(err) NULL
    )

    repo <- rstudioapi::showPrompt(
      title = "Which repository?",
      message = "Where should we create the issue? (owner/repo)",
      default = repo_guess
    )
  }

  if (is.null(input)) {
    ctx <- rstudioapi::getSourceEditorContext()
    selection <- ctx$selection[[1]]$text
    input <- if (nzchar(selection)) {
      c(strsplit(selection, "\n")[[1]], "")
    }
  }

  body <- reprex::reprex(input = input, venue = "gh", html_preview = TRUE)
  body <- paste(body, collapse = "\n")
  body <- URLencode(body, reserved = TRUE)
  url_new_issue <- glue::glue("https://github.com/{repo}/issues/new?body={body}")
  browseURL(url_new_issue)
  invisible(url_new_issue)
}

.shrtcts.yaml

- Name: Restart RStudio
  id: 6
  Binding: usethis:::restart_rstudio
  Interactive: true

- name: Go to Source File Location
  Description: Navigate to current source file in Files pane
  id: 1
  Interactive: false
  Binding: |-
    .browse_source_dir <- function(path = NULL) {
      if (!rstudioapi::hasFun("executeCommand")) return(invisible())
      if (is.null(path)) {
        path <- rstudioapi::getSourceEditorContext()$path
      }
      if (path == "") {
        message("Current source file hasn't been saved yet")
        return(invisible())
      }
      if (fs::is_file(path)) {
        path <- fs::path_dir(path)
      }
      if (!fs::dir_exists(path)) {
        message("Directory does not exist: ", path)
        return(invisible())
      }
      owd <- setwd(path)
      later::later(function() {
        rstudioapi::executeCommand("goToWorkingDir")
        setwd(owd)
      })
    }

- Name: Preview Markdown Selection
  Description: Preview the selected markdown
  id: 2
  Interactive: false
  Binding: |-
    ctx <- rstudioapi::getSourceEditorContext()
    if (!nzchar(ctx$selection[[1]]$text)) {
      message("Nothing selected")
      return(invisible())
    }
    text <- vapply(ctx$selection, `[[`, "", "text")

    tmprmd <- tempfile("md_preview_", fileext = ".Rmd")
    cat(text, file = tmprmd, sep = "\n\n")
    out <- rmarkdown::render(
      tmprmd,
      quiet = TRUE,
      output_format = rmarkdown::html_document(
        pandoc_args = c("--metadata", "pagetitle=preview")
      )
    )
    rstudioapi::viewer(out)

- Name: Drake - Load Project
  Description: Source "_drake.R"
  id: 3
  Interactive: true
  Binding: |
    drake_src <- here::here("_drake.R")
    if (file.exists(drake_src)) {
      rstudioapi::sendToConsole(paste0('source("', drake_src, '")'))
      rstudioapi::executeCommand("activateConsole")
    } else {
      message("_drake.R file not found: ", drake_src)
    }

- Name: Drake - Make
  Description: Run make.R as an RStudio job
  id: 4
  Interactive: false
  Binding: |
    make = here::here("make.R")
    if (file.exists(make)) {
      rstudioapi::jobRunScript(make)
    } else {
      message("Makefile does not exist: ", make)
    }

- Name: Drake - Loadd Targets for Function
  Description: Load the targets used by the selected function
  Interactive: false
  id: 5
  Binding: |
    ctx <- rstudioapi::getSourceEditorContext()
    if (!nzchar(ctx$selection[[1]]$text)) {
      message("Nothing selected")
      return(invisible())
    }
    if (!exists("plan", envir = globalenv())) {
      stop("Please load a drake plan first.", call. = FALSE)
    }
    plan <- get("plan", globalenv())
    args <- names(formals(ctx$selection[[1]]$text))
    cache <- getOption("rstudio_drake_cache") %||% drake::drake_cache()
    cache <- drake:::decorate_storr(cache)
    targets <- intersect(args, plan$target)
    cat("loading targets:", paste(targets, collapse = ", "))
    drake::loadd(list = targets, envir = globalenv(), cache = cache)

- Name: New Temporary R Markdown Document
  Binding: |
    tmp <- tempfile(fileext = ".Rmd")
    rmarkdown::draft(
      tmp,
      template = "github_document",
      package = "rmarkdown",
      edit = FALSE
    )
    rstudioapi::navigateToFile(tmp)
  Interactive: false

- Name: Send to Terminal
  Description: Send current selection to the terminal
  Interactive: false
  Binding: |
    function(command = NULL) {
      if (is.null(command)) {
        ctx <- rstudioapi::getSourceEditorContext()
        sel <- ctx$selection[[1]]$text
        command <- if (sel != "") sel
      }

      if (is.null(command)) stop("Nothing selected", call. = FALSE)

      term_list <- rstudioapi::terminalList()
      term_running <- vapply(term_list, rstudioapi::terminalRunning, logical(1))
      term_busy <- vapply(term_list, rstudioapi::terminalBusy, logical(1))

      if (length(term_list) == 1L && term_running[[1]]) {
        term_idx <- 1L
      } else {
        term_info <- lapply(term_list, rstudioapi::terminalContext)
        term_name <- vapply(term_info, `[[`, character(1), "caption")
        term_shell <- vapply(term_info, `[[`, character(1), "shell")
        term_busy <- c("", " (busy)")[term_busy + 1]
        term_order <- order(term_name)
        term_choices <- paste(
          sep = "",
          seq_along(term_list), ". ",
          term_name[term_order], ", ",
          term_shell[term_order], term_busy[term_order]
        )
        term_choices <- paste(term_choices, collapse = "\n")
        term_choices <- paste("0. New Terminal", term_choices, sep = "\n")
        choice <- rstudioapi::showPrompt(
          title = "Choose a Terminal",
          message = paste("Which Terminal?", term_choices, sep = "\n\n"),
          default = 0
        )
        if(is.null(choice)) stop("Canceled by user", call. = FALSE)
        choice <- as.integer(choice)
        stopifnot(!is.na(choice))
        idx <- if (choice <= length(term_order) && choice != 0) term_order[choice]
      }

      if (!is.null(idx)) {
        rstudioapi::terminalActivate(term_list[[idx]])
        rstudioapi::terminalSend(term_list[[idx]], command)
      } else {
        rstudioapi::terminalExecute(command, show = TRUE)
      }
    }

- Name: Download Latest RStudio Daily
  Interactive: true
  Binding: |
    ls <- xml2::read_html("https://dailies.rstudio.com/")
    ls <- rvest::html_nodes(ls, "#dir-rstudio li a")
    ls <- rvest::html_attr(ls, "href")
    urls <- paste0("https://dailies.rstudio.com/", ls)
    ls <- sub("rstudio/oss/", "", ls)
    ls <- sub("/$", "", ls)
    version <- rstudioapi::showPrompt(
      title = "Which version to download?",
      message = paste0(
        "Choose your platform (RStudio Desktop)\n\n",
        paste0(sprintf("%2d. ", seq_along(ls)), ls, collapse = "\n")
      )
    )
    url <- urls[as.integer(version)]
    x <- xml2::read_html(url)
    x <- rvest::html_node(x, "tr:nth-child(1) .filename")
    x <- rvest::html_node(x, "a")
    x <- rvest::html_attr(x, "href")
    outpath <- rstudioapi::selectDirectory(path = fs::path_home("Downloads"))
    if (is.null(outpath)) {
      message("Cancelled by user")
      return(invisible())
    }
    outpath <- file.path(outpath, basename(x))
    download.file(x, destfile = outpath)
    if (tolower(Sys.info()["sysname"]) == "darwin") {
      system(paste("open", outpath))
    } else {
      message("Downloaded to ", outpath)
    }

- Name: Preview pkgdown Documentation
  Description: Builds pkgdown documentation in a session-specific temporary directory
  Interactive: false
  Binding: |
    tmpdir <- getOption("pkgdown_preview_dir", NULL)
    if (is.null(tmpdir)) {
      tmpdir <- tempfile()
      dir.create(tmpdir)
      options(pkgdown_preview_dir = tmpdir)
    }
    pkgdown::build_site(override = list(destination = tmpdir), devel = TRUE)
    invisible(file.path(tmpdir, "index.html"))