Fallback created for git commands not standard handled by this module

private/find-mergetool.rkt

@@ -4,9 +4,12 @@
          "config.rkt")
 
 (provide find-mergetool
+         find-mergetools
          find-mergetool-path
+         mergetool-downloads
          configured-mergetool
-         set-mergetool!)
+         set-mergetool!
+         set-mergetool-auto!)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Supporting functions
@@ -62,6 +65,56 @@
            candidate
            (find-candidates (cdr candidates)))))))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return every usable merge tool candidate without duplicate tool names.
+; pre    : candidates contains merge tool candidate descriptions.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list of (tool description path) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-all-candidates candidates)
+  (let loop ((remaining candidates)
+             (names '())
+             (result '()))
+    (cond
+      ((null? remaining)
+       (reverse result))
+      (else
+       (let ((candidate (find-candidate (car remaining))))
+         (cond
+           ((not candidate)
+            (loop (cdr remaining) names result))
+           ((member (car candidate) names)
+            (loop (cdr remaining) names result))
+           (else
+            (loop (cdr remaining)
+                  (cons (car candidate) names)
+                  (cons
+                   (list (car candidate)
+                         (mergetool-description (car candidate))
+                         (cadr candidate))
+                   result)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; 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.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return a display description for a known Git merge tool.
+; pre    : tool is a Git merge tool name.
+; post   : tool has only been inspected.
+; result : A human-readable description.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-description tool)
+  (cond
+    ((string=? tool "winmerge") "WinMerge")
+    ((string=? tool "vscode") "Visual Studio Code")
+    ((string=? tool "kdiff3") "KDiff3")
+    ((string=? tool "meld") "Meld")
+    ((string=? tool "tortoisemerge") "TortoiseMerge")
+    ((string=? tool "opendiff") "FileMerge / opendiff")
+    (else tool)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Return well-known graphical merge tool candidates for Windows.
 ; pre    : Windows environment variables may or may not be defined.
@@ -159,9 +212,44 @@
 ; pre    : The git-cli configuration is readable.
 ; post   : The configuration has not been changed.
 ; result : The configured Git merge tool name, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return all well-known merge tools found on the current platform.
+; pre    : The platform and filesystem are available.
+; post   : No merge tool has been started.
+; result : A list of (name description path) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetools)
+  (find-all-candidates (mergetool-candidates)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return official download pointers for optional merge tools.
+; pre    : The current platform is known.
+; post   : No network request has been made.
+; result : A list of (name description url) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-downloads)
+  (case (system-type 'os)
+    ((windows)
+     '(("winmerge" "WinMerge" "https://winmerge.org/downloads/")
+       ("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("meld" "Meld" "https://meldmerge.org/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    ((macosx)
+     '(("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    ((unix)
+     '(("meld" "Meld" "https://meldmerge.org/")
+       ("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    (else '())))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (configured-mergetool)
-  (cfg-get 'git 'mergetool #f))
+  (let ((tool (cfg-get 'git 'mergetool #f)))
+    (if (and (string? tool)
+             (not (string=? tool "")))
+        tool
+        #f)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Store the Git merge tool name used by git-cli.
@@ -172,6 +260,20 @@
 (define (set-mergetool! tool)
   (cfg-set! 'git 'mergetool tool))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return git-cli to automatic merge tool detection.
+; pre    : A well-known merge tool can be found on the current platform.
+; post   : The explicit merge tool setting is cleared.
+; result : The automatically detected Git merge tool name.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-mergetool-auto!)
+  (let ((detected (detected-mergetool)))
+    (if detected
+        (begin
+          (cfg-set! 'git 'mergetool "")
+          (car detected))
+        (error 'git-config "No well-known merge tool found"))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Find the graphical merge tool that git-cli should prefer.
 ; pre    : The platform and git-cli configuration are available.
@@ -192,10 +294,13 @@
 ; 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))))
+  (let ((tool (find-mergetool)))
+    (if tool
+        (let loop ((tools (find-mergetools)))
+          (cond
+            ((null? tools) #f)
+            ((string=? tool (car (car tools)))
+             (caddr (car tools)))
+            (else
+             (loop (cdr tools)))))
+        #f)))