Merge git://spitspat.com/git/factor

2007-11-25 05:37:14 +01:00 · 2007-11-25 05:37:14 +01:00 · 306c437327
parent 86070337fd aa25860b5b
commit 306c437327
54 changed files with 654 additions and 365 deletions
--- a/6
+++ b/6
@ -62,6 +62,7 @@ default:
 	@echo "solaris-x86-64"
 	@echo "windows-ce-arm"
 	@echo "windows-nt-x86-32"
+	@echo "windows-nt-x86-64"
 	@echo ""
 	@echo "Additional modifiers:"
 	@echo ""
@ -113,6 +114,9 @@ solaris-x86-64:
 windows-nt-x86-32:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.32

+windows-nt-x86-64:
+	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.nt.x86.64
+
 windows-ce-arm:
 	$(MAKE) $(EXECUTABLE) CONFIG=vm/Config.windows.ce.arm

@ -138,7 +142,7 @@ clean:
 	rm -f vm/*.o

 vm/resources.o:
-	windres vm/factor.rs vm/resources.o
+	$(WINDRES) vm/factor.rs vm/resources.o

 .c.o:
 	$(CC) -c $(CFLAGS) -o $@ $<
--- a/core/io/files/files.factor
+++ b/core/io/files/files.factor
@ -97,7 +97,9 @@ TUPLE: no-parent-directory path ;
        ] }
    } cond drop ;

-: copy-file ( from to -- )
+HOOK: copy-file io-backend ( from to -- )
+
+M: object copy-file
    dup parent-directory make-directories
    <file-writer> [
        stdio get swap
--- a/extra/cocoa/cocoa.factor
+++ b/extra/cocoa/cocoa.factor
@ -58,8 +58,9 @@ SYMBOL: super-sent-messages
    "NSSavePanel"
    "NSView"
    "NSWindow"
+    "NSWorkspace"
 } [
-    f import-objc-class
+    [ ] import-objc-class
 ] each

 : <NSString> ( str -- alien ) <CFString> -> autorelease ;
--- a/extra/cocoa/messages/messages.factor
+++ b/extra/cocoa/messages/messages.factor
@ -4,7 +4,7 @@ USING: alien alien.c-types alien.compiler
 arrays assocs combinators compiler inference.transforms kernel
 math namespaces parser prettyprint prettyprint.sections
 quotations sequences strings words cocoa.runtime io macros
-memoize ;
+memoize debugger ;
 IN: cocoa.messages

 : make-sender ( method function -- quot )
@ -201,8 +201,11 @@ H{
 : import-objc-class ( name quot -- )
    2dup unless-defined
    dupd define-objc-class-word
-    dup objc-class register-objc-methods
-    objc-meta-class register-objc-methods ;
+    [
+        dup
+        objc-class register-objc-methods
+        objc-meta-class register-objc-methods
+    ] curry try ;

 : root-class ( class -- root )
    dup objc-class-super-class [ root-class ] [ ] ?if ;
--- a/extra/editors/editpadpro/summary.txt
+++ b/extra/editors/editpadpro/summary.txt
@ -0,0 +1 @@
+EditPadPro editor integration
--- a/extra/editors/emacs/summary.txt
+++ b/extra/editors/emacs/summary.txt
@ -0,0 +1 @@
+Emacs editor integration
--- a/extra/editors/gvim/summary.txt
+++ b/extra/editors/gvim/summary.txt
@ -0,0 +1 @@
+gVim editor integration
--- a/extra/editors/notepadpp/authors.txt
+++ b/extra/editors/notepadpp/authors.txt
@ -0,0 +1 @@
+Doug Coleman
--- a/extra/editors/notepadpp/notepadpp.factor
+++ b/extra/editors/notepadpp/notepadpp.factor
@ -0,0 +1,13 @@
+USING: editors io.launcher math.parser namespaces ;
+IN: notepadpp
+
+: notepadpp ( file line -- )
+    [
+        \ notepadpp get-global % " -n" % # " " % %
+    ] "" make run-detached ;
+
+! Put in your .factor-boot-rc
+! "c:\\Program Files\\notepad++\\notepad++.exe" \ notepadpp set-global
+! "k:\\Program Files (x86)\\notepad++\\notepad++.exe" \ notepadpp set-global
+
+[ notepadpp ] edit-hook set-global
--- a/extra/editors/notepadpp/summary.txt
+++ b/extra/editors/notepadpp/summary.txt
@ -0,0 +1 @@
+Notepad++ editor integration
--- a/extra/editors/scite/summary.txt
+++ b/extra/editors/scite/summary.txt
@ -0,0 +1 @@
+SciTE editor integration
--- a/extra/editors/textmate/summary.txt
+++ b/extra/editors/textmate/summary.txt
@ -0,0 +1 @@
+Textmate editor integration
--- a/extra/editors/vim/summary.txt
+++ b/extra/editors/vim/summary.txt
@ -0,0 +1 @@
+Vim editor integration
--- a/extra/fjsc/fjsc-tests.factor
+++ b/extra/fjsc/fjsc-tests.factor
@ -4,31 +4,31 @@ USING: kernel tools.test parser-combinators lazy-lists fjsc ;
 IN: temporary

 { T{ ast-expression f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
-  "55 2abc1 100" 'expression' parse car parse-result-parsed
+  "55 2abc1 100" 'expression' parse-1
 ] unit-test

 { T{ ast-quotation f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
-  "[ 55 2abc1 100 ]" 'quotation' parse car parse-result-parsed
+  "[ 55 2abc1 100 ]" 'quotation' parse-1
 ] unit-test

 { T{ ast-array f { T{ ast-number f 55 } T{ ast-identifier f "2abc1" } T{ ast-number f 100 } } } } [
-  "{ 55 2abc1 100 }" 'array' parse car parse-result-parsed
+  "{ 55 2abc1 100 }" 'array' parse-1
 ] unit-test

 { T{ ast-stack-effect f { } { "d" "e" "f" } } } [
-  "( -- d e f )" 'stack-effect' parse car parse-result-parsed 
+  "( -- d e f )" 'stack-effect' parse-1
 ] unit-test

 { T{ ast-stack-effect f { "a" "b" "c" } { "d" "e" "f" } } } [
-  "( a b c -- d e f )" 'stack-effect' parse car parse-result-parsed 
+  "( a b c -- d e f )" 'stack-effect' parse-1
 ] unit-test

 { T{ ast-stack-effect f { "a" "b" "c" } { } } } [
-  "( a b c -- )" 'stack-effect' parse car parse-result-parsed 
+  "( a b c -- )" 'stack-effect' parse-1
 ] unit-test

 { T{ ast-stack-effect f { } { } } } [
-  "( -- )" 'stack-effect' parse car parse-result-parsed 
+  "( -- )" 'stack-effect' parse-1
 ] unit-test

 { } [
@ -37,18 +37,18 @@ IN: temporary


 { T{ ast-expression f { T{ ast-string f "abcd" } } } } [
-  "\"abcd\"" 'statement' parse car parse-result-parsed 
+  "\"abcd\"" 'statement' parse-1
 ] unit-test

 { T{ ast-expression f { T{ ast-use f "foo" } } } } [
-  "USE: foo" 'statement' parse car parse-result-parsed
+  "USE: foo" 'statement' parse-1
 ] unit-test

 { T{ ast-expression f { T{ ast-in f "foo" } } } } [
-  "IN: foo" 'statement' parse car parse-result-parsed
+  "IN: foo" 'statement' parse-1
 ] unit-test

 { T{ ast-expression f { T{ ast-using f { "foo" "bar" }  } } } } [
-  "USING: foo bar ;" 'statement' parse car parse-result-parsed
+  "USING: foo bar ;" 'statement' parse-1
 ] unit-test

--- a/extra/fjsc/fjsc.factor
+++ b/extra/fjsc/fjsc.factor
@ -328,7 +328,7 @@ M: wrapper (parse-factor-quotation) ( object -- ast )
 GENERIC: fjsc-parse ( object -- ast )

 M: string fjsc-parse ( object -- ast )
-  'expression' parse car parse-result-parsed ;
+  'expression' parse-1 ;

 M: quotation fjsc-parse ( object -- ast )
  [
@ -345,11 +345,11 @@ M: quotation fjsc-parse ( object -- ast )
  ] string-out ;

 : fjsc-compile* ( string -- string )
-  'statement' parse car parse-result-parsed fjsc-compile ;
+  'statement' parse-1 fjsc-compile ;

 : fc* ( string -- string )
  [
-  'statement' parse car parse-result-parsed ast-expression-values do-expressions 
+  'statement' parse-1 ast-expression-values do-expressions
  ] { } make [ write ] each ;


--- a/extra/io/unix/launcher/launcher-tests.factor
+++ b/extra/io/unix/launcher/launcher-tests.factor
@ -0,0 +1,33 @@
+IN: temporary
+USING: io.unix.launcher tools.test ;
+
+[ "" tokenize-command ] unit-test-fails
+[ "   " tokenize-command ] unit-test-fails
+[ { "a" } ] [ "a" tokenize-command ] unit-test
+[ { "abc" } ] [ "abc" tokenize-command ] unit-test
+[ { "abc" } ] [ "abc   " tokenize-command ] unit-test
+[ { "abc" } ] [ "   abc" tokenize-command ] unit-test
+[ { "abc" "def" } ] [ "abc def" tokenize-command ] unit-test
+[ { "abc def" } ] [ "abc\\ def" tokenize-command ] unit-test
+[ { "abc\\" "def" } ] [ "abc\\\\ def" tokenize-command ] unit-test
+[ { "abc\\ def" } ] [ "'abc\\\\ def'" tokenize-command ] unit-test
+[ { "abc\\ def" } ] [ "  'abc\\\\ def'" tokenize-command ] unit-test
+[ { "abc\\ def" "hey" } ] [ "'abc\\\\ def' hey" tokenize-command ] unit-test
+[ { "abc def" "hey" } ] [ "'abc def' \"hey\"" tokenize-command ] unit-test
+[ "'abc def' \"hey" tokenize-command ] unit-test-fails
+[ "'abc def" tokenize-command ] unit-test-fails
+[ { "abc def" "h\"ey" } ] [ "'abc def' \"h\\\"ey\"  " tokenize-command ] unit-test
+
+[
+    {
+        "Hello world.app/Contents/MacOS/hello-ui"
+        "-i=boot.macosx-ppc.image"
+        "-include= math compiler ui"
+        "-deploy-vocab=hello-ui"
+        "-output-image=Hello world.app/Contents/Resources/hello-ui.image"
+        "-no-stack-traces"
+        "-no-user-init"
+    }
+] [
+    "\"Hello world.app/Contents/MacOS/hello-ui\" -i=boot.macosx-ppc.image \"-include= math compiler ui\" -deploy-vocab=hello-ui \"-output-image=Hello world.app/Contents/Resources/hello-ui.image\" -no-stack-traces -no-user-init" tokenize-command
+] unit-test
--- a/extra/io/unix/launcher/launcher.factor
+++ b/extra/io/unix/launcher/launcher.factor
@ -2,17 +2,45 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.launcher io.unix.backend io.nonblocking
 sequences kernel namespaces math system alien.c-types
-debugger continuations arrays assocs combinators unix.process ;
+debugger continuations arrays assocs combinators unix.process
+parser-combinators memoize promises strings ;
 IN: io.unix.launcher

 ! Search unix first
 USE: unix

-: get-arguments ( -- seq )
-    +command+ get
-    [ "/bin/sh" "-c" rot 3array ] [ +arguments+ get ] if* ;
+! Our command line parser. Supported syntax:
+! foo bar baz -- simple tokens
+! foo\ bar -- escaping the space
+! 'foo bar' -- quotation
+! "foo bar" -- quotation
+LAZY: 'escaped-char' "\\" token any-char-parser &> ;

-: assoc>env ( assoc -- env ) [ "=" swap 3append ] { } assoc>map ;
+LAZY: 'quoted-char' ( delimiter -- parser' )
+    'escaped-char'
+    swap [ member? not ] curry satisfy
+    <|> ; inline
+
+LAZY: 'quoted' ( delimiter -- parser )
+    dup 'quoted-char' <!*> swap dup surrounded-by ;
+
+LAZY: 'unquoted' ( -- parser ) " '\"" 'quoted-char' <!+> ;
+
+LAZY: 'argument' ( -- parser )
+    "\"" 'quoted' "'" 'quoted' 'unquoted' <|> <|>
+    [ >string ] <@ ;
+
+MEMO: 'arguments' ( -- parser )
+    'argument' " " token <!+> nonempty-list-of ;
+
+: tokenize-command ( command -- arguments )
+    'arguments' just parse-1 ;
+
+: get-arguments ( -- seq )
+    +command+ get [ tokenize-command ] [ +arguments+ get ] if* ;
+
+: assoc>env ( assoc -- env )
+    [ "=" swap 3append ] { } assoc>map ;

 : (spawn-process) ( -- )
    [
--- a/extra/io/unix/mmap/mmap.factor
+++ b/extra/io/unix/mmap/mmap.factor
@ -13,7 +13,7 @@ IN: io.unix.mmap
 M: unix-io <mapped-file> ( path length -- obj )
    swap >r
    dup PROT_READ PROT_WRITE bitor MAP_FILE MAP_SHARED bitor
-    r> mmap-open \ mapped-file construct-boa ;
+    r> mmap-open f mapped-file construct-boa ;

 M: unix-io (close-mapped-file) ( mmap -- )
    [ mapped-file-address ] keep
--- a/extra/io/windows/launcher/launcher.factor
+++ b/extra/io/windows/launcher/launcher.factor
@ -53,8 +53,11 @@ TUPLE: CreateProcess-args
        CreateProcess-args-lpProcessInformation
    } get-slots CreateProcess win32-error=0/f ;

+: escape-argument ( str -- newstr )
+    [ [ dup CHAR: " = [ CHAR: \\ , ] when , ] each ] "" make ;
+
 : join-arguments ( args -- cmd-line )
-    [ "\"" swap "\"" 3append ] map " " join ;
+    [ "\"" swap escape-argument "\"" 3append ] map " " join ;

 : app-name/cmd-line ( -- app-name cmd-line )
    +command+ get [
--- a/extra/io/windows/windows.factor
+++ b/extra/io/windows/windows.factor
@ -111,12 +111,14 @@ M: windows-io <file-appender> ( path -- stream )
    open-append <win32-file> <writer> ;

 M: windows-io rename-file ( from to -- )
-    [ normalize-pathname ] 2apply
-    MoveFile win32-error=0/f ;
+    [ normalize-pathname ] 2apply MoveFile win32-error=0/f ;

 M: windows-io delete-file ( path -- )
-    normalize-pathname
-    DeleteFile win32-error=0/f ;
+    normalize-pathname DeleteFile win32-error=0/f ;
+
+M: windows-io copy-file ( from to -- )
+    dup parent-directory make-directories
+    [ normalize-pathname ] 2apply 0 CopyFile win32-error=0/f ;

 M: windows-io make-directory ( path -- )
    normalize-pathname
--- a/extra/lint/lint.factor
+++ b/extra/lint/lint.factor
@ -13,7 +13,7 @@ SYMBOL: def-hash-keys
    2dup at -rot >r >r ?push r> r> set-at ;

 : add-word-def ( word quot -- )
-    dup quotation? [
+    dup callable? [
        def-hash get-global set-hash-vector
    ] [
        2drop
@ -33,6 +33,7 @@ SYMBOL: def-hash-keys
        { [ drop drop drop ] 3drop }
        { [ 0 = ] zero? }
        { [ pop drop ] pop* }
+        { [ [ ] if ] when }
    } [ first2 swap add-word-def ] each ;

 : accessor-words ( -- seq )
@ -108,13 +109,13 @@ M: object lint ( obj -- seq )
 : subseq/member? ( subseq/member seq -- ? )
    { [ 2dup start ] [ 2dup member? ] } || 2nip ;

-M: quotation lint ( quot -- seq )
+M: callable lint ( quot -- seq )
    def-hash-keys get [
        swap subseq/member?
    ] curry* subset ;

 M: word lint ( word -- seq )
-    word-def dup quotation? [ lint ] [ drop f ] if ;
+    word-def dup callable? [ lint ] [ drop f ] if ;

 : word-path. ( word -- )
    [ word-vocabulary ":" ] keep unparse 3append write nl ;
--- a/extra/pack/pack.factor
+++ b/extra/pack/pack.factor
@ -24,7 +24,7 @@ M: integer b, ( m n -- ) >endian % ;

 ! for doing native, platform-dependent sized values
 M: string b, ( n string -- ) heap-size b, ;
-: read-native ( string -- ) heap-size read endian> ;
+: read-native ( string -- n ) heap-size read endian> ;

 ! Portable
 : s8, ( n -- ) 1 b, ;
--- a/extra/parser-combinators/parser-combinators-docs.factor
+++ b/extra/parser-combinators/parser-combinators-docs.factor
@ -11,6 +11,15 @@ HELP: list-of
    "'items' is a parser that can parse the individual elements. 'separator' "
    "is a parser for the symbol that separatest them. The result tree of "
    "the resulting parser is an array of the parsed elements." }
-{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse car parse-result-parsed ." "{ 1 2 3 4 }" }
+{ $example "USE: parser-combinators" "\"1,2,3,4\" 'integer' \",\" token list-of parse-1 ." "{ 1 2 3 4 }" }
 { $see-also list-of } ;

+HELP: any-char-parser
+{ $values
+  { "parser" "a parser object" } }
+{ $description
+    "Return a parser that consumes a single value "
+    "from the input string. The value consumed is the "
+    "result of the parse." }
+{ $examples
+{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" any-char-parser parse-1 ." "102" } } ;
--- a/extra/parser-combinators/parser-combinators.factor
+++ b/extra/parser-combinators/parser-combinators.factor
@ -15,6 +15,9 @@ M: promise (parse) ( input parser -- list )

 TUPLE: parse-result parsed unparsed ;

+: parse-1 ( input parser -- result )
+  parse car parse-result-parsed ;
+
 C: <parse-result> parse-result

 TUPLE: token-parser string ;
@ -46,6 +49,9 @@ M: satisfy-parser (parse) ( input parser -- list )
    ] if
  ] if ;

+LAZY: any-char-parser ( -- parser )
+  [ drop t ] satisfy ;
+
 TUPLE: epsilon-parser ;

 C: epsilon epsilon-parser ( -- parser )
@ -165,7 +171,7 @@ M: some-parser (parse) ( input parser -- result )
  #! the parse is complete (the remaining input is empty),
  #! picks the first solution and only returns the parse
  #! tree since the remaining input is empty.
-  some-parser-p1 just parse car parse-result-parsed ;
+  some-parser-p1 just parse-1 ;


 : <& ( parser1 parser2 -- parser )
@ -240,15 +246,21 @@ LAZY: <(+)> ( parser -- parser )
    #! Implementation by Matthew Willis.
    dup <(*)> <&:> ;

-LAZY: pack ( close body open -- parser )
+: pack ( close body open -- parser )
  #! Parse a construct enclosed by two symbols,
  #! given a parser for the opening symbol, the
  #! closing symbol, and the body.
  <& &> ;

-LAZY: list-of ( items separator -- parser )
+: nonempty-list-of ( items separator -- parser )
+  [ over &> <*> <&:> ] keep <?> tuck pack ;
+
+: list-of ( items separator -- parser )
  #! Given a parser for the separator and for the
  #! items themselves, return a parser that parses
  #! lists of those items. The parse tree is an
  #! array of the parsed items.
-  over &> <*> <&:> { } succeed <|> ; 
+  nonempty-list-of { } succeed <|> ;
+
+LAZY: surrounded-by ( parser start end -- parser' )
+  [ token ] 2apply swapd pack ;
--- a/extra/parser-combinators/replace/replace.factor
+++ b/extra/parser-combinators/replace/replace.factor
@ -13,21 +13,21 @@ IN: parser-combinators
  } cond ;

 : search ( string parser -- seq )
-  'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
+  any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
    drop { }
  ] [
    car parse-result-parsed [ ] subset 
  ] if ;

 : search* ( string parsers -- seq )
-  unclip [ <|> ] reduce 'any-char' [ drop f ] <@ <|> <*> parse dup nil? [
+  unclip [ <|> ] reduce any-char-parser [ drop f ] <@ <|> <*> parse dup nil? [
    drop { }
  ] [
    car parse-result-parsed [ ] subset 
  ] if ;

 : (replace) ( string parser -- seq )
-  'any-char' <|> <*> parse car parse-result-parsed ;
+  any-char-parser <|> <*> parse-1 ;

 : replace ( string parser -- result )
 [  (replace) [ tree-write ] each ] string-out ;
--- a/extra/parser-combinators/simple/simple-docs.factor
+++ b/extra/parser-combinators/simple/simple-docs.factor
@ -3,17 +3,6 @@
 USING: help.syntax help.markup parser-combinators
 parser-combinators.simple ;

-HELP: 'any-char'
-{ $values 
-  { "parser" "a parser object" } }
-{ $description 
-    "Return a parser that consumes a single value "
-    "from the input string. The value consumed is the "  
-    "result of the parse." }
-{ $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"foo\" 'any-char' parse car parse-result-parsed ." "102" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
-
 HELP: 'digit'
 { $values 
  { "parser" "a parser object" } }
@ -22,8 +11,7 @@ HELP: 'digit'
    "the input string. The numeric value of the digit "
    " consumed is the result of the parse." }
 { $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse car parse-result-parsed ." "1" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
+{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'digit' parse-1 ." "1" } } ;

 HELP: 'integer'
 { $values 
@ -33,9 +21,7 @@ HELP: 'integer'
    "the input string. The numeric value of the integer "
    " consumed is the result of the parse." }
 { $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse car parse-result-parsed ." "123" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
-
+{ $example "USING: lazy-lists parser-combinators ;" "\"123\" 'integer' parse-1 ." "123" } } ;
 HELP: 'string'
 { $values 
  { "parser" "a parser object" } }
@ -44,9 +30,7 @@ HELP: 'string'
    "quotations from the input string. The string value "
    " consumed is the result of the parse." }
 { $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse car parse-result-parsed ." "\"foo\"" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
-
+{ $example "USING: lazy-lists parser-combinators ;" "\"\\\"foo\\\"\" 'string' parse-1 ." "\"foo\"" } } ;
 HELP: 'bold'
 { $values 
  { "parser" "a parser object" } }
@ -55,10 +39,8 @@ HELP: 'bold'
    "the '*' character from the input string. This is "
    "commonly used in markup languages to indicate bold "
    "faced text." }
-{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse car parse-result-parsed ." "\"foo\"" }
-{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse car parse-result-parsed ." "\"<strong>foo</strong>\"" }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
-
+{ $example "USE: parser-combinators" "\"*foo*\" 'bold' parse-1 ." "\"foo\"" }
+{ $example "USE: parser-combinators" "\"*foo*\" 'bold' [ \"<strong>\" swap \"</strong>\" 3append ] <@ parse-1 ." "\"<strong>foo</strong>\"" } ;
 HELP: 'italic'
 { $values 
  { "parser" "a parser object" } }
@ -68,10 +50,8 @@ HELP: 'italic'
    "commonly used in markup languages to indicate italic "
    "faced text." }
 { $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse car parse-result-parsed ." "\"foo\"" }
-{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse car parse-result-parsed ." "\"<emphasis>foo</emphasis>\"" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
-
+{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' parse-1 ." "\"foo\"" }
+{ $example "USING: lazy-lists parser-combinators ;" "\"_foo_\" 'italic' [ \"<emphasis>\" swap \"</emphasis>\" 3append ] <@ parse-1 ." "\"<emphasis>foo</emphasis>\"" } } ;
 HELP: comma-list
 { $values 
  { "element" "a parser object" } { "parser" "a parser object" } }
@ -80,5 +60,6 @@ HELP: comma-list
    "'element' should be a parser that can parse the elements. The "
    "result of the parser is a sequence of the parsed elements." }
 { $examples
-{ $example "USING: lazy-lists parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse car parse-result-parsed ." "{ 1 2 3 4 }" } }
-{ $see-also 'any-char' 'digit' 'integer' 'string' 'bold' 'italic' comma-list } ;
+{ $example "USING: lazy-lits parser-combinators ;" "\"1,2,3,4\" 'integer' comma-list parse-1 ." "{ 1 2 3 4 }" } } ;
+
+{ $see-also 'digit' 'integer' 'string' 'bold' 'italic' comma-list } related-words
--- a/extra/parser-combinators/simple/simple.factor
+++ b/extra/parser-combinators/simple/simple.factor
@ -4,9 +4,6 @@ USING: kernel strings math sequences lazy-lists words
 math.parser promises ;
 IN: parser-combinators 

-LAZY: 'any-char' ( -- parser )
-  [ drop t ] satisfy ;
-
 : 'digit' ( -- parser )
  [ digit? ] satisfy [ digit> ] <@ ;

--- a/extra/tools/deploy/deploy.factor
+++ b/extra/tools/deploy/deploy.factor
@ -26,12 +26,8 @@ IN: tools.deploy
    [ (copy-lines) ] [ stream-close ] [ ] cleanup ;

 : stage2 ( vm flags -- )
-	[
-        "\"" % swap % "\" -i=" %
-        boot-image-name %
-        [ " " % % ] each
-    ] "" make
-    dup print <process-stream>
+    >r "-i=" boot-image-name append 2array r> append dup .
+    <process-stream>
    dup duplex-stream-out stream-close
    copy-lines ;

@ -48,11 +44,11 @@ IN: tools.deploy

 : deploy-command-line ( vm image vocab config -- vm flags )
    [
-        "\"-include=" swap profile-string "\"" 3append ,
+        "-include=" swap profile-string append ,

        "-deploy-vocab=" swap append ,

-        "\"-output-image=" swap "\"" 3append ,
+        "-output-image=" swap append ,

        "-no-stack-traces" ,
        
--- a/extra/tools/deploy/macosx/macosx.factor
+++ b/extra/tools/deploy/macosx/macosx.factor
@ -1,18 +1,17 @@
 ! Copyright (C) 2007 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: io io.files io.launcher kernel namespaces sequences
-system cocoa.plists cocoa.application tools.deploy
-tools.deploy.config assocs hashtables prettyprint ;
+system tools.deploy tools.deploy.config assocs hashtables
+prettyprint io.unix.backend cocoa cocoa.plists
+cocoa.application cocoa.classes qualified ;
+QUALIFIED: unix
 IN: tools.deploy.macosx

 : touch ( path -- )
-    "touch \"" swap "\"" 3append run-process ;
+    { "touch" } swap add run-process ;

 : rm ( path -- )
-    "rm -rf \"" swap "\"" 3append run-process ;
-
-: chmod ( path perms -- )
-    [ "chmod " % % " \"" % % "\"" % ] "" make run-process ;
+    { "rm" "-rf" } swap add run-process ;

 : bundle-dir ( -- dir )
    vm parent-directory parent-directory ;
@ -21,10 +20,13 @@ IN: tools.deploy.macosx
    bundle-dir over path+ -rot
    >r "Contents" path+ r> path+ copy-directory ;

+: chmod ( path perms -- )
+    unix:chmod io-error ;
+
 : copy-vm ( executable bundle-name -- vm )
    "Contents/MacOS/" path+ swap path+ vm swap
    [ copy-file ] keep
-    [ "755" chmod ] keep ;
+    [ OCT: 755 chmod ] keep ;

 : copy-fonts ( name -- )
    "fonts/" resource-path
@ -63,6 +65,12 @@ TUPLE: macosx-deploy-implementation ;

 T{ macosx-deploy-implementation } deploy-implementation set-global

+: show-in-finder ( path -- )
+    NSWorkspace
+    -> sharedWorkspace
+    over <NSString> rot parent-directory <NSString>
+    -> selectFile:inFileViewerRootedAtPath: drop ;
+
 M: macosx-deploy-implementation deploy ( vocab -- )
    ".app deploy tool" assert.app
    "." resource-path cd
@ -70,5 +78,6 @@ M: macosx-deploy-implementation deploy ( vocab -- )
        bundle-name rm
        [ bundle-name create-app-dir ] keep
        [ bundle-name deploy.app-image ] keep
-        namespace
-    ] bind deploy* ;
+        namespace deploy*
+        bundle-name show-in-finder
+    ] bind ;
--- a/extra/ui/cocoa/cocoa.factor
+++ b/extra/ui/cocoa/cocoa.factor
@ -19,7 +19,7 @@ SYMBOL: stop-after-last-window?
 : event-loop ( -- )
    event-loop? [
        [
-            [ NSApp do-events ui-step ] ui-try
+            [ NSApp do-events ui-step 10 sleep ] ui-try
        ] with-autorelease-pool event-loop
    ] when ;

@ -60,11 +60,19 @@ M: cocoa-ui-backend set-title ( string world -- )
        drop
    ] if ;

-M: cocoa-ui-backend (open-world-window) ( world -- )
+M: cocoa-ui-backend (open-window) ( world -- )
    dup gadget-window
    dup auto-position
    world-handle second f -> makeKeyAndOrderFront: ;

+M: cocoa-ui-backend (close-window) ( handle -- )
+    first unregister-window ;
+
+M: cocoa-ui-backend close-window ( gadget -- )
+    find-world [
+        world-handle second f -> performClose:
+    ] when* ;
+
 M: cocoa-ui-backend raise-window ( world -- )
    world-handle [
        second dup f -> orderFront: -> makeKeyWindow
--- a/extra/ui/cocoa/views/views.factor
+++ b/extra/ui/cocoa/views/views.factor
@ -3,7 +3,8 @@
 USING: alien arrays assocs cocoa kernel math cocoa.messages
 cocoa.subclassing cocoa.classes cocoa.views cocoa.application
 cocoa.pasteboard cocoa.types cocoa.windows sequences ui
-ui.gadgets ui.gadgets.worlds ui.gestures core-foundation ;
+ui.gadgets ui.gadgets.worlds ui.gestures core-foundation
+threads ;
 IN: ui.cocoa.views

 : send-mouse-moved ( view event -- )
@ -313,8 +314,6 @@ CLASS: {
 { "dealloc" "void" { "id" "SEL" }
    [
        drop
-        dup window stop-world
-        dup unregister-window
        dup remove-observer
        SUPER-> dealloc
    ]
@ -347,6 +346,12 @@ CLASS: {
        forget-rollover
        2nip -> object -> contentView window unfocus-world
    ]
+}
+
+{ "windowShouldClose:" "bool" { "id" "SEL" "id" }
+    [
+        2nip -> contentView window ungraft t
+    ]
 } ;

 : install-window-delegate ( window -- )
--- a/extra/ui/tools/deploy/deploy.factor
+++ b/extra/ui/tools/deploy/deploy.factor
@ -77,7 +77,8 @@ TUPLE: deploy-gadget vocab settings ;

 : com-deploy ( gadget -- )
    dup com-save
-    find-deploy-vocab [ deploy ] curry call-listener ;
+    dup find-deploy-vocab [ deploy ] curry call-listener
+    close-window ;

 : com-help ( -- )
    "ui-deploy" help-window ;
@ -86,7 +87,11 @@ TUPLE: deploy-gadget vocab settings ;
    { +nullary+ t }
 } define-command

+: com-close ( gadget -- )
+    close-window ;
+
 deploy-gadget "toolbar" f {
+    { f com-close }
    { f com-help }
    { f com-revert }
    { f com-save }
--- a/extra/ui/tools/tools.factor
+++ b/extra/ui/tools/tools.factor
@ -67,11 +67,11 @@ M: workspace model-changed
 : com-profiler profiler-gadget select-tool ;

 workspace "tool-switching" f {
-    { T{ key-down f f "F2" } com-listener }
-    { T{ key-down f f "F3" } com-browser }
-    { T{ key-down f f "F4" } com-inspector }
-    { T{ key-down f f "F5" } com-walker }
-    { T{ key-down f f "F6" } com-profiler }
+    { T{ key-down f { C+ } "1" } com-listener }
+    { T{ key-down f { C+ } "2" } com-browser }
+    { T{ key-down f { C+ } "3" } com-inspector }
+    { T{ key-down f { C+ } "4" } com-walker }
+    { T{ key-down f { C+ } "5" } com-profiler }
 } define-command-map

 \ workspace-window
@ -86,8 +86,8 @@ H{ { +nullary+ t } { +listener+ t } } define-command
 workspace "workflow" f {
    { T{ key-down f { C+ } "n" } workspace-window }
    { T{ key-down f f "ESC" } hide-popup }
-    { T{ key-down f f "F8" } refresh-all }
-    { T{ key-down f { A+ } "F8" } test-changes }
+    { T{ key-down f f "F2" } refresh-all }
+    { T{ key-down f { A+ } "F2" } test-changes }
 } define-command-map

 [
--- a/extra/ui/tools/workspace/workspace.factor
+++ b/extra/ui/tools/workspace/workspace.factor
@ -2,11 +2,10 @@
 ! See http://factorcode.org/license.txt for BSD license.
 USING: classes continuations help help.topics kernel models
 sequences ui ui.backend ui.tools.debugger ui.gadgets
-ui.gadgets.books ui.gadgets.buttons
-ui.gadgets.labelled ui.gadgets.panes ui.gadgets.scrollers
-ui.gadgets.tracks ui.gadgets.worlds ui.gadgets.presentations
-ui.gadgets.status-bar ui.commands ui.gestures assocs arrays
-namespaces ;
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
+ui.gadgets.panes ui.gadgets.scrollers ui.gadgets.tracks
+ui.gadgets.worlds ui.gadgets.presentations ui.gadgets.status-bar
+ui.commands ui.gestures assocs arrays namespaces ;
 IN: ui.tools.workspace

 TUPLE: workspace book listener popup ;
--- a/extra/ui/ui.factor
+++ b/extra/ui/ui.factor
@ -65,16 +65,6 @@ M: world ungraft*
    dup world-handle (close-window)
    reset-world ;

-: open-world-window ( world -- )
-    dup pref-dim over set-gadget-dim dup relayout graft ;
-
-: open-window ( gadget title -- )
-    >r [ 1 track, ] { 0 1 } make-track r>
-    f <world> open-world-window ;
-
-: close-window ( gadget -- )
-    find-world [ ungraft ] when* ;
-
 : find-window ( quot -- world )
    windows get values
    [ gadget-child swap call ] curry* find-last nip ; inline
@ -146,9 +136,20 @@ SYMBOL: ui-hook
        notify-queued
        layout-queued
        redraw-worlds
-        10 sleep
    ] assert-depth ;

+: open-world-window ( world -- )
+    dup pref-dim over set-gadget-dim dup relayout graft ui-step ;
+
+: open-window ( gadget title -- )
+    >r [ 1 track, ] { 0 1 } make-track r>
+    f <world> open-world-window ;
+
+HOOK: close-window ui-backend ( gadget -- )
+
+M: object close-window
+    find-world [ ungraft ] when* ;
+
 : start-ui ( -- )
    init-timers
    restore-windows? [
--- a/extra/ui/windows/windows.factor
+++ b/extra/ui/windows/windows.factor
@ -94,8 +94,7 @@ SYMBOL: mouse-captured
    3drop window draw-world ;

 : handle-wm-size ( hWnd uMsg wParam lParam -- )
-    [ lo-word ] keep hi-word make-RECT get-RECT-dimensions 2array
-    2nip
+    [ lo-word ] keep hi-word make-RECT get-RECT-dimensions 2array 2nip
    dup { 0 0 } = [ 2drop ] [ swap window set-gadget-dim ui-step ] if ;

 : wm-keydown-codes ( -- key )
@ -348,7 +347,10 @@ M: windows-ui-backend (close-window)
 : event-loop ( msg -- )
    {
        { [ windows get empty? ] [ drop ] }
-        { [ dup peek-message? ] [ >r [ ui-step ] ui-try r> event-loop ] }
+        { [ dup peek-message? ] [
+            >r [ ui-step 10 sleep ] ui-try
+            r> event-loop
+        ] }
        { [ dup MSG-message WM_QUIT = ] [ drop ] }
        { [ t ] [
            dup TranslateMessage drop
@ -381,7 +383,7 @@ M: windows-ui-backend (close-window)
    >r class-name-ptr get-global f r>
    >r >r >r ex-style r> r>
        WS_CLIPSIBLINGS WS_CLIPCHILDREN bitor style bitor
-        0 0 r>
+        CW_USEDEFAULT dup r>
    get-RECT-dimensions
    f f f GetModuleHandle f CreateWindowEx dup win32-error=0/f ;

--- a/extra/ui/x11/x11.factor
+++ b/extra/ui/x11/x11.factor
@ -158,18 +158,14 @@ M: world selection-request-event
        { [ t ] [ drop send-notify-failure ] }
    } cond ;

-: close-window ( handle -- )
+M: x11-ui-backend (close-window) ( handle -- )
    dup x11-handle-xic XDestroyIC
    dup x11-handle-glx destroy-glx
    x11-handle-window dup unregister-window
    destroy-window ;

 M: world client-event
-    swap close-box? [
-        dup world-handle >r stop-world r> close-window
-    ] [
-        drop
-    ] if ;
+    swap close-box? [ ungraft ] [ drop ] if ;

 : gadget-window ( world -- )
    dup world-loc over rect-dim glx-window
@ -182,7 +178,7 @@ M: world client-event
        next-event dup
        None XFilterEvent zero? [ drop wait-event ] unless
    ] [
-        ui-step wait-event
+        ui-step 10 sleep wait-event
    ] if ;

 : do-events ( -- )
@ -222,7 +218,7 @@ M: x11-ui-backend set-title ( string world -- )
    world-handle x11-handle-window swap dpy get -rot
    3dup set-title-old set-title-new ;

-M: x11-ui-backend (open-world-window) ( world -- )
+M: x11-ui-backend (open-window) ( world -- )
    dup gadget-window
    world-handle x11-handle-window dup set-closable map-window ;

--- a/extra/webapps/fjsc/fjsc.factor
+++ b/extra/webapps/fjsc/fjsc.factor
@ -11,7 +11,7 @@ IN: webapps.fjsc
  #! Compile the factor code as a string, outputting the http
  #! response containing the javascript.
  serving-text
-  'expression' parse car parse-result-parsed fjsc-compile 
+  'expression' parse-1 fjsc-compile
  write flush ;

 ! The 'compile' action results in an URL that looks like
--- a/extra/webapps/planet/planet.factor
+++ b/extra/webapps/planet/planet.factor
@ -18,7 +18,7 @@ TUPLE: posting author title date link body ;
    #! entries is an array of { author entries } pairs.
    dup [
        [ fetch-feed ] [ error. drop f ] recover
-    ] parallel-map [ ] subset
+    ] parallel-map
    [ [ >r first r> 2array ] curry* map ] 2map concat ;

 : sort-entries ( entries -- entries' )
@ -108,6 +108,7 @@ SYMBOL: cached-postings
    { "Kio M. Smallwood"
    "http://sekenre.wordpress.com/feed/atom/"
    "http://sekenre.wordpress.com/" }
+    { "Phil Dawes" "http://www.phildawes.net/blog/category/factor/feed/atom" "http://www.phildawes.net/blog/" }
    { "Samuel Tardieu" "http://www.rfc1149.net/blog/tag/factor/feed/atom/" "http://www.rfc1149.net/blog/tag/factor/" }
    { "Slava Pestov" "http://factor-language.blogspot.com/atom.xml" "http://factor-language.blogspot.com/" }
 } default-blogroll set-global
--- a/extra/windows/kernel32/kernel32.factor
+++ b/extra/windows/kernel32/kernel32.factor
@ -566,7 +566,8 @@ FUNCTION: BOOL ConnectNamedPipe ( HANDLE hNamedPipe, LPOVERLAPPED lpOverlapped )
 ! FUNCTION: CopyFileA
 ! FUNCTION: CopyFileExA
 ! FUNCTION: CopyFileExW
-! FUNCTION: CopyFileW
+FUNCTION: BOOL CopyFileW ( LPCTSTR lpExistingFileName, LPCTSTR lpNewFileName, BOOL bFailIfExists ) ;
+: CopyFile CopyFileW ; inline
 ! FUNCTION: CopyLZFile
 ! FUNCTION: CreateActCtxA
 ! FUNCTION: CreateActCtxW
@ -575,7 +576,7 @@ FUNCTION: BOOL ConnectNamedPipe ( HANDLE hNamedPipe, LPOVERLAPPED lpOverlapped )
 ! FUNCTION: CreateDirectoryExA
 ! FUNCTION: CreateDirectoryExW
 FUNCTION: BOOL CreateDirectoryW ( LPCTSTR lpPathName, LPSECURITY_ATTRIBUTES lpSecurityAttribytes ) ;
-: CreateDirectory CreateDirectoryW ;
+: CreateDirectory CreateDirectoryW ; inline

 ! FUNCTION: CreateEventA
 ! FUNCTION: CreateEventW
--- a/misc/factor.sh
+++ b/misc/factor.sh
@ -0,0 +1,251 @@
+#!/bin/bash -e
+
+# Programs returning != 0 will not cause script to exit
+set +e
+
+# Case insensitive string comparison
+shopt -s nocaseglob
+#shopt -s nocasematch
+
+OS=
+ARCH=
+WORD=
+NO_UI=
+
+ensure_program_installed() {
+	echo -n "Checking for $1..."
+	result=`type -p $1`
+	if ! [[ -n $result ]] ; then
+		echo "not found!"
+		echo "Install $1 and try again."
+		exit 1
+	fi
+	echo "found!"
+}
+
+check_ret() {
+	RET=$?
+	if [[ $RET -ne 0 ]] ; then
+	   echo $1 failed
+	   exit 2
+	fi
+}
+
+check_gcc_version() {
+	GCC_VERSION=`gcc --version`
+	if [[ $GCC_VERSION == *3.3.* ]] ; then
+		echo "You have a known buggy version of gcc (3.3)"
+		echo "Install gcc 3.4 or higher and try again."
+		exit 3
+	fi
+}
+
+check_installed_programs() {
+	ensure_program_installed chmod
+	ensure_program_installed uname
+	ensure_program_installed git
+	ensure_program_installed wget
+	ensure_program_installed gcc
+	ensure_program_installed make
+	check_gcc_version
+}
+
+check_library_exists() {
+	GCC_TEST=factor-library-test.c
+	GCC_OUT=factor-library-test.out
+	echo "Checking for library $1"
+	echo "int main(){return 0;}" > $GCC_TEST
+	gcc $GCC_TEST -o $GCC_OUT -l $1
+	if [[ $? -ne 0 ]] ; then
+		echo "Warning: library $1 not found."
+		echo "***Factor will compile NO_UI=1"
+		NO_UI=1
+	fi
+	rm -f $GCC_TEST
+	rm -f $GCC_OUT
+}
+
+check_X11_libraries() {
+	check_library_exists freetype
+	check_library_exists GLU
+	check_library_exists GL
+	check_library_exists X11
+}
+
+check_libraries() {
+	case $OS in
+		linux) check_X11_libraries;;
+	esac
+}
+
+check_factor_exists() {
+	if [[ -d "factor" ]] ; then
+		echo "A directory called 'factor' already exists."
+		echo "Rename or delete it and try again."
+		exit 4
+	fi
+}
+
+find_os() {
+	uname_s=`uname -s`
+	case $uname_s in
+		CYGWIN_NT-5.2-WOW64) OS=windows-nt;;
+		*CYGWIN_NT*) OS=windows-nt;;
+		*CYGWIN*) OS=windows-nt;;
+		*darwin*) OS=macosx;;
+		*Darwin*) OS=macosx;;
+		*linux*) OS=linux;;
+		*Linux*) OS=linux;;
+	esac
+}
+
+find_architecture() {
+	uname_m=`uname -m`
+	case $uname_m in
+	   i386) ARCH=x86;;
+	   i686) ARCH=x86;;
+	   *86) ARCH=x86;;
+	   "Power Macintosh") ARCH=ppc;;
+	esac
+}
+
+write_test_program() {
+	echo "#include <stdio.h>" > $C_WORD.c
+	echo "int main(){printf(\"%d\", 8*sizeof(void*)); return 0; }" >> $C_WORD.c
+}
+
+find_word_size() {
+	C_WORD=factor-word-size
+	write_test_program
+	gcc -o $C_WORD $C_WORD.c
+	WORD=$(./$C_WORD)
+	check_ret $C_WORD
+	rm -f $C_WORD*
+}
+
+set_factor_binary() {
+	case $OS in
+		windows-nt) FACTOR_BINARY=factor-nt;;
+		macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;;
+		*) FACTOR_BINARY=factor;;
+	esac
+}
+
+echo_build_info() {
+	echo OS=$OS
+	echo ARCH=$ARCH
+	echo WORD=$WORD
+	echo FACTOR_BINARY=$FACTOR_BINARY
+	echo MAKE_TARGET=$MAKE_TARGET
+	echo BOOT_IMAGE=$BOOT_IMAGE
+}
+
+set_build_info() {
+	if ! [[ -n $OS && -n $ARCH && -n $WORD ]] ; then
+		echo "OS, ARCH, or WORD is empty.  Please report this"
+		exit 5
+	fi
+	
+	MAKE_TARGET=$OS-$ARCH-$WORD
+	BOOT_IMAGE=boot.$ARCH.$WORD.image
+	if [[ $OS == macosx && $ARCH == ppc ]] ; then
+		MAKE_TARGET=$OS-$ARCH
+		BOOT_IMAGE=boot.macosx-ppc.image
+	fi
+}
+
+find_build_info() {
+	find_os
+	find_architecture
+	find_word_size
+	set_factor_binary
+	set_build_info
+	echo_build_info
+}
+
+git_clone() {
+	echo "Downloading the git repository from factorcode.org..."
+	git clone git://factorcode.org/git/factor.git
+	check_ret git
+}
+
+git_pull_factorcode() {
+	git pull git://factorcode.org/git/factor.git
+	check_ret git
+}
+
+cd_factor() {
+	cd factor
+	check_ret cd
+}
+
+make_clean() {
+	make clean
+	check_ret make
+}
+
+make_factor() {
+	make NO_UI=$NO_UI $MAKE_TARGET -j5
+	check_ret make
+}
+
+delete_boot_images() {
+	echo "Deleting old images..."
+	rm $BOOT_IMAGE > /dev/null 2>&1
+	rm $BOOT_IMAGE.* > /dev/null 2>&1
+}
+
+get_boot_image() {
+	wget http://factorcode.org/images/latest/$BOOT_IMAGE
+	check_ret wget
+}
+
+maybe_download_dlls() {
+	if [[ $OS == windows-nt ]] ; then
+		wget http://factorcode.org/dlls/freetype6.dll
+		check_ret
+		wget http://factorcode.org/dlls/zlib1.dll
+		check_ret
+		chmod 777 *.dll
+		check_ret
+	fi
+}
+
+bootstrap() {
+	./$FACTOR_BINARY -i=$BOOT_IMAGE
+}
+
+usage() {
+	echo "usage: $0 install|update"
+}
+
+install() {
+	check_factor_exists
+	check_installed_programs
+	find_build_info
+	check_libraries
+	git_clone
+	cd_factor
+	make_factor
+	get_boot_image
+	maybe_download_dlls
+	bootstrap
+}
+
+update() {
+	check_installed_programs
+	find_build_info
+	check_libraries
+	git_pull_factorcode
+	make_clean
+	make_factor
+	delete_boot_images
+	get_boot_image
+	bootstrap
+}
+
+case "$1" in
+	install) install ;;
+	update) update ;;
+	*) usage ;;
+esac
--- a/misc/install.sh
+++ b/misc/install.sh
@ -1,120 +0,0 @@
-#!/bin/bash -e
-
-# Programs returning != 0 will not cause script to exit
-set +e
-
-# Case insensitive string comparison
-shopt -s nocaseglob
-#shopt -s nocasematch
-
-ensure_program_installed() {
-        echo -n "Checking for $1..."
-        result=`type -p $1`
-        if ! [[ -n $result ]] ; then
-                echo "not found!"
-                echo "Install $1 and try again."
-                exit 1
-        fi
-        echo "found!"
-}
-
-check_ret() {
-        RET=$?
-        if [[ $RET -ne 0 ]] ; then
-                echo $1 failed
-                exit 5
-        fi
-}
-
-ensure_program_installed uname
-ensure_program_installed git
-ensure_program_installed wget
-ensure_program_installed gcc
-ensure_program_installed make
-
-GCC_VERSION=`gcc --version`
-if [[ $GCC_VERSION == *3.3.* ]] ; then
-        echo "You have a known buggy version of gcc (3.3)"
-        echo "Install gcc 3.4 or higher and try again."
-        exit 1
-fi
-
-# OS
-OS=
-uname_s=`uname -s`
-case $uname_s in
-        CYGWIN_NT-5.2-WOW64) OS=windows-nt;;
-        *CYGWIN_NT*) OS=windows-nt;;
-        *CYGWIN*) OS=windows-nt;;
-        *darwin*) OS=macosx;;
-        *Darwin*) OS=macosx;;
-        *linux*) OS=linux;;
-        *Linux*) OS=linux;;
-esac
-
-# Architecture
-ARCH=
-uname_m=`uname -m`
-case $uname_m in
-        i386) ARCH=x86;;
-        i686) ARCH=x86;;
-        *86) ARCH=x86;;
-        "Power Macintosh") ARCH=ppc;;
-esac
-
-WORD=
-C_WORD=factor-word-size
-# Word size
-echo "#include <stdio.h>" > $C_WORD.c
-echo "int main() { printf(\"%d\", 8*sizeof(long)); return 0; }" >> $C_WORD.c
-gcc -o $C_WORD $C_WORD.c
-WORD=$(./$C_WORD)
-check_ret $C_WORD
-rm -f $C_WORD*
-
-case $OS in
-        windows-nt) FACTOR_BINARY=factor-nt;;
-        macosx) FACTOR_BINARY=./Factor.app/Contents/MacOS/factor;;
-        *) FACTOR_BINARY=factor;;
-esac
-
-MAKE_TARGET=$OS-$ARCH-$WORD
-BOOT_IMAGE=boot.$ARCH.$WORD.image
-
-echo OS=$OS
-echo ARCH=$ARCH
-echo WORD=$WORD
-echo FACTOR_BINARY=$FACTOR_BINARY
-echo MAKE_TARGET=$MAKE_TARGET
-echo BOOT_IMAGE=$BOOT_IMAGE
-
-if ! [[ -n $OS && -n $ARCH && -n $WORD ]] ; then
-        echo "OS, ARCH, or WORD is empty.  Please report this"
-        exit 4
-fi
-
-echo "Downloading the git repository from factorcode.org..."
-git clone git://factorcode.org/git/factor.git
-check_ret git
-
-cd factor
-check_ret cd
-
-make $MAKE_TARGET
-check_ret make
-
-echo "Deleting old images..."
-rm $BOOT_IMAGE > /dev/null 2>&1
-rm $BOOT_IMAGE.* > /dev/null 2>&1
-wget http://factorcode.org/images/latest/$BOOT_IMAGE
-check_ret wget
-
-if [[ $OS == windows-nt ]] ; then
-	wget http://factorcode.org/dlls/freetype6.dll
-	check_ret
-	wget http://factorcode.org/dlls/zlib1.dll
-	check_ret
-fi
-
-
-./$FACTOR_BINARY -i=$BOOT_IMAGE
--- a/vm/Config.windows.nt
+++ b/vm/Config.windows.nt
@ -0,0 +1,8 @@
+LIBS = -lm
+EXE_SUFFIX=-nt
+DLL_SUFFIX=-nt
+PLAF_DLL_OBJS += vm/os-windows-nt.o
+PLAF_EXE_OBJS += vm/resources.o
+PLAF_EXE_OBJS += vm/main-windows-nt.o
+#CFLAGS += -mwindows
+include vm/Config.windows
--- a/vm/Config.windows.nt.x86.32
+++ b/vm/Config.windows.nt.x86.32
@ -1,7 +1,3 @@
-LIBS = -lm
-EXE_SUFFIX=-nt
-DLL_SUFFIX=-nt
-PLAF_DLL_OBJS += vm/os-windows-nt.o
-PLAF_EXE_OBJS += vm/resources.o
-PLAF_EXE_OBJS += vm/main-windows-nt.o
-include vm/Config.x86.32 vm/Config.windows
+WINDRES=windres
+include vm/Config.windows.nt
+include vm/Config.x86.32
--- a/vm/Config.windows.nt.x86.64
+++ b/vm/Config.windows.nt.x86.64
@ -0,0 +1,4 @@
+CC=/k/target/bin/x86_64-pc-mingw32-gcc
+include vm/Config.windows.nt
+include vm/Config.x86.64
+WINDRES = /k/target/bin/windres
--- a/vm/debug.c
+++ b/vm/debug.c
@ -213,6 +213,7 @@ void dump_objects(F_FIXNUM type)
 void factorbug(void)
 {
 	reset_stdio();
+	open_console();

 	printf("Starting low level debugger...\n");
 	printf("  Basic commands:\n");
--- a/vm/factor.c
+++ b/vm/factor.c
@ -26,6 +26,7 @@ void default_parameters(F_PARAMETERS *p)

 	p->secure_gc = false;
 	p->fep = false;
+	p->console = false;
 }

 /* Get things started */
