From 2b698f609f197765b2dcf3e85fcdb2a846c7c9a5 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Mon, 6 Jul 2020 03:06:44 -0400 Subject: [PATCH] ENH export viewports and move rofi monitor awareness to external script --- bin/xmonad.hs | 81 +++++++++++++++++++++----- lib/XMonad/Internal/Command/DMenu.hs | 87 ++++------------------------ lib/XMonad/Internal/DBus/Control.hs | 2 + my-xmonad.cabal | 1 + 4 files changed, 82 insertions(+), 89 deletions(-) diff --git a/bin/xmonad.hs b/bin/xmonad.hs index 5c47d06..0c7e542 100644 --- a/bin/xmonad.hs +++ b/bin/xmonad.hs @@ -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 diff --git a/lib/XMonad/Internal/Command/DMenu.hs b/lib/XMonad/Internal/Command/DMenu.hs index 1b2fa86..4096e15 100644 --- a/lib/XMonad/Internal/Command/DMenu.hs +++ b/lib/XMonad/Internal/Command/DMenu.hs @@ -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" [] diff --git a/lib/XMonad/Internal/DBus/Control.hs b/lib/XMonad/Internal/DBus/Control.hs index eb48390..156b482 100644 --- a/lib/XMonad/Internal/DBus/Control.hs +++ b/lib/XMonad/Internal/DBus/Control.hs @@ -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 () diff --git a/my-xmonad.cabal b/my-xmonad.cabal index 9da1f96..d154119 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -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