Editors and Mergetools with drracket

README.md

@@ -39,6 +39,7 @@ alias for `git*`.
 (git* rebase main)
 (git* merge feature)
 (git* cherry-pick abc1234)
+(git* mergetool)
 
 (define branch "develop")
 (git* switch (eval branch))
@@ -54,6 +55,7 @@ behavior:
 - `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` /
@@ -66,7 +68,7 @@ credentials, SSH keys, pull strategy, and other repository configuration.
 ## Commands
 
 The package currently registers commands including `status`, `add`, `commit`,
-`push`, `pull`, `fetch`, `config`, `branch`, `remote`, `stash`, `restore`, `reset`, `revert`, `rebase`, `merge`, `cherry-pick`, `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`,
@@ -131,3 +133,40 @@ 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,23 @@
-#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.3.34")
+(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"
-    ))
+    ))
-
+
-(define build-deps
+(define build-deps
-  '("rackunit-lib"
+  '("rackunit-lib"
-    "racket-doc"))
+    "racket-doc"))
-
+
-(define scribblings
+(define scribblings
-  '(("scribblings/git-cli.scrbl" () ("git-cli"))))
+  '(("scribblings/git-cli.scrbl" () ("git-cli"))))
-
+

main.rkt

@@ -6,6 +6,8 @@
          "private/diff.rkt"
          "private/info-handler.rkt"
          "private/utils.rkt"
+         "private/find-editor.rkt"
+         "private/find-mergetool.rkt"
          simple-log
          racket/string
          net/sendurl
@@ -34,6 +36,7 @@
          git-rebase
          git-merge
          git-cherry-pick
+         git-mergetool
          git-clone
          git-rev-list
          git-diff
@@ -42,6 +45,11 @@
          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?
@@ -625,6 +633,29 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (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.
 ; pre    : The supplied arguments are valid for git switch.

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-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

scribblings/git-cli.scrbl

@@ -19,7 +19,7 @@ read credentials or other answers from the terminal.
 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['switch], @racket['clone],
+@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
@@ -314,6 +314,43 @@ through unchanged.
 ]
 }
 
+@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.