Bump version number and update the changelog.

These changes avoid the need for having a MonadFail instance for Decoder.

.github/ISSUE_TEMPLATE.md

@@ -0,0 +1,24 @@
+### Problem Description
+
+Describe the problem you are having, what you expect to happen
+instead, and how to reproduce the problem.
+
+### Configuration File
+
+Please include the smallest configuration file that reproduces the
+problem you are experiencing:
+
+```haskell
+module Main (main) where
+
+import XMonad
+
+main :: IO ()
+main = xmonad def
+```
+
+### Checklist
+
+  - [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
+
+  - [ ] I tested my configuration with [xmonad-testing](https://github.com/xmonad/xmonad-testing)

.github/PULL_REQUEST_TEMPLATE.md

@@ -0,0 +1,12 @@
+### Description
+
+Include a description for your changes, including the motivation
+behind them.
+
+### Checklist
+
+  - [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
+
+  - [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
+
+  - [ ] I updated the `CHANGES.md` file

.gitignore

@@ -23,3 +23,4 @@ tags
 
 # stack artifacts
 /.stack-work/
+/cabal.project.local

.travis.yml

@@ -13,27 +13,32 @@ before_cache:
 
 matrix:
   include:
-    - env: CABALVER=1.16 GHCVER=7.4.2
-      compiler: ": #GHC 7.4.2"
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}}
-    - env: CABALVER=1.16 GHCVER=7.6.3
-      compiler: ": #GHC 7.6.3"
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
-    - env: CABALVER=1.18 GHCVER=7.8.4
-      compiler: ": #GHC 7.8.4"
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
-    - env: CABALVER=1.22 GHCVER=7.10.2
-      compiler: ": #GHC 7.10.2"
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
+    - env: GHCVER=8.6.1  CABALVER=2.4
+      compiler: ": #GHC 8.6.1"
+      addons: { apt: { packages: [cabal-install-2.4,  ghc-8.6.1,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=8.4.3  CABALVER=2.2
+      compiler: ": #GHC 8.4.3"
+      addons: { apt: { packages: [cabal-install-2.2,  ghc-8.4.3,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=8.2.2  CABALVER=2.0
+      compiler: ": #GHC 8.2.2"
+      addons: { apt: { packages: [cabal-install-2.0,  ghc-8.2.2,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=8.0.1  CABALVER=1.24
+      compiler: ": #GHC 8.0.1"
+      addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1,  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,12 +47,17 @@ 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
 
 # check whether current requested install-plan matches cached package-db snapshot
- - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
+ - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
    then
      echo "cabal build-cache HIT";
      rm -rfv .ghc;
@@ -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,16 +1,415 @@
 # Change Log / Release Notes
 
-## 0.13
+## unknown
+
+## 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.
+
+  * `XMonad.Layout.Minimize`
+
+     Though the interface it offers is quite similar, this module has been
+     almost completely rewritten. The new `XMonad.Actions.Minimize` contains
+     several functions that allow interaction with minimization window state.
+     If you are using this module, you must upgrade your configuration to import
+     `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of
+     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.Layout.MultiToggle.TabBarDecoration`
+
+    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
+    dynamically toggle `XMonad.Layout.TabBarDecoration`.
+
+  * `XMonad.Layout.StateFull`
+
+    Provides `StateFull`: a stateful form of `Full` that does not misbehave when
+    floats are focused, and the `FocusTracking` layout transformer by means of
+    which `StateFull` is implemented. `FocusTracking` simply holds onto the last
+    true focus it was given and continues to use it as the focus for the
+    transformed layout until it sees another. It can be used to improve the
+    behaviour of a child layout that has not been given the focused window.
+
+  * `XMonad.Actions.SwapPromote`
+
+    Module for tracking master window history per workspace, and associated
+    functions for manipulating the stack using such history.
+
+  * `XMonad.Actions.CycleWorkspaceByScreen`
+
+    A new module that allows cycling through previously viewed workspaces in the
+    order they were viewed most recently on the screen where cycling is taking
+    place.
+
+    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.
+
+  * `XMonad.Actions.SpawnOn`
+
+    - Bind windows spawns by child processes of the original window to the same
+      workspace as the original window.
+
+  * `XMonad.Util.WindowProperties`
+
+    - Added the ability to test if a window has a tag from
+      `XMonad.Actions.TagWindows`
+
+  * `XMonad.Layout.Magnifier`
+
+    - Handle `IncMasterN` messages.
+
+  * `XMonad.Util.EZConfig`
+
+    - Can now parse Latin1 keys, to better accommodate users with
+      non-US keyboards.
+
+  * `XMonad.Actions.Submap`
+
+    Establish pointer grab to avoid freezing X, when button press occurs after
+    submap key press.  And terminate submap at button press in the same way,
+    as we do for wrong key press.
+
+  * `XMonad.Hooks.SetWMName`
+
+    Add function `getWMName`.
+
+  * `XMonad.Hooks.ManageHelpers`
+
+    Make type of ManageHook combinators more general.
+
+  * `XMonad.Prompt`
+
+    Export `insertString`.
+
+  * `XMonad.Prompt.Window`
+
+    - New function: `windowMultiPrompt` for using `mkXPromptWithModes`
+      with window prompts.
+
+  * `XMonad.Hooks.WorkspaceHistory`
+
+    - Now supports per screen history.
+
+  * `XMonad.Layout.ComboP`
+
+    - New `PartitionWins` message to re-partition all windows into the
+      configured sub-layouts.  Useful when window properties have
+      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.
+    - 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
 
   * The type of `completionKey` (of `XPConfig` record) has been
     changed from `KeySym` to `(KeyMask, KeySym)`. The default value
-    for this is still binded to `Tab` key.
+    for this is still bound to the `Tab` key.
 
   * New constructor `CenteredAt Rational Rational` added for
     `XMonad.Prompt.XPPosition`.
 
+  * `XMonad.Prompt` now stores its history file in the XMonad cache
+    directory in a file named `prompt-history`.
+
 ### New Modules
 
   * `XMonad.Layout.SortedLayout`
@@ -42,13 +441,29 @@
     EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
     you will usually be taken to the `NSP` workspace by them.
 
-### Minor Changes
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Hooks.ManageDocks`,
+
+    - Fix a very annoying bug where taskbars/docs would be
+      covered by windows.
+
+    - Also fix a bug that caused certain Gtk and Qt application to
+      have issues displaying menus and popups.
 
   * `XMonad.Layout.LayoutBuilder`
 
     Merge all functionality from `XMonad.Layout.LayoutBuilderP` into
     `XMonad.Layout.LayoutBuilder`.
 
+  * `XMonad.Actions.WindowGo`
+
+    - Fix `raiseNextMaybe` cycling between 2 workspaces only.
+
+  * `XMonad.Actions.UpdatePointer`
+
+    - Fix bug when cursor gets stuck in one of the corners.
+
   * `XMonad.Actions.DynamicProjects`
 
     - Switching away from a dynamic project that contains no windows
@@ -57,6 +472,11 @@
       The project itself was already being deleted, this just deletes
       the workspace created for it as well.
 
+    - Added function to change the working directory (`changeProjectDirPrompt`)
+
+    - All of the prompts are now multiple mode prompts.  Try using the
+      `changeModeKey` in a prompt and see what happens!
+
 ## 0.12 (December 14, 2015)
 
 ### Breaking Changes

README.md

@@ -1,12 +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 source distribution] [xmonad-git], and the
-[online haddock documentation] [xmonad-docs].
+[xmonad website][xmonad], the documents included with the
+[xmonad source distribution][xmonad-git], and the
+[online haddock documentation][xmonad-docs].
 
 ## Getting or Updating XMonadContrib
 
@@ -15,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
 
@@ -26,15 +29,15 @@ example, to use the Grid layout, one would import:
 
     XMonad.Layout.Grid
 
-For further details, see the [documentation] [developing] for the
-`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
+For further details, see the [documentation][developing] for the
+`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
-[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
+[xmonad-docs]: http://hackage.haskell.org/package/xmonad
+[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/CycleWS.hs

@@ -239,6 +239,7 @@ data WSType = EmptyWS     -- ^ cycle through empty workspaces
             | NonEmptyWS  -- ^ cycle through non-empty workspaces
             | HiddenWS    -- ^ cycle through non-visible workspaces
             | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces
+            | HiddenEmptyWS  -- ^ cycle through empty non-visible workspaces
             | AnyWS       -- ^ cycle through all workspaces
             | WSTagGroup Char
                           -- ^ cycle through workspaces in the same group, the
@@ -257,6 +258,9 @@ wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)
 wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS
                                     hi <- wsTypeToPred HiddenWS
                                     return (\w -> hi w && ne w)
+wsTypeToPred HiddenEmptyWS  = do ne <- wsTypeToPred EmptyWS
+                                 hi <- wsTypeToPred HiddenWS
+                                 return (\w -> hi w && ne w)
 wsTypeToPred AnyWS      = return (const True)
 wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
                                    return $ (cur ==).groupName

XMonad/Actions/CycleWorkspaceByScreen.hs

@@ -0,0 +1,102 @@
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleWorkspaceByScreen
+-- Copyright   :  (c) 2017 Ivan Malison
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  IvanMalison@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Cycle through previously viewed workspaces in the order they were viewed most
+-- recently on the screen where cycling is taking place.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleWorkspaceByScreen (
+    -- * Usage
+    -- $usage
+    cycleWorkspaceOnScreen
+  , cycleWorkspaceOnCurrentScreen
+  , handleKeyEvent
+  , repeatableAction
+  ) where
+
+import           Control.Monad
+import           Data.IORef
+import           Data.List
+import           Data.Maybe
+
+import           Graphics.X11.Xlib.Extras
+
+import           XMonad
+import           XMonad.Hooks.WorkspaceHistory
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- This module must be used in conjuction with XMonad.Hooks.WorkspaceHistory
+--
+-- To use, add something like the following to your keybindings
+-- , ((mod4Mask,  xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
+
+repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
+repeatableAction mods pressHandler = do
+  XConf {theRoot = root, display = d} <- ask
+  let getNextEvent = io $ allocaXEvent $ \p ->
+                 do
+                   maskEvent d (keyPressMask .|. keyReleaseMask) p
+                   KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                   s <- io $ keycodeToKeysym d c 0
+                   return (t, s)
+      handleEvent (t, s)
+        | t == keyRelease && s `elem` mods = return ()
+        | otherwise = (pressHandler t s) >> getNextEvent >>= handleEvent
+
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+  getNextEvent >>= handleEvent
+  io $ ungrabKeyboard d currentTime
+
+handleKeyEvent :: EventType
+               -> KeySym
+               -> X ()
+               -> EventType
+               -> KeySym
+               -> Maybe (X ())
+handleKeyEvent eventType key action = helper
+  where
+  helper et k
+    | et == eventType && k == key = Just action
+    | otherwise = Nothing
+
+
+runFirst :: [EventType -> KeySym -> Maybe (X ())] -> EventType -> KeySym -> X ()
+runFirst matchers eventType key =
+  fromMaybe (return ()) $ join $ find isJust $ map (\fn -> fn eventType key) matchers
+
+cycleWorkspaceOnScreen :: ScreenId -> [KeySym] -> KeySym -> KeySym -> X ()
+cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransaction $ do
+  startingHistory <- workspaceHistoryByScreen
+  currentWSIndex <- io $ newIORef 1
+  let cycleWorkspaces = fromMaybe [] $ lookup screenId startingHistory
+      getAndIncrementWS increment = do
+        current <- readIORef currentWSIndex
+        modifyIORef
+          currentWSIndex
+          ((`mod` (length cycleWorkspaces)) . (+ increment))
+        return $ cycleWorkspaces !! current
+      focusIncrement i = (io $ getAndIncrementWS i) >>= (windows . W.greedyView)
+
+  focusIncrement 1 -- Do the first workspace cycle
+  repeatableAction mods $
+    runFirst
+      [ handleKeyEvent keyPress nextKey $ focusIncrement 1
+      , handleKeyEvent keyPress prevKey $ focusIncrement (-1)
+      ]
+  return ()
+
+cycleWorkspaceOnCurrentScreen
+  :: [KeySym] -> KeySym -> KeySym -> X ()
+cycleWorkspaceOnCurrentScreen mods n p =
+  withWindowSet $ \ws ->
+    cycleWorkspaceOnScreen (W.screen $ W.current ws) mods n p

XMonad/Actions/DynamicProjects.hs

@@ -31,6 +31,7 @@ module XMonad.Actions.DynamicProjects
        , switchProjectPrompt
        , shiftToProjectPrompt
        , renameProjectPrompt
+       , changeProjectDirPrompt
 
          -- * Helper Functions
        , switchProject
@@ -43,6 +44,7 @@ module XMonad.Actions.DynamicProjects
 --------------------------------------------------------------------------------
 import Control.Applicative ((<|>))
 import Control.Monad (when, unless)
+import Data.Char (isSpace)
 import Data.List (sort, union, stripPrefix)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -52,8 +54,7 @@ import System.Directory (setCurrentDirectory, getHomeDirectory)
 import XMonad
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Prompt
-import XMonad.Prompt.Directory (directoryPrompt)
-import XMonad.Prompt.Workspace (Wor(..))
+import XMonad.Prompt.Directory
 import qualified XMonad.StackSet as W
 import qualified XMonad.Util.ExtensibleState as XS
 
@@ -142,6 +143,48 @@ data ProjectState = ProjectState
 instance ExtensionClass ProjectState where
   initialValue = ProjectState Map.empty Nothing
 
+--------------------------------------------------------------------------------
+-- Internal types for working with XPrompt.
+data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
+data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
+
+instance XPrompt ProjectPrompt where
+  showXPrompt (ProjectPrompt submode _) =
+    case submode of
+      SwitchMode -> "Switch or Create Project: "
+      ShiftMode  -> "Send Window to Project: "
+      RenameMode -> "New Project Name: "
+      DirMode    -> "Change Project Directory: "
+
+  completionFunction (ProjectPrompt RenameMode _) = return . (:[])
+  completionFunction (ProjectPrompt DirMode _) =
+    let xpt = directoryMultipleModes "" (const $ return ())
+    in completionFunction xpt
+  completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
+
+  modeAction (ProjectPrompt SwitchMode _) buf auto = do
+    let name = if null auto then buf else auto
+    ps <- XS.gets projects
+
+    case Map.lookup name ps of
+      Just p              -> switchProject p
+      Nothing | null name -> return ()
+              | otherwise -> switchProject (defProject name)
+
+  modeAction (ProjectPrompt ShiftMode _) buf auto = do
+    let name = if null auto then buf else auto
+    ps <- XS.gets projects
+    shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
+
+  modeAction (ProjectPrompt RenameMode _) name _ =
+    when (not (null name) && not (all isSpace name)) $ do
+      renameWorkspaceByName name
+      modifyProject (\p -> p { projectName = name })
+
+  modeAction (ProjectPrompt DirMode _) buf auto = do
+    let dir = if null auto then buf else auto
+    modifyProject (\p -> p { projectDirectory = dir })
+
 --------------------------------------------------------------------------------
 -- | Add dynamic projects support to the given config.
 dynamicProjects :: [Project] -> XConfig a -> XConfig a
@@ -198,6 +241,21 @@ currentProject = do
   proj <- lookupProject name
   return $ fromMaybe (defProject name) proj
 
+--------------------------------------------------------------------------------
+-- | Modify the current project using a pure function.
+modifyProject :: (Project -> Project) -> X ()
+modifyProject f = do
+  p  <- currentProject
+  ps <- XS.gets projects
+
+  -- If a project is renamed to match another project, the old project
+  -- will be removed and replaced with this one.
+  let new = f p
+      ps' = Map.insert (projectName new) new $ Map.delete (projectName p) ps
+
+  XS.modify $ \s -> s {projects = ps'}
+  activateProject new
+
 --------------------------------------------------------------------------------
 -- | Switch to the given project.
 switchProject :: Project -> X ()
@@ -220,22 +278,11 @@ switchProject p = do
 -- | Prompt for a project name and then switch to it.  Automatically
 -- creates a project if a new name is returned from the prompt.
 switchProjectPrompt :: XPConfig -> X ()
-switchProjectPrompt c = projectPrompt c switch
-  where
-    switch :: ProjectTable -> ProjectName -> X ()
-    switch ps name = case Map.lookup name ps of
-      Just p              -> switchProject p
-      Nothing | null name -> return ()
-              | otherwise -> directoryPrompt dirC "Project Dir: " (mkProject name)
-
-    dirC :: XPConfig
-    dirC = c { alwaysHighlight = False } -- Fix broken tab completion.
-
-    mkProject :: ProjectName -> FilePath -> X ()
-    mkProject name dir = do
-      let p = Project name dir Nothing
-      XS.modify $ \s -> s {projects = Map.insert name p $ projects s}
-      switchProject p
+switchProjectPrompt = projectPrompt [ SwitchMode
+                                    , ShiftMode
+                                    , RenameMode
+                                    , DirMode
+                                    ]
 
 --------------------------------------------------------------------------------
 -- | Shift the currently focused window to the given project.
@@ -248,40 +295,44 @@ shiftToProject p = do
 -- | Prompts for a project name and then shifts the currently focused
 -- window to that project.
 shiftToProjectPrompt :: XPConfig -> X ()
-shiftToProjectPrompt c = projectPrompt c go
-  where
-    go :: ProjectTable -> ProjectName -> X ()
-    go ps name = shiftToProject . fromMaybe (defProject name) $
-                 Map.lookup name ps
-
---------------------------------------------------------------------------------
--- | Prompt for a project name.
-projectPrompt :: XPConfig -> (ProjectTable -> ProjectName -> X ()) -> X ()
-projectPrompt c f = do
-  ws <- map W.tag `fmap` gets (W.workspaces . windowset)
-  ps <- XS.gets projects
-
-  let names = sort (Map.keys ps `union` ws)
-      label = "Switch or Create Project: "
-
-  mkXPrompt (Wor label) c (mkComplFunFromList' names) (f ps)
+shiftToProjectPrompt = projectPrompt [ ShiftMode
+                                     , RenameMode
+                                     , SwitchMode
+                                     , DirMode
+                                     ]
 
 --------------------------------------------------------------------------------
 -- | Rename the current project.
 renameProjectPrompt :: XPConfig -> X ()
-renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go
-  where
-    go :: String -> X ()
-    go name = do
-      p  <- currentProject
-      ps <- XS.gets projects
-      renameWorkspaceByName name
+renameProjectPrompt = projectPrompt [ RenameMode
+                                    , DirMode
+                                    , SwitchMode
+                                    , ShiftMode
+                                    ]
 
-      let p'  = fromMaybe (p { projectName = name }) $ Map.lookup name ps
-          ps' = Map.insert name p' $ Map.delete (projectName p) ps
+--------------------------------------------------------------------------------
+-- | Change the working directory used for the current project.
+--
+-- NOTE: This will only affect new processed started in this project.
+-- Existing processes will maintain the previous working directory.
+changeProjectDirPrompt :: XPConfig -> X ()
+changeProjectDirPrompt = projectPrompt [ DirMode
+                                       , SwitchMode
+                                       , ShiftMode
+                                       , RenameMode
+                                       ]
 
-      XS.modify $ \s -> s {projects = ps'}
-      activateProject p'
+--------------------------------------------------------------------------------
+-- | Prompt for a project name.
+projectPrompt :: [ProjectMode] -> XPConfig -> X ()
+projectPrompt submodes c = do
+  ws <- map W.tag `fmap` gets (W.workspaces . windowset)
+  ps <- XS.gets projects
+
+  let names = sort (Map.keys ps `union` ws)
+      modes = map (\m -> XPT $ ProjectPrompt m names) submodes
+
+  mkXPromptWithModes modes c
 
 --------------------------------------------------------------------------------
 -- | Activate a project by updating the working directory and

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -23,6 +23,8 @@ module XMonad.Actions.DynamicWorkspaceOrder
       getWsCompareByOrder
     , getSortByOrder
     , swapWith
+    , updateName
+    , removeName
 
     , moveTo
     , moveToGreedy
@@ -152,6 +154,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 ()
@@ -175,4 +192,4 @@ withNthWorkspace job wnum = do
   ws <- gets (map W.tag . sort . W.workspaces . windowset)
   case drop wnum ws of
     (w:_) -> windows $ job w
-    []    -> return ()
+    []    -> return ()

XMonad/Actions/GridSelect.hs

@@ -205,7 +205,8 @@ data GSConfig a = GSConfig {
       gs_navigate :: TwoD a (Maybe a),
       gs_rearranger :: Rearranger a,
       gs_originFractX :: Double,
-      gs_originFractY :: Double
+      gs_originFractY :: Double,
+      gs_bordercolor :: String
 }
 
 -- | That is 'fromClassName' if you are selecting a 'Window', or
@@ -322,15 +323,15 @@ diamondRestrict x y originX originY =
 findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
 findInElementMap pos = find ((== pos) . fst)
 
-drawWinBox :: Window -> XMonadFont -> (String, String) -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
-drawWinBox win font (fg,bg) ch cw text x y cp =
+drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
+drawWinBox win font (fg,bg) bc ch cw text x y cp =
   withDisplay $ \dpy -> do
   gc <- liftIO $ createGC dpy win
   bordergc <- liftIO $ createGC dpy win
   liftIO $ do
     Just fgcolor <- initColor dpy fg
     Just bgcolor <- initColor dpy bg
-    Just bordercolor <- initColor dpy borderColor
+    Just bordercolor <- initColor dpy bc
     setForeground dpy gc fgcolor
     setBackground dpy gc bgcolor
     setForeground dpy bordergc bordercolor
@@ -340,7 +341,10 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
            (\n -> do size <- liftIO $ textWidthXMF dpy font n
                      return $ size > (fromInteger (cw-(2*cp))))
            text
-  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+(div ch 2))) stext
+  -- calculate the offset to vertically centre the text based on the ascender and descender
+  (asc,desc) <- liftIO $ textExtentsXMF font stext
+  let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc
+  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
   liftIO $ freeGC dpy gc
   liftIO $ freeGC dpy bordergc
 
@@ -378,6 +382,7 @@ updateElementsWithColorizer colorizer elementmap = do
             colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
+                       (gs_bordercolor gsconfig)
                        cellheight
                        cellwidth
                        text
@@ -390,7 +395,7 @@ stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
 stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
     | t == buttonRelease = do
         s @  TwoDState { td_paneX = px, td_paneY = py,
-                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get
+                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
         let gridX = (fi x - (px - cw) `div` 2) `div` cw
             gridY = (fi y - (py - ch) `div` 2) `div` ch
         case lookup (gridX,gridY) (td_elementmap s) of
@@ -714,10 +719,7 @@ decorateName' w = do
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2)
-
-borderColor :: String
-borderColor = "white"
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
 
 -- | Brings selected window to the current workspace.
 bringSelected :: GSConfig Window -> X ()

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

XMonad/Actions/Minimize.hs

@@ -0,0 +1,144 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Minimize
+-- Copyright   :  (c) Bogdan Sinitsyn (2016)
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Adds actions for minimizing and maximizing windows
+--
+-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
+-- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from
+-- this module
+--
+-- Possible keybindings:
+--
+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow)
+-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindowAndFocus)
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Minimize
+  ( -- * Usage
+    -- $usage
+    minimizeWindow
+  , maximizeWindow
+  , maximizeWindowAndFocus
+  , withLastMinimized
+  , withLastMinimized'
+  , withFirstMinimized
+  , withFirstMinimized'
+  , withMinimized
+  ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import qualified XMonad.Layout.BoringWindows as BW
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Minimize
+import XMonad.Util.WindowProperties (getProp32)
+
+import Foreign.C.Types (CLong)
+import Control.Applicative((<$>))
+import Control.Monad (join)
+import Data.Maybe (fromMaybe, listToMaybe)
+import qualified Data.List as L
+import qualified Data.Map as M
+
+-- $usage
+-- Import this module with "XMonad.Layout.Minimize" and "XMonad.Layout.BoringWindows":
+-- > import XMonad.Actions.Minimize
+-- > import XMonad.Layout.Minimize
+-- > import qualified XMonad.Layout.BoringWindows as BW
+--
+-- Then apply 'minimize' and 'boringWindows' to your layout hook and use some
+-- actions from this module:
+-- > main = xmonad def { layoutHook = minimize . BW.boringWindows $ whatever }
+-- Example keybindings:
+-- >        , ((modm,               xK_m     ), withFocused minimizeWindow      )
+-- >        , ((modm .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow)
+
+setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
+setMinimizedState win st f = do
+    setWMState win st
+    withDisplay $ \dpy -> do
+        wm_state <- getAtom "_NET_WM_STATE"
+        hidden <- fromIntegral <$> getAtom "_NET_WM_STATE_HIDDEN"
+        wstate <- fromMaybe [] <$> getProp32 wm_state win
+        io $ changeProperty32 dpy win wm_state aTOM propModeReplace (f hidden wstate)
+
+setMinimized :: Window -> X ()
+setMinimized win = setMinimizedState win iconicState (:)
+
+setNotMinimized :: Window -> X ()
+setNotMinimized win = setMinimizedState win normalState L.delete
+
+-- It does not just set minimizedStack to newWindows because it should save
+-- order in which elements were added (newer first)
+modified :: (RectMap -> RectMap) -> X Bool
+modified f = XS.modified $
+    \Minimized { rectMap = oldRectMap, minimizedStack = oldStack } ->
+      let newRectMap = f oldRectMap
+          newWindows = M.keys newRectMap
+       in Minimized { rectMap = newRectMap
+                    , minimizedStack = (newWindows L.\\ oldStack)
+                                       ++
+                                       (oldStack `L.intersect` newWindows)
+                    }
+
+
+-- | Minimize a window
+minimizeWindow :: Window -> X ()
+minimizeWindow w = withWindowSet $ \ws ->
+  whenX (modified $ M.insert w (M.lookup w $ W.floating ws)) $ do
+    setMinimized w
+    windows $ W.sink w
+    BW.focusDown
+
+
+-- | Maximize window and apply a function to maximized window and 'WindowSet'
+maximizeWindowAndChangeWSet :: (Window -> WindowSet -> WindowSet) -> Window -> X ()
+maximizeWindowAndChangeWSet f w = do
+  mrect <- XS.gets (join . M.lookup w . rectMap)
+  whenX (modified $ M.delete w) $ do
+    setNotMinimized w
+    broadcastMessage BW.UpdateBoring
+    windows $ f w . maybe id (W.float w) mrect
+
+-- | Just maximize a window without focusing
+maximizeWindow :: Window -> X ()
+maximizeWindow = maximizeWindowAndChangeWSet $ const id
+
+-- | Maximize a window and then focus it
+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 ()
+withLastMinimized action = withLastMinimized' (flip whenJust action)
+
+-- | Like withLastMinimized but the provided action is always invoked with a
+--   'Maybe Window', that will be nothing if there is no last minimized window.
+withLastMinimized' :: (Maybe Window -> X ()) -> X ()
+withLastMinimized' action = withMinimized (action . listToMaybe)
+
+withMinimized :: ([Window] -> X a) -> X a
+withMinimized action = do
+  minimized <- XS.gets minimizedStack
+  currentStack <- withWindowSet $ return . W.index
+  action $ minimized `L.intersect` currentStack

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
--- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
--- natural but may make it impossible to navigate to a given window from the
--- current window, particularly in the floating layer.  /Center navigation/
--- feels less natural in certain situations but ensures that all windows can be
--- reached without the need to involve the mouse. A third option is to use
--- /Hybrid navigation/, which automatically chooses between the two whenever
--- navigation is attempted.  Navigation2D allows different navigation strategies
--- to be used in the two layers and allows customization of the navigation strategy
--- for the tiled layer based on the layout currently in effect.
+-- between layers.  Navigation2D provides three different navigation strategies
+-- (see <#Technical_Discussion> for details): /Line navigation/ and
+-- /Side navigation/ feel rather natural but may make it impossible to navigate
+-- to a given window from the current window, particularly in the floating
+-- layer. /Center navigation/ feels less natural in certain situations but
+-- ensures that all windows can be reached without the need to involve the
+-- mouse. Another option is to use a /Hybrid/ of the three strategies,
+-- automatically choosing whichever first provides a suitable target window.
+-- Navigation2D allows different navigation strategies to be used in the two
+-- 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@:
 --
@@ -96,11 +101,11 @@ import XMonad.Util.Types
 --
 -- Alternatively, you can use navigation2DP:
 --
--- > main = xmonad $ navigation2D def
--- >                              ("<Up>", "<Left>", "<Down>", "<Right>")
--- >                              [("M-",   windowGo  ),
--- >                               ("M-S-", windowSwap)]
--- >                              False
+-- > main = xmonad $ navigation2DP def
+-- >                               ("<Up>", "<Left>", "<Down>", "<Right>")
+-- >                               [("M-",   windowGo  ),
+-- >                                ("M-S-", windowSwap)]
+-- >                               False
 -- >               $ def
 --
 -- That's it. If instead you'd like more control, you can combine
@@ -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
--- navigation if it does not find any suitable target windows. This is useful since
--- Line navigation tends to fail on gaps, but provides more intuitive motions
--- when it succeeds—provided there are no floating windows.
+-- | Side navigation. Consider navigating to the right this time. The strategy
+-- is to take the line segment forming the right boundary of the current window,
+-- and push it to the right until it intersects with at least one other window.
+-- 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,
--- then falls back on Center navigation if it finds no suitable target window.
-doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
-doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
-    where
-        applyToBoth f g h a b c = f (g a b c) (h a b c)
+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
+-- y1 <= y2, and make the assumption valid by initialising SideRects with the
+-- property and carefully preserving it over any individual transformation.
+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
+  deriving Show
+
+-- 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_o), onNextNeighbour W.view)
-> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
-> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
+> , ((modMask, xK_a), onPrevNeighbour def W.view)
+> , ((modMask, xK_o), onNextNeighbour def W.view)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour def 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 (P i) = do w <- gets windowset
-                     let screens = W.current w : W.visible w
-                     if i<0 || i >= length screens
-                      then return Nothing
-                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
-                           in return $ Just $ W.screen $ ss !! i
+getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
+getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
+                                                  let screens = W.current w : W.visible w
+                                                  if i<0 || i >= length screens
+                                                    then return Nothing
+                                                    else let ss = sortBy (cmpScreen `on` getScreenIdAndRectangle) screens
+                                                    in return $ Just $ W.screen $ ss !! i
 
 -- | Switch to a given physical screen
-viewScreen :: PhysicalScreen -> X ()
-viewScreen p = do i <- getScreen p
-                  whenJust i $ \s -> do
-                  w <- screenWorkspace s
-                  whenJust w $ windows . W.view
+viewScreen :: ScreenComparator -> PhysicalScreen -> X ()
+viewScreen sc p = do i <- getScreen sc p
+                     whenJust i $ \s -> do
+                     w <- screenWorkspace s
+                     whenJust w $ windows . W.view
 
 -- | Send the active window to a given physical screen
-sendToScreen :: PhysicalScreen -> X ()
-sendToScreen p = do i <- getScreen p
-                    whenJust i $ \s -> do
-                      w <- screenWorkspace s
-                      whenJust w $ windows . W.shift
+sendToScreen :: ScreenComparator -> PhysicalScreen -> X ()
+sendToScreen sc p = do i <- getScreen sc p
+                       whenJust i $ \s -> do
+                         w <- screenWorkspace s
+                         whenJust w $ windows . W.shift
 
--- | Compare two screens by their top-left corners, ordering
--- | top-to-bottom and then left-to-right.
-cmpScreen :: Rectangle -> Rectangle -> Ordering
-cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+-- | A ScreenComparator allow to compare two screen based on their coordonate and Xinerama Id
+newtype ScreenComparator = ScreenComparator ((ScreenId, Rectangle) -> (ScreenId, Rectangle) -> Ordering)
 
+-- | 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 d = do w <- gets windowset
-                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
-                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
-                        pos = (curPos + d) `mod` length ss
-                    return $ ss !! pos
+getNeighbour :: ScreenComparator -> Int -> X ScreenId
+getNeighbour (ScreenComparator cmpScreen) d =
+  do w <- gets windowset
+     let ss = map W.screen $ sortBy (cmpScreen `on` getScreenIdAndRectangle) $ W.current w : W.visible w
+         curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
+         pos = (curPos + d) `mod` length ss
+     return $ ss !! pos
 
-neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-neighbourWindows d f = do s <- getNeighbour d
-                          w <- screenWorkspace s
-                          whenJust w $ windows . f
+neighbourWindows :: ScreenComparator -> Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows sc d f = do s <- getNeighbour sc d
+                             w <- screenWorkspace s
+                             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 = neighbourWindows 1
+onNextNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+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 = neighbourWindows (-1)
+onPrevNeighbour :: ScreenComparator -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onPrevNeighbour sc = neighbourWindows sc (-1)

XMonad/Actions/SpawnOn.hs

@@ -28,8 +28,14 @@ module XMonad.Actions.SpawnOn (
     shellPromptOn
 ) where
 
+import Control.Exception (tryJust)
+import Control.Monad (guard)
 import Data.List (isInfixOf)
+import Data.Maybe (isJust)
+import System.IO.Error (isDoesNotExistError)
+import System.IO.Unsafe (unsafePerformIO)
 import System.Posix.Types (ProcessID)
+import Text.Printf (printf)
 
 import XMonad
 import qualified XMonad.StackSet as W
@@ -68,6 +74,25 @@ instance ExtensionClass Spawner where
     initialValue = Spawner []
 
 
+getPPIDOf :: ProcessID -> Maybe ProcessID
+getPPIDOf pid =
+    case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger pid of
+      Left _         -> Nothing
+      Right contents -> case lines contents of
+                          []        -> Nothing
+                          first : _ -> case words first of
+                                         _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)
+                                         _                    -> Nothing
+
+getPPIDChain :: ProcessID -> [ProcessID]
+getPPIDChain pid' = ppid_chain pid' []
+    where ppid_chain pid acc =
+              if pid == 0
+              then acc
+              else case getPPIDOf pid of
+                     Nothing   -> acc
+                     Just ppid -> ppid_chain ppid (ppid : acc)
+
 -- | Get the current Spawner or create one if it doesn't exist.
 modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
 modifySpawner f = XS.modify (Spawner . f . pidsRef)
@@ -83,9 +108,17 @@ manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
 manageSpawnWithGC garbageCollect = do
     Spawner pids <- liftX XS.get
     mp <- pid
-    case flip lookup pids =<< mp of
-        Nothing -> idHook
-        Just mh  -> do
+    let ppid_chain = case mp of
+                       Just winpid -> winpid : getPPIDChain winpid
+                       Nothing     -> []
+        known_window_handlers = [ mh
+                                | ppid <- ppid_chain
+                                , let mpid = lookup ppid pids
+                                , isJust mpid
+                                , let (Just mh) = mpid ]
+    case known_window_handlers of
+        [] -> idHook
+        (mh:_)  -> do
             whenJust mp $ \p -> liftX $ do
                 ps <- XS.gets pidsRef
                 XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)

XMonad/Actions/Submap.hs

@@ -75,17 +75,23 @@ submapDefaultWithKey defAction keys = do
     XConf { theRoot = root, display = d } <- ask
 
     io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+    io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync
+                     none none currentTime
 
     (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-        maskEvent d keyPressMask p
-        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-        keysym <- keycodeToKeysym d code 0
-        if isModifierKey keysym
-            then nextkey
-            else return (m, keysym)
+        maskEvent d (keyPressMask .|. buttonPressMask) p
+        ev <- getEvent p
+        case ev of
+          KeyEvent { ev_keycode = code, ev_state = m } -> do
+            keysym <- keycodeToKeysym d code 0
+            if isModifierKey keysym
+                then nextkey
+                else return (m, keysym)
+          _ -> return (0, 0)
     -- Remove num lock mask and Xkb group state bits
     m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
 
+    io $ ungrabPointer d currentTime
     io $ ungrabKeyboard d currentTime
 
     fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)

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/Actions/UpdatePointer.hs

@@ -1,7 +1,8 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.UpdatePointer
--- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>
+-- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Robert Marlow <robreim@bobturf.org>
@@ -28,6 +29,7 @@ import Control.Arrow
 import Control.Monad
 import XMonad.StackSet (member, peek, screenDetail, current)
 import Data.Maybe
+import Control.Exception
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -63,9 +65,13 @@ updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
 updatePointer refPos ratio = do
   ws <- gets windowset
   dpy <- asks display
+  let defaultRect = screenRect $ screenDetail $ current ws
   rect <- case peek ws of
-        Nothing -> return $ (screenRect . screenDetail .current) ws
-        Just w  -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
+        Nothing -> return defaultRect
+        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
+                      return $ case tryAttributes of
+                        Left (_ :: SomeException) -> defaultRect
+                        Right attributes          -> windowAttributesToRectangle attributes
   root <- asks theRoot
   mouseIsMoving <- asks mouseFocused
   (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root

XMonad/Actions/WindowGo.hs

@@ -38,13 +38,14 @@ module XMonad.Actions.WindowGo (
 
 import Control.Monad
 import Data.Char (toLower)
+import qualified Data.List as L (nub,sortBy)
 import Data.Monoid
 import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
 import Graphics.X11 (Window)
 import XMonad.ManageHook
 import XMonad.Operations (windows)
 import XMonad.Prompt.Shell (getBrowser, getEditor)
-import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow)
+import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
 import XMonad.Util.Run (safeSpawnProg)
 {- $usage
 
@@ -66,12 +67,20 @@ appropriate one, or cover your bases by using instead something like:
 For detailed instructions on editing your key bindings, see
 "XMonad.Doc.Extending#Editing_key_bindings". -}
 
+-- | Get the list of workspaces sorted by their tag
+workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]
+workspacesSorted s = L.sortBy (\u t -> W.tag u `compare` W.tag t) $ W.workspaces s
+
+-- | Get a list of all windows in the 'StackSet' with an absolute ordering of workspaces
+allWindowsSorted :: Ord i => Eq a => W.StackSet i l a s sd -> [a]
+allWindowsSorted = L.nub . concatMap (W.integrate' . W.stack) . workspacesSorted
+
 -- | If windows that satisfy the query exist, apply the supplied
 -- function to them, otherwise run the action given as
 -- second parameter.
 ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
 ifWindows qry f el = withWindowSet $ \wins -> do
-  matches <- filterM (runQuery qry) $ W.allWindows wins
+  matches <- filterM (runQuery qry) $ allWindowsSorted wins
   case matches of
     [] -> el
     ws -> f ws

XMonad/Actions/WindowMenu.hs

@@ -28,7 +28,7 @@ import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Actions.GridSelect
 import XMonad.Layout.Maximize
-import XMonad.Layout.Minimize
+import XMonad.Actions.Minimize
 import XMonad.Util.XUtils (fi)
 
 -- $usage

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/Bluetile.hs

@@ -44,6 +44,7 @@ import XMonad.Layout.WindowSwitcherDecoration
 
 import XMonad.Actions.BluetileCommands
 import XMonad.Actions.CycleWS
+import XMonad.Actions.Minimize
 import XMonad.Actions.WindowMenu
 
 import XMonad.Hooks.CurrentWorkspaceOnTop
@@ -143,7 +144,7 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
 
     -- Minimizing
     , ((modMask',               xK_m     ), withFocused minimizeWindow)
-    , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
+    , ((modMask' .|. shiftMask, xK_m     ), withLastMinimized maximizeWindow)
     ]
     ++
     -- mod-[1..9] ++ [0] %! Switch to workspace N

XMonad/Config/Example.hs

@@ -0,0 +1,78 @@
+--------------------------------------------------------------------------------
+-- | Example.hs
+--
+-- Example configuration file for xmonad using the latest recommended
+-- features (e.g., 'desktopConfig').
+module Main (main) where
+
+--------------------------------------------------------------------------------
+import System.Exit
+import XMonad
+import XMonad.Config.Desktop
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageHelpers
+import XMonad.Layout.BinarySpacePartition (emptyBSP)
+import XMonad.Layout.NoBorders (noBorders)
+import XMonad.Layout.ResizableTile (ResizableTall(..))
+import XMonad.Layout.ToggleLayouts (ToggleLayout(..), toggleLayouts)
+import XMonad.Prompt
+import XMonad.Prompt.ConfirmPrompt
+import XMonad.Prompt.Shell
+import XMonad.Util.EZConfig
+
+--------------------------------------------------------------------------------
+main = do
+  spawn "xmobar" -- Start a task bar such as xmobar.
+
+  -- Start xmonad using the main desktop configuration with a few
+  -- simple overrides:
+  xmonad $ desktopConfig
+    { modMask    = mod4Mask -- Use the "Win" key for the mod key
+    , manageHook = myManageHook <+> manageHook desktopConfig
+    , layoutHook = desktopLayoutModifiers $ myLayouts
+    , logHook    = dynamicLogString def >>= xmonadPropLog
+    }
+
+    `additionalKeysP` -- Add some extra key bindings:
+      [ ("M-S-q",   confirmPrompt myXPConfig "exit" (io exitSuccess))
+      , ("M-p",     shellPrompt myXPConfig)
+      , ("M-<Esc>", sendMessage (Toggle "Full"))
+      ]
+
+--------------------------------------------------------------------------------
+-- | Customize layouts.
+--
+-- This layout configuration uses two primary layouts, 'ResizableTall'
+-- and 'BinarySpacePartition'.  You can also use the 'M-<Esc>' key
+-- binding defined above to toggle between the current layout and a
+-- full screen layout.
+myLayouts = toggleLayouts (noBorders Full) others
+  where
+    others = ResizableTall 1 (1.5/100) (3/5) [] ||| emptyBSP
+
+--------------------------------------------------------------------------------
+-- | Customize the way 'XMonad.Prompt' looks and behaves.  It's a
+-- great replacement for dzen.
+myXPConfig = def
+  { position          = Top
+  , alwaysHighlight   = True
+  , promptBorderWidth = 0
+  , font              = "xft:monospace:size=9"
+  }
+
+--------------------------------------------------------------------------------
+-- | Manipulate windows as they are created.  The list given to
+-- @composeOne@ is processed from top to bottom.  The first matching
+-- rule wins.
+--
+-- Use the `xprop' tool to get the info you need for these matches.
+-- For className, use the second value that xprop gives you.
+myManageHook = composeOne
+  [ className =? "Pidgin" -?> doFloat
+  , className =? "XCalc"  -?> doFloat
+  , className =? "mpv"    -?> doFloat
+  , isDialog              -?> doCenterFloat
+
+    -- Move transient windows to their parent:
+  , transience
+  ]

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

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,
-    xmobarStripTags,
+    xmobarColor, xmobarAction, xmobarRaw,
+    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/DynamicProperty.hs

@@ -58,8 +58,8 @@ dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_p
   when (ps == propertyNewValue && a == pa) $ do
     g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)
     windows g
-  return (All False) -- so anything else also processes it
-dynamicPropertyChange _ _ _ = return (All False)
+  return mempty -- so anything else also processes it
+dynamicPropertyChange _ _ _ = return mempty
 
 -- | A shorthand for the most common case, dynamic titles
 dynamicTitle :: ManageHook -> Event -> X All

XMonad/Hooks/EwmhDesktops.hs

@@ -25,6 +25,7 @@ module XMonad.Hooks.EwmhDesktops (
     ) where
 
 import Codec.Binary.UTF8.String (encode)
+import Control.Applicative((<$>))
 import Data.List
 import Data.Maybe
 import Data.Monoid
@@ -87,29 +88,19 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
     let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
     setClientList wins
 
-    -- Current desktop
-    case (elemIndex (W.currentTag s) $ map W.tag ws) of
-      Nothing -> return ()
-      Just curr -> do
-        setCurrentDesktop curr
+    -- Remap the current workspace to handle any renames that f might be doing.
+    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
+        maybeCurrent  = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
 
-        -- Per window Desktop
-        -- To make gnome-panel accept our xinerama stuff, we display
-        -- all visible windows on the current desktop.
-        forM_ (W.current s : W.visible s) $ \x ->
-            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
-                setWindowDesktop win curr
+    fromMaybe (return ()) $ setCurrentDesktop <$> maybeCurrent
 
-    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
+    sequence_ $ zipWith setWorkspaceWindowDesktops [0..] ws
 
     setActiveWindow
 
     return ()
 
+
 -- |
 -- Intercepts messages from pagers and similar applications and reacts on them.
 -- Currently supports:
@@ -230,6 +221,10 @@ setClientList wins = withDisplay $ \dpy -> do
     a' <- getAtom "_NET_CLIENT_LIST_STACKING"
     io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
 
+setWorkspaceWindowDesktops :: (Integral a) => a -> WindowSpace -> X()
+setWorkspaceWindowDesktops index workspace =
+  mapM_ (flip setWindowDesktop index) (W.integrate' $ W.stack workspace)
+
 setWindowDesktop :: (Integral a) => Window -> a -> X ()
 setWindowDesktop win i = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_DESKTOP"

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/ManageDocks.hs

@@ -140,12 +140,11 @@ docksEventHook (MapNotifyEvent { ev_window = w }) = do
     return (All True)
 docksEventHook (PropertyEvent { ev_window = w
                               , ev_atom = a }) = do
-    whenX (runQuery checkDock w) $ do
-        nws <- getAtom "_NET_WM_STRUT"
-        nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
-        when (a == nws || a == nwsp) $ do
-            strut <- getStrut w
-            whenX (updateStrutCache w strut) refreshDocks
+    nws <- getAtom "_NET_WM_STRUT"
+    nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
+    when (a == nws || a == nwsp) $ do
+        strut <- getStrut w
+        whenX (updateStrutCache w strut) refreshDocks
     return (All True)
 docksEventHook (DestroyWindowEvent {ev_window = w}) = do
     whenX (deleteFromStructCache w) refreshDocks
@@ -246,7 +245,9 @@ instance Message SetStruts
 instance LayoutModifier AvoidStruts a where
     modifyLayout (AvoidStruts ss) w r = do
         srect <- fmap ($ r) (calcGap ss)
-        setWorkarea srect
+        -- Ensure _NET_WORKAREA is not set.
+        -- See: https://github.com/xmonad/xmonad-contrib/pull/79
+        rmWorkarea
         runLayout w srect
 
     pureMess as@(AvoidStruts ss) m
@@ -262,13 +263,11 @@ instance LayoutModifier AvoidStruts a where
             toggleOne x xs | x `S.member` xs = S.delete x xs
                            | otherwise   = x `S.insert` xs
 
-setWorkarea :: Rectangle -> X ()
-setWorkarea (Rectangle x y w h) = withDisplay $ \dpy -> do
+rmWorkarea :: X ()
+rmWorkarea = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WORKAREA"
-    c <- getAtom "CARDINAL"
     r <- asks theRoot
-    io $ changeProperty32 dpy r a c propModeReplace [fi x, fi y, fi w, fi h]
-
+    io (deleteProperty dpy r a)
 
 -- | (Direction, height\/width, initial pixel, final pixel).
 

XMonad/Hooks/Minimize.hs

@@ -23,7 +23,7 @@ import Data.Monoid
 import Control.Monad(when)
 
 import XMonad
-import XMonad.Layout.Minimize
+import XMonad.Actions.Minimize
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -43,10 +43,10 @@ minimizeEventHook (ClientMessageEvent {ev_window = w,
     a_aw <- getAtom "_NET_ACTIVE_WINDOW"
     a_cs <- getAtom "WM_CHANGE_STATE"
 
-    when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)
+    when (mt == a_aw) $ maximizeWindow w
     when (mt == a_cs) $ do
       let message = fromIntegral . head $ dt
-      when (message == normalState) $ sendMessage (RestoreMinimizedWin w)
+      when (message == normalState) $ maximizeWindow w
       when (message == iconicState) $ minimizeWindow w
 
     return (All True)

XMonad/Hooks/RestoreMinimized.hs

@@ -1,4 +1,4 @@
-----------------------------------------------------------------------------
+-----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.RestoreMinimized
 -- Copyright   :  (c) Jan Vornberger 2009
@@ -15,6 +15,7 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.RestoreMinimized
+    {-# DEPRECATED "Use XMonad.Hooks.Minimize instead, this module has no effect" #-}
     ( -- * Usage
       -- $usage
       RestoreMinimized (..)
@@ -22,10 +23,8 @@ module XMonad.Hooks.RestoreMinimized
     ) where
 
 import Data.Monoid
-import Control.Monad(when)
 
 import XMonad
-import XMonad.Layout.Minimize
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -39,11 +38,4 @@ import XMonad.Layout.Minimize
 data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
 
 restoreMinimizedEventHook :: Event -> X All
-restoreMinimizedEventHook (ClientMessageEvent {ev_window = w,
-                                                ev_message_type = mt}) = do
-    a_aw <- getAtom "_NET_ACTIVE_WINDOW"
-    a_cs <- getAtom "WM_CHANGE_STATE"
-    when (mt == a_aw || mt == a_cs) $ do
-        sendMessage (RestoreMinimizedWin w)
-    return (All True)
 restoreMinimizedEventHook _ = return (All True)

XMonad/Hooks/UrgencyHook.hs

@@ -339,7 +339,7 @@ getNetWMState :: Window -> X [CLong]
 getNetWMState w = do
     a_wmstate <- getAtom "_NET_WM_STATE"
     fromMaybe [] `fmap` getProp32 a_wmstate w
-   
+
 
 -- The Non-ICCCM Manifesto:
 -- Note: Some non-standard choices have been made in this implementation to
@@ -497,14 +497,14 @@ data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
 
 instance UrgencyHook BorderUrgencyHook where
   urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
-    withDisplay $ \dpy -> io $ do
-      c' <- initColor dpy cs
+    withDisplay $ \dpy -> do
+      c' <- io (initColor dpy cs)
       case c' of
-        Just c -> setWindowBorder dpy w c
-        _      -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
-                                            ,show cs
-                                            ," in BorderUrgencyHook"
-                                            ]
+        Just c -> setWindowBorderWithFallback dpy w cs c
+        _      -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
+                                                 ,show cs
+                                                 ," in BorderUrgencyHook"
+                                                 ]
 
 -- | Flashes when a window requests your attention and you can't see it.
 -- Defaults to a duration of five seconds, and no extra args to dzen.
@@ -543,4 +543,3 @@ filterUrgencyHook skips w = do
         Just tag -> when (tag `elem` skips)
                         $ adjustUrgents (delete w)
         _ -> return ()
-

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/Hooks/WorkspaceHistory.hs

@@ -14,20 +14,25 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonad.Hooks.WorkspaceHistory
-    ( -- * Usage
+module XMonad.Hooks.WorkspaceHistory (
+      -- * Usage
       -- $usage
-
       -- * Hooking
-      workspaceHistoryHook
-
+    workspaceHistoryHook
       -- * Querying
-    , workspaceHistory
+  , workspaceHistory
+  , workspaceHistoryByScreen
+  , workspaceHistoryWithScreen
+    -- * Handling edits
+  , workspaceHistoryTransaction
+  ) where
 
-    ) where
+import           Control.Applicative
+import           Prelude
 
 import XMonad
-import XMonad.StackSet (currentTag)
+import XMonad.StackSet hiding (filter, delete)
+import Data.List
 import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
@@ -46,10 +51,10 @@ import qualified XMonad.Util.ExtensibleState as XS
 --
 -- To make use of the collected data, a query function is provided.
 
-data WorkspaceHistory =
-    WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.
-                     }
-    deriving (Typeable, Read, Show)
+data WorkspaceHistory = WorkspaceHistory
+  { history :: [(ScreenId, WorkspaceId)] -- ^ Workspace Screens in
+                                         -- reverse-chronological order.
+  } deriving (Typeable, Read, Show)
 
 instance ExtensionClass WorkspaceHistory where
     initialValue = WorkspaceHistory []
@@ -58,17 +63,41 @@ instance ExtensionClass WorkspaceHistory where
 -- | A 'logHook' that keeps track of the order in which workspaces have
 -- been viewed.
 workspaceHistoryHook :: X ()
-workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)
+workspaceHistoryHook = gets windowset >>= (XS.modify . updateLastActiveOnEachScreen)
+
+workspaceHistoryWithScreen :: X [(ScreenId, WorkspaceId)]
+workspaceHistoryWithScreen = XS.gets history
+
+workspaceHistoryByScreen :: X [(ScreenId, [WorkspaceId])]
+workspaceHistoryByScreen =
+  map (\wss -> (fst $ head wss, map snd wss)) .
+  groupBy (\a b -> fst a == fst b) .
+  sortBy (\a b -> compare (fst a) $ fst b)<$>
+  workspaceHistoryWithScreen
 
 -- | A list of workspace tags in the order they have been viewed, with the
 -- most recent first. No duplicates are present, but not all workspaces are
 -- guaranteed to appear, and there may be workspaces that no longer exist.
 workspaceHistory :: X [WorkspaceId]
-workspaceHistory = XS.gets history
+workspaceHistory = nub . map snd <$> XS.gets history
 
+workspaceHistoryTransaction :: X () -> X ()
+workspaceHistoryTransaction action = do
+  startingHistory <- XS.gets history
+  action
+  new <- (flip updateLastActiveOnEachScreen $ WorkspaceHistory startingHistory) <$> gets windowset
+  XS.put new
 
--- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not
+-- | Update the last visible workspace on each monitor if needed
 -- already there, or move it to the front if it is.
-makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory
-makeFirst w v = let (xs, ys) = break (w ==) $ history v
-                in v { history = w : (xs ++ drop 1 ys) }
+updateLastActiveOnEachScreen :: WindowSet -> WorkspaceHistory -> WorkspaceHistory
+updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
+  WorkspaceHistory { history = doUpdate cur $ foldl updateLastForScreen (history wh) $ vis ++ [cur] }
+  where
+    firstOnScreen sid = find ((== sid) . fst)
+    doUpdate Screen {workspace = Workspace { tag = wid }, screen = sid} curr =
+      let newEntry = (sid, wid) in newEntry:delete newEntry curr
+    updateLastForScreen curr Screen {workspace = Workspace { tag = wid }, screen = sid} =
+      let newEntry = (sid, wid)
+          alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
+      in if alreadyCurrent then curr else newEntry:delete newEntry curr

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/BinarySpacePartition.hs

@@ -20,6 +20,7 @@ module XMonad.Layout.BinarySpacePartition (
   -- * Usage
   -- $usage
     emptyBSP
+  , BinarySpacePartition
   , Rotate(..)
   , Swap(..)
   , ResizeDirectional(..)

XMonad/Layout/ComboP.hs

@@ -20,6 +20,7 @@ module XMonad.Layout.ComboP (
                              combineTwoP,
                              CombineTwoP,
                              SwapWindow(..),
+                             PartitionWins(..),
                              Property(..)
                             ) where
 
@@ -71,6 +72,16 @@ data SwapWindow =  SwapWindow        -- ^ Swap window between panes
                  deriving (Read, Show, Typeable)
 instance Message SwapWindow
 
+data PartitionWins = PartitionWins  -- ^ Reset the layout and
+                                    -- partition all windows into the
+                                    -- correct sub-layout.  Useful for
+                                    -- when window properties have
+                                    -- changed and you want ComboP to
+                                    -- update which layout a window
+                                    -- belongs to.
+                   deriving (Read, Show, Typeable)
+instance Message PartitionWins
+
 data CombineTwoP l l1 l2 a = C2P [a] [a] [a] l (l1 a) (l2 a) Property
                                 deriving (Read, Show)
 
@@ -100,6 +111,7 @@ instance (LayoutClass l (), LayoutClass l1 Window, LayoutClass l2 Window) =>
                 (maybe l1 id ml1') (maybe l2 id ml2') prop)
 
     handleMessage us@(C2P f ws1 ws2 super l1 l2 prop) m
+        | Just PartitionWins   <- fromMessage m = return . Just $ C2P [] [] [] super l1 l2 prop
         | Just SwapWindow      <- fromMessage m = swap us
         | Just (SwapWindowN 0) <- fromMessage m = swap us
         | Just (SwapWindowN n) <- fromMessage m = forwardToFocused us $ SomeMessage $ SwapWindowN $ n-1

XMonad/Layout/DecorationAddons.hs

@@ -24,7 +24,7 @@ import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Layout.Decoration
 import XMonad.Actions.WindowMenu
-import XMonad.Layout.Minimize
+import XMonad.Actions.Minimize
 import XMonad.Layout.Maximize
 import XMonad.Hooks.ManageDocks
 import XMonad.Util.Font

XMonad/Layout/Fullscreen.hs

@@ -30,17 +30,19 @@ module XMonad.Layout.Fullscreen
     ,FullscreenFloat, FullscreenFocus, FullscreenFull
     ) where
 
-import XMonad
-import XMonad.Layout.LayoutModifier
-import XMonad.Util.WindowProperties
-import XMonad.Hooks.ManageHelpers (isFullscreen)
-import qualified XMonad.StackSet as W
-import Data.List
-import Data.Maybe
-import Data.Monoid
-import qualified Data.Map as M
-import Control.Monad
-import Control.Arrow (second)
+import           XMonad
+import           XMonad.Layout.LayoutModifier
+import           XMonad.Hooks.ManageHelpers     (isFullscreen)
+import           XMonad.Util.WindowProperties
+import qualified XMonad.Util.Rectangle          as R
+import qualified XMonad.StackSet                as W
+
+import           Data.List
+import           Data.Maybe
+import           Data.Monoid
+import qualified Data.Map                       as M
+import           Control.Monad
+import           Control.Arrow                  (second)
 
 -- $usage
 -- Provides a ManageHook and an EventHook that sends layout messages
@@ -107,9 +109,12 @@ instance LayoutModifier FullscreenFull Window where
     _ -> Nothing
 
   pureModifier (FullscreenFull frect fulls) rect _ list =
-    (map (flip (,) rect') visfulls ++ rest, Nothing)
-    where visfulls = intersect fulls $ map fst list
-          rest = filter (flip notElem visfulls . fst) list
+    (visfulls' ++ rest', Nothing)
+    where (visfulls,rest) = partition (flip elem fulls . fst) list
+          visfulls' = map (second $ const rect') visfulls
+          rest' = if null visfulls'
+                  then rest
+                  else filter (not . R.supersetOf rect' . snd) rest
           rect' = scaleRationalRect rect frect
 
 instance LayoutModifier FullscreenFocus Window where
@@ -122,7 +127,7 @@ instance LayoutModifier FullscreenFocus Window where
   pureModifier (FullscreenFocus frect fulls) rect (Just (W.Stack {W.focus = f})) list
      | f `elem` fulls = ((f, rect') : rest, Nothing)
      | otherwise = (list, Nothing)
-     where rest = filter ((/= 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_t), sendMessage $ ToggleGap U) -- toggle the top 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_g), sendMessage $ ToggleGaps)               -- toggle all gaps
+-- > , ((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_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.Monad (forM)
+import Control.Applicative ((<$>),(<|>),(<$))
+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')
-                                      Nothing -> return $ Just l
-              Just Refocus -> refocus l >> return (Just l)
+                                      Just l' -> refocus l'
+                                      Nothing -> return Nothing
+              Just (ModifyX spec) -> do ml' <- applySpecX spec l
+                                        whenJust ml' (void . refocus)
+                                        return (ml' <|> Just l)
+              Just Refocus -> refocus l
               Just _ -> return Nothing
               Nothing -> handleMessage l $ SomeMessage (ToFocused sm)
             where handleOnFocused sm z = mapZM step $ Just z
@@ -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 g = case getFocusZ $ gZipper $ W.focus $ groups g
-            of Just w -> focus w
-               Nothing -> return ()
+refocus :: Groups l l2 Window -> X (Maybe (Groups l l2 Window))
+refocus g =
+  let mw = (getFocusZ . gZipper . W.focus . groups) g
+  in  g <$ mw <$ whenJust mw (modifyWindowSet . W.focusWindow)
 
 -- ** ModifySpec type
 
@@ -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
-                    g' = flip modifyGroups g $ f (ID id $ baseLayout g)
-                                               >>> toTags
-                                               >>> foldr reID ((ids, []), [])
-                                               >>> snd
-                                               >>> fromTags
-                in case groups g == groups g' of
-                     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
-
-
+applySpec f g =
+    let (seed', id:ids) =  gen $ seed g
+        g' = flip modifyGroups g $ f (ID id $ baseLayout g)
+                                   >>> toTags
+                                   >>> foldr (reID g) ((ids, []), [])
+                                   >>> snd
+                                   >>> fromTags
+    in case groups g == groups g' of
+      True -> Nothing
+      False -> Just g' { seed = seed' }
 
+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

@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-{-# LANGUAGE MultiParamTypeClasses, Rank2Types, ImpredicativeTypes #-}
+{-# LANGUAGE MultiParamTypeClasses, Rank2Types #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -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
@@ -178,7 +178,7 @@ focusFloatDown = focusHelper id id
 -- ** Groups-specific actions
 
 wrap :: G.ModifySpec -> X ()
-wrap = sendMessage . G.Modify
+wrap x = sendMessage (G.Modify x)
 
 -- | Swap the focused group with the previous one
 swapGroupUp :: X ()

XMonad/Layout/Hidden.hs

@@ -110,7 +110,7 @@ popNewestHiddenWindow = sendMessage PopNewestHiddenWindow
 --------------------------------------------------------------------------------
 hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
 hideWindowMsg (HiddenWindows hidden) win = do
-  windows (W.delete' win)
+  modify (\s -> s { windowset = W.delete' win $ windowset s })
   return . Just . HiddenWindows $ hidden ++ [win]
 
 --------------------------------------------------------------------------------
@@ -130,4 +130,5 @@ popOldestMsg (HiddenWindows (win:rest)) = do
 
 --------------------------------------------------------------------------------
 restoreWindow :: Window -> X ()
-restoreWindow = windows . W.insertUp
+restoreWindow win =
+  modify (\s -> s { windowset = W.insertUp win $ windowset s })

XMonad/Layout/ImageButtonDecoration.hs

@@ -38,7 +38,7 @@ import XMonad.Layout.DecorationAddons
 import XMonad.Util.Image
 
 import XMonad.Actions.WindowMenu
-import XMonad.Layout.Minimize
+import XMonad.Actions.Minimize
 import XMonad.Layout.Maximize
 
 -- $usage

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/Magnifier.hs

@@ -83,63 +83,65 @@ import XMonad.Util.XUtils
 
 -- | Increase the size of the window that has focus
 magnifier :: l a -> ModifiedLayout Magnifier l a
-magnifier = ModifiedLayout (Mag (1.5,1.5) On All)
+magnifier = ModifiedLayout (Mag 1 (1.5,1.5) On All)
 
 -- | Change the size of the window that has focus by a custom zoom
 magnifiercz :: Rational -> l a -> ModifiedLayout Magnifier l a
-magnifiercz cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On All)
+magnifiercz cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On All)
 
--- | Increase the size of the window that has focus, unless if it is the
--- master window.
+-- | Increase the size of the window that has focus, unless if it is one of the
+-- master windows.
 magnifier' :: l a -> ModifiedLayout Magnifier l a
-magnifier' = ModifiedLayout (Mag (1.5,1.5) On NoMaster)
+magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster)
 
 -- | Magnifier that defaults to Off
 magnifierOff :: l a -> ModifiedLayout Magnifier l a
-magnifierOff = ModifiedLayout (Mag (1.5,1.5) Off All)
+magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All)
 
 -- | Increase the size of the window that has focus by a custom zoom,
--- unless if it is the master window.
+-- unless if it is one of the the master windows.
 magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a
-magnifiercz' cz = ModifiedLayout (Mag (fromRational cz, fromRational cz) On NoMaster)
+magnifiercz' cz = ModifiedLayout (Mag 1 (fromRational cz, fromRational cz) On NoMaster)
 
 -- | A magnifier that greatly magnifies just the vertical direction
 maximizeVertical :: l a -> ModifiedLayout Magnifier l a
-maximizeVertical = ModifiedLayout (Mag (1,1000) Off All)
+maximizeVertical = ModifiedLayout (Mag 1 (1,1000) Off All)
 
 data MagnifyMsg = MagnifyMore | MagnifyLess | ToggleOn | ToggleOff | Toggle deriving ( Typeable )
 instance Message MagnifyMsg
 
-data Magnifier a = Mag (Double,Double) Toggle MagnifyMaster deriving (Read, Show)
+data Magnifier a = Mag !Int (Double,Double) Toggle MagnifyMaster deriving (Read, Show)
 
 data Toggle        = On  | Off      deriving  (Read, Show)
 data MagnifyMaster = All | NoMaster deriving  (Read, Show)
 
 instance LayoutModifier Magnifier Window where
-    redoLayout  (Mag z On All     ) r (Just s) wrs = applyMagnifier z r s wrs
-    redoLayout  (Mag z On NoMaster) r (Just s) wrs = unlessMaster (applyMagnifier z) r s wrs
+    redoLayout  (Mag _ z On All     ) r (Just s) wrs = applyMagnifier z r s wrs
+    redoLayout  (Mag n z On NoMaster) r (Just s) wrs = unlessMaster n (applyMagnifier z) r s wrs
     redoLayout  _                   _ _        wrs = return (wrs, Nothing)
 
-    handleMess (Mag z On  t) m
-                    | Just MagnifyMore <- fromMessage m = return . Just $ (Mag (z `addto`   0.1 ) On  t)
-                    | Just MagnifyLess <- fromMessage m = return . Just $ (Mag (z `addto` (-0.1)) On  t)
-                    | Just ToggleOff   <- fromMessage m = return . Just $ (Mag (z      ) Off t)
-                    | Just Toggle      <- fromMessage m = return . Just $ (Mag (z      ) Off t)
+    handleMess (Mag n z On  t) m
+                    | Just MagnifyMore    <- fromMessage m = return . Just $ Mag n             (z `addto`   0.1 ) On  t
+                    | Just MagnifyLess    <- fromMessage m = return . Just $ Mag n             (z `addto` (-0.1)) On  t
+                    | Just ToggleOff      <- fromMessage m = return . Just $ Mag n             z                  Off t
+                    | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  Off t
+                    | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  On  t
                     where addto (x,y) i = (x+i,y+i)
-    handleMess (Mag z Off t) m
-                    | Just ToggleOn    <- fromMessage m = return . Just $ (Mag z         On  t)
-                    | Just Toggle      <- fromMessage m = return . Just $ (Mag z         On  t)
+    handleMess (Mag n z Off t) m
+                    | Just ToggleOn       <- fromMessage m = return . Just $ Mag n             z                  On  t
+                    | Just Toggle         <- fromMessage m = return . Just $ Mag n             z                  On  t
+                    | Just (IncMasterN d) <- fromMessage m = return . Just $ Mag (max 0 (n+d)) z                  Off t
     handleMess _ _ = return Nothing
 
-    modifierDescription (Mag _ On  All     ) = "Magnifier"
-    modifierDescription (Mag _ On  NoMaster) = "Magnifier NoMaster"
-    modifierDescription (Mag _ Off _       ) = "Magnifier (off)"
+    modifierDescription (Mag _ _ On  All     ) = "Magnifier"
+    modifierDescription (Mag _ _ On  NoMaster) = "Magnifier NoMaster"
+    modifierDescription (Mag _ _ Off _       ) = "Magnifier (off)"
 
 type NewLayout a = Rectangle -> Stack a -> [(Window, Rectangle)] -> X ([(Window, Rectangle)], Maybe (Magnifier a))
 
-unlessMaster :: NewLayout a -> NewLayout a
-unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
-                                              else mainmod r s wrs
+unlessMaster :: Int -> NewLayout a -> NewLayout a
+unlessMaster n mainmod r s wrs = if null (drop (n-1) (up s)) then return (wrs, Nothing)
+                                                             else mainmod r s wrs
 
 applyMagnifier :: (Double,Double) -> Rectangle -> t -> [(Window, Rectangle)]
                -> X ([(Window, Rectangle)], Maybe a)

XMonad/Layout/Minimize.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE MultiParamTypeClasses, DeriveDataTypeable, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}
+{-# LANGUAGE MultiParamTypeClasses, TypeSynonymInstances, FlexibleContexts, PatternGuards #-}
 ----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.Minimize
@@ -18,20 +18,14 @@ module XMonad.Layout.Minimize (
         -- * Usage
         -- $usage
         minimize,
-        minimizeWindow,
-        MinimizeMsg(RestoreMinimizedWin,RestoreNextMinimizedWin),
-        Minimize,
     ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
+import XMonad.Util.Minimize (Minimized(..))
 import XMonad.Layout.LayoutModifier
 import XMonad.Layout.BoringWindows as BW
-import XMonad.Util.WindowProperties (getProp32)
-import Data.List
-import qualified Data.Map as M
-import Data.Maybe
-import Foreign.C.Types (CLong)
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -47,97 +41,33 @@ import Foreign.C.Types (CLong)
 --
 -- "XMonad.Doc.Extending#Editing_the_layout_hook"
 --
--- In the key-bindings, do something like:
---
--- >        , ((modm,               xK_m     ), withFocused minimizeWindow)
--- >        , ((modm .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
---
--- The first action will minimize the focused window, while the second one will restore
--- the next minimized window.
---
--- For detailed instruction on editing the key binding see:
---
--- "XMonad.Doc.Extending#Editing_key_bindings".
---
 -- The module is designed to work together with "XMonad.Layout.BoringWindows" so
 -- that minimized windows will be skipped over when switching the focused window with
 -- the keyboard. Include 'BW.boringWindows' in your layout hook and see the
 -- documentation of "XMonad.Layout.BoringWindows" on how to modify your keybindings.
 --
+-- See "XMonad.Actions.Minimize" for possible actions for minimizing/restoring windows
+--
 -- Also see "XMonad.Hooks.Minimize" if you want to be able to minimize
 -- and restore windows from your taskbar.
 
-data Minimize a = Minimize [Window] (M.Map Window W.RationalRect) deriving ( Read, Show )
-minimize :: LayoutClass l Window => l Window -> ModifiedLayout Minimize l Window
-minimize = ModifiedLayout $ Minimize [] M.empty
+data Minimize a = Minimize deriving ( Read, Show )
+minimize :: l Window -> ModifiedLayout Minimize l Window
+minimize = ModifiedLayout Minimize
 
-data MinimizeMsg = MinimizeWin Window
-                    | RestoreMinimizedWin Window
-                    | RestoreNextMinimizedWin
-                    deriving (Typeable, Eq)
-instance Message MinimizeMsg
-
-minimizeWindow :: Window -> X ()
-minimizeWindow w = sendMessage (MinimizeWin w) >> BW.focusDown
-
-setMinimizedState :: Window -> Int -> (CLong -> [CLong] -> [CLong]) -> X ()
-setMinimizedState win st f = do
-    setWMState win st
-    withDisplay $ \dpy -> do
-        wm_state <- getAtom "_NET_WM_STATE"
-        mini <- getAtom "_NET_WM_STATE_HIDDEN"
-        wstate <- fromMaybe [] `fmap` getProp32 wm_state win
-        let ptype = 4 -- The atom property type for changeProperty
-            fi_mini = fromIntegral mini
-        io $ changeProperty32 dpy win wm_state ptype propModeReplace (f fi_mini wstate)
-
-setMinimized :: Window -> X ()
-setMinimized win = setMinimizedState win iconicState (:)
-
-setNotMinimized :: Window -> X ()
-setNotMinimized win = setMinimizedState win normalState delete
 
 instance LayoutModifier Minimize Window where
     modifierDescription _ = "Minimize"
 
-    modifyLayout (Minimize minimized _) wksp rect = do
+    modifyLayout Minimize wksp rect = do
+        minimized <- XS.gets minimizedStack
         let stack = W.stack wksp
-            filtStack = stack >>=W.filter (\w -> not (w `elem` minimized))
+            filtStack = stack >>= W.filter (`notElem` minimized)
         runLayout (wksp {W.stack = filtStack}) rect
 
-    handleMess (Minimize minimized unfloated) m
-        | Just (MinimizeWin w) <- fromMessage m, not (w `elem` minimized) = do
-                setMinimized w
-                ws <- gets windowset
-                case M.lookup w (W.floating ws) of
-                  Nothing -> return $ Just $ Minimize (w:minimized) unfloated
-                  Just r -> do
-                    modify (\s -> s { windowset = W.sink w ws})
-                    return $ Just $ Minimize (w:minimized) (M.insert w r unfloated)
-        | Just (RestoreMinimizedWin w) <- fromMessage m = do
-            setNotMinimized w
-            case M.lookup w unfloated of
-              Nothing -> return $ Just $ Minimize (minimized \\ [w]) unfloated
-              Just r -> do
-                ws <- gets windowset
-                modify (\s -> s { windowset = W.float w r ws})
-                return $ Just $ Minimize (minimized \\ [w]) (M.delete w unfloated)
-        | Just RestoreNextMinimizedWin <- fromMessage m = do
-          ws <- gets windowset
-          if not (null minimized)
-            then case M.lookup (head minimized) unfloated of
-              Nothing -> do
-                let w = head minimized
-                setNotMinimized w
-                modify (\s -> s { windowset = W.focusWindow w ws})
-                return $ Just $ Minimize (tail minimized) unfloated
-              Just r -> do
-                let w = head minimized
-                setNotMinimized w
-                modify (\s -> s { windowset = (W.focusWindow w . W.float w r) ws})
-                return $ Just $ Minimize (tail minimized) (M.delete w unfloated)
-            else return Nothing
+    handleMess Minimize m
         | Just BW.UpdateBoring <- fromMessage m = do
+            minimized <- XS.gets minimizedStack
             ws <- gets (W.workspace . W.current . windowset)
             flip sendMessageWithNoRefresh ws $ BW.Replace "Minimize" minimized
             return Nothing

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
+              wlen = length $ W.integrate s
               -- 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 PatternGuards #-}
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses #-}
+{-# 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 (
-                                -- * Usage
-                                -- $usage
-                                noBorders,
-                                smartBorders,
-                                withBorder,
-                                lessBorders,
-                                SetsAmbiguous(..),
-                                Ambiguity(..),
-                                With(..),
-                                SmartBorder, WithBorder, ConfigurableBorder,
+module XMonad.Layout.NoBorders ( -- * Usage
+                                 -- $usage
+                                 noBorders
+                               , smartBorders
+                               , withBorder
+                               , lessBorders
+                               , hasBorder
+                               , SetsAmbiguous(..)
+                               , Ambiguity(..)
+                               , With(..)
+                               , BorderMessage (..), borderEventHook
+                               , SmartBorder, WithBorder, ConfigurableBorder
                                ) where
 
-import XMonad
-import XMonad.Layout.LayoutModifier
-import qualified XMonad.StackSet as W
-import Data.List
-import qualified Data.Map as M
-import Data.Function (on)
+import           XMonad
+import           XMonad.Layout.LayoutModifier
+import qualified XMonad.StackSet                as W
+import qualified XMonad.Util.Rectangle          as R
+
+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
-        ws <- withWindowSet (\wset -> return (hiddens p wset mst wrs))
-        asks (borderWidth . config) >>= setBorders (s \\ ws)
-        setBorders ws 0
-        return (wrs, Just $ ConfigurableBorder p ws)
+    redoLayout cb@(ConfigurableBorder gh ah nh ch) lr mst wrs = do
+        let gh' wset = let lh = (hiddens gh wset lr mst wrs)
+                       in  return $ (ah `union` lh) \\ nh
+        ch' <- withWindowSet gh'
+        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
--- >     where otherHiddens p = hiddens p wset mst wrs
+-- >  hiddens _ wset lr mst wrs = otherHiddens Screen \\ otherHiddens OnlyScreenFloat
+-- >     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
-            nonzerorect (Rectangle _ _ 0 0) = False
-            nonzerorect _ = True
+      where next p = hiddens p wset lr mst wrs
+
+            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
-                             -- ^ This constructor is used to combine the
-                             -- borderless windows provided by the
-                             -- SetsAmbiguous instances from two other
-                             -- 'Ambiguity' data types.
-               | OnlyFloat   -- ^ Only remove borders on floating windows that
-                             -- cover the whole screen
-               | Never       -- ^ Never remove borders when ambiguous:
-                             -- this is the same as smartBorders
-               | EmptyScreen -- ^ Focus in an empty screens 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.
+data Ambiguity
+    = Combine With Ambiguity Ambiguity
+        -- ^ This constructor is used to combine the borderless windows
+        -- provided by the SetsAmbiguous instances from two other 'Ambiguity'
+        -- data types.
+    | OnlyScreenFloat
+        -- ^ Only remove borders on floating windows that cover the whole
+        -- screen.
+    | OnlyLayoutFloatBelow
+        -- ^ Like 'OnlyLayoutFloat', but only removes borders if no window
+        -- stacked below remains visible. Considers all floating windows on the
+        -- current screen and all visible tiled windows of the child layout. If
+        -- any such window (that is stacked below) shows in any gap between the
+        -- parent layout rectangle and the physical screen, the border will
+        -- remain drawn.
+    | OnlyLayoutFloat
+        -- ^ 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,129 +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 (
-                               -- * Usage
-                               -- $usage
+module XMonad.Layout.Spacing
+    ( -- * 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,
-                               spacingWithEdge, SpacingWithEdge,
-                               smartSpacing, SmartSpacing,
-                               smartSpacingWithEdge, SmartSpacingWithEdge,
-                               ModifySpacing(..), setSpacing, incSpacing
-                             ) where
+import           XMonad
+import           XMonad.StackSet                    as W
+import qualified XMonad.Util.Rectangle              as R
+import           XMonad.Layout.LayoutModifier
+import           XMonad.Actions.MessageFeedback
 
-import Graphics.X11 (Rectangle(..))
-import Control.Arrow (second)
-import XMonad.Operations (sendMessage)
-import XMonad.Core (X,runLayout,Message,fromMessage,Typeable)
-import XMonad.StackSet (up, down, Workspace(..))
-import XMonad.Util.Font (fi)
-
-import XMonad.Layout.LayoutModifier
 
 -- $usage
--- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@ file:
+-- You can use this module by importing it into your @~\/.xmonad\/xmonad.hs@
+-- file:
 --
 -- > import XMonad.Layout.Spacing
 --
 -- and modifying your layoutHook as follows (for example):
 --
--- > layoutHook = spacing 2 $ Tall 1 (3/100) (1/2)
--- >                      -- put a 2px space around every window
---
+-- > layoutHook = spacingRaw True (Border 0 10 10 10) True (Border 10 10 10 10) True $
+-- >              layoutHook def
 
--- | Surround all windows by a certain number of pixels of blank space.
-spacing :: Int -> l a -> ModifiedLayout Spacing l a
-spacing p = ModifiedLayout (Spacing p)
+-- | Represent the borders of a rectangle.
+data Border = Border
+    { top       :: Integer
+    , bottom    :: Integer
+    , right     :: Integer
+    , left      :: Integer
+    } deriving (Show,Read)
 
-data Spacing a = Spacing Int deriving (Show, Read)
+-- | A 'LayoutModifier' providing customizable screen and window borders.
+-- Borders are clamped to @[0,Infinity]@ before being applied.
+data Spacing a = Spacing
+    { smartBorder           :: Bool
+        -- ^ When @True@ borders are not applied if
+        --   there fewer than two windows.
+    , screenBorder          :: Border
+        -- ^ The screen border.
+    , screenBorderEnabled   :: Bool
+        -- ^ Is the screen border enabled?
+    , windowBorder          :: Border
+        -- ^ The window borders.
+    , windowBorderEnabled   :: Bool
+        -- ^ Is the window border enabled?
+    } deriving (Show,Read)
 
--- | 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
-setSpacing :: Int -> X ()
-setSpacing n = sendMessage $ ModifySpacing $ const n
-
--- | Increase spacing by given amount
-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. See
+-- 'spacingRaw'.
+spacing :: Int -> l a -> ModifiedLayout Spacing l a
+spacing i = spacingRaw False (uniformBorder 0) False (uniformBorder i') True
+    where i' = fromIntegral i
 
 -- | Surround all windows by a certain number of pixels of blank space, and
 -- additionally adds the same amount of spacing around the edge of the screen.
-spacingWithEdge :: Int -> l a -> ModifiedLayout SpacingWithEdge l a
-spacingWithEdge p = ModifiedLayout (SpacingWithEdge p)
-
-data SpacingWithEdge a = SpacingWithEdge Int deriving (Show, Read)
-
-instance LayoutModifier SpacingWithEdge a where
-
-    pureModifier (SpacingWithEdge p) _ _ wrs = (map (second $ shrinkRect p) wrs, Nothing)
-
-    pureMess (SpacingWithEdge px) m
-     | Just (ModifySpacing f) <- fromMessage m = Just $ SpacingWithEdge $ max 0 $ f px
-     | otherwise = Nothing
-
-    modifyLayout (SpacingWithEdge p) w r = runLayout w (shrinkRect p r)
-
-    modifierDescription (SpacingWithEdge p) = "SpacingWithEdge " ++ show p
-
-shrinkRect :: Int -> Rectangle -> Rectangle
-shrinkRect p (Rectangle x y w h) = Rectangle (x+fi p) (y+fi p) (fi $ max 1 $ fi w-2*p) (fi $ max 1 $ fi h-2*p)
+-- See 'spacingRaw'.
+spacingWithEdge :: Int -> l a -> ModifiedLayout Spacing l a
+spacingWithEdge i = spacingRaw False (uniformBorder i') True (uniformBorder i') True
+    where i' = fromIntegral i
 
 -- | Surrounds all windows with blank space, except when the window is the only
--- visible window on the current workspace.
-smartSpacing :: Int -> l a -> ModifiedLayout SmartSpacing l a
-smartSpacing p = ModifiedLayout (SmartSpacing p)
+-- visible window on the current workspace. See 'spacingRaw'.
+smartSpacing :: Int -> l a -> ModifiedLayout Spacing l a
+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)
-    pureModifier (SmartSpacing p) _ _ wrs = (map (second $ shrinkRect p) wrs, 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)
-
-    modifierDescription (SmartSpacingWithEdge p) = "SmartSpacingWithEdge " ++ show p
+-- | See 'incScreenWindowSpacing'.
+incSpacing :: Int -> X ()
+incSpacing = incScreenWindowSpacing . fromIntegral

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/ThreeColumns.hs

@@ -97,8 +97,8 @@ split3HorizontallyBy :: Bool -> Rational -> Rectangle -> (Rectangle, Rectangle,
 split3HorizontallyBy middle f (Rectangle sx sy sw sh) =
     if middle
     then ( Rectangle (sx + fromIntegral r3w) sy r1w sh
-         , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh
-         , Rectangle sx sy r3w sh )
+         , Rectangle sx sy r3w sh
+         , Rectangle (sx + fromIntegral r3w + fromIntegral r1w) sy r2w sh )
     else ( Rectangle sx sy r1w sh
          , Rectangle (sx + fromIntegral r1w) sy r2w sh
          , Rectangle (sx + fromIntegral r1w + fromIntegral r2w) sy r3w sh )

XMonad/Layout/WindowNavigation.hs

@@ -195,7 +195,9 @@ navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangl
 navigable d pt = sortby d . filter (inr d pt . snd)
 
 sc :: Pixel -> Window -> X ()
-sc c win = withDisplay $ \dpy -> io $ setWindowBorder dpy win c
+sc c win = withDisplay $ \dpy -> do
+    colorName <- io (pixelToString dpy c)
+    setWindowBorderWithFallback dpy win colorName c
 
 center :: Rectangle -> Point
 center (Rectangle x y w h) = P (fromIntegral x + fromIntegral w/2)  (fromIntegral y + fromIntegral h/2)

XMonad/Prompt.hs

@@ -35,7 +35,7 @@ module XMonad.Prompt
     , emacsLikeXPKeymap, emacsLikeXPKeymap'
     , quit
     , killBefore, killAfter, startOfLine, endOfLine
-    , pasteString, moveCursor
+    , insertString, pasteString, moveCursor
     , setInput, getInput
     , moveWord, moveWord', killWord, killWord', deleteString
     , moveHistory, setSuccess, setDone
@@ -91,7 +91,6 @@ import           Data.List
 import qualified Data.Map                     as M
 import           Data.Maybe                   (fromMaybe)
 import           Data.Set                     (fromList, toList)
-import           System.Directory             (getAppUserDataDirectory)
 import           System.IO
 import           System.Posix.Files
 
@@ -127,7 +126,10 @@ data XPState =
         }
 
 data XPConfig =
-    XPC { font              :: String     -- ^ Font; use the prefix @"xft:"@ for TrueType fonts
+    XPC { font              :: String     -- ^ Font. For TrueType fonts, use something like
+                                          -- @"xft:Hack:pixelsize=1"@. Alternatively, use X Logical Font
+                                          -- Description, i.e. something like
+                                          -- @"-*-dejavu sans mono-medium-r-normal--*-80-*-*-*-*-iso10646-1"@.
         , bgColor           :: String     -- ^ Background color
         , fgColor           :: String     -- ^ Font color
         , fgHLight          :: String     -- ^ Font color of a highlighted completion entry
@@ -521,24 +523,59 @@ completionHandle c ks@(sym,_) (KeyEvent { ev_event_type = t, ev_state = m }) = d
   alwaysHlight <- gets $ alwaysHighlight . config
   mCleaned <- cleanMask m
   case () of
-    () | t == keyPress && (mCleaned,sym) == complKey ->
-          do
-            st <- get
-            let updateState l = case alwaysHlight of
-                  -- modify the buffer's value
-                  False -> let newCommand = nextCompletion (currentXPMode st) (command st) l
-                           in modify $ \s -> setCommand newCommand $ s { offset = length newCommand, highlightedCompl = Just newCommand}
-                  --TODO: Scroll or paginate results
-                  True -> let complIndex' = nextComplIndex st (length l)
-                              highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
-                          in modify $ \s -> setHighlightedCompl highlightedCompl' $ s { complIndex = complIndex' }
-                updateWins l = redrawWindows l >> eventLoop (completionHandle l)
-            case c of
-              []  -> updateWindows   >> eventLoop handle
-              [x] -> updateState [x] >> getCompletions >>= updateWins
-              l   -> updateState l   >> updateWins l
+    () | t == keyPress && (mCleaned,sym) == complKey -> do
+           st <- get
+
+           let updateWins  l = redrawWindows l >> eventLoop (completionHandle l)
+               updateState l = case alwaysHlight of
+                 False                                           -> simpleComplete l st
+                 True | Just (command st) /= highlightedCompl st -> alwaysHighlightCurrent st
+                      | otherwise                                -> alwaysHighlightNext l st
+
+           case c of
+             []  -> updateWindows   >> eventLoop handle
+             [x] -> updateState [x] >> getCompletions >>= updateWins
+             l   -> updateState l   >> updateWins l
       | t == keyRelease && (mCleaned,sym) == complKey -> eventLoop (completionHandle c)
       | otherwise -> keyPressHandle mCleaned ks -- some other key, handle it normally
+  where
+    -- When alwaysHighlight is off, just complete based on what the
+    -- user has typed so far.
+    simpleComplete :: [String] -> XPState -> XP ()
+    simpleComplete l st = do
+      let newCommand = nextCompletion (currentXPMode st) (command st) l
+      modify $ \s -> setCommand newCommand $
+                     s { offset = length newCommand
+                       , highlightedCompl = Just newCommand
+                       }
+
+    -- If alwaysHighlight is on, and this is the first use of the
+    -- completion key, update the buffer so that it contains the
+    -- current completion item.
+    alwaysHighlightCurrent :: XPState -> XP ()
+    alwaysHighlightCurrent st = do
+      let newCommand = fromMaybe (command st) $ highlightedItem st c
+      modify $ \s -> setCommand newCommand $
+                     setHighlightedCompl (Just newCommand) $
+                     s { offset = length newCommand
+                       }
+
+    -- If alwaysHighlight is on, and the user wants the next
+    -- completion, move to the next completion item and update the
+    -- buffer to reflect that.
+    --
+    --TODO: Scroll or paginate results
+    alwaysHighlightNext :: [String] -> XPState -> XP ()
+    alwaysHighlightNext l st = do
+      let complIndex' = nextComplIndex st (length l)
+          highlightedCompl' = highlightedItem st { complIndex = complIndex'} c
+          newCommand = fromMaybe (command st) $ highlightedCompl'
+      modify $ \s -> setHighlightedCompl highlightedCompl' $
+                     setCommand newCommand $
+                     s { complIndex = complIndex'
+                       , offset = length newCommand
+                       }
+
 -- some other event: go back to main loop
 completionHandle _ k e = handle k e
 
@@ -1064,7 +1101,7 @@ emptyHistory :: History
 emptyHistory = M.empty
 
 getHistoryFile :: IO FilePath
-getHistoryFile = fmap (++ "/history") $ getAppUserDataDirectory "xmonad"
+getHistoryFile = fmap (++ "/prompt-history") getXMonadCacheDir
 
 readHistory :: IO History
 readHistory = readHist `E.catch` \(SomeException _) -> return emptyHistory
@@ -1170,7 +1207,7 @@ breakAtSpace s
 
 -- | 'historyCompletion' provides a canned completion function much like
 --   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
---   from the query history stored in ~\/.xmonad\/history.
+--   from the query history stored in the XMonad cache directory.
 historyCompletion :: ComplFunction
 historyCompletion = historyCompletionP (const True)
 
@@ -1178,7 +1215,7 @@ historyCompletion = historyCompletionP (const True)
 -- name satisfies the given predicate.
 historyCompletionP :: (String -> Bool) -> ComplFunction
 historyCompletionP p x = fmap (toComplList . M.filterWithKey (const . p)) readHistory
-    where toComplList = deleteConsecutive . filter (isInfixOf x) . M.fold (++) []
+    where toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
 
 -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
 --   laziness and stability for efficiency.

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 fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn
+doAppend :: (String -> String) -> FilePath -> String -> X ()
+doAppend trans fn = io . bracket (openFile fn AppendMode) hClose . flip hPutStrLn . trans

XMonad/Prompt/Directory.hs

@@ -16,7 +16,8 @@ module XMonad.Prompt.Directory (
                              -- * Usage
                              -- $usage
                              directoryPrompt,
-                             Dir,
+                             directoryMultipleModes,
+                             Dir
                               ) where
 
 import XMonad
@@ -26,13 +27,23 @@ import XMonad.Util.Run ( runProcessWithInput )
 -- $usage
 -- For an example usage see "XMonad.Layout.WorkspaceDir"
 
-data Dir = Dir String
+data Dir = Dir String (String -> X ())
 
 instance XPrompt Dir where
-    showXPrompt (Dir x) = x
+    showXPrompt (Dir x _) = x
+    completionFunction _ = getDirCompl
+    modeAction (Dir _ f) buf auto =
+      let dir = if null auto then buf else auto
+      in f dir
 
 directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
-directoryPrompt c prom = mkXPrompt (Dir prom) c getDirCompl
+directoryPrompt c prom f = mkXPrompt (Dir prom f) c getDirCompl f
+
+-- | A @XPType@ entry suitable for using with @mkXPromptWithModes@.
+directoryMultipleModes :: String            -- ^ Prompt.
+                       -> (String -> X ())  -- ^ Action.
+                       -> XPType
+directoryMultipleModes p f = XPT (Dir p f)
 
 getDirCompl :: String -> IO [String]
 getDirCompl s = (filter notboring . lines) `fmap`

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 windowPromptGoto:
+--
+-- > import XMonad.Prompt
+-- > import XMonad.Prompt.Window ( windowPromptGoto )
+-- > import XMonad.Prompt.FuzzyMatch
+-- >
+-- > myXPConfig = def { searchPredicate = fuzzyMatch
+--                    , sorter          = fuzzySort
+--                    }
+-- 
+-- then add this to your keys definition:
+--
+-- > , ((modm .|. shiftMask, xK_g), windowPromptGoto myXPConfig)
+--
+-- 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,9 +8,10 @@
 -- Stability   :  unstable
 -- Portability :  unportable
 --
--- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read, remove):
+-- This module provides 4 <XMonad.Prompt> to ease password manipulation (generate, read, 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.
 --
@@ -18,28 +19,26 @@
 --
 -- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.
 --
--- The password store is setuped through an environment variable PASSWORD_STORE_DIR.
--- If this is set, use the content of the variable.
--- 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.
 --
 -- Source:
 --
--- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.
+-- - The password store implementation is <http://git.zx2c4.com/password-store the password-store cli>.
 --
--- - 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
-                            -- $usages
+                            -- * Usage
+                            -- $usage
                               passPrompt
                             , passGeneratePrompt
                             , passRemovePrompt
+                            , passTypePrompt
                             ) where
 
-import Control.Monad (liftM)
 import XMonad.Core
 import XMonad.Prompt ( XPrompt
                      , showXPrompt
@@ -54,32 +53,32 @@ 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':
 --
--- >   , ((modMask x , xK_p)                              , passPrompt xpconfig)
--- >   , ((modMask x .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)
--- >   , ((modMask x .|. controlMask  .|. shiftMask, xK_p), passRemovePrompt xpconfig)
+-- >   , ((modMask , xK_p)                              , passPrompt xpconfig)
+-- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt 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 +97,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 +125,41 @@ 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
+
 -- | 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
+-- | 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 +167,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
-@unicode-data@ on Debian) and the @xsel@ tool.
+The provided @unicodePrompt@ and @typeUnicodePrompt@ use @xsel@ and @xdotool@
+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
-unicodeDataFilename =  "/usr/share/unicode/UnicodeData.txt"
-
-entries :: [(Char, BS.ByteString)]
-entries = unsafePerformIO $ do
-    datE <- tryIOError $ BS.readFile unicodeDataFilename
-    case datE of
-        Left e -> do
-            hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
-            hPutStrLn stderr $ show e
-            hPutStrLn stderr $ "Do you have unicode-data installed?"
-            return []
-        Right dat -> return $ sortBy (comparing (BS.length . snd)) $ parseUnicodeData dat
-{-# NOINLINE entries #-}
+populateEntries :: String -> X Bool
+populateEntries unicodeDataFilename = do
+  entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
+  if null entries
+    then do
+      datE <- liftIO . tryIOError $ BS.readFile unicodeDataFilename
+      case datE of
+        Left e -> liftIO $ do
+          hPutStrLn stderr $ "Could not read file \"" ++ unicodeDataFilename ++ "\""
+          hPrint stderr e
+          hPutStrLn stderr "Do you have unicode-data installed?"
+          return False
+        Right dat -> do
+          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
-    parseLine l = do
-        field1 : field2 : _ <- return $ BS.split ';' l
-        [(c,"")] <- return $ readHex (BS.unpack field1)
-        return (chr c, field2)
+  where parseLine l = do
+          field1 : field2 : _ <- return $ BS.split ';' l
+          [(c,"")] <- return . readHex $ BS.unpack field1
+          return (chr c, field2)
 
-searchUnicode :: String -> [(Char, String)]
-searchUnicode s = map (second BS.unpack) $ filter go entries
-  where w = map BS.pack $  filter (all isAscii) $ filter ((> 1) . length) $ words $ map toUpper s
+searchUnicode :: [(Char, BS.ByteString)] -> String -> [(Char, String)]
+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
         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.
-unicodePrompt :: XPConfig -> X ()
-unicodePrompt config = mkXPrompt Unicode config unicodeCompl paste
+mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()
+mkUnicodePrompt prog args unicodeDataFilename config =
+  whenX (populateEntries unicodeDataFilename) $ do
+    entries <- fmap getUnicodeData (XS.get :: X UnicodeData)
+    mkXPrompt Unicode config (unicodeCompl entries) paste
   where
-    unicodeCompl [] = return []
-    unicodeCompl s = do
-        return $ map (\(c,d) -> printf "%s %s" [c] d) $ take 20 $ searchUnicode s
-
+    unicodeCompl _ [] = return []
+    unicodeCompl entries s = do
+      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]
-        return ()
+      runProcessWithInput prog args [c]
+      return ()
 
-data Unicode = Unicode
-instance XPrompt Unicode where
-    showXPrompt Unicode = "Unicode: "
-    commandToComplete Unicode s = s
-    nextCompletion Unicode = getNextCompletion
+-- | Prompt the user for a Unicode character to be inserted into the paste buffer of the X server.
+unicodePrompt :: String -> XPConfig -> X ()
+unicodePrompt = mkUnicodePrompt "xsel" ["-i"]
 
+-- | Prompt the user for a Unicode character to be typed by @xdotool@.
+typeUnicodePrompt :: String -> XPConfig -> X ()
+typeUnicodePrompt = mkUnicodePrompt "xdotool" ["type", "--clearmodifiers", "--file", "-"]

XMonad/Prompt/Window.hs

@@ -20,6 +20,7 @@ module XMonad.Prompt.Window
     -- $usage
     WindowPrompt(..),
     windowPrompt,
+    windowMultiPrompt,
     allWindows,
     wsWindows,
     XWindowMap,
@@ -30,6 +31,7 @@ module XMonad.Prompt.Window
     windowPromptBringCopy,
     ) where
 
+import Control.Monad (forM)
 import qualified Data.Map as M
 
 import qualified XMonad.StackSet as W
@@ -79,7 +81,36 @@ instance XPrompt WindowPrompt where
     commandToComplete _ c = c
     nextCompletion      _ = getNextCompletion
 
+-- | Internal type used for the multiple mode prompt.
+data WindowModePrompt =
+  WindowModePrompt WindowPrompt (M.Map String Window) (String -> String -> Bool)
+
+instance XPrompt WindowModePrompt where
+    showXPrompt (WindowModePrompt action _ _) =
+        showXPrompt action
+
+    completionFunction (WindowModePrompt _ winmap predicate) =
+        \s -> return . filter (predicate s) . map fst . M.toList $ winmap
+
+    modeAction (WindowModePrompt action winmap _) buf auto = do
+        let name = if null auto then buf else auto
+            a = case action of
+                  Goto          -> gotoAction  winmap
+                  Bring         -> bringAction winmap
+                  BringCopy     -> bringCopyAction winmap
+                  BringToMaster -> bringToMaster winmap
+        a name
+      where
+        winAction a m    = flip whenJust (windows . a) . flip M.lookup m
+        gotoAction       = winAction W.focusWindow
+        bringAction      = winAction bringWindow
+        bringCopyAction  = winAction bringCopyWindow
+        bringToMaster    = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)
+
 -- | Deprecated. Use windowPrompt instead.
+{-# DEPRECATED windowPromptGoto      "Use windowPrompt instead." #-}
+{-# DEPRECATED windowPromptBring     "Use windowPrompt instead." #-}
+{-# DEPRECATED windowPromptBringCopy "Use windowPrompt instead." #-}
 windowPromptGoto, windowPromptBring, windowPromptBringCopy :: XPConfig -> X ()
 windowPromptGoto c = windowPrompt c Goto windowMap
 windowPromptBring c = windowPrompt c Bring windowMap
@@ -106,22 +137,31 @@ type XWindowMap = X (M.Map String Window)
 -- selected window, according to WindowPrompt.
 windowPrompt :: XPConfig -> WindowPrompt -> XWindowMap -> X ()
 windowPrompt c t winmap = do
-  a <- case t of
-         Goto  -> fmap gotoAction  winmap
-         Bring -> fmap bringAction winmap
-         BringCopy -> fmap bringCopyAction winmap
-         BringToMaster -> fmap bringToMaster winmap
   wm <- winmap
-  mkXPrompt t c (compList wm) a
+  let mode     = WindowModePrompt t wm (searchPredicate c)
+      action   = modeAction mode
+      compList = completionFunction mode
+  mkXPrompt t c compList (\s -> action s s)
 
-    where
-      winAction a m    = flip whenJust (windows . a) . flip M.lookup m
-      gotoAction       = winAction W.focusWindow
-      bringAction      = winAction bringWindow
-      bringCopyAction  = winAction bringCopyWindow
-      bringToMaster    = winAction (\w s -> W.shiftMaster . W.focusWindow w $ bringWindow w s)
+-- | Like 'windowPrompt', but uses the multiple modes feature of
+-- @Prompt@ (via 'mkXPromptWithModes').
+--
+-- Given a list of actions along with the windows they should work
+-- with, display the appropriate prompt with the ability to switch
+-- between them using the @changeModeKey@.
+--
+-- For example, to have a prompt that first shows you all windows, but
+-- allows you to narrow the list down to just the windows on the
+-- current workspace:
+--
+-- > windowMultiPrompt config [(Goto, allWindows), (Goto, wsWindows)]
+windowMultiPrompt :: XPConfig -> [(WindowPrompt, XWindowMap)] -> X ()
+windowMultiPrompt c modes = do
+  modes' <- forM modes $ \(t, wm) -> do
+    wm' <- wm
+    return . XPT $ WindowModePrompt t wm' (searchPredicate c)
 
-      compList m s = return . filter (searchPredicate c s) . map fst . M.toList $ m
+  mkXPromptWithModes modes' c
 
 -- | Brings a copy of the specified window into the current workspace.
 bringCopyWindow :: Window -> WindowSet -> WindowSet

XMonad/Util/CustomKeys.hs

@@ -4,11 +4,9 @@
 -- Copyright  : (c) 2007 Valery V. Vorotyntsev
 -- License    : BSD3-style (see LICENSE)
 --
--- Maintainer : Valery V. Vorotynsev <valery.vv@gmail.com>
---
 -- Customized key bindings.
 --
--- (See also "XMonad.Util.EZConfig" in xmonad-contrib.)
+-- See also "XMonad.Util.EZConfig" in xmonad-contrib.
 --------------------------------------------------------------------
 
 module XMonad.Util.CustomKeys (
@@ -25,38 +23,30 @@ import qualified Data.Map as M
 
 -- $usage
 --
--- 1. In @~\/.xmonad\/xmonad.hs@ add:
+-- In @~\/.xmonad\/xmonad.hs@ add:
 --
 -- > import XMonad.Util.CustomKeys
 --
--- 2. Set key bindings with 'customKeys':
+-- Set key bindings with 'customKeys':
 --
 -- > main = xmonad def { keys = customKeys delkeys inskeys }
 -- >     where
 -- >       delkeys :: XConfig l -> [(KeyMask, KeySym)]
 -- >       delkeys XConfig {modMask = modm} =
--- >           -- we're preferring Futurama to Xinerama here
--- >           [ (modm .|. m, k) | (m, k) <- zip [0, shiftMask] [xK_w, xK_e, xK_r] ]
+-- >           [ (modm .|. shiftMask, xK_Return) -- > terminal
+-- >           , (modm .|. shiftMask, xK_c)      -- > close the focused window
+-- >           ]
+-- >           ++
+-- >           [ (modm .|. m, k) | m <- [0, shiftMask], k <- [xK_w, xK_e, xK_r] ]
 -- >
 -- >       inskeys :: XConfig l -> [((KeyMask, KeySym), X ())]
 -- >       inskeys conf@(XConfig {modMask = modm}) =
--- >           [ ((mod1Mask,             xK_F2  ), spawn $ terminal conf)
+-- >           [ ((mod1Mask,             xK_F2  ), spawn $ terminal conf) -- mod1-f2 %! Run a terminal emulator
+-- >           , ((modm,                 xK_Delete), kill) -- %! Close the focused window
 -- >           , ((modm .|. controlMask, xK_F11 ), spawn "xscreensaver-command -lock")
 -- >           , ((mod1Mask,             xK_Down), spawn "amixer set Master 1-")
 -- >           , ((mod1Mask,             xK_Up  ), spawn "amixer set Master 1+")
 -- >           ]
---
--- 0 (/hidden feature/). You can always replace bindings map
---   entirely. No need to import "CustomKeys" this time:
---
--- > import XMonad
--- > import System.Exit
--- > import qualified Data.Map as M
--- >
--- > main = xmonad def {
--- >          keys = \_ -> M.fromList [
--- >                  -- Let me out of here! I want my KDE back! Help! Help!
--- >                  ( (0, xK_Escape), io (exitWith ExitSuccess) ) ] }
 
 -- | Customize 'XMonad.Config.def' -- delete needless
 -- shortcuts and insert those you will use.

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
-    runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
+    curscreen <-
+      (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 menuCmd args opts = fmap (filter (/='\n')) $ runProcessWithInput menuCmd args (unlines opts)
+menuArgs :: MonadIO m => String -> [String] -> [String] -> m String
+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/EZConfig.hs

@@ -427,7 +427,11 @@ parseKey = parseRegular +++ parseSpecial
 -- | Parse a regular key name (represented by itself).
 parseRegular :: ReadP KeySym
 parseRegular = choice [ char s >> return k
-                      | (s,k) <- zip ['!'..'~'] [xK_exclam..xK_asciitilde]
+                      | (s,k) <- zip ['!'             .. '~'          ] -- ASCII
+                                     [xK_exclam       .. xK_asciitilde]
+
+                              ++ zip ['\xa0'          .. '\xff'       ] -- Latin1
+                                     [xK_nobreakspace .. xK_ydiaeresis]
                       ]
 
 -- | Parse a special key name (one enclosed in angle brackets).

XMonad/Util/ExtensibleState.hs

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

XMonad/Util/Font.hs

@@ -29,6 +29,7 @@ module XMonad.Util.Font
     , textExtentsXMF
     , printStringXMF
     , stringToPixel
+    , pixelToString
     , fi
     ) where
 
@@ -37,6 +38,8 @@ import Foreign
 import Control.Applicative
 import Control.Exception as E
 import Data.Maybe
+import Data.Bits (shiftR)
+import Text.Printf (printf)
 
 #ifdef XFT
 import Data.List
@@ -61,6 +64,19 @@ stringToPixel d s = fromMaybe fallBack <$> io getIt
     where getIt    = initColor d s
           fallBack = blackPixel d (defaultScreen d)
 
+-- | Convert a @Pixel@ into a @String@.
+pixelToString :: (MonadIO m) => Display -> Pixel -> m String
+pixelToString d p = do
+    let cm = defaultColormap d (defaultScreen d)
+    (Color _ r g b _) <- io (queryColor d cm $ Color p 0 0 0 0)
+    return ("#" ++ hex r ++ hex g ++ hex b)
+  where
+    -- NOTE: The @Color@ type has 16-bit values for red, green, and
+    -- blue, even though the actual type in X is only 8 bits wide.  It
+    -- seems that the upper and lower 8-bit sections of the @Word16@
+    -- values are the same.  So, we just discard the lower 8 bits.
+    hex = printf "%02x" . (`shiftR` 8)
+
 econst :: a -> IOException -> a
 econst = const
 

XMonad/Util/Minimize.hs

@@ -0,0 +1,37 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Util.Minimize
+-- Copyright   :  (c) Bogdan Sinitsyn (2016)
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  bogdan.sinitsyn@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Stores some common utilities for modules used for window minimizing/maximizing
+--
+-----------------------------------------------------------------------------
+module XMonad.Util.Minimize
+  ( RectMap
+  , Minimized(..)
+  ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import qualified Data.Map as M
+
+type RectMap = M.Map Window (Maybe W.RationalRect)
+
+data Minimized = Minimized
+    { rectMap :: RectMap
+    , minimizedStack :: [Window]
+    }
+    deriving (Eq, Typeable, Read, Show)
+
+instance ExtensionClass Minimized where
+  initialValue = Minimized { rectMap = M.empty
+                           , minimizedStack = []
+                           }
+  extensionType = PersistentExtension

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
--- command is executed.  Subsequent invocations for a command do nothing.
-spawnOnce :: String -> X ()
-spawnOnce xs = do
-    b <- XS.gets (Set.member xs . unspawnOnce)
+doOnce :: (String -> X ()) -> String -> X ()
+doOnce f s = do
+    b <- XS.gets (Set.member s . unspawnOnce)
     when (not b) $ do
-        spawn xs
-        XS.modify (SpawnOnce . Set.insert xs . unspawnOnce)
+        f s
+        XS.modify (SpawnOnce . Set.insert s . unspawnOnce)
+
+
+-- | The first time 'spawnOnce' is executed on a particular command,
+-- that command is executed.  Subsequent invocations for a command do
+-- nothing.
+spawnOnce :: String -> X ()
+spawnOnce cmd = doOnce spawn cmd
+
+-- | Like spawnOnce but launches the application on the given workspace.
+spawnOnOnce :: WorkspaceId -> String -> X ()
+spawnOnOnce ws cmd = doOnce (spawnOn ws) cmd
+
+-- | Lanch the given application n times on the specified
+-- workspace. Subsequent attempts to spawn this application will be
+-- ignored.
+spawnNOnOnce :: Int -> WorkspaceId -> String -> X ()
+spawnNOnOnce n ws cmd = doOnce (\c -> sequence_ $ replicate n $ spawnOn ws c) cmd
+
+-- | Spawn the application once and apply the manage hook. Subsequent
+-- attempts to spawn this application will be ignored.
+spawnAndDoOnce :: ManageHook -> String -> X ()
+spawnAndDoOnce mh cmd = doOnce (spawnAndDo mh) cmd

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/WindowProperties.hs

@@ -21,10 +21,12 @@ module XMonad.Util.WindowProperties (
     -- $helpers
     getProp32, getProp32s)
 where
-import XMonad
-import qualified XMonad.StackSet as W
-import Foreign.C.Types (CLong)
+
 import Control.Monad
+import Foreign.C.Types (CLong)
+import XMonad
+import XMonad.Actions.TagWindows (hasTag)
+import qualified XMonad.StackSet as W
 
 -- $edsl
 -- Allows to specify window properties, such as title, classname or
@@ -43,6 +45,7 @@ data Property = Title String
               | Or  Property Property
               | Not Property
               | Const Bool
+              | Tagged String -- ^ Tagged via 'XMonad.Actions.TagWindows'
               deriving (Read, Show)
 infixr 9 `And`
 infixr 8 `Or`
@@ -78,6 +81,7 @@ propertyToQuery (And p1 p2) = propertyToQuery p1 <&&> propertyToQuery p2
 propertyToQuery (Or p1 p2) = propertyToQuery p1 <||> propertyToQuery p2
 propertyToQuery (Not p) = not `fmap` propertyToQuery p
 propertyToQuery (Const b) = return b
+propertyToQuery (Tagged s) = ask >>= \w -> liftX (hasTag s w)
 
 -- $helpers
 

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 = getXineramaWsCompare' True
-
-getXineramaWsCompare' :: Bool -> X WorkspaceCompare
-getXineramaWsCompare' phy = do
+getXineramaPhysicalWsCompare :: ScreenComparator -> X WorkspaceCompare
+getXineramaPhysicalWsCompare (ScreenComparator sc) = 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
-    cmpPosition False w a b = comparing (tagToSid $ onScreen w) a b
-    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
+    tagToScreen s x = fromJust $ find ((== x) . S.tag . S.workspace) s
+    compareUsingScreen w = sc `on` getScreenIdAndRectangle . tagToScreen (onScreen 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 uses physical locations for screens.
-getSortByXineramaPhysicalRule :: X WorkspaceSort
-getSortByXineramaPhysicalRule = mkWsSort getXineramaPhysicalWsCompare
-
+-- | Like 'getSortByXineramaRule', but allow you to use physical locations for screens.
+getSortByXineramaPhysicalRule :: ScreenComparator -> X WorkspaceSort
+getSortByXineramaPhysicalRule sc = mkWsSort $ getXineramaPhysicalWsCompare sc

XMonad/Util/XUtils.hs

@@ -28,6 +28,7 @@ module XMonad.Util.XUtils
     , paintAndWrite
     , paintTextAndIcons
     , stringToPixel
+    , pixelToString
     , fi
     ) where
 
@@ -208,4 +209,3 @@ mkWindow d s rw x y w h p o = do
            set_background_pixel  attributes p
            createWindow d rw x y w h 0 (defaultDepthOfScreen s)
                         inputOutput visual attrmask attributes
-

cabal.project

@@ -0,0 +1,3 @@
+packages: ./
+          ../xmonad/
+          ../x11/

stack.yaml

@@ -0,0 +1,9 @@
+resolver: lts-7.19
+
+packages:
+  - ./
+  - ../xmonad
+
+extra-deps:
+  - X11-1.8
+  - X11-xft-0.3.1

xmonad-contrib.cabal

@@ -1,5 +1,5 @@
 name:               xmonad-contrib
-version:            0.12
+version:            0.15
 homepage:           http://xmonad.org/
 synopsis:           Third party extensions for xmonad
 description:
@@ -31,14 +31,12 @@ extra-source-files: README.md CHANGES.md scripts/generate-configs scripts/run-xm
                     tests/SwapWorkspaces.hs
                     tests/XPrompt.hs
                     XMonad/Config/dmwit.xmobarrc
+                    XMonad/Config/Example.hs
 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.2
+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
@@ -56,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,
@@ -66,9 +64,10 @@ library
                    random,
                    mtl >= 1 && < 3,
                    unix,
-                   X11>=1.6.1 && < 1.7,
-                   xmonad>=0.12   && < 0.13,
-                   utf8-string
+                   X11>=1.6.1 && < 1.10,
+                   xmonad >= 0.15 && < 0.16,
+                   utf8-string,
+                   semigroups
 
     if flag(use_xft)
         build-depends: X11-xft >= 0.2
@@ -83,25 +82,22 @@ library
     if impl(ghc >= 6.12.1)
         ghc-options:    -fno-warn-unused-do-bind
 
-    exposed-modules:    XMonad.Doc
-                        XMonad.Doc.Configuring
-                        XMonad.Doc.Extending
-                        XMonad.Doc.Developing
-                        XMonad.Actions.AfterDrag
+    exposed-modules:    XMonad.Actions.AfterDrag
                         XMonad.Actions.BluetileCommands
                         XMonad.Actions.Commands
                         XMonad.Actions.ConstrainedResize
                         XMonad.Actions.CopyWindow
                         XMonad.Actions.CycleRecentWS
                         XMonad.Actions.CycleSelectedLayouts
-                        XMonad.Actions.CycleWindows
                         XMonad.Actions.CycleWS
+                        XMonad.Actions.CycleWindows
+                        XMonad.Actions.CycleWorkspaceByScreen
                         XMonad.Actions.DeManage
                         XMonad.Actions.DwmPromote
-                        XMonad.Actions.DynamicWorkspaces
+                        XMonad.Actions.DynamicProjects
                         XMonad.Actions.DynamicWorkspaceGroups
                         XMonad.Actions.DynamicWorkspaceOrder
-                        XMonad.Actions.DynamicProjects
+                        XMonad.Actions.DynamicWorkspaces
                         XMonad.Actions.FindEmptyWorkspace
                         XMonad.Actions.FlexibleManipulate
                         XMonad.Actions.FlexibleResize
@@ -110,9 +106,11 @@ library
                         XMonad.Actions.FocusNth
                         XMonad.Actions.GridSelect
                         XMonad.Actions.GroupNavigation
+                        XMonad.Actions.KeyRemap
                         XMonad.Actions.Launcher
                         XMonad.Actions.LinkWorkspaces
                         XMonad.Actions.MessageFeedback
+                        XMonad.Actions.Minimize
                         XMonad.Actions.MouseGestures
                         XMonad.Actions.MouseResize
                         XMonad.Actions.Navigation2D
@@ -123,7 +121,6 @@ library
                         XMonad.Actions.Plane
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
-                        XMonad.Actions.KeyRemap
                         XMonad.Actions.RotSlaves
                         XMonad.Actions.Search
                         XMonad.Actions.ShowText
@@ -132,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
@@ -143,13 +141,13 @@ library
                         XMonad.Actions.WindowMenu
                         XMonad.Actions.WindowNavigation
                         XMonad.Actions.WithAll
+                        XMonad.Actions.Workscreen
                         XMonad.Actions.WorkspaceCursors
                         XMonad.Actions.WorkspaceNames
-                        XMonad.Actions.Workscreen
                         XMonad.Config.Arossato
                         XMonad.Config.Azerty
-                        XMonad.Config.Bluetile
                         XMonad.Config.Bepo
+                        XMonad.Config.Bluetile
                         XMonad.Config.Desktop
                         XMonad.Config.Dmwit
                         XMonad.Config.Droundy
@@ -159,14 +157,18 @@ library
                         XMonad.Config.Prime
                         XMonad.Config.Sjanssen
                         XMonad.Config.Xfce
+                        XMonad.Doc
+                        XMonad.Doc.Configuring
+                        XMonad.Doc.Developing
+                        XMonad.Doc.Extending
                         XMonad.Hooks.CurrentWorkspaceOnTop
                         XMonad.Hooks.DebugEvents
                         XMonad.Hooks.DebugKeyEvents
+                        XMonad.Hooks.DebugStack
                         XMonad.Hooks.DynamicBars
                         XMonad.Hooks.DynamicHooks
                         XMonad.Hooks.DynamicLog
                         XMonad.Hooks.DynamicProperty
-                        XMonad.Hooks.DebugStack
                         XMonad.Hooks.EwmhDesktops
                         XMonad.Hooks.FadeInactive
                         XMonad.Hooks.FadeWindows
@@ -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,8 +210,9 @@ library
                         XMonad.Layout.DecorationAddons
                         XMonad.Layout.DecorationMadness
                         XMonad.Layout.Dishes
-                        XMonad.Layout.DraggingVisualizer
+                        XMonad.Layout.MultiDishes
                         XMonad.Layout.DragPane
+                        XMonad.Layout.DraggingVisualizer
                         XMonad.Layout.Drawer
                         XMonad.Layout.Dwindle
                         XMonad.Layout.DwmStyle
@@ -224,8 +228,8 @@ library
                         XMonad.Layout.Hidden
                         XMonad.Layout.HintedGrid
                         XMonad.Layout.HintedTile
-                        XMonad.Layout.IfMax
                         XMonad.Layout.IM
+                        XMonad.Layout.IfMax
                         XMonad.Layout.ImageButtonDecoration
                         XMonad.Layout.IndependentScreens
                         XMonad.Layout.LayoutBuilder
@@ -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
@@ -285,12 +291,13 @@ library
                         XMonad.Layout.WorkspaceDir
                         XMonad.Layout.ZoomRow
                         XMonad.Prompt
-                        XMonad.Prompt.AppendFile
                         XMonad.Prompt.AppLauncher
+                        XMonad.Prompt.AppendFile
                         XMonad.Prompt.ConfirmPrompt
-                        XMonad.Prompt.Directory
                         XMonad.Prompt.DirExec
+                        XMonad.Prompt.Directory
                         XMonad.Prompt.Email
+                        XMonad.Prompt.FuzzyMatch
                         XMonad.Prompt.Input
                         XMonad.Prompt.Layout
                         XMonad.Prompt.Man
@@ -308,25 +315,29 @@ library
                         XMonad.Util.DebugWindow
                         XMonad.Util.Dmenu
                         XMonad.Util.Dzen
-                        XMonad.Util.ExtensibleState
                         XMonad.Util.EZConfig
+                        XMonad.Util.ExtensibleState
                         XMonad.Util.Font
                         XMonad.Util.Image
                         XMonad.Util.Invisible
                         XMonad.Util.Loggers
                         XMonad.Util.Loggers.NamedScratchpad
+                        XMonad.Util.Minimize
                         XMonad.Util.NamedActions
                         XMonad.Util.NamedScratchpad
                         XMonad.Util.NamedWindows
                         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.SpawnOnce
                         XMonad.Util.SpawnNamedPipe
+                        XMonad.Util.SessionStart
+                        XMonad.Util.SpawnOnce
                         XMonad.Util.Stack
                         XMonad.Util.StringProp
                         XMonad.Util.Themes