From 7d92a35e39f9e4360fe08dd2b243d19fe24401cc Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Wed, 25 Mar 2020 14:45:21 -0400 Subject: [PATCH] REF sendxmsg code --- bin/xmonad.hs | 49 ++++++++--------------------------- lib/ACPI.hs | 7 +---- lib/SendXMsg.hs | 63 ++++++++++++++++++++++++++++----------------- lib/WorkspaceMon.hs | 2 +- 4 files changed, 53 insertions(+), 68 deletions(-) diff --git a/bin/xmonad.hs b/bin/xmonad.hs index c359470..56ac358 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -82,9 +82,7 @@ main = do dbClient <- startXMonadService (barPID, h) <- spawnPipe' "xmobar" _ <- forkIO runPowermon - _ <- forkIO $ runWorkspaceMon $ fromList [ (myGimpClass, myGimpWorkspace) - , (myVMClass, myVMWorkspace) - ] + _ <- forkIO runWorkspaceMon' launch $ ewmh $ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient) @@ -102,6 +100,12 @@ main = do , focusedBorderColor = T.selectedBordersColor } +runWorkspaceMon' :: IO () +runWorkspaceMon' = runWorkspaceMon + $ fromList [ (myGimpClass, myGimpWorkspace) + , (myVMClass, myVMWorkspace) + ] + spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle) spawnPipe' x = io $ do (rd, wr) <- createPipe @@ -221,27 +225,13 @@ myManageHook = composeOne , isDialog -?> doCenterFloat ] --- This is a giant hack to "listen" for applications that close. Some --- apps like Virtualbox go on their own workspace which is dynamically --- created. But I want said workspace to disappear when the app --- closes. This is actually hard. We can't just listen to --- DestroyWindow events as VBox will "destroy" windows when it --- switches to fullscreen and back. We also can't just monitor the --- process from the window since WindowDestroy events don't have PIDs --- attached to them. Therefore, the hack to make this all work is to --- make a script fire when VirtualBox (and other apps that I want to --- control in this manner) close. This script fires a bogus --- ClientMessage event to the root window. This event will have a --- BITMAP atom (which should do nothing) and a "magic string" in the --- data field that can be intercepted here. When this event is --- registered here, close the dynamic workspaces that are empty. myEventHook :: Event -> X All myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } | t == bITMAP = do - let (magic, tag) = splitXMsg d - io $ print $ magic ++ "; " ++ tag - if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag - | magic == acpiMagic -> do + let (xtype, tag) = splitXMsg d + case xtype of + Workspace -> removeEmptyWorkspaceByTag tag + ACPI -> do let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent forM_ acpiTag $ \case Power -> myPowerPrompt @@ -249,23 +239,9 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } LidClose -> do status <- io isDischarging forM_ status $ \s -> runScreenLock >> when s runSuspend - | otherwise -> return () return (All True) --- myEventHook DestroyWindowEvent { ev_window = w } = do --- io $ print w - -- return (All True) myEventHook _ = return (All True) -removeEmptyWorkspaceByTag' :: String -> X () -removeEmptyWorkspaceByTag' tag = do - -- TODO this function works by first hiding the workspace to be - -- removed and then removing it. This won't work if there are no - -- other hidden workspaces to take it's place. So, need to scan - -- through the list of workspaces and swap the first one that is - -- empty with the workspace to be removed. If it actually is empty, - -- this will be enough to make it disappear. - removeEmptyWorkspaceByTag tag - data PowerPrompt = PowerPrompt instance XPrompt PowerPrompt where @@ -348,9 +324,6 @@ runOptimusPrompt = do -- shell commands -magicStringWS :: String -magicStringWS = "%%%%%" - myTerm :: String myTerm = "urxvt" diff --git a/lib/ACPI.hs b/lib/ACPI.hs index 0c2a67e..ac49157 100644 --- a/lib/ACPI.hs +++ b/lib/ACPI.hs @@ -2,7 +2,6 @@ module ACPI ( ACPIEvent(..) - , acpiMagic , isDischarging , runPowermon ) where @@ -35,7 +34,7 @@ instance Enum ACPIEvent where fromEnum LidClose = 2 sendACPIEvent :: ACPIEvent -> IO () -sendACPIEvent = sendXMsg acpiMagic . show . fromEnum +sendACPIEvent = sendXMsg ACPI . show . fromEnum parseLine :: ByteString -> Maybe ACPIEvent parseLine line = @@ -57,10 +56,6 @@ isDischarging = do Left _ -> return Nothing Right s -> return $ Just (s == "Discharging") --- TODO use a data type that enforces strings of max length 5 -acpiMagic :: String -acpiMagic = "%acpi" - runPowermon :: IO () runPowermon = do -- TODO barf when the socket doesn't exist diff --git a/lib/SendXMsg.hs b/lib/SendXMsg.hs index f94fe2f..fa4320c 100644 --- a/lib/SendXMsg.hs +++ b/lib/SendXMsg.hs @@ -1,15 +1,28 @@ -module SendXMsg (sendXMsg, splitXMsg) where +module SendXMsg (XMsgType(..), sendXMsg, splitXMsg) where -import Data.Char +import Data.Char -import Graphics.X11.Types -import Graphics.X11.Xlib.Atom -import Graphics.X11.Xlib.Display -import Graphics.X11.Xlib.Event -import Graphics.X11.Xlib.Extras +import Graphics.X11.Types +import Graphics.X11.Xlib.Atom +import Graphics.X11.Xlib.Display +import Graphics.X11.Xlib.Event +import Graphics.X11.Xlib.Extras -sendXMsg :: String -> String -> IO () -sendXMsg magic tag = do +-- 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 dpy <- openDisplay "" root <- rootWindow dpy $ defaultScreen dpy allocaXEvent $ \e -> do @@ -20,28 +33,32 @@ sendXMsg magic tag = do -- 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. - setClientMessageEvent e root bITMAP 8 m t + setClientMessageEvent e root bITMAP 8 x t sendEvent dpy root False substructureNotifyMask e flush dpy + closeDisplay dpy where - m = str2digit magic + x = fromIntegral $ fromEnum xtype t = str2digit $ tag ++ [garbageDelim] +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 = '~' - -splitXMsg :: (Integral a) => [a] -> (String, String) -splitXMsg s = (magic, filter isAlphaNum . takeWhile (/= garbageDelim) $ tag) - where - (magic, tag) = splitAt 5 $ map (chr . fromInteger . toInteger) s - -str2digit :: (Num a) => String -> a -str2digit = fromIntegral - . sum - . map (\(p, n) -> n * 256 ^ p) - . zip [0 :: Int ..] - . map fromEnum diff --git a/lib/WorkspaceMon.hs b/lib/WorkspaceMon.hs index 0203b5a..c388361 100644 --- a/lib/WorkspaceMon.hs +++ b/lib/WorkspaceMon.hs @@ -88,4 +88,4 @@ waitAndKill tag pid = waitUntilExit pidDir -- will spawn with the same PID within the delay limit res <- doesDirectoryExist d if res then threadDelay 100000 >> waitUntilExit d - else sendXMsg "%%%%%" tag + else sendXMsg Workspace tag