diff options
author | azahi <azahi@teknik.io> | 2018-10-08 21:18:13 +0300 |
---|---|---|
committer | azahi <azahi@teknik.io> | 2018-10-08 21:18:13 +0300 |
commit | d7176233da673ea5d92eadcbf52323b5d8419cfd (patch) | |
tree | f603bee246db9a0ca0d5c89933b34064f76495cf /src | |
parent | Clean up Actions (diff) |
Rework Custom
Change the names of high-order functoins Remove named keybindings Add check executable for keybindings Expand xmonad-ng library Bump to 0.15.1
Diffstat (limited to 'src')
-rw-r--r-- | src/Main.hs | 55 | ||||
-rw-r--r-- | src/Test.hs | 50 | ||||
-rw-r--r-- | src/XMonad/Custom/Bindings.hs | 326 | ||||
-rw-r--r-- | src/XMonad/Custom/Event.hs | 14 | ||||
-rw-r--r-- | src/XMonad/Custom/Layout.hs | 29 | ||||
-rw-r--r-- | src/XMonad/Custom/Log.hs | 8 | ||||
-rw-r--r-- | src/XMonad/Custom/Manage.hs | 20 | ||||
-rw-r--r-- | src/XMonad/Custom/Misc.hs | 6 | ||||
-rw-r--r-- | src/XMonad/Custom/Navigation.hs | 6 | ||||
-rw-r--r-- | src/XMonad/Custom/Projects.hs | 4 | ||||
-rw-r--r-- | src/XMonad/Custom/Scratchpads.hs | 28 | ||||
-rw-r--r-- | src/XMonad/Custom/Startup.hs | 8 | ||||
-rw-r--r-- | src/XMonad/Custom/Workspaces.hs | 9 | ||||
-rw-r--r-- | src/XMonad/Util/ALSA.hs | 1 |
14 files changed, 303 insertions, 261 deletions
diff --git a/src/Main.hs b/src/Main.hs index 27379ab..9afb3a1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -15,24 +15,23 @@ module Main where import XMonad import XMonad.Actions.DynamicProjects import XMonad.Actions.Navigation2D -import qualified XMonad.Custom.Bindings as Custom -import qualified XMonad.Custom.Event as Custom -import qualified XMonad.Custom.Layout as Custom -import qualified XMonad.Custom.Log as Custom -import qualified XMonad.Custom.Manage as Custom -import qualified XMonad.Custom.Misc as Custom -import qualified XMonad.Custom.Navigation as Custom -import qualified XMonad.Custom.Projects as Custom -import qualified XMonad.Custom.Startup as Custom -import qualified XMonad.Custom.Theme as Custom -import qualified XMonad.Custom.Workspaces as Custom +import qualified XMonad.Custom.Bindings as C +import qualified XMonad.Custom.Event as C +import qualified XMonad.Custom.Layout as C +import qualified XMonad.Custom.Log as C +import qualified XMonad.Custom.Manage as C +import qualified XMonad.Custom.Misc as C +import qualified XMonad.Custom.Navigation as C +import qualified XMonad.Custom.Projects as C +import qualified XMonad.Custom.Startup as C +import qualified XMonad.Custom.Theme as C +import qualified XMonad.Custom.Workspaces as C import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Hooks.UrgencyHook import XMonad.Layout.Fullscreen import qualified XMonad.StackSet as S -import XMonad.Util.NamedActions import XMonad.Util.NamedWindows import XMonad.Util.Run @@ -43,7 +42,7 @@ instance UrgencyHook NotifyUrgencyHook where urgencyHook NotifyUrgencyHook w = do n <- getName w Just i <- S.findTag w <$> gets windowset - safeSpawn (Custom.notify Custom.customApplications) [show n, "workspace " ++ wrap "[" "]" i] + safeSpawn (C.notify C.applications) [show n, "workspace " ++ wrap "[" "]" i] main :: IO () main = xmonad @@ -51,21 +50,21 @@ main = xmonad $ fullscreenSupport $ docks $ withUrgencyHook NotifyUrgencyHook - $ withNavigation2DConfig Custom.navigation2DConfig - $ dynamicProjects Custom.projects - $ addDescrKeys' ((Custom.modMask', xK_F1), Custom.showKeyBindings) Custom.keyBindings - $ def { borderWidth = Custom.border - , workspaces = Custom.workspaces' -- TODO save WS state - , layoutHook = Custom.layoutHook' -- TODO save layout state and floating W position - , terminal = Custom.term Custom.customApplications - , normalBorderColor = Custom.colorN - , focusedBorderColor = Custom.colorF - , modMask = Custom.modMask' - , logHook = Custom.logHook' - , startupHook = Custom.startupHook' - , mouseBindings = Custom.mouseBindings' - , manageHook = Custom.manageHook' - , handleEventHook = Custom.handleEventHook' + $ withNavigation2DConfig C.navigation + $ dynamicProjects C.projects + $ def { borderWidth = C.border + , workspaces = C.workspaces -- TODO save WS state + , layoutHook = C.layoutHook -- TODO save layout state and floating W position + , terminal = C.term C.applications + , normalBorderColor = C.colorN + , focusedBorderColor = C.colorF + , modMask = C.modMask + , keys = C.keys + , logHook = C.logHook + , startupHook = C.startupHook + , mouseBindings = C.mouseBindings + , manageHook = C.manageHook + , handleEventHook = C.handleEventHook , focusFollowsMouse = False , clickJustFocuses = False } diff --git a/src/Test.hs b/src/Test.hs new file mode 100644 index 0000000..eea5d61 --- /dev/null +++ b/src/Test.hs @@ -0,0 +1,50 @@ +module Main where + +import Control.Monad (void) +import qualified Data.Map as M +import qualified Data.Set as S +import XMonad +import XMonad.Prompt +import XMonad.StackSet (new) +import XMonad.Util.EZConfig (checkKeymap) +import XMonad.Util.Font +import XMonad.Custom.Bindings (rawKeys) +import XMonad.Custom.Theme (promptTheme) + +main :: IO () +main = do + dpy <- openDisplay "" + rootw <- rootWindow dpy $ defaultScreen dpy + + let xmc = def {layoutHook = Layout $ layoutHook def} + initialWinset = new (layoutHook xmc) (workspaces xmc) [] + + let cf = XConf { display = dpy + , config = xmc + , theRoot = rootw + , normalBorder = 0 + , focusedBorder = 0 + , keyActions = M.empty + , buttonActions = M.empty + , mouseFocused = False + , mousePosition = Nothing + , currentEvent = Nothing + } + + let st = XState { windowset = initialWinset + , numberlockMask = 0 + , mapped = S.empty + , waitingUnmap = M.empty + , dragging = Nothing + , extensibleState = M.empty + } + + void $ runX cf st $ do + checkKeymap xmc (rawKeys xmc) + + xmf <- initXMF (font promptTheme) + + case xmf of + Core _ -> io (putStrLn "Font: core") + Utf8 _ -> io (putStrLn "Font: utf8") + Xft _ -> io (putStrLn "Font: xft") diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs index e744c69..7504526 100644 --- a/src/XMonad/Custom/Bindings.hs +++ b/src/XMonad/Custom/Bindings.hs @@ -13,18 +13,17 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Bindings - ( showKeyBindings - , modMask' - , keyBindings - , mouseBindings' + ( keys + , rawKeys + , modMask + , mouseBindings ) where import Control.Monad import qualified Data.Map as M import System.Exit -import System.IO -import XMonad -import qualified XMonad.Actions.ConstrainedResize as C +import XMonad hiding (keys, modMask, + mouseBindings) import XMonad.Actions.CopyWindow import XMonad.Actions.CycleWS import XMonad.Actions.DynamicProjects @@ -36,12 +35,12 @@ import XMonad.Actions.MessageFeedback import XMonad.Actions.Navigation2D import XMonad.Actions.PerConditionKeys import XMonad.Actions.Promote +import XMonad.Actions.UpdatePointer import XMonad.Actions.WithAll import XMonad.Custom.Layout -import qualified XMonad.Custom.Misc as CM +import qualified XMonad.Custom.Misc as C import XMonad.Custom.Scratchpads import XMonad.Custom.Theme -import XMonad.Hooks.DynamicLog import XMonad.Hooks.UrgencyHook import XMonad.Layout.BinarySpacePartition import XMonad.Layout.Hidden @@ -58,21 +57,11 @@ import XMonad.Prompt.Workspace import qualified XMonad.StackSet as S import XMonad.Util.ALSA import XMonad.Util.EZConfig -import XMonad.Util.NamedActions import XMonad.Util.NamedScratchpad -import XMonad.Util.Run import XMonad.Util.WorkspaceCompare -import XMonad.Util.XSelection -showKeyBindings :: [((KeyMask, KeySym), NamedAction)] -> NamedAction -showKeyBindings a = addName "Show Keybindings" $ io $ do - p <- spawnPipe "zenity --text-info" -- TOOD Find an application that doesn't rely on any toolkits - hPutStr p $ unlines $ showKm a - hClose p - return () - -modMask' :: KeyMask -modMask' = mod4Mask +modMask :: KeyMask +modMask = mod4Mask directions :: [Direction2D] directions = [D, U, L, R] @@ -82,17 +71,17 @@ arrowKeys = [ "<D>" , "<U>" , "<L>" , "<R>" ] directionKeys = [ "j" , "k" , "h" , "l" ] wsKeys = map show [1..9 :: Int] -zipM :: [a] -> String -> [[a]] -> [t] -> (t -> X ()) -> [([a], NamedAction)] -zipM m nm ks as f = zipWith (\k d -> (m ++ k, addName nm $ f d)) ks as -zipM' :: [a] -> String -> [[a]] -> [t] -> (t -> t1 -> X ()) -> t1 -> [([a], NamedAction)] -zipM' m nm ks as f b = zipWith (\k d -> (m ++ k, addName nm $ f d b)) ks as +zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)] +zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as +zipKeys' :: [a] -> [[a]] -> [t1] -> (t1 -> t2 -> b) -> t2 -> [([a], b)] +zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as tryMessageR_ :: (Message a, Message b) => a -> b -> X () tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh] -xSelectionNotify :: MonadIO m => m () -xSelectionNotify = join $ io - $ unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x) <$> getSelection +-- xSelectionNotify :: MonadIO m => m () +-- xSelectionNotify = join $ io +-- $ unsafeSpawn . (\x -> C.notify C.applications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x) <$> getSelection toggleCopyToAll :: X () toggleCopyToAll = wsContainingCopies >>= \case [] -> windows copyToAll @@ -110,150 +99,157 @@ toggleFloat w = windows (\s -> if M.member w (S.floating s) then S.sink w s else S.float w (S.RationalRect (1/2 - 1/4) (1/2 - 1/4) (1/2) (1/2)) s) -keyBindings :: XConfig Layout -> [((KeyMask, KeySym), NamedAction)] -keyBindings c = let subKeys s ks = subtitle s:mkNamedKeymap c ks in - subKeys "System" - [ ("M-q" , addName "Restart XMonad" $ spawn "xmonad-ng --restart") - , ("M-S-q" , addName "Quit XMonad" $ confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) - , ("M-x" , addName "Shell prompt" $ shellPrompt promptTheme) - , ("M-o" , addName "Goto W prompt" $ windowPrompt promptTheme Goto allWindows) - , ("M-S-o" , addName "Bring W prompt" $ windowPrompt promptTheme Bring allWindows) +withUpdatePointer :: [(String, X ())] -> [(String, X ())] +withUpdatePointer = map addAction + where + addAction :: (String, X ()) -> (String, X ()) + addAction (key, action) = (key, action >> updatePointer (0.98, 0.01) (0, 0)) + +keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ()) +keys c = mkKeymap c (rawKeys c) + +rawKeys :: XConfig Layout -> [(String, X ())] +rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps where + keymaps = [ keysBase + , keysSystem + , keysMedia + , keysWorkspaces + , keysSpawnables + , keysWindows + , keysLayout + , keysResize + ] + +keysBase :: XConfig Layout -> [(String, X ())] +keysBase _ = + [ ("M-S-q" , confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess) + -- [ ("M-q" $ spawn "xmonad-ng --restart") + -- , ("M-C-q" $ spawn "xmonad-ng --recompile && xmonad-ng --restart"') + , ("M-x" , shellPrompt promptTheme) + , ("M-w" , windowPrompt promptTheme Goto allWindows) + , ("M-S-w" , windowPrompt promptTheme Bring allWindows) + ] + +keysSystem :: XConfig Layout -> [(String, X ())] +keysSystem _ = + [ ("M-C-g" , return ()) + , ("<XF86ScreenSaver>" , spawn "~/.xmonad/bin/screenlock.sh") + -- , ("M-S-c" , xSelectionNotify) + , ("M-<Print>" , spawn "~/.xmonad/bin/xshot-upload.sh") + , ("M-S-<Print>" , spawn "~/.xmonad/bin/xshot-select-upload.sh") + , ("M-<Insert>" , spawn "~/.xmonad/bin/xcast.sh --webm") + , ("M-S-<Insert>" , spawn "~/.xmonad/bin/xcast.sh --gif") + , ("M-C-<Insert>" , spawn "pkill ffmpeg") + , ("M-C-c" , spawn "~/.xmonad/bin/toggle-compton.sh") + , ("M-C-r" , spawn "~/.xmonad/bin/toggle-redshift.sh") + , ("M-C-p" , spawn "~/.xmonad/bin/toggle-touchpad.sh") + , ("M-C-t" , spawn "~/.xmonad/bin/toggle-trackpoint.sh") + ] + +keysMedia :: XConfig Layout -> [(String, X ())] +keysMedia _ = + [ ("<XF86AudioMute>" , void toggleMute) + , ("<XF86AudioLowerVolume>" , void $ lowerVolume 5) + , ("<XF86AudioRaiseVolume>" , void $ raiseVolume 5) + , ("<XF86AudioPlay>" , spawn "~/.xmonad/bin/mpc-play-pause.sh") + , ("<XF86AudioStop>" , spawn "mpc --no-status stop") + , ("<XF86AudioPrev>" , spawn "mpc --no-status prev") + , ("<XF86AudioNext>" , spawn "mpc --no-status next") ] - ^++^ - subKeys "Actions" - [ ("M-C-g" , addName "Cancel" $ return ()) - , ("<XF86ScreenSaver>" , addName "Lock screen" $ spawn "~/.xmonad/bin/\ - \screenlock.sh") - , ("M-S-c" , addName "Print clipboard content" xSelectionNotify) - , ("M-<Print>" , addName "Take a screenshot of the current WS, \ - \upload it and copy link to the buffer" $ spawn "~/.xmonad/bin/\ - \xshot-upload.sh") - , ("M-S-<Print>" , addName "Take a screenshot of the selected area, \ - \upload it and copy link to the buffer" $ spawn "~/.xmonad/bin/\ - \xshot-select-upload.sh") - , ("M-<Insert>" , addName "Start recording screen as webm" $ spawn "~/.xmonad/bin/\ - \xcast.sh --webm") - , ("M-S-<Insert>" , addName "Start recording screen as gif" $ spawn "~/.xmonad/bin/\ - \xcast.sh --gif") - , ("M-C-<Insert>" , addName "Stop recording" $ spawn "pkill ffmpeg") - , ("M-C-c" , addName "Toggle compton on/off" $ spawn "~/.xmonad/bin/\ - \toggle-compton.sh") - , ("M-C-r" , addName "Toggle redshift on/off" $ spawn "~/.xmonad/bin/\ - \toggle-redshift.sh") - , ("M-C-p" , addName "Toggle touchpad on/off" $ spawn "~/.xmonad/bin/\ - \toggle-touchpad.sh") - , ("M-C-t" , addName "Toggle trackpoint on/off" $ spawn "~/.xmonad/bin/\ - \toggle-trackpoint.sh") + +keysWorkspaces :: XConfig Layout -> [(String, X ())] +keysWorkspaces _ = + [ ("M-p" , switchProjectPrompt promptTheme) + , ("M-S-p" , shiftToProjectPrompt promptTheme) + , ("M-," , nextNonEmptyWS) + , ("M-." , prevNonEmptyWS) + , ("M-i" , toggleWS' ["NSP"]) + , ("M-n" , workspacePrompt promptTheme $ windows . S.shift) ] - ^++^ - subKeys "Volume & Music" - [ ("<XF86AudioMute>" , addName "ALSA: Mute" $ void toggleMute) - , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5) - , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5) - , ("<XF86AudioPlay>" , addName "MPD: Play/pause" $ spawn "~/.xmonad/bin/mpc-play-pause.sh") - , ("<XF86AudioStop>" , addName "MPD: Stop" $ spawn "mpc --no-status stop") - , ("<XF86AudioPrev>" , addName "MPD: Previos track" $ spawn "mpc --no-status prev") - , ("<XF86AudioNext>" , addName "MPD: Next track" $ spawn "mpc --no-status next") + ++ zipKeys "M-" wsKeys [0 ..] (withNthWorkspace S.greedyView) + ++ zipKeys "M-S-" wsKeys [0 ..] (withNthWorkspace S.shift) + ++ zipKeys "M-C-S-" wsKeys [0 ..] (withNthWorkspace copy) + +keysSpawnables :: XConfig Layout -> [(String, X ())] +keysSpawnables _ = + [ ("M-<Return>" , spawn (C.term C.applications)) + , ("M-b" , spawn (C.browser C.applications)) + , ("M-C-p" , passPrompt promptTheme) + , ("M-c" , namedScratchpadAction scratchpads "console") + , ("M-m" , namedScratchpadAction scratchpads "music") + , ("M-t" , namedScratchpadAction scratchpads "top") + , ("M-v" , namedScratchpadAction scratchpads "volume") ] - ^++^ - subKeys "Workspaces & Projects" - ( [ ("M-w" , addName "Switch to project" $ switchProjectPrompt promptTheme) - , ("M-S-w" , addName "Shift to project" $ shiftToProjectPrompt promptTheme) - , ("M-," , addName "Next non-empty WS" nextNonEmptyWS) - , ("M-." , addName "Previous non-empty WS" prevNonEmptyWS) - , ("M-i" , addName "Toggle last WS" $ toggleWS' ["NSP"]) - , ("M-`" , addName "WS prompt" $ workspacePrompt promptTheme $ windows . S.shift) - ] - ++ zipM "M-" "View WS" wsKeys [0 ..] (withNthWorkspace S.greedyView) - ++ zipM "M-S-" "Move W to WS" wsKeys [0 ..] (withNthWorkspace S.shift) - ++ zipM "M-C-S-" "Copy W to WS" wsKeys [0 ..] (withNthWorkspace copy) - ) - ^++^ - subKeys "Spawnables" - [ ("M-<Return>" , addName "Terminal" $ spawn (CM.term CM.customApplications)) - , ("M-b" , addName "Browser" $ spawn (CM.browser CM.customApplications)) - , ("M-S-p" , addName "Pass prompt" $ passPrompt promptTheme) - , ("M-c" , addName "NSP Console" $ namedScratchpadAction scratchpads "console") - , ("M-m" , addName "NSP Music" $ namedScratchpadAction scratchpads "music") - , ("M-t" , addName "NSP Top" $ namedScratchpadAction scratchpads "top") - , ("M-v" , addName "NSP Volume" $ namedScratchpadAction scratchpads "volume") + +keysWindows :: XConfig Layout -> [(String, X())] +keysWindows _ = + [ ("M-d" , kill) + , ("M-S-d" , confirmPrompt hotPromptTheme "Kill all" killAll) + , ("M-C-d" , toggleCopyToAll) + , ("M-a" , withFocused hideWindow) -- FIXME This is so broken + , ("M-S-a" , popOldestHiddenWindow) + , ("M-p" , promote) + , ("M-s" , withFocused $ sendMessage . MergeAll) + , ("M-S-s" , withFocused $ sendMessage . UnMerge) + , ("M-u" , focusUrgent) + , ("M-e" , windows S.focusMaster) + , ("M-'" , bindOn LD [ ("Tabs" , windows S.focusDown) + , ("" , onGroup S.focusDown') + ]) + , ("M-;" , bindOn LD [ ("Tabs" , windows S.focusUp) + , ("" , onGroup S.focusUp') + ]) + , ("M-S-'" , windows S.swapDown) + , ("M-S-;" , windows S.swapUp) ] - ^++^ - subKeys "Windows" - ( [ ("M-d" , addName "Kill W" kill) - , ("M-S-d" , addName "Kill all W on WS" $ confirmPrompt hotPromptTheme "Kill all" killAll) - , ("M-C-d" , addName "Duplicate W to all WS" toggleCopyToAll) - , ("M-a" , addName "Hide W" $ withFocused hideWindow) -- FIXME This is so broken - , ("M-S-a" , addName "Restore hidden W" popOldestHiddenWindow) - , ("M-p" , addName "Promote W" promote) - , ("M-s" , addName "Merge W from sublayout" $ withFocused $ sendMessage . MergeAll) - , ("M-S-s" , addName "Unmerge W from sublayout" $ withFocused $ sendMessage . UnMerge) - , ("M-u" , addName "Focus urgent W" focusUrgent) - , ("M-e" , addName "Focus master W" $ windows S.focusMaster) - , ("M-'" , addName "Navigate tabbed W -> D" $ bindOn LD [ ("Tabs" , windows S.focusDown) - , ("" , onGroup S.focusDown') - ]) - , ("M-;" , addName "Navigate tabbed W -> U" $ bindOn LD [ ("Tabs" , windows S.focusUp) - , ("" , onGroup S.focusUp') - ]) - , ("M-S-'" , addName "Swap tabbed W -> D" $ windows S.swapDown) - , ("M-S-;" , addName "Swap tabbed W -> U" $ windows S.swapUp) - ] - ++ zipM' "M-" "Navigate W" directionKeys directions windowGo True -- TODO W moving - ++ zipM' "M-S-" "Swap W" directionKeys directions windowSwap True - ++ zipM "M-C-" "Merge W with sublayout" directionKeys directions (sendMessage . pullGroup) - ++ zipM' "M-" "Navigate screen" arrowKeys directions screenGo True - ++ zipM' "M-S-" "Move W to screen" arrowKeys directions windowToScreen True - ++ zipM' "M-C-" "Swap W to screen" arrowKeys directions screenSwap True - ) - ^++^ - subKeys "Layout Management" - [ ("M-<Tab>" , addName "Cycle layouts" $ sendMessage NextLayout) - , ("M-C-<Tab>" , addName "Cycle sublayouts" $ toSubl NextLayout) - , ("M-S-<Tab>" , addName "Reset layout" $ setLayout $ XMonad.layoutHook c) - , ("M-y" , addName "Toggle float/tile on W" $ withFocused toggleFloat) - , ("M-S-y" , addName "Tile all floating W" sinkAll) - , ("M-S-," , addName "Decrease maximum W count" $ sendMessage $ IncMasterN (-1)) - , ("M-S-." , addName "Increase maximum W count" $ sendMessage $ IncMasterN 1) - , ("M-r" , addName "Rotate/reflect W" $ tryMessageR_ Rotate (Toggle REFLECTX)) - , ("M-S-r" , addName "Reflect W" $ sendMessage $ Toggle REFLECTX) - , ("M-f" , addName "Toggle fullscreen layout" $ sequence_ [ withFocused $ windows . S.sink - , sendMessage $ Toggle NBFULL - ]) - , ("M-S-g" , addName "Toggle gapped layout" $ sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout + ++ zipKeys' "M-" directionKeys directions windowGo True -- TODO W moving + ++ zipKeys' "M-S-" directionKeys directions windowSwap True + ++ zipKeys "M-C-" directionKeys directions (sendMessage . pullGroup) + ++ zipKeys' "M-" arrowKeys directions screenGo True + ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True + ++ zipKeys' "M-C-" arrowKeys directions screenSwap True + +keysLayout :: XConfig Layout -> [(String, X())] +keysLayout c = + [ ("M-<Tab>" , sendMessage NextLayout) + , ("M-C-<Tab>" , toSubl NextLayout) + , ("M-S-<Tab>" , setLayout $ XMonad.layoutHook c) + , ("M-y" , withFocused toggleFloat) + , ("M-S-y" , sinkAll) + , ("M-S-," , sendMessage $ IncMasterN (-1)) + , ("M-S-." , sendMessage $ IncMasterN 1) + , ("M-r" , tryMessageR_ Rotate (Toggle REFLECTX)) + , ("M-S-r" , sendMessage $ Toggle REFLECTX) + , ("M-f" , sequence_ [ withFocused $ windows . S.sink + , sendMessage $ Toggle NBFULL + ]) + , ("M-S-g" , sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout ] - ^++^ - subKeys "Resize" - [ ("M-[" , addName "Expand L" $ tryMessageR_ (ExpandTowards L) Shrink) - , ("M-]" , addName "Expand R" $ tryMessageR_ (ExpandTowards R) Expand) - , ("M-S-[" , addName "Expand U" $ tryMessageR_ (ExpandTowards U) MirrorShrink) - , ("M-S-]" , addName "Expand D" $ tryMessageR_ (ExpandTowards D) MirrorExpand) - , ("M-C-[" , addName "Shrink L" $ tryMessageR_ (ShrinkFrom R) Shrink) - , ("M-C-]" , addName "Shrink R" $ tryMessageR_ (ShrinkFrom L) Expand) - , ("M-S-C-[" , addName "Shrink U" $ tryMessageR_ (ShrinkFrom D) MirrorShrink) - , ("M-S-C-]" , addName "Shrink D" $ tryMessageR_ (ShrinkFrom U) MirrorExpand) + +keysResize :: XConfig Layout -> [(String, X())] +keysResize _ = + [ ("M-[" , tryMessageR_ (ExpandTowards L) Shrink) + , ("M-]" , tryMessageR_ (ExpandTowards R) Expand) + , ("M-S-[" , tryMessageR_ (ExpandTowards U) MirrorShrink) + , ("M-S-]" , tryMessageR_ (ExpandTowards D) MirrorExpand) + , ("M-C-[" , tryMessageR_ (ShrinkFrom R) Shrink) + , ("M-C-]" , tryMessageR_ (ShrinkFrom L) Expand) + , ("M-S-C-[" , tryMessageR_ (ShrinkFrom D) MirrorShrink) + , ("M-S-C-]" , tryMessageR_ (ShrinkFrom U) MirrorExpand) ] -mouseBindings' :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) -mouseBindings' XConfig {XMonad.modMask = m} = M.fromList - [ ((m, button1), \w -> focus w - >> F.mouseWindow F.position w - >> ifClick (snapSpacedMagicMove gapFull (Just 50) (Just 50) w) - >> windows S.shiftMaster - ) - , ((m .|. shiftMask, button1), \w -> focus w - >> C.mouseResizeWindow w True - >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w) - >> windows S.shiftMaster - ) - , ((m, button3), \w -> focus w - >> F.mouseWindow F.linear w - >> ifClick (snapMagicResize [L, R] (Just 50) (Just 50) w) - >> windows S.shiftMaster +mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) +mouseBindings XConfig {} = M.fromList + [ ((modMask, button1), \w -> focus w + >> F.mouseWindow F.position w + >> ifClick (snapSpacedMagicMove gapFull + (Just 50) (Just 50) w) + >> windows S.shiftMaster ) - , ((m .|. shiftMask, button3), \w -> focus w - >> C.mouseResizeWindow w True - >> ifClick (snapMagicResize [U, D] (Just 50) (Just 50) w) - >> windows S.shiftMaster + , ((modMask, button3), \w -> focus w + >> F.mouseWindow F.linear w + >> ifClick (snapMagicResize [L, R, U, D] + (Just 50) (Just 50) w) + >> windows S.shiftMaster ) ] diff --git a/src/XMonad/Custom/Event.hs b/src/XMonad/Custom/Event.hs index 4e0439e..c89714c 100644 --- a/src/XMonad/Custom/Event.hs +++ b/src/XMonad/Custom/Event.hs @@ -11,18 +11,18 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Event - ( handleEventHook' + ( handleEventHook ) where import Data.Monoid -import XMonad +import XMonad hiding (handleEventHook) import XMonad.Custom.Scratchpads import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks import XMonad.Util.Loggers.NamedScratchpad -handleEventHook' :: Event -> X All -handleEventHook' = mconcat [ nspTrackHook scratchpads - , docksEventHook - , fullscreenEventHook - ] +handleEventHook :: Event -> X All +handleEventHook = mconcat [ nspTrackHook scratchpads + , docksEventHook + , fullscreenEventHook + ] diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs index 9983b9c..f0a763b 100644 --- a/src/XMonad/Custom/Layout.hs +++ b/src/XMonad/Custom/Layout.hs @@ -16,17 +16,16 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Layout - ( layoutHook' + ( layoutHook , CustomTransformers (..) ) where -import XMonad +import XMonad hiding (layoutHook) import XMonad.Custom.Theme import XMonad.Hooks.ManageDocks import XMonad.Layout.Accordion import XMonad.Layout.BinarySpacePartition import XMonad.Layout.Fullscreen -import XMonad.Layout.Gaps import XMonad.Layout.Hidden import XMonad.Layout.LayoutModifier import XMonad.Layout.MultiToggle @@ -48,15 +47,15 @@ data CustomTransformers = GAPS instance Transformer CustomTransformers Window where transform GAPS x k = k (avoidStruts $ applySpacing x) (const x) -layoutHook' = fullscreenFloat - $ lessBorders OnlyLayoutFloat - $ mkToggle (single NBFULL) - $ avoidStruts - $ mkToggle (single GAPS) - $ mkToggle (single REFLECTX) - $ mkToggle (single REFLECTY) - $ windowNavigation - $ addTabs shrinkText tabTheme - $ hiddenWindows - $ subLayout [] (Simplest ||| Accordion) - emptyBSP +layoutHook = fullscreenFloat + $ lessBorders OnlyLayoutFloat + $ mkToggle (single NBFULL) + $ avoidStruts + $ mkToggle (single GAPS) + $ mkToggle (single REFLECTX) + $ mkToggle (single REFLECTY) + $ windowNavigation + $ addTabs shrinkText tabTheme + $ hiddenWindows + $ subLayout [] (Simplest ||| Accordion) + emptyBSP diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs index 4102f6f..461634e 100644 --- a/src/XMonad/Custom/Log.hs +++ b/src/XMonad/Custom/Log.hs @@ -16,11 +16,11 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Log - ( logHook' + ( logHook ) where import System.IO -import XMonad +import XMonad hiding (logHook) import XMonad.Actions.CopyWindow import XMonad.Custom.Theme import XMonad.Hooks.CurrentWorkspaceOnTop @@ -66,8 +66,8 @@ botBarPP = topBarPP safePrintToPipe :: Maybe Handle -> String -> IO () safePrintToPipe = maybe (\_ -> return ()) hPutStrLn -logHook' :: X () -logHook' = do +logHook :: X () +logHook = do currentWorkspaceOnTop ewmhDesktopsLogHook t <- getNamedPipe "xmobarTop" diff --git a/src/XMonad/Custom/Manage.hs b/src/XMonad/Custom/Manage.hs index d3895ef..e737108 100644 --- a/src/XMonad/Custom/Manage.hs +++ b/src/XMonad/Custom/Manage.hs @@ -11,10 +11,10 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Manage - ( manageHook' + ( manageHook ) where -import XMonad +import XMonad hiding (manageHook) import XMonad.Custom.Scratchpads import XMonad.Hooks.InsertPosition import XMonad.Hooks.ManageDocks @@ -37,20 +37,20 @@ composeActions = , className =? "xterm" -?> tileBelow , isDialog -?> doCenterFloat , isFullscreen -?> doFullFloat - , pure True -?> normalTile + , pure True -?> tileNormal , stringProperty "WM_WINDOW_ROLE" =? "pop-up" -?> doCenterFloat , stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooserDialog" -?> doCenterFloat , transience ] where - normalTile = insertPosition Above Newer + tileNormal = insertPosition Above Newer tileBelow = insertPosition Below Newer tileBelowNoFocus = insertPosition Below Older -manageHook' :: ManageHook -manageHook' = mconcat [ manageDocks - , fullscreenManageHook - , namedScratchpadManageHook scratchpads - , composeOne composeActions - ] +manageHook :: ManageHook +manageHook = mconcat [ manageDocks + , fullscreenManageHook + , namedScratchpadManageHook scratchpads + , composeOne composeActions + ] diff --git a/src/XMonad/Custom/Misc.hs b/src/XMonad/Custom/Misc.hs index 92ea877..584fe2d 100644 --- a/src/XMonad/Custom/Misc.hs +++ b/src/XMonad/Custom/Misc.hs @@ -14,7 +14,7 @@ module XMonad.Custom.Misc ( Applications (..) - , customApplications + , applications ) where data Applications = Applications @@ -25,8 +25,8 @@ data Applications = Applications , notify :: !String } deriving (Eq, Show) -customApplications :: Applications -customApplications = Applications +applications :: Applications +applications = Applications { term = "urxvtc" , browser = "qutebrowser" , top = "htop" diff --git a/src/XMonad/Custom/Navigation.hs b/src/XMonad/Custom/Navigation.hs index c301219..a1239d6 100644 --- a/src/XMonad/Custom/Navigation.hs +++ b/src/XMonad/Custom/Navigation.hs @@ -11,13 +11,13 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Navigation - ( navigation2DConfig + ( navigation ) where import XMonad.Actions.Navigation2D -navigation2DConfig :: Navigation2DConfig -navigation2DConfig = def +navigation :: Navigation2DConfig +navigation = def { defaultTiledNavigation = hybridOf sideNavigation centerNavigation , floatNavigation = hybridOf lineNavigation centerNavigation , layoutNavigation = [("Full", centerNavigation)] diff --git a/src/XMonad/Custom/Projects.hs b/src/XMonad/Custom/Projects.hs index b4b47b5..d45d1c5 100644 --- a/src/XMonad/Custom/Projects.hs +++ b/src/XMonad/Custom/Projects.hs @@ -16,7 +16,7 @@ module XMonad.Custom.Projects import XMonad.Actions.DynamicProjects import XMonad.Actions.SpawnOn -import qualified XMonad.Custom.Misc as CM +import qualified XMonad.Custom.Misc as C projects :: [Project] projects = @@ -32,6 +32,6 @@ projects = , Project { projectName = "WWW" , projectDirectory = "~/" - , projectStartHook = Just $ spawnOn "WWW" (CM.browser CM.customApplications) + , projectStartHook = Just $ spawnOn "WWW" (C.browser C.applications) } ] diff --git a/src/XMonad/Custom/Scratchpads.hs b/src/XMonad/Custom/Scratchpads.hs index e468ae7..98ddaf5 100644 --- a/src/XMonad/Custom/Scratchpads.hs +++ b/src/XMonad/Custom/Scratchpads.hs @@ -15,13 +15,13 @@ module XMonad.Custom.Scratchpads ) where import XMonad.Core -import qualified XMonad.Custom.Misc as CM +import XMonad.Custom.Misc as C import XMonad.ManageHook import qualified XMonad.StackSet as S import XMonad.Util.NamedScratchpad spawnTerminalWith :: String -> String -> String -spawnTerminalWith t c = CM.term CM.customApplications ++ " -title " ++ t ++ " -e " ++ c +spawnTerminalWith t c = term applications ++ " -title " ++ t ++ " -e " ++ c floatingNSP :: ManageHook floatingNSP = customFloating $ S.RationalRect x y w h @@ -34,19 +34,19 @@ floatingNSP = customFloating $ S.RationalRect x y w h scratchpads :: [NamedScratchpad] scratchpads = [ NS "console" - (spawnTerminalWith "NSPConsole" "~/.xmonad/bin/nsp-console.sh") - (title =? "NSPConsole") - floatingNSP + (spawnTerminalWith "NSPConsole" "~/.xmonad/bin/nsp-console.sh") + (title =? "NSPConsole") + floatingNSP , NS "volume" - (spawnTerminalWith "NSPVolume" (CM.mixer CM.customApplications)) - (title =? "NSPVolume") - floatingNSP + (spawnTerminalWith "NSPVolume" (C.mixer C.applications)) + (title =? "NSPVolume") + floatingNSP , NS "music" - (spawnTerminalWith "NSPMusic" "~/.bin/mp") - (title =? "NSPMusic") - floatingNSP + (spawnTerminalWith "NSPMusic" "~/.bin/mp") + (title =? "NSPMusic") + floatingNSP , NS "top" - (spawnTerminalWith "NSPTop" (CM.top CM.customApplications)) - (title =? "NSPTop") - floatingNSP + (spawnTerminalWith "NSPTop" (C.top C.applications)) + (title =? "NSPTop") + floatingNSP ] diff --git a/src/XMonad/Custom/Startup.hs b/src/XMonad/Custom/Startup.hs index 68b8fd3..3738f6a 100644 --- a/src/XMonad/Custom/Startup.hs +++ b/src/XMonad/Custom/Startup.hs @@ -11,12 +11,12 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Startup - ( startupHook' + ( startupHook ) where import Control.Monad import Data.Maybe -import XMonad +import XMonad hiding (startupHook) import XMonad.Hooks.ManageDocks import XMonad.Hooks.SetWMName import XMonad.Util.Cursor @@ -49,8 +49,8 @@ addEWMHFullscreen = do s <- mapM getAtom atomsToFullscreen mapM_ addNETSupported s -startupHook' :: X () -startupHook' = do +startupHook :: X () +startupHook = do spawnNamedPipe "xmobar ~/.xmonad/xmobarrcTop.hs" "xmobarTop" spawnNamedPipe "xmobar ~/.xmonad/xmobarrcBot.hs" "xmobarBot" docksStartupHook diff --git a/src/XMonad/Custom/Workspaces.hs b/src/XMonad/Custom/Workspaces.hs index 3c15671..555bf20 100644 --- a/src/XMonad/Custom/Workspaces.hs +++ b/src/XMonad/Custom/Workspaces.hs @@ -11,15 +11,14 @@ ----------------------------------------------------------------------------- module XMonad.Custom.Workspaces - ( workspaces' + ( workspaces ) where import XMonad.Actions.DynamicProjects -import XMonad.Core -import XMonad.Custom.Misc +import XMonad.Core hiding (workspaces) -workspaces' :: [WorkspaceId] -workspaces' = map show [1..9 :: Int] +workspaces :: [WorkspaceId] +workspaces = map show [1..9 :: Int] projects :: [Project] projects = diff --git a/src/XMonad/Util/ALSA.hs b/src/XMonad/Util/ALSA.hs index 27037cb..3e543df 100644 --- a/src/XMonad/Util/ALSA.hs +++ b/src/XMonad/Util/ALSA.hs @@ -32,7 +32,6 @@ import Control.Monad import Control.Monad.Trans import Data.Maybe import Sound.ALSA.Mixer -import XMonad.Core toggleMute :: MonadIO m => m Bool raiseVolume :: MonadIO m => Double -> m Double |