Merge branch 'master' into module-MutexScratchpads

.travis.yml

@@ -13,27 +13,32 @@ before_cache:
 
 matrix:
   include:
-    - env: CABALVER=1.16 GHCVER=7.6.3
+    - env: GHCVER=8.6.1  CABALVER=2.4
-      compiler: ": #GHC 7.6.3"
+      compiler: ": #GHC 8.6.1"
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
+      addons: { apt: { packages: [cabal-install-2.4,  ghc-8.6.1,  libxrandr-dev]
-    - env: CABALVER=1.18 GHCVER=7.8.4
+                     , sources:  [hvr-ghc]
-      compiler: ": #GHC 7.8.4"
+                     } }
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
+    - env: GHCVER=8.4.3  CABALVER=2.2
-    - env: CABALVER=1.22 GHCVER=7.10.3
+      compiler: ": #GHC 8.4.3"
-      compiler: ": #GHC 7.10.3"
+      addons: { apt: { packages: [cabal-install-2.2,  ghc-8.4.3,  libxrandr-dev]
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
+                     , sources:  [hvr-ghc]
-    - env: CABALVER=1.24 GHCVER=8.0.1
+                     } }
+    - 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 ];
@@ -42,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
@@ -57,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 ];
@@ -69,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:

CHANGES.md

@@ -1,27 +1,143 @@
 # Change Log / Release Notes
 
-## 0.14 (Not Yet)
+## unknown
 
 ### Breaking Changes
 
