Merge pull request #242 from orbisvicis/borderControl

Border Control

CHANGES.md

@@ -89,6 +89,24 @@
     - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
       `xmobarRaw`.
 
+  * `XMonad.Layout.NoBorders`
+
+    The layout now maintains a list of windows that never have borders, and a
+    list of windows that always have borders. Use `BorderMessage` to manage
+    these lists and the accompanying event hook (`borderEventHook`) to remove
+    destroyed windows from them. Also provides the `hasBorder` manage hook.
+
+    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
+    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See
+    the documentation for more information.
+
+    The type signature of `hiddens` was changed to accept a new `Rectangle`
+    parameter representing the bounds of the parent layout, placed after the
+    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
+    will need to update their configuration. For example, replace "`hiddens amb
+    wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make
+    use of the new parameter with "`hiddens amb wset lr mst wrs =`".
+
 ### New Modules
 
   * `XMonad.Hooks.RefocusLast`

XMonad/Layout/NoBorders.hs

@@ -4,7 +4,8 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.NoBorders
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- Copyright   :  (c) --    David Roundy <droundy@darcs.net>
+--                    2018  Yclept Nemo
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
@@ -18,25 +19,31 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.NoBorders (
+module XMonad.Layout.NoBorders ( -- * Usage
-                                -- * Usage
+                                 -- $usage
-                                -- $usage
+                                 noBorders
-                                noBorders,
+                               , smartBorders
-                                smartBorders,
+                               , withBorder
-                                withBorder,
+                               , lessBorders
-                                lessBorders,
+                               , hasBorder
-                                SetsAmbiguous(..),
+                               , SetsAmbiguous(..)
-                                Ambiguity(..),
+                               , Ambiguity(..)
-                                With(..),
+                               , With(..)
-                                SmartBorder, WithBorder, ConfigurableBorder,
+                               , BorderMessage (..), borderEventHook
+                               , SmartBorder, WithBorder, ConfigurableBorder
                                ) where
 
-import XMonad
+import           XMonad
-import XMonad.Layout.LayoutModifier
+import           XMonad.Layout.LayoutModifier
-import qualified XMonad.StackSet as W
+import qualified XMonad.StackSet                as W
-import Data.List
+import qualified XMonad.Util.Rectangle          as R
-import qualified Data.Map as M
+
-import Data.Function (on)
+import           Data.List
+import           Data.Monoid
+import qualified Data.Map                       as M
+import           Data.Function                  (on)
+import           Control.Monad                  (guard)
+
 
 -- $usage
 -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
@@ -100,34 +107,94 @@ smartBorders = lessBorders Never
 -- instances
 lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>
         p -> l a -> ModifiedLayout (ConfigurableBorder p) l a
-lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])
+lessBorders amb = ModifiedLayout (ConfigurableBorder amb [] [] [])
 
-data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show)
+-- | 'ManageHook' for sending 'HasBorder' messages:
+--
+-- >    title =? "foo" --> hasBorder True
+--
+-- There is no equivalent for 'ResetBorder'.
+hasBorder :: Bool -> ManageHook
+hasBorder b = ask >>= \w -> liftX (broadcastMessage $ HasBorder b w) >> idHook
+
+data BorderMessage
+    = HasBorder Bool Window
+        -- ^ If @True@, never remove the border from the specified window. If
+        -- @False@, always remove the border from the specified window.
+    | ResetBorder Window
+        -- ^ Reset the effects of any 'HasBorder' messages on the specified
+        -- window.
+    deriving (Typeable)
+
+instance Message BorderMessage
+
+data ConfigurableBorder p w = ConfigurableBorder
+    { _generateHidden :: p
+        -- ^ Generates a list of windows without borders. Uses 'SetsAmbiguous'
+        -- to filter the current layout.
+    , alwaysHidden   :: [w]
+        -- ^ Windows that never have borders. This list is added to the result
+        -- of 'generateHidden'.
+    , neverHidden    :: [w]
+        -- ^ Windows that always have borders - i.e. ignored by this module.
+        -- This list is subtraced from 'alwaysHidden' and so has higher
+        -- precendence.
+    , currentHidden  :: [w]
+        -- ^ The current set of windows without borders, i.e. the state.
+    } deriving (Read, Show)
+
+-- | Only necessary with 'BorderMessage' - remove non-existent windows from the
+-- 'alwaysHidden' or 'neverHidden' lists.
+borderEventHook :: Event -> X All
+borderEventHook (DestroyWindowEvent { ev_window = w }) = do
+    broadcastMessage $ ResetBorder w
+    return $ All True
+borderEventHook _ = return $ All True
 
 instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
-    unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s
+    unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch
 
