From a7e7eee2a8f6e0cba564c40f8989086969097925 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Thu, 7 Jul 2022 23:22:48 -0400 Subject: [PATCH] ENH make desktop dependencies more robust --- bin/xmonad.hs | 14 ++--- lib/XMonad/Internal/Command/Desktop.hs | 77 +++++++++++++++----------- lib/XMonad/Internal/DBus/Common.hs | 8 +++ 3 files changed, 61 insertions(+), 38 deletions(-) diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 7ab21a4..a7bd590 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -635,9 +635,9 @@ externalBindings ts db = [ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1 , KeyBinding "M-r" "run program" $ Left runCmdMenu , KeyBinding "M-" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5 - , KeyBinding "M-C-s" "capture area" $ Left runAreaCapture - , KeyBinding "M-C-S-s" "capture screen" $ Left runScreenCapture - , KeyBinding "M-C-d" "capture desktop" $ Left runDesktopCapture + , KeyBinding "M-C-s" "capture area" $ Left $ runAreaCapture ses + , KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses + , KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses , KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser -- , ("M-C-S-s", "capture focused window", spawn myWindowCap) ] @@ -653,10 +653,10 @@ externalBindings ts db = ] , KeyGroup "Dunst" - [ KeyBinding "M-`" "dunst history" $ Left runNotificationHistory - , KeyBinding "M-S-`" "dunst close" $ Left runNotificationClose - , KeyBinding "M-M1-`" "dunst context menu" $ Left runNotificationContext - , KeyBinding "M-C-`" "dunst close all" $ Left runNotificationCloseAll + [ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses + , KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses + , KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses + , KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses ] , KeyGroup "System" diff --git a/lib/XMonad/Internal/Command/Desktop.hs b/lib/XMonad/Internal/Command/Desktop.hs index 850426b..f8d5b5a 100644 --- a/lib/XMonad/Internal/Command/Desktop.hs +++ b/lib/XMonad/Internal/Command/Desktop.hs @@ -41,14 +41,14 @@ module XMonad.Internal.Command.Desktop import Control.Monad (void) import Control.Monad.IO.Class +import DBus import DBus.Client import System.Directory - ( createDirectoryIfMissing - , getHomeDirectory - ) import System.Environment import System.FilePath +import System.Posix.Files +import System.Posix.User import XMonad (asks) import XMonad.Actions.Volume @@ -99,17 +99,33 @@ volumeChangeSound = "smb_fireball.wav" runTerm :: SometimesX runTerm = sometimesExe "terminal" "urxvt" True myTerm --- TODO test that tmux is actually running (/tmp/tmux-/default) runTMux :: SometimesX runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act where - deps = listToAnds (sysExe myTerm) $ fmap sysExe ["tmux", "bash"] + deps = listToAnds (socketExists socketName) + $ fmap sysExe [myTerm, "tmux", "bash"] act = 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" + socketName = do + u <- getEffectiveUserID + t <- getTemporaryDirectory + return $ t "tmux-" ++ show u "default" + +socketExists :: IO FilePath -> IODependency_ +socketExists getPath = IOTest_ "find tmux socket current user" $ do + p <- getPath + e <- fileExist p + s <- isSocket <$> getFileStatus p + return $ case (e, s) of + (True, True) -> Nothing + (False, _) -> toErr $ "could not find socket at " ++ p + (_, False) -> toErr $ p ++ " is not a socket" + where + toErr = Just . Msg Error runCalc :: SometimesX runCalc = sometimesIO_ "calculator" "R" deps act @@ -120,10 +136,13 @@ runCalc = sometimesIO_ "calculator" "R" deps act runBrowser :: SometimesX runBrowser = sometimesExe "web browser" "brave" False myBrowser --- TODO test that emacs is actually running (/run/user/1000/emacs/server) runEditor :: SometimesX -runEditor = sometimesExeArgs "text editor" "emacs" True myEditor - ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"] +runEditor = sometimesIO_ "text editor" "emacs" tree cmd + where + cmd = spawnCmd myEditor + ["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"] + tree = toAnd_ (sysExe myEditor) (socketExists socketName) + socketName = ( "emacs" "server") <$> getEnv "XDG_RUNTIME_DIR" runFileManager :: SometimesX runFileManager = sometimesExe "file browser" "pcmanfm" True "pcmanfm" @@ -177,25 +196,27 @@ runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return -------------------------------------------------------------------------------- -- | Notification control --- TODO test that dunst is actually running (org.freedesktop.Notifications/org.dunstproject.cmd0) -runNotificationCmd :: String -> FilePath -> SometimesX -runNotificationCmd n arg = sometimesIO_ (n ++ " control") "dunstctl" tree cmd +runNotificationCmd :: String -> FilePath -> Maybe Client -> SometimesX +runNotificationCmd n arg cl = + sometimesDBus cl (n ++ " control") "dunstctl" tree cmd where - tree = Only_ $ sysExe myNotificationCtrl - cmd = spawnCmd myNotificationCtrl [arg] + cmd _ = spawnCmd myNotificationCtrl [arg] + tree = toAnd_ (DBusIO $ sysExe myNotificationCtrl) + $ Endpoint notifyBus notifyPath (interfaceName_ "org.dunstproject.cmd0") + $ Method_ $ memberName_ "NotificationAction" -runNotificationClose :: SometimesX +runNotificationClose :: Maybe Client -> SometimesX runNotificationClose = runNotificationCmd "close notification" "close" -runNotificationCloseAll :: SometimesX +runNotificationCloseAll :: Maybe Client -> SometimesX runNotificationCloseAll = runNotificationCmd "close all notifications" "close-all" -runNotificationHistory :: SometimesX +runNotificationHistory :: Maybe Client -> SometimesX runNotificationHistory = runNotificationCmd "see notification history" "history-pop" -runNotificationContext :: SometimesX +runNotificationContext :: Maybe Client -> SometimesX runNotificationContext = runNotificationCmd "open notification context" "context" @@ -264,13 +285,6 @@ runRecompile = do #!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" } #!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" } --- runRecompile :: X () --- runRecompile = do --- -- assume that the conf directory contains a valid stack project --- -- TODO this is hacky AF --- confDir <- getXMonadDir --- spawnCmdAt confDir "stack" ["install"] - -------------------------------------------------------------------------------- -- | Screen capture commands @@ -288,22 +302,23 @@ getCaptureDir = do where fallback = ( ".local/share") <$> getHomeDirectory --- TODO test that flameshot is actually running (Bus org.flameshot.Flameshot) -runFlameshot :: String -> String -> SometimesX -runFlameshot n mode = sometimesIO_ n myCapture - (Only_ $ sysExe myCapture) $ spawnCmd myCapture [mode] +runFlameshot :: String -> String -> Maybe Client -> SometimesX +runFlameshot n mode cl = sometimesDBus cl n myCapture tree cmd + where + cmd _ = spawnCmd myCapture [mode] + tree = toAnd_ (DBusIO $ sysExe myCapture) $ Bus $ busName_ "org.flameshot.Flameshot" -- TODO this will steal focus from the current window (and puts it -- in the root window?) ...need to fix -runAreaCapture :: SometimesX +runAreaCapture :: Maybe Client -> SometimesX runAreaCapture = runFlameshot "screen area capture" "gui" -- myWindowCap = "screencap -w" --external script -runDesktopCapture :: SometimesX +runDesktopCapture :: Maybe Client -> SometimesX runDesktopCapture = runFlameshot "fullscreen capture" "full" -runScreenCapture :: SometimesX +runScreenCapture :: Maybe Client -> SometimesX runScreenCapture = runFlameshot "screen capture" "screen" runCaptureBrowser :: SometimesX diff --git a/lib/XMonad/Internal/DBus/Common.hs b/lib/XMonad/Internal/DBus/Common.hs index dd137b2..3a1e838 100644 --- a/lib/XMonad/Internal/DBus/Common.hs +++ b/lib/XMonad/Internal/DBus/Common.hs @@ -4,6 +4,8 @@ module XMonad.Internal.DBus.Common ( xmonadBusName , btBus + , notifyBus + , notifyPath ) where import DBus @@ -14,3 +16,9 @@ xmonadBusName = busName_ "org.xmonad" btBus :: BusName btBus = busName_ "org.bluez" +notifyBus :: BusName +notifyBus = busName_ "org.freedesktop.Notifications" + +notifyPath :: ObjectPath +notifyPath = objectPath_ "/org/freedesktop/Notifications" +