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