diff --git a/README.md b/README.md index cbd125d..9100864 100644 --- a/README.md +++ b/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) +``` diff --git a/info.rkt b/info.rkt index 2e940c6..9a7d3e0 100644 --- a/info.rkt +++ b/info.rkt @@ -1,23 +1,23 @@ -#lang info - -(define collection "git-cli") -(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") -(define version "0.3.34") -(define pkg-authors '("Hans Dijkema")) -(define license 'MIT) - -(define deps - '("base" - "simple-ini" - "simple-log" - "racket-index" - "scribble-lib" - )) - -(define build-deps - '("rackunit-lib" - "racket-doc")) - -(define scribblings - '(("scribblings/git-cli.scrbl" () ("git-cli")))) - \ No newline at end of file +#lang info + +(define collection "git-cli") +(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") +(define version "0.3.36") +(define pkg-authors '("Hans Dijkema")) +(define license 'MIT) + +(define deps + '("base" + "simple-ini" + "simple-log" + "racket-index" + "scribble-lib" + )) + +(define build-deps + '("rackunit-lib" + "racket-doc")) + +(define scribblings + '(("scribblings/git-cli.scrbl" () ("git-cli")))) + diff --git a/main.rkt b/main.rkt index 994548e..51e52de 100644 --- a/main.rkt +++ b/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. diff --git a/private/find-editor.rkt b/private/find-editor.rkt new file mode 100644 index 0000000..d737681 --- /dev/null +++ b/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)))) diff --git a/private/find-mergetool.rkt b/private/find-mergetool.rkt new file mode 100644 index 0000000..4027956 --- /dev/null +++ b/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)))) diff --git a/private/git-provider.rkt b/private/git-provider.rkt index 6ae4e22..2210348 100644 --- a/private/git-provider.rkt +++ b/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-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 - (lambda () - (let loop () - (let ((line (read-line port))) - (channel-put output-channel (list source line)) - (if (eof-object? line) - (close-input-port port) - (loop))))))) + (let* ((env (environment-variables-copy + (current-environment-variables))) + (editor (find-editor)) + (mergetool-path (find-mergetool-path))) + (environment-variables-set! env + #"GIT_TERMINAL_PROMPT" + #"0") + (when editor + (let ((editor-bytes (string->bytes/utf-8 editor))) + (environment-variables-set! env + #"GIT_EDITOR" + editor-bytes) + (environment-variables-set! env + #"GIT_SEQUENCE_EDITOR" + editor-bytes))) + (when mergetool-path + (let* ((directory (path-only mergetool-path)) + (old-path (environment-variables-ref env #"PATH")) + (separator (if (eq? (system-type 'os) 'windows) ";" ":")) + (new-path + (if old-path + (string-append (path->string directory) + 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 'stderr stderr) + (read-output 'stdout stdout) + (read-output 'stderr stderr) - (let loop ((open-ports 2) - (result '())) - (if (= open-ports 0) - (begin - (subprocess-wait process) - (values (subprocess-status process) - (reverse result))) - (let* ((output (channel-get output-channel)) - (line (cadr output))) - (if (eof-object? line) - (loop (- open-ports 1) result) - (loop open-ports - (cons output result))))))))) + (let loop ((open-ports 2) + (result '())) + (if (= open-ports 0) + (begin + (subprocess-wait process) + (values (subprocess-status process) + (reverse result))) + (let* ((output (channel-get output-channel)) + (line (cadr output))) + (if (eof-object? line) + (loop (- open-ports 1) result) + (loop open-ports + (cons output result))))))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Provided utility functions diff --git a/scribblings/git-cli.scrbl b/scribblings/git-cli.scrbl index 2e7079f..75aa8ac 100644 --- a/scribblings/git-cli.scrbl +++ b/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=}, or @tt{--tool-help}, git-cli first tries +@racket[find-mergetool] and supplies the selected tool through Git's normal +@tt{--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.