Merge branch 'master' into rectangle

CHANGES.md

@@ -4,6 +4,26 @@
 
 ### Breaking Changes
 
+  * `XMonad.Layout.Spacing`
+
+    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
+    of four sides each with its own border width. The screen and window borders
+    are now separate and can be independently toggled on/off. The screen border
+    examines the window/rectangle list resulting from 'runLayout' rather than
+    the stack, which makes it compatible with layouts such as the builtin
+    `Full`. The child layout will always be called with the screen border. If
+    only a single window is displayed (and `smartBorder` enabled), it will be
+    expanded into the original layout rectangle. Windows that are displayed but
+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',
+    will be shifted out of the way, but not scaled (not possible for windows
+    created by XMonad). This isn't perfect, so you might want to disable
+    `Spacing` on such layouts.
+
+  * `XMonad.Util.SpawnOnce`
+
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
+      to shift spawned windows to a specific workspace.
+
   * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
 
   * `XMonad.Actions.GridSelect`
@@ -64,8 +84,22 @@
     - Handle workspace renames that might be occuring in the custom function
       that is provided to ewmhDesktopsLogHookCustom.
 
+  * `XMonad.Hooks.DynamicLog`
+
+    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
+      `xmobarRaw`.
+
 ### New Modules
 
+  * `XMonad.Layout.StateFull`
+
+    Provides StateFull: a stateful form of Full that does not misbehave when
+    floats are focused, and the FocusTracking layout transformer by means of
+    which StateFull is implemented. FocusTracking simply holds onto the last
+    true focus it was given and continues to use it as the focus for the
+    transformed layout until it sees another. It can be used to improve the
+    behaviour of a child layout that has not been given the focused window.
+
   * `XMonad.Hooks.Focus`
 
     A new module extending ManageHook EDSL to work on focused windows and
@@ -112,6 +146,15 @@
 
     A new module for handling pixel rectangles.
 
+  * `XMonad.Layout.BinaryColumn`
+
+    A new module which provides a simple grid layout, halving the window
+    sizes of each window after master.
+
+    This is similar to Column, but splits the window in a way
+    that maintains window sizes upon adding & removing windows as well as the
+    option to specify a minimum window size.
+
 ### Bug Fixes and Minor Changes
 
   * XMonad.Hooks.FadeWindows
@@ -134,6 +177,11 @@
     Added `sideNavigation` and a parameterised variant, providing a navigation
     strategy with fewer quirks for tiled layouts using X.L.Spacing.
 
+  * `XMonad.Layout.Fullscreen`
+    
+    The fullscreen layouts will now not render any window that is totally
+    obscured by fullscreen windows.
+    
   * `XMonad.Layout.Gaps`
 
     Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
@@ -262,6 +310,11 @@
     `lineCount` to enable a second (slave) window that displays lines beyond
     the initial (title) one.
 
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added optional `ppVisibleNoWindows` to differentiate between empty
+      and non-empty visible workspaces in pretty printing.
+
 ## 0.13 (February 10, 2017)
 
 ### Breaking Changes

XMonad/Config/Saegesser.hs

@@ -0,0 +1,79 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+---------------------------------------------------------------------
+-- |
+-- A mostly striped down configuration that demonstrates spawnOnOnce
+--
+---------------------------------------------------------------------
+import System.IO
+
+import XMonad
+
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Hooks.UrgencyHook
+import XMonad.Hooks.FadeInactive
+
+import XMonad.Layout.NoBorders
+import XMonad.Layout.ResizableTile
+import XMonad.Layout.Mosaic
+
+import XMonad.Util.Run
+import XMonad.Util.Cursor
+import XMonad.Util.NamedScratchpad
+import XMonad.Util.Scratchpad
+import XMonad.Util.SpawnOnce
+
+import XMonad.Actions.CopyWindow
+import XMonad.Actions.SpawnOn
+
+import qualified XMonad.StackSet as W
+
+main = do
+  myStatusBarPipe <- spawnPipe "xmobar"
+  xmonad $ docks $ withUrgencyHook NoUrgencyHook $ def
+    { terminal          = "xterm"
+    , workspaces        = myWorkspaces
+    , layoutHook        = myLayoutHook
+    , manageHook        = myManageHook <+> manageSpawn
+    , startupHook       = myStartupHook
+    , logHook           = myLogHook myStatusBarPipe
+    , focusFollowsMouse = False
+    }
+
+myManageHook = composeOne
+  [ isDialog                     -?> doFloat
+  , className =? "trayer"        -?> doIgnore
+  , className =? "Skype"         -?> doShift "chat"
+  , appName   =? "libreoffice"   -?> doShift "office"
+  , return True                  -?> doF W.swapDown
+  ]
+
+myWorkspaces = [ "web", "emacs", "chat", "vm", "office", "media", "xterms", "8", "9", "0"]
+
+myStartupHook = do
+  setDefaultCursor xC_left_ptr
+  spawnOnOnce "emacs" "emacs"
+  spawnNOnOnce 4 "xterms" "xterm"
+
+myLayoutHook = smartBorders $ avoidStruts $ standardLayouts
+  where standardLayouts = tiled ||| mosaic 2 [3,2]  ||| Mirror tiled ||| Full
+        tiled = ResizableTall nmaster delta ratio []
+        nmaster = 1
+        delta = 0.03
+        ratio = 0.6
+
+myLogHook p =  do
+  copies <- wsContainingCopies
+  let check ws | ws == "NSP" = ""                               -- Hide the scratchpad workspace
+               | ws `elem` copies = xmobarColor "red" "black" $ ws  -- Workspaces with copied windows are red on black
+               | otherwise = ws
+  dynamicLogWithPP $ xmobarPP { ppHidden = check
+                              , ppOutput = hPutStrLn p
+                              , ppUrgent = xmobarColor "white" "red"
+                              , ppTitle  = xmobarColor "green" "" . shorten 180
+                              }
+  fadeInactiveLogHook 0.6
+

