add helpers for creating Dialogs

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)