+  * `XMonad.Prompt`
+
+    - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and
+      `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt
+      actions.
+    - Prompt supports dynamic colors. Colors are now specified by the `XPColor`
+      type in `XPState` while `XPConfig` colors remain unchanged for backwards
+      compatibility.
+    - Fixes `showCompletionOnTab`.
+    - The behavior of `moveWord` and `moveWord'` has changed; brought in line
+      with the documentation and now internally consistent. The old keymaps
+      retain the original behavior; see the documentation to do the same your
+      XMonad configuration.
+
+### 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.
+
+  * `XMonad.Util.ExclusiveScratchpads`
+
+    Named scratchpads that can be mutually exclusive: This new module extends the
+    idea of named scratchpads such that you can define "families of scratchpads"
+    that are exclusive on the same screen. It also allows to remove this
+    constraint of being mutually exclusive with another scratchpad.
+
+### 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`).
+
+    Fixes a potential bug where an error during prompt execution would
+    leave the window open and keep the keyboard grabbed. See issue
+    [#180](https://github.com/xmonad/xmonad-contrib/issues/180).
+
+    Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where
+    using tab to wrap around the completion rows would fail when maxComplRows is
+    restricting the number of rows of output.
+
+  * `XMonad.Actions.DynamicProjects`
+
+    Make the input directory read from the prompt in `DynamicProjects`
+    absolute wrt the current directory.
+
+    Before this, the directory set by the prompt was treated like a relative
+    directory. This means that when you switch from a project with directory
+    `foo` into a project with directory `bar`, xmonad actually tries to `cd`
+    into `foo/bar`, instead of `~/bar` as expected.
+
+  * `XMonad.Actions.DynamicWorkspaceOrder`
+
+    Add a version of `withNthWorkspace` that takes a `[WorkspaceId] ->
+    [WorkspaceId]` transformation to apply over the list of workspace tags
+    resulting from the dynamic order.
+
+  * `XMonad.Actions.GroupNavigation`
+
+    Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy
+    cycling between all windows on all visible workspaces.
+
+
+## 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
+
+  * `XMonad.Layout.Spacing`
+
+    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
+    of four sides each with its own border width. The screen and window borders
+    are now separate and can be independently toggled on/off. The screen border
+    examines the window/rectangle list resulting from 'runLayout' rather than
+    the stack, which makes it compatible with layouts such as the builtin
+    `Full`. The child layout will always be called with the screen border. If
+    only a single window is displayed (and `smartBorder` enabled), it will be
+    expanded into the original layout rectangle. Windows that are displayed but
+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',
+    will be shifted out of the way, but not scaled (not possible for windows
+    created by XMonad). This isn't perfect, so you might want to disable
+    `Spacing` on such layouts.
+
+  * `XMonad.Util.SpawnOnce`
+
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
+      to shift spawned windows to a specific workspace.
+
   * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
 
   * `XMonad.Actions.GridSelect`
 
     - 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
@@ -32,27 +148,105 @@
      sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has
      been completely deprecated, and its functions have no effect.
 
+  * `XMonad.Prompt.Unicode`
+
+    - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
+      filepath to the `UnicodeData.txt` file containing unicode data.
+
+  * `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
+    value are:
+
+     - `def`(same as verticalScreenOrderer) will keep previous behavior
+     - `verticalScreenOrderer`
+     - `horizontalScreenOrderer`
+
+    One can build his custom ScreenOrderer using:
+     - `screenComparatorById` (allow to order by Xinerama id)
+     - `screenComparatorByRectangle` (allow to order by screen coordonate)
+     - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)
+
+  * `XMonad.Util.WorkspaceCompare`
+
+    `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
+    `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific
+      remapping of all visible windows to the active workspace (#216).
+    - Handle workspace renames that might be occuring in the custom function
+      that is provided to ewmhDesktopsLogHookCustom.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
+      `xmobarRaw`.
+
+  * `XMonad.Layout.NoBorders`
+
+    The layout now maintains a list of windows that never have borders, and a
+    list of windows that always have borders. Use `BorderMessage` to manage
+    these lists and the accompanying event hook (`borderEventHook`) to remove
+    destroyed windows from them. Also provides the `hasBorder` manage hook.
+
+    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
+    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See
+    the documentation for more information.
+
+    The type signature of `hiddens` was changed to accept a new `Rectangle`
+    parameter representing the bounds of the parent layout, placed after the
+    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
+    will need to update their configuration. For example, replace "`hiddens amb
+    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.Util.ExclusiveScratchpads`
+  * `XMonad.Layout.MultiToggle.TabBarDecoration`
 
-    Named scratchpads that can be mutually exclusive: This new module extends the
+    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
-    idea of named scratchpads such that you can define "families of scratchpads"
+    dynamically toggle `XMonad.Layout.TabBarDecoration`.
-    that are exclusive on the same screen. It also allows to remove this
-    constraint of being mutually exclusive with another scratchpad.
 
-  * `XMonad.Hooks.Focus`
+  * `XMonad.Layout.StateFull`
 
-    A new module extending ManageHook EDSL to work on focused windows and
+    Provides `StateFull`: a stateful form of `Full` that does not misbehave when
-    current workspace.
+    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.
 
-    This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply
+  * `XMonad.Actions.SwapPromote`
-    `manageHook` to activated window too. Thus, it may lead to unexpected
+
-    results, when `manageHook` previously working only for new windows, start
+    Module for tracking master window history per workspace, and associated
-    working for activated windows too. It may be solved, by adding
+    functions for manipulating the stack using such history.
-    `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`
 
@@ -63,8 +257,98 @@
     Also provides the `repeatableAction` helper function which can be used to
     build actions that can be repeated while a modifier key is held down.
 
+  * `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"
+    they match.
+
+  * `XMonad.Utils.SessionStart`
+
+    A new module that allows to query if this is the first time xmonad is
+    started of the session, or a xmonad restart.
+
+    Currently needs manual setting of the session start flag. This could be
+    automated when this moves to the core repository.
+
+  * `XMonad.Layout.MultiDishes`
+
+    A new layout based on Dishes, however it accepts additional configuration
+    to allow multiple windows within a single stack.
+
+  * `XMonad.Util.Rectangle`
+
+    A new module for handling pixel rectangles.
+
+  * `XMonad.Layout.BinaryColumn`
+
+    A new module which provides a simple grid layout, halving the window
+    sizes of each window after master.
+
+    This is similar to Column, but splits the window in a way
+    that maintains window sizes upon adding & removing windows as well as the
+    option to specify a minimum window size.
+
 ### Bug Fixes and Minor Changes
 
+  * `XMonad.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`
+
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
+    Monoids
+
+  * `XMonad.Hooks.Mosaic`
+
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
+    Monoids
+
+  * `XMonad.Actions.Navigation2D`
+
+    Added `sideNavigation` and a parameterised variant, providing a navigation
+    strategy with fewer quirks for tiled layouts using X.L.Spacing.
+
+  * `XMonad.Layout.Fullscreen`
+
+    The fullscreen layouts will now not render any window that is totally
+    obscured by fullscreen windows.
+
+  * `XMonad.Layout.Gaps`
+
+    Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
+    modifications to the `GapSpec`.
+
+  * `XMonad.Layout.Groups`
+
+    Added a new `ModifyX` message type that allows the modifying
+    function to return values in the `X` monad.
+
+  * `XMonad.Actions.Navigation2D`
+
+    Generalised (and hence deprecated) hybridNavigation to hybridOf.
+
+  * `XMonad.Layout.LayoutHints`
+
+    Preserve the window order of the modified layout, except for the focused
+    window that is placed on top. This fixes an issue where the border of the
+    focused window in certain situations could be rendered below borders of
+    unfocused windows. It also has a lower risk of interfering with the
+    modified layout.
+
+  * `XMonad.Layout.MultiColumns`
+
+    The focused window is placed above the other windows if they would be made to
+    overlap due to a layout modifier. (As long as it preserves the window order.)
+
   * `XMonad.Actions.GridSelect`
 
     - The vertical centring of text in each cell has been improved.
@@ -102,6 +386,10 @@
 
     Make type of ManageHook combinators more general.
 
+  * `XMonad.Prompt`
+
+    Export `insertString`.
+
   * `XMonad.Prompt.Window`
 
     - New function: `windowMultiPrompt` for using `mkXPromptWithModes`
@@ -118,6 +406,68 @@
       changed and you want to re-sort windows into the appropriate
       sub-layout.
 
+  * `XMonad.Actions.Minimize`
+
+    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
+      actions with both the last and first minimized windows easily.
+
+  * `XMonad.Config.Gnome`
+
+    - Update logout key combination (modm+shift+Q) to work with modern
+
+  * `XMonad.Prompt.Pass`
+
+    - New function `passTypePrompt` which uses `xdotool` to type in a password
+      from the store, bypassing the clipboard.
+    - New function `passEditPrompt` for editing a password from the
+      store.
+    - Now handles password labels with spaces and special characters inside
+      them.
+
+  * `XMonad.Prompt.Unicode`
+
+    - Persist unicode data cache across XMonad instances due to
+      `ExtensibleState` now used instead of `unsafePerformIO`.
+    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
+      Unicode character via `xdotool` instead of copying it to the paste buffer.
+    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
+      acts as a generic function to pass the selected Unicode character to any
+      program.
+
+  * `XMonad.Prompt.AppendFile`
+
+    - New function `appendFilePrompt'` which allows for transformation of the
+      string passed by a user before writing to a file.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added a new function `dzenWithFlags` which allows specifying the arguments
+    passed to `dzen2` invocation. The behaviour of current `dzen` function is
+    unchanged.
+
+  * `XMonad.Util.Dzen`
+
+    - Now provides functions `fgColor` and `bgColor` to specify foreground and
+    background color, `align` and `slaveAlign` to set text alignment, and
+    `lineCount` to enable a second (slave) window that displays lines beyond
+    the initial (title) one.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added optional `ppVisibleNoWindows` to differentiate between empty
+      and non-empty visible workspaces in pretty printing.
+
+  * `XMonad.Actions.DynamicWorkspaceOrder`
+
+    - 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

README.md

@@ -1,14 +1,15 @@
 # xmonad-contrib: Third Party Extensions to the xmonad Window Manager
 
 [![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
+[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)
 
 You need the ghc compiler and xmonad window manager installed in
 order to use these extensions.
 
 For installation and configuration instructions, please see the
-[xmonad website] [xmonad], the documents included with the
+[xmonad website][xmonad], the documents included with the
-[xmonad source distribution] [xmonad-git], and the
+[xmonad source distribution][xmonad-git], and the
-[online haddock documentation] [xmonad-docs].
+[online haddock documentation][xmonad-docs].
 
 ## Getting or Updating XMonadContrib
 
@@ -17,7 +18,7 @@ For installation and configuration instructions, please see the
   * Git version: <https://github.com/xmonad/xmonad-contrib>
 
 (To use git xmonad-contrib you must also use the
-[git version of xmonad] [xmonad-git].)
+[git version of xmonad][xmonad-git].)
 
 ## Contributing
 
@@ -28,15 +29,15 @@ example, to use the Grid layout, one would import:
 
     XMonad.Layout.Grid
 
-For further details, see the [documentation] [developing] for the
+For further details, see the [documentation][developing] for the
-`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
+`XMonad.Doc.Developing` module, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)  and the [xmonad website][xmonad].
 
 ## License
 
 Code submitted to the contrib repo is licensed under the same license as
 xmonad itself, with copyright held by the authors.
-
+ 
 [xmonad]: http://xmonad.org
 [xmonad-git]: https://github.com/xmonad/xmonad
-[xmonad-docs]: http://www.xmonad.org/xmonad-docs
+[xmonad-docs]: http://hackage.haskell.org/package/xmonad
-[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
+[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html

XMonad/Actions/Commands.hs

@@ -19,6 +19,7 @@ module XMonad.Actions.Commands (
                              -- $usage
                              commandMap,
                              runCommand,
+                             runCommandConfig,
                              runCommand',
                              workspaceCommands,
                              screenCommands,
@@ -103,11 +104,18 @@ defaultCommands = do
         ]
 
 -- | Given a list of command\/action pairs, prompt the user to choose a
---   command and return the corresponding action.
+--   command using dmenu and return the corresponding action.
 runCommand :: [(String, X ())] -> X ()
-runCommand cl = do
+runCommand = runCommandConfig dmenu
+
+
+-- | Given a list of command\/action pairs, prompt the user to choose a
+--   command using dmenu-compatible launcher and return the corresponding action.
+--   See X.U.Dmenu for compatible launchers.
+runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
+runCommandConfig f cl = do
   let m = commandMap cl
-  choice <- dmenu (M.keys m)
+  choice <- f (M.keys m)
   fromMaybe (return ()) (M.lookup choice m)
 
 -- | Given the name of a command from 'defaultCommands', return the

XMonad/Actions/DynamicProjects.hs

@@ -50,7 +50,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe, isNothing)
 import Data.Monoid ((<>))
-import System.Directory (setCurrentDirectory, getHomeDirectory)
+import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
 import XMonad
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Prompt
@@ -182,7 +182,8 @@ instance XPrompt ProjectPrompt where
       modifyProject (\p -> p { projectName = name })
 
   modeAction (ProjectPrompt DirMode _) buf auto = do
-    let dir = if null auto then buf else auto
+    let dir' = if null auto then buf else auto
+    dir <- io $ makeAbsolute dir'
     modifyProject (\p -> p { projectDirectory = dir })
 
 --------------------------------------------------------------------------------

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -23,11 +23,14 @@ module XMonad.Actions.DynamicWorkspaceOrder
       getWsCompareByOrder
     , getSortByOrder
     , swapWith
+    , updateName
+    , removeName
 
     , moveTo
     , moveToGreedy
     , shiftTo
 
+    , withNthWorkspace'
     , withNthWorkspace
 
     ) where
@@ -152,6 +155,21 @@ swapOrder w1 w2 = do
   XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
   windows id  -- force a status bar update
 
+-- | Update the name of a workspace in the stored order.
+updateName :: WorkspaceId -> WorkspaceId -> X ()
+updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
+
+-- | Remove a workspace from the stored order.
+removeName :: WorkspaceId -> X ()
+removeName = XS.modify . withWSO . M.delete
+
+-- | Update a key in a Map.
+changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
+changeKey oldKey newKey oldMap =
+  case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
+    (Nothing, _) -> oldMap
+    (Just val, newMap) -> M.insert newKey val newMap
+
 -- | View the next workspace of the given type in the given direction,
 -- where \"next\" is determined using the dynamic workspace order.
 moveTo :: Direction1D -> WSType -> X ()
@@ -166,13 +184,19 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
 shiftTo :: Direction1D -> WSType -> X ()
 shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
 
+-- | Do something with the nth workspace in the dynamic order after
+--   transforming it.  The callback is given the workspace's tag as well
+--   as the 'WindowSet' of the workspace itself.
+withNthWorkspace' :: ([WorkspaceId] -> [WorkspaceId]) -> (String -> WindowSet -> WindowSet) -> Int -> X ()
+withNthWorkspace' tr job wnum = do
+  sort <- getSortByOrder
+  ws <- gets (tr . map W.tag . sort . W.workspaces . windowset)
+  case drop wnum ws of
+    (w:_) -> windows $ job w
+    []    -> return ()
+
 -- | Do something with the nth workspace in the dynamic order.  The
 --   callback is given the workspace's tag as well as the 'WindowSet'
 --   of the workspace itself.
 withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
-withNthWorkspace job wnum = do
+withNthWorkspace = withNthWorkspace' id
-  sort <- getSortByOrder
-  ws <- gets (map W.tag . sort . W.workspaces . windowset)
-  case drop wnum ws of
-    (w:_) -> windows $ job w
-    []    -> return ()

XMonad/Actions/GroupNavigation.hs

@@ -16,7 +16,7 @@
 -- query.
 --
 -- Also provides a method for jumping back to the most recently used
--- window in any given group.
+-- window in any given group, and predefined groups.
 --
 ----------------------------------------------------------------------
 
@@ -27,9 +27,14 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
                                       , nextMatchOrDo
                                       , nextMatchWithThis
                                       , historyHook
+
+                                        -- * Utilities
+                                        -- $utilities
+                                      , isOnAnyVisibleWS
                                       ) where
 
 import Control.Monad.Reader
+import Control.Monad.State
 import Data.Foldable as Fold
 import Data.Map as Map
 import Data.Sequence as Seq
@@ -142,7 +147,7 @@ orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
     where
       wspcs      = SS.workspaces ss
       wspcsMap   = Fold.foldl' (\m ws -> Map.insert (SS.tag ws) ws m) Map.empty wspcs
-      wspcs'     = fmap (\wsid -> wspcsMap ! wsid) wsids
+      wspcs'     = fmap (wspcsMap !) wsids
       isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
 
 --- History navigation, requires a layout modifier -------------------
@@ -167,7 +172,7 @@ updateHistory :: HistoryDB -> X HistoryDB
 updateHistory (HistoryDB oldcur oldhist) = withWindowSet $ \ss -> do
   let newcur   = SS.peek ss
       wins     = Set.fromList $ SS.allWindows ss
-      newhist  = flt (flip Set.member wins) (ins oldcur oldhist)
+      newhist  = flt (`Set.member` wins) (ins oldcur oldhist)
   return $ HistoryDB newcur (del newcur newhist)
   where
     ins x xs = maybe xs (<| xs) x
@@ -216,3 +221,22 @@ findM cond xs = findM' cond (viewl xs)
       if isMatch
         then return (Just x')
         else findM qry xs'
+
+
+-- $utilities
+-- #utilities#
+-- Below are handy queries for use with 'nextMatch', 'nextMatchOrDo',
+-- and 'nextMatchWithThis'.
+
+-- | A query that matches all windows on visible workspaces. This is
+-- useful for configurations with multiple screens, and matches even
+-- invisible windows.
+isOnAnyVisibleWS :: Query Bool
+isOnAnyVisibleWS = do
+  w <- ask
+  ws <- liftX $ gets windowset
+  let allVisible = concat $ maybe [] SS.integrate . SS.stack . SS.workspace <$> SS.current ws:SS.visible ws
+      visibleWs = w `elem` allVisible
+      unfocused = maybe True (w /=) $ SS.peek ws
+  return $ visibleWs && unfocused
+

XMonad/Actions/MessageFeedback.hs

@@ -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 (
+module XMonad.Actions.MessageFeedback
-                                      -- * Usage
+    ( -- * Usage
-                                      -- $usage
+      -- $usage
 
-                                        send
+      -- * Messaging variants
-                                      , tryMessage
-                                      , tryMessage_
-                                      , tryInOrder
-                                      , tryInOrder_
-                                      , sm
-                                      , sendSM
-                                      , sendSM_
-                                      ) where
 
-import XMonad.Core ( X (), Message, SomeMessage(..), LayoutClass(..), windowset, catchX )
+      -- ** 'SomeMessage'
-import XMonad.StackSet ( current, workspace, layout, tag )
+      sendSomeMessageB, sendSomeMessage
-import XMonad.Operations ( updateLayout )
+    , sendSomeMessageWithNoRefreshB, sendSomeMessageWithNoRefresh
+    , sendSomeMessageWithNoRefreshToCurrentB, sendSomeMessageWithNoRefreshToCurrent
 
-import Control.Monad.State ( gets )
+      -- ** 'Message'
-import Data.Maybe ( isJust )
+    , sendMessageB
-import Control.Applicative ((<$>))
+    , 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.
+-- whereas configuration options will expect a @X ()@ action. For example, the
--- For example, the key binding
+-- 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
+-- is mis-typed. For this reason, this module provides alternatives (not ending
--- an underscore, e.g. tryMessage_) that discard their result and return an @X ()@.
+-- with an uppercase \"B\", e.g. 'XMonad.Operations.sendMessage' rather than
--- For example, to correct the previous example:
+-- '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
+-- | Variant of 'XMonad.Operations.sendMessage'. Accepts 'SomeMessage'; to use
--- message was handled by the layout, False otherwise.
+-- 'Message' see 'sendMessageB'. Returns @True@ if the message was handled,
-send :: Message a => a -> X Bool
+-- @False@ otherwise. Instead of using 'sendSomeMessageWithNoRefreshToCurrentB'
-send = sendSM . sm
+-- 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.
+-- | Variant of 'sendSomeMessageB' that discards the result.
--- Returns True if either message was handled, False otherwise.
+sendSomeMessage :: SomeMessage -> X ()
-tryMessage :: (Message a, Message b) => a -> b -> X Bool
+sendSomeMessage = void . sendSomeMessageB
-tryMessage m1 m2 = do b <- send m1
-                      if b then return True else send m2
 
-tryMessage_ :: (Message a, Message b) => a -> b -> X ()
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh'. Accepts
-tryMessage_ m1 m2 = tryMessage m1 m2 >> return ()
+-- '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
+-- | Variant of 'sendSomeMessageWithNoRefreshB' that discards the result.
--- is handled. Returns True if one of the messages was handled, False otherwise.
+sendSomeMessageWithNoRefresh :: SomeMessage -> Workspace WorkspaceId (Layout Window) Window -> X ()
-tryInOrder :: [SomeMessage] -> X Bool
+sendSomeMessageWithNoRefresh m = void . sendSomeMessageWithNoRefreshB m
-tryInOrder [] = return False
-tryInOrder (m:ms) = do b <- sendSM m
-                       if b then return True else tryInOrder ms
 
-tryInOrder_ :: [SomeMessage] -> X ()
+-- | Variant of 'XMonad.Operations.sendMessageWithNoRefresh' that sends the
-tryInOrder_ ms = tryInOrder ms >> return ()
+-- 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
+sendSM = sendSomeMessageWithNoRefreshToCurrentB
-              ml' <- handleMessage (layout w) m `catchX` return Nothing
-              updateLayout (tag w) ml'
-              return $ isJust ml'
-
 
+-- | 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

XMonad/Actions/Minimize.hs

@@ -29,6 +29,8 @@ module XMonad.Actions.Minimize
   , maximizeWindowAndFocus
   , withLastMinimized
   , withLastMinimized'
+  , withFirstMinimized
+  , withFirstMinimized'
   , withMinimized
   ) where
 
@@ -85,7 +87,7 @@ modified f = XS.modified $
        in Minimized { rectMap = newRectMap
                     , minimizedStack = (newWindows L.\\ oldStack)
                                        ++
-                                       (newWindows `L.intersect` oldStack)
+                                       (oldStack `L.intersect` newWindows)
                     }
 
 
@@ -115,6 +117,16 @@ maximizeWindow = maximizeWindowAndChangeWSet $ const id
 maximizeWindowAndFocus :: Window -> X ()
 maximizeWindowAndFocus = maximizeWindowAndChangeWSet W.focusWindow
 
+-- | Perform an action with first minimized window on current workspace
+--   or do nothing if there is no minimized windows on current workspace
+withFirstMinimized :: (Window -> X ()) -> X ()
+withFirstMinimized action = withFirstMinimized' (flip whenJust action)
+
+-- | Like withFirstMinimized but the provided action is always invoked with a
+--   'Maybe Window', that will be nothing if there is no first minimized window.
+withFirstMinimized' :: (Maybe Window -> X ()) -> X ()
+withFirstMinimized' action = withMinimized (action . listToMaybe . reverse)
+
 -- | Perform an action with last minimized window on current workspace
 --   or do nothing if there is no minimized windows on current workspace
 withLastMinimized :: (Window -> X ()) -> X ()

XMonad/Actions/Navigation2D.hs

@@ -43,6 +43,9 @@ module XMonad.Actions.Navigation2D ( -- * Usage
                                    , Navigation2D
                                    , lineNavigation
                                    , centerNavigation
+                                   , sideNavigation
+                                   , sideNavigationWithBias
+                                   , hybridOf
                                    , hybridNavigation
                                    , fullScreenRect
                                    , singleWindowRect
@@ -59,6 +62,7 @@ import Control.Applicative
 import qualified Data.List as L
 import qualified Data.Map as M
 import Data.Maybe
+import Data.Ord (comparing)
 import XMonad hiding (Screen)
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
@@ -70,16 +74,17 @@ import XMonad.Util.Types
 -- Navigation2D provides directional navigation (go left, right, up, down) for
 -- windows and screens.  It treats floating and tiled windows as two separate
 -- layers and provides mechanisms to navigate within each layer and to switch
--- between layers.  Navigation2D provides two different navigation strategies
+-- between layers.  Navigation2D provides three different navigation strategies
--- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
+-- (see <#Technical_Discussion> for details): /Line navigation/ and
--- natural but may make it impossible to navigate to a given window from the
+-- /Side navigation/ feel rather natural but may make it impossible to navigate
--- current window, particularly in the floating layer.  /Center navigation/
+-- to a given window from the current window, particularly in the floating
--- feels less natural in certain situations but ensures that all windows can be
+-- layer. /Center navigation/ feels less natural in certain situations but
--- reached without the need to involve the mouse. A third option is to use
+-- ensures that all windows can be reached without the need to involve the
--- /Hybrid navigation/, which automatically chooses between the two whenever
+-- mouse. Another option is to use a /Hybrid/ of the three strategies,
--- navigation is attempted.  Navigation2D allows different navigation strategies
+-- automatically choosing whichever first provides a suitable target window.
--- to be used in the two layers and allows customization of the navigation strategy
+-- Navigation2D allows different navigation strategies to be used in the two
--- for the tiled layer based on the layout currently in effect.
+-- layers and allows customization of the navigation strategy for the tiled
+-- layer based on the layout currently in effect.
 --
 -- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
 --
@@ -318,12 +323,46 @@ lineNavigation = N 1 doLineNavigation
 centerNavigation :: Navigation2D
 centerNavigation = N 2 doCenterNavigation
 
--- | Hybrid navigation. This attempts Line navigation, then falls back on Center
+-- | Side navigation. Consider navigating to the right this time. The strategy
--- navigation if it does not find any suitable target windows. This is useful since
+-- is to take the line segment forming the right boundary of the current window,
--- Line navigation tends to fail on gaps, but provides more intuitive motions
+-- and push it to the right until it intersects with at least one other window.
--- when it succeeds—provided there are no floating windows.
+-- Of those windows, one with a point that is the closest to the centre of the
+-- line (+1) is selected. This is probably the most intuitive strategy for the
+-- tiled layer when using XMonad.Layout.Spacing.
+sideNavigation :: Navigation2D
+sideNavigation = N 1 (doSideNavigationWithBias 1)
+
+-- | Side navigation with bias. Consider a case where the screen is divided
+-- up into three vertical panes; the side panes occupied by one window each and
+-- the central pane split across the middle by two windows. By the criteria
+-- of side navigation, the two central windows are equally good choices when
+-- navigating inwards from one of the side panes. Hence in order to be
+-- equitable, symmetric and pleasant to use, different windows are chosen when
+-- navigating from different sides. In particular, the lower is chosen when
+-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
+-- cycle through the four windows clockwise. This is implemented by using a bias
+-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
+-- this behaviour is lost and the same window chosen every time. A negative bias
+-- swaps the preferred window for each direction. A bias of zero disables the
+-- behaviour.
+sideNavigationWithBias :: Int -> Navigation2D
+sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
+
+-- | Hybrid of two modes of navigation, preferring the motions of the first.
+-- Use this if you want to fall back on a second strategy whenever the first
+-- does not find a candidate window. E.g.
+-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
+-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
+-- you to take advantage of some of the latter strategy's more interesting
+-- motions in the tiled layer.
+hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
+hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
+  where
+    applyToBoth f g a b c = f a b c <|> g a b c
+
+{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
 hybridNavigation :: Navigation2D
-hybridNavigation = N 2 doHybridNavigation
+hybridNavigation = hybridOf lineNavigation centerNavigation
 
 -- | Stores the configuration of directional navigation. The 'Default' instance
 -- uses line navigation for the tiled layer and for navigation between screens,
@@ -767,12 +806,54 @@ doCenterNavigation dir (cur, rect) winrects
                                              -- or it has the same distance but comes later
                                              -- in the window stack
 
--- | Implements Hybrid navigation. This attempts Line navigation first,
+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
--- then falls back on Center navigation if it finds no suitable target window.
+-- y1 <= y2, and make the assumption valid by initialising SideRects with the
-doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+-- property and carefully preserving it over any individual transformation.
-doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
-    where
+  deriving Show
-        applyToBoth f g h a b c = f (g a b c) (h a b c)
+
+-- Conversion from Rectangle format to SideRect.
+toSR :: Rectangle -> SideRect
+toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
+
+-- Implements side navigation with bias.
+doSideNavigationWithBias ::
+  Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
+doSideNavigationWithBias bias dir (cur, rect)
+  = fmap fst . listToMaybe
+  . L.sortBy (comparing dist) . foldr acClosest []
+  . filter (`toRightOf` (cur, transform rect))
+  . map (fmap transform)
+  where
+    -- Getting the center of the current window so we can make it the new origin.
+    cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
+    (x0, y0) = cOf . toSR $ rect
+
+    -- Translate the given SideRect by (-x0, -y0).
+    translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
+
+    -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
+    rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
+
+    -- Apply the above function until d becomes synonymous with R (wolog).
+    rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
+                  in  foldr (const $ (.) rHalfPiCC) id l
+
+    transform = rotateToR dir . translate . toSR
+
+    -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
+    -- below or above c, i.e. iff:
+    -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
+    toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
+
+    -- Greedily accumulate the windows tied for the leftmost left side.
+    acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
+                                   | x1 r >  x1 r' =          l
+    acClosest (w, r) _                             = (w, r) : []
+
+    -- Given a (_, SideRect), calculate how far it is from the y=bias line.
+    dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
+                | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
 
 -- | Swaps the current window with the window given as argument
 swap :: Window -> WindowSet -> WindowSet

XMonad/Actions/PhysicalScreens.hs

@@ -21,6 +21,12 @@ module XMonad.Actions.PhysicalScreens (
                                       , sendToScreen
                                       , onNextNeighbour
                                       , onPrevNeighbour
+                                      , horizontalScreenOrderer
+                                      , verticalScreenOrderer
+                                      , ScreenComparator(ScreenComparator)
+                                      , getScreenIdAndRectangle
+                                      , screenComparatorById
+                                      , screenComparatorByRectangle
                                       ) where
 
 import XMonad
@@ -36,17 +42,20 @@ physical location relative to each other (as reported by Xinerama),
 rather than their @ScreenID@ s, which are arbitrarily determined by
 your X server and graphics hardware.
 
-Screens are ordered by the upper-left-most corner, from top-to-bottom
+You can specify how to order the screen by giving a ScreenComparator.
+To create a screen comparator you can use screenComparatorByRectangle or screenComparatorByScreenId.
+The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
 and then left-to-right.
 
 Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 
 > import XMonad.Actions.PhysicalScreens
+> import Data.Default
 
-> , ((modMask, xK_a), onPrevNeighbour W.view)
+> , ((modMask, xK_a), onPrevNeighbour def W.view)
-> , ((modMask, xK_o), onNextNeighbour W.view)
+> , ((modMask, xK_o), onNextNeighbour def W.view)
-> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def W.shift)
-> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour def W.shift)
 
 > --
 > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
@@ -54,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, shiftMask)]]
+>     , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
 
 For detailed instructions on editing your key bindings, see
 "XMonad.Doc.Extending#Editing_key_bindings".
@@ -63,52 +72,78 @@ For detailed instructions on editing your key bindings, see
 -- | The type of the index of a screen by location
 newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
 
+getScreenIdAndRectangle :: (W.Screen i l a ScreenId ScreenDetail) -> (ScreenId, Rectangle)
+getScreenIdAndRectangle screen = (W.screen screen, rect) where
+  rect = screenRect $ W.screenDetail screen
+
 -- | Translate a physical screen index to a "ScreenId"
-getScreen :: PhysicalScreen -> X (Maybe ScreenId)
+getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
-getScreen (P i) = do w <- gets windowset
+getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
-                     let screens = W.current w : W.visible w
+                                                  let screens = W.current w : W.visible w
-                     if i<0 || i >= length screens
+                                                  if i<0 || i >= length screens
-                      then return Nothing
+                                                    then return Nothing
-                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
+                                                    else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
-                           in return $ Just $ W.screen $ ss !! i
+                                                    in return $ Just $ W.screen $ ss !! i
 
 -- | Switch to a given physical screen
-viewScreen :: PhysicalScreen -> X ()
+viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
-viewScreen p = do i <- getScreen p
+viewScreen sc p = do i <- getScreen sc p
-                  whenJust i $ \s -> do
+                     whenJust i $ \s -> do
-                  w <- screenWorkspace s
+                     w <- screenWorkspace s
-                  whenJust w $ windows . W.view
+                     whenJust w $ windows . W.view
 
 -- | Send the active window to a given physical screen
-sendToScreen :: PhysicalScreen -> X ()
+sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
-sendToScreen p = do i <- getScreen p
+sendToScreen sc p = do i <- getScreen sc p
-                    whenJust i $ \s -> do
+                       whenJust i $ \s -> do
-                      w <- screenWorkspace s
+                         w <- screenWorkspace s
-                      whenJust w $ windows . W.shift
+                         whenJust w $ windows . W.shift
 
--- | Compare two screens by their top-left corners, ordering
+-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
--- | top-to-bottom and then left-to-right.
+newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
-cmpScreen :: Rectangle -> Rectangle -> Ordering
-cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
 
+-- | The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
+instance Default ScreenComparator where
+  def= verticalScreenOrderer
+
+-- | Compare screen only by their coordonate
+screenComparatorByRectangle :: (Rectangle -> Rectangle -> Ordering) -> ScreenComparator
+screenComparatorByRectangle rectComparator = ScreenComparator comparator where
+  comparator (_, rec1) (_, rec2) = rectComparator rec1 rec2
+
+-- | Compare screen only by their Xinerama id
+screenComparatorById :: (ScreenId -> ScreenId -> Ordering) -> ScreenComparator
+screenComparatorById idComparator = ScreenComparator comparator where
+  comparator (id1, _) (id2, _) = idComparator id1 id2
+
+-- | orders screens by the upper-left-most corner, from top-to-bottom
+verticalScreenOrderer :: ScreenComparator
+verticalScreenOrderer = screenComparatorByRectangle comparator where
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1, x1) (y2, x2)
+
+-- | orders screens by the upper-left-most corner, from left-to-right
+horizontalScreenOrderer :: ScreenComparator
+horizontalScreenOrderer = screenComparatorByRectangle comparator where
+    comparator (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (x1, y1) (x2, y2)
 
 -- | Get ScreenId for neighbours of the current screen based on position offset.
-getNeighbour :: Int -> X ScreenId
+getNeighbour :: ScreenComparator -> Int -> X ScreenId
-getNeighbour d = do w <- gets windowset
+getNeighbour (ScreenComparator cmpScreen) d =
-                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
+  do w <- gets windowset
-                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
+     let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
-                        pos = (curPos + d) `mod` length ss
+         curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
-                    return $ ss !! pos
+         pos = (curPos + d) `mod` length ss
+     return $ ss !! pos
 
-neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-neighbourWindows d f = do s <- getNeighbour d
+neighbourWindows sc d f = do s <- getNeighbour sc d
-                          w <- screenWorkspace s
+                             w <- screenWorkspace s
-                          whenJust w $ windows . f
+                             whenJust w $ windows . f
 
 -- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
-onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-onNextNeighbour = neighbourWindows 1
+onNextNeighbour sc = neighbourWindows sc 1
 
 -- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
-onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-onPrevNeighbour = neighbourWindows (-1)
+onPrevNeighbour sc = neighbourWindows sc (-1)

XMonad/Actions/SwapPromote.hs

@@ -0,0 +1,407 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.SwapPromote
+-- Copyright   :  (c) 2018 Yclept Nemo
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Module for tracking master window history per workspace, and associated
+-- functions for manipulating the stack using such history.
+--
+-----------------------------------------------------------------------------
+
+
+module XMonad.Actions.SwapPromote
+    ( -- * Usage
+      -- $usage
+      MasterHistory (..)
+      -- * State Accessors
+    , getMasterHistoryMap
+    , getMasterHistoryFromTag
+    , getMasterHistoryCurrent
+    , getMasterHistoryFromWindow
+    , modifyMasterHistoryFromTag
+    , modifyMasterHistoryCurrent
+      -- * Log Hook
+    , masterHistoryHook
+      -- * Log Hook Building Blocks
+    , masterHistoryHook'
+    , updateMasterHistory
+      -- * Actions
+    , swapPromote
+    , swapPromote'
+    , swapIn
+    , swapIn'
+    , swapHybrid
+    , swapHybrid'
+      -- * Action Building Blocks
+    , swapApply
+    , swapPromoteStack
+    , swapInStack
+    , swapHybridStack
+      -- * List Utilities
+    , cycleN
+    , split
+    , split'
+    , merge
+    , merge'
+      -- * Stack Utilities
+    , stackSplit
+    , stackMerge
+    ) where
+
+
+import           XMonad
+import qualified XMonad.StackSet                as W
+import qualified XMonad.Util.ExtensibleState    as XS
+
+import qualified Data.Map                       as M
+import qualified Data.Set                       as S
+import           Data.List
+import           Data.Maybe
+import           Control.Arrow
+import           Control.Applicative ((<$>),(<*>))
+import           Control.Monad
+
+
+-- $usage
+-- Given your configuration file, import this module:
+--
+-- > import XMonad.Actions.SwapPromote
+--
+-- First add 'masterHistoryHook' to your 'logHook' to track master windows per
+-- workspace:
+--
+-- > myLogHook = otherHook >> masterHistoryHook
+--
+-- Then replace xmonad's default promote keybinding with 'swapPromote'':
+--
+-- > , ((mod1Mask, xK_Return), swapPromote' False)
+--
+-- Depending on your xmonad configuration or window actions the master history
+-- may be empty. If this is the case you can still chain another promotion
+-- function:
+--
+-- > import XMonad.Actions.DwmPromote
+-- > , ((mod1Mask, xK_Return), whenX (swapPromote False) dwmpromote)
+--
+-- To be clear, this is only called when the lack of master history hindered
+-- the swap and not other conditions, such as having a only a single window.
+--
+-- While 'swapPromote' preserves window focus, 'swapIn' preserves the focus
+-- position - effectively "swapping" new windows into focus without moving the
+-- zipper. A mix of both, 'swapHybrid' promotes focused non-master windows
+-- while swapping windows into the focused master. This works well on layouts
+-- with large masters. Both come with chainable variants, see 'swapIn'' and
+-- 'swapHybrid''.
+--
+-- So far floating windows have been treated no differently than tiled windows
+-- even though their positions are independent of the stack. Often, yanking
+-- floating windows in and out of the workspace will obliterate the stack
+-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
+-- toggled so frequenty and always replaces the master window. That's why the
+-- swap functions accept a boolean argument; when @True@ non-focused floating
+-- windows will be ignored.
+--
+-- All together:
+--
+-- > , ((mod1Mask, xK_Return), whenX (swapHybrid True) dwmpromote)
+
+
+-- | Mapping from workspace tag to master history list. The current master is
+-- the head of the list, the previous master the second element, and so on.
+-- Without history, the list is empty.
+newtype MasterHistory = MasterHistory
+    { getMasterHistory :: M.Map WorkspaceId [Window]
+    } deriving (Read,Show,Typeable)
+
+instance ExtensionClass MasterHistory where
+    initialValue = MasterHistory M.empty
+
+-- | Return the master history map from the state.
+getMasterHistoryMap :: X (M.Map WorkspaceId [Window])
+getMasterHistoryMap = XS.gets getMasterHistory
+
+-- | Return the master history list of a given tag. The master history list may
+-- be empty. An invalid tag will also result in an empty list.
+getMasterHistoryFromTag :: WorkspaceId -> X [Window]
+getMasterHistoryFromTag t = M.findWithDefault [] t <$> getMasterHistoryMap
+
+-- | Return the master history list of the current workspace.
+getMasterHistoryCurrent :: X [Window]
+getMasterHistoryCurrent =   gets (W.currentTag . windowset)
+                        >>= getMasterHistoryFromTag
+
+-- | Return the master history list of the workspace containing the given
+-- window. Return an empty list if the window is not in the stackset.
+getMasterHistoryFromWindow :: Window -> X [Window]
+getMasterHistoryFromWindow w =   gets (W.findTag w . windowset)
+                             >>= maybe (return []) getMasterHistoryFromTag
+
+-- | Modify the master history list of a given workspace, or the empty list of
+-- no such workspace is mapped. The result is then re-inserted into the master
+-- history map.
+modifyMasterHistoryFromTag :: WorkspaceId -> ([Window] -> [Window]) -> X ()
+modifyMasterHistoryFromTag t f = XS.modify $ \(MasterHistory m) ->
+    let l = M.findWithDefault [] t m
+    in  MasterHistory $ M.insert t (f l) m
+
+-- | Modify the master history list of the current workspace. While the current
+-- workspace is guaranteed to exist; its master history may not. For more
+-- information see 'modifyMasterHistoryFromTag'.
+modifyMasterHistoryCurrent :: ([Window] -> [Window]) -> X ()
+modifyMasterHistoryCurrent f =   gets (W.currentTag . windowset)
+                             >>= flip modifyMasterHistoryFromTag f
+
+-- | A 'logHook' to update the master history mapping. Non-existent workspaces
+-- are removed, and the master history list for the current workspaces is
+-- updated. See 'masterHistoryHook''.
+masterHistoryHook :: X ()
+masterHistoryHook = masterHistoryHook' True updateMasterHistory
+
+-- | Backend for 'masterHistoryHook'.
+masterHistoryHook' :: Bool
+                        -- ^ If @True@, remove non-existent workspaces.
+                   -> ([Window] -> [Window] -> [Window])
+                        -- ^ Function used to update the master history list of
+                        -- the current workspace. First argument is the master
+                        -- history, second is the integrated stack.  See
+                        -- 'updateMasterHistory' for more details.
+                   -> X ()
+masterHistoryHook' removeWorkspaces historyModifier = do
+    wset <- gets windowset
+    let W.Workspace wid _ mst = W.workspace . W.current $ wset
+        tags = map W.tag $ W.workspaces wset
+        st = W.integrate' mst
+    XS.modify $ \(MasterHistory mm) ->
+        let mm' = if removeWorkspaces
+                  then restrictKeys mm $ S.fromList tags
+                  else mm
+            ms  = M.findWithDefault [] wid mm'
+            ms' = historyModifier ms st
+        in  MasterHistory $ M.insert wid ms' mm'
+
+-- | Less efficient version of 'M.restrictKeys'. Given broader eventual
+-- adoption, replace this with 'M.restrictKeys'.
+restrictKeys :: Ord k => M.Map k a -> S.Set k -> M.Map k a
+restrictKeys m s = M.filterWithKey (\k _ -> k `S.member` s) m
+
+-- | Given the current master history list and an integrated stack, return the
+-- new master history list. The current master is either moved (if it exists
+-- within the history) or added to the head of the list, and all missing (i.e.
+-- closed) windows are removed.
+updateMasterHistory :: [Window] -- ^ The master history list.
+                    -> [Window] -- ^ The integrated stack.
+                    -> [Window]
+updateMasterHistory _  []       = []
+updateMasterHistory ms ws@(w:_) = (w : delete w ms) `intersect` ws
+
+-- | Wrap 'swapPromoteStack'; see also 'swapApply'.
+swapPromote :: Bool -> X Bool
+swapPromote = flip swapApply swapPromoteStack
+
+-- | Like 'swapPromote'' but discard the result.
+swapPromote' :: Bool -> X ()
+swapPromote' = void . swapPromote
+
+-- | Wrap 'swapInStack'; see also 'swapApply'.
+swapIn :: Bool -> X Bool
+swapIn = flip swapApply swapInStack
+
+-- | Like 'swapIn'' but discard the result.
+swapIn' :: Bool -> X ()
+swapIn' = void . swapIn
+
+-- | Wrap 'swapHybridStack'; see also 'swapApply'.
+swapHybrid :: Bool -> X Bool
+swapHybrid = flip swapApply swapHybridStack
+
+-- | Like 'swapHybrid'' but discard the result.
+swapHybrid' :: Bool -> X ()
+swapHybrid' = void . swapHybrid
+
+-- | Apply the given master history stack modifier to the current stack. If
+-- given @True@, all non-focused floating windows will be ignored. Return
+-- @True@ if insufficient history; if so use 'whenX' to sequence a backup
+-- promotion function.
+swapApply :: Bool
+          -> (Maybe Window -> W.Stack Window -> (Bool,W.Stack Window))
+          -> X Bool
+swapApply ignoreFloats swapFunction = do
+    fl <- gets $ W.floating . windowset
+    st <- gets $ W.stack . W.workspace . W.current . windowset
+    ch <- getMasterHistoryCurrent
+    let swapApply' s1 =
+            let fl' = if ignoreFloats then M.keysSet fl else S.empty
+                ff = (||) <$> (`S.notMember` fl') <*> (== W.focus s1)
+                fh = filter ff ch
+                pm = listToMaybe . drop 1 $ fh
+                (r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
+                (b,s3) = swapFunction pm s2
+                s4 = stackMerge s3 r
+                mh = let w = head . W.integrate $ s3
+                     in  const $ w : delete w ch
+            in (b,Just s4,mh)
+        (x,y,z) = maybe (False,Nothing,id) swapApply' st
+    -- Any floating master windows will be added to the history when 'windows'
+    -- calls the log hook.
+    modifyMasterHistoryCurrent z
+    windows $ W.modify Nothing . const $ y
+    return x
+
+-- | If the focused window is the master window and there is no previous
+-- master, do nothing. Otherwise swap the master with the previous master. If
+-- the focused window is not the master window, swap it with the master window.
+-- In either case focus follows the original window, i.e. the focused window
+-- does not change, only its position.
+--
+-- The first argument is the previous master (which may not exist), the second
+-- a window stack. Return @True@ if the master history hindered the swap; the
+-- history is either empty or out-of-sync. Though the latter shouldn't happen
+-- this function never changes the stack under such circumstances.
+swapPromoteStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapPromoteStack _         st@(W.Stack _x [] []) = (False,st)
+swapPromoteStack Nothing   st@(W.Stack _x [] _r) = (True,st)
+swapPromoteStack (Just pm)    (W.Stack  x []  r) =
+    let (r',l') = (reverse *** cycleN 1) $ span (/= pm) $ reverse r
+        st'     = W.Stack x l' r'
+        b       = null l'
+    in  (b,st')
+swapPromoteStack _            (W.Stack  x l   r) =
+    let r'  = (++ r) . cycleN 1 . reverse $ l
+        st' = W.Stack x [] r'
+    in  (False,st')
+
+-- | Perform the same swap as 'swapPromoteStack'. However the new window
+-- receives the focus; it appears to "swap into" the position of the original
+-- window. Under this model focus follows stack position and the zipper does
+-- not move.
+--
+-- See 'swapPromoteStack' for more details regarding the parameters.
+swapInStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapInStack _         st@(W.Stack _x [] []) = (False,st)
+swapInStack Nothing   st@(W.Stack _x [] _r) = (True,st)
+swapInStack (Just pm)    (W.Stack  x []  r) =
+    let (x',r') = case span (/= pm) r of
+            (__,[]) -> (x,r)
+            (sl,sr) -> (pm,sl ++ x : drop 1 sr)
+        st'     = W.Stack x' [] r'
+        b       = x' == x
+    in  (b,st')
+swapInStack _            (W.Stack  x l   r) =
+    let l'  = init l ++ [x]
+        x'  = last l
+        st' = W.Stack x' l' r
+    in  (False,st')
+
+-- | If the focused window is the master window, use 'swapInStack'. Otherwise use
+-- 'swapPromoteStack'.
+--
+-- See 'swapPromoteStack' for more details regarding the parameters.
+swapHybridStack :: Maybe Window -> W.Stack Window -> (Bool,W.Stack Window)
+swapHybridStack m st@(W.Stack _ [] _) = swapInStack m st
+swapHybridStack m st                  = swapPromoteStack m st
+
+-- | Cycle a list by the given count. If positive, cycle to the left. If
+-- negative, cycle to the right:
+--
+-- >>> cycleN 2 [1,2,3,4,5]
+-- [3,4,5,1,2]
+-- >>> cycleN (-2) [1,2,3,4,5]
+-- [4,5,1,2,3]
+cycleN :: Int -> [a] -> [a]
+cycleN n ls =
+    let l = length ls
+    in  take l $ drop (n `mod` l) $ cycle ls
+
+-- | Wrap 'split'' with an initial index of @0@, discarding the list's length.
+split :: (Num a, Enum a) => (b -> Bool) -> [b] -> ([(a,b)],[b])
+split p l =
+    let (_,ys,ns) = split' p 0 l
+    in  (ys,ns)
+
+-- | Given a predicate, an initial index and a list, return a tuple containing:
+--
+--  * List length.
+--  * Indexed list of elements which satisfy the predicate. An indexed element
+--    is a tuple containing the element index (offset by the initial index) and
+--    the element.
+--  * List of elements which do not satisfy the predicate.
+--
+-- The initial index and length of the list simplify chaining calls to this
+-- function, such as for zippers of lists.
+split' :: (Num a, Enum a) => (b -> Bool) -> a -> [b] -> (a,[(a,b)],[b])
+split' p i l =
+    let accumulate e (c,ys,ns) = if p (snd e)
+            then (c+1,e:ys,ns)
+            else (c+1,ys,e:ns)
+        (c',ys',ns') = foldr accumulate (0,[],[]) $ zip [i..] l
+    in  (c',ys',snd . unzip $ ns')
+
+-- | Wrap 'merge'' with an initial virtual index of @0@. Return only the
+-- unindexed list with elements from the leftover indexed list appended.
+merge :: (Ord a, Num a) => [(a,b)] -> [b] -> [b]
+merge il ul =
+    let (_,il',ul') = merge' 0 il ul
+    in  ul' ++ map snd il'
+
+-- | Inverse of 'split'. Merge an indexed list with an unindexed list (see
+-- 'split''). Given a virtual index, an indexed list and an unindexed list,
+-- return a tuple containing:
+--
+--  * Virtual index /after/ the unindexed list
+--  * Remainder of the indexed list
+--  * Merged unindexed list
+--
+-- If the indexed list is empty, this functions consumes the entire unindexed
+-- list. If the unindexed list is empty, this function consumes only adjacent
+-- indexed elements. For example, @[(10,"ten"),(12,"twelve")]@ implies missing
+-- unindexed elements and so once @(10,"ten")@ is consumed this function
+-- concludes.
+--
+-- The indexed list is assumed to have been created by 'split'' and not checked
+-- for correctness. Indices are assumed to be ascending, i.e.
+-- > [(1,"one"),(2,"two"),(4,"four")]
+--
+-- The initial and final virtual indices simplify chaining calls to the this
+-- function, as as for zippers of lists. Positive values shift the unindexed
+-- list towards the tail, as if preceded by that many elements.
+merge' :: (Ord a, Num a) => a -> [(a,b)] -> [b] -> (a,[(a,b)],[b])
+merge' i il@((j,a):ps) ul@(b:bs) = if j <= i
+    then let (x,y,z) = merge' (i+1) ps ul
+         in  (x,y,a:z)
+    else let (x,y,z) = merge' (i+1) il bs
+         in  (x,y,b:z)
+merge' i [] (b:bs) =
+         let (x,y,z) = merge' (i+1) [] bs
+         in  (x,y,b:z)
+merge' i il@((j,a):ps) [] = if j <= i
+    then let (x,y,z) = merge' (i+1) ps []
+         in  (x,y,a:z)
+    else (i,il,[])
+merge' i [] [] =
+         (i,[],[])
+
+-- | Remove all elements of the set from the stack. Skip the currently focused
+-- member. Return an indexed list of excluded elements and the modified stack.
+-- Use 'stackMerge' to re-insert the elements using this list.
+stackSplit :: (Num a, Enum a, Ord b) => W.Stack b -> S.Set b -> ([(a,b)],W.Stack b)
+stackSplit (W.Stack x l r) s =
+    let (c,fl,tl) = split' (`S.member` s) 0 (reverse l)
+        (_,fr,tr) = split' (`S.member` s) (c+1) r
+    in  (fl++fr,W.Stack x (reverse tl) tr)
+
+-- | Inverse of 'stackSplit'. Given a list of elements and their original
+-- indices, re-insert the elements into these same positions within the stack.
+-- Skip the currently focused member. Works best if the stack's length hasn't
+-- changed, though if shorter any leftover elements will be tacked on.
+stackMerge :: (Ord a, Num a) => W.Stack b -> [(a,b)] -> W.Stack b
+stackMerge (W.Stack x l r) il =
+    let (i,il1,l') = merge' 0 il (reverse l)
+        (_,il2,r') = merge' (i+1) il1 r
+    in  W.Stack x (reverse l') (r' ++ map snd il2)

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

XMonad/Config/Gnome.hs

@@ -47,7 +47,7 @@ gnomeConfig = desktopConfig
 
 gnomeKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_p), gnomeRun)
-    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-save --kill") ]
+    , ((modm .|. shiftMask, xK_q), spawn "gnome-session-quit --logout") ]
 
 -- | Launch the "Run Application" dialog.  gnome-panel must be running for this
 -- to work.

XMonad/Config/Saegesser.hs

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

XMonad/Hooks/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"]
+  x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
-  case () of
+  case x of
-    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
+    [cOMPOUND_TEXT,uTF8_STRING] -> case () of
-       | fmt == sTRING        -> guardSize  8 $ do
+      () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
-                                   vs <- gets value
+         | fmt == sTRING        -> guardSize  8 $ do
-                                   modify (\r -> r {value = []})
+                                     vs <- gets value
-                                   let ss = flip unfoldr (map twiddle vs) $
+                                     modify (\r -> r {value = []})
-                                            \s -> if null s
+                                     let ss = flip unfoldr (map twiddle vs) $
-                                                  then Nothing
+                                              \s -> if null s
-                                                  else let (w,s'') = break (== '\NUL') s
+                                                    then Nothing
-                                                           s'      = if null s''
+                                                    else let (w,s'') = break (== '\NUL') s
-                                                                     then s''
+                                                             s'      = if null s''
-                                                                     else tail s''
+                                                                       then s''
-                                                        in Just (w,s')
+                                                                       else tail s''
-                                   case ss of
+                                                          in Just (w,s')
-                                     [s] -> append $ show s
+                                     case ss of
-                                     ss' -> let go (s:ss'') c = append c        >>
+                                       [s] -> append $ show s
-                                                                append (show s) >>
+                                       ss' -> let go (s:ss'') c = append c        >>
-                                                                go ss'' ","
+                                                                  append (show s) >>
-                                                go []       _ = append "]"
+                                                                  go ss'' ","
-                                             in append "[" >> go ss' ""
+                                                  go []       _ = append "]"
-       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
+                                               in append "[" >> go ss' ""
-       | otherwise            -> (inX $ atomName fmt) >>=
+         | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
-                                 failure . ("unrecognized string type " ++)
+         | 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
+               x <- eat 1
-               return $ fromIntegral b
+               case x of
+                 [b] -> return $ fromIntegral b
 inhale 16 =  do
-               [b0,b1] <- eat 2
+               x <- eat 2
-               io $ allocaArray 2 $ \p -> do
+               case x of
-                 pokeArray p [b0,b1]
+                 [b0,b1] -> io $ allocaArray 2 $ \p -> do
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)
+                              pokeArray p [b0,b1]
-                 return $ fromIntegral v
+                              [v] <- peekArray 1 (castPtr p :: Ptr Word16)
+                              return $ fromIntegral v
 inhale 32 =  do
-               [b0,b1,b2,b3] <- eat 4
+               x <- eat 4
-               io $ allocaArray 4 $ \p -> do
+               case x of
-                 pokeArray p [b0,b1,b2,b3]
+                 [b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)
+                                    pokeArray p [b0,b1,b2,b3]
-                 return $ fromIntegral v
+                                    [v] <- peekArray 1 (castPtr p :: Ptr Word32)
+                                    return $ fromIntegral v
 inhale  b =  error $ "inhale " ++ show b
 
 eat   :: Int -> Decoder Raw

XMonad/Hooks/DynamicLog.hs

@@ -24,6 +24,7 @@ module XMonad.Hooks.DynamicLog (
 
     -- * Drop-in loggers
     dzen,
+    dzenWithFlags,
     xmobar,
     statusBar,
     dynamicLog,
@@ -42,8 +43,8 @@ module XMonad.Hooks.DynamicLog (
 
     -- * Formatting utilities
     wrap, pad, trim, shorten,
-    xmobarColor, xmobarStrip,
+    xmobarColor, xmobarAction, xmobarRaw,
-    xmobarStripTags,
+    xmobarStrip, xmobarStripTags,
     dzenColor, dzenEscape, dzenStrip,
 
     -- * Internal formatting functions
@@ -61,7 +62,7 @@ import Codec.Binary.UTF8.String (encodeString)
 import Control.Monad (liftM2, msum)
 import Data.Char ( isSpace, ord )
 import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
-import Data.Maybe ( isJust, catMaybes, mapMaybe )
+import Data.Maybe ( isJust, catMaybes, mapMaybe, fromMaybe )
 import Data.Ord ( comparing )
 import qualified Data.Map as M
 import qualified XMonad.StackSet as S
@@ -150,6 +151,32 @@ import XMonad.Hooks.ManageDocks
 
 ------------------------------------------------------------------------
 
+-- | Run xmonad with a dzen status bar with specified dzen
+--   command line arguments.
+--
+-- > main = xmonad =<< dzenWithFlags flags myConfig
+-- >
+-- > myConfig = def { ... }
+-- >
+-- > flags = "-e onstart lower -w 800 -h 24 -ta l -fg #a8a3f7 -bg #3f3c6d"
+--
+-- This function can be used to customize the arguments passed to dzen2.
+-- e.g changing the default width and height of dzen2.
+--
+-- If you wish to customize the status bar format at all, you'll have to
+-- use the 'statusBar' function instead.
+--
+-- The binding uses the XMonad.Hooks.ManageDocks module to automatically
+-- handle screen placement for dzen, and enables 'mod-b' for toggling
+-- the menu bar.
+--
+-- You should use this function only when the default 'dzen' function does not
+-- serve your purpose.
+--
+dzenWithFlags :: LayoutClass l Window
+    => String -> XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
+dzenWithFlags flags conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
+
 -- | Run xmonad with a dzen status bar set to some nice defaults.
 --
 -- > main = xmonad =<< dzen myConfig
@@ -159,16 +186,14 @@ import XMonad.Hooks.ManageDocks
 -- The intent is that the above config file should provide a nice
 -- status bar with minimal effort.
 --
--- If you wish to customize the status bar format at all, you'll have to
--- use the 'statusBar' function instead.
---
 -- The binding uses the XMonad.Hooks.ManageDocks module to automatically
 -- handle screen placement for dzen, and enables 'mod-b' for toggling
--- the menu bar.
+-- the menu bar. Please refer to 'dzenWithFlags' function for further
+-- documentation.
 --
 dzen :: LayoutClass l Window
      => XConfig l -> IO (XConfig (ModifiedLayout AvoidStruts l))
-dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
+dzen conf = dzenWithFlags flags conf
  where
     fg      = "'#a8a3f7'" -- n.b quoting
     bg      = "'#3f3c6d'"
@@ -295,7 +320,8 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
          fmt w = printer pp (S.tag w)
           where printer | any (\x -> maybe False (== S.tag w) (S.findTag x s)) urgents  = ppUrgent
                         | S.tag w == this                                               = ppCurrent
-                        | S.tag w `elem` visibles                                       = ppVisible
+                        | S.tag w `elem` visibles && isJust (S.stack w)                 = ppVisible
+                        | S.tag w `elem` visibles                                       = liftM2 fromMaybe ppVisible ppVisibleNoWindows
                         | isJust (S.stack w)                                            = ppHidden
                         | otherwise                                                     = ppHiddenNoWindows
 
@@ -392,6 +418,31 @@ xmobarColor :: String  -- ^ foreground color: a color name, or #rrggbb format
 xmobarColor fg bg = wrap t "</fc>"
  where t = concat ["<fc=", fg, if null bg then "" else "," ++ bg, ">"]
 
+-- | Encapsulate text with an action. The text will be displayed, and the
+-- action executed when the displayed text is clicked. Illegal input is not
+-- filtered, allowing xmobar to display any parse errors. Uses xmobar's new
+-- syntax wherein the command is surrounded by backticks.
+xmobarAction :: String
+                -- ^ Command. Use of backticks (`) will cause a parse error.
+             -> String
+                -- ^ Buttons 1-5, such as "145". Other characters will cause a
+                -- parse error.
+             -> String
+                -- ^ Displayed/wrapped text.
+             -> String
+xmobarAction command button = wrap l r
+    where
+        l = "<action=`" ++ command ++ "` button=" ++ button ++ ">"
+        r = "</action>"
+
+-- | Encapsulate arbitrary text for display only, i.e. untrusted content if
+-- wrapped (perhaps from window titles) will be displayed only, with all tags
+-- ignored. Introduced in xmobar 0.21; see their documentation. Be careful not
+-- to shorten the result.
+xmobarRaw :: String -> String
+xmobarRaw "" = ""
+xmobarRaw s  = concat ["<raw=", show $ length s, ":", s, "/>"]
+
 -- ??? add an xmobarEscape function?
 
 -- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
@@ -435,6 +486,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
                -- contain windows
              , ppHiddenNoWindows :: WorkspaceId -> String
                -- ^ how to print tags of empty hidden workspaces
+             , ppVisibleNoWindows :: Maybe (WorkspaceId -> String)
+               -- ^ how to print tags of empty visible workspaces
              , ppUrgent :: WorkspaceId -> String
                -- ^ format to be applied to tags of urgent workspaces.
              , ppSep :: String
@@ -487,6 +540,7 @@ instance Default PP where
                , ppVisible         = wrap "<" ">"
                , ppHidden          = id
                , ppHiddenNoWindows = const ""
+               , ppVisibleNoWindows= Nothing
                , ppUrgent          = id
                , ppSep             = " : "
                , ppWsSep           = " "

XMonad/Hooks/EwmhDesktops.hs

@@ -25,15 +25,19 @@ module XMonad.Hooks.EwmhDesktops (
     ) where
 
 import Codec.Binary.UTF8.String (encode)
+import Control.Applicative((<$>))
 import Data.List
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Map.Strict as M
+import System.IO.Unsafe
 
 import XMonad
 import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import qualified XMonad.Util.ExtensibleState as E
 import XMonad.Util.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.WindowProperties (getProp32)
@@ -69,6 +73,58 @@ ewmhDesktopsStartup = setSupported
 -- of the current state of workspaces and windows.
 ewmhDesktopsLogHook :: X ()
 ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
+
+-- |
+-- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and
+-- @_NET_DESKTOP_NAMES@).
+newtype DesktopNames = DesktopNames [String]
+                     deriving (Eq)
+
+instance ExtensionClass DesktopNames where
+    initialValue = DesktopNames []
+
+-- |
+-- Cached client list (e.g. @_NET_CLIENT_LIST@).
+newtype ClientList = ClientList [Window]
+                   deriving (Eq)
+
+instance ExtensionClass ClientList where
+    initialValue = ClientList []
+
+-- |
+-- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@).
+newtype CurrentDesktop = CurrentDesktop Int
+                       deriving (Eq)
+
+instance ExtensionClass CurrentDesktop where
+    initialValue = CurrentDesktop 0
+
+-- |
+-- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@).
+newtype WindowDesktops = WindowDesktops (M.Map Window Int)
+                       deriving (Eq)
+
+instance ExtensionClass WindowDesktops where
+    initialValue = WindowDesktops M.empty
+
+-- |
+-- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property
+-- updates.
+newtype ActiveWindow = ActiveWindow Window
+                     deriving (Eq)
+
+instance ExtensionClass ActiveWindow where
+    initialValue = ActiveWindow none
+
+-- | Compare the given value against the value in the extensible state. Run the
+-- action if it has changed.
+whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
+whenChanged v action = do
+    v0 <- E.get
+    unless (v == v0) $ do
+        action
+        E.put v
+
 -- |
 -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
 -- user-specified function to transform the workspace list (post-sorting)
