{-# OPTIONS_HADDOCK prune #-} ---------------------------------------------------------------------- -- | -- Description : la-ninpre xmonad config -- Maintainer : la-ninpre -- License : ISC -- Copyright : la-ninpre -- -- personal xmonad config. based heavily on distrotube's config. -- i've added some stuff and toki pona fonts -- ---------------------------------------------------------------------- module Main where import System.Directory import System.IO (hPutStrLn) import System.Exit (exitSuccess) import Data.Char (isSpace, toUpper) import Data.Maybe (fromJust, isJust) import Data.Monoid import Data.Tree import Data.List import qualified Data.Map as M import XMonad import qualified XMonad.StackSet as W import XMonad.Actions.CopyWindow (kill1) import XMonad.Actions.CycleWS ( Direction1D(..) , moveTo , shiftTo , WSType(..) , nextScreen , prevScreen ) import XMonad.Actions.GridSelect import XMonad.Actions.MouseResize import XMonad.Actions.Promote import XMonad.Actions.RotSlaves (rotSlavesDown, rotAllDown) import XMonad.Actions.WindowGo (runOrRaise) import XMonad.Actions.WithAll (sinkAll, killAll) import qualified XMonad.Actions.Search as S import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks ( avoidStruts , docks , manageDocks , ToggleStruts(..)) import XMonad.Hooks.ManageHelpers (isFullscreen, doFullFloat) import XMonad.Hooks.ServerMode import XMonad.Hooks.SetWMName import XMonad.Hooks.StatusBar.PP (filterOutWsPP) import XMonad.Hooks.WorkspaceHistory import XMonad.Layout.SimplestFloat import XMonad.Layout.ResizableTile import XMonad.Layout.Tabbed import XMonad.Layout.ThreeColumns import XMonad.Layout.Accordion import XMonad.Layout.LayoutModifier import XMonad.Layout.LimitWindows (limitWindows, increaseLimit, decreaseLimit) import XMonad.Layout.Magnifier import XMonad.Layout.MultiToggle (mkToggle, single, EOT(EOT), (??)) import XMonad.Layout.MultiToggle.Instances (StdTransformers( NBFULL , MIRROR , NOBORDERS )) import XMonad.Layout.NoBorders import XMonad.Layout.Renamed import XMonad.Layout.ShowWName import XMonad.Layout.Simplest import XMonad.Layout.Spacing import XMonad.Layout.SubLayouts import XMonad.Layout.WindowNavigation import qualified XMonad.Layout.BoringWindows as BW import XMonad.Layout.WindowArranger (windowArrange, WindowArrangerMsg(..)) import qualified XMonad.Layout.ToggleLayouts as T ( toggleLayouts , ToggleLayout(Toggle) ) import qualified XMonad.Layout.MultiToggle as MT (Toggle(..)) import XMonad.Util.Dmenu import XMonad.Util.Loggers import XMonad.Util.EZConfig (additionalKeysP) import XMonad.Util.NamedScratchpad import XMonad.Util.Run (runProcessWithInput, safeSpawn, spawnPipe) import XMonad.Util.SpawnOnce import XMonad.Util.WorkspaceCompare import LaNinpreConfig -- * misc functions -- -- | hides workspaces that have no windows myHiddenNoWindows :: WorkspaceId -> String myHiddenNoWindows = const "" mySuperscript :: Int -> String mySuperscript n = map ss $ show n where ss c | c == '0' = '⁰' | c == '1' = '¹' | c == '2' = '²' | c == '3' = '³' | c == '4' = '⁴' | c == '5' = '⁵' | c == '6' = '⁶' | c == '7' = '⁷' | c == '8' = '⁸' | c == '9' = '⁹' | otherwise = c -- | window count logger -- -- gets number of windows on current workspace myWindowCountLogger :: Logger myWindowCountLogger = gets $ Just . show . length . W.integrate' . W.stack . W.workspace . W.current . windowset -- * grid select -- -- $gridSelect -- -- this section provides theming of 'GridSelect' stuff. -- -- here, 'GridSelect' is used for following things: -- -- * spawning some frequently used programs -- -- * moving to desired window -- -- * bringing the desired window to the current workspace -- | custom colorizer for 'gridselect' -- -- essentially, it is just plain theme myColorizer :: a -> Bool -> X (String, String) myColorizer _ active = if active then return (col_bg_alt def, col_fg_alt def) else return (col_bg def, col_fg def) -- | custom 'GSConfig' myGridConfig :: GSConfig a myGridConfig = (buildDefaultGSConfig myColorizer) { gs_cellheight = 40 , gs_cellwidth = 200 , gs_cellpadding = 6 , gs_originFractX = 0.5 , gs_originFractY = 0.5 , gs_bordercolor = col_bg_alt def , gs_font = head myFonts } -- | spawn selected programs with grid select -- -- it is esentially the same as 'spawnSelected' but allows to specify program aliases mySpawnSelected :: [(String, String)] -> X () mySpawnSelected lst = gridselect myGridConfig lst >>= flip whenJust spawn -- * layouts -- -- ** spacing raw helper functions -- -- $spacingHelpers -- -- these make calls to 'spacingRaw' simpler to write -- | for many windows mySpacing :: Integer -> l a -> XMonad.Layout.LayoutModifier.ModifiedLayout Spacing l a mySpacing i = spacingRaw False (Border i i i i) True (Border i i i i) True -- | for fewer than two windows mySpacing' :: Integer -> l a -> XMonad.Layout.LayoutModifier.ModifiedLayout Spacing l a mySpacing' i = spacingRaw True (Border i i i i) True (Border i i i i) True -- ** actually layouts -- -- $layouts -- -- currently there are: -- -- * tall -- -- * floats -- -- * threeCol tall = renamed [Replace "tall"] $ smartBorders $ addTabs shrinkText myTabTheme $ subLayout [] (smartBorders Simplest ||| Accordion) $ limitWindows 12 $ mySpacing 4 $ ResizableTall 1 (5/100) (1/2) [] floats = renamed [Replace "floats"] $ smartBorders $ limitWindows 20 simplestFloat threeCol = renamed [Replace "threeCol"] $ smartBorders $ addTabs shrinkText myTabTheme $ subLayout [] (smartBorders Simplest ||| Accordion) $ limitWindows 7 $ mySpacing 4 $ ThreeColMid 1 (3/100) (1/2) -- | setting colors for tabs layout and tabs sublayout. myTabTheme :: Theme myTabTheme = def { fontName = head myFonts , activeTextColor = col_fg_alt def , activeColor = col_bg_alt def , activeBorderWidth = 0 , inactiveTextColor = col_fg def , inactiveColor = col_bg def , inactiveBorderWidth = 0 , urgentTextColor = col_bg_alt def , urgentColor = col_fg_alt def , urgentBorderWidth = 0 } -- ** layout hook -- $layoutHook -- -- putting it all together with some stuff myLayoutHook = avoidStruts $ mouseResize $ BW.boringWindows $ windowNavigation $ windowArrange $ T.toggleLayouts floats $ mkToggle (NBFULL ?? NOBORDERS ?? EOT) myDefaultLayout where myDefaultLayout = withBorder myBorderWidth tall ||| withBorder myBorderWidth threeCol -- * show wm name hook -- | theme for showWName which prints current workspace -- when you change workspaces. myShowWNameTheme :: SWNConfig myShowWNameTheme = def { swn_font = myFonts !! 1 , swn_fade = 0.7 , swn_bgcolor = col_bg def , swn_color = col_fg def } -- * workspaces -- -- $workspaces -- -- here are some helper functions to deal with workspaces. -- -- actual workspace list is in "LaNinpreConfig". -- | workspace indices to use with hotkeys myWorkspaceIndices = M.fromList $ zip myWorkspaces [1..] -- ** clickable workspace wrapper -- -- $clickable -- -- normal variant -- -- > clickable ws = ""++ws++"" -- > where i = fromJust $ M.lookup ws myWorkspaceIndices -- | provides option to click workspaces to switch to them. -- this is handled by @UnsafeStdinReader@ in xmobar config. clickable ws = ""++ws++"" where i = fromJust $ M.lookup ws myWorkspaceIndices -- * keybindings -- | keybindings list -- -- there's no way to document it using haddock, i guess... myKeys :: [(String, X ())] myKeys = [ ("M-C-r", spawn "xmonad --recompile") -- Recompiles xmonad , ("M-S-r", spawn "xmonad --restart") -- Restarts xmonad , ("M-S-q", io exitSuccess) -- Quits xmonad -- Run Prompt , ("M-p", spawn "dmenu_run -i -p \"Run: \"") -- Dmenu -- Useful programs to have a keybinding for launch , ("M-", spawn myTerminal) , ("M-e", spawn myFileMgr) , ("M-w", spawn myBrowser) , ("M-i", spawn (myTerminal ++ " --class alacritty,amfora -e " ++ myGeminiClient)) , ("M-S-e", spawn "emacsclient -c") -- Kill windows , ("M-S-c", kill1) -- Kill the currently focused client , ("M-S-a", killAll) -- Kill all windows on current workspace -- Workspaces , ("M-.", nextScreen) -- Switch focus to next monitor , ("M-,", prevScreen) -- Switch focus to prev monitor -- Shifts focused window to next ws , ("M-S-", shiftTo Next nonNSP >> moveTo Next nonNSP) -- Shifts focused window to prev ws , ("M-S-", shiftTo Prev nonNSP >> moveTo Prev nonNSP) -- Floating windows , ("M-f", sendMessage (T.Toggle "floats")) -- Toggles my 'floats' layout , ("M-t", withFocused $ windows . W.sink) -- Push floating window back to tile , ("M-S-t", sinkAll) -- Push ALL floating windows to tile -- Increase/decrease spacing (gaps) , ("C-M1-j", decWindowSpacing 4) -- Decrease window spacing , ("C-M1-k", incWindowSpacing 4) -- Increase window spacing , ("C-M1-h", decScreenSpacing 4) -- Decrease screen spacing , ("C-M1-l", incScreenSpacing 4) -- Increase screen spacing -- Grid Select (MOD-g followed by a key) , ("M-g g", mySpawnSelected myAppGrid) -- grid select favorite apps , ("M-g t", goToSelected myGridConfig) -- goto selected window , ("M-g b", bringSelected myGridConfig) -- bring selected window -- Windows navigation , ("M-m", windows W.focusMaster) -- Move focus to the master window , ("M-j", BW.focusDown) -- Move focus to the next window , ("M1-", BW.focusDown) -- legacy keybinding , ("M-k", BW.focusUp) -- Move focus to the prev window , ("M-S-m", windows W.swapMaster) -- Swap the focused window and the master window , ("M-S-j", windows W.swapDown) -- Swap focused window with next window , ("M-S-k", windows W.swapUp) -- Swap focused window with prev window , ("M-", promote) -- Moves focused window to master, others maintain order , ("M-S-", rotSlavesDown) -- Rotate all windows except master and keep focus in place , ("M-C-", rotAllDown) -- Rotate all the windows in the current stack -- Layouts , ("M-", sendMessage NextLayout) -- Switch to next layout , ("M-b", sendMessage (MT.Toggle NBFULL)) , ("M-", sendMessage (MT.Toggle NBFULL) >> sendMessage ToggleStruts) -- Toggles noborder/full -- Increase/decrease windows in the master pane or the stack , ("M-S-", sendMessage (IncMasterN 1)) -- Increase # of clients master pane , ("M-S-", sendMessage (IncMasterN (-1))) -- Decrease # of clients master pane , ("M-C-", increaseLimit) -- Increase # of windows , ("M-C-", decreaseLimit) -- Decrease # of windows -- Window resizing , ("M-h", sendMessage Shrink) -- Shrink horiz window width , ("M-l", sendMessage Expand) -- Expand horiz window width , ("M-M1-j", sendMessage MirrorShrink) -- Shrink vert window width , ("M-M1-k", sendMessage MirrorExpand) -- Expand vert window width -- Sublayouts -- This is used to push windows to tabbed sublayouts, or pull them out of it. , ("M-C-h", sendMessage $ pullGroup L) , ("M-C-l", sendMessage $ pullGroup R) , ("M-C-k", sendMessage $ pullGroup U) , ("M-C-j", sendMessage $ pullGroup D) , ("M-C-m", withFocused (sendMessage . MergeAll)) , ("M-C-u", withFocused (sendMessage . UnMerge)) , ("M-C-/", withFocused (sendMessage . UnMergeAll)) , ("M-C-", toSubl NextLayout) , ("M-C-.", onGroup W.focusUp') -- Switch focus to next tab , ("M-C-,", onGroup W.focusDown') -- Switch focus to prev tab -- Scratchpads -- Toggle show/hide these programs. They run on a hidden workspace. -- When you toggle them to show, it brings them to your current workspace. -- Toggle them to hide and it sends them back to hidden workspace (NSP). , ("M-s t", namedScratchpadAction myScratchPads "terminal") , ("M-s m", namedScratchpadAction myScratchPads "mocp") , ("M-s c", namedScratchpadAction myScratchPads "calculator") , ("M-s v", namedScratchpadAction myScratchPads "mpvfloat" ) -- Set wallpaper with 'feh'. Type 'SUPER+F1' to launch sxiv in the wallpapers directory. -- Then in sxiv, type 'C-x w' to set the wallpaper that you choose. , ("M-", spawn "sxiv -r -q -t -o ~/Pictures/wallpapers/*") , ("M-", spawn "/bin/ls ~/Pictures/wallpapers | shuf -n 1 \ \| xargs xwallpaper --stretch") -- pana e nimi sewi , ("M-", spawn "nimi_sewi") -- Controls for mocp music player (SUPER-u followed by a key) , ("M-u p", spawn (myMocp ++ " --play")) , ("M-u l", spawn (myMocp ++ " --next")) , ("M-u h", spawn (myMocp ++ " --previous")) , ("M-u ", spawn (myMocp ++ " --toggle-pause")) -- screenshots , ("", spawn "scrot_cmd -f") , ("C-", spawn "scrot_cmd -a") , ("M1-", spawn "scrot_cmd -w") -- Multimedia Keys , ("", spawn (myMocp ++ " --toggle-pause")) , ("", spawn (myMocp ++ " --previous")) , ("", spawn (myMocp ++ " --next")) , ("", spawn (myMocp ++ " -v 0")) , ("", spawn (myMocp ++ " -v -5")) , ("", spawn (myMocp ++ " -v +5")) , ("", spawn "firefox https://aaoth.xyz") , ("", runOrRaise "thunderbird" (resource =? "thunderbird")) , ("", namedScratchpadAction myScratchPads "calculator") , ("", spawn "dm-logout") ] -- the following lines are needed for named scratchpads. where nonNSP = WSIs (return (\ws -> W.tag ws /= "NSP")) nonEmptyNonNSP = WSIs (return (\ws -> isJust (W.stack ws) && W.tag ws /= "NSP")) main :: IO () main = do xmproc <- spawnPipe "xmobar ~/.config/xmonad/xmobar/xmobarrc" -- the xmonad, ya know...what the wm is named after! xmonad $ docks . ewmh $ def { manageHook = myManageHook <+> manageDocks --, handleEventHook = docksEventHook , modMask = myModMask , terminal = myTerminal , startupHook = myStartupHook , layoutHook = showWName' myShowWNameTheme myLayoutHook , workspaces = myWorkspaces , borderWidth = myBorderWidth , normalBorderColor = myNormColor , focusedBorderColor = myFocusColor , logHook = dynamicLogWithPP $ filterOutWsPP ["NSP"] $ xmobarPP { ppOutput = hPutStrLn xmproc , ppCurrent = xmobarColor (col_fg_alt def) "" . wrap "" "" -- toki pona . wrap "[" "]" -- . wrap " " " " -- normal , ppVisible = xmobarColor (col_fg_alt def) "" . clickable , ppHidden = xmobarColor (col_fg def) "" . wrap "" "'" . clickable , ppHiddenNoWindows = xmobarColor (col_bg_alt def) "" . clickable --, ppHiddenNoWindows = myHiddenNoWindows , ppTitle = xmobarColor (col_fg def) "" . shorten 60 , ppSep = xmobarColor (col_bg_alt def) "" " | " , ppWsSep = " " , ppUrgent = xmobarColor (col_fg_alt def) "" . wrap "!" "!" , ppExtras = [myWindowCountLogger] , ppOrder = \(ws:l:t:ex) -> [ws,l]++ex++[t] } } `additionalKeysP` myKeys