307 lines
13 KiB
Racket
307 lines
13 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/path
|
|
"config.rkt")
|
|
|
|
(provide find-mergetool
|
|
find-mergetools
|
|
find-mergetool-path
|
|
mergetool-downloads
|
|
configured-mergetool
|
|
set-mergetool!
|
|
set-mergetool-auto!)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; 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 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.
|
|
; 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.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; 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)
|
|
(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.
|
|
; 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 : 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.
|
|
; 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 ((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)))
|