@@ -77,38 +133,32 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
     sort' <- getSortByIndex
     let ws = f $ sort' $ W.workspaces s
 
-    -- Number of Workspaces
+    -- Set number of workspaces and names thereof
-    setNumberOfDesktops (length ws)
+    let desktopNames = map W.tag ws
+    whenChanged (DesktopNames desktopNames) $ do
+        setNumberOfDesktops (length desktopNames)
+        setDesktopNames desktopNames
 
-    -- Names thereof
+    -- Set client list; all windows, with focused windows last
-    setDesktopNames (map W.tag ws)
+    let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws
+    whenChanged (ClientList clientList) $ setClientList clientList
 
-    -- all windows, with focused windows last
+    -- Remap the current workspace to handle any renames that f might be doing.
-    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
+    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
-    setClientList wins
+        current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
+    whenChanged (CurrentDesktop $ fromMaybe 0 current) $ do
+        mapM_ setCurrentDesktop current
 
-    -- Current desktop
+    -- Set window-desktop mapping
-    case (elemIndex (W.currentTag s) $ map W.tag ws) of
+    let windowDesktops =
-      Nothing -> return ()
+          let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
-      Just curr -> do
+          in M.unions $ zipWith f [0..] ws
-        setCurrentDesktop curr
+    whenChanged (WindowDesktops windowDesktops) $ do
+        mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
 
