xmonad.hs (view raw)
1{-# OPTIONS_HADDOCK prune #-}
2{-# OPTIONS_GHC -Wno-deprecations #-}
3
4----------------------------------------------------------------------
5-- |
6-- Description : la-ninpre xmonad config
7-- Maintainer : la-ninpre
8--
9-- personal xmonad config. based heavily on distrotube's config.
10-- i've added some stuff and toki pona fonts
11--
12----------------------------------------------------------------------
13
14module Main where
15
16import System.Directory
17import System.IO (hPutStrLn)
18import System.Exit (exitSuccess)
19
20import Data.Char (isSpace, toUpper)
21import Data.Maybe (fromJust, isJust)
22import Data.Monoid
23import Data.Tree
24import Data.List
25import qualified Data.Map as M
26
27import XMonad
28import qualified XMonad.StackSet as W
29
30import XMonad.Actions.CopyWindow (kill1)
31import XMonad.Actions.CycleWS ( Direction1D(..)
32 , moveTo
33 , shiftTo
34 , WSType(..)
35 , nextScreen
36 , prevScreen
37 )
38import XMonad.Actions.GridSelect
39import XMonad.Actions.MouseResize
40import XMonad.Actions.Promote
41import XMonad.Actions.RotSlaves (rotSlavesDown, rotAllDown)
42import XMonad.Actions.WindowGo (runOrRaise)
43import XMonad.Actions.WithAll (sinkAll, killAll)
44import qualified XMonad.Actions.Search as S
45
46import XMonad.Hooks.DynamicLog
47import XMonad.Hooks.EwmhDesktops
48import XMonad.Hooks.ManageDocks ( avoidStruts
49 , docksEventHook
50 , manageDocks
51 , ToggleStruts(..))
52import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat)
53import XMonad.Hooks.ServerMode
54import XMonad.Hooks.SetWMName
55import XMonad.Hooks.WorkspaceHistory
56
57import XMonad.Layout.SimplestFloat
58import XMonad.Layout.ResizableTile
59import XMonad.Layout.Tabbed
60import XMonad.Layout.ThreeColumns
61import XMonad.Layout.Accordion
62import XMonad.Layout.LayoutModifier
63import XMonad.Layout.LimitWindows (limitWindows, increaseLimit, decreaseLimit)
64import XMonad.Layout.Magnifier
65import XMonad.Layout.MultiToggle (mkToggle, single, EOT(EOT), (??))
66import XMonad.Layout.MultiToggle.Instances (StdTransformers( NBFULL
67 , MIRROR
68 , NOBORDERS
69 ))
70import XMonad.Layout.NoBorders
71import XMonad.Layout.Renamed
72import XMonad.Layout.ShowWName
73import XMonad.Layout.Simplest
74import XMonad.Layout.Spacing
75import XMonad.Layout.SubLayouts
76import XMonad.Layout.WindowNavigation
77import qualified XMonad.Layout.BoringWindows as BW
78import XMonad.Layout.WindowArranger (windowArrange, WindowArrangerMsg(..))
79import qualified XMonad.Layout.ToggleLayouts as T ( toggleLayouts
80 , ToggleLayout(Toggle)
81 )
82import qualified XMonad.Layout.MultiToggle as MT (Toggle(..))
83
84import XMonad.Util.Dmenu
85import XMonad.Util.Loggers
86import XMonad.Util.EZConfig (additionalKeysP)
87import XMonad.Util.NamedScratchpad
88import XMonad.Util.Run (runProcessWithInput, safeSpawn, spawnPipe)
89import XMonad.Util.SpawnOnce
90import XMonad.Util.WorkspaceCompare
91
92import LaNinpreConfig
93
94-- * misc functions
95--
96-- | hides workspaces that have no windows
97myHiddenNoWindows :: WorkspaceId -> String
98myHiddenNoWindows = const ""
99
100mySuperscript :: Int -> String
101mySuperscript n = map ss $ show n
102 where ss c | c == '0' = '⁰'
103 | c == '1' = '¹'
104 | c == '2' = '²'
105 | c == '3' = '³'
106 | c == '4' = '⁴'
107 | c == '5' = '⁵'
108 | c == '6' = '⁶'
109 | c == '7' = '⁷'
110 | c == '8' = '⁸'
111 | c == '9' = '⁹'
112 | otherwise = c
113
114
115-- | window count logger
116--
117-- gets number of windows on current workspace
118myWindowCountLogger :: Logger
119myWindowCountLogger = gets $ Just . show . length . W.integrate' . W.stack
120 . W.workspace . W.current . windowset
121
122-- * grid select
123--
124-- $gridSelect
125--
126-- this section provides theming of @GridSelect@ stuff.
127--
128-- here, @GridSelect@ is used for following things:
129--
130-- * spawning some frequently used programs
131--
132-- * moving to desired window
133--
134-- * bringing the desired window to the current workspace
135
136-- | custom colorizer that colors windows based on their class
137myColorizer :: Window -> Bool -> X (String, String)
138myColorizer = colorRangeFromClassName
139 (0x00,0x00,0x00) -- lowest inactive bg
140 (0xbd,0x9c,0xf9) -- highest inactive bg
141 (0xc7,0x92,0xea) -- active bg
142 (0xc0,0xa7,0x9a) -- inactive fg
143 (0x28,0x2c,0x34) -- active fg
144
145-- | gridSelect config
146myGridConfig :: p -> GSConfig Window
147myGridConfig colorizer = (buildDefaultGSConfig myColorizer)
148 { gs_cellheight = 40
149 , gs_cellwidth = 200
150 , gs_cellpadding = 6
151 , gs_originFractX = 0.5
152 , gs_originFractY = 0.5
153 , gs_font = head myFonts
154 }
155
156-- | spawn selected programs with grid select
157spawnSelected' :: [(String, String)] -> X ()
158spawnSelected' lst = gridselect conf lst >>= flip whenJust spawn
159 where conf = def
160 { gs_cellheight = 40
161 , gs_cellwidth = 200
162 , gs_cellpadding = 6
163 , gs_originFractX = 0.5
164 , gs_originFractY = 0.5
165 , gs_font = head myFonts
166 }
167
168-- * layouts
169--
170-- ** spacing raw helper functions
171--
172-- $spacingHelpers
173--
174-- theese are making calls to spacingRaw simpler to write
175
176-- | for many windows
177mySpacing :: Integer -> l a -> XMonad.Layout.LayoutModifier.ModifiedLayout Spacing l a
178mySpacing i = spacingRaw False (Border i i i i) True (Border i i i i) True
179
180-- | for fewer than two windows
181mySpacing' :: Integer -> l a -> XMonad.Layout.LayoutModifier.ModifiedLayout Spacing l a
182mySpacing' i = spacingRaw True (Border i i i i) True (Border i i i i) True
183
184-- ** actually layouts
185--
186-- $layouts
187--
188-- currently there are:
189--
190-- * tall
191--
192-- * floats
193--
194-- * threeCol
195
196tall = renamed [Replace "tall"]
197 $ smartBorders
198 $ addTabs shrinkText myTabTheme
199 $ subLayout [] (smartBorders Simplest ||| Accordion)
200 $ limitWindows 12
201 $ mySpacing 4
202 $ ResizableTall 1 (5/100) (1/2) []
203
204floats = renamed [Replace "floats"]
205 $ smartBorders
206 $ limitWindows 20
207 simplestFloat
208
209threeCol = renamed [Replace "threeCol"]
210 $ smartBorders
211 $ addTabs shrinkText myTabTheme
212 $ subLayout [] (smartBorders Simplest ||| Accordion)
213 $ limitWindows 7
214 $ mySpacing 4
215 $ ThreeColMid 1 (3/100) (1/2)
216
217-- | setting colors for tabs layout and tabs sublayout.
218myTabTheme = def
219 { fontName = head myFonts
220 , activeColor = myColor "gray4"
221 , inactiveColor = myColor "gray0"
222 , activeBorderColor = myColor "gray4"
223 , inactiveBorderColor = myColor "gray0"
224 , activeTextColor = myColor "bg"
225 , inactiveTextColor = myColor "fg"
226 }
227
228-- ** layout hook
229
230-- $layoutHook
231--
232-- putting it all together with some stuff
233myLayoutHook = avoidStruts
234 $ mouseResize
235 $ BW.boringWindows
236 $ windowNavigation
237 $ windowArrange
238 $ T.toggleLayouts floats
239 $ mkToggle (NBFULL ?? NOBORDERS ?? EOT) myDefaultLayout
240 where
241 myDefaultLayout = withBorder myBorderWidth tall
242 ||| withBorder myBorderWidth threeCol
243
244-- * show wm name hook
245
246-- | theme for showWName which prints current workspace
247-- when you change workspaces.
248myShowWNameTheme :: SWNConfig
249myShowWNameTheme = def
250 { swn_font = myFonts !! 1
251 , swn_fade = 0.7
252 , swn_bgcolor = myColor "bg"
253 , swn_color = myColor "fg"
254 }
255
256-- * workspaces
257--
258-- $workspaces
259--
260-- here are some helper functions to deal with workspaces.
261--
262-- actual workspace list is in "LaNinpreConfig".
263
264-- | workspace indices to use with hotkeys
265myWorkspaceIndices = M.fromList $ zip myWorkspaces [1..]
266
267-- ** clickable workspace wrapper
268--
269-- $clickable
270--
271-- normal variant
272--
273-- > clickable ws = "<action=xdotool key super+"++show i++">"++ws++"</action>"
274-- > where i = fromJust $ M.lookup ws myWorkspaceIndices
275
276-- | provides option to click workspaces to switch to them.
277-- this is handled by @UnsafeStdinReader@ in xmobar config.
278clickable ws = "<fn=3><action=xdotool key super+"++show i++">"++ws++"</action></fn>"
279 where i = fromJust $ M.lookup ws myWorkspaceIndices
280
281-- * keybindings
282
283-- | keybindings list
284--
285-- there's no way to document it using haddock, i guess...
286myKeys :: [(String, X ())]
287myKeys =
288 [ ("M-C-r", spawn "xmonad --recompile") -- Recompiles xmonad
289 , ("M-S-r", spawn "xmonad --restart") -- Restarts xmonad
290 , ("M-S-q", io exitSuccess) -- Quits xmonad
291
292 -- Run Prompt
293 , ("M-r", spawn "dmenu_run -i -p \"Run: \"") -- Dmenu
294
295 -- Other Dmenu Prompts
296 -- In Xmonad and many tiling window managers, M-p is the default keybinding to
297 -- launch dmenu_run, so I've decided to use M-p plus KEY for these dmenu scripts.
298 , ("M-p p", spawn "passmenu") -- passmenu
299 , ("M-p c", spawn "dm-colpick") -- pick color from our scheme
300 , ("M-p e", spawn "dm-confedit") -- edit config files
301 , ("M-p i", spawn "dm-maim") -- screenshots (images)
302 , ("M-p k", spawn "dm-kill") -- kill processes
303 , ("M-p m", spawn "dm-man") -- manpages
304 , ("M-p q", spawn "dm-logout") -- logout menu
305 , ("M-p s", spawn "dm-websearch") -- search various search engines
306 , ("M-p h", spawn "dm-hub") -- hub of all scripts to choose one
307
308 -- Useful programs to have a keybinding for launch
309 , ("M-<Return>", spawn myTerminal)
310 , ("M-e", spawn myFileMgr)
311 , ("M-w", spawn myBrowser)
312 , ("M-i", spawn (myTerminal
313 ++ " --class alacritty,amfora -e "
314 ++ myGeminiClient))
315 , ("M-S-e", spawn "emacsclient -c")
316 -- Kill windows
317 , ("M-S-c", kill1) -- Kill the currently focused client
318 , ("M-S-a", killAll) -- Kill all windows on current workspace
319
320 -- Workspaces
321 , ("M-.", nextScreen) -- Switch focus to next monitor
322 , ("M-,", prevScreen) -- Switch focus to prev monitor
323 -- Shifts focused window to next ws
324 , ("M-S-<KP_Add>", shiftTo Next nonNSP >> moveTo Next nonNSP)
325 -- Shifts focused window to prev ws
326 , ("M-S-<KP_Subtract>", shiftTo Prev nonNSP >> moveTo Prev nonNSP)
327
328 -- Floating windows
329 , ("M-f", sendMessage (T.Toggle "floats")) -- Toggles my 'floats' layout
330 , ("M-t", withFocused $ windows . W.sink) -- Push floating window back to tile
331 , ("M-S-t", sinkAll) -- Push ALL floating windows to tile
332
333 -- Increase/decrease spacing (gaps)
334 , ("C-M1-j", decWindowSpacing 4) -- Decrease window spacing
335 , ("C-M1-k", incWindowSpacing 4) -- Increase window spacing
336 , ("C-M1-h", decScreenSpacing 4) -- Decrease screen spacing
337 , ("C-M1-l", incScreenSpacing 4) -- Increase screen spacing
338
339 -- Grid Select (MOD-g followed by a key)
340 , ("M-g g", spawnSelected' myAppGrid) -- grid select favorite apps
341 , ("M-g t", goToSelected $ myGridConfig myColorizer) -- goto selected window
342 , ("M-g b", bringSelected $ myGridConfig myColorizer) -- bring selected window
343
344 -- Windows navigation
345 , ("M-m", windows W.focusMaster) -- Move focus to the master window
346 , ("M-j", BW.focusDown) -- Move focus to the next window
347 , ("M1-<Tab>", BW.focusDown) -- legacy keybinding
348 , ("M-k", BW.focusUp) -- Move focus to the prev window
349 , ("M-S-m", windows W.swapMaster) -- Swap the focused window and the master window
350 , ("M-S-j", windows W.swapDown) -- Swap focused window with next window
351 , ("M-S-k", windows W.swapUp) -- Swap focused window with prev window
352 , ("M-<Backspace>", promote) -- Moves focused window to master, others maintain order
353 , ("M-S-<Tab>", rotSlavesDown) -- Rotate all windows except master and keep focus in place
354 , ("M-C-<Tab>", rotAllDown) -- Rotate all the windows in the current stack
355
356 -- Layouts
357 , ("M-<Tab>", sendMessage NextLayout) -- Switch to next layout
358 , ("M-b", sendMessage (MT.Toggle NBFULL))
359 , ("M-<Space>", sendMessage (MT.Toggle NBFULL) >> sendMessage ToggleStruts) -- Toggles noborder/full
360
361 -- Increase/decrease windows in the master pane or the stack
362 , ("M-S-<Up>", sendMessage (IncMasterN 1)) -- Increase # of clients master pane
363 , ("M-S-<Down>", sendMessage (IncMasterN (-1))) -- Decrease # of clients master pane
364 , ("M-C-<Up>", increaseLimit) -- Increase # of windows
365 , ("M-C-<Down>", decreaseLimit) -- Decrease # of windows
366
367 -- Window resizing
368 , ("M-h", sendMessage Shrink) -- Shrink horiz window width
369 , ("M-l", sendMessage Expand) -- Expand horiz window width
370 , ("M-M1-j", sendMessage MirrorShrink) -- Shrink vert window width
371 , ("M-M1-k", sendMessage MirrorExpand) -- Expand vert window width
372
373 -- Sublayouts
374 -- This is used to push windows to tabbed sublayouts, or pull them out of it.
375 , ("M-C-h", sendMessage $ pullGroup L)
376 , ("M-C-l", sendMessage $ pullGroup R)
377 , ("M-C-k", sendMessage $ pullGroup U)
378 , ("M-C-j", sendMessage $ pullGroup D)
379 , ("M-C-m", withFocused (sendMessage . MergeAll))
380 , ("M-C-u", withFocused (sendMessage . UnMerge))
381 , ("M-C-/", withFocused (sendMessage . UnMergeAll))
382 , ("M-C-<Space>", toSubl NextLayout)
383 , ("M-C-.", onGroup W.focusUp') -- Switch focus to next tab
384 , ("M-C-,", onGroup W.focusDown') -- Switch focus to prev tab
385
386 -- Scratchpads
387 -- Toggle show/hide these programs. They run on a hidden workspace.
388 -- When you toggle them to show, it brings them to your current workspace.
389 -- Toggle them to hide and it sends them back to hidden workspace (NSP).
390 , ("M-s t", namedScratchpadAction myScratchPads "terminal")
391 , ("M-s m", namedScratchpadAction myScratchPads "mocp")
392 , ("M-s c", namedScratchpadAction myScratchPads "calculator")
393 , ("M-s v", namedScratchpadAction myScratchPads "mpvfloat" )
394
395 -- Set wallpaper with 'feh'. Type 'SUPER+F1' to launch sxiv in the wallpapers directory.
396 -- Then in sxiv, type 'C-x w' to set the wallpaper that you choose.
397 , ("M-<F1>", spawn "sxiv -r -q -t -o ~/Pictures/wallpapers/*")
398 , ("M-<F2>", spawn "/bin/ls ~/Pictures/wallpapers | shuf -n 1 \
399 \| xargs xwallpaper --stretch")
400
401 -- pana e nimi sewi
402 , ("M-<F7>", spawn "nimi_sewi")
403
404 -- Controls for mocp music player (SUPER-u followed by a key)
405 , ("M-u p", spawn (myMocp ++ " --play"))
406 , ("M-u l", spawn (myMocp ++ " --next"))
407 , ("M-u h", spawn (myMocp ++ " --previous"))
408 , ("M-u <Space>", spawn (myMocp ++ " --toggle-pause"))
409
410 -- Multimedia Keys
411 , ("<XF86AudioPlay>", spawn (myMocp ++ " --toggle-pause"))
412 , ("<XF86AudioPrev>", spawn (myMocp ++ " --previous"))
413 , ("<XF86AudioNext>", spawn (myMocp ++ " --next"))
414 , ("<XF86AudioMute>", spawn (myMocp ++ " -v 0"))
415 , ("<XF86AudioLowerVolume>", spawn (myMocp ++ " -v -1"))
416 , ("<XF86AudioRaiseVolume>", spawn (myMocp ++ " -v +1"))
417 , ("<XF86HomePage>", spawn "brave https://aaoth.xyz")
418 , ("<XF86Search>", spawn "dm-websearch")
419 , ("<XF86Mail>", runOrRaise "geary" (resource =? "geary"))
420 , ("<XF86Calculator>", namedScratchpadAction myScratchPads "calculator")
421 , ("<XF86Sleep>", spawn "dm-logout")
422 ]
423 -- the following lines are needed for named scratchpads.
424 where nonNSP = WSIs (return (\ws -> W.tag ws /= "NSP"))
425 nonEmptyNonNSP = WSIs (return (\ws -> isJust (W.stack ws)
426 && W.tag ws /= "NSP"))
427
428
429main :: IO ()
430main = do
431 xmproc <- spawnPipe "xmobar ~/.xmonad/xmobar/xmobarrc"
432 -- the xmonad, ya know...what the wm is named after!
433 xmonad $ ewmh def
434 { manageHook = myManageHook <+> manageDocks
435 , handleEventHook = docksEventHook
436 , modMask = myModMask
437 , terminal = myTerminal
438 , startupHook = myStartupHook
439 , layoutHook = showWName' myShowWNameTheme myLayoutHook
440 , workspaces = myWorkspaces
441 , borderWidth = myBorderWidth
442 , normalBorderColor = myNormColor
443 , focusedBorderColor = myFocusColor
444 , logHook = dynamicLogWithPP
445 $ namedScratchpadFilterOutWorkspacePP
446 $ xmobarPP
447 { ppOutput = hPutStrLn xmproc
448 , ppCurrent = xmobarColor (myColor "green-bright") ""
449 . wrap "<fn=3>" "</fn>" -- toki pona
450 . wrap "[" "]"
451 -- . wrap " " " " -- normal
452 , ppVisible = xmobarColor (myColor "green-bright") "" . clickable
453 , ppHidden = xmobarColor (myColor "blue-bright") ""
454 . wrap "" "'"
455 . clickable
456 , ppHiddenNoWindows = xmobarColor (myColor "gray2") "" . clickable
457 --, ppHiddenNoWindows = myHiddenNoWindows
458 , ppTitle = xmobarColor (myColor "gray4") "" . shorten 60
459 , ppSep = xmobarColor (myColor "gray3") "" " | "
460 , ppWsSep = " "
461 , ppUrgent = xmobarColor (myColor "yellow") "" . wrap "!" "!"
462 , ppExtras = [myWindowCountLogger]
463 , ppOrder = \(ws:l:t:ex) -> [ws,l]++ex++[t]
464 }
465 } `additionalKeysP` myKeys
466