From ddfb4e3256a117beb0f387be0b494bf6c7472dc2 Mon Sep 17 00:00:00 2001 From: ketmar Date: Tue, 10 Nov 2020 05:18:21 +0000 Subject: [PATCH] xog: some more code FossilOrigin-Name: 62dda5c69767305ae7b7023183f3fe3b17dae392bc7141b714d5da652f6dcf18 --- libs/xog/xog-base-window-impl.f | 42 ++++++++++++++++++++++++++++++++++++----- libs/xog/xog-base-window.f | 6 ++++++ libs/xog/xog-common.f | 15 ++++++++++++--- samples/xog/xog-test-child.f | 25 ++++++++++++++---------- 4 files changed, 70 insertions(+), 18 deletions(-) diff --git a/libs/xog/xog-base-window-impl.f b/libs/xog/xog-base-window-impl.f index 97fcaaa..8d44f5c 100644 --- a/libs/xog/xog-base-window-impl.f +++ b/libs/xog/xog-base-window-impl.f @@ -391,7 +391,8 @@ BaseWindow method: create-ex ( parentobj -- successflag ) (get-title) 0 255 clamp ensure-asciiz >r winid xog-dpy XStoreName r> free-asciiz ;; set WM protocols (only for top-level windows) - 1 XA_WM_DELETE_WINDOW winid xog-dpy XSetWMProtocols drop + WM_TAKE_FOCUS >r WM_DELETE_WINDOW >r + 2 rp@ winid xog-dpy XSetWMProtocols drop 2rdrop ;; set NETWM type NET_WM_WINDOW_TYPE_NORMAL >r 1 rp@ 0 ( PropModeReplace) 32 ( bits) XA_ATOM NET_WM_WINDOW_TYPE winid xog-dpy XChangeProperty drop rdrop @@ -468,7 +469,7 @@ BaseWindow method: GravityNotify-Handler ( -- ) ; BaseWindow method: ResizeRequest-Handler ( -- ) ; BaseWindow method: CirculateNotify-Handler ( -- ) ; BaseWindow method: CirculateRequest-Handler ( -- ) ; -BaseWindow method: PropertyNotify-Handler ( -- ) ; +\ BaseWindow method: PropertyNotify-Handler ( -- ) ; BaseWindow method: SelectionClear-Handler ( -- ) ; BaseWindow method: SelectionRequest-Handler ( -- ) ; BaseWindow method: SelectionNotify-Handler ( -- ) ; @@ -520,14 +521,44 @@ BaseWindow method: ConfigureNotify-Handler ( -- ) BaseWindow method: ClientMessage-Handler ( -- ) (event) XClientMessageEvent message_type @ case WM_PROTOCOLS of - (event) XClientMessageEvent data @ XA_WM_DELETE_WINDOW @ = if - on-close-query if close endif - endif + (event) XClientMessageEvent data @ case + WM_DELETE_WINDOW of on-close-query if close endif endof + ;; this is rarely used (at least FluxBox doesn't send it) + WM_TAKE_FOCUS of (event) XClientMessageEvent data cell+ @ (debug-id.) ." WM_TAKE_FOCUS: " . cr endof + endcase endof XOF_INTERNAL_CLOSE of (destroy) endof + \ WM_CHANGE_STATE of (event) XClientMessageEvent data @ on-state-change endof endcase ; +BaseWindow method: PropertyNotify-Handler-WM_STATE ( -- ) + 5 cells ralloca >r + r@ 5 cells erase + r@ ( prop_return) r@ cell+ ( bytes_after_return) + r@ 2 +cells ( nitems_return) + r@ 3 +cells ( actual_format_return) + r@ 4 +cells ( actual_type_return) + AnyPropertyType false 1 0 WM_STATE winid xog-dpy XGetWindowProperty ifnot + r@ @ @ on-state-change + r@ @ XFree + endif + rdrop 5 cells rdealloca +; + +BaseWindow method: PropertyNotify-Handler ( -- ) + (event) XPropertyEvent atom @ xog-dpy XGetAtomName >r + endcr (debug-id.) ." PROPERTY \`" r@ zcount type ." \` is " + (event) XPropertyEvent state @ PropertyDelete = if ." deleted" else ." set" endif + cr r> XFree + + (event) XPropertyEvent state @ PropertyNewValue = if + (event) XPropertyEvent atom @ case + WM_STATE of PropertyNotify-Handler-WM_STATE endof + endcase + endif +; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; X11 event processor @@ -670,6 +701,7 @@ BaseWindow method: on-keyup ( keysym -- ) drop ; BaseWindow method: on-button-down ( bnum -- ) drop ; BaseWindow method: on-button-up ( bnum -- ) drop ; BaseWindow method: on-close-query ( -- allow-close-flag ) true ; +BaseWindow method: on-state-change ( newstate -- ) drop ; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; diff --git a/libs/xog/xog-base-window.f b/libs/xog/xog-base-window.f index aee0802..d144f8f 100644 --- a/libs/xog/xog-base-window.f +++ b/libs/xog/xog-base-window.f @@ -170,6 +170,9 @@ use-libs: oof method GenericEvent-Handler ( -- ) method UnknownEvent-Handler ( -- ) + ;; called when WM_STATE property was changed + method PropertyNotify-Handler-WM_STATE ( -- ) + ;; this will call the corresponding event handler ;; it works exactly as written: ;; first the event sinks from the top window to the destination, calling "(sink-event)" @@ -290,6 +293,9 @@ use-libs: oof ;; return "false" to prevent closing method on-close-query ( -- allow-close-flag ) + ;; WithdrawnState / NormalState / IconicState + method on-state-change ( newstate -- ) + ;;;; simple drawing ;;;; method set-color ( color -- ) method set-named-color ( addr count -- ) diff --git a/libs/xog/xog-common.f b/libs/xog/xog-common.f index def3f28..cef6f11 100644 --- a/libs/xog/xog-common.f +++ b/libs/xog/xog-common.f @@ -12,7 +12,10 @@ use-libs: x11 0 value WM_PROTOCOLS 0 value XOF_INTERNAL_CLOSE -0 var XA_WM_DELETE_WINDOW +0 value WM_DELETE_WINDOW +0 value WM_TAKE_FOCUS +0 value WM_CHANGE_STATE +0 value WM_STATE 0 value NET_WM_WINDOW_TYPE 0 value NET_WM_WINDOW_TYPE_NORMAL @@ -60,7 +63,10 @@ also x11 also xconst ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ..: (xog-dpy-after-open) ( -- ) false " WM_PROTOCOLS" drop xog-dpy XInternAtom to WM_PROTOCOLS - false " WM_DELETE_WINDOW" drop xog-dpy XInternAtom XA_WM_DELETE_WINDOW ! + false " WM_DELETE_WINDOW" drop xog-dpy XInternAtom to WM_DELETE_WINDOW + false " WM_TAKE_FOCUS" drop xog-dpy XInternAtom to WM_TAKE_FOCUS + false " WM_CHANGE_STATE" drop xog-dpy XInternAtom to WM_CHANGE_STATE + false " WM_STATE" drop xog-dpy XInternAtom to WM_STATE false " URFORTH_XOF_INTERNAL_CLOSE" drop xog-dpy XInternAtom to XOF_INTERNAL_CLOSE false " _NET_WM_WINDOW_TYPE" drop xog-dpy XInternAtom to NET_WM_WINDOW_TYPE false " _NET_WM_WINDOW_TYPE_NORMAL" drop xog-dpy XInternAtom to NET_WM_WINDOW_TYPE_NORMAL @@ -68,7 +74,10 @@ also x11 also xconst ..: (xog-dpy-after-close) ( -- ) 0 to WM_PROTOCOLS - XA_WM_DELETE_WINDOW 0! + 0 to WM_DELETE_WINDOW + 0 to WM_TAKE_FOCUS + 0 to WM_CHANGE_STATE + 0 to WM_STATE 0 to XOF_INTERNAL_CLOSE 0 to NET_WM_WINDOW_TYPE 0 to NET_WM_WINDOW_TYPE_NORMAL diff --git a/samples/xog/xog-test-child.f b/samples/xog/xog-test-child.f index 175b65d..070ab9f 100644 --- a/samples/xog/xog-test-child.f +++ b/samples/xog/xog-test-child.f @@ -8,15 +8,6 @@ CoreFont oop:new-allot oop:value font BaseFont ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -BaseWindow method: PropertyNotify-Handler ( -- ) - (event) XPropertyEvent atom @ xog-dpy XGetAtomName >r - endcr (debug-id.) ." PROPERTY \`" r@ zcount type ." \` is " - (event) XPropertyEvent state @ PropertyDelete = if ." deleted" else ." set" endif - cr r> XFree -; - - -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; BaseWindow oop:class 32 buffer: caption field cb-action ( self -- ) @@ -289,7 +280,21 @@ MyWindow method: on-keydown ( keysym -- ) ; \ MyWindow method: on-keyup ( keysym -- ) drop ; -\ MyWindow method: on-close-query ( -- allow-close-flag ) true ." closing MyWindow\n" ; + +MyWindow method: on-close-query ( -- allow-close-flag ) + true ." close query for mywindow " (debug-id.) cr +; + +MyWindow method: on-state-change ( newstate -- ) + ." mywindow " (debug-id.) space ." newstate: " + case + WithdrawnState of ." widthdrawn\n" endof + NormalState of ." normal\n" endof + IconicState of ." iconic\n" endof + otherwise . cr + endcase +; + MyWindow method: on-button-down ( bnum -- ) ." mywindow " (debug-id.) space ." bdown: " . cr -- 2.11.4.GIT