diff --git a/.travis.yml b/.travis.yml index 89106311..fda79e6f 100644 --- a/.travis.yml +++ b/.travis.yml @@ -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: diff --git a/CHANGES.md b/CHANGES.md index 8ba4134a..c127422f 100644 --- a/CHANGES.md +++ b/CHANGES.md @@ -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 diff --git a/XMonad/Actions/MessageFeedback.hs b/XMonad/Actions/MessageFeedback.hs index 1928d33f..1717f57c 100644 --- a/XMonad/Actions/MessageFeedback.hs +++ b/XMonad/Actions/MessageFeedback.hs @@ -1,7 +1,8 @@ ----------------------------------------------------------------------------- -- | -- Module : XMonad.Actions.MessageFeedback --- Copyright : (c) Quentin Moser +-- Copyright : (c) -- Quentin Moser +-- 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 () \ No newline at end of file +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 diff --git a/XMonad/Actions/PhysicalScreens.hs b/XMonad/Actions/PhysicalScreens.hs index 0d6aea21..ce54d132 100644 --- a/XMonad/Actions/PhysicalScreens.hs +++ b/XMonad/Actions/PhysicalScreens.hs @@ -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". diff --git a/XMonad/Actions/SwapPromote.hs b/XMonad/Actions/SwapPromote.hs index 8256c4ef..e8fc41aa 100644 --- a/XMonad/Actions/SwapPromote.hs +++ b/XMonad/Actions/SwapPromote.hs @@ -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 diff --git a/XMonad/Config/Azerty.hs b/XMonad/Config/Azerty.hs index af15e332..1bbfe195 100644 --- a/XMonad/Config/Azerty.hs +++ b/XMonad/Config/Azerty.hs @@ -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 diff --git a/XMonad/Hooks/DebugEvents.hs b/XMonad/Hooks/DebugEvents.hs index cec777c3..8292a2a4 100644 --- a/XMonad/Hooks/DebugEvents.hs +++ b/XMonad/Hooks/DebugEvents.hs @@ -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 diff --git a/XMonad/Hooks/RefocusLast.hs b/XMonad/Hooks/RefocusLast.hs deleted file mode 100644 index 3913c723..00000000 --- a/XMonad/Hooks/RefocusLast.hs +++ /dev/null @@ -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) - --- }}} - diff --git a/XMonad/Layout/Fullscreen.hs b/XMonad/Layout/Fullscreen.hs index 1080c851..4b8352af 100644 --- a/XMonad/Layout/Fullscreen.hs +++ b/XMonad/Layout/Fullscreen.hs @@ -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 diff --git a/XMonad/Layout/Grid.hs b/XMonad/Layout/Grid.hs index 845fa80e..769a6c63 100644 --- a/XMonad/Layout/Grid.hs +++ b/XMonad/Layout/Grid.hs @@ -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)] diff --git a/XMonad/Layout/Groups.hs b/XMonad/Layout/Groups.hs index c9258b58..d2aa9725 100644 --- a/XMonad/Layout/Groups.hs +++ b/XMonad/Layout/Groups.hs @@ -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 diff --git a/XMonad/Layout/Groups/Helpers.hs b/XMonad/Layout/Groups/Helpers.hs index baf42817..c77f1580 100644 --- a/XMonad/Layout/Groups/Helpers.hs +++ b/XMonad/Layout/Groups/Helpers.hs @@ -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 diff --git a/XMonad/Layout/MultiToggle.hs b/XMonad/Layout/MultiToggle.hs index 4bf1ba56..0d6081e4 100644 --- a/XMonad/Layout/MultiToggle.hs +++ b/XMonad/Layout/MultiToggle.hs @@ -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 diff --git a/XMonad/Layout/MultiToggle/TabBarDecoration.hs b/XMonad/Layout/MultiToggle/TabBarDecoration.hs new file mode 100644 index 00000000..867c5c30 --- /dev/null +++ b/XMonad/Layout/MultiToggle/TabBarDecoration.hs @@ -0,0 +1,47 @@ +{-# LANGUAGE TypeSynonymInstances, DeriveDataTypeable, MultiParamTypeClasses #-} + +----------------------------------------------------------------------------- +-- | +-- Module : XMonad.Layout.MultiToggle.TabBarDecoration +-- Copyright : (c) 2018 Lucian Poston +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : +-- 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') diff --git a/XMonad/Layout/NoBorders.hs b/XMonad/Layout/NoBorders.hs index b7f73fa1..0997ed69 100644 --- a/XMonad/Layout/NoBorders.hs +++ b/XMonad/Layout/NoBorders.hs @@ -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) diff --git a/XMonad/Layout/Spacing.hs b/XMonad/Layout/Spacing.hs index fe44cecc..e4efdd10 100644 --- a/XMonad/Layout/Spacing.hs +++ b/XMonad/Layout/Spacing.hs @@ -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 diff --git a/XMonad/Layout/StateFull.hs b/XMonad/Layout/StateFull.hs index 476255e5..ceacad1c 100644 --- a/XMonad/Layout/StateFull.hs +++ b/XMonad/Layout/StateFull.hs @@ -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 diff --git a/XMonad/Prompt.hs b/XMonad/Prompt.hs index 3ae58dd5..7ffa8128 100644 --- a/XMonad/Prompt.hs +++ b/XMonad/Prompt.hs @@ -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. diff --git a/XMonad/Prompt/FuzzyMatch.hs b/XMonad/Prompt/FuzzyMatch.hs index 24e306ae..a5d37d4a 100644 --- a/XMonad/Prompt/FuzzyMatch.hs +++ b/XMonad/Prompt/FuzzyMatch.hs @@ -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". diff --git a/XMonad/Util/ExtensibleState.hs b/XMonad/Util/ExtensibleState.hs index 7e12a12c..4132ce51 100644 --- a/XMonad/Util/ExtensibleState.hs +++ b/XMonad/Util/ExtensibleState.hs @@ -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 diff --git a/XMonad/Util/PureX.hs b/XMonad/Util/PureX.hs new file mode 100644 index 00000000..988ad5e5 --- /dev/null +++ b/XMonad/Util/PureX.hs @@ -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 '<*', '*>', '' 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@. +( m Any -> m a -> m Any +ifthis @. 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') + +-- }}} + diff --git a/XMonad/Util/Stack.hs b/XMonad/Util/Stack.hs index b774bc17..953de723 100644 --- a/XMonad/Util/Stack.hs +++ b/XMonad/Util/Stack.hs @@ -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) diff --git a/XMonad/Util/Themes.hs b/XMonad/Util/Themes.hs index f753a501..fc4875fe 100644 --- a/XMonad/Util/Themes.hs +++ b/XMonad/Util/Themes.hs @@ -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 = diff --git a/xmonad-contrib.cabal b/xmonad-contrib.cabal index 08e02764..23dc0b22 100644 --- a/xmonad-contrib.cabal +++ b/xmonad-contrib.cabal @@ -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