diff --git a/bin/xmonad.hs b/bin/xmonad.hs index db00b82..8872f2d 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -9,6 +9,7 @@ module Main (main) where import Control.Concurrent import Control.Monad (unless) +import Data.Either (fromRight) import Data.List ( isPrefixOf , sortBy @@ -81,7 +82,8 @@ main = do , childPIDs = [p] , childHandles = [h] } - ext <- evalExternal $ externalBindings bc sc ts + lock <- fromRight skip <$> evalFeature runScreenLock + ext <- evalExternal $ externalBindings bc sc ts lock warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions -- IDK why this is necessary; nothing prior to this line will print if missing hFlush stdout @@ -92,7 +94,7 @@ main = do , modMask = myModMask , layoutHook = myLayouts , manageHook = myManageHook - , handleEventHook = myEventHook + , handleEventHook = myEventHook lock , startupHook = myStartupHook , workspaces = myWorkspaces , logHook = myLoghook h @@ -375,19 +377,19 @@ manageApps = composeOne $ concatMap dwHook allDWs ++ -------------------------------------------------------------------------------- -- | Eventhook configuration -myEventHook :: Event -> X All -myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def +myEventHook :: X () -> Event -> X All +myEventHook lock = xMsgEventHook lock <+> docksEventHook <+> handleEventHook def -- | React to ClientMessage events from concurrent threads -xMsgEventHook :: Event -> X All -xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d } +xMsgEventHook :: X () -> Event -> X All +xMsgEventHook lock ClientMessageEvent { ev_message_type = t, ev_data = d } | t == bITMAP = do let (xtype, tag) = splitXMsg d case xtype of Workspace -> removeDynamicWorkspace tag - ACPI -> handleACPI tag + ACPI -> handleACPI lock tag return (All True) -xMsgEventHook _ = return (All True) +xMsgEventHook _ _ = return (All True) -------------------------------------------------------------------------------- -- | Keymap configuration @@ -504,9 +506,9 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of (Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip } -- _ -> Nothing -externalBindings :: BrightnessControls -> SSControls -> ThreadState +externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X () -> [KeyGroup (IO MaybeX)] -externalBindings bc sc ts = +externalBindings bc sc ts lock = [ KeyGroup "Launchers" [ KeyBinding "" "select/launch app" runAppMenu , KeyBinding "M-g" "launch clipboard manager" runClipMenu @@ -555,9 +557,10 @@ externalBindings bc sc ts = , KeyBinding "M-," "backlight down" $ return $ io <$> bctlDec bc , KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc , KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc - , KeyBinding "M-" "power menu" $ noCheck runPowerPrompt + , KeyBinding "M-" "power menu" $ noCheck $ runPowerPrompt lock , KeyBinding "M-" "quit xmonad" $ noCheck runQuitPrompt - , KeyBinding "M-" "lock screen" runScreenLock + -- TODO this won't be aware of when the lock doesn't exist + , KeyBinding "M-" "lock screen" $ noCheck lock -- M- reserved for showing the keymap , KeyBinding "M-" "restart xmonad" $ noCheck (runCleanup ts >> runRestart) , KeyBinding "M-" "recompile xmonad" $ noCheck runRecompile diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index 2244e78..3410676 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -44,8 +44,15 @@ myOptimusManager = "optimus-manager" -------------------------------------------------------------------------------- -- | Core commands -runScreenLock :: IO MaybeX -runScreenLock = spawnIfInstalled myScreenlock +-- runScreenLock :: IO MaybeX +-- runScreenLock = spawnIfInstalled myScreenlock + +runScreenLock :: Feature (X ()) (X ()) +runScreenLock = Feature + { ftrAction = spawn myScreenlock + , ftrSilent = False + , ftrChildren = [exe myScreenlock] + } runPowerOff :: X () runPowerOff = spawn "systemctl poweroff" @@ -101,6 +108,12 @@ runOptimusPrompt' = do runOptimusPrompt :: IO MaybeX runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt' +-- runOptimusPrompt :: Feature (X ()) (X ()) +-- runOptimusPrompt = Feature +-- { ftrAction = runOptimusPrompt' +-- , ftrSilent = False +-- , ftrChildren = [exe myOptimusManager] +-- } -------------------------------------------------------------------------------- -- | Universal power prompt @@ -128,8 +141,8 @@ data PowerPrompt = PowerPrompt instance XPrompt PowerPrompt where showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:" -runPowerPrompt :: X () -runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction +runPowerPrompt :: X () -> X () +runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeAction where comp = mkComplFunFromList [] theme = T.promptTheme { promptKeymap = keymap } @@ -148,6 +161,34 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction Poweroff -> runPowerOff -- TODO these dependency functions need to be assembled elsewhere and fed -- to this function - Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend - Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate + -- Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend + -- Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate + Shutdown -> lock >> runSuspend + Hibernate -> lock >> runHibernate Reboot -> runReboot + +-- runPowerPrompt :: Feature (X ()) (X ()) -> IO (X ()) +-- runPowerPrompt lock = do +-- lock' <- evalFeature lock +-- return $ mkXPrompt PowerPrompt theme comp $ executeAction $ fromRight (return ()) lock' +-- where +-- comp = mkComplFunFromList [] +-- theme = T.promptTheme { promptKeymap = keymap } +-- keymap = M.fromList +-- $ ((controlMask, xK_g), quit) : +-- map (first $ (,) 0) +-- [ (xK_p, sendAction Poweroff) +-- , (xK_s, sendAction Shutdown) +-- , (xK_h, sendAction Hibernate) +-- , (xK_r, sendAction Reboot) +-- , (xK_Return, quit) +-- , (xK_Escape, quit) +-- ] +-- sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True +-- executeAction l a = case toEnum $ read a of +-- Poweroff -> runPowerOff +-- -- TODO these dependency functions need to be assembled elsewhere and fed +-- -- to this function +-- Shutdown -> l >> runSuspend +-- Hibernate -> l >> runHibernate +-- Reboot -> runReboot diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs index 48d1041..1a5cc71 100644 --- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs +++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs @@ -99,15 +99,16 @@ runPowermon = runIfInstalled [pathR acpiPath] listenACPI -- | Handle ClientMessage event containing and ACPI event (to be used in -- Xmonad's event hook) -handleACPI :: String -> X () -handleACPI tag = do +handleACPI :: X () -> String -> X () +handleACPI lock tag = do let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent forM_ acpiTag $ \case - Power -> runPowerPrompt + Power -> runPowerPrompt lock Sleep -> runSuspendPrompt LidClose -> do status <- io isDischarging -- only run suspend if battery exists and is discharging forM_ status $ flip when runSuspend - io runScreenLock >>= whenInstalled + -- io runScreenLock >>= whenInstalled + lock