From d41def38570056f97c841c82d053f2c2d87cb32b Mon Sep 17 00:00:00 2001 From: Josh Rahm Date: Mon, 18 Apr 2022 20:47:07 -0600 Subject: Change window border when selecting windows --- src/Rahm/Desktop/Common.hs | 35 +++++++++++++++++++++++++++++++---- 1 file changed, 31 insertions(+), 4 deletions(-) (limited to 'src/Rahm/Desktop/Common.hs') diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs index c12322a..9187edf 100644 --- a/src/Rahm/Desktop/Common.hs +++ b/src/Rahm/Desktop/Common.hs @@ -2,13 +2,14 @@ module Rahm.Desktop.Common where import Prelude hiding ((!!)) -import Control.Monad (void) +import Control.Monad (void, when, forM_) import Control.Monad.Trans.Maybe import XMonad.Actions.DynamicWorkspaces import XMonad.Util.Run import XMonad.Prompt import XMonad.Prompt.Input import XMonad.Prompt.Shell +import XMonad.Util.XUtils import Rahm.Desktop.PromptConfig @@ -66,15 +67,41 @@ getString = runQuery $ do then t else printf "%s - %s" t a -askWindowId :: X (Maybe Window) +askWindowId :: X (Maybe [Window]) askWindowId = do windowTitlesToWinId <- withWindowSet $ \ss -> - Map.fromList <$> mapM (\wid -> (,) <$> getString wid <*> return wid) (allWindows ss) + Map.fromListWith (++) <$> mapM (\wid -> (,) <$> getString wid <*> return [wid]) (allWindows ss) runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId windowJump :: X () -windowJump = mapM_ focus =<< askWindowId +windowJump = (mapM_ (focus . head)) =<< askWindowId + +-- Temporarily set the border color of the given windows. +withBorderColor :: String -> [Window] -> X a -> X a +withBorderColor color wins fn = do + d <- asks display + px <- stringToPixel d color + oPx <- stringToPixel d =<< asks (normalBorderColor . config) + fPx <- stringToPixel d =<< asks (focusedBorderColor . config) + + colorName <- io (pixelToString d px) + oColorName <- io (pixelToString d oPx) + fColorName <- io (pixelToString d fPx) + + forM_ wins $ \w -> + setWindowBorderWithFallback d w colorName px + + ret <- fn + + withFocused $ \fw -> do + forM_ wins $ \w -> + when (w /= fw) $ + setWindowBorderWithFallback d w oColorName oPx + + setWindowBorderWithFallback d fw fColorName fPx + + return ret gotoWorkspace :: WorkspaceId -> X () gotoWorkspace wid = do -- cgit