New remove-hash* word; UI refactorings; adding new Whisker-style word browser

TODO.FACTOR.txt

@@ -1,3 +1,5 @@
+- redefine generic as tuple constructor -- still appears generic
+
 - remove F_USERENV rel
 - update walker for new interpreter
 - quotations should store their originating word
@@ -33,16 +35,13 @@
 
 + ui/help:
 
+- make-frame should compile
 - track:
   - don't allow negative dimensions
-  - support removing items
   - fix round-off error
-- zooming doesn't work
-- implement handlers for open, quit events, and whatever else
 - fix top level window positioning
 - changing window titles
 - reimplement clicking input
-- polish OS X menu bar code
 - clicks sent twice
 - speed up ideas:
   - only do clipping for certain gadgets
@@ -51,8 +50,12 @@
 - x11 input methods
 - x11 title bars are funny
 - cocoa:
+  - need to flush callbacks
   - don't multiplex in the event loop if there is no pending i/o
   - horizontal scrolling
+  - zooming doesn't work
+  - implement handlers for open, quit events, and whatever else
+  - polish OS X menu bar code
 - fix mouse-overs...
 - display lists
 - saving the image should save window configuration

library/bootstrap/boot-stage1.factor

@@ -193,10 +193,11 @@ vectors words ;
         "/library/ui/outliner.factor"
         "/library/ui/environment.factor"
         "/library/ui/listener.factor"
+        "/library/ui/presentations.factor"
+        "/library/ui/inspector.factor"
         "/library/ui/browser.factor"
         "/library/ui/apropos.factor"
         "/library/ui/launchpad.factor"
-        "/library/ui/presentations.factor"
 
         "/library/continuations.facts"
         "/library/errors.facts"

library/cocoa/menu-bar.factor

@@ -1,7 +1,8 @@
-USING: cocoa compiler gadgets gadgets-launchpad gadgets-layouts
+USING: cocoa compiler gadgets gadgets-browser gadgets-launchpad
-gadgets-listener kernel memory objc objc-FactorCallback
+gadgets-layouts gadgets-listener kernel memory objc
-objc-NSApplication objc-NSMenu objc-NSMenuItem objc-NSObject
+objc-FactorCallback objc-NSApplication objc-NSMenu
-objc-NSWindow sequences strings words ;
+objc-NSMenuItem objc-NSObject objc-NSWindow sequences strings
+words ;
 IN: gadgets-cocoa
 
 ! -------------------------------------------------------------------------
@@ -107,9 +108,9 @@ DEFER: described-menu
             { "Listener" listener-window "n" }
             { "Run..." menu-run-file "o" }
             { }
+            { "Browser" browser-window "b" }
             { "Apropos" apropos-window "r" }
-            { "Vocabularies" vocabs-window "" }
+            { "Globals" globals-window "" }
-            { "Globals" global-window "" }
             { "Memory" memory-window "" }
             { }
             { "Save Image" save "s" }

library/collections/hashtables.factor

@@ -143,6 +143,9 @@ IN: hashtables
         3drop
     ] if-key ;
 
+: remove-hash* ( key hash -- oldvalue )
+    [ hash ] 2keep remove-hash ;
+
 : hash-size ( hash -- n )
     dup hash-count swap hash-deleted - ; inline
 

library/compiler/alien/c-types.factor

@@ -71,11 +71,15 @@ SYMBOL: c-types
 : init-c-type ( name vocab -- )
     over define-pointer define-nth ;
 
-: define-primitive-type ( quot name -- )
+: (define-primitive-type) ( quot name -- )
     [ define-c-type ] keep "alien"
     2dup init-c-type
     2dup define-deref
     over c-setter [ 2dup define-set-nth define-out ] when ;
 
+: define-primitive-type ( quot name -- )
+    [ (define-primitive-type) ] keep dup c-setter
+    [ "alien" 2dup define-set-nth define-out ] [ drop ] if ;
+
 : typedef ( old new -- )
     over "*" append over "*" append (typedef) (typedef) ;

library/compiler/alien/primitive-types.factor

