Editor configuration added.

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.