ENH use dependency framework for power prompt
This commit is contained in:
parent
53a537960e
commit
9961f2909d
|
@ -92,10 +92,9 @@ run = do
|
||||||
{ tsChildPIDs = [p]
|
{ tsChildPIDs = [p]
|
||||||
, tsChildHandles = [h]
|
, tsChildHandles = [h]
|
||||||
}
|
}
|
||||||
lockRes <- evalSometimes runScreenLock
|
ext <- evalExternal $ externalBindings ts db
|
||||||
let lock = fromMaybe skip lockRes
|
|
||||||
ext <- evalExternal $ externalBindings ts db lock
|
|
||||||
sk <- evalAlways runShowKeys
|
sk <- evalAlways runShowKeys
|
||||||
|
ha <- evalAlways runHandleACPI
|
||||||
-- 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
|
||||||
ds <- getDirectories
|
ds <- getDirectories
|
||||||
|
@ -106,7 +105,7 @@ run = do
|
||||||
, modMask = myModMask
|
, modMask = myModMask
|
||||||
, layoutHook = myLayouts
|
, layoutHook = myLayouts
|
||||||
, manageHook = myManageHook
|
, manageHook = myManageHook
|
||||||
, handleEventHook = myEventHook lock
|
, handleEventHook = myEventHook ha
|
||||||
, startupHook = myStartupHook
|
, startupHook = myStartupHook
|
||||||
, workspaces = myWorkspaces
|
, workspaces = myWorkspaces
|
||||||
, logHook = myLoghook h
|
, logHook = myLoghook h
|
||||||
|
@ -442,17 +441,17 @@ manageApps = composeOne $ concatMap dwHook allDWs ++
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Eventhook configuration
|
-- | Eventhook configuration
|
||||||
|
|
||||||
myEventHook :: X () -> Event -> X All
|
myEventHook :: (String -> X ()) -> Event -> X All
|
||||||
myEventHook lock = xMsgEventHook lock <+> handleEventHook def
|
myEventHook handler = xMsgEventHook handler <+> handleEventHook def
|
||||||
|
|
||||||
-- | React to ClientMessage events from concurrent threads
|
-- | React to ClientMessage events from concurrent threads
|
||||||
xMsgEventHook :: X () -> Event -> X All
|
xMsgEventHook :: (String -> X ()) -> Event -> X All
|
||||||
xMsgEventHook lock ClientMessageEvent { ev_message_type = t, ev_data = d }
|
xMsgEventHook handler 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 lock tag
|
ACPI -> handler tag
|
||||||
Unknown -> io $ print "WARNING: unknown concurrent message"
|
Unknown -> io $ print "WARNING: unknown concurrent message"
|
||||||
return (All True)
|
return (All True)
|
||||||
xMsgEventHook _ _ = return (All True)
|
xMsgEventHook _ _ = return (All True)
|
||||||
|
@ -559,8 +558,8 @@ flagKeyBinding k@KeyBinding{ kbDesc = d, kbMaybeAction = a } = case a of
|
||||||
(Just x) -> Just $ k{ kbMaybeAction = x }
|
(Just x) -> Just $ k{ kbMaybeAction = x }
|
||||||
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
Nothing -> Just $ k{ kbDesc = "[!!!]" ++ d, kbMaybeAction = skip }
|
||||||
|
|
||||||
externalBindings :: ThreadState -> DBusState -> X () -> [KeyGroup (FeatureX)]
|
externalBindings :: ThreadState -> DBusState -> [KeyGroup FeatureX]
|
||||||
externalBindings ts db lock =
|
externalBindings ts db =
|
||||||
[ KeyGroup "Launchers"
|
[ KeyGroup "Launchers"
|
||||||
[ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
|
[ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu
|
||||||
, KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
|
, KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu
|
||||||
|
@ -615,7 +614,7 @@ externalBindings ts db lock =
|
||||||
, KeyBinding "M-S-," "keyboard down" $ ck bctlDec
|
, KeyBinding "M-S-," "keyboard down" $ ck bctlDec
|
||||||
, KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
|
, KeyBinding "M-S-M1-," "keyboard min" $ ck bctlMin
|
||||||
, KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
|
, KeyBinding "M-S-M1-." "keyboard max" $ ck bctlMax
|
||||||
, KeyBinding "M-<End>" "power menu" $ ftrAlways $ runPowerPrompt lock
|
, KeyBinding "M-<End>" "power menu" $ Right runPowerPrompt
|
||||||
, KeyBinding "M-<Home>" "quit xmonad" $ ftrAlways runQuitPrompt
|
, KeyBinding "M-<Home>" "quit xmonad" $ ftrAlways runQuitPrompt
|
||||||
, KeyBinding "M-<Delete>" "lock screen" $ Left runScreenLock
|
, KeyBinding "M-<Delete>" "lock screen" $ Left runScreenLock
|
||||||
-- M-<F1> reserved for showing the keymap
|
-- M-<F1> reserved for showing the keymap
|
||||||
|
|
|
@ -91,28 +91,6 @@ runVPNMenu :: SometimesX
|
||||||
runVPNMenu = sometimesIO "VPN selector" (Only_ $ localExe myDmenuVPN) $
|
runVPNMenu = sometimesIO "VPN selector" (Only_ $ localExe myDmenuVPN) $
|
||||||
spawnCmd myDmenuVPN $ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
|
spawnCmd myDmenuVPN $ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
|
||||||
|
|
||||||
runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
|
|
||||||
runShowKeys = Option showKeysDMenu (Always fallback)
|
|
||||||
where
|
|
||||||
-- TODO this should technically depend on dunst
|
|
||||||
fallback = const $ spawnNotify
|
|
||||||
$ defNoteError { body = Just $ Text "could not display keymap" }
|
|
||||||
|
|
||||||
showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
|
|
||||||
showKeysDMenu = Subfeature
|
|
||||||
{ sfName = "keyboard shortcut menu"
|
|
||||||
, sfData = IORoot_ showKeys $ Only_ $ sysExe myDmenuCmd
|
|
||||||
, sfLevel = Warn
|
|
||||||
}
|
|
||||||
|
|
||||||
showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
|
|
||||||
showKeys kbs = io $ do
|
|
||||||
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
|
||||||
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
|
|
||||||
where
|
|
||||||
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
|
||||||
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
|
|
||||||
|
|
||||||
runCmdMenu :: SometimesX
|
runCmdMenu :: SometimesX
|
||||||
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
|
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
|
||||||
|
|
||||||
|
@ -139,3 +117,28 @@ runNetMenu =
|
||||||
runAutorandrMenu :: SometimesX
|
runAutorandrMenu :: SometimesX
|
||||||
runAutorandrMenu =
|
runAutorandrMenu =
|
||||||
sometimesExeArgs "autorandr menu" True myDmenuMonitors $ themeArgs "#ff0066"
|
sometimesExeArgs "autorandr menu" True myDmenuMonitors $ themeArgs "#ff0066"
|
||||||
|
|
||||||
|
--------------------------------------------------------------------------------
|
||||||
|
-- | Shortcut menu
|
||||||
|
|
||||||
|
runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
|
||||||
|
runShowKeys = Option showKeysDMenu (Always fallback)
|
||||||
|
where
|
||||||
|
-- TODO this should technically depend on dunst
|
||||||
|
fallback = const $ spawnNotify
|
||||||
|
$ defNoteError { body = Just $ Text "could not display keymap" }
|
||||||
|
|
||||||
|
showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
|
||||||
|
showKeysDMenu = Subfeature
|
||||||
|
{ sfName = "keyboard shortcut menu"
|
||||||
|
, sfData = IORoot_ showKeys $ Only_ $ sysExe myDmenuCmd
|
||||||
|
, sfLevel = Warn
|
||||||
|
}
|
||||||
|
|
||||||
|
showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
|
||||||
|
showKeys kbs = io $ do
|
||||||
|
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
||||||
|
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
|
||||||
|
where
|
||||||
|
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
|
||||||
|
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs
|
||||||
|
|
|
@ -12,6 +12,9 @@ module XMonad.Internal.Command.Power
|
||||||
, runSuspendPrompt
|
, runSuspendPrompt
|
||||||
, runQuitPrompt
|
, runQuitPrompt
|
||||||
, hasBattery
|
, hasBattery
|
||||||
|
|
||||||
|
|
||||||
|
, powerPrompt
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Arrow (first)
|
import Control.Arrow (first)
|
||||||
|
@ -130,8 +133,16 @@ 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 () -> X ()
|
runPowerPrompt :: AlwaysX
|
||||||
runPowerPrompt lock = mkXPrompt PowerPrompt theme comp executeMaybeAction
|
runPowerPrompt = always1 "power prompt" withLock powerPromptNoLock
|
||||||
|
where
|
||||||
|
withLock = IORoot powerPrompt (Only $ IOSometimes runScreenLock id)
|
||||||
|
|
||||||
|
powerPromptNoLock :: X ()
|
||||||
|
powerPromptNoLock = powerPrompt skip
|
||||||
|
|
||||||
|
powerPrompt :: X () -> X ()
|
||||||
|
powerPrompt lock = mkXPrompt PowerPrompt theme comp executeMaybeAction
|
||||||
where
|
where
|
||||||
comp = mkComplFunFromList theme []
|
comp = mkComplFunFromList theme []
|
||||||
theme = T.promptTheme { promptKeymap = keymap }
|
theme = T.promptTheme { promptKeymap = keymap }
|
||||||
|
|
|
@ -6,7 +6,7 @@
|
||||||
|
|
||||||
module XMonad.Internal.Concurrent.ACPIEvent
|
module XMonad.Internal.Concurrent.ACPIEvent
|
||||||
( runPowermon
|
( runPowermon
|
||||||
, handleACPI
|
, runHandleACPI
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
|
@ -26,6 +26,7 @@ import XMonad.Core
|
||||||
import XMonad.Internal.Command.Power
|
import XMonad.Internal.Command.Power
|
||||||
import XMonad.Internal.Concurrent.ClientMessage
|
import XMonad.Internal.Concurrent.ClientMessage
|
||||||
import XMonad.Internal.Dependency
|
import XMonad.Internal.Dependency
|
||||||
|
import XMonad.Internal.Shell
|
||||||
|
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Data structure to hold the ACPI events I care about
|
-- | Data structure to hold the ACPI events I care about
|
||||||
|
@ -97,13 +98,18 @@ acpiPath = "/var/run/acpid.socket"
|
||||||
runPowermon :: SometimesIO
|
runPowermon :: SometimesIO
|
||||||
runPowermon = sometimesIO "ACPI event monitor" (Only_ $ pathR acpiPath) listenACPI
|
runPowermon = sometimesIO "ACPI event monitor" (Only_ $ pathR acpiPath) listenACPI
|
||||||
|
|
||||||
|
runHandleACPI :: Always (String -> X ())
|
||||||
|
runHandleACPI = always1 "ACPI event handler" withLock $ handleACPI skip
|
||||||
|
where
|
||||||
|
withLock = IORoot handleACPI (Only $ IOSometimes runScreenLock id)
|
||||||
|
|
||||||
-- | 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 :: X () -> String -> X ()
|
handleACPI :: X () -> String -> X ()
|
||||||
handleACPI lock 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 lock
|
Power -> powerPrompt lock
|
||||||
Sleep -> runSuspendPrompt
|
Sleep -> runSuspendPrompt
|
||||||
LidClose -> do
|
LidClose -> do
|
||||||
status <- io isDischarging
|
status <- io isDischarging
|
||||||
|
|
|
@ -42,6 +42,7 @@ module XMonad.Internal.Dependency
|
||||||
, ioAlways
|
, ioAlways
|
||||||
|
|
||||||
-- feature construction
|
-- feature construction
|
||||||
|
, always1
|
||||||
, sometimes1
|
, sometimes1
|
||||||
, sometimesIO
|
, sometimesIO
|
||||||
, sometimesDBus
|
, sometimesDBus
|
||||||
|
@ -460,13 +461,16 @@ testDBusDependency_ _ (DBusIO i) = testIODependency_ i
|
||||||
sometimes1_ :: LogLevel -> String -> Root a -> Sometimes a
|
sometimes1_ :: LogLevel -> String -> Root a -> Sometimes a
|
||||||
sometimes1_ l n t = [Subfeature{ sfData = t, sfName = n, sfLevel = l }]
|
sometimes1_ l n t = [Subfeature{ sfData = t, sfName = n, sfLevel = l }]
|
||||||
|
|
||||||
-- always1_ :: LogLevel -> String -> Root a Tree -> a -> Always a
|
always1_ :: LogLevel -> String -> Root a -> a -> Always a
|
||||||
-- always1_ l n t x =
|
always1_ l n t x =
|
||||||
-- Option (Subfeature{ sfData = t, sfName = n, sfLevel = l }) (Always x)
|
Option (Subfeature{ sfData = t, sfName = n, sfLevel = l }) (Always x)
|
||||||
|
|
||||||
sometimes1 :: String -> Root a -> Sometimes a
|
sometimes1 :: String -> Root a -> Sometimes a
|
||||||
sometimes1 = sometimes1_ Error
|
sometimes1 = sometimes1_ Error
|
||||||
|
|
||||||
|
always1 :: String -> Root a -> a -> Always a
|
||||||
|
always1 = always1_ Error
|
||||||
|
|
||||||
sometimesIO :: String -> Tree_ IODependency_ -> a -> Sometimes a
|
sometimesIO :: String -> Tree_ IODependency_ -> a -> Sometimes a
|
||||||
sometimesIO n t x = sometimes1 n $ IORoot_ x t
|
sometimesIO n t x = sometimes1 n $ IORoot_ x t
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue