Editor configuration added.

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
+When git-cli is loaded, it configures the current Racket process once for the
-`GIT_SEQUENCE_EDITOR` in the environment of the Git subprocess only. It does
+Git commands it starts. `GIT_TERMINAL_PROMPT` is set to `0`. When a GUI editor
-not change the user's global Git configuration.
+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
+`find-mergetool-path` can be used to inspect the executable that was found.
-directory to the environment of the Git subprocess, so Git's own mergetool
+If no tool is found, Git is left to select its own default.
-integration can still find it. If no tool is found, Git is left to select its
-own default.
 
 ```racket
 (find-mergetool)

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)
 

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.

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
+    (editor-at name description p arguments)))
-        (string-append (quote-command-path p) arguments)
-        #f)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-; goal   : Make an editor command from an existing well-known path.
+; goal   : Remove duplicate editor descriptions while preserving preference order.
-; pre    : p is a path or #f; arguments contains the editor wait arguments.
+; pre    : editors contains editor descriptions or #f values.
-; post   : p has only been inspected.
+; post   : editors has only been inspected.
-; result : An editor command string, or #f.
+; result : One editor description per editor name.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (editor-at p arguments)
+(define (unique-editors editors)
-  (if (and p (file-exists? p))
+  (let loop ((remaining editors)
-      (string-append (quote-command-path p) arguments)
+             (names '())
-      #f))
+             (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)
+(define (find-windows-editors)
-  (or (editor-on-path "code.cmd" " --wait")
+  (unique-editors
-      (editor-on-path "code.exe" " --wait")
+   (list
-      (editor-at
+    (editor-on-path "vscode" "Visual Studio Code" "code.cmd" " --wait")
-       (first-existing
+    (editor-on-path "vscode" "Visual Studio Code" "code.exe" " --wait")
-        (list
+    (editor-at
-         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+     "vscode"
-         (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+     "Visual Studio Code"
-         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")))
+     (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
-       " --wait")
+     " --wait")
-      (editor-at
+    (editor-at
-       (first-existing
+     "vscode"
-        (list
+     "Visual Studio Code"
-         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe")
+     (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
-         (environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe")
+     " --wait")
-         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe")))
+    (editor-at
-       " --wait")
+     "vscode"
-      (editor-on-path "notepad.exe" "")
+     "Visual Studio Code"
-      (editor-at
+     (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")
-       (environment-path "SystemRoot" "System32" "notepad.exe")
+     " --wait")
-       "")
+    (editor-on-path "notepad" "Notepad" "notepad.exe" "")
-      #f))
+    (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)
+(define (find-macos-editors)
-  (or (editor-on-path "code" " --wait")
+  (unique-editors
-      (editor-at
+   (list
-       (string->path
+    (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
-        "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
+    (editor-at
-       " --wait")
+     "vscode"
-      (let ((open
+     "Visual Studio Code"
-             (or (find-executable-path "open")
+     (string->path
-                 (let ((p (string->path "/usr/bin/open")))
+      "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
-                   (if (file-exists? p) p #f)))))
+     " --wait")
-        (if open
+    (let ((open
-            (format "~a -W -a TextEdit" (quote-command-path open))
+           (or (find-executable-path "open")
-            #f))
+               (let ((p (string->path "/usr/bin/open")))
-      #f))
+                 (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)
+(define (find-unix-editors)
-  (or (editor-on-path "code" " --wait")
+  (unique-editors
-      (editor-on-path "kate" " --block")
+   (list
-      (editor-on-path "gedit" " --wait")
+    (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
-      (editor-on-path "xed" " --wait")
+    (editor-on-path "kate" "Kate" "kate" " --block")
-      (editor-at (string->path "/snap/bin/code") " --wait")
+    (editor-on-path "gedit" "Gedit" "gedit" " --wait")
-      (editor-at (string->path "/usr/local/bin/code") " --wait")
+    (editor-on-path "xed" "Xed" "xed" " --wait")
-      (editor-at (string->path "/usr/bin/code") " --wait")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/snap/bin/code") " --wait")
-      (editor-at (string->path "/usr/local/bin/kate") " --block")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/usr/local/bin/code") " --wait")
-      (editor-at (string->path "/usr/bin/kate") " --block")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/usr/bin/code") " --wait")
-      (editor-at (string->path "/usr/bin/gedit") " --wait")
+    (editor-at "kate" "Kate" (string->path "/usr/local/bin/kate") " --block")
-      (editor-at (string->path "/usr/bin/xed") " --wait")
+    (editor-at "kate" "Kate" (string->path "/usr/bin/kate") " --block")
-      #f))
+    (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.
+; post   : The command has been stored and applied to the Git editor environment.
-; result : The result returned by the configuration layer.
+; 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)
+      (let ((editors (find-editors)))
-        ((windows) (find-windows-editor))
+        (if (null? editors)
-        ((macosx) (find-macos-editor))
+            #f
-        ((unix) (find-unix-editor))
+            (caddr (car editors))))))
-        (else #f))))

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))
+; goal   : Configure the process environment used by git-cli Git commands.
-  (let* ((env (environment-variables-copy
+; pre    : The editor finder can inspect the current platform.
-               (current-environment-variables)))
+; post   : Terminal prompting is disabled and a detected GUI editor is made
-         (editor (find-editor))
+;          available to Git and Git's sequence editor.
-         (mergetool-path (find-mergetool-path)))
+; result : void.
-    (environment-variables-set! env
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                                #"GIT_TERMINAL_PROMPT"
+(define (setup-git-environment!)
-                                #"0")
+  (putenv "GIT_TERMINAL_PROMPT" "0")
+  (let ((editor (find-editor)))
     (when editor
-      (let ((editor-bytes (string->bytes/utf-8 editor)))
+      (putenv "GIT_EDITOR" editor)
-        (environment-variables-set! env
+      (putenv "GIT_SEQUENCE_EDITOR" editor)))
-                                    #"GIT_EDITOR"
+  (void))
-                                    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)
+(setup-git-environment!)
-          (read-output 'stderr stderr)
 
-          (let loop ((open-ports 2)
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                     (result '()))
+; goal   : Run Git without allowing interactive terminal prompts.
-            (if (= open-ports 0)
+; pre    : args contains the Git command and its arguments; input is #f or a string
-                (begin
+;          that must be written to Git's standard input.
-                  (subprocess-wait process)
+; post   : Optional input has been written and standard output and error have been
-                  (values (subprocess-status process)
+;          read completely.
-                          (reverse result)))
+; result : The exit code and ordered (source line) output items.
-                (let* ((output (channel-get output-channel))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-                       (line (cadr output)))
+(define (run-git args #:input (input #f))
-                  (if (eof-object? line)
+  (let-values (((process stdout stdin stderr)
-                      (loop (- open-ports 1) result)
+                (apply subprocess
-                      (loop open-ports
+                       #f
-                            (cons output result)))))))))))
+                       #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

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
+Returns the configured or detected GUI editor command. When git-cli is
-@tt{GIT_EDITOR} and @tt{GIT_SEQUENCE_EDITOR}, without starting the editor.
+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]{