From b30fe4409e50f05f90d050da8dc372e23c60edde Mon Sep 17 00:00:00 2001 From: Jason Creighton Date: Sun, 18 Mar 2007 00:49:04 +0100 Subject: basic xinerama support (depends on Graphics.X11.Xinerama in X11-extras) darcs-hash:20070317234904-b9aa7-ef29cf597970298a24d770ec789f83638390d22a.gz --- Main.hs | 53 +++++++++++++++++++++++++++++++++++------------------ StackSet.hs | 4 ++++ XMonad.hs | 9 ++++++++- 3 files changed, 47 insertions(+), 19 deletions(-) diff --git a/Main.hs b/Main.hs index 2d9f288..d13e7a9 100644 --- a/Main.hs +++ b/Main.hs @@ -14,6 +14,7 @@ -- import Data.List +import Data.Maybe import Data.Bits hiding (rotate) import qualified Data.Map as M @@ -22,6 +23,7 @@ import System.Exit import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras +import Graphics.X11.Xinerama import Control.Monad.State @@ -69,10 +71,13 @@ main = do rootw <- rootWindow dpy dflt wmdelt <- internAtom dpy "WM_DELETE_WINDOW" False wmprot <- internAtom dpy "WM_PROTOCOLS" False + xinesc <- getScreenInfo dpy let st = XState { display = dpy , screen = dflt + , xineScreens = xinesc + , wsOnScreen = M.fromList $ map ((\n -> (n,n)) . fromIntegral . xsi_screen_number) xinesc , theRoot = rootw , wmdelete = wmdelt , wmprotocols = wmprot @@ -176,10 +181,11 @@ handle e@(MappingNotifyEvent {window = w}) = do handle e@(CrossingEvent {window = w, event_type = t}) | t == enterNotify && mode e == notifyNormal && detail e /= notifyInferior = do ws <- gets workspace - if W.member w ws - then setFocus w - else do b <- isRoot w - when b setTopFocus + case W.lookup w ws of + Just n -> do setFocus w + windows $ W.view n + Nothing -> do b <- isRoot w + when b setTopFocus -- left a window, check if we need to focus root handle e@(CrossingEvent {event_type = t}) @@ -217,10 +223,17 @@ handle e = trace (eventName e) -- ignoring refresh :: X () refresh = do ws <- gets workspace - whenJust (W.peek ws) $ \w -> withDisplay $ \d -> do - (sw,sh) <- gets dimensions - io $ do moveResizeWindow d w 0 0 (fromIntegral sw) (fromIntegral sh) -- fullscreen - raiseWindow d w + ws2sc <- gets wsOnScreen + xinesc <- gets xineScreens + forM_ (M.assocs ws2sc) $ \(n, scn) -> + whenJust (listToMaybe $ W.index n ws) $ \w -> withDisplay $ \d -> do + let sc = xinesc !! scn + io $ do moveResizeWindow d w (fromIntegral $ xsi_x_org sc) + (fromIntegral $ xsi_y_org sc) + (fromIntegral $ xsi_width sc) + (fromIntegral $ xsi_height sc) -- fullscreen + raiseWindow d w + whenJust (W.peek ws) setFocus -- | windows. Modify the current window list with a pure function, and refresh windows :: (WorkSpace -> WorkSpace) -> X () @@ -230,16 +243,12 @@ windows f = do ws <- gets workspace trace (show ws) -- log state changes to stderr --- | hide. Hide a list of windows by moving them offscreen. +-- | hide. Hide a window by moving it offscreen. hide :: Window -> X () hide w = withDisplay $ \d -> do (sw,sh) <- gets dimensions io $ moveWindow d w (2*fromIntegral sw) (2*fromIntegral sh) --- | reveal. Expose a list of windows, moving them on screen -reveal :: Window -> X () -reveal w = withDisplay $ \d -> io $ moveWindow d w 0 0 - -- --------------------------------------------------------------------- -- Window operations @@ -312,7 +321,7 @@ tag o = do let m = W.current ws when (n /= m) $ whenJust (W.peek ws) $ \w -> do - hide w + hide w windows $ W.shift n where n = o-1 @@ -320,14 +329,22 @@ tag o = do view :: Int -> X () view o = do ws <- gets workspace + ws2sc <- gets wsOnScreen let m = W.current ws when (n /= m) $ do - mapM_ reveal (W.index n ws) - mapM_ hide (W.index m ws) - windows $ W.view n + -- is the workspace we want to switch to currently visible? + if M.member n ws2sc + then windows $ W.view n + else do + -- This assumes that the current workspace is visible. + -- Is that always going to be true? + let Just curscreen = M.lookup m ws2sc + modify $ \s -> s { wsOnScreen = M.insert n curscreen (M.delete m ws2sc) } + windows $ W.view n + mapM_ hide (W.index m ws) + setTopFocus where n = o-1 - -- | True if window is under management by us isClient :: Window -> X Bool isClient w = liftM (W.member w) (gets workspace) diff --git a/StackSet.hs b/StackSet.hs index 15788bc..1453c97 100644 --- a/StackSet.hs +++ b/StackSet.hs @@ -61,6 +61,10 @@ empty n = StackSet { current = 0 member :: Ord a => a -> StackSet a -> Bool member a w = M.member a (cache w) +-- | /O(log n)/. Looks up the stack that x is in, if it is in the StackSet +lookup :: (Monad m, Ord a) => a -> StackSet a -> m Int +lookup x w = M.lookup x (cache w) + -- | /O(n)/. Number of stacks size :: StackSet a -> Int size = M.size . stacks diff --git a/XMonad.hs b/XMonad.hs index a312089..af4026d 100644 --- a/XMonad.hs +++ b/XMonad.hs @@ -15,7 +15,7 @@ -- module XMonad ( - X, WorkSpace, XState(..),runX, + X, WorkSpace, XState(..), runX, io, withDisplay, isRoot, spawn, trace, whenJust ) where @@ -28,11 +28,18 @@ import System.Posix.Process (executeFile, forkProcess, getProcessStatus) import System.Exit import Graphics.X11.Xlib +import Graphics.X11.Xinerama + +import qualified Data.Map as M + -- | XState, the window manager state. -- Just the display, width, height and a window list data XState = XState { display :: Display , screen :: {-# UNPACK #-} !ScreenNumber + , xineScreens :: {-# UNPACK #-} ![XineramaScreenInfo] + -- a mapping of workspaces to xinerama screen numbers + , wsOnScreen :: {-# UNPACK #-} !(M.Map Int Int) , theRoot :: {-# UNPACK #-} !Window , wmdelete :: {-# UNPACK #-} !Atom , wmprotocols :: {-# UNPACK #-} !Atom -- cgit v1.2.3