diff options
Diffstat (limited to 'accounts/gkleen@sif/xmonad/xmonad.hs')
-rw-r--r-- | accounts/gkleen@sif/xmonad/xmonad.hs | 902 |
1 files changed, 902 insertions, 0 deletions
diff --git a/accounts/gkleen@sif/xmonad/xmonad.hs b/accounts/gkleen@sif/xmonad/xmonad.hs new file mode 100644 index 00000000..579456ad --- /dev/null +++ b/accounts/gkleen@sif/xmonad/xmonad.hs | |||
@@ -0,0 +1,902 @@ | |||
1 | {-# LANGUAGE TupleSections, ViewPatterns, OverloadedStrings, FlexibleInstances, UndecidableInstances, MultiWayIf #-} | ||
2 | |||
3 | import XMonad | ||
4 | import XMonad.Hooks.DynamicLog | ||
5 | import XMonad.Hooks.ManageDocks | ||
6 | import XMonad.Util.Run | ||
7 | import XMonad.Util.Loggers | ||
8 | import XMonad.Util.EZConfig(additionalKeys) | ||
9 | import System.IO | ||
10 | import System.IO.Error | ||
11 | import System.Environment | ||
12 | import Data.Map (Map) | ||
13 | import qualified Data.Map as Map | ||
14 | import qualified XMonad.StackSet as W | ||
15 | import System.Exit | ||
16 | import Control.Monad.State (get) | ||
17 | -- import XMonad.Layout.Spiral | ||
18 | import Data.Ratio | ||
19 | import Data.List | ||
20 | import Data.Char | ||
21 | import Data.Maybe (fromMaybe, listToMaybe, maybeToList, catMaybes, isJust) | ||
22 | import XMonad.Layout.Tabbed | ||
23 | import XMonad.Prompt | ||
24 | import XMonad.Prompt.Input | ||
25 | import XMonad.Util.Scratchpad | ||
26 | import XMonad.Util.NamedScratchpad | ||
27 | import Control.Monad (sequence, liftM, liftM2, join, void) | ||
28 | import XMonad.Util.WorkspaceCompare | ||
29 | import XMonad.Layout.NoBorders | ||
30 | import XMonad.Layout.PerWorkspace | ||
31 | import XMonad.Layout.SimplestFloat | ||
32 | import XMonad.Layout.Renamed | ||
33 | import XMonad.Layout.Reflect | ||
34 | import XMonad.Layout.OnHost | ||
35 | import XMonad.Layout.Combo | ||
36 | import XMonad.Layout.ComboP | ||
37 | import XMonad.Layout.Column | ||
38 | import XMonad.Layout.TwoPane | ||
39 | import XMonad.Layout.IfMax | ||
40 | import XMonad.Layout.LayoutBuilder | ||
41 | import XMonad.Layout.WindowNavigation | ||
42 | import XMonad.Layout.Dwindle | ||
43 | import XMonad.Layout.TrackFloating | ||
44 | import System.Process | ||
45 | import System.Directory (removeFile) | ||
46 | import System.Posix.Files | ||
47 | import System.FilePath ((</>)) | ||
48 | import Control.Concurrent | ||
49 | import System.Posix.Process (getProcessID) | ||
50 | import System.IO.Error | ||
51 | import System.IO | ||
52 | import XMonad.Hooks.ManageHelpers hiding (CW) | ||
53 | import XMonad.Hooks.UrgencyHook as U | ||
54 | import XMonad.Hooks.EwmhDesktops | ||
55 | import XMonad.StackSet (RationalRect (..)) | ||
56 | import Control.Monad (when, filterM, (<=<)) | ||
57 | import Graphics.X11.ExtraTypes.XF86 | ||
58 | import XMonad.Util.Cursor | ||
59 | import XMonad.Actions.Warp | ||
60 | import XMonad.Actions.FloatKeys | ||
61 | import XMonad.Util.SpawnOnce | ||
62 | import System.Directory | ||
63 | import System.FilePath | ||
64 | import XMonad.Actions.CopyWindow | ||
65 | import XMonad.Hooks.ServerMode | ||
66 | import XMonad.Actions.Commands | ||
67 | import XMonad.Actions.CycleWS | ||
68 | import XMonad.Actions.RotSlaves | ||
69 | import XMonad.Actions.UpdatePointer | ||
70 | import XMonad.Prompt.Window | ||
71 | import Data.IORef | ||
72 | import Data.Monoid | ||
73 | import Data.String | ||
74 | import qualified XMonad.Actions.PhysicalScreens as P | ||
75 | |||
76 | import XMonad.Layout.IM | ||
77 | |||
78 | import XMonad.Prompt.MyShell | ||
79 | import XMonad.Prompt.MyPass | ||
80 | import XMonad.Prompt.MySsh | ||
81 | |||
82 | import XMonad.Mpv | ||
83 | |||
84 | import Network.HostName | ||
85 | |||
86 | import Control.Applicative ((<$>)) | ||
87 | |||
88 | import Libnotify as Notify hiding (appName) | ||
89 | import qualified Libnotify as Notify (appName) | ||
90 | import Libnotify (Notification) | ||
91 | -- import System.Information.Battery | ||
92 | |||
93 | import Data.Int (Int32) | ||
94 | |||
95 | import System.Posix.Process | ||
96 | import System.Posix.Signals | ||
97 | import System.Posix.IO as Posix | ||
98 | import Control.Exception | ||
99 | |||
100 | import System.IO.Unsafe | ||
101 | |||
102 | import Control.Monad.Trans.Class | ||
103 | import Control.Monad.Trans.Maybe | ||
104 | |||
105 | import Data.Fixed (Micro) | ||
106 | |||
107 | import qualified Data.Text as Text | ||
108 | import Data.Ord (comparing) | ||
109 | import Debug.Trace | ||
110 | |||
111 | instance MonadIO m => IsString (m ()) where | ||
112 | fromString = spawn | ||
113 | |||
114 | type KeyMap = Map (ButtonMask, KeySym) (X ()) | ||
115 | |||
116 | data Host = Host | ||
117 | { hName :: HostName | ||
118 | , hManageHook :: ManageHook | ||
119 | , hWsp :: Integer -> WorkspaceId | ||
120 | , hCoWsp :: String -> Maybe WorkspaceId | ||
121 | , hKeysMod :: XConfig Layout -> (KeyMap -> KeyMap) | ||
122 | , hScreens :: [P.PhysicalScreen] | ||
123 | , hKbLayouts :: [(String, Maybe String)] | ||
124 | , hCmds :: X [(String, X ())] | ||
125 | , hKeyUpKeys :: XConfig Layout -> KeyMap | ||
126 | } | ||
127 | |||
128 | defaultHost = Host { hName = "unkown" | ||
129 | , hManageHook = composeOne [manageScratchTerm] | ||
130 | , hWsp = show | ||
131 | , hCoWsp = const Nothing | ||
132 | , hKeysMod = const id | ||
133 | , hScreens = [0,1..] | ||
134 | , hKbLayouts = [ ("us", Just "dvp") | ||
135 | , ("us", Nothing) | ||
136 | , ("de", Nothing) | ||
137 | ] | ||
138 | , hCmds = return [] | ||
139 | , hKeyUpKeys = const Map.empty | ||
140 | } | ||
141 | |||
142 | browser :: String | ||
143 | browser = "env MOZ_USE_XINPUT2=1 firefox" | ||
144 | |||
145 | hostFromName :: HostName -> Host | ||
146 | hostFromName h@("vali") = defaultHost { hName = h | ||
147 | , hManageHook = composeOne $ catMaybes [ Just manageScratchTerm | ||
148 | , assign "web" $ className =? ".dwb-wrapped" | ||
149 | , assign "web" $ className =? "Chromium" | ||
150 | , assign "work" $ className =? "Emacs" | ||
151 | , assign "media" $ className =? "mpv" | ||
152 | ] | ||
153 | , hWsp = hWsp | ||
154 | , hCoWsp = hCoWsp | ||
155 | , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_d, ["chromium", "chromium $(xclip -o)"]) | ||
156 | , (xK_e, ["emacsclient -c"]) | ||
157 | ]) | ||
158 | `Map.union` | ||
159 | ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), scratchpadSpawnActionCustom $ (XMonad.terminal conf) ++ " -name scratchpad -title scratchpad -e tmux new-session -D -s scratch") | ||
160 | ] ) | ||
161 | , hScreens = hScreens defaultHost | ||
162 | } | ||
163 | where | ||
164 | workspaceNames = Map.fromList [ (2, "web") | ||
165 | , (3, "work") | ||
166 | , (10, "media") | ||
167 | ] | ||
168 | hWsp = wspFromMap workspaceNames | ||
169 | hCoWsp = coWspFromMap workspaceNames | ||
170 | assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp | ||
171 | hostFromName h | ||
172 | | h `elem` ["hel", "sif"] = defaultHost { hName = h | ||
173 | , hManageHook = namedScratchpadManageHook scratchpads <+> composeOne (catMaybes | ||
174 | [ assign "mpv" $ className =? "mpv" | ||
175 | , assign "mpv" $ (className =? "URxvt" <&&> title =? "irssi") | ||
176 | , assign "mpv" $ (className =? "URxvt" <&&> resource =? "presentation") | ||
177 | , assign "mpv" $ stringProperty "WM_WINDOW_ROLE" =? "presentation" | ||
178 | , assign "read" $ stringProperty "WM_WINDOW_ROLE" =? "presenter" | ||
179 | , assign "mpv" $ className =? "factorio" | ||
180 | , assign "web" $ className =? "chromium-browser" | ||
181 | , assign "web" $ className =? "Google-chrome" | ||
182 | , assign "work" $ (appName =? "Devtools" <&&> className =? "Firefox") | ||
183 | , assign "work" $ className =? "Postman" | ||
184 | , assign "web" $ className =? "Firefox" | ||
185 | , assign "comm" $ (className =? "URxvt" <&&> resource =? "comm") | ||
186 | , assign "comm" $ (className =? "Emacs" <&&> title =? "Mail") | ||
187 | , assign "comm" $ className =? "Zulip" | ||
188 | , assign "comm" $ className =? "Discord" | ||
189 | , assign "media" $ (className =? "URxvt" <&&> resource =? "media") | ||
190 | , assign "media" $ (className =? "URxvt" <&&> title =? "streamlink") | ||
191 | , assign "media" $ (className =? "URxvt" <&&> title =? "mpv") | ||
192 | , assign "monitor" $ (className =? "URxvt" <&&> fmap ("monitor" `isInfixOf`) title) | ||
193 | , assign "monitor" $ className =? "Grafana" | ||
194 | , Just $ (className =? "URxvt" <&&> resource =? "htop") -?> centerFloat | ||
195 | , Just $ (className =? "Scp-dbus-service.py") -?> centerFloat | ||
196 | , Just $ (className =? "URxvt" <&&> resource =? "log") -?> centerFloat | ||
197 | , assign "work" $ className =? "URxvt" | ||
198 | , assign' ["work", "uni"] $ (className =? "Emacs" <&&> appName /=? "Edit_with_Emacs_FRAME") | ||
199 | , assign' ["work", "uni"] $ className =? "jetbrains-idea-ce" | ||
200 | , assign "read" $ className =? "llpp" | ||
201 | , assign "read" $ className =? "Evince" | ||
202 | , assign "read" $ className =? "Zathura" | ||
203 | , assign "read" $ className =? "MuPDF" | ||
204 | , assign "read" $ className =? "Xournal" | ||
205 | , assign "read" $ appName =? "com-trollworks-gcs-app-GCS" | ||
206 | , assign "read" $ appName =? "Tux.py" | ||
207 | , assign "read" $ className =? "Gnucash" | ||
208 | , assign "comm" $ className =? "Skype" | ||
209 | , assign "comm" $ className =? "Daily" | ||
210 | , assign "comm" $ className =? "Pidgin" | ||
211 | , assign "comm" $ className =? "Slack" | ||
212 | , Just $ (resource =? "xvkbd") -?> doRectFloat $ RationalRect (1 % 8) (3 % 8) (6 % 8) (4 % 8) | ||
213 | , Just $ (stringProperty "_NET_WM_WINDOW_TYPE" =? "_NET_WM_WINDOW_TYPE_DIALOG") -?> doFloat | ||
214 | , Just $ (className =? "Dunst") -?> doFloat | ||
215 | , Just $ (className =? "Xmessage") -?> doCenterFloat | ||
216 | , Just $ (className =? "Nm-openconnect-auth-dialog") -?> centerFloat | ||
217 | , Just $ (className =? "Pinentry") -?> doCenterFloat | ||
218 | , Just $ (className =? "pinentry") -?> doCenterFloat | ||
219 | , Just $ (appName =? "Edit_with_Emacs_FRAME") -?> centerFloat | ||
220 | , Just $ (stringProperty "WM_WINDOW_ROLE" =? "GtkFileChooseDialog") -?> centerFloatSmall | ||
221 | , Just $ (className =? "Nvidia-settings") -?> doCenterFloat | ||
222 | , Just $ fmap ("Minetest" `isInfixOf`) title -?> doIgnore | ||
223 | , Just $ fmap ("Automachef" `isInfixOf`) title -?> doIgnore | ||
224 | , assign "call" $ className =? "zoom" | ||
225 | ]) | ||
226 | , hWsp = hWsp | ||
227 | , hCoWsp = hCoWsp | ||
228 | , hKeysMod = \conf -> Map.union $ (Map.fromList $ join $ map (spawnBindings conf) [ (xK_e, ["emacsclient -c"]) | ||
229 | , (xK_d, [fromString browser, fromString $ browser ++ " $(xclip -o)", fromString $ "notmuch-links"]) | ||
230 | , (xK_f, ["urxvtc -name comm -title Feeds -e mosh odin -- tmux new-session -ADs comm"]) | ||
231 | , (xK_c, [ inputPrompt xPConfig "dc" ?+ dc ]) | ||
232 | , (xK_g, ["pidgin"]) | ||
233 | , (xK_s, ["skype"]) | ||
234 | -- , (xK_p, [mkPassPrompt "Type password" pwType xPConfig, mkPassPrompt "Show password" pwShow xPConfig, mkPassPrompt "Copy password" pwClip xPConfig]) | ||
235 | , (xK_w, ["sudo rewacom"]) | ||
236 | , (xK_y, [ "tmux new-window -dt media /var/media/link.hs $(xclip -o)" | ||
237 | , "tmux new-window -dt media /var/media/download.hs $(xclip -o)" | ||
238 | , "urxvtc -name media -e tmuxp load /var/media" | ||
239 | ]) | ||
240 | , (xK_l, [ "tmux new-window -dt media mpv $(xclip -o)" | ||
241 | , "tmux new-window -dt media streamlink --retry-open 10 $(xclip -o)" | ||
242 | ]) | ||
243 | , (xK_m, [ "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch)'" | ||
244 | , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e '(notmuch-mua-new-mail)'" | ||
245 | , "emacsclient -c -F \"'(title . \\\"Mail\\\")\" -e \"(browse-url-mail \"$(xclip -o)\")\"" | ||
246 | ]) | ||
247 | , (xK_Return, ["keynav start,windowzoom", "keynav start"]) | ||
248 | , (xK_t, [inputPrompt xPConfig "fuzzytime timer" ?+ fuzzytime, fuzzytime "unset", work_fuzzytime]) | ||
249 | , (xK_a, [inputPrompt xPConfig "adjmix" ?+ adjmix]) | ||
250 | , (xK_s, [ inputPromptWithCompl xPConfig "start synergy" synergyCompl ?+ synergyStart | ||
251 | , inputPromptWithCompl xPConfig "stop synergy" synergyCompl ?+ synergyStop | ||
252 | ]) | ||
253 | , (xK_h, [ "urxvtc -name htop -e htop" | ||
254 | , "urxvtc -name log -e journalctl -xef" | ||
255 | ]) | ||
256 | , (xK_x, [ "autorandr -c" | ||
257 | , "autorandr -fl def" | ||
258 | ]) | ||
259 | , (xK_z, [ "zulip -- --force-device-scale-factor=2" | ||
260 | ]) | ||
261 | ]) | ||
262 | `Map.union` | ||
263 | ( Map.fromList [ ((XMonad.modMask conf .|. controlMask, xK_Return), namedScratchpadAction scratchpads "term") | ||
264 | , ((XMonad.modMask conf .|. controlMask, xK_a), namedScratchpadAction scratchpads "pavucontrol") | ||
265 | , ((XMonad.modMask conf .|. controlMask, xK_w), namedScratchpadAction scratchpads "alarms") | ||
266 | , ((XMonad.modMask conf .|. controlMask, xK_b), namedScratchpadAction scratchpads "blueman") | ||
267 | , ((XMonad.modMask conf .|. controlMask, xK_p), namedScratchpadAction scratchpads "keepassxc") | ||
268 | , ((XMonad.modMask conf .|. controlMask, xK_t), namedScratchpadAction scratchpads "toggl") | ||
269 | , ((XMonad.modMask conf .|. controlMask, xK_e), namedScratchpadAction scratchpads "emacs") | ||
270 | , ((XMonad.modMask conf .|. controlMask, xK_m), namedScratchpadAction scratchpads "calendar") | ||
271 | , ((XMonad.modMask conf .|. controlMask, xK_f), namedScratchpadAction scratchpads "music") | ||
272 | , ((XMonad.modMask conf .|. mod1Mask, xK_Up), rotate U) | ||
273 | , ((XMonad.modMask conf .|. mod1Mask, xK_Down), rotate D) | ||
274 | , ((XMonad.modMask conf .|. mod1Mask, xK_Left), rotate L) | ||
275 | , ((XMonad.modMask conf .|. mod1Mask, xK_Right), rotate R) | ||
276 | -- , ((XMonad.modMask conf .|. shiftMask, xK_a), startMute "hel") | ||
277 | ] ) | ||
278 | , hKeyUpKeys = \conf -> Map.fromList [ -- ((XMonad.modMask conf .|. shiftMask, xK_a), stopMute "hel") | ||
279 | ] | ||
280 | , hScreens = hScreens defaultHost | ||
281 | , hCmds = return [ ("prev-workspace", prevWS) | ||
282 | , ("next-workspace", nextWS) | ||
283 | , ("prev-window", rotAllDown) | ||
284 | , ("next-window", rotAllUp) | ||
285 | , ("banish", banishScreen LowerRight) | ||
286 | , ("update-gpg-tty", safeSpawn "gpg-connect-agent" ["UPDATESTARTUPTTY", "/bye"]) | ||
287 | , ("rescreen", rescreen) | ||
288 | , ("repanel", do | ||
289 | spawn "nm-applet" | ||
290 | spawn "blueman-applet" | ||
291 | spawn "pasystray" | ||
292 | spawn "kdeconnect-indicator" | ||
293 | spawn "dunst -print" | ||
294 | spawn "udiskie" | ||
295 | spawn "autocutsel -s PRIMARY" | ||
296 | spawn "autocutsel -s CLIPBOARD" | ||
297 | ) | ||
298 | , ("pause", mediaMpv $ MpvSetProperty "pause" True) | ||
299 | , ("unpause", mediaMpv $ MpvSetProperty "pause" False) | ||
300 | , ("exit", io $ exitWith ExitSuccess) | ||
301 | ] | ||
302 | } | ||
303 | where | ||
304 | withGdkScale act = void . xfork $ setEnv "GDK_SCALE" "2" >> act | ||
305 | workspaceNames = Map.fromList [ (1, "comm") | ||
306 | , (2, "web") | ||
307 | , (3, "work") | ||
308 | , (4, "read") | ||
309 | , (5, "monitor") | ||
310 | , (6, "uni") | ||
311 | , (8, "call") | ||
312 | , (9, "media") | ||
313 | , (10, "mpv") | ||
314 | ] | ||
315 | scratchpads = [ NS "term" "urxvtc -name scratchpad -title scratchpad -e tmux new-session -AD -s scratch" (resource =? "scratchpad") centerFloat | ||
316 | , NS "pavucontrol" "pavucontrol" (resource =? "pavucontrol") centerFloat | ||
317 | , NS "alarms" "alarm-clock-applet" (className =? "Alarm-clock-applet" <&&> title =? "Alarms") centerFloat | ||
318 | , NS "blueman" "blueman-manager" (className =? ".blueman-manager-wrapped") centerFloat | ||
319 | , NS "keepassxc" "keepassxc" (className =? "KeePassXC") centerFloat | ||
320 | , NS "toggl" "toggldesktop" (className =? "Toggl Desktop") centerFloat | ||
321 | , NS "calendar" "minetime -- --force-device-scale-factor=1.6" (className =? "MineTime") centerFloat | ||
322 | , NS "emacs" "emacsclient -c -F \"'(title . \\\"Scratchpad\\\")\"" (className =? "Emacs" <&&> title =? "Scratchpad") centerFloat | ||
323 | , NS "music" "google-play-music-desktop-player --force-device-scale-factor=1.6" (className =? "Google Play Music Desktop Player") centerFloat | ||
324 | ] | ||
325 | centerFloat = customFloating $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) | ||
326 | centerFloatSmall = customFloating $ RationalRect (1 % 4) (1 % 4) (1 % 2) (1 % 2) | ||
327 | hWsp = wspFromMap workspaceNames | ||
328 | hCoWsp = coWspFromMap workspaceNames | ||
329 | assign wsp test = (\wsp -> test -?> doShift wsp) <$> hCoWsp wsp | ||
330 | assign' :: [String] -> Query Bool -> Maybe MaybeManageHook | ||
331 | assign' wsps test = do | ||
332 | wsIds <- mapM hCoWsp wsps | ||
333 | return $ test -?> go wsIds | ||
334 | where | ||
335 | go :: [WorkspaceId] -> ManageHook | ||
336 | go wsps = do | ||
337 | visWsps <- liftX $ (\wset -> W.tag . W.workspace <$> W.current wset : W.visible wset) <$> gets windowset | ||
338 | case (filter (`elem` visWsps) wsps, wsps) of | ||
339 | (wsp : _, _) -> doShift wsp | ||
340 | (_, wsp : _) -> doShift wsp | ||
341 | ([], []) -> return mempty | ||
342 | rotate rot = do | ||
343 | safeSpawn "xrandr" ["--output", "eDP-1", "--rotate", xrandrDir] | ||
344 | mapM_ rotTouch touchscreens | ||
345 | where | ||
346 | xrandrDir = case rot of | ||
347 | U -> "normal" | ||
348 | L -> "left" | ||
349 | R -> "right" | ||
350 | D -> "inverted" | ||
351 | matrix = case rot of | ||
352 | U -> [ [ 1, 0, 0] | ||
353 | , [ 0, 1, 0] | ||
354 | , [ 0, 0, 1] | ||
355 | ] | ||
356 | L -> [ [ 0, -1, 1] | ||
357 | , [ 1, 0, 0] | ||
358 | , [ 0, 0, 1] | ||
359 | ] | ||
360 | R -> [ [ 0, 1, 0] | ||
361 | , [-1, 0, 1] | ||
362 | , [ 0, 0, 1] | ||
363 | ] | ||
364 | D -> [ [-1, 0, 1] | ||
365 | , [ 0, -1, 1] | ||
366 | , [ 0, 0, 1] | ||
367 | ] | ||
368 | touchscreens = [ "Wacom Co.,Ltd. Pen and multitouch sensor Finger touch" | ||
369 | , "Wacom Co.,Ltd. Pen and multitouch sensor Pen stylus" | ||
370 | , "Wacom Co.,Ltd. Pen and multitouch sensor Pen eraser" | ||
371 | ] | ||
372 | rotTouch screen = do | ||
373 | safeSpawn "xinput" $ ["set-prop", screen, "Coordinate Transformation Matrix"] ++ map (\n -> show n ++ ",") (concat matrix) | ||
374 | safeSpawn "xinput" ["map-to-output", screen, "eDP-1"] | ||
375 | withPw f label = io . void . forkProcess $ do | ||
376 | uninstallSignalHandlers | ||
377 | void $ createSession | ||
378 | (dropWhileEnd isSpace -> pw) <- readCreateProcess (proc "pass" ["show", label]) "" | ||
379 | void $ f pw | ||
380 | pwType :: String -> X () | ||
381 | pwType = withPw $ readCreateProcess (proc "xdotool" ["type", "--clearmodifiers", "--file", "-"]) | ||
382 | pwClip label = safeSpawn "pass" ["show", "--clip", label] | ||
383 | pwShow :: String -> X () | ||
384 | pwShow = withPw $ \pw -> do | ||
385 | xmessage <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE") | ||
386 | readCreateProcess (proc xmessage ["-file", "-"]) pw | ||
387 | fuzzytime str = safeSpawn "fuzzytime" $ "timer" : words str | ||
388 | work_fuzzytime = io . void . forkProcess $ do | ||
389 | readCreateProcess (proc "worktime" []) "" >>= safeSpawn "fuzzytime" . ("timer" : ) . pure | ||
390 | adjmix str = safeSpawn "adjmix" $ words str | ||
391 | dc expr = void . xfork $ do | ||
392 | result <- readProcess "dc" [] $ expr ++ "f" | ||
393 | let | ||
394 | (first : rest) = filter (not . null) $ lines result | ||
395 | notification = Notify.summary first <> Notify.body (unlines rest) <> Notify.timeout Infinite <> Notify.urgency Normal <> Notify.appName "dc" | ||
396 | void $ Notify.display notification | ||
397 | synergyCompl = mkComplFunFromList' ["mathw86"] | ||
398 | synergyStart host = safeSpawn "systemctl" ["--user", "start", "synergy-rtunnel@" ++ host ++ ".service"] | ||
399 | synergyStop host = safeSpawn "systemctl" ["--user", "stop", "synergy-rtunnel@" ++ host ++ ".service"] | ||
400 | |||
401 | hostFromName _ = defaultHost | ||
402 | |||
403 | -- muteRef :: IORef (Maybe (String, Notification)) | ||
404 | -- {-# NOINLINE muteRef #-} | ||
405 | -- muteRef = unsafePerformIO $ newIORef Nothing | ||
406 | |||
407 | -- startMute, stopMute :: String -> X () | ||
408 | -- startMute sink = liftIO $ do | ||
409 | -- muted <- isJust <$> readIORef muteRef | ||
410 | -- when (not muted) $ do | ||
411 | -- let | ||
412 | -- notification = Notify.summary "Muted" <> Notify.timeout Infinite <> Notify.urgency Normal | ||
413 | -- level = "0.0dB" | ||
414 | -- -- level <- runProcessWithInput "ssh" ["bragi", "cat", "/dev/shm/mix/" ++ sink ++ "/level"] "" | ||
415 | -- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", "0"] | ||
416 | -- hPutStrLn stderr "Mute" | ||
417 | -- writeIORef muteRef . Just . (level, ) =<< Notify.display notification | ||
418 | -- stopMute sink = liftIO $ do | ||
419 | -- let | ||
420 | -- unmute (Just (level, notification)) = do | ||
421 | -- hPutStrLn stderr "Unmute" | ||
422 | -- -- callProcess "ssh" ["bragi", "adjmix", "-t", sink, "-o", level] | ||
423 | -- Notify.close notification | ||
424 | -- unmute Nothing = return () | ||
425 | -- muted <- isJust <$> readIORef muteRef | ||
426 | -- when muted . join . atomicModifyIORef muteRef $ (Nothing, ) . unmute | ||
427 | |||
428 | wspFromMap workspaceNames = \i -> case Map.lookup i workspaceNames of | ||
429 | Just str -> show i ++ " " ++ str | ||
430 | Nothing -> show i | ||
431 | |||
432 | coWspFromMap workspaceNames = \str -> case filter ((== str) . snd) $ Map.toList workspaceNames of | ||
433 | [] -> Nothing | ||
434 | [(i, _)] -> Just $ wspFromMap workspaceNames i | ||
435 | _ -> Nothing | ||
436 | |||
437 | spawnModifiers = [0, controlMask, shiftMask .|. controlMask] | ||
438 | spawnBindings :: XConfig layout -> (KeySym, [X ()]) -> [((KeyMask, KeySym), X ())] | ||
439 | spawnBindings conf (k, cmds) = zipWith (\m cmd -> ((modm .|. mod1Mask .|. m, k), cmd)) spawnModifiers cmds | ||
440 | where | ||
441 | modm = XMonad.modMask conf | ||
442 | |||
443 | manageScratchTerm = (resource =? "scratchpad" <||> resource =? "keysetup") -?> doRectFloat $ RationalRect (1 % 16) (1 % 16) (7 % 8) (7 % 8) | ||
444 | |||
445 | tabbedLayout t = renamed [Replace "Tabbed"] $ reflectHoriz $ t CustomShrink $ tabbedTheme | ||
446 | tabbedLayoutHoriz t = renamed [Replace "Tabbed Horiz"] $ reflectVert $ t CustomShrink $ tabbedTheme | ||
447 | tabbedTheme = def | ||
448 | { activeColor = "black" | ||
449 | , inactiveColor = "black" | ||
450 | , urgentColor = "black" | ||
451 | , activeBorderColor = "grey" | ||
452 | , inactiveBorderColor = "#202020" | ||
453 | , urgentBorderColor = "#bb0000" | ||
454 | , activeTextColor = "grey" | ||
455 | , inactiveTextColor = "grey" | ||
456 | , urgentTextColor = "grey" | ||
457 | , decoHeight = 32 | ||
458 | , fontName = "xft:Fira Mono for Powerline:style=Medium:pixelsize=22.5" | ||
459 | } | ||
460 | |||
461 | main :: IO () | ||
462 | main = do | ||
463 | arguments <- either (const []) id <$> tryIOError getArgs | ||
464 | case arguments of | ||
465 | ["--command", s] -> do | ||
466 | d <- openDisplay "" | ||
467 | rw <- rootWindow d $ defaultScreen d | ||
468 | a <- internAtom d "XMONAD_COMMAND" False | ||
469 | m <- internAtom d s False | ||
470 | allocaXEvent $ \e -> do | ||
471 | setEventType e clientMessage | ||
472 | setClientMessageEvent e rw a 32 m currentTime | ||
473 | sendEvent d rw False structureNotifyMask e | ||
474 | sync d False | ||
475 | _ -> do | ||
476 | -- batteryMon <- xfork $ monitorBattery Nothing Nothing | ||
477 | hostname <- getHostName | ||
478 | let | ||
479 | host = hostFromName hostname | ||
480 | setEnv "HOST" hostname | ||
481 | let myConfig = withHostUrgency . ewmh $ docks def | ||
482 | { manageHook = hManageHook host | ||
483 | , terminal = "urxvtc" | ||
484 | , layoutHook = smartBorders . avoidStruts $ windowNavigation layout' | ||
485 | , logHook = do | ||
486 | dynamicLogString xmobarPP' >>= writeProps | ||
487 | updatePointer (99 % 100, 98 % 100) (0, 0) | ||
488 | , modMask = mod4Mask | ||
489 | , keys = \conf -> hKeysMod host conf $ myKeys' conf host | ||
490 | , workspaces = take (length numKeys) $ map wsp [1..] | ||
491 | , startupHook = setDefaultCursor xC_left_ptr | ||
492 | , normalBorderColor = "#202020" | ||
493 | , focusedBorderColor = "grey" | ||
494 | , handleEventHook = fullscreenEventHook <+> (serverModeEventHookCmd' $ hCmds host) <+> keyUpEventHook | ||
495 | } | ||
496 | writeProps str = do | ||
497 | let encodeCChar = map $ fromIntegral . fromEnum | ||
498 | atoms = [ "_XMONAD_WORKSPACES" | ||
499 | , "_XMONAD_LAYOUT" | ||
500 | , "_XMONAD_TITLE" | ||
501 | ] | ||
502 | (flip mapM_) (zip atoms (lines str)) $ \(atom', content) -> do | ||
503 | ustring <- getAtom "UTF8_STRING" | ||
504 | atom <- getAtom atom' | ||
505 | withDisplay $ \dpy -> io $ do | ||
506 | root <- rootWindow dpy $ defaultScreen dpy | ||
507 | changeProperty8 dpy root atom ustring propModeReplace $ encodeCChar content | ||
508 | sync dpy True | ||
509 | wsp = hWsp host | ||
510 | -- We can´t define per-host layout modifiers because we lack dependent types | ||
511 | layout' = onHost "skadhi" ( onWorkspace (wsp 1) (Full ||| withIM (1%5) (Title "Buddy List") tabbedLayout') $ | ||
512 | onWorkspace (wsp 10) Full $ | ||
513 | onWorkspace (wsp 2) (Full ||| tabbedLayout') $ | ||
514 | onWorkspace (wsp 5) tabbedLayout' $ | ||
515 | onWorkspace (wsp 8) (withIM (1%5) (Title "Friends") tabbedLayout') $ | ||
516 | defaultLayouts | ||
517 | ) $ | ||
518 | onHost "vali" ( onWorkspace (wsp 2) (Full ||| tabbedLayout' ||| combineTwo (TwoPane 0.01 0.57) Full tabbedLayout') $ | ||
519 | onWorkspace (wsp 3) workLayouts $ | ||
520 | defaultLayouts | ||
521 | ) $ | ||
522 | onHost "hel" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ | ||
523 | onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ | ||
524 | onWorkspace (wsp 3) workLayouts $ | ||
525 | onWorkspace (wsp 6) workLayouts $ | ||
526 | onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ | ||
527 | onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ | ||
528 | onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ | ||
529 | defaultLayouts | ||
530 | ) $ | ||
531 | onHost "sif" ( onWorkspace (wsp 1) (withIM (1 % 8) (Title "Buddy List") $ trackFloating tabbedLayout') $ | ||
532 | onWorkspace (wsp 2) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ | ||
533 | onWorkspace (wsp 3) workLayouts $ | ||
534 | onWorkspace (wsp 6) workLayouts $ | ||
535 | onWorkspace (wsp 4) (tabbedLayout' ||| tabbedLayoutHoriz' ||| Dwindle R CW 1 (5 % 100)) $ | ||
536 | onWorkspace (wsp 5) (tabbedLayout''' ||| Dwindle R CW 1 (5 % 100)) $ | ||
537 | onWorkspace (wsp 8) tabbedLayout''' $ | ||
538 | onWorkspace (wsp 10) (tabbedLayout''' ||| combineTwoP (TwoPane (1 % 100) (3 % 4)) tabbedLayout''' tabbedLayout''' (ClassName "mpv") ||| Dwindle R CW 1 (5 % 100)) $ | ||
539 | defaultLayouts | ||
540 | ) $ | ||
541 | defaultLayouts | ||
542 | -- tabbedLayout''' = renamed [Replace "Tabbed'"] $ IfMax 1 (noBorders Full) (tabbedLayout tabbedBottomAlways) | ||
543 | tabbedLayout''' = tabbedLayout tabbedBottom | ||
544 | tabbedLayout' = tabbedLayout tabbedBottomAlways | ||
545 | tabbedLayoutHoriz' = tabbedLayoutHoriz tabbedLeftAlways | ||
546 | defaultLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW 1 (5 % 100) ||| tabbedLayout' ||| Full | ||
547 | -- workLayouts = {- spiralWithDir East CW (1 % 2) -} Dwindle R CW (2 % 1) (5 % 100) ||| tabbedLayout' ||| Full | ||
548 | workLayouts = tabbedLayout' ||| (renamed [Replace "Combined"] $ combineTwoP (TwoPane (1 % 100) (1891 % 2560)) tabbedLayout''' (Column 1.6) (ClassName "Postman" `Or` ClassName "Emacs" `Or` ClassName "jetbrains-idea-ce" `Or` (Resource "Devtools" `And` ClassName "Firefox"))) ||| Full ||| Dwindle R CW 1 (5 % 100) | ||
549 | sqrtTwo = approxRational (sqrt 2) (1 / 2560) | ||
550 | xmobarPP' = xmobarPP { ppTitle = shorten 80 | ||
551 | , ppSort = (liftM2 (.)) getSortByIndex $ return scratchpadFilterOutWorkspace | ||
552 | , ppUrgent = wrap "(" ")" . xmobarColor "#800000" "" | ||
553 | , ppHiddenNoWindows = xmobarColor "#202020" "" . wrap "(" ")" | ||
554 | , ppVisible = wrap "(" ")" . xmobarColor "#808000" "" | ||
555 | , ppCurrent = wrap "(" ")" . xmobarColor "#008000" "" | ||
556 | , ppHidden = wrap "(" ")" | ||
557 | , ppWsSep = " " | ||
558 | , ppSep = "\n" | ||
559 | } | ||
560 | withHostUrgency = case hostname of | ||
561 | "hel" -> withUrgencyHookC urgencyHook' $ urgencyConfig { suppressWhen = U.Never, remindWhen = Dont } | ||
562 | "sif" -> withUrgencyHookC urgencyHook' $ urgencyConfig { suppressWhen = U.Never, remindWhen = Dont } | ||
563 | _ -> id | ||
564 | urgencyHook' window = do | ||
565 | runQuery ((resource =? "comm" <||> resource =? "Pidgin" <||> className =? "Gajim" <||> className =? "Skype") --> safeSpawn "thinklight" ["Blink", "100"]) window | ||
566 | urgencyHook (BorderUrgencyHook { urgencyBorderColor = "#bb0000" }) window | ||
567 | shutdown :: SomeException -> IO a | ||
568 | shutdown e = do | ||
569 | let pids = [ -- batteryMon | ||
570 | ] | ||
571 | mapM_ (signalProcess sigTERM) pids | ||
572 | mapM_ (getProcessStatus False False) pids | ||
573 | throw e | ||
574 | keyUpEventHook :: Event -> X All | ||
575 | keyUpEventHook event = handle event >> return (All True) | ||
576 | where | ||
577 | handle (KeyEvent { ev_event_type = t, ev_state = m, ev_keycode = code }) | ||
578 | | t == keyRelease = withDisplay $ \dpy -> do | ||
579 | s <- io $ keycodeToKeysym dpy code 0 | ||
580 | mClean <- cleanMask m | ||
581 | ks <- asks $ hKeyUpKeys host . config | ||
582 | userCodeDef () $ whenJust (Map.lookup (mClean, s) ks) id | ||
583 | | otherwise = return () | ||
584 | handle _ = return () | ||
585 | handle shutdown $ launch myConfig | ||
586 | |||
587 | secs :: Int -> Int | ||
588 | secs = (* 1000000) | ||
589 | |||
590 | -- monitorBattery :: Maybe BatteryContext -> Maybe Notification -> IO () | ||
591 | -- monitorBattery Nothing n = do | ||
592 | -- ctx <- batteryContextNew | ||
593 | -- case ctx of | ||
594 | -- Nothing -> threadDelay (secs 10) >> monitorBattery Nothing n | ||
595 | -- Just _ -> monitorBattery ctx n | ||
596 | -- monitorBattery ctx@(Just ctx') n = do | ||
597 | -- batInfo <- getBatteryInfo ctx' | ||
598 | -- case batInfo of | ||
599 | -- Nothing -> threadDelay (secs 1) >> monitorBattery ctx n | ||
600 | -- Just batInfo -> do | ||
601 | -- let n' | ||
602 | -- | batteryState batInfo == BatteryStateDischarging | ||
603 | -- , timeLeft <= 1200 | ||
604 | -- , timeLeft > 0 = Just $ summary "Discharging" <> hint "value" percentage <> urgency u <> body (duz timeLeft ++ "left") | ||
605 | -- | otherwise = Nothing | ||
606 | -- u | ||
607 | -- | timeLeft <= 600 = Critical | ||
608 | -- | timeLeft <= 1800 = Normal | ||
609 | -- | otherwise = Low | ||
610 | -- timeLeft = batteryTimeToEmpty batInfo | ||
611 | -- percentage :: Int32 | ||
612 | -- percentage = round $ batteryPercentage batInfo | ||
613 | -- ts = [("s", 60), ("m", 60), ("h", 24), ("d", 365), ("y", 1)] | ||
614 | -- duz ms = ss | ||
615 | -- where (ss, _) = foldl (\(ss, x) (s, y) -> ((if rem x y > 0 then show (rem x y) ++ s ++ " " else "") ++ ss , quot x y)) ("", ms) ts | ||
616 | -- case n' of | ||
617 | -- Just n' -> Notify.display (maybe mempty reuse n <> Notify.appName "monitorBattery" <> n') >>= (\n -> threadDelay (secs 2) >> monitorBattery ctx (Just n)) | ||
618 | -- Nothing -> threadDelay (secs 30) >> monitorBattery ctx n | ||
619 | |||
620 | disableTouchpad, disableTrackpoint, enableTrackpoint, enableTouchpad :: X () | ||
621 | enableTouchpad = safeSpawn "xinput" ["enable", "SynPS/2 Synaptics TouchPad"] | ||
622 | disableTouchpad = safeSpawn "xinput" ["disable", "SynPS/2 Synaptics TouchPad"] | ||
623 | enableTrackpoint = safeSpawn "xinput" ["enable", "TPPS/2 IBM TrackPoint"] | ||
624 | disableTrackpoint = safeSpawn "xinput" ["disable", "TPPS/2 IBM TrackPoint"] | ||
625 | |||
626 | isDisabled :: String -> X Bool | ||
627 | isDisabled str = do | ||
628 | out <- runProcessWithInput "xinput" ["list", str] "" | ||
629 | return $ "disabled" `isInfixOf` out | ||
630 | |||
631 | |||
632 | spawnKeychain :: X () | ||
633 | spawnKeychain = do | ||
634 | home <- liftIO getHomeDirectory | ||
635 | let keys = (map ((home </>) . (".ssh/" ++)) ["id", "id-rsa"]) ++ ["6B13AA67"] | ||
636 | liftIO (maybe (return ()) (setEnv "SSH_ASKPASS") =<< findAskpass) | ||
637 | safeSpawn "keychain" . (["--agents", "gpg,ssh"] ++)=<< liftIO (filterM doesFileExist keys) | ||
638 | where | ||
639 | findAskpass = filter `liftM` readFile "/etc/zshrc" | ||
640 | filter = listToMaybe . catMaybes . map (stripPrefix "export SSH_ASKPASS=") . lines | ||
641 | |||
642 | assimilateKeychain :: X () | ||
643 | assimilateKeychain = liftIO $ assimilateKeychain' >> return () | ||
644 | assimilateKeychain' = tryIOError $ do | ||
645 | -- pid <- getProcessID | ||
646 | -- tmpDir <- lookupEnv "TMPDIR" | ||
647 | -- let tmpDir' = fromMaybe "/tmp" tmpDir | ||
648 | -- tmpFile = tmpDir' </> "xmonad-keychain" ++ (show pid) ++ ".env" | ||
649 | env <- runProcessWithInput "sh" ["-c", "eval $(keychain --eval --noask --agents gpg,ssh); env"] "" -- > " ++ tmpFile] "" | ||
650 | -- env <- readFile tmpFile | ||
651 | let envVars = Map.fromList $ map (\(k, v) -> (k, tail' v)) $ map (span (/= '=')) $ envLines | ||
652 | envVars' = Map.filterWithKey (\k _ -> k `elem` transfer) envVars | ||
653 | transfer = ["SSH_AUTH_SOCK", "SSH_AGENT_PID", "GPG_AGENT_INFO"] | ||
654 | envLines = filter (elem '=') $ lines env :: [String] | ||
655 | sequence $ map (\(k, c) -> setEnv k c) $ Map.toList envVars' | ||
656 | -- removeFile tmpFile | ||
657 | where | ||
658 | tail' [] = [] | ||
659 | tail' (x:xs) = xs | ||
660 | |||
661 | |||
662 | numKeys = [xK_parenleft, xK_parenright, xK_braceright, xK_plus, xK_braceleft, xK_bracketright, xK_bracketleft, xK_exclam, xK_equal, xK_asterisk] | ||
663 | |||
664 | instance Shrinker CustomShrink where | ||
665 | shrinkIt _ "" = [""] | ||
666 | shrinkIt s cs | ||
667 | | length cs >= 4 = cs : shrinkIt s ((reverse . drop 4 . reverse $ cs) ++ "...") | ||
668 | | otherwise = cs : shrinkIt s (init cs) | ||
669 | |||
670 | xPConfig :: XPConfig | ||
671 | xPConfig = def | ||
672 | { font = "xft:Fira Mono for Powerline:style=Medium:pixelsize=22.5" | ||
673 | , height = 32 | ||
674 | , bgColor = "black" | ||
675 | , fgColor = "grey" | ||
676 | , fgHLight = "green" | ||
677 | , bgHLight = "black" | ||
678 | , borderColor = "grey" | ||
679 | , searchPredicate = (\needle haystack -> all (`isInfixOf` map toLower haystack) . map (map toLower) $ words needle) | ||
680 | , position = Top | ||
681 | } | ||
682 | |||
683 | sshOverrides host = map (\h -> mkOverride { oHost = h, oCommand = moshCmd . inTmux host} ) | ||
684 | [ "odin" | ||
685 | , "ymir" | ||
686 | , "surtr" | ||
687 | ] | ||
688 | ++ | ||
689 | map (\h -> mkOverride { oHost = h, oCommand = moshCmd' "/run/current-system/sw/bin/mosh-server" . withEnv [("TERM", "xterm")] . inTmux host} ) | ||
690 | [ "bragi", "bragi.asgard.yggdrasil" | ||
691 | ] | ||
692 | ++ | ||
693 | map (\h -> mkOverride { oHost = h, oCommand = sshCmd . inTmux host } ) | ||
694 | [ "uni2work-dev1" | ||
695 | ] | ||
696 | ++ | ||
697 | map (\h -> mkOverride { oHost = h, oCommand = sshCmd . withEnv [("TERM", "xterm")] . inTmux host } ) | ||
698 | [ "remote.cip.ifi.lmu.de" | ||
699 | , "uniworx3", "uniworx4", "uniworx5", "uniworxdb2" | ||
700 | , "testworx" | ||
701 | ] | ||
702 | |||
703 | backlight :: (Rational -> Rational) -> X () | ||
704 | backlight f = void . xfork . liftIO $ do | ||
705 | [ _device | ||
706 | , _class | ||
707 | , read . Text.unpack -> currentBright | ||
708 | , _currentPercentage | ||
709 | , read . Text.unpack -> maximumBright | ||
710 | ] <- Text.splitOn "," . Text.pack <$> readProcess "brightnessctl" ["-m"] "" | ||
711 | let current = currentBright % maximumBright | ||
712 | new' = f current * fromIntegral maximumBright | ||
713 | new :: Integer | ||
714 | new | floor new' < 0 = 0 | ||
715 | | ceiling new' > maximumBright = maximumBright | ||
716 | | new' >= maximumBright % 2 = ceiling new' | ||
717 | | otherwise = floor new' | ||
718 | callProcess "brightnessctl" ["-m", "s", show new] | ||
719 | |||
720 | cycleThrough :: [Rational] -> (Rational -> Rational) | ||
721 | cycleThrough opts current = fromMaybe currentOpt $ listToMaybe next' | ||
722 | where currentOpt = minimumBy (comparing $ abs . subtract current) opts | ||
723 | (_, _ : next') = break (== currentOpt) opts | ||
724 | |||
725 | cycleKbLayout :: [(String, Maybe String)] -> X () | ||
726 | cycleKbLayout [] = return () | ||
727 | cycleKbLayout layouts = liftIO $ do | ||
728 | next <- (getNext . extract) `liftM` runProcessWithInput "setxkbmap" ["-query"] "" | ||
729 | let | ||
730 | args = case next of | ||
731 | (l, Just v) -> [l, v] | ||
732 | (l, Nothing) -> [l] | ||
733 | safeSpawn "setxkbmap" args | ||
734 | where | ||
735 | extract :: String -> Maybe (String, Maybe String) | ||
736 | extract str = listToMaybe $ do | ||
737 | ["layout:", l] <- str' | ||
738 | [(l, Just v) | ["variant:", v] <- str'] ++ pure (l, Nothing) | ||
739 | where | ||
740 | str' = map words $ lines str | ||
741 | getNext :: Maybe (String, Maybe String) -> (String, Maybe String) | ||
742 | getNext = maybe (head layouts) getNext' | ||
743 | getNext' x = case elemIndex x layouts of | ||
744 | Nothing -> getNext Nothing | ||
745 | Just i -> layouts !! ((i + 1) `mod` length layouts) | ||
746 | |||
747 | mpvAll' :: MpvCommand -> IO [MpvResponse] | ||
748 | mpvAll' = mpvAll "/var/media/.mpv-ipc" | ||
749 | |||
750 | mpvOne' :: MpvCommand -> IO (Maybe MpvResponse) | ||
751 | mpvOne' = mpvOne "/var/media/.mpv-ipc" | ||
752 | |||
753 | mediaMpv :: MpvCommand -> X () | ||
754 | mediaMpv cmd = void . xfork $ print =<< mpvAll' cmd | ||
755 | |||
756 | mediaMpvTogglePause :: X () | ||
757 | mediaMpvTogglePause = void . xfork $ do | ||
758 | paused <- mapM mpvResponse <=< mpvAll' $ MpvGetProperty "pause" | ||
759 | if | ||
760 | | and paused -> print <=< mpvAll' $ MpvSetProperty "pause" False | ||
761 | | otherwise -> print <=< mpvOne' $ MpvSetProperty "pause" True | ||
762 | |||
763 | myKeys' conf host = Map.fromList $ | ||
764 | -- launch a terminal | ||
765 | [ ((modm, xK_Return), spawn $ (XMonad.terminal conf) ++ " -e tmux") | ||
766 | , ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) | ||
767 | |||
768 | -- launch dmenu | ||
769 | --, ((modm, xK_d ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") | ||
770 | , ((modm, xK_d ), shellPrompt "Run: " xPConfig) | ||
771 | , ((modm .|. shiftMask, xK_d ), prompt "Run in Terminal: " ("urxvtc" ++ " -e") xPConfig) | ||
772 | , ((modm, xK_at ), sshPrompt (sshOverrides . Just $ hName host) xPConfig) | ||
773 | |||
774 | -- close focused window | ||
775 | , ((modm .|. shiftMask, xK_q ), kill) | ||
776 | , ((modm .|. controlMask .|. shiftMask, xK_q ), spawn "xkill") | ||
777 | |||
778 | -- Rotate through the available layout algorithms | ||
779 | , ((modm, xK_space ), sendMessage NextLayout) | ||
780 | |||
781 | -- Reset the layouts on the current workspace to default | ||
782 | , ((modm .|. controlMask, xK_r ), (setLayout $ XMonad.layoutHook conf) >> refresh) | ||
783 | |||
784 | -- Resize viewed windows to the correct size | ||
785 | , ((modm, xK_r ), refresh) | ||
786 | |||
787 | -- Move focus to the next window | ||
788 | , ((modm, xK_t ), windows W.focusDown) | ||
789 | |||
790 | -- Move focus to the previous window | ||
791 | , ((modm, xK_n ), windows W.focusUp ) | ||
792 | |||
793 | -- Move focus to the master window | ||
794 | , ((modm, xK_m ), windows W.focusMaster ) | ||
795 | |||
796 | -- Swap the focused window and the master window | ||
797 | , ((modm .|. shiftMask, xK_m ), windows W.swapMaster) | ||
798 | |||
799 | -- Swap the focused window with the next window | ||
800 | , ((modm .|. shiftMask, xK_t ), windows W.swapDown ) | ||
801 | |||
802 | -- Swap the focused window with the previous window | ||
803 | , ((modm .|. shiftMask, xK_n ), windows W.swapUp ) | ||
804 | |||
805 | -- Swap the focused window with the previous window | ||
806 | , ((modm .|. shiftMask .|. controlMask, xK_m), sendMessage SwapWindow) | ||
807 | |||
808 | , ((modm, xK_Right), sendMessage $ Go R) | ||
809 | , ((modm, xK_Left ), sendMessage $ Go L) | ||
810 | , ((modm, xK_Up ), sendMessage $ Go U) | ||
811 | , ((modm, xK_Down ), sendMessage $ Go D) | ||
812 | , ((modm .|. shiftMask , xK_Right), sendMessage $ Move R) | ||
813 | , ((modm .|. shiftMask , xK_Left ), sendMessage $ Move L) | ||
814 | , ((modm .|. shiftMask , xK_Up ), sendMessage $ Move U) | ||
815 | , ((modm .|. shiftMask , xK_Down ), sendMessage $ Move D) | ||
816 | -- , ((modm .|. controlMask, xK_Right), withFocused $ keysMoveWindow (10, 0)) | ||
817 | -- , ((modm .|. controlMask, xK_Left ), withFocused $ keysMoveWindow (-10, 0)) | ||
818 | -- , ((modm .|. controlMask, xK_Up ), withFocused $ keysMoveWindow (0, -10)) | ||
819 | -- , ((modm .|. controlMask, xK_Down ), withFocused $ keysMoveWindow (0, 10)) | ||
820 | -- Shrink the master area | ||
821 | , ((modm, xK_h ), sendMessage Shrink) | ||
822 | |||
823 | -- Expand the master area | ||
824 | , ((modm, xK_s ), sendMessage Expand) | ||
825 | |||
826 | -- Push window back into tiling | ||
827 | , ((modm .|. shiftMask, xK_space ), withFocused $ windows . W.sink) | ||
828 | , ((modm, xK_BackSpace), focusUrgent) | ||
829 | , ((modm .|. shiftMask, xK_BackSpace), clearUrgents) | ||
830 | |||
831 | -- Increment the number of windows in the master area | ||
832 | , ((modm , xK_comma ), sendMessage (IncMasterN 1)) | ||
833 | |||
834 | -- Deincrement the number of windows in the master area | ||
835 | , ((modm , xK_period), sendMessage (IncMasterN (-1))) | ||
836 | |||
837 | , ((0, xF86XK_AudioRaiseVolume), safeSpawn "pulseaudio-ctl" ["up", "2"]) | ||
838 | , ((0, xF86XK_AudioLowerVolume), safeSpawn "pulseaudio-ctl" ["down", "2"]) | ||
839 | , ((0, xF86XK_AudioMute), safeSpawn "pulseaudio-ctl" ["mute"]) | ||
840 | , ((0, xF86XK_AudioPause), mediaMpv $ MpvSetProperty "pause" False) | ||
841 | , ((0, {-xF86XK_AudioMicMute-} 269025202), safeSpawn "pulseaudio-ctl" ["mute-input"]) | ||
842 | , ((0, xF86XK_AudioPlay), mediaMpvTogglePause) | ||
843 | , ((modm .|. mod1Mask, xK_space), mediaMpvTogglePause) | ||
844 | |||
845 | , ((0, xF86XK_MonBrightnessDown), backlight (subtract 5)) | ||
846 | , ((0, xF86XK_MonBrightnessUp), backlight (+ 5)) | ||
847 | |||
848 | , ((modm , xK_Escape), cycleKbLayout (hKbLayouts host)) | ||
849 | , ((modm .|. controlMask, xK_Escape), safeSpawn "setxkbmap" $ fst (head $ hKbLayouts host) : maybeToList (snd . head $ hKbLayouts host)) | ||
850 | |||
851 | -- Toggle the status bar gap | ||
852 | -- Use this binding with avoidStruts from Hooks.ManageDocks. | ||
853 | -- See also the statusBar function from Hooks.DynamicLog. | ||
854 | -- | ||
855 | , ((modm , xK_b ), sendMessage ToggleStruts) | ||
856 | |||
857 | , ((modm .|. shiftMask, xK_p ), safeSpawn "playerctl" ["-a", "pause"]) | ||
858 | |||
859 | -- Quit xmonad | ||
860 | , ((modm .|. shiftMask, xK_e ), io (exitWith ExitSuccess)) | ||
861 | |||
862 | -- Restart xmonad | ||
863 | -- , ((modm .|. shiftMask .|. controlMask, xK_r ), void . xfork $ recompile False >>= flip when (safeSpawn "xmonad" ["--restart"])) | ||
864 | , ((modm .|. shiftMask, xK_r ), void . liftIO $ executeFile "xmonad" True [] Nothing) | ||
865 | , ((modm .|. shiftMask, xK_l ), void . xfork $ do | ||
866 | sessId <- getEnv "XDG_SESSION_ID" | ||
867 | safeSpawn "loginctl" ["lock-session", sessId] | ||
868 | ) | ||
869 | , ((modm .|. shiftMask, xK_s ), safeSpawn "systemctl" ["suspend"]) | ||
870 | , ((modm .|. shiftMask, xK_h ), safeSpawn "systemctl" ["hibernate"]) | ||
871 | , ((modm .|. shiftMask, xK_b ), backlight $ cycleThrough [1, 3 % 4, 1 % 2, 1 % 4, 1 % 10, 1 % 100, 0] | ||
872 | ) | ||
873 | , ((modm .|. shiftMask .|. controlMask, xK_b), backlight $ cycleThrough [0, 1 % 100, 1 % 10, 1 % 4, 1 % 2, 3 % 4, 1] | ||
874 | ) | ||
875 | , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible | ||
876 | , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back | ||
877 | , ((modm .|. shiftMask, xK_g ), windowPrompt xPConfig Goto wsWindows) | ||
878 | , ((modm .|. shiftMask .|. controlMask, xK_g ), windowPrompt xPConfig Bring allWindows) | ||
879 | ] | ||
880 | ++ | ||
881 | |||
882 | -- | ||
883 | -- mod-[1..9], Switch to workspace N | ||
884 | -- | ||
885 | -- mod-[1..9], Switch to workspace N | ||
886 | -- mod-shift-[1..9], Move client to workspace N | ||
887 | -- | ||
888 | [((m .|. modm, k), windows $ f i) | ||
889 | | (i, k) <- zip (XMonad.workspaces conf) $ numKeys | ||
890 | , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)] | ||
891 | ] | ||
892 | ++ | ||
893 | [((m .|. modm .|. controlMask, k), void . runMaybeT $ | ||
894 | MaybeT (P.getScreen def i) >>= MaybeT . screenWorkspace >>= lift . windows . f | ||
895 | ) | ||
896 | | (i, k) <- zip (hScreens host) [xK_g, xK_c, xK_r, xK_l] | ||
897 | , (f, m) <- [(W.view, 0), (W.shift, shiftMask)] | ||
898 | ] | ||
899 | where | ||
900 | modm = XMonad.modMask conf | ||
901 | |||
902 | |||