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
|
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
|
||||||
|
|
||||||
|
|
|
@ -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" []
|
||||||
|
|
||||||
|
|
|
@ -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 ()
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue