From ad4729712c46327d566b3bea3d9d226fad264602 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 17:21:15 -0600 Subject: [PATCH 01/17] remove combinators that nobody uses --- extra/combinators/lib/lib.factor | 9 --------- 1 file changed, 9 deletions(-) diff --git a/extra/combinators/lib/lib.factor b/extra/combinators/lib/lib.factor index ac8c3d11d8..5e78d183b0 100755 --- a/extra/combinators/lib/lib.factor +++ b/extra/combinators/lib/lib.factor @@ -116,18 +116,9 @@ MACRO: construct-slots ( assoc tuple-class -- tuple ) [ dip ] curry swap 1quotation [ keep ] curry compose ] { } assoc>map concat compose ; -: either ( object first second -- ? ) - >r keep swap [ r> drop ] [ r> call ] ?if ; inline - : 2quot-with ( obj seq quot1 quot2 -- seq quot1 quot2 ) >r pick >r with r> r> swapd with ; -: or? ( obj quot1 quot2 -- ? ) - [ keep ] dip rot [ 2nip ] [ call ] if* ; inline - -: and? ( obj quot1 quot2 -- ? ) - [ keep ] dip rot [ call ] [ 2drop f ] if ; inline - MACRO: multikeep ( word out-indexes -- ... ) [ dup >r [ \ npick \ >r 3array % ] each From ce00c953847e8680158882209acade3e13735d02 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 17:22:05 -0600 Subject: [PATCH 02/17] remove some trivial definitions from lint --- extra/lint/lint.factor | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/extra/lint/lint.factor b/extra/lint/lint.factor index a8320c1464..77b0b11238 100644 --- a/extra/lint/lint.factor +++ b/extra/lint/lint.factor @@ -44,11 +44,13 @@ SYMBOL: def-hash-keys : trivial-defs { + [ drop ] [ 2array ] + [ bitand ] + [ . ] [ get ] [ t ] [ f ] [ { } ] - [ drop ] ! because of declare [ drop f ] [ "cdecl" ] [ first ] [ second ] [ third ] [ fourth ] @@ -80,6 +82,12 @@ def-hash get-global [ drop empty? not ] assoc-filter ! Remove trivial defs [ drop trivial-defs member? not ] assoc-filter +! Remove numbers only defs +[ drop [ number? ] all? not ] assoc-filter + +! Remove curry only defs +[ drop [ \ curry = ] all? not ] assoc-filter + ! Remove tag defs [ drop { From 819239edb9718c9149cbad1cdf33c6b0db5e06ae Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sun, 7 Dec 2008 23:51:13 -0600 Subject: [PATCH 03/17] add file-systems. word --- basis/tools/files/files.factor | 35 ++++++++++++++++++++++++++++++++-- 1 file changed, 33 insertions(+), 2 deletions(-) diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 58c24ef6ca..18baedae0a 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -1,14 +1,15 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays combinators io io.files kernel -math.parser sequences system vocabs.loader calendar ; +math.parser sequences system vocabs.loader calendar math +symbols fry prettyprint ; IN: tools.files > ] [ minute>> ] bi - [ number>string 2 CHAR: 0 pad-left ] bi@ ":" swap 3append ; + [ number>string 2 CHAR: 0 pad-left ] bi@ ":" glue ; : ls-timestamp ( timestamp -- string ) [ month>> month-abbreviation ] @@ -32,7 +33,37 @@ PRIVATE> : directory. ( path -- ) [ (directory.) ] with-directory-files [ print ] each ; +SYMBOLS: device-name mount-point type +available-space free-space used-space total-space +percent-used percent-free ; + +: percent ( real -- integer ) 100 * >integer ; inline + +: file-system-spec ( file-system-info obj -- str ) + { + { device-name [ device-name>> ] } + { mount-point [ mount-point>> ] } + { type [ type>> ] } + { available-space [ available-space>> ] } + { free-space [ free-space>> ] } + { used-space [ used-space>> ] } + { total-space [ total-space>> ] } + { percent-used [ + [ used-space>> ] [ total-space>> ] bi dup 0 = + [ 2drop 0 ] [ / percent ] if + ] } + } case ; + +: file-systems-info ( spec -- seq ) + file-systems swap '[ _ [ file-system-spec ] with map ] map ; + +: file-systems. ( spec -- ) + [ file-systems-info ] + [ [ unparse ] map ] bi prefix simple-table. ; + { { [ os unix? ] [ "tools.files.unix" ] } { [ os windows? ] [ "tools.files.windows" ] } } cond require + +! { device-name free-space used-space total-space percent-used } file-systems. From 24c9337db6c29f65a3c124a60285a6308297f955 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 00:05:52 -0600 Subject: [PATCH 04/17] remove >r r> --- basis/state-parser/state-parser.factor | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/basis/state-parser/state-parser.factor b/basis/state-parser/state-parser.factor index dab5414b49..9341f39426 100644 --- a/basis/state-parser/state-parser.factor +++ b/basis/state-parser/state-parser.factor @@ -139,7 +139,7 @@ M: not-enough-characters summary ( obj -- str ) : expect ( ch -- ) get-char 2dup = [ 2drop ] [ - >r 1string r> 1string expected + [ 1string ] bi@ expected ] if next ; : expect-string ( string -- ) @@ -155,4 +155,4 @@ M: not-enough-characters summary ( obj -- str ) swap [ init-parser call ] with-input-stream ; inline : string-parse ( input quot -- ) - >r r> state-parse ; inline + [ ] dip state-parse ; inline From 90cdb6c4f4fc23b3e9c63591c3a5fcd5d22f8fa2 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 00:10:24 -0600 Subject: [PATCH 05/17] remove >r r> --- basis/memoize/memoize-tests.factor | 4 ++-- basis/nmake/nmake.factor | 2 +- basis/random/mersenne-twister/mersenne-twister-tests.factor | 2 +- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/basis/memoize/memoize-tests.factor b/basis/memoize/memoize-tests.factor index 1f819d281d..7ee56866ce 100644 --- a/basis/memoize/memoize-tests.factor +++ b/basis/memoize/memoize-tests.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2007 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. -USING: math kernel memoize tools.test parser +USING: math kernel memoize tools.test parser generalizations prettyprint io.streams.string sequences eval ; IN: memoize.tests @@ -9,7 +9,7 @@ MEMO: fib ( m -- n ) [ 89 ] [ 10 fib ] unit-test -[ "USING: kernel math memoize ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) >r >r >r >r 1+ r> r> r> r> ;" eval ] must-fail +[ "USING: kernel math memoize generalizations ; IN: memoize.tests MEMO: x ( a b c d e -- f g h i j ) [ 1+ ] 4 ndip ;" eval ] must-fail MEMO: see-test ( a -- b ) reverse ; diff --git a/basis/nmake/nmake.factor b/basis/nmake/nmake.factor index 80c3ce3411..61a0950ce4 100644 --- a/basis/nmake/nmake.factor +++ b/basis/nmake/nmake.factor @@ -10,7 +10,7 @@ SYMBOL: building-seq : n, ( obj n -- ) get-building-seq push ; : n% ( seq n -- ) get-building-seq push-all ; -: n# ( num n -- ) >r number>string r> n% ; +: n# ( num n -- ) [ number>string ] dip n% ; : 0, ( obj -- ) 0 n, ; : 0% ( seq -- ) 0 n% ; diff --git a/basis/random/mersenne-twister/mersenne-twister-tests.factor b/basis/random/mersenne-twister/mersenne-twister-tests.factor index 8a2a5031fa..fe58e3d07c 100644 --- a/basis/random/mersenne-twister/mersenne-twister-tests.factor +++ b/basis/random/mersenne-twister/mersenne-twister-tests.factor @@ -11,7 +11,7 @@ IN: random.mersenne-twister.tests 100 [ 100 random ] replicate ; : test-rng ( seed quot -- ) - >r r> with-random ; + [ ] dip with-random ; [ f ] [ 1234 [ randoms randoms = ] test-rng ] unit-test From 22dd6a74b622488e58824c408437bcc11464c1d6 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 12:46:44 -0600 Subject: [PATCH 06/17] add a unit test for tools.files --- basis/tools/files/files-tests.factor | 3 +++ basis/tools/files/files.factor | 2 -- 2 files changed, 3 insertions(+), 2 deletions(-) diff --git a/basis/tools/files/files-tests.factor b/basis/tools/files/files-tests.factor index 6aa68d8127..4dc4ef23f0 100644 --- a/basis/tools/files/files-tests.factor +++ b/basis/tools/files/files-tests.factor @@ -6,3 +6,6 @@ IN: tools.files.tests \ directory. must-infer [ ] [ "" directory. ] unit-test + +[ ] +[ { device-name free-space used-space total-space percent-used } file-systems. ] unit-test diff --git a/basis/tools/files/files.factor b/basis/tools/files/files.factor index 18baedae0a..db49dcbf61 100755 --- a/basis/tools/files/files.factor +++ b/basis/tools/files/files.factor @@ -65,5 +65,3 @@ percent-used percent-free ; { [ os unix? ] [ "tools.files.unix" ] } { [ os windows? ] [ "tools.files.windows" ] } } cond require - -! { device-name free-space used-space total-space percent-used } file-systems. From eb4a6cbe7d514950d82f747361f7805b0f0933f6 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 12:24:36 -0800 Subject: [PATCH 07/17] fix bunny/outlined framebuffer refresh bug and put some lipstick on it --- extra/bunny/outlined/outlined.factor | 43 ++++++++++++++++------------ 1 file changed, 25 insertions(+), 18 deletions(-) diff --git a/extra/bunny/outlined/outlined.factor b/extra/bunny/outlined/outlined.factor index 6117a0fdea..3cf3f94d73 100755 --- a/extra/bunny/outlined/outlined.factor +++ b/extra/bunny/outlined/outlined.factor @@ -1,7 +1,8 @@ USING: arrays bunny.model bunny.cel-shaded continuations destructors kernel math multiline opengl opengl.shaders -opengl.framebuffers opengl.gl opengl.demo-support -opengl.capabilities sequences ui.gadgets combinators accessors ; +opengl.framebuffers opengl.gl opengl.demo-support fry +opengl.capabilities sequences ui.gadgets combinators accessors +macros ; IN: bunny.outlined STRING: outlined-pass1-fragment-shader-main-source @@ -176,24 +177,30 @@ TUPLE: bunny-outlined } cleave ] [ drop ] if ; +MACRO: (framebuffer-texture>>draw) ( iformat xformat setter -- ) + '[ _ _ (framebuffer-texture) [ @ drop ] keep ] ; + +: (make-framebuffer-textures) ( draw dim -- draw color normal depth ) + { + [ drop ] + [ GL_RGBA16F_ARB GL_RGBA [ >>color-texture ] (framebuffer-texture>>draw) ] + [ GL_RGBA16F_ARB GL_RGBA [ >>normal-texture ] (framebuffer-texture>>draw) ] + [ + GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT + [ >>depth-texture ] (framebuffer-texture>>draw) + ] + } 2cleave ; + +: remake-framebuffer ( draw -- ) + [ dispose-framebuffer ] + [ dup gadget>> dim>> + [ (make-framebuffer-textures) (make-framebuffer) >>framebuffer ] + [ >>framebuffer-dim drop ] bi + ] bi ; + : remake-framebuffer-if-needed ( draw -- ) dup [ gadget>> dim>> ] [ framebuffer-dim>> ] bi = - [ drop ] [ - [ dispose-framebuffer ] [ dup ] [ gadget>> dim>> ] tri { - [ - GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) - [ >>color-texture drop ] keep - ] [ - GL_RGBA16F_ARB GL_RGBA (framebuffer-texture) - [ >>normal-texture drop ] keep - ] [ - GL_DEPTH_COMPONENT32 GL_DEPTH_COMPONENT (framebuffer-texture) - [ >>depth-texture drop ] keep - ] - } 2cleave - [ (make-framebuffer) >>framebuffer ] [ >>framebuffer-dim ] bi - drop - ] if ; + [ drop ] [ remake-framebuffer ] if ; : clear-framebuffer ( -- ) GL_COLOR_ATTACHMENT0_EXT glDrawBuffer From 9b887c7e4c9b9081feab4dfd85d461a623281065 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 12:51:52 -0800 Subject: [PATCH 08/17] hey spheres, don't go run off the cliff if you didn't initialize --- extra/spheres/spheres.factor | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/extra/spheres/spheres.factor b/extra/spheres/spheres.factor index 7a0c0d2e77..543c26ae14 100755 --- a/extra/spheres/spheres.factor +++ b/extra/spheres/spheres.factor @@ -113,7 +113,7 @@ main() TUPLE: spheres-gadget < demo-gadget plane-program solid-sphere-program texture-sphere-program reflection-framebuffer reflection-depthbuffer - reflection-texture ; + reflection-texture initialized? ; : ( -- gadget ) 20.0 10.0 20.0 spheres-gadget new-demo-gadget ; @@ -182,9 +182,11 @@ M: spheres-gadget graft* ( gadget -- ) (make-reflection-texture) >>reflection-texture (make-reflection-depthbuffer) [ >>reflection-depthbuffer ] keep (make-reflection-framebuffer) >>reflection-framebuffer + t >>initialized? drop ; M: spheres-gadget ungraft* ( gadget -- ) + f >>initialized? dup find-gl-context { [ reflection-framebuffer>> [ delete-framebuffer ] when* ] @@ -238,9 +240,8 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) ] bi ; : reflection-frustum ( gadget -- -x x -y y near far ) - [ near-plane ] [ far-plane ] bi [ - drop dup [ -+ ] bi@ - ] 2keep ; + [ near-plane ] [ far-plane ] bi + [ drop dup [ -+ ] bi@ ] 2keep ; : (reflection-face) ( gadget face -- ) swap reflection-texture>> >r >r @@ -280,7 +281,7 @@ M: spheres-gadget pref-dim* ( gadget -- dim ) [ dim>> 0 0 rot first2 glViewport ] } cleave ] with-framebuffer ; -M: spheres-gadget draw-gadget* ( gadget -- ) +: (draw-gadget) ( gadget -- ) GL_DEPTH_TEST glEnable GL_SCISSOR_TEST glDisable 0.15 0.15 1.0 1.0 glClearColor { @@ -297,6 +298,9 @@ M: spheres-gadget draw-gadget* ( gadget -- ) ] } cleave ; +M: spheres-gadget draw-gadget* ( gadget -- ) + dup initialized?>> [ (draw-gadget) ] [ drop ] if ; + : spheres-window ( -- ) [ "Spheres" open-window ] with-ui ; From 14940bd7aa946cb6790c7b88fab71be495524a15 Mon Sep 17 00:00:00 2001 From: Joe Groff Date: Mon, 8 Dec 2008 12:55:22 -0800 Subject: [PATCH 09/17] give OpenGL demo keys a little boost --- extra/opengl/demo-support/demo-support.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/opengl/demo-support/demo-support.factor b/extra/opengl/demo-support/demo-support.factor index cd781508a7..92778194e3 100755 --- a/extra/opengl/demo-support/demo-support.factor +++ b/extra/opengl/demo-support/demo-support.factor @@ -5,7 +5,7 @@ IN: opengl.demo-support : FOV 2.0 sqrt 1+ ; inline : MOUSE-MOTION-SCALE 0.5 ; inline -: KEY-ROTATE-STEP 1.0 ; inline +: KEY-ROTATE-STEP 10.0 ; inline SYMBOL: last-drag-loc From 7f93d335a656611cc656ebe6fd8bf576a82453f3 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 20:10:52 -0600 Subject: [PATCH 10/17] fix bug in io.paths, add io.paths.windows --- extra/io/paths/paths.factor | 23 ++++++++++++++++------- extra/io/paths/windows/authors.txt | 1 + extra/io/paths/windows/tags.txt | 1 + extra/io/paths/windows/windows.factor | 13 +++++++++++++ 4 files changed, 31 insertions(+), 7 deletions(-) create mode 100644 extra/io/paths/windows/authors.txt create mode 100644 extra/io/paths/windows/tags.txt create mode 100644 extra/io/paths/windows/windows.factor diff --git a/extra/io/paths/paths.factor b/extra/io/paths/paths.factor index 8237e59a1b..75d08b60f8 100755 --- a/extra/io/paths/paths.factor +++ b/extra/io/paths/paths.factor @@ -1,11 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: io.files kernel sequences accessors -dlists deques arrays ; +USING: accessors arrays deques dlists io.files io.paths.private +kernel sequences system vocabs.loader fry continuations ; IN: io.paths TUPLE: directory-iterator path bfs queue ; + + +: find-file ( path bfs? quot: ( obj -- ? ) -- path/f ) [ ] dip [ keep and ] curry iterate-directory ; inline -: each-file ( path bfs? quot -- ) +: each-file ( path bfs? quot: ( obj -- ? ) -- ) [ ] dip [ f ] compose iterate-directory drop ; inline -: find-all-files ( path bfs? quot -- paths ) +: find-all-files ( path bfs? quot: ( obj -- ? ) -- paths ) [ ] dip pusher [ [ f ] compose iterate-directory drop ] dip ; inline : recursive-directory ( path bfs? -- paths ) [ ] accumulator [ each-file ] dip ; + +: find-in-directories ( directories bfs? quot -- path' ) + '[ _ _ find-file ] attempt-all ; inline + +os windows? [ "io.paths.windows" require ] when diff --git a/extra/io/paths/windows/authors.txt b/extra/io/paths/windows/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/io/paths/windows/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/io/paths/windows/tags.txt b/extra/io/paths/windows/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/extra/io/paths/windows/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/extra/io/paths/windows/windows.factor b/extra/io/paths/windows/windows.factor new file mode 100644 index 0000000000..b4858aaef8 --- /dev/null +++ b/extra/io/paths/windows/windows.factor @@ -0,0 +1,13 @@ +! Copyright (C) 2008 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: arrays continuations fry io.files io.paths +kernel windows.shell32 sequences ; +IN: io.paths.windows + +: program-files-directories ( -- array ) + program-files program-files-x86 2array ; inline + +: find-in-program-files ( base-directory bfs? quot -- path ) + [ + [ program-files-directories ] dip '[ _ append-path ] map + ] 2dip find-in-directories ; inline From 44e582bbebe92c194a74f0b761c4e3432a20d473 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 20:11:24 -0600 Subject: [PATCH 11/17] update all editors for windows 64 to look in "program files" and "program files (x86)" --- basis/editors/editpadlite/authors.txt | 2 ++ .../editpadlite/editpadlite-docs.factor | 7 ++++ basis/editors/editpadlite/editpadlite.factor | 16 +++++++++ basis/editors/editpadlite/summary.txt | 1 + basis/editors/editpadlite/tags.txt | 1 + .../editors/editpadpro/editpadpro-docs.factor | 7 ++-- basis/editors/editpadpro/editpadpro.factor | 9 +++-- basis/editors/editplus/editplus.factor | 4 +-- basis/editors/emeditor/emeditor.factor | 7 ++-- basis/editors/etexteditor/etexteditor.factor | 4 +-- basis/editors/gvim/windows/windows.factor | 5 ++- basis/editors/notepad2/notepad2.factor | 8 ++--- basis/editors/notepadpp/notepadpp.factor | 6 ++-- basis/editors/scite/scite.factor | 35 +++++++------------ basis/editors/scite/summary.txt | 2 +- basis/editors/ted-notepad/ted-notepad.factor | 9 ++--- basis/editors/textedit/textedit.factor | 3 -- basis/editors/ultraedit/ultraedit.factor | 5 ++- basis/editors/wordpad/wordpad.factor | 10 +++--- 19 files changed, 77 insertions(+), 64 deletions(-) create mode 100644 basis/editors/editpadlite/authors.txt create mode 100644 basis/editors/editpadlite/editpadlite-docs.factor create mode 100644 basis/editors/editpadlite/editpadlite.factor create mode 100644 basis/editors/editpadlite/summary.txt create mode 100644 basis/editors/editpadlite/tags.txt diff --git a/basis/editors/editpadlite/authors.txt b/basis/editors/editpadlite/authors.txt new file mode 100644 index 0000000000..aa43d6ea12 --- /dev/null +++ b/basis/editors/editpadlite/authors.txt @@ -0,0 +1,2 @@ +Ryan Murphy +Doug Coleman diff --git a/basis/editors/editpadlite/editpadlite-docs.factor b/basis/editors/editpadlite/editpadlite-docs.factor new file mode 100644 index 0000000000..4f0c8f800d --- /dev/null +++ b/basis/editors/editpadlite/editpadlite-docs.factor @@ -0,0 +1,7 @@ +USING: help.syntax help.markup ; +IN: editors.editpadpro + +ARTICLE: "editors.editpadpro" "EditPad Pro support" +"EditPadPro text editor integration on Windows. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ; + +ABOUT: "editors.editpadpro" diff --git a/basis/editors/editpadlite/editpadlite.factor b/basis/editors/editpadlite/editpadlite.factor new file mode 100644 index 0000000000..c002c2fa75 --- /dev/null +++ b/basis/editors/editpadlite/editpadlite.factor @@ -0,0 +1,16 @@ +USING: definitions kernel parser words sequences math.parser +namespaces editors io.launcher windows.shell32 io.files +io.paths.windows strings unicode.case make ; +IN: editors.editpadlite + +: editpadlite-path ( -- path ) + \ editpadlite-path get-global [ + "JGsoft" t [ >lower "editpadlite.exe" tail? ] find-in-program-files + ] unless* ; + +: editpadlite ( file line -- ) + [ + editpadlite-path , drop , + ] { } make run-detached drop ; + +[ editpadlite ] edit-hook set-global diff --git a/basis/editors/editpadlite/summary.txt b/basis/editors/editpadlite/summary.txt new file mode 100644 index 0000000000..445e15f75d --- /dev/null +++ b/basis/editors/editpadlite/summary.txt @@ -0,0 +1 @@ +EditPadLite editor integration diff --git a/basis/editors/editpadlite/tags.txt b/basis/editors/editpadlite/tags.txt new file mode 100644 index 0000000000..6bf68304bb --- /dev/null +++ b/basis/editors/editpadlite/tags.txt @@ -0,0 +1 @@ +unportable diff --git a/basis/editors/editpadpro/editpadpro-docs.factor b/basis/editors/editpadpro/editpadpro-docs.factor index f3484917cb..4f0c8f800d 100644 --- a/basis/editors/editpadpro/editpadpro-docs.factor +++ b/basis/editors/editpadpro/editpadpro-docs.factor @@ -1,6 +1,7 @@ USING: help.syntax help.markup ; +IN: editors.editpadpro -ARTICLE: "editpadpro" "EditPad Pro support" -"Just load this module and you will be able to edit documentation with EditPadPro. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ; +ARTICLE: "editors.editpadpro" "EditPad Pro support" +"EditPadPro text editor integration on Windows. Be sure to put EditPadPro in your system path so that it will be found. Windows only." ; -ABOUT: "editpadpro" \ No newline at end of file +ABOUT: "editors.editpadpro" diff --git a/basis/editors/editpadpro/editpadpro.factor b/basis/editors/editpadpro/editpadpro.factor index 09f59f0916..2a7f92f932 100644 --- a/basis/editors/editpadpro/editpadpro.factor +++ b/basis/editors/editpadpro/editpadpro.factor @@ -1,17 +1,16 @@ USING: definitions kernel parser words sequences math.parser namespaces editors io.launcher windows.shell32 io.files -io.paths strings unicode.case make ; +io.paths.windows strings unicode.case make ; IN: editors.editpadpro -: editpadpro-path +: editpadpro-path ( -- path ) \ editpadpro-path get-global [ - program-files "JGsoft" append-path - t [ >lower "editpadpro.exe" tail? ] find-file + "JGsoft" t [ >lower "editpadpro.exe" tail? ] find-in-program-files ] unless* ; : editpadpro ( file line -- ) [ - editpadpro-path , "/l" swap number>string append , , + editpadpro-path , number>string "/l" prepend , , ] { } make run-detached drop ; [ editpadpro ] edit-hook set-global diff --git a/basis/editors/editplus/editplus.factor b/basis/editors/editplus/editplus.factor index 8af036f290..9fa477f51a 100644 --- a/basis/editors/editplus/editplus.factor +++ b/basis/editors/editplus/editplus.factor @@ -1,10 +1,10 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make ; +namespaces sequences windows.shell32 make io.paths.windows ; IN: editors.editplus : editplus-path ( -- path ) \ editplus-path get-global [ - program-files "\\EditPlus 2\\editplus.exe" append-path + "EditPlus 2" t [ "editplus.exe" tail? ] find-in-program-files ] unless* ; : editplus ( file line -- ) diff --git a/basis/editors/emeditor/emeditor.factor b/basis/editors/emeditor/emeditor.factor index 9aec22eed1..fc3deae670 100644 --- a/basis/editors/emeditor/emeditor.factor +++ b/basis/editors/emeditor/emeditor.factor @@ -1,11 +1,10 @@ -USING: editors hardware-info.windows io.files io.launcher -kernel math.parser namespaces sequences windows.shell32 -make ; +USING: editors io.files io.launcher kernel math.parser +namespaces sequences windows.shell32 make io.paths.windows ; IN: editors.emeditor : emeditor-path ( -- path ) \ emeditor-path get-global [ - program-files "\\EmEditor\\EmEditor.exe" append-path + "EmEditor" t [ "EmEditor.exe" tail? ] find-in-program-files ] unless* ; : emeditor ( file line -- ) diff --git a/basis/editors/etexteditor/etexteditor.factor b/basis/editors/etexteditor/etexteditor.factor index 316bd24cfa..c4b3ad35c1 100755 --- a/basis/editors/etexteditor/etexteditor.factor +++ b/basis/editors/etexteditor/etexteditor.factor @@ -1,12 +1,12 @@ ! Copyright (C) 2008 Kibleur Christophe. ! See http://factorcode.org/license.txt for BSD license. USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make ; +namespaces sequences windows.shell32 io.paths.windows make ; IN: editors.etexteditor : etexteditor-path ( -- str ) \ etexteditor-path get-global [ - program-files "e\\e.exe" append-path + "e" t [ "e.exe" tail? ] find-in-program-files ] unless* ; : etexteditor ( file line -- ) diff --git a/basis/editors/gvim/windows/windows.factor b/basis/editors/gvim/windows/windows.factor index 8c4e1aaacb..2f733f3c2f 100644 --- a/basis/editors/gvim/windows/windows.factor +++ b/basis/editors/gvim/windows/windows.factor @@ -1,9 +1,8 @@ USING: editors.gvim io.files io.windows kernel namespaces -sequences windows.shell32 io.paths system ; +sequences windows.shell32 io.paths.windows system ; IN: editors.gvim.windows M: windows gvim-path \ gvim-path get-global [ - program-files "vim" append-path - t [ "gvim.exe" tail? ] find-file + "vim" t [ "gvim.exe" tail? ] find-in-program-files ] unless* ; diff --git a/basis/editors/notepad2/notepad2.factor b/basis/editors/notepad2/notepad2.factor index 4d333e45dd..e22de4f68d 100644 --- a/basis/editors/notepad2/notepad2.factor +++ b/basis/editors/notepad2/notepad2.factor @@ -2,10 +2,10 @@ USING: editors io.files io.launcher kernel math.parser namespaces sequences windows.shell32 make ; IN: editors.notepad2 -: notepad2-path ( -- str ) +: notepad2-path ( -- path ) \ notepad2-path get-global [ - program-files "C:\\Windows\\system32\\notepad.exe" append-path - ] unless* ; + "C:\\Windows\\system32\\notepad.exe" + ] unless* ; : notepad2 ( file line -- ) [ @@ -13,4 +13,4 @@ IN: editors.notepad2 "/g" , number>string , , ] { } make run-detached drop ; -[ notepad2 ] edit-hook set-global \ No newline at end of file +[ notepad2 ] edit-hook set-global diff --git a/basis/editors/notepadpp/notepadpp.factor b/basis/editors/notepadpp/notepadpp.factor index 540612aeec..d68008c2ca 100644 --- a/basis/editors/notepadpp/notepadpp.factor +++ b/basis/editors/notepadpp/notepadpp.factor @@ -1,10 +1,10 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make ; +namespaces sequences io.paths.windows make ; IN: editors.notepadpp -: notepadpp-path +: notepadpp-path ( -- path ) \ notepadpp-path get-global [ - program-files "notepad++\\notepad++.exe" append-path + "notepad++" t [ "notepad++.exe" tail? ] find-in-program-files ] unless* ; : notepadpp ( file line -- ) diff --git a/basis/editors/scite/scite.factor b/basis/editors/scite/scite.factor index 10152f53d5..e0b48a3e72 100644 --- a/basis/editors/scite/scite.factor +++ b/basis/editors/scite/scite.factor @@ -1,34 +1,25 @@ -! Basic SciTE integration for Factor. -! -! By Clemens F. Hofreither, 2007. +! Copyright (C) 2007 Clemens F. Hofreither. +! See http://factorcode.org/license.txt for BSD license. ! clemens.hofreither@gmx.net -! -! In your .factor-rc or .factor-boot-rc, -! require this module and set the scite-path -! variable to point to your executable, -! if not on the path. -! -USING: io.files io.launcher kernel namespaces math -math.parser editors sequences windows.shell32 make ; +USING: io.files io.launcher kernel namespaces io.paths.windows +math math.parser editors sequences make unicode.case ; IN: editors.scite : scite-path ( -- path ) \ scite-path get-global [ - program-files "ScITE Source Code Editor\\SciTE.exe" append-path - dup exists? [ - drop program-files "wscite\\SciTE.exe" append-path - ] unless + "Scintilla Text Editor" t + [ >lower "scite.exe" tail? ] find-in-program-files ] unless* ; : scite-command ( file line -- cmd ) - swap - [ - scite-path , - , - "-goto:" swap number>string append , - ] { } make ; + swap + [ + scite-path , + , + number>string "-goto:" prepend , + ] { } make ; : scite-location ( file line -- ) - scite-command run-detached drop ; + scite-command run-detached drop ; [ scite-location ] edit-hook set-global diff --git a/basis/editors/scite/summary.txt b/basis/editors/scite/summary.txt index 1088ee7f5a..c5f9bb9a09 100644 --- a/basis/editors/scite/summary.txt +++ b/basis/editors/scite/summary.txt @@ -1 +1 @@ -SciTE editor integration +Scintilla text editor (SciTE) integration diff --git a/basis/editors/ted-notepad/ted-notepad.factor b/basis/editors/ted-notepad/ted-notepad.factor index b4135c92a0..994dc60ba3 100644 --- a/basis/editors/ted-notepad/ted-notepad.factor +++ b/basis/editors/ted-notepad/ted-notepad.factor @@ -1,15 +1,16 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 make ; +namespaces sequences io.paths.windows make ; IN: editors.ted-notepad -: ted-notepad-path +: ted-notepad-path ( -- path ) \ ted-notepad-path get-global [ - program-files "\\TED Notepad\\TedNPad.exe" append-path + "TED Notepad" t [ "TedNPad.exe" tail? ] find-in-program-files ] unless* ; : ted-notepad ( file line -- ) [ - ted-notepad-path , "/l" swap number>string append , , + ted-notepad-path , + number>string "/l" prepend , , ] { } make run-detached drop ; [ ted-notepad ] edit-hook set-global diff --git a/basis/editors/textedit/textedit.factor b/basis/editors/textedit/textedit.factor index 6942e24534..cccc94b539 100644 --- a/basis/editors/textedit/textedit.factor +++ b/basis/editors/textedit/textedit.factor @@ -1,6 +1,5 @@ USING: definitions io.launcher kernel math math.parser parser namespaces prettyprint editors make ; - IN: editors.textedit : textedit-location ( file line -- ) @@ -9,5 +8,3 @@ IN: editors.textedit try-process ; [ textedit-location ] edit-hook set-global - - diff --git a/basis/editors/ultraedit/ultraedit.factor b/basis/editors/ultraedit/ultraedit.factor index 7c9c41df7a..f1929ebf64 100644 --- a/basis/editors/ultraedit/ultraedit.factor +++ b/basis/editors/ultraedit/ultraedit.factor @@ -1,11 +1,10 @@ USING: editors io.files io.launcher kernel math.parser -namespaces sequences windows.shell32 wne ; +namespaces sequences io.paths.windows make ; IN: editors.ultraedit : ultraedit-path ( -- path ) \ ultraedit-path get-global [ - program-files - "IDM Computer Solutions\\UltraEdit-32\\uedit32.exe" append-path + "IDM Computer Solutions" t [ "uedit32.exe" tail? ] find-in-program-files ] unless* ; : ultraedit ( file line -- ) diff --git a/basis/editors/wordpad/wordpad.factor b/basis/editors/wordpad/wordpad.factor index 3f3dd6cab1..fa0f6852dd 100644 --- a/basis/editors/wordpad/wordpad.factor +++ b/basis/editors/wordpad/wordpad.factor @@ -1,14 +1,14 @@ -USING: editors hardware-info.windows io.launcher kernel -math.parser namespaces sequences windows.shell32 io.files -arrays ; +USING: editors io.launcher kernel io.paths.windows +math.parser namespaces sequences io.files arrays ; IN: editors.wordpad : wordpad-path ( -- path ) \ wordpad-path get [ - program-files "Windows NT\\Accessories\\wordpad.exe" append-path + "Windows NT\\Accessories" t + [ "wordpad.exe" tail? ] find-in-program-files ] unless* ; : wordpad ( file line -- ) - drop wordpad-path swap 2array dup . run-detached drop ; + drop wordpad-path swap 2array run-detached drop ; [ wordpad ] edit-hook set-global From 14a54bb97a7a5182073be0d3fbe34e79d8b8fc8e Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 8 Dec 2008 21:30:10 -0600 Subject: [PATCH 12/17] trails: Un-processify trails --- extra/trails/trails.factor | 96 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 96 insertions(+) create mode 100644 extra/trails/trails.factor diff --git a/extra/trails/trails.factor b/extra/trails/trails.factor new file mode 100644 index 0000000000..cea5ece9f7 --- /dev/null +++ b/extra/trails/trails.factor @@ -0,0 +1,96 @@ + +USING: kernel accessors locals namespaces sequences sequences.lib threads + math math.order math.vectors + calendar + colors opengl ui ui.gadgets ui.gestures ui.render + circular + processing.shapes ; + +IN: trails + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Example 33-15 from the Processing book + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +! Return the mouse location relative to the current gadget + +: mouse ( -- point ) hand-loc get hand-gadget get screen-loc v- ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: point-list ( n -- seq ) [ drop { 0 0 } ] map ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: percent->radius ( percent -- radius ) neg 1 + 25 * 5 max ; + +: dot ( pos percent -- ) percent->radius circle ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +TUPLE: < gadget paused points ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: iterate-system ( GADGET -- ) + + ! Add a valid point if the mouse is in the gadget + ! Otherwise, add an "invisible" point + + hand-gadget get GADGET = + [ mouse GADGET points>> push-circular ] + [ { -10 -10 } GADGET points>> push-circular ] + if ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +:: start-trails-thread ( GADGET -- ) + GADGET f >>paused drop + [ + [ + GADGET paused>> + [ f ] + [ GADGET iterate-system GADGET relayout-1 1 milliseconds sleep t ] + if + ] + loop + ] + in-thread ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M: pref-dim* ( -- dim ) drop { 500 500 } ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +M:: draw-gadget* ( GADGET -- ) + origin get + [ + T{ rgba f 1 1 1 0.4 } \ fill-color set ! White, with some transparency + T{ rgba f 0 0 0 0 } \ stroke-color set ! no stroke + + black gl-clear + + GADGET points>> [ dot ] each-percent + ] + with-translation ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: trails-gadget ( -- ) + + new-gadget + + 300 point-list >>points + + t >>clipped? + + dup start-trails-thread ; + +: trails-window ( -- ) [ trails-gadget "Trails" open-window ] with-ui ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +MAIN: trails-window \ No newline at end of file From 971a6c89beac976ad8a90e7ff87df33133413c5c Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 21:31:41 -0600 Subject: [PATCH 13/17] move io.paths from extra to basis --- {extra => basis}/io/paths/authors.txt | 0 {extra => basis}/io/paths/paths.factor | 2 +- {extra => basis}/io/paths/windows/authors.txt | 0 {extra => basis}/io/paths/windows/tags.txt | 0 {extra => basis}/io/paths/windows/windows.factor | 0 5 files changed, 1 insertion(+), 1 deletion(-) rename {extra => basis}/io/paths/authors.txt (100%) rename {extra => basis}/io/paths/paths.factor (96%) rename {extra => basis}/io/paths/windows/authors.txt (100%) rename {extra => basis}/io/paths/windows/tags.txt (100%) rename {extra => basis}/io/paths/windows/windows.factor (100%) diff --git a/extra/io/paths/authors.txt b/basis/io/paths/authors.txt similarity index 100% rename from extra/io/paths/authors.txt rename to basis/io/paths/authors.txt diff --git a/extra/io/paths/paths.factor b/basis/io/paths/paths.factor similarity index 96% rename from extra/io/paths/paths.factor rename to basis/io/paths/paths.factor index 75d08b60f8..212ba9e396 100755 --- a/extra/io/paths/paths.factor +++ b/basis/io/paths/paths.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays deques dlists io.files io.paths.private +USING: accessors arrays deques dlists io.files kernel sequences system vocabs.loader fry continuations ; IN: io.paths diff --git a/extra/io/paths/windows/authors.txt b/basis/io/paths/windows/authors.txt similarity index 100% rename from extra/io/paths/windows/authors.txt rename to basis/io/paths/windows/authors.txt diff --git a/extra/io/paths/windows/tags.txt b/basis/io/paths/windows/tags.txt similarity index 100% rename from extra/io/paths/windows/tags.txt rename to basis/io/paths/windows/tags.txt diff --git a/extra/io/paths/windows/windows.factor b/basis/io/paths/windows/windows.factor similarity index 100% rename from extra/io/paths/windows/windows.factor rename to basis/io/paths/windows/windows.factor From 29bd77d04061158090b50ae9215298d4b3f903a6 Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Mon, 8 Dec 2008 21:32:09 -0600 Subject: [PATCH 14/17] Remove old trails --- extra/processing/gallery/trails/trails.factor | 47 ------------------- 1 file changed, 47 deletions(-) delete mode 100644 extra/processing/gallery/trails/trails.factor diff --git a/extra/processing/gallery/trails/trails.factor b/extra/processing/gallery/trails/trails.factor deleted file mode 100644 index a5b2b7b02a..0000000000 --- a/extra/processing/gallery/trails/trails.factor +++ /dev/null @@ -1,47 +0,0 @@ - -USING: kernel arrays sequences math math.order qualified - sequences.lib circular processing ui newfx processing.shapes ; - -IN: processing.gallery.trails - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -! Example 33-15 from the Processing book - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: point-list ( n -- seq ) [ drop 0 0 2array ] map ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: dot ( pos percent -- ) 1 swap - 25 * 5 max circle ; - -: step ( seq -- ) - - no-stroke - { 1 0.4 } fill - - 0 background - - mouse push-circular - [ dot ] - each-percent ; - -! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - -: go* ( -- ) - - 500 500 size* - - [ - 100 point-list - [ step ] - curry - draw - ] setup - - run ; - -: go ( -- ) [ go* ] with-ui ; - -MAIN: go From 101bc66b2b16d65fc16c576efafcf0e32b7f6553 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 21:32:19 -0600 Subject: [PATCH 15/17] add a unit test to io.paths --- basis/io/paths/paths-tests.factor | 11 +++++++++++ 1 file changed, 11 insertions(+) create mode 100644 basis/io/paths/paths-tests.factor diff --git a/basis/io/paths/paths-tests.factor b/basis/io/paths/paths-tests.factor new file mode 100644 index 0000000000..01763ce5c0 --- /dev/null +++ b/basis/io/paths/paths-tests.factor @@ -0,0 +1,11 @@ +USING: io.paths kernel tools.test io.files.unique sequences +io.files namespaces sorting ; +IN: io.paths.tests + +[ t ] [ + [ + 10 [ "io.paths.test" "gogogo" make-unique-file* ] replicate + current-directory get t [ ] find-all-files + ] with-unique-directory + [ natural-sort ] bi@ = +] unit-test From 154bc260c637c0c3670ad061648fc99243fdb076 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 21:32:36 -0600 Subject: [PATCH 16/17] remove io.files.unique.backend rename (make-unique-file) to touch-unique-file --- basis/io/files/unique/backend/backend.factor | 5 ---- basis/io/files/unique/unique.factor | 25 +++++++++++++------- basis/io/unix/files/unique/unique.factor | 4 ++-- basis/io/windows/files/unique/unique.factor | 8 +++---- 4 files changed, 22 insertions(+), 20 deletions(-) delete mode 100644 basis/io/files/unique/backend/backend.factor diff --git a/basis/io/files/unique/backend/backend.factor b/basis/io/files/unique/backend/backend.factor deleted file mode 100644 index 7b9809fa28..0000000000 --- a/basis/io/files/unique/backend/backend.factor +++ /dev/null @@ -1,5 +0,0 @@ -USING: io.backend ; -IN: io.files.unique.backend - -HOOK: (make-unique-file) io-backend ( path -- ) -HOOK: temporary-path io-backend ( -- path ) diff --git a/basis/io/files/unique/unique.factor b/basis/io/files/unique/unique.factor index ec89517bbc..66540fb48e 100644 --- a/basis/io/files/unique/unique.factor +++ b/basis/io/files/unique/unique.factor @@ -1,11 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel math math.bitwise math.parser -random sequences continuations namespaces -io.files io arrays io.files.unique.backend system -combinators vocabs.loader fry ; +USING: kernel math math.bitwise math.parser random sequences +continuations namespaces io.files io arrays system +combinators vocabs.loader fry io.backend ; IN: io.files.unique +HOOK: touch-unique-file io-backend ( path -- ) +HOOK: temporary-path io-backend ( -- path ) + SYMBOL: unique-length SYMBOL: unique-retries @@ -26,12 +28,17 @@ SYMBOL: unique-retries PRIVATE> +: (make-unique-file) ( path prefix suffix -- path ) + '[ + _ _ _ unique-length get random-name glue append-path + dup touch-unique-file + ] unique-retries get retry ; + : make-unique-file ( prefix suffix -- path ) - temporary-path -rot - [ - unique-length get random-name glue append-path - dup (make-unique-file) - ] 3curry unique-retries get retry ; + [ temporary-path ] 2dip (make-unique-file) ; + +: make-unique-file* ( prefix suffix -- path ) + [ current-directory get ] 2dip (make-unique-file) ; : with-unique-file ( prefix suffix quot: ( path -- ) -- ) [ make-unique-file ] dip [ delete-file ] bi ; inline diff --git a/basis/io/unix/files/unique/unique.factor b/basis/io/unix/files/unique/unique.factor index e47ac6a2e3..24dcdcb65a 100644 --- a/basis/io/unix/files/unique/unique.factor +++ b/basis/io/unix/files/unique/unique.factor @@ -1,13 +1,13 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: kernel io.ports io.unix.backend math.bitwise -unix io.files.unique.backend system ; +unix system io.files.unique ; IN: io.unix.files.unique : open-unique-flags ( -- flags ) { O_RDWR O_CREAT O_EXCL } flags ; -M: unix (make-unique-file) ( path -- ) +M: unix touch-unique-file ( path -- ) open-unique-flags file-mode open-file close-file ; M: unix temporary-path ( -- path ) "/tmp" ; diff --git a/basis/io/windows/files/unique/unique.factor b/basis/io/windows/files/unique/unique.factor index b1bf2bdc1c..ab99bf2cac 100644 --- a/basis/io/windows/files/unique/unique.factor +++ b/basis/io/windows/files/unique/unique.factor @@ -1,9 +1,9 @@ -USING: kernel system io.files.unique.backend -windows.kernel32 io.windows io.windows.files io.ports windows -destructors environment ; +USING: kernel system windows.kernel32 io.windows +io.windows.files io.ports windows destructors environment +io.files.unique ; IN: io.windows.files.unique -M: windows (make-unique-file) ( path -- ) +M: windows touch-unique-file ( path -- ) GENERIC_WRITE CREATE_NEW 0 open-file dispose ; M: windows temporary-path ( -- path ) From 08d0035ac873e91c8c4d48325d2afe72061347bf Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Mon, 8 Dec 2008 21:53:42 -0600 Subject: [PATCH 17/17] document new unique word --- basis/io/files/unique/unique-docs.factor | 36 +++++++++++++++++++++--- 1 file changed, 32 insertions(+), 4 deletions(-) diff --git a/basis/io/files/unique/unique-docs.factor b/basis/io/files/unique/unique-docs.factor index 825eb212f1..bfde09dc48 100644 --- a/basis/io/files/unique/unique-docs.factor +++ b/basis/io/files/unique/unique-docs.factor @@ -2,12 +2,40 @@ USING: help.markup help.syntax io io.ports kernel math io.files.unique.private math.parser io.files ; IN: io.files.unique +HELP: temporary-path +{ $values + { "path" "a pathname string" } +} +{ $description "A hook that returns the path of the temporary directory in a platform-specific way. Does not guarantee that path is writable by your user." } ; + +HELP: touch-unique-file +{ $values + { "path" "a pathname string" } +} +{ $description "Creates a unique file in a platform-specific way. The file is guaranteed not to exist and is openable by your user." } ; + +HELP: unique-length +{ $description "A symbol storing the number of random characters inserted between the prefix and suffix of a random file name." } ; + +HELP: unique-retries +{ $description "The number of times to try creating a unique file in case of a name collision. The odds of a name collision are extremely low with a sufficient " { $link unique-length } "." } ; + +{ unique-length unique-retries } related-words + HELP: make-unique-file ( prefix suffix -- path ) { $values { "prefix" "a string" } { "suffix" "a string" } { "path" "a pathname string" } } { $description "Creates a file that is guaranteed not to exist in a platform-specific temporary directory. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } -{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } -{ $see-also with-unique-file } ; +{ $errors "Throws an error if a new unique file cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ; + +HELP: make-unique-file* +{ $values + { "prefix" null } { "suffix" null } + { "path" "a pathname string" } +} +{ $description "Creates a file that is guaranteed not to exist in the directory in the " { $link current-directory } " variable. The file name is composed of a prefix, a number of random digits and letters, and the suffix. Returns the full pathname." } ; + +{ make-unique-file make-unique-file* with-unique-file } related-words HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- ) { $values { "prefix" "a string" } { "suffix" "a string" } @@ -18,8 +46,7 @@ HELP: with-unique-file ( prefix suffix quot: ( path -- ) -- ) HELP: make-unique-directory ( -- path ) { $values { "path" "a pathname string" } } { $description "Creates a directory that is guaranteed not to exist in a platform-specific temporary directory and returns the full pathname." } -{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } -{ $see-also with-unique-directory } ; +{ $errors "Throws an error if the directory cannot be created after a number of tries. The most likely error is incorrect directory permissions on the temporary directory." } ; HELP: with-unique-directory ( quot -- ) { $values { "quot" "a quotation" } } @@ -30,6 +57,7 @@ ARTICLE: "io.files.unique" "Temporary files" "The " { $vocab-link "io.files.unique" } " vocabulary implements cross-platform temporary file creation in a high-level and secure way." $nl "Files:" { $subsection make-unique-file } +{ $subsection make-unique-file* } { $subsection with-unique-file } "Directories:" { $subsection make-unique-directory }