ENH generalize (most) dmenu commands

This commit is contained in:
Nathan Dwarshuis 2023-01-02 19:32:12 -05:00
parent adfbb92136
commit 394eca3ad2
2 changed files with 22 additions and 21 deletions

View File

@ -798,14 +798,14 @@ externalBindings :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX
externalBindings runIO cleanup db = externalBindings runIO cleanup db =
[ KeyGroup [ KeyGroup
"Launchers" "Launchers"
[ KeyBinding "<XF86Search>" "select/launch app" $ Left runAppMenu [ KeyBinding "<XF86Search>" "select/launch app" $ Left $ toX runAppMenu
, KeyBinding "M-g" "launch clipboard manager" $ Left runClipMenu , KeyBinding "M-g" "launch clipboard manager" $ Left $ toX runClipMenu
, KeyBinding "M-a" "launch network selector" $ Left $ runNetMenu sys , KeyBinding "M-a" "launch network selector" $ Left $ toX $ runNetMenu sys
, KeyBinding "M-w" "launch window selector" $ Left runWinMenu , KeyBinding "M-w" "launch window selector" $ Left $ toX runWinMenu
, KeyBinding "M-u" "launch device selector" $ Left runDevMenu , KeyBinding "M-u" "launch device selector" $ Left $ toX runDevMenu
, KeyBinding "M-b" "launch bitwarden selector" $ Left $ runBwMenu ses , KeyBinding "M-b" "launch bitwarden selector" $ Left $ toX $ runBwMenu ses
, KeyBinding "M-v" "launch ExpressVPN selector" $ Left runVPNMenu , KeyBinding "M-v" "launch ExpressVPN selector" $ Left $ toX runVPNMenu
, KeyBinding "M-e" "launch bluetooth selector" $ Left runBTMenu , KeyBinding "M-e" "launch bluetooth selector" $ Left $ toX runBTMenu
, KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor , KeyBinding "M-C-e" "launch editor" $ Left $ toX runEditor
, KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser , KeyBinding "M-C-w" "launch browser" $ Left $ toX runBrowser
, KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux , KeyBinding "M-C-t" "launch terminal with tmux" $ Left $ toX runTMux
@ -816,7 +816,7 @@ externalBindings runIO cleanup db =
, 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 $ toX 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 $ toX $ runAreaCapture ses , KeyBinding "M-C-s" "capture area" $ Left $ toX $ runAreaCapture ses
, KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses , KeyBinding "M-C-S-s" "capture screen" $ Left $ toX $ runScreenCapture ses
@ -857,7 +857,7 @@ externalBindings runIO cleanup db =
, -- M-<F1> reserved for showing the keymap , -- M-<F1> reserved for showing the keymap
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 $ toX runAutorandrMenu
, KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
, KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
, KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses

View File

@ -22,6 +22,7 @@ import DBus
import Data.Internal.DBus import Data.Internal.DBus
import Data.Internal.XIO import Data.Internal.XIO
import Graphics.X11.Types import Graphics.X11.Types
import RIO hiding (hClose)
import RIO.Directory import RIO.Directory
( XdgDirectory (..) ( XdgDirectory (..)
, getXdgDirectory , getXdgDirectory
@ -74,7 +75,7 @@ clipboardPkgs = [Package AUR "rofi-greenclip"]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Other internal functions -- Other internal functions
spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX spawnDmenuCmd :: MonadUnliftIO m => T.Text -> [T.Text] -> Sometimes (m ())
spawnDmenuCmd n = spawnDmenuCmd n =
sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
@ -97,7 +98,7 @@ dmenuDep = sysExe dmenuPkgs myDmenuCmd
-- Exported Commands -- Exported Commands
-- TODO test that veracrypt and friends are installed -- TODO test that veracrypt and friends are installed
runDevMenu :: SometimesX runDevMenu :: MonadUnliftIO m => Sometimes (m ())
runDevMenu = sometimesIO_ "device manager" "rofi devices" t x runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
where where
t = dmenuTree $ Only_ (localExe [] myDmenuDevices) t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
@ -110,7 +111,7 @@ runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
++ myDmenuMatchingArgs ++ myDmenuMatchingArgs
-- TODO test that bluetooth interface exists -- TODO test that bluetooth interface exists
runBTMenu :: SometimesX runBTMenu :: MonadUnliftIO m => Sometimes (m ())
runBTMenu = runBTMenu =
Sometimes Sometimes
"bluetooth selector" "bluetooth selector"
@ -120,7 +121,7 @@ runBTMenu =
cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb" cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
runVPNMenu :: SometimesX runVPNMenu :: MonadUnliftIO m => Sometimes (m ())
runVPNMenu = runVPNMenu =
Sometimes Sometimes
"VPN selector" "VPN selector"
@ -136,16 +137,16 @@ runVPNMenu =
socketExists "expressVPN" [] $ socketExists "expressVPN" [] $
return "/var/lib/expressvpn/expressvpnd.socket" return "/var/lib/expressvpn/expressvpnd.socket"
runCmdMenu :: SometimesX runCmdMenu :: MonadUnliftIO m => Sometimes (m ())
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"] runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
runAppMenu :: SometimesX runAppMenu :: MonadUnliftIO m => Sometimes (m ())
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"] runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
runWinMenu :: SometimesX runWinMenu :: MonadUnliftIO m => Sometimes (m ())
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"] runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
runNetMenu :: Maybe SysClient -> SometimesX runNetMenu :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
runNetMenu cl = runNetMenu cl =
Sometimes Sometimes
"network control menu" "network control menu"
@ -161,7 +162,7 @@ runNetMenu cl =
DBusIO $ DBusIO $
sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
runAutorandrMenu :: SometimesX runAutorandrMenu :: MonadUnliftIO m => Sometimes (m ())
runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
where where
cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066" cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066"
@ -170,7 +171,7 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Password manager -- Password manager
runBwMenu :: Maybe SesClient -> SometimesX runBwMenu :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
where where
cmd _ = cmd _ =
@ -183,7 +184,7 @@ runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Clipboard -- Clipboard
runClipMenu :: SometimesX runClipMenu :: MonadUnliftIO m => Sometimes (m ())
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
where where
act = spawnCmd myDmenuCmd args act = spawnCmd myDmenuCmd args