ENH update to xmonad 0.17

This commit is contained in:
Nathan Dwarshuis 2022-03-05 18:18:16 -05:00
parent 9e6bcde08c
commit ee7406fd19
6 changed files with 37 additions and 29 deletions

View File

@ -35,7 +35,10 @@ import Xmobar.Plugins.IntelBacklight
import Xmobar.Plugins.Screensaver import Xmobar.Plugins.Screensaver
import Xmobar.Plugins.VPN import Xmobar.Plugins.VPN
import XMonad (getXMonadDir) import XMonad.Core
( cfgDir
, getDirectories
)
import XMonad.Hooks.DynamicLog (wrap) import XMonad.Hooks.DynamicLog (wrap)
import XMonad.Internal.Command.Power (hasBattery) import XMonad.Internal.Command.Power (hasBattery)
import XMonad.Internal.DBus.Brightness.ClevoKeyboard import XMonad.Internal.DBus.Brightness.ClevoKeyboard
@ -52,7 +55,7 @@ main = do
sysClient <- getDBusClient True sysClient <- getDBusClient True
sesClient <- getDBusClient False sesClient <- getDBusClient False
cs <- getAllCommands =<< rightPlugins sysClient sesClient cs <- getAllCommands =<< rightPlugins sysClient sesClient
d <- getXMonadDir d <- cfgDir <$> getDirectories
-- this is needed to see any printed messages -- this is needed to see any printed messages
hFlush stdout hFlush stdout
mapM_ (maybe skip disconnect) [sysClient, sesClient] mapM_ (maybe skip disconnect) [sysClient, sesClient]

View File

@ -93,9 +93,10 @@ main = do
ext <- evalExternal $ externalBindings ts lock ext <- evalExternal $ externalBindings ts lock
-- IDK why this is necessary; nothing prior to this line will print if missing -- IDK why this is necessary; nothing prior to this line will print if missing
hFlush stdout hFlush stdout
launch ds <- getDirectories
$ ewmh let conf = ewmh
$ addKeymap (filterExternal ext) $ addKeymap (filterExternal ext)
$ docks
$ def { terminal = myTerm $ def { terminal = myTerm
, modMask = myModMask , modMask = myModMask
, layoutHook = myLayouts , layoutHook = myLayouts
@ -109,6 +110,7 @@ main = do
, normalBorderColor = T.bordersColor , normalBorderColor = T.bordersColor
, focusedBorderColor = T.selectedBordersColor , focusedBorderColor = T.selectedBordersColor
} }
launch conf ds
where where
forkIO_ = void . forkIO forkIO_ = void . forkIO
@ -135,7 +137,6 @@ runCleanup ts = io $ do
-- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED? -- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
myStartupHook :: X () myStartupHook :: X ()
myStartupHook = setDefaultCursor xC_left_ptr myStartupHook = setDefaultCursor xC_left_ptr
<+> docksStartupHook
<+> startupHook def <+> startupHook def
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -363,7 +364,7 @@ compareXCoord s0 s1 = compare x0 x1
-- | Managehook configuration -- | Managehook configuration
myManageHook :: ManageHook myManageHook :: ManageHook
myManageHook = manageApps <+> manageDocks <+> manageHook def myManageHook = manageApps <+> manageHook def
manageApps :: ManageHook manageApps :: ManageHook
manageApps = composeOne $ concatMap dwHook allDWs ++ manageApps = composeOne $ concatMap dwHook allDWs ++
@ -388,7 +389,7 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
-- | Eventhook configuration -- | Eventhook configuration
myEventHook :: X () -> Event -> X All 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 -- | React to ClientMessage events from concurrent threads
xMsgEventHook :: X () -> Event -> X All xMsgEventHook :: X () -> Event -> X All
@ -443,8 +444,8 @@ internalBindings c =
windows $ W.view n') windows $ W.view n')
] ]
] ++ ] ++
[ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next (hiddenWS :&: Not emptyWS)
, KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev (hiddenWS :&: Not emptyWS)
]) ])
, KeyGroup "Dynamic Workspaces" , KeyGroup "Dynamic Workspaces"

View File

@ -43,6 +43,7 @@ import System.Directory
import System.Environment import System.Environment
import System.FilePath import System.FilePath
import XMonad (asks)
import XMonad.Actions.Volume import XMonad.Actions.Volume
import XMonad.Core hiding (spawn) import XMonad.Core hiding (spawn)
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
@ -145,7 +146,8 @@ soundDir = "sound"
playSound :: MonadIO m => FilePath -> m () playSound :: MonadIO m => FilePath -> m ()
playSound file = do 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 -- paplay seems to have less latency than aplay
spawnCmd "paplay" [p] spawnCmd "paplay" [p]
@ -230,7 +232,7 @@ runRestart = restart "xmonad" True
runRecompile :: X () runRecompile :: X ()
runRecompile = do runRecompile = do
-- assume that the conf directory contains a valid stack project -- assume that the conf directory contains a valid stack project
confDir <- getXMonadDir confDir <- asks (cfgDir . directories)
spawnAt confDir $ fmtCmd "stack" ["install"] spawnAt confDir $ fmtCmd "stack" ["install"]
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" } #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }

View File

@ -133,7 +133,7 @@ instance XPrompt PowerPrompt where
runPowerPrompt :: X () -> X () runPowerPrompt :: X () -> X ()
runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeMaybeAction runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeMaybeAction
where where
comp = mkComplFunFromList [] comp = mkComplFunFromList theme []
theme = T.promptTheme { promptKeymap = keymap } theme = T.promptTheme { promptKeymap = keymap }
keymap = M.fromList keymap = M.fromList
$ ((controlMask, xK_g), quit) : $ ((controlMask, xK_g), quit) :

View File

@ -13,6 +13,7 @@ import Data.Map.Lazy (Map, member)
import DBus import DBus
import DBus.Client import DBus.Client
import XMonad.Core (io)
import XMonad.Internal.Command.Desktop import XMonad.Internal.Command.Desktop
import XMonad.Internal.Dependency import XMonad.Internal.Dependency
@ -66,7 +67,7 @@ removedHasDrive [_, a] = maybe False (driveFlag `elem`)
removedHasDrive _ = False removedHasDrive _ = False
playSoundMaybe :: FilePath -> Bool -> IO () 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. -- 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 -- If it not already, we won't see any signals from the dbus until it is

View File

@ -17,7 +17,8 @@
# #
# resolver: ./custom-snapshot.yaml # resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.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. # User packages to be built.
# Various formats can be used as shown in the example below. # Various formats can be used as shown in the example below.
@ -45,7 +46,7 @@ extra-deps:
- tcp-streams-1.0.1.1 - tcp-streams-1.0.1.1
- github: ndwarshuis/xmobar - github: ndwarshuis/xmobar
# commit: 4186bcbc50a7c78ac0aee8bc3719e0dd9a46dace # commit: 4186bcbc50a7c78ac0aee8bc3719e0dd9a46dace
commit: 7d37ab57d8160cf840c1fe2a279c89eac599a10b commit: 918ee70d304c816000638ce82d8b446778377589
# Override default flag values for local packages and extra-deps # Override default flag values for local packages and extra-deps
# flags: {} # flags: {}