ENH export viewports and move rofi monitor awareness to external script

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 ()
+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
-    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
+    layout ws = description $ W.layout $ W.workspace $ W.current ws
-    nWindows = wrap "(" ")"
+    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
 

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 :: [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
@@ -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
+  (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"
-          , "-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" []
 

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 ()

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