From ee7406fd19e3a68f7bc7939693c2e21af7b2ec64 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Sat, 5 Mar 2022 18:18:16 -0500 Subject: [PATCH] ENH update to xmonad 0.17 --- bin/xmobar.hs | 7 +++-- bin/xmonad.hs | 43 +++++++++++++------------- lib/XMonad/Internal/Command/Desktop.hs | 6 ++-- lib/XMonad/Internal/Command/Power.hs | 2 +- lib/XMonad/Internal/DBus/Removable.hs | 3 +- stack.yaml | 5 +-- 6 files changed, 37 insertions(+), 29 deletions(-) diff --git a/bin/xmobar.hs b/bin/xmobar.hs index 3ecc9e1..4190560 100644 --- a/bin/xmobar.hs +++ b/bin/xmobar.hs @@ -35,7 +35,10 @@ import Xmobar.Plugins.IntelBacklight import Xmobar.Plugins.Screensaver import Xmobar.Plugins.VPN -import XMonad (getXMonadDir) +import XMonad.Core + ( cfgDir + , getDirectories + ) import XMonad.Hooks.DynamicLog (wrap) import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.DBus.Brightness.ClevoKeyboard @@ -52,7 +55,7 @@ main = do sysClient <- getDBusClient True sesClient <- getDBusClient False cs <- getAllCommands =<< rightPlugins sysClient sesClient - d <- getXMonadDir + d <- cfgDir <$> getDirectories -- this is needed to see any printed messages hFlush stdout mapM_ (maybe skip disconnect) [sysClient, sesClient] diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 9373a7a..828bcd0 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -93,22 +93,24 @@ main = do ext <- evalExternal $ externalBindings ts lock -- IDK why this is necessary; nothing prior to this line will print if missing hFlush stdout - launch - $ ewmh - $ addKeymap (filterExternal ext) - $ def { terminal = myTerm - , modMask = myModMask - , layoutHook = myLayouts - , manageHook = myManageHook - , handleEventHook = myEventHook lock - , startupHook = myStartupHook - , workspaces = myWorkspaces - , logHook = myLoghook h - , clickJustFocuses = False - , focusFollowsMouse = False - , normalBorderColor = T.bordersColor - , focusedBorderColor = T.selectedBordersColor - } + ds <- getDirectories + let conf = ewmh + $ addKeymap (filterExternal ext) + $ docks + $ def { terminal = myTerm + , modMask = myModMask + , layoutHook = myLayouts + , manageHook = myManageHook + , handleEventHook = myEventHook lock + , startupHook = myStartupHook + , workspaces = myWorkspaces + , logHook = myLoghook h + , clickJustFocuses = False + , focusFollowsMouse = False + , normalBorderColor = T.bordersColor + , focusedBorderColor = T.selectedBordersColor + } + launch conf ds where forkIO_ = void . forkIO @@ -135,7 +137,6 @@ runCleanup ts = io $ do -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED? myStartupHook :: X () myStartupHook = setDefaultCursor xC_left_ptr - <+> docksStartupHook <+> startupHook def -------------------------------------------------------------------------------- @@ -363,7 +364,7 @@ compareXCoord s0 s1 = compare x0 x1 -- | Managehook configuration myManageHook :: ManageHook -myManageHook = manageApps <+> manageDocks <+> manageHook def +myManageHook = manageApps <+> manageHook def manageApps :: ManageHook manageApps = composeOne $ concatMap dwHook allDWs ++ @@ -388,7 +389,7 @@ manageApps = composeOne $ concatMap dwHook allDWs ++ -- | Eventhook configuration myEventHook :: X () -> Event -> X All -myEventHook lock = xMsgEventHook lock <+> docksEventHook <+> handleEventHook def +myEventHook lock = xMsgEventHook lock <+> handleEventHook def -- | React to ClientMessage events from concurrent threads xMsgEventHook :: X () -> Event -> X All @@ -443,8 +444,8 @@ internalBindings c = windows $ W.view n') ] ] ++ - [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS - , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS + [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS) + , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev (hiddenWS :&: Not emptyWS) ]) , KeyGroup "Dynamic Workspaces" diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 3c1fbbc..e1ff394 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -43,6 +43,7 @@ import System.Directory import System.Environment import System.FilePath +import XMonad (asks) import XMonad.Actions.Volume import XMonad.Core hiding (spawn) import XMonad.Internal.Dependency @@ -145,7 +146,8 @@ soundDir = "sound" playSound :: MonadIO m => FilePath -> m () playSound file = do - p <- ( soundDir file) <$> getXMonadDir + -- manually look up directories to avoid the X monad + p <- io $ ( soundDir file) . cfgDir <$> getDirectories -- paplay seems to have less latency than aplay spawnCmd "paplay" [p] @@ -230,7 +232,7 @@ runRestart = restart "xmonad" True runRecompile :: X () runRecompile = do -- assume that the conf directory contains a valid stack project - confDir <- getXMonadDir + confDir <- asks (cfgDir . directories) spawnAt confDir $ fmtCmd "stack" ["install"] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" } diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index 54fea83..94f9632 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -133,7 +133,7 @@ instance XPrompt PowerPrompt where runPowerPrompt :: X () -> X () runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeMaybeAction where - comp = mkComplFunFromList [] + comp = mkComplFunFromList theme [] theme = T.promptTheme { promptKeymap = keymap } keymap = M.fromList $ ((controlMask, xK_g), quit) : diff --git a/lib/XMonad/Internal/DBus/Removable.hs b/lib/XMonad/Internal/DBus/Removable.hs index 04049cf..d59d178 100644 --- a/lib/XMonad/Internal/DBus/Removable.hs +++ b/lib/XMonad/Internal/DBus/Removable.hs @@ -13,6 +13,7 @@ import Data.Map.Lazy (Map, member) import DBus import DBus.Client +import XMonad.Core (io) import XMonad.Internal.Command.Desktop import XMonad.Internal.Dependency @@ -66,7 +67,7 @@ removedHasDrive [_, a] = maybe False (driveFlag `elem`) removedHasDrive _ = False playSoundMaybe :: FilePath -> Bool -> IO () -playSoundMaybe p b = when b $ playSound p +playSoundMaybe p b = when b $ io $ playSound p -- NOTE: the udisks2 service should be already running for this module to work. -- If it not already, we won't see any signals from the dbus until it is diff --git a/stack.yaml b/stack.yaml index ba5ddb9..f41dfd6 100644 --- a/stack.yaml +++ b/stack.yaml @@ -17,7 +17,8 @@ # # resolver: ./custom-snapshot.yaml # resolver: https://example.com/snapshots/2018-01-01.yaml -resolver: lts-17.4 +#resolver: lts-17.4 +resolver: nightly-2022-03-03 # User packages to be built. # Various formats can be used as shown in the example below. @@ -45,7 +46,7 @@ extra-deps: - tcp-streams-1.0.1.1 - github: ndwarshuis/xmobar # commit: 4186bcbc50a7c78ac0aee8bc3719e0dd9a46dace - commit: 7d37ab57d8160cf840c1fe2a279c89eac599a10b + commit: 918ee70d304c816000638ce82d8b446778377589 # Override default flag values for local packages and extra-deps # flags: {}