REF sendxmsg code
This commit is contained in:
parent
81227c1296
commit
7d92a35e39
|
@ -82,9 +82,7 @@ main = do
|
||||||
dbClient <- startXMonadService
|
dbClient <- startXMonadService
|
||||||
(barPID, h) <- spawnPipe' "xmobar"
|
(barPID, h) <- spawnPipe' "xmobar"
|
||||||
_ <- forkIO runPowermon
|
_ <- forkIO runPowermon
|
||||||
_ <- forkIO $ runWorkspaceMon $ fromList [ (myGimpClass, myGimpWorkspace)
|
_ <- forkIO runWorkspaceMon'
|
||||||
, (myVMClass, myVMWorkspace)
|
|
||||||
]
|
|
||||||
launch
|
launch
|
||||||
$ ewmh
|
$ ewmh
|
||||||
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient)
|
$ addDescrKeys' ((myModMask, xK_F1), showKeybindings) (myKeys [barPID] dbClient)
|
||||||
|
@ -102,6 +100,12 @@ main = do
|
||||||
, focusedBorderColor = T.selectedBordersColor
|
, focusedBorderColor = T.selectedBordersColor
|
||||||
}
|
}
|
||||||
|
|
||||||
|
runWorkspaceMon' :: IO ()
|
||||||
|
runWorkspaceMon' = runWorkspaceMon
|
||||||
|
$ fromList [ (myGimpClass, myGimpWorkspace)
|
||||||
|
, (myVMClass, myVMWorkspace)
|
||||||
|
]
|
||||||
|
|
||||||
spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
|
spawnPipe' :: MonadIO m => String -> m (ProcessID, Handle)
|
||||||
spawnPipe' x = io $ do
|
spawnPipe' x = io $ do
|
||||||
(rd, wr) <- createPipe
|
(rd, wr) <- createPipe
|
||||||
|
@ -221,27 +225,13 @@ myManageHook = composeOne
|
||||||
, isDialog -?> doCenterFloat
|
, 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 :: Event -> X All
|
||||||
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (magic, tag) = splitXMsg d
|
let (xtype, tag) = splitXMsg d
|
||||||
io $ print $ magic ++ "; " ++ tag
|
case xtype of
|
||||||
if | magic == magicStringWS -> removeEmptyWorkspaceByTag' tag
|
Workspace -> removeEmptyWorkspaceByTag tag
|
||||||
| magic == acpiMagic -> do
|
ACPI -> do
|
||||||
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
||||||
forM_ acpiTag $ \case
|
forM_ acpiTag $ \case
|
||||||
Power -> myPowerPrompt
|
Power -> myPowerPrompt
|
||||||
|
@ -249,23 +239,9 @@ myEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
LidClose -> do
|
LidClose -> do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
forM_ status $ \s -> runScreenLock >> when s runSuspend
|
||||||
| otherwise -> return ()
|
|
||||||
return (All True)
|
return (All True)
|
||||||
-- myEventHook DestroyWindowEvent { ev_window = w } = do
|
|
||||||
-- io $ print w
|
|
||||||
-- return (All True)
|
|
||||||
myEventHook _ = 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
|
data PowerPrompt = PowerPrompt
|
||||||
|
|
||||||
instance XPrompt PowerPrompt where
|
instance XPrompt PowerPrompt where
|
||||||
|
@ -348,9 +324,6 @@ runOptimusPrompt = do
|
||||||
|
|
||||||
-- shell commands
|
-- shell commands
|
||||||
|
|
||||||
magicStringWS :: String
|
|
||||||
magicStringWS = "%%%%%"
|
|
||||||
|
|
||||||
myTerm :: String
|
myTerm :: String
|
||||||
myTerm = "urxvt"
|
myTerm = "urxvt"
|
||||||
|
|
||||||
|
|
|
@ -2,7 +2,6 @@
|
||||||
|
|
||||||
module ACPI
|
module ACPI
|
||||||
( ACPIEvent(..)
|
( ACPIEvent(..)
|
||||||
, acpiMagic
|
|
||||||
, isDischarging
|
, isDischarging
|
||||||
, runPowermon
|
, runPowermon
|
||||||
) where
|
) where
|
||||||
|
@ -35,7 +34,7 @@ instance Enum ACPIEvent where
|
||||||
fromEnum LidClose = 2
|
fromEnum LidClose = 2
|
||||||
|
|
||||||
sendACPIEvent :: ACPIEvent -> IO ()
|
sendACPIEvent :: ACPIEvent -> IO ()
|
||||||
sendACPIEvent = sendXMsg acpiMagic . show . fromEnum
|
sendACPIEvent = sendXMsg ACPI . show . fromEnum
|
||||||
|
|
||||||
parseLine :: ByteString -> Maybe ACPIEvent
|
parseLine :: ByteString -> Maybe ACPIEvent
|
||||||
parseLine line =
|
parseLine line =
|
||||||
|
@ -57,10 +56,6 @@ isDischarging = do
|
||||||
Left _ -> return Nothing
|
Left _ -> return Nothing
|
||||||
Right s -> return $ Just (s == "Discharging")
|
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 :: IO ()
|
||||||
runPowermon = do
|
runPowermon = do
|
||||||
-- TODO barf when the socket doesn't exist
|
-- TODO barf when the socket doesn't exist
|
||||||
|
|
|
@ -1,4 +1,4 @@
|
||||||
module SendXMsg (sendXMsg, splitXMsg) where
|
module SendXMsg (XMsgType(..), sendXMsg, splitXMsg) where
|
||||||
|
|
||||||
import Data.Char
|
import Data.Char
|
||||||
|
|
||||||
|
@ -8,8 +8,21 @@ import Graphics.X11.Xlib.Display
|
||||||
import Graphics.X11.Xlib.Event
|
import Graphics.X11.Xlib.Event
|
||||||
import Graphics.X11.Xlib.Extras
|
import Graphics.X11.Xlib.Extras
|
||||||
|
|
||||||
sendXMsg :: String -> String -> IO ()
|
-- These are the "types" of client messages to send; add more here as needed
|
||||||
sendXMsg magic tag = do
|
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 ""
|
dpy <- openDisplay ""
|
||||||
root <- rootWindow dpy $ defaultScreen dpy
|
root <- rootWindow dpy $ defaultScreen dpy
|
||||||
allocaXEvent $ \e -> do
|
allocaXEvent $ \e -> do
|
||||||
|
@ -20,28 +33,32 @@ sendXMsg magic tag = do
|
||||||
-- string to be stored in the data field needs to be converted to
|
-- string to be stored in the data field needs to be converted to
|
||||||
-- its decimal equivalent. The penultimate argument will be used
|
-- its decimal equivalent. The penultimate argument will be used
|
||||||
-- for the magic string and the last will be used for the tag.
|
-- 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
|
sendEvent dpy root False substructureNotifyMask e
|
||||||
flush dpy
|
flush dpy
|
||||||
|
closeDisplay dpy
|
||||||
where
|
where
|
||||||
m = str2digit magic
|
x = fromIntegral $ fromEnum xtype
|
||||||
t = str2digit $ tag ++ [garbageDelim]
|
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
|
-- WORKAROUND: setClientMessageEvent seems to put garbage on the end
|
||||||
-- of the data field (which is probably some yucky c problem I don't
|
-- 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
|
-- understand). Easy solution, put something at the end of the tag to
|
||||||
-- separate the tag from the garbage
|
-- separate the tag from the garbage
|
||||||
garbageDelim :: Char
|
garbageDelim :: Char
|
||||||
garbageDelim = '~'
|
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
|
|
||||||
|
|
|
@ -88,4 +88,4 @@ waitAndKill tag pid = waitUntilExit pidDir
|
||||||
-- will spawn with the same PID within the delay limit
|
-- will spawn with the same PID within the delay limit
|
||||||
res <- doesDirectoryExist d
|
res <- doesDirectoryExist d
|
||||||
if res then threadDelay 100000 >> waitUntilExit d
|
if res then threadDelay 100000 >> waitUntilExit d
|
||||||
else sendXMsg "%%%%%" tag
|
else sendXMsg Workspace tag
|
||||||
|
|
Loading…
Reference in New Issue