Update src/Keyboard.hs

.gitignore

@@ -1,12 +0,0 @@
-# .gitignore
-
-
-*~
-*#
-.#*
-*rej
-*orig
-pinentry*
-*.hi
-*.o
-*.a

README.md

@@ -5,9 +5,26 @@ wazajisho library for handling japanese text in haskell
 <img src="https://git.ajattix.org/hashirama/waza-hs/raw/branch/main/misc/cover.jpg" alt="cover" width="30%" height="30%">
 
 
+### FileUtils.h
 
-### usage:
+for managing dictionaries we have a custom data structure, and you can use it that way:
-``` shell
+
-$ ghc -o myprog examples/Main.hs -i./src
+```haskell
+-- Access all directories in the list of FileGroups
+let directories = map directory fileGroups
+print directories -- ["/mnt/data1", "/mnt/data2"]
+
+-- Access all file lists in the list of FileGroups
+let filesList = map files fileGroups
+print filesList -- [["file1.mdx", "file2.css"], ["file3.mdx", "file4.png"]]
+
+-- Filter the FileGroups where any file in the files list contains ".mdx"
+let mdict_filter = filter (\group -> any (isSuffixOf ".mdx") (files group)) fileGroups
+
+-- Access all files of the filtered FileGroups
+let mdict_files = map files mdict_files
 ```
 
+you can for example, pass that list as a parameter for loading all of those dictionaries in [mdict-cpp](https://github.com/dictlab/mdict-cpp)
+
+TODO: move those functions to be some kind of helpers or operators

examples/Main.hs

@@ -1,132 +1,7 @@
--- Copyright © 2025 Hashirama Senju
+import KanaConv (convertHalfToFull)
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE BlockArguments #-}
-
-import GI.Gtk
-import qualified GI.Gtk as Gtk
-import GI.GLib (mainContextInvokeFull, MainContext)
-import GI.Gio hiding (Application)
-import Wazahs
-import Control.Concurrent
-import System.FilePath ((</>))
-import System.IO (writeFile)
-import Control.Concurrent.STM
-import System.Directory
-import qualified GI.WebKit.Objects.WebView as WK
-import qualified Data.Text as T
-import qualified Data.Text.IO as TIO
-
 
 main :: IO ()
 main = do
-    app <- new Application []
+  let input = "おいそこのｷﾐ｡あっはいはいはいは～い｡"
-
+  let output = convertHalfToFull input
-    onApplicationActivate app $ do
+  putStrLn output
-        window <- new GI.Gtk.ApplicationWindow [#application := app, #title := "Wazajisho"]
-        fd <- Gtk.fileDialogNew
-
-        home <- getHomeDirectory
-        let cfg = home </> ".local" </> "share" </> "wazajisho" </> "config"
-
-        filesVar <- newTVarIO []
-        
-        getFolderAsync fd window cfg $ \mPath -> case mPath of
-          Nothing -> putStrLn "Callback: no folder selected"
-          Just dir -> do
-            putStrLn $ "Callback: folder selected: " ++ dir
-            fs <- listFiles dir
-            putStrLn $ "Callback: listFiles found: " ++ show fs
-            atomically $ do
-              writeTVar filesVar fs
-
-
-        rootVBox <- Gtk.boxNew Gtk.OrientationVertical 6
-        topHBox  <- Gtk.boxNew Gtk.OrientationHorizontal 6
-        Gtk.widgetSetHexpand topHBox True
-        mainBox <- Gtk.boxNew Gtk.OrientationVertical 0
-
-        -- forces code to run in the same thread as gtk
-        mainContextInvokeFull Nothing 0 $ do
-            currentFiles <- readTVarIO filesVar
-            let icons = findIcons currentFiles
-            putStrLn "this was executed" -- well, it does works.
-            mapM_ putStrLn icons
-            toolbar <- createIconToolbar icons
-            Gtk.boxAppend mainBox toolbar
-            return False
-
-        
-        let htmlFilePath = "/tmp/index.html"
-        content <- TIO.readFile htmlFilePath
-        webview <- WK.webViewNew
-    
-        -- Load HTML content
-        WK.webViewLoadHtml webview content (Nothing :: Maybe T.Text)
-
--- Main vertical box
-
-
--- Toolbar
-
-
-            -- Search bar
-        searchBar <- new Gtk.Box
-          [ #orientation := Gtk.OrientationHorizontal
-          , #spacing := 20
-          , #baselinePosition := Gtk.BaselinePositionTop
-          , #halign := Gtk.AlignFill
-          , #hexpand := True
-          , #widthRequest := 300
-          , #marginTop := 10
-          , #marginEnd := 10
-          , #marginStart := 15
-          ]
-
-        entry <- Gtk.entryNew
-        Gtk.editableSetEditable entry True
-        #setHexpand entry True
-
-        searchButton <- new Gtk.Button [#label := "Search"]
-
-        Gtk.boxAppend searchBar entry
-        Gtk.boxAppend searchBar searchButton
-        Gtk.boxAppend mainBox searchBar
-
-        -- Phrase label (Yomichan-style heading)
-        phraseLabel <- new Gtk.Label [ #label := ("日本語の例文です" :: T.Text) ]
-        Gtk.widgetSetHalign phraseLabel Gtk.AlignCenter
-        Gtk.widgetSetHexpand phraseLabel True
-        #addCssClass phraseLabel "title-1"   -- large font style
-        Gtk.boxAppend mainBox phraseLabel
-
-        -- Webview
-        webviewBox <- Gtk.boxNew Gtk.OrientationHorizontal 0
-        Gtk.boxAppend webviewBox webview
-        Gtk.widgetSetVexpand webview True
-        Gtk.widgetSetHexpand webview True
-        Gtk.boxAppend mainBox webviewBox
-
-
-      --  Gtk.boxAppend topHBox searchBar   -- search bar in top area
-
--- keep your existing mainBox as the content area
-        Gtk.boxAppend rootVBox topHBox
-        Gtk.boxAppend rootVBox mainBox
-
--- now set the window child to rootVBox (do this once)
-        Gtk.windowSetChild window (Just rootVBox)
-
--- show
-        Gtk.widgetShow topHBox
-
-        Gtk.widgetShow rootVBox
-        Gtk.widgetShow window
-
-                      
-
-
-    applicationRun app Nothing
-    return ()

src/FileUtils.hs

@@ -0,0 +1,127 @@
+-- Copyright © 2024 Hashirama Senju
+
+import System.Clock   -- To measure time
+import System.Console.ANSI  -- For colored output
+--
+import Z.Data.CBytes (pack, unpack)
+import Z.IO.FileSystem (scandirRecursively)
+import System.FilePath (takeDirectory)
+import Data.List (groupBy, isSuffixOf, nub)
+import System.IO
+import qualified Data.Map as Map
+import Control.Concurrent.Async (mapConcurrently)
+import Control.Concurrent 
+
+-- Derived version with automatic string handling
+scanDirectoryRecursivelyStr :: String -> IO [String]
+scanDirectoryRecursivelyStr path = do
+    result <- scandirRecursively (pack path) (\p _ -> return True)
+    return (map unpack result)  -- Ensures all results are decoded to Strings (UTF-8)
+
+-- Function to filter files with a specific extension
+filterMdx :: [String] -> String -> [String]
+filterMdx files ext = filter (isSuffixOf ext) files
+
+-- Custom implementation of takeDirectory for UTF-8 strings
+takeDirectory' :: String -> String
+takeDirectory' path = reverse . dropWhile (/= '/') . reverse $ path
+
+data FileGroup = FileGroup
+  { directory :: String   -- The directory part of the file path (UTF-8 String)
+  , files     :: [String] -- List of file paths in that directory (UTF-8 Strings)
+  } deriving (Show, Eq)
+
+-- Create a map from directory to list of .mdx files
+groupMdxByDirectory :: [String] -> Map.Map String [String]
+groupMdxByDirectory mdxFiles = 
+  Map.fromListWith (++) [(takeDirectory' file, [file]) | file <- mdxFiles]
+
+-- Group files by their directory, including additional files that belong to the same directory
+groupFilesByDirectory :: [String] -> [String] -> IO [FileGroup]
+groupFilesByDirectory mdxFiles additionalFiles = do
+  -- Create a map of directories to .mdx files
+  let mdxMap = groupMdxByDirectory mdxFiles
+  
+  -- Function to process each directory group in parallel
+  let processGroup dir mdxFilesInDir = do
+        let -- Filter additional files that belong to the same directory
+            additionalFilesInDir = filter (\f -> takeDirectory' f == dir) additionalFiles
+            -- Remove matching files from additional files (those that are already in the .mdx list)
+            remainingAdditionalFiles = filter (\f -> not (f `elem` mdxFilesInDir)) additionalFilesInDir
+            -- Combine and remove duplicates
+            allFiles = nub (mdxFilesInDir ++ remainingAdditionalFiles)
+        return $ FileGroup dir allFiles
+
+  -- Process each directory group concurrently
+  groupedFiles <- mapConcurrently (\(dir, mdxFilesInDir) -> processGroup dir mdxFilesInDir) (Map.toList mdxMap)
+  return groupedFiles
+  
+-- Function to convert FileGroup to a string representation for file output
+fileGroupToString :: FileGroup -> String
+fileGroupToString (FileGroup dir files) = 
+    "Directory: " ++ dir ++ "\n" ++
+    unlines (map ("  " ++) files)
+
+
+-- Box-like animation function with green color
+boxAnimation :: IO ()
+boxAnimation = do
+    let frames = ["[   ]", "[.  ]", "[ . ]", "[  .]"]  -- Frame progression for box
+    let loop frames' = do
+          mapM_ (\frame -> do
+            setSGR [SetColor Foreground Vivid Green]  -- Set the box color to green
+            putStr "\r"  -- Move cursor to the start of the line
+            putStr frame  -- Print the current frame
+            hFlush stdout  -- Flush output buffer
+            threadDelay 200000) frames'  -- Wait 0.2 seconds between frames
+          loop frames'  -- Recursively call to keep the loop running
+    loop frames  -- Start the looping animation
+
+
+-- Main function
+main :: IO ()
+main = do
+
+        -- Start timing the operation
+    start <- getTime Monotonic
+
+    -- Notify the start of processing with color
+    setSGR [SetColor Foreground Vivid Blue]
+    putStrLn "Processing started..."
+    setSGR [Reset]  -- Reset colors
+        -- Create a thread for the box animation
+    animationThread <- forkIO boxAnimation
+
+  
+    allFiles <- scanDirectoryRecursivelyStr "/mnt/Data/Japanese_Resources/"
+    
+    -- Filter files with '.mdx' extension
+    let mdxFiles = filterMdx allFiles ".mdx"
+    
+    -- Group the files by their directories concurrently
+    groupedFiles <- groupFilesByDirectory mdxFiles allFiles
+
+    -- just to show that we finished processing, might be faster than doing I/O
+    putStrLn "Processing complete. Data is grouped."
+        -- Kill the animation thread
+    killThread animationThread
+            -- Stop timing the operation
+    end <- getTime Monotonic
+    let elapsed = toNanoSecs (diffTimeSpec end start) `div` 1000000  -- Convert to milliseconds
+
+    -- Show a colorful message after processing with elapsed time
+    setSGR [SetColor Foreground Vivid Green]
+    putStrLn $ "Processing complete. Time taken: " ++ show elapsed ++ " ms."
+    setSGR [Reset]  -- Reset colors
+
+    putStrLn "Starting to write results..."
+    animationThread <- forkIO boxAnimation
+    -- Open the output file and set its encoding to UTF-8
+    withFile "output.txt" WriteMode $ \handle -> do
+        hSetEncoding handle utf8  
+
+        -- Write the grouped files to the file
+        mapM_ (hPutStrLn handle . fileGroupToString) groupedFiles 
+
+    killThread animationThread
+

src/KanaConv.hs

@@ -0,0 +1,36 @@
+-- Copyright © 2024 Hashirama Senju
+
+{-# LANGUAGE OverloadedStrings #-}
+
+module KanaConv (convertHalfToFull) where  -- Export convertHalfToFull function
+
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+
+-- The Kana mapping for half-width to full-width katakana
+halfToFullMapping :: Map.Map String String
+halfToFullMapping = Map.fromList
+  [ ("ｱ", "ア"), ("ｲ", "イ"), ("ｳ", "ウ"), ("ｴ", "エ"), ("ｵ", "オ")
+  , ("ｶ", "カ"), ("ｷ", "キ"), ("ｸ", "ク"), ("ｹ", "ケ"), ("ｺ", "コ")
+  , ("ｻ", "サ"), ("ｼ", "シ"), ("ｽ", "ス"), ("ｾ", "セ"), ("ｿ", "ソ")
+  , ("ﾀ", "タ"), ("ﾁ", "チ"), ("ﾂ", "ツ"), ("ﾃ", "テ"), ("ﾄ", "ト")
+  , ("ﾅ", "ナ"), ("ﾆ", "ニ"), ("ﾇ", "ヌ"), ("ﾈ", "ネ"), ("ﾉ", "ノ")
+  , ("ﾊ", "ハ"), ("ﾋ", "ヒ"), ("ﾌ", "フ"), ("ﾍ", "ヘ"), ("ﾎ", "ホ")
+  , ("ﾏ", "マ"), ("ﾐ", "ミ"), ("ﾑ", "ム"), ("ﾒ", "メ"), ("ﾓ", "モ")
+  , ("ﾤ", "ヤ"), ("ﾦ", "ユ"), ("ﾧ", "ヨ"), ("ﾨ", "ラ"), ("ﾩ", "リ")
+  , ("ﾪ", "ル"), ("ﾬ", "レ"), ("ﾮ", "ロ"), ("ﾜ", "ワ"), ("ｦ", "ヲ")
+  , ("ﾝ", "ン"), ("ｧ", "ァ"), ("ｨ", "ィ"), ("ｩ", "ゥ"), ("ｪ", "ェ")
+  , ("ｫ", "ォ"), ("ｯ", "ッ"), ("ｬ", "ャ"), ("ｭ", "ュ"), ("ｮ", "ョ")
+  , ("｡", "。"), ("､", "、"), ("･", "・"), ("゛", "ﾞ"), ("゜", "ﾟ")
+  , ("｢", "「"), ("｣", "」"), ("ｰ", "ー")
+  ]
+
+-- Function to replace half-width characters with full-width characters
+replaceChar :: Char -> String
+replaceChar char
+  | Just full <- Map.lookup [char] halfToFullMapping = full
+  | otherwise = [char]
+
+-- Function to convert the entire string
+convertHalfToFull :: String -> String
+convertHalfToFull = concatMap replaceChar

src/Keyboard.hs

@@ -0,0 +1,12 @@
+import Data.Text.Lazy             as TL
+
+parseKB :: [String] -> [String]
+parseKB keylist = do {-
+        the thing is, we need to process this as a list, maybe with Map
+-}
+  our_keylist = TL.pack keylist
+  our_operator = TL.pack "-"
+  splited = TL.unpack $ TL.splitOn our_operator our_keylist
+
+-- getting the keys is partially implemented here:
+-- https://git.ajattix.org/hashirama/haskell-examples/src/branch/main/keyPress.hs

src/Wazahs.hs

@@ -1,252 +0,0 @@
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE OverloadedLabels #-}
-{-# LANGUAGE ImplicitParams #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-
-module Wazahs (
-    listFiles,
-    selectFolder,
-    getFolderAsync,
-    createIconToolbar,
-    findIcons,
-    (<@),
-    attachDialogOnRealize
-) where
-
--- imports
-
-import qualified Data.Conduit.Combinators as CC
-import GI.Gtk
-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   
-import System.FilePath
-import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
-import Data.Conduit
-import System.Environment 
-import Control.Concurrent
-import System.IO (writeFile)
-import Conduit
-import System.Process
-import qualified Data.Text as T
-import qualified Data.Map as M
-import System.Exit
-
--- | Recursively list all files in the given directory with .mdx extension.
-listFiles :: FilePath -> IO [FilePath]
-listFiles dir = runConduitRes $
-       CC.sourceDirectoryDeep False dir
-  .|   filterC (\fp -> takeExtension fp == ".mdx")
-  .|   sinkList
-
--- | Helper function for selecting folders in gtk
-selectFolder :: FileDialog -> ApplicationWindow -> (Maybe String -> IO ()) -> IO ()
-selectFolder fd w k =
-  fileDialogSelectFolder fd (Just w) (Nothing :: Maybe Cancellable) $ Just $ \_ r -> do
-    mbPath <- runMaybeT $ do
-      f <- MaybeT $ handleDialogError (\_ _ -> pure Nothing) (fileDialogSelectFolderFinish fd r)
-      p <- MaybeT $ fileGetPath f
-      p <$ (liftIO (doesDirectoryExist p) >>= guard)
-    k mbPath
-
--- Blocking: returns Maybe FilePath (checks config first).
--- WARNING: don't call on GTK main thread (it will block the dialog).
-getFolderBlocking
-  :: FileDialog           -- dialog (created by caller)
-  -> ApplicationWindow    -- parent (created by caller)
-  -> FilePath             -- config file path
-  -> IO (Maybe FilePath)
-getFolderBlocking fd w configFile = do
-  -- check config
-  cfgOk <- doesFileExist configFile
-  if cfgOk
-    then do
-      path <- readFile configFile
-      ok <- doesDirectoryExist path
-      if ok then return (Just path) else prompt
-    else prompt
- where
-  prompt = do
-    mv <- newEmptyMVar
-    -- use the existing callback-style selectFolder
-    selectFolder fd w $ \mPath -> do
-      case mPath of
-        Nothing -> putMVar mv Nothing
-        Just p  -> do
-          createDirectoryIfMissing True (takeDirectory configFile)
-          writeFile configFile p
-          putMVar mv (Just p)
-    takeMVar mv
-
-
--- | Restart the current program
-restartProgram :: IO ()
-restartProgram = do
-    exePath <- getExecutablePath
-    _ <- spawnProcess exePath []  -- launch a new instance
-    exitSuccess                  -- exit this instance
-
-
--- Async: safe to call from GTK main thread. Calls k with result.
-getFolderAsync
-  :: FileDialog
-  -> ApplicationWindow
-  -> FilePath
-  -> (Maybe FilePath -> IO ())   -- callback to receive result
-  -> IO ()
-getFolderAsync fd w configFile k = do
-  cfgOk <- doesFileExist configFile
-  if cfgOk
-    then do
-      path <- readFile configFile
-      ok <- doesDirectoryExist path
-      if ok
-        then k (Just path)
-        else showDialog
-    else showDialog
- where
-  showDialog = selectFolder fd w $ \mPath -> case mPath of
-    Nothing -> k Nothing
-    Just p  -> do
-      createDirectoryIfMissing True (takeDirectory configFile)
-      writeFile configFile p
-      k (Just p)
-      restartProgram
-
-
--- Return all icons corresponding to .mdx files
-findIcons :: [FilePath] -> [FilePath]
-findIcons files = [replaceExtension f "png" | f <- files, takeExtension f == ".mdx"]
-
-
--- not related to file handling:
-createIconToolbar' :: [FilePath] -> IO Gtk.Box
-createIconToolbar' iconPaths = do
-    toolbar <- Gtk.boxNew Gtk.OrientationHorizontal 0
-    Gtk.widgetSetHalign toolbar Gtk.AlignCenter
-    Gtk.widgetSetValign toolbar Gtk.AlignCenter
-
-    cssProvider <- Gtk.cssProviderNew
-    Gtk.cssProviderLoadFromString cssProvider $ T.pack $
-        ".classic-button {"
-        ++ "  -gtk-appearance: none;"
-        ++ "  background-image: linear-gradient(to bottom, #f3f3f3, #d8d8d8);"
-        ++ "  border: 1px solid #bbb;"
-        ++ "  border-radius: 4px;"
-        ++ "  color: #333;"
-        ++ "  box-shadow: inset 0 1px 0 rgba(255,255,255,0.7);"
-        ++ "  padding: 4px 8px;"
-        ++ "}"
-        ++ ".classic-button:hover {"
-        ++ "  background-image: linear-gradient(to bottom, #e6e6e6, #ccc);"
-        ++ "}"
-        ++ ".classic-button:active {"
-        ++ "  background-image: linear-gradient(to bottom, #ccc, #e6e6e6);"
-        ++ "}"
-
-    
-    mapM_ (\path -> do
-        icon <- Gtk.imageNewFromFile path
-        Gtk.widgetSetSizeRequest icon 64 64  -- Force minimum size
-
-        btn <- Gtk.buttonNew
-        Gtk.widgetAddCssClass btn "glass-button"
-        Gtk.widgetSetSizeRequest btn 80 80   -- Button size (icon + padding)
-        Gtk.widgetSetHalign btn Gtk.AlignCenter
-        Gtk.widgetSetValign btn Gtk.AlignCenter
-        Gtk.buttonSetChild btn (Just icon)
-        
-        -- Add click handler
-        void $ Gtk.on btn #clicked $ do
-            putStrLn $ "Selected: " ++ path
-            -- Add your click handler logic here
-            
-        Gtk.boxAppend toolbar btn
-        ) iconPaths
-    
-    return toolbar
-
-
-
--- Wrap the toolbar in a ScrolledWindow that scrolls horizontally
-createIconToolbar :: [FilePath] -> IO Gtk.Widget
-createIconToolbar iconPaths = do
-    -- Get your original toolbar (horizontal box)
-    toolbar <- createIconToolbar' iconPaths
-    
-    -- Create a new scrolled window
-    scrolled <- Gtk.scrolledWindowNew
-    
-    -- Show the horizontal scrollbar automatically, never show the vertical one
-    Gtk.scrolledWindowSetPolicy scrolled Gtk.PolicyTypeAutomatic Gtk.PolicyTypeNever
-
-    -- Put the horizontal box (your toolbar) inside the scrolled window
-    Gtk.scrolledWindowSetChild scrolled (Just toolbar)
-    
-    -- Return as a general Widget
-    Gtk.toWidget scrolled
-
--- helper for forcing lambdas to run in the gtk thread:
-infixr 0 <@
-(<@) :: IO () -> IO ()
-(<@) 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.IsWindow w => w -> IO ()
-setWindowAsDialog win = do
-  -- 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 :: 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) :: IO (Maybe GdkX11.X11Display)
-
-      case (mX11Display, mX11Surface) of
-        (Just _gdkX11Disp, Just x11Surf) -> do
-          -- get window XID and set ATOM via X11
-          xidCULong <- GdkX11.x11SurfaceGetXid x11Surf
-
-          dpy <- openDisplay ""
-          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 :: 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.IsWindow w => w -> IO SignalHandlerId
-attachDialogOnRealize win = do
-  wnd <- Gtk.toWindow win
-  on wnd #realize (setWindowAsDialog win)