twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-07-31 04:01:51 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into rectangle

Browse Source
This commit is contained in:
Brent Yorgey
2018-06-04 14:27:11 -05:00
committed by GitHub
parent 108431d03d 18eb79ce73
commit 44306eb0ab
11 changed files with 778 additions and 117 deletions
Download Patch File Download Diff File Expand all files Collapse all files

53
CHANGES.md
View File

@@ -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

79
XMonad/Config/Saegesser.hs Executable file
View File

@@ -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

37
XMonad/Hooks/DynamicLog.hs
View File

@@ -43,8 +43,8 @@ module XMonad.Hooks.DynamicLog (
-- * Formatting utilities
wrap, pad, trim, shorten,
xmobarColor, xmobarStrip,
xmobarStripTags,
xmobarColor, xmobarAction, xmobarRaw,
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 = " "

139
XMonad/Layout/BinaryColumn.hs Normal file
View File

@@ -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)

16
XMonad/Layout/Fullscreen.hs
View File

@@ -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

398
XMonad/Layout/Spacing.hs
View File

@@ -1,139 +1,341 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- 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 (
-- * Usage
-- $usage
module XMonad.Layout.Spacing
( -- * Usage
-- $usage
Border (..)
, Spacing (..)
, ModifySpacing (..)
, spacingRaw
, setSmartSpacing
, setScreenSpacing, setScreenSpacingEnabled
, setWindowSpacing, setWindowSpacingEnabled
, toggleSmartSpacing
, toggleScreenSpacingEnabled
, toggleWindowSpacingEnabled
, incWindowSpacing, incScreenSpacing
, decWindowSpacing, decScreenSpacing
, borderIncrementBy
-- * Backwards Compatibility
-- $backwardsCompatibility
, spacing, spacingWithEdge
, smartSpacing, smartSpacingWithEdge
, setSpacing, incSpacing
) where
spacing, Spacing,
spacingWithEdge, SpacingWithEdge,
smartSpacing, SmartSpacing,
smartSpacingWithEdge, SmartSpacingWithEdge,
ModifySpacing(..), setSpacing, incSpacing
) where
import XMonad
import XMonad.StackSet as W
import XMonad.Layout.LayoutModifier
import qualified XMonad.Util.Rectangle as R
import Graphics.X11 (Rectangle(..))
import Control.Arrow (second)
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
-- $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)
-- > -- put a 2px space around every window
--
-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $
-- > layoutHook def
-- | Surround all windows by a certain number of pixels of blank space.
spacing :: Int -> l a -> ModifiedLayout Spacing l a
spacing p = ModifiedLayout (Spacing p)
-- | Represent the borders of a rectangle.
data Border = Border
{ top :: Integer
, bottom :: Integer
, right :: Integer
, left :: Integer
} deriving (Show,Read)
data Spacing a = Spacing Int 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 }
-- This is run after 'modifyLayout' but receives the original stack, not
-- one possibly modified by the child layout. Does not remove borders from
-- 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)
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
setSpacing :: Int -> X ()
setSpacing n = sendMessage $ ModifySpacing $ const n
-- | Set 'smartBorder' to the given 'Bool'.
setSmartSpacing :: Bool -> X ()
setSmartSpacing = sendMessage . ModifySmartBorder . const
-- | Increase spacing by given amount
incSpacing :: Int -> X ()
incSpacing n = sendMessage $ ModifySpacing $ (+n)
-- | Set 'screenBorder' to the given 'Border'.
setScreenSpacing :: Border -> X ()
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
| Just (ModifySpacing f) <- fromMessage m = Just $ Spacing $ max 0 $ f px
| otherwise = Nothing
-- | Set 'windowBorderEnabled' to the given 'Bool'.
setWindowSpacingEnabled :: Bool -> X ()
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
spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)
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)
-- See 'spacingRaw'.
spacingWithEdge :: Integer -> l a -> ModifiedLayout Spacing l a
spacingWithEdge i = spacingRaw False (Border i i i i) True (Border i i i i) True
-- | Surrounds all windows with blank space, except when the window is the only
-- visible window on the current workspace.
smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a
smartSpacing p = ModifiedLayout (SmartSpacing p)
-- visible window on the current workspace. See 'spacingRaw'.
smartSpacing :: Integer -> l a -> ModifiedLayout Spacing l a
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)
pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
pureMess (SmartSpacing px) m
| 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
-- | Increment both screen and window borders; see 'incWindowSpacing' and
-- 'incScreenSpacing'.
incSpacing :: Integer -> X ()
incSpacing i = incWindowSpacing i >> incScreenSpacing i

95
XMonad/Layout/StateFull.hs Normal file
View File

@@ -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)

8
XMonad/Prompt/FuzzyMatch.hs
View File

@@ -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

37
XMonad/Util/SpawnOnce.hs
View File

@@ -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
-- command is executed. Subsequent invocations for a command do nothing.
spawnOnce :: String -> X ()
spawnOnce xs = do
b <- XS.gets (Set.member xs . unspawnOnce)
doOnce :: (String -> X ()) -> String -> X ()
doOnce f s = do
b <- XS.gets (Set.member s . unspawnOnce)
when (not b) $ do
spawn xs
XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
f s
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

31
XMonad/Util/Stack.hs
View File

@@ -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 <$>)

2
xmonad-contrib.cabal
View File

@@ -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