diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 372615a..abb3b1e 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -87,12 +87,19 @@ run :: IO () run = do db <- connectXDBus (h, p) <- spawnPipe "xmobar" + ps <- catMaybes <$> mapM executeSometimes [ runNetAppDaemon + , runFlameshotDaemon + , runNotificationDaemon + , runBwDaemon + , runClipManager + , runAutolock + ] void $ executeSometimes $ runRemovableMon $ dbSystemClient db dws <- allDWs forkIO_ $ void $ executeSometimes runPowermon forkIO_ $ runWorkspaceMon dws let ts = ThreadState - { tsChildPIDs = [p] + { tsChildPIDs = p:ps , tsChildHandles = [h] } fb <- evalAlways T.defFont diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 2d992e6..cf95c45 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -13,6 +13,10 @@ module XMonad.Internal.Command.DMenu , runBTMenu , runShowKeys , runAutorandrMenu + + -- daemons + , runBwDaemon + , runClipManager ) where import Control.Monad.Reader @@ -53,6 +57,9 @@ myDmenuMonitors = "rofi-autorandr" myDmenuNetworks :: String myDmenuNetworks = "networkmanager_dmenu" +myClipboardManager :: String +myClipboardManager = "greenclip" + -------------------------------------------------------------------------------- -- | Other internal functions @@ -86,10 +93,6 @@ runBTMenu :: SometimesX runBTMenu = sometimesExeArgs "bluetooth selector" "rofi bluetooth" False myDmenuBluetooth $ "-c":themeArgs "#0044bb" -runBwMenu :: SometimesX -runBwMenu = sometimesIO_ "password manager" "rofi bitwarden" - (Only_ $ localExe myDmenuPasswords) $ spawnCmd myDmenuPasswords - $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs runVPNMenu :: SometimesX runVPNMenu = sometimesIO_ "VPN selector" "rofi VPN" @@ -102,16 +105,6 @@ runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"] runAppMenu :: SometimesX runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"] -runClipMenu :: SometimesX -runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" deps act - where - act = spawnCmd myDmenuCmd args - deps = toAnd (sysExe myDmenuCmd) (sysExe "greenclip") - args = [ "-modi", "\"clipboard:greenclip print\"" - , "-show", "clipboard" - , "-run-command", "'{cmd}'" - ] ++ themeArgs "#00c44e" - runWinMenu :: SometimesX runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"] @@ -123,6 +116,39 @@ runAutorandrMenu :: SometimesX runAutorandrMenu = sometimesExeArgs "autorandr menu" "rofi autorandr" True myDmenuMonitors $ themeArgs "#ff0066" +-------------------------------------------------------------------------------- +-- | Password manager + +runBwDaemon :: Sometimes (IO ProcessHandle) +runBwDaemon = sometimesIO_ "password manager daemon" "rofi bitwarden" tree cmd + where + tree = Only_ $ localExe myDmenuPasswords + cmd = snd <$> spawnPipeArgs "rofi-bw" ["-d", "3600"] + +runBwMenu :: SometimesX +runBwMenu = sometimesIO_ "password manager" "rofi bitwarden" + (Only_ $ IOSometimes_ runBwDaemon) $ spawnCmd myDmenuPasswords + $ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs + +-------------------------------------------------------------------------------- +-- | Clipboard + +runClipManager :: Sometimes (IO ProcessHandle) +runClipManager = sometimesIO_ "clipboard daemon" "greenclip" tree cmd + where + tree = Only_ $ sysExe myClipboardManager + cmd = snd <$> spawnPipeArgs "greenclip" ["daemon"] + +runClipMenu :: SometimesX +runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act + where + act = spawnCmd myDmenuCmd args + tree = toAnd (sysExe myDmenuCmd) $ IOSometimes_ runClipManager + args = [ "-modi", "\"clipboard:greenclip print\"" + , "-show", "clipboard" + , "-run-command", "'{cmd}'" + ] ++ themeArgs "#00c44e" + -------------------------------------------------------------------------------- -- | Shortcut menu diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index d46304f..1163403 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -3,6 +3,9 @@ module XMonad.Internal.Command.Desktop ( myTerm + , playSound + + -- commands , runTerm , runTMux , runCalc @@ -30,7 +33,11 @@ module XMonad.Internal.Command.Desktop , runNotificationCloseAll , runNotificationHistory , runNotificationContext - , playSound + + -- daemons + , runNetAppDaemon + , runFlameshotDaemon + , runNotificationDaemon ) where import Control.Monad (void) @@ -79,6 +86,9 @@ myImageBrowser = "feh" myNotificationCtrl :: String myNotificationCtrl = "dunstctl" +myNotificationDaemon :: String +myNotificationDaemon = "dunst" + -------------------------------------------------------------------------------- -- | Misc constants @@ -170,9 +180,18 @@ runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return -------------------------------------------------------------------------------- -- | Notification control +runNotificationDaemon :: Sometimes (IO ProcessHandle) +runNotificationDaemon = sometimesIO_ "notification daemon" "dunst" tree cmd + where + tree = Only_ $ sysExe myNotificationDaemon + cmd = snd <$> spawnPipe myNotificationDaemon + runNotificationCmd :: String -> FilePath -> SometimesX -runNotificationCmd n cmd = - sometimesExeArgs (n ++ " control") "dunst" True myNotificationCtrl [cmd] +runNotificationCmd n arg = sometimesIO_ (n ++ " control") "dunstctl" tree cmd + where + tree = And_ (Only_ $ IOSometimes_ runNotificationDaemon) + (Only_ $ sysExe myNotificationCtrl) + cmd = spawnCmd myNotificationCtrl [arg] runNotificationClose :: SometimesX runNotificationClose = runNotificationCmd "close notification" "close" @@ -192,6 +211,13 @@ runNotificationContext = -------------------------------------------------------------------------------- -- | System commands +-- this is required for some vpn's to work properly with network-manager +runNetAppDaemon :: Sometimes (IO ProcessHandle) +runNetAppDaemon = sometimesIO_ "network applet" "NM-applet" tree cmd + where + tree = Only_ $ localExe "nm-applet" + cmd = snd <$> spawnPipe "nm-applet" + runToggleBluetooth :: SometimesX runToggleBluetooth = sometimesIO_ "bluetooth toggle" "bluetoothctl" (Only_ $ sysExe myBluetooth) @@ -265,9 +291,15 @@ getCaptureDir = do where fallback = ( ".local/share") <$> getHomeDirectory +runFlameshotDaemon :: Sometimes (IO ProcessHandle) +runFlameshotDaemon = sometimesIO_ "screen capture daemon" "flameshot" tree cmd + where + tree = Only_ $ sysExe myCapture + cmd = snd <$> (spawnPipe' $ (shell myCapture) { std_err = NoStream }) + runFlameshot :: String -> String -> SometimesX -runFlameshot n mode = sometimesIO_ n "flameshot" (Only_ $ sysExe myCapture) - $ spawnCmd myCapture [mode] +runFlameshot n mode = sometimesIO_ n myCapture + (Only_ $ IOSometimes_ runFlameshotDaemon) $ spawnCmd myCapture [mode] -- TODO this will steal focus from the current window (and puts it -- in the root window?) ...need to fix diff --git a/lib/XMonad/Internal/Command/Power.hs b/lib/XMonad/Internal/Command/Power.hs index 34e7a38..dee3667 100644 --- a/lib/XMonad/Internal/Command/Power.hs +++ b/lib/XMonad/Internal/Command/Power.hs @@ -2,6 +2,7 @@ -- | Commands for controlling power module XMonad.Internal.Command.Power + -- commands ( runHibernate , runOptimusPrompt , runPowerOff @@ -11,6 +12,11 @@ module XMonad.Internal.Command.Power , runSuspend , runSuspendPrompt , runQuitPrompt + + -- daemons + , runAutolock + + -- functions , hasBattery , suspendPrompt , quitPrompt @@ -28,9 +34,11 @@ import System.Directory import System.Exit import System.FilePath.Posix import System.IO.Error +import System.Process (ProcessHandle) import XMonad.Core import XMonad.Internal.Dependency +import XMonad.Internal.Process (spawnPipeArgs) import XMonad.Internal.Shell import qualified XMonad.Internal.Theme as T import XMonad.Prompt @@ -66,6 +74,15 @@ runHibernate = spawn "systemctl hibernate" runReboot :: X () runReboot = spawn "systemctl reboot" +-------------------------------------------------------------------------------- +-- | Autolock + +runAutolock :: Sometimes (IO ProcessHandle) +runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd + where + tree = And_ (Only_ $ sysExe "xss-lock") (Only_ $ IOSometimes_ runScreenLock) + cmd = snd <$> spawnPipeArgs "xss-lock" ["--ignore-sleep", "screenlock"] + -------------------------------------------------------------------------------- -- | Confirmation prompts diff --git a/lib/XMonad/Internal/Process.hs b/lib/XMonad/Internal/Process.hs index e81e2ef..6b6ba4d 100644 --- a/lib/XMonad/Internal/Process.hs +++ b/lib/XMonad/Internal/Process.hs @@ -4,7 +4,9 @@ module XMonad.Internal.Process ( waitUntilExit , killHandle + , spawnPipe' , spawnPipe + , spawnPipeArgs , createProcess' , readCreateProcessWithExitCode' , proc' @@ -76,9 +78,15 @@ spawn = io . void . createProcess' . shell' spawnAt :: MonadIO m => FilePath -> String -> m () spawnAt fp cmd = io $ void $ createProcess' $ (shell' cmd) { cwd = Just fp } -spawnPipe :: String -> IO (Handle, ProcessHandle) -spawnPipe cmd = do +spawnPipe' :: CreateProcess -> IO (Handle, ProcessHandle) +spawnPipe' cp = do -- ASSUME creating a pipe will always succeed in making a Just Handle - (Just h, _, _, p) <- createProcess' $ (shell cmd) { std_in = CreatePipe } + (Just h, _, _, p) <- createProcess' $ cp { std_in = CreatePipe } hSetBuffering h LineBuffering return (h, p) + +spawnPipe :: String -> IO (Handle, ProcessHandle) +spawnPipe = spawnPipe' . shell + +spawnPipeArgs :: FilePath -> [String] -> IO (Handle, ProcessHandle) +spawnPipeArgs cmd = spawnPipe' . proc cmd