summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--pager.cabal3
-rw-r--r--src/Graphics/X11/Extra.hs27
-rw-r--r--src/Graphics/X11/Xlib/Atom/Extra.hs39
-rw-r--r--src/Graphics/X11/Xlib/Display/Extra.hs20
-rw-r--r--src/Graphics/X11/Xlib/Extra.hs7
-rw-r--r--src/main.hs52
6 files changed, 85 insertions, 63 deletions
diff --git a/pager.cabal b/pager.cabal
index d05c17d..418727e 100644
--- a/pager.cabal
+++ b/pager.cabal
@@ -42,6 +42,9 @@ executable pager
, Data.Text.Extra
, Foreign.C.String.Extra
, Graphics.X11.Extra
+ , Graphics.X11.Xlib.Extra
+ , Graphics.X11.Xlib.Atom.Extra
+ , Graphics.X11.Xlib.Display.Extra
, Graphics.X11.Xlib.Extras.Extra
, Hack.Buffer.Extra
, Much.Screen
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
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-22 08:09:49 +0000