diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/desktops.hs | 13 | ||||
| -rw-r--r-- | src/pager.hs | 34 |
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 |