From 03c874d0c434208a50d4fbaf5a49d88b8a216e80 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Fri, 14 Aug 2026 16:03:18 +0200 Subject: [PATCH] Editor configuration added. --- README.md | 46 +++++-- info.rkt | 2 +- main.rkt | 163 +++++++++++++++++++++++- private/find-editor.rkt | 254 ++++++++++++++++++++++++-------------- private/git-provider.rkt | 128 +++++++++---------- scribblings/git-cli.scrbl | 68 +++++++++- 6 files changed, 485 insertions(+), 176 deletions(-) diff --git a/README.md b/README.md index 9100864..cfffb12 100644 --- a/README.md +++ b/README.md @@ -7,6 +7,7 @@ procedure and through direct procedures. ```racket (require git-cli) +(git 'init) (git 'status) (git 'log '-l '-5) (git 'fetch '--prune) @@ -31,6 +32,7 @@ must come from a Racket expression. `gt` remains available as a compatibility alias for `git*`. ```racket +(git* init) (git* remote -v) (git* switch main) (git* restore --staged main.rkt) @@ -67,11 +69,11 @@ credentials, SSH keys, pull strategy, and other repository configuration. ## Commands -The package currently registers commands including `status`, `add`, `commit`, +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`. -Most are also exported as direct procedures such as `git-status`, `git-add`, +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`. See the Scribble documentation for command-specific behavior and return values. @@ -96,6 +98,31 @@ See the Scribble documentation for command-specific behavior and return values. returns all values for one key. `get key` returns one string or `#f` when the key is absent. `set!` returns `#t` after a successful write. + +`config editor` is a git-cli configuration command rather than a Git +configuration key. With no additional arguments it presents an interactive +list of discovered GUI editors: + +```racket +(git* config editor) +``` + +The non-interactive forms are: + +```racket +(git* config editor --list) +(git* config editor vscode) +(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. + ## Low-level Git execution `run-git` can be used when direct access to Git's stdin/stdout protocol is @@ -137,15 +164,18 @@ A custom handler can still be installed through ## 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. +When git-cli is loaded, it configures the current Racket process once for the +Git commands it starts. `GIT_TERMINAL_PROMPT` is set to `0`. When a GUI editor +is found, `GIT_EDITOR` and `GIT_SEQUENCE_EDITOR` are set to that editor command. +`run-git` itself no longer copies or rewrites the process environment. The editor can be inspected or configured explicitly: ```racket (find-editor) +(find-editors) (set-editor! "code --wait") +(set-editor-auto!) ``` The editor search first checks `PATH` and then well-known platform locations. @@ -158,10 +188,8 @@ application bundle and TextEdit are recognized. On Linux common `/usr`, 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. +`find-mergetool-path` can be used to inspect the executable that was found. +If no tool is found, Git is left to select its own default. ```racket (find-mergetool) diff --git a/info.rkt b/info.rkt index dad64dc..ffc9694 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.36") +(define version "0.3.40") (define pkg-authors '("Hans Dijkema")) (define license 'MIT) diff --git a/main.rkt b/main.rkt index 51e52de..e0cad05 100644 --- a/main.rkt +++ b/main.rkt @@ -16,6 +16,7 @@ (provide gt git* git + git-init git-add git-status git-commit @@ -46,7 +47,9 @@ git-new-version git-next-version find-editor + find-editors set-editor! + set-editor-auto! find-mergetool find-mergetool-path set-mergetool! @@ -197,6 +200,145 @@ ; pre : args starts with get or set! and follows one of the supported forms. ; post : info contains the config operation used to process Git's result. ; result : Arguments accepted by git config. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return the editor description matching a configured editor name. +; pre : name can be formatted as an editor name. +; post : The editor list has only been inspected. +; result : A (name description command) item, or #f. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (find-editor-by-name name) + (let ((name* (string-downcase (format "~a" name)))) + (let loop ((editors (find-editors))) + (cond + ((null? editors) #f) + ((string=? (string-downcase (car (car editors))) name*) + (car editors)) + (else + (loop (cdr editors))))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return a Racket-oriented list of available GUI editors. +; pre : The platform editor finder is available. +; post : No editor has been started. +; result : (name description command current?) items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (available-editors) + (let ((current (find-editor))) + (map + (λ (editor) + (list (car editor) + (cadr editor) + (caddr editor) + (and current + (string=? current (caddr editor))))) + (find-editors)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Display the interactive git-cli editor selection. +; pre : editors contains the discovered editor descriptions. +; post : The choices have been displayed. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (display-editor-selection editors) + (displayln "Available editors:") + (newline) + (let loop ((items editors) + (index 1)) + (unless (null? items) + (let* ((editor (car items)) + (current (find-editor)) + (current? (and current + (string=? current (caddr editor))))) + (displayln + (format " ~a. ~a~a" + index + (cadr editor) + (if current? " [current]" ""))) + (displayln (format " ~a" (caddr editor))) + (newline) + (loop (cdr items) (+ index 1))))) + (displayln (format " ~a. Specify another editor command" + (+ (length editors) 1))) + (displayln (format " ~a. Automatic detection" + (+ (length editors) 2))) + (displayln " 0. Cancel") + (newline)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Ask the user to choose or enter the editor used by git-cli. +; pre : Standard input and output are available. +; post : A selected editor has been stored and activated, or the operation was cancelled. +; result : The selected editor command, or #f after cancellation. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (configure-editor-interactively) + (let ((editors (find-editors))) + (display-editor-selection editors) + (let* ((custom-index (+ (length editors) 1)) + (auto-index (+ (length editors) 2)) + (choice + (input-prompt + "Editor: " + #:loop-until + (λ (value) + (cond + ((eof-object? value) 'cancel) + (else + (let ((n (string->number value))) + (if (and n + (integer? n) + (<= 0 n auto-index)) + n + #f)))))))) + (cond + ((eq? choice 'cancel) #f) + ((= choice 0) #f) + ((<= choice (length editors)) + (set-editor! (caddr (list-ref editors (- choice 1))))) + ((= choice custom-index) + (let ((command + (input-prompt + "Editor command: " + #:loop-until + (λ (value) + (cond + ((eof-object? value) 'cancel) + ((string=? (string-trim value) "") #f) + (else value)))))) + (if (eq? command 'cancel) + #f + (set-editor! command)))) + ((= choice auto-index) + (set-editor-auto!)) + (else #f))))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Process the git-cli-specific `config editor` command. +; pre : args contains the arguments following `editor`. +; post : The requested editor configuration action has been performed. +; result : Editor data, the selected command, or #f after cancellation. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (git-config-editor args) + (cond + ((null? args) + (configure-editor-interactively)) + + ((and (= (length args) 1) + (git-argument=? (car args) '--list)) + (available-editors)) + + ((and (= (length args) 1) + (git-argument=? (car args) 'auto)) + (set-editor-auto!)) + + ((= (length args) 1) + (let ((editor (find-editor-by-name (car args)))) + (if editor + (set-editor! (caddr editor)) + (set-editor! (format "~a" (car args)))))) + + (else + (error 'git-config "Expected config editor [--list|auto|editor-name|editor-command]")))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (git-config-args args info) (define (scope? x) @@ -362,6 +504,14 @@ ) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Create an empty Git repository or reinitialize an existing repository. +; pre : The supplied arguments are valid for git init. +; post : Git init has completed successfully or an exception was raised. +; result : #t after a successful initialization. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-init cmd-git-init 'init) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Add file contents to the Git index. ; pre : The supplied arguments are valid for git add. @@ -424,10 +574,21 @@ ; post : Git config has completed or an exception has been raised. ; result : Structured config data, #f for a missing key, or #t after set!. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(def-cmd git-config cmd-git-config 'config +(def-git-cmd-proxy cmd-git-config-git 'config git-config-args 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))) + +(define (git-config . args) + (cmd-git-config args)) + +(hash-set! git-commands 'config cmd-git-config) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : List, create or delete branches. diff --git a/private/find-editor.rkt b/private/find-editor.rkt index d737681..fe18b6b 100644 --- a/private/find-editor.rkt +++ b/private/find-editor.rkt @@ -1,11 +1,14 @@ #lang racket/base (require racket/path + racket/string "config.rkt") (provide find-editor + find-editors configured-editor - set-editor!) + set-editor! + set-editor-auto!) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Supporting functions @@ -20,21 +23,6 @@ (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. @@ -48,102 +36,160 @@ #f))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Find an editor executable on PATH and append its wait arguments. +; goal : Make an editor description from an executable path. +; pre : p is a path or #f; arguments contains any required wait arguments. +; post : The filesystem has only been inspected. +; result : (name description command), or #f when the executable does not exist. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (editor-at name description p arguments) + (if (and p (file-exists? p)) + (list name + description + (string-append (quote-command-path p) arguments)) + #f)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Find an editor executable on PATH. ; pre : executable is a pathless executable name. ; post : PATH has only been inspected. -; result : An editor command string, or #f. +; result : (name description command), or #f. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (editor-on-path executable arguments) +(define (editor-on-path name description executable arguments) (let ((p (find-executable-path executable))) - (if p - (string-append (quote-command-path p) arguments) - #f))) + (editor-at name description p arguments))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; 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. +; goal : Remove duplicate editor descriptions while preserving preference order. +; pre : editors contains editor descriptions or #f values. +; post : editors has only been inspected. +; result : One editor description per editor name. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (editor-at p arguments) - (if (and p (file-exists? p)) - (string-append (quote-command-path p) arguments) - #f)) +(define (unique-editors editors) + (let loop ((remaining editors) + (names '()) + (result '())) + (cond + ((null? remaining) + (reverse result)) + ((not (car remaining)) + (loop (cdr remaining) names result)) + (else + (let* ((editor (car remaining)) + (name (car editor))) + (if (member name names) + (loop (cdr remaining) names result) + (loop (cdr remaining) + (cons name names) + (cons editor result)))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Find a well-known GUI editor on Windows. +; goal : Return known GUI editors found 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. +; result : A list of editor descriptions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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)) +(define (find-windows-editors) + (unique-editors + (list + (editor-on-path "vscode" "Visual Studio Code" "code.cmd" " --wait") + (editor-on-path "vscode" "Visual Studio Code" "code.exe" " --wait") + (editor-at + "vscode" + "Visual Studio Code" + (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd") + " --wait") + (editor-at + "vscode" + "Visual Studio Code" + (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd") + " --wait") + (editor-at + "vscode" + "Visual Studio Code" + (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd") + " --wait") + (editor-on-path "notepad" "Notepad" "notepad.exe" "") + (editor-at + "notepad" + "Notepad" + (environment-path "SystemRoot" "System32" "notepad.exe") + "")))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Find a well-known GUI editor on macOS. +; goal : Return known GUI editors found on macOS. ; pre : The current platform is macOS. ; post : PATH and standard application locations were inspected. -; result : A Git editor command string, or #f. +; result : A list of editor descriptions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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)) +(define (find-macos-editors) + (unique-editors + (list + (editor-on-path "vscode" "Visual Studio Code" "code" " --wait") + (editor-at + "vscode" + "Visual Studio Code" + (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 + (list "textedit" + "TextEdit" + (format "~a -W -a TextEdit" (quote-command-path open))) + #f))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Find a well-known GUI editor on Unix/Linux. +; goal : Return known GUI editors found 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. +; result : A list of editor descriptions. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(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)) +(define (find-unix-editors) + (unique-editors + (list + (editor-on-path "vscode" "Visual Studio Code" "code" " --wait") + (editor-on-path "kate" "Kate" "kate" " --block") + (editor-on-path "gedit" "Gedit" "gedit" " --wait") + (editor-on-path "xed" "Xed" "xed" " --wait") + (editor-at "vscode" "Visual Studio Code" (string->path "/snap/bin/code") " --wait") + (editor-at "vscode" "Visual Studio Code" (string->path "/usr/local/bin/code") " --wait") + (editor-at "vscode" "Visual Studio Code" (string->path "/usr/bin/code") " --wait") + (editor-at "kate" "Kate" (string->path "/usr/local/bin/kate") " --block") + (editor-at "kate" "Kate" (string->path "/usr/bin/kate") " --block") + (editor-at "gedit" "Gedit" (string->path "/usr/bin/gedit") " --wait") + (editor-at "xed" "Xed" (string->path "/usr/bin/xed") " --wait")))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Set the editor environment variables for Git commands started by git-cli. +; pre : command is a valid Git editor command. +; post : GIT_EDITOR and GIT_SEQUENCE_EDITOR contain command. +; result : command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (set-editor-environment! command) + (putenv "GIT_EDITOR" command) + (putenv "GIT_SEQUENCE_EDITOR" command) + command) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Provided functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return all well-known GUI editors found on the current platform. +; pre : The platform and filesystem are available. +; post : No editor has been started. +; result : A list of (name description command) items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (find-editors) + (case (system-type 'os) + ((windows) (find-windows-editors)) + ((macosx) (find-macos-editors)) + ((unix) (find-unix-editors)) + (else '()))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Read the editor explicitly configured for git-cli. ; pre : The git-cli configuration is readable. @@ -151,16 +197,35 @@ ; result : The configured editor command, or #f. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (configured-editor) - (cfg-get 'git 'editor #f)) + (let ((editor (cfg-get 'git 'editor #f))) + (if (and (string? editor) + (not (string=? (string-trim editor) ""))) + editor + #f))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -; goal : Store the editor command used by git-cli. +; goal : Store and activate 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. +; post : The command has been stored and applied to the Git editor environment. +; result : command. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (set-editor! command) - (cfg-set! 'git 'editor command)) + (cfg-set! 'git 'editor command) + (set-editor-environment! command)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Return git-cli to automatic editor detection and activate that editor. +; pre : A well-known GUI editor can be found on the current platform. +; post : The explicit editor setting is cleared and the detected editor is active. +; result : The automatically detected editor command. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (set-editor-auto!) + (let ((editors (find-editors))) + (if (null? editors) + (error 'git-config "No well-known GUI editor found") + (begin + (cfg-set! 'git 'editor "") + (set-editor-environment! (caddr (car editors))))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Find the GUI editor that git-cli should offer to Git. @@ -170,8 +235,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (find-editor) (or (configured-editor) - (case (system-type 'os) - ((windows) (find-windows-editor)) - ((macosx) (find-macos-editor)) - ((unix) (find-unix-editor)) - (else #f)))) + (let ((editors (find-editors))) + (if (null? editors) + #f + (caddr (car editors)))))) diff --git a/private/git-provider.rkt b/private/git-provider.rkt index 2210348..87ba894 100644 --- a/private/git-provider.rkt +++ b/private/git-provider.rkt @@ -6,7 +6,6 @@ racket/system "config.rkt" "find-editor.rkt" - "find-mergetool.rkt" ) (provide git-exe @@ -96,75 +95,70 @@ ; read completely. ; result : The exit code and ordered (source line) output items. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(define (run-git args #:input (input #f)) - (let* ((env (environment-variables-copy - (current-environment-variables))) - (editor (find-editor)) - (mergetool-path (find-mergetool-path))) - (environment-variables-set! env - #"GIT_TERMINAL_PROMPT" - #"0") +; goal : Configure the process environment used by git-cli Git commands. +; pre : The editor finder can inspect the current platform. +; post : Terminal prompting is disabled and a detected GUI editor is made +; available to Git and Git's sequence editor. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (setup-git-environment!) + (putenv "GIT_TERMINAL_PROMPT" "0") + (let ((editor (find-editor))) (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))))))) + (putenv "GIT_EDITOR" editor) + (putenv "GIT_SEQUENCE_EDITOR" editor))) + (void)) - (read-output 'stdout stdout) - (read-output 'stderr stderr) +(setup-git-environment!) - (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))))))))))) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Run Git without allowing interactive terminal prompts. +; pre : args contains the Git command and its arguments; input is #f or a string +; that must be written to Git's standard input. +; post : Optional input has been written and standard output and error have been +; read completely. +; result : The exit code and ordered (source line) output items. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (run-git args #:input (input #f)) + (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) + + (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 75aa8ac..73618ad 100644 --- a/scribblings/git-cli.scrbl +++ b/scribblings/git-cli.scrbl @@ -17,7 +17,7 @@ read credentials or other answers from the terminal. @defform[(git command argument ...)]{ Runs a registered Git @racket[command]. The arguments are passed to the command. -Registered command symbols are @racket['status], @racket['add], +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], @@ -54,6 +54,17 @@ converted from its literal syntax. @section{Provided commands} +@defproc[(git-init [argument any/c] ...) boolean?]{ +Runs @tt{git init} with the supplied arguments and returns @racket[#t] when Git +exits successfully. + +@racketblock[ +(git-init) +(git* init) +(git* init --bare) +] +} + @defproc[(git-status [argument any/c] ...) list?]{ Runs @tt{git status --porcelain} with the supplied arguments. @@ -155,6 +166,56 @@ appear directly after @racket['config] or directly after @racket['get] / @racket['set!]. A successful write returns @racket[#t]. } +@subsection{git-cli editor configuration} + +The @racket[git-config] procedure also recognizes the git-cli-specific +@tt{editor} operation. This does not write Git's @tt{core.editor}; it controls +the editor command used by git-cli through @tt{GIT_EDITOR} and +@tt{GIT_SEQUENCE_EDITOR}. + +With no additional argument an interactive selection is displayed. + +@racketblock[ +(git* config editor) +] + +The available editors can also be returned without prompting. + +@racketblock[ +(git* config editor --list) +] + +Each item contains the short editor name, description, command and a boolean +indicating whether that command is currently selected. + +A detected editor can be selected by its short name, or automatic detection can +be restored. + +@racketblock[ +(git* config editor vscode) +(git* config editor auto) +] + +An arbitrary editor command can be supplied using the ordinary procedure form. + +@racketblock[ +(git 'config 'editor "C:\\Program Files\\MyEditor\\editor.exe --wait") +] + +Changing the editor updates both @tt{GIT_EDITOR} and +@tt{GIT_SEQUENCE_EDITOR} immediately for subsequent Git commands. + +@defproc[(find-editors) list?]{ +Returns all well-known GUI editors found on the current platform as +@racket[(name description command)] items. +} + +@defproc[(set-editor-auto!) string?]{ +Clears the explicit git-cli editor selection, activates the first automatically +detected editor and returns its command. An exception is raised when no +well-known GUI editor 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 @@ -328,8 +389,9 @@ to choose its own default. } @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. +Returns the configured or detected GUI editor command. When git-cli is +loaded, the detected editor is assigned once to @tt{GIT_EDITOR} and +@tt{GIT_SEQUENCE_EDITOR}. The editor is not started by this procedure. } @defproc[(set-editor! [command string?]) any/c]{