Commits

evhan committed 503d2e6

Fix remote-download for upstream changes and bind remote-fetch

Comments (0)

Files changed (5)

  refspec-string
  refspec?
  remote
- remote-connect
+ remote-connect!
  remote-connected?
- remote-disconnect
- ;remote-download
+ remote-disconnect!
+ remote-download!
+ remote-fetch!
  remote-name
  remote-pushurl
  remote-pushurl-set!
  remote-repository
  remote-stats
  remote-update-fetchhead-set!
- remote-update-tips
+ remote-update-tips!
  remote-url
  remote-url-set!
  remote-url-supported?

git-lolevel-exports.scm

  remote-create
  remote-disconnect
  remote-download
+ remote-fetch
  remote-free
  remote-get-refspec
  remote-is-valid-name
 
 (define remote-add-fetch            (foreign-lambda/retval git_remote_add_fetch remote nonnull-c-string))
 (define remote-add-push             (foreign-lambda/retval git_remote_add_push remote nonnull-c-string))
+(define remote-fetch                (foreign-lambda/retval git_remote_fetch remote))
 (define remote-list                 (foreign-lambda/allocate strarray git_remote_list repository))
 (define remote-get-push-refspecs    (foreign-lambda/allocate strarray git_remote_get_push_refspecs remote))
 (define remote-get-fetch-refspecs   (foreign-lambda/allocate strarray git_remote_get_fetch_refspecs remote))
   (map (lambda (name) (remote repo name))
        (git-remote-list (repository->pointer repo))))
 
-(define (remote-connect rem #!optional (direction 'fetch))
+(define (remote-connect! rem #!optional (direction 'fetch))
   (git-remote-connect (remote->pointer rem) direction))
 
 (define (remote-rename rem name #!optional callback)
   (git-remote-rename (remote->pointer rem) name callback))
 
 (define (remote-stats rem)
-  (pointer->transfer-progress
-   rem
-   (git-remote-stats (remote->pointer rem))))
-
-;(define remote-download
-;  (let ((make-remote-download-callback
-;         (lambda (rem fn)
-;           (and fn (lambda (tp*)
-;                     (fn (pointer->transfer-progress rem tp*)))))))
-;    (lambda (rem #!optional fn)
-;      (if (remote-connected? rem)
-;          (git-remote-download
-;           (remote->pointer rem)
-;           (make-remote-download-callback rem fn))
-;          (dynamic-wind
-;           (lambda ()
-;             (remote-connect rem))
-;           (lambda ()
-;             (remote-download rem (make-remote-download-callback rem fn))
-;             (remote-update-tips rem)
-;             (remote-stats rem))
-;           (lambda ()
-;             (remote-disconnect rem)))))))
+  (pointer->transfer-progress rem (git-remote-stats (remote->pointer rem))))
+
+(define (remote-download! rem)
+  (cond ((remote-connected? rem)
+         (git-remote-download (remote->pointer rem))
+         (remote-stats rem))
+        (else
+         (remote-connect! rem)
+         (remote-download! rem)
+         (remote-disconnect! rem)
+         (remote-stats rem))))
 
 (define (create-remote repo name url)
   (pointer->remote repo (git-remote-create (repository->pointer repo) name url)))
     (test-assert "remote-connect" (remote-connect r))
     (test-assert "remote-connected? (connected)" (remote-connected? r))
     (test-assert "remote-disconnect" (remote-disconnect r))
-    (test-assert "remote-connected? (disconnected)" (not (remote-connected? r)))))
+    (test-assert "remote-connected? (disconnected)" (not (remote-connected? r)))
+    (test-assert "remote-download!" (remote-download! r))))
 
 (set! remote (remote cloned-repo "origin"))