XMonad/Hooks/DynamicLog.hs

@@ -43,8 +43,8 @@ module XMonad.Hooks.DynamicLog (
 
     -- * Formatting utilities
     wrap, pad, trim, shorten,
-    xmobarColor, xmobarStrip,
+    xmobarColor, xmobarAction, xmobarRaw,
-    xmobarStripTags,
+    xmobarStrip, xmobarStripTags,
     dzenColor, dzenEscape, dzenStrip,
 
     -- * Internal formatting functions
@@ -62,7 +62,7 @@ import Codec.Binary.UTF8.String (encodeString)
 import Control.Monad (liftM2, msum)
 import Data.Char ( isSpace, ord )
 import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
-import Data.Maybe ( isJust, catMaybes, mapMaybe )
+import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
 import Data.Ord ( comparing )
 import qualified Data.Map as M
 import qualified XMonad.StackSet as S
@@ -320,7 +320,8 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
          fmt w = printer pp (S.tag w)
           where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent
                         | S.tag w == this                                               = ppCurrent
-                        | S.tag w `elem` visibles                                       = ppVisible
+                        | S.tag w `elem` visibles && isJust (S.stack w)                 = ppVisible
+                        | S.tag w `elem` visibles                                       = liftM2 fromMaybe ppVisible ppVisibleNoWindows
                         | isJust (S.stack w)                                            = ppHidden
                         | otherwise                                                     = ppHiddenNoWindows
 
@@ -417,6 +418,31 @@ xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
 xmobarColor fg bg = wrap t "</fc>"
  where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
 
+-- | Encapsulate text with an action. The text will be displayed, and the
+-- action executed when the displayed text is clicked. Illegal input is not
+-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
+-- syntax wherein the command is surrounded by backticks.
+xmobarAction :: String
+                -- ^ Command. Use of backticks (`) will cause a parse error.
+             -> String
+                -- ^ Buttons 1-5, such as "145". Other characters will cause a
+                -- parse error.
+             -> String
+                -- ^ Displayed/wrapped text.
+             -> String
+xmobarAction command button = wrap l r
+    where
+        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
+        r = "</action>"
+
+-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
+-- wrapped (perhaps from window titles) will be displayed only, with all tags
+-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
+-- to shorten the result.
+xmobarRaw :: String -> String
+xmobarRaw "" = ""
+xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]
+
 -- ??? add an xmobarEscape function?
 
 -- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
@@ -460,6 +486,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
                -- contain windows
              , ppHiddenNoWindows :: WorkspaceId -> String
                -- ^ how to print tags of empty hidden workspaces
+             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
+               -- ^ how to print tags of empty visible workspaces
              , ppUrgent :: WorkspaceId -> String
                -- ^ format to be applied to tags of urgent workspaces.
              , ppSep :: String
@@ -512,6 +540,7 @@ instance Default PP where
                , ppVisible         = wrap "<" ">"
                , ppHidden          = id
                , ppHiddenNoWindows = const ""
+               , ppVisibleNoWindows= Nothing
                , ppUrgent          = id
                , ppSep             = " : "
                , ppWsSep           = " "

XMonad/Layout/BinaryColumn.hs

@@ -0,0 +1,139 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.BinaryColumn
+-- Copyright   :  (c) 2009 Ilya Portnov, (c) 2018 Campbell Barton
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Campbell Barton <ideasman42@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides Column layout that places all windows in one column.
+-- Each window is half the height of the previous,
+-- except for the last pair of windows.
+--
+-- Note: Originally based on 'XMonad.Layout.Column' with changes:
+--
+-- * Adding/removing windows doesn't resize all other windows.
+-- (last window pair exception).
+-- * Minimum window height option.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.BinaryColumn (
+                             -- * Usage
+                             -- $usage
+                             BinaryColumn (..)
+                            ) where
+import XMonad
+import qualified XMonad.StackSet
+import qualified Data.List
+
+-- $usage
+-- This module defines layout named BinaryColumn.
+-- It places all windows in one column.
+-- Windows heights are calculated to prevent window resizing whenever
+-- a window is added or removed.
+-- This is done by keeping the last two windows in the stack the same height.
+--
+-- You can use this module by adding following in your @xmonad.hs@:
+--
+-- > import XMonad.Layout.BinaryColumn
+--
+-- Then add layouts to your layoutHook:
+--
+-- > myLayoutHook = BinaryColumn 1.0 32 ||| ...
+--
+-- The first value causes the master window to take exactly half of the screen,
+-- the second ensures that windows are no less than 32 pixels tall.
+--
+-- Shrink/Expand can be used to adjust the first value by increments of 0.1.
+--
+-- * 2.0 uses all space for the master window
+-- (minus the space for windows which get their fixed height).
+-- * 0.0 gives an evenly spaced grid.
+-- Negative values reverse the sizes so the last
+-- window in the stack becomes larger.
+--
+
+data BinaryColumn a = BinaryColumn Float Int
+  deriving (Read, Show)
+
+instance XMonad.LayoutClass BinaryColumn a where
+  pureLayout = columnLayout
+  pureMessage = columnMessage
+
+columnMessage :: BinaryColumn a -> SomeMessage -> Maybe (BinaryColumn a)
+columnMessage (BinaryColumn q min_size) m = fmap resize (fromMessage m)
+  where
+    resize Shrink = BinaryColumn (max (-2.0) (q - 0.1)) min_size
+    resize Expand = BinaryColumn (min   2.0  (q + 0.1)) min_size
+
+columnLayout :: BinaryColumn a
+  -> XMonad.Rectangle
+  -> XMonad.StackSet.Stack a
+  -> [(a, XMonad.Rectangle)]
+columnLayout (BinaryColumn scale min_size) rect stack = zip ws rects
+  where
+    ws = XMonad.StackSet.integrate stack
+    n = length ws
+    scale_abs = abs scale
+    heights_noflip =
+      let
+        -- Regular case: check for min size.
+        f n size div False = let
+          n_fl = (fromIntegral n)
+          n_prev_fl = (fromIntegral (n + 1))
+          div_test = min (div) (n_prev_fl)
+          value_test = (toInteger (round ((fromIntegral size) / div_test)))
+          value_max = size - (toInteger (min_size * n))
+          (value, divide_next, no_room) =
+            if value_test < value_max then
+              (value_test, div, False)
+            else
+              (value_max, n_fl, True)
+          size_next = size - value
+          n_next = n - 1
+          in value
+          : f n_next size_next divide_next no_room
+        -- Fallback case: when windows have reached min size
+        -- simply create an even grid with the remaining space.
+        f n size div True = let
+          n_fl = (fromIntegral n)
+          value_even = ((fromIntegral size) / div)
+          value = (toInteger (round value_even))
+
+          n_next = n - 1
+          size_next = size - value
+          divide_next = n_fl
+          in value
+          : f n_next size_next n_fl True
+        -- Last item: included twice.
+        f 0 size div no_room_prev =
+          [size];
+      in f
+         n_init size_init divide_init False
+      where
+        n_init = n - 1
+        size_init = (toInteger (rect_height rect))
+        divide_init =
+          if scale_abs == 0.0 then
+            (fromIntegral n)
+          else
+            (1.0 / (0.5 * scale_abs))
+
+    heights =
+      if (scale < 0.0) then
+        Data.List.reverse (take n heights_noflip)
+      else
+        heights_noflip
+
+    ys = [fromIntegral $ sum $ take k heights | k <- [0..n - 1]]
+    rects = map (mkRect rect) $ zip heights ys
+
+mkRect :: XMonad.Rectangle
+  -> (Integer,XMonad.Position)
+  -> XMonad.Rectangle
+mkRect (XMonad.Rectangle xs ys ws _) (h, y) =
+  XMonad.Rectangle xs (ys + fromIntegral y) ws (fromInteger h)

XMonad/Layout/Fullscreen.hs

@@ -109,7 +109,7 @@ instance LayoutModifier FullscreenFull Window where
   pureModifier (FullscreenFull frect fulls) rect _ list =
     (map (flip (,) rect') visfulls ++ rest, Nothing)
     where visfulls = intersect fulls $ map fst list
-          rest = filter (flip notElem visfulls . fst) list
+          rest = filter (not . (flip elem visfulls `orP` covers rect')) list
           rect' = scaleRationalRect rect frect
 
 instance LayoutModifier FullscreenFocus Window where
@@ -122,7 +122,7 @@ instance LayoutModifier FullscreenFocus Window where
   pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
      | f `elem` fulls = ((f, rect') : rest, Nothing)
      | otherwise = (list, Nothing)
-     where rest = filter ((/= f) . fst) list
+     where rest = filter (not . ((== f) `orP` covers rect')) list
            rect' = scaleRationalRect rect frect
   pureModifier _ _ Nothing list = (list, Nothing)
 
@@ -240,3 +240,15 @@ fullscreenManageHook' isFull = isFull --> do
     sendMessageWithNoRefresh FullscreenChanged cw
   idHook
 
+-- | True iff one rectangle completely contains another.
+covers :: Rectangle -> Rectangle -> Bool
+(Rectangle x1 y1 w1 h1) `covers` (Rectangle x2 y2 w2 h2) =
+  let fi = fromIntegral
+      in x1 <= x2 &&
+         y1 <= y2 &&
+         x1 + fi w1 >= x2 + fi w2 &&
+         y1 + fi h1 >= y2 + fi h2
+
+-- | Applies a pair of predicates to a pair of operands, combining them with ||.
+orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
+orP f g (x, y) = f x || g y

XMonad/Layout/Spacing.hs

@@ -1,139 +1,341 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Spacing
--- Copyright   :  (c) Brent Yorgey
+-- Copyright   :  (C) --   Brent Yorgey
+--                    2018 Yclept Nemo
 -- License     :  BSD-style (see LICENSE)
 --
 -- Maintainer  :  <byorgey@gmail.com>
 -- Stability   :  unstable
--- Portability :  portable
+-- Portability :  unportable
 --
 -- Add a configurable amount of space around windows.
 --
 -- Note: For space\/gaps along edges of the /screen/ see "XMonad.Layout.Gaps".
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.Spacing (
+module XMonad.Layout.Spacing
-                               -- * Usage
+    ( -- * Usage
       -- $usage
-
+      Border (..)
-                               spacing, Spacing,
+    , Spacing (..)
-                               spacingWithEdge, SpacingWithEdge,
+    , ModifySpacing (..)
-                               smartSpacing, SmartSpacing,
+    , spacingRaw
-                               smartSpacingWithEdge, SmartSpacingWithEdge,
+    , setSmartSpacing
-                               ModifySpacing(..), setSpacing, incSpacing
+    , setScreenSpacing, setScreenSpacingEnabled
+    , setWindowSpacing, setWindowSpacingEnabled
+    , toggleSmartSpacing
+    , toggleScreenSpacingEnabled
+    , toggleWindowSpacingEnabled
+    , incWindowSpacing, incScreenSpacing
+    , decWindowSpacing, decScreenSpacing
+    , borderIncrementBy
+      -- * Backwards Compatibility
+      -- $backwardsCompatibility
+    , spacing, spacingWithEdge
+    , smartSpacing, smartSpacingWithEdge
+    , setSpacing, incSpacing
     ) where
 
-import Graphics.X11 (Rectangle(..))
+import           XMonad
-import Control.Arrow (second)
+import           XMonad.StackSet                as W
-import XMonad.Operations (sendMessage)
-import XMonad.Core (X,runLayout,Message,fromMessage,Typeable)
-import XMonad.StackSet (up, down, Workspace(..))
-import XMonad.Util.Font (fi)
-
 import           XMonad.Layout.LayoutModifier
+import qualified XMonad.Util.Rectangle          as R
+
 
 -- $usage
--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@
+-- file:
 --
 -- > import XMonad.Layout.Spacing
 --
 -- and modifying your layoutHook as follows (for example):
 --
--- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2)
+-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $
--- >                      -- put a 2px space around every window
+-- >              layoutHook def
+
+-- | Represent the borders of a rectangle.
+data Border = Border
+    { top       :: Integer
+    , bottom    :: Integer
+    , right     :: Integer
+    , left      :: Integer
+    } deriving (Show,Read)
+
+-- | A 'LayoutModifier' providing customizable screen and window borders.
+-- Borders are clamped to @[0,Infinity]@ before being applied.
+data Spacing a = Spacing
+    { smartBorder           :: Bool
+        -- ^ When @True@ borders are not applied if
+        --   there fewer than two windows.
+    , screenBorder          :: Border
+        -- ^ The screen border.
+    , screenBorderEnabled   :: Bool
+        -- ^ Is the screen border enabled?
+    , windowBorder          :: Border
+        -- ^ The window borders.
+    , windowBorderEnabled   :: Bool
+        -- ^ Is the window border enabled?
+    } deriving (Show,Read)
+
+instance Eq a => LayoutModifier Spacing a where
+    -- This is a bit of a chicken-and-egg problem - the visible window list has
+    -- yet to be generated. Several workarounds to incorporate the screen
+    -- border:
+    -- 1. Call 'runLayout' twice, with/without the screen border. Since layouts
+    --    run arbitrary X actions, this breaks an important underlying
+    --    assumption. Also, doesn't really solve the chicken-egg problem.
+    -- 2. Create the screen border after and if the child layout returns more
+    --    than one window. Unfortunately this breaks the window ratios
+    --    presented by the child layout, another important assumption.
+    -- 3. Create the screen border before, and remove it after and if the child
+    --    layout returns fewer than two visible windows. This is somewhat hacky
+    --    but probably the best option. Could significantly modify the child
+    --    layout if it would have returned more than one window given the space
+    --    of the screen border, but this is the underlying chicken-egg problem,
+    --    and some concession must be made:
+    --      * no border -> multiple windows
+    --      * border -> single window
+    --    Also slightly breaks layouts that expect to present absolutely-sized
+    --    windows; a single window will be scaled up by the border size.
+    --    Overall these are trivial assumptions.
     --
+    -- Note #1: the original code counted the windows of the 'Workspace' stack,
+    -- and so generated incorrect results even for the builtin 'Full' layout.
+    -- Even though most likely true, it isn't guaranteed that a layout will
+    -- never return windows not in the stack, specifically that an empty stack
+    -- will lead to 0 visible windows and a stack with a single window will
+    -- lead to 0-1 visible windows (see 'XMonad.Layout.Decoration'). So as much
+    -- as I would like to pass a rectangle without screen borders to the child
+    -- layout when appropriate (per the original approach), I can't. Since the
+    -- screen border is always present whether displayed or not, child layouts
+    -- can't depend on an accurate layout rectangle.
+    --
+    -- Note #2: If there are fewer than two stack windows displayed, the stack
+    -- window (if present) is scaled up while the non-stack windows are moved a
+    -- border-dependent amount based on their quadrant. So a non-stack window
+    -- in the top-left quadrant will be moved using only the border's top and
+    -- left components. Originally I was going to use an edge-attachment
+    -- algorithm, but this is much simpler and covers most cases. Edge
+    -- attachment would have scaled non-stack windows, but most non-stack
+    -- windows are created by XMonad and therefore cannot be scaled. I suggest
+    -- this layout be disabled for any incompatible child layouts.
+    modifyLayout (Spacing _b _sb False _wb _wbe) wsp lr =
+        runLayout wsp lr
+    modifyLayout (Spacing b sb _sbe _wb _wbe) wsp lr = do
+        let sb1 = borderClampGTZero sb
+            lr' = withBorder' sb1 2 lr
+            sb2 = toBorder lr' lr
+        (wrs,ml) <- runLayout wsp lr'
+        let ff (w,wr) (i,ps) = if w `elem` (W.integrate' . W.stack $ wsp)
+                               then let wr' = withBorder' sb2 2 wr
+                                    in  (i+1,(w,wr'):ps)
+                               else let wr' = moveByQuadrant lr wr sb2
+                                    in  (i,(w,wr'):ps)
+            (c,wrs') = foldr ff (0::Integer,[]) wrs
+        return $ if c <= 1 && b
+            then (wrs',ml)
+            else (wrs,ml)
+      where
+        moveByQuadrant :: Rectangle -> Rectangle -> Border -> Rectangle
+        moveByQuadrant rr mr@(Rectangle {rect_x = x, rect_y = y}) (Border bt bb br bl) =
+            let (rcx,rcy) = R.center rr
+                (mcx,mcy) = R.center mr
+                dx = orderSelect (compare mcx rcx) (bl,0,negate br)
+                dy = orderSelect (compare mcy rcy) (bt,0,negate bb)
+            in  mr { rect_x = x + fromIntegral dx, rect_y = y + fromIntegral dy }
 
--- | Surround all windows by a certain number of pixels of blank space.
+    -- This is run after 'modifyLayout' but receives the original stack, not
-spacing :: Int -> l a -> ModifiedLayout Spacing l a
+    -- one possibly modified by the child layout. Does not remove borders from
-spacing p = ModifiedLayout (Spacing p)
+    -- windows not in the stack, i.e. decorations generated by
+    -- 'XMonad.Layout.Decorations'.
+    pureModifier (Spacing _b _sb _sbe _wb False) _lr _mst wrs =
+        (wrs, Nothing)
+    pureModifier (Spacing b _sb _sbe wb _wbe) _lr mst wrs =
+        let wb' = borderClampGTZero wb
+            ff p@(w,wr) (i,ps) = if w `elem` W.integrate' mst
+                                 then let wr' = withBorder' wb' 2 wr
+                                      in  (i+1,(w,wr'):ps)
+                                 else (i,p:ps)
+            (c,wrs') = foldr ff (0::Integer,[]) wrs
+        in  if c <= 1 && b
+            then (wrs, Nothing)
+            else (wrs', Nothing)
 
-data Spacing a = Spacing Int deriving (Show, Read)
+    pureMess s@(Spacing b sb sbe wb wbe) m
+        | Just (ModifySmartBorder f) <- fromMessage m
+        = Just $ s { smartBorder = f b }
+        | Just (ModifyScreenBorder f) <- fromMessage m
+        = Just $ s { screenBorder = f sb }
+        | Just (ModifyScreenBorderEnabled f) <- fromMessage m
+        = Just $ s { screenBorderEnabled = f sbe }
+        | Just (ModifyWindowBorder f) <- fromMessage m
+        = Just $ s { windowBorder = f wb }
+        | Just (ModifyWindowBorderEnabled f) <- fromMessage m
+        = Just $ s { windowBorderEnabled = f wbe }
+        | otherwise
+        = Nothing
+
+    modifierDescription Spacing {} =
+        "Spacing"
+
+
+-- | Generate the 'ModifiedLayout', exposing all initial state of 'Spacing'.
+spacingRaw :: Bool     -- ^ The 'smartBorder'.
+           -> Border   -- ^ The 'screenBorder'.
+           -> Bool     -- ^ The 'screenBorderEnabled'.
+           -> Border   -- ^ The 'windowBorder'.
+           -> Bool     -- ^ The 'windowBorderEnabled'.
+           -> l a -> ModifiedLayout Spacing l a
+spacingRaw b sb sbe wb wbe = ModifiedLayout (Spacing b sb sbe wb wbe)
+
+-- | Messages to alter the state of 'Spacing' using the endomorphic function
+-- arguments.
+data ModifySpacing
+    = ModifySmartBorder (Bool -> Bool)
+    | ModifyScreenBorder (Border -> Border)
+    | ModifyScreenBorderEnabled (Bool -> Bool)
+    | ModifyWindowBorder (Border -> Border)
+    | ModifyWindowBorderEnabled (Bool -> Bool)
+    deriving (Typeable)
 
--- | Message to dynamically modify (e.g. increase/decrease/set) the size of the window spacing
-data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)
 instance Message ModifySpacing
 
--- | Set spacing to given amount
+-- | Set 'smartBorder' to the given 'Bool'.
-setSpacing :: Int -> X ()
+setSmartSpacing :: Bool -> X ()
-setSpacing n = sendMessage $ ModifySpacing $ const n
+setSmartSpacing = sendMessage . ModifySmartBorder . const
 
--- | Increase spacing by given amount
+-- | Set 'screenBorder' to the given 'Border'.
-incSpacing :: Int -> X ()
+setScreenSpacing :: Border -> X ()
-incSpacing n = sendMessage $ ModifySpacing $ (+n)
+setScreenSpacing = sendMessage . ModifyScreenBorder . const
 
-instance LayoutModifier Spacing a where
+-- | Set 'screenBorderEnabled' to the given 'Bool'.
+setScreenSpacingEnabled :: Bool -> X ()
+setScreenSpacingEnabled = sendMessage . ModifyScreenBorderEnabled . const
 
-    pureModifier (Spacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
+-- | Set 'windowBorder' to the given 'Border'.
+setWindowSpacing :: Border -> X ()
+setWindowSpacing = sendMessage . ModifyWindowBorder . const
 
-    pureMess (Spacing px) m
+-- | Set 'windowBorderEnabled' to the given 'Bool'.
-     | Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px
+setWindowSpacingEnabled :: Bool -> X ()
-     | otherwise = Nothing
+setWindowSpacingEnabled = sendMessage . ModifyWindowBorderEnabled . const
 
-    modifierDescription (Spacing p) = "Spacing " ++ show p
+-- | Toggle 'smartBorder'.
+toggleSmartSpacing :: X ()
+toggleSmartSpacing = sendMessage $ ModifySmartBorder not
+
+-- | Toggle 'screenBorderEnabled'.
+toggleScreenSpacingEnabled :: X ()
+toggleScreenSpacingEnabled = sendMessage $ ModifyScreenBorderEnabled not
+
+-- | Toggle 'windowBorderEnabled'.
+toggleWindowSpacingEnabled :: X ()
+toggleWindowSpacingEnabled = sendMessage $ ModifyWindowBorderEnabled not
+
+-- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which
+-- preserves border ratios during clamping.
+incWindowSpacing :: Integer -> X ()
+incWindowSpacing = sendMessage . ModifyWindowBorder . borderIncrementBy
+
+-- | Increment the borders of 'screenBorder' using 'borderIncrementBy'.
+incScreenSpacing :: Integer -> X ()
+incScreenSpacing = sendMessage . ModifyScreenBorder . borderIncrementBy
+
+-- | Inverse of 'incWindowSpacing', equivalent to applying 'negate'.
+decWindowSpacing :: Integer -> X ()
+decWindowSpacing = incWindowSpacing . negate
+
+-- | Inverse of 'incScreenSpacing'.
+decScreenSpacing :: Integer -> X ()
+decScreenSpacing = incScreenSpacing . negate
+
+-- | Map a function over a 'Border'. That is, over the four individual borders.
+borderMap :: (Integer -> Integer) -> Border -> Border
+borderMap f (Border t b r l) = Border (f t) (f b) (f r) (f l)
+
+-- | Clamp borders to within @[0,Infinity]@.
+borderClampGTZero :: Border -> Border
+borderClampGTZero = borderMap (max 0)
+
+-- | Change the border spacing by the provided amount, adjusted so that at
+-- least one border field is @>=0@.
+borderIncrementBy :: Integer -> Border -> Border
+borderIncrementBy i (Border t b r l) =
+    let bl = [t,b,r,l]
+        o  = maximum bl
+        o' = max i $ negate o
+        [t',b',r',l'] = map (+o') bl
+    in  Border t' b' r' l'
+
+-- | Interface to 'XMonad.Util.Rectangle.withBorder'.
+withBorder' :: Border -> Integer -> Rectangle -> Rectangle
+withBorder' (Border t b r l) = R.withBorder t b r l
+
+-- | Return the border necessary to derive the second rectangle from the first.
+-- Since 'R.withBorder' may scale the borders to stay within rectangle bounds,
+-- it is not an invertible operation, i.e. applying a negated border may not
+-- return the original rectangle. Use this instead.
+toBorder :: Rectangle -> Rectangle -> Border
+toBorder r1 r2 =
+    let R.PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = R.pixelsToCoordinates r1
+        R.PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = R.pixelsToCoordinates r2
+        l = r2_x1 - r1_x1
+        r = r1_x2 - r2_x2
+        t = r2_y1 - r1_y1
+        b = r1_y2 - r2_y2
+    in Border t b r l
+
+-- | Given an ordering and a three-tuple, return the first tuple entry if 'LT',
+-- second if 'EQ' and third if 'GT'.
+orderSelect :: Ordering -> (a,a,a) -> a
+orderSelect o (lt,eq,gt) = case o of
+    LT -> lt
+    EQ -> eq
+    GT -> gt
+
+-----------------------------------------------------------------------------
+-- Backwards Compatibility:
+-----------------------------------------------------------------------------
+{-# DEPRECATED spacing, spacingWithEdge, smartSpacing, smartSpacingWithEdge "Use spacingRaw instead." #-}
+{-# DEPRECATED setSpacing "Use setWindowSpacing/setScreenSpacing instead." #-}
+{-# DEPRECATED incSpacing "Use incWindowSpacing/incScreenSpacing instead." #-}
+
+-- $backwardsCompatibility
+-- The following functions exist solely for compatibility with pre-0.14
+-- releases.
+
+-- | Surround all windows by a certain number of pixels of blank space. See
+-- 'spacingRaw'.
+spacing :: Integer -> l a -> ModifiedLayout Spacing l a
+spacing i = spacingRaw False (Border 0 0 0 0) False (Border i i i i) True
 
 -- | Surround all windows by a certain number of pixels of blank space, and
 -- additionally adds the same amount of spacing around the edge of the screen.
-spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a
+-- See 'spacingRaw'.
-spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)
+spacingWithEdge :: Integer -> l a -> ModifiedLayout Spacing l a
-
+spacingWithEdge i = spacingRaw False (Border i i i i) True (Border i i i i) True
-data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read)
-
-instance LayoutModifier SpacingWithEdge a where
-
-    pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
-
-    pureMess (SpacingWithEdge px) m
-     | Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px
-     | otherwise = Nothing
-
-    modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r)
-
-    modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p
-
-shrinkRect :: Int -> Rectangle -> Rectangle
-shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)
 
 -- | Surrounds all windows with blank space, except when the window is the only
--- visible window on the current workspace.
+-- visible window on the current workspace. See 'spacingRaw'.
-smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a
+smartSpacing :: Integer -> l a -> ModifiedLayout Spacing l a
-smartSpacing p = ModifiedLayout (SmartSpacing p)
+smartSpacing i = spacingRaw True (Border 0 0 0 0) False (Border i i i i) True
 
-data SmartSpacing a = SmartSpacing Int deriving (Show, Read)
+-- | Surrounds all windows with blank space, and adds the same amount of
+-- spacing around the edge of the screen, except when the window is the only
+-- visible window on the current workspace. See 'spacingRaw'.
+smartSpacingWithEdge :: Integer -> l a -> ModifiedLayout Spacing l a
+smartSpacingWithEdge i = spacingRaw True (Border i i i i) True (Border i i i i) True
 
-instance LayoutModifier SmartSpacing a where
+-- | Set all borders to a uniform size; see 'setWindowSpacing' and
+-- 'setScreenSpacing'.
+setSpacing :: Integer -> X ()
+setSpacing i = setWindowSpacing b >> setScreenSpacing b
+    where b = Border i i i i
 
-    pureModifier _ _ _ [x] = ([x], Nothing)
+-- | Increment both screen and window borders; see 'incWindowSpacing' and
-    pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
+-- 'incScreenSpacing'.
-
+incSpacing :: Integer -> X ()
-    pureMess (SmartSpacing px) m
+incSpacing i = incWindowSpacing i >> incScreenSpacing i
-     | Just (ModifySpacing f) <- fromMessage m = Just $ SmartSpacing $ max 0 $ f px
-     | otherwise = Nothing
-
-    modifierDescription (SmartSpacing p) = "SmartSpacing " ++ show p
-
--- | Surrounds all windows with blank space, and adds the same amount of spacing
--- around the edge of the screen, except when the window is the only visible
--- window on the current workspace.
-smartSpacingWithEdge :: Int -> l a -> ModifiedLayout SmartSpacingWithEdge l a
-smartSpacingWithEdge p = ModifiedLayout (SmartSpacingWithEdge p)
-
-data SmartSpacingWithEdge a = SmartSpacingWithEdge Int deriving (Show, Read)
-
-instance LayoutModifier SmartSpacingWithEdge a where
-
-    pureModifier _ _ _ [x] = ([x], Nothing)
-    pureModifier (SmartSpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
-
-    modifyLayout (SmartSpacingWithEdge p) w r
-        | maybe False (\s -> null (up s) && null (down s)) (stack w) = runLayout w r
-        | otherwise = runLayout w (shrinkRect p r)
-
-    pureMess (SmartSpacingWithEdge px) m
-     | Just (ModifySpacing f) <- fromMessage m = Just $ SmartSpacingWithEdge $ max 0 $ f px
-     | otherwise = Nothing
-
-    modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p

XMonad/Layout/StateFull.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE FlexibleInstances, FlexibleContexts, MultiParamTypeClasses #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.StateFull
+-- Description :  The StateFull Layout & FocusTracking Layout Transformer
+-- Copyright   :  (c) 2018  L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  L. S. Leary
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides StateFull: a stateful form of Full that does not misbehave when
+-- floats are focused, and the FocusTracking layout transformer by means of
+-- which StateFull is implemented. FocusTracking simply holds onto the last
+-- true focus it was given and continues to use it as the focus for the
+-- transformed layout until it sees another. It can be used to improve the
+-- behaviour of a child layout that has not been given the focused window.
+--------------------------------------------------------------------------------
+
+module XMonad.Layout.StateFull (
+  -- * Usage
+  -- $Usage
+  pattern StateFull,
+  StateFull,
+  FocusTracking(..),
+  focusTracking
+) where
+
+import XMonad hiding ((<&&>))
+import qualified XMonad.StackSet as W
+import XMonad.Util.Stack (findZ)
+
+import Data.Maybe (fromMaybe)
+import Control.Applicative ((<|>))
+import Control.Monad (join)
+
+-- $Usage
+--
+-- To use it, first you need to:
+--
+-- > import XMonad.Layout.StateFull
+--
+-- Then to toggle your tiled layout with @StateFull@, you can do:
+--
+-- > main = xmonad def { layoutHook = someTiledLayout ||| StateFull }
+--
+-- Or, some child layout that depends on focus information can be made to fall
+-- back on the last focus it had:
+--
+-- > main = xmonad def
+-- >  { layoutHook = someParentLayoutWith aChild (focusTracking anotherChild) }
+
+-- | The @FocusTracking@ data type for which the @LayoutClass@ instance is
+--   provided.
+data FocusTracking l a = FocusTracking (Maybe a) (l a)
+  deriving (Show, Read)
+
+-- | Transform a layout into one that remembers and uses its last focus.
+focusTracking :: l a -> FocusTracking l a
+focusTracking = FocusTracking Nothing
+
+-- | A type synonym to match the @StateFull@ pattern synonym.
+type StateFull = FocusTracking Full
+
+-- | A pattern synonym for the primary use case of the @FocusTracking@
+--   transformer; using @Full@.
+pattern StateFull :: StateFull a
+pattern StateFull = FocusTracking Nothing Full
+
+instance LayoutClass l Window => LayoutClass (FocusTracking l) Window where
+
+  description (FocusTracking _ child)
+    | (chDesc == "Full")  = "StateFull"
+    | (' ' `elem` chDesc) = "FocusTracking (" ++ chDesc ++ ")"
+    | otherwise           = "FocusTracking " ++ chDesc
+    where chDesc = description child
+
+  runLayout (W.Workspace i (FocusTracking mOldFoc childL) mSt) sr = do
+
+    mRealFoc <- gets (W.peek . windowset)
+    let mGivenFoc = W.focus <$> mSt
+        passedMSt = if mRealFoc == mGivenFoc then mSt
+                    else join (mOldFoc >>= \oF -> findZ (==oF) mSt) <|> mSt
+
+    (wrs, mChildL') <- runLayout (W.Workspace i childL passedMSt) sr
+    let newFT = if mRealFoc /= mGivenFoc then FocusTracking mOldFoc <$> mChildL'
+                else Just $ FocusTracking mGivenFoc (fromMaybe childL mChildL')
+
+    return (wrs, newFT)
+
+  handleMessage (FocusTracking mf childLayout) m =
+    (fmap . fmap) (FocusTracking mf) (handleMessage childLayout m)

XMonad/Prompt/FuzzyMatch.hs

@@ -18,6 +18,10 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage
                                 , fuzzySort
                                 ) where
 
+import Data.Char
+import Data.Function
+import Data.List
+
 -- $usage
 -- 
 -- This module offers two aspects of fuzzy matching of completions offered by
@@ -61,10 +65,6 @@ module XMonad.Prompt.FuzzyMatch ( -- * Usage
 -- For detailed instructions on editing the key bindings, see
 -- "Xmonad.Doc.Extending#Editing_key_bindings".
 
-import Data.Char
-import Data.Function
-import Data.List
-
 -- | Returns True if the first argument is a subsequence of the second argument,
 -- that is, it can be obtained from the second sequence by deleting elements.
 fuzzyMatch :: String -> String -> Bool

XMonad/Util/SpawnOnce.hs

@@ -15,9 +15,10 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Util.SpawnOnce (spawnOnce) where
+module XMonad.Util.SpawnOnce (spawnOnce, spawnOnOnce, spawnNOnOnce, spawnAndDoOnce) where
 
 import XMonad
+import XMonad.Actions.SpawnOn
 import Data.Set as Set
 import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad
@@ -29,11 +30,31 @@ instance ExtensionClass SpawnOnce where
     initialValue = SpawnOnce Set.empty
     extensionType = PersistentExtension
 
--- | The first time 'spawnOnce' is executed on a particular command, that
+doOnce :: (String -> X ()) -> String -> X ()
--- command is executed.  Subsequent invocations for a command do nothing.
+doOnce f s = do
-spawnOnce :: String -> X ()
+    b <- XS.gets (Set.member s . unspawnOnce)
-spawnOnce xs = do
-    b <- XS.gets (Set.member xs . unspawnOnce)
     when (not b) $ do
-        spawn xs
+        f s
-        XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
+        XS.modify (SpawnOnce . Set.insert s . unspawnOnce)
+
+
+-- | The first time 'spawnOnce' is executed on a particular command,
+-- that command is executed.  Subsequent invocations for a command do
+-- nothing.
+spawnOnce :: String -> X ()
+spawnOnce cmd = doOnce spawn cmd
+
+-- | Like spawnOnce but launches the application on the given workspace.
+spawnOnOnce :: WorkspaceId -> String -> X ()
+spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd
+
+-- | Lanch the given application n times on the specified
+-- workspace. Subsequent attempts to spawn this application will be
+-- ignored.
+spawnNOnOnce :: Int -> WorkspaceId -> String -> X ()
+spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd
+
+-- | Spawn the application once and apply the manage hook. Subsequent
+-- attempts to spawn this application will be ignored.
+spawnAndDoOnce :: ManageHook -> String -> X ()
+spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd

XMonad/Util/Stack.hs

@@ -38,6 +38,8 @@ module XMonad.Util.Stack ( -- * Usage
                          , focusUpZ
                          , focusDownZ
                          , focusMasterZ
+                         , findS
+                         , findZ
                            -- ** Extraction
                          , getFocusZ
                          , getIZ
@@ -73,10 +75,13 @@ module XMonad.Util.Stack ( -- * Usage
                          , mapE_
                          , mapEM
                          , mapEM_
+                         , reverseS
+                         , reverseZ
                          ) where
 
 import qualified XMonad.StackSet as W
-import Control.Monad (liftM)
+import Control.Applicative ((<|>))
+import Control.Monad (guard,liftM)
 import Data.List (sortBy)
 
 
@@ -175,6 +180,22 @@ focusMasterZ (Just (W.Stack f up down)) | not $ null up
     = Just $ W.Stack (last up) [] (reverse (init up) ++ [f] ++ down)
 focusMasterZ (Just s) = Just s
 
+-- | Refocus a @Stack a@ on an element satisfying the predicate, or fail to
+--   @Nothing@.
+findS :: Eq a => (a -> Bool) -> W.Stack a -> Maybe (W.Stack a)
+findS p st = st <$ (guard . p . W.focus) st <|> findUp st <|> findDown st
+  where findDown = reverseZ . findUp . reverseS
+        findUp s | u:ups <- W.up s = (if p u then Just else findUp)
+                                   $ W.Stack u ups (W.focus s : W.down s)
+                 | otherwise       = Nothing
+
+-- | Refocus a @Zipper a@ on an element satisfying the predicate, or fail to
+--   @Nothing@. Never returns @Just Nothing@, so the second layer of @Maybe@ is
+--   actually redundant.
+findZ :: Eq a => (a -> Bool) -> Zipper a -> Maybe (Zipper a)
+findZ _ Nothing   = Nothing
+findZ p (Just st) = Just <$> findS p st
+
 -- ** Extraction
 
 -- | Get the focused element
@@ -338,3 +359,11 @@ fromE (Left a) = a
 -- | Tag the element with 'Right' if the property is true, 'Left' otherwise
 tagBy :: (a -> Bool) -> a -> Either a a
 tagBy p a = if p a then Right a else Left a
+
+-- | Reverse a @Stack a@; O(1).
+reverseS :: W.Stack a -> W.Stack a
+reverseS (W.Stack foc ups downs) = W.Stack foc downs ups
+
+-- | Reverse a @Zipper a@; O(1).
+reverseZ :: Zipper a -> Zipper a
+reverseZ = (reverseS <$>)

xmonad-contrib.cabal

@@ -194,6 +194,7 @@ library
                         XMonad.Layout.Accordion
                         XMonad.Layout.AutoMaster
                         XMonad.Layout.AvoidFloats
+                        XMonad.Layout.BinaryColumn
                         XMonad.Layout.BinarySpacePartition
                         XMonad.Layout.BorderResize
                         XMonad.Layout.BoringWindows
@@ -273,6 +274,7 @@ library
                         XMonad.Layout.Spiral
                         XMonad.Layout.Square
                         XMonad.Layout.StackTile
+                        XMonad.Layout.StateFull
                         XMonad.Layout.Stoppable
                         XMonad.Layout.SubLayouts
                         XMonad.Layout.TabBarDecoration