dependency to net-lib

README.md

@@ -24,12 +24,38 @@ procedure and through direct procedures.
 `git` is an ordinary procedure. The first argument is the Git command symbol
 and the remaining arguments are passed to that command.
 
+`git*` is the compact command-style syntax. Bare arguments are converted to
+strings, so `(git* remote get-url origin)` is equivalent to
+`(git 'remote "get-url" "origin")`. Use `(eval expression)` when an argument
+must come from a Racket expression. `gt` remains available as a compatibility
+alias for `git*`.
+
+```racket
+(git* remote -v)
+(git* switch main)
+(git* restore --staged main.rkt)
+(git* reset --hard HEAD)
+(git* revert HEAD)
+(git* rebase main)
+(git* merge feature)
+(git* cherry-pick abc1234)
+(git* mergetool)
+
+(define branch "develop")
+(git* switch (eval branch))
+```
+
 Several commands provide Racket-oriented output in addition to the normal Git
 behavior:
 
 - `git-status` uses Git's porcelain status and returns structured status items.
 - `git-log -l` / `git-log --list` returns `(commit subject)` items.
 - `git-tag -l` / `git-tag --list` returns tag names; with `-n` it returns `(tag subject)` items and `-n<number>` supports multiple content lines.
+- `git-branch -l` / `git-branch --list` returns `(current|local|remote branch)` items; `-a`, `-r`, and `--sort=` remain Git options.
+- `git-remote` returns remote names; `git-remote -v` / `git-remote --verbose` returns separate `(name url fetch|push)` items.
+- `git-stash list` returns `(stash-name description)` items; other stash subcommands keep Git's normal behavior.
+- `git-restore`, `git-reset`, `git-revert`, `git-rebase`, `git-merge`, and `git-cherry-pick` pass Git's command syntax through unchanged.
+- `git-mergetool` uses Git's mergetool interface and prefers a configured or well-known graphical merge tool.
 - `git-diff` renders HTML by default; `--output=-` selects stdout and
   `--output=string` returns a string.
 - `git-show` renders a commit and its diff as HTML by default. `-l` /
@@ -42,14 +68,34 @@ credentials, SSH keys, pull strategy, and other repository configuration.
 ## Commands
 
 The package currently registers commands including `status`, `add`, `commit`,
-`push`, `pull`, `fetch`, `branch`, `switch`, `clone`, `tag`, `log`,
+`push`, `pull`, `fetch`, `config`, `branch`, `remote`, `stash`, `restore`, `reset`, `revert`, `rebase`, `merge`, `cherry-pick`, `mergetool`, `switch`, `clone`, `tag`, `log`,
 `rev-list`, `diff`, `show`, `grep`, `help`, `version`, and `new-version`.
 
 Most are also exported as direct procedures such as `git-status`, `git-add`,
-`git-fetch`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`.
+`git-fetch`, `git-config`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`.
 
 See the Scribble documentation for command-specific behavior and return values.
 
+## Git configuration
+
+`git config` has a small Racket-oriented interface:
+
+```racket
+(git 'config '--all)
+(git 'config 'get '--all)
+(git 'config '--global 'get '--all)
+(git 'config 'get '--global "user.email")
+(git 'config 'get '--all "credential.helper")
+(git 'config 'get "credential.helper")
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config '--global 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
+```
+
+`get --all` without a key returns `(key value)` items. `get --all key`
+returns all values for one key. `get key` returns one string or `#f` when the
+key is absent. `set!` returns `#t` after a successful write.
+
 ## Low-level Git execution
 
 `run-git` can be used when direct access to Git's stdin/stdout protocol is
@@ -63,3 +109,64 @@ needed. Optional text can be supplied to Git with `#:input`.
 The result remains two values: Git's exit code and the ordered
 `(source line)` output items.
 
+## Authentication retry
+
+Authentication failures are recognized centrally after `run-git`. The
+recognizer covers common authentication/authorization errors, including HTTP
+401 and 403 responses.
+
+`current-git-authentication-handler` defaults to
+`default-git-authentication-handler`. After an authentication failure the
+default handler rejects the failed credential first. If a Git credential
+helper exists, `git credential fill` is then tried so that helpers such as Git
+Credential Manager can obtain a replacement credential.
+
+When no usable credential is returned, git-cli asks for a username and
+password/token using `input-prompt`. The `#:loop-until` callbacks validate the
+input and return the final value, as intended by `input-prompt`. If no
+credential helper is configured, git-cli configures the non-persistent `cache`
+helper locally before approving the supplied credential.
+
+The original Git command is retried once. If authentication fails again, the
+credential used for that retry is rejected before the normal Git error is
+raised. This prevents a bad token from remaining in the credential cache.
+
+A custom handler can still be installed through
+`current-git-authentication-handler`.
+
+
+## GUI editor and merge tool
+
+git-cli looks for a GUI editor and passes it to Git through `GIT_EDITOR` and
+`GIT_SEQUENCE_EDITOR` in the environment of the Git subprocess only. It does
+not change the user's global Git configuration.
+
+The editor can be inspected or configured explicitly:
+
+```racket
+(find-editor)
+(set-editor! "code --wait")
+```
+
+The editor search first checks `PATH` and then well-known platform locations.
+On Windows this includes the normal per-user and Program Files locations for
+VS Code, with Notepad as fallback. On macOS the standard Visual Studio Code
+application bundle and TextEdit are recognized. On Linux common `/usr`,
+`/usr/local`, and Snap locations are checked for VS Code, Kate, Gedit, and Xed.
+
+`git-mergetool` stays on top of Git's own mergetool mechanism. If no tool is
+specified explicitly, git-cli prefers a configured or well-known graphical
+tool such as WinMerge, Meld, KDiff3, VS Code, TortoiseMerge, or opendiff.
+The finder checks `PATH` first and then common platform installation locations.
+When a merge tool is found outside `PATH`, git-cli adds that executable's
+directory to the environment of the Git subprocess, so Git's own mergetool
+integration can still find it. If no tool is found, Git is left to select its
+own default.
+
+```racket
+(find-mergetool)
+(find-mergetool-path)
+(set-mergetool! "winmerge")
+(git* mergetool)
+(git* mergetool --tool=meld)
+```

info.rkt