-        -- Per window Desktop
+    -- Set active window
-        -- To make gnome-panel accept our xinerama stuff, we display
+    let activeWindow' = fromMaybe none (W.peek s)
-        -- all visible windows on the current desktop.
+    whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
-        forM_ (W.current s : W.visible s) $ \x ->
-            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
-                setWindowDesktop win curr
-
-    forM_ (W.hidden s) $ \w ->
-        case elemIndex (W.tag w) (map W.tag ws) of
-          Nothing -> return ()
-          Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
-                         setWindowDesktop win wn
-
-    setActiveWindow
-
-    return ()
 
 -- |
 -- Intercepts messages from pagers and similar applications and reacts on them.
@@ -255,9 +305,8 @@ setSupported = withDisplay $ \dpy -> do
 
     setWMName "xmonad"
 
-setActiveWindow :: X ()
+setActiveWindow :: Window -> X ()
-setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
+setActiveWindow w = withDisplay $ \dpy -> do
-    let w = fromMaybe none (W.peek s)
     r <- asks theRoot
     a <- getAtom "_NET_ACTIVE_WINDOW"
     c <- getAtom "WINDOW"

XMonad/Hooks/FadeWindows.hs

@@ -61,7 +61,8 @@ import           Control.Monad.Reader                    (ask
                                                          ,asks)
 import           Control.Monad.State                     (gets)
 import qualified Data.Map                    as M
-import           Data.Monoid
+import           Data.Monoid                      hiding ((<>))
+import           Data.Semigroup
 
 import           Graphics.X11.Xlib.Extras                (Event(..))
 
@@ -134,6 +135,9 @@ instance Monoid Opacity where
   r      `mappend` OEmpty = r
   _      `mappend` r      = r
 
+instance Semigroup Opacity where
+  (<>) = mappend
+
 -- | A FadeHook is similar to a ManageHook, but records window opacity.
 type FadeHook = Query Opacity
 

XMonad/Hooks/WallpaperSetter.hs

@@ -41,7 +41,8 @@ import Data.Ord (comparing)
 import Control.Monad
 import Control.Applicative
 import Data.Maybe
-import Data.Monoid
+import Data.Monoid hiding ((<>))
+import Data.Semigroup
 
 -- $usage
 -- This module requires imagemagick and feh to be installed, as these are utilized
@@ -86,6 +87,9 @@ instance Monoid WallpaperList where
   mappend (WallpaperList w1) (WallpaperList w2) =
     WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
 
+instance Semigroup WallpaperList where
+  (<>) = mappend
+
 -- | Complete wallpaper configuration passed to the hook
 data WallpaperConf = WallpaperConf {
     wallpaperBaseDir :: FilePath  -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)

XMonad/Layout/BinaryColumn.hs

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

XMonad/Layout/Fullscreen.hs

@@ -30,17 +30,19 @@ module XMonad.Layout.Fullscreen
     ,FullscreenFloat, FullscreenFocus, FullscreenFull
     ) where
 
-import XMonad
+import           XMonad
-import XMonad.Layout.LayoutModifier
+import           XMonad.Layout.LayoutModifier
-import XMonad.Util.WindowProperties
+import           XMonad.Hooks.ManageHelpers     (isFullscreen)
-import XMonad.Hooks.ManageHelpers (isFullscreen)
+import           XMonad.Util.WindowProperties
-import qualified XMonad.StackSet as W
+import qualified XMonad.Util.Rectangle          as R
-import Data.List
+import qualified XMonad.StackSet                as W
-import Data.Maybe
+
-import Data.Monoid
+import           Data.List
-import qualified Data.Map as M
+import           Data.Maybe
-import Control.Monad
+import           Data.Monoid
-import Control.Arrow (second)
+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)
+    (visfulls' ++ rest', Nothing)
-    where visfulls = intersect fulls $ map fst list
+    where (visfulls,rest) = partition (flip elem fulls . fst) list
-          rest = filter (flip notElem visfulls . 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 ((/= f) . fst) list
+     where rest = filter (not . orP (== f) (R.supersetOf rect')) list
            rect' = scaleRationalRect rect frect
   pureModifier _ _ Nothing list = (list, Nothing)
 
@@ -240,3 +245,6 @@ fullscreenManageHook' isFull = isFull --> do
     sendMessageWithNoRefresh FullscreenChanged cw
   idHook
 
+-- | Applies a pair of predicates to a pair of operands, combining them with ||.
+orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
+orP f g (x, y) = f x || g y

XMonad/Layout/Gaps.hs

@@ -14,7 +14,9 @@
 -- be used for tiling, along with support for toggling gaps on and
 -- off.
 --
--- Note that "XMonad.Hooks.ManageDocks" is the preferred solution for
+-- Note 1: For gaps\/space around /windows/ see "XMonad.Layout.Spacing".
+--
+-- Note 2: "XMonad.Hooks.ManageDocks" is the preferred solution for
 -- leaving space for your dock-type applications (status bars,
 -- toolbars, docks, etc.), since it automatically sets up appropriate
 -- gaps, allows them to be toggled, etc.  However, this module may
@@ -29,8 +31,8 @@ module XMonad.Layout.Gaps (
                                -- * Usage
                                -- $usage
                           Direction2D(..), Gaps,
-                          GapSpec, gaps, gaps', GapMessage(..)
+                          GapSpec, gaps, gaps', GapMessage(..),
-
+                          weakModifyGaps, modifyGap, setGaps, setGap
                           ) where
 
 import XMonad.Core
@@ -55,10 +57,23 @@ import Data.List (delete)
 -- You can additionally add some keybindings to toggle or modify the gaps,
 -- for example:
 --
--- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps)  -- toggle all gaps
+-- > , ((modm .|. controlMask, xK_g), sendMessage $ ToggleGaps)               -- toggle all gaps
--- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U) -- toggle the top gap
+-- > , ((modm .|. controlMask, xK_t), sendMessage $ ToggleGap U)              -- toggle the top gap
--- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R)  -- increment the right-hand gap
+-- > , ((modm .|. controlMask, xK_w), sendMessage $ IncGap 5 R)               -- increment the right-hand gap
--- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R)  -- decrement the right-hand gap
+-- > , ((modm .|. controlMask, xK_q), sendMessage $ DecGap 5 R)               -- decrement the right-hand gap
+-- > , ((modm .|. controlMask, xK_r), sendMessage $ ModifyGaps rotateGaps)    -- rotate gaps 90 degrees clockwise
+-- > , ((modm .|. controlMask, xK_h), sendMessage $ weakModifyGaps halveHor)  -- halve the left and right-hand gaps
+-- > , ((modm .|. controlMask, xK_d), sendMessage $ modifyGap (*2) L)         -- double the left-hand gap
+-- > , ((modm .|. controlMask, xK_s), sendMessage $ setGaps [(U,18), (R,23)]) -- reset the GapSpec
+-- > , ((modm .|. controlMask, xK_b), sendMessage $ setGap 30 D)              -- set the bottom gap to 30
+-- > ]
+-- >   where rotateGaps gs = zip (map (rotate . fst) gs) (map snd gs)
+-- >         rotate U = R
+-- >         rotate R = D
+-- >         rotate D = L
+-- >         rotate L = U
+-- >         halveHor d i | d `elem` [L, R] = i `div` 2
+-- >                      | otherwise       = i
 --
 -- If you want complete control over all gaps, you could include
 -- something like this in your keybindings, assuming in this case you
@@ -93,6 +108,7 @@ data GapMessage = ToggleGaps              -- ^ Toggle all gaps.
                 | ToggleGap  !Direction2D    -- ^ Toggle a single gap.
                 | IncGap !Int !Direction2D    -- ^ Increase a gap by a certain number of pixels.
                 | DecGap !Int !Direction2D    -- ^ Decrease a gap.
+                | ModifyGaps (GapSpec -> GapSpec) -- ^ Modify arbitrarily.
   deriving (Typeable)
 
 instance Message GapMessage
@@ -106,11 +122,46 @@ instance LayoutModifier Gaps a where
       | Just (ToggleGap d) <- fromMessage m
         = Just $ Gaps conf (toggleGap conf cur d)
       | Just (IncGap i d)  <- fromMessage m
-        = Just $ Gaps (incGap conf d i) cur
+        = Just $ Gaps (limit . continuation (+  i ) d $ conf) cur
       | Just (DecGap i d)  <- fromMessage m
