2022-12-26 14:45:49 -05:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
|
2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Dmenu (Rofi) Commands
|
2020-04-01 22:06:00 -04:00
|
|
|
|
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
|
2022-12-30 14:58:23 -05:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
|
|
|
import DBus
|
2023-01-02 19:44:17 -05:00
|
|
|
import qualified Data.ByteString.Char8 as BC
|
2022-12-30 14:58:23 -05:00
|
|
|
import Data.Internal.DBus
|
2023-01-01 18:33:02 -05:00
|
|
|
import Data.Internal.XIO
|
2022-12-30 14:58:23 -05:00
|
|
|
import Graphics.X11.Types
|
2023-01-02 19:44:17 -05:00
|
|
|
import RIO
|
|
|
|
import qualified RIO.ByteString as B
|
2022-12-31 19:47:02 -05:00
|
|
|
import RIO.Directory
|
2022-12-30 14:58:23 -05:00
|
|
|
( XdgDirectory (..)
|
|
|
|
, getXdgDirectory
|
|
|
|
)
|
2022-12-31 19:47:02 -05:00
|
|
|
import qualified RIO.Text as T
|
2023-01-02 19:44:17 -05:00
|
|
|
-- import System.IO
|
2022-12-30 14:58:23 -05:00
|
|
|
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
|
2020-03-28 14:44:50 -04:00
|
|
|
|
2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- DMenu executables
|
2020-04-01 22:06:00 -04:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuCmd :: FilePath
|
2020-03-28 14:44:50 -04:00
|
|
|
myDmenuCmd = "rofi"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuDevices :: FilePath
|
2021-06-19 00:17:47 -04:00
|
|
|
myDmenuDevices = "rofi-dev"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuPasswords :: FilePath
|
2021-06-19 00:17:47 -04:00
|
|
|
myDmenuPasswords = "rofi-bw"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuBluetooth :: FilePath
|
2021-11-29 00:56:16 -05:00
|
|
|
myDmenuBluetooth = "rofi-bt"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuVPN :: FilePath
|
2021-12-15 00:30:18 -05:00
|
|
|
myDmenuVPN = "rofi-evpn"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuMonitors :: FilePath
|
2021-06-19 00:17:47 -04:00
|
|
|
myDmenuMonitors = "rofi-autorandr"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuNetworks :: FilePath
|
2021-06-19 00:17:47 -04:00
|
|
|
myDmenuNetworks = "networkmanager_dmenu"
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myClipboardManager :: FilePath
|
2022-07-03 01:11:32 -04:00
|
|
|
myClipboardManager = "greenclip"
|
|
|
|
|
2022-07-09 01:02:37 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Packages
|
2022-07-09 01:02:37 -04:00
|
|
|
|
|
|
|
dmenuPkgs :: [Fulfillment]
|
2022-07-09 14:59:42 -04:00
|
|
|
dmenuPkgs = [Package Official "rofi"]
|
2022-07-09 01:02:37 -04:00
|
|
|
|
|
|
|
clipboardPkgs :: [Fulfillment]
|
2022-07-09 14:59:42 -04:00
|
|
|
clipboardPkgs = [Package AUR "rofi-greenclip"]
|
2022-07-09 01:02:37 -04:00
|
|
|
|
2021-06-19 00:17:47 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Other internal functions
|
2021-06-19 00:17:47 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
spawnDmenuCmd :: MonadUnliftIO m => T.Text -> [T.Text] -> Sometimes (m ())
|
2022-07-09 01:02:37 -04:00
|
|
|
spawnDmenuCmd n =
|
|
|
|
sometimesExeArgs n "rofi preset" dmenuPkgs True myDmenuCmd
|
2020-04-01 22:06:00 -04:00
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
themeArgs :: T.Text -> [T.Text]
|
2020-08-15 17:00:13 -04:00
|
|
|
themeArgs hexColor =
|
|
|
|
[ "-theme-str"
|
2022-12-26 14:45:49 -05:00
|
|
|
, T.concat ["'#element.selected.normal { background-color: ", hexColor, "; }'"]
|
2020-08-15 17:00:13 -04:00
|
|
|
]
|
|
|
|
|
2022-12-26 14:45:49 -05:00
|
|
|
myDmenuMatchingArgs :: [T.Text]
|
2020-08-15 17:00:13 -04:00
|
|
|
myDmenuMatchingArgs = ["-i"] -- case insensitivity
|
|
|
|
|
2022-07-09 01:02:37 -04:00
|
|
|
dmenuTree :: IOTree_ -> IOTree_
|
|
|
|
dmenuTree = And_ $ Only_ dmenuDep
|
|
|
|
|
|
|
|
dmenuDep :: IODependency_
|
|
|
|
dmenuDep = sysExe dmenuPkgs myDmenuCmd
|
|
|
|
|
2020-04-01 22:06:00 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Exported Commands
|
2020-04-01 22:06:00 -04:00
|
|
|
|
2022-07-07 01:05:17 -04:00
|
|
|
-- TODO test that veracrypt and friends are installed
|
2023-01-02 19:32:12 -05:00
|
|
|
runDevMenu :: MonadUnliftIO m => Sometimes (m ())
|
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
|
2022-07-09 01:02:37 -04:00
|
|
|
t = dmenuTree $ Only_ (localExe [] myDmenuDevices)
|
2022-06-28 23:27:55 -04:00
|
|
|
x = do
|
2022-08-08 13:21:09 -04:00
|
|
|
c <- io $ getXdgDirectory XdgConfig "rofi/devices.dhall"
|
2022-12-30 14:58:23 -05:00
|
|
|
spawnCmd myDmenuDevices $
|
|
|
|
["-c", T.pack 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
|
2023-01-02 19:32:12 -05:00
|
|
|
runBTMenu :: MonadUnliftIO m => Sometimes (m ())
|
2022-12-30 14:58:23 -05:00
|
|
|
runBTMenu =
|
|
|
|
Sometimes
|
|
|
|
"bluetooth selector"
|
|
|
|
xpfBluetooth
|
|
|
|
[Subfeature (IORoot_ cmd tree) "rofi bluetooth"]
|
2022-07-08 20:01:35 -04:00
|
|
|
where
|
2022-12-30 14:58:23 -05:00
|
|
|
cmd = spawnCmd myDmenuBluetooth $ "-c" : themeArgs "#0044bb"
|
2022-07-09 01:02:37 -04:00
|
|
|
tree = dmenuTree $ Only_ $ sysExe [] myDmenuBluetooth
|
2021-11-29 00:56:16 -05:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runVPNMenu :: MonadUnliftIO m => Sometimes (m ())
|
2022-12-30 14:58:23 -05:00
|
|
|
runVPNMenu =
|
|
|
|
Sometimes
|
|
|
|
"VPN selector"
|
|
|
|
xpfVPN
|
|
|
|
[Subfeature (IORoot_ cmd tree) "rofi VPN"]
|
2022-07-08 00:21:05 -04:00
|
|
|
where
|
2022-12-30 14:58:23 -05:00
|
|
|
cmd =
|
|
|
|
spawnCmd myDmenuVPN $
|
|
|
|
["-c"] ++ themeArgs "#007766" ++ myDmenuMatchingArgs
|
|
|
|
tree =
|
|
|
|
dmenuTree $
|
|
|
|
toAnd_ (localExe [] myDmenuVPN) $
|
|
|
|
socketExists "expressVPN" [] $
|
|
|
|
return "/var/lib/expressvpn/expressvpnd.socket"
|
2021-12-15 00:30:18 -05:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runCmdMenu :: MonadUnliftIO m => Sometimes (m ())
|
2021-11-20 19:35:24 -05:00
|
|
|
runCmdMenu = spawnDmenuCmd "command menu" ["-show", "run"]
|
2020-03-28 14:44:50 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runAppMenu :: MonadUnliftIO m => Sometimes (m ())
|
2021-11-20 19:35:24 -05:00
|
|
|
runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
|
2020-03-28 14:44:50 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runWinMenu :: MonadUnliftIO m => Sometimes (m ())
|
2021-11-20 19:35:24 -05:00
|
|
|
runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]
|
2020-03-28 14:44:50 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runNetMenu :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
|
2022-12-30 14:58:23 -05:00
|
|
|
runNetMenu cl =
|
|
|
|
Sometimes
|
|
|
|
"network control menu"
|
|
|
|
enabled
|
|
|
|
[Subfeature root "network control menu"]
|
2022-07-08 00:21:05 -04:00
|
|
|
where
|
2022-08-01 10:47:05 -04:00
|
|
|
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"
|
2022-12-30 14:58:23 -05:00
|
|
|
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
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runAutorandrMenu :: MonadUnliftIO m => Sometimes (m ())
|
2022-07-09 01:02:37 -04:00
|
|
|
runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
|
|
|
|
where
|
|
|
|
cmd = spawnCmd myDmenuMonitors $ themeArgs "#ff0066"
|
|
|
|
tree = dmenuTree $ Only_ $ localExe [] myDmenuMonitors
|
2022-06-26 20:07:25 -04:00
|
|
|
|
2022-07-03 01:11:32 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Password manager
|
2022-07-03 01:11:32 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runBwMenu :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
|
2022-07-08 00:21:05 -04:00
|
|
|
runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
|
|
|
|
where
|
2022-12-30 14:58:23 -05:00
|
|
|
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
|
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Clipboard
|
2022-07-03 01:11:32 -04:00
|
|
|
|
2023-01-02 19:32:12 -05:00
|
|
|
runClipMenu :: MonadUnliftIO m => Sometimes (m ())
|
2022-07-03 01:11:32 -04:00
|
|
|
runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
|
|
|
|
where
|
|
|
|
act = spawnCmd myDmenuCmd args
|
2022-12-30 14:58:23 -05:00
|
|
|
tree =
|
|
|
|
listToAnds
|
|
|
|
dmenuDep
|
|
|
|
[ sysExe clipboardPkgs myClipboardManager
|
|
|
|
, process [] $ T.pack myClipboardManager
|
|
|
|
]
|
|
|
|
args =
|
|
|
|
[ "-modi"
|
|
|
|
, "\"clipboard:greenclip print\""
|
|
|
|
, "-show"
|
|
|
|
, "clipboard"
|
|
|
|
, "-run-command"
|
|
|
|
, "'{cmd}'"
|
|
|
|
]
|
|
|
|
++ themeArgs "#00c44e"
|
2022-07-03 01:11:32 -04:00
|
|
|
|
2022-06-26 20:07:25 -04:00
|
|
|
--------------------------------------------------------------------------------
|
2022-12-30 14:58:23 -05:00
|
|
|
-- Shortcut menu
|
2022-06-26 20:07:25 -04:00
|
|
|
|
2023-01-02 19:44:17 -05:00
|
|
|
runShowKeys
|
|
|
|
:: MonadUnliftIO m
|
|
|
|
=> Always ([((KeyMask, KeySym), NamedAction)] -> m ())
|
2022-12-30 14:58:23 -05:00
|
|
|
runShowKeys =
|
|
|
|
Always "keyboard menu" $
|
|
|
|
Option showKeysDMenu $
|
|
|
|
Always_ $
|
|
|
|
FallbackAlone fallback
|
2022-06-26 20:07:25 -04:00
|
|
|
where
|
|
|
|
-- TODO this should technically depend on dunst
|
2022-12-30 14:58:23 -05:00
|
|
|
fallback =
|
|
|
|
const $
|
|
|
|
spawnNotify $
|
|
|
|
defNoteError {body = Just $ Text "could not display keymap"}
|
2022-06-26 20:07:25 -04:00
|
|
|
|
2023-01-02 19:44:17 -05:00
|
|
|
showKeysDMenu
|
|
|
|
:: MonadUnliftIO m
|
|
|
|
=> SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
|
2022-12-30 14:58:23 -05:00
|
|
|
showKeysDMenu =
|
|
|
|
Subfeature
|
|
|
|
{ sfName = "keyboard shortcut menu"
|
|
|
|
, sfData = IORoot_ showKeys $ Only_ dmenuDep
|
|
|
|
}
|
2022-06-26 20:07:25 -04:00
|
|
|
|
2023-01-02 19:44:17 -05:00
|
|
|
showKeys :: MonadUnliftIO m => [((KeyMask, KeySym), NamedAction)] -> m ()
|
2022-12-29 14:49:06 -05:00
|
|
|
showKeys kbs = do
|
|
|
|
h <- spawnPipe cmd
|
2023-01-02 19:44:17 -05:00
|
|
|
B.hPut h $ BC.unlines $ BC.pack <$> showKm kbs
|
|
|
|
hClose h
|
2022-06-26 20:07:25 -04:00
|
|
|
where
|
2022-12-30 14:58:23 -05:00
|
|
|
cmd =
|
|
|
|
fmtCmd myDmenuCmd $
|
|
|
|
["-dmenu", "-p", "commands"]
|
|
|
|
++ themeArgs "#7f66ff"
|
|
|
|
++ myDmenuMatchingArgs
|