@@ -103,25 +103,27 @@ USING: alien compiler kernel kernel-internals math namespaces ;
 
 [
     [ alien-unsigned-cell <alien> alien>string ] "getter" set
+    [ >r >r alien-address r> r> set-alien-unsigned-cell ] "setter" set
     bootstrap-cell "width" set
     bootstrap-cell "align" set
     "box_c_string" "boxer-function" set
     "unbox_c_string" "unboxer-function" set
-] "char*" define-primitive-type
+] "char*" (define-primitive-type)
 
 [
     [ alien-unsigned-4 ] "getter" set
-    bootstrap-cell "width" set
+    [ >r >r alien-address r> r> set-alien-unsigned-4 ] "setter" set
-    bootstrap-cell "align" set
+    4 "width" set
+    4 "align" set
     "box_utf16_string" "boxer-function" set
     "unbox_utf16_string" "unboxer-function" set
-] "ushort*" define-primitive-type
+] "ushort*" (define-primitive-type)
 
 [
     [ alien-unsigned-4 zero? not ] "getter" set
     [ 1 0 ? set-alien-unsigned-4 ] "setter" set
-    bootstrap-cell "width" set
+    4 "width" set
-    bootstrap-cell "align" set
+    4 "align" set
     "box_boolean" "boxer-function" set
     "unbox_boolean" "unboxer-function" set
 ] "bool" define-primitive-type

library/ui/apropos.factor

@@ -25,7 +25,7 @@ C: apropos-gadget ( -- )
     {
         { [ <pane> <scroller> ] set-apropos-gadget-scroller @center }
         { [ <apropos-prompt> ] set-apropos-gadget-input @top }
-    } make-frame ;
+    } make-frame* ;
 
 M: apropos-gadget pref-dim* drop { 350 200 0 } ;
 

library/ui/browser.factor

@@ -1,122 +1,114 @@
 ! Copyright (C) 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-browser
-USING: arrays gadgets gadgets-buttons gadgets-labels
+USING: gadgets gadgets-buttons gadgets-inspector gadgets-labels
-gadgets-layouts gadgets-panes gadgets-scrolling gadgets-theme
+gadgets-layouts gadgets-panes gadgets-presentations
-generic hashtables help inspector kernel math namespaces
+gadgets-scrolling gadgets-theme gadgets-tracks generic
-prettyprint sequences words ;
+hashtables help inspector kernel math prettyprint sequences
+words ;
 
-SYMBOL: components
+TUPLE: browser
-
+    vocabs
-H{ } clone components set-global
+    vocab-track showing-vocabs
-
+    word-track showing-words ;
-: get-components ( class -- assoc )
-    components get-global hash [
-        { { "Slots" [ describe ] } }
-    ] unless* ;
-
-{
-    { "Definition" [ help ] }
-    { "Calls in" [ usage. ] }
-    { "Calls out" [ uses. ] }
-    { "Links in" [ links-in. ] }
-    { "Links out" [ links-out. ] }
-    { "Vocabulary" [ word-vocabulary words. ] }
-    { "Properties" [ word-props describe ] }
-} \ word components get-global set-hash
-
-{
-    { "Article" [ help ] }
-    { "Links in" [ links-in. ] }
-    { "Links out" [ links-out. ] }
-} \ link components get-global set-hash
-
-{
-    { "Call stack" [ continuation-call callstack. ] }
-    { "Data stack" [ continuation-data stack. ] }
-    { "Retain stack" [ continuation-retain stack. ] }
-    { "Name stack" [ continuation-name stack. ] }
-    { "Catch stack" [ continuation-catch stack. ] }
-} \ continuation components get-global set-hash
-
-TUPLE: book page pages ;
-
-: show-page ( key book -- )
-    dup book-page unparent
-    [ book-pages assoc ] keep
-    [ set-book-page ] 2keep
-    add-gadget ;
-
-C: book ( pages -- book )
-    dup delegate>gadget
-    [ set-book-pages ] 2keep
-    [ >r first first r> show-page ] keep ;
-
-M: book pref-dim* ( book -- dim ) book-page pref-dim ;
-
-M: book layout* ( book -- )
-    dup rect-dim swap book-page set-gadget-dim ;
-
-: component-pages ( obj -- assoc )
-    dup class get-components
-    [ first2 swapd make-pane <scroller> 2array ] map-with ;
-
-: <tab> ( name book -- button )
-    dupd [ show-page drop ] curry curry
-    >r <label> r> <bevel-button> ;
-
-: tabs ( assoc book gadget -- )
-    >r swap [ first swap <tab> ] map-with r> add-gadgets ;
-
-TUPLE: browser object history tabs ;
-
-: save-current ( browser -- )
-    dup browser-object swap browser-history push ;
-
-: browse ( obj browser -- )
-    [ set-browser-object ] 2keep
-    dup browser-tabs clear-gadget
-    >r component-pages dup <book> r>
-    [ @center frame-add ] 2keep browser-tabs tabs ;
 
 : find-browser [ browser? ] find-parent ;
 
