1 files changed, 32 insertions, 1 deletions
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 =