From e934ceaa10aba0fc2d894b83522eb0d3075fe454 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Thu, 5 Mar 2020 21:22:26 -0500 Subject: [PATCH] ENH add exit event program to handle empty dynamic workspaces --- .gitignore | 4 +--- bin/xit-event.hs | 52 ++++++++++++++++++++++++++++++++++++++++++++++++ my-xmonad.cabal | 13 ++++++++++-- stack.yaml | 2 +- xmonad.hs | 28 ++++++++++++++++++-------- 5 files changed, 85 insertions(+), 14 deletions(-) create mode 100644 bin/xit-event.hs diff --git a/.gitignore b/.gitignore index 336e959..beaf1d2 100644 --- a/.gitignore +++ b/.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 diff --git a/bin/xit-event.hs b/bin/xit-event.hs new file mode 100644 index 0000000..d8eb24a --- /dev/null +++ b/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 diff --git a/my-xmonad.cabal b/my-xmonad.cabal index c47bc60..0d19482 100644 --- a/my-xmonad.cabal +++ b/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 diff --git a/stack.yaml b/stack.yaml index f5b329d..3ffa4e3 100644 --- a/stack.yaml +++ b/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: {} diff --git a/xmonad.hs b/xmonad.hs index 1f3d6d1..7f71abe 100644 --- a/xmonad.hs +++ b/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"