diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Rahm/Desktop/Common.hs | 28 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Dragging.hs | 19 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 119 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Keys/Wml.hs | 111 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Submap.hs | 53 |
5 files changed, 282 insertions, 48 deletions
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs index 5c29a1c..71ffad0 100644 --- a/src/Rahm/Desktop/Common.hs +++ b/src/Rahm/Desktop/Common.hs @@ -2,6 +2,7 @@ module Rahm.Desktop.Common ( focusLocation, masterWindow, windowsInWorkspace, + pointerWorkspace, getString, askWindowId, windowJump, @@ -17,6 +18,9 @@ module Rahm.Desktop.Common runMaybeT_, setBorderColor, click, + pointerLocation, + pointerWindow, + getDisplayAndRoot, Location (..), ) where @@ -225,3 +229,27 @@ click = do (dpy, root) <- asks $ (,) <$> display <*> X.theRoot (_, _, window, _, _, _, _, _) <- io $ X.queryPointer dpy root focus window + +getDisplayAndRoot :: X (X.Display, X.Window) +getDisplayAndRoot = X.asks $ (,) <$> X.display <*> X.theRoot + +pointerLocation :: (Integral a, Integral b) => X (a, b) +pointerLocation = do + (dpy, root) <- getDisplayAndRoot + (_, _, _, fromIntegral -> x, fromIntegral -> y, _, _, _) <- + io $ X.queryPointer dpy root + return (x, y) + +pointerWindow :: X X.Window +pointerWindow = do + (dpy, root) <- getDisplayAndRoot + (_, _, w, _, _, _, _, _) <- + io $ X.queryPointer dpy root + return w + +pointerWorkspace :: X (Maybe WorkspaceId) +pointerWorkspace = runMaybeT $ do + (x, y) <- lift pointerLocation + (S.Screen (S.tag -> ws1) _ _) <- MaybeT $ X.pointScreen x y + return ws1 + diff --git a/src/Rahm/Desktop/Dragging.hs b/src/Rahm/Desktop/Dragging.hs index 8485a46..5252390 100644 --- a/src/Rahm/Desktop/Dragging.hs +++ b/src/Rahm/Desktop/Dragging.hs @@ -5,7 +5,7 @@ import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (MaybeT)) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Maybe (fromMaybe) -import Rahm.Desktop.Common (runMaybeT_, setBorderColor) +import Rahm.Desktop.Common (runMaybeT_, setBorderColor, pointerWindow, pointerLocation) import Rahm.Desktop.Layout.Hole (addHoleForWindow, removeHoleForWindow, resetHole) import Rahm.Desktop.Logger import Rahm.Desktop.Marking (setAlternateWindows) @@ -97,23 +97,6 @@ mouseMoveWindowAndThen beforeAction (AfterDragAction releaseAction) window = do releaseAction window (maybe 0 X.ev_button curev) X.refresh -getDisplayAndRoot :: X (X.Display, X.Window) -getDisplayAndRoot = X.asks $ (,) <$> X.display <*> X.theRoot - -pointerLocation :: (Integral a, Integral b) => X (a, b) -pointerLocation = do - (dpy, root) <- getDisplayAndRoot - (_, _, _, fromIntegral -> x, fromIntegral -> y, _, _, _) <- - io $ X.queryPointer dpy root - return (x, y) - -pointerWindow :: X X.Window -pointerWindow = do - (dpy, root) <- getDisplayAndRoot - (_, _, w, _, _, _, _, _) <- - io $ X.queryPointer dpy root - return w - dragWorkspace :: X () dragWorkspace = do (ox, oy) <- pointerLocation diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index fe96338..210d4c5 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -50,7 +50,7 @@ import Rahm.Desktop.Common runMaybeT_, setBorderColor, withBorderColor, - withBorderColorM, + withBorderColorM, pointerWorkspace, ) import Rahm.Desktop.DMenu (runDMenu) import qualified Rahm.Desktop.Dragging as D @@ -83,13 +83,19 @@ import Rahm.Desktop.Keys.Dsl (-|-), ) import Rahm.Desktop.Keys.Wml - ( gotoWorkspaceFn, + ( addWindowToSelection, + clearWindowSelection, + getAndResetWindowSelection, + gotoWorkspaceFn, moveWindowToWorkspaceFn, readNextLocationSet, + readNextLocationSet', readNextWorkspace, readNextWorkspaceName, readWindowsetMacro, readWorkspaceMacro, + removeWindowFromSelection, + toggleWindowInSelection, workspaceForString, workspaceForStringT, workspaceName, @@ -130,7 +136,8 @@ import Rahm.Desktop.RebindKeys ) import qualified Rahm.Desktop.StackSet as W import Rahm.Desktop.Submap - ( mapNextString, + ( escape, + mapNextString, submap, submapButtonsWithKey, ) @@ -290,7 +297,7 @@ keymap = runKeys $ do doc "Jump to a window" $ pushPendingBuffer "' " $ do runMaybeT_ $ do - l <- readNextLocationSet + l <- readNextLocationSet' case l of (h : _) -> lift (focusLocation h) _ -> return () @@ -567,6 +574,34 @@ keymap = runKeys $ do doc "For mosaic layout, shrink the size-share of the current window" $ sendMessage =<< shrinkPositionAlt + bind xK_n $ do + forM_ + [ ( justMod, + addWindowToSelection, + "Add a window set to the selection set", + "n " + ), + ( shiftMod, + removeWindowFromSelection, + "Remove a window set from the selection set", + "N " + ) + ] + $ \(m, fn, d, ch) -> do + m $ + doc d $ + pushPendingBuffer ch $ do + runMaybeT_ $ do + locset <- readNextLocationSet' + lift $ + forM_ locset $ \(Location _ mWin) -> + mapM_ fn mWin + + bind xK_period $ do + justMod $ + doc "Toggle the currently focused window in the selection set; (kinda) shorthand for Mod+n . ." $ + flip whenJust toggleWindowInSelection =<< withWindowSet (return . W.peek) + bind xK_m $ do justMod $ doc @@ -973,10 +1008,14 @@ mouseMap = runButtons $ do bind button1 $ do justMod $ - doc "Float and move a window" $ - \w -> - pushPendingBuffer "Dragging" $ - focus w >> mouseMoveWindow w >> windows W.shiftMaster + doc + "Float and move a window" + myMouseMoveWindow + + shiftMod $ + doc + "Add the currently focused window to the selection set." + toggleWindowInSelection bind button2 $ do justMod $ windows . (W.shiftMaster .) . W.focusWindow @@ -1117,10 +1156,66 @@ mouseMap = runButtons $ do doc "Jump to the last location." $ noWindow (click >> jumpToLastLocation) - bind button1 $ - noMod $ - doc "'drag' a workspace to another screen" $ - noWindow D.dragWorkspace + -- bind button1 $ + -- noMod $ + -- doc "'drag' a workspace to another screen" $ + -- noWindow D.dragWorkspace + + continuous $ do + bind button1 $ + noMod $ + doc + "add the window under the cursor to the window selection" + toggleWindowInSelection + + bind button2 $ + noMod $ + doc "Clear the window selection" (noWindow clearWindowSelection) + + bind button13 $ + noMod $ + doc "Kill the windows in the selection" $ + noWindow $ do + windows <- getAndResetWindowSelection + forM_ windows X.killWindow + escape + + bind button3 $ + noMod $ + doc "Move all the windows to the workspace the pointer is on" $ + noWindow $ do + wins <- getAndResetWindowSelection + runMaybeT_ $ do + ws <- MaybeT pointerWorkspace + lift $ + let f = + appEndo + ( mconcat (map (Endo . W.shiftWin ws) wins) + ) + in windows f >> escape + + bind button15 $ noMod $ doc "" $ noWindow (return () :: X ()) + + forM_ [(button7, ",.", "right"), (button6, ";.", "left")] $ + \(b, mot, d) -> do + bind b $ + noMod $ + doc + ( "Move the selected windows to the workspace on the \ + \screen to the " + ++ d + ) + $ noWindow $ do + wins <- getAndResetWindowSelection + runMaybeT_ $ do + ws' <- workspaceForStringT mot + ws <- MaybeT . return $ workspaceName ws' + lift $ + let f = + appEndo + ( mconcat (map (Endo . W.shiftWin ws) wins) + ) + in windows f >> escape let workspaceButtons = [ ( button2, diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index 6c46361..0d0691f 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -17,9 +17,15 @@ module Rahm.Desktop.Keys.Wml readWindowsetMacro, readNextWorkspace, readNextLocationSet, + readNextLocationSet', moveLocationToWorkspace, moveWindowToWorkspaceFn, + getAndResetWindowSelection, gotoWorkspaceFn, + toggleWindowInSelection, + addWindowToSelection, + clearWindowSelection, + removeWindowFromSelection, readMacroString, justWorkspace, justWorkspaceWithPreferredWindow, @@ -37,10 +43,11 @@ module Rahm.Desktop.Keys.Wml locationSetForKeys, readNextWorkspaceName, workspaceName, + wmlLogHook, ) where -import Control.Monad (forM_, join, when) +import Control.Monad (forM_, join, void, when) import Control.Monad.Trans.Class (MonadTrans (lift)) import Control.Monad.Trans.Maybe (MaybeT (..), mapMaybeT) import Control.Monad.Trans.State as S @@ -50,17 +57,19 @@ import Control.Monad.Trans.State as S put, ) import Data.Char (isAlpha, isAlphaNum, isDigit, ord) -import Data.List (intercalate, sortOn) +import Data.List (find, intercalate, sortOn) import Data.List.Safe (head, last) import Data.Map (Map) import qualified Data.Map as Map - ( empty, + ( delete, + elems, + empty, insert, keys, lookup, member, ) -import Data.Maybe (catMaybes, fromMaybe) +import Data.Maybe (catMaybes, fromJust, fromMaybe) import Data.Ord (Down (..)) import Data.Typeable (cast) import Rahm.Desktop.Common @@ -70,6 +79,7 @@ import Rahm.Desktop.Common getCurrentWorkspace, gotoWorkspace, moveLocationToWorkspace, + setBorderColor, windowsInWorkspace, ) import Rahm.Desktop.History @@ -122,6 +132,7 @@ import XMonad WorkspaceId, X, asks, + clearArea, directories, io, killWindow, @@ -172,6 +183,10 @@ saveMacros = do macros <- getMacros io $ writeFile dataFile $ show macros +selColor = "#b8b880" + +selFocusColor = "#ffff00" + insertWorkspaceMacroString :: (KeyMask, KeySym) -> KeyString -> X () insertWorkspaceMacroString k ks = do macros <- getMacros @@ -195,6 +210,68 @@ insertWindowSetMacroString k ks = do instance ExtensionClass MaybeMacros where initialValue = NoMacros +newtype WindowSelect = WindowSelect (Map Window (X ())) + +instance ExtensionClass WindowSelect where + initialValue = WindowSelect mempty + +toggleWindowInSelection :: Window -> X () +toggleWindowInSelection win = do + (WindowSelect sel) <- XS.get + case Map.lookup win sel of + Nothing -> do + foc <- withWindowSet (return . W.peek) + + cleanup <- + setBorderColor + ( if Just win == foc + then selFocusColor + else selColor + ) + [win] + + XS.put $ WindowSelect $ Map.insert win cleanup sel + (Just cleanup) -> do + XS.put $ WindowSelect $ Map.delete win sel + cleanup + +addWindowToSelection :: Window -> X () +addWindowToSelection win = do + (WindowSelect sel) <- XS.get + case Map.lookup win sel of + Nothing -> do + foc <- withWindowSet (return . W.peek) + + cleanup <- + setBorderColor + ( if Just win == foc + then selFocusColor + else selColor + ) + [win] + + XS.put $ WindowSelect $ Map.insert win cleanup sel + _ -> return () + +removeWindowFromSelection :: Window -> X () +removeWindowFromSelection win = do + (WindowSelect sel) <- XS.get + case Map.lookup win sel of + (Just cleanup) -> do + XS.put $ WindowSelect $ Map.delete win sel + cleanup + _ -> return () + +clearWindowSelection :: X () +clearWindowSelection = void getAndResetWindowSelection + +getAndResetWindowSelection :: X [Window] +getAndResetWindowSelection = do + (WindowSelect mp) <- XS.get + sequence_ (Map.elems mp) + XS.put (initialValue :: WindowSelect) + return (Map.keys mp) + data Workspace = forall a. (Typeable a) => Workspace @@ -522,7 +599,19 @@ readNextWorkspace = mt = lift . fromX readNextLocationSet :: (KeyFeeder m) => MaybeT m [Location] -readNextLocationSet = +readNextLocationSet = do + (WindowSelect mp) <- MaybeT (Just <$> fromX XS.get) + case Map.keys mp of + [] -> readNextLocationSet' + wins -> do + lift $ fromX $ addStringToPendingBuffer "<sel> " + fromMaybeTX $ + mapM windowLocation + =<< MaybeT (Just <$> fromX getAndResetWindowSelection) + +-- Like readNextLocationSet, but ignores the window selection. +readNextLocationSet' :: (KeyFeeder m) => MaybeT m [Location] +readNextLocationSet' = readNextKey $ \mask sym str -> do macros <- (lift . fromX) $ windowsetMacros <$> getMacros @@ -543,6 +632,10 @@ readNextLocationSet = -- (: []) <$> MaybeT (fromX $ pastHistory (ord ch - 0x30)) -- The current window. (_, _, ".") -> (: []) <$> mt getCurrentLocation + -- The selected windows in the selection set. + (_, _, "#") -> + fromMaybeTX $ + mapM windowLocation =<< MaybeT (Just <$> fromX getAndResetWindowSelection) -- The window on the far-left of the screens. (_, _, "^") -> (: []) <$> fromMaybeTX farLeftWindow -- The windows on the far-right of the screens. @@ -618,3 +711,11 @@ readNextLocationSet = where mt :: (KeyFeeder m) => X a -> MaybeT m a mt = lift . fromX + +wmlLogHook :: X () +wmlLogHook = do + -- Reset the border colors for the selected window. + (WindowSelect (Map.keys -> sel)) <- XS.get + foc <- (withWindowSet (return . fromMaybe (0 :: Window) . W.peek) :: X Window) + void $ setBorderColor selColor (filter (/= foc) sel) + mapM_ (setBorderColor selFocusColor . (: [])) (find (== foc) sel) diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs index 2cb71c3..f5d8f9f 100644 --- a/src/Rahm/Desktop/Submap.hs +++ b/src/Rahm/Desktop/Submap.hs @@ -8,6 +8,7 @@ module Rahm.Desktop.Submap submap, submapDefault, submapDefaultWithKey, + escape, ) where @@ -19,15 +20,17 @@ import Data.Map (Map) import qualified Data.Map as Map (findWithDefault, lookup) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word64) -import Rahm.Desktop.Common (runMaybeT_) +import Rahm.Desktop.Common (pointerWindow, runMaybeT_) import XMonad ( Button, ButtonMask, Display, Event (..), + ExtensionClass (initialValue), KeyMask, KeySym, MonadReader (ask), + StateExtension, Window, X, XConf (..), @@ -52,6 +55,23 @@ import XMonad ungrabPointer, (.|.), ) +import qualified XMonad.Util.ExtensibleState as XS + +newtype Escape = Escape Bool + +instance ExtensionClass Escape where + initialValue = Escape False + +-- Escape a submapping. Useful for continuous submappings where a final +-- button/key should finish the mapping. +escape :: X () +escape = XS.put (Escape True) + +getEscape :: X Bool +getEscape = do + (Escape cur) <- XS.get + XS.put (Escape False) + return cur currentTimeMillis :: IO Int currentTimeMillis = round . (* 1000) <$> getPOSIXTime @@ -131,17 +151,23 @@ submap = submapDefault (return ()) -- next button is pressed. nextButton :: X (Maybe (ButtonMask, Button)) nextButton = do - XConf {theRoot = root, display = d} <- ask - io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime + b <- getEscape + if b + then return Nothing + else nextButton' + where + nextButton' = do + XConf {theRoot = root, display = d} <- ask + io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync 0 0 currentTime - ret <- io $ - getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do - ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv - return (m, button) + ret <- io $ + getMaskEventWithTimeout 5000 d buttonPressMask $ \xEv -> do + ButtonEvent {ev_button = button, ev_state = m} <- getEvent xEv + return (m, button) - io $ ungrabPointer d currentTime + io $ ungrabPointer d currentTime - return ret + return ret {- Grabs the mouse and reports the next mouse motion. -} nextMotion :: X (Int, Int) @@ -184,9 +210,10 @@ submapButtonsWithKey :: submapButtonsWithKey defaultAction actions window = do maybe (return ()) - ( \arg@(_, button) -> - case Map.lookup arg actions of - Nothing -> defaultAction arg window - Just fn -> fn window + ( \key -> do + win' <- pointerWindow + case Map.lookup key actions of + Nothing -> defaultAction key win' + Just fn -> fn win' ) =<< nextButton |