Add atomPropertyGDKx11.hs

atomPropertyGDKx11.hs

@@ -0,0 +1,69 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE OverloadedLabels #-}
+{-# LANGUAGE ImplicitParams #-}
+
+import Data.GI.Base (castTo)
+import qualified GI.Gtk as Gtk
+import qualified GI.Gdk as Gdk
+import qualified GI.GdkX11 as GdkX11
+import GI.Gio
+import Control.Monad (void)
+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)
+
+main :: IO ()
+main = do
+  app <- new Gtk.Application [#applicationId := "org.example.test"]
+  on app #activate $ do
+    win <- new Gtk.ApplicationWindow
+      [ #application := app
+      , #title := "Dialog Window"
+      , #defaultWidth := 400
+      , #defaultHeight := 100
+      , #resizable := False
+      , #decorated := False
+      ]
+
+    -- show + realize the window so a surface exists
+    Gtk.widgetShow win
+    widget <- Gtk.toWidget win
+    #realize widget
+
+    mSurface <- #getSurface win
+    case mSurface of
+      Just surface -> do
+        -- get X11 surface and display (via GDK casts)
+        mX11Surface <- castTo GdkX11.X11Surface surface
+        display     <- Gdk.surfaceGetDisplay surface
+        mX11Display <- castTo GdkX11.X11Display display
+
+        case (mX11Display, mX11Surface) of
+          (Just _gdkX11Disp, Just x11Surf) -> do
+            -- get the XID (window id) from the GDK X11 surface
+            xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
+
+            -- open a fresh X11 connection (use X11 package)
+            dpy <- openDisplay ""
+
+            -- intern atoms using X11 package
+            atomType   <- internAtom dpy "_NET_WM_WINDOW_TYPE" False
+            atomDialog <- internAtom dpy "_NET_WM_WINDOW_TYPE_DIALOG" False
+            atomAtom   <- internAtom dpy "ATOM" False
+
+            -- set the property as an ATOM (correct format for EWMH)
+            withArray [atomDialog] $ \ptr -> do
+              let win = fromIntegral (xidCULong :: CULong) :: Window
+              -- propModeReplace is provided by Graphics.X11.Xlib.Extras as 0,
+              -- but we import propModeReplace symbol for clarity if needed.
+              void $ xChangeProperty dpy win atomType atomAtom 32 propModeReplace (castPtr ptr) 1
+              flush dpy
+
+            -- note: we keep the X11 connection open for the lifetime of the app;
+            -- if you prefer, call closeDisplay dpy when done.
+          _ -> putStrLn "Not running under X11."
+      Nothing -> putStrLn "No surface available"
+
+  void $ applicationRun app Nothing