@ -110,6 +111,8 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded
 			p.fep = true;
 		else if(STRNCMP(argv[i],STR_FORMAT("-i="),3) == 0)
 			p.image = argv[i] + 3;
+		else if(STRCMP(argv[i],STR_FORMAT("-console")) == 0)
+			p.console = true ;
 	}

 	init_factor(&p);
@ -135,6 +138,9 @@ void init_factor_from_args(F_CHAR *image, int argc, F_CHAR **argv, bool embedded

 	nest_stacks();

+	if(p.console)
+		open_console();
+
 	if(p.fep)
 		factorbug();

--- a/vm/image.h
+++ b/vm/image.h
@ -32,6 +32,7 @@ typedef struct {
 	CELL code_size;
 	bool secure_gc;
 	bool fep;
+	bool console;
 } F_PARAMETERS;

 void load_image(F_PARAMETERS *p);
--- a/vm/os-unix.c
+++ b/vm/os-unix.c
@ -256,3 +256,5 @@ void reset_stdio(void)
 	fcntl(0,F_SETFL,0);
 	fcntl(1,F_SETFL,0);
 }
+
+void open_console(void) { }
--- a/vm/os-unix.h
+++ b/vm/os-unix.h
@ -39,3 +39,4 @@ s64 current_millis(void);
 void sleep_millis(CELL msec);

 void reset_stdio(void);
