Merge branch 'master' of git://factorcode.org/git/factor

diff --git a/basis/editors/macvim/authors.txt b/basis/editors/macvim/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/basis/editors/macvim/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/basis/editors/macvim/macvim.factor b/basis/editors/macvim/macvim.factor
new file mode 100755 (executable)
index 0000000..b5f864d
--- /dev/null
+++ b/basis/editors/macvim/macvim.factor
@@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.macvim
+
+: macvim-location ( file line -- )
+    drop
+    [ "open" , "-a" , "MacVim", , ] { } make
+    try-process ;
+
+[ macvim-location ] edit-hook set-global
+
+

diff --git a/basis/editors/macvim/summary.txt b/basis/editors/macvim/summary.txt
new file mode 100644 (file)
index 0000000..894d635
--- /dev/null
+++ b/basis/editors/macvim/summary.txt
@@ -0,0 +1 @@
+MacVim editor integration

diff --git a/basis/editors/macvim/tags.txt b/basis/editors/macvim/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/editors/macvim/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/editors/textedit/authors.txt b/basis/editors/textedit/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/basis/editors/textedit/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/basis/editors/textedit/summary.txt b/basis/editors/textedit/summary.txt
new file mode 100644 (file)
index 0000000..1d72d10
--- /dev/null
+++ b/basis/editors/textedit/summary.txt
@@ -0,0 +1 @@
+TextEdit editor integration

diff --git a/basis/editors/textedit/tags.txt b/basis/editors/textedit/tags.txt
new file mode 100644 (file)
index 0000000..6bf6830
--- /dev/null
+++ b/basis/editors/textedit/tags.txt
@@ -0,0 +1 @@
+unportable

diff --git a/basis/editors/textedit/textedit.factor b/basis/editors/textedit/textedit.factor
new file mode 100755 (executable)
index 0000000..6942e24
--- /dev/null
+++ b/basis/editors/textedit/textedit.factor
@@ -0,0 +1,13 @@
+USING: definitions io.launcher kernel math math.parser parser
+namespaces prettyprint editors make ;
+
+IN: editors.textedit
+
+: textedit-location ( file line -- )
+    drop
+    [ "open" , "-a" , "TextEdit", , ] { } make
+    try-process ;
+
+[ textedit-location ] edit-hook set-global
+
+

diff --git a/extra/printf/authors.txt b/extra/printf/authors.txt
new file mode 100644 (file)
index 0000000..e091bb8
--- /dev/null
+++ b/extra/printf/authors.txt
@@ -0,0 +1 @@
+John Benediktsson

