huge update-o

1 files changed, 49 insertions, 110 deletions

diff --git a/src/lib/XMonad/Custom/Bindings.hs b/src/lib/XMonad/Custom/Bindings.hs
index 208ccdf..e9498ca 100644
--- a/src/lib/XMonad/Custom/Bindings.hs
+++ b/src/lib/XMonad/Custom/Bindings.hs
@@ -1,28 +1,24 @@
-{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-name-shadowing #-}
 
 -- |
 -- Module                  : XMonad.Custom.Bindings
 -- Description             : Key bindings and keys configuration
--- Copyright               : (c) Azat Bahawi 2018-2021
+-- Copyright               : (c) Azat Bahawi 2018-2022
 -- SPDX-License-Identifier : GPL-3.0-or-later
--- Maintainer              : azahi@teknik.io
+-- Maintainer              : azat@bahawi.net
 -- Stability               : experimental
 -- Portability             : non-portable
 --
 
 module XMonad.Custom.Bindings
-  ( keys
-  , rawKeys
-  , modMask
-  , mouseBindings
+  ( ngKeys
+  , ngModMask
+  , ngMouseBindings
   ) where
 
 import qualified Data.Map                      as M
 import           System.Exit
-import           XMonad                  hiding ( keys
-                                                , modMask
-                                                , mouseBindings
-                                                )
+import           XMonad
 import           XMonad.Actions.CopyWindow
 import           XMonad.Actions.CycleWS
 import           XMonad.Actions.DynamicProjects
@@ -35,16 +31,12 @@ import           XMonad.Actions.Navigation2D
 import           XMonad.Actions.Promote
 import           XMonad.Actions.UpdatePointer
 import           XMonad.Actions.WithAll
-import           XMonad.Custom.Layout
 import qualified XMonad.Custom.Misc            as C
 import           XMonad.Custom.Scratchpads
 import           XMonad.Custom.Theme
 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
@@ -54,18 +46,30 @@ import           XMonad.Prompt.Workspace
 import qualified XMonad.StackSet               as S
 import           XMonad.Util.EZConfig
 import           XMonad.Util.NamedScratchpad
-import           XMonad.Util.WorkspaceCompare
 
-modMask :: KeyMask
-modMask = mod4Mask
+ngModMask :: KeyMask
+ngModMask = mod4Mask
 
-directions :: [Direction2D]
-directions = [D, U, L, R]
+ngKeys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
+ngKeys c = mkKeymap c (rawKeys c)
 
-arrowKeys, directionKeys, wsKeys :: [String]
-arrowKeys = ["<D>", "<U>", "<L>", "<R>"]
-directionKeys = ["j", "k", "h", "l"]
-wsKeys = map show [1 .. 9 :: Int]
+ngMouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
+ngMouseBindings XConfig { XMonad.modMask = ngModMask } = M.fromList
+  [ ( (ngModMask, button1)
+    , \w ->
+      focus w
+        >> F.mouseWindow F.position w
+        >> ifClick (snapMagicMove (Just 50) (Just 50) w)
+        >> windows S.shiftMaster
+    )
+  , ( (ngModMask, button3)
+    , \w ->
+      focus w
+        >> F.mouseWindow F.linear w
+        >> ifClick (snapMagicResize [L, R, U, D] (Just 50) (Just 50) w)
+        >> windows S.shiftMaster
+    )
+  ]
 
 zipKeys :: [a] -> [[a]] -> [t1] -> (t1 -> b) -> [([a], b)]
 zipKeys m ks as f = zipWith (\k d -> (m ++ k, f d)) ks as
@@ -73,42 +77,6 @@ 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]
-
-toggleCopyToAll :: X ()
-toggleCopyToAll = wsContainingCopies >>= \case
-  [] -> 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
-  )
-
-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
@@ -122,32 +90,25 @@ rawKeys c = withUpdatePointer $ concatMap ($ c) keymaps
     , keysLayout
     , keysResize
     ]
+  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))
 
 keysBase :: XConfig Layout -> [(String, X ())]
 keysBase _ =
