ENH make power prompt better

This commit is contained in:
Nathan Dwarshuis 2020-03-16 19:34:13 -04:00
parent 7a7365de3d
commit c7d7a12ca1
2 changed files with 26 additions and 15 deletions

View File

@ -10,13 +10,15 @@ import qualified Theme as T
import Control.Monad (mapM_, forM_, void, when)
import Data.List (sortBy, sortOn)
import Data.Maybe (fromMaybe, isJust)
import qualified Data.Map.Lazy as M
import Data.Maybe (isJust)
import Data.Monoid (All(..))
import Graphics.X11.Xlib.Atom
import Graphics.X11.Xlib.Extras
import Graphics.X11.Types
import Control.Arrow (first)
import Control.Exception
import System.Directory
@ -165,7 +167,7 @@ myManageHook = composeOne
-- assume virtualbox is not run with the toolbar in fullscreen mode
-- as this makes a new window that confusingly must go over the
-- actual VM window
[ className =? "VirtualBoxVM" -?> doShift "VM"
[ className =? "VirtualBoxVM" -?> doShift myVMWorkspace
-- the seafile applet
, className =? "Seafile Client" -?> doFloat
-- gnucash
@ -173,7 +175,7 @@ myManageHook = composeOne
-- xsane
, className =? "Xsane" -?> doFloat
-- all of GIMP
, className =? "Gimp" -?> doFloat
, className =? "Gimp" -?> doFloat >> doShift myGimpWorkspace
-- , title =? "GIMP Startup" -?> doIgnore
-- plots and graphics created by R
, className =? "R_x11" -?> doFloat
@ -227,11 +229,10 @@ removeEmptyWorkspaceByTag' tag = do
-- this will be enough to make it disappear.
removeEmptyWorkspaceByTag tag
-- TODO is there a better way to get the prompt to say what I want?
data PowerPrompt = PowerPrompt
instance XPrompt PowerPrompt where
showXPrompt PowerPrompt = "Select Option: "
showXPrompt PowerPrompt = "(P)oweroff (S)uspend (H)ibernate (R)eboot:"
runScreenLock :: X ()
runScreenLock = spawn "screenlock"
@ -249,18 +250,27 @@ runReboot :: X ()
runReboot = spawn "systemctl reboot"
myPowerPrompt :: X ()
myPowerPrompt = mkXPrompt PowerPrompt conf comps
$ fromMaybe (return ())
. (`lookup` commands)
myPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction
where
comps = mkComplFunFromList' (map fst commands)
conf = T.promptTheme
commands =
[ ("poweroff", runPowerOff)
, ("suspend", runScreenLock >> runSuspend)
, ("hibernate", runScreenLock >> runHibernate)
, ("reboot", runReboot)
comp = mkComplFunFromList []
theme = T.promptTheme { promptKeymap = keymap }
keymap = M.fromList
$ ((0, xK_g), quit) :
map (first $ (,) 0)
[ (xK_p, sendAction "p")
, (xK_s, sendAction "s")
, (xK_h, sendAction "h")
, (xK_r, sendAction "r")
, (xK_Return, quit)
, (xK_Escape, quit)
]
sendAction a = setInput a >> setSuccess True >> setDone True
executeAction a
| a == "p" = runPowerOff
| a == "s" = runScreenLock >> runSuspend
| a == "h" = runScreenLock >> runHibernate
| a == "r" = runReboot
| otherwise = return () -- should never happen
myQuitPrompt :: X ()
myQuitPrompt = confirmPrompt T.promptTheme "quit?" $ io exitSuccess

View File

@ -27,6 +27,7 @@ executable xmonad
, unix >= 2.7.2.2
, process >= 1.6.5.0
, directory >= 1.3.3.0
, containers >= 0.6.0.1
, my-xmonad
default-language: Haskell2010
ghc-options: -Wall -Werror -fno-warn-missing-signatures -threaded