120 lines
3.6 KiB
Haskell
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" []
|