remote command added

README.md

@@ -30,6 +30,8 @@ behavior:
 - `git-status` uses Git's porcelain status and returns structured status items.
 - `git-log -l` / `git-log --list` returns `(commit subject)` items.
 - `git-tag -l` / `git-tag --list` returns tag names; with `-n` it returns `(tag subject)` items and `-n<number>` supports multiple content lines.
+- `git-branch -l` / `git-branch --list` returns `(current|local|remote branch)` items; `-a`, `-r`, and `--sort=` remain Git options.
+- `git-remote` returns remote names; `git-remote -v` / `git-remote --verbose` returns separate `(name url fetch|push)` items.
 - `git-diff` renders HTML by default; `--output=-` selects stdout and
   `--output=string` returns a string.
 - `git-show` renders a commit and its diff as HTML by default. `-l` /

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.23")
+(define version "0.3.29")
 (define pkg-authors '("Hans Dijkema"))
 (define license 'MIT)
 

main.rkt

@@ -11,9 +11,8 @@
          net/sendurl
          )
 
-; test
+(provide gt
-
+         git
-(provide 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.

scribblings/git-cli.scrbl

@@ -19,7 +19,7 @@ read credentials or other answers from the terminal.
 Runs a registered Git @racket[command]. The arguments are passed to the command.
 Registered command symbols are @racket['status], @racket['add],
 @racket['commit], @racket['push], @racket['pull], @racket['fetch],
-@racket['config], @racket['branch], @racket['switch], @racket['clone],
+@racket['config], @racket['branch], @racket['remote], @racket['switch], @racket['clone],
 @racket['tag],
 @racket['log], @racket['rev-list], @racket['diff],
 @racket['show], @racket['grep], @racket['help], @racket['version], and
@@ -134,12 +134,76 @@ appear directly after @racket['config] or directly after @racket['get] /
 @racket['set!]. A successful write returns @racket[#t].
 }
 
-@defproc[(git-branch [argument any/c] ...) boolean?]{
+@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
 installed Git executable.
-}
 
+With Git's @tt{-l} or @tt{--list} option, git-cli returns structured branch
+information. Each item starts with one of @racket['current], @racket['local],
+or @racket['remote], followed by the branch name.
+
+@racketblock[
+(git-branch '-l)
+
+'((current "main")
+  (local "develop"))
+]
+
+Git's normal branch selection and sorting options are passed through. For
+example, remote branches can be requested with @tt{-r}, all branches with
+@tt{-a}, and Git's @tt{--sort=<key>} option controls the returned order.
+
+@racketblock[
+(git 'branch '-l '-a "--sort=refname")
+
+'((current "main")
+  (local "develop")
+  (remote "origin/main"))
+]
+
+Without @tt{-l} or @tt{--list}, normal Git output is displayed and the
+procedure returns @racket[#t] when Git exits successfully.
+}
+@defproc[(git-remote [argument any/c] ...) any/c]{
+Runs @tt{git remote} with the supplied arguments and keeps the command's own
+subcommand structure.
+
+With no arguments, the remote names are returned as a Racket list.
+
+@racketblock[
+(git-remote)
+
+'("origin" "upstream")
+]
+
+With top-level @tt{-v} or @tt{--verbose}, each line reported by Git is returned
+as a separate structured item containing the remote name, URL, and the
+@racket['fetch] or @racket['push] role.
+
+@racketblock[
+(git-remote '-v)
+
+'(("origin" "https://example.invalid/project.git" fetch)
+  ("origin" "https://example.invalid/project.git" push))
+]
+
+The two Git lines are deliberately not merged. This keeps the result close to
+the output and semantics of @tt{git remote -v}.
+
+For @tt{get-url}, one URL is returned as a string. With @tt{--all}, a list of
+URLs is returned.
+
+@racketblock[
+(git 'remote 'get-url "origin")
+(git 'remote 'get-url '--all "origin")
+(git 'remote 'get-url '--push '--all "origin")
+]
+
+Other forms, including @tt{add}, @tt{rename}, @tt{remove}, @tt{set-head},
+@tt{show}, @tt{prune}, @tt{update}, @tt{set-branches}, and @tt{set-url}, are
+passed to Git unchanged and use the normal git-cli command result processing.
+}
 @defproc[(git-switch [argument any/c] ...) boolean?]{
 Runs @tt{git switch} with the supplied arguments.