diff --git a/xmonad b/xmonad index f4a5b88..e25d090 160000 --- a/xmonad +++ b/xmonad @@ -1 +1 @@ -Subproject commit f4a5b88e64b2e9b80ddf81a0ba178ec4d005cfa8 +Subproject commit e25d090112f2a76364a10b88a729b8586c18145b diff --git a/xmonad-contrib b/xmonad-contrib index ee3ea24..28d86f3 160000 --- a/xmonad-contrib +++ b/xmonad-contrib @@ -1 +1 @@ -Subproject commit ee3ea2402dee7876eccb32fc8a83bb2f3d3198bc +Subproject commit 28d86f3a28ad36cf47de3421c201523f6021c6aa diff --git a/xmonad.hs b/xmonad.hs index 0c01cc6..b24e8c1 100644 --- a/xmonad.hs +++ b/xmonad.hs @@ -30,35 +30,26 @@ import XMonad terminal, workspaces ), - button1, - button3, className, composeAll, doF, doFloat, doIgnore, doShift, - focus, handleEventHook, mod4Mask, - mouseMoveWindow, - mouseResizeWindow, resource, sendMessage, - shiftMask, spawn, title, withWindowSet, xmonad, (-->), - (.|.), (<&&>), (<+>), (=?), (|||), ) -import XMonad.Actions.FloatSnap -import XMonad.Actions.Navigation2D (windowGo, withNavigation2DConfig) import XMonad.Actions.WindowGo (raise, runOrRaise) import XMonad.Hooks.DynamicLog ( PP @@ -93,8 +84,8 @@ import XMonad.Hooks.StatusBar statusBarProp, withEasySB, ) -import XMonad.Layout (JumpToLayout (JumpToLayout), Resize (Expand, Shrink)) -import XMonad.Layout.Fullscreen (fullscreenEventHook, fullscreenFull, fullscreenManageHook) +import XMonad.Layout (Resize (Expand, Shrink)) +import XMonad.Layout.Fullscreen (fullscreenEventHook) import XMonad.Layout.LayoutModifier import qualified XMonad.Layout.LayoutModifier import XMonad.Layout.Named (named) @@ -111,7 +102,7 @@ import XMonad.Layout.WindowNavigation windowNavigation, ) import XMonad.StackSet (RationalRect (RationalRect), Stack (Stack), Workspace (tag), currentTag, greedyView, integrate', shift, stack) -import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings) +import XMonad.Util.EZConfig (additionalKeysP) import XMonad.Util.Font (fi) import XMonad.Util.Loggers (logTitles, wrapL) import XMonad.Util.SpawnOnce (spawnOnce) @@ -123,51 +114,44 @@ main = do colors <- getWalColors xmonad . ewmhFullscreen . ewmh . withEasySB (statusBarProp "xmobar ~/.config/xmobar/xmobarrc" (pure $ myXmobarPP colors)) defToggleStrutsKey - $ withNavigation2DConfig def $ - def - { modMask = mod4Mask, - terminal = "st", - startupHook = myStartupHook, - borderWidth = 2, - normalBorderColor = head colors, - focusedBorderColor = colors !! 4, - workspaces = myWorkspaces, - manageHook = myManageHook, - layoutHook = myLayout, - handleEventHook = - handleEventHook def <+> fullscreenEventHook - } - `additionalKeysP` [ ("M-S-z", spawn "xscreensaver-command -lock"), - ("M-S-s", unGrab *> spawn "cast_screenshot"), - ("M-f", runOrRaise "brave" (className =? "Brave-browser")), - ("M-o", runOrRaise "emacs" (className =? "Emacs")), - ("M-i", raise (className =? "jetbrains-idea")), - ("M-", spawn "rofi -show drun"), - ("M-p", spawn "dmenu-with-suggestions"), - -- audio settings - ("", spawn "amixer set Master 5%- unmute"), - ("", spawn "amixer set Master 5%+ unmute"), - ("", spawn "amixer set Master toggle"), - ("", spawn "playerctl play-pause"), - ("", spawn "playerctl previous"), - ("", spawn "playerctl next"), - -- window navigation - ("M-l", windowGo R False), - ("M-h", windowGo L False), - ("M-S-h", sendMessage Shrink), -- Shrink horiz window width - ("M-S-l", sendMessage Expand), -- Expand horiz window width - -- layout switching - ("M-", sendMessage NextLayout), - ("M-", sendMessage $ JumpToLayout "Full"), -- jump directly to the Full layout - -- dmenu stuff - ("M1-", spawn "powerbutton"), - -- lockscreen - ("M-", spawn "betterlockscreen -l & sleep 4 && xdg-screensaver activate") - ] - `additionalMouseBindings` [ ((mod4Mask, button1), \w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 200) (Just 200) w)), - ((mod4Mask .|. shiftMask, button1), \w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L, R, U, D] (Just 200) (Just 200) w)), - ((mod4Mask, button3), \w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R, D] (Just 50) (Just 50) w)) - ] + $ def + { modMask = mod4Mask, + terminal = "st", + startupHook = myStartupHook, + borderWidth = 2, + normalBorderColor = "#000000", + focusedBorderColor = colors !! 7, + workspaces = myWorkspaces, + manageHook = myManageHook, + layoutHook = myLayout, + handleEventHook = + handleEventHook def <+> fullscreenEventHook + } + `additionalKeysP` [ ("M-S-z", spawn "xscreensaver-command -lock"), + ("M-S-s", unGrab *> spawn "cast_screenshot"), + ("M-f", runOrRaise "brave" (className =? "Brave-browser")), + ("M-i", raise (className =? "jetbrains-idea")), + ("M-", spawn "rofi -show drun"), + ("M-p", spawn "dmenu-with-suggestions"), + -- audio settings + ("", spawn "amixer set Master 5%- unmute"), + ("", spawn "amixer set Master 5%+ unmute"), + ("", spawn "amixer set Master toggle"), + ("", spawn "playerctl play-pause"), + ("", spawn "playerctl previous"), + ("", spawn "playerctl next"), + -- window navigation + ("M-l", sendMessage $ Go R), + ("M-h", sendMessage $ Go L), + ("M-S-h", sendMessage Shrink), -- Shrink horiz window width + ("M-S-l", sendMessage Expand), -- Expand horiz window width + -- layout switching + ("M-", sendMessage NextLayout), + -- dmenu stuff + ("M1-", spawn "powerbutton"), + -- lockscreen + ("M-", spawn "betterlockscreen -l") + ] myXmobarPP :: [String] -> PP myXmobarPP colors = @@ -175,8 +159,8 @@ myXmobarPP colors = { ppSep = walXmobarColor 1 " \63617 ", ppTitleSanitize = xmobarStrip, ppCurrent = wrap " " "" . xmobarBorder "Top" (colors !! 6) 2, - ppHidden = walXmobarColor 2 . wrap " " "", - ppHiddenNoWindows = walXmobarColor 1 . wrap " " "", + ppHidden = white . wrap " " "", + ppHiddenNoWindows = lowWhite . wrap " " "", ppUrgent = red . wrap (yellow "!") (yellow "!"), ppVisible = wrap " " "" . xmobarBorder "Bottom" (colors !! 6) 2, ppOrder = \[ws, l, _, wins] -> [ws, l, wins], @@ -184,8 +168,8 @@ myXmobarPP colors = ppSort = hideWorkspaces } where - formatFocused = wrap (walXmobarColor 4 "\58279") (walXmobarColor 4 "\58254") . walXmobarColor 4 . ppWindow - formatUnfocused = wrap (walXmobarColor 7 "\58279") (walXmobarColor 7 "\58254") . walXmobarColor 7 . ppWindow + formatFocused = wrap (walXmobarColor 7 "\58279") (walXmobarColor 7 "\58254") . walXmobarColor 7 . ppWindow + formatUnfocused = wrap (walXmobarColor 4 "\58279") (walXmobarColor 4 "\58254") . walXmobarColor 4 . ppWindow walXmobarColor index = xmobarColor (colors !! index) "" ppWindow :: String -> String ppWindow = xmobarRaw . (\w -> if null w then "untitled" else w) . shorten 30 @@ -209,14 +193,10 @@ myXmobarPP colors = myStartupHook :: X () myStartupHook = do - mapM_ - spawnOnce - [ "picom --experimental-backends &", - "sh $HOME/.fehbg", - "setxkbmap -option caps:escape", - "xset r rate 300 50", - "signal-deskto &" - ] + spawnOnce "picom &" + spawnOnce "sh $HOME/.fehbg" + spawnOnce "setxkbmap -option caps:escape" + spawnOnce "xset r rate 300 50" getWalColors :: IO [String] getWalColors = do @@ -232,7 +212,7 @@ mySpacing' i = spacingRaw True (Border i 0 i i) True (Border i 0 i i) True myWorkspaces :: [String] myWorkspaces = show <$> ([1 .. 9] :: [Integer]) -myLayout = fullscreenFull $ smartBorders $ tiled ||| smartBorders Full ||| Mirror (fullWSpacing 8 $ Tall nmaster delta ratio) +myLayout = smartBorders $ windowNavigation tiled ||| smartBorders Full ||| Mirror (fullWSpacing 8 $ Tall nmaster delta ratio) where tiled = named "Tall" $ mySpacing' 8 $ Tall nmaster delta ratio nmaster = 1 -- Default number of windows in the master pane @@ -271,7 +251,6 @@ myManageHook = (className =? "TelegramDesktop") <&&> (title ~=? "Media viewer") --> doFloat ] <+> insertPosition End Newer - <+> fullscreenManageHook where viewShift = doF . liftM2 (.) greedyView shift