-  [ ("M-S-q", confirmPrompt hotPromptTheme "Quit XMonad?" $ io exitSuccess)
-  , ("M-q"  , spawn "xmonad --restart")
-  , -- TODO Replace with interal calls
-    ("M-C-q", spawn "xmonad --recompile && xmonad --restart")
+  [ ("M-S-q", confirmPrompt hotPromptTheme "Quit?" $ io exitSuccess)
   , ("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 ())
-  , -- TODO Replace scripts with internal functions
-    ("<XF86ScreenSaver>", spawn "~/.xmonad/scripts/screenlock.sh")
-  , ("M-<Print>", spawn "~/.xmonad/scripts/xshot-upload.sh")
-  , ("M-S-<Print>", spawn "~/.xmonad/scripts/xshot-select-upload.sh")
-  , ("M-C-c", spawn "~/.xmonad/scripts/toggle-compton.sh")
-  , ("M-C-r", spawn "~/.xmonad/scripts/toggle-redshift.sh")
-  , ("M-C-p", spawn "~/.xmonad/scripts/toggle-touchpad.sh")
-  , ("M-C-t", spawn "~/.xmonad/scripts/toggle-trackpoint.sh")
-  ]
+keysSystem _ = [("M-C-g", return ())]
 
-keysMedia :: XConfig Layout -> [(String, X ())] -- TODO Make audio keys compatible with ALSA/PA at the same time
+keysMedia :: XConfig Layout -> [(String, X ())]
 keysMedia _ =
   [ ("<XF86AudioMicMute>", spawn "pactl set-source-mute 1 toggle")
   , ("<XF86AudioMute>"   , spawn "pactl set-sink-mute 0 toggle")
@@ -167,19 +128,17 @@ keysWorkspaces :: XConfig Layout -> [(String, X ())]
 keysWorkspaces _ =
   [ ("M-S-o", switchProjectPrompt promptTheme)
     , ("M-S-p", shiftToProjectPrompt promptTheme)
-    , ("M-,"  , nextNonEmptyWS)
-    , ("M-."  , prevNonEmptyWS)
     , ("M-i"  , toggleWS' ["NSP"])
-    , ("M-n", workspacePrompt promptTheme $ windows . S.shift)
+    , ("M-n"  , workspacePrompt promptTheme $ windows . S.shift)
     ]
     ++ zipKeys "M-"     wsKeys [0 ..] (withNthWorkspace S.greedyView)
     ++ zipKeys "M-S-"   wsKeys [0 ..] (withNthWorkspace S.shift)
     ++ zipKeys "M-C-S-" wsKeys [0 ..] (withNthWorkspace copy)
+  where wsKeys = map show [1 .. 9 :: Int]
 
 keysSpawnables :: XConfig Layout -> [(String, X ())]
 keysSpawnables _ =
   [ ("M-<Return>", spawn (C.term C.applications))
-  , ("M-b"       , spawn (C.browser C.applications))
   , ("M-c"       , namedScratchpadAction scratchpads "console")
   , ("M-m"       , namedScratchpadAction scratchpads "music")
   , ("M-t"       , namedScratchpadAction scratchpads "top")
@@ -190,7 +149,6 @@ keysWindows :: XConfig Layout -> [(String, X ())]
 keysWindows _ =
   [ ("M-d"  , kill)
     , ("M-S-d", confirmPrompt hotPromptTheme "Kill all" killAll)
-    , ("M-a"  , toggleCopyToAll)
     , ("M-e"  , withFocused hideWindow)
     , ("M-S-e", popOldestHiddenWindow)
     , ("M-p"  , promote)
@@ -201,28 +159,24 @@ keysWindows _ =
     , ("M-S-'", windows S.swapDown)
     , ("M-S-;", windows S.swapUp)
     ]
-    ++ 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-"   vimKeys directions windowGo   True -- TODO W moving
+    ++ zipKeys' "M-S-" vimKeys directions windowSwap True
+    ++ zipKeys "M-C-" vimKeys directions (sendMessage . pullGroup)
     ++ zipKeys' "M-"   arrowKeys directions screenGo       True
     ++ zipKeys' "M-S-" arrowKeys directions windowToScreen True
     ++ zipKeys' "M-C-" arrowKeys directions screenSwap     True
+ where
+  directions = [D, U, L, R]
+  arrowKeys  = ["<D>", "<U>", "<L>", "<R>"]
+  vimKeys    = ["j", "k", "h", "l"]
 
 keysLayout :: XConfig Layout -> [(String, X ())]
 keysLayout c =
   [ ("M-<Tab>"  , sendMessage NextLayout)
   , ("M-C-<Tab>", toSubl NextLayout)
   , ("M-S-<Tab>", setLayout $ XMonad.layoutHook c)
-  , ("M-o"      , withFocused toggleFloat)
-  , ("M-S-o"    , 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-C-g", sendMessage $ Toggle GAPS) -- FIXME Breaks merged tabbed layout
   ]
 
 keysResize :: XConfig Layout -> [(String, X ())]
@@ -236,21 +190,6 @@ keysResize _ =
   , ("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{} = M.fromList
-  [ ( (modMask, button1)
-    , \w ->
-      focus w
-        >> F.mouseWindow F.position w
-        >> ifClick (snapMagicMove (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
-    )
-  ]
+ where
+  tryMessageR_ :: (Message a, Message b) => a -> b -> X ()
+  tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh]