ndwarshuis
/
xmonad-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH generalize all desktop commands

This commit is contained in:
Nathan Dwarshuis 2023-01-02 19:28:41 -05:00
parent db7011bfd8
commit adfbb92136
2 changed files with 75 additions and 52 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
bin/xmonad.hs
View File

@ -806,40 +806,40 @@ externalBindings runIO cleanup db =
, KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses , KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses
, KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu , KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu
, KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu , KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu
, KeyBinding "M-C-e" "launch editor" $ Left runEditor , KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor
, KeyBinding "M-C-w" "launch browser" $ Left runBrowser , KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser
, KeyBinding "M-C-t" "launch terminal with tmux" $ Left runTMux , KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux
, KeyBinding "M-C-S-t" "launch terminal" $ Left runTerm , KeyBinding "M-C-S-t" "launch terminal" $ Left $ toX runTerm
, KeyBinding "M-C-q" "launch calc" $ Left runCalc , KeyBinding "M-C-q" "launch calc" $ Left $ toX runCalc
, KeyBinding "M-C-f" "launch file manager" $ Left runFileManager , KeyBinding "M-C-f" "launch file manager" $ Left $ toX runFileManager
] ]
, KeyGroup , KeyGroup
"Actions" "Actions"
[ 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 ses , KeyBinding "M-C-s" "capture area" $ Left $ toX $ runAreaCapture ses
, KeyBinding "M-C-S-s" "capture screen" $ Left $ runScreenCapture ses , KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses
, KeyBinding "M-C-d" "capture desktop" $ Left $ runDesktopCapture ses , KeyBinding "M-C-d" "capture desktop" $ Left $ toX $ runDesktopCapture ses
, KeyBinding "M-C-b" "browse captures" $ Left runCaptureBrowser , KeyBinding "M-C-b" "browse captures" $ Left $ toX runCaptureBrowser
-- , ("M-C-S-s", "capture focused window", spawn myWindowCap) -- , ("M-C-S-s", "capture focused window", spawn myWindowCap)
] ]
, KeyGroup , KeyGroup
"Multimedia" "Multimedia"
[ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left runTogglePlay [ KeyBinding "<XF86AudioPlay>" "toggle play/pause" $ Left $ toX runTogglePlay
, KeyBinding "<XF86AudioPrev>" "previous track" $ Left runPrevTrack , KeyBinding "<XF86AudioPrev>" "previous track" $ Left $ toX runPrevTrack
, KeyBinding "<XF86AudioNext>" "next track" $ Left runNextTrack , KeyBinding "<XF86AudioNext>" "next track" $ Left $ toX runNextTrack
, KeyBinding "<XF86AudioStop>" "stop" $ Left runStopPlay , KeyBinding "<XF86AudioStop>" "stop" $ Left $ toX runStopPlay
, KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left runVolumeDown , KeyBinding "<XF86AudioLowerVolume>" "volume down" $ Left $ toX runVolumeDown
, KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left runVolumeUp , KeyBinding "<XF86AudioRaiseVolume>" "volume up" $ Left $ toX runVolumeUp
, KeyBinding "<XF86AudioMute>" "volume mute" $ Left runVolumeMute , KeyBinding "<XF86AudioMute>" "volume mute" $ Left $ toX runVolumeMute
] ]
, KeyGroup , KeyGroup
"Dunst" "Dunst"
[ KeyBinding "M-`" "dunst history" $ Left $ runNotificationHistory ses [ KeyBinding "M-`" "dunst history" $ Left $ toX $ runNotificationHistory ses
, KeyBinding "M-S-`" "dunst close" $ Left $ runNotificationClose ses , KeyBinding "M-S-`" "dunst close" $ Left $ toX $ runNotificationClose ses
, KeyBinding "M-M1-`" "dunst context menu" $ Left $ runNotificationContext ses , KeyBinding "M-M1-`" "dunst context menu" $ Left $ toX $ runNotificationContext ses
, KeyBinding "M-C-`" "dunst close all" $ Left $ runNotificationCloseAll ses , KeyBinding "M-C-`" "dunst close all" $ Left $ toX $ runNotificationCloseAll ses
] ]
, KeyGroup , KeyGroup
"System" "System"
@ -858,21 +858,23 @@ externalBindings runIO cleanup db =
KeyBinding "M-<F2>" "restart xmonad" restartf KeyBinding "M-<F2>" "restart xmonad" restartf
, KeyBinding "M-<F3>" "recompile xmonad" recompilef , KeyBinding "M-<F3>" "recompile xmonad" recompilef
, KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu , KeyBinding "M-<F8>" "select autorandr profile" $ Left runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" $ Left runToggleEthernet , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ runToggleBluetooth sys , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ liftIO . runIO <$> callToggle ses , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
, KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
] ]
] ]
where where
ses = dbSesClient db ses = dbSesClient db
sys = dbSysClient db sys = dbSysClient db
brightessControls ctl getter = (fmap (liftIO . runIO) . getter . ctl) ses brightessControls ctl getter = (toX . getter . ctl) ses
ib = Left . brightessControls intelBacklightControls ib = Left . brightessControls intelBacklightControls
ck = Left . brightessControls clevoKeyboardControls ck = Left . brightessControls clevoKeyboardControls
ftrAlways n = Right . Always n . Always_ . FallbackAlone ftrAlways n = Right . Always n . Always_ . FallbackAlone
restartf = ftrAlways "restart function" (cleanup >> runRestart) restartf = ftrAlways "restart function" (cleanup >> runRestart)
recompilef = ftrAlways "recompile function" runRecompile recompilef = ftrAlways "recompile function" runRecompile
toX_ = liftIO . runIO
toX = fmap toX_
type MaybeX = Maybe (X ()) type MaybeX = Maybe (X ())

