Nothing
# gert -------------------------------------------------------------------------
gert_shush <- function(expr, regexp) {
check_character(regexp)
withCallingHandlers(
gertMessage = function(cnd) {
m <- map_lgl(regexp, ~ grepl(.x, cnd_message(cnd), perl = TRUE))
if (any(m)) {
cnd_muffle(cnd)
}
},
expr
)
}
# Repository -------------------------------------------------------------------
git_repo <- function() {
check_uses_git()
proj_get()
}
uses_git <- function() {
repo <- tryCatch(
gert::git_find(proj_get()),
error = function(e) NULL
)
!is.null(repo)
}
check_uses_git <- function() {
if (uses_git()) {
return(invisible())
}
ui_stop(c(
"Cannot detect that project is already a Git repository.",
"Do you need to run {ui_code('use_git()')}?"
))
}
git_init <- function() {
gert::git_init(proj_get())
}
# Config -----------------------------------------------------------------------
# `where = "de_facto"` means look at the values that are "in force", i.e. where
# local repo variables override global user-level variables, when both are
# defined
#
# `where = "local"` is strict, i.e. it only returns a value that is in the local
# config
git_cfg_get <- function(name, where = c("de_facto", "local", "global")) {
where <- match.arg(where)
if (where == "de_facto") {
return(git_cfg_get(name, "local") %||% git_cfg_get(name, "global"))
}
if (where == "global" || !uses_git()) {
dat <- gert::git_config_global()
} else {
dat <- gert::git_config(repo = git_repo())
}
if (where == "local") {
dat <- dat[dat$level == "local", ]
}
out <- dat$value[tolower(dat$name) == tolower(name)]
if (length(out) > 0) out else NULL
}
# more-specific case for user-name and -email
git_user_get <- function(where = c("de_facto", "local", "global")) {
where <- match.arg(where)
list(
name = git_cfg_get("user.name", where),
email = git_cfg_get("user.email", where)
)
}
# translate from "usethis" terminology to "git" terminology
where_from_scope <- function(scope = c("user", "project")) {
scope = match.arg(scope)
where_scope <- c(user = "global", project = "de_facto")
where_scope[scope]
}
# ensures that core.excludesFile is configured
# if configured, leave well enough alone
# if not, check for existence of one of the Usual Suspects; if found, configure
# otherwise, configure as path_home(".gitignore")
ensure_core_excludesFile <- function() {
path <- git_ignore_path(scope = "user")
if (!is.null(path)) {
return(invisible())
}
# .gitignore is most common, but .gitignore_global appears in prominent
# places --> so we allow the latter, but prefer the former
path <-
path_first_existing(path_home(c(".gitignore", ".gitignore_global"))) %||%
path_home(".gitignore")
if (!is_windows()) {
# express path relative to user's home directory, except on Windows
path <- path("~", path_rel(path, path_home()))
}
ui_done("Configuring {ui_field('core.excludesFile')}: {ui_path(path)}")
gert::git_config_global_set("core.excludesFile", path)
invisible()
}
# Status------------------------------------------------------------------------
git_status <- function(untracked) {
check_bool(untracked)
st <- gert::git_status(repo = git_repo())
if (!untracked) {
st <- st[st$status != "new", ]
}
st
}
# Commit -----------------------------------------------------------------------
git_ask_commit <- function(message, untracked, push = FALSE, paths = NULL) {
if (!is_interactive() || !uses_git()) {
return(invisible())
}
# this is defined here to encourage all commits to route through this function
git_commit <- function(paths, message) {
repo <- git_repo()
ui_done("Adding files")
gert::git_add(paths, repo = repo)
ui_done("Making a commit with message {ui_value(message)}")
gert::git_commit(message, repo = repo)
}
uncommitted <- git_status(untracked)$file
if (is.null(paths)) {
paths <- uncommitted
} else {
paths <- intersect(paths, uncommitted)
}
n <- length(paths)
if (n == 0) {
return(invisible())
}
paths <- sort(paths)
ui_paths <- map_chr(paths, ui_path)
if (n > 10) {
ui_paths <- c(ui_paths[1:10], "...")
}
if (n == 1) {
file_hint <- "There is 1 uncommitted file:"
} else {
file_hint <- "There are {n} uncommitted files:"
}
ui_line(c(
file_hint,
paste0("* ", ui_paths)
))
# Only push if no remote & a single change
push <- push && git_can_push(max_local = 1)
msg <- paste0(
"Is it ok to commit ",
if (push) "and push ",
if (n == 1) 'it' else 'them',
"?"
)
if (ui_yeah(msg)) {
git_commit(paths, message)
if (push) {
git_push()
}
}
invisible()
}
git_uncommitted <- function(untracked = FALSE) {
nrow(git_status(untracked)) > 0
}
challenge_uncommitted_changes <- function(untracked = FALSE, msg = NULL) {
if (!uses_git()) {
return(invisible())
}
if (rstudioapi::hasFun("documentSaveAll")) {
rstudioapi::documentSaveAll()
}
default_msg <- "
There are uncommitted changes, which may cause problems or be lost when \\
we push, pull, switch, or compare branches"
msg <- glue(msg %||% default_msg)
if (git_uncommitted(untracked = untracked)) {
if (ui_yeah("{msg}\nDo you want to proceed anyway?")) {
return(invisible())
} else {
ui_stop("Uncommitted changes. Please commit before continuing.")
}
}
}
git_conflict_report <- function() {
st <- git_status(untracked = FALSE)
conflicted <- st$file[st$status == "conflicted"]
n <- length(conflicted)
if (n == 0) {
return(invisible())
}
conflicted_paths <- map_chr(conflicted, ui_path)
ui_line(c(
"There are {n} conflicted files:",
paste0("* ", conflicted_paths)
))
msg <- glue("
Are you ready to sort this out?
If so, we will open the conflicted files for you to edit.")
yes <- "Yes, I'm ready to resolve the merge conflicts."
no <- "No, I want to abort this merge."
if (ui_yeah(msg, yes = yes, no = no, shuffle = FALSE)) {
ui_silence(purrr::walk(conflicted, edit_file))
ui_stop("
Please fix each conflict, save, stage, and commit.
To back out of this merge, run {ui_code('gert::git_merge_abort()')} \\
(in R) or {ui_code('git merge --abort')} (in the shell).")
} else {
gert::git_merge_abort(repo = git_repo())
ui_stop("Abandoning the merge, since it will cause merge conflicts")
}
}
# Remotes ----------------------------------------------------------------------
## remref --> remote, branch
git_parse_remref <- function(remref) {
regex <- paste0("^", names(git_remotes()), collapse = "|")
regex <- glue("({regex})/(.*)")
list(remote = sub(regex, "\\1", remref), branch = sub(regex, "\\2", remref))
}
remref_remote <- function(remref) git_parse_remref(remref)$remote
remref_branch <- function(remref) git_parse_remref(remref)$branch
# Pull -------------------------------------------------------------------------
# Pull from remref or upstream tracking. If neither given/exists, do nothing.
# Therefore, this does less than `git pull`.
git_pull <- function(remref = NULL, verbose = TRUE) {
check_string(remref, allow_na = TRUE, allow_null = TRUE)
repo <- git_repo()
branch <- git_branch()
remref <- remref %||% git_branch_tracking(branch)
if (is.na(remref)) {
if (verbose) {
ui_done("No remote branch to pull from for {ui_value(branch)}.")
}
return(invisible())
}
if (verbose) {
ui_done("Pulling from {ui_value(remref)}.")
}
gert::git_fetch(
remote = remref_remote(remref),
refspec = remref_branch(remref),
repo = repo,
verbose = FALSE
)
# this is pretty brittle, because I've hard-wired these messages
# https://github.com/r-lib/gert/blob/main/R/merge.R
# but at time of writing, git_merge() offers no verbosity control
gert_shush(
regexp = c(
"Already up to date, nothing to merge",
"Performing fast-forward merge, no commit needed"
),
gert::git_merge(remref, repo = repo)
)
st <- git_status(untracked = TRUE)
if (any(st$status == "conflicted")) {
git_conflict_report()
}
invisible()
}
# Branch ------------------------------------------------------------------
git_branch <- function() {
info <- gert::git_info(repo = git_repo())
branch <- info$shorthand
if (identical(branch, "HEAD")) {
ui_stop("Detached head; can't continue")
}
if (is.na(branch)) {
ui_stop("On an unborn branch -- do you need to make an initial commit?")
}
branch
}
git_branch_tracking <- function(branch = git_branch()) {
repo <- git_repo()
if (!gert::git_branch_exists(branch, local = TRUE, repo = repo)) {
ui_stop("There is no local branch named {ui_value(branch)}")
}
gbl <- gert::git_branch_list(local = TRUE, repo = repo)
sub("^refs/remotes/", "", gbl$upstream[gbl$name == branch])
}
git_branch_compare <- function(branch = git_branch(), remref = NULL) {
remref <- remref %||% git_branch_tracking(branch)
gert::git_fetch(
remote = remref_remote(remref),
refspec = remref_branch(remref),
repo = git_repo(),
verbose = FALSE
)
out <- gert::git_ahead_behind(upstream = remref, ref = branch, repo = git_repo())
list(local_only = out$ahead, remote_only = out$behind)
}
git_can_push <- function(max_local = Inf, branch = git_branch(), remref = NULL) {
remref <- remref %||% git_branch_tracking(branch)
if (is.null(remref)) {
return(FALSE)
}
comp <- git_branch_compare(branch, remref)
comp$remote_only == 0 && comp$local_only <= max_local
}
git_push <- function(branch = git_branch(), remref = NULL, verbose = TRUE) {
remref <- remref %||% git_branch_tracking(branch)
if (verbose) {
ui_done("Pushing local {ui_value(branch)} branch to {ui_value(remref)}.")
}
gert::git_push(
remote = remref_remote(remref),
refspec = glue("refs/heads/{branch}:refs/heads/{remref_branch(remref)}"),
verbose = FALSE,
repo = git_repo()
)
}
git_push_first <- function(branch = git_branch(), remote = "origin", verbose = TRUE) {
if (verbose) {
remref <- glue("{remote}/{branch}")
ui_done("
Pushing {ui_value(branch)} branch to GitHub and setting \\
{ui_value(remref)} as upstream branch"
)
}
gert::git_push(
remote = remote,
set_upstream = TRUE,
verbose = FALSE,
repo = git_repo()
)
}
# Checks ------------------------------------------------------------------
check_current_branch <- function(is = NULL, is_not = NULL,
message = NULL) {
gb <- git_branch()
if (!is.null(is)) {
check_string(is)
if (gb == is) {
return(invisible())
} else {
msg <- message %||%
"Must be on branch {ui_value(is)}, not {ui_value(gb)}."
ui_stop(msg)
}
}
if (!is.null(is_not)) {
check_string(is_not)
if (gb != is_not) {
return(invisible())
} else {
msg <- message %||%
"Can't be on branch {ui_value(gb)}."
ui_stop(msg)
}
}
invisible()
}
# examples of remref: upstream/main, origin/foofy
check_branch_up_to_date <- function(direction = c("pull", "push"),
remref = NULL,
use = NULL) {
direction <- match.arg(direction)
branch <- git_branch()
remref <- remref %||% git_branch_tracking(branch)
use <- use %||% switch(direction, pull = "git pull", push = "git push")
if (is.na(remref)) {
ui_done("Local branch {ui_value(branch)} is not tracking a remote branch.")
return(invisible())
}
if (direction == "pull") {
ui_done("
Checking that local branch {ui_value(branch)} has the changes \\
in {ui_value(remref)}")
} else {
ui_done("
Checking that remote branch {ui_value(remref)} has the changes \\
in {ui_value(branch)}")
}
comparison <- git_branch_compare(branch, remref)
# TODO: properly pluralize "commit(s)" when I switch to cli
if (direction == "pull") {
if (comparison$remote_only == 0) {
return(invisible())
} else {
ui_stop("
Local branch {ui_value(branch)} is behind {ui_value(remref)} by \\
{comparison$remote_only} commit(s).
Please use {ui_code(use)} to update.")
}
} else {
if (comparison$local_only == 0) {
return(invisible())
} else {
# TODO: consider offering to push for them?
ui_stop("
Local branch {ui_value(branch)} is ahead of {ui_value(remref)} by \\
{comparison$local_only} commit(s).
Please use {ui_code(use)} to update.")
}
}
}
check_branch_pulled <- function(remref = NULL, use = NULL) {
check_branch_up_to_date(direction = "pull", remref = remref, use = use)
}
check_branch_pushed <- function(remref = NULL, use = NULL) {
check_branch_up_to_date(direction = "push", remref = remref, use = use)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.