summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2023-02-07 04:18:37 +0100
committertv <tv@krebsco.de>2023-02-07 04:25:35 +0100
commited526491aa05ee173095bcb519cf2d64fa40fb46 (patch)
tree37863b214418feff7ec92a21e37a126903cd15a8
parent9f8d54bce82fb61c428996a9367ec1579410ff32 (diff)
move moveWindowToDesktop to Graphics.X11.EWMH
-rw-r--r--lib/Graphics/X11/EWMH.hs9
-rw-r--r--src/pager.hs21
2 files changed, 14 insertions, 16 deletions
diff --git a/lib/Graphics/X11/EWMH.hs b/lib/Graphics/X11/EWMH.hs
index 856cfdb..fe9217a 100644
--- a/lib/Graphics/X11/EWMH.hs
+++ b/lib/Graphics/X11/EWMH.hs
@@ -48,6 +48,15 @@ getWindowTitle dpy w =
getWindowPropertyString dpy _NET_WM_NAME w <|>
getWindowPropertyString dpy _WM_NAME w
+moveWindowToDesktop :: Display -> Window -> CLong -> IO ()
+moveWindowToDesktop dpy w s =
+ allocaXEvent $ \e -> do
+ setEventType e clientMessage
+ setClientMessageEvent' e (fromIntegral w) _NET_WM_DESKTOP 32 [fromIntegral s,0,0,0,0]
+ sendEvent dpy (fromIntegral w) True mask e
+ where
+ mask = substructureNotifyMask
+
setDesktopNames :: [String] -> Display -> IO ()
setDesktopNames names dpy = do
changeProperty8 dpy r a t propModeReplace names'
diff --git a/src/pager.hs b/src/pager.hs
index f5c7e0d..dbfc6b0 100644
--- a/src/pager.hs
+++ b/src/pager.hs
@@ -9,7 +9,7 @@ import Blessings.Text (Blessings(Plain,SGR),pp)
import Control.Concurrent
import Control.Monad (forM)
import Control.Monad (forever)
-import Data.Bits ((.|.),testBit)
+import Data.Bits (testBit)
import Data.Default (def)
import Data.Function ((&))
import Data.List.Extra ((!!?))
@@ -17,7 +17,6 @@ import Data.Maybe (catMaybes,fromMaybe)
import Data.Monoid.Extra (mintercalate)
import Data.Set (Set)
import Data.Text (Text)
-import Foreign.C.Types (CLong)
import Much.Screen (Screen(Screen), withScreen)
import Pager.Types
import Scanner
@@ -223,31 +222,21 @@ main = do
Just s = name `List.elemIndex` map workspace_name workspaces
in
--debug (name, s, activeWindow, window) >>
- --windowToDesktop d activeWindow (fromIntegral s)
- windowToDesktop d (fromIntegral window) (fromIntegral s)
+ --X11.moveWindowToDesktop d activeWindow (fromIntegral s)
+ X11.moveWindowToDesktop d (fromIntegral window) (fromIntegral s)
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)
- windowToDesktop d (fromIntegral window) (fromIntegral s)
+ --X11.moveWindowToDesktop d activeWindow (fromIntegral s)
+ X11.moveWindowToDesktop d (fromIntegral window) (fromIntegral s)
X11.switchToDesktop d (fromIntegral s)
_ ->
return ()
-windowToDesktop :: X11.Display -> X11.Window -> CLong -> IO ()
-windowToDesktop d w s =
- X11.allocaXEvent $ \e -> do
- X11.setEventType e X11.clientMessage
- X11.setClientMessageEvent' e (fromIntegral w) X11._NET_WM_DESKTOP 32 [fromIntegral s,0,0,0,0]
- X11.sendEvent d (fromIntegral w) True mask e
- where
- mask = X11.substructureRedirectMask .|. X11.substructureNotifyMask
-
-
run :: Handle -> IO Event -> State -> IO (State, Action)
run o getEvent = rec . Right where
rec = \case