From a1bdbd7143caf7fb644f0fe816660c92d0212daa Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 19:20:22 -0500 Subject: [PATCH 1/3] Remove debug message --- core/sequences/sequences.factor | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index f179bf069c..de10e5c2e4 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -44,7 +44,7 @@ M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; TUPLE: bounds-error index seq ; : bounds-error ( n seq -- * ) - die \ bounds-error construct-boa throw ; + \ bounds-error construct-boa throw ; : bounds-check ( n seq -- n seq ) 2dup bounds-check? [ bounds-error ] unless ; inline From c5c7999a1577c13d5bdcbbc4b2f0bbd3163046d7 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Wed, 21 Nov 2007 19:21:02 -0500 Subject: [PATCH 2/3] Doc update --- extra/help/handbook/handbook.factor | 2 ++ 1 file changed, 2 insertions(+) mode change 100644 => 100755 extra/help/handbook/handbook.factor diff --git a/extra/help/handbook/handbook.factor b/extra/help/handbook/handbook.factor old mode 100644 new mode 100755 index 749a5ed0ec..d1b48d9955 --- a/extra/help/handbook/handbook.factor +++ b/extra/help/handbook/handbook.factor @@ -48,6 +48,7 @@ $nl { "pathname string" { "an OS-specific pathname which identifies a file" } } { "sequence" { "an object whose class implements the " { $link "sequence-protocol" } } } { "slot" { "a component of an object which can store a value" } } + { "stack effect" { "a pictorial representation of a word's inputs and outputs, for example " { $snippet "+ ( x y -- z )" } ". See " { $link "effects" } } } { "true value" { "any object not equal to " { $link f } } } { "vocabulary" { "a named set of words. See " { $link "vocabularies" } } } { "vocabulary specifier" { "a " { $link vocab } ", " { $link vocab-link } " or a string naming a vocabulary" } } @@ -71,6 +72,7 @@ $nl ARTICLE: "dataflow" "Data and control flow" { $subsection "evaluator" } { $subsection "words" } +{ $subsection "effects" } { $subsection "shuffle-words" } { $subsection "booleans" } { $subsection "conditionals" } From a7ef4eb1a2d81b4236550dc17527aedd7f4b73e4 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 22 Nov 2007 01:40:17 -0500 Subject: [PATCH 3/3] Fix saving UI state in image --- extra/tools/test/ui/ui.factor | 2 +- extra/ui/backend/backend.factor | 4 +- extra/ui/gadgets/editors/editors-tests.factor | 2 +- extra/ui/gadgets/gadgets-tests.factor | 2 +- .../gadgets/scrollers/scrollers-tests.factor | 2 +- extra/ui/gadgets/scrollers/scrollers.factor | 2 +- extra/ui/gadgets/worlds/worlds.factor | 10 --- extra/ui/tools/browser/browser-tests.factor | 2 +- extra/ui/tools/listener/listener-tests.factor | 2 +- extra/ui/tools/search/search-tests.factor | 2 +- extra/ui/tools/tools-tests.factor | 2 +- extra/ui/tools/walker/walker-tests.factor | 2 +- extra/ui/tools/workspace/workspace.factor | 2 +- extra/ui/ui-docs.factor | 12 +--- extra/ui/ui.factor | 65 +++++++++++++++---- extra/ui/windows/windows.factor | 10 +-- 16 files changed, 76 insertions(+), 47 deletions(-) mode change 100644 => 100755 extra/ui/backend/backend.factor diff --git a/extra/tools/test/ui/ui.factor b/extra/tools/test/ui/ui.factor index 0376e7f4c7..6dcf9da4b5 100755 --- a/extra/tools/test/ui/ui.factor +++ b/extra/tools/test/ui/ui.factor @@ -1,5 +1,5 @@ USING: dlists ui.gadgets kernel ui namespaces io.streams.string -io ; +io ui.private ; IN: tools.test.ui ! We can't print to stdio here because that might be a pane diff --git a/extra/ui/backend/backend.factor b/extra/ui/backend/backend.factor old mode 100644 new mode 100755 index 09ce18280b..a0646f35b0 --- a/extra/ui/backend/backend.factor +++ b/extra/ui/backend/backend.factor @@ -7,7 +7,9 @@ SYMBOL: ui-backend HOOK: set-title ui-backend ( string world -- ) -HOOK: (open-world-window) ui-backend ( world -- ) +HOOK: (open-window) ui-backend ( world -- ) + +HOOK: (close-window) ui-backend ( handle -- ) HOOK: raise-window ui-backend ( world -- ) diff --git a/extra/ui/gadgets/editors/editors-tests.factor b/extra/ui/gadgets/editors/editors-tests.factor index 6be0423e95..6966e9639f 100755 --- a/extra/ui/gadgets/editors/editors-tests.factor +++ b/extra/ui/gadgets/editors/editors-tests.factor @@ -1,5 +1,5 @@ USING: ui.gadgets.editors tools.test kernel io io.streams.plain -definitions namespaces ui.gadgets +definitions namespaces ui.gadgets ui.private ui.gadgets.grids prettyprint documents ui.gestures tools.test.inference tools.test.ui models ; diff --git a/extra/ui/gadgets/gadgets-tests.factor b/extra/ui/gadgets/gadgets-tests.factor index 48bb3718cb..6c651fa248 100755 --- a/extra/ui/gadgets/gadgets-tests.factor +++ b/extra/ui/gadgets/gadgets-tests.factor @@ -2,7 +2,7 @@ IN: temporary USING: ui.gadgets ui.gadgets.packs ui.gadgets.worlds tools.test namespaces models kernel tools.test.inference dlists math math.parser ui sequences hashtables assocs io arrays -prettyprint io.streams.string ; +prettyprint io.streams.string ui.private ; [ T{ rect f { 10 10 } { 20 20 } } ] [ diff --git a/extra/ui/gadgets/scrollers/scrollers-tests.factor b/extra/ui/gadgets/scrollers/scrollers-tests.factor index a53cf1fb0e..7d0dd0158f 100755 --- a/extra/ui/gadgets/scrollers/scrollers-tests.factor +++ b/extra/ui/gadgets/scrollers/scrollers-tests.factor @@ -1,5 +1,5 @@ IN: temporary -USING: ui.gadgets ui.gadgets.scrollers +USING: ui.gadgets ui.gadgets.scrollers ui.private namespaces tools.test kernel models ui.gadgets.viewports ui.gadgets.labels ui.gadgets.grids ui.gadgets.frames ui.gadgets.sliders math math.vectors arrays sequences diff --git a/extra/ui/gadgets/scrollers/scrollers.factor b/extra/ui/gadgets/scrollers/scrollers.factor index b125104e4f..98951b74e3 100755 --- a/extra/ui/gadgets/scrollers/scrollers.factor +++ b/extra/ui/gadgets/scrollers/scrollers.factor @@ -89,7 +89,7 @@ scroller H{ 3drop ] if ; -: (scroll>gadget) ( rect scroller -- ) +: (scroll>gadget) ( gadget scroller -- ) >r { 0 0 } over pref-dim swap r> [ relative-scroll-rect ] keep (scroll>rect) ; diff --git a/extra/ui/gadgets/worlds/worlds.factor b/extra/ui/gadgets/worlds/worlds.factor index fc0e78a61c..a44b553858 100755 --- a/extra/ui/gadgets/worlds/worlds.factor +++ b/extra/ui/gadgets/worlds/worlds.factor @@ -115,13 +115,3 @@ world H{ : close-global ( world global -- ) dup get-global find-world rot eq? [ f swap set-global ] [ drop ] if ; - -: focus-gestures ( new old -- ) - drop-prefix - T{ lose-focus } swap each-gesture - T{ gain-focus } swap each-gesture ; - -M: world graft* - dup (open-world-window) - dup world-title over set-title - request-focus ; diff --git a/extra/ui/tools/browser/browser-tests.factor b/extra/ui/tools/browser/browser-tests.factor index 5a343919e7..00c8e5489c 100755 --- a/extra/ui/tools/browser/browser-tests.factor +++ b/extra/ui/tools/browser/browser-tests.factor @@ -1,6 +1,6 @@ IN: temporary USING: tools.test tools.test.ui ui.tools.browser -tools.test.inference ; +tools.test.inference ui.private ; { 0 1 } [ ] unit-test-effect [ ] [ [ ] with-grafted-gadget ] unit-test diff --git a/extra/ui/tools/listener/listener-tests.factor b/extra/ui/tools/listener/listener-tests.factor index 4e59fd63ee..62bd350e71 100755 --- a/extra/ui/tools/listener/listener-tests.factor +++ b/extra/ui/tools/listener/listener-tests.factor @@ -1,7 +1,7 @@ USING: continuations documents ui.tools.interactor ui.tools.listener hashtables kernel namespaces parser sequences timers tools.test ui.commands ui.gadgets ui.gadgets.editors -ui.gadgets.panes vocabs words tools.test.ui ; +ui.gadgets.panes vocabs words tools.test.ui ui.private ; IN: temporary timers [ init-timers ] unless diff --git a/extra/ui/tools/search/search-tests.factor b/extra/ui/tools/search/search-tests.factor index 47ae786f59..ed110e19d6 100755 --- a/extra/ui/tools/search/search-tests.factor +++ b/extra/ui/tools/search/search-tests.factor @@ -1,6 +1,6 @@ USING: assocs ui.tools.search help.topics io.files io.styles kernel namespaces sequences source-files threads timers -tools.test ui.gadgets ui.gestures vocabs +tools.test ui.gadgets ui.gestures ui.private vocabs vocabs.loader words tools.test.ui debugger ; IN: temporary diff --git a/extra/ui/tools/tools-tests.factor b/extra/ui/tools/tools-tests.factor index 919d1705af..eb30b198d6 100755 --- a/extra/ui/tools/tools-tests.factor +++ b/extra/ui/tools/tools-tests.factor @@ -2,7 +2,7 @@ USING: ui.tools ui.tools.interactor ui.tools.listener ui.tools.search ui.tools.workspace kernel models namespaces sequences timers tools.test ui.gadgets ui.gadgets.buttons ui.gadgets.labelled ui.gadgets.presentations -ui.gadgets.scrollers vocabs tools.test.ui ui ; +ui.gadgets.scrollers vocabs tools.test.ui ui ui.private ; IN: temporary [ diff --git a/extra/ui/tools/walker/walker-tests.factor b/extra/ui/tools/walker/walker-tests.factor index eea6d78f22..b37c38c6ed 100755 --- a/extra/ui/tools/walker/walker-tests.factor +++ b/extra/ui/tools/walker/walker-tests.factor @@ -1,6 +1,6 @@ USING: arrays continuations ui.tools.listener ui.tools.walker ui.tools.workspace inspector kernel namespaces sequences threads -listener tools.test ui ui.gadgets ui.gadgets.worlds +listener tools.test ui ui.gadgets ui.gadgets.worlds ui.private ui.gadgets.packs vectors ui.tools tools.interpreter tools.interpreter.debug tools.test.inference tools.test.ui ; IN: temporary diff --git a/extra/ui/tools/workspace/workspace.factor b/extra/ui/tools/workspace/workspace.factor index 2fc82eb67d..79857fa2e6 100755 --- a/extra/ui/tools/workspace/workspace.factor +++ b/extra/ui/tools/workspace/workspace.factor @@ -70,7 +70,7 @@ M: gadget tool-scroller drop f ; [ find-workspace hide-popup ] "Error" show-titled-popup ; -M: workspace pref-dim* drop { 600 750 } ; +M: workspace pref-dim* drop { 600 700 } ; M: workspace focusable-child* dup workspace-popup [ ] [ workspace-listener ] ?if ; diff --git a/extra/ui/ui-docs.factor b/extra/ui/ui-docs.factor index 231682ce6e..651a12c737 100755 --- a/extra/ui/ui-docs.factor +++ b/extra/ui/ui-docs.factor @@ -34,7 +34,7 @@ HELP: ui HELP: start-ui { $description "Called by the UI backend to initialize the platform-independent parts of UI. This word should be called after the backend is ready to start displaying new windows, and before the event loop starts." } ; -HELP: (open-world-window) +HELP: (open-window) { $values { "world" world } } { $description "Opens a native window containing the given world. This grafts the world by calling " { $link graft } ". Each world can only be displayed in one top-level window at a time." } { $notes "This word should not be called directly by user code. Instead, use " { $link open-window } "." } ; @@ -44,11 +44,6 @@ HELP: ui-try { $description "Calls the quotation. If it throws an error, opens a window with the error and restores the data stack." } { $notes "This is essentially a graphical variant of " { $link try } "." } ; -HELP: stop-world -{ $values { "world" world } } -{ $description "Stops a world." } -{ $notes "This word should only be called by the UI backend, and not user code." } ; - ARTICLE: "ui-glossary" "UI glossary" { $table { "color specifier" @@ -177,9 +172,8 @@ ARTICLE: "ui-backend-windows" "UI backend window management" "This word can also be called directly if the UI backend is notified by the window system that window contents have been invalidated. Before and after drawing, two words are called, which the UI backend must implement:" { $subsection select-gl-context } { $subsection flush-gl-context } -"If the user clicks the window's close box, you must call the following two words in sequence:" -{ $subsection stop-world } -{ $subsection unregister-window } ; +"If the user clicks the window's close box, you must call the following word:" +{ $subsection close-window } ; ARTICLE: "ui-layouts" "Gadget hierarchy and layouts" "A layout gadget is a gadget whose sole purpose is to contain other gadgets. Layout gadgets position and resize children according to a certain policy, taking the preferred size of the children into account. Gadget hierarchies are constructed by building up nested layouts." diff --git a/extra/ui/ui.factor b/extra/ui/ui.factor index 4d2101997e..0e1b82ab9b 100755 --- a/extra/ui/ui.factor +++ b/extra/ui/ui.factor @@ -28,10 +28,17 @@ SYMBOL: windows : unregister-window ( handle -- ) windows global [ [ first = not ] curry* subset ] change-at ; + + T{ lose-focus } swap each-gesture + T{ gain-focus } swap each-gesture ; + : focus-world ( world -- ) t over set-world-focused? dup raised-window @@ -41,18 +48,27 @@ SYMBOL: windows f over set-world-focused? focus-path f swap focus-gestures ; +M: world graft* + dup (open-window) + dup world-title over set-title + request-focus ; + : reset-world ( world -- ) + #! This is used when a window is being closed, but also + #! when restoring saved worlds on image startup. dup world-fonts clear-assoc dup unfocus-world f swap set-world-handle ; -: stop-world ( world -- ) - dup ungraft +M: world ungraft* + dup free-fonts dup hand-clicked close-global dup hand-gadget close-global - dup free-fonts + dup world-handle (close-window) reset-world ; +PRIVATE> + : open-world-window ( world -- ) dup pref-dim over set-gadget-dim dup relayout graft ; @@ -60,13 +76,45 @@ SYMBOL: windows >r [ 1 track, ] { 0 1 } make-track r> f open-world-window ; +: close-window ( gadget -- ) + find-world [ ungraft ] when* ; + : find-window ( quot -- world ) windows get values [ gadget-child swap call ] curry* find-last nip ; inline +SYMBOL: ui-hook + +: init-ui ( -- ) + \ graft-queue set-global + \ layout-queue set-global + V{ } clone windows set-global ; + + \ graft-queue set-global - \ layout-queue set-global - V{ } clone windows set-global ; - : redraw-worlds ( seq -- ) [ dup update-hand draw-world ] each ; @@ -105,6 +146,8 @@ SYMBOL: ui-hook : notify-queued ( -- ) graft-queue [ notify ] dlist-slurp ; +PRIVATE> + : ui-step ( -- ) [ do-timers diff --git a/extra/ui/windows/windows.factor b/extra/ui/windows/windows.factor index d4e3770f7b..3ce745970d 100755 --- a/extra/ui/windows/windows.factor +++ b/extra/ui/windows/windows.factor @@ -216,14 +216,14 @@ SYMBOL: hWnd dup win-hRC wglDeleteContext win32-error=0/f dup win-hWnd swap win-hDC ReleaseDC win32-error=0/f ; -: handle-wm-close ( hWnd uMsg wParam lParam -- ) - 3drop - window [ world-handle ] keep - stop-world +M: windows-ui-backend (close-window) dup win-hWnd unregister-window dup cleanup-window win-hWnd DestroyWindow win32-error=0/f ; +: handle-wm-close ( hWnd uMsg wParam lParam -- ) + 3drop window ungraft ; + : handle-wm-set-focus ( hWnd uMsg wParam lParam -- ) 3drop window [ focus-world ] when* ; @@ -414,7 +414,7 @@ SYMBOL: hWnd : setup-gl ( hwnd -- hDC hRC ) get-dc dup setup-pixel-format dup get-rc ; -M: windows-ui-backend (open-world-window) ( world -- ) +M: windows-ui-backend (open-window) ( world -- ) [ rect-dim first2 create-window dup setup-gl ] keep [ f ] keep [ swap win-hWnd register-window ] 2keep