xmonad-config/lib/SendXMsg.hs

65 lines
2.1 KiB
Haskell
Raw Normal View History

2020-03-25 14:45:21 -04:00
module SendXMsg (XMsgType(..), sendXMsg, splitXMsg) where
2020-03-13 20:50:13 -04:00
2020-03-25 14:45:21 -04:00
import Data.Char
2020-03-13 20:50:13 -04:00
2020-03-25 14:45:21 -04:00
import Graphics.X11.Types
import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Display
import Graphics.X11.Xlib.Event
import Graphics.X11.Xlib.Extras
2020-03-13 20:50:13 -04:00
2020-03-25 14:45:21 -04:00
-- These are the "types" of client messages to send; add more here as needed
data XMsgType = ACPI
| Workspace
deriving (Eq, Show)
instance Enum XMsgType where
toEnum 0 = ACPI
toEnum 1 = Workspace
toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"
fromEnum ACPI = 0
fromEnum Workspace = 1
sendXMsg :: XMsgType -> String -> IO ()
sendXMsg xtype tag = do
2020-03-13 20:50:13 -04:00
dpy <- openDisplay ""
root <- rootWindow dpy $ defaultScreen dpy
allocaXEvent $ \e -> do
setEventType e clientMessage
-- NOTE: This function is written such that the penultimate
-- argument represents the first 40 bits of the 160 bit data
-- field, and it also only takes a decimal digit, which means the
-- string to be stored in the data field needs to be converted to
-- its decimal equivalent. The penultimate argument will be used
-- for the magic string and the last will be used for the tag.
2020-03-25 14:45:21 -04:00
setClientMessageEvent e root bITMAP 8 x t
2020-03-13 20:50:13 -04:00
sendEvent dpy root False substructureNotifyMask e
flush dpy
2020-03-25 14:45:21 -04:00
closeDisplay dpy
2020-03-13 20:50:13 -04:00
where
2020-03-25 14:45:21 -04:00
x = fromIntegral $ fromEnum xtype
t = str2digit $ tag ++ [garbageDelim]
2020-03-25 14:45:21 -04:00
str2digit :: String -> Time
str2digit = fromIntegral
. sum
. map (\(p, n) -> n * 256 ^ p)
. zip [0 :: Int ..]
. map fromEnum
splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
splitXMsg msg = (xtype, tag)
where
xtype = toEnum $ fromInteger $ toInteger $ head msg
tag = filterGarbage $ mapToChr $ drop 5 msg
filterGarbage = filter isAlphaNum . takeWhile (/= garbageDelim)
mapToChr = map (chr . fromInteger . toInteger)
-- WORKAROUND: setClientMessageEvent seems to put garbage on the end
-- of the data field (which is probably some yucky c problem I don't
-- understand). Easy solution, put something at the end of the tag to
-- separate the tag from the garbage
garbageDelim :: Char
garbageDelim = '~'