module System.Taffybar.Information.EWMHDesktopInfo
( EWMHIcon(..)
, EWMHIconData
, WorkspaceIdx(..)
, X11Window
, X11WindowHandle
, focusWindow
, getActiveWindow
, getCurrentWorkspace
, getVisibleWorkspaces
, getWindowClass
, getWindowIconsData
, getWindowTitle
, getWindows
, getWorkspace
, getWorkspaceNames
, isWindowUrgent
, parseWindowClasses
, switchOneWorkspace
, switchToWorkspace
, withDefaultCtx
, withEWMHIcons
) where
import Control.Applicative
import Control.Monad.Trans.Class
import Data.List.Split
import Data.Maybe
import Data.Tuple
import Data.Word
import Debug.Trace
import Foreign.ForeignPtr
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.Storable
import System.Taffybar.Information.SafeX11
import Prelude
import System.Taffybar.Information.X11DesktopInfo
type X11WindowHandle = ((WorkspaceIdx, String, String), X11Window)
newtype WorkspaceIdx = WSIdx Int
deriving (Show, Read, Ord, Eq)
type PixelsWordType = Word64
type EWMHIconData = (ForeignPtr PixelsWordType, Int)
data EWMHIcon = EWMHIcon
{ ewmhWidth :: Int
, ewmhHeight :: Int
, ewmhPixelsARGB :: Ptr PixelsWordType
} deriving (Show, Eq)
getCurrentWorkspace :: X11Property WorkspaceIdx
getCurrentWorkspace = WSIdx <$> readAsInt Nothing "_NET_CURRENT_DESKTOP"
getVisibleWorkspaces :: X11Property [WorkspaceIdx]
getVisibleWorkspaces = do
vis <- getVisibleTags
allNames <- map swap <$> getWorkspaceNames
cur <- getCurrentWorkspace
return $ cur : mapMaybe (`lookup` allNames) vis
getWorkspaceNames :: X11Property [(WorkspaceIdx, String)]
getWorkspaceNames = go <$> readAsListOfString Nothing "_NET_DESKTOP_NAMES"
where go = zip [WSIdx i | i <- [0..]]
switchToWorkspace :: WorkspaceIdx -> X11Property ()
switchToWorkspace (WSIdx idx) = do
cmd <- getAtom "_NET_CURRENT_DESKTOP"
sendCommandEvent cmd (fromIntegral idx)
switchOneWorkspace :: Bool -> Int -> X11Property ()
switchOneWorkspace dir end = do
cur <- getCurrentWorkspace
switchToWorkspace $ if dir then getPrev cur end else getNext cur end
getPrev :: WorkspaceIdx -> Int -> WorkspaceIdx
getPrev (WSIdx idx) end
| idx > 0 = WSIdx $ idx-1
| otherwise = WSIdx end
getNext :: WorkspaceIdx -> Int -> WorkspaceIdx
getNext (WSIdx idx) end
| idx < end = WSIdx $ idx+1
| otherwise = WSIdx 0
getWindowTitle :: X11Window -> X11Property String
getWindowTitle window = do
let w = Just window
prop <- readAsString w "_NET_WM_NAME"
case prop of
"" -> readAsString w "WM_NAME"
_ -> return prop
getWindowClass :: X11Window -> X11Property String
getWindowClass window = readAsString (Just window) "WM_CLASS"
parseWindowClasses :: String -> [String]
parseWindowClasses = filter (not . null) . splitOn "\NUL"
getWindowIconsData :: X11Window -> X11Property (Maybe EWMHIconData)
getWindowIconsData window = do
dpy <- getDisplay
atom <- getAtom "_NET_WM_ICON"
lift $ rawGetWindowPropertyBytes 32 dpy atom window
withEWMHIcons :: EWMHIconData -> ([EWMHIcon] -> IO a) -> IO a
withEWMHIcons (fptr, size) action =
withForeignPtr fptr ((>>= action) . parseIcons size)
parseIcons :: Int -> Ptr PixelsWordType -> IO [EWMHIcon]
parseIcons 0 _ = return []
parseIcons totalSize arr = do
iwidth <- fromIntegral <$> peek arr
iheight <- fromIntegral <$> peekElemOff arr 1
let pixelsPtr = advancePtr arr 2
thisSize = iwidth * iheight
newArr = advancePtr pixelsPtr thisSize
thisIcon =
EWMHIcon
{ ewmhWidth = iwidth
, ewmhHeight = iheight
, ewmhPixelsARGB = pixelsPtr
}
getRes newSize
| newSize < 0 = trace "This should not happen parseIcons" return []
| otherwise = (thisIcon :) <$> parseIcons newSize newArr
getRes $ totalSize - fromIntegral (thisSize + 2)
getActiveWindow :: X11Property (Maybe X11Window)
getActiveWindow =
listToMaybe . filter (> 0) <$> readAsListOfWindow Nothing "_NET_ACTIVE_WINDOW"
getWindows :: X11Property [X11Window]
getWindows = readAsListOfWindow Nothing "_NET_CLIENT_LIST"
getWorkspace :: X11Window -> X11Property WorkspaceIdx
getWorkspace window = WSIdx <$> readAsInt (Just window) "_NET_WM_DESKTOP"
focusWindow :: X11Window -> X11Property ()
focusWindow wh = do
cmd <- getAtom "_NET_ACTIVE_WINDOW"
sendWindowEvent cmd (fromIntegral wh)