diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 4c02c50..5deb25b 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -14,7 +14,7 @@ import Data.List , sortBy , sortOn ) -import Data.Maybe (isJust) +import Data.Maybe (isJust, mapMaybe) import Data.Monoid (All (..)) import Graphics.X11.Types @@ -74,9 +74,10 @@ main = do , childPIDs = [p] , childHandles = [h] } + ekbs <- evalExternal $ externalBindings ts launch $ ewmh - $ addKeymap ts + $ addKeymap (filterExternal ekbs) $ def { terminal = myTerm , modMask = myModMask , layoutHook = myLayouts @@ -369,126 +370,162 @@ xMsgEventHook _ = return (All True) myModMask :: KeyMask myModMask = mod4Mask -addKeymap :: ThreadState -> XConfig l -> XConfig l -addKeymap ts = addDescrKeys' ((myModMask, xK_F1), runShowKeys) (mkKeys ts) +addKeymap :: [KeyGroup (X ())] -> XConfig l -> XConfig l +addKeymap external = addDescrKeys' ((myModMask, xK_F1), runShowKeys) + (\c -> concatMap (mkNamedSubmap c) $ internalBindings c ++ external) -mkKeys :: ThreadState -> XConfig Layout -> [((KeyMask, KeySym), NamedAction)] -mkKeys ts c = - mkNamedSubmap "Window Layouts" - [ ("M-j", "focus down", windows W.focusDown) - , ("M-k", "focus up", windows W.focusUp) - , ("M-m", "focus master", windows W.focusMaster) - , ("M-d", "focus master", runHide) - , ("M-S-j", "swap down", windows W.swapDown) - , ("M-S-k", "swap up", windows W.swapUp) - , ("M-S-m", "swap master", windows W.swapMaster) - , ("M-", "next layout", sendMessage NextLayout) - , ("M-S-", "reset layout", setLayout $ layoutHook c) - , ("M-t", "sink tiling", withFocused $ windows . W.sink) - , ("M-S-t", "float tiling", withFocused O.float) - , ("M--", "shrink", sendMessage Shrink) - , ("M-=", "expand", sendMessage Expand) - , ("M-S--", "remove master window", sendMessage $ IncMasterN (-1)) - , ("M-S-=", "add master window", sendMessage $ IncMasterN 1) - ] ++ +internalBindings :: XConfig Layout -> [KeyGroup (X ())] +internalBindings c = + [ KeyGroup "Window Layouts" + [ KeyBinding "M-j" "focus down" $ windows W.focusDown + , KeyBinding "M-k" "focus up" $ windows W.focusUp + , KeyBinding "M-m" "focus master" $ windows W.focusMaster + , KeyBinding "M-d" "focus master" runHide + , KeyBinding "M-S-j" "swap down" $ windows W.swapDown + , KeyBinding "M-S-k" "swap up" $ windows W.swapUp + , KeyBinding "M-S-m" "swap master" $ windows W.swapMaster + , KeyBinding "M-" "next layout" $ sendMessage NextLayout + , KeyBinding "M-S-" "reset layout" $ setLayout $ layoutHook c + , KeyBinding "M-t" "sink tiling" $ withFocused $ windows . W.sink + , KeyBinding "M-S-t" "float tiling" $ withFocused O.float + , KeyBinding "M--" "shrink" $ sendMessage Shrink + , KeyBinding "M-=" "expand" $ sendMessage Expand + , KeyBinding "M-S--" "remove master window" $ sendMessage $ IncMasterN (-1) + , KeyBinding "M-S-=" "add master window" $ sendMessage $ IncMasterN 1 + ] - mkNamedSubmap "Workspaces" - -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get - -- valid keysyms) - ([ (mods ++ n, msg ++ n, f n) | n <- myWorkspaces - , (mods, msg, f) <- - [ ("M-", "switch to workspace ", windows . W.view) - , ("M-S-", "move client to workspace ", windows . W.shift) - , ("M-C-", "follow client to workspace ", \n' -> do - windows $ W.shift n' - windows $ W.view n') - ] - ] ++ - [ ("M-M1-l", "move up workspace", moveTo Next HiddenNonEmptyWS) - , ("M-M1-h", "move down workspace", moveTo Prev HiddenNonEmptyWS) - ]) ++ + , KeyGroup "Workspaces" + -- ASSUME standard workspaces only use numbers 0-9 (otherwise we won't get + -- valid keysyms) + ([ KeyBinding (mods ++ n) (msg ++ n) (f n) | n <- myWorkspaces + , (mods, msg, f) <- + [ ("M-", "switch to workspace ", windows . W.view) + , ("M-S-", "move client to workspace ", windows . W.shift) + , ("M-C-", "follow client to workspace ", \n' -> do + windows $ W.shift n' + windows $ W.view n') + ] + ] ++ + [ KeyBinding "M-M1-l" "move up workspace" $ moveTo Next HiddenNonEmptyWS + , KeyBinding "M-M1-h" "move down workspace" $ moveTo Prev HiddenNonEmptyWS + ]) - mkNamedSubmap "Dynamic Workspaces" - [ ("M-C-" ++ [k], "launch/switch to " ++ n, cmd) - | DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs, - let cmd = case a of - Just a' -> spawnOrSwitch t a' - Nothing -> windows $ W.view t - ] ++ + , KeyGroup "Dynamic Workspaces" + [ KeyBinding ("M-C-" ++ [k]) ("launch/switch to " ++ n) cmd + | DynWorkspace { dwTag = t, dwKey = k, dwCmd = a, dwName = n } <- allDWs, + let cmd = case a of + Just a' -> spawnOrSwitch t a' + Nothing -> windows $ W.view t + ] - mkNamedSubmap "Screens" - [ ("M-l", "move up screen", nextScreen) - , ("M-h", "move down screen", prevScreen) - , ("M-C-l", "follow client up screen", shiftNextScreen >> nextScreen) - , ("M-C-h", "follow client down screen", shiftPrevScreen >> prevScreen) - , ("M-S-l", "shift workspace up screen", swapNextScreen >> nextScreen) - , ("M-S-h", "shift workspace down screen", swapPrevScreen >> prevScreen) - ] ++ - - mkNamedSubmap "Actions" - [ ("M-q", "close window", kill1) - , ("M-r", "run program", runCmdMenu) - , ("M-", "warp pointer", warpToWindow 0.5 0.5) - , ("M-C-s", "capture area", runAreaCapture) - , ("M-C-S-s", "capture screen", runScreenCapture) - , ("M-C-d", "capture desktop", runDesktopCapture) - , ("M-C-b", "browse captures", runCaptureBrowser) - -- , ("M-C-S-s", "capture focused window", spawn myWindowCap) - ] ++ - - mkNamedSubmap "Launchers" - [ ("", "select/launch app", runAppMenu) - , ("M-g", "launch clipboard manager", runClipMenu) - , ("M-a", "launch network selector", runNetMenu) - , ("M-w", "launch window selector", runWinMenu) - , ("M-u", "launch device selector", runDevMenu) - , ("M-b", "launch bitwarden selector", runBwMenu) - , ("M-C-e", "launch editor", runEditor) - , ("M-C-w", "launch browser", runBrowser) - , ("M-C-t", "launch terminal with tmux", runTMux) - , ("M-C-S-t", "launch terminal", runTerm) - , ("M-C-q", "launch calc", runCalc) - , ("M-C-f", "launch file manager", runFileManager) - ] ++ - - mkNamedSubmap "Multimedia" - [ ("", "toggle play/pause", runTogglePlay) - , ("", "previous track", runPrevTrack) - , ("", "next track", runNextTrack) - , ("", "stop", runStopPlay) - , ("", "volume down", runVolumeDown) - , ("", "volume up", runVolumeUp) - , ("", "volume mute", runVolumeMute) - ] ++ + , KeyGroup "Screens" + [ KeyBinding "M-l" "move up screen" nextScreen + , KeyBinding "M-h" "move down screen" prevScreen + , KeyBinding "M-C-l" "follow client up screen" $ shiftNextScreen >> nextScreen + , KeyBinding "M-C-h" "follow client down screen" $ shiftPrevScreen >> prevScreen + , KeyBinding "M-S-l" "shift workspace up screen" $ swapNextScreen >> nextScreen + , KeyBinding "M-S-h" "shift workspace down screen" $ swapPrevScreen >> prevScreen + ] -- dummy map for dunst commands (defined separately but this makes them show -- up in the help menu) - mkNamedSubmap "Dunst" - [ ("M-`", "dunst history", return ()) - , ("M-S-`", "dunst close", return ()) - , ("M-M1-`", "dunst context menu", return ()) - , ("M-C-`", "dunst close all", return ()) - ] ++ - - mkNamedSubmap "System" - [ ("M-.", "backlight up", runIncBacklight) - , ("M-,", "backlight down", runDecBacklight) - , ("M-M1-,", "backlight min", runMinBacklight) - , ("M-M1-.", "backlight max", runMaxBacklight) - , ("M-", "power menu", runPowerPrompt) - , ("M-", "quit xmonad", runQuitPrompt) - , ("M-", "lock screen", runScreenLock) - -- M- reserved for showing the keymap - , ("M-", "restart xmonad", runCleanup ts >> runRestart) - , ("M-", "recompile xmonad", runRecompile) - , ("M-", "start Isync Service", runStartISyncService) - , ("M-C-", "start Isync Timer", runStartISyncTimer) - , ("M-", "select autorandr profile", runAutorandrMenu) - , ("M-", "toggle ethernet", runToggleEthernet) - , ("M-", "toggle bluetooth", runToggleBluetooth) - , ("M-", "toggle screensaver", runToggleDPMS) - , ("M-", "switch gpu", runOptimusPrompt) + , KeyGroup "Dunst" + [ KeyBinding "M-`" "dunst history" skip + , KeyBinding "M-S-`" "dunst close" skip + , KeyBinding "M-M1-`" "dunst context menu" skip + , KeyBinding "M-C-`" "dunst close all" skip + ] ] + +mkNamedSubmap :: XConfig Layout -> KeyGroup (X ()) -> [((KeyMask, KeySym), NamedAction)] +mkNamedSubmap c KeyGroup { kgHeader = h, kgBindings = b } = + (subtitle h:) $ mkNamedKeymap c + $ (\KeyBinding{kbSyms = s, kbDesc = d, kbAction = a} -> (s, addName d a)) + <$> b + +data KeyBinding a = KeyBinding + { kbSyms :: String + , kbDesc :: String + , kbAction :: a + } + +data KeyGroup a = KeyGroup + { kgHeader :: String + , kgBindings :: [KeyBinding a] + } + +evalExternal :: [KeyGroup (IO MaybeX)] -> IO [KeyGroup MaybeX] +evalExternal = mapM go where - mkNamedSubmap header bindings = (subtitle header:) $ mkNamedKeymap c - $ map (\(key, name, cmd) -> (key, addName name cmd)) bindings + go k@KeyGroup { kgBindings = bs } = + (\bs' -> k { kgBindings = bs' }) <$> mapM evalKeyBinding bs + +evalKeyBinding :: Monad m => KeyBinding (m a) -> m (KeyBinding a) +evalKeyBinding k@KeyBinding { kbAction = a } = (\b -> k { kbAction = b }) <$> a + +filterExternal :: [KeyGroup MaybeX] -> [KeyGroup (X ())] +filterExternal = fmap go + where + go k@KeyGroup { kgBindings = bs } = + k { kgBindings = mapMaybe go' bs } + go' k@KeyBinding { kbAction = Installed x } = Just $ k { kbAction = x } + go' _ = Nothing + +externalBindings :: ThreadState -> [KeyGroup (IO MaybeX)] +externalBindings ts = + [ KeyGroup "Launchers" + [ KeyBinding "" "select/launch app" runAppMenu + , KeyBinding "M-g" "launch clipboard manager" runClipMenu + , KeyBinding "M-a" "launch network selector" runNetMenu + , KeyBinding "M-w" "launch window selector" runWinMenu + , KeyBinding "M-u" "launch device selector" runDevMenu + , KeyBinding "M-b" "launch bitwarden selector" runBwMenu + , KeyBinding "M-C-e" "launch editor" runEditor + , KeyBinding "M-C-w" "launch browser" runBrowser + , KeyBinding "M-C-t" "launch terminal with tmux" runTMux + , KeyBinding "M-C-S-t" "launch terminal" runTerm + , KeyBinding "M-C-q" "launch calc" runCalc + , KeyBinding "M-C-f" "launch file manager" runFileManager + ] + + , KeyGroup "Actions" + [ KeyBinding "M-q" "close window" $ noCheck kill1 + , KeyBinding "M-r" "run program" runCmdMenu + , KeyBinding "M-" "warp pointer" $ noCheck $ warpToWindow 0.5 0.5 + , KeyBinding "M-C-s" "capture area" runAreaCapture + , KeyBinding "M-C-S-s" "capture screen" runScreenCapture + , KeyBinding "M-C-d" "capture desktop" runDesktopCapture + , KeyBinding "M-C-b" "browse captures" runCaptureBrowser + -- , ("M-C-S-s", "capture focused window", spawn myWindowCap) + ] + + , KeyGroup "Multimedia" + [ KeyBinding "" "toggle play/pause" runTogglePlay + , KeyBinding "" "previous track" runPrevTrack + , KeyBinding "" "next track" runNextTrack + , KeyBinding "" "stop" runStopPlay + , KeyBinding "" "volume down" runVolumeDown + , KeyBinding "" "volume up" runVolumeUp + , KeyBinding "" "volume mute" runVolumeMute + ] + + , KeyGroup "System" + [ KeyBinding "M-." "backlight up" $ noCheck runIncBacklight + , KeyBinding "M-," "backlight down" $ noCheck runDecBacklight + , KeyBinding "M-M1-," "backlight min" $ noCheck runMinBacklight + , KeyBinding "M-M1-." "backlight max" $ noCheck runMaxBacklight + , KeyBinding "M-" "power menu" $ noCheck runPowerPrompt + , KeyBinding "M-" "quit xmonad" $ noCheck runQuitPrompt + , KeyBinding "M-" "lock screen" runScreenLock + -- M- reserved for showing the keymap + , KeyBinding "M-" "restart xmonad" $ noCheck (runCleanup ts >> runRestart) + , KeyBinding "M-" "recompile xmonad" $ noCheck runRecompile + , KeyBinding "M-" "start Isync Service" $ noCheck runStartISyncService + , KeyBinding "M-C-" "start Isync Timer" $ noCheck runStartISyncTimer + , KeyBinding "M-" "select autorandr profile" runAutorandrMenu + , KeyBinding "M-" "toggle ethernet" runToggleEthernet + , KeyBinding "M-" "toggle bluetooth" runToggleBluetooth + , KeyBinding "M-" "toggle screensaver" $ noCheck runToggleDPMS + , KeyBinding "M-" "switch gpu" $ noCheck runOptimusPrompt + ] + ] diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 07c6cab..bc17e56 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -18,6 +18,7 @@ import Control.Monad.Reader import Graphics.X11.Types import System.IO +import System.Directory (getXdgDirectory, XdgDirectory(..)) import XMonad.Core hiding (spawn) import XMonad.Internal.Process @@ -25,13 +26,28 @@ import XMonad.Internal.Shell import XMonad.Util.NamedActions -------------------------------------------------------------------------------- --- | Other internal functions +-- | DMenu executables myDmenuCmd :: String myDmenuCmd = "rofi" -spawnDmenuCmd :: [String] -> X () -spawnDmenuCmd = spawnCmd myDmenuCmd +myDmenuDevices :: String +myDmenuDevices = "rofi-dev" + +myDmenuPasswords :: String +myDmenuPasswords = "rofi-bw" + +myDmenuMonitors :: String +myDmenuMonitors = "rofi-autorandr" + +myDmenuNetworks :: String +myDmenuNetworks = "networkmanager_dmenu" + +-------------------------------------------------------------------------------- +-- | Other internal functions + +spawnDmenuCmd :: [String] -> IO MaybeX +spawnDmenuCmd = spawnCmdIfInstalled myDmenuCmd themeArgs :: String -> [String] themeArgs hexColor = @@ -45,18 +61,19 @@ myDmenuMatchingArgs = ["-i"] -- case insensitivity -------------------------------------------------------------------------------- -- | Exported Commands -devSecrets :: [String] -devSecrets = ["-c", "/home/ndwar/.config/rofi/devices.yml"] +runDevMenu :: IO MaybeX +runDevMenu = runIfInstalled [myDmenuDevices] $ do + c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml" + spawnCmd myDmenuDevices + $ ["-c", c] + ++ "--" : themeArgs "#999933" + ++ myDmenuMatchingArgs -runDevMenu :: X () -runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs - where - rofiArgs = "--" : themeArgs "#999933" ++ myDmenuMatchingArgs - -runBwMenu :: X () -runBwMenu = spawnCmd "rofi-bw" $ ["-c", "--"] ++ themeArgs "#bb6600" - ++ myDmenuMatchingArgs +runBwMenu :: IO MaybeX +runBwMenu = runIfInstalled [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 } @@ -64,24 +81,25 @@ runShowKeys x = addName "Show Keybindings" $ do where cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"] ++ themeArgs "#a200ff" ++ myDmenuMatchingArgs -runCmdMenu :: X () +runCmdMenu :: IO MaybeX runCmdMenu = spawnDmenuCmd ["-show", "run"] -runAppMenu :: X () +runAppMenu :: IO MaybeX runAppMenu = spawnDmenuCmd ["-show", "drun"] -runClipMenu :: X () +-- TODO this also depends on greenclip +runClipMenu :: IO MaybeX runClipMenu = spawnDmenuCmd $ [ "-modi", "\"clipboard:greenclip print\"" , "-show", "clipboard" , "-run-command", "'{cmd}'" ] ++ themeArgs "#00c44e" -runWinMenu :: X () +runWinMenu :: IO MaybeX runWinMenu = spawnDmenuCmd ["-show", "window"] -runNetMenu :: X () -runNetMenu = spawnCmd "networkmanager_dmenu" $ themeArgs "#ff3333" +runNetMenu :: IO MaybeX +runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333" -runAutorandrMenu :: X () -runAutorandrMenu = spawnCmd "rofi-autorandr" $ themeArgs "#ff0066" +runAutorandrMenu :: IO MaybeX +runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066" diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 8052e47..3436067 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -52,75 +52,103 @@ import XMonad.Internal.Shell import XMonad.Operations -------------------------------------------------------------------------------- --- | Some nice apps +-- | My Executables myTerm :: String myTerm = "urxvt" -runTerm :: X () -runTerm = spawn myTerm +myBrowser :: String +myBrowser = "brave-accel" -runTMux :: X () -runTMux = spawn - $ "tmux has-session" - #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c] - #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg } - where - c = "exec tmux attach-session -d" - msg = "could not connect to tmux session" - -runCalc :: X () -runCalc = spawnCmd myTerm ["-e", "R"] - -runBrowser :: X () -runBrowser = spawn "brave-accel" - -runEditor :: X () -runEditor = spawnCmd "emacsclient" - ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"] - -runFileManager :: X () -runFileManager = spawn "pcmanfm" - --------------------------------------------------------------------------------- --- | Multimedia Commands +myEditor :: String +myEditor = "emacsclient" myMultimediaCtl :: String myMultimediaCtl = "playerctl" -runTogglePlay :: X () -runTogglePlay = spawnCmd myMultimediaCtl ["play-pause"] +myBluetooth :: String +myBluetooth = "bluetoothctl" -runPrevTrack :: X () -runPrevTrack = spawnCmd myMultimediaCtl ["previous"] +myCapture :: String +myCapture = "flameshot" -runNextTrack :: X () -runNextTrack = spawnCmd myMultimediaCtl ["next"] +myImageBrowser :: String +myImageBrowser = "feh" -runStopPlay :: X () -runStopPlay = spawnCmd myMultimediaCtl ["stop"] +-------------------------------------------------------------------------------- +-- | Misc constants volumeChangeSound :: FilePath volumeChangeSound = "smb_fireball.wav" -runVolumeDown :: X () -runVolumeDown = spawnSound volumeChangeSound >> void (lowerVolume 2) +ethernetIface :: String +ethernetIface = "enp7s0f1" -runVolumeUp :: X () -runVolumeUp = spawnSound volumeChangeSound >> void (raiseVolume 2) +-------------------------------------------------------------------------------- +-- | Some nice apps -runVolumeMute :: X () -runVolumeMute = void toggleMute >> spawnSound volumeChangeSound +runTerm :: IO MaybeX +runTerm = spawnIfInstalled myTerm + +runTMux :: IO MaybeX +runTMux = runIfInstalled [myTerm, "tmux", "bash"] cmd + where + cmd = spawn + $ "tmux has-session" + #!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c] + #!|| fmtNotifyCmd defNoteError { body = Just $ Text msg } + c = "exec tmux attach-session -d" + msg = "could not connect to tmux session" + +runCalc :: IO MaybeX +runCalc = runIfInstalled [myTerm, "R"] $ spawnCmd myTerm ["-e", "R"] + +runBrowser :: IO MaybeX +runBrowser = spawnIfInstalled myBrowser + +runEditor :: IO MaybeX +runEditor = spawnCmdIfInstalled myEditor + ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"] + +runFileManager :: IO MaybeX +runFileManager = spawnIfInstalled "pcmanfm" + +-------------------------------------------------------------------------------- +-- | Multimedia Commands + +runMultimediaIfInstalled :: String -> IO MaybeX +runMultimediaIfInstalled cmd = spawnCmdIfInstalled myMultimediaCtl [cmd] + +runTogglePlay :: IO MaybeX +runTogglePlay = runMultimediaIfInstalled "play-pause" + +runPrevTrack :: IO MaybeX +runPrevTrack = runMultimediaIfInstalled "previous" + +runNextTrack :: IO MaybeX +runNextTrack = runMultimediaIfInstalled "next" + +runStopPlay :: IO MaybeX +runStopPlay = runMultimediaIfInstalled "stop" + +runVolumeDown :: IO MaybeX +runVolumeDown = spawnSound volumeChangeSound (return ()) $ void (lowerVolume 2) + +runVolumeUp :: IO MaybeX +runVolumeUp = spawnSound volumeChangeSound (return ()) $ void (raiseVolume 2) + +runVolumeMute :: IO MaybeX +runVolumeMute = spawnSound volumeChangeSound (void toggleMute) $ return () -------------------------------------------------------------------------------- -- | System commands -runToggleBluetooth :: X () -runToggleBluetooth = spawn - $ "bluetoothctl show | grep -q \"Powered: no\"" +runToggleBluetooth :: IO MaybeX +runToggleBluetooth = runIfInstalled [myBluetooth] $ spawn + $ myBluetooth ++ " show | grep -q \"Powered: no\"" #!&& "a=on" #!|| "a=off" - #!>> fmtCmd "bluetoothctl" ["power", "$a", ">", "/dev/null"] + #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"] #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "bluetooth powered $a" } runIncBacklight :: X () @@ -138,11 +166,8 @@ runMaxBacklight = io $ void callMaxBrightness runToggleDPMS :: X () runToggleDPMS = io $ void callToggle -ethernetIface :: String -ethernetIface = "enp7s0f1" - -runToggleEthernet :: X () -runToggleEthernet = spawn +runToggleEthernet :: IO MaybeX +runToggleEthernet = runIfInstalled ["nmcli"] $ spawn $ "nmcli -g GENERAL.STATE device show " ++ ethernetIface ++ " | grep -q disconnected" #!&& "a=connect" #!|| "a=disconnect" @@ -199,25 +224,25 @@ getCaptureDir = do where fallback = ( ".local/share") <$> getHomeDirectory -runFlameshot :: String -> X () -runFlameshot mode = do +runFlameshot :: String -> IO MaybeX +runFlameshot mode = runIfInstalled [myCapture] $ do ssDir <- io getCaptureDir - spawnCmd "flameshot" $ mode : ["-p", ssDir] + spawnCmd myCapture $ mode : ["-p", ssDir] -- TODO this will steal focus from the current window (and puts it -- in the root window?) ...need to fix -runAreaCapture :: X () +runAreaCapture :: IO MaybeX runAreaCapture = runFlameshot "gui" -- myWindowCap = "screencap -w" --external script -runScreenCapture :: X () -runScreenCapture = runFlameshot "screen" - -runDesktopCapture :: X () +runDesktopCapture :: IO MaybeX runDesktopCapture = runFlameshot "full" -runCaptureBrowser :: X () -runCaptureBrowser = do +runScreenCapture :: IO MaybeX +runScreenCapture = runFlameshot "screen" + +runCaptureBrowser :: IO MaybeX +runCaptureBrowser = runIfInstalled [myImageBrowser] $ do dir <- io getCaptureDir - spawnCmd "feh" [dir] + spawnCmd myImageBrowser [dir] diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index c8e098f..23ea735 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -31,8 +31,8 @@ import XMonad.Prompt.ConfirmPrompt -------------------------------------------------------------------------------- -- | Core commands -runScreenLock :: X () -runScreenLock = spawn "screenlock" +runScreenLock :: IOMaybeX +runScreenLock = spawnIfInstalled "screenlock" runPowerOff :: X () runPowerOff = spawn "systemctl poweroff" @@ -119,6 +119,6 @@ runPowerPrompt = mkXPrompt PowerPrompt theme comp executeAction sendAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True executeAction a = case toEnum $ read a of Poweroff -> runPowerOff - Shutdown -> runScreenLock >> runSuspend - Hibernate -> runScreenLock >> runHibernate + Shutdown -> (io runScreenLock >>= whenInstalled) >> runSuspend + Hibernate -> (io runScreenLock >>= whenInstalled) >> runHibernate Reboot -> runReboot diff --git a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs index 39d1b6d..7fd1c3c 100644 --- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs +++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs @@ -23,6 +23,7 @@ import System.IO.Streams.UnixSocket import XMonad.Core import XMonad.Internal.Command.Power +import XMonad.Internal.Shell import XMonad.Internal.Concurrent.ClientMessage -------------------------------------------------------------------------------- @@ -100,4 +101,6 @@ handleACPI tag = do Sleep -> runSuspendPrompt LidClose -> do status <- io isDischarging - forM_ status $ \s -> runScreenLock >> when s runSuspend + forM_ status $ \s -> do + io runScreenLock >>= whenInstalled + when s runSuspend diff --git a/lib/XMonad/Internal/Concurrent/Removable.hs b/lib/XMonad/Internal/Concurrent/Removable.hs index e7323b7..4141701 100644 --- a/lib/XMonad/Internal/Concurrent/Removable.hs +++ b/lib/XMonad/Internal/Concurrent/Removable.hs @@ -56,7 +56,7 @@ removedHasDrive [_, a] = maybe False (driveFlag `elem`) removedHasDrive _ = False playSoundMaybe :: FilePath -> Bool -> IO () -playSoundMaybe p b = when b $ spawnSound p +playSoundMaybe p b = when b $ playSound p -- NOTE: the udisks2 service should be already running for this module to work. -- If it not already, we won't see any signals from the dbus until it is diff --git a/lib/XMonad/Internal/Shell.hs b/lib/XMonad/Internal/Shell.hs index fab6758..5702411 100644 --- a/lib/XMonad/Internal/Shell.hs +++ b/lib/XMonad/Internal/Shell.hs @@ -2,23 +2,69 @@ -- | Functions for formatting and spawning shell commands module XMonad.Internal.Shell - ( fmtCmd + ( MaybeExe(..) + , MaybeX + , IOMaybeX + , runIfInstalled + , whenInstalled + , spawnIfInstalled + , spawnCmdIfInstalled + , noCheck + , fmtCmd , spawnCmd , spawnSound + , playSound , doubleQuote , singleQuote + , skip , (#!&&) , (#!||) , (#!>>) ) where +import Control.Monad (filterM) import Control.Monad.IO.Class -import System.FilePath.Posix +import Data.Maybe (isNothing) -import XMonad.Core (getXMonadDir) +import System.FilePath.Posix +import System.Directory (findExecutable) + +import XMonad.Core (getXMonadDir, X) import XMonad.Internal.Process +-------------------------------------------------------------------------------- +-- | Gracefully handling missing binaries + +data MaybeExe m = Installed (m ()) | Missing [String] | Noop + +type MaybeX = MaybeExe X + +type IOMaybeX = IO MaybeX + +runIfInstalled :: MonadIO m => [String] -> m () -> IO (MaybeExe m) +runIfInstalled exes x = do + missing <- filterM (fmap isNothing . findExecutable) exes + return $ case missing of + [] -> Installed x + ms -> Missing ms + +spawnIfInstalled :: MonadIO m => String -> IO (MaybeExe m) +spawnIfInstalled exe = runIfInstalled [exe] $ spawn exe + +spawnCmdIfInstalled :: MonadIO m => String -> [String] -> IO (MaybeExe m) +spawnCmdIfInstalled exe args = runIfInstalled [exe] $ spawnCmd exe args + +whenInstalled :: Monad m => MaybeExe m -> m () +whenInstalled (Installed x) = x +whenInstalled _ = return () + +skip :: Monad m => m () +skip = return () + +noCheck :: Monad m => a () -> m (MaybeExe a) +noCheck = return . Installed + -------------------------------------------------------------------------------- -- | Opening subshell @@ -31,8 +77,12 @@ spawnCmd cmd args = spawn $ fmtCmd cmd args soundDir :: FilePath soundDir = "sound" -spawnSound :: MonadIO m => FilePath -> m () -spawnSound file = do +spawnSound :: MonadIO m => FilePath -> m () -> m () -> IO (MaybeExe m) +spawnSound file pre post = runIfInstalled ["paplay"] + $ pre >> playSound file >> post + +playSound :: MonadIO m => FilePath -> m () +playSound file = do path <- ( soundDir file) <$> getXMonadDir -- paplay seems to have less latency than aplay spawnCmd "paplay" [path]