]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/mason/git/git.factor
core: subseq-index? -> subseq-of?
[factor.git] / extra / mason / git / git.factor
index 71a71b6ccbf4fe3595262981f65bda5c9970eada..9cccf438c74b6e2b9d6a590af8a92c6a35fbc63b 100644 (file)
@@ -1,15 +1,14 @@
 ! Copyright (C) 2010 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors combinators.short-circuit continuations
-debugger io io.directories io.directories.hierarchy
+USING: accessors continuations debugger io io.directories
 io.encodings.utf8 io.files io.launcher io.sockets
 io.streams.string kernel mason.common mason.email sequences
 splitting ;
 IN: mason.git
 
 : git-id ( -- id )
-    { "git" "show" } utf8 [ lines ] with-process-reader
-    first " " split second ;
+    { "git" "show" } utf8 [ read-lines ] with-process-reader
+    first split-words second ;
 
 <PRIVATE
 
@@ -17,11 +16,11 @@ IN: mason.git
     {
         "git"
         "clone"
-        "git://factorcode.org/git/factor.git"
+        "https://github.com/factor/factor.git"
     } ;
 
 : git-clone ( -- )
-    #! Must be run from builds-dir
+    ! Must be run from builds-dir
     "Cloning initial repository" print-timestamp
     git-clone-cmd try-output-process ;
 
@@ -29,7 +28,7 @@ IN: mason.git
     {
         "git"
         "pull"
-        "git://factorcode.org/git/factor.git"
+        "https://github.com/factor/factor.git"
         "master"
     } ;
 
@@ -48,30 +47,17 @@ IN: mason.git
 
 : git-pull-failed ( error -- )
     dup output-process-error? [
-        dup output>> "not uptodate. Cannot merge." swap subseq?
+        dup output>> "not uptodate. Cannot merge." subseq-of?
         [ git-repo-corrupted ]
         [ rethrow ]
         if
     ] [ rethrow ] if ;
 
-: with-process-reader* ( desc encoding quot -- )
-    [ <process-reader*> ] dip swap [ with-input-stream ] dip
-    dup wait-for-process dup { 0 1 } member?
-    [ 2drop ] [ process-failed ] if ; inline
-
 : git-status-cmd ( -- cmd )
-    { "git" "status" } ;
-
-: git-status-failed ( error -- )
-    #! Exit code 1 means there's nothing to commit.
-    dup { [ process-failed? ] [ code>> 1 = ] } 1&&
-    [ drop ] [ rethrow ] if ;
+    { "git" "status" "--porcelain" } ;
 
 : git-status ( -- seq )
-    [
-        git-status-cmd utf8 [ lines ] with-process-reader*
-        [ "#\t" head? ] filter
-    ] [ git-status-failed { } ] recover ;
+    git-status-cmd utf8 [ read-lines ] with-process-reader ;
 
 : check-repository ( -- seq )
     "factor" [ git-status ] with-directory ;
@@ -90,9 +76,9 @@ IN: mason.git
 
 PRIVATE>
 
-: git-pull ( -- id )
-    #! Must be run from builds-dir.
-    "factor" exists? [
+: git-clone-or-pull ( -- id )
+    ! Must be run from builds-dir.
+    "factor" file-exists? [
         check-repository [
             "factor" [
                 [ git-pull-cmd short-running-process ]