-: browse-back ( browser -- )
+: <title-border> ( gadget title -- gadget )
-    dup browser-history dup empty?
+    {
-    [ 2drop ] [ pop swap browse ] if ;
+        { [ <label> dup highlight-theme ] f @top }
+        { [ ] f @center }
+    } make-frame ;
 
-C: browser ( obj -- browser )
+: showing-word? ( word browser -- ? )
-    V{ } clone over set-browser-history
+    browser-showing-words hash-member? ;
-    dup delegate>frame [
-        "<" <label> [ find-browser browse-back ] <bevel-button> ,
-        <shelf> dup pick set-browser-tabs ,
-    ] { } make make-shelf dup highlight-theme
-    over @top frame-add
-    [ browse ] keep ;
 
-TUPLE: browser-button object ;
+: (show-word) ( gadget word browser -- )
+    [ browser-showing-words set-hash ] 3keep nip
+    browser-word-track track-add ;
 
-: browser-window ( obj -- ) <browser> "Browser" open-window ;
+DEFER: show-vocab
 
-: browser-button-action ( button -- )
+: show-word ( word browser -- )
-    [ browser-button-object ] keep find-browser [
+    2dup showing-word? [
-        find-browser dup save-current browse
+        2drop
     ] [
-        browser-window
+        over word-vocabulary over show-vocab
-    ] if* ;
+        >r [ f <inspector> ] keep r> (show-word)
+    ] if ;
 
-: browser-button-gestures ( gadget -- )
+: hide-word ( word browser -- )
+    [ browser-showing-words remove-hash* ] keep
+    browser-word-track track-remove ;
+
+: toggle-word ( word browser -- )
+    2dup showing-word? [ hide-word ] [ show-word ] if ;
+
+: <word-button> ( word -- gadget )
+    dup word-name <label> swap
+    [ swap find-browser toggle-word ] curry
+    <roll-button> ;
+
+: <vocab> ( vocab -- gadget )
     [
-        [ browser-button-object browser-window ] if-clicked
+        words natural-sort
-    ] T{ button-up f 3 } set-action ;
+        [ <word-button> ] map make-pile <scroller>
+    ] keep <title-border> ;
 
-C: browser-button ( gadget object -- button )
+: showing-vocab? ( vocab browser -- ? )
-    [ set-browser-button-object ] keep
+    browser-showing-vocabs hash-member? ;
+
+: (show-vocab) ( gadget vocab browser -- )
+    [ browser-showing-vocabs set-hash ] 3keep nip
+    browser-vocab-track track-add ;
+
+: show-vocab ( vocab browser -- )
+    2dup showing-vocab?
+    [ 2drop ] [ >r [ <vocab> ] keep r> (show-vocab) ] if ;
+
+: hide-vocab-words ( vocab browser -- )
     [
-        >r [ browser-button-action ] <roll-button> r>
+        browser-showing-words hash-keys
-        set-gadget-delegate
+        [ word-vocabulary = ] subset-with
-    ] keep
+    ] keep swap [ swap hide-word ] each-with ;
-    dup browser-button-gestures ;
 
