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

exit code checking added

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-12 16:50:57 +02:00
parent b832ab8184
commit e4e37d2214
4 changed files with 36 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
info.rkt
+3 -2
View File
@@ -2,13 +2,14 @@
(define collection "git-cli") (define collection "git-cli")
(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") (define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
(define version "0.3.5") (define version "0.3.6")
(define pkg-authors '("Hans Dijkema")) (define pkg-authors '("Hans Dijkema"))
(define license 'MIT) (define license 'MIT)
(define deps (define deps
'("base" '("base"
("simple-ini") "simple-ini"
"simple-log"
"racket-index" "racket-index"
"scribble-lib" "scribble-lib"
"racket-makefile" "racket-makefile"
main.rkt
+23 -20
View File
@@ -57,26 +57,29 @@
(λ (args) (if (has-git-arg? args '-s) (λ (args) (if (has-git-arg? args '-s)
args args
(cons '-s args))) (cons '-s args)))
(λ (cmd result output out) (λ (cmd exit-code result output out)
(if result (if (= exit-code 0)
(map (λ (line) (if result
(let* ((state (string->symbol (string-trim (substring line 0 2)))) (map (λ (line)
(file (string-trim (substring line 3)))) (let* ((state (string->symbol (string-trim (substring line 0 2))))
(cond (file (string-trim (substring line 3))))
([eq? state '??] (list 'new file)) (cond
([eq? state 'M] (list 'modified file)) ([eq? state '??] (list 'new file))
([eq? state 'A] (list 'added file)) ([eq? state 'M] (list 'modified file))
([eq? state 'D] (list 'deleted file)) ([eq? state 'A] (list 'added file))
([eq? state 'AM] (list 'modified file)) ([eq? state 'D] (list 'deleted file))
([eq? state 'AD] (list 'deleted file)) ([eq? state 'AM] (list 'modified file))
([eq? state 'MM] (list 'modified file)) ([eq? state 'AD] (list 'deleted file))
([eq? state 'MD] (list 'deleted file)) ([eq? state 'MM] (list 'modified file))
(else ([eq? state 'MD] (list 'deleted file))
(git-error 'status "Unexpected state" state)) (else
) (git-error 'status "Unexpected state" state))
)) )
out) ))
(git-error 'status "Error" output))) out)
(git-error 'status "Error" output))
(git-error 'status "Exitcode <> 0" (cons (format "~a\n" exit-code) output))
))
) )
private/git-commands.rkt
+6 -4
View File
@@ -49,10 +49,12 @@
args) args)
(define (std-process-git-result cmd result output out) (define (std-process-git-result cmd exit-code result output out)
(git-displ out) (git-displ out)
(if result (if result
result (if (= exit-code 0)
#t
#f)
(git-error cmd "Error" out))) (git-error cmd "Error" out)))
(define-syntax def-git-cmd-proxy (define-syntax def-git-cmd-proxy
@@ -64,9 +66,9 @@
((_ f cmd pre-code process-result) ((_ f cmd pre-code process-result)
(define (f args) (define (f args)
(let ((nargs (pre-code args))) (let ((nargs (pre-code args)))
(let ((output (run-git (cons cmd nargs)))) (let-values (((exit-code output) (run-git (cons cmd nargs))))
(let-values (((result out) (git-out cmd output))) (let-values (((result out) (git-out cmd output)))
(process-result cmd result output out)))))) (process-result cmd exit-code result output out))))))
) )
) )
private/git-provider.rkt
+4 -5
View File
@@ -72,9 +72,7 @@
(set! cached-git-exe exe-path)))) (set! cached-git-exe exe-path))))
(define/contract (run-git args) (define (run-git args)
(-> (listof (or/c path-string? symbol?))
(listof (list/c (one-of/c 'stdout 'stderr) string?)))
(putenv "GIT_TERMINAL_PROMPT" "0") (putenv "GIT_TERMINAL_PROMPT" "0")
(let-values (((process stdout stdin stderr) (let-values (((process stdout stdin stderr)
(apply subprocess (apply subprocess
@@ -107,7 +105,8 @@
(if (= open-ports 0) (if (= open-ports 0)
(begin (begin
(subprocess-wait process) (subprocess-wait process)
(reverse result)) (values (subprocess-status process)
(reverse result)))
(let* ((output (channel-get output-channel)) (let* ((output (channel-get output-channel))
(line (cadr output))) (line (cadr output)))
(if (eof-object? line) (if (eof-object? line)
@@ -146,7 +145,7 @@
(format "~a" e))) (format "~a" e)))
(format "~a" e))) (format "~a" e)))
(if (list? outp) outp (list outp)))) (if (list? outp) outp (list outp))))
(enter (if (eq? (system-type 'os) 'windows) "\r\n" "\n")) (enter (if (eq? (system-type 'os) 'windows) "\n" "\n"))
(msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter))) (msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter)))
) )
(err-git msg) (err-git msg)