-----------------------------------------------------------------------------
-- |
-- Module      : System.Taffybar.Information.EWMHDesktopInfo
-- Copyright   : (c) José A. Romero L.
-- License     : BSD3-style (see LICENSE)
--
-- Maintainer  : José A. Romero L. <escherdragon@gmail.com>
-- Stability   : unstable
-- Portability : unportable
--
-- Functions to access data provided by the X11 desktop via EWHM hints. This
-- module requires that the EwmhDesktops hook from the XMonadContrib project
-- be installed in your @~\/.xmonad\/xmonad.hs@ configuration:
--
-- > import XMonad
-- > import XMonad.Hooks.EwmhDesktops (ewmh)
-- >
-- > main = xmonad $ ewmh $ ...
--
-----------------------------------------------------------------------------

module System.Taffybar.Information.EWMHDesktopInfo
  ( EWMHIcon(..)
  , EWMHIconData
  , WorkspaceId(..)
  , X11Window
  , allEWMHProperties
  , ewmhActiveWindow
  , ewmhClientList
  , ewmhClientListStacking
  , ewmhCurrentDesktop
  , ewmhDesktopNames
  , ewmhNumberOfDesktops
  , ewmhStateHidden
  , ewmhWMClass
  , ewmhWMDesktop
  , ewmhWMIcon
  , ewmhWMName
  , ewmhWMName2
  , ewmhWMState
  , ewmhWMStateHidden
  , focusWindow
  , getActiveWindow
  , getCurrentWorkspace
  , getVisibleWorkspaces
  , getWindowClass
  , getWindowIconsData
  , getWindowMinimized
  , getWindowState
  , getWindowStateProperty
  , getWindowTitle
  , getWindows
  , getWindowsStacking
  , getWorkspace
  , getWorkspaceNames
  , isWindowUrgent
  , parseWindowClasses
  , switchOneWorkspace
  , switchToWorkspace
  , withDefaultCtx
  , withEWMHIcons
  ) where

import Control.Applicative
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Data.List
import Data.List.Split
import Data.Maybe
import Data.Tuple
import Data.Word
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import System.Log.Logger
import System.Taffybar.Information.SafeX11 hiding (logHere)
import System.Taffybar.Information.X11DesktopInfo

import Prelude

