ENH export viewports and move rofi monitor awareness to external script

This commit is contained in:
Nathan Dwarshuis 2020-07-06 03:06:44 -04:00
parent 21250b1818
commit 2b698f609f
4 changed files with 82 additions and 89 deletions

View File

@ -8,6 +8,7 @@
module Main (main) where
import Control.Concurrent
import Control.Monad (unless)
import Data.List
( isPrefixOf
@ -55,8 +56,10 @@ import XMonad.Layout.Renamed
import XMonad.Layout.Tabbed
import qualified XMonad.StackSet as W
import XMonad.Util.Cursor
import qualified XMonad.Util.ExtensibleState as E
import XMonad.Util.EZConfig
import XMonad.Util.NamedActions
import XMonad.Util.WorkspaceCompare
main :: IO ()
main = do
@ -104,6 +107,7 @@ runCleanup ts = io $ do
--------------------------------------------------------------------------------
-- | Startuphook configuration
-- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
myStartupHook :: X ()
myStartupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook
<+> startupHook def
@ -235,36 +239,85 @@ runHide = sendMessage $ Toggle HIDE
--------------------------------------------------------------------------------
-- | Loghook configuration
--
myLoghook :: Handle -> X ()
myLoghook h = do
logXinerama h
logViewports
-- | Viewports loghook
-- This is all stuff that should probably be added to the EVMH contrib module.
-- Basically, this will send the workspace "viewport" positions to
-- _NET_DESKTOP_VIEWPORT which can be further processed by tools such as
-- 'wmctrl' to figure out which workspaces are on what monitor outside of
-- xmomad. This is more or less the way i3 does this, where the current
-- workspace has a valid position and everything else is just (0, 0). Also, I
-- probably should set the _NET_SUPPORT atom to reflect the existance of
-- _NET_DESKTOP_VIEWPORT, but for now there seems to be no ill effects so why
-- bother...(if that were necessary it would go in the startup hook)
newtype DesktopViewports = DesktopViewports [Int]
deriving Eq
instance ExtensionClass DesktopViewports where
initialValue = DesktopViewports []
logViewports :: X ()
logViewports = withWindowSet $ \s -> do
sort' <- getSortByIndex
let ws = sort' $ W.workspaces s
let desktopViewports = concatMap (wsToViewports s) ws
whenChanged (DesktopViewports desktopViewports) $
setDesktopViewports desktopViewports
where
wsToViewports s w = let cur = W.current s in
if W.tag w == currentTag cur then currentPos cur else [0, 0]
currentTag = W.tag . W.workspace
currentPos = rectXY . screenRect . W.screenDetail
rectXY (Rectangle x y _ _) = [fromIntegral x, fromIntegral y]
setDesktopViewports :: [Int] -> X ()
setDesktopViewports vps = withDisplay $ \dpy -> do
r <- asks theRoot
a <- getAtom "_NET_DESKTOP_VIEWPORT"
c <- getAtom "CARDINAL"
io $ changeProperty32 dpy r a c propModeReplace $ map fromIntegral vps
-- stolen from XMonad.Hooks.EwmhDesktops
whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
whenChanged v action = do
v0 <- E.get
unless (v == v0) $ do
action
E.put v
-- | Xinerama loghook (for xmobar)
-- The format will be like "[<1> 2 3] 4 5 | LAYOUT (N)" where each digit is the
-- workspace and LAYOUT is the current layout. Each workspace in the brackets is
-- currently visible and the order reflects the physical location of each
-- screen. The "<>" is the workspace that currently has focus. N is the number
-- of windows on the current workspace.
myLoghook :: Handle -> X ()
myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama
myWindowSetXinerama
:: LayoutClass layout a1 =>
W.StackSet String (layout a1) a2 ScreenId ScreenDetail -> String
myWindowSetXinerama ws =
unwords $ filter (not . null) [onScreen, offScreen, sep, layout, nWindows]
logXinerama :: Handle -> X ()
logXinerama h = withWindowSet $ \ws -> io
$ hPutStrLn h
$ unwords
$ filter (not . null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
where
onScreen = xmobarColor hilightFgColor hilightBgColor
onScreen ws = xmobarColor hilightFgColor hilightBgColor
$ pad
$ unwords
$ map (fmtTags . W.tag . W.workspace)
$ map (fmtTags ws . W.tag . W.workspace)
$ sortBy compareXCoord
$ W.current ws : W.visible ws
offScreen = xmobarColor T.backdropFgColor ""
offScreen ws = xmobarColor T.backdropFgColor ""
$ unwords
$ map W.tag
$ filter (isJust . W.stack)
$ sortOn W.tag
$ W.hidden ws
sep = xmobarColor T.backdropFgColor "" ":"
layout = description $ W.layout $ W.workspace $ W.current ws
nWindows = wrap "(" ")"
layout ws = description $ W.layout $ W.workspace $ W.current ws
nWindows ws = wrap "(" ")"
$ show
$ length
$ W.integrate'
@ -273,7 +326,7 @@ myWindowSetXinerama ws =
$ W.current ws
hilightBgColor = "#8fc7ff"
hilightFgColor = T.blend' 0.5 hilightBgColor T.fgColor
fmtTags t = if t == W.currentTag ws
fmtTags ws t = if t == W.currentTag ws
then xmobarColor T.fgColor hilightBgColor t
else t

View File

@ -14,80 +14,23 @@ module XMonad.Internal.Command.DMenu
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 hiding (spawn)
import XMonad.Internal.Process
import XMonad.Internal.Shell
import XMonad.StackSet
import XMonad.Util.NamedActions
--------------------------------------------------------------------------------
-- | Fix rofi screen indexing limitations
--
-- Apparently xrandr and xinerama order monitors differently, which means they
-- have different indices. Since rofi uses the former and xmonad uses the
-- latter, these functions 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
--------------------------------------------------------------------------------
-- | Other internal functions
myDmenuCmd :: String
myDmenuCmd = "rofi"
spawnDmenuCmd :: String -> [String] -> X ()
spawnDmenuCmd cmd args = do
name <- getMonitorName
case name of
Just n -> spawnCmd cmd $ args ++ ["-m", n]
Nothing -> io $ putStrLn "fail"
spawnDmenuCmd' :: [String] -> X ()
spawnDmenuCmd' = spawnDmenuCmd myDmenuCmd
spawnDmenuCmd :: [String] -> X ()
spawnDmenuCmd = spawnCmd myDmenuCmd
--------------------------------------------------------------------------------
-- | Exported Commands
@ -99,7 +42,7 @@ devSecrets = concatMap (\x -> ["-s", x])
]
runDevMenu :: X ()
runDevMenu = spawnDmenuCmd "rofi-dev" $ devSecrets ++ rofiArgs
runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs
where
rofiArgs =
[ "--"
@ -108,7 +51,7 @@ runDevMenu = spawnDmenuCmd "rofi-dev" $ devSecrets ++ rofiArgs
]
runBwMenu :: X ()
runBwMenu = spawnDmenuCmd "rofi-bw"
runBwMenu = spawnCmd "rofi-bw"
["-c"
, "--"
, "-theme-str"
@ -117,29 +60,23 @@ runBwMenu = spawnDmenuCmd "rofi-bw"
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
runShowKeys x = addName "Show Keybindings" $ do
name <- getMonitorName
case name of
Just n -> do
(h, _, _, _) <- io $ createProcess' $ (shell' $ cmd n)
{ std_in = CreatePipe }
io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
Nothing -> io $ putStrLn "fail"
where cmd name = fmtCmd myDmenuCmd
(h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
where cmd = fmtCmd myDmenuCmd
[ "-dmenu"
, "-m", name
, "-p", "commands"
, "-theme-str"
, "'#element.selected.normal { background-color: #a200ff; }'"
]
runCmdMenu :: X ()
runCmdMenu = spawnDmenuCmd' ["-show", "run"]
runCmdMenu = spawnDmenuCmd ["-show", "run"]
runAppMenu :: X ()
runAppMenu = spawnDmenuCmd' ["-show", "drun"]
runAppMenu = spawnDmenuCmd ["-show", "drun"]
runClipMenu :: X ()
runClipMenu = spawnDmenuCmd'
runClipMenu = spawnDmenuCmd
[ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard"
, "-run-command", "'{cmd}'"
@ -147,8 +84,8 @@ runClipMenu = spawnDmenuCmd'
]
runWinMenu :: X ()
runWinMenu = spawnDmenuCmd' ["-show", "window"]
runWinMenu = spawnDmenuCmd ["-show", "window"]
runNetMenu :: X ()
runNetMenu = spawnDmenuCmd "networkmanager_dmenu" []
runNetMenu = spawnCmd "networkmanager_dmenu" []

View File

@ -13,6 +13,7 @@ import DBus.Client
import XMonad.Internal.DBus.IntelBacklight
import XMonad.Internal.DBus.Screensaver
-- import XMonad.Internal.DBus.Workspaces
startXMonadService :: IO Client
startXMonadService = do
@ -26,6 +27,7 @@ startXMonadService = do
putStrLn "Started xmonad dbus client"
exportIntelBacklight client
exportScreensaver client
-- exportWorkspaces client
return client
stopXMonadService :: Client -> IO ()

View File

@ -18,6 +18,7 @@ library
, XMonad.Internal.DBus.IntelBacklight
, XMonad.Internal.DBus.Control
, XMonad.Internal.DBus.Screensaver
, XMonad.Internal.DBus.Workspaces
, XMonad.Internal.Process
, Xmobar.Plugins.Bluetooth
, Xmobar.Plugins.Device