hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

remote command added

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-13 23:47:54 +02:00
parent aa16ee10c8
commit bf2c903524
4 changed files with 188 additions and 9 deletions
Download Patch File Download Diff File Expand all files Collapse all files
README.md
+2
View File
@@ -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
+1 -1
View File
@@ -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
+118 -5
View File
@@ -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.
scribblings/git-cli.scrbl
+67 -3
View File
@@ -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.