From 49461c8eb459d11e42b8b5b65c16d193ff9a11a8 Mon Sep 17 00:00:00 2001 From: slava Date: Fri, 26 May 2006 03:25:00 +0000 Subject: [PATCH] Major UI improvements, fix problem with deferred words --- library/bootstrap/boot-stage1.factor | 5 +- library/cocoa/menu-bar.factor | 2 +- library/test/collections/sequences.factor | 6 ++ library/test/words.factor | 5 +- library/tools/debugger.factor | 43 +++++--- library/tools/describe.factor | 6 +- {contrib => library/tools}/inspector.factor | 2 + library/tools/listener.factor | 10 +- library/ui/borders.factor | 2 +- library/ui/browser.factor | 67 ++++++------- library/ui/environment.factor | 13 +++ library/ui/frames.factor | 2 +- library/ui/help.factor | 45 +++++++++ library/ui/inspector.factor | 106 -------------------- library/ui/launchpad.factor | 11 +- library/ui/listener.factor | 38 +++---- library/ui/panes.factor | 2 +- library/ui/tabs.factor | 48 +++++++++ library/ui/tiles.factor | 28 ++++++ library/ui/tracks.factor | 25 ++++- native/run.c | 2 +- 21 files changed, 268 insertions(+), 200 deletions(-) rename {contrib => library/tools}/inspector.factor (98%) create mode 100644 library/ui/help.factor delete mode 100644 library/ui/inspector.factor create mode 100644 library/ui/tabs.factor create mode 100644 library/ui/tiles.factor diff --git a/library/bootstrap/boot-stage1.factor b/library/bootstrap/boot-stage1.factor index 3586848cd3..5c250fa6b7 100644 --- a/library/bootstrap/boot-stage1.factor +++ b/library/bootstrap/boot-stage1.factor @@ -109,6 +109,7 @@ vectors words ; "/library/tools/memory.factor" "/library/tools/listener.factor" + "/library/tools/inspector.factor" "/library/tools/walker.factor" "/library/tools/annotations.factor" @@ -182,6 +183,7 @@ vectors words ; "/library/ui/gestures.factor" "/library/ui/borders.factor" "/library/ui/buttons.factor" + "/library/ui/tiles.factor" "/library/ui/line-editor.factor" "/library/ui/sliders.factor" "/library/ui/viewports.factor" @@ -191,13 +193,14 @@ vectors words ; "/library/ui/incremental.factor" "/library/ui/paragraphs.factor" "/library/ui/panes.factor" + "/library/ui/tabs.factor" "/library/ui/outliner.factor" "/library/ui/environment.factor" "/library/ui/presentations.factor" "/library/ui/listener.factor" - "/library/ui/inspector.factor" "/library/ui/browser.factor" "/library/ui/apropos.factor" + "/library/ui/help.factor" "/library/ui/launchpad.factor" "/library/continuations.facts" diff --git a/library/cocoa/menu-bar.factor b/library/cocoa/menu-bar.factor index e35086efb6..d85e8e44c3 100644 --- a/library/cocoa/menu-bar.factor +++ b/library/cocoa/menu-bar.factor @@ -113,7 +113,7 @@ DEFER: described-menu { { "File" { "New Listener" listener-window "n" } - { "New Browser" [ f browser-window ] "b" } + { "New Browser" browser-window "b" } { } { "Run..." menu-run-file "o" } { } diff --git a/library/test/collections/sequences.factor b/library/test/collections/sequences.factor index 0df365b5d6..4c14f957e4 100644 --- a/library/test/collections/sequences.factor +++ b/library/test/collections/sequences.factor @@ -212,3 +212,9 @@ unit-test [ 10 "hi" "bye" copy-into ] unit-test-fails [ { 1 2 3 5 6 } ] [ 3 { 1 2 3 4 5 6 } remove-index ] unit-test + +[ V{ 1 2 3 } ] +[ 3 V{ 1 2 } clone [ push-new ] keep ] unit-test + +[ V{ 1 2 3 } ] +[ 3 V{ 1 3 2 } clone [ push-new ] keep ] unit-test diff --git a/library/test/words.factor b/library/test/words.factor index c3aef4ee80..b4b5d18df2 100644 --- a/library/test/words.factor +++ b/library/test/words.factor @@ -1,5 +1,5 @@ IN: temporary -USING: arrays generic hashtables kernel math namespaces +USING: arrays errors generic hashtables kernel math namespaces sequences test words ; [ 4 ] [ @@ -99,6 +99,9 @@ GENERIC: freakish M: array freakish ; [ t ] [ \ bar \ freakish usage member? ] unit-test +DEFER: x +[ t ] [ [ x ] catch third \ x eq? ] unit-test + ! This has to be the last test in the file. : test-last ( -- ) ; diff --git a/library/tools/debugger.factor b/library/tools/debugger.factor index e39edbbbf1..49e08b1155 100644 --- a/library/tools/debugger.factor +++ b/library/tools/debugger.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2004, 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -IN: errors USING: arrays generic hashtables inspector io kernel kernel-internals math namespaces parser prettyprint sequences -sequences-internals strings vectors words ; +sequences-internals strings styles vectors words ; +IN: errors SYMBOL: error SYMBOL: error-continuation @@ -128,32 +128,51 @@ M: object error. ( error -- ) . ; : :res ( n -- ) restarts get nth first3 continue-with ; +: (debug-help) ( string quot -- ) + simple-object terpri ; + +: restart. ( restart n -- ) + [ [ # " :res " % first % ] "" make ] keep + [ :res ] curry (debug-help) ; + : restarts. ( -- ) restarts get dup empty? [ drop ] [ + terpri "The following restarts are available:" print - dup length [ - number>string write " :res " write first print - ] 2each + terpri + dup length [ restart. ] 2each ] if ; +DEFER: :error +DEFER: :cc + : debug-help ( -- ) - restarts. - ":s :r :c show stacks at time of error" print + terpri + "Debugger commands:" print + terpri + ":s data stack at exception time" [ :s ] (debug-help) + ":r retain stack at exception time" [ :r ] (debug-help) + ":c call stack at exception time" [ :c ] (debug-help) + ":error starts the inspector with the error" [ :error ] (debug-help) + ":cc starts the inspector with the error continuation" [ :cc ] (debug-help) ":get ( var -- value ) accesses variables at time of error" print - ":error starts the inspector with the error" print - ":cc starts the inspector with the error continuation" print flush ; : flush-error-handler ( -- ) [ "Error in default error handler!" print ] when ; : print-error ( error -- ) - "An unhandled error was caught:" print terpri - [ dup error. ] catch nip flush-error-handler ; + [ + dup error. + restarts. + debug-help + ] [ + "Error in print-error!" print + ] recover drop ; -: try ( quot -- ) [ print-error terpri debug-help ] recover ; +: try ( quot -- ) [ print-error ] recover ; : save-error ( error continuation -- ) error-continuation set-global diff --git a/library/tools/describe.factor b/library/tools/describe.factor index 8ecc73fd23..2bdc305971 100644 --- a/library/tools/describe.factor +++ b/library/tools/describe.factor @@ -2,7 +2,8 @@ ! See http://factorcode.org/license.txt for BSD license. IN: inspector USING: arrays generic hashtables help io kernel kernel-internals -math namespaces prettyprint sequences strings vectors words ; +math namespaces prettyprint sequences strings styles vectors +words ; GENERIC: summary ( object -- string ) @@ -61,6 +62,9 @@ M: word summary ( word -- ) drop "a uniquely generated symbol" ] if ; +M: input summary ( input -- ) + "Input: " swap input-string unparse-short append ; + : format-column ( list ? -- list ) >r [ unparse-short ] map r> [ [ 0 [ length max ] reduce ] keep diff --git a/contrib/inspector.factor b/library/tools/inspector.factor similarity index 98% rename from contrib/inspector.factor rename to library/tools/inspector.factor index c7ac43e8d3..c6aea29407 100644 --- a/contrib/inspector.factor +++ b/library/tools/inspector.factor @@ -23,7 +23,9 @@ SYMBOL: inspector-stack sheet sheet-numbers sheet. ; : inspector-help ( -- ) + terpri "Object inspector." print + terpri "inspecting ( -- obj ) push current object" print "go ( n -- ) inspect nth slot" print "up -- return to previous object" print diff --git a/library/tools/listener.factor b/library/tools/listener.factor index 6402185939..0281143e7d 100644 --- a/library/tools/listener.factor +++ b/library/tools/listener.factor @@ -9,10 +9,8 @@ SYMBOL: quit-flag SYMBOL: listener-hook SYMBOL: datastack-hook -SYMBOL: error-hook " " listener-prompt set-global -[ drop terpri debug-help ] error-hook set-global : bye ( -- ) quit-flag on ; @@ -32,16 +30,10 @@ SYMBOL: error-hook f depth (read-multiline) >r >quotation r> in get ] with-parser in set ; -: listen-try - [ - print-error error-continuation get error-hook get call - ] recover ; - : listen ( -- ) listener-hook get call listener-prompt get write flush - [ read-multiline [ call ] [ bye ] if ] - listen-try ; + [ read-multiline [ call ] [ bye ] if ] try ; : (listener) ( -- ) quit-flag get [ quit-flag off ] [ listen (listener) ] if ; diff --git a/library/ui/borders.factor b/library/ui/borders.factor index e79d662547..e5e37c31f5 100644 --- a/library/ui/borders.factor +++ b/library/ui/borders.factor @@ -12,7 +12,7 @@ C: border ( child gap -- border ) [ add-gadget ] keep ; : ( child -- border ) - 5 ; + 3 ; : layout-border-loc ( border -- ) dup border-size swap gadget-child set-rect-loc ; diff --git a/library/ui/browser.factor b/library/ui/browser.factor index ad0e3b254c..826074756a 100644 --- a/library/ui/browser.factor +++ b/library/ui/browser.factor @@ -1,9 +1,9 @@ ! Copyright (C) 2006 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. IN: gadgets-browser -USING: gadgets gadgets-buttons gadgets-inspector gadgets-labels -gadgets-layouts gadgets-panes gadgets-presentations -gadgets-scrolling gadgets-theme gadgets-tracks generic +USING: gadgets gadgets-buttons gadgets-labels gadgets-layouts +gadgets-panes gadgets-presentations gadgets-scrolling +gadgets-tabs gadgets-tiles gadgets-theme gadgets-tracks generic hashtables help inspector kernel math prettyprint sequences words ; @@ -36,41 +36,32 @@ TUPLE: browser vocabs vocab-track word-track ; : find-browser [ browser? ] find-parent ; -TUPLE: tile ; - -: find-tile [ tile? ] find-parent ; - : close-tile ( tile -- ) dup gadget-parent [ browser-track-showing hash>alist rassoc ] keep hide-asset ; -: ( -- gadget ) - { 0.0 0.0 0.0 1.0 } close-box - [ find-tile close-tile ] ; - -: ( title -- gadget ) - { - { [