1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
|
module Rahm.Desktop.DMenu
( menuCommand,
menuCommandString,
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, MonadIO)
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.Run (runProcessWithInput, safeSpawn)
data Colors
= Colors
{ fg :: String,
bg :: String
}
| DefaultColors
menuCommand :: [String]
menuCommand = ["rofi", "-monitor", "-4", "-i", "-dmenu", "-sort", "-levenshtein-sort"]
menuCommandString :: String
menuCommandString = unwords menuCommand
runDMenu :: X ()
runDMenu =
void $
safeSpawn
"rofi"
["-monitor", "-4", "-display-run", "Execute", "-show", "run"]
runDMenuPrompt :: String -> Maybe String -> [String] -> X String
runDMenuPrompt prompt color select =
let realColor = maybe [] (\c -> ["-sb", c, "-nf", c]) color
in runProcessWithInput
"/home/rahm/.local/bin/dmenu_debug.sh"
( [ "-p",
prompt,
"-l",
"12",
"-dim",
"0.4"
]
++ realColor
)
(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 =
maybe
[]
( \c -> ["-theme-str", printf "* {theme-color: %s;}" c]
)
color
menuMapArgs
(head menuCommand)
(tail menuCommand ++ ["-p", prompt] ++ realColor)
map
|
