Merge branch 'master' of git://factorcode.org/git/factor
						commit
						97df8037bc
					
				| 
						 | 
				
			
			@ -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." }
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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 version write
 | 
			
		||||
    "Factor #" write build number>string write
 | 
			
		||||
    " on " write os write "/" write cpu print ;
 | 
			
		||||
 | 
			
		||||
: listener ( -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -6,16 +6,20 @@ 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 %
 | 
			
		||||
        "temp/checksums.txt" , destination ,
 | 
			
		||||
    ] { } make try-process ;
 | 
			
		||||
 | 
			
		||||
: new-images ( -- )
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
: <time-display> ( timestamp -- gadget )
 | 
			
		||||
    [ hh:mm:ss lcd ] <filter> <label-control>
 | 
			
		||||
    "99:99:99" lcd over set-label-string
 | 
			
		||||
    monospace-font over set-label-font ;
 | 
			
		||||
 | 
			
		||||
: time-window ( -- )
 | 
			
		||||
    [ time get <time-display> "Time" open-window ] with-ui ;
 | 
			
		||||
 | 
			
		||||
MAIN: time-window
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -1 +1 @@
 | 
			
		|||
7-segment numeric display demo
 | 
			
		||||
7-segment LCD clock demo
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -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
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
| 
						 | 
				
			
			@ -17,6 +17,6 @@ SYMBOL: vocab-monitor
 | 
			
		|||
    [
 | 
			
		||||
        "" resource-path t <monitor> vocab-monitor set-global
 | 
			
		||||
        [ monitor-thread t ] "Vocabulary monitor" spawn-server drop
 | 
			
		||||
    ] [ drop ] recover ;
 | 
			
		||||
    ] ignore-errors ;
 | 
			
		||||
 | 
			
		||||
[ start-monitor-thread ] "vocabs.monitor" add-init-hook
 | 
			
		||||
| 
						 | 
				
			
			
 | 
			
		|||
		Loading…
	
		Reference in New Issue