Add X.Custom and split existing code in modules

1 files changed, 255 insertions, 0 deletions

diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs
new file mode 100644
index 0000000..fd59e88
--- /dev/null
+++ b/src/XMonad/Custom/Bindings.hs
@@ -0,0 +1,255 @@
+module XMonad.Custom.Bindings
+    ( showKeyBindings
+    , modMask'
+    , keyBindings
+    , mouseBindings'
+    ) where
+
+import           Control.Monad
+import qualified Data.Map                            as M
+import           System.Exit
+import           System.IO
+import           XMonad
+import           XMonad.Actions.CopyWindow
+import qualified XMonad.Actions.ConstrainedResize as C
+import           XMonad.Actions.CycleWS
+import qualified XMonad.Actions.FlexibleManipulate as F
+import           XMonad.Actions.DynamicProjects
+import XMonad.Actions.FloatSnap
+import           XMonad.Actions.DynamicWorkspaces
+import           XMonad.Actions.FloatSnapSpaced
+import           XMonad.Actions.MessageFeedback
+import           XMonad.Actions.Navigation2D
+import           XMonad.Actions.PerConditionKeys
+import           XMonad.Actions.Promote
+import           XMonad.Actions.Volume
+import           XMonad.Actions.WithAll
+import           XMonad.Custom.Layout
+import qualified XMonad.Custom.Misc                  as CM
+import           XMonad.Custom.Scratchpads
+import           XMonad.Custom.Theme
+import           XMonad.Hooks.DynamicLog
+import           XMonad.Hooks.UrgencyHook
+import           XMonad.Layout.BinarySpacePartition
+import           XMonad.Layout.Hidden
+import           XMonad.Layout.MultiToggle
+import           XMonad.Layout.MultiToggle.Instances
+import           XMonad.Layout.Reflect
+import           XMonad.Layout.ResizableTile
+import           XMonad.Layout.SubLayouts
+import           XMonad.Prompt.ConfirmPrompt
+import           XMonad.Prompt.Pass
+import           XMonad.Prompt.Shell
+import           XMonad.Prompt.Window
+import           XMonad.Prompt.Workspace
+import qualified XMonad.StackSet                     as S
+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 "/usr/bin/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
+
+directions :: [Direction2D]
+directions = [D, U, L, R]
+
+arrowKeys, directionKeys, wsKeys :: [String]
+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
+
+tryMessageR_ :: (Message a, Message b) => a -> b -> X ()
+tryMessageR_ x y = sequence_ [tryMessage_ x y, refresh]
+
+xSelectionNotify :: MonadIO m => m ()
+xSelectionNotify = join
+                 $ io
+                 $ (unsafeSpawn . (\x -> CM.notify CM.customApplications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x))
+                   <$> getSelection
+
+toggleCopyToAll :: X ()
+toggleCopyToAll = wsContainingCopies >>= \x -> case x of
+                                                    [] -> windows copyToAll
+                                                    _  -> killAllOtherCopies
+
+getSortByIndexNonSP :: X ([WindowSpace] -> [WindowSpace])
+getSortByIndexNonSP = (. namedScratchpadFilterOutWorkspace) <$> getSortByIndex
+
+nextNonEmptyWS, prevNonEmptyWS :: X ()
+nextNonEmptyWS = findWorkspace getSortByIndexNonSP Next HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t
+prevNonEmptyWS = findWorkspace getSortByIndexNonSP Prev HiddenNonEmptyWS 1 >>= \t -> windows . S.view $ t
+
+toggleFloat :: Window -> X ()
+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 "/usr/bin/xmonad --restart")
+    , ("M-C-q"  , addName "Recompile & restart XMonad" $ spawn "/usr/bin/xmonad --recompile && /usr/bin/xmonad --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)
+    ]
+
+    ^++^
+    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 "/usr/bin/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")
+    ]
+
+    ^++^
+    subKeys "Volume & Music" -- TODO replace play/pause script with Haskell implementation
+    [ ("<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 "/usr/bin/mpc --no-status stop")
+    , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "/usr/bin/mpc --no-status prev")
+    , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "/usr/bin/mpc --no-status next")
+    ]
+
+    ^++^
+    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")
+    ]
+
+    ^++^
+    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 "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 "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
+    ]
+
+    ^++^
+    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)
+    ]
+
+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 gapBase  (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
+      )
+    , ((m .|. shiftMask, button3), \w -> focus w >> C.mouseResizeWindow w True
+                                                 >> ifClick (snapMagicResize [U, D]       (Just 50) (Just 50) w)
+                                                 >> windows S.shiftMaster
+      )
+    ]