summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authortv <tv@krebsco.de>2023-02-07 03:01:37 +0100
committertv <tv@krebsco.de>2023-02-07 03:34:12 +0100
commitfe48ecd3b1cc11f176c1080539b70abac956f0a0 (patch)
tree896a7153a5dc9b861e4321a44f925e97a696648a
parentf28825e471e206bcb7e6dc8e4874c2b771f7d24c (diff)
move EWMH-related stuff to Graphics.X11.EWMH
-rw-r--r--lib/Graphics/X11/EWMH.hs48
-rw-r--r--lib/Graphics/X11/EWMH/Atom.hs23
-rw-r--r--lib/Graphics/X11/Xlib/Atom/Extra.hs18
-rw-r--r--pager.cabal2
-rw-r--r--src/main.hs44
5 files changed, 79 insertions, 56 deletions
diff --git a/lib/Graphics/X11/EWMH.hs b/lib/Graphics/X11/EWMH.hs
new file mode 100644
index 0000000..4f539ad
--- /dev/null
+++ b/lib/Graphics/X11/EWMH.hs
@@ -0,0 +1,48 @@
+module Graphics.X11.EWMH
+ ( module Graphics.X11.EWMH
+ , module Graphics.X11.EWMH.Atom
+ ) where
+
+import Control.Applicative ((<|>))
+import Data.Text (Text)
+import Foreign.C.Types (CLong)
+import Graphics.X11.EWMH.Atom
+import Graphics.X11.Types (Window)
+import Graphics.X11.Xlib.Atom.Extra
+import Graphics.X11.Xlib.Display (defaultRootWindow)
+import Graphics.X11.Xlib.Extras (getWindowProperty32)
+import Graphics.X11.Xlib.Extras.Extra (getWindowPropertyText)
+import Graphics.X11.Xlib.Types (Display)
+import qualified Data.Text as Text
+
+
+getActiveWindow :: Display -> IO (Maybe Window)
+getActiveWindow dpy =
+ (fmap (fromIntegral . head) <$>) $
+ getWindowProperty32 dpy _NET_ACTIVE_WINDOW w
+ where w = defaultRootWindow dpy
+
+getCurrentDesktop :: Display -> IO (Maybe CLong)
+getCurrentDesktop dpy =
+ (fmap head <$>) $
+ getWindowProperty32 dpy _NET_CURRENT_DESKTOP w <|>
+ getWindowProperty32 dpy _WIN_WORKSPACE w
+ where w = defaultRootWindow dpy
+
+getDesktopNames :: Display -> IO (Maybe [Text])
+getDesktopNames dpy = do
+ (fmap (init . Text.split (=='\NUL')) <$>) $
+ getWindowPropertyText dpy _NET_DESKTOP_NAMES w <|>
+ getWindowPropertyText dpy _WIN_WORKSPACE_NAMES w
+ where w = defaultRootWindow dpy
+
+getWindowDesktop :: Display -> Window -> IO (Maybe CLong)
+getWindowDesktop dpy w =
+ (fmap head <$>) $
+ getWindowProperty32 dpy _NET_WM_DESKTOP w <|>
+ getWindowProperty32 dpy _WIN_WORKSPACE w
+
+getWindowTitle :: Display -> Window -> IO (Maybe Text)
+getWindowTitle dpy w =
+ getWindowPropertyText dpy _NET_WM_NAME w <|>
+ getWindowPropertyText dpy _WM_NAME w
diff --git a/lib/Graphics/X11/EWMH/Atom.hs b/lib/Graphics/X11/EWMH/Atom.hs
new file mode 100644
index 0000000..71f9ff5
--- /dev/null
+++ b/lib/Graphics/X11/EWMH/Atom.hs
@@ -0,0 +1,23 @@
+module Graphics.X11.EWMH.Atom where
+
+import Graphics.X11.Types (Atom)
+import Graphics.X11.Xlib.Atom.Extra (unsafeInternAtom)
+
+
+_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
diff --git a/lib/Graphics/X11/Xlib/Atom/Extra.hs b/lib/Graphics/X11/Xlib/Atom/Extra.hs
index 8442c48..d96b54f 100644
--- a/lib/Graphics/X11/Xlib/Atom/Extra.hs
+++ b/lib/Graphics/X11/Xlib/Atom/Extra.hs
@@ -11,24 +11,6 @@ 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
diff --git a/pager.cabal b/pager.cabal
index 17bb744..c2fccc0 100644
--- a/pager.cabal
+++ b/pager.cabal
@@ -57,6 +57,8 @@ library
Data.Text.Encoding.Extra
, Foreign.C.String.Extra
, Graphics.X11.Extra
+ , Graphics.X11.EWMH
+ , Graphics.X11.EWMH.Atom
, Graphics.X11.Xlib.Atom.Extra
, Graphics.X11.Xlib.Display.Extra
, Graphics.X11.Xlib.Extra
diff --git a/src/main.hs b/src/main.hs
index 39f5491..2c500c7 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -6,7 +6,6 @@
module Main (main) where
import Blessings.Text (Blessings(Plain,SGR),pp)
-import Control.Applicative ((<|>))
import Control.Concurrent
import Control.Monad (forM)
import Control.Monad (forever)
@@ -37,35 +36,15 @@ import qualified Data.Text.Extra as Text
import qualified Data.Text.IO as Text
import qualified Data.Text.Read as Text
import qualified Graphics.X11 as X11
+import qualified Graphics.X11.EWMH as X11;
import qualified Graphics.X11.Extra as X11
import qualified Graphics.X11.Xlib.Extras as X11
-import qualified Graphics.X11.Xlib.Extras.Extra as X11
import qualified Hack.Buffer as Buffer
import qualified Hack.Buffer.Extra as Buffer
import qualified Pager.Sixelerator as Pager
import qualified System.Console.Terminal.Size as Term
-getActiveWindow :: X11.Display -> IO (Maybe X11.Window)
-getActiveWindow d =
- (fmap (fromIntegral . head) <$>) $
- 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 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 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
getGeometry d w = do
(_, x, y, width, height, _, _) <- X11.getGeometry d w
@@ -76,25 +55,14 @@ getGeometry d w = do
, geometry_height = fromIntegral height
}
-getWindowDesktop :: X11.Display -> X11.Window -> IO (Maybe CLong)
-getWindowDesktop d w =
- (fmap head <$>) $
- 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 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
let rootWindow = X11.defaultRootWindow display
- currentDesktop <- fromMaybe 0 <$> getCurrentDesktop display
+ currentDesktop <- fromMaybe 0 <$> X11.getCurrentDesktop display
workspaces <- do
- names <- zip [0..] . fromMaybe [] <$> getDesktopNames display
+ names <- zip [0..] . fromMaybe [] <$> X11.getDesktopNames display
ws <-
forM names $ \(index, name) -> do
return Workspace
@@ -111,8 +79,8 @@ getWorkspaces display screenGeometry focusWindows = do
let
f w = do
- title <- getWindowTitle display w
- desktop <- fromMaybe 0 <$> getWindowDesktop display w
+ title <- X11.getWindowTitle display w
+ desktop <- fromMaybe 0 <$> X11.getWindowDesktop display w
geometry <- getGeometry display w
wm_hints <- X11.getWMHints display w
@@ -173,7 +141,7 @@ main = do
error $ "bad arguments: " <> show args
- Just activeWindow <- X11.withDefaultDisplay getActiveWindow
+ Just activeWindow <- X11.withDefaultDisplay X11.getActiveWindow
screenGeometry <-
X11.withDefaultDisplay $ \display -> do