+void open_console(void);
--- a/vm/os-windows-ce.c
+++ b/vm/os-windows-ce.c
@ -46,3 +46,5 @@ void c_to_factor_toplevel(CELL quot)
 {
 	c_to_factor(quot);
 }
+
+void open_console(void) { }
--- a/vm/os-windows-ce.h
+++ b/vm/os-windows-ce.h
@ -24,3 +24,4 @@ char *getenv(char *name);

 s64 current_millis(void);
 void c_to_factor_toplevel(CELL quot);
+void open_console(void);
--- a/vm/os-windows-nt.c
+++ b/vm/os-windows-nt.c
@ -88,3 +88,17 @@ void c_to_factor_toplevel(CELL quot)
 	c_to_factor(quot);
 	RemoveVectoredExceptionHandler((void*)exception_handler);
 }
+
+void open_console(void)
+{
+	/*
+	// Do this: http://www.cygwin.com/ml/cygwin/2007-11/msg00432.html
+	if(console_open)
+		return;
+
+	if(AttachConsole(ATTACH_PARENT_PROCESS) || AllocConsole())
+	{
+		console_open = true;
+	}
+	*/
+}
--- a/vm/os-windows-nt.h
+++ b/vm/os-windows-nt.h
@ -18,3 +18,5 @@ typedef char F_SYMBOL;

 void c_to_factor_toplevel(CELL quot);
 long exception_handler(PEXCEPTION_POINTERS pe);
+bool console_open;
+void open_console(void);