diff --git a/README.md b/README.md index cfffb12..65984e1 100644 --- a/README.md +++ b/README.md @@ -23,7 +23,23 @@ 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. +and the remaining arguments are passed to that command. Registered commands use +their git-cli wrapper and can provide structured Racket results or additional +behavior. Any other command is passed directly to the installed Git executable +and handled with git-cli's standard command result processing. + +For example, commands that do not have a dedicated wrapper can still be used: + +```racket +(git 'blame "main.rkt") +(git* clean -n) +(git* worktree list) +(git* archive --format=zip HEAD) +``` + +A successful fallback command returns `#t` after displaying normal Git output. +A failing fallback command raises the same standard git-cli error as an ordinary +pass-through wrapper. `git*` is the compact command-style syntax. Bare arguments are converted to strings, so `(git* remote get-url origin)` is equivalent to @@ -69,12 +85,16 @@ credentials, SSH keys, pull strategy, and other repository configuration. ## Commands -The package currently registers commands including `init`, `status`, `add`, `commit`, -`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`. +The package registers wrappers for commands where git-cli adds useful behavior, +including `init`, `status`, `add`, `commit`, `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`. Other Git commands do not +need a wrapper and are passed directly to Git. -Most are also exported as direct procedures such as `git-init`, `git-status`, `git-add`, -`git-fetch`, `git-config`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`. +Most registered commands are also exported as direct procedures such as +`git-init`, `git-status`, `git-add`, `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. @@ -111,17 +131,41 @@ The non-interactive forms are: ```racket (git* config editor --list) +(git* config editor --downloads) (git* config editor vscode) +(git* config editor notepad++) (git* config editor auto) (git 'config 'editor "C:\\Program Files\\MyEditor\\editor.exe --wait") ``` -`--list` returns `(name description command current?)` items. A known editor -name selects the matching detected editor. `auto` clears the explicit git-cli -editor choice and returns to automatic detection. Any other single value is -stored as the editor command. Changing the editor immediately updates -`GIT_EDITOR` and `GIT_SEQUENCE_EDITOR` for subsequent Git commands. +`--list` returns `(name description command current?)` items and `--downloads` +returns official download pointers for optional editors. A known editor name +selects the matching detected editor. `auto` clears the explicit git-cli editor +choice and returns to automatic detection. Any other single value is stored as +the editor command. Changing the editor immediately updates `GIT_EDITOR` and +`GIT_SEQUENCE_EDITOR` for subsequent Git commands. + +On Windows, Notepad++ is detected both on `PATH` and in the normal Program Files +locations. It is started with `-multiInst -nosession`, so Git waits for the +separate editor instance to close. + + +`config mergetool` uses the same git-cli configuration pattern: + +```racket +(git* config mergetool) +(git* config mergetool --list) +(git* config mergetool --downloads) +(git* config mergetool winmerge) +(git* config mergetool auto) +``` + +`--list` returns `(name description path current?)` items. A known tool name +selects the detected tool, while another single value is stored as the Git +mergetool name. `auto` clears the explicit git-cli choice and returns to +automatic detection. The interactive form also offers download/install +suggestions. ## Low-level Git execution @@ -180,7 +224,7 @@ The editor can be inspected or configured explicitly: 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 +VS Code and Notepad++, 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. @@ -193,8 +237,11 @@ If no tool is found, Git is left to select its own default. ```racket (find-mergetool) +(find-mergetools) (find-mergetool-path) +(mergetool-downloads) (set-mergetool! "winmerge") +(set-mergetool-auto!) (git* mergetool) (git* mergetool --tool=meld) ``` diff --git a/info.rkt b/info.rkt index ffc9694..2d9b545 100644 --- a/info.rkt +++ b/info.rkt @@ -2,7 +2,7 @@ (define collection "git-cli") (define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") -(define version "0.3.40") +(define version "0.4.0") (define pkg-authors '("Hans Dijkema")) (define license 'MIT) diff --git a/main.rkt b/main.rkt index e0cad05..843feee 100644 --- a/main.rkt +++ b/main.rkt @@ -10,6 +10,7 @@ "private/find-mergetool.rkt" simple-log racket/string + racket/list net/sendurl ) @@ -48,11 +49,15 @@ git-next-version find-editor find-editors + editor-downloads set-editor! set-editor-auto! find-mergetool + find-mergetools find-mergetool-path + mergetool-downloads set-mergetool! + set-mergetool-auto! default-git-authentication-handler current-git-authentication-handler exn:fail:git-auth? @@ -91,17 +96,26 @@ (git* cmd arg ...)))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Invoke a supported Git command through the command table. -; pre : command is a registered Git command symbol. -; post : The selected command has processed all supplied arguments. -; result : The command-specific result. +; goal : Invoke a Git command through a registered wrapper or direct fallback. +; pre : command identifies a Git command and args contains its arguments. +; post : Registered commands use their wrapper; other commands are passed to Git. +; result : The command-specific result or the standard Git command result. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git command . args) - ((hash-ref git-commands command - (λ () - (error "Not a supported or recognized git command: " command))) - args)) + (let ((cmd (hash-ref git-commands command #f))) + (if cmd + (cmd args) + (let-values (((exit-code output) + (run-git (cons command (flatten args))))) + (let-values (((result out) (git-out command output))) + (std-process-git-result + command + exit-code + result + output + out + (make-hash))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Supporting functions @@ -261,6 +275,8 @@ (+ (length editors) 1))) (displayln (format " ~a. Automatic detection" (+ (length editors) 2))) + (displayln (format " ~a. Download/install suggestions" + (+ (length editors) 3))) (displayln " 0. Cancel") (newline)) @@ -275,6 +291,7 @@ (display-editor-selection editors) (let* ((custom-index (+ (length editors) 1)) (auto-index (+ (length editors) 2)) + (downloads-index (+ (length editors) 3)) (choice (input-prompt "Editor: " @@ -286,7 +303,7 @@ (let ((n (string->number value))) (if (and n (integer? n) - (<= 0 n auto-index)) + (<= 0 n downloads-index)) n #f)))))))) (cond @@ -309,6 +326,10 @@ (set-editor! command)))) ((= choice auto-index) (set-editor-auto!)) + ((= choice downloads-index) + (display-download-pointers + "Suggested editors:" + (editor-downloads))) (else #f))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -326,6 +347,10 @@ (git-argument=? (car args) '--list)) (available-editors)) + ((and (= (length args) 1) + (git-argument=? (car args) '--downloads)) + (editor-downloads)) + ((and (= (length args) 1) (git-argument=? (car args) 'auto)) (set-editor-auto!)) @@ -337,7 +362,177 @@ (set-editor! (format "~a" (car args)))))) (else - (error 'git-config "Expected config editor [--list|auto|editor-name|editor-command]")))) + (error 'git-config "Expected config editor [--list|--downloads|auto|editor-name|editor-command]")))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Display official download pointers. +; pre : items contains (name description url) items. +; post : The pointers have been displayed. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (display-download-pointers title items) + (displayln title) + (newline) + (for-each + (λ (item) + (displayln (format " ~a" (cadr item))) + (displayln (format " ~a" (caddr item))) + (newline)) + items) + (void)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return the merge tool description matching a configured tool name. +; pre : name can be formatted as a merge tool name. +; post : The merge tool list has only been inspected. +; result : A (name description path) item, or #f. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (find-mergetool-by-name name) + (let ((name* (string-downcase (format "~a" name)))) + (let loop ((tools (find-mergetools))) + (cond + ((null? tools) #f) + ((string=? (string-downcase (car (car tools))) name*) + (car tools)) + (else + (loop (cdr tools))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return a Racket-oriented list of available merge tools. +; pre : The platform merge tool finder is available. +; post : No merge tool has been started. +; result : (name description path current?) items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (available-mergetools) + (let ((current (find-mergetool))) + (map + (λ (tool) + (list (car tool) + (cadr tool) + (caddr tool) + (and current + (string=? current (car tool))))) + (find-mergetools)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Display the interactive git-cli merge tool selection. +; pre : tools contains the discovered merge tool descriptions. +; post : The choices have been displayed. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (display-mergetool-selection tools) + (displayln "Available merge tools:") + (newline) + (let loop ((items tools) + (index 1)) + (unless (null? items) + (let* ((tool (car items)) + (current (find-mergetool)) + (current? (and current + (string=? current (car tool))))) + (displayln + (format " ~a. ~a~a" + index + (cadr tool) + (if current? " [current]" ""))) + (displayln (format " ~a" (caddr tool))) + (newline) + (loop (cdr items) (+ index 1))))) + (displayln (format " ~a. Specify another merge tool name" + (+ (length tools) 1))) + (displayln (format " ~a. Automatic detection" + (+ (length tools) 2))) + (displayln (format " ~a. Download/install suggestions" + (+ (length tools) 3))) + (displayln " 0. Cancel") + (newline)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Ask the user to choose or enter the merge tool used by git-cli. +; pre : Standard input and output are available. +; post : A selected merge tool has been stored, automatic detection was restored, +; download pointers were shown, or the operation was cancelled. +; result : The selected merge tool name, #f after cancellation, or void after pointers. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (configure-mergetool-interactively) + (let ((tools (find-mergetools))) + (display-mergetool-selection tools) + (let* ((custom-index (+ (length tools) 1)) + (auto-index (+ (length tools) 2)) + (downloads-index (+ (length tools) 3)) + (choice + (input-prompt + "Merge tool: " + #:loop-until + (λ (value) + (cond + ((eof-object? value) 'cancel) + (else + (let ((n (string->number value))) + (if (and n + (integer? n) + (<= 0 n downloads-index)) + n + #f)))))))) + (cond + ((eq? choice 'cancel) #f) + ((= choice 0) #f) + ((<= choice (length tools)) + (set-mergetool! (car (list-ref tools (- choice 1))))) + ((= choice custom-index) + (let ((tool + (input-prompt + "Merge tool name: " + #:loop-until + (λ (value) + (cond + ((eof-object? value) 'cancel) + ((string=? (string-trim value) "") #f) + (else value)))))) + (if (eq? tool 'cancel) + #f + (set-mergetool! tool)))) + ((= choice auto-index) + (set-mergetool-auto!)) + ((= choice downloads-index) + (display-download-pointers + "Suggested merge tools:" + (mergetool-downloads))) + (else #f))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Process the git-cli-specific `config mergetool` command. +; pre : args contains the arguments following `mergetool`. +; post : The requested merge tool configuration action has been performed. +; result : Merge tool data, the selected tool name, download pointers, or #f. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (git-config-mergetool args) + (cond + ((null? args) + (configure-mergetool-interactively)) + + ((and (= (length args) 1) + (git-argument=? (car args) '--list)) + (available-mergetools)) + + ((and (= (length args) 1) + (git-argument=? (car args) '--downloads)) + (mergetool-downloads)) + + ((and (= (length args) 1) + (git-argument=? (car args) 'auto)) + (set-mergetool-auto!)) + + ((= (length args) 1) + (let ((tool (find-mergetool-by-name (car args)))) + (if tool + (set-mergetool! (car tool)) + (set-mergetool! (format "~a" (car args)))))) + + (else + (error 'git-config + "Expected config mergetool [--list|--downloads|auto|tool-name]")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-config-args args info) @@ -579,10 +774,15 @@ process-git-config-result) (define (cmd-git-config args) - (if (and (pair? args) - (git-argument=? (car args) 'editor)) - (git-config-editor (cdr args)) - (cmd-git-config-git args))) + (cond + ((and (pair? args) + (git-argument=? (car args) 'editor)) + (git-config-editor (cdr args))) + ((and (pair? args) + (git-argument=? (car args) 'mergetool)) + (git-config-mergetool (cdr args))) + (else + (cmd-git-config-git args)))) (define (git-config . args) (cmd-git-config args)) diff --git a/private/find-editor.rkt b/private/find-editor.rkt index fe18b6b..0a4ba04 100644 --- a/private/find-editor.rkt +++ b/private/find-editor.rkt @@ -6,6 +6,7 @@ (provide find-editor find-editors + editor-downloads configured-editor set-editor! set-editor-auto!) @@ -108,6 +109,20 @@ "Visual Studio Code" (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd") " --wait") + (editor-on-path "notepad++" + "Notepad++" + "notepad++.exe" + " -multiInst -nosession") + (editor-at + "notepad++" + "Notepad++" + (environment-path "ProgramFiles" "Notepad++" "notepad++.exe") + " -multiInst -nosession") + (editor-at + "notepad++" + "Notepad++" + (environment-path "ProgramFiles(x86)" "Notepad++" "notepad++.exe") + " -multiInst -nosession") (editor-on-path "notepad" "Notepad" "notepad.exe" "") (editor-at "notepad" @@ -190,6 +205,23 @@ ((unix) (find-unix-editors)) (else '()))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return official download pointers for optional GUI editors. +; pre : The current platform is known. +; post : No network request has been made. +; result : A list of (name description url) items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (editor-downloads) + (case (system-type 'os) + ((windows) + '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download") + ("notepad++" "Notepad++" "https://notepad-plus-plus.org/downloads/"))) + ((macosx) + '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download"))) + ((unix) + '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download"))) + (else '()))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Read the editor explicitly configured for git-cli. ; pre : The git-cli configuration is readable. diff --git a/private/find-mergetool.rkt b/private/find-mergetool.rkt index 4027956..8e49077 100644 --- a/private/find-mergetool.rkt +++ b/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))) diff --git a/scribblings/git-cli.scrbl b/scribblings/git-cli.scrbl index 73618ad..8dcee54 100644 --- a/scribblings/git-cli.scrbl +++ b/scribblings/git-cli.scrbl @@ -16,19 +16,39 @@ 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['init], @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 +Runs a Git @racket[command]. When the command has a registered git-cli wrapper, +that wrapper is used. Registered wrappers can provide structured Racket results, +argument handling, or other command-specific behavior. + +Registered command symbols include @racket['init], @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]. +When no wrapper is registered, the command and arguments are passed directly to +the installed Git executable through @racket[run-git]. The result is handled by +the same standard result processing used by ordinary pass-through wrappers: +normal Git output is displayed and a successful command returns @racket[#t]; +a non-zero exit status raises a git-cli error. + +This makes dedicated wrappers optional for Git commands where git-cli does not +add useful behavior. + +@racketblock[ +(git 'blame "main.rkt") +(git* clean -n) +(git* worktree list) +(git* archive --format=zip HEAD) +] + +Some registered 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]. } @@ -49,6 +69,9 @@ converted from its literal syntax. (git* switch (eval branch)) ] +Because @racket[git] falls back to direct Git execution for commands without a +registered wrapper, @racket[git*] can also be used with those commands. + @racket[gt] is retained as a compatibility alias for @racket[git*]. } @@ -183,6 +206,7 @@ The available editors can also be returned without prompting. @racketblock[ (git* config editor --list) +(git* config editor --downloads) ] Each item contains the short editor name, description, command and a boolean @@ -193,6 +217,7 @@ be restored. @racketblock[ (git* config editor vscode) +(git* config editor notepad++) (git* config editor auto) ] @@ -216,6 +241,49 @@ detected editor and returns its command. An exception is raised when no well-known GUI editor can be found. } +@defproc[(editor-downloads) list?]{ +Returns official download pointers for optional GUI editors as +@racket[(name description url)] items. No network request is performed. +} + +On Windows, Notepad++ is detected both on @tt{PATH} and in the normal Program +Files locations. git-cli invokes it with @tt{-multiInst -nosession}. + +@subsection{git-cli merge tool configuration} + +The @racket[git-config] procedure also recognizes the git-cli-specific +@tt{mergetool} operation. + +@racketblock[ +(git* config mergetool) +(git* config mergetool --list) +(git* config mergetool --downloads) +(git* config mergetool winmerge) +(git* config mergetool auto) +] + +With no additional argument an interactive selection is displayed. +@tt{--list} returns @racket[(name description path current?)] items and +@tt{--downloads} returns official download pointers. A detected merge tool can +be selected by its short Git tool name. @tt{auto} clears the explicit git-cli +selection and restores automatic detection. + +@defproc[(find-mergetools) list?]{ +Returns all well-known graphical merge tools found on the current platform as +@racket[(name description path)] items. +} + +@defproc[(mergetool-downloads) list?]{ +Returns official download pointers for optional merge tools as +@racket[(name description url)] items. No network request is performed. +} + +@defproc[(set-mergetool-auto!) string?]{ +Clears the explicit git-cli merge tool selection and returns the first +automatically detected Git merge tool name. An exception is raised when no +well-known merge tool can be found. +} + @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