-        = Just $ Gaps (incGap conf d (-i)) cur
+        = Just $ Gaps (limit . continuation (+(-i)) d $ conf) cur
+      | Just (ModifyGaps f) <- fromMessage m
+        = Just $ Gaps (limit . f $ conf) cur
       | otherwise = Nothing
 
+-- | Modifies gaps weakly, for convenience.
+weakModifyGaps :: (Direction2D -> Int -> Int) -> GapMessage
+weakModifyGaps = ModifyGaps . weakToStrong
+
+-- | Arbitrarily modify a single gap with the given function.
+modifyGap :: (Int -> Int) -> Direction2D -> GapMessage
+modifyGap f d = ModifyGaps $ continuation f d
+
+-- | Set the GapSpec.
+setGaps :: GapSpec -> GapMessage
+setGaps = ModifyGaps . const
+
+-- | Set a gap to the given value.
+setGap :: Int -> Direction2D -> GapMessage
+setGap = modifyGap . const
+
+-- | Imposes limits upon a GapSpec, ensuring gaps are at least 0. Not exposed.
+limit :: GapSpec -> GapSpec
+limit = weakToStrong $ \_ -> max 0
+
+-- | Takes a weak gaps-modifying function f and returns a GapSpec modifying
+-- function. Not exposed.
+weakToStrong :: (Direction2D -> Int -> Int) -> GapSpec -> GapSpec
+weakToStrong f gs = zip (map fst gs) (map (uncurry f) gs)
+
+-- | Given f as a definition for the behaviour of a gaps modifying function in
+-- one direction d, produces a continuation of the function to the other
+-- directions using the identity. Not exposed.
+continuation :: (Int -> Int) -> Direction2D -> GapSpec -> GapSpec
+continuation f d1 = weakToStrong h
+  where h d2 | d2 == d1  = f
+             | otherwise = id
+
 applyGaps :: Gaps a -> Rectangle -> Rectangle
 applyGaps gs r = foldr applyGap r (activeGaps gs)
   where
@@ -131,9 +182,6 @@ toggleGap conf cur d | d `elem` cur            = delete d cur
                      | d `elem` (map fst conf) = d:cur
                      | otherwise               = cur
 
-incGap :: GapSpec -> Direction2D -> Int -> GapSpec
-incGap gs d i = map (\(dir,j) -> if dir == d then (dir,max (j+i) 0) else (dir,j)) gs
-
 -- | Add togglable manual gaps to a layout.
 gaps :: GapSpec   -- ^ The gaps to allow, paired with their initial sizes.
      -> l a       -- ^ The layout to modify.

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

XMonad/Layout/Groups.hs

