diff options
author | tv <tv@krebsco.de> | 2023-02-07 02:05:27 +0100 |
---|---|---|
committer | tv <tv@krebsco.de> | 2023-02-07 02:05:27 +0100 |
commit | 3bd9c00812d91ade512e71a9f8e0f5b8917c3fa7 (patch) | |
tree | 381d87594d44a5439b4140f1e74d968fca9098bd /src | |
parent | 84a56482858d169769490421e3642e7c2c9d542a (diff) |
move atoms to Graphics.X11.Xlib.Atom.Extra
Diffstat (limited to 'src')
-rw-r--r-- | src/Graphics/X11/Extra.hs | 27 | ||||
-rw-r--r-- | src/Graphics/X11/Xlib/Atom/Extra.hs | 39 | ||||
-rw-r--r-- | src/Graphics/X11/Xlib/Display/Extra.hs | 20 | ||||
-rw-r--r-- | src/Graphics/X11/Xlib/Extra.hs | 7 | ||||
-rw-r--r-- | src/main.hs | 52 |
5 files changed, 82 insertions, 63 deletions
diff --git a/src/Graphics/X11/Extra.hs b/src/Graphics/X11/Extra.hs index bed1ba3..ce4cb46 100644 --- a/src/Graphics/X11/Extra.hs +++ b/src/Graphics/X11/Extra.hs @@ -1,24 +1,5 @@ -module Graphics.X11.Extra where +module Graphics.X11.Extra + ( module Graphics.X11.Xlib.Extra + ) where -import Control.Exception (bracket) -import System.Environment (getEnv) -import System.IO.Unsafe (unsafePerformIO) -import qualified Graphics.X11 as X11 - - -unsafeInternAtom :: String -> Bool -> X11.Atom -unsafeInternAtom atomName onlyIfExists = - unsafePerformIO $ withDefaultDisplay $ \display -> - X11.internAtom display atomName onlyIfExists - -defaultDisplayName :: String -defaultDisplayName = - unsafePerformIO (getEnv "DISPLAY") - -withDisplay :: String -> (X11.Display -> IO a) -> IO a -withDisplay display = - bracket (X11.openDisplay display) X11.closeDisplay - -withDefaultDisplay :: (X11.Display -> IO a) -> IO a -withDefaultDisplay = - withDisplay defaultDisplayName +import Graphics.X11.Xlib.Extra diff --git a/src/Graphics/X11/Xlib/Atom/Extra.hs b/src/Graphics/X11/Xlib/Atom/Extra.hs new file mode 100644 index 0000000..8442c48 --- /dev/null +++ b/src/Graphics/X11/Xlib/Atom/Extra.hs @@ -0,0 +1,39 @@ +module Graphics.X11.Xlib.Atom.Extra where + +import Graphics.X11.Types (Atom) +import Graphics.X11.Xlib.Atom (internAtom) +import Graphics.X11.Xlib.Display.Extra (withDefaultDisplay) +import System.IO.Unsafe (unsafePerformIO) + + +unsafeInternAtom :: String -> Bool -> Atom +unsafeInternAtom atomName onlyIfExists = + unsafePerformIO $ withDefaultDisplay $ \display -> + internAtom display atomName onlyIfExists + +_NET_ACTIVE_WINDOW :: Atom +_NET_ACTIVE_WINDOW = unsafeInternAtom "_NET_ACTIVE_WINDOW" True + +_NET_CLIENT_LIST :: Atom +_NET_CLIENT_LIST = unsafeInternAtom "_NET_CLIENT_LIST" True + +_NET_CURRENT_DESKTOP :: Atom +_NET_CURRENT_DESKTOP = unsafeInternAtom "_NET_CURRENT_DESKTOP" True + +_NET_DESKTOP_NAMES :: Atom +_NET_DESKTOP_NAMES = unsafeInternAtom "_NET_DESKTOP_NAMES" True + +_NET_WM_DESKTOP :: Atom +_NET_WM_DESKTOP = unsafeInternAtom "_NET_WM_DESKTOP" True + +_NET_WM_NAME :: Atom +_NET_WM_NAME = unsafeInternAtom "_NET_WM_NAME" True + +_WIN_WORKSPACE :: Atom +_WIN_WORKSPACE = unsafeInternAtom "_WIN_WORKSPACE" True + +_WIN_WORKSPACE_NAMES :: Atom +_WIN_WORKSPACE_NAMES = unsafeInternAtom "_WIN_WORKSPACE_NAMES" True + +_WM_NAME :: Atom +_WM_NAME = unsafeInternAtom "WM_NAME" True diff --git a/src/Graphics/X11/Xlib/Display/Extra.hs b/src/Graphics/X11/Xlib/Display/Extra.hs new file mode 100644 index 0000000..16b1a74 --- /dev/null +++ b/src/Graphics/X11/Xlib/Display/Extra.hs @@ -0,0 +1,20 @@ +module Graphics.X11.Xlib.Display.Extra where + +import Control.Exception (bracket) +import System.Environment (getEnv) +import System.IO.Unsafe (unsafePerformIO) +import Graphics.X11.Xlib.Types (Display) +import Graphics.X11.Xlib.Display (closeDisplay, openDisplay) + + +defaultDisplayName :: String +defaultDisplayName = + unsafePerformIO (getEnv "DISPLAY") + +withDisplay :: String -> (Display -> IO a) -> IO a +withDisplay display = + bracket (openDisplay display) closeDisplay + +withDefaultDisplay :: (Display -> IO a) -> IO a +withDefaultDisplay = + withDisplay defaultDisplayName diff --git a/src/Graphics/X11/Xlib/Extra.hs b/src/Graphics/X11/Xlib/Extra.hs new file mode 100644 index 0000000..c2093ab --- /dev/null +++ b/src/Graphics/X11/Xlib/Extra.hs @@ -0,0 +1,7 @@ +module Graphics.X11.Xlib.Extra + ( module Graphics.X11.Xlib.Atom.Extra + , module Graphics.X11.Xlib.Display.Extra + ) where + +import Graphics.X11.Xlib.Atom.Extra +import Graphics.X11.Xlib.Display.Extra diff --git a/src/main.hs b/src/main.hs index 669aedd..39f5491 100644 --- a/src/main.hs +++ b/src/main.hs @@ -46,52 +46,24 @@ import qualified Pager.Sixelerator as Pager import qualified System.Console.Terminal.Size as Term -atom_NET_ACTIVE_WINDOW :: X11.Atom -atom_NET_ACTIVE_WINDOW = X11.unsafeInternAtom "_NET_ACTIVE_WINDOW" True - -atom_NET_CLIENT_LIST :: X11.Atom -atom_NET_CLIENT_LIST = X11.unsafeInternAtom "_NET_CLIENT_LIST" True - -atom_NET_CURRENT_DESKTOP :: X11.Atom -atom_NET_CURRENT_DESKTOP = X11.unsafeInternAtom "_NET_CURRENT_DESKTOP" True - -atom_NET_DESKTOP_NAMES :: X11.Atom -atom_NET_DESKTOP_NAMES = X11.unsafeInternAtom "_NET_DESKTOP_NAMES" True - -atom_NET_WM_DESKTOP :: X11.Atom -atom_NET_WM_DESKTOP = X11.unsafeInternAtom "_NET_WM_DESKTOP" True - -atom_NET_WM_NAME :: X11.Atom -atom_NET_WM_NAME = X11.unsafeInternAtom "_NET_WM_NAME" True - -atom_WIN_WORKSPACE :: X11.Atom -atom_WIN_WORKSPACE = X11.unsafeInternAtom "_WIN_WORKSPACE" True - -atom_WIN_WORKSPACE_NAMES :: X11.Atom -atom_WIN_WORKSPACE_NAMES = X11.unsafeInternAtom "_WIN_WORKSPACE_NAMES" True - -atom_WM_NAME :: X11.Atom -atom_WM_NAME = X11.unsafeInternAtom "WM_NAME" True - - getActiveWindow :: X11.Display -> IO (Maybe X11.Window) getActiveWindow d = (fmap (fromIntegral . head) <$>) $ - X11.getWindowProperty32 d atom_NET_ACTIVE_WINDOW w + X11.getWindowProperty32 d X11._NET_ACTIVE_WINDOW w where w = X11.defaultRootWindow d getCurrentDesktop :: X11.Display -> IO (Maybe CLong) getCurrentDesktop d = (fmap head <$>) $ - X11.getWindowProperty32 d atom_NET_CURRENT_DESKTOP w <|> - X11.getWindowProperty32 d atom_WIN_WORKSPACE w + X11.getWindowProperty32 d X11._NET_CURRENT_DESKTOP w <|> + X11.getWindowProperty32 d X11._WIN_WORKSPACE w where w = X11.defaultRootWindow d getDesktopNames :: X11.Display -> IO (Maybe [Text]) getDesktopNames d = do (fmap (Text.split (=='\NUL')) <$>) $ - X11.getWindowPropertyText d atom_NET_DESKTOP_NAMES w <|> - X11.getWindowPropertyText d atom_WIN_WORKSPACE_NAMES w + X11.getWindowPropertyText d X11._NET_DESKTOP_NAMES w <|> + X11.getWindowPropertyText d X11._WIN_WORKSPACE_NAMES w where w = X11.defaultRootWindow d getGeometry :: X11.Display -> X11.Window -> IO Geometry @@ -107,13 +79,13 @@ getGeometry d w = do getWindowDesktop :: X11.Display -> X11.Window -> IO (Maybe CLong) getWindowDesktop d w = (fmap head <$>) $ - X11.getWindowProperty32 d atom_NET_WM_DESKTOP w <|> - X11.getWindowProperty32 d atom_WIN_WORKSPACE w + X11.getWindowProperty32 d X11._NET_WM_DESKTOP w <|> + X11.getWindowProperty32 d X11._WIN_WORKSPACE w getWindowTitle :: X11.Display -> X11.Window -> IO (Maybe Text) getWindowTitle d w = - X11.getWindowPropertyText d atom_NET_WM_NAME w <|> - X11.getWindowPropertyText d atom_WM_NAME w + X11.getWindowPropertyText d X11._NET_WM_NAME w <|> + X11.getWindowPropertyText d X11._WM_NAME w getWorkspaces :: X11.Display -> Geometry -> Set X11.Window -> IO [Workspace] getWorkspaces display screenGeometry focusWindows = do @@ -135,7 +107,7 @@ getWorkspaces display screenGeometry focusWindows = do clientList <- maybe [] (map fromIntegral) <$> - X11.getWindowProperty32 display atom_NET_CLIENT_LIST rootWindow + X11.getWindowProperty32 display X11._NET_CLIENT_LIST rootWindow let f w = do @@ -291,7 +263,7 @@ switchDesktop :: X11.Display -> CLong -> IO () switchDesktop d s = X11.allocaXEvent $ \e -> do X11.setEventType e X11.clientMessage - X11.setClientMessageEvent' e w atom_NET_CURRENT_DESKTOP 32 [fromIntegral s,0,0,0,0] + 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 @@ -302,7 +274,7 @@ 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) atom_NET_WM_DESKTOP 32 [fromIntegral s,0,0,0,0] + 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 |