75
lib/XMonad/Internal/Command/Desktop.hs
View File

@ -119,10 +119,10 @@ volumeChangeSound = "smb_fireball.wav"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Some nice apps -- Some nice apps
runTerm :: SometimesX runTerm :: MonadUnliftIO m => Sometimes (m ())
runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm
runTMux :: SometimesX runTMux :: MonadUnliftIO m => Sometimes (m ())
runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
where where
deps = deps =
@ -140,13 +140,13 @@ runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
t <- getTemporaryDirectory t <- getTemporaryDirectory
return $ t </> "tmux-" ++ show u </> "default" return $ t </> "tmux-" ++ show u </> "default"
runCalc :: SometimesX runCalc :: MonadUnliftIO m => Sometimes (m ())
runCalc = sometimesIO_ "calculator" "bc" deps act runCalc = sometimesIO_ "calculator" "bc" deps act
where where
deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package Official "bc"] myCalc) deps = toAnd_ (sysExe myTermPkgs myTerm) (sysExe [Package Official "bc"] myCalc)
act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"] act = spawnCmd myTerm ["-e", T.pack myCalc, "-l"]
runBrowser :: SometimesX runBrowser :: MonadUnliftIO m => Sometimes (m ())
runBrowser = runBrowser =
sometimesExe sometimesExe
"web browser" "web browser"
@ -155,7 +155,7 @@ runBrowser =
False False
myBrowser myBrowser
runEditor :: SometimesX runEditor :: MonadUnliftIO m => Sometimes (m ())
runEditor = sometimesIO_ "text editor" "emacs" tree cmd runEditor = sometimesIO_ "text editor" "emacs" tree cmd
where where
cmd = 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 -- before xmonad starts, so just check to see if the process has started
tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer tree = toAnd_ (sysExe myEditorPkgs myEditor) $ process [] $ T.pack myEditorServer
runFileManager :: SometimesX runFileManager :: MonadUnliftIO m => Sometimes (m ())
runFileManager = runFileManager =
sometimesExe sometimesExe
"file browser" "file browser"
@ -178,7 +178,11 @@ runFileManager =
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Multimedia Commands -- Multimedia Commands
runMultimediaIfInstalled :: T.Text -> T.Text -> SometimesX runMultimediaIfInstalled
:: MonadUnliftIO m
=> T.Text
-> T.Text
-> Sometimes (m ())
runMultimediaIfInstalled n cmd = runMultimediaIfInstalled n cmd =
sometimesExeArgs sometimesExeArgs
(T.append n " multimedia control") (T.append n " multimedia control")
@ -188,16 +192,16 @@ runMultimediaIfInstalled n cmd =
myMultimediaCtl myMultimediaCtl
[cmd] [cmd]
runTogglePlay :: SometimesX runTogglePlay :: MonadUnliftIO m => Sometimes (m ())
runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause" runTogglePlay = runMultimediaIfInstalled "play/pause" "play-pause"
runPrevTrack :: SometimesX runPrevTrack :: MonadUnliftIO m => Sometimes (m ())
runPrevTrack = runMultimediaIfInstalled "previous track" "previous" runPrevTrack = runMultimediaIfInstalled "previous track" "previous"
runNextTrack :: SometimesX runNextTrack :: MonadUnliftIO m => Sometimes (m ())
runNextTrack = runMultimediaIfInstalled "next track" "next" runNextTrack = runMultimediaIfInstalled "next track" "next"
runStopPlay :: SometimesX runStopPlay :: MonadUnliftIO m => Sometimes (m ())
runStopPlay = runMultimediaIfInstalled "stop playback" "stop" runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
@ -213,7 +217,13 @@ playSound file = do
-- paplay seems to have less latency than aplay -- paplay seems to have less latency than aplay
spawnCmd "paplay" [T.pack p] 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 = featureSound n file pre post =
sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $ sometimesIO_ (T.unwords ["volume", n, " control"]) "paplay" tree $
pre >> playSound file >> post 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 -- to play sound (duh) but libpulse is the package with the paplay binary
tree = Only_ $ sysExe [Package Official "pulseaudio"] "paplay" tree = Only_ $ sysExe [Package Official "pulseaudio"] "paplay"
runVolumeDown :: SometimesX runVolumeDown :: MonadUnliftIO m => Sometimes (m ())
runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2) runVolumeDown = featureSound "up" volumeChangeSound (return ()) $ void (lowerVolume 2)
runVolumeUp :: SometimesX runVolumeUp :: MonadUnliftIO m => Sometimes (m ())
runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2) runVolumeUp = featureSound "down" volumeChangeSound (return ()) $ void (raiseVolume 2)
runVolumeMute :: SometimesX runVolumeMute :: MonadUnliftIO m => Sometimes (m ())
runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return () runVolumeMute = featureSound "mute" volumeChangeSound (void toggleMute) $ return ()
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Notification control -- 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 = runNotificationCmd n arg cl =
sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
where where
@ -245,18 +260,18 @@ runNotificationCmd n arg cl =
Method_ $ Method_ $
memberName_ "NotificationAction" memberName_ "NotificationAction"
runNotificationClose :: Maybe SesClient -> SometimesX runNotificationClose :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runNotificationClose = runNotificationCmd "close notification" "close" runNotificationClose = runNotificationCmd "close notification" "close"
runNotificationCloseAll :: Maybe SesClient -> SometimesX runNotificationCloseAll :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runNotificationCloseAll = runNotificationCloseAll =
runNotificationCmd "close all notifications" "close-all" runNotificationCmd "close all notifications" "close-all"
runNotificationHistory :: Maybe SesClient -> SometimesX runNotificationHistory :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runNotificationHistory = runNotificationHistory =
runNotificationCmd "see notification history" "history-pop" runNotificationCmd "see notification history" "history-pop"
runNotificationContext :: Maybe SesClient -> SometimesX runNotificationContext :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runNotificationContext = runNotificationContext =
runNotificationCmd "open notification context" "context" runNotificationCmd "open notification context" "context"
@ -275,7 +290,7 @@ runNetAppDaemon cl =
app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet" app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True) cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)
runToggleBluetooth :: Maybe SysClient -> SometimesX runToggleBluetooth :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
runToggleBluetooth cl = runToggleBluetooth cl =
Sometimes Sometimes
"bluetooth toggle" "bluetooth toggle"
@ -292,7 +307,7 @@ runToggleBluetooth cl =
#!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"] #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
#!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"} #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}
runToggleEthernet :: SometimesX runToggleEthernet :: MonadUnliftIO m => Sometimes (m ())
runToggleEthernet = runToggleEthernet =
Sometimes Sometimes
"ethernet toggle" "ethernet toggle"
@ -320,6 +335,7 @@ runToggleEthernet =
runRestart :: X () runRestart :: X ()
runRestart = restart "xmonad" True 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 -- TODO only recompile the VM binary if we have virtualbox enabled
runRecompile :: X () runRecompile :: X ()
runRecompile = do runRecompile = do
@ -348,7 +364,12 @@ getCaptureDir = do
where where
fallback = (</> ".local/share") <$> getHomeDirectory 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 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
where where
cmd _ = spawnCmd myCapture [mode] 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 -- 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 :: Maybe SesClient -> SometimesX runAreaCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runAreaCapture = runFlameshot "screen area capture" "gui" runAreaCapture = runFlameshot "screen area capture" "gui"
-- myWindowCap = "screencap -w" --external script -- myWindowCap = "screencap -w" --external script
runDesktopCapture :: Maybe SesClient -> SometimesX runDesktopCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runDesktopCapture = runFlameshot "fullscreen capture" "full" runDesktopCapture = runFlameshot "fullscreen capture" "full"
runScreenCapture :: Maybe SesClient -> SometimesX runScreenCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runScreenCapture = runFlameshot "screen capture" "screen" runScreenCapture = runFlameshot "screen capture" "screen"
runCaptureBrowser :: SometimesX runCaptureBrowser :: MonadUnliftIO m => Sometimes (m ())
runCaptureBrowser = sometimesIO_ runCaptureBrowser = sometimesIO_
"screen capture browser" "screen capture browser"
"feh" "feh"