-M: browser-button gadget-help ( button -- string )
+: hide-vocab ( vocab browser -- )
-    browser-button-object dup word? [ synopsis ] [ summary ] if ;
+    2dup hide-vocab-words
+    [ browser-showing-vocabs remove-hash* ] keep
+    browser-vocab-track track-remove ;
+
+: toggle-vocab ( word browser -- )
+    2dup showing-vocab? [ hide-vocab ] [ show-vocab ] if ;
+
+: <vocab-button> ( vocab -- gadget )
+    dup <label> swap
+    [ swap find-browser toggle-vocab ] curry
+    <roll-button> ;
+
+: <vocabs> ( -- gadget )
+    vocabs [ <vocab-button> ] map make-pile <scroller>
+    "Vocabularies" <title-border> ;
+
+: add-vocabs ( vocabs browser -- )
+    [ set-browser-vocabs ] 2keep track-add ;
+
+: add-vocab-track ( track browser -- )
+    [ set-browser-vocab-track ] 2keep track-add ;
+
+: add-word-track ( track browser -- )
+    [ set-browser-word-track ] 2keep track-add ;
+
+C: browser ( -- browser )
+    H{ } clone over set-browser-showing-vocabs
+    H{ } clone over set-browser-showing-words
+    <y-track> over set-delegate
+    <vocabs> over add-vocabs
+    <x-track> over add-vocab-track
+    <x-track> over add-word-track
+    { 1/4 1/4 1/2 } over set-track-sizes ;
+
+: browser-window ( word -- )
+    <browser> [ "Browser" open-window ] keep show-word ;
+
+M: word show-object ( word button -- )
+    find-browser [ show-word ] [ browser-window ] if* ;

library/ui/frames.factor

@@ -95,8 +95,8 @@ M: frame layout* ( frame -- dim )
     #! the loc is @center, @top, etc.
     [ swap frame set [ frame-add-spec ] each ] with-scope ;
 
-: make-frame ( gadget specs -- gadget )
+: make-frame ( specs -- gadget )
-    #! Specs is an array of triples { quot setter loc }.
+    <frame> [ swap build-frame ] keep ;
-    #! The setter has stack effect ( new gadget -- ),
+
-    #! the loc is @center, @top, etc.
+: make-frame* ( gadget specs -- gadget )
     over [ delegate>frame build-frame ] keep ;

library/ui/inspector.factor

@@ -0,0 +1,105 @@
+! Copyright (C) 2006 Slava Pestov.
+! See http://factorcode.org/license.txt for BSD license.
+USING: arrays gadgets gadgets-buttons gadgets-labels
+gadgets-layouts gadgets-panes gadgets-presentations
+gadgets-scrolling gadgets-theme generic hashtables help
+inspector kernel math namespaces prettyprint sequences words ;
+IN: gadgets-inspector
+
+SYMBOL: components
+
+H{ } clone components set-global
+
+: get-components ( class -- assoc )
+    components get-global hash [
+        { { "Slots" [ describe ] } }
+    ] unless* ;
+
+{
+    { "Definition" [ help ] }
+    { "Calls in" [ usage. ] }
+    { "Calls out" [ uses. ] }
+    { "Links in" [ links-in. ] }
+    { "Links out" [ links-out. ] }
+    { "Properties" [ word-props describe ] }
+} \ word components get-global set-hash
+
+{
+    { "Article" [ help ] }
+    { "Links in" [ links-in. ] }
+    { "Links out" [ links-out. ] }
+} \ link components get-global set-hash
+
+{
+    { "Call stack" [ continuation-call callstack. ] }
+    { "Data stack" [ continuation-data stack. ] }
+    { "Retain stack" [ continuation-retain stack. ] }
+    { "Name stack" [ continuation-name stack. ] }
+    { "Catch stack" [ continuation-catch stack. ] }
+} \ continuation components get-global set-hash
+
+TUPLE: book page pages ;
+
+: show-page ( key book -- )
+    dup book-page unparent
+    [ book-pages assoc ] keep
+    [ set-book-page ] 2keep
+    add-gadget ;
+
+C: book ( pages -- book )
+    dup delegate>gadget
+    [ set-book-pages ] 2keep
+    [ >r first first r> show-page ] keep ;
+
+M: book pref-dim* ( book -- dim ) book-page pref-dim ;
+
+M: book layout* ( book -- )
+    dup rect-dim swap book-page set-gadget-dim ;
+
+: component-pages ( obj -- assoc )
+    dup class get-components
+    [ first2 swapd make-pane <scroller> 2array ] map-with ;
+
+: <tab> ( name book -- button )
+    dupd [ show-page drop ] curry curry
+    >r <label> r> <bevel-button> ;
+
+: tabs ( assoc book gadget -- )
+    >r swap [ first swap <tab> ] map-with r> add-gadgets ;
+
+TUPLE: inspector object history tabs ;
+
+: save-current ( inspector -- )
+    dup inspector-object swap inspector-history push ;
+
+: (inspect) ( obj inspector -- )
+    [ set-inspector-object ] 2keep
+    dup inspector-tabs clear-gadget
+    >r component-pages dup <book> r>
+    [ @center frame-add ] 2keep inspector-tabs tabs ;
+
+: inspect ( obj inspector -- ) dup save-current (inspect) ;
+
+: find-inspector [ inspector? ] find-parent ;
+
+: go-back ( inspector -- )
+    dup inspector-history dup empty?
+    [ 2drop ] [ pop swap inspect ] if ;
+
+: <back-button> ( -- gadget )
+    "<" <label> [ find-inspector go-back ] <bevel-button> ;
+
+C: inspector ( obj history? -- inspector )
+    V{ } clone over set-inspector-history
+    dup delegate>frame [
+        swap [ <back-button> , ] when
+        <shelf> dup pick set-inspector-tabs ,
+    ] { } make make-shelf dup highlight-theme
+    over @top frame-add
+    [ (inspect) ] keep ;
+
+: inspector-window ( obj -- )
+    t <inspector> "Inspector" open-window ;
+
+M: object show-object ( object button -- )
+    find-inspector [ inspect ] [ inspector-window ] if* ;

