ENH make desktop dependencies more robust
This commit is contained in:
parent
8d495123dc
commit
a7e7eee2a8
|
@ -635,9 +635,9 @@ externalBindings ts db =
|
||||||
[ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
|
[ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
|
||||||
, KeyBinding "M-r" "run program" $ Left runCmdMenu
|
, KeyBinding "M-r" "run program" $ Left runCmdMenu
|
||||||
, KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
|
, KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
|
||||||
, KeyBinding "M-C-s" "capture area" $ Left runAreaCapture
|
, KeyBinding "M-C-s" "capture area" $ Left $ runAreaCapture ses
|
||||||
, KeyBinding "M-C-S-s" "capture screen" $ Left runScreenCapture
|
, KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses
|
||||||
, KeyBinding "M-C-d" "capture desktop" $ Left runDesktopCapture
|
, KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses
|
||||||
, KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
|
, KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser
|
||||||
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
||||||
]
|
]
|
||||||
|
@ -653,10 +653,10 @@ externalBindings ts db =
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "Dunst"
|
, KeyGroup "Dunst"
|
||||||
[ KeyBinding "M-`" "dunst history" $ Left runNotificationHistory
|
[ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses
|
||||||
, KeyBinding "M-S-`" "dunst close" $ Left runNotificationClose
|
, KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses
|
||||||
, KeyBinding "M-M1-`" "dunst context menu" $ Left runNotificationContext
|
, KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses
|
||||||
, KeyBinding "M-C-`" "dunst close all" $ Left runNotificationCloseAll
|
, KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses
|
||||||
]
|
]
|
||||||
|
|
||||||
, KeyGroup "System"
|
, KeyGroup "System"
|
||||||
|
|
|
@ -41,14 +41,14 @@ module XMonad.Internal.Command.Desktop
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
|
||||||
|
import DBus
|
||||||
import DBus.Client
|
import DBus.Client
|
||||||
|
|
||||||
import System.Directory
|
import System.Directory
|
||||||
( createDirectoryIfMissing
|
|
||||||
, getHomeDirectory
|
|
||||||
)
|
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
|
import System.Posix.Files
|
||||||
|
import System.Posix.User
|
||||||
|
|
||||||
import XMonad (asks)
|
import XMonad (asks)
|
||||||
import XMonad.Actions.Volume
|
import XMonad.Actions.Volume
|
||||||
|
@ -99,17 +99,33 @@ volumeChangeSound = "smb_fireball.wav"
|
||||||
runTerm :: SometimesX
|
runTerm :: SometimesX
|
||||||
runTerm = sometimesExe "terminal" "urxvt" True myTerm
|
runTerm = sometimesExe "terminal" "urxvt" True myTerm
|
||||||
|
|
||||||
-- TODO test that tmux is actually running (/tmp/tmux-<UID>/default)
|
|
||||||
runTMux :: SometimesX
|
runTMux :: SometimesX
|
||||||
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
|
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
|
||||||
where
|
where
|
||||||
deps = listToAnds (sysExe myTerm) $ fmap sysExe ["tmux", "bash"]
|
deps = listToAnds (socketExists socketName)
|
||||||
|
$ fmap sysExe [myTerm, "tmux", "bash"]
|
||||||
act = spawn
|
act = spawn
|
||||||
$ "tmux has-session"
|
$ "tmux has-session"
|
||||||
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
|
#!&& fmtCmd myTerm ["-e", "bash", "-c", singleQuote c]
|
||||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
|
#!|| fmtNotifyCmd defNoteError { body = Just $ Text msg }
|
||||||
c = "exec tmux attach-session -d"
|
c = "exec tmux attach-session -d"
|
||||||
msg = "could not connect to tmux session"
|
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 :: SometimesX
|
||||||
runCalc = sometimesIO_ "calculator" "R" deps act
|
runCalc = sometimesIO_ "calculator" "R" deps act
|
||||||
|
@ -120,10 +136,13 @@ runCalc = sometimesIO_ "calculator" "R" deps act
|
||||||
runBrowser :: SometimesX
|
runBrowser :: SometimesX
|
||||||
runBrowser = sometimesExe "web browser" "brave" False myBrowser
|
runBrowser = sometimesExe "web browser" "brave" False myBrowser
|
||||||
|
|
||||||
-- TODO test that emacs is actually running (/run/user/1000/emacs/server)
|
|
||||||
runEditor :: SometimesX
|
runEditor :: SometimesX
|
||||||
runEditor = sometimesExeArgs "text editor" "emacs" True myEditor
|
runEditor = sometimesIO_ "text editor" "emacs" tree cmd
|
||||||
["-c", "-e", doubleQuote "(select-frame-set-input-focus (selected-frame))"]
|
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 :: SometimesX
|
||||||
runFileManager = sometimesExe "file browser" "pcmanfm" True "pcmanfm"
|
runFileManager = sometimesExe "file browser" "pcmanfm" True "pcmanfm"
|
||||||
|
@ -177,25 +196,27 @@ runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return
|
||||||
--------------------------------------------------------------------------------
|
--------------------------------------------------------------------------------
|
||||||
-- | Notification control
|
-- | Notification control
|
||||||
|
|
||||||
-- TODO test that dunst is actually running (org.freedesktop.Notifications/org.dunstproject.cmd0)
|
runNotificationCmd :: String -> FilePath -> Maybe Client -> SometimesX
|
||||||
runNotificationCmd :: String -> FilePath -> SometimesX
|
runNotificationCmd n arg cl =
|
||||||
runNotificationCmd n arg = sometimesIO_ (n ++ " control") "dunstctl" tree cmd
|
sometimesDBus cl (n ++ " control") "dunstctl" tree cmd
|
||||||
where
|
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"
|
runNotificationClose = runNotificationCmd "close notification" "close"
|
||||||
|
|
||||||
runNotificationCloseAll :: SometimesX
|
runNotificationCloseAll :: Maybe Client -> SometimesX
|
||||||
runNotificationCloseAll =
|
runNotificationCloseAll =
|
||||||
runNotificationCmd "close all notifications" "close-all"
|
runNotificationCmd "close all notifications" "close-all"
|
||||||
|
|
||||||
runNotificationHistory :: SometimesX
|
runNotificationHistory :: Maybe Client -> SometimesX
|
||||||
runNotificationHistory =
|
runNotificationHistory =
|
||||||
runNotificationCmd "see notification history" "history-pop"
|
runNotificationCmd "see notification history" "history-pop"
|
||||||
|
|
||||||
runNotificationContext :: SometimesX
|
runNotificationContext :: Maybe Client -> SometimesX
|
||||||
runNotificationContext =
|
runNotificationContext =
|
||||||
runNotificationCmd "open notification context" "context"
|
runNotificationCmd "open notification context" "context"
|
||||||
|
|
||||||
|
@ -264,13 +285,6 @@ runRecompile = do
|
||||||
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
|
#!&& fmtNotifyCmd defNoteInfo { body = Just $ Text "compilation succeeded" }
|
||||||
#!|| fmtNotifyCmd defNoteError { body = Just $ Text "compilation failed" }
|
#!|| 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
|
-- | Screen capture commands
|
||||||
|
|
||||||
|
@ -288,22 +302,23 @@ getCaptureDir = do
|
||||||
where
|
where
|
||||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||||
|
|
||||||
-- TODO test that flameshot is actually running (Bus org.flameshot.Flameshot)
|
runFlameshot :: String -> String -> Maybe Client -> SometimesX
|
||||||
runFlameshot :: String -> String -> SometimesX
|
runFlameshot n mode cl = sometimesDBus cl n myCapture tree cmd
|
||||||
runFlameshot n mode = sometimesIO_ n myCapture
|
where
|
||||||
(Only_ $ sysExe myCapture) $ spawnCmd myCapture [mode]
|
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
|
-- TODO this will steal focus from the current window (and puts it
|
||||||
-- in the root window?) ...need to fix
|
-- in the root window?) ...need to fix
|
||||||
runAreaCapture :: SometimesX
|
runAreaCapture :: Maybe Client -> SometimesX
|
||||||
runAreaCapture = runFlameshot "screen area capture" "gui"
|
runAreaCapture = runFlameshot "screen area capture" "gui"
|
||||||
|
|
||||||
-- myWindowCap = "screencap -w" --external script
|
-- myWindowCap = "screencap -w" --external script
|
||||||
|
|
||||||
runDesktopCapture :: SometimesX
|
runDesktopCapture :: Maybe Client -> SometimesX
|
||||||
runDesktopCapture = runFlameshot "fullscreen capture" "full"
|
runDesktopCapture = runFlameshot "fullscreen capture" "full"
|
||||||
|
|
||||||
runScreenCapture :: SometimesX
|
runScreenCapture :: Maybe Client -> SometimesX
|
||||||
runScreenCapture = runFlameshot "screen capture" "screen"
|
runScreenCapture = runFlameshot "screen capture" "screen"
|
||||||
|
|
||||||
runCaptureBrowser :: SometimesX
|
runCaptureBrowser :: SometimesX
|
||||||
|
|
|
@ -4,6 +4,8 @@
|
||||||
module XMonad.Internal.DBus.Common
|
module XMonad.Internal.DBus.Common
|
||||||
( xmonadBusName
|
( xmonadBusName
|
||||||
, btBus
|
, btBus
|
||||||
|
, notifyBus
|
||||||
|
, notifyPath
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import DBus
|
import DBus
|
||||||
|
@ -14,3 +16,9 @@ xmonadBusName = busName_ "org.xmonad"
|
||||||
btBus :: BusName
|
btBus :: BusName
|
||||||
btBus = busName_ "org.bluez"
|
btBus = busName_ "org.bluez"
|
||||||
|
|
||||||
|
notifyBus :: BusName
|
||||||
|
notifyBus = busName_ "org.freedesktop.Notifications"
|
||||||
|
|
||||||
|
notifyPath :: ObjectPath
|
||||||
|
notifyPath = objectPath_ "/org/freedesktop/Notifications"
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue