From eb59d860efec85c1713cb0757637527b94c9d2a2 Mon Sep 17 00:00:00 2001 From: hashirama Date: Sun, 9 Nov 2025 14:54:56 -0400 Subject: [PATCH] add helpers for creating Dialogs --- src/Wazahs.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 55 insertions(+), 1 deletion(-) diff --git a/src/Wazahs.hs b/src/Wazahs.hs index 59d44d1..b08b854 100644 --- a/src/Wazahs.hs +++ b/src/Wazahs.hs @@ -1,4 +1,8 @@ -{-# LANGUAGE OverloadedStrings, OverloadedLabels, ImplicitParams #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedLabels #-} +{-# LANGUAGE ImplicitParams #-} +{-# LANGUAGE ScopedTypeVariables #-} + module Wazahs ( listFiles, selectFolder, @@ -16,6 +20,15 @@ import GI.GLib (mainContextInvokeFull) import GI.Gio hiding (Application) import qualified GI.Gtk as GTK import qualified GI.Gtk as Gtk +import qualified GI.Gdk as Gdk +import qualified GI.GdkX11 as GdkX11 +import Data.GI.Base.Signals +import Data.GI.Base (castTo) +import Foreign.Marshal.Array (withArray) +import Foreign.Ptr (castPtr) +import Foreign.C.Types (CULong) +import Graphics.X11.Xlib +import Graphics.X11.Xlib.Extras (xChangeProperty, propModeReplace) import Control.Monad (when, void, mzero, guard) import Data.Foldable (for_) import System.Directory @@ -192,3 +205,44 @@ infixr 0 <@ (<@) action = mainContextInvokeFull Nothing 0 $ do action return False + + +-- | 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 win = do + mSurface <- #getSurface win + case mSurface of + Just surface -> do + -- Cast to X11 surface & display + mX11Surface <- castTo GdkX11.X11Surface surface + display <- Gdk.surfaceGetDisplay surface + mX11Display <- castTo GdkX11.X11Display display + + case (mX11Display, mX11Surface) of + (Just _gdkX11Disp, Just x11Surf) -> do + -- get window XID + 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 + winX = fromIntegral (xidCULong :: CULong) + void $ xChangeProperty dpy winX atomType atomAtom 32 propModeReplace (castPtr ptr) 1 + flush dpy + + closeDisplay dpy + _ -> putStrLn "Not running under X11." + Nothing -> putStrLn "No surface available" + +-- | 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)