hashirama/waza-hs
hashirama/waza-hs
Watch
1
0
Fork
You've already forked waza-hs
 0
Code Issues Pull requests Projects Releases Wiki Activity Actions

polymorphic approach

Browse source
This commit is contained in:
千住柱間 2025-11-09 15:13:11 -04:00
commit 8bb30d4ed3
Signed by: hashirama
GPG key ID: 53E62470A86BC185
1 changed files with 16 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

29
src/Wazahs.hs
View file

@ -210,31 +210,32 @@ infixr 0 <@
-- | Set _NET_WM_WINDOW_TYPE to _NET_WM_WINDOW_TYPE_DIALOG for a realized GTK window.
-- Safe to call from the GTK main thread after the window has a surface (i.e. after realize).
setWindowAsDialog :: Gtk.ApplicationWindow -> IO ()
setWindowAsDialog :: Gtk.IsWindow w => w -> IO ()
setWindowAsDialog win = do
mSurface <- #getSurface win
-- upcast to concrete Gtk.Window right away (resolves ambiguity)
wnd <- Gtk.toWindow win
-- now get surface with a concrete Window type in scope
mSurface <- #getSurface wnd
case mSurface of
Just surface -> do
-- Cast to X11 surface & display
mX11Surface <- castTo GdkX11.X11Surface surface
Just (surface :: Gdk.Surface) -> do
-- cast to GDK X11 surface & display (explicit IO results)
mX11Surface <- (castTo GdkX11.X11Surface surface) :: IO (Maybe GdkX11.X11Surface)
display <- Gdk.surfaceGetDisplay surface
mX11Display <- castTo GdkX11.X11Display display
mX11Display <- (castTo GdkX11.X11Display display) :: IO (Maybe GdkX11.X11Display)
case (mX11Display, mX11Surface) of
(Just _gdkX11Disp, Just x11Surf) -> do
-- get window XID
-- get window XID and set ATOM via X11
xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
-- open a short-lived X11 connection (Xlib Display*)
dpy <- openDisplay ""
-- intern atoms and set property as ATOM (EWMH)
atomType <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
atomAtom <- internAtom dpy "ATOM" False
withArray [atomDialog] $ \ptr -> do
let winX :: Graphics.X11.Xlib.Window
let winX :: Window
winX = fromIntegral (xidCULong :: CULong)
void $ xChangeProperty dpy winX atomType atomAtom 32 propModeReplace (castPtr ptr) 1
flush dpy
@ -245,5 +246,7 @@ setWindowAsDialog win = do
-- | Attach setting the dialog atom to the window's #realize signal.
-- Returns the SignalHandlerId so you can disconnect if needed.
attachDialogOnRealize :: Gtk.ApplicationWindow -> IO SignalHandlerId
attachDialogOnRealize win = on win #realize (setWindowAsDialog win)
attachDialogOnRealize :: Gtk.IsWindow w => w -> IO SignalHandlerId
attachDialogOnRealize win = do
wnd <- Gtk.toWindow win
on wnd #realize (setWindowAsDialog win)