exit code checking added

private/git-commands.rkt

@@ -49,10 +49,12 @@
   args)
 
 
-(define (std-process-git-result cmd result output out)
+(define (std-process-git-result cmd exit-code result output out)
   (git-displ out)
   (if result
-      result
+      (if (= exit-code 0)
+          #t
+          #f)
       (git-error cmd "Error" out)))
 
 (define-syntax def-git-cmd-proxy
@@ -64,9 +66,9 @@
     ((_ f cmd pre-code process-result)
      (define (f 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)))
-             (process-result cmd result output out))))))
+             (process-result cmd exit-code result output out))))))
     )
   )
 

private/git-provider.rkt

@@ -72,9 +72,7 @@
      (set! cached-git-exe exe-path))))
 
 
-(define/contract (run-git args)
-  (-> (listof (or/c path-string? symbol?))
-      (listof (list/c (one-of/c 'stdout 'stderr) string?)))
+(define (run-git args)
   (putenv "GIT_TERMINAL_PROMPT" "0")
   (let-values (((process stdout stdin stderr)
                 (apply subprocess
@@ -107,7 +105,8 @@
           (if (= open-ports 0)
               (begin
                 (subprocess-wait process)
-                (reverse result))
+                (values (subprocess-status process)
+                        (reverse result)))
               (let* ((output (channel-get output-channel))
                      (line (cadr output)))
                 (if (eof-object? line)
@@ -146,7 +145,7 @@
                                          (format "~a" e)))
                                  (format "~a" e)))
                       (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)))
             )
        (err-git msg)