ENH use dep interface for screen lock
This commit is contained in:
parent
543858c95e
commit
5c30d513eb
|
@ -9,6 +9,7 @@ module Main (main) where
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad (unless)
|
import Control.Monad (unless)
|
||||||
|
|
||||||
|
import Data.Either (fromRight)
|
||||||
import Data.List
|
import Data.List
|
||||||
( isPrefixOf
|
( isPrefixOf
|
||||||
, sortBy
|
, sortBy
|
||||||
|
@ -81,7 +82,8 @@ main = do
|
||||||
, childPIDs = [p]
|
, childPIDs = [p]
|
||||||
, childHandles = [h]
|
, 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
|
warnMissing $ externalToMissing ext ++ fmap (io <$>) depActions
|
||||||
-- 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
|
||||||
|
@ -92,7 +94,7 @@ main = do
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts
|
, layoutHook = myLayouts
|
||||||
, manageHook = myManageHook
|
, manageHook = myManageHook
|
||||||
, handleEventHook = myEventHook
|
, handleEventHook = myEventHook lock
|
||||||
, startupHook = myStartupHook
|
, startupHook = myStartupHook
|
||||||
, workspaces = myWorkspaces
|
, workspaces = myWorkspaces
|
||||||
, logHook = myLoghook h
|
, logHook = myLoghook h
|
||||||
|
@ -375,19 +377,19 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Eventhook configuration
|
-- | Eventhook configuration
|
||||||
|
|
||||||
myEventHook :: Event -> X All
|
myEventHook :: X () -> Event -> X All
|
||||||
myEventHook = xMsgEventHook <+> docksEventHook <+> handleEventHook def
|
myEventHook lock = xMsgEventHook lock <+> docksEventHook <+> handleEventHook def
|
||||||
|
|
||||||
-- | React to ClientMessage events from concurrent threads
|
-- | React to ClientMessage events from concurrent threads
|
||||||
xMsgEventHook :: Event -> X All
|
xMsgEventHook :: X () -> Event -> X All
|
||||||
xMsgEventHook ClientMessageEvent { ev_message_type = t, ev_data = d }
|
xMsgEventHook lock ClientMessageEvent { ev_message_type = t, ev_data = d }
|
||||||
| t == bITMAP = do
|
| t == bITMAP = do
|
||||||
let (xtype, tag) = splitXMsg d
|
let (xtype, tag) = splitXMsg d
|
||||||
case xtype of
|
case xtype of
|
||||||
Workspace -> removeDynamicWorkspace tag
|
Workspace -> removeDynamicWorkspace tag
|
||||||
ACPI -> handleACPI tag
|
ACPI -> handleACPI lock tag
|
||||||
return (All True)
|
return (All True)
|
||||||
xMsgEventHook _ = return (All True)
|
xMsgEventHook _ _ = return (All True)
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Keymap configuration
|
-- | Keymap configuration
|
||||||
|
@ -504,9 +506,9 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbAction = a } = case a of
|
||||||
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
(Left _) -> Just $ k{ kbDesc = "[!!!]" ++ d, kbAction = skip }
|
||||||
-- _ -> Nothing
|
-- _ -> Nothing
|
||||||
|
|
||||||
externalBindings :: BrightnessControls -> SSControls -> ThreadState
|
externalBindings :: BrightnessControls -> SSControls -> ThreadState -> X ()
|
||||||
-> [KeyGroup (IO MaybeX)]
|
-> [KeyGroup (IO MaybeX)]
|
||||||
externalBindings bc sc ts =
|
externalBindings bc sc ts lock =
|
||||||
[ KeyGroup "Launchers"
|
[ KeyGroup "Launchers"
|
||||||
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
[ KeyBinding "<XF86Search>" "select/launch app" runAppMenu
|
||||||
, KeyBinding "M-g" "launch clipboard manager" runClipMenu
|
, 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-," "backlight down" $ return $ io <$> bctlDec bc
|
||||||
, KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc
|
, KeyBinding "M-M1-," "backlight min" $ return $ io <$> bctlMin bc
|
||||||
, KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc
|
, KeyBinding "M-M1-." "backlight max" $ return $ io <$> bctlMax bc
|
||||||
, KeyBinding "M-<End>" "power menu" $ noCheck runPowerPrompt
|
, KeyBinding "M-<End>" "power menu" $ noCheck $ runPowerPrompt lock
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ noCheck runQuitPrompt
|
||||||
, KeyBinding "M-<Delete>" "lock screen" runScreenLock
|
-- TODO this won't be aware of when the lock doesn't exist
|
||||||
|
, KeyBinding "M-<Delete>" "lock screen" $ noCheck lock
|
||||||
-- M-<F1> reserved for showing the keymap
|
-- M-<F1> reserved for showing the keymap
|
||||||
, KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
|
, KeyBinding "M-<F2>" "restart xmonad" $ noCheck (runCleanup ts >> runRestart)
|
||||||
, KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile
|
, KeyBinding "M-<F3>" "recompile xmonad" $ noCheck runRecompile
|
||||||
|
|
|
@ -44,8 +44,15 @@ myOptimusManager = "optimus-manager"
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Core commands
|
-- | Core commands
|
||||||
|
|
||||||
runScreenLock :: IO MaybeX
|
-- runScreenLock :: IO MaybeX
|
||||||
runScreenLock = spawnIfInstalled myScreenlock
|
-- runScreenLock = spawnIfInstalled myScreenlock
|
||||||
|
|
||||||
|
runScreenLock :: Feature (X ()) (X ())
|
||||||
|
runScreenLock = Feature
|
||||||
|
{ ftrAction = spawn myScreenlock
|
||||||
|
, ftrSilent = False
|
||||||
|
, ftrChildren = [exe myScreenlock]
|
||||||
|
}
|
||||||
|
|
||||||
runPowerOff :: X ()
|
runPowerOff :: X ()
|
||||||
runPowerOff = spawn "systemctl poweroff"
|
runPowerOff = spawn "systemctl poweroff"
|
||||||
|
@ -101,6 +108,12 @@ runOptimusPrompt' = do
|
||||||
|
|
||||||
runOptimusPrompt :: IO MaybeX
|
runOptimusPrompt :: IO MaybeX
|
||||||
runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt'
|
runOptimusPrompt = runIfInstalled [exe myOptimusManager] runOptimusPrompt'
|
||||||
|
-- runOptimusPrompt :: Feature (X ()) (X ())
|
||||||
|
-- runOptimusPrompt = Feature
|
||||||
|
-- { ftrAction = runOptimusPrompt'
|
||||||
|
-- , ftrSilent = False
|
||||||
|
-- , ftrChildren = [exe myOptimusManager]
|
||||||
|
-- }
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Universal power prompt
|
-- | Universal power prompt
|
||||||
|
@ -128,8 +141,8 @@ data PowerPrompt = PowerPrompt
|
||||||
instance XPrompt PowerPrompt where
|
instance XPrompt PowerPrompt where
|
||||||
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
|
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
|
||||||
|
|
||||||
runPowerPrompt :: X ()
|
runPowerPrompt :: X () -> X ()
|
||||||
runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeAction
|
||||||
where
|
where
|
||||||
comp = mkComplFunFromList []
|
comp = mkComplFunFromList []
|
||||||
theme = T.promptTheme { promptKeymap = keymap }
|
theme = T.promptTheme { promptKeymap = keymap }
|
||||||
|
@ -148,6 +161,34 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
|
||||||
Poweroff -> runPowerOff
|
Poweroff -> runPowerOff
|
||||||
-- TODO these dependency functions need to be assembled elsewhere and fed
|
-- TODO these dependency functions need to be assembled elsewhere and fed
|
||||||
-- to this function
|
-- to this function
|
||||||
Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
|
-- Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend
|
||||||
Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
|
-- Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate
|
||||||
|
Shutdown -> lock >> runSuspend
|
||||||
|
Hibernate -> lock >> runHibernate
|
||||||
Reboot -> runReboot
|
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
|
||||||
|
|
|
@ -99,15 +99,16 @@ runPowermon = runIfInstalled [pathR acpiPath] listenACPI
|
||||||
|
|
||||||
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
-- | Handle ClientMessage event containing and ACPI event (to be used in
|
||||||
-- Xmonad's event hook)
|
-- Xmonad's event hook)
|
||||||
handleACPI :: String -> X ()
|
handleACPI :: X () -> String -> X ()
|
||||||
handleACPI tag = do
|
handleACPI lock tag = do
|
||||||
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
|
||||||
forM_ acpiTag $ \case
|
forM_ acpiTag $ \case
|
||||||
Power -> runPowerPrompt
|
Power -> runPowerPrompt lock
|
||||||
Sleep -> runSuspendPrompt
|
Sleep -> runSuspendPrompt
|
||||||
LidClose -> do
|
LidClose -> do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
-- only run suspend if battery exists and is discharging
|
-- only run suspend if battery exists and is discharging
|
||||||
forM_ status $ flip when runSuspend
|
forM_ status $ flip when runSuspend
|
||||||
io runScreenLock >>= whenInstalled
|
-- io runScreenLock >>= whenInstalled
|
||||||
|
lock
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue