Merge git://factorcode.org/git/factor

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
 

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 ;
 
 

extra/io/unix/launcher/launcher-tests.factor

@@ -0,0 +1,19 @@
+IN: temporary
+USING: io.unix.launcher tools.test ;
+
+[ { } ] [ "" tokenize-command ] unit-test
+[ { } ] [ "   " tokenize-command ] unit-test
+[ { "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

extra/io/unix/launcher/launcher.factor

@@ -2,17 +2,46 @@
 ! 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: 'chars' 'escaped-char' any-char-parser <|> <*> ;
+
+LAZY: 'quoted-1' 'chars' "\"" "\"" surrounded-by ;
+
+LAZY: 'quoted-2' 'chars' "'" "'" surrounded-by ;
+
+LAZY: 'non-space-char'
+    'escaped-char' [ CHAR: \s = not ] satisfy <|> ;
+
+LAZY: 'unquoted' 'non-space-char' <+> ;
+
+LAZY: 'argument'
+    'quoted-1' 'quoted-2' 'unquoted' <|> <|>
+    [ >string ] <@ ;
+
+MEMO: 'arguments' ( -- parser )
+    'argument' " " token <+> list-of ;
+
+: tokenize-command ( command -- arguments )
+    'arguments' parse-1 ;
+
+: get-arguments ( -- seq )
+    +command+ get [ tokenize-command ] [ +arguments+ get ] if* ;
+
+: assoc>env ( assoc -- env )
+    [ "=" swap 3append ] { } assoc>map ;
 
 : (spawn-process) ( -- )
     [

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 [

extra/io/windows/windows.factor

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

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" } } ;

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 )
@@ -251,4 +257,7 @@ LAZY: list-of ( items separator -- parser )
   #! items themselves, return a parser that parses
   #! lists of those items. The parse tree is an
   #! array of the parsed items.
-  over &> <*> <&:> { } succeed <|> ; 
+  dup <?> -rot over &> <*> <&:> &> { } succeed <|> ;
+
+LAZY: surrounded-by ( parser start end -- parser' )
+    [ token ] 2apply swapd pack ;

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 ;

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

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> ] <@ ;
 

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
 
 [

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

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