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

core/io/backend/backend.factor

@@ -17,11 +17,9 @@ HOOK: io-multiplex io-backend ( ms -- )
 
 HOOK: normalize-directory io-backend ( str -- newstr )
 
-M: object normalize-directory ;
-
 HOOK: normalize-pathname io-backend ( str -- newstr )
 
-M: object normalize-pathname ;
+M: object normalize-directory normalize-pathname ;
 
 : set-io-backend ( io-backend -- )
     io-backend set-global init-io init-stdio ;

core/io/files/files-tests.factor

@@ -1,6 +1,7 @@
 IN: io.files.tests
-USING: tools.test io.files io threads kernel continuations io.encodings.ascii
+USING: tools.test io.files io threads kernel continuations
-io.files.unique sequences strings accessors ;
+io.encodings.ascii io.files.unique sequences strings accessors
+io.encodings.utf8 ;
 
 [ ] [ "blahblah" temp-file dup exists? [ delete-directory ] [ drop ] if ] unit-test
 [ ] [ "blahblah" temp-file make-directory ] unit-test
@@ -82,6 +83,12 @@ io.files.unique sequences strings accessors ;
     "delete-tree-test" temp-file delete-tree
 ] unit-test
 
+[ { { "kernel" t } } ] [
+    "core" resource-path [
+        "." directory [ first "kernel" = ] subset
+    ] with-directory
+] unit-test
+
 [ ] [
     "copy-tree-test/a/b/c" temp-file make-directories
 ] unit-test
@@ -130,6 +137,15 @@ io.files.unique sequences strings accessors ;
 
 [ t ] [ cwd "misc" resource-path [ ] with-directory cwd = ] unit-test
 
+[ t ] [
+    temp-directory [ "hi41" "test41" utf8 set-file-contents ] with-directory
+    temp-directory "test41" append-path utf8 file-contents "hi41" =
+] unit-test
+
+[ t ] [
+    temp-directory [ "test41" file-info size>> ] with-directory 4 =
+] unit-test
+
 [ ] [ "append-test" temp-file dup exists? [ delete-file ] [ drop ] if ] unit-test
 
 [ ] [ "append-test" temp-file ascii <file-appender> dispose ] unit-test

core/io/files/files.factor

@@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream )
 HOOK: (file-appender) io-backend ( path -- stream )
 
 : <file-reader> ( path encoding -- stream )
-    swap (file-reader) swap <decoder> ;
+    swap normalize-pathname (file-reader) swap <decoder> ;
 
 : <file-writer> ( path encoding -- stream )
-    swap (file-writer) swap <encoder> ;
+    swap normalize-pathname (file-writer) swap <encoder> ;
 
 : <file-appender> ( path encoding -- stream )
-    swap (file-appender) swap <encoder> ;
+    swap normalize-pathname (file-appender) swap <encoder> ;
 
 : file-lines ( path encoding -- seq )
     <file-reader> lines ;
@@ -272,6 +272,9 @@ DEFER: copy-tree-into
 
 : temp-file ( name -- path ) temp-directory prepend-path ;
 
