Merge branch 'main' into restore

Author: jeroen

NAMESPACE

@@ -28,8 +28,11 @@ export(git_commit_id)
 export(git_commit_info)
 export(git_commit_stats)
 export(git_config)
+export(git_config_get)
 export(git_config_global)
+export(git_config_global_get)
 export(git_config_global_set)
+export(git_config_local_get)
 export(git_config_set)
 export(git_conflicts)
 export(git_diff)

NEWS.md

@@ -1,6 +1,9 @@
 # gert (development version)
 
- - Add `git_restore()` function (#259)
+- Add `git_restore()` function (#259)
+- Add `git_config_get()`, `git_config_local_get()`, and `git_config_global_get()` to retrieve a single named config option, returning `NULL` if unset (#267).
+- `git_clone()` without a `path` argument now clones into a directory named after the
+"humanish" part of the URL, so "git@github.com:francisbarton/myrepo.git" gets cloned into `myrepo` (@francisbardon, #192).
 - `git_remote_set_pushurl()` gains an `add` argument to append push URLs instead of replacing them. (@robitalec, #128)
 - Fix `git_info()` for the case when no upstream is configured (@mpage, #263)
 - `git_branch_create()`: `force` now also applies to the checkout step, allowing branch creation even when local changes would be overwritten (@MichaelChirico, #177).

R/config.R

@@ -4,14 +4,13 @@
 #' Get or set Git options, as `git config` does on the command line. **Global**
 #' settings affect all of a user's Git operations (`git config --global`),
 #' whereas **local** settings are scoped to a specific repository (`git config
-#' --local`). When both exist, local options always win. Four functions address
-#' the four possible combinations of getting vs setting and global vs. local.
+#' --local`). When both exist, local options always win.
 #'
 #' ```{r echo = FALSE, results = "asis"}
 #' dat <- data.frame(
-#'   local = c("`git_config()`", "`git_config_set()`"),
-#'   global = c("`git_config_global()`", "`git_config_global_set()`"),
-#'   row.names = c("get", "set")
+#'   local = c("`git_config()`", "`git_config_get()`", "`git_config_local_get()`", "`git_config_set()`"),
+#'   global = c("`git_config_global()`", "`git_config_get()`", "`git_config_global_get()`", "`git_config_global_set()`"),
+#'   row.names = c("get all", "get one (local+global)", "get one (local or global only)", "set")
 #' )
 #' knitr::kable(dat, col.names = paste0("**", colnames(dat), "**"))
 #' ```
@@ -21,6 +20,11 @@
 #'   option is determined from global or local config.
 #' * `git_config_global()`: a `data.frame`, as for `git_config()`, except only
 #'   for global Git options.
+#' * `git_config_get()`: the value of the named option considering both local and
+#'   global config (local wins), or `NULL` if unset.
+#' * `git_config_local_get()`: as for `git_config_get()`, but restricted to
+#'   local (repository-level) config only.
+#' * `git_config_global_get()`: as for `git_config_get()`, but for global config only.
 #' * `git_config_set()`, `git_config_global_set()`: The previous value(s) of
 #'   `name` in local or global config, respectively. If this option was
 #'   previously unset, returns `NULL`. Returns invisibly.
@@ -36,15 +40,16 @@
 #'
 #' previous <- git_config_set("aaa.bbb", "ccc", repo = r)
 #' previous
-#' cfg <- git_config(repo = r)
-#' subset(cfg, level == "local")
-#' cfg$value[cfg$name == "aaa.bbb"]
+#' git_config_local_get("aaa.bbb", repo = r)
 #'
 #' previous <- git_config_set("aaa.bbb", NULL, repo = r)
 #' previous
-#' cfg <- git_config(repo = r)
-#' subset(cfg, level == "local")
-#' cfg$value[cfg$name == "aaa.bbb"]
+#' git_config_local_get("aaa.bbb", repo = r)
+#'
+#' # Get a single named option (returns NULL if unset)
+#' git_config_get("aaa.bbb", repo = r)
+#' git_config_set("aaa.bbb", "ccc", repo = r)
+#' git_config_get("aaa.bbb", repo = r)
 #'
 #' unlink(r, recursive = TRUE)
 #'
@@ -53,6 +58,10 @@
 #' git_config_global_set("user.name", "Your Name")
 #' git_config_global_set("user.email", "your@email.com")
 #' git_config_global()
+#'
+#' # Get a single global option (returns NULL if unset)
+#' git_config_global_get("user.name")
+#' git_config_global_get("gert.nonexistent")
 #' }
 #' @export
 #' @family git
@@ -70,10 +79,41 @@ git_config_global <- function() {
   .Call(R_git_config_list, NULL)
 }
 
+#' @export
+#' @rdname git_config
+#' @param name Name of the option to get or set
+git_config_get <- function(name, repo = '.') {
+  cfg <- git_config(repo = repo)
+  if (!name %in% cfg$name) {
+    return(NULL)
+  }
+  cfg$value[cfg$name == name]
+}
+
+#' @export
+#' @rdname git_config
+git_config_local_get <- function(name, repo = '.') {
+  cfg <- git_config(repo = repo)
+  cfg <- cfg[cfg$level == "local", ]
+  if (!name %in% cfg$name) {
+    return(NULL)
+  }
+  cfg$value[cfg$name == name]
+}
+
+#' @export
+#' @rdname git_config
+git_config_global_get <- function(name) {
+  cfg <- git_config_global()
+  if (!name %in% cfg$name) {
+    return(NULL)
+  }
+  cfg$value[cfg$name == name]
+}
+
 #' @export
 #' @rdname git_config
 #' @useDynLib gert R_git_config_set
-#' @param name Name of the option to set
 #' @param value Value to set. Must be a string, logical, number or `NULL` (to
 #'   unset).
 #' @param add if `TRUE`, append a new entry for `name` instead of replacing
@@ -85,8 +125,7 @@ git_config_set <- function(name, value, add = FALSE, repo = '.') {
   }
   repo <- git_open(repo)
   name <- as.character(name)
-  orig_cfg <- git_config(repo = repo)
-  out <- orig_cfg$value[orig_cfg$name == name & orig_cfg$level == "local"]
+  out <- git_config_local_get(name, repo = repo)
   .Call(R_git_config_set, repo, name, value, add)
   if (length(out) > 0) {
     invisible(out)
@@ -98,8 +137,7 @@ git_config_set <- function(name, value, add = FALSE, repo = '.') {
 #' @export
 #' @rdname git_config
 git_config_global_set <- function(name, value, add = FALSE) {
-  orig_cfg <- git_config_global()
-  out <- orig_cfg$value[orig_cfg$name == name]
+  out <- git_config_global_get(name)
   .Call(R_git_config_set, NULL, name, value, add)
   if (length(out) > 0) {
     invisible(out)
@@ -141,9 +179,8 @@ configure_global_user <- function() {
 }
 
 global_user_is_configured <- function() {
-  cfg <- git_config_global()
-  user_name_exists <- any(cfg$name == "user.name")
-  user_email_exists <- any(cfg$name == "user.email")
+  user_name_exists <- !is.null(git_config_global_get("user.name"))
+  user_email_exists <- !is.null(git_config_global_get("user.email"))
   user_name_exists && user_email_exists
 }
 
@@ -161,14 +198,10 @@ global_user_is_configured <- function() {
 #'   `FALSE` otherwise.
 #'
 #' @export
-#' @examples
+#' @examplesIf interactive()
 #' user_is_configured()
 user_is_configured <- function(repo = ".") {
-  cfg <- tryCatch(
-    git_config(repo),
-    error = function(e) git_config_global()
-  )
-  user_name_exists <- any(cfg$name == "user.name")
-  user_email_exists <- any(cfg$name == "user.email")
+  user_name_exists <- !is.null(git_config_get("user.name", repo = repo))
+  user_email_exists <- !is.null(git_config_get("user.email", repo = repo))
   user_name_exists && user_email_exists
 }

R/fetch.R

@@ -174,6 +174,9 @@ git_push <- function(
 #' repositories, and `https://yourname@github.com/` or `git@github.com/` for
 #' private repos. You will be prompted for a password or pat when needed.
 #' @param path Directory of the Git repository to create.
+#' By default, the "humanish" part of the URL.
+#' For instance, "git@github.com:someone/myrepo.git" will be cloned to
+#' `myrepo/`.
 #' @param ssh_key path or object containing your ssh private key. By default we
 #' look for keys in `ssh-agent` and [credentials::ssh_key_info()].
 #' @param branch name of branch to check out locally
@@ -220,8 +223,13 @@ git_clone <- function(
   verbose = interactive()
 ) {
   stopifnot(is.character(url))
+  # "humanish" part of the URL
+  # https://github.com/git/git/blob/6e8d538aab8fe4dd07ba9fb87b5c7edcfa5706ad/dir.h#L494
   if (!length(path)) {
-    path <- file.path(getwd(), basename(url))
+    path <- file.path(
+      getwd(),
+      sub("\\.git$", "", sub("/.git$", "", basename(url)))
+    )
   }
   stopifnot(is.character(path))
   stopifnot(is.null(branch) || is.character(branch))
@@ -249,7 +257,7 @@ git_clone <- function(
 #' @param rebase if TRUE we try to rebase instead of merge local changes. This
 #' is not possible in case of conflicts (you will get an error).
 #' @param ... arguments passed to `git_fetch()`
-git_pull <- function(remote = NULL, rebase = FALSE, ..., repo = '.'){
+git_pull <- function(remote = NULL, rebase = FALSE, ..., repo = '.') {
   repo <- git_open(repo)
   info <- git_info(repo)
   branch <- info$shorthand

R/repository.R

@@ -5,6 +5,8 @@
 #' * `git_info()` shows basic information about a repository, such as the SHA
 #'   and branch of the current HEAD.
 #'
+#' @section Path:
+#'
 #' For `git_init()` the `path` parameter sets the directory of the git repository
 #' to create. If this directory already exists, it must be empty. If it does
 #' not exist, it is created, along with any intermediate directories that don't
@@ -21,7 +23,7 @@
 #' @family git
 #' @useDynLib gert R_git_repository_init
 #' @inheritParams git_open
-#' @param path the location of the git repository, see details.
+#' @param path the location of the git repository, see the "path" section.
 #' @param bare if true, a Git repository without a working directory is created
 #' @git repository
 #' @return
@@ -68,6 +70,9 @@ git_find <- function(path = '.') {
 #' @export
 #' @rdname git_repo
 #' @useDynLib gert R_git_repository_info
+#' @section Detached head:
+#' If `git_info()$shorthand` is equal to `HEAD`,
+#' it means the repository is in a [detached head state](https://jvns.ca/blog/2023/11/01/confusing-git-terminology/#detached-head-state).
 git_info <- function(repo = '.') {
   repo <- git_open(repo)
   .Call(R_git_repository_info, repo)