logHere :: MonadIO m => Priority -> String -> m ()
logHere :: forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
logHere Priority
p = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (String -> IO ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Priority -> String -> IO ()
logM String
"System.Taffybar.Information.EWMHDesktopInfo" Priority
p

newtype WorkspaceId = WorkspaceId Int deriving (Int -> WorkspaceId -> ShowS
[WorkspaceId] -> ShowS
WorkspaceId -> String
(Int -> WorkspaceId -> ShowS)
-> (WorkspaceId -> String)
-> ([WorkspaceId] -> ShowS)
-> Show WorkspaceId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WorkspaceId -> ShowS
showsPrec :: Int -> WorkspaceId -> ShowS
$cshow :: WorkspaceId -> String
show :: WorkspaceId -> String
$cshowList :: [WorkspaceId] -> ShowS
showList :: [WorkspaceId] -> ShowS
Show, ReadPrec [WorkspaceId]
ReadPrec WorkspaceId
Int -> ReadS WorkspaceId
ReadS [WorkspaceId]
(Int -> ReadS WorkspaceId)
-> ReadS [WorkspaceId]
-> ReadPrec WorkspaceId
-> ReadPrec [WorkspaceId]
-> Read WorkspaceId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS WorkspaceId
readsPrec :: Int -> ReadS WorkspaceId
$creadList :: ReadS [WorkspaceId]
readList :: ReadS [WorkspaceId]
$creadPrec :: ReadPrec WorkspaceId
readPrec :: ReadPrec WorkspaceId
$creadListPrec :: ReadPrec [WorkspaceId]
readListPrec :: ReadPrec [WorkspaceId]
Read, Eq WorkspaceId
Eq WorkspaceId
-> (WorkspaceId -> WorkspaceId -> Ordering)
-> (WorkspaceId -> WorkspaceId -> Bool)
-> (WorkspaceId -> WorkspaceId -> Bool)
-> (WorkspaceId -> WorkspaceId -> Bool)
-> (WorkspaceId -> WorkspaceId -> Bool)
-> (WorkspaceId -> WorkspaceId -> WorkspaceId)
-> (WorkspaceId -> WorkspaceId -> WorkspaceId)
-> Ord WorkspaceId
WorkspaceId -> WorkspaceId -> Bool
WorkspaceId -> WorkspaceId -> Ordering
WorkspaceId -> WorkspaceId -> WorkspaceId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WorkspaceId -> WorkspaceId -> Ordering
compare :: WorkspaceId -> WorkspaceId -> Ordering
$c< :: WorkspaceId -> WorkspaceId -> Bool
< :: WorkspaceId -> WorkspaceId -> Bool
$c<= :: WorkspaceId -> WorkspaceId -> Bool
<= :: WorkspaceId -> WorkspaceId -> Bool
$c> :: WorkspaceId -> WorkspaceId -> Bool
> :: WorkspaceId -> WorkspaceId -> Bool
$c>= :: WorkspaceId -> WorkspaceId -> Bool
>= :: WorkspaceId -> WorkspaceId -> Bool
$cmax :: WorkspaceId -> WorkspaceId -> WorkspaceId
max :: WorkspaceId -> WorkspaceId -> WorkspaceId
$cmin :: WorkspaceId -> WorkspaceId -> WorkspaceId
min :: WorkspaceId -> WorkspaceId -> WorkspaceId
Ord, WorkspaceId -> WorkspaceId -> Bool
(WorkspaceId -> WorkspaceId -> Bool)
-> (WorkspaceId -> WorkspaceId -> Bool) -> Eq WorkspaceId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WorkspaceId -> WorkspaceId -> Bool
== :: WorkspaceId -> WorkspaceId -> Bool
$c/= :: WorkspaceId -> WorkspaceId -> Bool
/= :: WorkspaceId -> WorkspaceId -> Bool
Eq)

-- A super annoying detail of the XGetWindowProperty interface is that: "If the
-- returned format is 32, the returned data is represented as a long array and
-- should be cast to that type to obtain the elements." This means that even
-- though only the 4 least significant bits will ever contain any data, the
-- array that is returned from X11 can have a larger word size. This means that
-- we need to manipulate the underlying data in annoying ways to pass it to gtk
-- appropriately.
type PixelsWordType = Word64

type EWMHProperty = String

ewmhActiveWindow, ewmhClientList, ewmhClientListStacking, ewmhCurrentDesktop, ewmhDesktopNames, ewmhNumberOfDesktops, ewmhStateHidden, ewmhWMDesktop, ewmhWMStateHidden, ewmhWMClass, ewmhWMState, ewmhWMIcon, ewmhWMName, ewmhWMName2 :: EWMHProperty
ewmhActiveWindow :: String
ewmhActiveWindow = String
"_NET_ACTIVE_WINDOW"
ewmhClientList :: String
ewmhClientList = String
"_NET_CLIENT_LIST"
ewmhClientListStacking :: String
ewmhClientListStacking = String
"_NET_CLIENT_LIST_STACKING"
ewmhCurrentDesktop :: String
ewmhCurrentDesktop = String
"_NET_CURRENT_DESKTOP"
ewmhDesktopNames :: String
ewmhDesktopNames = String
"_NET_DESKTOP_NAMES"
ewmhNumberOfDesktops :: String
ewmhNumberOfDesktops = String
"_NET_NUMBER_OF_DESKTOPS"
ewmhStateHidden :: String
ewmhStateHidden = String
"_NET_WM_STATE_HIDDEN"
ewmhWMClass :: String
ewmhWMClass = String
"WM_CLASS"
ewmhWMDesktop :: String
ewmhWMDesktop = String
"_NET_WM_DESKTOP"
ewmhWMIcon :: String
ewmhWMIcon = String
"_NET_WM_ICON"
ewmhWMName :: String
ewmhWMName = String
"_NET_WM_NAME"
ewmhWMName2 :: String
ewmhWMName2 = String
"WM_NAME"
ewmhWMState :: String
ewmhWMState = String
"_NET_WM_STATE"
ewmhWMStateHidden :: String
ewmhWMStateHidden = String
"_NET_WM_STATE_HIDDEN"

allEWMHProperties :: [EWMHProperty]
allEWMHProperties :: [String]
allEWMHProperties =
  [ String
ewmhActiveWindow
  , String
ewmhClientList
  , String
ewmhClientListStacking
  , String
ewmhCurrentDesktop
  , String
ewmhDesktopNames
  , String
ewmhNumberOfDesktops
  , String
ewmhStateHidden
  , String
ewmhWMClass
  , String
ewmhWMDesktop
  , String
ewmhWMIcon
  , String
ewmhWMName
  , String
ewmhWMName2
  , String
ewmhWMState
  , String
ewmhWMStateHidden
  ]

type EWMHIconData = (ForeignPtr PixelsWordType, Int)

data EWMHIcon = EWMHIcon
  { EWMHIcon -> Int
ewmhWidth :: Int
  , EWMHIcon -> Int
ewmhHeight :: Int
  , EWMHIcon -> Ptr PixelsWordType
ewmhPixelsARGB :: Ptr PixelsWordType
  } deriving (Int -> EWMHIcon -> ShowS
[EWMHIcon] -> ShowS
EWMHIcon -> String
(Int -> EWMHIcon -> ShowS)
-> (EWMHIcon -> String) -> ([EWMHIcon] -> ShowS) -> Show EWMHIcon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EWMHIcon -> ShowS
showsPrec :: Int -> EWMHIcon -> ShowS
$cshow :: EWMHIcon -> String
show :: EWMHIcon -> String
$cshowList :: [EWMHIcon] -> ShowS
showList :: [EWMHIcon] -> ShowS
Show, EWMHIcon -> EWMHIcon -> Bool
(EWMHIcon -> EWMHIcon -> Bool)
-> (EWMHIcon -> EWMHIcon -> Bool) -> Eq EWMHIcon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EWMHIcon -> EWMHIcon -> Bool
== :: EWMHIcon -> EWMHIcon -> Bool
$c/= :: EWMHIcon -> EWMHIcon -> Bool
/= :: EWMHIcon -> EWMHIcon -> Bool
Eq)

getWindowStateProperty :: String -> X11Window -> X11Property Bool
getWindowStateProperty :: String -> PixelsWordType -> X11Property Bool
getWindowStateProperty String
property PixelsWordType
window =
  Bool -> Bool
not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([String] -> Bool)
-> ReaderT X11Context IO [String] -> X11Property Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PixelsWordType -> [String] -> ReaderT X11Context IO [String]
getWindowState PixelsWordType
window [String
property]

getWindowState :: X11Window -> [String] -> X11Property [String]
getWindowState :: PixelsWordType -> [String] -> ReaderT X11Context IO [String]
getWindowState PixelsWordType
window [String]
request = do
  let getAsLong :: String -> ReaderT X11Context IO b
getAsLong String
s = PixelsWordType -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PixelsWordType -> b)
-> ReaderT X11Context IO PixelsWordType -> ReaderT X11Context IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ReaderT X11Context IO PixelsWordType
getAtom String
s
  [CLong]
