377 lines
13 KiB
Haskell
377 lines
13 KiB
Haskell
module Bindings
|
|
( keybinds
|
|
, mousebinds
|
|
) where
|
|
|
|
--
|
|
-- q , w , e : screen naviagation
|
|
-- h , j , k , l : vim-style 2D navitgation
|
|
-- n , p : next/previous
|
|
-- r : run
|
|
-- t : tile
|
|
-- g : toggle spacing (gaps)
|
|
-- b " toggle bar
|
|
-- x , y : reflect
|
|
-- z : minimize
|
|
-- [ , ] : tab navigation
|
|
|
|
import System.Exit (exitSuccess)
|
|
|
|
import Data.Monoid ( appEndo )
|
|
import Data.Ratio ( (%) )
|
|
import qualified Data.Map as M
|
|
|
|
import XMonad ( (.|.) , gets )
|
|
import XMonad.Util.Types ( Direction2D (U, D, L, R) )
|
|
import XMonad.Hooks.ManageDocks ( ToggleStruts (ToggleStruts) )
|
|
import XMonad.Util.Run ( safeSpawn )
|
|
import XMonad.Util.Paste ( pasteSelection )
|
|
import XMonad.Layout.ResizableTile ( MirrorResize (MirrorShrink, MirrorExpand) )
|
|
import XMonad.Layout.Reflect ( REFLECTX (REFLECTX) , REFLECTY (REFLECTY) )
|
|
import XMonad.Layout.MultiToggle ( Toggle (Toggle) )
|
|
import XMonad.Layout.BoringWindows ( focusUp , focusDown )
|
|
import XMonad.Layout.Maximize ( maximizeRestore )
|
|
import XMonad.Actions.CopyWindow ( kill1 )
|
|
-- import XMonad.Actions.FloatKeys ( keysResizeWindow, keysMoveWindow, ChangeDim )
|
|
import XMonad.Actions.FloatKeys
|
|
import XMonad.Actions.Navigation2D ( switchLayer , windowGo , windowSwap )
|
|
import XMonad.Hooks.ManageHelpers ( doRectFloat )
|
|
|
|
import XMonad.Core
|
|
( Layout
|
|
, X
|
|
, terminal
|
|
, modMask
|
|
, layoutHook
|
|
, XConfig (XConfig)
|
|
, whenJust
|
|
, runQuery
|
|
, windowset
|
|
, io
|
|
, ScreenId
|
|
, WindowSpace
|
|
)
|
|
|
|
import XMonad.Layout.IndependentScreens
|
|
( workspaces'
|
|
, onCurrentScreen
|
|
, unmarshallS
|
|
)
|
|
|
|
import XMonad.Layout.SubLayouts
|
|
( onGroup
|
|
, pushGroup
|
|
, GroupMsg (MergeAll, UnMerge)
|
|
)
|
|
|
|
import Graphics.X11.Types
|
|
( Window , ButtonMask , KeyMask , KeySym , Button
|
|
, button1 , button2 , button3
|
|
, shiftMask , controlMask
|
|
, xK_Return , xK_Escape , xK_Insert , xK_Right , xK_Left
|
|
, xK_space , xK_plus , xK_minus , xK_comma , xK_period
|
|
, xK_bracketleft , xK_bracketright
|
|
, xK_1 , xK_9 , xK_0
|
|
, xK_b , xK_c , xK_e , xK_g , xK_h , xK_j , xK_k , xK_l , xK_m
|
|
, xK_n , xK_o , xK_p , xK_q , xK_r , xK_t , xK_u , xK_w , xK_x
|
|
, xK_y , xK_z
|
|
, xK_KP_End , xK_KP_Down , xK_KP_Next
|
|
, xK_KP_Add, xK_KP_Subtract, xK_KP_Insert, xK_KP_Enter
|
|
)
|
|
|
|
import Graphics.X11.ExtraTypes.XF86
|
|
( xF86XK_AudioMute
|
|
, xF86XK_AudioLowerVolume , xF86XK_AudioRaiseVolume
|
|
, xF86XK_AudioPlay , xF86XK_AudioStop
|
|
, xF86XK_AudioPrev , xF86XK_AudioNext
|
|
, xF86XK_RotateWindows
|
|
, xF86XK_MonBrightnessUp , xF86XK_MonBrightnessDown
|
|
)
|
|
|
|
import XMonad.Layout
|
|
( IncMasterN (..)
|
|
, Resize (Shrink, Expand)
|
|
, ChangeLayout (NextLayout)
|
|
)
|
|
|
|
import XMonad.Operations
|
|
( windows
|
|
, sendMessage
|
|
, setLayout
|
|
, withFocused
|
|
, screenWorkspace
|
|
, restart
|
|
, mouseResizeWindow
|
|
, mouseMoveWindow
|
|
, focus
|
|
, D
|
|
)
|
|
|
|
import XMonad.StackSet
|
|
( StackSet (..)
|
|
, RationalRect (..)
|
|
, Workspace (..)
|
|
, shift
|
|
, view
|
|
, swapUp
|
|
, swapDown
|
|
, sink
|
|
, view
|
|
, floating
|
|
, screen
|
|
, shiftMaster
|
|
, focusDown'
|
|
, focusUp'
|
|
)
|
|
|
|
import XMonad.Layout.Spacing
|
|
( toggleScreenSpacingEnabled
|
|
, toggleWindowSpacingEnabled
|
|
)
|
|
|
|
import XMonad.Actions.Minimize
|
|
( minimizeWindow
|
|
, withLastMinimized
|
|
, maximizeWindowAndFocus
|
|
)
|
|
|
|
import XMonad.Actions.CycleWS
|
|
( toggleWS'
|
|
, WSType (WSIs)
|
|
, shiftTo
|
|
, moveTo
|
|
, Direction1D (Next, Prev)
|
|
)
|
|
|
|
import ManageHook ( scratchpadKeybinds )
|
|
import Prompts ( promptKeybinds )
|
|
import Utils ( mkSubmap )
|
|
|
|
mousebinds :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
|
mousebinds XConfig {modMask = modm} = M.fromList bindings
|
|
where
|
|
bindings =
|
|
[ ((modm, button1), move)
|
|
, ((modm, button2), toMaster)
|
|
, ((modm, button3), resize)
|
|
]
|
|
move = mouseDo mouseMoveWindow
|
|
resize = mouseDo mouseResizeWindow
|
|
toMaster = mouseDo return
|
|
mouseDo f w = focus w >> f w >> windows shiftMaster
|
|
|
|
keybinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
|
|
keybinds = foldr1 keyComb
|
|
[ wmBinds
|
|
, spawnBinds
|
|
, promptKeybinds
|
|
, scratchpadKeybinds
|
|
, workspaceBinds
|
|
, screenBinds
|
|
]
|
|
where
|
|
keyComb f g conf = M.union (f conf) (g conf)
|
|
|
|
spawnBinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
|
|
spawnBinds conf = M.fromList . map mkSpawn $ bindList
|
|
where
|
|
bindList = singles ++ playerctl ++ xbacklight ++ pamixer
|
|
singles =
|
|
[ ((modm, xK_Return), terminal conf, [])
|
|
, ((0, xF86XK_RotateWindows), "thinkpad-rotate", [])
|
|
, ((modm, xK_Escape), "slock", [])
|
|
]
|
|
-- mpc = withCmd "mpc"
|
|
-- [ ((0, xK_KP_End), ["prev"])
|
|
-- , ((0, xK_KP_Down), ["toggle"])
|
|
-- , ((0, xK_KP_Next), ["next"])
|
|
-- , ((0, xF86XK_AudioPlay), ["toggle"])
|
|
-- , ((0, xF86XK_AudioStop), ["stop"])
|
|
-- , ((0, xF86XK_AudioPrev), ["prev"])
|
|
-- , ((0, xF86XK_AudioNext), ["next"])
|
|
-- ]
|
|
playerctl = withCmd "playerctl"
|
|
[ ((0, xK_KP_End), ["previous"])
|
|
, ((0, xK_KP_Down), ["play-pause"])
|
|
, ((0, xK_KP_Next), ["next"])
|
|
, ((0, xF86XK_AudioPlay), ["play-pause"])
|
|
, ((0, xF86XK_AudioStop), ["stop"])
|
|
, ((0, xF86XK_AudioPrev), ["previous"])
|
|
, ((0, xF86XK_AudioNext), ["next"])
|
|
]
|
|
xbacklight = withCmd "xbacklight"
|
|
[ ((0, xF86XK_MonBrightnessUp), ["-inc", "10"])
|
|
, ((0, xF86XK_MonBrightnessDown), ["-dec", "10"])
|
|
]
|
|
pamixer = withCmd "pamixer"
|
|
[ ((0, xK_KP_Subtract), ["--decrease", "5"])
|
|
, ((0, xK_KP_Add), ["--increase", "5", "--allow-boost"])
|
|
, ((0, xK_KP_Enter), ["--set-volume", "100"])
|
|
, ((0, xK_KP_Insert), ["--togle-mute"])
|
|
, ((0, xF86XK_AudioLowerVolume), ["--decrease", "5"])
|
|
, ((0, xF86XK_AudioRaiseVolume), ["--increase", "5", "--allow-boost"])
|
|
, ((0, xF86XK_AudioMute), ["--toggle-mute"])
|
|
]
|
|
mkSpawn (comb,cmd,args) = (comb, safeSpawn cmd args)
|
|
withCmd cmd = map (\(comb,args) -> (comb,cmd,args))
|
|
modm = modMask conf
|
|
|
|
wmBinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
|
|
wmBinds conf@XConfig {modMask = modm} = M.fromList
|
|
[ ((0, xK_Insert), pasteSelection)
|
|
|
|
, ((modm .|. shiftMask, xK_o), restart "obtoxmd" True)
|
|
, ((modm .|. shiftMask, xK_r), restart "xmonad" True)
|
|
, ((modm .|. shiftMask, xK_Escape), io exitSuccess)
|
|
|
|
-- navigating windows
|
|
, ((modm, xK_j), windowGo D False)
|
|
, ((modm, xK_k), windowGo U False)
|
|
, ((modm, xK_h), windowGo L False)
|
|
, ((modm, xK_l), windowGo R False)
|
|
, ((modm, xK_n), focusDown)
|
|
, ((modm, xK_p), focusUp)
|
|
|
|
-- sublayout things
|
|
, ((modm .|. controlMask, xK_m), withFocused (sendMessage . MergeAll))
|
|
, ((modm .|. controlMask, xK_u), withFocused (sendMessage . UnMerge))
|
|
, ((modm .|. controlMask, xK_h), sendMessage $ pushGroup L)
|
|
, ((modm .|. controlMask, xK_l), sendMessage $ pushGroup R)
|
|
, ((modm .|. controlMask, xK_k), sendMessage $ pushGroup U)
|
|
, ((modm .|. controlMask, xK_j), sendMessage $ pushGroup D)
|
|
, ((modm, xK_bracketleft), onGroup focusUp')
|
|
, ((modm, xK_bracketright), onGroup focusDown')
|
|
|
|
-- moving windows
|
|
, ((modm .|. shiftMask, xK_j), move M.! "D")
|
|
, ((modm .|. shiftMask, xK_k), move M.! "U")
|
|
, ((modm .|. shiftMask, xK_h), move M.! "L")
|
|
, ((modm .|. shiftMask, xK_l), move M.! "R")
|
|
, ((modm .|. shiftMask, xK_n), windows swapDown)
|
|
, ((modm .|. shiftMask, xK_p), windows swapUp)
|
|
|
|
-- resizing windows
|
|
, ((modm, xK_plus ), resize M.! "+")
|
|
, ((modm, xK_minus), resize M.! "-")
|
|
, ((modm .|. shiftMask .|. controlMask, xK_h), resize M.! "L")
|
|
, ((modm .|. shiftMask .|. controlMask, xK_l), resize M.! "R")
|
|
, ((modm .|. shiftMask .|. controlMask, xK_j), resize M.! "D")
|
|
, ((modm .|. shiftMask .|. controlMask, xK_k), resize M.! "U")
|
|
|
|
, ((modm .|. controlMask, xK_space), switchLayer)
|
|
|
|
, ((modm .|. shiftMask, xK_c ), kill1)
|
|
, ((modm, xK_space ), sendMessage NextLayout)
|
|
, ((modm .|. shiftMask, xK_space ), setLayout $ layoutHook conf)
|
|
, ((modm, xK_x ), sendMessage $ Toggle REFLECTX)
|
|
, ((modm, xK_y ), sendMessage $ Toggle REFLECTY)
|
|
, ((modm, xK_z ), withFocused minimizeWindow)
|
|
, ((modm .|. shiftMask, xK_z ), unminimize)
|
|
, ((modm, xK_m ), toggleMax)
|
|
|
|
, ((modm, xK_t ), withFocused $ windows . sink)
|
|
, ((modm .|. shiftMask, xK_t ), untile)
|
|
|
|
, ((modm, xK_comma ), sendMessage (IncMasterN 1))
|
|
, ((modm, xK_period), sendMessage (IncMasterN (-1)))
|
|
, ((modm, xK_g ), toggleSpacing)
|
|
, ((modm, xK_b ), sendMessage ToggleStruts)
|
|
|
|
, ((modm, xK_Right ), moveTo Next spacesOnCurrentScreen)
|
|
, ((modm, xK_Left ), moveTo Prev spacesOnCurrentScreen)
|
|
, ((modm .|. shiftMask, xK_Right ), shiftTo Next spacesOnCurrentScreen)
|
|
, ((modm .|. shiftMask, xK_Left ), shiftTo Prev spacesOnCurrentScreen)
|
|
|
|
, ((modm, xK_0), toggleWS' ["NSP"])
|
|
]
|
|
|
|
where
|
|
toggleSpacing = toggleWindowSpacingEnabled >> toggleScreenSpacingEnabled
|
|
toggleMax = withFocused (sendMessage . maximizeRestore)
|
|
unminimize = withLastMinimized maximizeWindowAndFocus
|
|
|
|
untile = withFocused rectFloatFocused
|
|
where
|
|
rectFloatFocused focused = action focused >>= windows
|
|
action = fmap appEndo . doIt
|
|
doIt = runQuery $ doRectFloat rect
|
|
rect = RationalRect 0.05 0.05 0.9 0.9
|
|
|
|
resize :: M.Map [Char] (X())
|
|
resize = M.intersectionWith onFloat flt tilling
|
|
where
|
|
|
|
flt :: M.Map [Char] (Window -> X())
|
|
flt = M.fromList
|
|
[ ("L", keysResizeWindow (-n, 0) (0, 0))
|
|
, ("R", keysResizeWindow ( n, 0) (0, 0))
|
|
, ("D", keysResizeWindow ( 0, n) (0, 0))
|
|
, ("U", keysResizeWindow ( 0, -n) (0, 0))
|
|
, ("+", keysResizeWindow ( n, n) (1%2, 1%2))
|
|
, ("-", keysResizeWindow (-n, -n) (1%2, 1%2))
|
|
]
|
|
|
|
tilling :: M.Map [Char] (X())
|
|
tilling = M.fromList
|
|
[ ("L", sendMessage Shrink)
|
|
, ("R", sendMessage Expand)
|
|
, ("D", sendMessage MirrorShrink)
|
|
, ("U", sendMessage MirrorExpand)
|
|
, ("+", return ())
|
|
, ("-", return ())
|
|
]
|
|
n = 10
|
|
|
|
move :: M.Map [Char] (X())
|
|
move = M.intersectionWith onFloat flt tilling
|
|
where
|
|
|
|
flt :: M.Map [Char] (Window -> X())
|
|
flt = M.fromList
|
|
[ ("L", keysMoveWindow (-n, 0))
|
|
, ("R", keysMoveWindow ( n, 0))
|
|
, ("D", keysMoveWindow ( 0, n))
|
|
, ("U", keysMoveWindow ( 0, -n))
|
|
]
|
|
|
|
tilling :: M.Map [Char] (X())
|
|
tilling = M.fromList
|
|
[ ("L", windowSwap L False)
|
|
, ("R", windowSwap R False)
|
|
, ("D", windowSwap D False)
|
|
, ("U", windowSwap U False)
|
|
]
|
|
n = 10
|
|
|
|
onFloat a b = withFocused $ ifFloat a (const b)
|
|
where
|
|
ifFloat x y w = isFloat w >>= picker x y w
|
|
|
|
picker x _ w True = x w
|
|
picker _ y w False = y w
|
|
|
|
isFloat :: Window -> X Bool
|
|
isFloat w = M.member w . floating <$> gets windowset
|
|
|
|
spacesOnCurrentScreen :: WSType
|
|
spacesOnCurrentScreen = WSIs $ isOnScreen <$> currentScreen
|
|
where
|
|
|
|
isOnScreen :: ScreenId -> WindowSpace -> Bool
|
|
isOnScreen s = (s ==) . unmarshallS . tag
|
|
|
|
currentScreen :: X ScreenId
|
|
currentScreen = gets $ screen . current . windowset
|
|
|
|
workspaceBinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
|
|
workspaceBinds conf@XConfig {modMask = modm} = M.fromList $
|
|
[((m .|. modm, k), windows $ onCurrentScreen f i)
|
|
| (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
|
|
, (f, m) <- [(view, 0), (shift, shiftMask)]]
|
|
|
|
screenBinds :: XConfig Layout -> M.Map (ButtonMask, KeySym) (X ())
|
|
screenBinds XConfig {modMask = modm} = M.fromList $
|
|
[((m .|. modm, k), screenWorkspace i >>= flip whenJust (windows . f))
|
|
| (i, k) <- zip [0,1] [xK_w, xK_e]
|
|
, (f, m) <- [(view, 0), (shift, shiftMask)]]
|