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

--------------------------------------------------------------------------------
-- | Dmenu (Rofi) Commands

module XMonad.Internal.Command.DMenu
  ( runCmdMenu
  , runAppMenu
  , runClipMenu
  , runWinMenu
  , runNetMenu
  , runDevMenu
  , runBwMenu
  , runShowKeys
  , runAutorandrMenu
  ) where

import           Control.Monad.Reader

import           Graphics.X11.Types

import           System.Directory         (XdgDirectory (..), getXdgDirectory)
import           System.IO

import           XMonad.Core              hiding (spawn)
import           XMonad.Internal.Notify
import           XMonad.Internal.Process
import           XMonad.Internal.Shell
import           XMonad.Util.NamedActions

--------------------------------------------------------------------------------
-- | DMenu executables

myDmenuCmd :: String
myDmenuCmd = "rofi"

myDmenuDevices :: String
myDmenuDevices = "rofi-dev"

myDmenuPasswords :: String
myDmenuPasswords = "rofi-bw"

myDmenuMonitors :: String
myDmenuMonitors = "rofi-autorandr"

myDmenuNetworks :: String
myDmenuNetworks = "networkmanager_dmenu"

--------------------------------------------------------------------------------
-- | Other internal functions

spawnDmenuCmd :: [String] -> IO MaybeX
spawnDmenuCmd = spawnCmdIfInstalled myDmenuCmd

themeArgs :: String -> [String]
themeArgs hexColor =
  [ "-theme-str"
  , "'#element.selected.normal { background-color: " ++ hexColor ++ "; }'"
  ]

myDmenuMatchingArgs :: [String]
myDmenuMatchingArgs = ["-i"] -- case insensitivity

--------------------------------------------------------------------------------
-- | Exported Commands

runDevMenu :: IO MaybeX
runDevMenu = runIfInstalled [Required myDmenuDevices] $ do
  c <- io $ getXdgDirectory XdgConfig "rofi/devices.yml"
  spawnCmd myDmenuDevices
    $ ["-c", c]
    ++ "--" : themeArgs "#999933"
    ++ myDmenuMatchingArgs

runBwMenu :: IO MaybeX
runBwMenu = runIfInstalled [Required myDmenuPasswords] $
  spawnCmd myDmenuPasswords $ ["-c", "--"] ++ themeArgs "#bb6600" ++ myDmenuMatchingArgs

runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
runShowKeys x = addName "Show Keybindings" $ do
  s <- io $ runDMenuShowKeys x
  ifInstalled s
    $ spawnNotify
    $ defNoteError { body = Just $ Text "could not display keymap" }

runDMenuShowKeys :: [((KeyMask, KeySym), NamedAction)] -> IO MaybeX
runDMenuShowKeys kbs = runIfInstalled [Required myDmenuCmd] $ 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 "#a200ff" ++ myDmenuMatchingArgs

runCmdMenu :: IO MaybeX
runCmdMenu = spawnDmenuCmd ["-show", "run"]

runAppMenu :: IO MaybeX
runAppMenu = spawnDmenuCmd ["-show", "drun"]

-- TODO this also depends on greenclip
runClipMenu :: IO MaybeX
runClipMenu = spawnDmenuCmd $
  [ "-modi", "\"clipboard:greenclip print\""
  , "-show", "clipboard"
  , "-run-command", "'{cmd}'"
  ] ++ themeArgs "#00c44e"

runWinMenu :: IO MaybeX
runWinMenu = spawnDmenuCmd ["-show", "window"]

runNetMenu :: IO MaybeX
runNetMenu = spawnCmdIfInstalled myDmenuNetworks $ themeArgs "#ff3333"

runAutorandrMenu :: IO MaybeX
runAutorandrMenu = spawnCmdIfInstalled myDmenuMonitors $ themeArgs "#ff0066"