From 9df7d5498208e985a1529db673aee92bee26c0dc Mon Sep 17 00:00:00 2001 From: Eduardo Cavazos Date: Fri, 2 Dec 2005 10:47:18 +0000 Subject: [PATCH] Ported to 0.79 --- contrib/factory/factory.factor | 119 +++++++++++++++++++------- contrib/x11/automata.factor | 22 ++--- contrib/x11/boids.factor | 24 +++--- contrib/x11/concurrent-widgets.factor | 12 ++- contrib/x11/draw-string.factor | 6 +- contrib/x11/x.factor | 27 ++++-- 6 files changed, 146 insertions(+), 64 deletions(-) diff --git a/contrib/factory/factory.factor b/contrib/factory/factory.factor index 2d3be758e6..4fc67b3183 100644 --- a/contrib/factory/factory.factor +++ b/contrib/factory/factory.factor @@ -1,12 +1,28 @@ IN: factory -USING: kernel namespaces generic math sequences hashtables io vectors words +USING: kernel namespaces generic math sequences hashtables io arrays words prettyprint lists concurrency xlib x concurrent-widgets simple-error-handler ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +DEFER: workspace-menu +DEFER: wm-frame? +DEFER: manage-window +DEFER: window-list +DEFER: refresh-window-list +DEFER: layout-frame +DEFER: mapped-windows + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: popup-window ( -- ) mouse-sensor move-window raise-window map-window ; + +: popup-window% [ popup-window ] with-window-object ; + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + SYMBOL: root-menu : setup-root-menu ( -- ) @@ -16,7 +32,9 @@ SYMBOL: root-menu "xlogo" [ "launch program..." print ] root-menu get add-popup-menu-item "xclock" [ "launch program..." print ] root-menu get add-popup-menu-item "xload" [ "launch program..." print ] root-menu get add-popup-menu-item - "emacs" [ "launch program..." print ] root-menu get add-popup-menu-item ; + "emacs" [ "launch program..." print ] root-menu get add-popup-menu-item + "Workspaces" + [ workspace-menu get popup-window% ] root-menu get add-popup-menu-item ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -97,13 +115,10 @@ TUPLE: wm-root ; dup [ swap drop ] [ drop >r dpy get r> ] - ifte ; + if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -DEFER: wm-frame? -DEFER: manage-window - M: wm-root handle-map-request-event ( event -- ) drop XMapRequestEvent-window id>obj ! obj @@ -155,17 +170,17 @@ M: wm-root move-request-x ( event wm-root -- x ) dup move-request-x? [ XConfigureRequestEvent-x ] [ XConfigureRequestEvent-window [ window-x ] with-win ] - ifte ; + if ; M: wm-root move-request-y ( event wm-root -- y ) drop dup move-request-y? [ XConfigureRequestEvent-y ] [ XConfigureRequestEvent-window [ window-y ] with-win ] - ifte ; + if ; M: wm-root move-request-position ( event wm-root -- { x y } ) - 2dup move-request-x -rot move-request-y 2vector ; + 2dup move-request-x -rot move-request-y 2array ; M: wm-root execute-move-request ( event wm-root -- ) dupd move-request-position swap XConfigureRequestEvent-window move-window+ ; @@ -177,17 +192,17 @@ M: wm-root size-request-width ( event wm-root -- width ) dup size-request-width? [ XConfigureRequestEvent-width ] [ XConfigureRequestEvent-window [ window-width ] with-win ] - ifte ; + if ; M: wm-root size-request-height ( event wm-root -- height ) drop dup size-request-height? [ XConfigureRequestEvent-height ] [ XConfigureRequestEvent-window [ window-height ] with-win ] - ifte ; + if ; M: wm-root size-request-size ( event wm-root -- { width height } ) - 2dup size-request-width -rot size-request-height 2vector ; + 2dup size-request-width -rot size-request-height 2array ; M: wm-root execute-size-request ( event wm-root -- ) dupd size-request-size swap XConfigureRequestEvent-window resize-window+ ; @@ -203,9 +218,6 @@ M: wm-root handle-configure-request-event ( event wm-root -- ) ! M: wm-root handle-button-press-event ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -DEFER: window-list -DEFER: refresh-window-list - M: wm-root handle-button-press-event ( event wm-root -- ) drop ! event @@ -215,7 +227,7 @@ M: wm-root handle-button-press-event ( event wm-root -- ) root-menu get raise-window% root-menu get map-window% ] [ root-menu get unmap-window% ] - ifte ] } + if ] } { [ dup XButtonEvent-button Button2 = ] [ window-list get window-map-state% IsUnmapped = @@ -224,7 +236,7 @@ M: wm-root handle-button-press-event ( event wm-root -- ) window-list get refresh-window-list window-list get map-window% ] [ window-list get unmap-window% ] - ifte ] } } + if ] } } cond ; @@ -332,7 +344,7 @@ TUPLE: wm-frame child ; M: wm-frame handle-destroy-window-event ( event -- ) 2dup destroy-window-event-match? - [ destroy-window% drop ] [ drop drop ] ifte ; + [ destroy-window% drop ] [ drop drop ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -341,7 +353,7 @@ M: wm-frame handle-destroy-window-event ( event -- ) M: wm-frame handle-map-request-event ( event -- ) 2dup map-request-event-match? ! event frame ? - [ dup wm-frame-child map-window% map-window% drop ] [ drop drop ] ifte ; + [ dup wm-frame-child map-window% map-window% drop ] [ drop drop ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -350,7 +362,7 @@ M: wm-frame handle-map-request-event ( event -- ) M: wm-frame handle-map-event ( event -- ) 2dup map-event-match? - [ dup map-window% raise-window% drop ] [ drop drop ] ifte ; + [ dup map-window% raise-window% drop ] [ drop drop ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! M: wm-frame handle-configure-request-event ( event frame ) @@ -360,16 +372,16 @@ M: wm-frame move-request-x ( event frame -- x ) over move-request-x? [ drop XConfigureRequestEvent-x ] [ nip window-x% ] - ifte ; + if ; M: wm-frame move-request-y ( event frame -- y ) over move-request-y? [ drop XConfigureRequestEvent-y ] [ nip window-y% ] - ifte ; + if ; M: wm-frame move-request-position ( event frame -- { x y } ) - 2dup move-request-x -rot move-request-y 2vector ; + 2dup move-request-x -rot move-request-y 2array ; M: wm-frame execute-move-request ( event frame ) dup -rot move-request-position swap move-window% ; @@ -380,16 +392,16 @@ M: wm-frame size-request-width ( event frame -- width ) over size-request-width? [ drop XConfigureRequestEvent-width ] [ nip wm-frame-child window-width% ] - ifte ; + if ; M: wm-frame size-request-height ( event frame -- height ) over size-request-height? [ drop XConfigureRequestEvent-height ] [ nip wm-frame-child window-height% ] - ifte ; + if ; M: wm-frame size-request-size ( event frame -- size ) - 2dup size-request-width -rot size-request-height 2vector ; + 2dup size-request-width -rot size-request-height 2array ; : execute-size-request/child ( event frame ) dup wm-frame-child -rot size-request-size swap resize-window% ; @@ -413,12 +425,10 @@ M: wm-frame handle-configure-request-event ( event frame ) wm-frame-child window-id swap XUnmapEvent-window = ; M: wm-frame handle-unmap-event ( event frame ) - 2dup unmap-event-match? [ unmap-window% drop ] [ drop drop ] ifte ; + 2dup unmap-event-match? [ unmap-window% drop ] [ drop drop ] if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -DEFER: layout-frame - : drag-move-frame ( frame -- ) drag-move-window% ; : drag-resize-frame ( frame -- ) dup drag-resize-window% layout-frame ; @@ -437,7 +447,7 @@ M: wm-frame handle-enter-window-event ( event frame ) nip dup wm-frame-child valid-window?% [ wm-frame-child >r RevertToPointerRoot CurrentTime r> set-input-focus% ] [ destroy-window% ] - ifte ; + if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -454,6 +464,52 @@ M: wm-frame handle-property-event ( event frame ) swap resize-window% ! frame drop ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! Workspaces +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +GENERIC: switch-to + +SYMBOL: current-workspace + +TUPLE: workspace windows ; + +: create-workspace [ ] ; + +M: workspace switch-to ( workspace -- ) + mapped-windows dup current-workspace get set-workspace-windows + [ unmap-window+ ] each + dup workspace-windows [ map-window+ ] each + current-workspace set ; + +SYMBOL: workspace-1 +SYMBOL: workspace-2 +SYMBOL: workspace-3 +SYMBOL: workspace-4 + +create-workspace workspace-1 set +create-workspace workspace-2 set +create-workspace workspace-3 set +create-workspace workspace-4 set + +workspace-1 get current-workspace set + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +SYMBOL: workspace-menu + +: setup-workspace-menu ( -- ) + create-menu workspace-menu set + "black" lookup-color workspace-menu get set-window-background% + "Workspace 1" + [ workspace-1 get switch-to ] workspace-menu get add-popup-menu-item + "Workspace 2" + [ workspace-2 get switch-to ] workspace-menu get add-popup-menu-item + "Workspace 3" + [ workspace-3 get switch-to ] workspace-menu get add-popup-menu-item + "Workspace 4" + [ workspace-4 get switch-to ] workspace-menu get add-popup-menu-item ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! window-list ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -471,7 +527,7 @@ SYMBOL: window-list wm-frame-child ! window-list frame child fetch-name% ! window-list frame name-or-f dup ! window-list frame name-or-f name-or-f - [ ] [ drop "*untitled*" ] ifte ! window-list frame name + [ ] [ drop "*untitled*" ] if ! window-list frame name swap ! window-list name frame [ map-window% ] ! window-list name frame [ map-window% ] cons ! window-list name action @@ -505,5 +561,6 @@ SYMBOL: window-list root get create-wm-root setup-root-menu setup-window-list + setup-workspace-menu manage-existing-windows [ concurrent-event-loop ] spawn ; \ No newline at end of file diff --git a/contrib/x11/automata.factor b/contrib/x11/automata.factor index 357c450ce9..b9255503d6 100644 --- a/contrib/x11/automata.factor +++ b/contrib/x11/automata.factor @@ -3,7 +3,7 @@ IN: automata USING: parser kernel hashtables namespaces sequences lists math io - threads strings vectors prettyprint xlib x ; + threads strings arrays prettyprint xlib x ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! set-rule @@ -11,6 +11,8 @@ USING: parser kernel hashtables namespaces sequences lists math io SYMBOL: rule +8 rule set + SYMBOL: char-0 48 char-0 set @@ -27,7 +29,7 @@ SYMBOL: char-0 : rule-values ( n -- { ... } ) >bin 8 char-0 get pad-left - >vector + >array [ 48 - ] map ; : set-rule ( n -- ) @@ -40,15 +42,15 @@ SYMBOL: char-0 : 3nth ( n seq -- slice ) >r dup 3 + r> ; : next-chunk ( << slice: a b c >> - value ) - >vector rule get hash ; + >array rule get hash ; + +: (step) ( line -- new-line ) + dup length 2 - [ swap 3nth next-chunk ] map-with ; : step-line ( line -- new-line ) >r { 0 } r> { 0 } append append (step) ; -: (step) ( line -- new-line ) - dup length 2 - [ swap 3nth next-chunk ] map-with ; - ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Display the rule ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -64,7 +66,7 @@ SYMBOL: char-0 : random-line ( -- line ) 0 400 - [ drop 0 1 random-int ] + [ drop 2 random-int ] map ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -72,13 +74,13 @@ SYMBOL: char-0 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : show-point ( { x y } p -- ) -1 = [ draw-point ] [ drop ] ifte ; +1 = [ draw-point ] [ drop ] if ; : (show-line) ( { x y } line -- ) [ >r dup r> show-point { 1 0 } v+ ] each drop ; : show-line ( y line -- ) - >r >r 0 r> 2vector r> (show-line) ; + >r >r 0 r> 2array r> (show-line) ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Go @@ -95,7 +97,7 @@ SYMBOL: char-0 flush-dpy ; : random-gallery - 1 255 random-int + 255 random-int 1 + dup unparse print set-rule run-rule diff --git a/contrib/x11/boids.factor b/contrib/x11/boids.factor index bbb76ceb2a..c55fc9f1f6 100644 --- a/contrib/x11/boids.factor +++ b/contrib/x11/boids.factor @@ -2,7 +2,7 @@ IN: boids -USING: namespaces math kernel sequences vectors xlib x ; +USING: namespaces math kernel sequences arrays xlib x ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -38,18 +38,22 @@ SYMBOL: time-slice 0.5 time-slice set ! random-boid and random-boids ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! -: random-n ( n -- random-0-to-n-1 ) - 1 - 0 swap random-int ; +! : random-range dupd swap - random-int + ; + +: random-range ( a b -- n ) 1 + dupd swap - random-int + ; + +! : random-n ( n -- random-0-to-n-1 ) +! 1 - 0 swap random-int ; : random-pos ( -- pos ) - world-size get [ random-n ] map ; + world-size get [ random-int ] map ; : random-vel ( -- vel ) - 2 >vector [ drop -10 10 random-int ] map ; + 2 >array [ drop -10 10 random-range ] map ; : random-boid ( -- boid ) random-pos random-vel ; -: random-boids ( n -- boids ) >vector [ drop random-boid ] map ; +: random-boids ( n -- boids ) >array [ drop random-boid ] map ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -179,7 +183,7 @@ SYMBOL: boids normalize separation-weight get v*n ] - ifte ; + if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -192,7 +196,7 @@ SYMBOL: boids normalize alignment-weight get v*n ] - ifte ; + if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -207,7 +211,7 @@ SYMBOL: boids normalize cohesion-weight get v*n ] - ifte ; + if ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -248,7 +252,7 @@ SYMBOL: boids : wrap-pos ( pos -- pos ) [ ] each - wrap-y swap wrap-x swap 2vector ; + wrap-y swap wrap-x swap 2array ; : iterate-boid ( self -- self ) dup >r new-pos wrap-pos r> new-vel ; diff --git a/contrib/x11/concurrent-widgets.factor b/contrib/x11/concurrent-widgets.factor index f468c651dd..892bc7f229 100644 --- a/contrib/x11/concurrent-widgets.factor +++ b/contrib/x11/concurrent-widgets.factor @@ -229,7 +229,7 @@ TUPLE: menu item-width item-height space ; ! dup ! event obj-or-f obj-or-f ! [ handle-event ] ! [ drop drop ] ! event obj-or-f obj-or-f [ handle-event ] [ drop drop ] -! ifte +! if ! event-loop ; ! It's possible to have multiple displays open simultaneously. @@ -241,7 +241,7 @@ TUPLE: menu item-width item-height space ; QueuedAfterFlush events-queued 0 > [ next-event ] [ 100 sleep concurrent-next-event ] - ifte ; + if ; : concurrent-event-loop ( -- ) concurrent-next-event ! event @@ -252,7 +252,7 @@ TUPLE: menu item-width item-height space ; dup ! event obj-or-f obj-or-f [ handle-event ] [ drop drop ] ! event obj-or-f obj-or-f [ handle-event ] [ drop drop ] - ifte + if concurrent-event-loop ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -293,4 +293,8 @@ TUPLE: menu item-width item-height space ; : vertical-layout% [ vertical-layout ] with-window-object ; -: draw-string% [ draw-string ] with-window-object ; \ No newline at end of file +: draw-string% [ draw-string ] with-window-object ; + +: get-transient-for-hint% [ get-transient-for-hint ] with-window-object ; + +: fetch-name% [ fetch-name ] with-window-object ; \ No newline at end of file diff --git a/contrib/x11/draw-string.factor b/contrib/x11/draw-string.factor index bcbf8f4353..4237d9cdc8 100644 --- a/contrib/x11/draw-string.factor +++ b/contrib/x11/draw-string.factor @@ -1,20 +1,20 @@ IN: x -USING: kernel math vectors namespaces sequences xlib x rectangle ; +USING: kernel math arrays namespaces sequences xlib x rectangle ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : text-width ( string -- width ) font get swap dup length XTextWidth ; -: string-size ( string -- size ) text-width font get font-height 2vector ; +: string-size ( string -- size ) text-width font get font-height 2array ; : string-rect ( string -- rect ) string-size { 0 0 } swap ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! : base-point ( rect -- ) - top-left font get XFontStruct-ascent 0 swap 2vector v+ ; + top-left font get XFontStruct-ascent 0 swap 2array v+ ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! diff --git a/contrib/x11/x.factor b/contrib/x11/x.factor index 06594aa0da..b39bae9ea6 100644 --- a/contrib/x11/x.factor +++ b/contrib/x11/x.factor @@ -1,5 +1,5 @@ -IN: x USING: namespaces kernel math vectors alien sequences xlib ; +IN: x USING: namespaces kernel math arrays alien sequences xlib ; SYMBOL: dpy SYMBOL: scr @@ -72,10 +72,10 @@ DEFER: with-win >r dpy get win get r> [ ] each XResizeWindow drop ; : set-window-width ( width -- ) - window-height 2vector resize-window ; + window-height 2array resize-window ; : set-window-height ( height -- ) - window-width swap 2vector resize-window ; + window-width swap 2array resize-window ; : set-window-border-width ( width -- ) >r dpy get win get r> XSetWindowBorderWidth drop ; @@ -112,7 +112,7 @@ DEFER: with-win : window-size ( -- { width height } ) dpy get win get 0 0 0 - 0 0 2dup 2vector >r + 0 0 2dup 2array >r 0 0 XGetGeometry drop r> [ *uint ] map ; @@ -122,7 +122,7 @@ DEFER: with-win : window-position ( -- { x y } ) dpy get win get 0 - 0 0 2dup 2vector >r + 0 0 2dup 2array >r 0 0 0 0 XGetGeometry drop r> [ *int ] map ; @@ -218,6 +218,18 @@ DEFER: with-win : ungrab-pointer ( time -- ) >r dpy get r> XUngrabPointer drop ; +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! +! 14 - Inter-Client Communication Functions +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + +: fetch-name ( -- name-or-f ) + dpy get win get 0 dup >r XFetchName drop r> + dup *void* alien-address 0 = [ drop f ] [ *char* ] if ; + +: get-transient-for-hint ( -- win-or-f ) + dpy get win get 0 dup >r XGetTransientForHint r> + swap 0 = [ drop f ] [ *Window ] if ; + ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Not Categorized Yet ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -232,6 +244,9 @@ DEFER: with-win : center-window-horizontally+ [ center-window-horizontally ] with-win ; : window-children+ [ window-children ] with-win ; : window-map-state+ [ window-map-state ] with-win ; +: destroy-window+ [ destroy-window ] with-win ; +: map-window+ [ map-window ] with-win ; +: unmap-window+ [ unmap-window ] with-win ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! @@ -284,7 +299,7 @@ DEFER: with-win : mouse-sensor ( -- { root-x root-y } ) dpy get win get 0 0 0 0 2dup >r >r - 0 0 0 XQueryPointer drop r> *int r> *int 2vector ; + 0 0 0 XQueryPointer drop r> *int r> *int 2array ; ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! ! Windows and their children