-    redoLayout (ConfigurableBorder p s) _ mst wrs = do
+    redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do
-        ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
+        let gh' wset = let lh = (hiddens gh wset lr mst wrs)
-        asks (borderWidth . config) >>= setBorders (s \\ ws)
+                       in  return $ (ah `union` lh) \\ nh
-        setBorders ws 0
+        ch' <- withWindowSet gh'
-        return (wrs, Just $ ConfigurableBorder p ws)
+        asks (borderWidth . config) >>= setBorders (ch \\ ch')
+        setBorders ch' 0
+        return (wrs, Just $ cb { currentHidden = ch' })
+
+    pureMess cb@(ConfigurableBorder gh ah nh ch) m
+        | Just (HasBorder b w) <- fromMessage m =
+            let consNewIf l True  = if w `elem` l then Nothing else Just (w:l)
+                consNewIf l False = Just l
+            in  (ConfigurableBorder gh) <$> consNewIf ah (not b)
+                                        <*> consNewIf nh b
+                                        <*> pure ch
+        | Just (ResetBorder w) <- fromMessage m =
+            let delete' e l = if e `elem` l then (True,delete e l) else (False,l)
+                (da,ah') = delete' w ah
+                (dn,nh') = delete' w nh
+            in  if da || dn
+                then Just cb { alwaysHidden = ah', neverHidden = nh' }
+                else Nothing
+        | otherwise = Nothing
 
 -- | SetsAmbiguous allows custom actions to generate lists of windows that
 -- should not have borders drawn through 'ConfigurableBorder'
 --
 -- To add your own (though perhaps those options would better belong as an
--- aditional constructor to 'Ambiguity'), you can add the function as such:
+-- additional constructor to 'Ambiguity'), you can add the following function.
+-- Note that @lr@, the parameter representing the 'Rectangle' of the parent
+-- layout, was added to 'hiddens' in 0.14. Update your instance accordingly.
 --
 -- > data MyAmbiguity = MyAmbiguity deriving (Read, Show)
 --
 -- > instance SetsAmbiguous MyAmbiguity where
--- >  hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat
+-- >  hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat
--- >     where otherHiddens p = hiddens p wset mst wrs
+-- >     where otherHiddens p = hiddens p wset lr mst wrs
 --
 -- The above example is redundant, because you can have the same result with:
 --
--- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )
+-- > layoutHook = lessBorders (Combine Difference Screen OnlyScreenFloat) (Tall 1 0.5 0.03 ||| ... )
 --
 -- To get the same result as 'smartBorders':
 --
@@ -136,32 +203,87 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
 -- This indirect method is required to keep the 'Read' and 'Show' for
 -- ConfigurableBorder so that xmonad can serialize state.
 class SetsAmbiguous p where
-    hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
+    hiddens :: p -> WindowSet -> Rectangle -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
 
+-- Quick overview since the documentation lacks clarity:
+-- * Overall stacking order =
+--      tiled stacking order ++ floating stacking order
+--   Where tiled windows are (obviously) stacked below floating windows.
+-- * Tiled stacking order =
+--      [(window, Rectangle] order
+--   Given by 'XMonad.Core.LayoutClass' where earlier entries are stacked
+--   higher.
+-- * Floating stacking order =
+--      focus order
+--   Given by the workspace stack where a higher focus corresponds to a higher
+--   stacking position.
+--
+-- Integrating a stack returns a list in order of [highest...lowest].
+--
+-- 'XMonad.Core.LayoutClass' is given a stack with all floating windows removed
+-- and returns a list (in stack order) of only the visible tiled windows, while
+-- the workspace stack contains all windows (visible/hidden, floating/tiled) in
+-- focus order. The StackSet 'floating' field maps all floating windows across
+-- all workspaces to relative rectangles - without the associated screen.
+--
+-- 'XMonad.Operations.windows' gets the windowset from the state, mutates it,
+-- then updates the state before calling 'runLayout' with the new windowset -
+-- excluding any floating windows. Aside from the filtering, the stack received
+-- by the layout should be identical to the one received from 'withWindowSet'.
 instance SetsAmbiguous Ambiguity where
-    hiddens amb wset mst wrs
+    hiddens amb wset lr mst wrs
       | Combine Union a b <- amb = on union next a b
       | Combine Difference a b <- amb = on (\\) next a b
       | Combine Intersection a b <- amb = on intersect next a b
       | otherwise = tiled ms ++ floating
-      where next p = hiddens p wset mst wrs
+      where next p = hiddens p wset lr mst wrs
-            nonzerorect (Rectangle _ _ 0 0) = False
+
-            nonzerorect _ = True
+            screens = [ scr | scr <- W.screens wset
+                            , case amb of
+                                    Never -> True
+                                    _     -> not $ null $ integrate scr
+                            , not . R.empty . screenRect
+                                $ W.screenDetail scr
+                            ]
+
+            -- This originally considered all floating windows across all
+            -- workspaces. It seems more efficient to have each layout manage
+            -- its own floating windows - and equally valid though untested
+            -- against a multihead setup. In some cases the previous code would
+            -- redundantly add then remove borders from already-borderless
+            -- windows.
+            floating = do
+                let wz :: Integer -> (Window,Rectangle)
+                       -> (Integer,Window,Rectangle)
+                    wz i (w,wr) = (i,w,wr)
+                    -- For the following: in stacking order lowest -> highest.
+                    ts = reverse . zipWith wz [-1,-2..] $ wrs
+                    fs = zipWith wz [0..] $ do
+                        w       <- reverse . W.index $ wset
+                        Just wr <- [M.lookup w (W.floating wset)]
+                        return (w,scaleRationalRect sr wr)
+                    sr = screenRect . W.screenDetail . W.current $ wset
+                (i1,w1,wr1) <- fs
+                guard $ case amb of
+                    OnlyLayoutFloatBelow ->
+                        let vu = do
+                            gr           <- sr `R.difference` lr
+                            (i2,_w2,wr2) <- ts ++ fs
+                            guard $ i2 < i1
+                            [wr2 `R.intersects` gr]
+                        in lr == wr1 && (not . or) vu
+                    OnlyLayoutFloat ->
+                        lr == wr1
+                    _ ->
+                        wr1 `R.supersetOf` sr
+                return w1
 
-            screens =
-              [ scr | scr <- W.screens wset,
-                      case amb of
-                            Never -> True
-                            _ -> not $ null $ integrate scr,
-                      nonzerorect . screenRect $ W.screenDetail scr]
-            floating = [ w |
-                        (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
-                        px <= 0, py <= 0,
-                        wx + px >= 1, wy + py >= 1]
             ms = filter (`elem` W.integrate' mst) $ map fst wrs
             tiled [w]
               | Screen <- amb = [w]
-              | OnlyFloat <- amb = []
+              | OnlyScreenFloat <- amb = []
+              | OnlyLayoutFloat <- amb = []
+              | OnlyLayoutFloatBelow <- amb = []
               | OtherIndicated <- amb
               , let nonF = map integrate $ W.current wset : W.visible wset
               , length (concat nonF) > length wrs
@@ -174,23 +296,34 @@ instance SetsAmbiguous Ambiguity where
 -- subsequent constructors add additional cases where borders are not drawn
 -- than their predecessors. These behaviors make most sense with with multiple
 -- screens: for single screens, 'Never' or 'smartBorders' makes more sense.
-data Ambiguity = Combine With Ambiguity Ambiguity
+data Ambiguity
-                             -- ^ This constructor is used to combine the
+    = Combine With Ambiguity Ambiguity
-                             -- borderless windows provided by the
+        -- ^ This constructor is used to combine the borderless windows
-                             -- SetsAmbiguous instances from two other
+        -- provided by the SetsAmbiguous instances from two other 'Ambiguity'
-                             -- 'Ambiguity' data types.
+        -- data types.
-               | OnlyFloat   -- ^ Only remove borders on floating windows that
+    | OnlyScreenFloat
-                             -- cover the whole screen
+        -- ^ Only remove borders on floating windows that cover the whole
-               | Never       -- ^ Never remove borders when ambiguous:
+        -- screen.
-                             -- this is the same as smartBorders
+    | OnlyLayoutFloatBelow
-               | EmptyScreen -- ^ Focus in an empty screens does not count as
+        -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window
-                             -- ambiguous.
+        -- stacked below remains visible. Considers all floating windows on the
-               | OtherIndicated
+        -- current screen and all visible tiled windows of the child layout. If
-                             -- ^ No borders on full when all other screens
+        -- any such window (that is stacked below) shows in any gap between the
-                             -- have borders.
+        -- parent layout rectangle and the physical screen, the border will
-               | Screen      -- ^ Borders are never drawn on singleton screens.
+        -- remain drawn.
-                             -- With this one you really need another way such
+    | OnlyLayoutFloat
-                             -- as a statusbar to detect focus.
+        -- ^ Only remove borders on floating windows that exactly cover the
+        -- parent layout rectangle.
+    | Never
+        -- ^ Never remove borders when ambiguous: this is the same as
+        -- smartBorders.
+    | EmptyScreen
+        -- ^ Focus in an empty screen does not count as ambiguous.
+    | OtherIndicated
+        -- ^ No borders on full when all other screens have borders.
+    | Screen
+        -- ^ Borders are never drawn on singleton screens.  With this one you
+        -- really need another way such as a statusbar to detect focus.
     deriving (Read, Show)
 
 -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two