remote command added

2026-08-13 23:47:54 +02:00
parent aa16ee10c8
commit bf2c903524
4 changed files with 188 additions and 9 deletions
@@ -11,9 +11,8 @@
         net/sendurl
         )

-; test
-
-(provide git
+(provide gt
+         git
         git-add
         git-status
         git-commit
@@ -26,6 +25,7 @@
         git-log
         git-grep
         git-branch
+         git-remote
         git-clone
         git-rev-list
         git-diff
@@ -54,6 +54,11 @@
 ;; Command invocation using 'git'
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

+(define-syntax gt
+  (syntax-rules ()
+    ((_ cmd a1 ...)
+     (git 'cmd 'a1 ...))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Invoke a supported Git command through the command table.
 ; pre    : command is a registered Git command symbol.
@@ -380,11 +385,119 @@
 ; goal   : List, create or delete branches.
 ; pre    : The supplied arguments are valid for git branch.
 ; post   : Git branch has completed successfully or an exception was raised.
-; result : #t after a successful branch command.
+; result : A structured branch list with --list/-l, otherwise #t.
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(def-cmd git-branch cmd-git-branch 'branch)
+(def-cmd git-branch cmd-git-branch 'branch
+  (λ (args info)
+    (let* ((split-id (format "git-cli-branch-split-~a-~a"
+                             (random 1000000000)
+                             (random 1000000000)))
+           (list-output
+            (ormap
+             (λ (e)
+               (let ((o (format "~a" e)))
+                 (or (string=? o "--list")
+                     (string=? o "-l"))))
+             args)))
+      (hash-set! info 'scheme-format list-output)
+      (hash-set! info 'branch-split-id split-id)
+      (if list-output
+          (append args
+                  (list
+                   (format "--format=%(HEAD)~a%(refname)" split-id)))
+          args)))
+  (λ (cmd exit-code result output out info)
+    (if (hash-ref info 'scheme-format #f)
+        (if (and (= exit-code 0) result)
+            (let ((split-id (hash-ref info 'branch-split-id)))
+              (map
+               (λ (line)
+                 (let* ((parts (string-split line split-id #:trim? #f))
+                        (head (car parts))
+                        (ref (if (null? (cdr parts)) "" (cadr parts))))
+                   (cond
+                     ((string-prefix? ref "refs/heads/")
+                      (list (if (string=? head "*") 'current 'local)
+                            (substring ref (string-length "refs/heads/"))))
+                     ((string-prefix? ref "refs/remotes/")
+                      (list 'remote
+                            (substring ref (string-length "refs/remotes/"))))
+                     (else
+                      (list 'branch ref)))))
+               out))
+            (std-process-git-result cmd exit-code result output out info))
+        (std-process-git-result cmd exit-code result output out info)))
+  )

 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List, add, rename or remove remotes.
+; pre    : The supplied arguments are valid for git remote.
+; post   : Git remote has completed successfully or an exception was raised.
+; result : A structured remote list with --list/-l, otherwise #t.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-remote cmd-git-remote 'remote
+  (λ (args info)
+    (cond
+      ((null? args)
+       (hash-set! info 'remote-operation 'list)
+       args)
+
+      ((and (= (length args) 1)
+            (member (car args) '(-v --verbose)))
+       (hash-set! info 'remote-operation 'verbose-list)
+       args)
+
+      ((eq? (car args) 'get-url)
+       (hash-set! info 'remote-operation
+                  (if (member '--all args)
+                      'get-url-all
+                      'get-url))
+       args)
+
+      (else
+       (hash-set! info 'remote-operation 'command)
+       args)))
+
+  (λ (cmd exit-code result output out info)
+    (let* ((operation (hash-ref info 'remote-operation 'command))
+           (stdout (map cadr
+                        (filter (λ (entry) (eq? (car entry) 'stdout))
+                                output))))
+      (cond
+        ((eq? operation 'list)
+         (if (= exit-code 0)
+             stdout
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'verbose-list)
+         (if (= exit-code 0)
+             (map
+              (λ (line)
+                (let ((m (regexp-match
+                          #px"^([^\\s]+)\\s+(.+) \\((fetch|push)\\)$"
+                          line)))
+                  (if m
+                      (list (cadr m)
+                            (caddr m)
+                            (string->symbol (cadddr m)))
+                      (list line #f 'unknown))))
+              stdout)
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'get-url)
+         (if (= exit-code 0)
+             (if (null? stdout) #f (car stdout))
+             (std-process-git-result cmd exit-code result output out info)))
+
+        ((eq? operation 'get-url-all)
+         (if (= exit-code 0)
+             stdout
+             (std-process-git-result cmd exit-code result output out info)))
+
+        (else
+         (std-process-git-result cmd exit-code result output out info)))))
+  )
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ; goal   : Switch branches.
 ; pre    : The supplied arguments are valid for git switch.
 ; post   : Git switch has completed successfully or an exception has been raised.