Editor configuration added.

2026-08-14 16:03:18 +02:00
parent c18c10c22f
commit 03c874d0c4
6 changed files with 485 additions and 176 deletions
@@ -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