diff options
| -rw-r--r-- | src/Internal/Keys.hs | 48 | ||||
| -rw-r--r-- | src/Internal/ScreenRotate.hs | 19 | ||||
| -rw-r--r-- | src/Main.hs | 5 |
3 files changed, 60 insertions, 12 deletions
diff --git a/src/Internal/Keys.hs b/src/Internal/Keys.hs index 195e12f..1118788 100644 --- a/src/Internal/Keys.hs +++ b/src/Internal/Keys.hs @@ -45,6 +45,7 @@ import Internal.Lib import Internal.DMenu import Internal.PassMenu import Internal.Logger +import Internal.ScreenRotate (screenRotateForward, screenRotateBackward) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) @@ -376,6 +377,17 @@ mouseMap = runButtons $ do Map.lookup button (mouseMap config) subMouse = submapButtonsWithKey defaultButtons . flip runButtons config + + let continuous :: [(Button, X ())] -> Button -> Window -> X () + continuous actions button w = do + case find ((==button) . fst) actions of + Just (_, action) -> action + Nothing -> return () + + (subMouse $ + forM_ (map fst actions) $ \b -> + bind b $ noMod $ \w -> continuous actions b w) w + bind button1 $ do justMod $ \w -> focus w >> mouseMoveWindow w >> windows W.shiftMaster @@ -406,6 +418,9 @@ mouseMap = runButtons $ do bind button14 $ do noMod $ \_ -> click >> sendMessage ToggleZoom + bind button15 $ do + noMod $ \_ -> spawn "pavucontrol" + let mediaButtons = [ (button4, increaseVolume), (button5, decreaseVolume), @@ -416,19 +431,32 @@ mouseMap = runButtons $ do (button7, mediaNext) ] + forM_ (map fst mediaButtons) $ \b -> + bind b $ noMod $ continuous mediaButtons b - let continuous :: [(Button, X ())] -> Button -> Window -> X () - continuous actions button w = do - case find ((==button) . fst) actions of - Just (_, action) -> action - Nothing -> return () + bind button15 $ do - (subMouse $ - forM_ (map fst mediaButtons) $ \b -> - bind b $ noMod $ \w -> continuous actions b w) w + noMod $ subMouse $ do + + bind button15 $ do + noMod $ \_ -> jumpToLast - forM_ (map fst mediaButtons) $ \b -> - bind b $ noMod $ continuous mediaButtons b + + let workspaceButtons = [ + (button2, swapMaster), + + (button9, relativeWorkspaceShift next), + (button8, relativeWorkspaceShift prev), + + (button4, windows W.focusUp), + (button5, windows W.focusDown), + + (button7, windows screenRotateForward), + (button6, windows screenRotateBackward) + ] + + forM_ (map fst workspaceButtons) $ \b -> + bind b $ noMod $ continuous workspaceButtons b applyKeys :: XConfig l -> IO (XConfig l) applyKeys config = diff --git a/src/Internal/ScreenRotate.hs b/src/Internal/ScreenRotate.hs new file mode 100644 index 0000000..ff6417c --- /dev/null +++ b/src/Internal/ScreenRotate.hs @@ -0,0 +1,19 @@ +module Internal.ScreenRotate where + +import XMonad.StackSet as W + +screenRotateForward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd +screenRotateForward (W.StackSet current visible others floating) = do + let screens = current : visible + workspaces = tail $ cycle $ map W.workspace screens + (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces + in W.StackSet current' visible' others floating + +screenRotateBackward :: W.StackSet i l a sid sd -> W.StackSet i l a sid sd +screenRotateBackward (W.StackSet current visible others floating) = do + let screens = current : visible + workspaces = rcycle $ map W.workspace screens + (current':visible') = zipWith (\s w -> s {workspace = w} ) screens workspaces + in W.StackSet current' visible' others floating + + where rcycle l = last l : l diff --git a/src/Main.hs b/src/Main.hs index cda3ae2..5433c2e 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -48,8 +48,9 @@ main = do , title =? "Event Tester" --> doFloat , title =? "Floating Term" --> doCenterFloat , title =? "Notes" --> doCenterFloat - , title =? "xmessage" --> doFloat - , title =? "gxmessage" --> doFloat + , title =? "xmessage" --> doCenterFloat + , title =? "gxmessage" --> doCenterFloat + , title =? "Volume Control" --> doCenterFloat , className =? "mpv" --> doFloat , className =? "gnubby_ssh_prompt" --> doFloat ] |