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 module Main (main) where
import Control.Concurrent import Control.Concurrent
import Control.Monad (unless)
import Data.List import Data.List
( isPrefixOf ( isPrefixOf
@ -55,8 +56,10 @@ import XMonad.Layout.Renamed
import XMonad.Layout.Tabbed import XMonad.Layout.Tabbed
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Util.Cursor import XMonad.Util.Cursor
import qualified XMonad.Util.ExtensibleState as E
import XMonad.Util.EZConfig import XMonad.Util.EZConfig
import XMonad.Util.NamedActions import XMonad.Util.NamedActions
import XMonad.Util.WorkspaceCompare
main :: IO () main :: IO ()
main = do main = do
@ -104,6 +107,7 @@ runCleanup ts = io $ do
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Startuphook configuration -- | Startuphook configuration
-- TODO add _NET_DESKTOP_VIEWPORTS to _NET_SUPPORTED?
myStartupHook :: X () myStartupHook :: X ()
myStartupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook myStartupHook = setDefaultCursor xC_left_ptr <+> docksStartupHook
<+> startupHook def <+> startupHook def
@ -235,36 +239,85 @@ runHide = sendMessage $ Toggle HIDE
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Loghook configuration -- | 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 -- 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 -- workspace and LAYOUT is the current layout. Each workspace in the brackets is
-- currently visible and the order reflects the physical location of each -- currently visible and the order reflects the physical location of each
-- screen. The "<>" is the workspace that currently has focus. N is the number -- screen. The "<>" is the workspace that currently has focus. N is the number
-- of windows on the current workspace. -- of windows on the current workspace.
myLoghook :: Handle -> X () logXinerama :: Handle -> X ()
myLoghook h = withWindowSet $ io . hPutStrLn h . myWindowSetXinerama logXinerama h = withWindowSet $ \ws -> io
$ hPutStrLn h
myWindowSetXinerama $ unwords
:: LayoutClass layout a1 => $ filter (not . null) [onScreen ws, offScreen ws, sep, layout ws, nWindows ws]
W.StackSet String (layout a1) a2 ScreenId ScreenDetail -> String
myWindowSetXinerama ws =
unwords $ filter (not . null) [onScreen, offScreen, sep, layout, nWindows]
where where
onScreen = xmobarColor hilightFgColor hilightBgColor onScreen ws = xmobarColor hilightFgColor hilightBgColor
$ pad $ pad
$ unwords $ unwords
$ map (fmtTags . W.tag . W.workspace) $ map (fmtTags ws . W.tag . W.workspace)
$ sortBy compareXCoord $ sortBy compareXCoord
$ W.current ws : W.visible ws $ W.current ws : W.visible ws
offScreen = xmobarColor T.backdropFgColor "" offScreen ws = xmobarColor T.backdropFgColor ""
$ unwords $ unwords
$ map W.tag $ map W.tag
$ filter (isJust . W.stack) $ filter (isJust . W.stack)
$ sortOn W.tag $ sortOn W.tag
$ W.hidden ws $ W.hidden ws
sep = xmobarColor T.backdropFgColor "" ":" sep = xmobarColor T.backdropFgColor "" ":"
layout = description $ W.layout $ W.workspace $ W.current ws layout ws = description $ W.layout $ W.workspace $ W.current ws
nWindows = wrap "(" ")" nWindows ws = wrap "(" ")"
$ show $ show
$ length $ length
$ W.integrate' $ W.integrate'
@ -273,7 +326,7 @@ myWindowSetXinerama ws =
$ W.current ws $ W.current ws
hilightBgColor = "#8fc7ff" hilightBgColor = "#8fc7ff"
hilightFgColor = T.blend' 0.5 hilightBgColor T.fgColor 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 then xmobarColor T.fgColor hilightBgColor t
else t else t

View File

@ -14,80 +14,23 @@ module XMonad.Internal.Command.DMenu
import Control.Monad.Reader import Control.Monad.Reader
import Data.List
import Data.Maybe
import Graphics.X11.Types import Graphics.X11.Types
import Graphics.X11.Xlib
import Graphics.X11.Xrandr
import System.IO import System.IO
import XMonad.Core hiding (spawn) import XMonad.Core hiding (spawn)
import XMonad.Internal.Process import XMonad.Internal.Process
import XMonad.Internal.Shell import XMonad.Internal.Shell
import XMonad.StackSet
import XMonad.Util.NamedActions 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 -- | Other internal functions
myDmenuCmd :: String myDmenuCmd :: String
myDmenuCmd = "rofi" myDmenuCmd = "rofi"
spawnDmenuCmd :: String -> [String] -> X () spawnDmenuCmd :: [String] -> X ()
spawnDmenuCmd cmd args = do spawnDmenuCmd = spawnCmd myDmenuCmd
name <- getMonitorName
case name of
Just n -> spawnCmd cmd $ args ++ ["-m", n]
Nothing -> io $ putStrLn "fail"
spawnDmenuCmd' :: [String] -> X ()
spawnDmenuCmd' = spawnDmenuCmd myDmenuCmd
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- | Exported Commands -- | Exported Commands
@ -99,7 +42,7 @@ devSecrets = concatMap (\x -> ["-s", x])
] ]
runDevMenu :: X () runDevMenu :: X ()
runDevMenu = spawnDmenuCmd "rofi-dev" $ devSecrets ++ rofiArgs runDevMenu = spawnCmd "rofi-dev" $ devSecrets ++ rofiArgs
where where
rofiArgs = rofiArgs =
[ "--" [ "--"
@ -108,7 +51,7 @@ runDevMenu = spawnDmenuCmd "rofi-dev" $ devSecrets ++ rofiArgs
] ]
runBwMenu :: X () runBwMenu :: X ()
runBwMenu = spawnDmenuCmd "rofi-bw" runBwMenu = spawnCmd "rofi-bw"
["-c" ["-c"
, "--" , "--"
, "-theme-str" , "-theme-str"
@ -117,29 +60,23 @@ runBwMenu = spawnDmenuCmd "rofi-bw"
runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction runShowKeys :: [((KeyMask, KeySym), NamedAction)] -> NamedAction
runShowKeys x = addName "Show Keybindings" $ do runShowKeys x = addName "Show Keybindings" $ do
name <- getMonitorName (h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
case name of io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
Just n -> do where cmd = fmtCmd myDmenuCmd
(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
[ "-dmenu" [ "-dmenu"
, "-m", name
, "-p", "commands" , "-p", "commands"
, "-theme-str" , "-theme-str"
, "'#element.selected.normal { background-color: #a200ff; }'" , "'#element.selected.normal { background-color: #a200ff; }'"
] ]
runCmdMenu :: X () runCmdMenu :: X ()
runCmdMenu = spawnDmenuCmd' ["-show", "run"] runCmdMenu = spawnDmenuCmd ["-show", "run"]
runAppMenu :: X () runAppMenu :: X ()
runAppMenu = spawnDmenuCmd' ["-show", "drun"] runAppMenu = spawnDmenuCmd ["-show", "drun"]
runClipMenu :: X () runClipMenu :: X ()
runClipMenu = spawnDmenuCmd' runClipMenu = spawnDmenuCmd
[ "-modi", "\"clipboard:greenclip print\"" [ "-modi", "\"clipboard:greenclip print\""
, "-show", "clipboard" , "-show", "clipboard"
, "-run-command", "'{cmd}'" , "-run-command", "'{cmd}'"
@ -147,8 +84,8 @@ runClipMenu = spawnDmenuCmd'
] ]
runWinMenu :: X () runWinMenu :: X ()
runWinMenu = spawnDmenuCmd' ["-show", "window"] runWinMenu = spawnDmenuCmd ["-show", "window"]
runNetMenu :: X () 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.IntelBacklight
import XMonad.Internal.DBus.Screensaver import XMonad.Internal.DBus.Screensaver
-- import XMonad.Internal.DBus.Workspaces
startXMonadService :: IO Client startXMonadService :: IO Client
startXMonadService = do startXMonadService = do
@ -26,6 +27,7 @@ startXMonadService = do
putStrLn "Started xmonad dbus client" putStrLn "Started xmonad dbus client"
exportIntelBacklight client exportIntelBacklight client
exportScreensaver client exportScreensaver client
-- exportWorkspaces client
return client return client
stopXMonadService :: Client -> IO () stopXMonadService :: Client -> IO ()

View File

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