diff --git a/extra/printf/printf-tests.factor b/extra/printf/printf-tests.factor
new file mode 100644 (file)
index 0000000..b2a4957
--- /dev/null
+++ b/extra/printf/printf-tests.factor
@@ -0,0 +1,79 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: kernel printf tools.test ;
+
+[ t ] [ "10" [ "%d" { 10 } sprintf ] call = ] unit-test
+
+[ t ] [ "123.456" [ "%f" { 123.456 } sprintf ] call = ] unit-test
+
+[ t ] [ "123.10" [ "%01.2f" { 123.1 } sprintf ] call = ] unit-test
+
+[ t ] [ "1.2345" [ "%.4f" { 1.23456789 } sprintf ] call = ] unit-test
+
+[ t ] [ "  1.23" [ "%6.2f" { 1.23456789 } sprintf ] call = ] unit-test
+
+[ t ] [ "3.625e+8" [ "%.3e" { 362525200 } sprintf ] call = ] unit-test
+
+[ t ] [ "2008-09-10" 
+      [ "%04d-%02d-%02d" { 2008 9 10 } sprintf ] call = ] unit-test
+
+[ t ] [ "Hello, World!" 
+      [ "%s" { "Hello, World!" } sprintf ] call = ] unit-test
+
+[ t ] [ "printf test" 
+      [ "printf test" { } sprintf ] call = ] unit-test
+
+[ t ] [ "char a = 'a'"
+      [ "char %c = 'a'" { CHAR: a } sprintf ] call = ] unit-test
+
+[ t ] [ "00" [ "%02x" { HEX: 0 } sprintf ] call = ] unit-test
+
+[ t ] [ "ff" [ "%02x" { HEX: ff } sprintf ] call = ] unit-test
+
+[ t ] [ "signed -3 = unsigned 4294967293 = hex fffffffd"
+      [ "signed %d = unsigned %u = hex %x" { -3 -3 -3 } sprintf ] call = ] unit-test
+
+[ t ] [ "0 message(s)"
+      [ "%d %s(s)%" { 0 "message" } sprintf ] call = ] unit-test
+
+[ t ] [ "0 message(s) with %"
+      [ "%d %s(s) with %%" { 0 "message" } sprintf ] call = ] unit-test
+
+[ t ] [ "justif: \"left      \""
+      [ "justif: \"%-10s\"" { "left" } sprintf ] call = ] unit-test
+
+[ t ] [ "justif: \"     right\""
+      [ "justif: \"%10s\"" { "right" } sprintf ] call = ] unit-test
+
+[ t ] [ " 3: 0003 zero padded" 
+      [ " 3: %04d zero padded" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " 3: 3    left justif" 
+      [ " 3: %-4d left justif" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " 3:    3 right justif" 
+      [ " 3: %4d right justif" { 3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3: -003 zero padded"
+      [ " -3: %04d zero padded" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3: -3   left justif"
+      [ " -3: %-4d left justif" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ " -3:   -3 right justif"
+      [ " -3: %4d right justif" { -3 } sprintf ] call = ] unit-test
+
+[ t ] [ "There are 10 monkeys in the kitchen" 
+      [ "There are %d monkeys in the %s" { 10 "kitchen" } sprintf ] call = ] unit-test
+
+[ f ] [ "%d" [ "%d" 10 sprintf ] call = ] unit-test
+
+[ t ] [ "[monkey]" [ "[%s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[    monkey]" [ "[%10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[monkey    ]" [ "[%-10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[0000monkey]" [ "[%010s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[####monkey]" [ "[%'#10s]" { "monkey" } sprintf ] call = ] unit-test
+[ t ] [ "[many monke]" [ "[%10.10s]" { "many monkeys" } sprintf ] call = ] unit-test
+
+

diff --git a/extra/printf/printf.factor b/extra/printf/printf.factor
new file mode 100644 (file)
index 0000000..8638afc
--- /dev/null
+++ b/extra/printf/printf.factor
@@ -0,0 +1,135 @@
+! Copyright (C) 2008 John Benediktsson
+! See http://factorcode.org/license.txt for BSD license
+
+USING: ascii io io.encodings.ascii io.files present kernel strings 
+math math.parser unicode.case sequences combinators 
+accessors namespaces prettyprint vectors ;
+
+IN: printf 
+
+! FIXME: Handle invalid formats properly.
+! FIXME: Handle incomplete formats properly.
+! FIXME: Deal only with CHAR rather than converting to { CHAR } ?
+! FIXME: Understand intermediate allocations that are happening...
+
+TUPLE: state type pad align width decimals neg loop ;
+
+SYMBOL: current
+
+SYMBOL: args
+
+<PRIVATE
+
+: start-% ( -- )
+    state new 
+      CHAR: s >>type
+      CHAR: \s >>pad
+      CHAR: r >>align
+      0 >>width
+      -1 >>decimals
+      f >>neg
+      CHAR: % >>loop
+    current set ;
+
+: stop-% ( -- ) 
+    current off ;
+
+: render ( s -- s )  
+    >vector
+
+    current get decimals>> 0 >= current get type>> CHAR: f = and
+      [ CHAR: . swap dup rot swap index current get decimals>> + 1 + dup rot swap
+        CHAR: 0 pad-right swap 0 swap rot <slice> ] when
+
+    current get align>> CHAR: l = 
+
+        [ current get neg>> [ { CHAR: - } prepend ] when 
+          current get width>> CHAR: \s pad-right ]
+
+        [ current get pad>> CHAR: \s = 
+            [ current get neg>> [ { CHAR: - } prepend ] when 
+              current get width>> current get pad>> pad-left ] 
+            [ current get width>> current get neg>> [ 1 - ] when
+              current get pad>> pad-left
+              current get neg>> [ { CHAR: - } prepend ] when ] if
+        ] if 
+
+    current get decimals>> 0 >= current get type>> CHAR: f = not and
+      [ current get align>> CHAR: l =
+          [ current get decimals>> CHAR: \s pad-right ]
+          [ current get decimals>> current get pad>> pad-left ] if
+        current get decimals>> head-slice ] when
+    >string ;
+
+: loop-% ( c -- s ) 
+    current get swap
+    {
+      { CHAR: % [ drop stop-% "%" ] }
+      { CHAR: ' [ CHAR: ' >>loop drop "" ] }
+      { CHAR: . [ CHAR: . >>loop 0 >>decimals drop "" ] }
+      { CHAR: - [ CHAR: l >>align drop "" ] }
+      { CHAR: 0 [ dup width>> 0 = [ CHAR: 0 >>pad ] when 
+                  [ 10 * 0 + ] change-width drop "" ] } 
+      { CHAR: 1 [ [ 10 * 1 + ] change-width drop "" ] } 
+      { CHAR: 2 [ [ 10 * 2 + ] change-width drop "" ] } 
+      { CHAR: 3 [ [ 10 * 3 + ] change-width drop "" ] } 
+      { CHAR: 4 [ [ 10 * 4 + ] change-width drop "" ] } 
+      { CHAR: 5 [ [ 10 * 5 + ] change-width drop "" ] } 
+      { CHAR: 6 [ [ 10 * 6 + ] change-width drop "" ] } 
+      { CHAR: 7 [ [ 10 * 7 + ] change-width drop "" ] } 
+      { CHAR: 8 [ [ 10 * 8 + ] change-width drop "" ] } 
+      { CHAR: 9 [ [ 10 * 9 + ] change-width drop "" ] } 
+      { CHAR: d [ CHAR: d >>type drop
+                  args get pop >fixnum 
+                  dup 0 < [ current get t >>neg drop ] when 
+                  abs present render stop-% ] }
+      { CHAR: f [ CHAR: f >>type drop
+                  args get pop >float 
+                  dup 0 < [ current get t >>neg drop ] when 
+                  abs present render stop-% ] }
+      { CHAR: s [ CHAR: s >>type drop 
+                  args get pop present render stop-% ] }
+      { CHAR: c [ CHAR: c >>type 1 >>width drop 
+                  1 args get pop <string> stop-% ] }
+      { CHAR: x [ CHAR: x >>type drop 
+                  args get pop >hex present render stop-% ] }
+      { CHAR: X [ CHAR: X >>type drop 
+                  args get pop >hex present >upper render stop-% ] }
+      [ drop drop stop-% "" ]
+    } case ;
+
+: loop-. ( c -- s )
+    dup digit? current get swap
+      [ swap CHAR: 0 - swap [ 10 * + ] change-decimals drop "" ] 
+      [ CHAR: % >>loop drop loop-% ] if ;
+
+: loop-' ( c -- s ) 
+    current get swap >>pad CHAR: % >>loop drop "" ;
+
+: loop- ( c -- s )
+    dup CHAR: % = [ drop start-% "" ] [ 1 swap <string> ] if ;
+
+: loop ( c -- s ) 
+   current get 
+     [ current get loop>> 
+       { 
+         { CHAR: % [ loop-% ] }
+         { CHAR: ' [ loop-' ] }
+         { CHAR: . [ loop-. ] }
+         [ drop stop-% loop- ]              ! FIXME: RAISE ERROR
+       } case ] 
+     [ loop- ] if ;
+
+PRIVATE>
+
+: sprintf ( fmt args -- str ) 
+    [ >vector reverse args set
+      V{ } swap [ loop append ] each >string ] with-scope ;
+
+: printf ( fmt args -- ) 
+    sprintf print ;
+
+: fprintf ( path fmt args -- ) 
+    rot ascii [ sprintf write flush ] with-file-appender ;
+
+