library/ui/launchpad.factor

@@ -1,8 +1,8 @@
 IN: gadgets-launchpad
-USING: gadgets gadgets-apropos gadgets-browser gadgets-borders
+USING: gadgets gadgets-apropos gadgets-borders gadgets-browser
-gadgets-buttons gadgets-labels gadgets-layouts gadgets-listener
+gadgets-buttons gadgets-inspector gadgets-labels gadgets-layouts
-gadgets-panes gadgets-scrolling gadgets-theme help inspector io
+gadgets-listener gadgets-panes gadgets-scrolling gadgets-theme
-kernel memory namespaces sequences ; 
+help inspector io kernel memory namespaces sequences ; 
 
 : <launchpad> ( menu -- )
     [ first2 >r <label> [ drop ] r> append <bevel-button> ] map
@@ -24,20 +24,17 @@ kernel memory namespaces sequences ;
 : apropos-window ( -- )
     <apropos-gadget> "Apropos" open-window ;
 
-: vocabs-window ( -- )
+: globals-window ( -- )
-    [ vocabs. ] "Vocabularies" pane-window ;
+    global inspector-window ;
-
-: global-window ( -- )
-    global browser-window ;
 
 : default-launchpad
     {
         { "Listener" [ listener-window ] }
         { "Documentation" [ handbook-window ] }
         { "Help index" [ articles-window ] }
+        { "Browser" [ browser-window ] }
         { "Apropos" [ apropos-window ] }
-        { "Vocabularies" [ vocabs-window ] }
+        { "Globals" [ globals-window ] }
-        { "Globals" [ global-window ] }
         { "Memory" [ memory-window ] }
         { "Save image" [ save ] }
         { "Exit" [ 0 exit ] }

library/ui/listener.factor

@@ -56,7 +56,7 @@ C: listener-gadget ( -- gadget )
     {
         { [ <stack-bar> ] set-listener-gadget-stack @top }
         { [ <input-pane> <scroller> ] set-listener-gadget-scroller @center }
-    } make-frame dup start-listener ;
+    } make-frame* dup start-listener ;
 
 M: listener-gadget pref-dim* drop { 600 600 0 } ;
 

library/ui/presentations.factor

@@ -1,9 +1,26 @@
 ! Copyright (C) 2005, 2006 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 IN: gadgets-presentations
-USING: arrays gadgets gadgets-borders gadgets-browser
+USING: arrays gadgets gadgets-borders
-gadgets-labels gadgets-layouts gadgets-outliner gadgets-panes
+gadgets-buttons gadgets-labels gadgets-layouts gadgets-outliner
-hashtables io kernel sequences strings styles ;
+gadgets-panes generic hashtables inspector io kernel prettyprint
+sequences strings styles words ;
+
+! Clickable objects
+TUPLE: object-button object ;
+
+G: show-object ( object gadget -- ) 1 standard-combination ;
+
+C: object-button ( gadget object -- button )
+    [ set-object-button-object ] keep
+    [
+        >r [
+            [ object-button-object ] keep show-object
+        ] <roll-button> r> set-gadget-delegate
+    ] keep ;
+
+M: object-button gadget-help ( button -- string )
+    object-button-object dup word? [ synopsis ] [ summary ] if ;
 
 ! Character styles
 
