twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 03:20:21 -07:00
Code Issues Packages Projects Releases Wiki Activity

Merge branch 'master' into module/TwoPanePersistent

Browse Source
This commit is contained in:
Brent Yorgey 2019-01-21 11:03:26 -06:00 committed by GitHub
commit c2c0585d7e
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
24 changed files with 909 additions and 404 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
.travis.yml
View File

@ -1,7 +1,6 @@
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
language: c
sudo: false
dist: precise
cache:
directories:
@ -14,27 +13,32 @@ before_cache:
matrix:
include:
- env: CABALVER=1.16 GHCVER=7.6.3
compiler: ": #GHC 7.6.3"
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
- env: CABALVER=1.18 GHCVER=7.8.4
compiler: ": #GHC 7.8.4"
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
- env: CABALVER=1.22 GHCVER=7.10.3
compiler: ": #GHC 7.10.3"
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
- env: CABALVER=1.24 GHCVER=8.0.1
- env: GHCVER=8.6.1 CABALVER=2.4
compiler: ": #GHC 8.6.1"
addons: { apt: { packages: [cabal-install-2.4, ghc-8.6.1, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.4.3 CABALVER=2.2
compiler: ": #GHC 8.4.3"
addons: { apt: { packages: [cabal-install-2.2, ghc-8.4.3, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.2.2 CABALVER=2.0
compiler: ": #GHC 8.2.2"
addons: { apt: { packages: [cabal-install-2.0, ghc-8.2.2, libxrandr-dev]
, sources: [hvr-ghc]
} }
- env: GHCVER=8.0.1 CABALVER=1.24
compiler: ": #GHC 8.0.1"
addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1, libxrandr-dev]
, sources: [hvr-ghc]
} }
before_install:
- unset CC
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
install:
# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal --version
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
@ -43,6 +47,11 @@ install:
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
fi
- travis_retry cabal update -v
# build xmonad from HEAD
- git clone https://github.com/xmonad/xmonad.git
- cabal install xmonad/
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
@ -58,8 +67,8 @@ install:
echo "cabal build-cache MISS";
rm -rf $HOME/.cabsnap;
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
cabal install --only-dependencies --enable-tests --enable-benchmarks;
fi
- cabal install --only-dependencies --enable-tests --enable-benchmarks;
# snapshot package-db on cache miss
- if [ ! -d $HOME/.cabsnap ];
@ -70,8 +79,6 @@ install:
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
fi
- cabal install xmonad/
# Here starts the actual work to be performed for the package under test;
# any command which exits with a non-zero exit code causes the build to fail.
script:

158
CHANGES.md
View File

@ -1,6 +1,63 @@
# Change Log / Release Notes
## 0.14 (Not Yet)
## unknown
### Breaking Changes
### New Modules
* `XMonad.Layout.TwoPanePersistent`
A layout that is like TwoPane but keeps track of the slave window that is
currently beside the master. In TwoPane, the default behavior when the master
is focused is to display the next window in the stack on the slave pane. This
is a problem when a different slave window is selected without changing the stack
order.
### Bug Fixes and Minor Changes
* `XMonad.Prompt`
Added `sorter` to `XPConfig` used to sort the possible completions by how
well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).
## 0.15
### Breaking Changes
* `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`
The layout will no longer perform refreshes inside of its message handling.
If you have been relying on it to in your xmonad.hs, you will need to start
sending its messages in a manner that properly handles refreshing, e.g. with
`sendMessage`.
### New Modules
* `XMonad.Util.Purex`
Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from
the `XConf` and modifications to the `XState` are fundamentally pure --
contrary to the current treatment of such actions in most xmonad code. Pure
modifications to the `WindowSet` can be readily composed, but due to the
need for those modifications to be properly handled by `windows`, other pure
changes to the `XState` cannot be interleaved with those changes to the
`WindowSet` without superfluous refreshes, hence breaking composability.
This module aims to rectify that situation by drawing attention to it and
providing `PureX`: a pure type with the same monadic interface to state as
`X`. The `XLike` typeclass enables writing actions generic over the two
monads; if pure, existing `X` actions can be generalised with only a change
to the type signature. Various other utilities are provided, in particular
the `defile` function which is needed by end-users.
### Bug Fixes and Minor Changes
* Add support for GHC 8.6.1.
* `XMonad.Actions.MessageHandling`
Refresh-performing functions updated to better reflect the new `sendMessage`.
## 0.14
### Breaking Changes
@ -30,18 +87,6 @@
- Added field `gs_bordercolor` to `GSConfig` to specify border color.
* `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling
activated window. That means, actions, which you don't want to happen on
activated windows, should be guarded by
not <$> activated
predicate. By default, with empty `ManageHook`, window activation will do
nothing.
Also, you can use regular 'ManageHook' combinators for changing window
activation behavior.
* `XMonad.Layout.Minimize`
Though the interface it offers is quite similar, this module has been
@ -57,7 +102,7 @@
- `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
filepath to the `UnicodeData.txt` file containing unicode data.
* `XMonad.Actions.PhysicalScreen`
* `XMonad.Actions.PhysicalScreens`
`getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter
of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default
@ -75,7 +120,7 @@
* `XMonad.Util.WorkspaceCompare`
`getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
`XMonad.Actions.PhysicalScreen` (see changelog of this module for more information)
`XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
* `XMonad.Hooks.EwmhDesktops`
@ -107,29 +152,42 @@
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 =`".
* `XMonad.Actions.MessageFeedback`
- Follow the naming conventions of `XMonad.Operations`. Functions returning
`X ()` are named regularly (previously these ended in underscore) while
those returning `X Bool` are suffixed with an uppercase 'B'.
- Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
`sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
(renamed from `send`).
- The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
type `SomeMessage -> X Bool`, which means you are no longer constrained
to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
- The `send*Messages*` family of funtions allows for sequencing arbitrary
sets of messages with minimal refresh. It makes little sense for these
functions to support custom message dispatchers.
- Remain backwards compatible. Maintain deprecated aliases of all renamed
functions:
- `send` -> `sendMessageWithNoRefreshToCurrentB`
- `sendSM` -> `sendSomeMessageWithNoRefreshToCurrentB`
- `sendSM_` -> `sendSomeMessageWithNoRefreshToCurrent`
- `tryInOrder` -> `tryInOrderWithNoRefreshToCurrentB`
- `tryInOrder_` -> `tryInOrderWithNoRefreshToCurrent`
- `tryMessage` -> `tryMessageWithNoRefreshToCurrentB`
- `tryMessage_` -> `tryMessageWithNoRefreshToCurrent`
### New Modules
* `XMonad.Layout.TwoPanePersistent`
* `XMonad.Layout.MultiToggle.TabBarDecoration`
A layout that is like TwoPane but keeps track of the slave window that is
currently beside the master. In TwoPane, the default behavior when the master
is focused is to display the next window in the stack on the slave pane. This
is a problem when a different slave window is selected without changing the stack
order.
* `XMonad.Hooks.RefocusLast`
Provides log and event hooks that keep track of recently focused windows on
a per workspace basis and automatically refocus the last window when the
current one is closed. Also provides an action to toggle focus between the
current and previous window, and one that refocuses appropriately on sending
the current window to another workspace.
Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
dynamically toggle `XMonad.Layout.TabBarDecoration`.
* `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
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.
@ -139,19 +197,6 @@
Module for tracking master window history per workspace, and associated
functions for manipulating the stack using such history.
* `XMonad.Hooks.Focus`
A new module extending ManageHook EDSL to work on focused windows and
current workspace.
This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply
`manageHook` to activated window too. Thus, it may lead to unexpected
results, when `manageHook` previously working only for new windows, start
working for activated windows too. It may be solved, by adding
`not <$> activated` before those part of `manageHook`, which should not be
called for activated windows. But this lifts `manageHook` into
`FocusHook` and it needs to be converted back later using `manageFocus`.
* `XMonad.Actions.CycleWorkspaceByScreen`
A new module that allows cycling through previously viewed workspaces in the
@ -163,9 +208,9 @@
* `XMonad.Prompt.FuzzyMatch`
Provides a predicate 'fuzzyMatch' that is much more lenient in matching
completions in XMonad.Prompt than the default prefix match. Also provides
a function 'fuzzySort' that allows sorting the fuzzy matches by "how well"
Provides a predicate `fuzzyMatch` that is much more lenient in matching
completions in `XMonad.Prompt` than the default prefix match. Also provides
a function `fuzzySort` that allows sorting the fuzzy matches by "how well"
they match.
* `XMonad.Utils.SessionStart`
@ -196,17 +241,22 @@
### Bug Fixes and Minor Changes
* XMonad.Hooks.FadeWindows
* `XMonad.Layout.Grid`
Fix as per issue #223; Grid will no longer calculate more columns than there
are windows.
* `XMonad.Hooks.FadeWindows`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* XMonad.Hooks.WallpaperSetter
* `XMonad.Hooks.WallpaperSetter`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
* XMonad.Hooks.Mosaic
* `XMonad.Hooks.Mosaic`
Added support for GHC version 8.4.x by adding a Semigroup instance for
Monoids
@ -359,6 +409,12 @@
- Added `updateName` and `removeName` to better control ordering when
workspace names are changed or workspaces are removed.
* `XMonad.Config.Azerty`
* Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY
keyboards, which are slightly different from the French ones in the top
row.
## 0.13 (February 10, 2017)
### Breaking Changes

283
XMonad/Actions/MessageFeedback.hs
View File

@ -1,7 +1,8 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.MessageFeedback
-- Copyright : (c) Quentin Moser <moserq@gmail.com>
-- Copyright : (c) -- Quentin Moser <moserq@gmail.com>
-- 2018 Yclept Nemo
-- License : BSD3
--
-- Maintainer : orphaned
@ -13,87 +14,263 @@
-- this facility.
-----------------------------------------------------------------------------
module XMonad.Actions.MessageFeedback (
-- * Usage
-- $usage
module XMonad.Actions.MessageFeedback
( -- * Usage
-- $usage
send
, tryMessage
, tryMessage_
, tryInOrder
, tryInOrder_
, sm
, sendSM
, sendSM_
) where
-- * Messaging variants
import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
import XMonad.StackSet ( current, workspace, layout, tag )
import XMonad.Operations ( updateLayout )
-- ** 'SomeMessage'
sendSomeMessageB, sendSomeMessage
, sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
, sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
import Control.Monad.State ( gets )
import Data.Maybe ( isJust )
import Control.Applicative ((<$>))
-- ** 'Message'
, sendMessageB
, sendMessageWithNoRefreshB
, sendMessageWithNoRefreshToCurrentB, sendMessageWithNoRefreshToCurrent
-- * Utility Functions
-- ** Send All
, sendSomeMessagesB, sendSomeMessages, sendMessagesB, sendMessages
-- ** Send Until
, tryInOrderB, tryInOrderWithNoRefreshToCurrentB, tryInOrderWithNoRefreshToCurrent
, tryMessageB, tryMessageWithNoRefreshToCurrentB, tryMessageWithNoRefreshToCurrent
-- ** Aliases
, sm
-- * Backwards Compatibility
-- $backwardsCompatibility
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import Data.Maybe ( isJust )
import Control.Monad ( void )
import Control.Monad.State ( gets )
import Control.Applicative ( (<$>), liftA2 )
-- $usage
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MessageFeedback
--
-- You can then use this module's functions wherever an action is expected.
-- You can then use this module's functions wherever an action is expected. All
-- feedback variants are supported:
--
-- * message to any workspace with no refresh
-- * message to current workspace with no refresh
-- * message to current workspace with refresh
--
-- Except "message to any workspace with refresh" which makes little sense.
--
-- Note that most functions in this module have a return type of @X Bool@
-- whereas configuration options will expect a @X ()@ action.
-- For example, the key binding
-- whereas configuration options will expect a @X ()@ action. For example, the
-- key binding:
--
-- > -- Shrink the master area of a tiled layout, or move the focused window
-- > -- to the left in a WindowArranger-based layout
-- > ((modKey, xK_Left), tryMessage Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrentB Shrink (MoveLeft 50))
--
-- is mis-typed. For this reason, this module provides alternatives (ending with
-- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
-- For example, to correct the previous example:
-- is mis-typed. For this reason, this module provides alternatives (not ending
-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
-- 'sendMessageB') that discard their boolean result and return an @X ()@. For
-- example, to correct the previous example:
--
-- > ((modKey, xK_Left), tryMessage_ Shrink (MoveLeft 50))
-- > ((modKey, xK_Left), tryMessageWithNoRefreshToCurrent Shrink (MoveLeft 50))
--
-- This module also provides 'SomeMessage' variants of each 'Message' function
-- for when the messages are of differing types (but still instances of
-- 'Message'). First box each message using 'SomeMessage' or the convenience
-- alias 'sm'. Then, for example, to send each message:
--
-- > sendSomeMessages [sm messageOfTypeA, sm messageOfTypeB]
--
-- This is /not/ equivalent to the following example, which will not refresh
-- the workspace unless the last message is handled:
--
-- > sendMessageWithNoRefreshToCurrent messageOfTypeA >> sendMessage messageOfTypeB
-- | Behaves like 'XMonad.Operations.sendMessage', but returns True of the
-- message was handled by the layout, False otherwise.
send :: Message a => a -> X Bool
send = sendSM . sm
-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
-- for efficiency this is pretty much an exact copy of the
-- 'XMonad.Operations.sendMessage' code - foregoes the O(n) 'updateLayout'.
sendSomeMessageB :: SomeMessage -> X Bool
sendSomeMessageB m = windowBracket id $ do
w <- workspace . current <$> gets windowset
ml <- handleMessage (layout w) m `catchX` return Nothing
whenJust ml $ \l ->
modifyWindowSet $ \ws -> ws { current = (current ws)
{ workspace = (workspace $ current ws)
{ layout = l }}}
return $ isJust ml
-- | Sends the first message, and if it was not handled, sends the second.
-- Returns True if either message was handled, False otherwise.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage m1 m2 = do b <- send m1
if b then return True else send m2
-- | Variant of 'sendSomeMessageB' that discards the result.
sendSomeMessage :: SomeMessage -> X ()
sendSomeMessage = void . sendSomeMessageB
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
-- 'SomeMessage'; to use 'Message' see 'sendMessageWithNoRefreshB'. Returns
-- @True@ if the message was handled, @False@ otherwise.
sendSomeMessageWithNoRefreshB :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendSomeMessageWithNoRefreshB m w
= handleMessage (layout w) m `catchX` return Nothing
>>= liftA2 (>>) (updateLayout $ tag w) (return . isJust)
-- | Tries sending every message of the list in order until one of them
-- is handled. Returns True if one of the messages was handled, False otherwise.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder [] = return False
tryInOrder (m:ms) = do b <- sendSM m
if b then return True else tryInOrder ms
-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ ms = tryInOrder ms >> return ()
-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
-- message to the current layout. Accepts 'SomeMessage'; to use 'Message' see
-- 'sendMessageWithNoRefreshToCurrentB'. Returns @True@ if the message was
-- handled, @False@ otherwise. This function is somewhat of a cross between
-- 'XMonad.Operations.sendMessage' (sends to the current layout) and
-- 'XMonad.Operations.sendMessageWithNoRefresh' (does not refresh).
sendSomeMessageWithNoRefreshToCurrentB :: SomeMessage -> X Bool
sendSomeMessageWithNoRefreshToCurrentB m
= (gets $ workspace . current . windowset)
>>= sendSomeMessageWithNoRefreshB m
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' that discards the
-- result.
sendSomeMessageWithNoRefreshToCurrent :: SomeMessage -> X ()
sendSomeMessageWithNoRefreshToCurrent = void . sendSomeMessageWithNoRefreshToCurrentB
-- | Convenience shorthand for 'XMonad.Core.SomeMessage'.
-- | Variant of 'sendSomeMessageB' which like 'XMonad.Operations.sendMessage'
-- accepts 'Message' rather than 'SomeMessage'. Returns @True@ if the message
-- was handled, @False@ otherwise.
sendMessageB :: Message a => a -> X Bool
sendMessageB = sendSomeMessageB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshB' which like
-- 'XMonad.Operations.sendMessageWithNoRefresh' accepts 'Message' rather than
-- 'SomeMessage'. Returns @True@ if the message was handled, @False@ otherwise.
sendMessageWithNoRefreshB :: Message a => a -> Workspace WorkspaceId (Layout Window) Window -> X Bool
sendMessageWithNoRefreshB = sendSomeMessageWithNoRefreshB . SomeMessage
-- | Variant of 'sendSomeMessageWithNoRefreshToCurrentB' which accepts
-- 'Message' rather than 'SomeMessage'. Returns @True@ if the message was
-- handled, @False@ otherwise.
sendMessageWithNoRefreshToCurrentB :: Message a => a -> X Bool
sendMessageWithNoRefreshToCurrentB = sendSomeMessageWithNoRefreshToCurrentB . SomeMessage
-- | Variant of 'sendMessageWithNoRefreshToCurrentB' that discards the result.
sendMessageWithNoRefreshToCurrent :: Message a => a -> X ()
sendMessageWithNoRefreshToCurrent = void . sendMessageWithNoRefreshToCurrentB
-- | Send each 'SomeMessage' to the current layout without refresh (using
-- 'sendSomeMessageWithNoRefreshToCurrentB') and collect the results. If any
-- message was handled, refresh. If you want to sequence a series of messages
-- that would have otherwise used 'XMonad.Operations.sendMessage' while
-- minimizing refreshes, use this.
sendSomeMessagesB :: [SomeMessage] -> X [Bool]
sendSomeMessagesB
= windowBracket or
. mapM sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'sendSomeMessagesB' that discards the results.
sendSomeMessages :: [SomeMessage] -> X ()
sendSomeMessages = void . sendSomeMessagesB
-- | Variant of 'sendSomeMessagesB' which accepts 'Message' rather than
-- 'SomeMessage'. Use this if all the messages are of the same type.
sendMessagesB :: Message a => [a] -> X [Bool]
sendMessagesB = sendSomeMessagesB . map SomeMessage
-- | Variant of 'sendMessagesB' that discards the results.
sendMessages :: Message a => [a] -> X ()
sendMessages = void . sendMessagesB
-- | Apply the dispatch function in order to each message of the list until one
-- is handled. Returns @True@ if so, @False@ otherwise.
tryInOrderB :: (SomeMessage -> X Bool) -> [SomeMessage] -> X Bool
tryInOrderB _ [] = return False
tryInOrderB f (m:ms) = do b <- f m
if b then return True else tryInOrderB f ms
-- | Variant of 'tryInOrderB' that sends messages to the current layout without
-- refresh using 'sendSomeMessageWithNoRefreshToCurrentB'.
tryInOrderWithNoRefreshToCurrentB :: [SomeMessage] -> X Bool
tryInOrderWithNoRefreshToCurrentB = tryInOrderB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryInOrderWithNoRefreshToCurrent' that discards the results.
tryInOrderWithNoRefreshToCurrent :: [SomeMessage] -> X ()
tryInOrderWithNoRefreshToCurrent = void . tryInOrderWithNoRefreshToCurrentB
-- | Apply the dispatch function to the first message, and if it was not
-- handled, apply it to the second. Returns @True@ if either message was
-- handled, @False@ otherwise.
tryMessageB :: (Message a, Message b) => (SomeMessage -> X Bool) -> a -> b -> X Bool
tryMessageB f m1 m2 = tryInOrderB f [sm m1,sm m2]
-- | Variant of 'tryMessageB' that sends messages to the current layout without
-- refresh using 'sendMessageWithNoRefreshToCurrentB'.
tryMessageWithNoRefreshToCurrentB :: (Message a, Message b) => a -> b -> X Bool
tryMessageWithNoRefreshToCurrentB = tryMessageB sendSomeMessageWithNoRefreshToCurrentB
-- | Variant of 'tryMessage' that discards the results.
tryMessageWithNoRefreshToCurrent :: (Message a, Message b) => a -> b -> X ()
tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
-- | Convenience shorthand for 'SomeMessage'.
sm :: Message a => a -> SomeMessage
sm = SomeMessage
--------------------------------------------------------------------------------
-- Backwards Compatibility:
--------------------------------------------------------------------------------
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- | See 'sendMessageWithNoRefreshToCurrentB'.
send :: Message a => a -> X Bool
send = sendMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
sendSM :: SomeMessage -> X Bool
sendSM m = do w <- workspace . current <$> gets windowset
ml' <- handleMessage (layout w) m `catchX` return Nothing
updateLayout (tag w) ml'
return $ isJust ml'
sendSM = sendSomeMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
sendSM_ :: SomeMessage -> X ()
sendSM_ m = sendSM m >> return ()
sendSM_ = sendSomeMessageWithNoRefreshToCurrent
-- | See 'tryInOrderWithNoRefreshToCurrentB'.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = tryInOrderWithNoRefreshToCurrentB
-- | See 'tryInOrderWithNoRefreshToCurrent'.
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = tryInOrderWithNoRefreshToCurrent
-- | See 'tryMessageWithNoRefreshToCurrentB'.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage = tryMessageWithNoRefreshToCurrentB
-- | See 'tryMessageWithNoRefreshToCurrent'.
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ = tryMessageWithNoRefreshToCurrent

2
XMonad/Actions/PhysicalScreens.hs
View File

@ -63,7 +63,7 @@ Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> --
> [((modm .|. mask, key), f sc)
> | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
> , (f, mask) <- [(viewScreen, 0), (sendToScreen def, shiftMask)]]
> , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
For detailed instructions on editing your key bindings, see
"XMonad.Doc.Extending#Editing_key_bindings".

3
XMonad/Actions/SwapPromote.hs
View File

@ -1,3 +1,5 @@
{-# LANGUAGE DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.SwapPromote
@ -63,6 +65,7 @@ import qualified Data.Set as S
import Data.List
import Data.Maybe
import Control.Arrow
import Control.Applicative ((<$>),(<*>))
import Control.Monad

12
XMonad/Config/Azerty.hs
View File

@ -17,7 +17,7 @@
module XMonad.Config.Azerty (
-- * Usage
-- $usage
azertyConfig, azertyKeys
azertyConfig, azertyKeys, belgianConfig, belgianKeys
) where
import XMonad
@ -40,11 +40,17 @@ import qualified Data.Map as M
azertyConfig = def { keys = azertyKeys <+> keys def }
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
belgianConfig = def { keys = belgianKeys <+> keys def }
azertyKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0]
belgianKeys = azertyKeysTop [0x26,0xe9,0x22,0x27,0x28,0xa7,0xe8,0x21,0xe7,0xe0]
azertyKeysTop topRow conf@(XConfig {modMask = modm}) = M.fromList $
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
++
[((m .|. modm, k), windows $ f i)
| (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
| (i, k) <- zip (workspaces conf) topRow,
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
++
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3

79
XMonad/Hooks/DebugEvents.hs
View File

@ -34,6 +34,7 @@ import Control.Exception.Extensible as E
import Control.Monad.State
import Control.Monad.Reader
import Data.Char (isDigit)
import Data.Maybe (fromJust)
import Data.List (genericIndex
,genericLength
,unfoldr
@ -696,30 +697,31 @@ dumpList'' m ((l,p,t):ps) sep = do
dumpString :: Decoder Bool
dumpString = do
fmt <- asks pType
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case x of
[cOMPOUND_TEXT,uTF8_STRING] -> case () of
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
ss' -> let go (s:ss'') c = append c >>
append (show s) >>
go ss'' ","
go [] _ = append "]"
in append "[" >> go ss' ""
| fmt == uTF8_STRING -> dumpUTF -- duplicate type test instead of code :)
| otherwise -> (inX $ atomName fmt) >>=
failure . ("unrecognized string type " ++)
-- show who owns a selection
dumpSelection :: Decoder Bool
@ -917,7 +919,7 @@ dumpExcept xs item = do
let w = (length (value sp) - length vs) * 8
-- now we get to reparse again so we get our copy of it
put sp
Just v <- getInt' w
v <- fmap fromJust (getInt' w)
-- and after all that, we can process the exception list
dumpExcept' xs that v
@ -1176,20 +1178,23 @@ getInt w f = getInt' w >>= maybe (return False) (append . f)
-- @@@@@@@@@ evil beyond evil. there *has* to be a better way
inhale :: Int -> Decoder Integer
inhale 8 = do
[b] <- eat 1
return $ fromIntegral b
x <- eat 1
case x of
[b] -> return $ fromIntegral b
inhale 16 = do
[b0,b1] <- eat 2
io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
x <- eat 2
case x of
[b0,b1] -> io $ allocaArray 2 $ \p -> do
pokeArray p [b0,b1]
[v] <- peekArray 1 (castPtr p :: Ptr Word16)
return $ fromIntegral v
inhale 32 = do
[b0,b1,b2,b3] <- eat 4
io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
x <- eat 4
case x of
[b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
pokeArray p [b0,b1,b2,b3]
[v] <- peekArray 1 (castPtr p :: Ptr Word32)
return $ fromIntegral v
inhale b = error $ "inhale " ++ show b
eat :: Int -> Decoder Raw

145
XMonad/Hooks/RefocusLast.hs
View File

@ -1,145 +0,0 @@
--------------------------------------------------------------------------------
-- |
-- Module : XMonad.Hooks.RefocusLast
-- Description : Hooks and actions to refocus the previous window.
-- Copyright : (c) 2018 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : unportable
--
-- Provides log and event hooks that keep track of recently focused windows on a
-- per workspace basis and automatically refocus the last window when the
-- current one is closed. Also provides an action to toggle focus between the
-- current and previous window, and one that refocuses appropriately on sending
-- the current window to another workspace.
--------------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Hooks.RefocusLast (
-- * Usage
-- $Usage
RecentWins(..),
RecentsMap(..),
refocusLastLogHook,
refocusLastEventHook,
toggleFocus,
shiftRL
) where
import XMonad
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import Control.Monad (when)
import Data.Maybe (fromMaybe)
import Data.Monoid (All(..))
import qualified Data.Map.Strict as M
-- }}}
-- --< Usage >-- {{{
-- $Usage
-- To use this module, you must include 'refocusLastLogHook' in your log hook.
-- This suffices to make use of both 'toggleFocus' and 'shiftRL' but will not
-- refocus automatically upon loss of the current window; for that you must also
-- include 'refocusLastEventHook' in your event hook.
--
-- Example configuration:
--
-- > import XMonad
-- > import XMonad.Hooks.RefocusLast
-- > import qualified Data.Map.Strict as M
-- >
-- > main = xmonad def
-- > { handleEventHook = refocusLastEventHook <+> handleEventHook def
-- > , logHook = refocusLastLogHook <+> logHook def
-- > , keys = rlKeys <+> keys def
-- > } where rlKeys = \cnf -> M.fromList
-- > $ ((modMask cnf, xK_a), toggleFocus)
-- > : [ ((modMask cnf .|. shiftMask, n), shiftRL wksp)
-- > | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf)
-- > ]
-- }}}
-- --< Types >-- {{{
-- | Data type holding onto the previous and current @Window@.
data RecentWins = Recent { previous :: !Window, current :: !Window }
deriving (Show, Read, Eq, Typeable)
-- | Newtype wrapper for a @Map@ holding a @Recent@ for each workspace.
-- Is an instance of @ExtensionClass@ with persistence of state.
newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)
deriving (Show, Read, Eq, Typeable)
instance ExtensionClass RecentsMap where
initialValue = RecentsMap M.empty
extensionType = PersistentExtension
-- }}}
-- --< Public Hooks & Actions >-- {{{
-- | This log hook is what records recently focused windows into extensible
-- state.
refocusLastLogHook :: X ()
refocusLastLogHook = withFocii $ \fw tag -> do
m <- getRecentsMap
let insertRecent la ca = XS.put . RecentsMap $ M.insert tag (Recent la ca) m
case M.lookup tag m of
Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw)
Nothing -> insertRecent fw fw
-- | This event hook runs iff the core xmonad event handler will unmanage the
-- event window, and shifts focus to the last focused window if possible.
refocusLastEventHook :: Event -> X All
refocusLastEventHook ev = All True <$ handle ev
where
handle (DestroyWindowEvent { ev_window = w }) = refocusLast w
handle (UnmapEvent { ev_send_event = synth, ev_window = w }) = do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
when (synth || e == 0) (refocusLast w)
handle _ = return ()
refocusLast w = withFocAndRec $ \_ _ (Recent lw cw) ->
when (w == cw) (modify $ refocus lw)
refocus newfoc xs = xs { windowset = W.focusWindow newfoc (windowset xs) }
-- | Refocuses the previously focused window; acts as a toggle.
toggleFocus :: X ()
toggleFocus = withFocAndRec $ \fw _ (Recent lw _) ->
when (fw /= lw) (windows $ W.focusWindow lw)
-- | Sends the focused window to the specified workspace, refocusing the last
-- focused window. Note that the native version of this, @windows . W.shift@,
-- has a nice property that this does not: shifting a window to another
-- workspace then shifting it back preserves its place in the stack.
shiftRL :: WorkspaceId -> X ()
shiftRL to = withFocAndRec $ \fw from (Recent lw _) ->
when (to /= from) (windows $ W.shiftWin to fw . W.focusWindow lw)
-- }}}
-- --< Private Utilities >-- {{{
-- | Get the RecentsMap out of extensible state and remove its newtype wrapper.
getRecentsMap :: X (M.Map WorkspaceId RecentWins)
getRecentsMap = XS.get >>= \(RecentsMap m) -> return m
-- | Perform an X action dependent on the focused window and current workspace.
withFocii :: (Window -> WorkspaceId -> X ()) -> X ()
withFocii f = withWindowSet $ \ws ->
whenJust (W.peek ws) $ \w -> f w (W.currentTag ws)
-- | As above, but also dependent on successful lookup of the RecentsMap.
withFocAndRec :: (Window -> WorkspaceId -> RecentWins -> X ()) -> X ()
withFocAndRec f = withFocii $ \fw tag ->
M.lookup tag <$> getRecentsMap >>= flip whenJust (f fw tag)
-- }}}

44
XMonad/Layout/Fullscreen.hs
View File

@ -30,17 +30,19 @@ module XMonad.Layout.Fullscreen
,FullscreenFloat, FullscreenFocus, FullscreenFull
) where
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Util.WindowProperties
import XMonad.Hooks.ManageHelpers (isFullscreen)
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Hooks.ManageHelpers (isFullscreen)
import XMonad.Util.WindowProperties
import qualified XMonad.Util.Rectangle as R
import qualified XMonad.StackSet as W
import Data.List
import Data.Maybe
import Data.Monoid
import qualified Data.Map as M
import Control.Monad
import Control.Arrow (second)
-- $usage
-- Provides a ManageHook and an EventHook that sends layout messages
@ -107,9 +109,12 @@ instance LayoutModifier FullscreenFull Window where
_ -> Nothing
pureModifier (FullscreenFull frect fulls) rect _ list =
(map (flip (,) rect') visfulls ++ rest, Nothing)
where visfulls = intersect fulls $ map fst list
rest = filter (not . (flip elem visfulls `orP` covers rect')) list
(visfulls' ++ rest', Nothing)
where (visfulls,rest) = partition (flip elem fulls . fst) list
visfulls' = map (second $ const rect') visfulls
rest' = if null visfulls'
then rest
else filter (not . R.supersetOf rect' . snd) rest
rect' = scaleRationalRect rect frect
instance LayoutModifier FullscreenFocus Window where
@ -122,7 +127,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 (not . ((== f) `orP` covers rect')) list
where rest = filter (not . orP (== f) (R.supersetOf rect')) list
rect' = scaleRationalRect rect frect
pureModifier _ _ Nothing list = (list, Nothing)
@ -240,15 +245,6 @@ 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

2
XMonad/Layout/Grid.hs
View File

@ -56,7 +56,7 @@ arrange :: Double -> Rectangle -> [a] -> [(a, Rectangle)]
arrange aspectRatio (Rectangle rx ry rw rh) st = zip st rectangles
where
nwins = length st
ncols = max 1 . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
ncols = max 1 . min nwins . round . sqrt $ fromIntegral nwins * fromIntegral rw / (fromIntegral rh * aspectRatio)
mincs = max 1 $ nwins `div` ncols
extrs = nwins - ncols * mincs
chop :: Int -> Dimension -> [(Position, Dimension)]

24
XMonad/Layout/Groups.hs
View File

@ -61,8 +61,8 @@ import XMonad.Util.Stack
import Data.Maybe (isJust, isNothing, fromMaybe, catMaybes, fromJust)
import Data.List ((\\))
import Control.Arrow ((>>>))
import Control.Applicative ((<$>))
import Control.Monad (forM)
import Control.Applicative ((<$>),(<|>),(<$))
import Control.Monad (forM,void)
-- $usage
-- This module provides a layout combinator that allows you
@ -311,12 +311,12 @@ instance (LayoutClass l Window, LayoutClass l2 (Group l Window))
Just (ToGroup i sm') -> do mg's <- handleOnIndex i sm' z
return $ maybeMakeNew l Nothing mg's
Just (Modify spec) -> case applySpec spec l of
Just l' -> refocus l' >> return (Just l')
Nothing -> return $ Just l
Just (ModifyX spec) -> applySpecX spec l >>= \case
Just l' -> refocus l' >> return (Just l')
Nothing -> return $ Just l
Just Refocus -> refocus l >> return (Just l)
Just l' -> refocus l'
Nothing -> return Nothing
Just (ModifyX spec) -> do ml' <- applySpecX spec l
whenJust ml' (void . refocus)
return (ml' <|> Just l)
Just Refocus -> refocus l
Just _ -> return Nothing
Nothing -> handleMessage l $ SomeMessage (ToFocused sm)
where handleOnFocused sm z = mapZM step $ Just z
@ -343,10 +343,10 @@ maybeMakeNew :: Groups l l2 a -> Maybe (l2 (Group l a)) -> [Maybe (WithID l a)]
maybeMakeNew _ Nothing ml's | all isNothing ml's = Nothing
maybeMakeNew g mpart' ml's = justMakeNew g mpart' ml's
refocus :: Groups l l2 Window -> X ()
refocus g = case getFocusZ $ gZipper $ W.focus $ groups g
of Just w -> focus w
Nothing -> return ()
refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
refocus g =
let mw = (getFocusZ . gZipper . W.focus . groups) g
in g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)
-- ** ModifySpec type

4
XMonad/Layout/Groups/Helpers.hs
View File

@ -45,7 +45,7 @@ import qualified XMonad.StackSet as W
import qualified XMonad.Layout.Groups as G
import XMonad.Actions.MessageFeedback
import XMonad.Actions.MessageFeedback (sendMessageB)
import Control.Monad (unless)
import qualified Data.Map as M
@ -92,7 +92,7 @@ alt :: G.ModifySpec -> (WindowSet -> WindowSet) -> X ()
alt f g = alt2 (G.Modify f) $ windows g
alt2 :: G.GroupsMessage -> X () -> X ()
alt2 m x = do b <- send m
alt2 m x = do b <- sendMessageB m
unless b x
-- | Swap the focused window with the previous one

3
XMonad/Layout/MultiToggle.hs
View File

@ -90,7 +90,8 @@ import Data.Maybe
-- > instance Transformer MIRROR Window where
-- > transform _ x k = k (Mirror x) (\(Mirror x') -> x')
--
-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable \#-}@ at the
-- Note, you need to put @{-\# LANGUAGE DeriveDataTypeable,
-- TypeSynonymInstances, MultiParamTypeClasses \#-}@ at the
-- beginning of your file.
-- | A class to identify custom transformers (and look up transforming

47
XMonad/Layout/MultiToggle/TabBarDecoration.hs Normal file
View File

@ -0,0 +1,47 @@
{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Layout.MultiToggle.TabBarDecoration
-- Copyright : (c) 2018 Lucian Poston
-- License : BSD-style (see LICENSE)
--
-- Maintainer : <lucianposton@pm.me>
-- Stability : unstable
-- Portability : unportable
--
-- Provides a simple transformer for use with "XMonad.Layout.MultiToggle" to
-- dynamically toggle "XMonad.Layout.TabBarDecoration".
-----------------------------------------------------------------------------
module XMonad.Layout.MultiToggle.TabBarDecoration (
SimpleTabBar(..)
) where
import XMonad.Layout.MultiToggle
import XMonad
import XMonad.Layout.LayoutModifier
import XMonad.Layout.TabBarDecoration
-- $usage
-- To use this module with "XMonad.Layout.MultiToggle", add the @SIMPLETABBAR@
-- to your layout For example, from a basic layout like
--
-- > layout = tiled ||| Full
--
-- Add @SIMPLETABBAR@ by changing it this to
--
-- > layout = mkToggle (single SIMPLETABBAR) (tiled ||| Full)
--
-- You can now dynamically toggle the 'XMonad.Layout.TabBarDecoration'
-- transformation by adding a key binding such as @mod-x@ as follows.
--
-- > ...
-- > , ((modm, xK_x ), sendMessage $ Toggle SIMPLETABBAR)
-- > ...
-- | Transformer for "XMonad.Layout.TabBarDecoration".
data SimpleTabBar = SIMPLETABBAR deriving (Read, Show, Eq, Typeable)
instance Transformer SimpleTabBar Window where
transform _ x k = k (simpleTabBar x) (\(ModifiedLayout _ (ModifiedLayout _ x')) -> x')

5
XMonad/Layout/NoBorders.hs
View File

@ -1,5 +1,5 @@
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
@ -42,6 +42,7 @@ import Data.List
import Data.Monoid
import qualified Data.Map as M
import Data.Function (on)
import Control.Applicative ((<$>),(<*>),pure)
import Control.Monad (guard)

103
XMonad/Layout/Spacing.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
@ -21,7 +21,7 @@ module XMonad.Layout.Spacing
-- $usage
Border (..)
, Spacing (..)
, ModifySpacing (..)
, SpacingModifier (..)
, spacingRaw
, setSmartSpacing
, setScreenSpacing, setScreenSpacingEnabled
@ -29,20 +29,26 @@ module XMonad.Layout.Spacing
, toggleSmartSpacing
, toggleScreenSpacingEnabled
, toggleWindowSpacingEnabled
, setScreenWindowSpacing
, incWindowSpacing, incScreenSpacing
, decWindowSpacing, decScreenSpacing
, borderIncrementBy
, incScreenWindowSpacing, decScreenWindowSpacing
, borderMap, borderIncrementBy
-- * Backwards Compatibility
-- $backwardsCompatibility
, SpacingWithEdge
, SmartSpacing, SmartSpacingWithEdge
, ModifySpacing (..)
, spacing, spacingWithEdge
, smartSpacing, smartSpacingWithEdge
, setSpacing, incSpacing
) where
import XMonad
import XMonad.StackSet as W
import XMonad.StackSet as W
import qualified XMonad.Util.Rectangle as R
import XMonad.Layout.LayoutModifier
import qualified XMonad.Util.Rectangle as R
import XMonad.Actions.MessageFeedback
-- $usage
@ -175,6 +181,9 @@ instance Eq a => LayoutModifier Spacing a where
= Just $ s { windowBorder = f wb }
| Just (ModifyWindowBorderEnabled f) <- fromMessage m
= Just $ s { windowBorderEnabled = f wbe }
| Just (ModifySpacing f) <- fromMessage m
= Just $ let f' = borderMap (fromIntegral . f . fromIntegral)
in s { screenBorder = f' sb, windowBorder = f' wb }
| otherwise
= Nothing
@ -193,7 +202,7 @@ 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
data SpacingModifier
= ModifySmartBorder (Bool -> Bool)
| ModifyScreenBorder (Border -> Border)
| ModifyScreenBorderEnabled (Bool -> Bool)
@ -201,7 +210,7 @@ data ModifySpacing
| ModifyWindowBorderEnabled (Bool -> Bool)
deriving (Typeable)
instance Message ModifySpacing
instance Message SpacingModifier
-- | Set 'smartBorder' to the given 'Bool'.
setSmartSpacing :: Bool -> X ()
@ -235,6 +244,12 @@ toggleScreenSpacingEnabled = sendMessage $ ModifyScreenBorderEnabled not
toggleWindowSpacingEnabled :: X ()
toggleWindowSpacingEnabled = sendMessage $ ModifyWindowBorderEnabled not
-- | Set all borders to a uniform size; see 'setWindowSpacing' and
-- 'setScreenSpacing'.
setScreenWindowSpacing :: Integer -> X ()
setScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]
. flip id . const . uniformBorder
-- | Increment the borders of 'windowBorder' using 'borderIncrementBy', which
-- preserves border ratios during clamping.
incWindowSpacing :: Integer -> X ()
@ -252,6 +267,20 @@ decWindowSpacing = incWindowSpacing . negate
decScreenSpacing :: Integer -> X ()
decScreenSpacing = incScreenSpacing . negate
-- | Increment both screen and window borders; see 'incWindowSpacing' and
-- 'incScreenSpacing'.
incScreenWindowSpacing :: Integer -> X ()
incScreenWindowSpacing = sendMessages . flip map [ModifyWindowBorder,ModifyScreenBorder]
. flip id . borderIncrementBy
-- | Inverse of 'incScreenWindowSpacing'.
decScreenWindowSpacing :: Integer -> X ()
decScreenWindowSpacing = incScreenWindowSpacing . negate
-- | Construct a uniform 'Border'. That is, having equal individual borders.
uniformBorder :: Integer -> Border
uniformBorder i = Border i i i i
-- | 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)
@ -299,43 +328,61 @@ orderSelect o (lt,eq,gt) = case o of
-----------------------------------------------------------------------------
-- Backwards Compatibility:
-----------------------------------------------------------------------------
{-# DEPRECATED SpacingWithEdge, SmartSpacing, SmartSpacingWithEdge "Use Spacing instead." #-}
{-# DEPRECATED ModifySpacing "Use SpacingModifier instead, perhaps with sendMessages." #-}
{-# DEPRECATED spacing, spacingWithEdge, smartSpacing, smartSpacingWithEdge "Use spacingRaw instead." #-}
{-# DEPRECATED setSpacing "Use setWindowSpacing/setScreenSpacing instead." #-}
{-# DEPRECATED incSpacing "Use incWindowSpacing/incScreenSpacing instead." #-}
{-# DEPRECATED setSpacing "Use setScreenWindowSpacing instead." #-}
{-# DEPRECATED incSpacing "Use incScreenWindowSpacing instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- The following functions and types exist solely for compatibility with
-- pre-0.14 releases.
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SpacingWithEdge = Spacing
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SmartSpacing = Spacing
-- | A type synonym for the 'Spacing' 'LayoutModifier'.
type SmartSpacingWithEdge = Spacing
-- | Message to dynamically modify (e.g. increase\/decrease\/set) the size of
-- the screen spacing and window spacing. See 'SpacingModifier'.
data ModifySpacing = ModifySpacing (Int -> Int) deriving (Typeable)
instance Message ModifySpacing
-- | 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
spacing :: Int -> l a -> ModifiedLayout Spacing l a
spacing i = spacingRaw False (uniformBorder 0) False (uniformBorder i') True
where i' = fromIntegral i
-- | 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.
-- 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
spacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a
spacingWithEdge i = spacingRaw False (uniformBorder i') True (uniformBorder i') True
where i' = fromIntegral i
-- | Surrounds all windows with blank space, except when the window is the only
-- 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
smartSpacing :: Int -> l a -> ModifiedLayout Spacing l a
smartSpacing i = spacingRaw True (uniformBorder 0) False (uniformBorder i') True
where i' = fromIntegral i
-- | 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
smartSpacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a
smartSpacingWithEdge i = spacingRaw True (uniformBorder i') True (uniformBorder i') True
where i' = fromIntegral i
-- | 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
-- | See 'setScreenWindowSpacing'.
setSpacing :: Int -> X ()
setSpacing = setScreenWindowSpacing . fromIntegral
-- | Increment both screen and window borders; see 'incWindowSpacing' and
-- 'incScreenSpacing'.
incSpacing :: Integer -> X ()
incSpacing i = incWindowSpacing i >> incScreenSpacing i
-- | See 'incScreenWindowSpacing'.
incSpacing :: Int -> X ()
incSpacing = incScreenWindowSpacing . fromIntegral

3
XMonad/Layout/StateFull.hs
View File

@ -34,7 +34,7 @@ import qualified XMonad.StackSet as W
import XMonad.Util.Stack (findZ)
import Data.Maybe (fromMaybe)
import Control.Applicative ((<|>))
import Control.Applicative ((<|>),(<$>))
import Control.Monad (join)
-- $Usage
@ -67,7 +67,6 @@ 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

13
XMonad/Prompt.hs
View File

@ -156,6 +156,10 @@ data XPConfig =
, searchPredicate :: String -> String -> Bool
-- ^ Given the typed string and a possible
-- completion, is the completion valid?
, sorter :: String -> [String] -> [String]
-- ^ Used to sort the possible completions by how well they
-- match the search string (see X.P.FuzzyMatch for an
-- example).
}
data XPType = forall p . XPrompt p => XPT p
@ -268,6 +272,7 @@ instance Default XPConfig where
, showCompletionOnTab = False
, searchPredicate = isPrefixOf
, alwaysHighlight = False
, sorter = const id
}
{-# DEPRECATED defaultXPConfig "Use def (from Data.Default, and re-exported from XMonad.Prompt) instead." #-}
defaultXPConfig = def
@ -956,8 +961,10 @@ getCompletionFunction st = case operationMode st of
getCompletions :: XP [String]
getCompletions = do
s <- get
io $ getCompletionFunction s (commandToComplete (currentXPMode s) (command s))
`E.catch` \(SomeException _) -> return []
let q = commandToComplete (currentXPMode s) (command s)
compl = getCompletionFunction s
srt = sorter (config s)
io $ (srt q <$> compl q) `E.catch` \(SomeException _) -> return []
setComplWin :: Window -> ComplWindowDim -> XP ()
setComplWin w wi =
@ -1215,7 +1222,7 @@ historyCompletion = historyCompletionP (const True)
-- name satisfies the given predicate.
historyCompletionP :: (String -> Bool) -> ComplFunction
historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory
where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) []
where toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
-- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
-- laziness and stability for efficiency.

10
XMonad/Prompt/FuzzyMatch.hs
View File

@ -48,19 +48,19 @@ import Data.List
-- 11. "FastSPR" is ranked before "FasterSPR" because its match starts at
-- position 5 while the match in "FasterSPR" starts at position 7.
--
-- To use these functions in an XPrompt, for example, for windowPromptGoto:
-- To use these functions in an XPrompt, for example, for windowPrompt:
--
-- > import XMonad.Prompt
-- > import XMonad.Prompt.Window ( windowPromptGoto )
-- > import XMonad.Prompt.Window ( windowPrompt )
-- > import XMonad.Prompt.FuzzyMatch
-- >
-- > myXPConfig = def { searchPredicate = fuzzyMatch
-- , sorter = fuzzySort
-- }
-- > , sorter = fuzzySort
-- > }
--
-- then add this to your keys definition:
--
-- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig)
-- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows)
--
-- For detailed instructions on editing the key bindings, see
-- "Xmonad.Doc.Extending#Editing_key_bindings".

23
XMonad/Util/ExtensibleState.hs
View File

@ -27,6 +27,7 @@ module XMonad.Util.ExtensibleState (
import Data.Typeable (typeOf,cast)
import qualified Data.Map as M
import XMonad.Core
import XMonad.Util.PureX
import qualified Control.Monad.State as State
import Data.Maybe (fromMaybe)
@ -75,27 +76,29 @@ import Data.Maybe (fromMaybe)
--
-- | Modify the map of state extensions by applying the given function.
modifyStateExts :: (M.Map String (Either String StateExtension)
-> M.Map String (Either String StateExtension))
-> X ()
modifyStateExts
:: XLike m
=> (M.Map String (Either String StateExtension)
-> M.Map String (Either String StateExtension))
-> m ()
modifyStateExts f = State.modify $ \st -> st { extensibleState = f (extensibleState st) }
-- | Apply a function to a stored value of the matching type or the initial value if there
-- is none.
modify :: ExtensionClass a => (a -> a) -> X ()
modify :: (ExtensionClass a, XLike m) => (a -> a) -> m ()
modify f = put . f =<< get
-- | Add a value to the extensible state field. A previously stored value with the same
-- type will be overwritten. (More precisely: A value whose string representation of its type
-- is equal to the new one's)
put :: ExtensionClass a => a -> X ()
put :: (ExtensionClass a, XLike m) => a -> m ()
put v = modifyStateExts . M.insert (show . typeOf $ v) . Right . extensionType $ v
-- | Try to retrieve a value of the requested type, return an initial value if there is no such value.
get :: ExtensionClass a => X a
get :: (ExtensionClass a, XLike m) => m a
get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
where toValue val = maybe initialValue id $ cast val
getState' :: ExtensionClass a => a -> X a
getState' :: (ExtensionClass a, XLike m) => a -> m a
getState' k = do
v <- State.gets $ M.lookup (show . typeOf $ k) . extensibleState
case v of
@ -110,14 +113,14 @@ get = getState' undefined -- `trick' to avoid needing -XScopedTypeVariables
[(x,"")] -> Just x
_ -> Nothing
gets :: ExtensionClass a => (a -> b) -> X b
gets :: (ExtensionClass a, XLike m) => (a -> b) -> m b
gets = flip fmap get
-- | Remove the value from the extensible state field that has the same type as the supplied argument
remove :: ExtensionClass a => a -> X ()
remove :: (ExtensionClass a, XLike m) => a -> m ()
remove wit = modifyStateExts $ M.delete (show . typeOf $ wit)
modified :: (ExtensionClass a, Eq a) => (a -> a) -> X Bool
modified :: (ExtensionClass a, Eq a, XLike m) => (a -> a) -> m Bool
modified f = do
v <- get
case f v of

276
XMonad/Util/PureX.hs Normal file
View File

@ -0,0 +1,276 @@
{-# LANGUAGE GeneralizedNewtypeDeriving, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Util.PureX
-- Copyright : L. S. Leary 2018
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : L. S. Leary
-- Stability : unstable
-- Portability : not portable
--
-- Unlike the opaque @IO@ actions that @X@ actions can wrap, regular reads from
-- the 'XConf' and modifications to the 'XState' are fundamentally pure—contrary
-- to the current treatment of such actions in most xmonad code. Pure
-- modifications to the 'WindowSet' can be readily composed, but due to the need
-- for those modifications to be properly handled by 'windows', other pure
-- changes to the @XState@ cannot be interleaved with those changes to the
-- @WindowSet@ without superfluous refreshes, hence breaking composability.
--
-- This module aims to rectify that situation by drawing attention to it and
-- providing 'PureX': a pure type with the same monadic interface to state as
-- @X@. The 'XLike' typeclass enables writing actions generic over the two
-- monads; if pure, existing @X@ actions can be generalised with only a change
-- to the type signature. Various other utilities are provided, in particular
-- the 'defile' function which is needed by end-users.
--
-----------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Util.PureX (
-- * Usage
-- $Usage
PureX, XLike(..), defile,
windowBracket', handlingRefresh,
runPureX, toXLike,
-- * Utility
-- ** Generalised when* functions
when', whenM', whenJust',
-- ** Infix operators
(<?), (&>),
-- ** @WindowSet@ operations
withWindowSet', withFocii,
modify'', modifyWindowSet',
getStack, putStack, peek,
view, greedyView, invisiView,
shift, curScreen, curWorkspace,
curTag, curScreenId,
) where
-- xmonad
import XMonad
import qualified XMonad.StackSet as W
-- mtl
import Control.Monad.State
import Control.Monad.Reader
-- base
import Data.Semigroup (Semigroup(..), Any(..))
import Control.Applicative (liftA2)
-- }}}
-- --< Usage >-- {{{
-- $Usage
--
-- The suggested pattern of usage for this module is to write composable, pure
-- actions as @XLike m => m Any@ or @PureX Any@ values, where the encapsulated
-- @Any@ value encodes whether or not a refresh is needed to properly institute
-- changes. These values can then be combined monoidally (i.e. with '<>' AKA
-- '<+>') or with operators such as '<*', '*>', '<?' and '&>' to build seamless
-- new actions. The end user can run and handle the effects of the pure actions
-- in the @X@ monad by applying the @defile@ function, which you may want to
-- re-export. Alternatively, if an action does not make stackset changes that
-- need to be handled by @windows@, it can be written with as an
-- @XLike m => m ()@ and used directly.
--
-- Unfortunately since layouts must handle messages in the @X@ monad, this
-- approach does not quite apply to actions involving them. However a relatively
-- direct translation to impure actions is possible: you can write composable,
-- refresh-tracking actions as @X Any@ values, making sure to eschew
-- refresh-inducing functions like @windows@ and @sendMessage@ in favour of
-- 'modifyWindowSet' and utilities provided by "XMonad.Actions.MessageFeedback".
-- The 'windowBracket_' function recently added to "XMonad.Operations" is the
-- impure analogue of @defile@. Note that @PureX Any@ actions can be composed
-- into impure ones after applying 'toX'; don't use @defile@ for this. E.g.
--
-- > windowBracket_ (composableImpureAction <> toX composablePureAction)
--
-- Although both @X@ and @PureX@ have Monoid instances over monoidal values,
-- @(XLike m, Monoid a)@ is not enough to infer @Monoid (m a)@ (due to the
-- open-world assumption). Hence a @Monoid (m Any)@ constraint may need to be
-- used when working with @XLike m => m Any@ where no context is forcing @m@ to
-- unify with @X@ or @PureX@. This can also be avoided by working with
-- @PureX Any@ values and generalising them with 'toXLike' where necessary.
--
-- @PureX@ also enables a more monadic style when writing windowset operations;
-- see the implementation of the utilities in this module for examples.
-- For an example of a whole module written in terms of this one, see
-- "XMonad.Hooks.RefocusLast".
--
-- }}}
-- --< Core >-- {{{
-- | The @PureX@ newtype over @ReaderT XConf (State XState) a@.
newtype PureX a = PureX (ReaderT XConf (State XState) a)
deriving (Functor, Applicative, Monad, MonadReader XConf, MonadState XState)
instance Semigroup a => Semigroup (PureX a) where
(<>) = liftA2 (<>)
instance Monoid a => Monoid (PureX a) where
mappend = liftA2 mappend
mempty = return mempty
-- | The @XLike@ typeclass over monads reading @XConf@ values and tracking
-- @XState@ state.
class (MonadReader XConf m, MonadState XState m) => XLike m where
toX :: m a -> X a
instance XLike X where
toX = id
instance XLike PureX where
toX = toXLike
-- | Consume a @PureX a@.
runPureX :: PureX a -> XConf -> XState -> (a, XState)
runPureX (PureX m) = runState . runReaderT m
-- | Despite appearing less general, @PureX a@ is actually isomorphic to
-- @XLike m => m a@.
toXLike :: XLike m => PureX a -> m a
toXLike pa = state =<< runPureX pa <$> ask
-- | A generalisation of 'windowBracket'. Handles refreshing for an action that
-- __performs no refresh of its own__ but can indicate that it needs one
-- through a return value that's tested against the supplied predicate. The
-- action can interleave changes to the @WindowSet@ with @IO@ or changes to
-- the @XState@.
windowBracket' :: XLike m => (a -> Bool) -> m a -> X a
windowBracket' p = windowBracket p . toX
-- | A version of @windowBracket'@ specialised to take a @PureX Any@ action and
-- handle windowset changes with a refresh when the @Any@ holds @True@.
-- Analogous to 'windowBracket_'. Don't bake this into your action; it's for
-- the end-user.
defile :: PureX Any -> X ()
defile = void . windowBracket' getAny
-- | A version of @windowBracket@ specialised to take an @X ()@ action and
-- perform a refresh handling any changes it makes.
handlingRefresh :: X () -> X ()
handlingRefresh = windowBracket (\_ -> True)
-- }}}
-- --< Utility >-- {{{
-- | A 'when' that accepts a monoidal return value.
when' :: (Monad m, Monoid a) => Bool -> m a -> m a
when' b ma = if b then ma else return mempty
-- | A @whenX@/@whenM@ that accepts a monoidal return value.
whenM' :: (Monad m, Monoid a) => m Bool -> m a -> m a
whenM' mb m = when' <$> mb >>= ($ m)
-- | A 'whenJust' that accepts a monoidal return value.
whenJust' :: (Monad m, Monoid b) => Maybe a -> (a -> m b) -> m b
whenJust' = flip $ maybe (return mempty)
-- | Akin to @<*@. Discarding the wrapped value in the second argument either
-- way, keep its effects iff the first argument returns @Any True@.
(<?) :: Monad m => m Any -> m a -> m Any
ifthis <? thenthis = do
Any b <- ifthis
when' b (Any b <$ thenthis)
infixl 4 <?
-- | Akin to a low precedence @<>@. Combines applicative effects left-to-right
-- and wrapped @Bool@s with @&&@ (instead of @||@).
(&>) :: Applicative f => f Any -> f Any -> f Any
(&>) = liftA2 $ \(Any b1) (Any b2) -> Any (b1 && b2)
infixl 1 &>
-- | A generalisation of 'withWindowSet'.
withWindowSet' :: XLike m => (WindowSet -> m a) -> m a
withWindowSet' = (=<< gets windowset)
-- | If there is a current tag and a focused window, perform an operation with
-- them, otherwise return mempty.
withFocii :: (XLike m, Monoid a) => (WorkspaceId -> Window -> m a) -> m a
withFocii f = join $ (whenJust' <$> peek) <*> (f <$> curTag)
-- | A generalisation of 'modifyWindowSet'.
modifyWindowSet' :: XLike m => (WindowSet -> WindowSet) -> m ()
modifyWindowSet' f = modify $ \xs -> xs { windowset = f (windowset xs) }
-- | A variant of @W.modify@ and @W.modify'@ handling the @Nothing@ and @Just@
-- cases uniformly.
modify''
:: (Maybe (W.Stack a) -> Maybe (W.Stack a))
-> (W.StackSet i l a s sd -> W.StackSet i l a s sd)
modify'' f = W.modify (f Nothing) (f . Just)
-- | Get the stack from the current workspace.
getStack :: XLike m => m (Maybe (W.Stack Window))
getStack = W.stack <$> curWorkspace
-- | Set the stack on the current workspace.
putStack :: XLike m => Maybe (W.Stack Window) -> m ()
putStack mst = modifyWindowSet' . modify'' $ \_ -> mst
-- | Get the focused window if there is one.
peek :: XLike m => m (Maybe Window)
peek = withWindowSet' (return . W.peek)
-- | Get the current screen.
curScreen
:: XLike m
=> m (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)
curScreen = withWindowSet' (return . W.current)
-- | Get the current workspace.
curWorkspace :: XLike m => m WindowSpace
curWorkspace = W.workspace <$> curScreen
-- | Get the current tag.
curTag :: XLike m => m WorkspaceId
curTag = W.tag <$> curWorkspace
-- | Get the current @ScreenId@.
curScreenId :: XLike m => m ScreenId
curScreenId = W.screen <$> curScreen
-- | Internal. Refresh-tracking logic of view operations.
viewWith
:: XLike m => (WorkspaceId -> WindowSet -> WindowSet) -> WorkspaceId -> m Any
viewWith viewer tag = do
itag <- curTag
when' (tag /= itag) $ do
modifyWindowSet' (viewer tag)
Any . (tag ==) <$> curTag
-- | A version of @W.view@ that tracks the need to refresh.
view :: XLike m => WorkspaceId -> m Any
view = viewWith W.view
-- | A version of @W.greedyView@ that tracks the need to refresh.
greedyView :: XLike m => WorkspaceId -> m Any
greedyView = viewWith W.greedyView
-- | View a workspace if it's not visible. An alternative to @view@ and
-- @greedyView@ that—rather than changing the current screen or affecting
-- another—opts not to act.
invisiView :: XLike m => WorkspaceId -> m Any
invisiView = viewWith $ \tag ws ->
if tag `elem` (W.tag . W.workspace <$> W.current ws : W.visible ws)
then W.view tag ws
else ws
-- | A refresh-tracking version of @W.Shift@.
shift :: XLike m => WorkspaceId -> m Any
shift tag = withFocii $ \ctag fw ->
when' (tag /= ctag) $ do
modifyWindowSet' (W.shiftWin tag fw)
mfw' <- peek
return (Any $ Just fw /= mfw')
-- }}}

2
XMonad/Util/Stack.hs
View File

@ -80,7 +80,7 @@ module XMonad.Util.Stack ( -- * Usage
) where
import qualified XMonad.StackSet as W
import Control.Applicative ((<|>))
import Control.Applicative ((<|>),(<$>),(<$))
import Control.Monad (guard,liftM)
import Data.List (sortBy)

18
XMonad/Util/Themes.hs
View File

@ -20,6 +20,7 @@ module XMonad.Util.Themes
, xmonadTheme
, smallClean
, robertTheme
, darkTheme
, deiflTheme
, oxymor00nTheme
, donaldTheme
@ -90,6 +91,7 @@ ppThemeInfo t = themeName t <> themeDescription t <> "by" <> themeAuthor t
listOfThemes :: [ThemeInfo]
listOfThemes = [ xmonadTheme
, smallClean
, darkTheme
, deiflTheme
, oxymor00nTheme
, robertTheme
@ -163,6 +165,22 @@ robertTheme =
}
}
-- | Dark Theme, by Lucian Poston.
darkTheme :: ThemeInfo
darkTheme =
newTheme { themeName = "darkTheme"
, themeAuthor = "Lucian Poston"
, themeDescription = "Dark Theme"
, theme = def { inactiveBorderColor = "#202030"
, activeBorderColor = "#a0a0d0"
, inactiveColor = "#000000"
, activeColor = "#000000"
, inactiveTextColor = "#607070"
, activeTextColor = "#a0d0d0"
, decoHeight = 15
}
}
-- | deifl\'s Theme, by deifl.
deiflTheme :: ThemeInfo
deiflTheme =

11
xmonad-contrib.cabal
View File

@ -1,5 +1,5 @@
name: xmonad-contrib
version: 0.13
version: 0.15
homepage: http://xmonad.org/
synopsis: Third party extensions for xmonad
description:
@ -36,7 +36,7 @@ cabal-version: >= 1.6
build-type: Simple
bug-reports: https://github.com/xmonad/xmonad-contrib/issues
tested-with: GHC==7.6.3, GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.1
tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.1, GHC==8.2.2, GHC==8.4.3, GHC==8.6.1
source-repository head
type: git
@ -54,7 +54,7 @@ flag testing
library
build-depends: base >= 4.5 && < 5,
bytestring >= 0.10 && < 0.11,
containers >= 0.5 && < 0.6,
containers >= 0.5 && < 0.7,
directory,
extensible-exceptions,
filepath,
@ -65,7 +65,7 @@ library
mtl >= 1 && < 3,
unix,
X11>=1.6.1 && < 1.10,
xmonad>=0.13 && < 0.14,
xmonad >= 0.15 && < 0.16,
utf8-string,
semigroups
@ -181,7 +181,6 @@ library
XMonad.Hooks.Minimize
XMonad.Hooks.Place
XMonad.Hooks.PositionStoreHooks
XMonad.Hooks.RefocusLast
XMonad.Hooks.RestoreMinimized
XMonad.Hooks.ScreenCorners
XMonad.Hooks.Script
@ -253,6 +252,7 @@ library
XMonad.Layout.MultiColumns
XMonad.Layout.MultiToggle
XMonad.Layout.MultiToggle.Instances
XMonad.Layout.MultiToggle.TabBarDecoration
XMonad.Layout.Named
XMonad.Layout.NoBorders
XMonad.Layout.NoFrillsDecoration
@ -330,6 +330,7 @@ library
XMonad.Util.NoTaskbar
XMonad.Util.Paste
XMonad.Util.PositionStore
XMonad.Util.PureX
XMonad.Util.Rectangle
XMonad.Util.RemoteWindows
XMonad.Util.Replace