New benchmarks and UI improvements

extra/benchmark/crc32/crc32.factor

@@ -0,0 +1,10 @@
+USING: io.crc32 io.files kernel math ;
+IN: benchmark.crc32
+
+: crc32-primes-list ( -- )
+    10 [
+        "extra/math/primes/list/list.factor" resource-path
+        file-contents crc32 drop
+    ] times ;
+
+MAIN: crc32-primes-list

extra/benchmark/md5/md5.factor

@@ -0,0 +1,7 @@
+USING: crypto.md5 io.files kernel ;
+IN: benchmark.md5
+
+: md5-primes-list ( -- )
+    "extra/math/primes/list/list.factor" resource-path file>md5 drop ;
+
+MAIN: md5-primes-list

extra/benchmark/random/random.factor

@@ -0,0 +1,14 @@
+USING: io.files random math.parser io math ;
+IN: benchmark.random
+
+: random-numbers-path "random-numbers.txt" temp-file ;
+
+: write-random-numbers ( n -- )
+    random-numbers-path [
+        [ 200 random 100 - number>string print ] times
+    ] with-file-writer ;
+
+: random-main ( -- )
+    1000000 write-random-numbers ;
+
+MAIN: random-main

extra/benchmark/sort/sort.factor

@@ -1,7 +1,8 @@
-USING: kernel sequences sorting random ;
+USING: kernel sequences sorting benchmark.random math.parser
+io.files ;
 IN: benchmark.sort
 
 : sort-benchmark
-    100000 [ drop 100000 random ] map natural-sort drop ;
+    random-numbers-path file-lines [ string>number ] map natural-sort drop ;
 
 MAIN: sort-benchmark

extra/benchmark/sum-file/sum-file.factor

