Merge pull request #574 from slotThe/only-float

X.L.NoBorders: Add OnlyFloat

CHANGES.md

@@ -582,6 +582,9 @@
 
     - Fixed handling of floating window borders in multihead setups that was
       broken since 0.14.
+      
+    - Added `OnlyFloat` constructor to `Ambiguity` to unconditionally
+      remove all borders on floating windows.
 
   * `XMonad.Hooks.UrgencyHook`
 

XMonad/Layout/NoBorders.hs

@@ -279,6 +279,8 @@ instance SetsAmbiguous Ambiguity where
                         in lr == wr1 && (not . or) vu
                     OnlyLayoutFloat ->
                         lr == wr1
+                    OnlyFloat ->
+                        True
                     _ ->
                         wr1 `R.supersetOf` sr
                 return w1
@@ -288,6 +290,7 @@ instance SetsAmbiguous Ambiguity where
               | Screen <- amb = [w]
               | OnlyScreenFloat <- amb = []
               | OnlyLayoutFloat <- amb = []
+              | OnlyFloat <- amb = []
               | OnlyLayoutFloatBelow <- amb = []
               | OtherIndicated <- amb
               , let nonF = map integrate $ W.current wset : W.visible wset
@@ -326,6 +329,9 @@ data Ambiguity
         -- ^ Focus in an empty screen does not count as ambiguous.
     | OtherIndicated
         -- ^ No borders on full when all other screens have borders.
+    | OnlyFloat
+        -- ^ Remove borders on all floating windows; tiling windows of
+        -- any kinds are not affected.
     | Screen
         -- ^ Borders are never drawn on singleton screens.  With this one you
         -- really need another way such as a statusbar to detect focus.

tests/Instances.hs

@@ -122,6 +122,10 @@ instance Arbitrary RectC where
 instance Arbitrary Rectangle where
   arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
 
+instance Arbitrary RationalRect where
+  arbitrary = RationalRect <$> dim <*> dim <*> dim <*> dim
+   where
+    dim = arbitrary `suchThat` liftM2 (&&) (>= 0) (<= 1)
 
 newtype SizedPositive = SizedPositive Int
     deriving (Eq, Ord, Show, Read)

tests/NoBorders.hs

@@ -1,13 +1,17 @@
+{-# LANGUAGE ViewPatterns    #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# OPTIONS_GHC -Wall #-}
 module NoBorders where
 
+import Instances ()
 import Test.Hspec
+import Test.Hspec.QuickCheck
 
 import qualified Data.Map as M
 
 import XMonad hiding (Screen)
 import qualified XMonad.Layout.NoBorders as NB
+import XMonad.Prelude
 import XMonad.StackSet
 
 spec :: Spec
@@ -39,6 +43,27 @@ spec = do
                 NB.hiddens amb ws r1 s1 [] `shouldBe` [1]
             it "removes border on visible screen" $ do
                 NB.hiddens amb ws r2 s2 [] `shouldBe` [2]
+        prop "prop_OnlyFloat" prop_OnlyFloat
+
+-- | All floating windows should be borderless.
+prop_OnlyFloat
+    :: [Window]       -- ^ Windows on the first monitor
+    -> [Window]       -- ^ Windows on the second monitor
+    -> [RationalRect] -- ^ Floating window rectangles
+    -> Bool           -- ^ Whether to consider focused or visible screen
+    -> Bool
+prop_OnlyFloat (nub -> w1) (nub -> w2) frs b
+     = sort (w `intersect` map fst floats)
+    == sort (NB.hiddens NB.OnlyFloat ws r (differentiate w) [])
+  where
+    (w, w', r) = if b then (w1, w2, r1) else (w2, w1, r2)
+    ws         = wsDualHead (differentiate w1) (differentiate w2) floats
+    floats     = zip (interleave w w') frs
+
+    interleave :: [a] -> [a] -> [a]
+    interleave (x : xs) (y : ys) = x : y : interleave xs ys
+    interleave []       ys       = ys
+    interleave xs       []       = xs
 
 -- +------+------+
 -- |  r1  |  r2  |