ENH move workspace appending to managehook for vbox and gimp

This commit is contained in:
Nathan Dwarshuis 2020-03-26 23:33:45 -04:00
parent 365a1d0267
commit 2a98917b3e
1 changed files with 41 additions and 32 deletions

View File

@ -19,6 +19,7 @@ import Control.Concurrent
import Control.Monad import Control.Monad
( forM ( forM
, forM_ , forM_
, liftM2
, mapM_ , mapM_
, void , void
, when , when
@ -112,18 +113,6 @@ spawnPipe' x = io $ do
myWorkspaces :: [String] myWorkspaces :: [String]
myWorkspaces = map show [1..10 :: Int] myWorkspaces = map show [1..10 :: Int]
myVMWorkspace :: String
myVMWorkspace = "VM"
myVMClass :: String
myVMClass = "VirtualBoxVM"
myGimpWorkspace :: String
myGimpWorkspace = "GIMP"
myGimpClass :: String
myGimpClass = "Gimp"
myLayouts = onWorkspace myVMWorkspace (noBorders Full) myLayouts = onWorkspace myVMWorkspace (noBorders Full)
-- $ onWorkspace myGimpWorkspace gimpLayout -- $ onWorkspace myGimpWorkspace gimpLayout
$ tall ||| single ||| full $ tall ||| single ||| full
@ -186,12 +175,16 @@ myWindowSetXinerama ws = wsString ++ sep ++ layout
(_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0 (_, Rectangle x0 _ _ _) = getScreenIdAndRectangle s0
(_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1 (_, Rectangle x1 _ _ _) = getScreenIdAndRectangle s1
viewShift = doF . liftM2 (.) W.view W.shift
appendViewShift tag = liftX (appendWorkspace tag) >> viewShift tag
myManageHook :: ManageHook myManageHook :: ManageHook
myManageHook = composeOne myManageHook = composeOne
-- assume virtualbox is not run with the toolbar in fullscreen mode -- assume virtualbox is not run with the toolbar in fullscreen mode
-- as this makes a new window that confusingly must go over the -- as this makes a new window that confusingly must go over the
-- actual VM window -- actual VM window
[ className =? myVMClass -?> doShift myVMWorkspace [ className =? myVMClass -?> appendViewShift myVMWorkspace
-- the seafile applet -- the seafile applet
, className =? "Seafile Client" -?> doFloat , className =? "Seafile Client" -?> doFloat
-- gnucash -- gnucash
@ -199,7 +192,7 @@ myManageHook = composeOne
-- xsane -- xsane
, className =? "Xsane" -?> doFloat , className =? "Xsane" -?> doFloat
-- all of GIMP -- all of GIMP
, className =? myGimpClass -?> doFloat >> doShift myGimpWorkspace , className =? myGimpClass -?> doFloat >> appendViewShift myGimpWorkspace
-- , title =? "GIMP Startup" -?> doIgnore -- , title =? "GIMP Startup" -?> doIgnore
-- plots and graphics created by R -- plots and graphics created by R
, className =? "R_x11" -?> doFloat , className =? "R_x11" -?> doFloat
@ -433,12 +426,6 @@ runScreenCapture = runFlameshot "screen"
runDesktopCapture :: X () runDesktopCapture :: X ()
runDesktopCapture = runFlameshot "full" runDesktopCapture = runFlameshot "full"
runVBox :: X ()
runVBox = spawnCmd "vbox-start" ["win8raw"]
runGimp :: X ()
runGimp = spawnCmd "gimp" []
runCleanup :: [ProcessID] -> Client -> X () runCleanup :: [ProcessID] -> Client -> X ()
runCleanup ps client = io $ do runCleanup ps client = io $ do
mapM_ killPID ps mapM_ killPID ps
@ -528,16 +515,38 @@ showKeybindings x = addName "Show Keybindings" $ do
, "'#element.selected.normal { background-color: #a200ff; }'" , "'#element.selected.normal { background-color: #a200ff; }'"
] ]
appendOrSwitch :: WorkspaceId -> X () -> X () myVMWorkspace :: String
appendOrSwitch tag cmd = do myVMWorkspace = "VM"
occupied <- withWindowSet $ \ws ->
return $ elem tag myVMClass :: String
myVMClass = "VirtualBoxVM"
myGimpWorkspace :: String
myGimpWorkspace = "GIMP"
-- TODO I don't feel like changing the version long term
myGimpClass :: String
myGimpClass = "Gimp-2.10"
wsOccupied :: Eq a1 => a1 -> W.StackSet a1 l a2 sid sd -> Bool
wsOccupied tag ws = elem tag
$ map W.tag $ map W.tag
-- TODO there is likely a much better way to do this...
$ filter (\w -> case W.stack w of { Nothing -> False; _ -> True } )
-- list of all workspaces with windows on them -- list of all workspaces with windows on them
$ W.workspace (W.current ws) -- TODO is there not a better way to do this?
: W.hidden ws $ W.workspace (W.current ws) : W.hidden ws ++ map W.workspace (W.visible ws)
++ map W.workspace (W.visible ws)
if occupied then windows $ W.view tag else appendWorkspace tag >> cmd spawnOrSwitch :: WorkspaceId -> X () -> X ()
spawnOrSwitch tag cmd = do
occupied <- withWindowSet $ return . wsOccupied tag
if occupied then windows $ W.view tag else cmd
runVBox :: X ()
runVBox = spawnOrSwitch myVMWorkspace $ spawnCmd "vbox-start" ["win8raw"]
runGimp :: X ()
runGimp = spawnOrSwitch myGimpWorkspace $ spawnCmd "gimp-2.10" []
myModMask :: KeyMask myModMask :: KeyMask
myModMask = mod4Mask myModMask = mod4Mask
@ -614,8 +623,8 @@ mkKeys hs client c =
, ("M-C-t", "launch terminal", runTerm) , ("M-C-t", "launch terminal", runTerm)
, ("M-C-q", "launch calc", runCalc) , ("M-C-q", "launch calc", runCalc)
, ("M-C-f", "launch file manager", runFileManager) , ("M-C-f", "launch file manager", runFileManager)
, ("M-C-v", "launch windows VM", appendOrSwitch myVMWorkspace runVBox) , ("M-C-v", "launch windows VM", runVBox)
, ("M-C-g", "launch GIMP", appendOrSwitch myGimpWorkspace runGimp) , ("M-C-g", "launch GIMP", runGimp)
] ++ ] ++
mkNamedSubmap c "Multimedia" mkNamedSubmap c "Multimedia"