xmonad-config/lib/XMonad/Internal/Command/DMenu.hs

208 lines
6.4 KiB
Haskell
Raw Normal View History

2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Dmenu (Rofi) Commands
2020-04-01 20:17:47 -04:00
module XMonad.Internal.Command.DMenu
( runCmdMenu
, runAppMenu
, runClipMenu
, runWinMenu
, runNetMenu
, runDevMenu
2020-05-02 00:02:29 -04:00
, runBwMenu
2021-12-15 00:30:18 -05:00
, runVPNMenu
2021-11-29 00:56:16 -05:00
, runBTMenu
2020-04-01 20:17:47 -04:00
, runShowKeys
2020-08-17 18:46:02 -04:00
, runAutorandrMenu
2020-04-01 20:17:47 -04:00
) where
2022-06-26 19:27:04 -04:00
import Control.Monad.Reader
2022-07-09 17:44:14 -04:00
import Data.Internal.DBus
import Data.Internal.Dependency
2022-07-08 00:21:05 -04:00
import DBus
import Graphics.X11.Types
2022-07-08 00:21:05 -04:00
import System.Directory
( XdgDirectory (..)
, getXdgDirectory
)
2022-06-26 19:27:04 -04:00
import System.IO
import XMonad.Core hiding (spawn)
import XMonad.Internal.Command.Desktop
2022-07-08 00:21:05 -04:00
import XMonad.Internal.DBus.Common
2022-06-26 19:27:04 -04:00
import XMonad.Internal.Notify
import XMonad.Internal.Process
2021-11-21 10:26:28 -05:00
import XMonad.Internal.Shell
import XMonad.Util.NamedActions
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
2021-06-19 00:17:47 -04:00
-- | DMenu executables
2020-04-01 22:06:00 -04:00
myDmenuCmd :: String
myDmenuCmd = "rofi"
2021-06-19 00:17:47 -04:00
myDmenuDevices :: String
myDmenuDevices = "rofi-dev"
myDmenuPasswords :: String
myDmenuPasswords = "rofi-bw"
2021-11-29 00:56:16 -05:00
myDmenuBluetooth :: String
myDmenuBluetooth = "rofi-bt"
2021-12-15 00:30:18 -05:00
myDmenuVPN :: String
myDmenuVPN = "rofi-evpn"
2021-06-19 00:17:47 -04:00
myDmenuMonitors :: String
myDmenuMonitors = "rofi-autorandr"
myDmenuNetworks :: String
myDmenuNetworks = "networkmanager_dmenu"
2022-07-03 01:11:32 -04:00
myClipboardManager :: String
myClipboardManager = "greenclip"
--------------------------------------------------------------------------------
-- | Packages
dmenuPkgs :: [Fulfillment]
dmenuPkgs = [Package Official "rofi"]
clipboardPkgs :: [Fulfillment]
clipboardPkgs = [Package AUR "rofi-greenclip"]
2021-06-19 00:17:47 -04:00
--------------------------------------------------------------------------------
-- | Other internal functions
spawnDmenuCmd :: String -> [String] -> SometimesX
spawnDmenuCmd n =
sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
2020-04-01 22:06:00 -04:00
2020-08-15 17:00:13 -04:00
themeArgs :: String -> [String]
themeArgs hexColor =
[ "-theme-str"
, "'#element.selected.normal { background-color: " ++ hexColor ++ "; }'"
]
myDmenuMatchingArgs :: [String]
myDmenuMatchingArgs = ["-i"] -- case insensitivity
dmenuTree :: IOTree_ -> IOTree_
dmenuTree = And_ $ Only_ dmenuDep
dmenuDep :: IODependency_
dmenuDep = sysExe dmenuPkgs myDmenuCmd
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | Exported Commands
2022-07-07 01:05:17 -04:00
-- TODO test that veracrypt and friends are installed
runDevMenu :: SometimesX
2022-07-02 17:09:21 -04:00
runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
2022-06-28 23:27:55 -04:00
where
t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
2022-06-28 23:27:55 -04:00
x = do
c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
spawnCmd myDmenuDevices
$ ["-c", c]
++ "--" : themeArgs "#999933"
++ myDmenuMatchingArgs
2020-05-02 00:02:29 -04:00
2022-07-07 01:05:17 -04:00
-- TODO test that bluetooth interface exists
runBTMenu :: SometimesX
runBTMenu = Sometimes "bluetooth selector" xpfBluetooth
[Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
where
cmd = spawnCmd myDmenuBluetooth $ "-c":themeArgs "#0044bb"
tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
2021-11-29 00:56:16 -05:00
runVPNMenu :: SometimesX
runVPNMenu = Sometimes "VPN selector" xpfVPN
[Subfeature (IORoot_ cmd tree) "rofi VPN"]
2022-07-08 00:21:05 -04:00
where
cmd = spawnCmd myDmenuVPN
$ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
tree = dmenuTree $ toAnd_ (localExe [] myDmenuVPN)
$ socketExists "expressVPN" []
2022-07-08 00:21:05 -04:00
$ return "/var/lib/expressvpn/expressvpnd.socket"
2021-12-15 00:30:18 -05:00
runCmdMenu :: SometimesX
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
runAppMenu :: SometimesX
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
runWinMenu :: SometimesX
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
2022-07-09 17:08:10 -04:00
runNetMenu :: Maybe SysClient -> SometimesX
runNetMenu cl = Sometimes "network control menu" enabled
[Subfeature root "network control menu"]
2022-07-08 00:21:05 -04:00
where
enabled f = xpfEthernet f || xpfWireless f || xpfVPN f
root = DBusRoot_ cmd tree cl
2022-07-08 00:21:05 -04:00
cmd _ = spawnCmd myDmenuNetworks $ themeArgs "#ff3333"
tree = And_ (Only_ $ Bus networkManagerPkgs networkManagerBus)
$ toAnd_ (DBusIO dmenuDep) $ DBusIO
$ sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
2020-08-17 18:46:02 -04:00
runAutorandrMenu :: SometimesX
runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
where
cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066"
tree = dmenuTree $ Only_ $ localExe [] myDmenuMonitors
2022-07-03 01:11:32 -04:00
--------------------------------------------------------------------------------
-- | Password manager
2022-07-09 17:08:10 -04:00
runBwMenu :: Maybe SesClient -> SometimesX
2022-07-08 00:21:05 -04:00
runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
where
cmd _ = spawnCmd myDmenuPasswords
$ ["-c"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs
tree = And_ (Only_ $ Bus [] $ busName_ "org.rofi.bitwarden")
$ toAnd_ (DBusIO dmenuDep) (DBusIO $ localExe [] myDmenuPasswords)
2022-07-03 01:11:32 -04:00
--------------------------------------------------------------------------------
-- | Clipboard
runClipMenu :: SometimesX
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
where
act = spawnCmd myDmenuCmd args
tree = listToAnds dmenuDep [ sysExe clipboardPkgs myClipboardManager
, process [] myClipboardManager
]
2022-07-03 01:11:32 -04:00
args = [ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
] ++ themeArgs "#00c44e"
--------------------------------------------------------------------------------
-- | Shortcut menu
runShowKeys :: Always ([((KeyMask, KeySym), NamedAction)] -> X ())
runShowKeys = Always "keyboard menu" $ Option showKeysDMenu $ Always_
$ FallbackAlone fallback
where
-- TODO this should technically depend on dunst
fallback = const $ spawnNotify
$ defNoteError { body = Just $ Text "could not display keymap" }
showKeysDMenu :: SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> X ())
showKeysDMenu = Subfeature
{ sfName = "keyboard shortcut menu"
, sfData = IORoot_ showKeys $ Only_ dmenuDep
}
showKeys :: [((KeyMask, KeySym), NamedAction)] -> X ()
showKeys kbs = io $ do
(h, _, _, _) <- createProcess' $ (shell' cmd) { std_in = CreatePipe }
forM_ h $ \h' -> hPutStr h' (unlines $ showKm kbs) >> hClose h'
where
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs