From ee9be16599f20aef6d1d3fd15666c00452f85aba Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 21 Nov 2022 12:05:03 -0700 Subject: Format with ormolu. --- src/Main.hs | 162 ++--- src/Rahm/Desktop/Common.hs | 68 +- src/Rahm/Desktop/DMenu.hs | 60 +- src/Rahm/Desktop/Desktop.hs | 33 +- src/Rahm/Desktop/Hash.hs | 7 +- src/Rahm/Desktop/History.hs | 41 +- src/Rahm/Desktop/Hooks/WindowChange.hs | 29 +- src/Rahm/Desktop/Keys.hs | 954 +++++++++++++------------- src/Rahm/Desktop/Keys/Dsl.hs | 182 ++--- src/Rahm/Desktop/Keys/Wml.hs | 351 +++++----- src/Rahm/Desktop/Layout.hs | 108 +-- src/Rahm/Desktop/Layout/Bordering.hs | 172 ++--- src/Rahm/Desktop/Layout/ConsistentMosaic.hs | 28 +- src/Rahm/Desktop/Layout/CornerLayout.hs | 24 +- src/Rahm/Desktop/Layout/Draw.hs | 135 ++-- src/Rahm/Desktop/Layout/Flip.hs | 57 +- src/Rahm/Desktop/Layout/Hole.hs | 9 +- src/Rahm/Desktop/Layout/List.hs | 125 ++-- src/Rahm/Desktop/Layout/Pop.hs | 86 +-- src/Rahm/Desktop/Layout/Redescribe.hs | 14 +- src/Rahm/Desktop/Layout/ReinterpretMessage.hs | 12 +- src/Rahm/Desktop/Layout/Rotate.hs | 32 +- src/Rahm/Desktop/Logger.hs | 17 +- src/Rahm/Desktop/Marking.hs | 112 +-- src/Rahm/Desktop/MouseMotion.hs | 24 +- src/Rahm/Desktop/NoPersist.hs | 3 +- src/Rahm/Desktop/PassMenu.hs | 17 +- src/Rahm/Desktop/PromptConfig.hs | 15 +- src/Rahm/Desktop/RebindKeys.hs | 78 +-- src/Rahm/Desktop/StackSet.hs | 116 ++-- src/Rahm/Desktop/Submap.hs | 112 +-- src/Rahm/Desktop/Swallow.hs | 11 +- src/Rahm/Desktop/SwapMaster.hs | 28 +- src/Rahm/Desktop/Theater.hs | 98 +-- src/Rahm/Desktop/Workspaces.hs | 76 +- src/Rahm/Desktop/XMobarLog.hs | 119 ++-- 36 files changed, 1825 insertions(+), 1690 deletions(-) (limited to 'src') diff --git a/src/Main.hs b/src/Main.hs index a98e568..766716c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,33 +1,30 @@ -import XMonad - -import XMonad.Hooks.DynamicProperty -import Control.Monad.Trans.Class import Control.Monad.Reader -import XMonad.Hooks.ManageDocks (docks) -import System.Directory (getHomeDirectory) -import System.FilePath (()) -import XMonad.Hooks.EwmhDesktops (ewmh) -import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) -import XMonad.Layout.Fullscreen (fullscreenEventHook) -import System.Environment (setEnv) -import Data.Monoid +import Control.Monad.Trans.Class import qualified Data.Map as Map -import Text.Printf - -import Rahm.Desktop.Swallow -import Rahm.Desktop.Marking +import Data.Monoid import Rahm.Desktop.Common -import Rahm.Desktop.XMobarLog +import Rahm.Desktop.DMenu (menuCommandString) +import Rahm.Desktop.History +import Rahm.Desktop.Hooks.WindowChange import Rahm.Desktop.Keys import Rahm.Desktop.Layout import Rahm.Desktop.Logger -import Rahm.Desktop.DMenu (menuCommandString) +import Rahm.Desktop.Marking import Rahm.Desktop.RebindKeys -import Rahm.Desktop.Hooks.WindowChange -import Rahm.Desktop.History - -import qualified XMonad as X import qualified Rahm.Desktop.StackSet as W +import Rahm.Desktop.Swallow +import Rahm.Desktop.XMobarLog +import System.Directory (getHomeDirectory) +import System.Environment (setEnv) +import System.FilePath (()) +import Text.Printf +import XMonad +import qualified XMonad as X +import XMonad.Hooks.DynamicProperty +import XMonad.Hooks.EwmhDesktops (ewmh) +import XMonad.Hooks.ManageDocks (docks) +import XMonad.Hooks.ManageHelpers (doFullFloat, isFullscreen) +import XMonad.Layout.Fullscreen (fullscreenEventHook) main = do putStrLn "Welcome To RDE!" @@ -41,49 +38,56 @@ main = do xmobar <- spawnXMobar - (=<<) X.xmonad $ - applyKeys $ withLocationChangeHook historyHook $ ewmh $ docks $ def - { terminal = "alacritty" - , modMask = mod3Mask - , borderWidth = 2 - , keys = const mempty - , focusedBorderColor = "#ff6c00" - , normalBorderColor = "#404040" - , layoutHook = myLayout - , startupHook = spawn fp - , manageHook = composeAll [ - isFullscreen --> doFullFloat - , doLogWindow - , className =? "Tilda" --> doFloat - , className =? "yakuake" --> doFloat - , className =? "MPlayer" --> doFloat - , title =? "Event Tester" --> doFloat - , title =? "Floating Term" --> doCenterFloat - , title =? "Notes" --> doCenterFloat - , title =? "xmessage" --> doCenterFloat - , title =? "gxmessage" --> doCenterFloat - , title =? "Volume Control" --> doCenterFloat - , className =? "mpv" --> doFloat - , className =? "gnubby_ssh_prompt" --> doFloat - ] - -- This config uses dynamic workspaces, but I have to seed XMonad - -- with something. However, this configuration only supports 36 - -- monitors on boot. If you need more than 36 monitors, you'll have to - -- configure those ones after starting XMonad. - , workspaces = map return (['0'..'9'] ++ ['a'..'z']) - , handleEventHook = - composeAll [ - fullscreenEventHook, - remapHook, - swallowHook, - dynamicTitle (composeAll [ - title =? "Spotify" --> doMarkWindow "s" - ])] - , focusFollowsMouse = False - , clickJustFocuses = False - , logHook = xMobarLogHook xmobar - } - + (=<<) X.xmonad $ + applyKeys $ + withLocationChangeHook historyHook $ + ewmh $ + docks $ + def + { terminal = "alacritty", + modMask = mod3Mask, + borderWidth = 2, + keys = const mempty, + focusedBorderColor = "#ff6c00", + normalBorderColor = "#404040", + layoutHook = myLayout, + startupHook = spawn fp, + manageHook = + composeAll + [ isFullscreen --> doFullFloat, + doLogWindow, + className =? "Tilda" --> doFloat, + className =? "yakuake" --> doFloat, + className =? "MPlayer" --> doFloat, + title =? "Event Tester" --> doFloat, + title =? "Floating Term" --> doCenterFloat, + title =? "Notes" --> doCenterFloat, + title =? "xmessage" --> doCenterFloat, + title =? "gxmessage" --> doCenterFloat, + title =? "Volume Control" --> doCenterFloat, + className =? "mpv" --> doFloat, + className =? "gnubby_ssh_prompt" --> doFloat + ], + -- This config uses dynamic workspaces, but I have to seed XMonad + -- with something. However, this configuration only supports 36 + -- monitors on boot. If you need more than 36 monitors, you'll have to + -- configure those ones after starting XMonad. + workspaces = map return (['0' .. '9'] ++ ['a' .. 'z']), + handleEventHook = + composeAll + [ fullscreenEventHook, + remapHook, + swallowHook, + dynamicTitle + ( composeAll + [ title =? "Spotify" --> doMarkWindow "s" + ] + ) + ], + focusFollowsMouse = False, + clickJustFocuses = False, + logHook = xMobarLogHook xmobar + } changeHook :: Location -> Location -> X () changeHook l1 l2 = @@ -98,9 +102,16 @@ doLogWindow = do return (Endo id) doMarkWindow :: Mark -> ManageHook -doMarkWindow m = ask >>= (\w -> liftX (do - ws <- getCurrentWorkspace - markAllLocations m [Location ws (Just w)]) >> return (Endo id)) +doMarkWindow m = + ask + >>= ( \w -> + liftX + ( do + ws <- getCurrentWorkspace + markAllLocations m [Location ws (Just w)] + ) + >> return (Endo id) + ) doCenterFloat :: ManageHook doCenterFloat = @@ -109,14 +120,11 @@ doCenterFloat = centerRect :: W.RationalRect -> W.RationalRect centerRect (W.RationalRect x y w h) = W.RationalRect ((1 - w) / 2) ((1 - h) / 2) w h - windowHooks :: WindowHook -> XConfig l -> XConfig l windowHooks (Query readerT) config = do - - config { - startupHook = do - withWindowSet $ mapM_ (runReaderT readerT) . W.allWindows - startupHook config, - - manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config) - } + config + { startupHook = do + withWindowSet $ mapM_ (runReaderT readerT) . W.allWindows + startupHook config, + manageHook = mappend (Query readerT >> return (Endo id)) (manageHook config) + } diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs index 3e6d54c..e012a8f 100644 --- a/src/Rahm/Desktop/Common.hs +++ b/src/Rahm/Desktop/Common.hs @@ -1,59 +1,61 @@ module Rahm.Desktop.Common where -import Prelude hiding ((!!)) - -import Control.Monad (void, when, forM_) +import Control.Monad (forM_, void, when) import Control.Monad.Trans.Maybe -import XMonad.Util.Run -import XMonad.Prompt -import XMonad.Prompt.Input -import XMonad.Prompt.Shell -import XMonad.Util.XUtils - -import Rahm.Desktop.PromptConfig - import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) -import Data.Maybe -import Text.Printf -import XMonad hiding (workspaces, Screen) import qualified Data.Map as Map -import Rahm.Desktop.DMenu +import Data.Maybe import Data.Ord (comparing) - +import Rahm.Desktop.DMenu +import Rahm.Desktop.PromptConfig import qualified Rahm.Desktop.StackSet as S +import Text.Printf +import XMonad hiding (Screen, workspaces) +import XMonad.Prompt +import XMonad.Prompt.Input +import XMonad.Prompt.Shell +import XMonad.Util.Run +import XMonad.Util.XUtils +import Prelude hiding ((!!)) -- A location is a workspace and maybe a window with that workspace. -data Location = Location { - locationWorkspace :: WorkspaceId, +data Location = Location + { locationWorkspace :: WorkspaceId, locationWindow :: Maybe Window - } deriving (Read, Show, Eq, Ord) + } + deriving (Read, Show, Eq, Ord) focusLocation :: Location -> X () focusLocation (Location ws Nothing) = windows $ S.greedyView ws focusLocation (Location _ (Just win)) = windows $ S.focusWindow win masterWindow :: MaybeT X Window -masterWindow = MaybeT $ withWindowSet $ \ss -> - let windows = (S.integrate' . S.stack . S.workspace . S.current) ss - in case windows of - (a:_) -> return $ Just a - _ -> return Nothing +masterWindow = MaybeT $ + withWindowSet $ \ss -> + let windows = (S.integrate' . S.stack . S.workspace . S.current) ss + in case windows of + (a : _) -> return $ Just a + _ -> return Nothing windowsInWorkspace :: WorkspaceId -> X [Location] windowsInWorkspace wid = withWindowSet $ - return . concatMap (\ws -> - if S.tag ws == wid - then map (Location wid . Just) $ S.integrate' (S.stack ws) - else []) . S.workspaces + return + . concatMap + ( \ws -> + if S.tag ws == wid + then map (Location wid . Just) $ S.integrate' (S.stack ws) + else [] + ) + . S.workspaces data WinPrompt = WinPrompt instance XPrompt WinPrompt where - showXPrompt _ = "[Window] " - commandToComplete _ = id + showXPrompt _ = "[Window] " + commandToComplete _ = id getString :: Window -> X String getString = runQuery $ do @@ -107,7 +109,7 @@ withBorderWidth width ws fn = do forM_ ws $ \window -> io $ setWindowBorderWidth d window $ fromIntegral width - ret <- fn + ret <- fn forM_ ws $ \window -> io $ setWindowBorderWidth d window 2 @@ -119,7 +121,7 @@ withBorderWidth width ws fn = do gotoWorkspace :: WorkspaceId -> X () gotoWorkspace wid = windows $ S.greedyView wid -moveLocationToWorkspace :: Location -> WorkspaceId -> X () +moveLocationToWorkspace :: Location -> WorkspaceId -> X () moveLocationToWorkspace (Location _ (Just win)) wid = windows $ S.shiftWin wid win moveLocationToWorkspace _ _ = return () @@ -136,4 +138,4 @@ getCurrentLocation = do return (Location ws win) runMaybeT_ :: (Monad m) => MaybeT m a -> m () -runMaybeT_ = void . runMaybeT +runMaybeT_ = void . runMaybeT diff --git a/src/Rahm/Desktop/DMenu.hs b/src/Rahm/Desktop/DMenu.hs index d20d001..eeb0d5f 100644 --- a/src/Rahm/Desktop/DMenu.hs +++ b/src/Rahm/Desktop/DMenu.hs @@ -1,19 +1,20 @@ module Rahm.Desktop.DMenu where -import XMonad.Util.Dmenu -import XMonad import Control.Monad +import Data.List (intercalate) import Data.Map (Map) import qualified Data.Map as Map -import XMonad.Util.Run -import Data.List (intercalate) import Text.Printf (printf) +import XMonad +import XMonad.Util.Dmenu +import XMonad.Util.Run -data Colors = - Colors { - fg :: String, - bg :: String - } | DefaultColors +data Colors + = Colors + { fg :: String, + bg :: String + } + | DefaultColors menuCommand :: [String] menuCommand = ["rofi", "-monitor", "-4", "-i", "-dmenu", "-sort", "-levenshtein-sort"] @@ -22,24 +23,37 @@ menuCommandString :: String menuCommandString = unwords menuCommand runDMenu :: X () -runDMenu = void $ - safeSpawn - "rofi" - ["-monitor", "-4", "-display-run", "Execute", "-show", "run"] +runDMenu = + void $ + safeSpawn + "rofi" + ["-monitor", "-4", "-display-run", "Execute", "-show", "run"] runDMenuPrompt :: String -> Maybe String -> [String] -> X String runDMenuPrompt prompt color select = let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color - in - runProcessWithInput "/home/rahm/.local/bin/dmenu_debug.sh" ([ - "-p", prompt, - "-l", "12", - "-dim", "0.4" ] ++ realColor) (intercalate "\n" select) - + in runProcessWithInput + "/home/rahm/.local/bin/dmenu_debug.sh" + ( [ "-p", + prompt, + "-l", + "12", + "-dim", + "0.4" + ] + ++ realColor + ) + (intercalate "\n" select) runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a) runDMenuPromptWithMap prompt color map = do - let realColor = maybe [] ( - \c -> ["-theme-str", printf "* {theme-color: %s;}" c]) color - menuMapArgs (head menuCommand) - (tail menuCommand ++ ["-p", prompt] ++ realColor) map + let realColor = + maybe + [] + ( \c -> ["-theme-str", printf "* {theme-color: %s;}" c] + ) + color + menuMapArgs + (head menuCommand) + (tail menuCommand ++ ["-p", prompt] ++ realColor) + map diff --git a/src/Rahm/Desktop/Desktop.hs b/src/Rahm/Desktop/Desktop.hs index 053b330..5466fd1 100644 --- a/src/Rahm/Desktop/Desktop.hs +++ b/src/Rahm/Desktop/Desktop.hs @@ -4,22 +4,24 @@ module Rahm.Desktop.Desktop where -- state of the current screen -> workspace and thus restore it. -- import XMonad.Operations -import Data.Maybe (fromMaybe) + import Control.Monad (forM_) -import XMonad (X(..)) -import qualified XMonad.StackSet as W -import qualified XMonad as X +import Data.Default import Data.Map (Map) import qualified Data.Map as Map -import Data.Default +import Data.Maybe (fromMaybe) +import XMonad (X (..)) +import qualified XMonad as X +import qualified XMonad.StackSet as W import qualified XMonad.Util.ExtensibleState as XS newtype Desktop si wi = Desktop (Map si wi) deriving (Read, Show) -newtype Desktops = Desktops { - theaters :: Map String (Desktop X.ScreenId X.WorkspaceId) -} deriving (Read, Show) +newtype Desktops = Desktops + { theaters :: Map String (Desktop X.ScreenId X.WorkspaceId) + } + deriving (Read, Show) instance Default Desktops where def = Desktops mempty @@ -32,9 +34,11 @@ saveCurrentDesktop :: String -> X () saveCurrentDesktop name = X.withWindowSet $ \windowSet -> XS.modify $ \(Desktops m) -> - Desktops $ flip (Map.insert name) m $ - Desktop $ Map.fromList $ - map (\(W.Screen ws sid _) -> (sid, W.tag ws)) $ W.screens windowSet + Desktops $ + flip (Map.insert name) m $ + Desktop $ + Map.fromList $ + map (\(W.Screen ws sid _) -> (sid, W.tag ws)) $ W.screens windowSet restoreDesktop :: String -> X () restoreDesktop name = do @@ -47,7 +51,7 @@ restoreDesktop name = do fromMaybe scr $ do wid <- Map.lookup (W.screen scr) screenToWorkspace workspace <- Map.lookup wid workspacesById - return $ scr { W.workspace = workspace } + return $ scr {W.workspace = workspace} newScreens = map newScreenWorkspace (cur : vis) newVisibleWorkspaces = map (W.tag . W.workspace) newScreens @@ -55,6 +59,5 @@ restoreDesktop name = do filter (\ws -> not (W.tag ws `elem` newVisibleWorkspaces)) $ W.workspaces ws - (newCur:newVisible) = newScreens - in - W.StackSet newCur newVisible newHiddenWorkspaces float + (newCur : newVisible) = newScreens + in W.StackSet newCur newVisible newHiddenWorkspaces float diff --git a/src/Rahm/Desktop/Hash.hs b/src/Rahm/Desktop/Hash.hs index dc58d96..abce660 100644 --- a/src/Rahm/Desktop/Hash.hs +++ b/src/Rahm/Desktop/Hash.hs @@ -1,11 +1,12 @@ {-# LANGUAGE OverloadedStrings #-} + module Rahm.Desktop.Hash where -import Numeric (showHex) +import qualified Crypto.Hash.SHA1 as SHA1 import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BC -import qualified Crypto.Hash.SHA1 as SHA1 +import Numeric (showHex) quickHash :: String -> String quickHash str = - concatMap (`showHex` "") $ BS.unpack (SHA1.hash $ BC.pack str) + concatMap (`showHex` "") $ BS.unpack (SHA1.hash $ BC.pack str) diff --git a/src/Rahm/Desktop/History.hs b/src/Rahm/Desktop/History.hs index 516cd94..c5bc72d 100644 --- a/src/Rahm/Desktop/History.hs +++ b/src/Rahm/Desktop/History.hs @@ -1,19 +1,18 @@ module Rahm.Desktop.History where -import XMonad -import Text.Printf -import qualified Rahm.Desktop.StackSet as W -import Data.IntMap (IntMap) -import qualified Data.IntMap as IntMap import Data.Default -import qualified XMonad.Util.ExtensibleState as XS - import Data.Foldable (toList) -import Rahm.Desktop.Hooks.WindowChange +import Data.IntMap (IntMap) +import qualified Data.IntMap as IntMap +import Data.Sequence (Seq (..)) +import qualified Data.Sequence as Seq import Rahm.Desktop.Common +import Rahm.Desktop.Hooks.WindowChange import Rahm.Desktop.Logger -import Data.Sequence (Seq(..)) -import qualified Data.Sequence as Seq +import qualified Rahm.Desktop.StackSet as W +import Text.Printf +import XMonad +import qualified XMonad.Util.ExtensibleState as XS data BoundedSeqZipper a = BoundedSeqZipper Int (Seq a) (Seq a) deriving (Eq, Show, Ord, Read) @@ -24,15 +23,15 @@ instance Functor BoundedSeqZipper where zipperDbgPrint :: (Show a) => BoundedSeqZipper a -> String zipperDbgPrint (BoundedSeqZipper _ h (c :<| t)) = concat $ - map (printf " %s " . show) (toList h) ++ - [printf "[%s]" (show c)] ++ - map (printf " %s " . show) (toList t) + map (printf " %s " . show) (toList h) + ++ [printf "[%s]" (show c)] + ++ map (printf " %s " . show) (toList t) zipperDbgPrint _ = "" pushZipper :: a -> BoundedSeqZipper a -> BoundedSeqZipper a pushZipper e (BoundedSeqZipper maxSize _ (tail :|> _)) - | maxSize <= Seq.length tail = - BoundedSeqZipper maxSize mempty (e :<| tail) + | maxSize <= Seq.length tail = + BoundedSeqZipper maxSize mempty (e :<| tail) pushZipper e (BoundedSeqZipper maxSize _ tail) = BoundedSeqZipper maxSize mempty (e :<| tail) @@ -48,16 +47,18 @@ zipperForward :: BoundedSeqZipper a -> BoundedSeqZipper a zipperForward (BoundedSeqZipper s (e :<| h) t) = BoundedSeqZipper s h (e :<| t) zipperForward b = b -newtype History = History { - currentZipper :: BoundedSeqZipper Location -} deriving (Read, Show) +newtype History = History + { currentZipper :: BoundedSeqZipper Location + } + deriving (Read, Show) instance Default History where def = History (BoundedSeqZipper 1000 mempty mempty) instance ExtensionClass History where initialValue = def - -- extensionType = PersistentExtension + +-- extensionType = PersistentExtension pastHistory :: Int -> X (Maybe Location) pastHistory i = do @@ -72,7 +73,6 @@ getMostRecentLocationInHistory = do (BoundedSeqZipper _ _ (t :<| _)) -> return $ Just t _ -> return Nothing - historyBack :: X () historyBack = do History z <- XS.get @@ -101,5 +101,4 @@ historyHook Nothing loc = XS.modify $ \(History z) -> History (pushZipper loc z) historyHook (Just (Location ws _)) l@(Location ws' _) | ws /= ws' = do XS.modify $ \(History z) -> History (pushZipper l z) - historyHook _ _ = return () diff --git a/src/Rahm/Desktop/Hooks/WindowChange.hs b/src/Rahm/Desktop/Hooks/WindowChange.hs index 3bc66a4..092fbf4 100644 --- a/src/Rahm/Desktop/Hooks/WindowChange.hs +++ b/src/Rahm/Desktop/Hooks/WindowChange.hs @@ -1,12 +1,11 @@ module Rahm.Desktop.Hooks.WindowChange where -import XMonad import Control.Monad -import qualified XMonad.Util.ExtensibleState as XS import Data.Default import Rahm.Desktop.Common - import qualified Rahm.Desktop.StackSet as W +import XMonad +import qualified XMonad.Util.ExtensibleState as XS newtype LastLocation = LastLocation (Maybe Location) deriving (Read, Show) @@ -17,7 +16,7 @@ instance Default LastLocation where instance ExtensionClass LastLocation where initialValue = def extensionType = PersistentExtension - + -- Creates a log hook from the function provided. -- -- The first argument to the function is the old window, the second argument in @@ -26,18 +25,18 @@ instance ExtensionClass LastLocation where -- If the first window is Nothing, this is the first time XMonad started. withLocationChangeHook :: (Maybe Location -> Location -> X ()) -> XConfig l -> XConfig l withLocationChangeHook fn config = - config { - logHook = do - logHook config + config + { logHook = do + logHook config - currentLocation <- - Location <$> getCurrentWorkspace <*> withWindowSet (return . W.peek) + currentLocation <- + Location <$> getCurrentWorkspace <*> withWindowSet (return . W.peek) - LastLocation last <- XS.get + LastLocation last <- XS.get - when (last /= Just currentLocation) $ - fn last currentLocation + when (last /= Just currentLocation) $ + fn last currentLocation - XS.put $ LastLocation $ Just currentLocation - return () - } + XS.put $ LastLocation $ Just currentLocation + return () + } diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index eae1c34..0ab868f 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -1,78 +1,75 @@ module Rahm.Desktop.Keys (applyKeys) where -import Control.Monad.Trans.Maybe import Control.Applicative import Control.Monad import Control.Monad.Fix (fix) import Control.Monad.Loops (iterateWhile) import Control.Monad.Reader import Control.Monad.Trans.Class +import Control.Monad.Trans.Maybe import Control.Monad.Writer import Data.Char import Data.List hiding ((!!)) import Data.List.Safe ((!!)) import Data.Map (Map) -import Data.Maybe (isJust, fromMaybe, mapMaybe) -import Data.Monoid (Endo(..)) +import qualified Data.Map as Map +import Data.Maybe (fromMaybe, isJust, mapMaybe) +import Data.Monoid (Endo (..)) import Data.Proxy import Debug.Trace -import Graphics.X11.ExtraTypes.XF86; +import Graphics.X11.ExtraTypes.XF86 import Graphics.X11.ExtraTypes.XorgDefault -import Prelude hiding ((!!)) -import System.IO -import System.Process -import Text.Printf -import XMonad -import XMonad.Actions.CopyWindow as CopyWindow -import XMonad.Actions.RotSlaves -import XMonad.Actions.SpawnOn as SpawnOn -import XMonad.Actions.WindowNavigation -import XMonad.Hooks.ManageDocks -import XMonad.Layout.MosaicAlt -import XMonad.Layout.Spacing -import XMonad.Prompt -import XMonad.Prompt.Input -import XMonad.Prompt.Shell -import XMonad.Util.XUtils -import XMonad.Util.CustomKeys -import XMonad.Util.Run (safeSpawn) -import XMonad.Util.Scratchpad -import XMonad.Util.Ungrab import Prettyprinter - -import qualified Data.Map as Map - +import Rahm.Desktop.Common import Rahm.Desktop.DMenu +import Rahm.Desktop.Desktop +import Rahm.Desktop.History import Rahm.Desktop.Keys.Dsl +import Rahm.Desktop.Keys.Wml import Rahm.Desktop.Layout import Rahm.Desktop.Layout.Bordering import Rahm.Desktop.Layout.ConsistentMosaic import Rahm.Desktop.Layout.Flip (flipHorizontally, flipVertically) import Rahm.Desktop.Layout.Hole (toggleHole) -import Rahm.Desktop.Layout.List (toNextLayout, toPreviousLayout, toFirstLayout, toIndexedLayout) +import Rahm.Desktop.Layout.List (toFirstLayout, toIndexedLayout, toNextLayout, toPreviousLayout) import Rahm.Desktop.Layout.Pop (togglePop) import Rahm.Desktop.Layout.Rotate (rotateLayout) -import Rahm.Desktop.Common import Rahm.Desktop.Logger import Rahm.Desktop.Marking -import Rahm.Desktop.Keys.Wml import Rahm.Desktop.MouseMotion import Rahm.Desktop.PassMenu import Rahm.Desktop.PromptConfig import Rahm.Desktop.RebindKeys +import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.Submap import Rahm.Desktop.Swallow import Rahm.Desktop.SwapMaster (swapMaster) -import Rahm.Desktop.Workspaces -import Rahm.Desktop.Desktop import Rahm.Desktop.Theater - -import qualified Rahm.Desktop.StackSet as W -import Rahm.Desktop.History +import Rahm.Desktop.Workspaces +import System.IO +import System.Process +import Text.Printf +import XMonad +import XMonad.Actions.CopyWindow as CopyWindow +import XMonad.Actions.RotSlaves +import XMonad.Actions.SpawnOn as SpawnOn +import XMonad.Actions.WindowNavigation +import XMonad.Hooks.ManageDocks +import XMonad.Layout.MosaicAlt +import XMonad.Layout.Spacing +import XMonad.Prompt +import XMonad.Prompt.Input +import XMonad.Prompt.Shell +import XMonad.Util.CustomKeys +import XMonad.Util.Run (safeSpawn) +import XMonad.Util.Scratchpad +import XMonad.Util.Ungrab +import XMonad.Util.XUtils +import Prelude hiding ((!!)) type KeyMap l = XConfig l -> Map (KeyMask, KeySym) (X ()) -type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) +type ButtonsMap l = XConfig l -> Map (KeyMask, Button) (Window -> X ()) spawnX :: String -> X () spawnX = spawn @@ -84,17 +81,24 @@ noWindow :: b -> Window -> b noWindow = const decreaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ -5%" + increaseVolume = spawnX "pactl set-sink-volume @DEFAULT_SINK@ +5%" + playPause = spawnX "spotify-control play" + mediaPrev = spawnX "spotify-control prev" + mediaNext = spawnX "spotify-control next" decreaseVolumeDoc = doc "Decrease volume" decreaseVolume + increaseVolumeDoc = doc "Increase volume" increaseVolume + playPauseDoc = doc "Play/Pause current media" playPause + mediaPrevDoc = doc "Previous media" mediaPrev -mediaNextDoc = doc "Next media" mediaNext +mediaNextDoc = doc "Next media" mediaNext button6 :: Button button6 = 6 @@ -128,7 +132,6 @@ button15 = 15 keyBindingToKeymap :: (XConfig l -> KeyBindings) -> KeyMap l keyBindingToKeymap bindings config = Map.mapWithKey bindingToX (bindings config) - where bindingToX :: (KeyMask, KeySym) -> Documented KeyBinding -> X () bindingToX key b = @@ -151,11 +154,11 @@ keymap = runKeys $ do forM_ [xK_apostrophe, xK_w] $ \k -> bind k $ do justMod $ doc "Jumps between marks." $ - runMaybeT_ $ do - l <- readNextLocationSet - case l of - (h:_) -> lift (focusLocation h) - _ -> return () + runMaybeT_ $ do + l <- readNextLocationSet + case l of + (h : _) -> lift (focusLocation h) + _ -> return () bind xK_BackSpace $ do -- The only raw keybinding. Meant to get a terminal to unbrick XMonad if @@ -163,12 +166,12 @@ keymap = runKeys $ do -- where dmenu/alacritty may not be installed. rawMask mod4Mask $ doc "Spawns XTerm as a fallback if xkb is messed up." $ - spawnX "xterm" + spawnX "xterm" -- Moves xmobar to different monitors. justMod $ doc "Move XMobar to another screen." $ - spawnX "pkill -SIGUSR1 xmobar" + spawnX "pkill -SIGUSR1 xmobar" bind xK_F1 $ do -- Experimental. Sends 'a' to all windows. @@ -178,21 +181,32 @@ keymap = runKeys $ do -- focused. It's pretty annoying because it keeps me from doing some cool -- things all for BS security theater, but I guess there might be some way -- to do this via XTest? - shiftMod $ withWindowSet $ mapM_ (\w -> do - logs Info "Try send to %s" (show w) - sendKey (0, xK_a) w) . W.allWindows + shiftMod $ + withWindowSet $ + mapM_ + ( \w -> do + logs Info "Try send to %s" (show w) + sendKey (0, xK_a) w + ) + . W.allWindows justMod $ - doc "Print this documentation" - (safeSpawn "gxmessage" [ - "-fn", "Source Code Pro", - documentation (keymap config)] :: X ()) + doc + "Print this documentation" + ( safeSpawn + "gxmessage" + [ "-fn", + "Source Code Pro", + documentation (keymap config) + ] :: + X () + ) bind xK_F7 $ - justMod $ - doc "Print this documentation." - (logs Info "%s" (documentation (keymap config)) :: X ()) + doc + "Print this documentation." + (logs Info "%s" (documentation (keymap config)) :: X ()) bind xK_F10 $ do justMod playPauseDoc @@ -207,25 +221,25 @@ keymap = runKeys $ do justMod swapMaster bind xK_Tab $ do - justMod $ windows W.focusDown + justMod $ windows W.focusDown shiftMod $ windows W.focusUp -- Switch between different screens. These are the leftmost keys on the home -- row in a Dvorak layout. One might want to switch these to ASD for QWERTY. - forM_ (zip [xK_a, xK_o, xK_e] [0..]) $ \(key, idx) -> + forM_ (zip [xK_a, xK_o, xK_e] [0 ..]) $ \(key, idx) -> bind key $ do -- Move focus to that screen. - justMod $ + justMod $ doc ("Switch focus to screen " ++ show idx) $ - withScreen W.view idx + withScreen W.view idx -- Swap the current screen with the one given - altMod $ + altMod $ doc ("Swap the current screen with screen " ++ show idx) $ - withScreen W.greedyView idx + withScreen W.greedyView idx -- Move the current window to the select screen. shiftMod $ doc ("Move the current window to screne " ++ show idx) $ - withScreen W.shift idx + withScreen W.shift idx altgrMod (logs Info "Test altgr" :: X ()) @@ -233,12 +247,12 @@ keymap = runKeys $ do bind xK_bracketright $ do justMod $ doc "Increase the gaps between windows." $ - sendMessage $ modifyWindowBorder 5 + sendMessage $ modifyWindowBorder 5 bind xK_bracketleft $ do justMod $ doc "Decrease the gaps between windows." $ - sendMessage $ modifyWindowBorder (-5) + sendMessage $ modifyWindowBorder (-5) bind xK_b $ do justMod $ spawnX "bluetooth-select.sh" @@ -251,45 +265,43 @@ keymap = runKeys $ do doc "Kill the current window" CopyWindow.kill1 bind xK_f $ do - justMod $ + justMod $ doc "Flip the current layout vertically" $ - sendMessage flipVertically + sendMessage flipVertically shiftMod $ doc "Flip the current layout horizontally" $ - sendMessage flipHorizontally + sendMessage flipHorizontally bind xK_g $ do - justMod $ - doc "Goto/Send/Etc To a workspace\n\n\t\ - - \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\ - \alphanumeric character, that's the workspace to operate on\n\n\ - - \\tThe following special characters can also reference workspaces:\n\t\t\ - \]: The next workspace, skipping those already visible.\n\t\t\ - \[: The previous workspace, skipping those already visible.\n\t\t\ - \): The next workspace.\n\t\t\ - \(: The previous workspace.\n\t\t\ - \}: The workspace on the screen to the right\n\t\t\ - \{: The workspace on the screen to the left\n\t\t\ - \: The accompaningWorkspace (toggled case)\n\t\t\ - \/: Prompt to select a window, and reference that workspace\n\t\t\ - \^: The first populated workspace\n\t\t\ - \$: The last populated workspace\n\t\t\ - \*: The hidden workspace.\n\t\t\ - \_: Black hole. Sending a window here closes it.\n\n\t\ - \Other keybindings starting with H-g\n\t\t\ - \F1: display this help.\n\n\t" $ - runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace + doc + "Goto/Send/Etc To a workspace\n\n\t\ + \Workspaces are alphanumeric characters. So if the next key typed is an\n\t\ + \alphanumeric character, that's the workspace to operate on\n\n\ + \\tThe following special characters can also reference workspaces:\n\t\t\ + \]: The next workspace, skipping those already visible.\n\t\t\ + \[: The previous workspace, skipping those already visible.\n\t\t\ + \): The next workspace.\n\t\t\ + \(: The previous workspace.\n\t\t\ + \}: The workspace on the screen to the right\n\t\t\ + \{: The workspace on the screen to the left\n\t\t\ + \: The accompaningWorkspace (toggled case)\n\t\t\ + \/: Prompt to select a window, and reference that workspace\n\t\t\ + \^: The first populated workspace\n\t\t\ + \$: The last populated workspace\n\t\t\ + \*: The hidden workspace.\n\t\t\ + \_: Black hole. Sending a window here closes it.\n\n\t\ + \Other keybindings starting with H-g\n\t\t\ + \F1: display this help.\n\n\t" + $ runMaybeT_ $ (lift . gotoWorkspaceFn) =<< readNextWorkspace controlMod $ doc "Restore the desktop marked with the next typed character." $ - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> restoreDesktop [ch] - _ -> return () + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> restoreDesktop [ch] + _ -> return () -- shiftMod $ -- doc "Swap a workspace with another workspace." $ @@ -299,12 +311,12 @@ keymap = runKeys $ do shiftMod $ doc "Restore a theater state" $ - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> restoreTheater (Just [ch]) - [' '] -> restoreTheater Nothing - _ -> return () + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> restoreTheater (Just [ch]) + [' '] -> restoreTheater Nothing + _ -> return () bind xK_n $ do justMod $ @@ -312,67 +324,66 @@ keymap = runKeys $ do withFocused $ sendMessage . toggleBanish shiftMod $ - doc "Rotate border windows" $ repeatable $ do - - bind xK_h $ do - - (justMod -|- noMod) $ - withFocused $ sendMessage . moveForward - - shiftMod $ - sendMessage (rotateBorderForward (Proxy :: Proxy Window)) - - bind xK_l $ do - - (justMod -|- noMod) $ - withFocused $ sendMessage . moveBackward - - shiftMod $ - sendMessage (rotateBorderBackward (Proxy :: Proxy Window)) - - bind xK_plus $ do - - (justMod -|- noMod) $ - sendMessage $ - changeWidth Proxy (1/24) <> - changeHeight (Proxy :: Proxy Window) (1/24) - - bind xK_minus $ do - - (justMod -|- noMod) $ - sendMessage $ - changeWidth Proxy (-1/24) <> - changeHeight (Proxy :: Proxy Window) (-1/24) + doc "Rotate border windows" $ + repeatable $ do + bind xK_h $ do + (justMod -|- noMod) $ + withFocused $ sendMessage . moveForward + + shiftMod $ + sendMessage (rotateBorderForward (Proxy :: Proxy Window)) + + bind xK_l $ do + (justMod -|- noMod) $ + withFocused $ sendMessage . moveBackward + + shiftMod $ + sendMessage (rotateBorderBackward (Proxy :: Proxy Window)) + + bind xK_plus $ do + (justMod -|- noMod) $ + sendMessage $ + changeWidth Proxy (1 / 24) + <> changeHeight (Proxy :: Proxy Window) (1 / 24) + + bind xK_minus $ do + (justMod -|- noMod) $ + sendMessage $ + changeWidth Proxy (-1 / 24) + <> changeHeight (Proxy :: Proxy Window) (-1 / 24) bind xK_d $ justMod $ - doc "Record (define) macros." $ - subkeys $ do - bind xK_w $ noMod $ - doc "Record a windowset macro" $ - runMaybeT_ readWindowsetMacro - - bind xK_t $ noMod $ - doc "Record a workspace macro" $ - runMaybeT_ readWorkspaceMacro + doc "Record (define) macros." $ + subkeys $ do + bind xK_w $ + noMod $ + doc "Record a windowset macro" $ + runMaybeT_ readWindowsetMacro + + bind xK_t $ + noMod $ + doc "Record a workspace macro" $ + runMaybeT_ readWorkspaceMacro bind xK_h $ do justMod $ doc "Focus on the next window down in the stack" $ - windows W.focusDown + windows W.focusDown shiftMod $ doc "Swap the current window with the next one down in the stack" $ - windows W.swapDown + windows W.swapDown controlMod $ - doc "Rotate all the windows down the stack" - rotAllDown + doc + "Rotate all the windows down the stack" + rotAllDown bind xK_j $ do justMod $ doc "Shrink the size of the master region" $ - sendMessage Shrink + sendMessage Shrink shiftMod $ doc "Go to the previous window in history." historyBack @@ -380,186 +391,201 @@ keymap = runKeys $ do bind xK_k $ do justMod $ doc "Expand the size of the master region" $ - sendMessage Expand + sendMessage Expand shiftMod $ doc "Go to the next window in history." historyForward bind xK_l $ do - justMod $ + justMod $ doc "Focus the next window in the stack" $ - windows W.focusUp + windows W.focusUp - shiftMod $ + shiftMod $ doc "Swap the currently focused window with the next window in the stack." $ - windows W.swapUp + windows W.swapUp controlMod $ - doc "Rotate the windows up." - rotAllUp + doc + "Rotate the windows up." + rotAllUp altMod $ doc "Lock the screen" $ - spawnX "xsecurelock" + spawnX "xsecurelock" bind xK_minus $ do - justMod $ + justMod $ doc "Decrease the number of windows in the master region." $ - sendMessage (IncMasterN (-1)) + sendMessage (IncMasterN (-1)) shiftMod $ doc "For mosaic layout, shrink the size-share of the current window" $ - sendMessage =<< shrinkPositionAlt + sendMessage =<< shrinkPositionAlt bind xK_m $ do justMod $ doc "Mark the current window with the next typed character." $ do - locs <- fromMaybe [] <$> runMaybeT readNextLocationSet - let wins = mapMaybe locationWindow locs - withBorderColor "#00ffff" wins $ do - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> markAllLocations str locs - _ -> return () + locs <- fromMaybe [] <$> runMaybeT readNextLocationSet + let wins = mapMaybe locationWindow locs + withBorderColor "#00ffff" wins $ do + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> markAllLocations str locs + _ -> return () shiftMod $ doc "Mark the current desktop with the next typed character." $ - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> saveCurrentDesktop str - _ -> return () + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> saveCurrentDesktop str + _ -> return () controlMod $ doc "Mark the current theater with the next typed character." $ - runMaybeT_ $ do - mapNextString $ \_ str -> lift $ - case str of - [ch] | isAlpha ch -> saveCurrentTheater (Just str) - _ -> return () + runMaybeT_ $ do + mapNextString $ \_ str -> lift $ + case str of + [ch] | isAlpha ch -> saveCurrentTheater (Just str) + _ -> return () bind xK_plus $ do justMod $ doc "Increase the number of windows in the master region." $ - sendMessage (IncMasterN 1) + sendMessage (IncMasterN 1) shiftMod $ doc "For mosaic layout, increase the size-share of the current window." $ - sendMessage =<< expandPositionAlt + sendMessage =<< expandPositionAlt bind xK_q $ do shiftMod $ doc "Recompile and restart XMonad" $ - spawnX "xmonad --recompile && xmonad --restart" + spawnX "xmonad --recompile && xmonad --restart" justMod $ doc "Experimental Bindings" $ - subkeys $ do - - bind xK_q $ - (justMod -|- noMod) $ - doc "EXPERIMENTAL: Move mouse to control media." $ - mouseRotateMotion (logs Info "CW") (logs Info "CCW") + subkeys $ do + bind xK_q $ + (justMod -|- noMod) $ + doc "EXPERIMENTAL: Move mouse to control media." $ + mouseRotateMotion (logs Info "CW") (logs Info "CCW") bind xK_r $ do justMod $ doc "Run a command via Rofi" runDMenu shiftMod $ doc "Rotate the current layout. (flips x, y coordinates)" $ - sendMessage rotateLayout + sendMessage rotateLayout bind xK_s $ do forM_ [(False, justMod), (True, shiftMod)] $ \(doSwap, f) -> - f $ - doc (if doSwap - then "Swap a windowset with another windowset." - else "Shift a windowset to a workspace") $ do - locations <- fromMaybe [] <$> runMaybeT readNextLocationSet - let locationWindows = mapMaybe locationWindow locations - - withBorderColor "#00ffff" locationWindows $ do - runMaybeT_ $ do - if doSwap - then do - otherWindows <- - lift $ mapMaybe locationWindow . fromMaybe [] <$> - runMaybeT readNextLocationSet - lift $ windows $ - W.swapWindows (zip locationWindows otherWindows) - else do - workspace <- readNextWorkspace - mapM_ (lift . moveLocationToWorkspaceFn workspace) locations - - lift $ setAlternateWindows locationWindows - forM_ locations $ \loc -> - case locationWindow loc of - Nothing -> return () - Just win -> do - lift $ setAlternateWorkspace win (locationWorkspace loc) + f $ + doc + ( if doSwap + then "Swap a windowset with another windowset." + else "Shift a windowset to a workspace" + ) + $ do + locations <- fromMaybe [] <$> runMaybeT readNextLocationSet + let locationWindows = mapMaybe locationWindow locations + + withBorderColor "#00ffff" locationWindows $ do + runMaybeT_ $ do + if doSwap + then do + otherWindows <- + lift $ + mapMaybe locationWindow . fromMaybe [] + <$> runMaybeT readNextLocationSet + lift $ + windows $ + W.swapWindows (zip locationWindows otherWindows) + else do + workspace <- readNextWorkspace + mapM_ (lift . moveLocationToWorkspaceFn workspace) locations + + lift $ setAlternateWindows locationWindows + forM_ locations $ \loc -> + case locationWindow loc of + Nothing -> return () + Just win -> do + lift $ setAlternateWorkspace win (locationWorkspace loc) altMod $ spawnX "sudo -A systemctl suspend && xsecurelock" bind xK_space $ do - justMod $ doc "Layout-related bindings" $ subkeys $ do - - bind xK_n $ - (noMod -|- justMod) $ doc "Use the next layout in the layout list." $ - sendMessage toNextLayout - - bind xK_p $ - (noMod -|- justMod) $ doc "Use the previous layout in the layout list." $ - sendMessage toPreviousLayout - - bind xK_b $ - (noMod -|- justMod) $ doc "Go back to the first layout in the layout list." $ - sendMessage toFirstLayout - - bind xK_h $ - (noMod -|- justMod) $ doc "Flip the layout across the horizontal axis" $ - sendMessage flipVertically - - bind xK_v $ - (noMod -|- justMod) $ doc "Flip the layout across the vertical axis" $ - sendMessage flipHorizontally - - bind xK_r $ - (noMod -|- justMod) $ doc "Rotate the layout 90 degrees" $ - sendMessage rotateLayout - - bind xK_c $ - (noMod -|- justMod) $ doc "Toggle the pop window" $ - sendMessage togglePop - - bind xK_t $ - (noMod -|- justMod) $ doc "Jump to the middle layout." $ - sendMessage (toIndexedLayout (nLayouts `div` 2)) - - bind xK_x $ - (noMod -|- justMod) $ doc "Toggle the hole" $ - sendMessage toggleHole - - let spaceResize = repeatable $ do - bind xK_bracketright $ do - noMod $ - doc "Increase the gaps between windows." $ - sendMessage $ modifyWindowBorder 5 - - bind xK_bracketleft $ do - noMod $ - doc "Decrease the gaps between windows." $ - sendMessage $ modifyWindowBorder (-5) - - bind xK_bracketleft $ noMod spaceResize - bind xK_bracketright $ noMod spaceResize + justMod $ + doc "Layout-related bindings" $ + subkeys $ do + bind xK_n $ + (noMod -|- justMod) $ + doc "Use the next layout in the layout list." $ + sendMessage toNextLayout + + bind xK_p $ + (noMod -|- justMod) $ + doc "Use the previous layout in the layout list." $ + sendMessage toPreviousLayout + + bind xK_b $ + (noMod -|- justMod) $ + doc "Go back to the first layout in the layout list." $ + sendMessage toFirstLayout + + bind xK_h $ + (noMod -|- justMod) $ + doc "Flip the layout across the horizontal axis" $ + sendMessage flipVertically + + bind xK_v $ + (noMod -|- justMod) $ + doc "Flip the layout across the vertical axis" $ + sendMessage flipHorizontally + + bind xK_r $ + (noMod -|- justMod) $ + doc "Rotate the layout 90 degrees" $ + sendMessage rotateLayout + + bind xK_c $ + (noMod -|- justMod) $ + doc "Toggle the pop window" $ + sendMessage togglePop + + bind xK_t $ + (noMod -|- justMod) $ + doc "Jump to the middle layout." $ + sendMessage (toIndexedLayout (nLayouts `div` 2)) + + bind xK_x $ + (noMod -|- justMod) $ + doc "Toggle the hole" $ + sendMessage toggleHole + + let spaceResize = repeatable $ do + bind xK_bracketright $ do + noMod $ + doc "Increase the gaps between windows." $ + sendMessage $ modifyWindowBorder 5 + + bind xK_bracketleft $ do + noMod $ + doc "Decrease the gaps between windows." $ + sendMessage $ modifyWindowBorder (-5) + + bind xK_bracketleft $ noMod spaceResize + bind xK_bracketright $ noMod spaceResize bind xK_t $ do - justMod $ + justMod $ doc "Spawn a terminal." $ spawnX (terminal config) shiftMod $ doc "Sink the current window into the tiling." $ withFocused $ windows . W.sink - altMod $ + altMod $ doc "Spawn a floating terminal" $ spawnX (terminal config ++ " -t Floating\\ Term") bind xK_v $ @@ -567,136 +593,142 @@ keymap = runKeys $ do -- respectively. justMod $ doc "Changes the volume." $ - repeatable $ do - bind xK_h $ - justMod $ - doc "Decrease volume." - decreaseVolumeDoc - - bind xK_l $ - justMod $ - doc "Increase volume." - increaseVolumeDoc - - bind xK_v $ - justMod (return () :: X ()) + repeatable $ do + bind xK_h $ + justMod $ + doc + "Decrease volume." + decreaseVolumeDoc + + bind xK_l $ + justMod $ + doc + "Increase volume." + increaseVolumeDoc + + bind xK_v $ + justMod (return () :: X ()) bind xK_x $ do justMod $ doc "Toggles respect for struts." $ - sendMessage ToggleStruts + sendMessage ToggleStruts bind xK_z $ do - justMod $ doc "Less often used keybindings." $ - subkeys $ do - - bind xK_p $ do - (justMod -|- noMod) $ - doc "Go to the prior window in the history" historyBack - - bind xK_t $ do - (justMod -|- noMod) (logs Info "Test Log" :: X ()) - - -- bind xK_n $ do - -- (justMod -|- noMod) $ - -- doc "Take a note" $ - -- spawnX (terminal config ++ " -t Notes -e notes new") - bind xK_n $ do - (justMod -|- noMod) $ - doc "Go to the next window in the history" historyForward - - bind xK_c $ do - shiftMod $ - doc "Kill all other copies of a window." - CopyWindow.killAllOtherCopies - - bind xK_e $ do - (justMod -|- noMod) $ - doc "Select an emoji" $ - spawnX "emoji-select.sh" - - (shiftMod -|- rawMask shiftMask) $ - doc "Select an emoticon" $ - spawnX "emoticon-select.sh" - - bind xK_a $ - (justMod -|- noMod) $ - doc "Move the audio sink for an application." $ - spawnX "set-sink.sh" - - bind xK_w $ - (justMod -|- noMod) $ - doc "Select a network to connect to." $ - spawnX "networkmanager_dmenu" - - bind xK_o $ - (justMod -|- noMod) $ - doc "Open a file from the library" $ - spawnX "library-view.sh" - - bind xK_s $ - (justMod -|- noMod) $ - doc "Toggle the ability for terminals to swallow child windows." - toggleSwallowEnabled - - bind xK_v $ do - (justMod -|- noMod) $ - doc "Set the volume via rofi." $ - spawnX "set-volume.sh" - (shiftMod -|- rawMask shiftMask) $ - doc "Set the volume of an application via rofi." $ - spawnX "set-volume.sh -a" - - let navigateHistory = repeatable $ do - bind xK_bracketright $ do - noMod $ - doc "Move forward in location history" historyForward - - bind xK_bracketleft $ do - noMod $ - doc "Move backward in location history" historyBack - - bind xK_bracketleft $ noMod $ - doc "Move forward in location history" navigateHistory - bind xK_bracketright $ noMod $ - doc "Move backward in location history" navigateHistory - - -- Double-tap Z to toggle zoom. - bind xK_z $ do - noMod -|- justMod $ - doc "Toggle zoom on the current window." $ - sendMessage togglePop - - -- Z is reserved to create sub keybindings to do various things. - -- I don't really use these at the moment. - bind xK_h $ noMod mediaPrevDoc - bind xK_j $ noMod playPauseDoc - bind xK_l $ noMod mediaNextDoc + subkeys $ do + bind xK_p $ do + (justMod -|- noMod) $ + doc "Go to the prior window in the history" historyBack + + bind xK_t $ do + (justMod -|- noMod) (logs Info "Test Log" :: X ()) + + -- bind xK_n $ do + -- (justMod -|- noMod) $ + -- doc "Take a note" $ + -- spawnX (terminal config ++ " -t Notes -e notes new") + bind xK_n $ do + (justMod -|- noMod) $ + doc "Go to the next window in the history" historyForward + + bind xK_c $ do + shiftMod $ + doc + "Kill all other copies of a window." + CopyWindow.killAllOtherCopies + + bind xK_e $ do + (justMod -|- noMod) $ + doc "Select an emoji" $ + spawnX "emoji-select.sh" + + (shiftMod -|- rawMask shiftMask) $ + doc "Select an emoticon" $ + spawnX "emoticon-select.sh" + + bind xK_a $ + (justMod -|- noMod) $ + doc "Move the audio sink for an application." $ + spawnX "set-sink.sh" + + bind xK_w $ + (justMod -|- noMod) $ + doc "Select a network to connect to." $ + spawnX "networkmanager_dmenu" + + bind xK_o $ + (justMod -|- noMod) $ + doc "Open a file from the library" $ + spawnX "library-view.sh" + + bind xK_s $ + (justMod -|- noMod) $ + doc + "Toggle the ability for terminals to swallow child windows." + toggleSwallowEnabled + + bind xK_v $ do + (justMod -|- noMod) $ + doc "Set the volume via rofi." $ + spawnX "set-volume.sh" + (shiftMod -|- rawMask shiftMask) $ + doc "Set the volume of an application via rofi." $ + spawnX "set-volume.sh -a" + + let navigateHistory = repeatable $ do + bind xK_bracketright $ do + noMod $ + doc "Move forward in location history" historyForward + + bind xK_bracketleft $ do + noMod $ + doc "Move backward in location history" historyBack + + bind xK_bracketleft $ + noMod $ + doc "Move forward in location history" navigateHistory + bind xK_bracketright $ + noMod $ + doc "Move backward in location history" navigateHistory + + -- Double-tap Z to toggle zoom. + bind xK_z $ do + noMod -|- justMod $ + doc "Toggle zoom on the current window." $ + sendMessage togglePop + + -- Z is reserved to create sub keybindings to do various things. + -- I don't really use these at the moment. + bind xK_h $ noMod mediaPrevDoc + bind xK_j $ noMod playPauseDoc + bind xK_l $ noMod mediaNextDoc -- Centers the current focused window. i.e. toggles the Zoom layout -- modifier. shiftMod $ doc "Toggle zoom on the current window." $ - sendMessage togglePop + sendMessage togglePop bind xK_F8 $ do justMod $ do ll <- getLogLevel let next = if minBound == ll then maxBound else pred ll - safeSpawnX "notify-send" + safeSpawnX + "notify-send" ["-t", "2000", printf "LogLevel set to %s" (show next)] setLogLevel next logs next "LogLevel set to %s." (show next) shiftMod $ do ss <- withWindowSet return - logs Info "Current Stack Set:%s" + logs + Info + "Current Stack Set:%s" (show $ viaShow $ W.mapLayout (const ()) ss) - bind xF86XK_Calculator $ do noMod $ spawnX $ terminal config ++ " -t Floating\\ Term -e /usr/bin/env python3" @@ -738,20 +770,22 @@ mouseMap = runButtons $ do let x button = Map.lookup button (mouseMap config) - let defaultButtons button = fromMaybe (\w -> return ()) $ + let defaultButtons button = + fromMaybe (\w -> return ()) $ 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 + 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 + ( 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 @@ -777,80 +811,83 @@ mouseMap = runButtons $ do justMod $ noWindow mediaNext bind button14 $ do - noMod $ subMouse $ do - - bind button3 $ - noMod $ noWindow (gotoWorkspace "s") - - bind button13 $ do - noMod $ noWindow $ click >> CopyWindow.kill1 - - - bind button14 $ do - noMod $ noWindow $ click >> sendMessage togglePop - - bind button15 $ do - noMod $ noWindow $ spawnX "pavucontrol" - - let mediaButtons = [ - (button4, increaseVolume), - (button5, decreaseVolume), - (button2, playPause), - (button9, historyForward), - (button8, historyBack), - (button6, mediaPrev), - (button7, mediaNext) - ] - - forM_ (map fst mediaButtons) $ \b -> - bind b $ noMod $ continuous mediaButtons b - - bind button13 $ noMod $ subMouse $ do - bind button1 $ noMod mouseMoveWindow - bind button2 $ noMod $ windows . W.sink - bind button3 $ noMod mouseResizeWindow - - let swapButtons = [ - (button6, windows W.swapDown), - (button7, windows W.swapUp) - ] - - forM_ (map fst swapButtons) $ \b -> - bind b $ noMod $ \w -> click >> continuous swapButtons b w - - bind button13 $ noMod $ subMouse $ do - bind button13 $ noMod $ subMouse $ do - bind button13 $ noMod $ noWindow $ spawnX "xsecurelock" - bind button1 $ noMod $ noWindow $ - spawnX "sudo -A systemctl suspend && xsecurelock" + noMod $ + subMouse $ do + bind button3 $ + noMod $ noWindow (gotoWorkspace "s") + + bind button13 $ do + noMod $ noWindow $ click >> CopyWindow.kill1 + + bind button14 $ do + noMod $ noWindow $ click >> sendMessage togglePop + + bind button15 $ do + noMod $ noWindow $ spawnX "pavucontrol" + + let mediaButtons = + [ (button4, increaseVolume), + (button5, decreaseVolume), + (button2, playPause), + (button9, historyForward), + (button8, historyBack), + (button6, mediaPrev), + (button7, mediaNext) + ] + + forM_ (map fst mediaButtons) $ \b -> + bind b $ noMod $ continuous mediaButtons b + + bind button13 $ + noMod $ + subMouse $ do + bind button1 $ noMod mouseMoveWindow + bind button2 $ noMod $ windows . W.sink + bind button3 $ noMod mouseResizeWindow + + let swapButtons = + [ (button6, windows W.swapDown), + (button7, windows W.swapUp) + ] + + forM_ (map fst swapButtons) $ \b -> + bind b $ noMod $ \w -> click >> continuous swapButtons b w + + bind button13 $ + noMod $ + subMouse $ do + bind button13 $ + noMod $ + subMouse $ do + bind button13 $ noMod $ noWindow $ spawnX "xsecurelock" + bind button1 $ + noMod $ + noWindow $ + spawnX "sudo -A systemctl suspend && xsecurelock" bind button15 $ do - - noMod $ subMouse $ do - bind button13 $ - noMod $ - noWindow $ - gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace - - bind button15 $ do - noMod $ noWindow jumpToLastLocation - - - let workspaceButtons = [ - (button2, swapMaster), - - (button9, viewAdjacent next), - (button8, viewAdjacent prev), - - (button4, windows W.focusUp), - (button5, windows W.focusDown), - - (button7, windows W.screenRotateForward), - (button6, windows W.screenRotateBackward) - ] - - forM_ (map fst workspaceButtons) $ \b -> - bind b $ noMod $ continuous workspaceButtons b + noMod $ + subMouse $ do + bind button13 $ + noMod $ + noWindow $ + gotoWorkspace . accompaningWorkspace =<< getCurrentWorkspace + + bind button15 $ do + noMod $ noWindow jumpToLastLocation + + let workspaceButtons = + [ (button2, swapMaster), + (button9, viewAdjacent next), + (button8, viewAdjacent prev), + (button4, windows W.focusUp), + (button5, windows W.focusDown), + (button7, windows W.screenRotateForward), + (button6, windows W.screenRotateBackward) + ] + + forM_ (map fst workspaceButtons) $ \b -> + bind b $ noMod $ continuous workspaceButtons b -- Bindings specific to a window. These are set similarly to th ekeymap above, -- but uses a Query monad to tell which windows the keys will apply to. @@ -861,7 +898,6 @@ mouseMap = runButtons $ do windowSpecificBindings :: XConfig l -> WriterT (Map (KeyMask, KeySym) (X ())) Query () windowSpecificBindings config = do - w <- lift ask let mods = permuteMods [shiftMask, controlMask, 0] @@ -869,7 +905,6 @@ windowSpecificBindings config = do emitKey = flip sendKey w configureIf (flip elem (browsers ++ spotify) <$> className) $ do - bind xK_h $ do rawMask controlMask $ emitKey (0, xK_BackSpace) forM_ mods $ \mask -> @@ -881,14 +916,13 @@ windowSpecificBindings config = do bind xK_c $ forM_ mods $ \mask -> - rawMask (altMask .|.mask) $ emitKey (mask, xK_Up) + rawMask (altMask .|. mask) $ emitKey (mask, xK_Up) bind xK_n $ forM_ mods $ \mask -> rawMask (altMask .|. mask) $ emitKey (mask, xK_Right) configureIf (flip elem browsers <$> className) $ do - -- if the window is a browser, configure these bindings. Lots of browsers -- make up their own garbage bindings that are not standard across many -- other applications. This alleviates the issue. @@ -909,7 +943,6 @@ windowSpecificBindings config = do -- -- Ctrl+d -> Delete current tab. - bind xK_u $ rawMask con