move switchToDesktop to Graphics.X11.EWMH

2 files changed, 28 insertions, 19 deletions

diff --git a/src/desktops.hs b/src/desktops.hs
index fd5f99d..9b64e2d 100644
--- a/src/desktops.hs
+++ b/src/desktops.hs
@@ -1,15 +1,16 @@
 {-# LANGUAGE LambdaCase #-}
 module Main (main) where
 
+import Data.List (elemIndex)
 import Data.Map (Map)
 import Data.Maybe (fromMaybe)
-import Graphics.X11.EWMH (getCurrentDesktop, getDesktopNames, setDesktopNames)
+import Graphics.X11.EWMH (getCurrentDesktop, getDesktopNames, setDesktopNames, switchToDesktop)
 import Graphics.X11.Extra (withDefaultDisplay)
+import System.Environment (getArgs)
 import qualified Data.Aeson as Aeson
 import qualified Data.ByteString.Lazy.Char8 as LBS8
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
-import System.Environment (getArgs)
 
 
 main :: IO ()
@@ -28,6 +29,7 @@ main =
             (x:y:xs) -> (x,y) : pairUp xs
             _ -> []
       "set" : names -> setWorkspaces names
+      "switch" : name : [] -> switchToWorkspace name
       x -> error $ "bad command: " <> show x
 
 getWorkspaces :: IO ()
@@ -68,3 +70,10 @@ renameWorkspaces renames = do
 
 setWorkspaces :: [String] -> IO ()
 setWorkspaces = withDefaultDisplay . setDesktopNames
+
+switchToWorkspace :: String -> IO ()
+switchToWorkspace name =
+    withDefaultDisplay $ \dpy -> do
+      names <- fromMaybe [] <$> getDesktopNames dpy
+      let Just i = name `elemIndex` names
+      switchToDesktop dpy (fromIntegral i)
diff --git a/src/pager.hs b/src/pager.hs
index 41c6eec..f5c7e0d 100644
--- a/src/pager.hs
+++ b/src/pager.hs
@@ -201,43 +201,43 @@ main = do
 
             return result
 
+    -- DEBUG: hPutStrLn hderp "XXX 5" >> hFlush hderp
 
     case snd result of
       FocusWorkspace name -> do
+          --wmpost (manager (fst result)) ("/workspace/" <> Text.unpack name <> "/view") ()
           case command (fst result) of
+            --ViewWorkspace ->
+            --  wmpost manager ("/workspace/" <> Text.unpack name <> "/view") () :: IO (Maybe ())
             ViewWorkspace -> do
+              -- XXX [xmonad-http] wmpost manager ("/workspace/" <> Text.unpack name <> "/view") () :: IO (Maybe ())
               X11.withDefaultDisplay $ \d -> do
                 let Just s = name `List.elemIndex` map workspace_name workspaces
-                switchDesktop d (fromIntegral s)
+                X11.switchToDesktop d (fromIntegral s)
+
+            ShiftWindowToWorkspace window -> do
+              -- XXX [xmonad-http] wmpost manager ("/workspace/" <> Text.unpack name <> "/shift/" <> Text.unpack wid) () :: IO (Maybe ())
 
-            ShiftWindowToWorkspace _ -> do
               X11.withDefaultDisplay $ \d ->
                 let
                   Just s = name `List.elemIndex` map workspace_name workspaces
                 in
-                windowToDesktop d activeWindow (fromIntegral s)
+                --debug (name, s, activeWindow, window) >>
+                --windowToDesktop d activeWindow (fromIntegral s)
+                windowToDesktop d (fromIntegral window) (fromIntegral s)
 
-            ShiftWindowToAndViewWorkspace _ -> do
+            ShiftWindowToAndViewWorkspace window -> do
+              -- XXX [xmonad-http] wmpost manager ("/workspace/" <> Text.unpack name <> "/shiftview/" <> show wid) () :: IO (Maybe ())
               X11.withDefaultDisplay $ \d -> do
                 let Just s = name `List.elemIndex` map workspace_name workspaces
-                windowToDesktop d activeWindow (fromIntegral s)
-                switchDesktop d (fromIntegral s)
+                --windowToDesktop d activeWindow (fromIntegral s)
+                windowToDesktop d (fromIntegral window) (fromIntegral s)
+                X11.switchToDesktop d (fromIntegral s)
 
       _ ->
         return ()
 
 
-switchDesktop :: X11.Display -> CLong -> IO ()
-switchDesktop d s =
-  X11.allocaXEvent $ \e -> do
-    X11.setEventType e X11.clientMessage
-    X11.setClientMessageEvent' e w X11._NET_CURRENT_DESKTOP 32 [fromIntegral s,0,0,0,0]
-    X11.sendEvent d w False mask e
-  where
-    w = X11.defaultRootWindow d
-    mask = X11.structureNotifyMask
-
-
 windowToDesktop :: X11.Display -> X11.Window -> CLong -> IO ()
 windowToDesktop d w s =
   X11.allocaXEvent $ \e -> do