REF sendxmsg code

bin/xmonad.hs

@@ -82,9 +82,7 @@ main = do
   dbClient <- startXMonadService
   (barPID, h) <- spawnPipe' "xmobar"
   _ <- forkIO runPowermon
-  _ <- forkIO $ runWorkspaceMon $ fromList [ (myGimpClass, myGimpWorkspace)
+  _ <- forkIO runWorkspaceMon'
-                                           , (myVMClass, myVMWorkspace)
-                                           ]
   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
+    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
          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"
 

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

lib/SendXMsg.hs

@@ -1,4 +1,4 @@
-module SendXMsg (sendXMsg, splitXMsg) where
+module SendXMsg (XMsgType(..), sendXMsg, splitXMsg) where
 
 import           Data.Char
 
@@ -8,8 +8,21 @@ import Graphics.X11.Xlib.Display
 import           Graphics.X11.Xlib.Event
 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 ""
   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

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