ENH inform user if keymap can't be displayed

This commit is contained in:
Nathan Dwarshuis 2021-06-20 13:55:31 -04:00
parent bf00984a04
commit 6620616b7b
3 changed files with 31 additions and 14 deletions

View File

@ -21,6 +21,7 @@ import System.Directory (XdgDirectory (..), getXdgDirectory)
import System.IO
import XMonad.Core hiding (spawn)
import XMonad.Internal.Notify
import XMonad.Internal.Process
import XMonad.Internal.Shell
import XMonad.Util.NamedActions
@ -73,13 +74,20 @@ runBwMenu :: IO MaybeX
runBwMenu = runIfInstalled [Required myDmenuPasswords] $
spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
-- TODO what to do with this if rofi doesn't exist?
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
runShowKeys x = addName "Show Keybindings" $ do
(h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
++ themeArgs "#a200ff" ++ myDmenuMatchingArgs
s <- io $ runDMenuShowKeys x
ifInstalled s
$ spawnNotify
$ defNoteError { body = Just $ Text "could not display keymap" }
runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> IO MaybeX
runDMenuShowKeys kbs = runIfInstalled [Required myDmenuCmd] $ 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 "#a200ff" ++ myDmenuMatchingArgs
runCmdMenu :: IO MaybeX
runCmdMenu = spawnDmenuCmd ["-show", "run"]

View File

@ -13,8 +13,10 @@ module XMonad.Internal.Notify
, defNoteInfo
, defNoteError
, fmtNotifyCmd
, spawnNotify
) where
import Control.Monad.IO.Class
import Data.Maybe
import DBus.Notify
@ -43,13 +45,16 @@ parseBody (Text s) = Just s
parseBody _ = Nothing
fmtNotifyCmd :: Note -> String
fmtNotifyCmd note =
fmtCmd "notify-send" $ getIcon note
++ getSummary note
++ getBody note
fmtNotifyCmd = fmtCmd "notify-send" . fmtNotifyArgs
spawnNotify :: MonadIO m => Note -> m ()
spawnNotify = spawnCmd "notify-send" . fmtNotifyArgs
fmtNotifyArgs :: Note -> [String]
fmtNotifyArgs n = getIcon n ++ getSummary n ++ getBody n
where
-- TODO add the rest of the options as needed
getSummary = (:[]) . doubleQuote . summary
getIcon n = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
$ appImage n
getBody n = maybeToList $ (fmap doubleQuote . parseBody) =<< body n
getIcon n' = maybe [] (\i -> ["-i", case i of { Icon s -> s; File s -> s }])
$ appImage n'
getBody n' = maybeToList $ (fmap doubleQuote . parseBody) =<< body n'

View File

@ -9,6 +9,7 @@ module XMonad.Internal.Shell
, runIfInstalled
, warnMissing
, whenInstalled
, ifInstalled
, spawnIfInstalled
, spawnCmdIfInstalled
, noCheck
@ -78,8 +79,11 @@ spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m)
spawnCmdIfInstalled exe args = runIfInstalled [Required exe] $ spawnCmd exe args
whenInstalled :: Monad m => MaybeExe m -> m ()
whenInstalled (Installed x _) = x
whenInstalled _ = return ()
whenInstalled = flip ifInstalled skip
ifInstalled :: Monad m => MaybeExe m -> m () -> m ()
ifInstalled (Installed x _) _ = x
ifInstalled _ alt = alt
skip :: Monad m => m ()
skip = return ()