From 262e9632e624edd68a9a444d8effe7aef1658ccf Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 10 Nov 2008 19:17:41 -0600 Subject: [PATCH 1/2] Remove 'unmaintained/update' (moving back to 'extra') --- unmaintained/update/backup/backup.factor | 28 ----------- unmaintained/update/latest/latest.factor | 53 -------------------- unmaintained/update/update.factor | 64 ------------------------ 3 files changed, 145 deletions(-) delete mode 100644 unmaintained/update/backup/backup.factor delete mode 100644 unmaintained/update/latest/latest.factor delete mode 100644 unmaintained/update/update.factor diff --git a/unmaintained/update/backup/backup.factor b/unmaintained/update/backup/backup.factor deleted file mode 100644 index 0dcf853b98..0000000000 --- a/unmaintained/update/backup/backup.factor +++ /dev/null @@ -1,28 +0,0 @@ - -USING: namespaces debugger io.files bootstrap.image builder.util ; - -IN: update.backup - -: backup-boot-image ( -- ) - my-boot-image-name - { "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string - move-file ; - -: backup-image ( -- ) - "factor.image" - { "factor" "-" [ "datestamp" get ] ".image" } to-string - move-file ; - -: backup-vm ( -- ) - "factor" - { "factor" "-" [ "datestamp" get ] } to-string - move-file ; - -: backup ( -- ) - datestamp "datestamp" set - [ - backup-boot-image - backup-image - backup-vm - ] - try ; diff --git a/unmaintained/update/latest/latest.factor b/unmaintained/update/latest/latest.factor deleted file mode 100644 index df057422f9..0000000000 --- a/unmaintained/update/latest/latest.factor +++ /dev/null @@ -1,53 +0,0 @@ - -USING: kernel namespaces system io.files bootstrap.image http.client - builder.util update update.backup ; - -IN: update.latest - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: git-pull-master ( -- ) - image parent-directory - [ - { "git" "pull" "git://factorcode.org/git/factor.git" "master" } - run-command - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: remote-latest-image ( -- url ) - { "http://factorcode.org/images/latest/" my-boot-image-name } to-string ; - -: download-latest-image ( -- ) remote-latest-image download ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: rebuild-latest ( -- ) - image parent-directory - [ - backup - download-latest-image - make-clean - make - boot - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: update-latest ( -- ) - image parent-directory - [ - git-id - git-pull-master - git-id - = not - [ rebuild-latest ] - when - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MAIN: update-latest \ No newline at end of file diff --git a/unmaintained/update/update.factor b/unmaintained/update/update.factor deleted file mode 100644 index 1d25a9792e..0000000000 --- a/unmaintained/update/update.factor +++ /dev/null @@ -1,64 +0,0 @@ - -USING: kernel system sequences io.files io.launcher bootstrap.image - http.client - builder.util builder.release.branch ; - -IN: update - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: run-command ( cmd -- ) to-strings try-process ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: git-pull-clean ( -- ) - image parent-directory - [ - { "git" "pull" "git://factorcode.org/git/factor.git" branch-name } - run-command - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: remote-clean-image ( -- url ) - { "http://factorcode.org/images/clean/" platform "/" my-boot-image-name } - to-string ; - -: download-clean-image ( -- ) remote-clean-image download ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: make-clean ( -- ) { gnu-make "clean" } run-command ; -: make ( -- ) { gnu-make } run-command ; -: boot ( -- ) { "./factor" { "-i=" my-boot-image-name } } run-command ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: rebuild ( -- ) - image parent-directory - [ - download-clean-image - make-clean - make - boot - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: update ( -- ) - image parent-directory - [ - git-id - git-pull-clean - git-id - = not - [ rebuild ] - when - ] - with-directory ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -MAIN: update \ No newline at end of file From 7104cd4fe8e63f89495f5f25e3f748690c87f903 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 10 Nov 2008 19:20:08 -0600 Subject: [PATCH 2/2] Fix 'extra/update' --- extra/update/backup/backup.factor | 28 +++++++++++++ extra/update/latest/latest.factor | 53 +++++++++++++++++++++++++ extra/update/update.factor | 66 +++++++++++++++++++++++++++++++ extra/update/util/util.factor | 62 +++++++++++++++++++++++++++++ 4 files changed, 209 insertions(+) create mode 100644 extra/update/backup/backup.factor create mode 100644 extra/update/latest/latest.factor create mode 100644 extra/update/update.factor create mode 100644 extra/update/util/util.factor diff --git a/extra/update/backup/backup.factor b/extra/update/backup/backup.factor new file mode 100644 index 0000000000..0c7b442ffa --- /dev/null +++ b/extra/update/backup/backup.factor @@ -0,0 +1,28 @@ + +USING: namespaces debugger io.files bootstrap.image update.util ; + +IN: update.backup + +: backup-boot-image ( -- ) + my-boot-image-name + { "boot." my-arch "-" [ "datestamp" get ] ".image" } to-string + move-file ; + +: backup-image ( -- ) + "factor.image" + { "factor" "-" [ "datestamp" get ] ".image" } to-string + move-file ; + +: backup-vm ( -- ) + "factor" + { "factor" "-" [ "datestamp" get ] } to-string + move-file ; + +: backup ( -- ) + datestamp "datestamp" set + [ + backup-boot-image + backup-image + backup-vm + ] + try ; diff --git a/extra/update/latest/latest.factor b/extra/update/latest/latest.factor new file mode 100644 index 0000000000..7cc2fac853 --- /dev/null +++ b/extra/update/latest/latest.factor @@ -0,0 +1,53 @@ + +USING: kernel namespaces system io.files bootstrap.image http.client + update update.backup update.util ; + +IN: update.latest + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: git-pull-master ( -- ) + image parent-directory + [ + { "git" "pull" "git://factorcode.org/git/factor.git" "master" } + run-command + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: remote-latest-image ( -- url ) + { "http://factorcode.org/images/latest/" my-boot-image-name } to-string ; + +: download-latest-image ( -- ) remote-latest-image download ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rebuild-latest ( -- ) + image parent-directory + [ + backup + download-latest-image + make-clean + make + boot + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: update-latest ( -- ) + image parent-directory + [ + git-id + git-pull-master + git-id + = not + [ rebuild-latest ] + when + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: update-latest \ No newline at end of file diff --git a/extra/update/update.factor b/extra/update/update.factor new file mode 100644 index 0000000000..c6a5671345 --- /dev/null +++ b/extra/update/update.factor @@ -0,0 +1,66 @@ + +USING: kernel system sequences io.files io.launcher bootstrap.image + http.client + update.util ; + + ! builder.util builder.release.branch ; + +IN: update + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: run-command ( cmd -- ) to-strings try-process ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: git-pull-clean ( -- ) + image parent-directory + [ + { "git" "pull" "git://factorcode.org/git/factor.git" branch-name } + run-command + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: remote-clean-image ( -- url ) + { "http://factorcode.org/images/clean/" platform "/" my-boot-image-name } + to-string ; + +: download-clean-image ( -- ) remote-clean-image download ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: make-clean ( -- ) { gnu-make "clean" } run-command ; +: make ( -- ) { gnu-make } run-command ; +: boot ( -- ) { "./factor" { "-i=" my-boot-image-name } } run-command ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: rebuild ( -- ) + image parent-directory + [ + download-clean-image + make-clean + make + boot + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: update ( -- ) + image parent-directory + [ + git-id + git-pull-clean + git-id + = not + [ rebuild ] + when + ] + with-directory ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: update \ No newline at end of file diff --git a/extra/update/util/util.factor b/extra/update/util/util.factor new file mode 100644 index 0000000000..b638b61528 --- /dev/null +++ b/extra/update/util/util.factor @@ -0,0 +1,62 @@ + +USING: kernel classes strings quotations words math math.parser arrays + combinators.cleave + accessors + system prettyprint splitting + sequences combinators sequences.deep + io + io.launcher + io.encodings.utf8 + calendar + calendar.format ; + +IN: update.util + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +DEFER: to-strings + +: to-string ( obj -- str ) + dup class + { + { \ string [ ] } + { \ quotation [ call ] } + { \ word [ execute ] } + { \ fixnum [ number>string ] } + { \ array [ to-strings concat ] } + } + case ; + +: to-strings ( seq -- str ) + dup [ string? ] all? + [ ] + [ [ to-string ] map flatten ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: cpu- ( -- cpu ) cpu unparse "." split "-" join ; + +: platform ( -- string ) { [ os unparse ] cpu- } to-strings "-" join ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: branch-name ( -- string ) "clean-" platform append ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: gnu-make ( -- string ) + os { freebsd openbsd netbsd } member? [ "gmake" ] [ "make" ] if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: git-id ( -- id ) + { "git" "show" } utf8 [ readln ] with-input-stream + " " split second ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: datestamp ( -- string ) + now + { year>> month>> day>> hour>> minute>> } + [ pad-00 ] map "-" join ;