@@ -25,7 +42,7 @@ hashtables io kernel sequences strings styles ;
     over specified-font over set-label-font ;
 
 : apply-browser-style ( style gadget -- style gadget )
-    presented [ <browser-button> ] apply-style ;
+    presented [ <object-button> ] apply-style ;
 
 : <presentation> ( style text -- gadget )
     <label>

library/ui/scrolling.factor

@@ -71,6 +71,9 @@ M: viewport layout* ( viewport -- )
 M: viewport focusable-child* ( viewport -- gadget )
     gadget-child ;
 
+M: viewport pref-dim* ( viewport -- dim )
+    gadget-child pref-dim ;
+
 : scroll-to ( gadget -- )
     #! Scroll the scroller that contains this gadget, if any, so
     #! that the gadget becomes visible.
@@ -92,7 +95,7 @@ C: scroller ( gadget -- scroller )
         { [ <viewport> ] set-scroller-viewport @center }
         { [ <x-slider> ] set-scroller-x @bottom }
         { [ <y-slider> ] set-scroller-y @right }
-    } make-frame dup scroller-actions ;
+    } make-frame* dup scroller-actions ;
 
 M: scroller focusable-child* ( scroller -- viewport )
     scroller-viewport ;

library/ui/tracks.factor

@@ -4,7 +4,10 @@ IN: gadgets-tracks
 USING: gadgets gadgets-layouts gadgets-theme io kernel math
 namespaces sequences ;
 
-TUPLE: divider # splitter ;
+TUPLE: divider ;
+
+: divider-# ( divider -- n )
+    dup gadget-parent gadget-children index 2 /i ;
 
 : divider-size { 8 8 0 } ;
 
@@ -15,6 +18,10 @@ TUPLE: track sizes saved-sizes ;
 C: track ( orientation -- track )
     [ delegate>pack ] keep 1 over set-pack-fill ;
 
+: <x-track> { 0 1 0 } <track> ;
+
+: <y-track> { 1 0 0 } <track> ;
+
 : track-dim ( track -- dim )
     #! Space available for content (minus dividers)
     dup rect-dim swap track-sizes length 1-
@@ -58,8 +65,7 @@ M: track layout* ( splitter -- )
     dup [ drop ] T{ button-up } set-action
     [ divider-motion ] T{ drag } set-action ;
 
-C: divider ( n -- divider )
+C: divider ( -- divider )
-    [ set-divider-# ] keep
     dup delegate>gadget
     dup divider-actions
     dup reverse-video-theme ;
@@ -71,14 +77,24 @@ C: divider ( n -- divider )
     dup length 1 max recip add normalize-sizes ;
 
 : add-divider ( track -- )
-    dup track-sizes length dup zero?
+    dup track-sizes empty?
-    [ 2drop ] [ 1- <divider> swap add-gadget ] if ;
+    [ drop ] [ <divider> swap add-gadget ] if ;
 
 : track-add ( gadget track -- )
     dup add-divider [ add-gadget ] keep
     dup track-sizes track-add-size swap set-track-sizes ;
 
+: nth-gadget gadget-children nth ;
+
+: track-remove@ ( n track -- )
+    #! Remove the divider if this is not the last child.
+    2dup nth-gadget unparent
+    dup gadget-children empty? [
+        2dup gadget-children length = [ >r 1- r> ] when
+        2dup nth-gadget unparent
+    ] unless
+    [ >r 2 /i r> track-sizes remove-index normalize-sizes ] keep
+    [ set-track-sizes ] keep relayout-1 ;
+
 : track-remove ( gadget track -- )
-    ! wrong
+    [ gadget-children index ] keep track-remove@ ;
-    [ gadget-children index ] 2keep swap unparent
-    [ remove-index ] keep set-track-sizes ;

library/ui/world.factor

@@ -24,8 +24,8 @@ DEFER: request-focus
 C: world ( gadget status -- world )
     {
         { [ ] set-world-status @bottom }
-        { [ ] f @center }
+        { [ ] set-world-gadget @center }
-    } make-frame
+    } make-frame*
     t over set-gadget-root?
     H{ } clone over set-world-fonts
     dup world-gadget request-focus ;