@@ -1,23 +1,24 @@
-#lang info
+#lang info
-
+
-(define collection "git-cli")
+(define collection "git-cli")
-(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
+(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
-(define version "0.4")
+(define version "0.3.36")
-(define pkg-authors '("Hans Dijkema"))
+(define pkg-authors '("Hans Dijkema"))
-(define license 'MIT)
+(define license 'MIT)
-
+
-(define deps
+(define deps
-  '("base"
+  '("base"
-    "simple-ini"
+    "simple-ini"
-    "simple-log"
+    "simple-log"
-    "racket-index"
+    "racket-index"
-    "scribble-lib"
+    "scribble-lib"
-    "racket-makefile"
+    "net-lib"
-    "package-zipper"))
+    ))
-
+
-(define build-deps
+(define build-deps
-  '("rackunit-lib"
+  '("rackunit-lib"
-    "racket-doc"))
+    "racket-doc"))
-
+
-(define scribblings
+(define scribblings
-  '(("scribblings/git.scrbl" () ("Git"))))
+  '(("scribblings/git-cli.scrbl" () ("git-cli"))))
+

main.rkt

@@ -4,14 +4,18 @@
          "private/git-commands.rkt"
          "private/config.rkt"
          "private/diff.rkt"
-         "private/info.rkt"
+         "private/info-handler.rkt"
          "private/utils.rkt"
+         "private/find-editor.rkt"
+         "private/find-mergetool.rkt"
          simple-log
          racket/string
          net/sendurl
          )
 
-(provide git
+(provide gt
+         git*
+         git
          git-add
          git-status
          git-commit
@@ -20,9 +24,19 @@
          git-fetch
          git-switch
          git-tag
+         git-config
          git-log
          git-grep
          git-branch
+         git-remote
+         git-stash
+         git-restore
+         git-reset
+         git-revert
+         git-rebase
+         git-merge
+         git-cherry-pick
+         git-mergetool
          git-clone
          git-rev-list
          git-diff
@@ -30,6 +44,19 @@
          git-help
          git-version
          git-new-version
+         git-next-version
+         find-editor
+         set-editor!
+         find-mergetool
+         find-mergetool-path
+         set-mergetool!
+         default-git-authentication-handler
+         current-git-authentication-handler
+         exn:fail:git-auth?
+         exn:fail:git-auth-command
+         exn:fail:git-auth-args
+         exn:fail:git-auth-exit-code
+         exn:fail:git-auth-output
          (all-from-out "private/diff.rkt")
          )
 
@@ -43,6 +70,23 @@
 ;; Command invocation using 'git'
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(define-syntax git*-argument
+  (syntax-rules (eval)
+    ((_ (eval expr))
+     expr)
+    ((_ arg)
+     (format "~a" 'arg))))
+
+(define-syntax git*
+  (syntax-rules ()
+    ((_ cmd arg ...)
+     (git 'cmd (git*-argument arg) ...))))
+
+(define-syntax gt
+  (syntax-rules ()
+    ((_ cmd arg ...)
+     (git* cmd arg ...))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Invoke a supported Git command through the command table.
 ; pre    : command is a registered Git command symbol.
@@ -69,6 +113,26 @@
 (define (git-prompt p)
   (input-prompt p))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Compare a Git argument independent of its Racket representation.
+; pre    : arg and expected can be formatted as command-line arguments.
+; post   : Neither value has been changed.
+; result : #t when both arguments have the same command-line text.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-argument=? arg expected)
+  (string=? (format "~a" arg)
+            (format "~a" expected)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Test whether a Git argument occurs in a set of accepted values.
+; pre    : values is a list of Git argument representations.
+; post   : arg and values have only been inspected.
+; result : #t when arg matches one of values.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-argument-member? arg values)
+  (ormap (λ (value) (git-argument=? arg value))
+         values))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Add --porcelain to a Git argument list when it is absent.
 ; pre    : args is a list and an optional transformation accepts a list.
@@ -116,6 +180,134 @@
                  (string-contains? line* "no changes added to commit"))))
          out))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Convert one git config --list output line to a key/value item.
+; pre    : line is one line produced by git config --list.
+; post   : line has only been inspected.
+; result : A list containing the configuration key and value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (config-line->item line)
+  (let ((m (regexp-match #px"^([^=]+)=(.*)$" line)))
+    (if m
+        (list (cadr m) (caddr m))
+        (list line ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Translate the Racket-oriented config interface to git config arguments.
+; pre    : args starts with get or set! and follows one of the supported forms.
+; post   : info contains the config operation used to process Git's result.
+; result : Arguments accepted by git config.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config-args args info)
+  (define (scope? x)
+    (git-argument-member? x '(--global --local --system)))
+
+  (define (split-scope args)
+    (cond
+      ((and (pair? args) (scope? (car args)))
+       (values (car args) (cdr args)))
+      (else
+       (values #f args))))
+
+  (let-values (((scope args*) (split-scope args)))
+    (cond
+      ;; Short form: (git 'config '--all)
+      ((and (not scope)
+            (= (length args*) 1)
+            (git-argument=? (car args*) '--all))
+       (hash-set! info 'config-operation 'all)
+       '(--list))
+
+      ((null? args*)
+       (error 'git-config "Expected get or set!"))
+
+      (else
+       (let ((action (car args*))
+             (rest (cdr args*)))
+         (cond
+           ((git-argument=? action 'get)
+            ;; Also accept scope directly after get.
+            (let-values (((scope* rest*) (split-scope rest)))
+              (let ((effective-scope (or scope scope*)))
+                (when (and scope scope*)
+                  (error 'git-config "Configuration scope specified twice"))
+                (cond
+                  ((null? rest*)
+                   (error 'git-config "Expected a configuration key or --all"))
+
+                  ((git-argument=? (car rest*) '--all)
+                   (cond
+                     ((null? (cdr rest*))
+                      (hash-set! info 'config-operation 'all)
+                      (append (if effective-scope (list effective-scope) '())
+                              '(--list)))
+                     ((null? (cddr rest*))
+                      (hash-set! info 'config-operation 'get-all)
+                      (append (if effective-scope (list effective-scope) '())
+                              (list '--get-all (cadr rest*))))
+                     (else
+                      (error 'git-config "Too many arguments for config get --all"))))
+
+                  ((null? (cdr rest*))
+                   (hash-set! info 'config-operation 'get)
+                   (append (if effective-scope (list effective-scope) '())
+                           (list '--get (car rest*))))
+
+                  (else
+                   (error 'git-config "Too many arguments for config get"))))))
+
+           ((git-argument=? action 'set!)
+            ;; Also accept scope directly after set!.
+            (let-values (((scope* rest*) (split-scope rest)))
+              (let ((effective-scope (or scope scope*)))
+                (when (and scope scope*)
+                  (error 'git-config "Configuration scope specified twice"))
+                (if (= (length rest*) 2)
+                    (begin
+                      (hash-set! info 'config-operation 'set)
+                      (append (if effective-scope (list effective-scope) '())
+                              rest*))
+                    (error 'git-config "Expected config set! [scope] key value")))))
+
+           (else
+            (error 'git-config "Expected get or set!"))))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Process the result of the Racket-oriented git config interface.
+; pre    : info contains the operation selected by git-config-args.
+; post   : Successful query output has been converted to Racket data.
+; result : Config data, #f for a missing single key, or #t after set!.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (process-git-config-result cmd exit-code result output out info)
+  (let* ((operation (hash-ref info 'config-operation))
+         (stdout (map cadr
+                      (filter (λ (entry) (eq? (car entry) 'stdout))
+                              output))))
+    (cond
+      ((eq? operation 'all)
+       (if (= exit-code 0)
+           (map config-line->item stdout)
+           (std-process-git-result cmd exit-code result output out info)))
+
+      ((eq? operation 'get-all)
+       (cond
+         ((= exit-code 0) stdout)
+         ((= exit-code 1) '())
+         (else
+          (std-process-git-result cmd exit-code result output out info))))
+
+      ((eq? operation 'get)
+       (cond
+         ((= exit-code 0)
+          (if (null? stdout) #f (car stdout)))
+         ((= exit-code 1) #f)
+         (else
+          (std-process-git-result cmd exit-code result output out info))))
+
+      (else
+       (std-process-git-result cmd exit-code result output out info)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Command definition macro
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -226,14 +418,243 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def-cmd git-fetch cmd-git-fetch 'fetch)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read or write Git configuration through a Racket-oriented interface.
+; pre    : Arguments follow one of the supported get/set! forms.
+; post   : Git config has completed or an exception has been raised.
+; result : Structured config data, #f for a missing key, or #t after set!.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-config cmd-git-config 'config
+  git-config-args
+  process-git-config-result)
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : List, create or delete branches.
 ; pre    : The supplied arguments are valid for git branch.
 ; post   : Git branch has completed successfully or an exception was raised.
-; result : #t after a successful branch command.
+; result : A structured branch list with --list/-l, otherwise #t.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(def-cmd git-branch cmd-git-branch 'branch)
+(def-cmd git-branch cmd-git-branch 'branch
+  (λ (args info)
+    (let* ((split-id (format "git-cli-branch-split-~a-~a"
+                             (random 1000000000)
+                             (random 1000000000)))
+           (list-output
+            (ormap
+             (λ (e)
+               (let ((o (format "~a" e)))
+                 (or (string=? o "--list")
+                     (string=? o "-l"))))
+             args)))
+      (hash-set! info 'scheme-format list-output)
+      (hash-set! info 'branch-split-id split-id)
+      (if list-output
+          (append args
+                  (list
+                   (format "--format=%(HEAD)~a%(refname)" split-id)))
+          args)))
+  (λ (cmd exit-code result output out info)
+    (if (hash-ref info 'scheme-format #f)
+        (if (and (= exit-code 0) result)
+            (let ((split-id (hash-ref info 'branch-split-id)))
+              (map
+               (λ (line)
+                 (let* ((parts (string-split line split-id #:trim? #f))
+                        (head (car parts))
+                        (ref (if (null? (cdr parts)) "" (cadr parts))))
+                   (cond
+                     ((string-prefix? ref "refs/heads/")
+                      (list (if (string=? head "*") 'current 'local)
+                            (substring ref (string-length "refs/heads/"))))
+                     ((string-prefix? ref "refs/remotes/")
+                      (list 'remote
+                            (substring ref (string-length "refs/remotes/"))))
+                     (else
+                      (list 'branch ref)))))
+               out))
+            (std-process-git-result cmd exit-code result output out info))
+        (std-process-git-result cmd exit-code result output out info)))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List, add, rename or remove remotes.
+; pre    : The supplied arguments are valid for git remote.
+; post   : Git remote has completed successfully or an exception was raised.
+; result : A structured remote list with --list/-l, otherwise #t.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-remote cmd-git-remote 'remote
+  (λ (args info)
+    (cond
+      ((null? args)
+       (hash-set! info 'remote-operation 'list)
+       args)
+
+      ((and (= (length args) 1)
+            (git-argument-member? (car args) '(-v --verbose)))
+       (hash-set! info 'remote-operation 'verbose-list)
+       args)
+
+      ((git-argument=? (car args) 'get-url)
+       (hash-set! info 'remote-operation
+                  (if (ormap (λ (arg) (git-argument=? arg '--all)) args)
+                      'get-url-all
+                      'get-url))
+       args)
+
+      (else
+       (hash-set! info 'remote-operation 'command)
+       args)))
+
+  (λ (cmd exit-code result output out info)
+    (let* ((operation (hash-ref info 'remote-operation 'command))
+           (stdout (map cadr
+                        (filter (λ (entry) (eq? (car entry) 'stdout))
+                                output))))
+      (cond
+        ((eq? operation 'list)
+         (if (= exit-code 0)
+             stdout
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'verbose-list)
+         (if (= exit-code 0)
+             (map
+              (λ (line)
+                (let ((m (regexp-match
+                          #px"^([^\\s]+)\\s+(.+) \\((fetch|push)\\)$"
+                          line)))
+                  (if m
+                      (list (cadr m)
+                            (caddr m)
+                            (string->symbol (cadddr m)))
+                      (list line #f 'unknown))))
+              stdout)
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'get-url)
+         (if (= exit-code 0)
+             (if (null? stdout) #f (car stdout))
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'get-url-all)
+         (if (= exit-code 0)
+             stdout
+             (std-process-git-result cmd exit-code result output out info)))
+
+        (else
+         (std-process-git-result cmd exit-code result output out info)))))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store, inspect or restore stashed working tree changes.
+; pre    : The supplied arguments are valid for git stash.
+; post   : Git stash has completed successfully or an exception was raised.
+; result : Structured stash entries for `stash list`, otherwise the normal result.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-stash cmd-git-stash 'stash
+  (λ (args info)
+    (let ((list-output
+           (and (pair? args)
+                (git-argument=? (car args) 'list)
+                (not
+                 (ormap
+                  (λ (arg)
+                    (regexp-match?
+                     #px"^--(format|pretty)(=|$)"
+                     (format "~a" arg)))
+                  args)))))
+      (hash-set! info 'stash-list list-output)
+      (if list-output
+          (append args
+                  '("--format=%gd%x00%gs"))
+          args)))
+  (λ (cmd exit-code result output out info)
+    (if (hash-ref info 'stash-list #f)
+        (if (= exit-code 0)
+            (map
+             (λ (line)
+               (let ((parts (string-split line "\u0000" #:trim? #f)))
+                 (if (null? (cdr parts))
+                     (list (car parts) "")
+                     (list (car parts) (cadr parts)))))
+             (map cadr
+                  (filter (λ (entry) (eq? (car entry) 'stdout))
+                          output)))
+            (std-process-git-result cmd exit-code result output out info))
+        (std-process-git-result cmd exit-code result output out info)))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Restore working tree or index files from a Git source.
+; pre    : The supplied arguments are valid for git restore.
+; post   : Git restore has completed successfully or an exception was raised.
+; result : #t after a successful restore.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-restore cmd-git-restore 'restore)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reset HEAD or selected paths according to Git reset semantics.
+; pre    : The supplied arguments are valid for git reset.
+; post   : Git reset has completed successfully or an exception was raised.
+; result : #t after a successful reset.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-reset cmd-git-reset 'reset)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Revert one or more commits using Git's revert command.
+; pre    : The supplied arguments are valid for git revert.
+; post   : Git revert has completed successfully or an exception was raised.
+; result : #t after a successful revert or sequencer command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-revert cmd-git-revert 'revert)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reapply commits on top of another base with Git rebase.
+; pre    : The supplied arguments are valid for git rebase.
+; post   : Git rebase has completed successfully or an exception was raised.
+; result : #t after a successful rebase or rebase control command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-rebase cmd-git-rebase 'rebase)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Join development histories with Git merge.
+; pre    : The supplied arguments are valid for git merge.
+; post   : Git merge has completed successfully or an exception was raised.
+; result : #t after a successful merge or merge control command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-merge cmd-git-merge 'merge)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Apply changes introduced by existing commits.
+; pre    : The supplied arguments are valid for git cherry-pick.
+; post   : Git cherry-pick has completed successfully or an exception was raised.
+; result : #t after a successful cherry-pick or sequencer command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-cherry-pick cmd-git-cherry-pick 'cherry-pick)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve merge conflicts using a graphical Git merge tool.
+; pre    : The supplied arguments are valid for git mergetool.
+; post   : Git mergetool has completed successfully or an exception was raised.
+; result : #t after a successful mergetool command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-mergetool cmd-git-mergetool 'mergetool
+  (λ (args info)
+    (let ((tool-specified
+           (ormap
+            (λ (arg)
+              (let ((value (format "~a" arg)))
+                (or (string=? value "-t")
+                    (regexp-match? #px"^--tool=" value)
+                    (string=? value "--tool-help"))))
+            args)))
+      (if tool-specified
+          args
+          (let ((tool (find-mergetool)))
+            (if tool
+                (cons (format "--tool=~a" tool) args)
+                args))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Switch branches.
@@ -498,7 +919,7 @@
                           ((string=? o "-c") (set! matches #t))
                           ((string=? o "-n") (set! line-nr #t))))
                       e)
-                    (map (λ (x) (if (eq? x '-i) "-i" x)) args))))
+                    (map (λ (x) (if (git-argument=? x '-i) "-i" x)) args))))
         (when (eq? line-nr #f)
           (set! nargs (cons "-n" nargs)))  ;; add line numbers / counts for pattern recognition
         (hash-set! info 'matches matches)
@@ -583,14 +1004,31 @@
 ; result : The new version as a list containing major, minor and patch.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (cmd-git-new-version args)
-  (when(null? args)
+  (when (null? args)
       (error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch"))
   (let ((kind (car args)))
-    (git-next-version kind ".")
+    (info-next-version kind ".")
     (git-version)))
 
 (hash-set! git-commands 'new-version cmd-git-new-version)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Implement the registered next-version command.
+; pre    : args must be empty. 
+; post   : The version definition in info.rkt has been updated.
+; result : The new patch version.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-next-version . args)
+  (cmd-git-next-version args))
+
+(define (cmd-git-next-version args)
+  (unless (null? args)
+    (error "git-next-version expexts no arguments"))
+  (let ((kind 'patch))
+    (info-next-version kind ".")
+    (git-version)))
+
+(hash-set! git-commands 'next-version cmd-git-next-version)
 
 
 

private/find-editor.rkt

@@ -0,0 +1,177 @@
+#lang racket/base
+
+(require racket/path
+         "config.rkt")
+
+(provide find-editor
+         configured-editor
+         set-editor!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Quote an executable path for use as a Git editor command.
+; pre    : p is a path to an executable.
+; post   : p has only been converted to a string.
+; result : A quoted command path.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (quote-command-path p)
+  (format "\"~a\"" (path->string p)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return an existing executable from a list of candidate paths.
+; pre    : candidates contains paths or #f values.
+; post   : The filesystem has only been inspected.
+; result : The first existing path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (first-existing candidates)
+  (cond
+    ((null? candidates) #f)
+    ((and (car candidates)
+          (file-exists? (car candidates)))
+     (car candidates))
+    (else
+     (first-existing (cdr candidates)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a path below an environment variable when it is defined.
+; pre    : variable is an environment variable name.
+; post   : The environment has only been inspected.
+; result : The constructed path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (environment-path variable . parts)
+  (let ((base (getenv variable)))
+    (if base
+        (apply build-path base parts)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find an editor executable on PATH and append its wait arguments.
+; pre    : executable is a pathless executable name.
+; post   : PATH has only been inspected.
+; result : An editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-on-path executable arguments)
+  (let ((p (find-executable-path executable)))
+    (if p
+        (string-append (quote-command-path p) arguments)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Make an editor command from an existing well-known path.
+; pre    : p is a path or #f; arguments contains the editor wait arguments.
+; post   : p has only been inspected.
+; result : An editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-at p arguments)
+  (if (and p (file-exists? p))
+      (string-append (quote-command-path p) arguments)
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on Windows.
+; pre    : The current platform is Windows.
+; post   : PATH and standard Windows installation locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-windows-editor)
+  (or (editor-on-path "code.cmd" " --wait")
+      (editor-on-path "code.exe" " --wait")
+      (editor-at
+       (first-existing
+        (list
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")))
+       " --wait")
+      (editor-at
+       (first-existing
+        (list
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe")))
+       " --wait")
+      (editor-on-path "notepad.exe" "")
+      (editor-at
+       (environment-path "SystemRoot" "System32" "notepad.exe")
+       "")
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on macOS.
+; pre    : The current platform is macOS.
+; post   : PATH and standard application locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-macos-editor)
+  (or (editor-on-path "code" " --wait")
+      (editor-at
+       (string->path
+        "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
+       " --wait")
+      (let ((open
+             (or (find-executable-path "open")
+                 (let ((p (string->path "/usr/bin/open")))
+                   (if (file-exists? p) p #f)))))
+        (if open
+            (format "~a -W -a TextEdit" (quote-command-path open))
+            #f))
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find a well-known GUI editor on Unix/Linux.
+; pre    : The current platform is Unix.
+; post   : PATH and common Linux installation locations were inspected.
+; result : A Git editor command string, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-unix-editor)
+  (or (editor-on-path "code" " --wait")
+      (editor-on-path "kate" " --block")
+      (editor-on-path "gedit" " --wait")
+      (editor-on-path "xed" " --wait")
+      (editor-at (string->path "/snap/bin/code") " --wait")
+      (editor-at (string->path "/usr/local/bin/code") " --wait")
+      (editor-at (string->path "/usr/bin/code") " --wait")
+      (editor-at (string->path "/usr/local/bin/kate") " --block")
+      (editor-at (string->path "/usr/bin/kate") " --block")
+      (editor-at (string->path "/usr/bin/gedit") " --wait")
+      (editor-at (string->path "/usr/bin/xed") " --wait")
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the editor explicitly configured for git-cli.
+; pre    : The git-cli configuration is readable.
+; post   : The configuration has not been changed.
+; result : The configured editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (configured-editor)
+  (cfg-get 'git 'editor #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store the editor command used by git-cli.
+; pre    : command is a command string suitable for GIT_EDITOR.
+; post   : The command has been stored in the git-cli configuration.
+; result : The result returned by the configuration layer.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-editor! command)
+  (cfg-set! 'git 'editor command))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the GUI editor that git-cli should offer to Git.
+; pre    : The platform and git-cli configuration are available.
+; post   : No editor has been started.
+; result : A configured or well-known GUI editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-editor)
+  (or (configured-editor)
+      (case (system-type 'os)
+        ((windows) (find-windows-editor))
+        ((macosx) (find-macos-editor))
+        ((unix) (find-unix-editor))
+        (else #f))))

private/find-mergetool.rkt

@@ -0,0 +1,201 @@
+#lang racket/base
+
+(require racket/path
+         "config.rkt")
+
+(provide find-mergetool
+         find-mergetool-path
+         configured-mergetool
+         set-mergetool!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a path below an environment variable when it is defined.
+; pre    : variable is an environment variable name.
+; post   : The environment has only been inspected.
+; result : The constructed path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (environment-path variable . parts)
+  (let ((base (getenv variable)))
+    (if base
+        (apply build-path base parts)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find one merge tool candidate on PATH or at a well-known path.
+; pre    : candidate contains tool name, executable name and zero or more paths.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list containing tool name and executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-candidate candidate)
+  (let* ((tool (car candidate))
+         (executable (cadr candidate))
+         (path-executable (find-executable-path executable)))
+    (cond
+      (path-executable
+       (list tool path-executable))
+      (else
+       (let loop ((paths (cddr candidate)))
+         (cond
+           ((null? paths) #f)
+           ((and (car paths)
+                 (file-exists? (car paths)))
+            (list tool (car paths)))
+           (else
+            (loop (cdr paths)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the first usable merge tool candidate.
+; pre    : candidates contains merge tool candidate descriptions.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list containing tool name and executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-candidates candidates)
+  (cond
+    ((null? candidates) #f)
+    (else
+     (let ((candidate (find-candidate (car candidates))))
+       (if candidate
+           candidate
+           (find-candidates (cdr candidates)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for Windows.
+; pre    : Windows environment variables may or may not be defined.
+; post   : The environment has only been inspected.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (windows-mergetool-candidates)
+  (list
+   (list "winmerge" "WinMergeU.exe"
+         (environment-path "ProgramFiles" "WinMerge" "WinMergeU.exe")
+         (environment-path "ProgramFiles(x86)" "WinMerge" "WinMergeU.exe"))
+   (list "vscode" "code.cmd"
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd"))
+   (list "vscode" "code.exe"
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe"))
+   (list "kdiff3" "kdiff3.exe"
+         (environment-path "ProgramFiles" "KDiff3" "kdiff3.exe")
+         (environment-path "ProgramFiles(x86)" "KDiff3" "kdiff3.exe"))
+   (list "meld" "meld.exe"
+         (environment-path "LOCALAPPDATA" "Programs" "Meld" "Meld.exe")
+         (environment-path "ProgramFiles" "Meld" "Meld.exe")
+         (environment-path "ProgramFiles(x86)" "Meld" "Meld.exe"))
+   (list "tortoisemerge" "TortoiseMerge.exe"
+         (environment-path "ProgramFiles" "TortoiseSVN" "bin" "TortoiseMerge.exe")
+         (environment-path "ProgramFiles(x86)" "TortoiseSVN" "bin" "TortoiseMerge.exe"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for macOS.
+; pre    : The current platform is macOS.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (macos-mergetool-candidates)
+  (list
+   (list "opendiff" "opendiff"
+         (string->path "/usr/bin/opendiff"))
+   (list "vscode" "code"
+         (string->path
+          "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code"))
+   (list "kdiff3" "kdiff3"
+         (string->path "/Applications/kdiff3.app/Contents/MacOS/kdiff3"))
+   (list "meld" "meld")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for Unix/Linux.
+; pre    : The current platform is Unix.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (unix-mergetool-candidates)
+  (list
+   (list "meld" "meld"
+         (string->path "/usr/bin/meld")
+         (string->path "/usr/local/bin/meld"))
+   (list "kdiff3" "kdiff3"
+         (string->path "/usr/bin/kdiff3")
+         (string->path "/usr/local/bin/kdiff3"))
+   (list "vscode" "code"
+         (string->path "/snap/bin/code")
+         (string->path "/usr/bin/code")
+         (string->path "/usr/local/bin/code"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return merge tool candidates for the current platform.
+; pre    : The current platform is supported by Racket.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-candidates)
+  (case (system-type 'os)
+    ((windows) (windows-mergetool-candidates))
+    ((macosx) (macos-mergetool-candidates))
+    ((unix) (unix-mergetool-candidates))
+    (else '())))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the automatically detected merge tool and executable path.
+; pre    : Platform paths are accessible.
+; post   : No merge tool has been started.
+; result : A list containing tool name and path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (detected-mergetool)
+  (find-candidates (mergetool-candidates)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the merge tool explicitly configured for git-cli.
+; pre    : The git-cli configuration is readable.
+; post   : The configuration has not been changed.
+; result : The configured Git merge tool name, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (configured-mergetool)
+  (cfg-get 'git 'mergetool #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store the Git merge tool name used by git-cli.
+; pre    : tool is a Git mergetool name such as "winmerge" or "meld".
+; post   : The tool name has been stored in the git-cli configuration.
+; result : The result returned by the configuration layer.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-mergetool! tool)
+  (cfg-set! 'git 'mergetool tool))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the graphical merge tool that git-cli should prefer.
+; pre    : The platform and git-cli configuration are available.
+; post   : No merge tool has been started.
+; result : A configured or detected Git merge tool name, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetool)
+  (or (configured-mergetool)
+      (let ((detected (detected-mergetool)))
+        (if detected
+            (car detected)
+            #f))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the executable path belonging to the automatically detected merge tool.
+; pre    : Platform paths are accessible.
+; post   : No merge tool has been started.
+; result : The executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetool-path)
+  (let ((configured (configured-mergetool))
+        (detected (detected-mergetool)))
+    (if configured
+        #f
+        (if detected
+            (cadr detected)
+            #f))))

private/git-auth.rkt

@@ -0,0 +1,287 @@
+#lang racket/base
+
+(require racket/string
+         net/url
+         "git-provider.rkt"
+         "utils.rkt")
+
+(provide exn:fail:git-auth?
+         exn:fail:git-auth-command
+         exn:fail:git-auth-args
+         exn:fail:git-auth-exit-code
+         exn:fail:git-auth-output
+         authentication-failure?
+         raise-git-auth-error
+         default-git-authentication-handler
+         reject-git-authentication
+         current-git-authentication-handler)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication exception
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(struct exn:fail:git-auth exn:fail
+  (command args exit-code output)
+  #:transparent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the first value of a Git configuration key.
+; pre    : key is a Git configuration key.
+; post   : Git config has been queried without displaying its output.
+; result : The configured value, or #f when the key is absent.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config-value key)
+  (let-values (((exit-code output)
+                (run-git (list 'config '--get key))))
+    (if (= exit-code 0)
+        (let ((stdout
+               (map cadr
+                    (filter (λ (entry) (eq? (car entry) 'stdout))
+                            output))))
+          (if (null? stdout) #f (car stdout)))
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Determine the remote name used by the current branch.
+; pre    : The current directory is a Git working tree.
+; post   : Git branch/config have only been queried.
+; result : The configured remote name, or "origin" as fallback.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-current-remote)
+  (let-values (((exit-code output)
+                (run-git '(branch --show-current))))
+    (if (= exit-code 0)
+        (let ((stdout
+               (map cadr
+                    (filter (λ (entry) (eq? (car entry) 'stdout))
+                            output))))
+          (if (null? stdout)
+              "origin"
+              (let ((remote
+                     (git-config-value
+                      (format "branch.~a.remote" (car stdout)))))
+                (if remote remote "origin"))))
+        "origin")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Determine the remote URL relevant to the failed Git command.
+; pre    : cmd and args belong to a failed authenticated Git command.
+; post   : Git config has only been queried.
+; result : An HTTP(S) remote URL, or #f when it cannot be determined.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-authentication-url cmd args)
+  (let* ((remote (git-current-remote))
+         (url (git-config-value (format "remote.~a.url" remote))))
+    (if url
+        url
+        (git-config-value "remote.origin.url"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Convert an HTTP(S) remote URL to Git credential input.
+; pre    : value is a URL string.
+; post   : value has only been parsed.
+; result : protocol, host and optional username, or #f values for unsupported URLs.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (url->credential-parts value)
+  (with-handlers ((exn:fail? (λ (e) (values #f #f #f))))
+    (let* ((u (string->url value))
+           (protocol (url-scheme u))
+           (host (url-host u))
+           (user (url-user u)))
+      (if (and (member protocol '("http" "https"))
+               (string? host)
+               (not (string=? host "")))
+          (values protocol host user)
+          (values #f #f #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build Git credential protocol input.
+; pre    : protocol and host are strings; username and password may be #f.
+; post   : Arguments have only been formatted.
+; result : A credential protocol string terminated by a blank line.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (credential-input protocol host username password)
+  (string-append
+   (format "protocol=~a\n" protocol)
+   (format "host=~a\n" host)
+   (if username (format "username=~a\n" username) "")
+   (if password (format "password=~a\n" password) "")
+   "\n"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask Git's configured credential helper for credentials.
+; pre    : protocol and host identify the failed HTTP(S) remote.
+; post   : The helper may have prompted or updated its own credential state.
+; result : #t when git credential fill succeeded, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-fill protocol host username)
+  (let-values (((exit-code output)
+                (run-git '(credential fill)
+                         #:input (credential-input protocol host username #f))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Offer credentials to Git's configured credential helper.
+; pre    : protocol, host, username and password describe a credential.
+; post   : Git credential approve has been invoked.
+; result : #t when Git accepted the approve operation, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-approve protocol host username password)
+  (let-values (((exit-code output)
+                (run-git '(credential approve)
+                         #:input (credential-input protocol host username password))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reject credentials for an HTTP(S) remote through Git.
+; pre    : protocol and host identify the credential; username may be #f.
+; post   : Git credential reject has been invoked.
+; result : #t when Git accepted the reject operation, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-reject protocol host username)
+  (let-values (((exit-code output)
+                (run-git '(credential reject)
+                         #:input (credential-input protocol host username #f))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ensure a non-persistent credential helper exists for this repository.
+; pre    : The current directory is inside a Git working tree.
+; post   : credential.helper=cache is configured locally when no helper existed.
+; result : #t when a helper exists or was configured, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (ensure-credential-helper)
+  (let ((helper (git-config-value "credential.helper")))
+    (if helper
+        #t
+        (let-values (((exit-code output)
+                      (run-git '(config --local credential.helper cache))))
+          (= exit-code 0)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask the user for credentials and approve them through Git.
+; pre    : protocol and host identify an HTTP(S) remote.
+; post   : Supplied credentials have been offered to Git's helper.
+; result : #t when credentials were approved, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (ask-and-approve-credential protocol host username)
+  (let* ((username*
+          (if username
+              username
+              (input-prompt
+               (format "Username for ~a: " host)
+               #:loop-until
+               (λ (value)
+                 (cond
+                   ((eof-object? value)
+                    (error 'git-authentication "Input cancelled"))
+                   ((string=? (string-trim value) "")
+                    #f)
+                   (else
+                    (string-trim value)))))))
+         (password
+          (input-prompt
+           (format "Password/token for ~a: " host)
+           #:loop-until
+           (λ (value)
+             (cond
+               ((eof-object? value)
+                (error 'git-authentication "Input cancelled"))
+               ((string=? value "")
+                #f)
+               (else
+                value))))))
+    (and (ensure-credential-helper)
+         (git-credential-approve protocol host username* password))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication handling
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Recognize output that indicates Git authentication failed.
+; pre    : exit-code and output belong to a completed Git command.
+; post   : output has only been inspected.
+; result : #t when a known authentication failure is present, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define auth-recognizer
+  #px"(authentication failed|failed to authenticate|could not read (username|password)|access denied|terminal prompts disabled|requested url returned error: (401|403))")
+
+(define (authentication-failure? exit-code output)
+  (and (not (= exit-code 0))
+       (ormap
+        (λ (entry)
+          (let ((line (string-downcase (format "~a" (cadr entry)))))
+            (regexp-match? auth-recognizer line)))
+        output)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Raise a Git authentication exception containing the failed invocation.
+; pre    : cmd, args, exit-code and output describe a failed Git command.
+; post   : An exn:fail:git-auth exception has been raised.
+; result : No normal return value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (raise-git-auth-error cmd args exit-code output)
+  (let ((msg (format "git ~a: authentication failed" cmd)))
+    (raise
+     (exn:fail:git-auth msg
+                        (current-continuation-marks)
+                        cmd
+                        args
+                        exit-code
+                        output))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reject the credential associated with a failed Git command.
+; pre    : cmd and args identify a failed authenticated Git invocation.
+; post   : Git's credential helper has been asked to forget the credential.
+; result : #t when a credential could be identified and rejected, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (reject-git-authentication cmd args)
+  (let ((url (git-authentication-url cmd args)))
+    (if (not url)
+        #f
+        (let-values (((protocol host username)
+                      (url->credential-parts url)))
+          (if protocol
+              (git-credential-reject protocol host username)
+              #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve an authentication failure using Git first, then input-prompt.
+; pre    : cmd, args and e describe one failed Git invocation.
+; post   : Git's helper has been tried; a missing helper may be configured locally.
+; result : #t when retrying the original command is meaningful, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (default-git-authentication-handler cmd args e)
+  (let ((url (git-authentication-url cmd args)))
+    (if (not url)
+        #f
+        (let-values (((protocol host username)
+                      (url->credential-parts url)))
+          (if (not protocol)
+              #f
+              (let ((helper (git-config-value "credential.helper")))
+                (when helper
+                  (git-credential-reject protocol host username))
+                (if (and helper
+                         (git-credential-fill protocol host username))
+                    #t
+                    (ask-and-approve-credential
+                     protocol host username))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Supply the callback that can resolve an authentication failure.
+; pre    : The callback accepts command, arguments and an exn:fail:git-auth value.
+; post   : The callback is used by command proxies before one authentication retry.
+; result : A parameter containing the current authentication callback.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define current-git-authentication-handler
+  (make-parameter default-git-authentication-handler))

private/git-commands.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require "git-provider.rkt"
+         "git-auth.rkt"
          racket/string
          racket/list
          )
@@ -9,6 +10,13 @@
          check-git-args
          has-git-arg?
          std-process-git-result
+         default-git-authentication-handler
+         current-git-authentication-handler
+         exn:fail:git-auth?
+         exn:fail:git-auth-command
+         exn:fail:git-auth-args
+         exn:fail:git-auth-exit-code
+         exn:fail:git-auth-output
          )
 
 
@@ -83,7 +91,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Define the internal proxy for a Git command.
 ; pre    : pre-code and process-result accept the command proxy arguments.
-; post   : The proxy invokes Git without standard input and processes its result.
+; post   : Authentication failures are offered once to the current authentication
+;          handler before the Git command is retried.
 ; result : A procedure named f accepting a list of Git arguments.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define-syntax def-git-cmd-proxy
@@ -93,8 +102,27 @@
        (let* ((args (flatten args*))
               (info (make-hash))
               (nargs (pre-code args info)))
-         (let-values (((exit-code output) (run-git (cons cmd nargs))))
+         (let retry ((authentication-retry? #t))
-           (let-values (((result out) (git-out cmd output)))
+           (with-handlers
-             (process-result cmd exit-code result output out info))))))
+               ((exn:fail:git-auth?
+                 (λ (e)
+                   (if authentication-retry?
+                       (if ((current-git-authentication-handler) cmd nargs e)
+                           (retry #f)
+                           (git-error cmd
+                                      (format "Exitcode <> 0: ~a"
+                                              (exn:fail:git-auth-exit-code e))
+                                      (exn:fail:git-auth-output e)))
+                       (begin
+                         (reject-git-authentication cmd nargs)
+                         (git-error cmd
+                                    (format "Exitcode <> 0: ~a"
+                                            (exn:fail:git-auth-exit-code e))
+                                    (exn:fail:git-auth-output e)))))))
+             (let-values (((exit-code output) (run-git (cons cmd nargs))))
+               (when (authentication-failure? exit-code output)
+                 (raise-git-auth-error cmd nargs exit-code output))
+               (let-values (((result out) (git-out cmd output)))
+                 (process-result cmd exit-code result output out info))))))))
     )
   )

private/git-provider.rkt

@@ -5,6 +5,8 @@
          racket/contract
          racket/system
          "config.rkt"
+         "find-editor.rkt"
+         "find-mergetool.rkt"
          )
 
 (provide git-exe
@@ -95,46 +97,74 @@
 ; result : The exit code and ordered (source line) output items.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (run-git args #:input (input #f))
-  (putenv "GIT_TERMINAL_PROMPT" "0")
+  (let* ((env (environment-variables-copy
-  (let-values (((process stdout stdin stderr)
+               (current-environment-variables)))
-                (apply subprocess
+         (editor (find-editor))
-                       #f
+         (mergetool-path (find-mergetool-path)))
-                       #f
+    (environment-variables-set! env
-                       #f
+                                #"GIT_TERMINAL_PROMPT"
-                       (git-exe)
+                                #"0")
-                       (map (λ (arg) (format "~a" arg)) args)
+    (when editor
-                       )))
+      (let ((editor-bytes (string->bytes/utf-8 editor)))
-    (when input
+        (environment-variables-set! env
-      (display input stdin)
+                                    #"GIT_EDITOR"
-      (flush-output stdin))
+                                    editor-bytes)
-    (close-output-port stdin)
+        (environment-variables-set! env
-    (let ((output-channel (make-channel)))
+                                    #"GIT_SEQUENCE_EDITOR"
-        (define (read-output source port)
+                                    editor-bytes)))
-          (thread
+    (when mergetool-path
-           (lambda ()
+      (let* ((directory (path-only mergetool-path))
-             (let loop ()
+             (old-path (environment-variables-ref env #"PATH"))
-               (let ((line (read-line port)))
+             (separator (if (eq? (system-type 'os) 'windows) ";" ":"))
-                 (channel-put output-channel (list source line))
+             (new-path
-                 (if (eof-object? line)
+              (if old-path
-                     (close-input-port port)
+                  (string-append (path->string directory)
-                     (loop)))))))
+                                 separator
+                                 (bytes->string/utf-8 old-path))
+                  (path->string directory))))
+        (environment-variables-set! env
+                                    #"PATH"
+                                    (string->bytes/utf-8 new-path))))
+    (parameterize ((current-environment-variables env))
+      (let-values (((process stdout stdin stderr)
+                    (apply subprocess
+                           #f
+                           #f
+                           #f
+                           (git-exe)
+                           (map (λ (arg) (format "~a" arg)) args)
+                           )))
+        (when input
+          (display input stdin)
+          (flush-output stdin))
+        (close-output-port stdin)
+        (let ((output-channel (make-channel)))
+          (define (read-output source port)
+            (thread
+             (λ ()
+               (let loop ()
+                 (let ((line (read-line port)))
+                   (channel-put output-channel (list source line))
+                   (if (eof-object? line)
+                       (close-input-port port)
+                       (loop)))))))
 
-        (read-output 'stdout stdout)
+          (read-output 'stdout stdout)
-        (read-output 'stderr stderr)
+          (read-output 'stderr stderr)
 
-        (let loop ((open-ports 2)
+          (let loop ((open-ports 2)
-                   (result '()))
+                     (result '()))
-          (if (= open-ports 0)
+            (if (= open-ports 0)
-              (begin
+                (begin
-                (subprocess-wait process)
+                  (subprocess-wait process)
-                (values (subprocess-status process)
+                  (values (subprocess-status process)
-                        (reverse result)))
+                          (reverse result)))
-              (let* ((output (channel-get output-channel))
+                (let* ((output (channel-get output-channel))
-                     (line (cadr output)))
+                       (line (cadr output)))
-                (if (eof-object? line)
+                  (if (eof-object? line)
-                    (loop (- open-ports 1) result)
+                      (loop (- open-ports 1) result)
-                    (loop open-ports
+                      (loop open-ports
-                          (cons output result)))))))))
+                            (cons output result)))))))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Provided utility functions

private/info-handler.rkt

@@ -6,7 +6,7 @@
 
 (provide info-version
          set-info-version!
-         git-next-version
+         info-next-version
          )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -74,7 +74,7 @@
 ; post   : The version definition in info.rkt has been updated.
 ; result : #t after writing the new version.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (git-next-version kind . dir*)
+(define (info-next-version kind . dir*)
   (let ((dir (if (null? dir*)
                  "."
                  (car dir*))))

private/utils.rkt

@@ -6,6 +6,24 @@
          valid-http-or-file-url?
          )
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask the user for input .
+; pre    : p is a prompt.
+; post   : It should give back the supplied input as string.
+; result : the return value of until.
+; internals:
+;
+; input-prompt displays the given prompt and reads a line
+; of text. After the user presses enter, this line is
+; fed to the until callback. If the until callback returns
+; #f, the prompt is displayed again. Otherwise, the value
+; of until is returned.
+;
+; The programmer must make sure the until returns whatever
+; format is appropriate. In general it will be a string. 
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (define (input-prompt p #:loop-until [until (λ (x) x)])
   (let loop ()
     (display p)
@@ -20,7 +38,6 @@
   )
 
 
-
 (define (valid-http-or-file-url? value)
   (if (not (string? value))
       #f

scribblings/git-cli.scrbl

@@ -0,0 +1,596 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../main.rkt"))
+
+@title[#:tag "top"]{git-cli}
+@author{Hans Dijkema}
+
+@defmodule[git-cli]
+
+The @racketmodname[git-cli] module provides a command-line-like Git interface
+implemented by invoking the @tt{git} executable. Commands do not allow Git to
+read credentials or other answers from the terminal.
+
+@section{Command interface}
+
+@defform[(git command argument ...)]{
+Runs a registered Git @racket[command]. The arguments are passed to the command.
+Registered command symbols are @racket['status], @racket['add],
+@racket['commit], @racket['push], @racket['pull], @racket['fetch],
+@racket['config], @racket['branch], @racket['remote], @racket['stash], @racket['restore], @racket['reset], @racket['revert], @racket['rebase], @racket['merge], @racket['cherry-pick], @racket['mergetool], @racket['switch], @racket['clone],
+@racket['tag],
+@racket['log], @racket['rev-list], @racket['diff],
+@racket['show], @racket['grep], @racket['help], @racket['version], and
+@racket['new-version].
+
+Most registered commands invoke the Git command with the same name. Some
+commands process the result into a Racket value, such as @racket['status],
+@racket['grep], @racket['log] with @tt{--list}, @racket['version], and
+@racket['new-version].
+}
+
+
+@defform[(git* command argument ...)]{
+Provides compact command-style syntax for @racket[git]. The command name is
+used as a symbol. Other literal arguments are converted to strings.
+
+@racketblock[
+(git* remote -v)
+(git* switch main)
+]
+
+An argument written as @racket[(eval expression)] is evaluated instead of being
+converted from its literal syntax.
+
+@racketblock[
+(define branch "develop")
+(git* switch (eval branch))
+]
+
+@racket[gt] is retained as a compatibility alias for @racket[git*].
+}
+
+@section{Provided commands}
+
+@defproc[(git-status [argument any/c] ...) list?]{
+Runs @tt{git status --porcelain} with the supplied arguments.
+
+Each result item has the form
+@racket[(index-status worktree-status file)]. The index status describes the
+change staged for the next commit. The worktree status describes the change in
+the working tree relative to the index.
+
+Both statuses are one of @racket['unchanged], @racket['modified],
+@racket['type-changed], @racket['added], @racket['deleted], @racket['renamed],
+@racket['copied], @racket['unmerged], @racket['untracked], or
+@racket['ignored]. For an untracked file, Git reports @tt{??}, so both statuses
+are @racket['untracked].
+
+@racketblock[
+'((modified unchanged "staged.rkt")
+  (unchanged modified "working-tree.rkt")
+  (modified modified "both.rkt")
+  (renamed unchanged "old.rkt -> new.rkt")
+  (untracked untracked "new.rkt"))
+]}
+
+@defproc[(git-add [argument any/c] ...) boolean?]{
+Adds file contents to the index. Returns @racket[#t] when Git exits with status
+zero; otherwise an exception is raised.
+}
+
+@defproc[(git-commit [argument any/c] ...) boolean?]{
+Creates a commit. When @tt{-m} is omitted, a commit message is requested before
+Git is started. A repository with nothing to commit returns @racket[#t]. Other
+non-zero exit statuses, including a rejected commit hook, raise an exception.
+}
+
+@defproc[(git-push [argument any/c] ...) boolean?]{
+Pushes changes using @tt{--porcelain}. Returns @racket[#t] when Git exits with
+status zero; otherwise an exception is raised.
+}
+
+@defproc[(git-pull [argument any/c] ...) boolean?]{
+Fetches and integrates changes. Normal progress written by Git to standard
+error is accepted when Git exits successfully.
+}
+
+@defproc[(git-fetch [argument any/c] ...) boolean?]{
+Downloads refs and objects from a remote repository without integrating them
+into the current branch. Arguments are passed directly to @tt{git fetch}.
+
+For example:
+
+@racketblock[
+(git-fetch)
+(git-fetch '--prune)
+(git 'fetch '--prune)
+]
+}
+
+@defproc[(git-config [argument any/c] ...) any/c]{
+Provides a Racket-oriented interface to @tt{git config}. The same interface is
+available through @racket[git] with command @racket['config].
+
+@racketblock[
+(git 'config '--all)
+(git 'config 'get '--all)
+(git 'config '--global 'get '--all)
+(git 'config 'get '--global '--all)
+]
+
+returns all visible configuration entries as key/value items:
+
+@racketblock[
+'(("user.name" "Hans Dijkema")
+  ("user.email" "hans@example.invalid")
+  ("credential.helper" "manager"))
+]
+
+@racketblock[
+(git 'config 'get "credential.helper")
+]
+
+returns one value as a string, or @racket[#f] when the key is absent.
+
+@racketblock[
+(git 'config 'get '--all "credential.helper")
+]
+
+returns all values for one key as a list. An absent key produces the empty
+list.
+
+Configuration values can be written with @racket['set!]:
+
+@racketblock[
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config '--global 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
+]
+
+The optional scope can be @tt{--global}, @tt{--local}, or @tt{--system}. It may
+appear directly after @racket['config] or directly after @racket['get] /
+@racket['set!]. A successful write returns @racket[#t].
+}
+
+@defproc[(git-branch [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git branch} with the supplied arguments. This can be used to list,
+create, rename, or delete branches according to the options supported by the
+installed Git executable.
+
+With Git's @tt{-l} or @tt{--list} option, git-cli returns structured branch
+information. Each item starts with one of @racket['current], @racket['local],
+or @racket['remote], followed by the branch name.
+
+@racketblock[
+(git-branch '-l)
+
+'((current "main")
+  (local "develop"))
+]
+
+Git's normal branch selection and sorting options are passed through. For
+example, remote branches can be requested with @tt{-r}, all branches with
+@tt{-a}, and Git's @tt{--sort=<key>} option controls the returned order.
+
+@racketblock[
+(git 'branch '-l '-a "--sort=refname")
+
+'((current "main")
+  (local "develop")
+  (remote "origin/main"))
+]
+
+Without @tt{-l} or @tt{--list}, normal Git output is displayed and the
+procedure returns @racket[#t] when Git exits successfully.
+}
+@defproc[(git-remote [argument any/c] ...) any/c]{
+Runs @tt{git remote} with the supplied arguments and keeps the command's own
+subcommand structure.
+
+With no arguments, the remote names are returned as a Racket list.
+
+@racketblock[
+(git-remote)
+
+'("origin" "upstream")
+]
+
+With top-level @tt{-v} or @tt{--verbose}, each line reported by Git is returned
+as a separate structured item containing the remote name, URL, and the
+@racket['fetch] or @racket['push] role.
+
+@racketblock[
+(git-remote '-v)
+
+'(("origin" "https://example.invalid/project.git" fetch)
+  ("origin" "https://example.invalid/project.git" push))
+]
+
+The two Git lines are deliberately not merged. This keeps the result close to
+the output and semantics of @tt{git remote -v}.
+
+For @tt{get-url}, one URL is returned as a string. With @tt{--all}, a list of
+URLs is returned.
+
+@racketblock[
+(git 'remote 'get-url "origin")
+(git 'remote 'get-url '--all "origin")
+(git 'remote 'get-url '--push '--all "origin")
+]
+
+Other forms, including @tt{add}, @tt{rename}, @tt{remove}, @tt{set-head},
+@tt{show}, @tt{prune}, @tt{update}, @tt{set-branches}, and @tt{set-url}, are
+passed to Git unchanged and use the normal git-cli command result processing.
+}
+@defproc[(git-stash [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git stash} with the supplied arguments. Calling it without a
+subcommand keeps Git's normal behavior, which is equivalent to
+@tt{git stash push}.
+
+@tt{git stash list} is returned as structured Racket data. Each item contains
+the stash reference and Git's stash description.
+
+@racketblock[
+(git-stash 'list)
+
+'(("stash@{0}" "WIP on main: 1234567 Example")
+  ("stash@{1}" "On main: older work"))
+]
+
+The structured form is only used when the caller has not supplied a
+@tt{--format} or @tt{--pretty} option. Explicit Git formatting is left
+unchanged.
+
+Other stash subcommands, including @tt{push}, @tt{show}, @tt{pop},
+@tt{apply}, @tt{drop}, @tt{clear}, @tt{branch}, @tt{create}, @tt{store},
+@tt{export}, and @tt{import}, are passed to Git unchanged.
+}
+
+@defproc[(git-restore [argument any/c] ...) boolean?]{
+Runs @tt{git restore} with the supplied arguments. Git's path, source,
+@tt{--staged}, @tt{--worktree}, and patch semantics are preserved.
+
+@racketblock[
+(git-restore "main.rkt")
+(git-restore '--staged "main.rkt")
+(git* restore --source=HEAD~1 main.rkt)
+]
+}
+
+@defproc[(git-reset [argument any/c] ...) boolean?]{
+Runs @tt{git reset} with the supplied arguments. Modes such as @tt{--soft},
+@tt{--mixed}, @tt{--hard}, @tt{--merge}, and @tt{--keep}, as well as path
+forms, are passed through unchanged.
+
+@racketblock[
+(git-reset '--hard 'HEAD)
+(git* reset --soft HEAD~1)
+]
+}
+
+@defproc[(git-revert [argument any/c] ...) boolean?]{
+Runs @tt{git revert} with the supplied arguments. Sequencer controls such as
+@tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed through
+unchanged.
+
+@racketblock[
+(git-revert 'HEAD)
+(git* revert --abort)
+]
+}
+
+@defproc[(git-rebase [argument any/c] ...) boolean?]{
+Runs @tt{git rebase} with the supplied arguments, including normal, interactive,
+and continuation/abort forms.
+
+@racketblock[
+(git-rebase "main")
+(git* rebase --continue)
+(git* rebase --abort)
+]
+}
+
+@defproc[(git-merge [argument any/c] ...) boolean?]{
+Runs @tt{git merge} with the supplied arguments and preserves Git's merge
+options and control forms.
+
+@racketblock[
+(git-merge "feature")
+(git* merge --abort)
+]
+}
+
+@defproc[(git-cherry-pick [argument any/c] ...) boolean?]{
+Runs @tt{git cherry-pick} with the supplied arguments. Sequencer controls such
+as @tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed
+through unchanged.
+
+@racketblock[
+(git-cherry-pick "abc1234")
+(git* cherry-pick --continue)
+]
+}
+
+@defproc[(git-mergetool [argument any/c] ...) boolean?]{
+Runs @tt{git mergetool}. When the caller does not specify @tt{-t},
+@tt{--tool=<tool>}, or @tt{--tool-help}, git-cli first tries
+@racket[find-mergetool] and supplies the selected tool through Git's normal
+@tt{--tool=<tool>} option. If no known graphical tool is found, Git is allowed
+to choose its own default.
+
+@racketblock[
+(git-mergetool)
+(git* mergetool --tool=meld)
+]
+}
+
+@defproc[(find-editor) (or/c string? #f)]{
+Returns the configured or detected GUI editor command used for
+@tt{GIT_EDITOR} and @tt{GIT_SEQUENCE_EDITOR}, without starting the editor.
+}
+
+@defproc[(set-editor! [command string?]) any/c]{
+Stores a git-cli-specific editor command.
+}
+
+@defproc[(find-mergetool) (or/c string? #f)]{
+Returns the configured or detected Git merge tool name.
+}
+
+@defproc[(find-mergetool-path) (or/c path? #f)]{
+Returns the executable path of an automatically detected merge tool. The finder
+checks @tt{PATH} first and then well-known platform installation locations.
+When the merge tool was configured explicitly by name, this procedure returns
+@racket[#f].
+}
+
+@defproc[(set-mergetool! [tool string?]) any/c]{
+Stores the Git merge tool name preferred by git-cli.
+}
+
+@defproc[(git-switch [argument any/c] ...) boolean?]{
+Runs @tt{git switch} with the supplied arguments.
+
+@racketblock[
+(git-switch "main")
+(git-switch '-c "feature")
+(git 'switch "main")
+]
+}
+
+@defproc[(git-clone [argument any/c] ...) boolean?]{
+Runs @tt{git clone} with the supplied arguments.
+}
+
+@defproc[(git-tag [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git tag} with the supplied arguments. It can list, create, delete, or
+verify tags according to the options supported by Git.
+
+When @tt{-l} or @tt{--list} is supplied, the matching tag names are returned
+as a Racket list. Git's sorting options are passed through unchanged, so the
+returned list keeps Git's order.
+
+@racketblock[
+(git-tag '-l)
+(git-tag '--list "--sort=version:refname")
+(git-tag '--list "--sort=-creatordate")
+]
+
+When @tt{-n} or @tt{-n1} is combined with @tt{-l} or @tt{--list}, each result
+item contains the tag name and the subject reported by Git.
+
+@racketblock[
+(git-tag '-l '-n)
+
+'(("v0.3.16" "Release 0.3.16")
+  ("v0.3.17" "Release 0.3.17"))
+]
+
+With @tt{-n<number>} and a number greater than one, git-cli asks Git for that
+many content lines using @tt{%(contents:lines=<number>)}. The returned message
+is kept as one string, including embedded newlines.
+
+For structured tag output git-cli asks Git for an explicit format using
+@tt{%(refname:strip=2)} and either @tt{%(contents:subject)} or
+@tt{%(contents:lines=<number>)}. Generated field and record delimiters are used
+to split the result safely.
+
+Other forms keep the normal command behavior and return @racket[#t] when Git
+exits successfully. Git errors are handled by the standard git-cli result
+processor.
+}
+@defproc[(git-rev-list [argument any/c] ...) boolean?]{
+Runs @tt{git rev-list} with the supplied arguments and displays Git's normal
+output. It returns @racket[#t] when Git exits successfully.
+}
+
+@defproc[(git-diff [argument any/c] ...) (or/c boolean? string?)]{
+Shows differences between Git objects or the working tree and index.
+
+By default a successful diff is rendered as HTML in the default browser. The
+git-cli-specific option @tt{--output=-} keeps Git's textual output on standard
+output. @tt{--output=string} returns the textual diff as a string.
+
+@racketblock[
+(git-diff)
+(git-diff '--cached)
+(git-diff '--output=-)
+(git-diff '--output=string)
+]
+}
+
+@defproc[(git-log [argument any/c] ...) (or/c boolean? list?)]{
+Displays Git log output and returns @racket[#t] when Git exits successfully.
+
+The git-cli-specific option @tt{--list}, or its short form @tt{-l}, changes the
+result to a Racket list. Internally this option is replaced by Git's
+@tt{--oneline} option. Each returned item contains the abbreviated commit id and
+the commit subject.
+
+@racketblock[
+(git-log '--list '-5)
+
+'(("003f371" "Diverse commando's toegevoegd. Ik weet nog niet of ik ze allemaal ga houden")
+  ("2cb7e93" "Small changes. git main function is now a real function, not syntax"))
+]
+
+Other Git log options are still passed to Git. Consequently, options that add
+extra output lines can also influence how useful @tt{--list} is as a structured
+result.
+}
+
+
+
+@defproc[(git-show [argument any/c] ...) (or/c boolean? string? list?)]{
+Shows a Git object.
+
+For a commit that includes a patch, the default git-cli output is HTML. The
+commit information is shown above the diff and the diff is rendered using the
+same Diff2Html presentation as @racket[git-diff].
+
+The git-cli-specific output options are @tt{--output=html},
+@tt{--output=-}, and @tt{--output=string}. @tt{--output=html} explicitly
+selects the HTML presentation, @tt{--output=-} keeps Git's normal textual
+output, and @tt{--output=string} returns that textual output as a string.
+Options such as @tt{--stat}, @tt{--name-only}, @tt{--name-status}, and
+@tt{--no-patch} default to textual output because they do not normally contain
+a patch.
+
+The git-cli-specific option @tt{--list}, or its short form @tt{-l}, returns a
+Racket value. Without another show-format option it implies @tt{--stat}.
+
+@racketblock[
+(git-show '-l "9741b1c")
+]
+
+The result of @tt{--stat --list} contains @racket['file] and
+@racket['total] items:
+
+@racketblock[
+'((file "README.md" 67 "+++---")
+  (file "main.rkt" 532 "++++-------------------------------------------")
+  (total 9 124 823))
+]
+
+With @tt{--name-only --list}, the result is a list of file names. With
+@tt{--name-status --list}, every result item is the tab-separated Git
+name-status record converted to a list of strings.
+
+@tt{--list}/@tt{-l} cannot be combined with @tt{--output=...}. Only one of
+@tt{--stat}, @tt{--name-only}, and @tt{--name-status} can be used with
+@tt{--list}.
+}
+
+@defproc[(git-grep [argument any/c] ...) list?]{
+Searches tracked files. Each result contains the file, optional line number,
+optional match count, and matched text. Exit status one means that no matches
+were found and returns an empty list.
+}
+
+@defproc[(git-help [argument any/c] ...) boolean?]{
+Runs @tt{git help} with the supplied arguments and returns @racket[#t] when Git
+exits successfully.
+}
+
+@section{Package version}
+
+@defproc[(git-version) list?]{
+Reads the package version from @filepath{info.rkt} and returns it as a list
+containing major, minor, and patch.
+}
+
+
+@defproc[(git-new-version [kind symbol?]) list?]{
+Updates the version in @filepath{info.rkt}. The kind is @racket['major],
+@racket['minor], or @racket['patch], with @racket['maj] and @racket['min] as
+abbreviations. The result is the new version as a list of three integers.
+}
+
+
+@section{Low-level Git execution}
+
+@defproc[(run-git [args list?]
+                  [#:input input (or/c #f string?) #f])
+         (values exact-integer? list?)]{
+Runs Git without interactive terminal prompts. When @racket[input] is a string,
+it is written to Git's standard input before that input port is closed.
+
+The procedure returns two values: Git's exit code and the ordered output items,
+where each item identifies either @racket['stdout] or @racket['stderr].
+
+@racketblock[
+(run-git '(credential fill)
+         #:input "protocol=https\nhost=git.dijkewijk.nl\n\n")
+]
+}
+
+@section{Authentication retry}
+
+Git commands recognize common authentication failures immediately after the
+Git process finishes and before command-specific result processing takes
+place. Such a failure is represented by @racket[exn:fail:git-auth?].
+
+@defparam[current-git-authentication-handler handler procedure?]{
+Controls the callback used when an authentication failure is detected. The
+callback receives the Git command symbol, the processed Git argument list and
+the @racket[exn:fail:git-auth] exception.
+
+The callback returns a true value when it has handled authentication and the
+original Git command should be tried again. A command is retried at most once.
+The default callback is @racket[default-git-authentication-handler].
+
+@racketblock[
+(current-git-authentication-handler
+ (lambda (cmd args e)
+   ;; Perform credential handling here.
+   #t))
+]
+}
+
+@defproc[(exn:fail:git-auth? [v any/c]) boolean?]{
+Recognizes the authentication exception used internally by git-cli.
+}
+
+@defproc[(exn:fail:git-auth-command [e exn:fail:git-auth?]) symbol?]{
+Returns the Git command of the failed invocation.
+}
+
+@defproc[(exn:fail:git-auth-args [e exn:fail:git-auth?]) list?]{
+Returns the processed Git arguments of the failed invocation.
+}
+
+@defproc[(exn:fail:git-auth-exit-code [e exn:fail:git-auth?]) exact-integer?]{
+Returns Git's exit code.
+}
+
+@defproc[(exn:fail:git-auth-output [e exn:fail:git-auth?]) list?]{
+Returns the ordered @racket['stdout]/@racket['stderr] output items from the
+failed Git process.
+}
+
+
+
+@section{Authentication}
+
+@defproc[(default-git-authentication-handler
+          [cmd symbol?]
+          [args list?]
+          [e exn:fail:git-auth?])
+         boolean?]{
+Handles one authentication failure. A credential that already failed is first
+rejected. An existing Git credential helper is then asked for a replacement
+credential. If that does not succeed, git-cli requests a username and
+password/token using @racket[input-prompt]. Its @racket[#:loop-until] callbacks
+both validate the input and return the value that is used. If no helper is
+configured, Git's non-persistent @tt{cache} helper is configured locally before
+the credential is approved. The original command is retried once; a credential
+that fails on the retry is rejected before the Git error is raised.
+}
+
+@defparam[current-git-authentication-handler handler procedure?]{
+Contains the authentication callback used after a recognized authentication
+failure. Its default value is @racket[default-git-authentication-handler].
+}

scribblings/git.scrbl

@@ -1,271 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket/base
-                     racket/contract
-                     "../main.rkt"))
-
-@title[#:tag "top"]{git-cli}
-@author{Hans Dijkema}
-
-@defmodule[git-cli]
-
-The @racketmodname[git-cli] module provides a command-line-like Git interface
-implemented by invoking the @tt{git} executable. Commands do not allow Git to
-read credentials or other answers from the terminal.
-
-@section{Command interface}
-
-@defform[(git command argument ...)]{
-Runs a registered Git @racket[command]. The arguments are passed to the command.
-Registered command symbols are @racket['status], @racket['add],
-@racket['commit], @racket['push], @racket['pull], @racket['fetch],
-@racket['branch], @racket['switch], @racket['clone], @racket['tag],
-@racket['log], @racket['rev-list], @racket['diff],
-@racket['show], @racket['grep], @racket['help], @racket['version], and
-@racket['new-version].
-
-Most registered commands invoke the Git command with the same name. Some
-commands process the result into a Racket value, such as @racket['status],
-@racket['grep], @racket['log] with @tt{--list}, @racket['version], and
-@racket['new-version].
-}
-
-@section{Provided commands}
-
-@defproc[(git-status [argument any/c] ...) list?]{
-Runs @tt{git status --porcelain} with the supplied arguments.
-
-Each result item has the form
-@racket[(index-status worktree-status file)]. The index status describes the
-change staged for the next commit. The worktree status describes the change in
-the working tree relative to the index.
-
-Both statuses are one of @racket['unchanged], @racket['modified],
-@racket['type-changed], @racket['added], @racket['deleted], @racket['renamed],
-@racket['copied], @racket['unmerged], @racket['untracked], or
-@racket['ignored]. For an untracked file, Git reports @tt{??}, so both statuses
-are @racket['untracked].
-
-@racketblock[
-'((modified unchanged "staged.rkt")
-  (unchanged modified "working-tree.rkt")
-  (modified modified "both.rkt")
-  (renamed unchanged "old.rkt -> new.rkt")
-  (untracked untracked "new.rkt"))
-]}
-
-@defproc[(git-add [argument any/c] ...) boolean?]{
-Adds file contents to the index. Returns @racket[#t] when Git exits with status
-zero; otherwise an exception is raised.
-}
-
-@defproc[(git-commit [argument any/c] ...) boolean?]{
-Creates a commit. When @tt{-m} is omitted, a commit message is requested before
-Git is started. A repository with nothing to commit returns @racket[#t]. Other
-non-zero exit statuses, including a rejected commit hook, raise an exception.
-}
-
-@defproc[(git-push [argument any/c] ...) boolean?]{
-Pushes changes using @tt{--porcelain}. Returns @racket[#t] when Git exits with
-status zero; otherwise an exception is raised.
-}
-
-@defproc[(git-pull [argument any/c] ...) boolean?]{
-Fetches and integrates changes. Normal progress written by Git to standard
-error is accepted when Git exits successfully.
-}
-
-@defproc[(git-fetch [argument any/c] ...) boolean?]{
-Downloads refs and objects from a remote repository without integrating them
-into the current branch. Arguments are passed directly to @tt{git fetch}.
-
-For example:
-
-@racketblock[
-(git-fetch)
-(git-fetch '--prune)
-(git 'fetch '--prune)
-]
-}
-
-@defproc[(git-branch [argument any/c] ...) boolean?]{
-Runs @tt{git branch} with the supplied arguments. This can be used to list,
-create, rename, or delete branches according to the options supported by the
-installed Git executable.
-}
-
-@defproc[(git-switch [argument any/c] ...) boolean?]{
-Runs @tt{git switch} with the supplied arguments.
-
-@racketblock[
-(git-switch "main")
-(git-switch '-c "feature")
-(git 'switch "main")
-]
-}
-
-@defproc[(git-clone [argument any/c] ...) boolean?]{
-Runs @tt{git clone} with the supplied arguments.
-}
-
-@defproc[(git-tag [argument any/c] ...) (or/c boolean? list?)]{
-Runs @tt{git tag} with the supplied arguments. It can list, create, delete, or
-verify tags according to the options supported by Git.
-
-When @tt{-l} or @tt{--list} is supplied, the matching tag names are returned
-as a Racket list. Git's sorting options are passed through unchanged, so the
-returned list keeps Git's order.
-
-@racketblock[
-(git-tag '-l)
-(git-tag '--list "--sort=version:refname")
-(git-tag '--list "--sort=-creatordate")
-]
-
-When @tt{-n} or @tt{-n1} is combined with @tt{-l} or @tt{--list}, each result
-item contains the tag name and the subject reported by Git.
-
-@racketblock[
-(git-tag '-l '-n)
-
-'(("v0.3.16" "Release 0.3.16")
-  ("v0.3.17" "Release 0.3.17"))
-]
-
-With @tt{-n<number>} and a number greater than one, git-cli asks Git for that
-many content lines using @tt{%(contents:lines=<number>)}. The returned message
-is kept as one string, including embedded newlines.
-
-For structured tag output git-cli asks Git for an explicit format using
-@tt{%(refname:strip=2)} and either @tt{%(contents:subject)} or
-@tt{%(contents:lines=<number>)}. Generated field and record delimiters are used
-to split the result safely.
-
-Other forms keep the normal command behavior and return @racket[#t] when Git
-exits successfully. Git errors are handled by the standard git-cli result
-processor.
-}
-@defproc[(git-rev-list [argument any/c] ...) boolean?]{
-Runs @tt{git rev-list} with the supplied arguments and displays Git's normal
-output. It returns @racket[#t] when Git exits successfully.
-}
-
-@defproc[(git-diff [argument any/c] ...) (or/c boolean? string?)]{
-Shows differences between Git objects or the working tree and index.
-
-By default a successful diff is rendered as HTML in the default browser. The
-git-cli-specific option @tt{--output=-} keeps Git's textual output on standard
-output. @tt{--output=string} returns the textual diff as a string.
-
-@racketblock[
-(git-diff)
-(git-diff '--cached)
-(git-diff '--output=-)
-(git-diff '--output=string)
-]
-}
-
-@defproc[(git-log [argument any/c] ...) (or/c boolean? list?)]{
-Displays Git log output and returns @racket[#t] when Git exits successfully.
-
-The git-cli-specific option @tt{--list}, or its short form @tt{-l}, changes the
-result to a Racket list. Internally this option is replaced by Git's
-@tt{--oneline} option. Each returned item contains the abbreviated commit id and
-the commit subject.
-
-@racketblock[
-(git-log '--list '-5)
-
-'(("003f371" "Diverse commando's toegevoegd. Ik weet nog niet of ik ze allemaal ga houden")
-  ("2cb7e93" "Small changes. git main function is now a real function, not syntax"))
-]
-
-Other Git log options are still passed to Git. Consequently, options that add
-extra output lines can also influence how useful @tt{--list} is as a structured
-result.
-}
-
-
-
-@defproc[(git-show [argument any/c] ...) (or/c boolean? string? list?)]{
-Shows a Git object.
-
-For a commit that includes a patch, the default git-cli output is HTML. The
-commit information is shown above the diff and the diff is rendered using the
-same Diff2Html presentation as @racket[git-diff].
-
-The git-cli-specific output options are @tt{--output=html},
-@tt{--output=-}, and @tt{--output=string}. @tt{--output=html} explicitly
-selects the HTML presentation, @tt{--output=-} keeps Git's normal textual
-output, and @tt{--output=string} returns that textual output as a string.
-Options such as @tt{--stat}, @tt{--name-only}, @tt{--name-status}, and
-@tt{--no-patch} default to textual output because they do not normally contain
-a patch.
-
-The git-cli-specific option @tt{--list}, or its short form @tt{-l}, returns a
-Racket value. Without another show-format option it implies @tt{--stat}.
-
-@racketblock[
-(git-show '-l "9741b1c")
-]
-
-The result of @tt{--stat --list} contains @racket['file] and
-@racket['total] items:
-
-@racketblock[
-'((file "README.md" 67 "+++---")
-  (file "main.rkt" 532 "++++-------------------------------------------")
-  (total 9 124 823))
-]
-
-With @tt{--name-only --list}, the result is a list of file names. With
-@tt{--name-status --list}, every result item is the tab-separated Git
-name-status record converted to a list of strings.
-
-@tt{--list}/@tt{-l} cannot be combined with @tt{--output=...}. Only one of
-@tt{--stat}, @tt{--name-only}, and @tt{--name-status} can be used with
-@tt{--list}.
-}
-
-@defproc[(git-grep [argument any/c] ...) list?]{
-Searches tracked files. Each result contains the file, optional line number,
-optional match count, and matched text. Exit status one means that no matches
-were found and returns an empty list.
-}
-
-@defproc[(git-help [argument any/c] ...) boolean?]{
-Runs @tt{git help} with the supplied arguments and returns @racket[#t] when Git
-exits successfully.
-}
-
-@section{Package version}
-
-@defproc[(git-version) list?]{
-Reads the package version from @filepath{info.rkt} and returns it as a list
-containing major, minor, and patch.
-}
-
-
-@defproc[(git-new-version [kind symbol?]) list?]{
-Updates the version in @filepath{info.rkt}. The kind is @racket['major],
-@racket['minor], or @racket['patch], with @racket['maj] and @racket['min] as
-abbreviations. The result is the new version as a list of three integers.
-}
-
-
-@section{Low-level Git execution}
-
-@defproc[(run-git [args list?]
-                  [#:input input (or/c #f string?) #f])
-         (values exact-integer? list?)]{
-Runs Git without interactive terminal prompts. When @racket[input] is a string,
-it is written to Git's standard input before that input port is closed.
-
-The procedure returns two values: Git's exit code and the ordered output items,
-where each item identifies either @racket['stdout] or @racket['stderr].
-
-@racketblock[
-(run-git '(credential fill)
-         #:input "protocol=https\nhost=git.dijkewijk.nl\n\n")
-]
-}