@@ -1,4 +1,5 @@
-USING: io io.files math math.parser kernel prettyprint ;
+USING: io io.files math math.parser kernel prettyprint
+benchmark.random ;
 IN: benchmark.sum-file
 
 : sum-file-loop ( n -- n' )
@@ -8,6 +9,6 @@ IN: benchmark.sum-file
     [ 0 sum-file-loop ] with-file-reader . ;
 
 : sum-file-main ( -- )
-    home "sum-file-in.txt" path+ sum-file ;
+    random-numbers-path sum-file ;
 
 MAIN: sum-file-main

extra/help/handbook/handbook.factor

@@ -199,6 +199,7 @@ ARTICLE: "tools" "Developer tools"
 "Debugging tools:"
 { $subsection "tools.annotations" }
 { $subsection "tools.test" }
+{ $subsection "tools.threads" }
 "Performance tools:"
 { $subsection "tools.memory" }
 { $subsection "profiling" }

extra/help/help.factor

@@ -122,18 +122,31 @@ M: word set-article-parent swap "help-parent" set-word-prop ;
 
 : (:help-multi)
     "This error has multiple delegates:" print
-    ($index) nl ;
+    ($index) nl
+    "Use \\ ... help to get help about a specific delegate." print ;
 
 : (:help-none)
     drop "No help for this error. " print ;
 
+: (:help-debugger)
+    nl
+    "Debugger commands:" print
+    nl
+    ":help - documentation for this error" print
+    ":s    - data stack at exception time" print
+    ":r    - retain stack at exception time" print
+    ":c    - call stack at exception time" print
+    ":edit - jump to source location (parse errors only)" print
+
+    ":get  ( var -- value ) accesses variables at time of the error" print ;
+
 : :help ( -- )
     error get delegates [ error-help ] map [ ] subset
     {
         { [ dup empty? ] [ (:help-none) ] }
         { [ dup length 1 = ] [ first help ] }
         { [ t ] [ (:help-multi) ] }
-    } cond ;
+    } cond (:help-debugger) ;
 
 : remove-article ( name -- )
     dup articles get key? [

extra/opengl/gl/extensions/extensions.factor

@@ -17,7 +17,7 @@ SYMBOL: +gl-function-pointers+
 : reset-gl-function-pointers ( -- )
     100 <hashtable> +gl-function-pointers+ set-global ;
     
-[ reset-gl-function-pointers ] "opengl.gl init hook" add-init-hook
+[ reset-gl-function-pointers ] "opengl.gl" add-init-hook
 reset-gl-function-pointers
 reset-gl-function-number-counter
 

extra/tools/threads/threads-docs.factor

@@ -0,0 +1,17 @@
+IN: tools.threads
+USING: help.markup help.syntax threads ;
+
+HELP: threads.
+{ $description "Prints a list of running threads and their state. The ``Waiting on'' column displays one of the following:"
+    { $list
+        "``running'' if the thread is the current thread"
+        "``yield'' if the thread is waiting to run"
+        { "the string given to " { $link suspend } " if the thread is suspended" }
+    }
+} ;
+
+ARTICLE: "tools.threads" "Listing threads"
+"Printing a list of running threads:"
+{ $subsection threads. } ;
+
+ABOUT: "tools.threads"

extra/ui/gadgets/buttons/buttons.factor

@@ -88,7 +88,6 @@ TUPLE: repeat-button ;
 
 repeat-button H{
     { T{ drag } [ button-clicked ] }
-    { T{ button-down } [ button-clicked ] }
 } set-gestures
 
 : <repeat-button> ( label quot -- button )

extra/ui/tools/listener/listener.factor

@@ -40,9 +40,14 @@ M: listener-gadget call-tool* ( input listener -- )
 M: listener-gadget tool-scroller
     listener-gadget-output find-scroller ;
 
+: wait-for-listener ( listener -- )
+    #! Wait for the listener to start.
+    listener-gadget-input interactor-flag wait-for-flag ;
+
 : workspace-busy? ( workspace -- ? )
-    workspace-listener listener-gadget-input
+    workspace-listener
-    interactor-busy? ;
+    dup wait-for-listener
+    listener-gadget-input interactor-busy? ;
 
 : get-listener ( -- listener )
     [ workspace-busy? not ] get-workspace* workspace-listener ;
@@ -134,10 +139,6 @@ M: stack-display tool-scroller
 : start-listener-thread ( listener -- )
     [ listener-thread ] curry "Listener" spawn drop ;
 
-: wait-for-listener ( listener -- )
-    #! Wait for the listener to start.
-    listener-gadget-input interactor-flag wait-for-flag ;
-
 : restart-listener ( listener -- )
     #! Returns when listener is ready to receive input.
     dup com-end dup clear-output

extra/ui/tools/tools.factor

@@ -1,15 +1,14 @@
-! Copyright (C) 2006, 2007 Slava Pestov.
+! Copyright (C) 2006, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays assocs debugger ui.tools.workspace
-ui.tools.operations ui.tools.browser ui.tools.inspector
+ui.tools.operations ui.tools.traceback ui.tools.browser
-ui.tools.listener ui.tools.profiler
+ui.tools.inspector ui.tools.listener ui.tools.profiler
 ui.tools.operations inspector io kernel math models namespaces
 prettyprint quotations sequences ui ui.commands ui.gadgets
-ui.gadgets.books ui.gadgets.buttons
+ui.gadgets.books ui.gadgets.buttons ui.gadgets.labelled
-ui.gadgets.labelled ui.gadgets.scrollers ui.gadgets.tracks
+ui.gadgets.scrollers ui.gadgets.tracks ui.gadgets.worlds
-ui.gadgets.worlds ui.gadgets.presentations ui.gestures words
+ui.gadgets.presentations ui.gestures words vocabs.loader
-vocabs.loader tools.test ui.gadgets.buttons
+tools.test ui.gadgets.buttons ui.gadgets.status-bar mirrors ;
-ui.gadgets.status-bar mirrors ;
 IN: ui.tools
 
 : <workspace-tabs> ( -- tabs )
@@ -83,7 +82,13 @@ workspace "workflow" f {
 } define-command-map
 
 [
-    <workspace>
+    <workspace> "Factor workspace" open-status-window
-    dup "Factor workspace" open-status-window
-    workspace-listener wait-for-listener
 ] workspace-window-hook set-global
+
+: inspect-continuation ( traceback -- )
+    control-value [ inspect ] curry call-listener ;
+
+traceback-gadget "toolbar" f {
+    { T{ key-down f f "v" } variables }
+    { T{ key-down f f "n" } inspect-continuation }
+} define-command-map

extra/ui/tools/traceback/traceback.factor

@@ -54,7 +54,3 @@ M: variables-gadget pref-dim* drop { 400 400 } ;
 
 : traceback-window ( continuation -- )
     <model> <traceback-gadget> "Traceback" open-window ;
-
-traceback-gadget "toolbar" f {
-    { T{ key-down f f "v" } variables }
-} define-command-map

extra/ui/tools/walker/walker.factor

@@ -7,7 +7,7 @@ ui.tools.workspace ui.gestures ui.gadgets.labels ui threads
 namespaces tools.walker assocs ;
 IN: ui.tools.walker
 
-TUPLE: walker-gadget status continuation thread ;
+TUPLE: walker-gadget status continuation thread traceback ;
 
 : walker-command ( walker msg -- )
     over walker-gadget-thread thread-registered?
@@ -29,6 +29,9 @@ TUPLE: walker-gadget status continuation thread ;
 M: walker-gadget ungraft*
     dup delegate ungraft* detach walker-command ;
 
+M: walker-gadget focusable-child*
+    walker-gadget-traceback ;
+
 : walker-state-string ( status thread -- string )
     [
         "Thread: " %
@@ -48,10 +51,10 @@ M: walker-gadget ungraft*
     [ walker-state-string ] curry <filter> <label-control> ;
 
 : <walker-gadget> ( status continuation thread -- gadget )
-    walker-gadget construct-boa [
+    over <traceback-gadget> walker-gadget construct-boa [
         toolbar,
         g walker-gadget-status self <thread-status> f track,
-        g walker-gadget-continuation <traceback-gadget> 1 track,
+        g walker-gadget-traceback 1 track,
     ] { 0 1 } build-track ;
 
 : walker-help "ui-walker" help-window ;