integers <- (String -> ReaderT X11Context IO CLong)
-> [String] -> ReaderT X11Context IO [CLong]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM String -> ReaderT X11Context IO CLong
forall {b}. Num b => String -> ReaderT X11Context IO b
getAsLong [String]
request
  Maybe [CLong]
properties <- PropertyFetcher CLong
-> Maybe PixelsWordType -> String -> X11Property (Maybe [CLong])
forall a.
Integral a =>
PropertyFetcher a
-> Maybe PixelsWordType -> String -> X11Property (Maybe [a])
fetch PropertyFetcher CLong
getWindowProperty32 (PixelsWordType -> Maybe PixelsWordType
forall a. a -> Maybe a
Just PixelsWordType
window) String
ewmhWMState
  let integerToString :: [(CLong, String)]
integerToString = [CLong] -> [String] -> [(CLong, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [CLong]
integers [String]
request
      present :: [CLong]
present = [CLong] -> [CLong] -> [CLong]
forall a. Eq a => [a] -> [a] -> [a]
intersect [CLong]
integers ([CLong] -> [CLong]) -> [CLong] -> [CLong]
forall a b. (a -> b) -> a -> b
$ [CLong] -> Maybe [CLong] -> [CLong]
forall a. a -> Maybe a -> a
fromMaybe [] Maybe [CLong]
properties
      presentStrings :: [Maybe String]
presentStrings = (CLong -> Maybe String) -> [CLong] -> [Maybe String]
forall a b. (a -> b) -> [a] -> [b]
map (CLong -> [(CLong, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(CLong, String)]
integerToString) [CLong]
present
  [String] -> ReaderT X11Context IO [String]
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> ReaderT X11Context IO [String])
-> [String] -> ReaderT X11Context IO [String]
forall a b. (a -> b) -> a -> b
$ [Maybe String] -> [String]
forall a. [Maybe a] -> [a]
catMaybes [Maybe String]
presentStrings

-- | Get a bool reflecting whether window with provided X11Window is minimized
-- or not.
getWindowMinimized :: X11Window -> X11Property Bool
getWindowMinimized :: PixelsWordType -> X11Property Bool
getWindowMinimized = String -> PixelsWordType -> X11Property Bool
getWindowStateProperty String
ewmhStateHidden

-- | Retrieve the index of the current workspace in the desktop, starting from
-- 0.
getCurrentWorkspace :: X11Property WorkspaceId
getCurrentWorkspace :: X11Property WorkspaceId
getCurrentWorkspace = Int -> WorkspaceId
WorkspaceId (Int -> WorkspaceId)
-> ReaderT X11Context IO Int -> X11Property WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PixelsWordType -> String -> ReaderT X11Context IO Int
readAsInt Maybe PixelsWordType
forall a. Maybe a
Nothing String
ewmhCurrentDesktop

-- | Retrieve the indexes of all currently visible workspaces
-- with the active workspace at the head of the list.
getVisibleWorkspaces :: X11Property [WorkspaceId]
getVisibleWorkspaces :: X11Property [WorkspaceId]
getVisibleWorkspaces = do
  [String]
vis <- ReaderT X11Context IO [String]
getVisibleTags
  [(String, WorkspaceId)]
allNames <- ((WorkspaceId, String) -> (String, WorkspaceId))
-> [(WorkspaceId, String)] -> [(String, WorkspaceId)]
forall a b. (a -> b) -> [a] -> [b]
map (WorkspaceId, String) -> (String, WorkspaceId)
forall a b. (a, b) -> (b, a)
swap ([(WorkspaceId, String)] -> [(String, WorkspaceId)])
-> ReaderT X11Context IO [(WorkspaceId, String)]
-> ReaderT X11Context IO [(String, WorkspaceId)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT X11Context IO [(WorkspaceId, String)]
getWorkspaceNames
  WorkspaceId
cur <- X11Property WorkspaceId
getCurrentWorkspace
  [WorkspaceId] -> X11Property [WorkspaceId]
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([WorkspaceId] -> X11Property [WorkspaceId])
-> [WorkspaceId] -> X11Property [WorkspaceId]
forall a b. (a -> b) -> a -> b
$ WorkspaceId
cur WorkspaceId -> [WorkspaceId] -> [WorkspaceId]
forall a. a -> [a] -> [a]
: (String -> Maybe WorkspaceId) -> [String] -> [WorkspaceId]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> [(String, WorkspaceId)] -> Maybe WorkspaceId
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(String, WorkspaceId)]
allNames) [String]
vis

-- | Return a list with the names of all the workspaces currently
-- available.
getWorkspaceNames :: X11Property [(WorkspaceId, String)]
getWorkspaceNames :: ReaderT X11Context IO [(WorkspaceId, String)]
getWorkspaceNames = [String] -> [(WorkspaceId, String)]
forall {b}. [b] -> [(WorkspaceId, b)]
go ([String] -> [(WorkspaceId, String)])
-> ReaderT X11Context IO [String]
-> ReaderT X11Context IO [(WorkspaceId, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PixelsWordType -> String -> ReaderT X11Context IO [String]
readAsListOfString Maybe PixelsWordType
forall a. Maybe a
Nothing String
ewmhDesktopNames
  where go :: [b] -> [(WorkspaceId, b)]
go = [WorkspaceId] -> [b] -> [(WorkspaceId, b)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int -> WorkspaceId
WorkspaceId Int
i | Int
i <- [Int
0..]]

-- | Ask the window manager to switch to the workspace with the given
-- index, starting from 0.
switchToWorkspace :: WorkspaceId -> X11Property ()
switchToWorkspace :: WorkspaceId -> X11Property ()
switchToWorkspace (WorkspaceId Int
idx) = do
  PixelsWordType
cmd <- String -> ReaderT X11Context IO PixelsWordType
getAtom String
ewmhCurrentDesktop
  PixelsWordType -> PixelsWordType -> X11Property ()
sendCommandEvent PixelsWordType
cmd (Int -> PixelsWordType
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
idx)

-- | Move one workspace up or down from the current workspace
switchOneWorkspace :: Bool -> Int -> X11Property ()
switchOneWorkspace :: Bool -> Int -> X11Property ()
switchOneWorkspace Bool
dir Int
end = do
  WorkspaceId
cur <- X11Property WorkspaceId
getCurrentWorkspace
  WorkspaceId -> X11Property ()
switchToWorkspace (WorkspaceId -> X11Property ()) -> WorkspaceId -> X11Property ()
forall a b. (a -> b) -> a -> b
$ if Bool
dir then WorkspaceId -> Int -> WorkspaceId
getPrev WorkspaceId
cur Int
end else WorkspaceId -> Int -> WorkspaceId
getNext WorkspaceId
cur Int
end

-- | Check for corner case and switch one workspace up
getPrev :: WorkspaceId -> Int -> WorkspaceId
getPrev :: WorkspaceId -> Int -> WorkspaceId
getPrev (WorkspaceId Int
idx) Int
end
  | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = Int -> WorkspaceId
WorkspaceId (Int -> WorkspaceId) -> Int -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1
  | Bool
otherwise = Int -> WorkspaceId
WorkspaceId Int
end

-- | Check for corner case and switch one workspace down
getNext :: WorkspaceId -> Int -> WorkspaceId
getNext :: WorkspaceId -> Int -> WorkspaceId
getNext (WorkspaceId Int
idx) Int
end
  | Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
end = Int -> WorkspaceId
WorkspaceId (Int -> WorkspaceId) -> Int -> WorkspaceId
forall a b. (a -> b) -> a -> b
$ Int
idxInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1
  | Bool
otherwise = Int -> WorkspaceId
WorkspaceId Int
0

-- | Get the title of the given X11 window.
getWindowTitle :: X11Window -> X11Property String
getWindowTitle :: PixelsWordType -> X11Property String
getWindowTitle PixelsWordType
window = do
  let w :: Maybe PixelsWordType
w = PixelsWordType -> Maybe PixelsWordType
forall a. a -> Maybe a
Just PixelsWordType
window
  String
prop <- Maybe PixelsWordType -> String -> X11Property String
readAsString Maybe PixelsWordType
w String
ewmhWMName
  case String
prop of
    String
"" -> Maybe PixelsWordType -> String -> X11Property String
readAsString Maybe PixelsWordType
w String
ewmhWMName2
    String
_  -> String -> X11Property String
forall a. a -> ReaderT X11Context IO a
forall (m :: * -> *) a. Monad m => a -> m a
return String
prop

-- | Get the class of the given X11 window.
getWindowClass :: X11Window -> X11Property String
getWindowClass :: PixelsWordType -> X11Property String
getWindowClass PixelsWordType
window = Maybe PixelsWordType -> String -> X11Property String
readAsString (PixelsWordType -> Maybe PixelsWordType
forall a. a -> Maybe a
Just PixelsWordType
window) String
ewmhWMClass

parseWindowClasses :: String -> [String]
parseWindowClasses :: String -> [String]
parseWindowClasses = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null) ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"\NUL"

-- | Get EWMHIconData for the given X11Window
getWindowIconsData :: X11Window -> X11Property (Maybe EWMHIconData)
getWindowIconsData :: PixelsWordType -> X11Property (Maybe EWMHIconData)
getWindowIconsData PixelsWordType
window = do
  Display
dpy <- X11Property Display
getDisplay
  PixelsWordType
atom <- String -> ReaderT X11Context IO PixelsWordType
getAtom String
ewmhWMIcon
  IO (Maybe EWMHIconData) -> X11Property (Maybe EWMHIconData)
forall (m :: * -> *) a. Monad m => m a -> ReaderT X11Context m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO (Maybe EWMHIconData) -> X11Property (Maybe EWMHIconData))
-> IO (Maybe EWMHIconData) -> X11Property (Maybe EWMHIconData)
forall a b. (a -> b) -> a -> b
$ Int
-> Display
-> PixelsWordType
-> PixelsWordType
-> IO (Maybe EWMHIconData)
forall a.
Storable a =>
Int
-> Display
-> PixelsWordType
-> PixelsWordType
-> IO (Maybe (ForeignPtr a, Int))
rawGetWindowPropertyBytes Int
32 Display
dpy PixelsWordType
atom PixelsWordType
window

-- | Operate on the data contained in 'EWMHIconData' in the easier to interact
-- with format offered by 'EWMHIcon'. This function is much like
-- 'withForeignPtr' in that the 'EWMHIcon' values that are provided to the
-- callable argument should not be kept around in any way, because it can not be
-- guaranteed that the finalizer for the memory to which those icon objects
-- point will not be executed, after the call to 'withEWMHIcons' completes.
withEWMHIcons :: EWMHIconData -> ([EWMHIcon] -> IO a) -> IO a
withEWMHIcons :: forall a. EWMHIconData -> ([EWMHIcon] -> IO a) -> IO a
withEWMHIcons (ForeignPtr PixelsWordType
fptr, Int
size) [EWMHIcon] -> IO a
action =
  ForeignPtr PixelsWordType -> (Ptr PixelsWordType -> IO a) -> IO a
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr PixelsWordType
fptr ((IO [EWMHIcon] -> ([EWMHIcon] -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [EWMHIcon] -> IO a
action) (IO [EWMHIcon] -> IO a)
-> (Ptr PixelsWordType -> IO [EWMHIcon])
-> Ptr PixelsWordType
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Ptr PixelsWordType -> IO [EWMHIcon]
parseIcons Int
size)

-- | Split icon raw integer data into EWMHIcons. Each icon raw data is an
-- integer for width, followed by height, followed by exactly (width*height)
-- ARGB pixels, optionally followed by the next icon.
--
-- XXX: This function should not be made public, because its return value contains
-- (sub)pointers whose allocation we do not control.
parseIcons :: Int -> Ptr PixelsWordType -> IO [EWMHIcon]
parseIcons :: Int -> Ptr PixelsWordType -> IO [EWMHIcon]
parseIcons Int
0 Ptr PixelsWordType
_ = [EWMHIcon] -> IO [EWMHIcon]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
parseIcons Int
totalSize Ptr PixelsWordType
arr = do
  Int
iwidth <- PixelsWordType -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PixelsWordType -> Int) -> IO PixelsWordType -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PixelsWordType -> IO PixelsWordType
forall a. Storable a => Ptr a -> IO a
peek Ptr PixelsWordType
arr
  Int
iheight <- PixelsWordType -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (PixelsWordType -> Int) -> IO PixelsWordType -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr PixelsWordType -> Int -> IO PixelsWordType
forall a. Storable a => Ptr a -> Int -> IO a
peekElemOff Ptr PixelsWordType
arr Int
1
  let pixelsPtr :: Ptr PixelsWordType
pixelsPtr = Ptr PixelsWordType -> Int -> Ptr PixelsWordType
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr PixelsWordType
arr Int
2
      thisSize :: Int
thisSize = Int
iwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
iheight
      newArr :: Ptr PixelsWordType
newArr = Ptr PixelsWordType -> Int -> Ptr PixelsWordType
forall a. Storable a => Ptr a -> Int -> Ptr a
advancePtr Ptr PixelsWordType
pixelsPtr Int
thisSize
      thisIcon :: EWMHIcon
thisIcon =
        EWMHIcon
        { ewmhWidth :: Int
ewmhWidth = Int
iwidth
        , ewmhHeight :: Int
ewmhHeight = Int
iheight
        , ewmhPixelsARGB :: Ptr PixelsWordType
ewmhPixelsARGB = Ptr PixelsWordType
pixelsPtr
        }
      getRes :: Int -> IO [EWMHIcon]
getRes Int
newSize
        | Int
newSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 =
          Priority -> String -> IO ()
forall (m :: * -> *). MonadIO m => Priority -> String -> m ()
logHere Priority
ERROR String
"Attempt to recurse on negative value in parseIcons"
                    IO () -> IO [EWMHIcon] -> IO [EWMHIcon]
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> [EWMHIcon] -> IO [EWMHIcon]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Bool
otherwise = (EWMHIcon
thisIcon EWMHIcon -> [EWMHIcon] -> [EWMHIcon]
forall a. a -> [a] -> [a]
:) ([EWMHIcon] -> [EWMHIcon]) -> IO [EWMHIcon] -> IO [EWMHIcon]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Ptr PixelsWordType -> IO [EWMHIcon]
parseIcons Int
newSize Ptr PixelsWordType
newArr
  Int -> IO [EWMHIcon]
getRes (Int -> IO [EWMHIcon]) -> Int -> IO [EWMHIcon]
forall a b. (a -> b) -> a -> b
$ Int
totalSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
thisSize Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2)

