|
| 1 | +{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, LambdaCase #-} |
| 2 | + |
| 3 | +----------------------------------------------------------------------------- |
| 4 | +-- | |
| 5 | +-- Module : XMonad.Layout.PerScreen |
| 6 | +-- Description : Configure layouts based on the screen rectangle. |
| 7 | +-- Copyright : (c) Brandon S. Allbery KF8NH |
| 8 | +-- License : BSD-style (see LICENSE) |
| 9 | +-- |
| 10 | +-- Maintainer : <[email protected]> |
| 11 | +-- Stability : unstable |
| 12 | +-- Portability : unportable |
| 13 | +-- |
| 14 | +-- Configure layouts based on the screen rectangle passed to the layout. |
| 15 | +-- This gives you true per-screen functionality. |
| 16 | +-- |
| 17 | +-- The old PerScreen is now X.L.ByWidth. We re-export it deprecated for |
| 18 | +-- backward compatibility. |
| 19 | +----------------------------------------------------------------------------- |
| 20 | + |
| 21 | +module XMonad.Layout.PerScreen |
| 22 | + ( -- * Usage |
| 23 | + -- $usage |
| 24 | + OnScreen, |
| 25 | + onScreen, |
| 26 | + onScreens, |
| 27 | + -- * Deprecated |
| 28 | + -- $deprecated |
| 29 | + BW.PerScreen, |
| 30 | + ifWider |
| 31 | + ) where |
| 32 | + |
| 33 | +import XMonad |
| 34 | +import qualified XMonad.StackSet as W |
| 35 | + |
| 36 | +import XMonad.Prelude (fromMaybe, fi) |
| 37 | + |
| 38 | +import qualified XMonad.Layout.ByWidth as BW |
| 39 | + |
| 40 | +import Data.List (find) |
| 41 | + |
| 42 | +-- $usage |
| 43 | +-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file: |
| 44 | +-- |
| 45 | +-- > import XMonad.Layout.OnScreen |
| 46 | +-- |
| 47 | +-- and modifying your layoutHook as follows (for example): |
| 48 | +-- |
| 49 | +-- > layoutHook = onScreen 1 (Tall 1 (3/100) (1/2) ||| Full) Full |
| 50 | +-- |
| 51 | +-- Replace any of the layouts with any arbitrarily complicated layout. |
| 52 | +-- 'onScreen' can also be used inside other layout combinators, although the |
| 53 | +-- result may be confusing. |
| 54 | + |
| 55 | +-- | Specify a layout to run on a given screen. |
| 56 | +onScreen :: (LayoutClass l1 a, LayoutClass l2 a) |
| 57 | + => ScreenId -> l1 a -> l2 a -> OnScreen l1 l2 a |
| 58 | +onScreen s = onScreens [s] |
| 59 | + |
| 60 | +-- | Specify a layout to run on a list of screens. |
| 61 | +-- Note that this works by 'ScreenId'. It has a 'Num' instance, so literal |
| 62 | +-- screen numbers will work as expected, but if you use a binding you need |
| 63 | +-- to use the 'S' constructor. |
| 64 | +onScreens :: (LayoutClass l1 a, LayoutClass l2 a) |
| 65 | + => [ScreenId] -> l1 a -> l2 a -> OnScreen l1 l2 a |
| 66 | +onScreens ss l1 l2 = OnScreen ss l1 l2 False -- @@@ is this right? |
| 67 | + |
| 68 | +data OnScreen l1 l2 a = OnScreen [ScreenId] (l1 a) (l2 a) Bool |
| 69 | + deriving (Read, Show) |
| 70 | + |
| 71 | +instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnScreen l1 l2) a where |
| 72 | + runLayout (W.Workspace i p@(OnScreen ss l1 l2 _) ms) r = do |
| 73 | + -- this sucks. |
| 74 | + -- You might think we could use the existing screen detail, but we may be |
| 75 | + -- invoked from 'rescreen' in which case only 'rescreen' and 'windows' |
| 76 | + -- know the new screen layout. So we need to duplicate the 'rescreen' |
| 77 | + -- logic (and pray there's no TOCTOU) to get the current screen rects. |
| 78 | + -- It'd be easier if 'runLayout' were passed the whole 'StackSet' with |
| 79 | + -- 'windows's idea of the current screen rects, but then it wouldn't know |
| 80 | + -- which 'Workspace' to work on… |
| 81 | + which <- withDisplay getCleanedScreenInfo >>= \case |
| 82 | + [] -> trace "OnScreen: no screens?" >> return False |
| 83 | + rs -> return $ maybe 0 fst (find (f r) (zip [0..] rs)) `elem` ss |
| 84 | + where f lr (_,sr) = rect_x lr >= rect_x sr && |
| 85 | + rect_x lr < rect_x sr + fi (rect_width sr) && |
| 86 | + rect_y lr >= rect_y sr && |
| 87 | + rect_y lr < rect_y sr + fi (rect_height sr) |
| 88 | + if which |
| 89 | + then do (wrs, mlt') <- runLayout (W.Workspace i l1 ms) r |
| 90 | + return (wrs, Just $ updateL1 p mlt') |
| 91 | + else do (wrs, mlt') <- runLayout (W.Workspace i l2 ms) r |
| 92 | + return (wrs, Just $ updateL2 p mlt') |
| 93 | + |
| 94 | + handleMessage (OnScreen ss l1 l2 b) m |
| 95 | + | b = handleMessage l1 m >>= maybe (return Nothing) (\nl1 -> return . Just $ OnScreen ss nl1 l2 b) |
| 96 | + | otherwise = handleMessage l2 m >>= maybe (return Nothing) (\nl2 -> return . Just $ OnScreen ss l1 nl2 b) |
| 97 | + |
| 98 | + description (OnScreen _ l1 _ True ) = description l1 |
| 99 | + description (OnScreen _ _ l2 False) = description l2 |
| 100 | + |
| 101 | +updateL1 :: OnScreen l1 l2 a -> Maybe (l1 a) -> OnScreen l1 l2 a |
| 102 | +updateL1 (OnScreen ss l1 l2 _) mlt = OnScreen ss (fromMaybe l1 mlt) l2 True |
| 103 | + |
| 104 | +updateL2 :: OnScreen l1 l2 a -> Maybe (l2 a) -> OnScreen l1 l2 a |
| 105 | +updateL2 (OnScreen ss l1 l2 _) mlt = OnScreen ss l1 (fromMaybe l2 mlt) False |
| 106 | + |
| 107 | +-- $deprecated |
| 108 | +-- Older versions of this module exported an 'ifWidth' layout modifier. This |
| 109 | +-- has been moved to 'XMonad.Layout.ByWidth', but is re-exported for backward |
| 110 | +-- compatibility. It is deprecated and will be removed in favor of 'ByWidth' |
| 111 | +-- in a future release. |
| 112 | + |
| 113 | +ifWider :: (LayoutClass l1 a, LayoutClass l2 a) |
| 114 | + => Dimension -- ^ target screen width |
| 115 | + -> l1 a -- ^ layout to use when the screen is wide enough |
| 116 | + -> l2 a -- ^ layout to use otherwise |
| 117 | + -> BW.PerScreen l1 l2 a |
| 118 | +ifWider = BW.ifWider |
| 119 | +{-# DEPRECATED ifWider "Use XMonad.Layout.ByWidth.ifWider instead" #-} |
0 commit comments