FIX client message ctype formatting errors

This commit is contained in:
Nathan Dwarshuis 2022-03-05 18:18:35 -05:00
parent ee7406fd19
commit 29c58aec7a
2 changed files with 23 additions and 30 deletions

View File

@ -399,6 +399,7 @@ xMsgEventHook lock ClientMessageEvent { ev_message_type = t, ev_data = d }
case xtype of case xtype of
Workspace -> removeDynamicWorkspace tag Workspace -> removeDynamicWorkspace tag
ACPI -> handleACPI lock tag ACPI -> handleACPI lock tag
Unknown -> io $ print "WARNING: unknown concurrent message"
return (All True) return (All True)
xMsgEventHook _ _ = return (All True) xMsgEventHook _ _ = return (All True)

View File

@ -37,6 +37,7 @@ import Graphics.X11.Xlib.Extras
-- TODO is there a way to do this in the libraries that import this one? -- TODO is there a way to do this in the libraries that import this one?
data XMsgType = ACPI data XMsgType = ACPI
| Workspace | Workspace
| Unknown
deriving (Eq, Show) deriving (Eq, Show)
instance Enum XMsgType where instance Enum XMsgType where
@ -46,23 +47,7 @@ instance Enum XMsgType where
fromEnum ACPI = 0 fromEnum ACPI = 0
fromEnum Workspace = 1 fromEnum Workspace = 1
fromEnum Unknown = 2
--------------------------------------------------------------------------------
-- | Internal functions
str2digit :: String -> Time
str2digit = fromIntegral
. sum
. map (\(p, n) -> n * 256 ^ p)
. zip [0 :: Int ..]
. map fromEnum
-- 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 = '~'
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported API -- | Exported API
@ -70,12 +55,11 @@ garbageDelim = '~'
-- | Given a string from the data field in a ClientMessage event, return the -- | Given a string from the data field in a ClientMessage event, return the
-- type and payload -- type and payload
splitXMsg :: (Integral a) => [a] -> (XMsgType, String) splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
splitXMsg msg = (xtype, tag) splitXMsg [] = (Unknown, "")
splitXMsg (x:xs) = (xtype, tag)
where where
xtype = toEnum $ fromInteger $ toInteger $ head msg xtype = toEnum $ fromInteger $ toInteger x
tag = filterGarbage $ mapToChr $ drop 5 msg tag = map (chr . fromInteger . toInteger) $ takeWhile (/= 0) xs
filterGarbage = filter isAlphaNum . takeWhile (/= garbageDelim)
mapToChr = map (chr . fromInteger . toInteger)
-- | Emit a ClientMessage event to the X server with the given type and payloud -- | Emit a ClientMessage event to the X server with the given type and payloud
sendXMsg :: XMsgType -> String -> IO () sendXMsg :: XMsgType -> String -> IO ()
@ -84,16 +68,24 @@ sendXMsg xtype tag = do
root <- rootWindow dpy $ defaultScreen dpy root <- rootWindow dpy $ defaultScreen dpy
allocaXEvent $ \e -> do allocaXEvent $ \e -> do
setEventType e clientMessage setEventType e clientMessage
-- NOTE: This function is written such that the penultimate -- Set the client message for the root window to be something hacky and
-- argument represents the first 40 bits of the 160 bit data -- somewhat random that can be intercepted later in the main xmonad thread.
-- 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 -- Use the bitmap type since this is (hopefully) not going to be used by any
-- its decimal equivalent. The penultimate argument will be used -- apps I'm using (let alone the root window). If this isn't the case, the
-- for the magic string and the last will be used for the tag. -- logs will have some really weird messages in them. The format field is
setClientMessageEvent e root bITMAP 8 x t -- set to 8 (eg one byte) which allows direct conversion between Word8 types
-- and chars/string. The last argument is a list of data, where the first
-- character represents the message type (Workspace vs ACPI) and the
-- remaining members represent the tag. Note that the data payload for the
-- message is 20 bytes, so the tag can be 19 characters long. Anything
-- longer will be clipped to 19, and anything less than 19 will be padded
-- with 0 (note this used to be random garbage before). See this function
-- for more details.
setClientMessageEvent' e root bITMAP 8 (x:t)
sendEvent dpy root False substructureNotifyMask e sendEvent dpy root False substructureNotifyMask e
flush dpy flush dpy
closeDisplay dpy closeDisplay dpy
where where
x = fromIntegral $ fromEnum xtype x = fromIntegral $ fromEnum xtype
t = str2digit $ tag ++ [garbageDelim] t = fmap (fromIntegral . fromEnum) tag