Change window border when selecting windows

4 files changed, 80 insertions, 26 deletions

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
diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs
index 6973b81..69873e4 100644
--- a/src/Rahm/Desktop/Keys.hs
+++ b/src/Rahm/Desktop/Keys.hs
@@ -32,6 +32,7 @@ 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
@@ -392,19 +393,21 @@ keymap = runKeys $ do
       sendMessage rotateLayout
 
   bind xK_s $ do
-    justMod $ runMaybeT_ $ do
-      locations <- readNextLocationSet 
-
-      workspace <- readNextWorkspace
-      mapM_ (lift . moveLocationToWorkspaceFn workspace) locations
-
-      lift $ setAlternateWindows (mapMaybe locationWindow locations)
-      forM_ locations $ \loc ->
-        case locationWindow loc of
-          Nothing -> return ()
-          Just win -> do
-            lift $ logs $ printf "setAlternate %s %s" (show win) (show $ locationWorkspace loc)
-            lift $ setAlternateWorkspace win (locationWorkspace loc)
+    justMod $ do
+      locations <- fromMaybe [] <$> runMaybeT readNextLocationSet
+      let locationWindows = mapMaybe locationWindow locations
+
+      withBorderColor "#00ffff" locationWindows $ do
+        runMaybeT_ $ 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"
 
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index 47be2e7..21b8c4c 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -18,9 +18,11 @@ import Control.Monad.Trans.Maybe
 import Control.Monad.Trans.State as S
 import Control.Monad.Trans.Class
 import Control.Monad (join, forM_)
+import Data.List (sortOn, intercalate)
+import Data.Ord (Down(..))
 
 import Data.Char (isAlphaNum, isAlpha, isDigit, ord)
-import Data.Maybe (fromMaybe)
+import Data.Maybe (fromMaybe, catMaybes)
 import XMonad.Actions.CopyWindow as CopyWindow
 import XMonad.Util.Run (safeSpawn)
 import Prelude hiding (head, last)
@@ -191,8 +193,19 @@ readNextWorkspace =
 
         justWorkspace <$> (MaybeT $ return $ head $ tail $ rest)
 
+      (_, _, ";") -> do
+        ws <- readNextWorkspace
+        screens <-
+          mt $
+            map (W.tag . W.workspace . snd)
+              <$> withWindowSet (return . getHorizontallyOrderedScreens)
+
+        let (front, _) = break (==workspaceName ws) (screens ++ screens)
+
+        justWorkspace <$> (MaybeT $ return $ last $ front)
+
       (_, _, "/") -> fromMaybeTX $ do
-        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT askWindowId)
+        justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head=<<) <$> askWindowId))
 
       (_, _, "@") -> do
         loc <- readNextLocationSet
@@ -220,13 +233,20 @@ readNextLocationSet =
       (_, _, "$") -> (:[]) <$> fromMaybeTX farRightWindow
       (_, _, "\"") -> (:[]) <$> MaybeT (fromX nextLocation)
       (_, _, "'") -> (:[]) <$>  MaybeT (fromX lastLocation)
-      (_, _, "*") -> fromMaybeTX $ (:[]) <$> (windowLocation =<< masterWindow)
+      (_, _, "*") -> 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 $
-        (:[]) <$> (windowLocation =<< MaybeT askWindowId)
-      (_, _, "%") -> fromMaybeTX $
-        mapM windowLocation =<< lift (withWindowSet (return . W.allWindows))
+        (mapM windowLocation =<< MaybeT askWindowId)
+      (_, _, "%") -> fromMaybeTX $ do
+        ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
+        lift $ logs $ "allWindows " ++ intercalate "\n"  (map show ret)
+        return ret
       (_, _, "@") ->
         (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace
       (_, _, "!") -> (:[]) <$> (joinMaybe $ head <$> readNextLocationSet)
@@ -236,15 +256,19 @@ readNextLocationSet =
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ if null l1 then l2 else l1
-
-      (_, _, "&") -> do
+      (_, _, "|") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return (l1 ++ l2)
+      (_, _, "_") -> return []
       (_, _, "\\") -> do
         l1 <- readNextLocationSet
         l2 <- readNextLocationSet
         return $ filter (not . flip elem l2) l1
+      (_, _, "&") -> do -- intersection
+        l1 <- readNextLocationSet
+        l2 <- readNextLocationSet
+        return $ filter (flip elem l2) l1
         
       _ -> MaybeT (return Nothing)
   where
diff --git a/src/Rahm/Desktop/Submap.hs b/src/Rahm/Desktop/Submap.hs
index 48a3144..5a05f9e 100644
--- a/src/Rahm/Desktop/Submap.hs
+++ b/src/Rahm/Desktop/Submap.hs
@@ -66,7 +66,7 @@ mapNextStringWithKeysym fn = do
 
   ret <- io $ fix $ \nextkey -> do
     ret <-
-      getMaskEventWithTimeout 2000 d keyPressMask $ \p -> do
+      getMaskEventWithTimeout 5000 d keyPressMask $ \p -> do
         KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
         keysym <- keycodeToKeysym d code 0
         (_, str) <- lookupString (asKeyEvent p)