+M: object normalize-pathname ( path -- path' )
+    current-directory get prepend-path ;
+
 ! Pathname presentations
 TUPLE: pathname string ;
 

extra/io/unix/files/files.factor

@@ -94,7 +94,7 @@ M: unix-io copy-file ( from to -- )
     \ file-info construct-boa ;
 
 M: unix-io file-info ( path -- info )
-    stat* stat>file-info ;
+    normalize-pathname stat* stat>file-info ;
 
 M: unix-io link-info ( path -- info )
-    lstat* stat>file-info ;
+    normalize-pathname lstat* stat>file-info ;

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

@@ -1,7 +1,7 @@
 IN: io.unix.launcher.tests
 USING: io.files tools.test io.launcher arrays io namespaces
 continuations math io.encodings.binary io.encodings.ascii
-accessors kernel sequences ;
+accessors kernel sequences io.encodings.utf8 ;
 
 [ ] [
     [ "launcher-test-1" temp-file delete-file ] ignore-errors
@@ -95,3 +95,15 @@ accessors kernel sequences ;
         +replace-environment+ >>environment-mode
     ascii <process-stream> lines
 ] unit-test
+
+[ "hi\n" ] [
+    temp-directory [
+        [ "aloha" delete-file ] ignore-errors
+        <process>
+            { "echo" "hi" } >>command
+            "aloha" >>stdout
+        try-process
+    ] with-directory
+    temp-directory "aloha" append-path
+    utf8 file-contents
+] unit-test

extra/io/unix/launcher/launcher.factor

@@ -37,7 +37,8 @@ USE: unix
     2nip reset-fd ;
 
 : redirect-file ( obj mode fd -- )
-    >r file-mode open dup io-error r> redirect-fd ;
+    >r >r normalize-pathname r> file-mode
+    open dup io-error r> redirect-fd ;
 
 : redirect-closed ( obj mode fd -- )
     >r >r drop "/dev/null" r> r> redirect-file ;
@@ -67,9 +68,9 @@ USE: unix
 
 : spawn-process ( process -- * )
     [
-        current-directory get cd
         setup-priority
         setup-redirection
+        current-directory get cd
         dup pass-environment? [
             dup get-environment set-os-envs
         ] when

extra/io/windows/files/files.factor

@@ -89,4 +89,7 @@ SYMBOLS: +read-only+ +hidden+ +system+
     ] if ;
 
 M: windows-nt-io file-info ( path -- info )
-    get-file-information-stat ;
+    normalize-pathname get-file-information-stat ;
+
+M: windows-nt-io link-info ( path -- info )
+    file-info ;

extra/io/windows/windows.factor

@@ -51,7 +51,7 @@ M: win32-file close-handle ( handle -- )
 ! Clean up resources (open handle) if add-completion fails
 : open-file ( path access-mode create-mode flags -- handle )
     [
-        >r >r >r normalize-pathname r>
+        >r >r
         share-mode security-attributes-inherit r> r> CreateFile-flags f CreateFile
         dup invalid-handle? dup close-later
         dup add-completion

extra/peg/peg.factor

@@ -3,7 +3,8 @@
 USING: kernel sequences strings namespaces math assocs shuffle 
        vectors arrays combinators.lib math.parser match
        unicode.categories sequences.lib compiler.units parser
-       words quotations effects memoize accessors combinators.cleave ;
+       words quotations effects memoize accessors 
+       combinators.cleave locals ;
 IN: peg
 
 TUPLE: parse-result remaining ast ;
@@ -14,9 +15,23 @@ SYMBOL: ignore
   parse-result construct-boa ;
 
 SYMBOL: compiled-parsers
+SYMBOL: packrat
+SYMBOL: failed
 
 GENERIC: (compile) ( parser -- quot )
 
+:: run-packrat-parser ( input quot c -- result )
+  input slice? [ input slice-from ] [ 0 ] if
+  quot c [ drop H{ } clone ] cache 
+  [
+    drop input quot call  
+  ] cache ; inline
+
+: run-parser ( input quot -- result )
+  #! If a packrat cache is available, use memoization for
+  #! packrat parsing, otherwise do a standard peg call.
+  packrat get [ run-packrat-parser ] [ call ] if* ; inline
+
 : compiled-parser ( parser -- word )
   #! Look to see if the given parser has been compiled.
   #! If not, compile it to a temporary word, cache it,
@@ -24,11 +39,11 @@ GENERIC: (compile) ( parser -- quot )
   dup compiled-parsers get at [
     nip
   ] [
-    dup (compile) define-temp 
+    dup (compile) [ run-parser ] curry define-temp 
     [ swap compiled-parsers get set-at ] keep
   ] if* ;
 
-MEMO: compile ( parser -- word )
+: compile ( parser -- word )
   H{ } clone compiled-parsers [ 
     [ compiled-parser ] with-compilation-unit 
   ] with-variable ;

extra/ui/gadgets/scrollers/scrollers.factor

@@ -3,13 +3,14 @@
 USING: arrays ui.gadgets
 ui.gadgets.viewports ui.gadgets.frames ui.gadgets.grids
 ui.gadgets.theme ui.gadgets.sliders ui.gestures kernel math
-namespaces sequences models combinators math.vectors ;
+namespaces sequences models combinators math.vectors
+tuples ;
 IN: ui.gadgets.scrollers
 
 TUPLE: scroller viewport x y follows ;
 
 : find-scroller ( gadget -- scroller/f )
-    [ scroller? ] find-parent ;
+    [ [ scroller? ] is? ] find-parent ;
 
 : scroll-up-page scroller-y -1 swap slide-by-page ;
 

extra/ui/tools/listener/listener.factor

@@ -6,7 +6,8 @@ kernel models namespaces parser quotations sequences ui.commands
 ui.gadgets ui.gadgets.editors ui.gadgets.labelled
 ui.gadgets.panes ui.gadgets.buttons ui.gadgets.scrollers
 ui.gadgets.tracks ui.gestures ui.operations vocabs words
-prettyprint listener debugger threads boxes concurrency.flags ;
+prettyprint listener debugger threads boxes concurrency.flags
+math arrays ;
 IN: ui.tools.listener
 
 TUPLE: listener-gadget input output stack ;
@@ -23,9 +24,19 @@ TUPLE: listener-gadget input output stack ;
 : <listener-input> ( listener -- gadget )
     listener-gadget-output <pane-stream> <interactor> ;
 
+TUPLE: input-scroller ;
+
+: <input-scroller> ( interactor -- scroller )
+    <scroller>
+    input-scroller construct-empty
+    [ set-gadget-delegate ] keep ;
+
+M: input-scroller pref-dim*
+    drop { 0 100 } ;
+
 : listener-input, ( -- )
     g <listener-input> g-> set-listener-gadget-input
-    <scroller> "Input" <labelled-gadget> f track, ;
+    <input-scroller> "Input" <labelled-gadget> f track, ;
 
 : welcome. ( -- )
    "If this is your first time with Factor, please read the " print