ENH add exit event program to handle empty dynamic workspaces

.gitignore

@@ -8,9 +8,7 @@ xmonad-*
 
 # files used by stack
 .stack-work/
-
-# directory created by `build` script
-bin/
+stack.yaml.lock
 
 # files automatically created by xmonad
 xmonad.state

bin/xit-event.hs

@@ -0,0 +1,52 @@
+-- | Send a special event as a signal to the window manager
+-- Specifically, this is meant to be run after applications exit which
+-- will allow xmonad to react to processes closing. It takes two
+-- arguments: a string called the "magic string" up to 5 characters
+-- and a string up to 15 characters called the "tag." These will be
+-- concatenated and sent to xmonad in a ClientRequest event of type
+-- BITMAP (which hopefully will never do anything) to the root window.
+-- Operationally, the magic string is meant to be used to
+-- differentiate this event and the tag is meant to be a signal to be
+-- read by xmonad.
+
+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 System.Environment
+import System.Exit
+
+main :: IO ()
+main = getArgs >>= parse
+
+parse :: [String] -> IO ()
+parse [magic, tag] = send magic tag >> exitSuccess
+parse _ = exitFailure
+
+send :: String -> String -> IO ()
+send magic tag = do
+  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.
+    setClientMessageEvent e root bITMAP 8 m t
+    sendEvent dpy root False substructureNotifyMask e
+  flush dpy
+  where
+    m = str2digit magic
+    t = str2digit tag
+
+str2digit :: (Num a) => String -> a
+str2digit = fromIntegral
+  . sum
+  . map (\(p, n) -> n * 256 ^ p)
+  . zip [0 :: Int ..]
+  . map fromEnum

my-xmonad.cabal

@@ -3,13 +3,22 @@ version:             0.1.0.0
 build-type:          Simple
 cabal-version:       >=1.10
 
-executable my-xmonad
+executable xmonad
   main-is:             ../xmonad.hs
-  -- other-modules lists custom modules in my ~/.xmonad/lib/ directory
   other-modules:
   build-depends:       base
                      , xmonad >= 0.13
                      , xmonad-contrib >= 0.13
+                     , xmonad-extras >= 0.15.2
+                     , X11 >= 1.9.1
   hs-source-dirs:      lib
   default-language:    Haskell2010
   ghc-options:         -Wall -Werror -fno-warn-missing-signatures -threaded
+
+executable xit-event
+  main-is:             bin/xit-event.hs
+  other-modules:
+  build-depends:       base
+                     , X11 >= 1.9.1
+  default-language:    Haskell2010
+  ghc-options:         -Wall -Werror -fno-warn-missing-signatures -threaded

stack.yaml

@@ -39,7 +39,7 @@ packages:
 # - git: https://github.com/commercialhaskell/stack.git
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
-# extra-deps: []
+extra-deps: []
 
 # Override default flag values for local packages and extra-deps
 # flags: {}

xmonad.hs

@@ -12,8 +12,8 @@ import System.IO
 import Data.Char
 import Data.List (sortBy)
 import Data.Maybe (fromMaybe, isJust)
-import Data.Ord (comparing)
 import Data.Monoid (All(..))
+import Data.Ord (comparing)
 
 import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Extras
@@ -210,13 +210,18 @@ myManageHook = composeOne
 -- data field that can be intercepted here. When this event is
 -- registered here, close the dynamic workspaces that are empty.
 myEventHook (ClientMessageEvent { ev_message_type = t, ev_data = d })
-  | t == bITMAP && magicstring == data2string d = do
-    mapM_ removeEmptyWorkspaceByTag [myVMWorkspace, myGimpWorkspace]
+  | t == bITMAP = do
+    let (magic, tag) = splitAt 5 $ map (chr . fromInteger . toInteger) d
+    io $ putStrLn magic
+    if magic == magicString then do 
+      let tag' = filter isAlphaNum tag
+      io $ putStrLn (show tag')
+      -- TODO this actually won't remove an empty workspace if
+      -- there are the same number of active workspaces as screens
+      removeEmptyWorkspaceByTag tag'
+    else return ()
     return (All True)
   | otherwise = return (All True)
-    where
-      magicstring = "xxxxxxxxxxxxxxxxxxxx"
-      data2string = map (chr . fromInteger . toInteger)
 myEventHook _ = do
   return (All True)
 
@@ -314,7 +319,6 @@ myModMask = mod4Mask
 _myRofi = "rofi -m -4" -- show rofi always with the focused window
 myTerm = "urxvt"
 myBrowser = "brave"
-myVBox = "vbox-start win8raw"
 myEditor = "emacsclient -c -e \"(select-frame-set-input-focus (selected-frame))\""
 myCalc = "urxvt -e R"
 myFileManager = "pcmanfm"
@@ -333,6 +337,14 @@ myScreenCap = "flameshot gui" --external script
 -- myWindowCap = "screencap -w" --external script
 myScreenLock = "screenlock" --external script
 
+removeWorkspaceOnExit cmd ws =
+  unwords [cmd, "&&", "xit-event", magicString, ws]
+
+magicString = "%%%%%"
+
+myVBox = removeWorkspaceOnExit "vbox-start win8raw" myVMWorkspace
+myGimp = removeWorkspaceOnExit "gimp" myGimpWorkspace
+
 showVBox = windows $ W.view myVMWorkspace
 
 showKeybindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
@@ -405,7 +417,7 @@ myKeys c =
   , ("M-C-q", addName "launch calc" $ spawn myCalc)
   , ("M-C-f", addName "launch file manager" $ spawn myFileManager)
   , ("M-C-v", addName "launch windows VM" $ spawn myVBox  >> appendWorkspace myVMWorkspace)
-  , ("M-C-g", addName "launch GIMP" $ spawn "gimp" >> appendWorkspace myGimpWorkspace)
+  , ("M-C-g", addName "launch GIMP" $ spawn myGimp >> appendWorkspace myGimpWorkspace)
   ] ++
 
   mkNamedSubmap c "Multimedia"