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

extra/builder/test/test.factor

@@ -3,6 +3,7 @@ USING: kernel namespaces assocs
        io.files io.encodings.utf8 prettyprint 
        help.lint
        benchmark
+       tools.time
        bootstrap.stage2
        tools.test tools.vocabs
        builder.util ;
@@ -26,8 +27,8 @@ IN: builder.test
 
 : do-all ( -- )
   bootstrap-time get   "../boot-time" utf8 [ . ] with-file-writer
-  [ do-load  ] runtime "../load-time" utf8 [ . ] with-file-writer
-  [ do-tests ] runtime "../test-time" utf8 [ . ] with-file-writer
+  [ do-load  ] benchmark "../load-time" utf8 [ . ] with-file-writer
+  [ do-tests ] benchmark "../test-time" utf8 [ . ] with-file-writer
   do-help-lint
   do-benchmarks ;
 

extra/builder/util/util.factor

@@ -12,8 +12,6 @@ IN: builder.util
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: runtime ( quot -- time ) benchmark nip ;
-
 : minutes>ms ( min -- ms ) 60 * 1000 * ;
 
 : file>string ( file -- string ) utf8 file-contents ;

extra/io/launcher/launcher.factor

@@ -221,3 +221,9 @@ M: duplex-stream underlying-handle
     [ in>> underlying-handle ]
     [ out>> underlying-handle ] bi
     [ = [ "Invalid duplex stream" throw ] when ] keep ;
+
+M: encoder underlying-handle
+    stream>> underlying-handle ;
+
+M: decoder underlying-handle
+    stream>> underlying-handle ;

extra/io/unix/files/files.factor

@@ -45,9 +45,10 @@ M: unix (file-appender) ( path -- stream )
 
 M: unix touch-file ( path -- )
     normalize-path
-    touch-mode file-mode open
-    dup 0 < [ err_no EEXIST = [ err_no io-error ] unless ] when
-    close ;
+    dup exists?
+        [ f utime ]
+        [ touch-mode file-mode open close ]
+    if ;
 
 M: unix move-file ( from to -- )
     [ normalize-path ] bi@ rename io-error ;

extra/tools/time/time-docs.factor

@@ -14,7 +14,8 @@ ARTICLE: "timing" "Timing code"
 ABOUT: "timing"
 
 HELP: benchmark
-{ $values { "quot" "a quotation" } { "gctime" "an integer denoting milliseconds" } { "runtime" "an integer denoting milliseconds" } }
+{ $values { "quot" "a quotation" }
+          { "runtime" "an integer denoting milliseconds" } }
 { $description "Runs a quotation, measuring the total wall clock time and the total time spent in the garbage collector." }
 { $notes "A nicer word for interactive use is " { $link time } "." } ;
 

extra/tools/time/time.factor

@@ -4,7 +4,7 @@ USING: kernel math math.vectors memory io io.styles prettyprint
 namespaces system sequences splitting assocs strings ;
 IN: tools.time
 
-: benchmark ( quot -- gctime runtime )
+: benchmark ( quot -- runtime )
     millis >r call millis r> - ; inline
 
 : simple-table. ( values -- )

extra/ui/ui.factor

@@ -41,8 +41,9 @@ SYMBOL: stop-after-last-window?
     windows global [ [ first = not ] with filter ] change-at ;
 
 : raised-window ( world -- )
-    windows get-global [ second eq? ] with find drop
-    windows get-global [ length 1- ] keep exchange ;
+    windows get-global
+    [ [ second eq? ] with find drop ] keep
+    [ nth ] [ delete-nth ] [ nip ] 2tri push ;
 
 : focus-gestures ( new old -- )
     drop-prefix <reversed>

extra/unix/ffi/ffi.factor

@@ -3,4 +3,10 @@ USING: alien.syntax ;
 
 IN: unix.ffi
 
-FUNCTION: int open ( char* path, int flags, int prot ) ;
+FUNCTION: int open ( char* path, int flags, int prot ) ;
+
+C-STRUCT: utimbuf
+    { "time_t" "actime"  }
+    { "time_t" "modtime" } ;
+
+FUNCTION: int utime ( char* path, utimebuf* buf ) ;

extra/unix/unix.factor

@@ -86,6 +86,12 @@ ERROR: open-error path flags prot message ;
     3dup unix.ffi:open
     dup 0 >= [ >r 3drop r> ] [ drop err_no strerror open-error ] if ;
 
+ERROR: utime-error path message ;
+
+: utime ( path buf -- )
+    dupd unix.ffi:utime
+    0 = [ drop ] [ err_no strerror utime-error ] if ;
+
 FUNCTION: int pclose ( void* file ) ;
 FUNCTION: int pipe ( int* filedes ) ;
 FUNCTION: void* popen ( char* command, char* type ) ;

extra/windows/com/wrapper/wrapper.factor

@@ -29,7 +29,7 @@ unless
             >r find-com-interface-definition family-tree
             r> 1quotation [ >r iid>> r> 2array ] curry map
         ] map-index concat
-        [ f ] add ,
+        [ f ] prefix ,
         \ case ,
         "void*" heap-size
         [ * rot <displaced-alien> com-add-ref 0 rot set-void*-nth S_OK ]
@@ -99,7 +99,7 @@ unless
 PRIVATE>
 
 : <com-wrapper> ( implementations -- wrapper )
-    (make-vtbls) f com-wrapper construct-boa ;
+    (make-vtbls) f com-wrapper boa ;
 
 M: com-wrapper dispose
     t >>freed?