-- | Get the window that currently has focus if such a window exists.
getActiveWindow :: X11Property (Maybe X11Window)
getActiveWindow :: X11Property (Maybe PixelsWordType)
getActiveWindow = [PixelsWordType] -> Maybe PixelsWordType
forall a. [a] -> Maybe a
listToMaybe ([PixelsWordType] -> Maybe PixelsWordType)
-> ([PixelsWordType] -> [PixelsWordType])
-> [PixelsWordType]
-> Maybe PixelsWordType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PixelsWordType -> Bool) -> [PixelsWordType] -> [PixelsWordType]
forall a. (a -> Bool) -> [a] -> [a]
filter (PixelsWordType -> PixelsWordType -> Bool
forall a. Ord a => a -> a -> Bool
> PixelsWordType
0) ([PixelsWordType] -> Maybe PixelsWordType)
-> ReaderT X11Context IO [PixelsWordType]
-> X11Property (Maybe PixelsWordType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PixelsWordType
-> String -> ReaderT X11Context IO [PixelsWordType]
readAsListOfWindow Maybe PixelsWordType
forall a. Maybe a
Nothing String
ewmhActiveWindow

-- | Return a list of all @X11Window@s, sorted by initial mapping order, oldest to newest.
getWindows :: X11Property [X11Window]
getWindows :: ReaderT X11Context IO [PixelsWordType]
getWindows = Maybe PixelsWordType
-> String -> ReaderT X11Context IO [PixelsWordType]
readAsListOfWindow Maybe PixelsWordType
forall a. Maybe a
Nothing String
ewmhClientList

-- | Return a list of all @X11Window@s, sorted in stacking order, bottom-to-top.
getWindowsStacking :: X11Property [X11Window]
getWindowsStacking :: ReaderT X11Context IO [PixelsWordType]
getWindowsStacking = Maybe PixelsWordType
-> String -> ReaderT X11Context IO [PixelsWordType]
readAsListOfWindow Maybe PixelsWordType
forall a. Maybe a
Nothing String
ewmhClientListStacking

-- | Return the index (starting from 0) of the workspace on which the given
-- window is being displayed.
getWorkspace :: X11Window -> X11Property WorkspaceId
getWorkspace :: PixelsWordType -> X11Property WorkspaceId
getWorkspace PixelsWordType
window = Int -> WorkspaceId
WorkspaceId (Int -> WorkspaceId)
-> ReaderT X11Context IO Int -> X11Property WorkspaceId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe PixelsWordType -> String -> ReaderT X11Context IO Int
readAsInt (PixelsWordType -> Maybe PixelsWordType
forall a. a -> Maybe a
Just PixelsWordType
window) String
ewmhWMDesktop

-- | Ask the window manager to give focus to the given window.
focusWindow :: X11Window -> X11Property ()
focusWindow :: PixelsWordType -> X11Property ()
focusWindow PixelsWordType
wh = do
  PixelsWordType
cmd <- String -> ReaderT X11Context IO PixelsWordType
getAtom String
ewmhActiveWindow
  PixelsWordType -> PixelsWordType -> X11Property ()
sendWindowEvent PixelsWordType
cmd (PixelsWordType -> PixelsWordType
forall a b. (Integral a, Num b) => a -> b
fromIntegral PixelsWordType
wh)