ENH export viewports and move rofi monitor awareness to external script
This commit is contained in:
parent
21250b1818
commit
2b698f609f
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 }
|
||||
(h, _, _, _) <- io $ createProcess' $ (shell' cmd) { std_in = CreatePipe }
|
||||
io $ forM_ h $ \h' -> hPutStr h' (unlines $ showKm x) >> hClose h'
|
||||
Nothing -> io $ putStrLn "fail"
|
||||
where cmd name = fmtCmd myDmenuCmd
|
||||
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" []
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue