lib/XMonad/Config/LaNinpre.hs (view raw)
1----------------------------------------------------------------------
2-- |
3-- Module : XMonad.Config.LaNinpre
4-- Description : xmonad config of la ninpre
5-- Maintainer : la-ninpre
6-- License : ISC
7-- Copyright : la-ninpre <aaoth AT aaoth DOT xyz>
8--
9----------------------------------------------------------------------
10
11module XMonad.Config.LaNinpre where
12
13import Data.List(intercalate)
14import System.Exit
15
16import XMonad
17import qualified XMonad.StackSet as W
18
19import XMonad.Actions.GridSelect
20 ( GSConfig(GSConfig, gs_font, gs_bordercolor)
21 , buildDefaultGSConfig
22 , bringSelected
23 , gridselect
24 , goToSelected
25 )
26import XMonad.Actions.WithAll (sinkAll)
27
28import XMonad.Hooks.EwmhDesktops
29 ( ewmhFullscreen
30 , ewmh
31 )
32import XMonad.Hooks.ManageDocks (ToggleStruts(ToggleStruts))
33import XMonad.Hooks.ManageHelpers
34 ( doFullFloat
35 , isFullscreen
36 )
37import XMonad.Hooks.StatusBar
38 ( StatusBarConfig
39 , defToggleStrutsKey
40 , statusBarProp
41 , withEasySB
42 )
43import XMonad.Hooks.StatusBar.PP
44 ( PP(ppSep, ppCurrent, ppHidden, ppHiddenNoWindows, ppLayout)
45 , filterOutWsPP
46 , xmobarColor
47 , xmobarFont
48 )
49
50import XMonad.Layout.BoringWindows
51 ( boringWindows
52 , focusDown
53 , focusMaster
54 , focusUp
55 , swapDown
56 , swapUp
57 )
58import XMonad.Layout.NoBorders (noBorders, smartBorders)
59import XMonad.Layout.Renamed
60 ( Rename(Replace)
61 , renamed
62 )
63import XMonad.Layout.ResizableThreeColumns (ResizableThreeCol(ResizableThreeColMid))
64import XMonad.Layout.ResizableTile
65 (ResizableTall(ResizableTall)
66 , MirrorResize(MirrorShrink, MirrorExpand)
67 )
68import XMonad.Layout.Simplest (Simplest(Simplest))
69import XMonad.Layout.Spacing
70 ( spacingWithEdge
71 , toggleWindowSpacingEnabled
72 , toggleScreenSpacingEnabled
73 )
74import XMonad.Layout.SubLayouts
75 ( GroupMsg(UnMerge, UnMergeAll)
76 , onGroup
77 , pullGroup
78 , subLayout
79 )
80import XMonad.Layout.Tabbed
81 (Theme
82 ( activeBorderWidth
83 , activeColor
84 , activeTextColor
85 , fontName
86 , inactiveBorderWidth
87 , inactiveColor
88 , inactiveTextColor
89 , urgentBorderWidth
90 , urgentColor
91 , urgentTextColor
92 )
93 , addTabs
94 , shrinkText
95 )
96import XMonad.Layout.ToggleLayouts (ToggleLayout(ToggleLayout), toggleLayouts)
97import XMonad.Layout.WindowNavigation (Direction2D(D, L, R, U), windowNavigation)
98
99import XMonad.Util.ClickableWorkspaces (clickablePP)
100import XMonad.Util.EZConfig (mkKeymap)
101import XMonad.Util.NamedScratchpad
102 ( NamedScratchpad(NS)
103 , customFloating
104 , namedScratchpadAction
105 , namedScratchpadManageHook
106 , scratchpadWorkspaceTag
107 )
108import XMonad.Layout.Groups (onLayout)
109
110-- * fonts
111--
112-- $fonts
113--
114-- default font and helper for fonts.
115
116-- | default font
117fontDef :: String
118fontDef = fontXft "Lato" "regular" 14
119
120-- | font constructor
121--
122-- it is just a helper function to simplify the process of specifying font
123-- with xft.
124fontXft :: String -- ^ font family
125 -> String -- ^ font style
126 -> Int -- ^ font size
127 -> String
128fontXft font style size = intercalate ":" [ "xft"
129 , font
130 , style
131 , "size=" ++ show size
132 , "antialias=true"
133 , "hinting=true"
134 ]
135
136-- * colors
137--
138-- $colors
139--
140-- color theme and stuff
141
142-- | default color theme
143colorTheme :: ColorTheme
144colorTheme = ColorTheme "#111111" "#ccbbcc" "#223333" "#ffaaaa"
145
146-- | color theme datatype
147--
148-- 'Default' instance gives simple four-color colorscheme
149data ColorTheme = ColorTheme {
150 col_bg :: String,
151 col_fg :: String,
152 col_bg_alt :: String,
153 col_fg_alt :: String
154}
155
156instance Default ColorTheme where
157 def = colorTheme
158
159
160-- * software
161--
162-- $software
163--
164-- these are just contstants
165
166-- | set terminal emulator
167terminalEmulator :: String
168terminalEmulator = "alacritty"
169
170-- | set web browser
171webBrowser :: String
172webBrowser = "firefox"
173
174-- | set gemini client
175geminiBrowser :: String
176geminiBrowser = "lagrange"
177
178-- | set file manager
179fileManager :: String
180fileManager = "thunar"
181
182-- | music on console
183--
184-- this is to avoid spamming strings everywhere. @moc@ doesn't comply with
185-- XDG_CONFIG_HOME, so we force it to do so.
186mocpString :: String
187mocpString = "mocp -M '~/.config/moc'"
188
189-- | set editor
190editor :: String
191editor = terminalEmulator ++ " -e vi"
192
193-- * manage hook
194--
195-- $managehook
196--
197-- send some windows here and there.
198
199-- | manage hook
200localManageHook :: ManageHook
201localManageHook = composeAll
202 [ className =? "confirm" --> doFloat
203 , className =? "file_progress" --> doFloat
204 , className =? "dialog" --> doFloat
205 , className =? "download" --> doFloat
206 , className =? "error" --> doFloat
207 , className =? "notification" --> doFloat
208 , className =? "splash" --> doFloat
209 , className =? "toolbar" --> doFloat
210 , className =? "Image Lounge" --> doFloat
211 -- web workspace
212 , title =? "Mozilla Firefox" --> doShift ( workspacesTP !! 1 )
213 , className =? "Brave-browser" --> doShift ( workspacesTP !! 1 )
214 , className =? "amfora" --> doShift ( workspacesTP !! 1 )
215 , className =? "qutebrowser" --> doShift ( workspacesTP !! 1 )
216 -- doc workspace
217 , className =? "Geary" --> doShift ( workspacesTP !! 3 )
218 , className =? "libreoffice" --> doShift ( workspacesTP !! 3 )
219 -- vm workspace
220 -- chat workspace
221 , className =? "discord" --> doShift ( workspacesTP !! 5 )
222 , className =? "TelegramDesktop" --> doShift ( workspacesTP !! 5 )
223 , className =? "Element" --> doShift ( workspacesTP !! 5 )
224 , className =? "Steam" --> doShift ( workspacesTP !! 5 )
225 -- full workspace
226 , isFullscreen --> doShift ( workspacesTP !! 6 )
227 -- vid workspace
228 , className =? "Deadbeef" --> doShift ( workspacesTP !! 7 )
229 , appName =? "mpv" --> doShift ( workspacesTP !! 7 )
230 , className =? "vlc" --> doShift ( workspacesTP !! 7 )
231 -- gfx workspace
232 , className =? "Gimp" --> doShift ( workspacesTP !! 8 )
233 , className =? "Blender" --> doShift ( workspacesTP !! 8 )
234 , className =? "obs" --> doShift ( workspacesTP !! 8 )
235 , isFullscreen --> doFullFloat
236 ] <+> namedScratchpadManageHook scratchPads
237
238-- * scratchpads
239--
240-- $scratchpads
241--
242-- currently i have:
243--
244-- * plain terminal scratchpad
245--
246-- * music on console
247--
248-- * calculator (qalculate-gtk)
249--
250-- * mpv instance that plays playlist in @~\/Video\/sp_playlist.m3u@
251
252-- | scratchpad list
253scratchPads :: [NamedScratchpad]
254scratchPads = [ NS "terminal" spawnTerm findTerm manageTerm
255 , NS "mocp" spawnMocp findMocp manageMocp
256 , NS "calculator" spawnCalc findCalc manageCalc
257 , NS "mpvfloat" spawnMpv findMpv manageMpv
258 ]
259 where
260 -- terminal
261 spawnTerm = terminalEmulator ++ " -t scratchpad"
262 findTerm = title =? "scratchpad"
263 manageTerm = customFloating $ W.RationalRect l t w h
264 where
265 h = 0.9
266 w = 0.9
267 t = 0.95 - h
268 l = 0.95 - w
269 -- music on console
270 spawnMocp = terminalEmulator ++ " -t mocp -e " ++ mocpString
271 findMocp = title =? "mocp"
272 manageMocp = customFloating $ W.RationalRect l t w h
273 where
274 h = 0.9
275 w = 0.9
276 t = 0.95 - h
277 l = 0.95 - w
278 -- calculator
279 spawnCalc = "qalculate-gtk"
280 findCalc = className =? "Qalculate-gtk"
281 manageCalc = customFloating $ W.RationalRect l t w h
282 where
283 h = 0.5
284 w = 0.4
285 t = 0.75 - h
286 l = 0.70 - w
287 -- mpv scratchpad to watch some stuff listed in ~/Video/sp_playlist.m3u
288 spawnMpv = "mpv --pause -x11-name mpv-sp ~/Video/sp_playlist.m3u"
289 ++ mpvGeometry mpvPercentage mpvPercentage
290 findMpv = appName =? "mpv-sp"
291 manageMpv = customFloating $ W.RationalRect l t w h
292 where
293 h = mpvPercentage
294 w = mpvPercentage
295 t = 0.03
296 l = 0.996 - w
297 mpvPercentage = 1/4
298 mpvGeometry h w = " --geometry=" ++ show pw ++ "x" ++ show ph
299 where
300 pw = ceiling (1920 * w)
301 ph = ceiling (1080 * h)
302
303-- * workspaces
304--
305-- $workspaces
306--
307-- i've got two ways of specifying them. first one is pretty close to the
308-- original dt's config and second one is using linja pona font by jan same
309-- (check it out [here](http://musilili.net/linja-pona/)).
310
311-- | normal english workspace names
312workspacesNorm :: [String]
313workspacesNorm = [ "dev"
314 , "www"
315 , "term"
316 , "doc"
317 , "vm"
318 , "chat"
319 , "full"
320 , "vid"
321 , "misc"
322 ]
323
324-- | toki pona workspace names
325--
326-- uses sitelen-pona font.
327workspacesTP :: [String]
328workspacesTP = [ "\xe661\xe921" -- sona nanpa
329 , "\xe63b" -- musi
330 , "\xe649" -- pali
331 , "\xe62a\xf105" -- lipu ale
332 , "\xe653\xf115" -- poki ilo
333 , "\xe66c" -- toki
334 , "\xe62a\xf200" -- lipu suli
335 , "\xf010\xe915" -- sitelen tawa
336 , "\xf010\xf107" -- sitelen ante
337 ]
338
339-- * grid select
340--
341-- $gridselect
342--
343-- stuff for 'GridSelect'
344
345-- | app grid for 'GridSelect' layout
346appGrid :: [(String,String)]
347appGrid = [
348 ("files" ,"thunar" )
349 , ("mail" ,"thunderbird" )
350 , ("blender" ,"blender-3.3" )
351 , ("inkscape" ,"inkscape" )
352 , ("discord" ,"discord" )
353 , ("steam" ,"steam" )
354 , ("obs" ,"obs" )
355 , ("gimp" ,"gimp" )
356 , ("ardour" ,"ardour7" )
357 , ("mumble" ,"mumble" )
358 , ("gajim" ,"gajim" )
359 , ("element" ,"element-desktop" )
360 , ("kdenlive" ,"kdenlive" )
361 ]
362
363-- | uses colors from 'ColorTheme'
364boringColorizer :: a -> Bool -> X (String, String)
365boringColorizer _ active = if active
366 then return (col_bg_alt def, col_fg_alt def)
367 else return (col_bg def, col_fg def)
368
369-- | 'GridSelect' config
370gridSelectConfig :: GSConfig a
371gridSelectConfig = (buildDefaultGSConfig boringColorizer)
372 { gs_font = fontDef
373 , gs_bordercolor = col_bg_alt def
374 }
375
376-- | allows to add aliases for commands unlike original 'spawnSelected'
377spawnSelected' :: GSConfig String -> [(String, String)] -> X ()
378spawnSelected' conf lst = gridselect conf lst >>= flip whenJust spawn
379
380-- * keybindings
381--
382-- $keybindings
383--
384-- list of keybindings. it supposed to override the default keybindings.
385
386-- | keybindings in 'EZConfig' format
387keybinds :: [(String, X ())]
388keybinds = [ ("M-<Return>", spawn terminalEmulator)
389 , ("M-w", spawn webBrowser)
390 , ("M-p", spawn "dmenu_run")
391 , ("M-<Delete>", spawn "slock")
392 , ("<Print>", spawn "scrot_cmd -f")
393 , ("C-<Print>", spawn "scrot_cmd -a")
394 , ("M1-<Print>", spawn "scrot_cmd -w")
395
396 , ("M-s t", namedScratchpadAction scratchPads "terminal")
397 , ("M-s c", namedScratchpadAction scratchPads "calculator")
398 , ("M-s m", namedScratchpadAction scratchPads "mocp")
399 , ("M-s v", namedScratchpadAction scratchPads "mpvfloat")
400
401 , ("M-g t", goToSelected gridSelectConfig)
402 , ("M-g b", bringSelected gridSelectConfig)
403 , ("M-g g", spawnSelected' gridSelectConfig appGrid)
404
405 , ("M-S-c", kill)
406 , ("M-<Space>", sendMessage NextLayout)
407 , ("M-f", sendMessage ToggleLayout >> sendMessage ToggleStruts)
408 , ("M-h", sendMessage Shrink)
409 , ("M-l", sendMessage Expand)
410 , ("M-C-j", sendMessage MirrorShrink)
411 , ("M-C-k", sendMessage MirrorExpand)
412 , ("M-M1-h", sendMessage $ pullGroup L)
413 , ("M-M1-j", sendMessage $ pullGroup D)
414 , ("M-M1-k", sendMessage $ pullGroup U)
415 , ("M-M1-l", sendMessage $ pullGroup R)
416 , ("M-M1-u", withFocused $ sendMessage . UnMerge)
417 , ("M-M1-m", withFocused $ sendMessage . UnMergeAll)
418 , ("M-M1-,", onGroup W.focusDown')
419 , ("M-M1-.", onGroup W.focusUp')
420 , ("M-j", focusDown)
421 , ("M-k", focusUp)
422 , ("M-S-j", swapDown)
423 , ("M-S-k", swapUp)
424 , ("M-m", focusMaster)
425 , ("M-S-m", windows W.swapMaster)
426 , ("M-t", withFocused $ windows . W.sink)
427 , ("M-S-t", sinkAll)
428 , ("M-<Tab>", toggleWindowSpacingEnabled >> toggleScreenSpacingEnabled)
429
430 , ("M-S-q", io exitSuccess)
431 , ("M-S-r", spawn "xmonad --recompile && xmonad --restart")
432
433 , ("<XF86AudioPlay>", spawn $ mocpString ++ " -G")
434 , ("<XF86AudioRaiseVolume>", spawn $ mocpString ++ " -v +5")
435 , ("<XF86AudioLowerVolume>", spawn $ mocpString ++ " -v -5")
436 , ("<XF86AudioMute>", spawn $ mocpString ++ " -v 0")
437 , ("<XF86AudioPrev>", spawn $ mocpString ++ " --previous")
438 , ("<XF86AudioNext>", spawn $ mocpString ++ " --next")
439 ]
440 ++
441 [("M-" ++ m ++ show k, windows $ f i)
442 | (i, k) <- zip workspacesTP [1..9]
443 , (f, m) <- [(W.greedyView, ""), (W.shift, "S-")]
444 ]
445
446-- * xmobar
447--
448-- $xmobar
449--
450-- stuff for xmobar
451
452-- | xmobar pretty printer
453localXmobarPP :: PP
454localXmobarPP = def
455 { ppSep = xmobarColor (col_bg_alt def) "" " | "
456 , ppCurrent = xmobarColor (col_fg_alt def) "" . sitelen
457 , ppHidden = xmobarColor (col_fg def) "" . sitelen
458 , ppHiddenNoWindows = xmobarColor (col_bg_alt def) "" . sitelen
459 , ppLayout = sitelen
460 } where
461 sitelen = xmobarFont 3
462
463-- | status bar config
464statusBarConfig :: StatusBarConfig
465statusBarConfig = statusBarProp "xmobar"
466 $ clickablePP $ filterOutWsPP [scratchpadWorkspaceTag] localXmobarPP
467
468-- * layouts
469--
470-- $layouts
471--
472-- stuff for layouts
473
474-- | theme for 'Tabbed' layout
475tabTheme :: Theme
476tabTheme = def
477 { fontName = fontDef
478 , activeTextColor = col_fg_alt def
479 , activeColor = col_bg_alt def
480 , activeBorderWidth = 0
481 , inactiveTextColor = col_fg def
482 , inactiveColor = col_bg def
483 , inactiveBorderWidth = 0
484 , urgentTextColor = col_bg_alt def
485 , urgentColor = col_fg_alt def
486 , urgentBorderWidth = 0
487 }
488
489-- * misc
490
491-- | layout hook
492--
493-- __NOTE__: it uses sitelen-pona font to name layouts.
494localLayoutHook = windowNavigation
495 $ boringWindows
496 $ toggleLayouts full
497 $ smartBorders
498 $ tiled ||| threeCol
499 where
500 tiled = renamed [Replace "\xe624"] -- lawa
501 $ addTabs shrinkText tabTheme
502 $ subLayout [] Simplest
503 $ spacingWithEdge space
504 $ ResizableTall nmaster delta ratio []
505 threeCol = renamed [Replace "\xe665"] -- supa
506 $ addTabs shrinkText tabTheme
507 $ subLayout [] Simplest
508 $ spacingWithEdge space
509 $ ResizableThreeColMid nmaster delta ratio []
510 full = renamed [Replace "\xe663"] -- suli
511 $ noBorders Full
512 nmaster = 1
513 ratio = 1/2
514 delta = 3/100
515 space = 4
516
517-- | main config
518--
519-- you can override things like that:
520--
521-- @
522-- myConfig = laNinpreConfig { workspaces = 'workspacesNorm' }
523-- main = xmonad myConfig
524-- @
525laNinpreConfig = def
526 { terminal = terminalEmulator
527 , modMask = mod4Mask
528 , layoutHook = localLayoutHook
529 , manageHook = localManageHook
530 , workspaces = workspacesTP
531 , borderWidth = 1
532 , keys = (`mkKeymap` keybinds)
533 , normalBorderColor = col_bg_alt def
534 , focusedBorderColor = col_fg_alt def
535 }
536
537main :: IO ()
538main = xmonad
539 . ewmhFullscreen
540 . ewmh
541 . withEasySB statusBarConfig defToggleStrutsKey
542 $ laNinpreConfig
543