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

209 lines
6.4 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
--------------------------------------------------------------------------------
-- | Dmenu (Rofi) Commands
module XMonad.Internal.Command.DMenu
( runCmdMenu
, runAppMenu
, runClipMenu
, runWinMenu
, runNetMenu
, runDevMenu
, runBwMenu
, runVPNMenu
, runBTMenu
, runShowKeys
, runAutorandrMenu
) where
import qualified Data.ByteString.Char8 as BC
import Data.Internal.DBus
import Data.Internal.Dependency
import DBus
import Graphics.X11.Types
import qualified RIO.ByteString.Lazy as B
import qualified RIO.Text as T
import System.Directory
( XdgDirectory (..)
, getXdgDirectory
)
import XMonad.Core hiding (spawn)
import XMonad.Internal.Command.Desktop
import XMonad.Internal.DBus.Common
import XMonad.Internal.Notify
import XMonad.Internal.Shell
import XMonad.Util.NamedActions
--------------------------------------------------------------------------------
-- | DMenu executables
myDmenuCmd :: FilePath
myDmenuCmd = "rofi"
myDmenuDevices :: FilePath
myDmenuDevices = "rofi-dev"
myDmenuPasswords :: FilePath
myDmenuPasswords = "rofi-bw"
myDmenuBluetooth :: FilePath
myDmenuBluetooth = "rofi-bt"
myDmenuVPN :: FilePath
myDmenuVPN = "rofi-evpn"
myDmenuMonitors :: FilePath
myDmenuMonitors = "rofi-autorandr"
myDmenuNetworks :: FilePath
myDmenuNetworks = "networkmanager_dmenu"
myClipboardManager :: FilePath
myClipboardManager = "greenclip"
--------------------------------------------------------------------------------
-- | Packages
dmenuPkgs :: [Fulfillment]
dmenuPkgs = [Package Official "rofi"]
clipboardPkgs :: [Fulfillment]
clipboardPkgs = [Package AUR "rofi-greenclip"]
--------------------------------------------------------------------------------
-- | Other internal functions
spawnDmenuCmd :: T.Text -> [T.Text] -> SometimesX
spawnDmenuCmd n =
sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
themeArgs :: T.Text -> [T.Text]
themeArgs hexColor =
[ "-theme-str"
, T.concat ["'#element.selected.normal { background-color: ", hexColor, "; }'"]
]
myDmenuMatchingArgs :: [T.Text]
myDmenuMatchingArgs = ["-i"] -- case insensitivity
dmenuTree :: IOTree_ -> IOTree_
dmenuTree = And_ $ Only_ dmenuDep
dmenuDep :: IODependency_
dmenuDep = sysExe dmenuPkgs myDmenuCmd
--------------------------------------------------------------------------------
-- | Exported Commands
-- TODO test that veracrypt and friends are installed
runDevMenu :: SometimesX
runDevMenu = sometimesIO_ "device manager" "rofi devices" t x
where
t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
x = do
c <- io $ getXdgDirectory XdgConfig "rofi/devices.dhall"
spawnCmd myDmenuDevices
$ ["-c", T.pack c]
++ "--" : themeArgs "#999933"
++ myDmenuMatchingArgs
-- 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
runVPNMenu :: SometimesX
runVPNMenu = Sometimes "VPN selector" xpfVPN
[Subfeature (IORoot_ cmd tree) "rofi VPN"]
where
cmd = spawnCmd myDmenuVPN
$ ["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
tree = dmenuTree $ toAnd_ (localExe [] myDmenuVPN)
$ socketExists "expressVPN" []
$ return "/var/lib/expressvpn/expressvpnd.socket"
runCmdMenu :: SometimesX
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
runAppMenu :: SometimesX
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
runWinMenu :: SometimesX
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
runNetMenu :: Maybe SysClient -> SometimesX
runNetMenu cl = Sometimes "network control menu" enabled
[Subfeature root "network control menu"]
where
enabled f = xpfEthernet f || xpfWireless f || xpfVPN f
root = DBusRoot_ cmd tree cl
cmd _ = spawnCmd myDmenuNetworks $ themeArgs "#ff3333"
tree = And_ (Only_ $ Bus networkManagerPkgs networkManagerBus)
$ toAnd_ (DBusIO dmenuDep) $ DBusIO
$ sysExe [Package AUR "networkmanager-dmenu-git"] myDmenuNetworks
runAutorandrMenu :: SometimesX
runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
where
cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066"
tree = dmenuTree $ Only_ $ localExe [] myDmenuMonitors
--------------------------------------------------------------------------------
-- | Password manager
runBwMenu :: Maybe SesClient -> SometimesX
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)
--------------------------------------------------------------------------------
-- | Clipboard
runClipMenu :: SometimesX
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
where
act = spawnCmd myDmenuCmd args
tree = listToAnds dmenuDep [ sysExe clipboardPkgs myClipboardManager
, process [] $ T.pack myClipboardManager
]
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 $ spawnStdin i cmd
where
i = B.fromStrict $ BC.pack $ unlines $ showKm kbs
cmd = fmtCmd myDmenuCmd $ ["-dmenu", "-p", "commands"]
++ themeArgs "#7f66ff" ++ myDmenuMatchingArgs