diff options
Diffstat (limited to 'src/Rahm/Desktop/Keys')
| -rw-r--r-- | src/Rahm/Desktop/Keys/Dsl.hs | 182 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Keys/Wml.hs | 351 |
2 files changed, 272 insertions, 261 deletions
diff --git a/src/Rahm/Desktop/Keys/Dsl.hs b/src/Rahm/Desktop/Keys/Dsl.hs index 55912f8..adb2668 100644 --- a/src/Rahm/Desktop/Keys/Dsl.hs +++ b/src/Rahm/Desktop/Keys/Dsl.hs @@ -1,27 +1,28 @@ -- Domain-specific language for configuring key/button bindings. module Rahm.Desktop.Keys.Dsl where -import Data.List -import Data.Bits ((.&.)) -import Control.Monad.Writer -import Text.Printf -import Control.Arrow (second, first) +import Control.Arrow (first, second) import Control.Monad (void) -import Control.Monad.State (State(..), modify', get, execState) -import XMonad +import Control.Monad.State (State (..), execState, get, modify') +import Control.Monad.Writer +import Data.Bits ((.&.)) +import Data.List import Data.Map (Map) import qualified Data.Map as Map +import Text.Printf +import XMonad data Documented t = Documented String t -data KeyBinding = - Action (X ()) | - Submap KeyBindings | - Repeat KeyBindings +data KeyBinding + = Action (X ()) + | Submap KeyBindings + | Repeat KeyBindings type KeyBindings = Map (KeyMask, KeySym) (Documented KeyBinding) type ButtonBinding = Window -> X () + type ButtonBindings = Map (KeyMask, Button) ButtonBinding {- Module that defines a DSL for binding keys. -} @@ -42,13 +43,14 @@ class Bindable k where type BindableMonad k :: (* -> *) -> * -> * bind :: k -> BindingBuilder (BindableValue k) a -> BindableMonad k l () - -- section :: String -> BindableMonad k l () -> BindableMonad k l () + +-- section :: String -> BindableMonad k l () -> BindableMonad k l () class Binding k b where toB :: k -> b rawMask :: KeyMask -> k -> BindingBuilder b () - rawMask m x = BindingBuilder $ modify' (second ((m, toB x):)) + rawMask m x = BindingBuilder $ modify' (second ((m, toB x) :)) instance Binding (X ()) (Documented KeyBinding) where toB = Documented "" . Action @@ -112,9 +114,10 @@ instance Bindable KeySym where m <- modMask <$> getConfig let (_, values) = execState stM (m, []) - KeysM $ modify' $ second $ - flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values)) - + KeysM $ + modify' $ + second $ + flip (<>) (Map.fromList (map (\(m, v) -> ((m, key), v)) values)) instance Bindable Button where type BindableValue Button = ButtonBinding @@ -125,8 +128,10 @@ instance Bindable Button where m <- modMask <$> getConfig let (_, values) = execState stM (m, []) - ButtonsM $ modify' $ second $ - flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values)) + ButtonsM $ + modify' $ + second $ + flip (<>) (Map.fromList (map (\(m, v) -> ((m, button), v)) values)) shiftControlAltSuperHyperAltgrMod :: (Binding k b) => k -> BindingBuilder b () shiftControlAltSuperHyperAltgrMod = @@ -376,10 +381,12 @@ altgrMod = maskMod altgrMask {- Can combine two or more of the functions above to apply the same action to - multiple masks. -} -(-|-) :: (Binding k b) => - (k -> BindingBuilder b ()) -> - (k -> BindingBuilder b ()) -> - k -> BindingBuilder b () +(-|-) :: + (Binding k b) => + (k -> BindingBuilder b ()) -> + (k -> BindingBuilder b ()) -> + k -> + BindingBuilder b () (-|-) fn1 fn2 f = fn1 f >> fn2 f {- Meant for submapping, binds all alphanumeric charactes to (fn c). -} @@ -392,63 +399,65 @@ mapNumbersAndAlpha km fn = do - pressed and fn is the function provided. -} mapNumbers :: KeyMask -> (Char -> X ()) -> KeysM l () mapNumbers km fn = do - mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) - [ (xK_0, '0') - , (xK_1, '1') - , (xK_2, '2') - , (xK_3, '3') - , (xK_4, '4') - , (xK_5, '5') - , (xK_6, '6') - , (xK_7, '7') - , (xK_8, '8') - , (xK_9, '9') - -- Programmer Dvorak shifts the numbers so I have to map to their unshifted - -- form. - , (xK_bracketright, '6') - , (xK_exclam, '8') - , (xK_bracketleft, '7') - , (xK_braceleft, '5') - , (xK_braceright, '3') - , (xK_parenleft, '1') - , (xK_equal, '9') - , (xK_asterisk, '0') - , (xK_parenright, '2') - , (xK_plus, '4') ] + mapM_ + (\(key, ch) -> bind key $ rawMask km (fn ch)) + [ (xK_0, '0'), + (xK_1, '1'), + (xK_2, '2'), + (xK_3, '3'), + (xK_4, '4'), + (xK_5, '5'), + (xK_6, '6'), + (xK_7, '7'), + (xK_8, '8'), + (xK_9, '9'), + -- Programmer Dvorak shifts the numbers so I have to map to their unshifted + -- form. + (xK_bracketright, '6'), + (xK_exclam, '8'), + (xK_bracketleft, '7'), + (xK_braceleft, '5'), + (xK_braceright, '3'), + (xK_parenleft, '1'), + (xK_equal, '9'), + (xK_asterisk, '0'), + (xK_parenright, '2'), + (xK_plus, '4') + ] {- Meant for submapping. This binds all alpha charactes to (fn c) where c is the - character pressed and fn is the function provided. -} mapAlpha :: KeyMask -> (Char -> X ()) -> KeysM l () mapAlpha km fn = - mapM_ (\(key, ch) -> bind key $ rawMask km (fn ch)) [ - (xK_a, 'a') - , (xK_b, 'b') - , (xK_c, 'c') - , (xK_d, 'd') - , (xK_e, 'e') - , (xK_f, 'f') - , (xK_g, 'g') - , (xK_h, 'h') - , (xK_i, 'i') - , (xK_j, 'j') - , (xK_k, 'k') - , (xK_l, 'l') - , (xK_m, 'm') - , (xK_n, 'n') - , (xK_o, 'o') - , (xK_p, 'p') - , (xK_q, 'q') - , (xK_r, 'r') - , (xK_s, 's') - , (xK_t, 't') - , (xK_u, 'u') - , (xK_v, 'v') - , (xK_w, 'w') - , (xK_x, 'x') - , (xK_y, 'y') - , (xK_z, 'z') - ] - + mapM_ + (\(key, ch) -> bind key $ rawMask km (fn ch)) + [ (xK_a, 'a'), + (xK_b, 'b'), + (xK_c, 'c'), + (xK_d, 'd'), + (xK_e, 'e'), + (xK_f, 'f'), + (xK_g, 'g'), + (xK_h, 'h'), + (xK_i, 'i'), + (xK_j, 'j'), + (xK_k, 'k'), + (xK_l, 'l'), + (xK_m, 'm'), + (xK_n, 'n'), + (xK_o, 'o'), + (xK_p, 'p'), + (xK_q, 'q'), + (xK_r, 'r'), + (xK_s, 's'), + (xK_t, 't'), + (xK_u, 'u'), + (xK_v, 'v'), + (xK_w, 'w'), + (xK_x, 'x'), + (xK_y, 'y'), + (xK_z, 'z') + ] documentation :: KeyBindings -> String documentation = execWriter . document' "" @@ -467,8 +476,8 @@ documentation = execWriter . document' "" keyBindingsToList :: KeyBindings -> Map String (KeyBinding, [(KeyMask, KeySym)]) keyBindingsToList b = - (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) <$> - group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b) + (\list -> ((\(_, Documented _ t) -> t) (head list), map fst list)) + <$> group (\(_, Documented doc _) -> doc) (sortOn (snd . fst) $ Map.toList b) prettyShow :: (KeyMask, KeySym) -> String prettyShow (mask, key) = printf "%s%s" (showMask mask) (keysymToString key) @@ -477,20 +486,17 @@ documentation = execWriter . document' "" Action _ -> False _ -> True - showMask :: KeyMask -> String showMask mask = - let masks = [(shiftMask, "S"), - (altMask, "A"), - (mod3Mask, "H"), - (mod4Mask, "M"), - (altgrMask, "AGr"), - (controlMask, "C")] in - - concatMap ((++"-") . snd) $ filter ((/=0) . (.&.mask) . fst) masks - + let masks = + [ (shiftMask, "S"), + (altMask, "A"), + (mod3Mask, "H"), + (mod4Mask, "M"), + (altgrMask, "AGr"), + (controlMask, "C") + ] + in concatMap ((++ "-") . snd) $ filter ((/= 0) . (.&. mask) . fst) masks group :: (Ord b) => (a -> b) -> [a] -> Map b [a] group fn = Map.fromListWith (++) . map (first fn . (\a -> (a, [a]))) - - diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index 7cff173..1c8d073 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -14,161 +14,159 @@ -- \%@s // All windows except those on workspace 's' module Rahm.Desktop.Keys.Wml where -import qualified XMonad.Util.ExtensibleState as XS +import Control.Monad (forM_, join, unless) +import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Control.Monad.Trans.State as S -import Control.Monad.Trans.Class -import Control.Monad (join, forM_, unless) -import Data.List (sortOn, intercalate) -import Data.Ord (Down(..)) -import Data.Typeable (cast) -import XMonad.Prompt.ConfirmPrompt (confirmPrompt) -import System.Exit (exitWith, ExitCode(..)) - -import qualified Data.Map as Map -import Data.Map (Map) -import Data.Char (isAlphaNum, isAlpha, isDigit, ord) -import Data.Maybe (fromMaybe, catMaybes) -import XMonad.Actions.CopyWindow as CopyWindow -import XMonad.Util.Run (safeSpawn) -import Prelude hiding (head, last) +import Data.Char (isAlpha, isAlphaNum, isDigit, ord) +import Data.List (intercalate, sortOn) import Data.List.Safe (head, last) -import qualified Rahm.Desktop.StackSet as W - +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes, fromMaybe) +import Data.Ord (Down (..)) +import Data.Typeable (cast) import Rahm.Desktop.Common -import Rahm.Desktop.Keys.Dsl import Rahm.Desktop.History +import Rahm.Desktop.Keys.Dsl +import Rahm.Desktop.Logger import Rahm.Desktop.Marking -import Rahm.Desktop.Workspaces +import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.Submap -import Rahm.Desktop.Logger - +import Rahm.Desktop.Workspaces +import System.Exit (ExitCode (..), exitWith) import Text.Printf - import XMonad +import XMonad.Actions.CopyWindow as CopyWindow +import XMonad.Prompt.ConfirmPrompt (confirmPrompt) +import qualified XMonad.Util.ExtensibleState as XS +import XMonad.Util.Run (safeSpawn) +import Prelude hiding (head, last) type KeyString = [(KeyMask, KeySym, String)] -data Macros = Macros { - workspaceMacros :: Map (KeyMask, KeySym) KeyString -, windowsetMacros :: Map (KeyMask, KeySym) KeyString -} deriving (Read, Show) +data Macros = Macros + { workspaceMacros :: Map (KeyMask, KeySym) KeyString, + windowsetMacros :: Map (KeyMask, KeySym) KeyString + } + deriving (Read, Show) instance ExtensionClass Macros where initialValue = Macros Map.empty Map.empty extensionType = PersistentExtension -data Workspace = - forall a. (Typeable a) => Workspace { - moveLocationToWorkspaceFn :: Location -> X () - , gotoWorkspaceFn :: X () - , workspaceName :: Maybe String - , extraWorkspaceData :: a +data Workspace = forall a. + (Typeable a) => + Workspace + { moveLocationToWorkspaceFn :: Location -> X (), + gotoWorkspaceFn :: X (), + workspaceName :: Maybe String, + extraWorkspaceData :: a } readWorkspaceMacro :: MaybeT X () readWorkspaceMacro = mapNextStringWithKeysym $ \mask sym _ -> do macro <- readMacroString - lift $ XS.modify $ \m -> m { - workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m) } + lift $ + XS.modify $ \m -> + m + { workspaceMacros = Map.insert (mask, sym) macro (workspaceMacros m) + } readWindowsetMacro :: MaybeT X () readWindowsetMacro = mapNextStringWithKeysym $ \mask sym _ -> do macro <- readMacroString - lift $ XS.modify $ \m -> m { - windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m) } + lift $ + XS.modify $ \m -> + m + { windowsetMacros = Map.insert (mask, sym) macro (windowsetMacros m) + } readMacroString :: MaybeT X KeyString readMacroString = do mapNextStringWithKeysym $ \m k s -> case (m, k, s) of - _ | k == xK_Return -> return [] - _ | k == xK_Escape -> MaybeT $ return Nothing - r -> ([r]++) <$> readMacroString + _ | k == xK_Return -> return [] + _ | k == xK_Escape -> MaybeT $ return Nothing + r -> ([r] ++) <$> readMacroString justWorkspace :: String -> Workspace justWorkspace s = - Workspace { - moveLocationToWorkspaceFn = flip moveLocationToWorkspace s - , gotoWorkspaceFn = gotoWorkspace s - , workspaceName = Just s - , extraWorkspaceData = () - } + Workspace + { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s, + gotoWorkspaceFn = gotoWorkspace s, + workspaceName = Just s, + extraWorkspaceData = () + } justWorkspaceWithPreferredWindow :: Window -> String -> Workspace justWorkspaceWithPreferredWindow w s = - Workspace { - moveLocationToWorkspaceFn = flip moveLocationToWorkspace s - , gotoWorkspaceFn = do - windows $ \ws' -> - let ws = W.greedyView s ws' - l = W.integrate' $ W.stack $ W.workspace $ W.current ws in - if w `elem` l - then W.focusWindow w ws - else ws - - , workspaceName = Just s - , extraWorkspaceData = () - } + Workspace + { moveLocationToWorkspaceFn = flip moveLocationToWorkspace s, + gotoWorkspaceFn = do + windows $ \ws' -> + let ws = W.greedyView s ws' + l = W.integrate' $ W.stack $ W.workspace $ W.current ws + in if w `elem` l + then W.focusWindow w ws + else ws, + workspaceName = Just s, + extraWorkspaceData = () + } blackHoleWorkspace :: Workspace blackHoleWorkspace = - Workspace { - moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow - , gotoWorkspaceFn = - confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess) - , workspaceName = Nothing - , extraWorkspaceData = () - } + Workspace + { moveLocationToWorkspaceFn = mapM_ killWindow . locationWindow, + gotoWorkspaceFn = + confirmPrompt def "Do you want to exit xmonad" $ io (exitWith ExitSuccess), + workspaceName = Nothing, + extraWorkspaceData = () + } alternateWorkspace :: Workspace alternateWorkspace = - Workspace { - moveLocationToWorkspaceFn = \l@(Location _ maybeWin) -> do - logs Info "Moving Location: %s" (show l) - case maybeWin of - Nothing -> return () - Just win -> do - alter <- getAlternateWorkspace win - logs Info "Moving %s to %s" (show win) (show alter) - mapM_ (moveLocationToWorkspace l) alter - - , gotoWorkspaceFn = do - (Location _ maybeWin) <- getCurrentLocation - case maybeWin of - Nothing -> return () - Just win -> do - mapM_ gotoWorkspace =<< getAlternateWorkspace win - - , workspaceName = Nothing - , extraWorkspaceData = () - } + Workspace + { moveLocationToWorkspaceFn = \l@(Location _ maybeWin) -> do + logs Info "Moving Location: %s" (show l) + case maybeWin of + Nothing -> return () + Just win -> do + alter <- getAlternateWorkspace win + logs Info "Moving %s to %s" (show win) (show alter) + mapM_ (moveLocationToWorkspace l) alter, + gotoWorkspaceFn = do + (Location _ maybeWin) <- getCurrentLocation + case maybeWin of + Nothing -> return () + Just win -> do + mapM_ gotoWorkspace =<< getAlternateWorkspace win, + workspaceName = Nothing, + extraWorkspaceData = () + } newtype FloatWorkspace = FloatWorkspace Workspace floatWorkspace :: Workspace -> Workspace -floatWorkspace ws@Workspace { extraWorkspaceData = d } = - Workspace { - moveLocationToWorkspaceFn = \location -> do - - forM_ (locationWindow location) $ \win -> do - case cast d of - Just (FloatWorkspace ws') -> do - windows $ W.sink win - moveLocationToWorkspaceFn ws' location - Nothing -> do - windows $ \ss -> - if win `Map.member` W.floating ss - then ss -- win is already floating - else W.float win (W.RationalRect (1/8) (1/8) (6/8) (6/8)) ss - moveLocationToWorkspaceFn ws location - - - , gotoWorkspaceFn = gotoWorkspaceFn ws - , workspaceName = workspaceName ws - , extraWorkspaceData = FloatWorkspace ws - } +floatWorkspace ws@Workspace {extraWorkspaceData = d} = + Workspace + { moveLocationToWorkspaceFn = \location -> do + forM_ (locationWindow location) $ \win -> do + case cast d of + Just (FloatWorkspace ws') -> do + windows $ W.sink win + moveLocationToWorkspaceFn ws' location + Nothing -> do + windows $ \ss -> + if win `Map.member` W.floating ss + then ss -- win is already floating + else W.float win (W.RationalRect (1 / 8) (1 / 8) (6 / 8) (6 / 8)) ss + moveLocationToWorkspaceFn ws location, + gotoWorkspaceFn = gotoWorkspaceFn ws, + workspaceName = workspaceName ws, + extraWorkspaceData = FloatWorkspace ws + } joinMaybe :: (Monad m) => MaybeT m (Maybe a) -> MaybeT m a joinMaybe (MaybeT ma) = MaybeT $ join <$> ma @@ -186,8 +184,8 @@ instance KeyFeeder X where fromX = id readNextKey = mapNextStringWithKeysym -newtype FeedKeys a = FeedKeys { unFeedKeys :: StateT KeyString X a } - deriving (Monad, Functor, Applicative) +newtype FeedKeys a = FeedKeys {unFeedKeys :: StateT KeyString X a} + deriving (Monad, Functor, Applicative) instance KeyFeeder FeedKeys where fromX = FeedKeys . lift @@ -195,7 +193,7 @@ instance KeyFeeder FeedKeys where readNextKey fn = do ls <- lift $ FeedKeys S.get case ls of - ((mask, sym, str):t) -> do + ((mask, sym, str) : t) -> do lift $ FeedKeys $ S.put t fn mask sym str _ -> MaybeT (return Nothing) @@ -234,32 +232,37 @@ readNextWorkspace = readNextKey $ \mask sym str -> case (mask, sym, str) of (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing - (_, _, [ch]) | isAlphaNum ch || ch == '*' -> return $ justWorkspace [ch] (_, _, "[") -> - justWorkspace <$> - (lift1 (adjacentWorkspaceNotVisible prev) =<< - readNextWorkspaceName) + justWorkspace + <$> ( lift1 (adjacentWorkspaceNotVisible prev) + =<< readNextWorkspaceName + ) (_, _, "]") -> - justWorkspace <$> - (lift1 (adjacentWorkspaceNotVisible next) =<< - readNextWorkspaceName) + justWorkspace + <$> ( lift1 (adjacentWorkspaceNotVisible next) + =<< readNextWorkspaceName + ) (_, _, "(") -> - justWorkspace <$> - (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName) + justWorkspace + <$> (lift1 (adjacentWorkspace prev) =<< readNextWorkspaceName) (_, _, ")") -> - justWorkspace <$> - (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName) - (_, _, "^") -> mapMaybeT fromX $ MaybeT $ - withWindowSet $ \ws -> return $ - (fmap (justWorkspace . W.tag . W.workspace . snd) . head) - (getHorizontallyOrderedScreens ws) + justWorkspace + <$> (lift1 (adjacentWorkspace next) =<< readNextWorkspaceName) + (_, _, "^") -> mapMaybeT fromX $ + MaybeT $ + withWindowSet $ \ws -> + return $ + (fmap (justWorkspace . W.tag . W.workspace . snd) . head) + (getHorizontallyOrderedScreens ws) (_, _, "'") -> fromMaybeTX $ justWorkspace . locationWorkspace <$> MaybeT lastLocation (_, _, ".") -> mt $ justWorkspace <$> getCurrentWorkspace - (_, _, "$") -> MaybeT $ fromX $ - withWindowSet $ \ws -> return $ - (fmap (justWorkspace . W.tag . W.workspace . snd) . last) - (getHorizontallyOrderedScreens ws) + (_, _, "$") -> MaybeT $ + fromX $ + withWindowSet $ \ws -> + return $ + (fmap (justWorkspace . W.tag . W.workspace . snd) . last) + (getHorizontallyOrderedScreens ws) (_, _, ":") -> floatWorkspace <$> readNextWorkspace (_, _, ",") -> do ws <- readNextWorkspace @@ -268,10 +271,9 @@ readNextWorkspace = map (W.tag . W.workspace . snd) <$> withWindowSet (return . getHorizontallyOrderedScreens) - let (_, rest) = break ((==workspaceName ws) . Just) (screens ++ screens) + let (_, rest) = break ((== workspaceName ws) . Just) (screens ++ screens) justWorkspace <$> MaybeT (return $ head $ tail rest) - (_, _, ";") -> do ws <- readNextWorkspace screens <- @@ -279,25 +281,24 @@ readNextWorkspace = map (W.tag . W.workspace . snd) <$> withWindowSet (return . getHorizontallyOrderedScreens) - let (front, _) = break ((==workspaceName ws) . Just) (screens ++ screens) + let (front, _) = break ((== workspaceName ws) . Just) (screens ++ screens) justWorkspace <$> MaybeT (return $ last front) - (_, _, "/") -> fromMaybeTX $ do - justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head=<<) <$> askWindowId)) - + justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head =<<) <$> askWindowId)) (_, _, "@") -> do loc <- readNextLocationSet - MaybeT $ fromX $ withWindowSet $ \ws -> return $ do - win <- locationWindow =<< head loc - winLocation <- W.findWindow ws win - (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation - + MaybeT $ + fromX $ + withWindowSet $ \ws -> return $ do + win <- locationWindow =<< head loc + winLocation <- W.findWindow ws win + (justWorkspaceWithPreferredWindow win . W.tag) <$> W.getLocationWorkspace winLocation (_, _, "~") -> justWorkspace . accompaningWorkspace <$> readNextWorkspaceName - (_, _, " ") -> mt $ - justWorkspace . accompaningWorkspace <$> getCurrentWorkspace - + (_, _, " ") -> + mt $ + justWorkspace . accompaningWorkspace <$> getCurrentWorkspace (_, _, "_") -> return blackHoleWorkspace (_, _, "-") -> return alternateWorkspace (_, _, "=") -> do @@ -311,7 +312,6 @@ readNextWorkspace = if workspaceName ws1 == workspaceName ws2 then ws3 else ws4 - (_, _, "?") -> do l1 <- readNextLocationSet @@ -324,7 +324,6 @@ readNextWorkspace = if null l1 then ws2 else ws1 - (mask, keysym, _) -> do macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . workspaceMacros <$> XS.get) fromMaybeTX $ workspaceForKeysT macro @@ -337,41 +336,46 @@ readNextLocationSet = readNextKey $ \mask sym str -> case (mask, sym, str) of (_, e, _) | e == xK_Escape -> MaybeT $ return Nothing - (_, _, [ch]) | isAlpha ch -> mt $ getMarkedLocations [ch] - (_, _, "0") -> (:[]) <$> MaybeT (fromX getMostRecentLocationInHistory) - (_, _, [ch]) | isDigit ch -> - (:[]) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30)) - (_, _, ".") -> (:[]) <$> mt getCurrentLocation - (_, _, "^") -> (:[]) <$> fromMaybeTX farLeftWindow - (_, _, "$") -> (:[]) <$> fromMaybeTX farRightWindow - (_, _, "\"") -> (:[]) <$> MaybeT (fromX nextLocation) - (_, _, "'") -> (:[]) <$> MaybeT (fromX lastLocation) - (_, _, "*") -> mt $ do -- All visible windows. - wins <- withWindowSet $ - return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens + (_, _, "0") -> (: []) <$> MaybeT (fromX getMostRecentLocationInHistory) + (_, _, [ch]) + | isDigit ch -> + (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30)) + (_, _, ".") -> (: []) <$> mt getCurrentLocation + (_, _, "^") -> (: []) <$> fromMaybeTX farLeftWindow + (_, _, "$") -> (: []) <$> fromMaybeTX farRightWindow + (_, _, "\"") -> (: []) <$> MaybeT (fromX nextLocation) + (_, _, "'") -> (: []) <$> MaybeT (fromX lastLocation) + (_, _, "*") -> mt $ do + -- All visible windows. + wins <- + withWindowSet $ + return . concatMap (W.integrate' . W.stack . W.workspace) . W.screens catMaybes <$> mapM (runMaybeT . windowLocation) wins - - (_, _, "-") -> fromMaybeTX $ - mapM windowLocation =<< lift getAlternateWindows - (_, _, "/") -> fromMaybeTX $ - mapM windowLocation =<< MaybeT askWindowId + (_, _, "-") -> + fromMaybeTX $ + mapM windowLocation =<< lift getAlternateWindows + (_, _, "/") -> + fromMaybeTX $ + mapM windowLocation =<< MaybeT askWindowId (_, _, "%") -> fromMaybeTX $ do ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows)) - lift $ logs Info "allWindows %s" (intercalate "\n" (map show ret)) + lift $ logs Info "allWindows %s" (intercalate "\n" (map show ret)) return ret - (_, _, s) | s == "\t" || s == "@" || s == "\n" -> - (mt . windowsInWorkspace) =<< readNextWorkspaceName - (_, _, "!") -> (:[]) <$> joinMaybe (head <$> readNextLocationSet) + (_, _, s) + | s == "\t" || s == "@" || s == "\n" -> + (mt . windowsInWorkspace) =<< readNextWorkspaceName + (_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet) (_, _, ",") -> tail <$> readNextLocationSet (_, _, "~") -> reverse <$> readNextLocationSet - (_, _, ":") -> mt $ - withWindowSet $ - fmap catMaybes . - mapM (runMaybeT . windowLocation) . - Map.keys . - W.floating + (_, _, ":") -> + mt $ + withWindowSet $ + fmap catMaybes + . mapM (runMaybeT . windowLocation) + . Map.keys + . W.floating (_, _, "?") -> do l1 <- readNextLocationSet l2 <- readNextLocationSet @@ -385,7 +389,8 @@ readNextLocationSet = l1 <- readNextLocationSet l2 <- readNextLocationSet return $ filter (not . flip elem l2) l1 - (_, _, "&") -> do -- intersection + (_, _, "&") -> do + -- intersection l1 <- readNextLocationSet l2 <- readNextLocationSet return $ filter (`elem` l2) l1 |