diff --git a/CHANGES.md b/CHANGES.md index 8b75d296b3..22363b9a51 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -81,6 +81,15 @@ ### New Modules + * `XMonad.Layout.IfWidth` + - The `ifWidth` layout modifier from `XMonad.Layout.PerScreen` has been moved + here. It is re-exported by the new `PerScreen` module, but is marked as + deprecated with a pointer to this module. + + * `XMonad.Layout.PerScreen` + - A complete reimplementation that provides proper `onScreen` and `onScreens` + layout modifiers. It also re-exports `ifWidth` for backward compatibility. + * `XMonad.Layout.CenterMainFluid` - A three column layout with main column in the center and two stack column surrounding it. Master window will be on center column and diff --git a/XMonad/Layout/IfWidth.hs b/XMonad/Layout/IfWidth.hs new file mode 100644 index 0000000000..a178dc31e8 --- /dev/null +++ b/XMonad/Layout/IfWidth.hs @@ -0,0 +1,77 @@ +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.IfWidth +-- Description : Configure layouts based on the width of your screen. +-- Copyright : (c) Edward Z. Yang +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- Stability : unstable +-- Portability : unportable +-- +-- Configure layouts based on the width of your screen; use your +-- favorite multi-column layout for wide screens and a full-screen +-- layout for small ones. +----------------------------------------------------------------------------- + +module XMonad.Layout.IfWidth + ( -- * Usage + -- $usage + PerScreen, + ifWider + ) where + +import XMonad +import qualified XMonad.StackSet as W + +import XMonad.Prelude (fromMaybe) + +-- $usage +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: +-- +-- > import XMonad.Layout.ByWidth +-- +-- and modifying your layoutHook as follows (for example): +-- +-- > layoutHook = ifWider 1280 (Tall 1 (3/100) (1/2) ||| Full) Full +-- +-- Replace any of the layouts with any arbitrarily complicated layout. +-- 'ifWider' can also be used inside other layout combinators. +-- +-- For backward compatibility, the type constructor is still called 'PerScreen'. + +ifWider :: (LayoutClass l1 a, LayoutClass l2 a) + => Dimension -- ^ target screen width + -> l1 a -- ^ layout to use when the screen is wide enough + -> l2 a -- ^ layout to use otherwise + -> PerScreen l1 l2 a +ifWider w = PerScreen w False + +data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show) + +-- | Construct new PerScreen values with possibly modified layouts. +mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> + PerScreen l1 l2 a +mkNewPerScreenT (PerScreen w _ lt lf) mlt' = + (\lt' -> PerScreen w True lt' lf) $ fromMaybe lt mlt' + +mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> + PerScreen l1 l2 a +mkNewPerScreenF (PerScreen w _ lt lf) mlf' = + PerScreen w False lt $ fromMaybe lf mlf' + +instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where + runLayout (W.Workspace i p@(PerScreen w _ lt lf) ms) r + | rect_width r > w = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r + return (wrs, Just $ mkNewPerScreenT p mlt') + | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r + return (wrs, Just $ mkNewPerScreenF p mlt') + + handleMessage (PerScreen w bool lt lf) m + | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerScreen w bool nt lf) + | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerScreen w bool lt) + + description (PerScreen _ True l1 _) = description l1 + description (PerScreen _ _ _ l2) = description l2 diff --git a/XMonad/Layout/PerScreen.hs b/XMonad/Layout/PerScreen.hs index b07d7429e4..b5c264fc97 100644 --- a/XMonad/Layout/PerScreen.hs +++ b/XMonad/Layout/PerScreen.hs @@ -3,73 +3,120 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Layout.PerScreen --- Description : Configure layouts based on the width of your screen. --- Copyright : (c) Edward Z. Yang +-- Description : Configure layouts based on the screen rectangle. +-- Copyright : (c) Brandon S. Allbery KF8NH -- License : BSD-style (see LICENSE) -- --- Maintainer : +-- Maintainer : -- Stability : unstable -- Portability : unportable -- --- Configure layouts based on the width of your screen; use your --- favorite multi-column layout for wide screens and a full-screen --- layout for small ones. +-- Configure layouts based on the screen rectangle passed to the layout. +-- This gives you true per-screen functionality. +-- +-- The old PerScreen is now X.L.ByWidth. We re-export it deprecated for +-- backward compatibility. ----------------------------------------------------------------------------- module XMonad.Layout.PerScreen ( -- * Usage -- $usage - PerScreen, + OnScreen, + onScreen, + onScreens, + -- * Deprecated + -- $deprecated + IW.PerScreen, ifWider ) where import XMonad import qualified XMonad.StackSet as W -import XMonad.Prelude (fromMaybe) +import XMonad.Prelude (fromMaybe, fi) + +import qualified XMonad.Layout.IfWidth as IW + +import Data.List (find) -- $usage -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: -- --- > import XMonad.Layout.PerScreen +-- > import XMonad.Layout.OnScreen -- -- and modifying your layoutHook as follows (for example): -- --- > layoutHook = ifWider 1280 (Tall 1 (3/100) (1/2) ||| Full) Full +-- > layoutHook = onScreen 1 (Tall 1 (3/100) (1/2) ||| Full) Full -- -- Replace any of the layouts with any arbitrarily complicated layout. --- ifWider can also be used inside other layout combinators. +-- 'onScreen' can also be used inside other layout combinators, although the +-- result may be confusing. + +-- | Specify a layout to run on a given screen. +onScreen :: (LayoutClass l1 a, LayoutClass l2 a) + => ScreenId -> l1 a -> l2 a -> OnScreen l1 l2 a +onScreen s = onScreens [s] + +-- | Specify a layout to run on a list of screens. +-- Note that this works by 'ScreenId'. It has a 'Num' instance, so literal +-- screen numbers will work as expected, but if you use a binding you need +-- to use the 'S' constructor. +onScreens :: (LayoutClass l1 a, LayoutClass l2 a) + => [ScreenId] -> l1 a -> l2 a -> OnScreen l1 l2 a +onScreens ss l1 l2 = OnScreen ss l1 l2 False + +data OnScreen l1 l2 a = OnScreen [ScreenId] (l1 a) (l2 a) Bool + deriving (Read, Show) + +instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnScreen l1 l2) a where + runLayout (W.Workspace i p@(OnScreen ss l1 l2 _) ms) r = do + which <- withWindowSet $ \ws -> do + let srs = sinfo (W.current ws) : map sinfo (W.visible ws) + f lr (_,sr) = rect_x lr >= rect_x sr && + rect_x lr < rect_x sr + fi (rect_width sr) && + rect_y lr >= rect_y sr && + rect_y lr < rect_y sr + fi (rect_height sr) + sinfo (W.Screen _ sid (SD sd)) = (sid, sd) + return $ maybe 0 fst (find (f r) srs) `elem` ss + if which + then do handleMessage l2 (SomeMessage Hide) + (wrs, mlt') <- runLayout (W.Workspace i l1 ms) r + return (wrs, Just $ updateL1 p mlt') + else do handleMessage l1 (SomeMessage Hide) + (wrs, mlt') <- runLayout (W.Workspace i l2 ms) r + return (wrs, Just $ updateL2 p mlt') + + handleMessage (OnScreen ss l1 l2 b) m + | fromMessage m == Just Hide = do + l1' <- handleMessage l1 m + l2' <- handleMessage l2 m + return $ Just $ OnScreen ss (fromMaybe l1 l1') (fromMaybe l2 l2') b + | fromMessage m == Just ReleaseResources = do + l1' <- handleMessage l1 m + l2' <- handleMessage l2 m + return $ Just $ OnScreen ss (fromMaybe l1 l1') (fromMaybe l2 l2') b + | b = handleMessage l1 m >>= maybe (return Nothing) (\nl1 -> return . Just $ OnScreen ss nl1 l2 b) + | otherwise = handleMessage l2 m >>= maybe (return Nothing) (\nl2 -> return . Just $ OnScreen ss l1 nl2 b) + + description (OnScreen _ l1 _ True ) = description l1 + description (OnScreen _ _ l2 False) = description l2 + +updateL1 :: OnScreen l1 l2 a -> Maybe (l1 a) -> OnScreen l1 l2 a +updateL1 (OnScreen ss l1 l2 _) mlt = OnScreen ss (fromMaybe l1 mlt) l2 True + +updateL2 :: OnScreen l1 l2 a -> Maybe (l2 a) -> OnScreen l1 l2 a +updateL2 (OnScreen ss l1 l2 _) mlt = OnScreen ss l1 (fromMaybe l2 mlt) False + +-- $deprecated +-- Older versions of this module exported an 'ifWidth' layout modifier. This +-- has been moved to 'XMonad.Layout.IfWidth', but is re-exported for backward +-- compatibility. It is deprecated and will be removed in favor of 'IfWidth' +-- in a future release. ifWider :: (LayoutClass l1 a, LayoutClass l2 a) => Dimension -- ^ target screen width -> l1 a -- ^ layout to use when the screen is wide enough -> l2 a -- ^ layout to use otherwise - -> PerScreen l1 l2 a -ifWider w = PerScreen w False - -data PerScreen l1 l2 a = PerScreen Dimension Bool (l1 a) (l2 a) deriving (Read, Show) - --- | Construct new PerScreen values with possibly modified layouts. -mkNewPerScreenT :: PerScreen l1 l2 a -> Maybe (l1 a) -> - PerScreen l1 l2 a -mkNewPerScreenT (PerScreen w _ lt lf) mlt' = - (\lt' -> PerScreen w True lt' lf) $ fromMaybe lt mlt' - -mkNewPerScreenF :: PerScreen l1 l2 a -> Maybe (l2 a) -> - PerScreen l1 l2 a -mkNewPerScreenF (PerScreen w _ lt lf) mlf' = - PerScreen w False lt $ fromMaybe lf mlf' - -instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (PerScreen l1 l2) a where - runLayout (W.Workspace i p@(PerScreen w _ lt lf) ms) r - | rect_width r > w = do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r - return (wrs, Just $ mkNewPerScreenT p mlt') - | otherwise = do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r - return (wrs, Just $ mkNewPerScreenF p mlt') - - handleMessage (PerScreen w bool lt lf) m - | bool = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ PerScreen w bool nt lf) - | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . PerScreen w bool lt) - - description (PerScreen _ True l1 _) = description l1 - description (PerScreen _ _ _ l2) = description l2 + -> IW.PerScreen l1 l2 a +ifWider = IW.ifWider +{-# DEPRECATED ifWider "Use XMonad.Layout.IfWidth.ifWider instead" #-} diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index bc97b5308d..65cf0601b8 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -261,6 +261,7 @@ library XMonad.Layout.HintedTile XMonad.Layout.IM XMonad.Layout.IfMax + XMonad.Layout.IfWidth XMonad.Layout.ImageButtonDecoration XMonad.Layout.IndependentScreens XMonad.Layout.LayoutBuilder