diff --git a/core/io/backend/backend.factor b/core/io/backend/backend.factor index 1595ecd576..151dbc7df7 100755 --- a/core/io/backend/backend.factor +++ b/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 ; diff --git a/core/io/files/files-tests.factor b/core/io/files/files-tests.factor index 36b32ea34c..369ecc6868 100755 --- a/core/io/files/files-tests.factor +++ b/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 -io.files.unique sequences strings accessors ; +USING: tools.test io.files io threads kernel continuations +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 dispose ] unit-test diff --git a/core/io/files/files.factor b/core/io/files/files.factor index 6500bdb387..78f1612cb8 100755 --- a/core/io/files/files.factor +++ b/core/io/files/files.factor @@ -13,13 +13,13 @@ HOOK: (file-writer) io-backend ( path -- stream ) HOOK: (file-appender) io-backend ( path -- stream ) : ( path encoding -- stream ) - swap (file-reader) swap ; + swap normalize-pathname (file-reader) swap ; : ( path encoding -- stream ) - swap (file-writer) swap ; + swap normalize-pathname (file-writer) swap ; : ( path encoding -- stream ) - swap (file-appender) swap ; + swap normalize-pathname (file-appender) swap ; : file-lines ( path encoding -- seq ) 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 ; diff --git a/extra/io/unix/files/files.factor b/extra/io/unix/files/files.factor index 1e7d682314..2888231e20 100755 --- a/extra/io/unix/files/files.factor +++ b/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 ; diff --git a/extra/io/unix/launcher/launcher-tests.factor b/extra/io/unix/launcher/launcher-tests.factor index 9e19245d01..7e527196be 100755 --- a/extra/io/unix/launcher/launcher-tests.factor +++ b/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 lines ] unit-test + +[ "hi\n" ] [ + temp-directory [ + [ "aloha" delete-file ] ignore-errors + + { "echo" "hi" } >>command + "aloha" >>stdout + try-process + ] with-directory + temp-directory "aloha" append-path + utf8 file-contents +] unit-test diff --git a/extra/io/unix/launcher/launcher.factor b/extra/io/unix/launcher/launcher.factor index 0cbb78b881..1292f2cacf 100755 --- a/extra/io/unix/launcher/launcher.factor +++ b/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 diff --git a/extra/io/windows/files/files.factor b/extra/io/windows/files/files.factor index 094014fac6..b4513f7da8 100755 --- a/extra/io/windows/files/files.factor +++ b/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 ; diff --git a/extra/io/windows/windows.factor b/extra/io/windows/windows.factor index dac55664a4..635a992777 100755 --- a/extra/io/windows/windows.factor +++ b/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 diff --git a/extra/peg/peg.factor b/extra/peg/peg.factor index 00271a9ad3..dd0b11fce3 100755 --- a/extra/peg/peg.factor +++ b/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 ; diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index 98951b74e3..7966f4e206 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/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 ; diff --git a/extra/ui/tools/listener/listener.factor b/extra/ui/tools/listener/listener.factor index 75401b3861..7db0d63f45 100755 --- a/extra/ui/tools/listener/listener.factor +++ b/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 -- gadget ) listener-gadget-output ; +TUPLE: input-scroller ; + +: ( interactor -- scroller ) + + input-scroller construct-empty + [ set-gadget-delegate ] keep ; + +M: input-scroller pref-dim* + drop { 0 100 } ; + : listener-input, ( -- ) g g-> set-listener-gadget-input - "Input" f track, ; + "Input" f track, ; : welcome. ( -- ) "If this is your first time with Factor, please read the " print