aboutsummaryrefslogtreecommitdiff
path: root/src/Rahm/Desktop
diff options
context:
space:
mode:
Diffstat (limited to 'src/Rahm/Desktop')
-rw-r--r--src/Rahm/Desktop/Common.hs15
-rw-r--r--src/Rahm/Desktop/DMenu.hs33
-rw-r--r--src/Rahm/Desktop/Keys/Wml.hs25
3 files changed, 59 insertions, 14 deletions
diff --git a/src/Rahm/Desktop/Common.hs b/src/Rahm/Desktop/Common.hs
index c10dd64..44587d3 100644
--- a/src/Rahm/Desktop/Common.hs
+++ b/src/Rahm/Desktop/Common.hs
@@ -31,13 +31,14 @@ import Control.Monad.Trans.Identity (IdentityT (..))
import Control.Monad.Trans.Maybe (MaybeT (..))
import Data.Char (toLower)
import Data.Either (either)
-import Data.List (concatMap, head, isInfixOf, map, (++))
+import Data.List (concatMap, isInfixOf, map, (++))
+import Data.List.Safe (head, tail)
import Data.List.Split (splitOn)
import qualified Data.Map as Map (fromListWith)
import Data.Maybe (Maybe (..), maybe)
import Data.Void (Void (..), absurd)
import Data.Word (Word32)
-import Rahm.Desktop.DMenu (runDMenuPromptWithMap)
+import Rahm.Desktop.DMenu (runDMenuPromptWithMap, runDMenuPromptWithMapMulti)
import Rahm.Desktop.Logger
import qualified Rahm.Desktop.StackSet as S
( Screen (Screen, workspace),
@@ -79,6 +80,7 @@ import qualified XMonad.Hooks.ManageHelpers as X
import XMonad.Prompt (XPrompt (commandToComplete, showXPrompt))
import qualified XMonad.Util.Run as X
import XMonad.Util.XUtils (pixelToString, stringToPixel)
+import Prelude hiding (head, tail)
-- A location is a workspace and maybe a window with that workspace.
data Location = Location
@@ -126,15 +128,18 @@ getString = runQuery $ do
then t
else printf "%s - %s" t a
-askWindowId :: X (Maybe [Window])
+askWindowId :: X [Window]
askWindowId = do
windowTitlesToWinId <- withWindowSet $ \ss ->
Map.fromListWith (++) <$> mapM (\wid -> (,) <$> getString wid <*> return [wid]) (S.allWindows ss)
- runDMenuPromptWithMap "Window" (Just "#f542f5") windowTitlesToWinId
+ concat <$> runDMenuPromptWithMapMulti "Window" (Just "#f542f5") windowTitlesToWinId
windowJump :: X ()
-windowJump = mapM_ (focus . head) =<< askWindowId
+windowJump = mapM_ focus . headM =<< askWindowId
+ where
+ headM :: [a] -> Maybe a
+ headM = head
withBorderWidth :: Int -> [Window] -> X a -> X a
withBorderWidth width ws fn = do
diff --git a/src/Rahm/Desktop/DMenu.hs b/src/Rahm/Desktop/DMenu.hs
index a5856e9..eefb291 100644
--- a/src/Rahm/Desktop/DMenu.hs
+++ b/src/Rahm/Desktop/DMenu.hs
@@ -4,14 +4,17 @@ module Rahm.Desktop.DMenu
runDMenu,
runDMenuPrompt,
runDMenuPromptWithMap,
+ runDMenuPromptWithMapMulti,
)
where
import Control.Monad (void)
import Data.List (intercalate)
+import Data.Maybe (mapMaybe)
import Data.Map (Map)
+import qualified Data.Map as Map
import Text.Printf (printf)
-import XMonad (X)
+import XMonad (X, MonadIO)
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.Run (runProcessWithInput, safeSpawn)
@@ -51,6 +54,34 @@ runDMenuPrompt prompt color select =
)
(intercalate "\n" select)
+-- | Like 'menu' but also takes a list of command line arguments.
+menuMultiArgs :: MonadIO m => String -> [String] -> [String] -> m [String]
+menuMultiArgs menuCmd args opts =
+ lines <$> runProcessWithInput menuCmd args (unlines opts)
+
+-- | Like 'menuMap' but also takes a list of command line arguments.
+menuMapMultiArgs :: MonadIO m => String -> [String] -> Map String a ->
+ m [a]
+menuMapMultiArgs menuCmd args selectionMap = do
+ selection <- menuFunction (Map.keys selectionMap)
+ return $ mapMaybe (`Map.lookup`selectionMap) selection
+ where
+ menuFunction = menuMultiArgs menuCmd args
+
+
+runDMenuPromptWithMapMulti :: String -> Maybe String -> Map String a -> X [a]
+runDMenuPromptWithMapMulti prompt color map = do
+ let realColor =
+ maybe
+ []
+ ( \c -> ["-theme-str", printf "* {theme-color: %s;}" c]
+ )
+ color
+ menuMapMultiArgs
+ (head menuCommand)
+ ("-multi-select" : (tail menuCommand ++ ["-p", prompt] ++ realColor))
+ map
+
runDMenuPromptWithMap :: String -> Maybe String -> Map String a -> X (Maybe a)
runDMenuPromptWithMap prompt color map = do
let realColor =
diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs
index def3b27..5565c31 100644
--- a/src/Rahm/Desktop/Keys/Wml.hs
+++ b/src/Rahm/Desktop/Keys/Wml.hs
@@ -71,6 +71,11 @@ import qualified Data.Map as Map
import Data.Maybe (catMaybes, fromJust, fromMaybe)
import Data.Ord (Down (..))
import Data.Typeable (cast)
+-- getMostRecentLocationInHistory,
+
+-- pastHistory,
+
+import Rahm.Desktop.BorderColors (BorderColor (BorderColor), setBorderColor)
import Rahm.Desktop.Common
( Location (..),
askWindowId,
@@ -81,10 +86,8 @@ import Rahm.Desktop.Common
windowsInWorkspace,
)
import Rahm.Desktop.History
- ( -- getMostRecentLocationInHistory,
- lastLocation,
+ ( lastLocation,
nextLocation,
- -- pastHistory,
)
import Rahm.Desktop.Layout.PinWindow (pinnedWindows)
import Rahm.Desktop.Logger (LogLevel (Info, Trace), logs)
@@ -143,7 +146,6 @@ import XMonad
import XMonad.Prompt.ConfirmPrompt (confirmPrompt)
import qualified XMonad.Util.ExtensibleState as XS (get, modify, put)
import Prelude hiding (head, last)
-import Rahm.Desktop.BorderColors (setBorderColor, BorderColor (BorderColor))
type KeyString = [(KeyMask, KeySym, String)]
@@ -183,7 +185,6 @@ saveMacros = do
macros <- getMacros
io $ writeFile dataFile $ show macros
-
selColor = BorderColor "#ffff00" "#b8b880"
insertWorkspaceMacroString :: (KeyMask, KeySym) -> KeyString -> X ()
@@ -527,7 +528,7 @@ readNextWorkspace =
-- The workspace with the searched for window.
(_, _, "/") -> fromMaybeTX $ do
- justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT ((head =<<) <$> askWindowId))
+ justWorkspace <$> ((MaybeT . workspaceWithWindow) =<< MaybeT (head <$> askWindowId))
-- The workspace with the next read window on it.
(_, _, "@") -> do
@@ -583,6 +584,14 @@ readNextWorkspace =
mt :: (KeyFeeder m) => X a -> MaybeT m a
mt = lift . fromX
+nonempty :: (Monad m) => m [a] -> MaybeT m [a]
+nonempty l = MaybeT $ do
+ l
+ >>= ( \case
+ [] -> return Nothing
+ a -> return (Just a)
+ )
+
readNextLocationSet :: (KeyFeeder m) => MaybeT m [Location]
readNextLocationSet = do
(WindowSelect mp) <- MaybeT (Just <$> fromX XS.get)
@@ -640,7 +649,7 @@ readNextLocationSet' =
-- Search for the windows.
(_, _, "/") ->
fromMaybeTX $
- mapM windowLocation =<< MaybeT askWindowId
+ mapM windowLocation =<< nonempty askWindowId
-- All windows.
(_, _, "%") -> fromMaybeTX $ do
ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows))
@@ -650,7 +659,7 @@ readNextLocationSet' =
-- Windows in a workspace
(_, _, s)
| s == "\t" || s == "@" || s == "\n" ->
- (mt . windowsInWorkspace) =<< readNextWorkspaceName
+ (mt . windowsInWorkspace) =<< readNextWorkspaceName
-- The first window in the next window set.
(_, _, "!") -> (: []) <$> joinMaybe (head <$> readNextLocationSet)
-- The windows except the first in a window set.
generated by cgit (git 2.34.1) at 2026-02-22 18:19:45 +0000