xmonad-config/lib/Internal/DMenu.hs

120 lines
3.6 KiB
Haskell

module Internal.DMenu where
import Shell
import Control.Monad.Reader
import Data.List
import Data.Maybe
import Graphics.X11.Types
import Graphics.X11.Xlib
import Graphics.X11.Xrandr
import System.IO
import XMonad.Core
import XMonad.StackSet
import XMonad.Util.NamedActions
import XMonad.Util.Run
-- | Focus rofi on the current workspace always
-- Apparently xrandr and xinerama order monitors differently, which
-- means they have different indices. Since rofi uses the former and
-- xmonad uses the latter, this function is to figure out the xrandr
-- screen name based on the xinerama screen that is currently in
-- focus. The steps to do this:
-- 1) get the coordinates of the currently focuses xinerama screen
-- 2) get list of Xrandr outputs and filter which ones are connected
-- 3) match the coordinates of the xinerama screen with the xrandr
-- output and return the latter's name (eg "DP-0") which can be
-- fed to Rofi
getMonitorName :: X (Maybe String)
getMonitorName = do
dpy <- asks display
root <- asks theRoot
-- these are the focused screen coordinates according to xinerama
(sx, sy) <- getCoords
io $ do
res <- xrrGetScreenResourcesCurrent dpy root
outputs <- forM res $ \res' ->
forM (xrr_sr_outputs res') $ \output -> do
oi <- xrrGetOutputInfo dpy res' output
case oi of
-- connection: 0 == connected, 1 == disconnected
Just XRROutputInfo { xrr_oi_connection = 0
, xrr_oi_name = name
, xrr_oi_crtc = crtc
} -> do
ci <- xrrGetCrtcInfo dpy res' crtc
return $ (\ci' -> Just (name, xrr_ci_x ci', xrr_ci_y ci'))
=<< ci
_ -> return Nothing
return $ (\(name, _, _) -> Just name)
=<< find (\(_, x, y) -> x == sx && y == sy) . catMaybes
=<< outputs
where
getCoords = do
(Rectangle x y _ _) <- getFocusedScreen
return (fromIntegral x, fromIntegral y)
getFocusedScreen :: X Rectangle
getFocusedScreen = withWindowSet $ return . screenRect . screenDetail . current
myDmenuCmd :: String
myDmenuCmd = "rofi"
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
runShowKeys x = addName "Show Keybindings" $ do
name <- getMonitorName
case name of
Just n -> do
h <- spawnPipe $ cmd n
io $ hPutStr h (unlines $ showKm x)
io $ hClose h
return ()
-- TODO put better error message here
Nothing -> io $ putStrLn "fail"
where cmd name = fmtCmd myDmenuCmd
[ "-dmenu"
, "-m"
, name
, "-p"
, "commands"
, "-theme-str"
, "'#element.selected.normal { background-color: #a200ff; }'"
]
spawnDmenuCmd :: String -> [String] -> X ()
spawnDmenuCmd cmd args = do
name <- getMonitorName
case name of
Just n -> spawnCmd cmd $ ["-m", n] ++ args
Nothing -> io $ putStrLn "fail"
spawnDmenuCmd' :: [String] -> X ()
spawnDmenuCmd' = spawnDmenuCmd myDmenuCmd
runCmdMenu :: X ()
runCmdMenu = spawnDmenuCmd' ["-show", "run"]
runAppMenu :: X ()
runAppMenu = spawnDmenuCmd' ["-show", "drun"]
runClipMenu :: X ()
runClipMenu = spawnDmenuCmd'
[ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
, "-theme-str", "'#element.selected.normal { background-color: #00c44e; }'"
]
runWinMenu :: X ()
runWinMenu = spawnDmenuCmd' ["-show", "window"]
runNetMenu :: X ()
runNetMenu = spawnDmenuCmd "networkmanager_dmenu" []
runDevMenu :: X ()
runDevMenu = spawnDmenuCmd "rofi-devices" []