From aeef08cd514009522ee58c6784ad339d0a1bddbe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 14:57:37 -0600 Subject: [PATCH 1/8] Improve LCD demo --- extra/lcd/lcd.factor | 22 ++++++++++++++++++---- extra/lcd/summary.txt | 2 +- 2 files changed, 19 insertions(+), 5 deletions(-) mode change 100644 => 100755 extra/lcd/summary.txt diff --git a/extra/lcd/lcd.factor b/extra/lcd/lcd.factor index 605ac4cd59..c2eba8b7b6 100755 --- a/extra/lcd/lcd.factor +++ b/extra/lcd/lcd.factor @@ -1,4 +1,6 @@ -USING: sequences kernel math io ; +USING: sequences kernel math io calendar calendar.model +arrays models namespaces ui.gadgets ui.gadgets.labels +ui.gadgets.theme ui ; IN: lcd : lcd-digit ( row digit -- str ) @@ -6,14 +8,26 @@ IN: lcd " _ _ _ _ _ _ _ _ " " | | | _| _| |_| |_ |_ | |_| |_| * " " |_| | |_ _| | _| |_| | |_| | * " + " " } nth >r 4 * dup 4 + r> subseq ; : lcd-row ( num row -- string ) [ swap lcd-digit ] curry { } map-as concat ; : lcd ( digit-str -- string ) - 3 [ lcd-row ] with map "\n" join ; + 4 [ lcd-row ] with map "\n" join ; -: lcd-demo ( -- ) "31337" lcd print ; +: hh:mm:ss ( timestamp -- string ) + { + timestamp-hour timestamp-minute timestamp-second + } get-slots >fixnum 3array [ pad-00 ] map ":" join ; -MAIN: lcd-demo +: ( timestamp -- gadget ) + [ hh:mm:ss lcd ] + "99:99:99" lcd over set-label-string + monospace-font over set-label-font ; + +: time-window ( -- ) + [ time get "Time" open-window ] with-ui ; + +MAIN: time-window diff --git a/extra/lcd/summary.txt b/extra/lcd/summary.txt old mode 100644 new mode 100755 index 1b6436a614..e477045071 --- a/extra/lcd/summary.txt +++ b/extra/lcd/summary.txt @@ -1 +1 @@ -7-segment numeric display demo +7-segment LCD clock demo From da575528cf4b69f236c7b5b7a8e87e979835dcfb Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 14:58:02 -0600 Subject: [PATCH 2/8] Add ignore-errors to core --- core/continuations/continuations-docs.factor | 7 ++++++- core/continuations/continuations.factor | 3 +++ extra/tools/test/test.factor | 3 --- extra/vocabs/monitor/monitor.factor | 2 +- 4 files changed, 10 insertions(+), 5 deletions(-) diff --git a/core/continuations/continuations-docs.factor b/core/continuations/continuations-docs.factor index a1e2525c14..5fc86e25d4 100755 --- a/core/continuations/continuations-docs.factor +++ b/core/continuations/continuations-docs.factor @@ -23,9 +23,10 @@ $nl "Two words raise an error in the innermost error handler for the current dynamic extent:" { $subsection throw } { $subsection rethrow } -"Two words for establishing an error handler:" +"Words for establishing an error handler:" { $subsection cleanup } { $subsection recover } +{ $subsection ignore-errors } "Unhandled errors are reported in the listener and can be debugged using various tools. See " { $link "debugger" } "." { $subsection "errors-restartable" } { $subsection "errors-post-mortem" } ; @@ -148,6 +149,10 @@ HELP: recover { $values { "try" quotation } { "recovery" "a quotation with stack effect " { $snippet "( error -- )" } } } { $description "Calls the " { $snippet "try" } " quotation. If an exception is thrown in the dynamic extent of the " { $snippet "try" } " quotation, restores the data stack and calls the " { $snippet "recovery" } " quotation to handle the error." } ; +HELP: ignore-errors +{ $values { "try" quotation } } +{ $description "Calls the quotation. If an exception is thrown in the dynamic extent of the quotation, restores the data stack and returns." } ; + HELP: rethrow { $values { "error" object } } { $description "Throws an error without saving the current continuation in the " { $link error-continuation } " global variable. This is done so that inspecting the error stacks sheds light on the original cause of the exception, rather than the point where it was rethrown." } diff --git a/core/continuations/continuations.factor b/core/continuations/continuations.factor index a0aa59332e..d68b5b2433 100755 --- a/core/continuations/continuations.factor +++ b/core/continuations/continuations.factor @@ -120,6 +120,9 @@ SYMBOL: thread-error-hook : recover ( try recovery -- ) >r [ swap >c call c> drop ] curry r> ifcc ; inline +: ignore-errors ( quot -- ) + [ drop ] recover ; inline + : cleanup ( try cleanup-always cleanup-error -- ) over >r compose [ dip rethrow ] curry recover r> call ; inline diff --git a/extra/tools/test/test.factor b/extra/tools/test/test.factor index 69093f18a6..0ab68f502e 100755 --- a/extra/tools/test/test.factor +++ b/extra/tools/test/test.factor @@ -48,9 +48,6 @@ SYMBOL: this-test : must-fail ( quot -- ) [ drop t ] must-fail-with ; -: ignore-errors ( quot -- ) - [ drop ] recover ; inline - : (run-test) ( vocab -- ) dup vocab-source-loaded? [ vocab-tests diff --git a/extra/vocabs/monitor/monitor.factor b/extra/vocabs/monitor/monitor.factor index d3e4a44896..32a104687e 100755 --- a/extra/vocabs/monitor/monitor.factor +++ b/extra/vocabs/monitor/monitor.factor @@ -17,6 +17,6 @@ SYMBOL: vocab-monitor [ "" resource-path t vocab-monitor set-global [ monitor-thread t ] "Vocabulary monitor" spawn-server drop - ] [ drop ] recover ; + ] ignore-errors ; [ start-monitor-thread ] "vocabs.monitor" add-init-hook From 5a8ab4f6ee33b73fc983cef4f00e9e7e851c4370 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 14:58:16 -0600 Subject: [PATCH 3/8] Use temp-file --- extra/bootstrap/image/upload/upload.factor | 6 ++++-- extra/bunny/model/model.factor | 4 ++-- 2 files changed, 6 insertions(+), 4 deletions(-) diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 552e26ebf5..0cdc7ccc26 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -6,16 +6,18 @@ bootstrap.image sequences io namespaces io.launcher math ; : destination "slava@factorcode.org:www/images/latest/" ; +: checksums "checksums.txt" temp-file ; + : boot-image-names images [ boot-image-name ] map ; : compute-checksums ( -- ) - "checksums.txt" [ + checksums [ boot-image-names [ dup write bl file>md5str print ] each ] with-file-writer ; : upload-images ( -- ) [ - "scp" , boot-image-names % "checksums.txt" , destination , + "scp" , boot-image-names % checksums , destination , ] { } make try-process ; : new-images ( -- ) diff --git a/extra/bunny/model/model.factor b/extra/bunny/model/model.factor index 2d731dd830..49a0f9254a 100755 --- a/extra/bunny/model/model.factor +++ b/extra/bunny/model/model.factor @@ -39,12 +39,12 @@ IN: bunny.model [ normals ] 2keep 3array ] time ; -: model-path "bun_zipper.ply" ; +: model-path "bun_zipper.ply" temp-file ; : model-url "http://factorcode.org/bun_zipper.ply" ; : maybe-download ( -- path ) - model-path resource-path dup exists? [ + model-path dup exists? [ "Downloading bunny from " write model-url dup print flush over download-to From 4c3eabe9a3a46a2944cea6aae16c39341f8728a1 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 14:58:41 -0600 Subject: [PATCH 4/8] Handle repaint messages properly --- extra/ui/windows/windows.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index 45da2706f4..b5ab63c4c8 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -85,7 +85,7 @@ SYMBOL: mouse-captured : handle-wm-paint ( hWnd uMsg wParam lParam -- ) #! wParam and lParam are unused #! only paint if width/height both > 0 - 3drop window relayout-1 ; + 3drop window relayout-1 yield ; : handle-wm-size ( hWnd uMsg wParam lParam -- ) 2nip From d143eedb6887b0ba58c257f7994240b174fb40a2 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 15:22:39 -0600 Subject: [PATCH 5/8] Fix image upload for cygwin --- extra/bootstrap/image/upload/upload.factor | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/extra/bootstrap/image/upload/upload.factor b/extra/bootstrap/image/upload/upload.factor index 0cdc7ccc26..1fa8ee4f41 100755 --- a/extra/bootstrap/image/upload/upload.factor +++ b/extra/bootstrap/image/upload/upload.factor @@ -17,7 +17,9 @@ bootstrap.image sequences io namespaces io.launcher math ; : upload-images ( -- ) [ - "scp" , boot-image-names % checksums , destination , + "scp" , + boot-image-names % + "temp/checksums.txt" , destination , ] { } make try-process ; : new-images ( -- ) From 0c9855167736d9f045cb127150b060f3b848d927 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 15:22:49 -0600 Subject: [PATCH 6/8] Add failing test --- extra/calendar/calendar-tests.factor | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/extra/calendar/calendar-tests.factor b/extra/calendar/calendar-tests.factor index a3ae5f115a..a03ebeffcb 100755 --- a/extra/calendar/calendar-tests.factor +++ b/extra/calendar/calendar-tests.factor @@ -161,3 +161,19 @@ continuations system io.streams.string ; [ 1+1/2 ] [ "+01:30" [ read-rfc3339-gmt-offset ] with-string-reader ] unit-test + +: check+dt now dup clone [ rot +dt drop ] keep = ; + +[ t ] [ 5 seconds check+dt ] unit-test + +[ t ] [ 5 minutes check+dt ] unit-test + +[ t ] [ 5 hours check+dt ] unit-test + +[ t ] [ 5 days check+dt ] unit-test + +[ t ] [ 5 weeks check+dt ] unit-test + +[ t ] [ 5 months check+dt ] unit-test + +[ t ] [ 5 years check+dt ] unit-test From dd9ace770710d339f02e4610743365a5cb56189a Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 15:24:30 -0600 Subject: [PATCH 7/8] Don't need version number anymore --- core/kernel/kernel.factor | 2 -- core/listener/listener.factor | 2 +- 2 files changed, 1 insertion(+), 3 deletions(-) diff --git a/core/kernel/kernel.factor b/core/kernel/kernel.factor index d1f3af4779..61574e406f 100755 --- a/core/kernel/kernel.factor +++ b/core/kernel/kernel.factor @@ -3,8 +3,6 @@ USING: kernel.private ; IN: kernel -: version ( -- str ) "0.92" ; foldable - ! Stack stuff : spin ( x y z -- z y x ) swap rot ; inline diff --git a/core/listener/listener.factor b/core/listener/listener.factor index 288cb53322..c3142bde4d 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -63,7 +63,7 @@ M: duplex-stream stream-read-quot [ listen until-quit ] if ; inline : print-banner ( -- ) - "Factor " write version write + "Factor #" write build write " on " write os write "/" write cpu print ; : listener ( -- ) From ac02bd8319c7dd906399e641e7e9bdfdb69945fe Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 26 Feb 2008 16:45:06 -0600 Subject: [PATCH 8/8] Fix listener --- core/listener/listener.factor | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/core/listener/listener.factor b/core/listener/listener.factor index c3142bde4d..110f0d3ee1 100755 --- a/core/listener/listener.factor +++ b/core/listener/listener.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2003, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: arrays hashtables io kernel math memory namespaces -parser sequences strings io.styles io.streams.lines +USING: arrays hashtables io kernel math math.parser memory +namespaces parser sequences strings io.styles io.streams.lines io.streams.duplex vectors words generic system combinators tuples continuations debugger definitions compiler.units ; IN: listener @@ -63,7 +63,7 @@ M: duplex-stream stream-read-quot [ listen until-quit ] if ; inline : print-banner ( -- ) - "Factor #" write build write + "Factor #" write build number>string write " on " write os write "/" write cpu print ; : listener ( -- )