ENH generalize all desktop commands
This commit is contained in:
parent
db7011bfd8
commit
adfbb92136
|
|
@ -806,40 +806,40 @@ externalBindings runIO cleanup db =
|
|||
, KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
|
||||
, KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
|
||||
, KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
|
||||
, KeyBinding "M-C-e" "launch editor" $ Left runEditor
|
||||
, KeyBinding "M-C-w" "launch browser" $ Left runBrowser
|
||||
, KeyBinding "M-C-t" "launch terminal with tmux" $ Left runTMux
|
||||
, KeyBinding "M-C-S-t" "launch terminal" $ Left runTerm
|
||||
, KeyBinding "M-C-q" "launch calc" $ Left runCalc
|
||||
, KeyBinding "M-C-f" "launch file manager" $ Left runFileManager
|
||||
, KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor
|
||||
, KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser
|
||||
, KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux
|
||||
, KeyBinding "M-C-S-t" "launch terminal" $ Left $ toX runTerm
|
||||
, KeyBinding "M-C-q" "launch calc" $ Left $ toX runCalc
|
||||
, KeyBinding "M-C-f" "launch file manager" $ Left $ toX runFileManager
|
||||
]
|
||||
, KeyGroup
|
||||
"Actions"
|
||||
[ KeyBinding "M-q" "close window" $ ftrAlways "kill window function" kill1
|
||||
, KeyBinding "M-r" "run program" $ Left runCmdMenu
|
||||
, KeyBinding "M-<Space>" "warp pointer" $ ftrAlways "warp function" $ warpToWindow 0.5 0.5
|
||||
, 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
|
||||
, KeyBinding "M-C-s" "capture area" $ Left $ toX $ runAreaCapture ses
|
||||
, KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses
|
||||
, KeyBinding "M-C-d" "capture desktop" $ Left $ toX $ runDesktopCapture ses
|
||||
, KeyBinding "M-C-b" "browse captures" $ Left $ toX runCaptureBrowser
|
||||
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
|
||||
]
|
||||
, KeyGroup
|
||||
"Multimedia"
|
||||
[ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay
|
||||
, KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack
|
||||
, KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack
|
||||
, KeyBinding "<XF86AudioStop>" "stop" $ Left runStopPlay
|
||||
, KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left runVolumeDown
|
||||
, KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp
|
||||
, KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute
|
||||
[ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left $ toX runTogglePlay
|
||||
, KeyBinding "<XF86AudioPrev>" "previous track" $ Left $ toX runPrevTrack
|
||||
, KeyBinding "<XF86AudioNext>" "next track" $ Left $ toX runNextTrack
|
||||
, KeyBinding "<XF86AudioStop>" "stop" $ Left $ toX runStopPlay
|
||||
, KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left $ toX runVolumeDown
|
||||
, KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left $ toX runVolumeUp
|
||||
, KeyBinding "<XF86AudioMute>" "volume mute" $ Left $ toX runVolumeMute
|
||||
]
|
||||
, KeyGroup
|
||||
"Dunst"
|
||||
[ 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
|
||||
[ KeyBinding "M-`" "dunst history" $ Left $ toX $ runNotificationHistory ses
|
||||
, KeyBinding "M-S-`" "dunst close" $ Left $ toX $ runNotificationClose ses
|
||||
, KeyBinding "M-M1-`" "dunst context menu" $ Left $ toX $ runNotificationContext ses
|
||||
, KeyBinding "M-C-`" "dunst close all" $ Left $ toX $ runNotificationCloseAll ses
|
||||
]
|
||||
, KeyGroup
|
||||
"System"
|
||||
|
|
@ -858,21 +858,23 @@ externalBindings runIO cleanup db =
|
|||
KeyBinding "M-<F2>" "restart xmonad" restartf
|
||||
, KeyBinding "M-<F3>" "recompile xmonad" recompilef
|
||||
, KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
|
||||
, KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet
|
||||
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys
|
||||
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ liftIO . runIO <$> callToggle ses
|
||||
, KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
|
||||
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
|
||||
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
|
||||
, KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
|
||||
]
|
||||
]
|
||||
where
|
||||
ses = dbSesClient db
|
||||
sys = dbSysClient db
|
||||
brightessControls ctl getter = (fmap (liftIO . runIO) . getter . ctl) ses
|
||||
brightessControls ctl getter = (toX . getter . ctl) ses
|
||||
ib = Left . brightessControls intelBacklightControls
|
||||
ck = Left . brightessControls clevoKeyboardControls
|
||||
ftrAlways n = Right . Always n . Always_ . FallbackAlone
|
||||
restartf = ftrAlways "restart function" (cleanup >> runRestart)
|
||||
recompilef = ftrAlways "recompile function" runRecompile
|
||||
toX_ = liftIO . runIO
|
||||
toX = fmap toX_
|
||||
|
||||
type MaybeX = Maybe (X ())
|
||||
|
||||
|
|
|
|||
|
|
@ -119,10 +119,10 @@ volumeChangeSound = "smb_fireball.wav"
|
|||
--------------------------------------------------------------------------------
|
||||
-- Some nice apps
|
||||
|
||||
runTerm :: SometimesX
|
||||
runTerm :: MonadUnliftIO m => Sometimes (m ())
|
||||
runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
|
||||
|
||||
runTMux :: SometimesX
|
||||
runTMux :: MonadUnliftIO m => Sometimes (m ())
|
||||
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
|
||||
where
|
||||
deps =
|
||||
|
|
@ -140,13 +140,13 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
|
|||
t <- getTemporaryDirectory
|
||||
return $ t </> "tmux-" ++ show u </> "default"
|
||||
|
||||
runCalc :: SometimesX
|
||||
runCalc :: MonadUnliftIO m => Sometimes (m ())
|
||||
runCalc = sometimesIO_ "calculator" "bc" deps act
|
||||
where
|
||||
deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package Official "bc"] myCalc)
|
||||
act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
|
||||
|
||||
runBrowser :: SometimesX
|
||||
runBrowser :: MonadUnliftIO m => Sometimes (m ())
|
||||
runBrowser =
|
||||
sometimesExe
|
||||
"web browser"
|
||||
|
|
@ -155,7 +155,7 @@ runBrowser =
|
|||
False
|
||||
myBrowser
|
||||
|
||||
runEditor :: SometimesX
|
||||
runEditor :: MonadUnliftIO m => Sometimes (m ())
|
||||
runEditor = sometimesIO_ "text editor" "emacs" tree cmd
|
||||
where
|
||||
cmd =
|
||||
|
|
@ -166,7 +166,7 @@ runEditor = sometimesIO_ "text editor" "emacs" tree cmd
|
|||
-- before xmonad starts, so just check to see if the process has started
|
||||
tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
|
||||
|
||||
runFileManager :: SometimesX
|
||||
runFileManager :: MonadUnliftIO m => Sometimes (m ())
|
||||
runFileManager =
|
||||
sometimesExe
|
||||
"file browser"
|
||||
|
|
@ -178,7 +178,11 @@ runFileManager =
|
|||
--------------------------------------------------------------------------------
|
||||
-- Multimedia Commands
|
||||
|
||||
runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX
|
||||
runMultimediaIfInstalled
|
||||
:: MonadUnliftIO m
|
||||
=> T.Text
|
||||
-> T.Text
|
||||
-> Sometimes (m ())
|
||||
runMultimediaIfInstalled n cmd =
|
||||
sometimesExeArgs
|
||||
(T.append n " multimedia control")
|
||||
|
|
@ -188,16 +192,16 @@ runMultimediaIfInstalled n cmd =
|
|||
myMultimediaCtl
|
||||
[cmd]
|
||||
|
||||
runTogglePlay :: SometimesX
|
||||
runTogglePlay :: MonadUnliftIO m => Sometimes (m ())
|
||||
runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
|
||||
|
||||
runPrevTrack :: SometimesX
|
||||
runPrevTrack :: MonadUnliftIO m => Sometimes (m ())
|
||||
runPrevTrack = runMultimediaIfInstalled "previous track" "previous"
|
||||
|
||||
runNextTrack :: SometimesX
|
||||
runNextTrack :: MonadUnliftIO m => Sometimes (m ())
|
||||
runNextTrack = runMultimediaIfInstalled "next track" "next"
|
||||
|
||||
runStopPlay :: SometimesX
|
||||
runStopPlay :: MonadUnliftIO m => Sometimes (m ())
|
||||
runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -213,7 +217,13 @@ playSound file = do
|
|||
-- paplay seems to have less latency than aplay
|
||||
spawnCmd "paplay" [T.pack p]
|
||||
|
||||
featureSound :: T.Text -> FilePath -> X () -> X () -> SometimesX
|
||||
featureSound
|
||||
:: MonadUnliftIO m
|
||||
=> T.Text
|
||||
-> FilePath
|
||||
-> m ()
|
||||
-> m ()
|
||||
-> Sometimes (m ())
|
||||
featureSound n file pre post =
|
||||
sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $
|
||||
pre >> playSound file >> post
|
||||
|
|
@ -222,19 +232,24 @@ featureSound n file pre post =
|
|||
-- to play sound (duh) but libpulse is the package with the paplay binary
|
||||
tree = Only_ $ sysExe [Package Official "pulseaudio"] "paplay"
|
||||
|
||||
runVolumeDown :: SometimesX
|
||||
runVolumeDown :: MonadUnliftIO m => Sometimes (m ())
|
||||
runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2)
|
||||
|
||||
runVolumeUp :: SometimesX
|
||||
runVolumeUp :: MonadUnliftIO m => Sometimes (m ())
|
||||
runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2)
|
||||
|
||||
runVolumeMute :: SometimesX
|
||||
runVolumeMute :: MonadUnliftIO m => Sometimes (m ())
|
||||
runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Notification control
|
||||
|
||||
runNotificationCmd :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
|
||||
runNotificationCmd
|
||||
:: MonadUnliftIO m
|
||||
=> T.Text
|
||||
-> T.Text
|
||||
-> Maybe SesClient
|
||||
-> Sometimes (m ())
|
||||
runNotificationCmd n arg cl =
|
||||
sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
|
||||
where
|
||||
|
|
@ -245,18 +260,18 @@ runNotificationCmd n arg cl =
|
|||
Method_ $
|
||||
memberName_ "NotificationAction"
|
||||
|
||||
runNotificationClose :: Maybe SesClient -> SometimesX
|
||||
runNotificationClose :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runNotificationClose = runNotificationCmd "close notification" "close"
|
||||
|
||||
runNotificationCloseAll :: Maybe SesClient -> SometimesX
|
||||
runNotificationCloseAll :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runNotificationCloseAll =
|
||||
runNotificationCmd "close all notifications" "close-all"
|
||||
|
||||
runNotificationHistory :: Maybe SesClient -> SometimesX
|
||||
runNotificationHistory :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runNotificationHistory =
|
||||
runNotificationCmd "see notification history" "history-pop"
|
||||
|
||||
runNotificationContext :: Maybe SesClient -> SometimesX
|
||||
runNotificationContext :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runNotificationContext =
|
||||
runNotificationCmd "open notification context" "context"
|
||||
|
||||
|
|
@ -275,7 +290,7 @@ runNetAppDaemon cl =
|
|||
app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
|
||||
cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
|
||||
|
||||
runToggleBluetooth :: Maybe SysClient -> SometimesX
|
||||
runToggleBluetooth :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
|
||||
runToggleBluetooth cl =
|
||||
Sometimes
|
||||
"bluetooth toggle"
|
||||
|
|
@ -292,7 +307,7 @@ runToggleBluetooth cl =
|
|||
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
|
||||
#!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
|
||||
|
||||
runToggleEthernet :: SometimesX
|
||||
runToggleEthernet :: MonadUnliftIO m => Sometimes (m ())
|
||||
runToggleEthernet =
|
||||
Sometimes
|
||||
"ethernet toggle"
|
||||
|
|
@ -320,6 +335,7 @@ runToggleEthernet =
|
|||
runRestart :: X ()
|
||||
runRestart = restart "xmonad" True
|
||||
|
||||
-- TODO use rio in here so I don't have to fill my xinit log with stack poop
|
||||
-- TODO only recompile the VM binary if we have virtualbox enabled
|
||||
runRecompile :: X ()
|
||||
runRecompile = do
|
||||
|
|
@ -348,7 +364,12 @@ getCaptureDir = do
|
|||
where
|
||||
fallback = (</> ".local/share") <$> getHomeDirectory
|
||||
|
||||
runFlameshot :: T.Text -> T.Text -> Maybe SesClient -> SometimesX
|
||||
runFlameshot
|
||||
:: MonadUnliftIO m
|
||||
=> T.Text
|
||||
-> T.Text
|
||||
-> Maybe SesClient
|
||||
-> Sometimes (m ())
|
||||
runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
|
||||
where
|
||||
cmd _ = spawnCmd myCapture [mode]
|
||||
|
|
@ -359,18 +380,18 @@ runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
|
|||
|
||||
-- TODO this will steal focus from the current window (and puts it
|
||||
-- in the root window?) ...need to fix
|
||||
runAreaCapture :: Maybe SesClient -> SometimesX
|
||||
runAreaCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runAreaCapture = runFlameshot "screen area capture" "gui"
|
||||
|
||||
-- myWindowCap = "screencap -w" --external script
|
||||
|
||||
runDesktopCapture :: Maybe SesClient -> SometimesX
|
||||
runDesktopCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runDesktopCapture = runFlameshot "fullscreen capture" "full"
|
||||
|
||||
runScreenCapture :: Maybe SesClient -> SometimesX
|
||||
runScreenCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
||||
runScreenCapture = runFlameshot "screen capture" "screen"
|
||||
|
||||
runCaptureBrowser :: SometimesX
|
||||
runCaptureBrowser :: MonadUnliftIO m => Sometimes (m ())
|
||||
runCaptureBrowser = sometimesIO_
|
||||
"screen capture browser"
|
||||
"feh"
|
||||
|
|
|
|||
Loading…
Reference in New Issue