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