@@ -1,6 +1,6 @@
 {-# OPTIONS_GHC -fno-warn-name-shadowing -fno-warn-unused-binds #-}
 {-# LANGUAGE StandaloneDeriving, FlexibleContexts, DeriveDataTypeable
-  , UndecidableInstances, FlexibleInstances, MultiParamTypeClasses
+  , UndecidableInstances, FlexibleInstances, LambdaCase, MultiParamTypeClasses
   , PatternGuards, Rank2Types, TypeSynonymInstances #-}
 
 -----------------------------------------------------------------------------
@@ -25,6 +25,7 @@ module XMonad.Layout.Groups ( -- * Usage
                               -- * Messages
                             , GroupsMessage(..)
                             , ModifySpec
+                            , ModifySpecX
                               -- ** Useful 'ModifySpec's
                             , swapUp
                             , swapDown
@@ -60,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.Applicative ((<$>),(<|>),(<$))
-import Control.Monad (forM)
+import Control.Monad (forM,void)
 
 -- $usage
 -- This module provides a layout combinator that allows you
@@ -99,7 +100,6 @@ group :: l Window -> l2 (Group l Window) -> Groups l l2 Window
 group l l2 = Groups l l2 startingGroups (U 1 0)
     where startingGroups = fromJust $ singletonZ $ G (ID (U 0 0) l) emptyZ
 
-
 -- * Stuff with unique keys
 
 data Uniq = U Integer Integer
@@ -187,6 +187,7 @@ data GroupsMessage = ToEnclosing SomeMessage -- ^ Send a message to the enclosin
                              -- to the layout.
                    | Modify ModifySpec -- ^ Modify the ordering\/grouping\/focusing
                                        -- of windows according to a 'ModifySpec'
+                   | ModifyX ModifySpecX -- ^ Same as 'Modify', but within the 'X' monad
                      deriving Typeable
 
 instance Show GroupsMessage where
@@ -206,6 +207,13 @@ modifyGroups f g = let (seed', id:_) = gen (seed g)
                    in g { groups = fromMaybe defaultGroups . f . Just $ groups g
                         , seed = seed' }
 
+modifyGroupsX :: (Zipper (Group l a) -> X (Zipper (Group l a)))
+              -> Groups l l2 a -> X (Groups l l2 a)
+modifyGroupsX f g = do
+  let (seed', id:_) = gen (seed g)
+      defaultGroups = fromJust $ singletonZ $ G (ID id $ baseLayout g) emptyZ
+  g' <- f . Just $ groups g
+  return g { groups = fromMaybe defaultGroups g', seed = seed' }
 
 -- ** Readaptation
 
@@ -303,9 +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')
+                                      Just l' -> refocus l'
-                                      Nothing -> return $ Just l
+                                      Nothing -> return Nothing
-              Just Refocus -> refocus l >> return (Just l)
+              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
@@ -332,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 :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
-refocus g = case getFocusZ $ gZipper $ W.focus $ groups g
+refocus g =
-            of Just w -> focus w
+  let mw = (getFocusZ . gZipper . W.focus . groups) g
-               Nothing -> return ()
+  in  g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)
 
 -- ** ModifySpec type
 
@@ -361,29 +372,50 @@ type ModifySpec = forall l. WithID l Window
                 -> Zipper (Group l Window)
                 -> Zipper (Group l Window)
 
+-- ** ModifierSpecX type
+
+-- | This is the same as 'ModifySpec', but it allows the function to use
+-- actions inside the 'X' monad. This is useful, for example, if the function
+-- has to make decisions based on the results of a 'runQuery'.
+type ModifySpecX = forall l. WithID l Window
+                 -> Zipper (Group l Window)
+                 -> X (Zipper (Group l Window))
+
 -- | Apply a ModifySpec.
 applySpec :: ModifySpec -> Groups l l2 Window -> Maybe (Groups l l2 Window)
-applySpec f g = let (seed', id:ids) = gen $ seed g
+applySpec f g =
-                    g' = flip modifyGroups g $ f (ID id $ baseLayout g)
+    let (seed', id:ids) =  gen $ seed g
-                                               >>> toTags
+        g' = flip modifyGroups g $ f (ID id $ baseLayout g)
-                                               >>> foldr reID ((ids, []), [])
+                                   >>> toTags
-                                               >>> snd
+                                   >>> foldr (reID g) ((ids, []), [])
-                                               >>> fromTags
+                                   >>> snd
-                in case groups g == groups g' of
+                                   >>> fromTags
-                     True -> Nothing
+    in case groups g == groups g' of
-                     False -> Just g' { seed = seed' }
+      True -> Nothing
-
+      False -> Just g' { seed = seed' }
-    where reID eg ((id:ids, seen), egs)
-              = let myID = getID $ gLayout $ fromE eg
-                in case elem myID seen of
-                     False -> ((id:ids, myID:seen), eg:egs)
-                     True -> ((ids, seen), mapE_ (setID id) eg:egs)
-              where setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
-          reID _ (([], _), _) = undefined -- The list of ids is infinite
-
-
 
+applySpecX :: ModifySpecX -> Groups l l2 Window -> X (Maybe (Groups l l2 Window))
+applySpecX f g = do
+    let (seed', id:ids) = gen $ seed g
+    g' <- flip modifyGroupsX g $ f (ID id $ baseLayout g)
+                                >>> fmap toTags
+                                >>> fmap (foldr (reID g) ((ids, []), []))
+                                >>> fmap snd
+                                >>> fmap fromTags
+    return $ case groups g == groups g' of
+      True -> Nothing
+      False -> Just g' { seed = seed' }
 
+reID :: Groups l l2 Window
+     -> Either (Group l Window) (Group l Window)
+     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
+     -> (([Uniq], [Uniq]), [Either (Group l Window) (Group l Window)])
+reID _ _ (([], _), _) = undefined -- The list of ids is infinite
+reID g eg ((id:ids, seen), egs) = case elem myID seen of
+                                    False -> ((id:ids, myID:seen), eg:egs)
+                                    True -> ((ids, seen), mapE_ (setID id) eg:egs)
+    where myID = getID $ gLayout $ fromE eg
+          setID id (G (ID _ _) z) = G (ID id $ baseLayout g) z
 
 -- ** Misc. ModifySpecs
 

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

XMonad/Layout/LayoutHints.hs

@@ -44,6 +44,7 @@ import Data.Monoid(All(..))
 
 import Data.Set (Set)
 import qualified Data.Set as Set
+import Data.Maybe(fromJust)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -147,10 +148,15 @@ instance LayoutModifier LayoutHintsToCenter Window where
     modifyLayout _ ws@(W.Workspace _ _ (Just st)) r = do
         (arrs,ol) <- runLayout ws r
         flip (,) ol
+            . changeOrder (W.focus st : (filter (/= W.focus st) $ map fst arrs))
             . head . reverse . sortBy (compare `on` (fitting . map snd))
             . map (applyHints st r) . applyOrder r
             <$> mapM (\x -> fmap ((,) x) $ mkAdjust (fst x)) arrs
 
+changeOrder :: [Window] -> [(Window, Rectangle)] -> [(Window, Rectangle)]
+changeOrder w wr = zip w' $ map (fromJust . flip lookup wr) w'
+    where w' = filter (`elem` map fst wr) w
+
 -- apply hints to first, grow adjacent windows
 applyHints :: W.Stack Window -> Rectangle -> [((Window, Rectangle),(D -> D))] -> [(Window, Rectangle)]
 applyHints _ _ [] = []

XMonad/Layout/Mosaic.hs

@@ -38,7 +38,8 @@ import Control.Monad(mplus)
 import Data.Foldable(Foldable,foldMap, sum)
 import Data.Function(on)
 import Data.List(sortBy)
-import Data.Monoid(Monoid,mempty, mappend)
+import Data.Monoid(Monoid,mempty, mappend, (<>))
+import Data.Semigroup
 
 
 -- $usage
@@ -202,6 +203,9 @@ instance Monoid (Tree a) where
     mappend x Empty = x
     mappend x y = Branch x y
 
+instance Semigroup (Tree a) where
+    (<>) = mappend
+
 makeTree ::  (Num a1, Ord a1) => (a -> a1) -> [a] -> Tree a
 makeTree _ [] = Empty
 makeTree _ [x] = Leaf x

XMonad/Layout/MultiColumns.hs

@@ -77,10 +77,9 @@ data MultiCol a = MultiCol
   } deriving (Show,Read,Eq)
 
 instance LayoutClass MultiCol a where
-    doLayout l r s = return (zip w rlist, resl)
+    doLayout l r s = return (combine s rlist, resl)
         where rlist = doL (multiColNWin l') (multiColSize l') r wlen
-              w = W.integrate s
+              wlen = length $ W.integrate s
-              wlen = length w
               -- Make sure the list of columns is big enough and update active column
               nw = multiColNWin l ++ repeat (multiColDefWin l)
               l' = l { multiColNWin = take (max (length $ multiColNWin l) $ getCol (wlen-1) nw + 1) nw
@@ -90,6 +89,7 @@ instance LayoutClass MultiCol a where
               resl = if l'==l
                      then Nothing
                      else Just l'
+              combine (W.Stack foc left right) rs = zip (foc : reverse left ++ right) $ raiseFocused (length left) rs
     handleMessage l m =
         return $ msum [fmap resize     (fromMessage m)
                       ,fmap incmastern (fromMessage m)]
@@ -104,6 +104,10 @@ instance LayoutClass MultiCol a where
                   a = multiColActive l
     description _ = "MultiCol"
 
+raiseFocused :: Int -> [a] -> [a]
+raiseFocused n xs = actual ++ before ++ after
+    where (before,rest) = splitAt n xs
+          (actual,after) = splitAt 1 rest
 
 -- | Get which column a window is in, starting at 0.
 getCol :: Int -> [Int] -> Int

XMonad/Layout/MultiDishes.hs

@@ -0,0 +1,92 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.MultiDishes
+-- Copyright   :  (c) Jeremy Apthorp, Nathan Fairhurst
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Nathan Fairhurst <nathan.p3pictures@gmail.com>
+-- Stability   :  unstable
+-- Portability :  portable
+--
+-- MultiDishes is a layout that stacks groups of extra windows underneath
+-- the master windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Layout.MultiDishes (
+                              -- * Usage
+                              -- $usage
+                              MultiDishes (..)
+                            ) where
+
+import XMonad
+import XMonad.StackSet (integrate)
+import Control.Monad (ap)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.MultiDishes
+--
+-- Then edit your @layoutHook@ by adding the MultiDishes layout:
+--
+-- > myLayout = MultiDishes 2 3 (1/6) ||| Full ||| etc..
+-- > main = xmonad def { layoutHook = myLayout }
+--
+-- This is based on the Layout Dishes, but accepts another parameter for
+-- the maximum number of dishes allowed within a stack.
+--
+-- > MultiDishes x 1 y
+-- is equivalent to 
+-- > Dishes x y
+--
+-- The stack with the fewest dishes is always on top, so 4 windows
+-- with the layout `MultiDishes 1 2 (1/5)` would look like this:
+--
+-- > _________
+-- > |       |
+-- > |   M   |
+-- > |_______|
+-- > |_______|
+-- > |___|___|
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+data MultiDishes a = MultiDishes Int Int Rational deriving (Show, Read)
+instance LayoutClass MultiDishes a where
+    pureLayout (MultiDishes nmaster dishesPerStack h) r =
+        ap zip (multiDishes h r nmaster dishesPerStack . length) . integrate
+    pureMessage (MultiDishes nmaster dishesPerStack h) m = fmap incmastern (fromMessage m)
+        where incmastern (IncMasterN d) = MultiDishes (max 0 (nmaster+d)) dishesPerStack h
+
+multiDishes :: Rational -> Rectangle -> Int -> Int -> Int -> [Rectangle]
+multiDishes h s nmaster dishesPerStack n = if n <= nmaster
+                        then splitHorizontally n s
+                        else ws
+ where
+    (filledDishStackCount, remainder) =
+      (n - nmaster) `quotRem` (max 1 dishesPerStack)
+
+    (firstDepth, dishStackCount) =
+      if remainder == 0 then
+        (dishesPerStack, filledDishStackCount)
+      else
+        (remainder, filledDishStackCount + 1)
+
+    (masterRect, dishesRect) =
+      splitVerticallyBy (1 - (fromIntegral dishStackCount) * h) s
+
+    dishStackRects =
+      splitVertically dishStackCount dishesRect
+
+    allDishRects = case dishStackRects of
+      (firstStack:bottomDishStacks) ->
+        splitHorizontally firstDepth firstStack ++ (bottomDishStacks >>= splitHorizontally dishesPerStack)
+      [] -> []
+
+    ws =
+      splitHorizontally nmaster masterRect ++ allDishRects

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

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  :  <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')

XMonad/Layout/NoBorders.hs

@@ -1,10 +1,11 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
-{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE TypeSynonymInstances, PatternGuards, DeriveDataTypeable #-}
 
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.NoBorders
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- Copyright   :  (c) --    David Roundy <droundy@darcs.net>
+--                    2018  Yclept Nemo
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
@@ -18,25 +19,32 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Layout.NoBorders (
+module XMonad.Layout.NoBorders ( -- * Usage
-                                -- * Usage
+                                 -- $usage
-                                -- $usage
+                                 noBorders
-                                noBorders,
+                               , smartBorders
-                                smartBorders,
+                               , withBorder
-                                withBorder,
+                               , lessBorders
-                                lessBorders,
+                               , hasBorder
-                                SetsAmbiguous(..),
+                               , SetsAmbiguous(..)
-                                Ambiguity(..),
+                               , Ambiguity(..)
-                                With(..),
+                               , With(..)
-                                SmartBorder, WithBorder, ConfigurableBorder,
+                               , BorderMessage (..), borderEventHook
+                               , SmartBorder, WithBorder, ConfigurableBorder
                                ) where
 
-import XMonad
+import           XMonad
-import XMonad.Layout.LayoutModifier
+import           XMonad.Layout.LayoutModifier
-import qualified XMonad.StackSet as W
+import qualified XMonad.StackSet                as W
-import Data.List
+import qualified XMonad.Util.Rectangle          as R
-import qualified Data.Map as M
+
-import Data.Function (on)
+import           Data.List
+import           Data.Monoid
+import qualified Data.Map                       as M
+import           Data.Function                  (on)
+import           Control.Applicative            ((<$>),(<*>),pure)
+import           Control.Monad                  (guard)
+
 
 -- $usage
 -- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
@@ -100,34 +108,94 @@ smartBorders = lessBorders Never
 -- instances
 lessBorders :: (SetsAmbiguous p, Read p, Show p, LayoutClass l a) =>
         p -> l a -> ModifiedLayout (ConfigurableBorder p) l a
-lessBorders amb = ModifiedLayout (ConfigurableBorder amb [])
+lessBorders amb = ModifiedLayout (ConfigurableBorder amb [] [] [])
 
-data ConfigurableBorder p w = ConfigurableBorder p [w] deriving (Read, Show)
+-- | 'ManageHook' for sending 'HasBorder' messages:
+--
+-- >    title =? "foo" --> hasBorder True
+--
+-- There is no equivalent for 'ResetBorder'.
+hasBorder :: Bool -> ManageHook
+hasBorder b = ask >>= \w -> liftX (broadcastMessage $ HasBorder b w) >> idHook
+
+data BorderMessage
+    = HasBorder Bool Window
+        -- ^ If @True@, never remove the border from the specified window. If
+        -- @False@, always remove the border from the specified window.
+    | ResetBorder Window
+        -- ^ Reset the effects of any 'HasBorder' messages on the specified
+        -- window.
+    deriving (Typeable)
+
+instance Message BorderMessage
+
+data ConfigurableBorder p w = ConfigurableBorder
+    { _generateHidden :: p
+        -- ^ Generates a list of windows without borders. Uses 'SetsAmbiguous'
+        -- to filter the current layout.
+    , alwaysHidden   :: [w]
+        -- ^ Windows that never have borders. This list is added to the result
+        -- of 'generateHidden'.
+    , neverHidden    :: [w]
+        -- ^ Windows that always have borders - i.e. ignored by this module.
+        -- This list is subtraced from 'alwaysHidden' and so has higher
+        -- precendence.
+    , currentHidden  :: [w]
+        -- ^ The current set of windows without borders, i.e. the state.
+    } deriving (Read, Show)
+
+-- | Only necessary with 'BorderMessage' - remove non-existent windows from the
+-- 'alwaysHidden' or 'neverHidden' lists.
+borderEventHook :: Event -> X All
+borderEventHook (DestroyWindowEvent { ev_window = w }) = do
+    broadcastMessage $ ResetBorder w
+    return $ All True
+borderEventHook _ = return $ All True
 
 instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
-    unhook (ConfigurableBorder _p s) = asks (borderWidth . config) >>= setBorders s
+    unhook (ConfigurableBorder _ _ _ ch) = asks (borderWidth . config) >>= setBorders ch
 
-    redoLayout (ConfigurableBorder p s) _ mst wrs = do
+    redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do
-        ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
+        let gh' wset = let lh = (hiddens gh wset lr mst wrs)
-        asks (borderWidth . config) >>= setBorders (s \\ ws)
+                       in  return $ (ah `union` lh) \\ nh
-        setBorders ws 0
+        ch' <- withWindowSet gh'
-        return (wrs, Just $ ConfigurableBorder p ws)
+        asks (borderWidth . config) >>= setBorders (ch \\ ch')
+        setBorders ch' 0
+        return (wrs, Just $ cb { currentHidden = ch' })
+
+    pureMess cb@(ConfigurableBorder gh ah nh ch) m
+        | Just (HasBorder b w) <- fromMessage m =
+            let consNewIf l True  = if w `elem` l then Nothing else Just (w:l)
+                consNewIf l False = Just l
+            in  (ConfigurableBorder gh) <$> consNewIf ah (not b)
+                                        <*> consNewIf nh b
+                                        <*> pure ch
+        | Just (ResetBorder w) <- fromMessage m =
+            let delete' e l = if e `elem` l then (True,delete e l) else (False,l)
+                (da,ah') = delete' w ah
+                (dn,nh') = delete' w nh
+            in  if da || dn
+                then Just cb { alwaysHidden = ah', neverHidden = nh' }
+                else Nothing
+        | otherwise = Nothing
 
 -- | SetsAmbiguous allows custom actions to generate lists of windows that
 -- should not have borders drawn through 'ConfigurableBorder'
 --
 -- To add your own (though perhaps those options would better belong as an
--- aditional constructor to 'Ambiguity'), you can add the function as such:
+-- additional constructor to 'Ambiguity'), you can add the following function.
+-- Note that @lr@, the parameter representing the 'Rectangle' of the parent
+-- layout, was added to 'hiddens' in 0.14. Update your instance accordingly.
 --
 -- > data MyAmbiguity = MyAmbiguity deriving (Read, Show)
 --
 -- > instance SetsAmbiguous MyAmbiguity where
--- >  hiddens _ wset mst wrs = otherHiddens Screen \\ otherHiddens OnlyFloat
+-- >  hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat
--- >     where otherHiddens p = hiddens p wset mst wrs
+-- >     where otherHiddens p = hiddens p wset lr mst wrs
 --
 -- The above example is redundant, because you can have the same result with:
 --
--- > layoutHook = lessBorders (Combine Difference Screen OnlyFloat) (Tall 1 0.5 0.03 ||| ... )
+-- > layoutHook = lessBorders (Combine Difference Screen OnlyScreenFloat) (Tall 1 0.5 0.03 ||| ... )
 --
 -- To get the same result as 'smartBorders':
 --
@@ -136,32 +204,87 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
 -- This indirect method is required to keep the 'Read' and 'Show' for
 -- ConfigurableBorder so that xmonad can serialize state.
 class SetsAmbiguous p where
-    hiddens :: p -> WindowSet -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
+    hiddens :: p -> WindowSet -> Rectangle -> Maybe (W.Stack Window) -> [(Window, Rectangle)] -> [Window]
 
+-- Quick overview since the documentation lacks clarity:
+-- * Overall stacking order =
+--      tiled stacking order ++ floating stacking order
+--   Where tiled windows are (obviously) stacked below floating windows.
+-- * Tiled stacking order =
+--      [(window, Rectangle] order
+--   Given by 'XMonad.Core.LayoutClass' where earlier entries are stacked
+--   higher.
+-- * Floating stacking order =
+--      focus order
+--   Given by the workspace stack where a higher focus corresponds to a higher
+--   stacking position.
+--
+-- Integrating a stack returns a list in order of [highest...lowest].
+--
+-- 'XMonad.Core.LayoutClass' is given a stack with all floating windows removed
+-- and returns a list (in stack order) of only the visible tiled windows, while
+-- the workspace stack contains all windows (visible/hidden, floating/tiled) in
+-- focus order. The StackSet 'floating' field maps all floating windows across
+-- all workspaces to relative rectangles - without the associated screen.
+--
+-- 'XMonad.Operations.windows' gets the windowset from the state, mutates it,
+-- then updates the state before calling 'runLayout' with the new windowset -
+-- excluding any floating windows. Aside from the filtering, the stack received
+-- by the layout should be identical to the one received from 'withWindowSet'.
 instance SetsAmbiguous Ambiguity where
-    hiddens amb wset mst wrs
+    hiddens amb wset lr mst wrs
       | Combine Union a b <- amb = on union next a b
       | Combine Difference a b <- amb = on (\\) next a b
       | Combine Intersection a b <- amb = on intersect next a b
       | otherwise = tiled ms ++ floating
-      where next p = hiddens p wset mst wrs
+      where next p = hiddens p wset lr mst wrs
-            nonzerorect (Rectangle _ _ 0 0) = False
+
-            nonzerorect _ = True
+            screens = [ scr | scr <- W.screens wset
+                            , case amb of
+                                    Never -> True
+                                    _     -> not $ null $ integrate scr
+                            , not . R.empty . screenRect
+                                $ W.screenDetail scr
+                            ]
+
+            -- This originally considered all floating windows across all
+            -- workspaces. It seems more efficient to have each layout manage
+            -- its own floating windows - and equally valid though untested
+            -- against a multihead setup. In some cases the previous code would
+            -- redundantly add then remove borders from already-borderless
+            -- windows.
+            floating = do
+                let wz :: Integer -> (Window,Rectangle)
+                       -> (Integer,Window,Rectangle)
+                    wz i (w,wr) = (i,w,wr)
+                    -- For the following: in stacking order lowest -> highest.
+                    ts = reverse . zipWith wz [-1,-2..] $ wrs
+                    fs = zipWith wz [0..] $ do
+                        w       <- reverse . W.index $ wset
+                        Just wr <- [M.lookup w (W.floating wset)]
+                        return (w,scaleRationalRect sr wr)
+                    sr = screenRect . W.screenDetail . W.current $ wset
+                (i1,w1,wr1) <- fs
+                guard $ case amb of
+                    OnlyLayoutFloatBelow ->
+                        let vu = do
+                            gr           <- sr `R.difference` lr
+                            (i2,_w2,wr2) <- ts ++ fs
+                            guard $ i2 < i1
+                            [wr2 `R.intersects` gr]
+                        in lr == wr1 && (not . or) vu
+                    OnlyLayoutFloat ->
+                        lr == wr1
+                    _ ->
+                        wr1 `R.supersetOf` sr
+                return w1
 
-            screens =
-              [ scr | scr <- W.screens wset,
-                      case amb of
-                            Never -> True
-                            _ -> not $ null $ integrate scr,
-                      nonzerorect . screenRect $ W.screenDetail scr]
-            floating = [ w |
-                        (w, W.RationalRect px py wx wy) <- M.toList . W.floating $ wset,
-                        px <= 0, py <= 0,
-                        wx + px >= 1, wy + py >= 1]
             ms = filter (`elem` W.integrate' mst) $ map fst wrs
             tiled [w]
               | Screen <- amb = [w]
-              | OnlyFloat <- amb = []
+              | OnlyScreenFloat <- amb = []
+              | OnlyLayoutFloat <- amb = []
+              | OnlyLayoutFloatBelow <- amb = []
               | OtherIndicated <- amb
               , let nonF = map integrate $ W.current wset : W.visible wset
               , length (concat nonF) > length wrs
@@ -174,23 +297,34 @@ instance SetsAmbiguous Ambiguity where
 -- subsequent constructors add additional cases where borders are not drawn
 -- than their predecessors. These behaviors make most sense with with multiple
 -- screens: for single screens, 'Never' or 'smartBorders' makes more sense.
-data Ambiguity = Combine With Ambiguity Ambiguity
+data Ambiguity
-                             -- ^ This constructor is used to combine the
+    = Combine With Ambiguity Ambiguity
-                             -- borderless windows provided by the
+        -- ^ This constructor is used to combine the borderless windows
-                             -- SetsAmbiguous instances from two other
+        -- provided by the SetsAmbiguous instances from two other 'Ambiguity'
-                             -- 'Ambiguity' data types.
+        -- data types.
-               | OnlyFloat   -- ^ Only remove borders on floating windows that
+    | OnlyScreenFloat
-                             -- cover the whole screen
+        -- ^ Only remove borders on floating windows that cover the whole
-               | Never       -- ^ Never remove borders when ambiguous:
+        -- screen.
-                             -- this is the same as smartBorders
+    | OnlyLayoutFloatBelow
-               | EmptyScreen -- ^ Focus in an empty screens does not count as
+        -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window
-                             -- ambiguous.
+        -- stacked below remains visible. Considers all floating windows on the
-               | OtherIndicated
+        -- current screen and all visible tiled windows of the child layout. If
-                             -- ^ No borders on full when all other screens
+        -- any such window (that is stacked below) shows in any gap between the
-                             -- have borders.
+        -- parent layout rectangle and the physical screen, the border will
-               | Screen      -- ^ Borders are never drawn on singleton screens.
+        -- remain drawn.
-                             -- With this one you really need another way such
+    | OnlyLayoutFloat
-                             -- as a statusbar to detect focus.
+        -- ^ Only remove borders on floating windows that exactly cover the
+        -- parent layout rectangle.
+    | Never
+        -- ^ Never remove borders when ambiguous: this is the same as
+        -- smartBorders.
+    | EmptyScreen
+        -- ^ Focus in an empty screen does not count as ambiguous.
+    | OtherIndicated
+        -- ^ No borders on full when all other screens have borders.
+    | Screen
+        -- ^ Borders are never drawn on singleton screens.  With this one you
+        -- really need another way such as a statusbar to detect focus.
     deriving (Read, Show)
 
 -- | Used to indicate to the 'SetsAmbiguous' instance for 'Ambiguity' how two

XMonad/Layout/Spacing.hs

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

XMonad/Layout/StateFull.hs

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

XMonad/Layout/TwoPanePersistent.hs

@@ -0,0 +1,98 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.TwoPanePersistent
+-- Copyright   :  (c) Chayanon Wichitrnithed
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Chayanon Wichitrnithed <namowi@gatech.edu>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This layout is the same as "XMonad.Layout.TwoPane" except that it keeps track of the slave window
+-- that is alongside the master pane. In other words, it prevents the slave pane
+-- from changing after the focus goes back to the master pane.
+
+-----------------------------------------------------------------------------
+
+
+module XMonad.Layout.TwoPanePersistent
+  (
+    -- * Usage
+    -- $usage
+  TwoPanePersistent(..)
+  ) where
+
+import XMonad.StackSet (focus, up, down, Stack, Stack(..))
+import XMonad hiding (focus)
+
+-- $usage
+-- Import the module in @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Layout.TwoPanePersistent
+--
+-- Then add the layout to the @layoutHook@:
+--
+-- > myLayout = TwoPanePersistent Nothing (3/100) (1/2) ||| Full ||| etc..
+-- > main = xmonad def { layoutHook = myLayout }
+
+
+data TwoPanePersistent a = TwoPanePersistent
+  { slaveWin :: (Maybe a)  -- ^ slave window; if 'Nothing' or not in the current workspace,
+                           -- the window below the master will go into the slave pane
+  , dFrac :: Rational -- ^ shrink/expand size
+  , mFrac :: Rational -- ^ initial master size
+  } deriving (Show, Read)
+
+
+instance (Show a, Eq a) => LayoutClass TwoPanePersistent a where
+  doLayout l r s =
+    case reverse (up s) of
+      -- master is focused
+      []         -> return $ focusedMaster l s r
+
+      -- slave is focused
+      (master:_) -> return $ focusedSlave l s r master
+
+
+  pureMessage (TwoPanePersistent w delta split) x =
+    case fromMessage x of
+      Just Shrink -> Just (TwoPanePersistent w delta (split - delta))
+      Just Expand -> Just (TwoPanePersistent w delta (split + delta))
+      _ -> Nothing
+
+  description _ = "TwoPanePersistent"
+
+
+----------------------------------------------------------------------------------------
+
+focusedMaster :: (Eq a) => TwoPanePersistent a -> Stack a -> Rectangle
+              -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) )
+focusedMaster (TwoPanePersistent w delta split) s r =
+  let (left, right) = splitHorizontallyBy split r in
+      case down s of
+        -- there exist windows below the master
+        (next:_) -> let nextSlave = ( [(focus s, left), (next, right)]
+                                    , Just $ TwoPanePersistent (Just next) delta split )
+                    in case w of
+                      -- if retains state, preserve the layout
+                      Just win -> if win `elem` (down s) && (focus s /= win)
+                                  then ( [(focus s, left), (win, right)]
+                                       , Just $ TwoPanePersistent w delta split )
+                                  else nextSlave
+                      -- if no previous state, default to the next slave window
+                      Nothing -> nextSlave
+
+
+        -- the master is the only window
+        []       -> ( [(focus s, r)]
+                    , Just $ TwoPanePersistent Nothing delta split )
+
+
+
+focusedSlave :: TwoPanePersistent a -> Stack a -> Rectangle -> a
+             -> ( [(a, Rectangle)], Maybe (TwoPanePersistent a) )
+focusedSlave (TwoPanePersistent _ delta split) s r m =
+  ( [(m, left), (focus s, right)]
+  , Just $ TwoPanePersistent (Just $ focus s) delta split )
+  where (left, right) = splitHorizontallyBy split r

XMonad/Prompt/AppendFile.hs

@@ -23,6 +23,7 @@ module XMonad.Prompt.AppendFile (
                                  -- $usage
 
                                  appendFilePrompt,
+                                 appendFilePrompt',
                                  AppendFile,
                                 ) where
 
@@ -55,6 +56,17 @@ import Control.Exception.Extensible (bracket)
 --
 -- (Put the spawn on the line after the prompt to append the time instead.)
 --
+-- 'appendFilePrompt'' can be used to transform the string input in the prompt
+-- before saving into the file. Previous example with date can be rewritten as:
+--
+-- > ,  ((modm .|. controlMask, xK_n), do
+-- >            date <- io $ liftM (formatTime defaultTimeLocale "[%Y-%m-%d %H:%M] ") getZonedTime
+-- >            appendFilePrompt' def (date ++) $ "/home/me/NOTES"
+-- >        )
+--
+-- A benefit is that if the prompt is cancelled the date is not output to
+-- the file too.
+--
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
@@ -66,11 +78,17 @@ instance XPrompt AppendFile where
 -- | Given an XPrompt configuration and a file path, prompt the user
 --   for a line of text, and append it to the given file.
 appendFilePrompt :: XPConfig -> FilePath -> X ()
-appendFilePrompt c fn = mkXPrompt (AppendFile fn)
+appendFilePrompt c fn = appendFilePrompt' c id fn
+
+-- | Given an XPrompt configuration, string transformation function
+--   and a file path, prompt the user for a line of text, transform it
+--   and append the result to the given file.
+appendFilePrompt' :: XPConfig -> (String -> String) -> FilePath -> X ()
+appendFilePrompt' c trans fn = mkXPrompt (AppendFile fn)
                                   c
                                   (const (return []))
-                                  (doAppend fn)
+                                  (doAppend trans fn)
 
 -- | Append a string to a file.
-doAppend :: FilePath -> String -> X ()
+doAppend :: (String -> String) -> FilePath -> String -> X ()
-doAppend fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn
+doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans

XMonad/Prompt/FuzzyMatch.hs

@@ -0,0 +1,104 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Prompt.FuzzyMatch
+-- Copyright   : (C) 2015 Norbert Zeh
+-- License     : GPL
+--
+-- Maintainer  : Norbert Zeh <norbert.zeh@gmail.com>
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- A module for fuzzy completion matching in prompts akin to emacs ido mode.
+--
+--------------------------------------------------------------------------------
+
+module XMonad.Prompt.FuzzyMatch ( -- * Usage
+                                  -- $usage
+                                  fuzzyMatch
+                                , fuzzySort
+                                ) where
+
+import Data.Char
+import Data.Function
+import Data.List
+
+-- $usage
+-- 
+-- This module offers two aspects of fuzzy matching of completions offered by
+-- XMonad.Prompt.
+--
+-- 'fuzzyMatch' can be used as the searchPredicate in the XPConfig.  The effect
+-- is that any completion that contains the currently typed characters as a
+-- subsequence is a valid completion; matching is case insensitive.  This means
+-- that the sequence of typed characters can be obtained from the completion by
+-- deleting an appropriate subset of its characters.  Example: "spr" matches
+-- "FastSPR" but also "SuccinctParallelTrees" because it's a subsequence of the
+-- latter: "S.......P.r..........".
+--
+-- While this type of inclusiveness is helpful most of the time, it sometimes
+-- also produces surprising matches.  'fuzzySort' helps sorting matches by
+-- relevance, using a simple heuristic for measuring relevance.  The matches are
+-- sorted primarily by the length of the substring that contains the query
+-- characters and secondarily the starting position of the match.  So, if the
+-- search string is "spr" and the matches are "FastSPR", "FasterSPR", and
+-- "SuccinctParallelTrees", then the order is "FastSPR", "FasterSPR",
+-- "SuccinctParallelTrees" because both "FastSPR" and "FasterSPR" contain "spr"
+-- within a substring of length 3 ("SPR") while the shortest substring of
+-- "SuccinctParallelTrees" that matches "spr" is "SuccinctPar", which has length
+-- 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 windowPrompt:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.Window ( windowPrompt )
+-- > import XMonad.Prompt.FuzzyMatch
+-- >
+-- > myXPConfig = def { searchPredicate = fuzzyMatch
+-- >                  , sorter          = fuzzySort
+-- >                  }
+-- 
+-- then add this to your keys definition:
+--
+-- > , ((modm .|. shiftMask, xK_g), windowPrompt myXPConfig Goto allWindows)
+--
+-- For detailed instructions on editing the key bindings, see
+-- "Xmonad.Doc.Extending#Editing_key_bindings".
+
+-- | Returns True if the first argument is a subsequence of the second argument,
+-- that is, it can be obtained from the second sequence by deleting elements.
+fuzzyMatch :: String -> String -> Bool
+fuzzyMatch []         _      = True
+fuzzyMatch _          []     = False
+fuzzyMatch xxs@(x:xs) (y:ys) | toLower x == toLower y = fuzzyMatch xs  ys
+                             | otherwise              = fuzzyMatch xxs ys
+
+-- | Sort the given set of strings by how well they match.  Match quality is
+-- measured first by the length of the substring containing the match and second
+-- by the positions of the matching characters in the string.
+fuzzySort :: String -> [String] -> [String]
+fuzzySort q = map snd . sortBy (compare `on` fst) . map (rankMatch q)
+
+rankMatch :: String -> String -> ((Int, Int), String)
+rankMatch q s = (minimum $ rankMatches q s, s)
+
+rankMatches :: String -> String -> [(Int, Int)]
+rankMatches [] _ = [(0, 0)]
+rankMatches q  s = map (\(l, r) -> (r - l, l)) $ findShortestMatches q s
+
+findShortestMatches :: String -> String -> [(Int, Int)]
+findShortestMatches q s = foldl' extendMatches spans oss
+  where (os:oss) = map (findOccurrences s) q
+        spans    = [(o, o) | o <- os]
+
+findOccurrences :: String -> Char -> [Int]
+findOccurrences s c = map snd $ filter ((toLower c ==) . toLower . fst) $ zip s [0..]
+
+extendMatches :: [(Int, Int)] -> [Int] -> [(Int, Int)]
+extendMatches spans xs = map last $ groupBy ((==) `on` snd) $ extendMatches' spans xs
+
+extendMatches' :: [(Int, Int)] -> [Int] -> [(Int, Int)]
+extendMatches' []                    _          = []
+extendMatches' _                     []         = []
+extendMatches' spans@((l, r):spans') xs@(x:xs') | r < x     = (l, x) : extendMatches' spans' xs
+                                                | otherwise = extendMatches' spans xs'

XMonad/Prompt/Pass.hs

@@ -8,38 +8,48 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read, remove):
+-- This module provides 5 <XMonad.Prompt>s to ease password
+-- manipulation (generate, read, edit, remove):
 --
--- - one to lookup passwords in the password-storage.
+-- - two to lookup passwords in the password-store; one of which
+--   copies to the clipboard, and the other uses @xdotool@ to type the
+--   password directly.
 --
--- - one to generate a password for a given password label that the user inputs.
+-- - one to generate a password for a given password label that the
+--   user inputs.
 --
--- - one to delete a stored password for a given password label that the user inputs.
+-- - one to edit a password for a given password label that the user
+--   inputs.
 --
--- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.
+-- - one to delete a stored password for a given password label that
+--   the user inputs.
 --
--- The password store is setuped through an environment variable PASSWORD_STORE_DIR.
+-- All those prompts benefit from the completion system provided by
--- If this is set, use the content of the variable.
+-- the module <XMonad.Prompt>.
--- Otherwise, the password store is located on user's home @$HOME\/.password-store@.
 --
+-- The password store is setup through an environment variable
+-- PASSWORD_STORE_DIR, or @$HOME\/.password-store@ if it is unset.
+-- The editor is determined from the environment variable EDITOR.
 --
 -- Source:
 --
--- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.
+-- - The <https://www.passwordstore.org/ password store>
+--   implementation is <http://git.zx2c4.com/password-store here>.
 --
--- - Inspired from <http://babushk.in/posts/combining-xmonad-and-pass.html>
+-- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html>
 --
 -----------------------------------------------------------------------------
 
 module XMonad.Prompt.Pass (
-                            -- * Usages
+                            -- * Usage
-                            -- $usages
+                            -- $usage
                               passPrompt
                             , passGeneratePrompt
                             , passRemovePrompt
+                            , passEditPrompt
+                            , passTypePrompt
                             ) where
 
-import Control.Monad (liftM)
 import XMonad.Core
 import XMonad.Prompt ( XPrompt
                      , showXPrompt
@@ -54,32 +64,34 @@ import System.FilePath (takeExtension, dropExtension, combine)
 import System.Posix.Env (getEnv)
 import XMonad.Util.Run (runProcessWithInput)
 
--- $usages
+-- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Prompt.Pass
 --
--- Then add a keybinding for 'passPrompt', 'passGeneratePrompt' or 'passRemovePrompt':
+-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt',
+-- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt':
 --
 -- >   , ((modMask , xK_p)                              , passPrompt xpconfig)
 -- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)
+-- >   , ((modMask .|. shiftMask, xK_p)                 , passEditPrompt xpconfig)
 -- >   , ((modMask .|. controlMask  .|. shiftMask, xK_p), passRemovePrompt xpconfig)
 --
 -- For detailed instructions on:
 --
 -- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
 --
--- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
+-- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/>
 --
 
 type Predicate = String -> String -> Bool
 
 getPassCompl :: [String] -> Predicate -> String -> IO [String]
-getPassCompl compls p s = do return $ filter (p s) compls
+getPassCompl compls p s = return $ filter (p s) compls
 
 type PromptLabel = String
 
-data Pass = Pass PromptLabel
+newtype Pass = Pass PromptLabel
 
 instance XPrompt Pass where
   showXPrompt       (Pass prompt) = prompt ++ ": "
@@ -98,7 +110,7 @@ passwordStoreFolderDefault home = combine home ".password-store"
 passwordStoreFolder :: IO String
 passwordStoreFolder =
   getEnv "PASSWORD_STORE_DIR" >>= computePasswordStoreDir
-  where computePasswordStoreDir Nothing         = liftM passwordStoreFolderDefault getHomeDirectory
+  where computePasswordStoreDir Nothing         = fmap passwordStoreFolderDefault getHomeDirectory
         computePasswordStoreDir (Just storeDir) = return storeDir
 
 -- | A pass prompt factory
@@ -126,23 +138,52 @@ passGeneratePrompt = mkPassPrompt "Generate password" generatePassword
 passRemovePrompt :: XPConfig -> X ()
 passRemovePrompt = mkPassPrompt "Remove password" removePassword
 
+-- | A prompt to type in a password for a given entry.
+-- This doesn't touch the clipboard.
+--
+passTypePrompt :: XPConfig -> X ()
+passTypePrompt = mkPassPrompt "Type password" typePassword
+
+-- | A prompt to edit a given entry.
+-- This doesn't touch the clipboard.
+--
+passEditPrompt :: XPConfig -> X ()
+passEditPrompt = mkPassPrompt "Edit password" editPassword
+
 -- | Select a password.
 --
 selectPassword :: String -> X ()
-selectPassword passLabel = spawn $ "pass --clip " ++ passLabel
+selectPassword passLabel = spawn $ "pass --clip \"" ++ escapeQuote passLabel ++ "\""
 
 -- | Generate a 30 characters password for a given entry.
 -- If the entry already exists, it is updated with a new password.
 --
 generatePassword :: String -> X ()
-generatePassword passLabel = spawn $ "pass generate --force " ++ passLabel ++ " 30"
+generatePassword passLabel = spawn $ "pass generate --force \"" ++ escapeQuote passLabel ++ "\" 30"
 
 -- | Remove a password stored for a given entry.
 --
 removePassword :: String -> X ()
-removePassword passLabel = spawn $ "pass rm --force " ++ passLabel
+removePassword passLabel = spawn $ "pass rm --force \"" ++ escapeQuote passLabel ++ "\""
 
--- | Retrieve the list of passwords from the password storage 'passwordStoreDir
+-- | Edit a password stored for a given entry.
+--
+editPassword :: String -> X ()
+editPassword passLabel = spawn $ "pass edit \"" ++ escapeQuote passLabel ++ "\""
+
+-- | Type a password stored for a given entry using xdotool.
+--
+typePassword :: String -> X ()
+typePassword passLabel = spawn $ "pass \"" ++ escapeQuote passLabel
+  ++ "\"|head -n1|tr -d '\n'|xdotool type --clearmodifiers --file -"
+
+escapeQuote :: String -> String
+escapeQuote = concatMap escape
+  where escape :: Char -> String
+        escape '"' = ['\\', '\"']
+        escape x = return x
+
+-- | Retrieve the list of passwords from the password store 'passwordStoreDir
 getPasswords :: FilePath -> IO [String]
 getPasswords passwordStoreDir = do
   files <- runProcessWithInput "find" [
@@ -150,7 +191,7 @@ getPasswords passwordStoreDir = do
     "-type", "f",
     "-name", "*.gpg",
     "-printf", "%P\n"] []
-  return $ map removeGpgExtension $ lines files
+  return . map removeGpgExtension $ lines files
 
 removeGpgExtension :: String -> String
 removeGpgExtension file | takeExtension file == ".gpg" = dropExtension file

XMonad/Prompt/Unicode.hs

@@ -1,6 +1,7 @@
 {- |
 Module      :  XMonad.Prompt.Unicode
 Copyright   :  (c) 2016 Joachim Breitner
+                   2017 Nick Hu
 License     :  BSD-style (see LICENSE)
 
 Maintainer  :  <mail@joachim-breitner.de>
@@ -9,14 +10,18 @@ Stability   :  stable
 A prompt for searching unicode characters by name and inserting them into
 the clipboard.
 
-Requires the file @\/usr\/share\/unicode\/UnicodeData.txt@ (shipped in the package
+The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@
-@unicode-data@ on Debian) and the @xsel@ tool.
+respectively.
 -}
 
+{-# LANGUAGE DeriveDataTypeable #-}
+
 module XMonad.Prompt.Unicode (
  -- * Usage
  -- $usage
- unicodePrompt
+ unicodePrompt,
+ typeUnicodePrompt,
+ mkUnicodePrompt
  ) where
 
 import qualified Data.ByteString.Char8 as BS
@@ -33,9 +38,23 @@ import Data.List
 import Text.Printf
 
 import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
 import XMonad.Util.Run
 import XMonad.Prompt
 
+data Unicode = Unicode
+instance XPrompt Unicode where
+  showXPrompt Unicode = "Unicode: "
+  commandToComplete Unicode s = s
+  nextCompletion Unicode = getNextCompletion
+
+newtype UnicodeData = UnicodeData { getUnicodeData :: [(Char, BS.ByteString)] }
+  deriving (Typeable, Read, Show)
+
+instance ExtensionClass UnicodeData where
+  initialValue = UnicodeData []
+  extensionType = StateExtension
+
 {- $usage
 
 You can use this module by importing it, along with
@@ -46,54 +65,61 @@ You can use this module by importing it, along with
 
 and adding an appropriate keybinding, for example:
 
->  , ((modm .|. controlMask, xK_u), unicodePrompt def)
+>  , ((modm .|. controlMask, xK_u), unicodePrompt "/path/to/unicode-data" def)
 
+More flexibility is given by the @mkUnicodePrompt@ function, which takes a
+command and a list of arguments to pass as its first two arguments. See
+@unicodePrompt@ for details.
 -}
 
-unicodeDataFilename :: String
+populateEntries :: String -> X Bool
-unicodeDataFilename =  "/usr/share/unicode/UnicodeData.txt"
+populateEntries unicodeDataFilename = do
-
+  entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
-entries :: [(Char, BS.ByteString)]
+  if null entries
-entries = unsafePerformIO $ do
+    then do
-    datE <- tryIOError $ BS.readFile unicodeDataFilename
+      datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename
-    case datE of
+      case datE of
-        Left e -> do
+        Left e -> liftIO $ do
-            hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
+          hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
-            hPutStrLn stderr $ show e
+          hPrint stderr e
-            hPutStrLn stderr $ "Do you have unicode-data installed?"
+          hPutStrLn stderr "Do you have unicode-data installed?"
-            return []
+          return False
-        Right dat -> return $ sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat
+        Right dat -> do
-{-# NOINLINE entries #-}
+          XS.put . UnicodeData . sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat
+          return True
+    else return True
 
 parseUnicodeData :: BS.ByteString -> [(Char, BS.ByteString)]
 parseUnicodeData = mapMaybe parseLine . BS.lines
-  where
+  where parseLine l = do
-    parseLine l = do
+          field1 : field2 : _ <- return $ BS.split ';' l
-        field1 : field2 : _ <- return $ BS.split ';' l
+          [(c,"")] <- return . readHex $ BS.unpack field1
-        [(c,"")] <- return $ readHex (BS.unpack field1)
+          return (chr c, field2)
-        return (chr c, field2)
 
-searchUnicode :: String -> [(Char, String)]
+searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]
-searchUnicode s = map (second BS.unpack) $ filter go entries
+searchUnicode entries s = map (second BS.unpack) $ filter go entries
-  where w = map BS.pack $  filter (all isAscii) $ filter ((> 1) . length) $ words $ map toUpper s
+  where w = map BS.pack . filter (all isAscii) . filter ((> 1) . length) . words $ map toUpper s
         go (c,d) = all (`BS.isInfixOf` d) w
 
--- | Prompt the user for a unicode character to be inserted into the paste buffer of the X server.
+mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
-unicodePrompt :: XPConfig -> X ()
+mkUnicodePrompt prog args unicodeDataFilename config =
-unicodePrompt config = mkXPrompt Unicode config unicodeCompl paste
+  whenX (populateEntries unicodeDataFilename) $ do
+    entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
+    mkXPrompt Unicode config (unicodeCompl entries) paste
   where
-    unicodeCompl [] = return []
+    unicodeCompl _ [] = return []
-    unicodeCompl s = do
+    unicodeCompl entries s = do
-        return $ map (\(c,d) -> printf "%s %s" [c] d) $ take 20 $ searchUnicode s
+      let m = searchUnicode entries s
-
+      return . map (\(c,d) -> printf "%s %s" [c] d) $ take 20 m
     paste [] = return ()
     paste (c:_) = do
-        runProcessWithInput "xsel" ["-i"] [c]
+      runProcessWithInput prog args [c]
-        return ()
+      return ()
 
-data Unicode = Unicode
+-- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.
-instance XPrompt Unicode where
+unicodePrompt :: String -> XPConfig -> X ()
-    showXPrompt Unicode = "Unicode: "
+unicodePrompt = mkUnicodePrompt "xsel" ["-i"]
-    commandToComplete Unicode s = s
-    nextCompletion Unicode = getNextCompletion
 
+-- | Prompt the user for a Unicode character to be typed by @xdotool@.
+typeUnicodePrompt :: String -> XPConfig -> X ()
+typeUnicodePrompt = mkUnicodePrompt "xdotool" ["type", "--clearmodifiers", "--file", "-"]

XMonad/Util/Dmenu.hs

@@ -24,6 +24,7 @@ import XMonad
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 import XMonad.Util.Run
+import Control.Monad (liftM)
 
 -- $usage
 -- You can use this module with the following in your Config.hs file:
@@ -41,28 +42,32 @@ import XMonad.Util.Run
 -- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>
 dmenuXinerama :: [String] -> X String
 dmenuXinerama opts = do
-    curscreen <- (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int
+    curscreen <-
-    runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
+      (fromIntegral . W.screen . W.current) `fmap` gets windowset :: X Int
+    _ <-
+      runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
     menuArgs "dmenu" ["-xs", show (curscreen+1)] opts
 
 -- | Run dmenu to select an option from a list.
-dmenu :: [String] -> X String
+dmenu :: MonadIO m => [String] -> m String
 dmenu opts = menu "dmenu" opts
 
 -- | like 'dmenu' but also takes the command to run.
-menu :: String -> [String] -> X String
+menu :: MonadIO m => String -> [String] -> m String
 menu menuCmd opts = menuArgs menuCmd [] opts
 
 -- | Like 'menu' but also takes a list of command line arguments.
-menuArgs :: String -> [String] -> [String] -> X String
+menuArgs :: MonadIO m => String -> [String] -> [String] -> m String
-menuArgs menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts)
+menuArgs menuCmd args opts = liftM (filter (/='\n')) $
+  runProcessWithInput menuCmd args (unlines opts)
 
 -- | Like 'dmenuMap' but also takes the command to run.
-menuMap :: String -> M.Map String a -> X (Maybe a)
+menuMap :: MonadIO m => String -> M.Map String a -> m (Maybe a)
 menuMap menuCmd selectionMap = menuMapArgs menuCmd [] selectionMap
 
 -- | Like 'menuMap' but also takes a list of command line arguments.
-menuMapArgs :: String -> [String] -> M.Map String a -> X (Maybe a)
+menuMapArgs :: MonadIO m => String -> [String] -> M.Map String a ->
+               m (Maybe a)
 menuMapArgs menuCmd args selectionMap = do
   selection <- menuFunction (M.keys selectionMap)
   return $ M.lookup selection selectionMap
@@ -70,5 +75,5 @@ menuMapArgs menuCmd args selectionMap = do
         menuFunction = menuArgs menuCmd args
 
 -- | Run dmenu to select an entry from a map based on the key.
-dmenuMap :: M.Map String a -> X (Maybe a)
+dmenuMap :: MonadIO m => M.Map String a -> m (Maybe a)
 dmenuMap selectionMap = menuMap "dmenu" selectionMap

XMonad/Util/Dzen.hs

@@ -25,6 +25,11 @@ module XMonad.Util.Dzen (
     x,
     y,
     addArgs,
+    fgColor,
+    bgColor,
+    align,
+    slaveAlign,
+    lineCount,
 
     -- * Legacy interface
     dzen,
@@ -41,6 +46,7 @@ import Control.Monad
 import XMonad
 import XMonad.StackSet
 import XMonad.Util.Run (runProcessWithInputAndWait, seconds)
+import XMonad.Util.Font (Align (..))
 
 type DzenConfig = (Int, [String]) -> X (Int, [String])
 
@@ -116,6 +122,45 @@ x n = addArgs ["-x", show n]
 y :: Int -> DzenConfig
 y n = addArgs ["-y", show n]
 
+-- | Set the foreground color.
+--
+-- Please be advised that @fgColor@ and @bgColor@ also exist in "XMonad.Prompt".
+-- If you use both modules, you might have to tell the compiler which one you mean:
+--
+-- > import XMonad.Prompt as P
+-- > import XMonad.Util.Dzen as D
+-- >
+-- > dzenConfig (D.fgColor "#f0f0f0") "foobar"
+fgColor :: String -> DzenConfig
+fgColor c = addArgs ["-fg", c]
+
+-- | Set the background color.
+bgColor :: String -> DzenConfig
+bgColor c = addArgs ["-bg", c]
+
+-- | Set the alignment of the title (main) window content.
+-- Note that @AlignRightOffset@ is treated as equal to @AlignRight@.
+--
+-- > import XMonad.Util.Font (Align(..))
+-- >
+-- > dzenConfig (align AlignLeft) "foobar"
+align :: Align -> DzenConfig
+align = align' "-ta"
+
+-- | Set the alignment of the slave window content.
+-- Using this option only makes sense if you also use the @lineCount@ parameter.
+slaveAlign :: Align -> DzenConfig
+slaveAlign = align' "-sa"
+
+-- Set an alignment parameter
+align' :: String -> Align -> DzenConfig
+align' opt a = addArgs [opt, s] where
+  s = case a of
+        AlignCenter        -> "c"
+        AlignLeft          -> "l"
+        AlignRight         -> "r"
+        AlignRightOffset _ -> "r"
+
 -- | Specify the font.  Check out xfontsel to get the format of the String
 -- right; if your dzen supports xft, then you can supply that here, too.
 font :: String -> DzenConfig
@@ -160,6 +205,14 @@ detailFromScreenId sc ws = fmap screenRect maybeSD where
     mapping = map (\s -> (screen s, screenDetail s)) (c:v)
     maybeSD = lookup sc mapping
 
+-- | Enable slave window and specify the number of lines.
+--
+-- Dzen can optionally draw a second window underneath the title window.
+-- By default, this window is only displayed if the mouse enters the title window.
+-- This option is only useful if the string you want to display contains more than one line.
+lineCount :: Int -> DzenConfig
+lineCount n = addArgs ["-l", show n]
+
 -- | @dzen str timeout@ pipes @str@ to dzen2 for @timeout@ microseconds.
 -- Example usage:
 --

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)
+modifyStateExts
-                   -> M.Map String (Either String StateExtension))
+  :: XLike m
-                -> X ()
+  => (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

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 '<*', '*>', '<?' 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')
+
+-- }}}
+

XMonad/Util/Rectangle.hs

@@ -0,0 +1,214 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Rectangle
+-- Copyright   :  (c) 2018 Yclept Nemo
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module for handling pixel rectangles: 'Rectangle'.
+--
+-----------------------------------------------------------------------------
+
+
+module XMonad.Util.Rectangle
+    ( -- * Usage
+      -- $usage
+      PointRectangle (..)
+    , pixelsToIndices, pixelsToCoordinates
+    , indicesToRectangle, coordinatesToRectangle
+    , empty
+    , intersects
+    , supersetOf
+    , difference
+    , withBorder
+    , center
+    , toRatio
+    ) where
+
+import           XMonad
+import qualified XMonad.StackSet as W
+
+import           Data.Ratio
+
+
+-- $usage
+-- > import XMonad.Util.Rectangle as R
+-- > R.empty (Rectangle 0 0 1024 768)
+
+
+-- | Rectangle as two points. What those points mean depends on the conversion
+-- function.
+data PointRectangle a = PointRectangle
+    { point_x1::a   -- ^ Point nearest to the origin.
+    , point_y1::a
+    , point_x2::a   -- ^ Point furthest from the origin.
+    , point_y2::a
+    } deriving (Eq,Read,Show)
+
+-- | There are three possible ways to convert rectangles to pixels:
+--
+-- * Consider integers as "gaps" between pixels; pixels range from @(N,N+1)@,
+-- exclusively: @(0,1)@, @(1,2)@, and so on. This leads to interval ambiguity:
+-- whether an integer endpoint contains a pixel depends on which direction the
+-- interval approaches the pixel. Consider the adjacent pixels @(0,1)@ and
+-- @(1,2)@ where @1@ can refer to either pixel @(0,1)@ or pixel @(1,2)@.
+--
+-- * Consider integers to demarcate the start of each pixel; pixels range from
+-- @[N,N+1)@: @[0,1)@, @[1,2)@, and so on - or equivalently: @(N,N+1]@. This is
+-- the most flexible coordinate system, and the convention used by the
+-- 'Rectangle' type.
+--
+-- * Consider integers to demarcate the center of each pixel; pixels range from
+-- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
+-- down or up) to the nearest integers. So each pixel, from zero, is listed as:
+-- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
+-- considers pixels as row/colum indices.  While easiest to reason with,
+-- indices are unable to represent zero-dimension rectangles.
+--
+-- Consider pixels as indices. Do not use this on empty rectangles.
+pixelsToIndices :: Rectangle -> (PointRectangle Integer)
+pixelsToIndices (Rectangle px py dx dy) =
+    PointRectangle (fromIntegral px)
+                   (fromIntegral py)
+                   (fromIntegral px + fromIntegral dx - 1)
+                   (fromIntegral py + fromIntegral dy - 1)
+
+-- | Consider pixels as @[N,N+1)@ coordinates. Available for empty rectangles.
+pixelsToCoordinates :: Rectangle -> (PointRectangle Integer)
+pixelsToCoordinates (Rectangle px py dx dy) =
+    PointRectangle (fromIntegral px)
+                   (fromIntegral py)
+                   (fromIntegral px + fromIntegral dx)
+                   (fromIntegral py + fromIntegral dy)
+
+-- | Invert 'pixelsToIndices'.
+indicesToRectangle :: (PointRectangle Integer) -> Rectangle
+indicesToRectangle (PointRectangle x1 y1 x2 y2) =
+    Rectangle (fromIntegral x1)
+              (fromIntegral y1)
+              (fromIntegral $ x2 - x1 + 1)
+              (fromIntegral $ y2 - y1 + 1)
+
+-- | Invert 'pixelsToCoordinates'.
+coordinatesToRectangle :: (PointRectangle Integer) -> Rectangle
+coordinatesToRectangle (PointRectangle x1 y1 x2 y2) =
+    Rectangle (fromIntegral x1)
+              (fromIntegral y1)
+              (fromIntegral $ x2 - x1)
+              (fromIntegral $ y2 - y1)
+
+-- | True if either the 'rect_width' or 'rect_height' fields are zero, i.e. the
+-- rectangle has no area.
+empty :: Rectangle -> Bool
+empty (Rectangle _ _ _ 0) = True
+empty (Rectangle _ _ 0 _) = True
+empty (Rectangle _ _ _ _) = False
+
+-- | True if the intersection of the set of points comprising each rectangle is
+-- not the empty set. Therefore any rectangle containing the initial points of
+-- an empty rectangle will never intersect that rectangle - including the same
+-- empty rectangle.
+intersects :: Rectangle -> Rectangle -> Bool
+intersects r1 r2 | empty r1 || empty r2 = False
+                 | otherwise            =    r1_x1 < r2_x2
+                                          && r1_x2 > r2_x1
+                                          && r1_y1 < r2_y2
+                                          && r1_y2 > r2_y1
+    where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
+          PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
+
+-- | True if the first rectangle contains at least all the points of the second
+-- rectangle. Any rectangle containing the initial points of an empty rectangle
+-- will be a superset of that rectangle - including the same empty rectangle.
+supersetOf :: Rectangle -> Rectangle -> Bool
+supersetOf r1 r2 =    r1_x1 <= r2_x1
+                   && r1_y1 <= r2_y1
+                   && r1_x2 >= r2_x2
+                   && r1_y2 >= r2_y2
+    where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
+          PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
+
+-- | Return the smallest set of rectangles resulting from removing all the
+-- points of the second rectangle from those of the first, i.e. @r1 - r2@, such
+-- that @0 <= l <= 4@ where @l@ is the length of the resulting list.
+difference :: Rectangle -> Rectangle -> [Rectangle]
+difference r1 r2 | r1 `intersects` r2 = map coordinatesToRectangle $
+                                        concat [rt,rr,rb,rl]
+                 | otherwise          = [r1]
+    where PointRectangle r1_x1 r1_y1 r1_x2 r1_y2 = pixelsToCoordinates r1
+          PointRectangle r2_x1 r2_y1 r2_x2 r2_y2 = pixelsToCoordinates r2
+          -- top - assuming (0,0) is top-left
+          rt = if r2_y1 > r1_y1 && r2_y1 < r1_y2
+               then [PointRectangle (max r2_x1 r1_x1) r1_y1 r1_x2 r2_y1]
+               else []
+          -- right
+          rr = if r2_x2 > r1_x1 && r2_x2 < r1_x2
+               then [PointRectangle r2_x2 (max r2_y1 r1_y1) r1_x2 r1_y2]
+               else []
+          -- bottom
+          rb = if r2_y2 > r1_y1 && r2_y2 < r1_y2
+               then [PointRectangle r1_x1 r2_y2 (min r2_x2 r1_x2) r1_y2]
+               else []
+          -- left
+          rl = if r2_x1 > r1_x1 && r2_x1 < r1_x2
+               then [PointRectangle r1_x1 r1_y1 r2_x1 (min r2_y2 r1_y2)]
+               else []
+
+-- | Fit a 'Rectangle' within the given borders of itself. Given insufficient
+-- space, borders are minimized while preserving the ratio of opposite borders.
+-- Origin is top-left, and yes, negative borders are allowed.
+withBorder :: Integer -- ^ Top border.
+           -> Integer -- ^ Bottom border.
+           -> Integer -- ^ Right border.
+           -> Integer -- ^ Left border.
+           -> Integer -- ^ Smallest allowable rectangle dimensions, i.e.
+                      --   width/height, with values @<0@ defaulting to @0@.
+           -> Rectangle -> Rectangle
+withBorder t b r l i (Rectangle x y w h) =
+    let -- conversions
+        w' = fromIntegral w
+        h' = fromIntegral h
+        -- minimum window dimensions
+        i' = max i 0
+        iw = min i' w'
+        ih = min i' h'
+        -- maximum border dimensions
+        bh = w' - iw
+        bv = h' - ih
+        -- scaled border ratios
+        rh = if l + r <= 0
+             then 1
+             else min 1 $ bh % (l + r)
+        rv = if t + b <= 0
+             then 1
+             else min 1 $ bv % (t + b)
+        -- scaled border pixels
+        t' = truncate $ rv * fromIntegral t
+        b' = truncate $ rv * fromIntegral b
+        r' = truncate $ rh * fromIntegral r
+        l' = truncate $ rh * fromIntegral l
+    in  Rectangle (x + l')
+                  (y + t')
+                  (w - r' - fromIntegral l')
+                  (h - b' - fromIntegral t')
+
+-- | Calculate the center - @(x,y)@ - as if the 'Rectangle' were bounded.
+center :: Rectangle -> (Ratio Integer,Ratio Integer)
+center (Rectangle x y w h) = (cx,cy)
+    where cx = fromIntegral x + (fromIntegral w) % 2
+          cy = fromIntegral y + (fromIntegral h) % 2
+
+-- | Invert 'scaleRationalRect'. Since that operation is lossy a roundtrip
+-- conversion may not result in the original value. The first 'Rectangle' is
+-- scaled to the second:
+--
+-- >>> (Rectangle 2 2 6 6) `toRatio` (Rectangle 0 0 10 10)
+-- RationalRect (1 % 5) (1 % 5) (3 % 5) (3 % 5)
+toRatio :: Rectangle -> Rectangle -> W.RationalRect
+toRatio (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2) =
+    let [x1n,y1n,x2n,y2n] = map fromIntegral [x1,y1,x2,y2]
+        [w1n,h1n,w2n,h2n] = map fromIntegral [w1,h1,w2,h2]
+    in  W.RationalRect ((x1n-x2n)/w2n) ((y1n-y2n)/h2n) (w1n/w2n) (h1n/h2n)

XMonad/Util/SessionStart.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.SessionStart
+-- Copyright   :  (c) Markus Ongyerth 2017
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  markus@ongy.net
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A module for detectiong session startup.  Useful to start
+-- status bars, compositors and session initialization.
+-- This is a more general approach than spawnOnce and allows spawnOn etc.
+-----------------------------------------------------------------------------
+
+module XMonad.Util.SessionStart
+    ( doOnce
+    , isSessionStart
+    , setSessionStarted
+    )
+where
+
+import Control.Monad (when)
+import Control.Applicative ((<$>))
+
+import XMonad
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- ---------------------------------------------------------------------
+-- $usage
+--
+-- Add 'setSessionStarted' at the end of the 'startupHook' to set the
+-- flag.
+--
+-- To do something only when the session is started up, use 
+-- 'isSessionStart' to query or wrap it in 'doOnce' to only do it when
+-- the flag isn't set.
+-- ---------------------------------------------------------------------
+
+data SessionStart = SessionStart { unSessionStart :: Bool }
+    deriving (Read, Show, Typeable)
+
+instance ExtensionClass SessionStart where
+    initialValue = SessionStart True
+    extensionType = PersistentExtension
+
+-- | Use this to only do a part of your hook on session start
+doOnce :: X () -> X ()
+doOnce act = do
+    startup <- isSessionStart
+    when startup act
+
+-- | Query if the current startup is the session start
+isSessionStart :: X Bool
+isSessionStart = unSessionStart <$> XS.get
+
+-- This should become a noop/be deprecated when merged into master, and
+-- the flag should be set when the state file is loaded.
+-- | This currently has to be added to the end of the startup hook to
+-- set the flag.
+setSessionStarted :: X ()
+setSessionStarted = XS.put $ SessionStart False

XMonad/Util/SpawnOnce.hs

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

XMonad/Util/Stack.hs

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

XMonad/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 =

XMonad/Util/WorkspaceCompare.hs

@@ -25,10 +25,10 @@ module XMonad.Util.WorkspaceCompare ( WorkspaceCompare, WorkspaceSort
 import XMonad
 import qualified XMonad.StackSet as S
 import Data.List
-import Data.Monoid
-import Data.Ord
 import Data.Maybe
-import Data.Function
+import Data.Monoid (mconcat)
+import XMonad.Actions.PhysicalScreens (ScreenComparator(ScreenComparator), getScreenIdAndRectangle, screenComparatorById)
+import Data.Function (on)
 
 type WorkspaceCompare = WorkspaceId -> WorkspaceId -> Ordering
 type WorkspaceSort = [WindowSpace] -> [WindowSpace]
@@ -64,28 +64,22 @@ getWsCompareByTag = return compare
 --   and screen id. It produces the same ordering as
 --   'XMonad.Hooks.DynamicLog.pprWindowSetXinerama'.
 getXineramaWsCompare :: X WorkspaceCompare
-getXineramaWsCompare = getXineramaWsCompare' False
+getXineramaWsCompare = getXineramaPhysicalWsCompare $ screenComparatorById compare
 
 -- | A comparison function like 'getXineramaWsCompare', but uses physical locations for screens.
-getXineramaPhysicalWsCompare :: X WorkspaceCompare
+getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare
-getXineramaPhysicalWsCompare = getXineramaWsCompare' True
+getXineramaPhysicalWsCompare (ScreenComparator sc) = do
-
-getXineramaWsCompare' :: Bool -> X WorkspaceCompare
-getXineramaWsCompare' phy = do
     w <- gets windowset
     return $ \ a b -> case (isOnScreen a w, isOnScreen b w) of
-        (True, True)   -> cmpPosition phy w a b
+        (True, True)   -> compareUsingScreen w a b
         (False, False) -> compare a b
         (True, False)  -> LT
         (False, True)  -> GT
   where
     onScreen w =  S.current w : S.visible w
     isOnScreen a w  = a `elem` map (S.tag . S.workspace) (onScreen w)
-    tagToSid s x = S.screen $ fromJust $ find ((== x) . S.tag . S.workspace) s
+    tagToScreen s x = fromJust $ find ((== x) . S.tag . S.workspace) s
-    cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b
+    compareUsingScreen w = sc `on` getScreenIdAndRectangle . tagToScreen (onScreen w)
-    cmpPosition True w a b = comparing (rect.(tagToSid $ onScreen w)) a b
-      where rect i = let (Rectangle x y _ _) = screens !! fromIntegral i in (y,x)
-            screens = map (screenRect . S.screenDetail) $ sortBy (comparing S.screen) $ S.current w : S.visible w
 
 -- | Create a workspace sorting function from a workspace comparison
 --   function.
@@ -109,8 +103,6 @@ getSortByTag = mkWsSort getWsCompareByTag
 --   sorted by tag.
 getSortByXineramaRule :: X WorkspaceSort
 getSortByXineramaRule = mkWsSort getXineramaWsCompare
-
+-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.
--- | Like 'getSortByXineramaRule', but uses physical locations for screens.
+getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
-getSortByXineramaPhysicalRule :: X WorkspaceSort
+getSortByXineramaPhysicalRule sc = mkWsSort $ getXineramaPhysicalWsCompare sc
-getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare
-

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
+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,
@@ -64,9 +64,10 @@ library
                    random,
                    mtl >= 1 && < 3,
                    unix,
-                   X11>=1.6.1 && < 1.9,
+                   X11>=1.6.1 && < 1.10,
-                   xmonad>=0.13   && < 0.14,
+                   xmonad >= 0.15 && < 0.16,
-                   utf8-string
+                   utf8-string,
+                   semigroups
 
     if flag(use_xft)
         build-depends: X11-xft >= 0.2
@@ -128,6 +129,7 @@ library
                         XMonad.Actions.SpawnOn
                         XMonad.Actions.Submap
                         XMonad.Actions.SwapWorkspaces
+                        XMonad.Actions.SwapPromote
                         XMonad.Actions.TagWindows
                         XMonad.Actions.TopicSpace
                         XMonad.Actions.TreeSelect
@@ -193,6 +195,7 @@ library
                         XMonad.Layout.Accordion
                         XMonad.Layout.AutoMaster
                         XMonad.Layout.AvoidFloats
+                        XMonad.Layout.BinaryColumn
                         XMonad.Layout.BinarySpacePartition
                         XMonad.Layout.BorderResize
                         XMonad.Layout.BoringWindows
@@ -207,6 +210,7 @@ library
                         XMonad.Layout.DecorationAddons
                         XMonad.Layout.DecorationMadness
                         XMonad.Layout.Dishes
+                        XMonad.Layout.MultiDishes
                         XMonad.Layout.DragPane
                         XMonad.Layout.DraggingVisualizer
                         XMonad.Layout.Drawer
@@ -248,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
@@ -271,6 +276,7 @@ library
                         XMonad.Layout.Spiral
                         XMonad.Layout.Square
                         XMonad.Layout.StackTile
+                        XMonad.Layout.StateFull
                         XMonad.Layout.Stoppable
                         XMonad.Layout.SubLayouts
                         XMonad.Layout.TabBarDecoration
@@ -279,6 +285,7 @@ library
                         XMonad.Layout.ToggleLayouts
                         XMonad.Layout.TrackFloating
                         XMonad.Layout.TwoPane
+                        XMonad.Layout.TwoPanePersistent
                         XMonad.Layout.WindowArranger
                         XMonad.Layout.WindowNavigation
                         XMonad.Layout.WindowSwitcherDecoration
@@ -291,6 +298,7 @@ library
                         XMonad.Prompt.DirExec
                         XMonad.Prompt.Directory
                         XMonad.Prompt.Email
+                        XMonad.Prompt.FuzzyMatch
                         XMonad.Prompt.Input
                         XMonad.Prompt.Layout
                         XMonad.Prompt.Man
@@ -323,11 +331,14 @@ library
                         XMonad.Util.NoTaskbar
                         XMonad.Util.Paste
                         XMonad.Util.PositionStore
+                        XMonad.Util.PureX
+                        XMonad.Util.Rectangle
                         XMonad.Util.RemoteWindows
                         XMonad.Util.Replace
                         XMonad.Util.Run
                         XMonad.Util.Scratchpad
                         XMonad.Util.SpawnNamedPipe
+                        XMonad.Util.SessionStart
                         XMonad.Util.SpawnOnce
                         XMonad.Util.Stack
                         XMonad.Util.StringProp