Merge branch 'master' into dzen-dock

.github/PULL_REQUEST_TEMPLATE.md

@@ -10,3 +10,5 @@ behind them.
   - [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
 
   - [ ] I updated the `CHANGES.md` file
+
+  - [ ] I updated the `XMonad.Doc.Extending` file (if appropriate)

.gitignore

@@ -24,3 +24,6 @@ tags
 # stack artifacts
 /.stack-work/
 /cabal.project.local
+
+stack.yaml.lock
+

.travis.yml

@@ -1,91 +1,149 @@
-# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
+# This Travis job script has been generated by a script via
+#
+#   haskell-ci '-o' '.travis.yml' 'xmonad-contrib.cabal' '--apt' 'libxrandr-dev'
+#
+# For more information, see https://github.com/haskell-CI/haskell-ci
+#
+# version: 0.5.20190916
+#
 language: c
-sudo: false
+dist: xenial
-
+git:
+  # whether to recursively clone submodules
+  submodules: false
 cache:
   directories:
-    - $HOME/.cabsnap
     - $HOME/.cabal/packages
-
+    - $HOME/.cabal/store
 before_cache:
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
-  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
+  # remove files that are regenerated by 'cabal update'
-
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
+  - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
+  - rm -rfv $CABALHOME/packages/head.hackage
 matrix:
   include:
-    - env: CABALVER=1.16 GHCVER=7.6.3
+    - compiler: ghc-8.8.1
-      compiler: ": #GHC 7.6.3"
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0","libxrandr-dev"]}}
-      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
+    - compiler: ghc-8.6.5
-    - env: CABALVER=1.18 GHCVER=7.8.4
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0","libxrandr-dev"]}}
-      compiler: ": #GHC 7.8.4"
+    - compiler: ghc-8.4.4
-      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0","libxrandr-dev"]}}
-    - env: CABALVER=1.22 GHCVER=7.10.3
+    - compiler: ghc-8.2.2
-      compiler: ": #GHC 7.10.3"
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0","libxrandr-dev"]}}
-      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
+    - compiler: ghc-8.0.2
-    - env: CABALVER=1.24 GHCVER=8.0.1
+      addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0","libxrandr-dev"]}}
-      compiler: ": #GHC 8.0.1"
-      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
-
 before_install:
- - unset CC
+  - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
- - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+  - WITHCOMPILER="-w $HC"
-
+  - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
+  - HCPKG="$HC-pkg"
+  - unset CC
+  - CABAL=/opt/ghc/bin/cabal
+  - CABALHOME=$HOME/.cabal
+  - export PATH="$CABALHOME/bin:$PATH"
+  - TOP=$(pwd)
+  - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
+  - echo $HCNUMVER
+  - CABAL="$CABAL -vnormal+nowrap+markoutput"
+  - set -o pipefail
+  - |
+    echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }'           >> .colorful.awk
+    echo 'BEGIN { state = "output"; }'                                     >> .colorful.awk
+    echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }'            >> .colorful.awk
+    echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }'             >> .colorful.awk
+    echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
+    echo '  if (state == "cabal") {'                                       >> .colorful.awk
+    echo '    print blue($0)'                                              >> .colorful.awk
+    echo '  } else {'                                                      >> .colorful.awk
+    echo '    print $0'                                                    >> .colorful.awk
+    echo '  }'                                                             >> .colorful.awk
+    echo '}'                                                               >> .colorful.awk
+  - cat .colorful.awk
+  - |
+    color_cabal_output () {
+      awk -f $TOP/.colorful.awk
+    }
+  - echo text | color_cabal_output
 install:
- # build xmonad from HEAD
+  - ${CABAL} --version
- - git clone https://github.com/xmonad/xmonad.git
+  - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
-
+  - TEST=--enable-tests
- - cabal --version
+  - BENCH=--enable-benchmarks
- - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+  - HEADHACKAGE=false
- - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
+  - rm -f $CABALHOME/config
-   then
+  - |
-     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
+    echo "verbose: normal +nowrap +markoutput"          >> $CABALHOME/config
-          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
+    echo "remote-build-reporting: anonymous"            >> $CABALHOME/config
-   fi
+    echo "write-ghc-environment-files: always"          >> $CABALHOME/config
- - travis_retry cabal update -v
+    echo "remote-repo-cache: $CABALHOME/packages"       >> $CABALHOME/config
- - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
+    echo "logs-dir:          $CABALHOME/logs"           >> $CABALHOME/config
- - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
+    echo "world-file:        $CABALHOME/world"          >> $CABALHOME/config
- - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
+    echo "extra-prog-path:   $CABALHOME/bin"            >> $CABALHOME/config
-
+    echo "symlink-bindir:    $CABALHOME/bin"            >> $CABALHOME/config
-# check whether current requested install-plan matches cached package-db snapshot
+    echo "installdir:        $CABALHOME/bin"            >> $CABALHOME/config
- - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
+    echo "build-summary:     $CABALHOME/logs/build.log" >> $CABALHOME/config
-   then
+    echo "store-dir:         $CABALHOME/store"          >> $CABALHOME/config
-     echo "cabal build-cache HIT";
+    echo "install-dirs user"                            >> $CABALHOME/config
-     rm -rfv .ghc;
+    echo "  prefix: $CABALHOME"                         >> $CABALHOME/config
-     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
+    echo "repository hackage.haskell.org"               >> $CABALHOME/config
-     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
+    echo "  url: http://hackage.haskell.org/"           >> $CABALHOME/config
-   else
+  - |
-     echo "cabal build-cache MISS";
+    echo "program-default-options"                >> $CABALHOME/config
-     rm -rf $HOME/.cabsnap;
+    echo "  ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
-     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
+  - cat $CABALHOME/config
-     cabal install --only-dependencies --enable-tests --enable-benchmarks;
+  - rm -fv cabal.project cabal.project.local cabal.project.freeze
-   fi
+  - travis_retry ${CABAL} v2-update -v
-
+  # Generate cabal.project
-# snapshot package-db on cache miss
+  - rm -rf cabal.project cabal.project.local cabal.project.freeze
- - if [ ! -d $HOME/.cabsnap ];
+  - touch cabal.project
-   then
+  - |
-      echo "snapshotting package-db to build-cache";
+    echo "packages: ." >> cabal.project
-      mkdir $HOME/.cabsnap;
+  - |
-      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(xmonad-contrib)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
-      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
+  - cat cabal.project || true
-   fi
+  - cat cabal.project.local || true
-
+  - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
- - cabal install xmonad/
+  - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
-
+  - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
-# Here starts the actual work to be performed for the package under test;
+  - rm  cabal.project.freeze
-# any command which exits with a non-zero exit code causes the build to fail.
+  - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
 script:
- - if [ -f configure.ac ]; then autoreconf -i; fi
+  - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
- - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
+  # Packaging...
- - cabal build   # this builds all libraries and executables (including tests/benchmarks)
+  - ${CABAL} v2-sdist all | color_cabal_output
- - cabal test
+  # Unpacking...
-# - cabal check   # complains about -Werror even though it is
+  - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
-                  # hidden behind a manual flag with default false
+  - cd ${DISTDIR} || false
- - cabal sdist   # tests that a source-distribution can be generated
+  - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
-
+  - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm       '{}' \;
-# Check that the resulting source distribution can be built & installed.
+  - PKGDIR_xmonad_contrib="$(find . -maxdepth 1 -type d -regex '.*/xmonad-contrib-[0-9.]*')"
-# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
+  # Generate cabal.project
-# `cabal install --force-reinstalls dist/*-*.tar.gz`
+  - rm -rf cabal.project cabal.project.local cabal.project.freeze
- - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
+  - touch cabal.project
-   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
+  - |
+    echo "packages: ${PKGDIR_xmonad_contrib}" >> cabal.project
+  - |
+  - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(xmonad-contrib)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
+  - cat cabal.project || true
+  - cat cabal.project.local || true
+  # Building...
+  # this builds all libraries and executables (without tests/benchmarks)
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
+  # Building with tests and benchmarks...
+  # build & run tests, build benchmarks
+  - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
+  # cabal check...
+  - (cd ${PKGDIR_xmonad_contrib} && ${CABAL} -vnormal check)
+  # haddock...
+  - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output
+  # Building without installed constraints for packages in global-db...
+  - rm -f cabal.project.local
+  - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
 
+# REGENDATA ["-o",".travis.yml","xmonad-contrib.cabal","--apt","libxrandr-dev"]
 # EOF

CHANGES.md

@@ -1,27 +1,488 @@
 # Change Log / Release Notes
 
-## 0.14 (Not Yet)
+## unknown
 
 ### Breaking Changes
 
+  * `XMonad.Prompt`
+
+    Now `mkComplFunFromList` and `mkComplFunFromList'` take an
+    additional `XPConfig` argument, so that they can take into
+    account the given `searchPredicate`.
+
+    A `complCaseSensitivity` field has been added to `XPConfig`, indicating
+    whether case-sensitivity is desired when performing completion.
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    It is no longer recommended to use `fullscreenEventHook` directly.
+    Instead, use `ewmhFullscreen` which additionally advertises fullscreen
+    support in `_NET_SUPPORTED` and fixes fullscreening of applications that
+    explicitly check it, e.g. mupdf-gl, sxiv, …
+
+    `XMonad.Layout.Fullscreen.fullscreenSupport` now advertises it as well,
+    and no configuration changes are required in this case.
+
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    `ewmh` function will use `logHook` for handling activated window. And now
+    by default window activation will do nothing.
+
+    You can use regular `ManageHook` combinators for changing window
+    activation behavior and then add resulting `ManageHook` using
+    `activateLogHook` to your `logHook`. Also, module `X.H.Focus` provides
+    additional combinators.
+
+  * `XMonad.Prompt.Directory`
+
+    The `Dir` constructor now takes an additional `ComplCaseSensitivity`
+    argument to indicate whether directory completion is case sensitive.
+
+  * All modules still exporting a `defaultFoo` constructor
+
+    All of these were now removed. You can use the re-exported `def` from
+    `Data.Default` instead.
+
+### New Modules
+
+  * `XMonad.Util.ActionCycle`
+
+    A module providing a simple way to implement "cycling" `X` actions,
+    useful for things like alternating toggle-style keybindings.
+
+
+  * `XMonad.Actions.RotateSome`
+
+    Functions for rotating some elements around the stack while keeping others
+    anchored in place. Useful in combination with layouts that dictate window
+    visibility based on stack position, such as "XMonad.Layout.LimitWindows".
+
+    Export 'surfaceNext' and 'surfacePrev' actions, which treat the focused window
+    and any hidden windows as a ring that can be rotated through the focused position.
+
+    Export 'rotateSome', a pure function that rotates some elements around a stack
+    while keeping others anchored in place.
+
+  * `XMonad.Actions.Sift`
+
+    Provide 'siftUp' and 'siftDown' actions, which behave like 'swapUp' and 'swapDown'
+    but handle the wrapping case by exchanging the windows at either end of the stack
+    instead of rotating the stack.
+
+  * `XMonad.Hooks.WindowSwallowing`
+
+    A handleEventHook that implements window swallowing:
+    Hide parent windows like terminals when opening other programs (like image viewers) from within them,
+    restoring them once the child application closes.
+
+  * `XMonad.Actions.TiledWindowDragging`
+
+    An action that allows you to change the position of windows by dragging them around.
+
+  * `XMonad.Layout.ResizableThreeColumns`
+
+    A layout based on 'XMonad.Layout.ThreeColumns' but with each slave window's
+    height resizable.
+
+  * `XMonad.Layout.TallMastersCombo`
+
+    A layout combinator that support Shrink, Expand, and IncMasterN just as
+    the 'Tall' layout, and also support operations of two master windows:
+    a main master, which is the original master window;
+    a sub master, the first window of the second pane.
+    This combinator can be nested, and has a good support for using
+    'XMonad.Layout.Tabbed' as a sublayout.
+
+  * `XMonad.Actions.PerWindowKeys`
+
+    Create actions that run on a `Query Bool`, usually associated with
+    conditions on a window, basis. Useful for creating bindings that are
+    excluded or exclusive for some windows.
+
+  * `XMonad.Util.DynamicScratchpads`
+
+    Declare any window as a scratchpad on the fly. Once declared, the
+    scratchpad behaves like `XMonad.Util.NamedScratchpad`.
+
+  * `XMonad.Prompt.Zsh`
+
+    A version of `XMonad.Prompt.Shell` that lets you use completions supplied by
+    zsh.
+
+  * `XMonad.Util.ClickableWorkspaces`
+
+    Provides clickablePP, which when applied to the PP pretty-printer used by
+    `XMonad.Hooks.DynamicLog.dynamicLogWithPP`, will make the workspace tags
+    clickable in XMobar (for switching focus).
+
+  * `XMonad.Layout.VoidBorders`
+
+    Provides a modifier that semi-permanently (requires manual intervention)
+    disables borders for windows from the layout it modifies.
+
+  * `XMonad.Hooks.Focus`
+
+    Extends ManageHook EDSL to work on focused windows and current workspace.
+
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Actions.DynamicProjects`
+
+    The `changeProjectDirPrompt` function respects the `complCaseSensitivity` field
+    of `XPConfig` when performing directory completion.
+
+  * `XMonad.Layout.WorkspaceDir`
+
+    - The `changeDir` function respects the `complCaseSensitivity` field of `XPConfig`
+      when performing directory completion.
+
+    - `Chdir` message is exported, so it's now possible to change the
+      directory programmaticaly, not just via a user prompt.
+
+  * `XMonad.Prompt.Directory`
+
+    - Added `directoryMultipleModes'`, like `directoryMultipleModes` with an additional
+     `ComplCaseSensitivity` argument.
+
+    - Directory completions are now sorted.
+
+  * `XMonad.Prompt.FuzzyMatch`
+
+    `fuzzySort` will now accept cases where the input is not a subsequence of
+    every completion.
+
+  * `XMonad.Prompt.Shell`
+
+    Added `getShellCompl'`, like `getShellCompl` with an additional `ComplCaseSensitivity`
+    argument.
+
+    Added `compgenDirectories` and `compgenFiles` to get the directory/filename completion
+    matches returned by the compgen shell builtin.
+
+  * `XMonad.Prompt.Unicode`
+
+    Reworked internally to be call `spawnPipe` (asynchronous) instead of
+    `runProcessWithInput` (synchronous), which fixes `typeUnicodePrompt`.
+
+    Now respects `searchPredicate` and `sorter` from user-supplied `XPConfig`.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added `statusBar'` function, like existing `statusBar` but accepts a pretty
+      printing options argument embedded in the X monad, to allow for dynamically
+      modified options such as `workspaceNamesPP`.
+
+    - Added `shortenLeft` function, like existing `shorten` but shortens by
+      truncating from left instead of right. Useful for showing directories.
+
+  * `XMonad.Layout.BoringWindows`
+
+     Added boring-aware `swapUp`, `swapDown`, `siftUp`, and `siftDown` functions.
+
+  * `XMonad.Util.NamedScratchpad`
+
+     Added two new exported functions to the module:
+     - `customRunNamedScratchpadAction`
+         (provides the option to customize the `X ()` action the scratchpad is launched by)
+     - `spawnHereNamedScratchpadAction`
+         (uses `XMonad.Actions.SpawnOn.spawnHere` to initially start the scratchpad on the workspace it was launched on)
+
+  * `XMonad.Util.Run`
+
+     Added two new functions to the module:
+     `spawnPipeWithLocaleEncoding` and
+     `spawnPipeWithUtf8Encoding`. `spawnPipe` is now alias for
+     `spawnPipeWithLocaleEncoding`.
+
+     Added the function `spawnPipeWithNoEncoding` for cases where
+     binary handle is required.
+
+  * `XMonad.Prompt.Window`
+
+    Added 'allApplications' function which maps application executable
+    names to it's underlying window.
+
+  * `XMonad.Prompt.WindowBringer`
+
+    Added 'windowApMap' function which maps application executable
+    names to it's underlying window.
+
+  * `XMonad.Actions.Search`
+
+    - The `hoogle` function now uses the new URL `hoogle.haskell.org`.
+    - Added `promptSearchBrowser'` function to only suggest previous searches of
+      the selected search engine (instead of all search engines).
+
+  * `XMonad.Layout.BoringWindows`
+
+    Added 'markBoringEverywhere' function, to mark the currently
+    focused window boring on all layouts, when using 'XMonad.Actions.CopyWindow'.
+
+  * `XMonad.Layout.MouseResizableTile`
+
+    When we calculate dragger widths, we first try to get the border width of
+    the focused window, before failing over to using the initial `borderWidth`.
+
+  * `XMonad.Actions.CycleRecentWS`
+
+    - Added `cycleRecentNonEmptyWS` function which behaves like `cycleRecentWS`
+      but is constrainded to non-empty workspaces.
+
+    - Added `toggleRecentWS` and `toggleRecentNonEmptyWS` functions which toggle
+      between the current and most recent workspace, and continue to toggle back
+      and forth on repeated presses, rather than cycling through other workspaces.
+
+    - Added `recentWS` function which allows the recency list to be filtered with
+      a user-provided predicate.
+
+  * `XMonad.Prompt.Window`
+
+    - Added a `WithWindow` constructor to `WindowPrompt` to allow executing
+      actions of type `Window -> X ()` on the chosen window.
+
+  * `XMonad.Layout.Hidden`
+
+    - Export `HiddenWindows` type constructor.
+    - Export `popHiddenWindow` function restoring a specific window.
+
+  * `XMonad.Hooks.ManageDocks`
+    - Export `AvoidStruts` constructor
+
+  * `XMonad.Hooks.ManageHelpers`
+    - Export `doSink`
+
+  * `XMonad.Util.EZConfig`
+    - Added support for XF86Bluetooth.
+    
+  * `XMonad.Util.Loggers`
+    - Make `battery` and `loadAvg` distro-independent.
+
+  * `XMonad.Hooks.DynamicLog`
+    - Added `xmobarBorder` function to create borders around strings.
+
+  * `XMonad.Layout.Minimize`
+
+    - Export `Minimize` type constructor.
+
+  * `XMonad.Actions.WorkspaceNames`
+
+    - Added `workspaceNamesListTransform` which makes workspace names visible
+      to external pagers.
+
+  * Several `LayoutClass` instances now have an additional `Typeable`
+    constraint which may break some advanced configs. The upside is that we
+    can now add `Typeable` to `LayoutClass` in `XMonad.Core` and make it
+    possible to introspect the current layout and its modifiers.
+
+  * `XMonad.Actions.TopicSpace`
+
+    - `switchTopic` now correctly updates the last used topics.
+    - `setLastFocusedTopic` will now check whether we have exceeded the
+      `maxTopicHistory` and prune the topic history as necessary, as well as
+      cons the given topic onto the list __before__ filtering it.
+    - Added `switchNthLastFocusedExclude`, which works like
+      `switchNthLastFocused` but is able to exclude certain topics.
+    - Added `switchTopicWith`, which works like `switchTopic`, but one is able
+      to give `setLastFocusedTopic` a custom filtering function as well.
+    - Instead of a hand-rolled history, use the oneu from
+      `XMonad.Hooks.WorkspaceHistory`.
+    - Added the screen-aware functions `getLastFocusedTopicsByScreen` and
+      `switchNthLastFocusedByScreen`.
+
+  * `XMonad.Hooks.WorkspaceHistory`
+
+    - Added `workspaceHistoryModify` to modify the workspace history with a pure
+      function.
+      
+  * `XMonad.Hooks.DynamicLog`
+
+    - Add the -dock argument to the dzen spawn arguments      
+
+## 0.16
+
+### Breaking Changes
+
+  * `XMonad.Layout.Decoration`
+    - Added `Theme` record fields for controlling decoration border width for active/inactive/urgent windows.
+  * `XMonad.Prompt`
+
+    - Prompt ships a vim-like keymap, see `vimLikeXPKeymap` and
+      `vimLikeXPKeymap'`. A reworked event loop supports new vim-like prompt
+      actions.
+    - Prompt supports dynamic colors. Colors are now specified by the `XPColor`
+      type in `XPState` while `XPConfig` colors remain unchanged for backwards
+      compatibility.
+    - Fixes `showCompletionOnTab`.
+    - The behavior of `moveWord` and `moveWord'` has changed; brought in line
+      with the documentation and now internally consistent. The old keymaps
+      retain the original behavior; see the documentation to do the same your
+      XMonad configuration.
+  * `XMonad.Util.Invisble`
+    - Requires `MonadFail` for `Read` instance
+
+### New Modules
+
+  * `XMonad.Layout.TwoPanePersistent`
+
+    A layout that is like TwoPane but keeps track of the slave window that is
+    currently beside the master. In TwoPane, the default behavior when the master
+    is focused is to display the next window in the stack on the slave pane. This
+    is a problem when a different slave window is selected without changing the stack
+    order.
+
+  * `XMonad.Util.ExclusiveScratchpads`
+
+    Named scratchpads that can be mutually exclusive: This new module extends the
+    idea of named scratchpads such that you can define "families of scratchpads"
+    that are exclusive on the same screen. It also allows to remove this
+    constraint of being mutually exclusive with another scratchpad.
+
+  * `XMonad.Actions.Prefix`
+
+    A module that allows the user to use an Emacs-style prefix
+    argument (raw or numeric).
+
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Layout.Tabbed`
+
+    tabbedLeft and tabbedRight will set their tabs' height and width according to decoHeight/decoWidth
+
+  * `XMonad.Prompt`
+
+    Added `sorter` to `XPConfig` used to sort the possible completions by how
+    well they match the search string (example: `XMonad.Prompt.FuzzyMatch`).
+
+    Fixes a potential bug where an error during prompt execution would
+    leave the window open and keep the keyboard grabbed. See issue
+    [#180](https://github.com/xmonad/xmonad-contrib/issues/180).
+
+    Fixes [issue #217](https://github.com/xmonad/xmonad-contrib/issues/217), where
+    using tab to wrap around the completion rows would fail when maxComplRows is
+    restricting the number of rows of output.
+
+  * `XMonad.Prompt.Pass`
+
+    Added 'passOTPPrompt' to support getting OTP type password. This require
+    pass-otp (https://github.com/tadfisher/pass-otp) has been setup in the running
+    machine.
+
+    Added 'passGenerateAndCopyPrompt', which both generates a new password and
+    copies it to the clipboard.  These two actions are commonly desirable to
+    take together, e.g. when establishing a new account.
+
+    Made password prompts traverse symlinks when gathering password names for
+    autocomplete.
+
+  * `XMonad.Actions.DynamicProjects`
+
+    Make the input directory read from the prompt in `DynamicProjects`
+    absolute wrt the current directory.
+
+    Before this, the directory set by the prompt was treated like a relative
+    directory. This means that when you switch from a project with directory
+    `foo` into a project with directory `bar`, xmonad actually tries to `cd`
+    into `foo/bar`, instead of `~/bar` as expected.
+
+  * `XMonad.Actions.DynamicWorkspaceOrder`
+
+    Add a version of `withNthWorkspace` that takes a `[WorkspaceId] ->
+    [WorkspaceId]` transformation to apply over the list of workspace tags
+    resulting from the dynamic order.
+
+  * `XMonad.Actions.GroupNavigation`
+
+    Add a utility function `isOnAnyVisibleWS :: Query Bool` to allow easy
+    cycling between all windows on all visible workspaces.
+
+
+  * `XMonad.Hooks.WallpaperSetter`
+
+    Preserve the aspect ratio of wallpapers that xmonad sets. When previous
+    versions would distort images to fit the screen size, it will now find a
+    best fit by cropping instead.
+
+  * `XMonad.Util.Themes`
+
+    Add adwaitaTheme and adwaitaDarkTheme to match their respective
+    GTK themes.
+
+  * 'XMonad.Layout.BinarySpacePartition'
+
+    Add a new `SplitShiftDirectional` message that allows moving windows by
+    splitting its neighbours.
+
+  * `XMonad.Prompt.FuzzyMatch`
+
+    Make fuzzy sort show shorter strings first.
+
+## 0.15
+
+### Breaking Changes
+
+  * `XMonad.Layout.Groups` & `XMonad.Layout.Groups.Helpers`
+    The layout will no longer perform refreshes inside of its message handling.
+    If you have been relying on it to in your xmonad.hs, you will need to start
+    sending its messages in a manner that properly handles refreshing, e.g. with
+    `sendMessage`.
+
+### New Modules
+
+  * `XMonad.Util.Purex`
+
+    Unlike the opaque `IO` actions that `X` actions can wrap, regular reads from
+    the `XConf` and modifications to the `XState` are fundamentally pure --
+    contrary to the current treatment of such actions in most xmonad code. Pure
+    modifications to the `WindowSet` can be readily composed, but due to the
+    need for those modifications to be properly handled by `windows`, other pure
+    changes to the `XState` cannot be interleaved with those changes to the
+    `WindowSet` without superfluous refreshes, hence breaking composability.
+
+    This module aims to rectify that situation by drawing attention to it and
+    providing `PureX`: a pure type with the same monadic interface to state as
+    `X`. The `XLike` typeclass enables writing actions generic over the two
+    monads; if pure, existing `X` actions can be generalised with only a change
+    to the type signature. Various other utilities are provided, in particular
+    the `defile` function which is needed by end-users.
+
+### Bug Fixes and Minor Changes
+
+  * Add support for GHC 8.6.1.
+
+  * `XMonad.Actions.MessageHandling`
+    Refresh-performing functions updated to better reflect the new `sendMessage`.
+
+## 0.14
+
+### Breaking Changes
+
+  * `XMonad.Layout.Spacing`
+
+    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
+    of four sides each with its own border width. The screen and window borders
+    are now separate and can be independently toggled on/off. The screen border
+    examines the window/rectangle list resulting from 'runLayout' rather than
+    the stack, which makes it compatible with layouts such as the builtin
+    `Full`. The child layout will always be called with the screen border. If
+    only a single window is displayed (and `smartBorder` enabled), it will be
+    expanded into the original layout rectangle. Windows that are displayed but
+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',
+    will be shifted out of the way, but not scaled (not possible for windows
+    created by XMonad). This isn't perfect, so you might want to disable
+    `Spacing` on such layouts.
+
+  * `XMonad.Util.SpawnOnce`
+
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
+      to shift spawned windows to a specific workspace.
+
   * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
 
   * `XMonad.Actions.GridSelect`
 
     - Added field `gs_bordercolor` to `GSConfig` to specify border color.
 
-  * `ewmh` function from `X.H.EwmhDesktops` will use `manageHook` for handling
-    activated window. That means, actions, which you don't want to happen on
-    activated windows, should be guarded by
-
-        not <$> activated
-
-    predicate. By default, with empty `ManageHook`, window activation will do
-    nothing.
-
-    Also, you can use regular 'ManageHook' combinators for changing window
-    activation behavior.
-
   * `XMonad.Layout.Minimize`
 
      Though the interface it offers is quite similar, this module has been
@@ -32,20 +493,111 @@
      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.Hooks.Focus`
+  * `XMonad.Layout.MultiToggle.TabBarDecoration`
 
-    A new module extending ManageHook EDSL to work on focused windows and
+    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
-    current workspace.
+    dynamically toggle `XMonad.Layout.TabBarDecoration`.
 
-    This module will enable window activation (`_NET_ACTIVE_WINDOW`) and apply
+  * `XMonad.Hooks.RefocusLast`
-    `manageHook` to activated window too. Thus, it may lead to unexpected
+
-    results, when `manageHook` previously working only for new windows, start
+    Provides hooks and actions that keep track of recently focused windows on a
-    working for activated windows too. It may be solved, by adding
+    per workspace basis and automatically refocus the last window on loss of the
-    `not <$> activated` before those part of `manageHook`, which should not be
+    current (if appropriate as determined by user specified criteria).
-    called for activated windows.  But this lifts `manageHook` into
+
-    `FocusHook` and it needs to be converted back later using `manageFocus`.
+  * `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`
 
@@ -56,8 +608,85 @@
     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
@@ -106,7 +735,12 @@
 
   * `XMonad.Hooks.ManageHelpers`
 
-    Make type of ManageHook combinators more general.
+    - Make type of ManageHook combinators more general.
+    - New manage hook `doSink` for sinking windows (as upposed to the `doFloat` manage hook)
+
+  * `XMonad.Prompt`
+
+    Export `insertString`.
 
   * `XMonad.Prompt.Window`
 
@@ -124,9 +758,67 @@
       changed and you want to re-sort windows into the appropriate
       sub-layout.
 
+  * `XMonad.Actions.Minimize`
+
+    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
+      actions with both the last and first minimized windows easily.
+
+  * `XMonad.Config.Gnome`
+
+    - Update logout key combination (modm+shift+Q) to work with modern
+
+  * `XMonad.Prompt.Pass`
+
+    - New function `passTypePrompt` which uses `xdotool` to type in a password
+      from the store, bypassing the clipboard.
+    - New function `passEditPrompt` for editing a password from the
+      store.
+    - Now handles password labels with spaces and special characters inside
+      them.
+
+  * `XMonad.Prompt.Unicode`
+
+    - Persist unicode data cache across XMonad instances due to
+      `ExtensibleState` now used instead of `unsafePerformIO`.
+    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
+      Unicode character via `xdotool` instead of copying it to the paste buffer.
+    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
+      acts as a generic function to pass the selected Unicode character to any
+      program.
+
+  * `XMonad.Prompt.AppendFile`
+
+    - New function `appendFilePrompt'` which allows for transformation of the
+      string passed by a user before writing to a file.
+
   * `XMonad.Hooks.DynamicLog`
 
-    - Add the -dock argument to the dzen spawn arguments
+    - 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)
 

README.md

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

XMonad/Actions/Commands.hs

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

XMonad/Actions/CycleRecentWS.hs

@@ -19,11 +19,16 @@ module XMonad.Actions.CycleRecentWS (
                                 -- * Usage
                                 -- $usage
                                 cycleRecentWS,
-                                cycleWindowSets
+                                cycleRecentNonEmptyWS,
+                                cycleWindowSets,
+                                toggleRecentWS,
+                                toggleRecentNonEmptyWS,
+                                toggleWindowSets,
+                                recentWS
 ) where
 
 import XMonad hiding (workspaces)
-import XMonad.StackSet
+import XMonad.StackSet hiding (filter)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
@@ -47,9 +52,41 @@ cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this a
               -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
                           --   If it's the same as the nextWorkspace key, it is effectively ignored.
               -> X ()
-cycleRecentWS = cycleWindowSets options
+cycleRecentWS = cycleWindowSets $ recentWS (const True)
- where options w = map (view `flip` w) (recentTags w)
+
-       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
+
+-- | Like 'cycleRecentWS', but restricted to non-empty workspaces.
+cycleRecentNonEmptyWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                                  --   As soon as one of them is released, the final switch is made.
+                      -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
+                      -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
+                                  --   If it's the same as the nextWorkspace key, it is effectively ignored.
+                      -> X ()
+cycleRecentNonEmptyWS = cycleWindowSets $ recentWS (not . null . stack)
+
+
+-- | Switch to the most recent workspace. The stack of most recently used workspaces
+-- is updated, so repeated use toggles between a pair of workspaces.
+toggleRecentWS :: X ()
+toggleRecentWS = toggleWindowSets $ recentWS (const True)
+
+
+-- | Like 'toggleRecentWS', but restricted to non-empty workspaces.
+toggleRecentNonEmptyWS :: X ()
+toggleRecentNonEmptyWS = toggleWindowSets $ recentWS (not . null . stack)
+
+
+-- | Given a predicate p and the current WindowSet w, create a list of recent WindowSets,
+-- most recent first, where the focused workspace satisfies p.
+recentWS :: (WindowSpace -> Bool) -- ^ A workspace predicate.
+         -> WindowSet             -- ^ The current WindowSet
+         -> [WindowSet]
+recentWS p w = map (`view` w) recentTags
+ where recentTags = map tag
+                  $ filter p
+                  $ map workspace (visible w)
+                    ++ hidden w
+                    ++ [workspace (current w)]
 
 
 cycref :: [a] -> Int -> a
@@ -83,3 +120,12 @@ cycleWindowSets genOptions mods keyNext keyPrev = do
   io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
   setOption 0
   io $ ungrabKeyboard d currentTime
+
+
+-- | Switch to the first of a finite list of WindowSets.
+toggleWindowSets :: (WindowSet -> [WindowSet]) -> X ()
+toggleWindowSets genOptions = do
+  options <- gets $ genOptions . windowset
+  case options of
+    []  -> return ()
+    o:_ -> windows (const o)

XMonad/Actions/CycleWS.hs

@@ -262,7 +262,7 @@ 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
+wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) <$> gets windowset
                                    return $ (cur ==).groupName
                                    where groupName = takeWhile (/=sep).tag
 wsTypeToPred (WSIs p)   = p

XMonad/Actions/DynamicProjects.hs

@@ -50,7 +50,7 @@ import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
 import Data.Maybe (fromMaybe, isNothing)
 import Data.Monoid ((<>))
-import System.Directory (setCurrentDirectory, getHomeDirectory)
+import System.Directory (setCurrentDirectory, getHomeDirectory, makeAbsolute)
 import XMonad
 import XMonad.Actions.DynamicWorkspaces
 import XMonad.Prompt
@@ -145,24 +145,24 @@ instance ExtensionClass ProjectState where
 
 --------------------------------------------------------------------------------
 -- Internal types for working with XPrompt.
-data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
+data ProjectPrompt = ProjectPrompt XPConfig ProjectMode [ProjectName]
 data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
 
 instance XPrompt ProjectPrompt where
-  showXPrompt (ProjectPrompt submode _) =
+  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 _ RenameMode _) = return . (:[])
-  completionFunction (ProjectPrompt DirMode _) =
+  completionFunction (ProjectPrompt c DirMode _) =
-    let xpt = directoryMultipleModes "" (const $ return ())
+    let xpt = directoryMultipleModes' (complCaseSensitivity c) "" (const $ return ())
     in completionFunction xpt
-  completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
+  completionFunction (ProjectPrompt c _ ns) = mkComplFunFromList' c ns
 
-  modeAction (ProjectPrompt SwitchMode _) buf auto = do
+  modeAction (ProjectPrompt _ SwitchMode _) buf auto = do
     let name = if null auto then buf else auto
     ps <- XS.gets projects
 
@@ -171,18 +171,19 @@ instance XPrompt ProjectPrompt where
       Nothing | null name -> return ()
               | otherwise -> switchProject (defProject name)
 
-  modeAction (ProjectPrompt ShiftMode _) buf auto = do
+  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 _ =
+  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
+  modeAction (ProjectPrompt _ DirMode _) buf auto = do
-    let dir = if null auto then buf else auto
+    let dir' = if null auto then buf else auto
+    dir <- io $ makeAbsolute dir'
     modifyProject (\p -> p { projectDirectory = dir })
 
 --------------------------------------------------------------------------------
@@ -230,7 +231,7 @@ dynamicProjectsStartupHook ps = XS.modify go
 --------------------------------------------------------------------------------
 -- | Find a project based on its name.
 lookupProject :: ProjectName -> X (Maybe Project)
-lookupProject name = Map.lookup name `fmap` XS.gets projects
+lookupProject name = Map.lookup name <$> XS.gets projects
 
 --------------------------------------------------------------------------------
 -- | Fetch the current project (the one being used for the currently
@@ -326,11 +327,11 @@ changeProjectDirPrompt = projectPrompt [ DirMode
 -- | Prompt for a project name.
 projectPrompt :: [ProjectMode] -> XPConfig -> X ()
 projectPrompt submodes c = do
-  ws <- map W.tag `fmap` gets (W.workspaces . windowset)
+  ws <- map W.tag <$> gets (W.workspaces . windowset)
   ps <- XS.gets projects
 
   let names = sort (Map.keys ps `union` ws)
-      modes = map (\m -> XPT $ ProjectPrompt m names) submodes
+      modes = map (\m -> XPT $ ProjectPrompt c m names) submodes
 
   mkXPromptWithModes modes c
 

XMonad/Actions/DynamicWorkspaceGroups.hs

@@ -133,7 +133,7 @@ instance XPrompt WSGPrompt where
 promptWSGroupView :: XPConfig -> String -> X ()
 promptWSGroupView xp s = do
   gs <- fmap (M.keys . unWSG) XS.get
-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) viewWSGroup
 
 -- | Prompt for a name for the current workspace group.
 promptWSGroupAdd :: XPConfig -> String -> X ()
@@ -144,4 +144,4 @@ promptWSGroupAdd xp s =
 promptWSGroupForget :: XPConfig -> String -> X ()
 promptWSGroupForget xp s = do
   gs <- fmap (M.keys . unWSG) XS.get
-  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' xp gs) forgetWSGroup

XMonad/Actions/DynamicWorkspaceOrder.hs

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

XMonad/Actions/DynamicWorkspaces.hs

@@ -108,7 +108,7 @@ withWorkspaceIndex job widx = do
   maybe (return ()) (windows . job) wtag
     where
       ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
-      ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
+      ilookup idx = Map.lookup idx <$> XS.gets workspaceIndexMap
 
 
 mkCompl :: [String] -> String -> IO [String]

XMonad/Actions/FloatSnap.hs

@@ -27,7 +27,6 @@ module XMonad.Actions.FloatSnap (
                 ifClick') where
 
 import XMonad
-import Control.Applicative((<$>))
 import Data.List (sort)
 import Data.Maybe (listToMaybe,fromJust,isNothing)
 import qualified XMonad.StackSet as W
@@ -291,8 +290,8 @@ getSnap horiz collidedist d w = do
     screen <- W.current <$> gets windowset
     let sr = screenRect $ W.screenDetail screen
         wl = W.integrate' . W.stack $ W.workspace screen
-    gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
+    gr <- ($sr) <$> calcGap (S.fromList [minBound .. maxBound])
-    wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
+    wla <- filter (collides wa) <$> (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
 
     return ( neighbours (back wa sr gr wla) (wpos wa)
            , neighbours (front wa sr gr wla) (wpos wa + wdim wa)

XMonad/Actions/GridSelect.hs

@@ -28,7 +28,6 @@ module XMonad.Actions.GridSelect (
     -- * Configuration
     GSConfig(..),
     def,
-    defaultGSConfig,
     TwoDPosition,
     buildDefaultGSConfig,
 
@@ -107,13 +106,13 @@ import Data.Word (Word8)
 --
 -- Then add a keybinding, e.g.
 --
--- >    , ((modm, xK_g), goToSelected defaultGSConfig)
+-- >    , ((modm, xK_g), goToSelected def)
 --
 -- This module also supports displaying arbitrary information in a grid and letting
 -- the user select from it. E.g. to spawn an application from a given list, you
 -- can use the following:
 --
--- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
+-- >   , ((modm, xK_s), spawnSelected def ["xterm","gmplayer","gvim"])
 
 -- $commonGSConfig
 --
@@ -123,7 +122,7 @@ import Data.Word (Word8)
 -- > {-# LANGUAGE NoMonomorphismRestriction #-}
 -- > import XMonad
 -- > ...
--- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }
+-- > gsconfig1 = def { gs_cellheight = 30, gs_cellwidth = 100 }
 --
 -- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
 -- in order to specify a custom colorizer is @gsconfig2@ (found in
@@ -230,10 +229,6 @@ instance HasColorizer a where
 instance HasColorizer a => Default (GSConfig a) where
     def = buildDefaultGSConfig defaultColorizer
 
-{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
-defaultGSConfig :: HasColorizer a => GSConfig a
-defaultGSConfig = def
-
 type TwoDPosition = (Integer, Integer)
 
 type TwoDElementMap a = [(TwoDPosition,(String,a))]
@@ -435,7 +430,7 @@ shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.l
 select :: TwoD a (Maybe a)
 select = do
   s <- get
-  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+  return $ snd . snd <$> findInElementMap (td_curpos s) (td_elementmap s)
 
 -- | Closes gridselect returning no element.
 cancel :: TwoD a (Maybe a)
@@ -711,11 +706,11 @@ windowMap = do
     ws <- gets windowset
     wins <- mapM keyValuePair (W.allWindows ws)
     return wins
- where keyValuePair w = flip (,) w `fmap` decorateName' w
+ where keyValuePair w = flip (,) w <$> decorateName' w
 
 decorateName' :: Window -> X String
 decorateName' w = do
-  fmap show $ getName w
+  show <$> getName w
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
@@ -770,7 +765,7 @@ gridselectWorkspace' conf func = withWindowSet $ \ws -> do
 --
 -- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
 -- >
--- > gridselectWorkspace' defaultGSConfig
+-- > gridselectWorkspace' def
 -- >                          { gs_navigate   = navNSearch
 -- >                          , gs_rearranger = searchStringRearrangerGenerator id
 -- >                          }

XMonad/Actions/GroupNavigation.hs

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

XMonad/Actions/Launcher.hs

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

XMonad/Actions/Minimize.hs

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

XMonad/Actions/MouseResize.hs

@@ -105,7 +105,7 @@ handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
 handleResize _ _ = return ()
 
 createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
-createInputWindow ((w,r),mr) = do
+createInputWindow ((w,r),mr) =
   case mr of
     Just tr  -> withDisplay $ \d -> do
                   tw <- mkInputWindow d tr

XMonad/Actions/Navigation2D.hs

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

XMonad/Actions/NoBorders.hs

@@ -27,7 +27,7 @@ toggleBorder :: Window -> X ()
 toggleBorder w = do
     bw <- asks (borderWidth . config)
     withDisplay $ \d -> io $ do
-        cw <- wa_border_width `fmap` getWindowAttributes d w
+        cw <- wa_border_width <$> getWindowAttributes d w
         if cw == 0
             then setWindowBorderWidth d w bw
             else setWindowBorderWidth d w 0

XMonad/Actions/PerWindowKeys.hs

@@ -0,0 +1,60 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.PerWindowKeys
+-- Copyright   :  (c) Wilson Sales, 2019
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Wilson Sales <spoonm@spoonm.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Define key-bindings on per-window basis.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PerWindowKeys (
+                                    -- * Usage
+                                    -- $usage
+                                    bindAll,
+                                    bindFirst
+                                   ) where
+
+import XMonad
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >  import XMonad.Actions.PerWindowKeys
+--
+-- >   ,((0, xK_F2), bindFirst [(className =? "firefox", spawn "dmenu"), (isFloat, withFocused $ windows . W.sink)])
+--
+-- >   ,((0, xK_F3), bindAll [(isDialog, kill), (pure True, doSomething)])
+--
+-- If you want an action that will always run, but also want to do something for
+-- other queries, you can use @'bindAll' [(query1, action1), ..., (pure True,
+-- alwaysDoThisAction)]@.
+--
+-- Similarly, if you want a default action to be run if all the others failed,
+-- you can use @'bindFirst' [(query1, action1), ..., (pure True,
+-- doThisIfTheOthersFail)]@.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Run an action if a Query holds true. Doesn't stop at the first one that
+-- does, however, and could potentially run all actions.
+bindAll :: [(Query Bool, X ())] -> X ()
+bindAll = mapM_ choose where
+  choose (mh,action) = withFocused $ \w -> whenX (runQuery mh w) action
+
+-- | Run the action paired with the first Query that holds true.
+bindFirst :: [(Query Bool, X ())] -> X ()
+bindFirst = withFocused . chooseOne
+
+chooseOne :: [(Query Bool, X ())] -> Window -> X ()
+chooseOne [] _ = return ()
+chooseOne ((mh,a):bs) w = do
+  c <- runQuery mh w
+  if c then a
+       else chooseOne bs w

XMonad/Actions/PhysicalScreens.hs

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

XMonad/Actions/Prefix.hs

@@ -0,0 +1,210 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleContexts #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Prefix
+-- Copyright   :  (c) Matus Goljer <matus.goljer@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Matus Goljer <matus.goljer@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module that allows the user to use a prefix argument (raw or numeric).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Prefix
+       (
+      -- * Usage
+      -- $usage
+
+      -- * Installation
+      -- $installation
+
+         PrefixArgument(..)
+       , usePrefixArgument
+       , useDefaultPrefixArgument
+       , withPrefixArgument
+       , isPrefixRaw
+       , isPrefixNumeric
+       , ppFormatPrefix
+       ) where
+
+import qualified Data.Map as M
+import Data.Maybe
+import Control.Monad (liftM2)
+
+import XMonad
+import XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Paste (sendKey)
+import XMonad.Actions.Submap (submapDefaultWithKey)
+
+{- $usage
+
+This module implements Emacs-style prefix argument.  The argument
+comes in two flavours, "Raw" and "Numeric".
+
+To initiate the "prefix mode" you hit the prefix keybinding (default
+C-u).  This sets the Raw argument value to 1.  Repeatedly hitting this
+key increments the raw value by 1.  The Raw argument is usually used
+as a toggle, changing the behaviour of the function called in some way.
+
+An example might be calling "mpc add" to add new song to the playlist,
+but with C-u we also clean up the playlist beforehand.
+
+When in the "Raw mode", you can hit numeric keys 0..9 (with no
+modifier) to enter a "Numeric argument".  Numeric argument represents
+a natural number.  Hitting numeric keys in sequence produces the
+decimal number that would result from typing them.  That is, the
+sequence C-u 4 2 sets the Numeric argument value to the number 42.
+
+If you have a function which understands the prefix argument, for example:
+
+>    addMaybeClean :: PrefixArgument -> X ()
+>    addMaybeClean (Raw _) = spawn "mpc clear" >> spawn "mpc add <file>"
+>    addMaybeClean _ = spawn "mpc add <file>"
+
+you can turn it into an X action with the function 'withPrefixArgument'.
+
+Binding it in your config
+
+>    ((modm, xK_a), withPrefixArgument addMaybeClean)
+
+Hitting MOD-a will add the <file> to the playlist while C-u MOD-a will
+clear the playlist and then add the file.
+
+You can of course use an anonymous action, like so:
+
+>    ((modm, xK_a), withPrefixArgument $ \prefix -> do
+>        case prefix of ...
+>    )
+
+If the prefix key is followed by a binding which is unknown to XMonad,
+the prefix along with that binding is sent to the active window.
+
+There is one caveat: when you use an application which has a nested
+C-u binding, for example C-c C-u in Emacs org-mode, you have to hit
+C-g (or any other non-recognized key really) to get out of the "xmonad
+grab" and let the C-c C-u be sent to the application.
+
+-}
+
+{- $installation
+
+The simplest way to enable this is to use 'useDefaultPrefixArgument'
+
+>    xmonad $ useDefaultPrefixArgument $ defaultConfig { .. }
+
+The default prefix argument is C-u.  If you want to customize the
+prefix argument, use the following:
+
+>    xmonad $ usePrefixArgument prefixKey $ defaultConfig { .. }
+
+where 'prefixKey' is a function which takes 'XConfig' as an argument
+in case you wish to extract the 'modMask'.  An example
+implementation is the following:
+
+>    prefixKey :: XConfig t -> (KeyMask, KeySym)
+>    prefixKey XConfig{modMask = modm} = (modm, xK_u)
+
+-}
+
+data PrefixArgument = Raw Int | Numeric Int | None
+                      deriving (Typeable, Read, Show)
+instance ExtensionClass PrefixArgument where
+  initialValue = None
+  extensionType = PersistentExtension
+
+-- | Run 'job' in the 'X' monad and then execute 'cleanup'.  In case
+-- of exception, 'cleanup' is executed anyway.
+--
+-- Return the return value of 'job'.
+finallyX :: X a -> X a -> X a
+finallyX job cleanup = catchX (job >>= \r -> cleanup >> return r) cleanup
+
+-- | Set Prefix up with custom configuration.
+--
+-- See usage section.
+usePrefixArgument :: LayoutClass l Window
+                  => (XConfig Layout -> (KeyMask, KeySym))
+                  -> XConfig l
+                  -> XConfig l
+usePrefixArgument prefix conf = conf {
+    keys = liftM2 M.union keys' (keys conf)
+  }
+  where keys' conf' =
+          let binding = prefix conf'
+          in M.singleton binding (handlePrefixArg [binding])
+
+-- | Set Prefix up with default prefix key (C-u).
+useDefaultPrefixArgument :: LayoutClass l Window
+                         => XConfig l
+                         -> XConfig l
+useDefaultPrefixArgument = usePrefixArgument (\_ -> (controlMask, xK_u))
+
+handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
+handlePrefixArg events = do
+  ks <- asks keyActions
+  logger <- asks (logHook . config)
+  flip finallyX (XS.put None >> logger) $ do
+    prefix <- XS.get
+    case prefix of
+      Raw a -> XS.put $ Raw (a + 1)
+      None -> XS.put $ Raw 1
+      _ -> return ()
+    logger
+    submapDefaultWithKey defaultKey ks
+  where defaultKey key@(m, k) =
+          if k `elem` (xK_0 : [xK_1 .. xK_9]) && m == noModMask
+          then do
+            prefix <- XS.get
+            let x = fromJust (Prelude.lookup k keyToNum)
+            case prefix of
+              Raw _ -> XS.put $ Numeric x
+              Numeric a -> XS.put $ Numeric $ a * 10 + x
+              None -> return () -- should never happen
+            handlePrefixArg (key:events)
+          else do
+            prefix <- XS.get
+            mapM_ (uncurry sendKey) $ case prefix of
+              Raw a -> replicate a (head events) ++ [key]
+              _ -> reverse (key:events)
+        keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
+
+-- | Turn a prefix-aware X action into an X-action.
+--
+-- First, fetch the current prefix, then pass it as argument to the
+-- original function.  You should use this to "run" your commands.
+withPrefixArgument :: (PrefixArgument -> X ()) -> X ()
+withPrefixArgument = (>>=) XS.get
+
+-- | Test if 'PrefixArgument' is 'Raw' or not.
+isPrefixRaw :: PrefixArgument -> Bool
+isPrefixRaw (Raw _) = True
+isPrefixRaw _ = False
+
+-- | Test if 'PrefixArgument' is 'Numeric' or not.
+isPrefixNumeric :: PrefixArgument -> Bool
+isPrefixNumeric (Numeric _) = True
+isPrefixNumeric _ = False
+
+-- | Format the prefix using the Emacs convetion for use in a
+-- statusbar, like xmobar.
+--
+-- To add this formatted prefix to printer output, you can set it up
+-- like so
+--
+-- > myPrinter :: PP
+-- > myPrinter = def { ppExtras = [ppFormatPrefix] }
+--
+-- And then in your 'logHook' configuration
+--
+-- > logHook = dynamicLogWithPP myPrinter
+ppFormatPrefix :: X (Maybe String)
+ppFormatPrefix = do
+  prefix <- XS.get
+  return $ case prefix of
+    Raw n -> Just $ foldr1 (\a b -> a ++ " " ++ b) $ replicate n "C-u"
+    Numeric n -> Just $ "C-u " ++ show n
+    None -> Nothing

XMonad/Actions/RandomBackground.hs

@@ -24,7 +24,6 @@ module XMonad.Actions.RandomBackground (
 import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
               MonadIO, asks)
 import System.Random
-import Control.Monad(liftM)
 import Numeric(showHex)
 
 -- $usage
@@ -55,7 +54,7 @@ randPermutation xs g = swap $ zip (randoms g) xs
 
 -- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
 randomBg' ::  (MonadIO m) => RandomColor -> m String
-randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
+randomBg' (RGB l h) = io $ fmap (toHex . take 3 . randomRs (l,h)) newStdGen
 randomBg' (HSV s v) = io $ do
     g <- newStdGen
     let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g

XMonad/Actions/RotateSome.hs

@@ -0,0 +1,163 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RotateSome
+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Functions for rotating some elements around the stack while keeping others
+-- anchored in place. Useful in combination with layouts that dictate window
+-- visibility based on stack position, such as "XMonad.Layout.LimitWindows".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RotateSome (
+    -- * Usage
+    -- $usage
+    -- * Example
+    -- $example
+    surfaceNext,
+    surfacePrev,
+    rotateSome,
+  ) where
+
+import Control.Arrow ((***))
+import Data.List (partition, sortOn, (\\))
+import qualified Data.Map as M
+import XMonad (Window, WindowSpace, Rectangle, X, runLayout, screenRect, windows, withWindowSet)
+import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modify', stack)
+
+{- $usage
+You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.RotateSome
+
+and add keybindings such as the following:
+
+>   , ((modMask .|. controlMask, xK_n), surfaceNext)
+>   , ((modMask .|. controlMask, xK_p), surfacePrev)
+
+-}
+
+{- $example
+#Example#
+
+Consider a workspace whose stack contains five windows A B C D E but whose
+layout limits how many will actually be shown, showing only the first plus
+two additional windows, starting with the third:
+
+>  ┌─────┬─────┐
+>  │     │  C  │
+>  │  A  ├─────┤
+>  │     │  D  │
+>  └─────┴─────┘
+>
+>  A  B  C  D  E
+>  _     ____
+
+If C has focus and we'd like to replace it with one of the unshown windows,
+'surfaceNext' will move the next unshown window, E, into the focused position:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *C* │                │     │ *E* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  B *C* D  E                A  C *E* D  B
+>  _     ____                   _     ____
+
+This repositioned windows B C E by treating them as a sequence that can be
+rotated through the focused stack position. Windows A and D remain anchored
+to their original (visible) positions.
+
+A second call to 'surfaceNext' moves B into focus:
+
+>  ┌─────┬─────┐                ┌─────┬─────┐
+>  │     │ *E* │                │     │ *B* │
+>  │  A  ├─────┤ surfaceNext -> │  A  ├─────┤
+>  │     │  D  │                │     │  D  │
+>  └─────┴─────┘                └─────┴─────┘
+>
+>  A  C *E* D  B                A  E *B* D  C
+>  _     ____                   _     ____
+
+A third call would complete the cycle, bringing C back into focus.
+
+-}
+
+-- |
+-- Treating the focused window and any unshown windows as a ring that can be
+-- rotated through the focused position, surface the next element in the ring.
+surfaceNext :: X ()
+surfaceNext = do
+  ring <- surfaceRing
+  windows . modify' $ rotateSome (`elem` ring)
+
+-- | Like 'surfaceNext' in reverse.
+surfacePrev :: X ()
+surfacePrev = do
+  ring <- surfaceRing
+  windows . modify' $ reverseStack . rotateSome (`elem` ring) . reverseStack
+
+-- |
+-- Return a list containing the current focus plus any unshown windows. Note
+-- that windows are shown if 'runLayout' provides them with a rectangle or if
+-- they are floating.
+surfaceRing :: X [Window]
+surfaceRing = withWindowSet $ \wset -> do
+  let Screen wsp _ sd = current wset
+
+  case stack wsp >>= filter' (`M.notMember` floating wset) of
+    Nothing -> pure []
+    Just st -> go st <$> layoutWindows wsp {stack = Just st} (screenRect sd)
+  where
+    go :: Stack Window -> [Window] -> [Window]
+    go (Stack t ls rs) shown = t : ((ls ++ rs) \\ shown)
+
+    layoutWindows :: WindowSpace -> Rectangle -> X [Window]
+    layoutWindows wsp rect = map fst . fst <$> runLayout wsp rect
+
+-- | Like "XMonad.StackSet.filter" but won't move focus.
+filter' :: (a -> Bool) -> Stack a -> Maybe (Stack a)
+filter' p (Stack f ls rs)
+  | p f       = Just $ Stack f (filter p ls) (filter p rs)
+  | otherwise = Nothing
+
+-- |
+-- @'rotateSome' p stack@ treats the elements of @stack@ that satisfy predicate
+-- @p@ as a ring that can be rotated, while all other elements remain anchored
+-- in place.
+rotateSome :: (a -> Bool) -> Stack a -> Stack a
+rotateSome p (Stack t ls rs) =
+  let
+    -- Flatten the stack, index each element relative to the focused position,
+    -- then partition into movable and anchored elements.
+    (movables, anchors) =
+      partition (p . snd) $
+        zip
+          [negate (length ls)..]
+          (reverse ls ++ t : rs)
+
+    -- Pair each movable element with the index of its next movable neighbor.
+    -- Append anchored elements, along with their unchanged indices, and sort
+    -- by index. Separate lefts (negative indices) from the rest, and grab the
+    -- new focus from the head of the remaining elements.
+    (ls', t':rs') =
+      (map snd *** map snd)
+        . span ((< 0) . fst)
+        . sortOn fst
+        . (++) anchors
+        . map (fst *** snd)
+        $ zip movables (rotate movables)
+  in
+    Stack t' (reverse ls') rs'
+
+rotate :: [a] -> [a]
+rotate = uncurry (flip (++)) . splitAt 1
+
+reverseStack :: Stack a -> Stack a
+reverseStack (Stack t ls rs) = Stack t rs ls

XMonad/Actions/Search.hs

@@ -18,6 +18,7 @@ module XMonad.Actions.Search (   -- * Usage
                                  searchEngineF,
                                  promptSearch,
                                  promptSearchBrowser,
+                                 promptSearchBrowser',
                                  selectSearch,
                                  selectSearchBrowser,
                                  isPrefixOf,
@@ -35,6 +36,7 @@ module XMonad.Actions.Search (   -- * Usage
                                  debbts,
                                  debpts,
                                  dictionary,
+                                 ebay,
                                  google,
                                  hackage,
                                  hoogle,
@@ -113,6 +115,8 @@ import           XMonad.Util.XSelection   (getSelection)
 
 * 'dictionary' -- dictionary.reference.com search.
 
+* 'ebay' -- Ebay keyword search.
+
 * 'google' -- basic Google search.
 
 * 'hackage' -- Hackage, the Haskell package database.
@@ -191,7 +195,7 @@ Or in combination with XMonad.Util.EZConfig:
 >
 > searchList :: [(String, S.SearchEngine)]
 > searchList = [ ("g", S.google)
->              , ("h", S.hoohle)
+>              , ("h", S.hoogle)
 >              , ("w", S.wikipedia)
 >              ]
 
@@ -281,7 +285,7 @@ searchEngineF :: Name -> Site -> SearchEngine
 searchEngineF = SearchEngine
 
 -- The engines.
-amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
+amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle,
   images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
   youtube, duckduckgo :: SearchEngine
 amazon        = searchEngine "amazon"        "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
@@ -291,9 +295,10 @@ deb           = searchEngine "deb"           "http://packages.debian.org/"
 debbts        = searchEngine "debbts"        "http://bugs.debian.org/"
 debpts        = searchEngine "debpts"        "http://packages.qa.debian.org/"
 dictionary    = searchEngine "dict"          "http://dictionary.reference.com/browse/"
+ebay          = searchEngine "ebay"          "http://www.ebay.com/sch/i.html?_nkw="
 google        = searchEngine "google"        "http://www.google.com/search?num=100&q="
 hackage       = searchEngine "hackage"       "http://hackage.haskell.org/package/"
-hoogle        = searchEngine "hoogle"        "http://www.haskell.org/hoogle/?q="
+hoogle        = searchEngine "hoogle"        "http://hoogle.haskell.org/?hoogle="
 images        = searchEngine "images"        "http://images.google.fr/images?q="
 imdb          = searchEngine "imdb"          "http://www.imdb.com/find?s=all&q="
 isohunt       = searchEngine "isohunt"       "http://isohunt.com/torrents/?ihq="
@@ -312,7 +317,7 @@ vocabulary    = searchEngine "vocabulary"    "http://www.vocabulary.com/search?q
 duckduckgo    = searchEngine "duckduckgo"    "https://duckduckgo.com/?t=lm&q="
 
 multi :: SearchEngine
-multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
+multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
 
 {- | This function wraps up a search engine and creates a new one, which works
    like the argument, but goes directly to a URL if one is given rather than
@@ -361,6 +366,18 @@ promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearchBrowser config browser (SearchEngine name site) =
     mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site
 
+{- | Like 'promptSearchBrowser', but only suggest previous searches for the
+   given 'SearchEngine' in the prompt. -}
+promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
+promptSearchBrowser' config browser (SearchEngine name site) =
+    mkXPrompt
+        (Search name)
+        config
+        (historyCompletionP (searchName `isPrefixOf`))
+        $ search browser site
+  where
+    searchName = showXPrompt (Search name)
+
 {- | Like 'search', but in this case, the string is not specified but grabbed
  from the user's response to a prompt. Example:
 

XMonad/Actions/ShowText.hs

@@ -17,7 +17,6 @@ module XMonad.Actions.ShowText
     ( -- * Usage
       -- $usage
       def
-    , defaultSTConfig
     , handleTimerEvent
     , flashText
     , ShowTextConfig(..)
@@ -80,10 +79,6 @@ instance Default ShowTextConfig where
         , st_fg   = "white"
     }
 
-{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
-defaultSTConfig :: ShowTextConfig
-defaultSTConfig = def
-
 -- | Handles timer events that notify when a window should be removed
 handleTimerEvent :: Event -> X All
 handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do

XMonad/Actions/Sift.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Sift
+-- Copyright   :  (c) 2020 Ivan Brennan <ivanbrennan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Ivan Brennan <ivanbrennan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Functions for sifting windows up and down. Sifts behave identically to
+-- swaps (i.e. 'swapUp' and 'swapDown' from "XMonad.StackSet"), except in
+-- the wrapping case: rather than rotating the entire stack by one position
+-- like a swap would, a sift causes the windows at either end of the stack
+-- to trade positions.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Sift (
+    -- * Usage
+    -- $usage
+    siftUp,
+    siftDown,
+  ) where
+
+import XMonad.StackSet (Stack (Stack), StackSet, modify')
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Sift
+--
+-- and add keybindings such as the following:
+--
+-- >   , ((modMask .|. shiftMask, xK_j ), windows siftDown)
+-- >   , ((modMask .|. shiftMask, xK_k ), windows siftUp  )
+--
+
+-- |
+-- siftUp, siftDown. Exchange the focused window with its neighbour in
+-- the stack ordering, wrapping if we reach the end. Unlike 'swapUp' and
+-- 'swapDown', wrapping is handled by trading positions with the window
+-- at the other end of the stack.
+--
+siftUp, siftDown :: StackSet i l a s sd -> StackSet i l a s sd
+siftUp   = modify' siftUp'
+siftDown = modify' (reverseStack . siftUp' . reverseStack)
+
+siftUp' :: Stack a -> Stack a
+siftUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
+siftUp' (Stack t []     rs) =
+  case reverse rs of
+    (x:xs) -> Stack t (xs ++ [x]) []
+    []     -> Stack t []          []
+
+reverseStack :: Stack a -> Stack a
+reverseStack (Stack t ls rs) = Stack t rs ls

XMonad/Actions/SwapPromote.hs

@@ -0,0 +1,406 @@
+{-# 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.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/TagWindows.hs

@@ -89,7 +89,7 @@ getTags w = withDisplay $ \d ->
 
 -- | check a window for the given tag
 hasTag :: String -> Window -> X Bool
-hasTag s w = (s `elem`) `fmap` getTags w
+hasTag s w = (s `elem`) <$> getTags w
 
 -- | add a tag to the existing ones
 addTag :: String -> Window -> X ()
@@ -180,7 +180,7 @@ instance XPrompt TagPrompt where
 tagPrompt :: XPConfig -> (String -> X ()) -> X ()
 tagPrompt c f = do
   sc <- tagComplList
-  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
+  mkXPrompt TagPrompt c (mkComplFunFromList' c sc) f
 
 tagComplList :: X [String]
 tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
@@ -192,7 +192,7 @@ tagDelPrompt :: XPConfig -> X ()
 tagDelPrompt c = do
   sc <- tagDelComplList
   if (sc /= [])
-    then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
+    then mkXPrompt TagPrompt c (mkComplFunFromList' c sc) (\s -> withFocused (delTag s))
     else return ()
 
 tagDelComplList :: X [String]

XMonad/Actions/TiledWindowDragging.hs

@@ -0,0 +1,101 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.TiledWindowDragging
+-- Copyright   :  (c) 2020 Leon Kowarschick
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides an action that allows you to change the position of windows by dragging them around.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.TiledWindowDragging
+  (
+  -- * Usage
+  -- $usage
+    dragWindow
+  )
+where
+import           XMonad
+import qualified XMonad.StackSet               as W
+import           XMonad.Layout.DraggingVisualizer
+import           Control.Monad
+
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.TiledWindowDragging
+-- > import XMonad.Layout.DraggingVisualizer
+--
+-- then edit your 'layoutHook' by adding the draggingVisualizer to your layout:
+-- 
+-- > myLayout = draggingVisualizer $ layoutHook def
+--
+-- Then add a mouse binding for 'dragWindow':
+--
+-- > , ((modMask .|. shiftMask, button1), dragWindow)
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+
+
+-- | Create a mouse binding for this to be able to drag your windows around.
+-- You need "XMonad.Layout.DraggingVisualizer" for this to look good.
+dragWindow :: Window -> X ()
+dragWindow window = whenX (isClient window) $ do
+    focus window
+    (offsetX, offsetY)                <- getPointerOffset window
+    (winX, winY, winWidth, winHeight) <- getWindowPlacement window
+
+    mouseDrag
+        (\posX posY ->
+          let rect = Rectangle (fInt (fInt winX + (posX - fInt offsetX)))
+                               (fInt (fInt winY + (posY - fInt offsetY)))
+                               (fInt winWidth)
+                               (fInt winHeight)
+          in  sendMessage $ DraggingWindow window rect
+        )
+        (sendMessage DraggingStopped >> performWindowSwitching window)
+
+
+-- | get the pointer offset relative to the given windows root coordinates
+getPointerOffset :: Window -> X (Int, Int)
+getPointerOffset win = do
+    (_, _, _, oX, oY, _, _, _) <- withDisplay (\d -> io $ queryPointer d win)
+    return (fInt oX, fInt oY)
+
+-- | return a tuple of windowX, windowY, windowWidth, windowHeight
+getWindowPlacement :: Window -> X (Int, Int, Int, Int)
+getWindowPlacement window = do
+    wa <- withDisplay (\d -> io $ getWindowAttributes d window)
+    return (fInt $ wa_x wa, fInt $ wa_y wa, fInt $ wa_width wa, fInt $ wa_height wa)
+
+
+performWindowSwitching :: Window -> X ()
+performWindowSwitching win = do
+    root                          <- asks theRoot
+    (_, _, selWin, _, _, _, _, _) <- withDisplay (\d -> io $ queryPointer d root)
+    ws                            <- gets windowset
+    let allWindows = W.index ws
+    when ((win `elem` allWindows) && (selWin `elem` allWindows)) $ do
+        let allWindowsSwitched = map (switchEntries win selWin) allWindows
+        let (ls, t : rs)       = break (== win) allWindowsSwitched
+        let newStack           = W.Stack t (reverse ls) rs
+        windows $ W.modify' $ const newStack
+   where
+    switchEntries a b x | x == a    = b
+                        | x == b    = a
+                        | otherwise = x
+
+
+
+-- | shorthand for fromIntegral
+fInt :: Integral a => Integral b => a -> b
+fInt = fromIntegral
+
+

XMonad/Actions/TopicSpace.hs

@@ -1,4 +1,3 @@
-{-# LANGUAGE DeriveDataTypeable #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.TopicSpace
@@ -19,21 +18,40 @@ module XMonad.Actions.TopicSpace
 
   -- * Usage
   -- $usage
-   Topic
+
+  -- * Types for Building Topics
+    Topic
   , Dir
   , TopicConfig(..)
+
+    -- * Default Topic Config
   , def
-  , defaultTopicConfig
+
-  , getLastFocusedTopics
+    -- * Switching and Shifting Topics
-  , setLastFocusedTopic
+  , switchTopic
-  , reverseLastFocusedTopics
+  , switchTopicWith
-  , pprWindowSet
+  , switchNthLastFocused
+  , switchNthLastFocusedByScreen
+  , switchNthLastFocusedExclude
+  , shiftNthLastFocused
+
+    -- * Topic Actions
   , topicActionWithPrompt
   , topicAction
   , currentTopicAction
-  , switchTopic
+
-  , switchNthLastFocused
+    -- * Getting the Topic History
-  , shiftNthLastFocused
+  , getLastFocusedTopics
+  , getLastFocusedTopicsByScreen
+
+    -- * Modifying the Topic History
+  , setLastFocusedTopic
+  , reverseLastFocusedTopics
+
+    -- * Pretty Printing
+  , pprWindowSet
+
+    -- * Utility
   , currentTopicDir
   , checkTopicConfig
   , (>*>)
@@ -42,24 +60,28 @@ where
 
 import XMonad
 
-import Data.List
+import qualified Data.Map                as M
-import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
-import Data.Ord
-import qualified Data.Map as M
-import Control.Monad (liftM2,when,unless,replicateM_)
-import System.IO
-
-import qualified XMonad.StackSet as W
-
-import XMonad.Prompt
-import XMonad.Prompt.Workspace
-
-import XMonad.Hooks.UrgencyHook
-import XMonad.Hooks.DynamicLog (PP(..))
 import qualified XMonad.Hooks.DynamicLog as DL
+import qualified XMonad.StackSet         as W
+
+import Control.Applicative (liftA2)
+import Control.Monad (replicateM_, unless, when)
+import Data.List ((\\), elemIndex, nub, sort, sortOn)
+import Data.Maybe (fromJust, fromMaybe, isNothing, listToMaybe)
+import System.IO (hClose, hPutStr)
+
+import XMonad.Prompt (XPConfig)
+import XMonad.Prompt.Workspace (workspacePrompt)
+
+import XMonad.Hooks.DynamicLog (PP(ppHidden, ppVisible))
+import XMonad.Hooks.UrgencyHook (readUrgents)
+import XMonad.Hooks.WorkspaceHistory
+    ( workspaceHistory
+    , workspaceHistoryByScreen
+    , workspaceHistoryModify
+    )
 
 import XMonad.Util.Run (spawnPipe)
-import qualified XMonad.Util.ExtensibleState as XS
 
 -- $overview
 -- This module allows to organize your workspaces on a precise topic basis.  So
@@ -75,7 +97,23 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- of last focused topics.
 
 -- $usage
--- Here is an example of configuration using TopicSpace:
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import qualified Data.Map        as M
+-- > import qualified XMonad.StackSet as W
+-- >
+-- > import XMonad.Actions.TopicSpace
+--
+-- You will then have to
+--
+--   * Define new a new 'TopicConfig'
+--
+--   * Add the appropriate keybindings
+--
+--   * Replace the @workspaces@ field in your 'XConfig' with a list of your
+--     topics names
+--
+-- Let us go through a full example together.  Given the following topic names
 --
 -- > -- The list of all topics/workspaces of your xmonad configuration.
 -- > -- The order is important, new topics must be inserted
@@ -88,7 +126,9 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- >   , "mail", "movie", "music", "talk", "text", "tools", "web", "xmonad"
 -- >   , "yi", "documents", "twitter", "pdf"
 -- >   ]
--- >
+--
+-- we can define a 'TopicConfig' like this
+--
 -- > myTopicConfig :: TopicConfig
 -- > myTopicConfig = def
 -- >   { topicDirs = M.fromList $
@@ -131,25 +171,22 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- >       , ("pdf",        spawn pdfViewerCmd)
 -- >       ]
 -- >   }
--- >
+--
--- > -- extend your keybindings
+-- Above we have used the `spawnShell` and `spawnShellIn` helper functions; here
--- > myKeys conf@XConfig{modMask=modm} =
+-- they are:
--- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
+--
--- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
--- >   , ((modm              , xK_g     ), promptedGoto)
--- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)
--- >   {- more  keys ... -}
--- >   ]
--- >   ++
--- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)
--- >   | (i, k) <- zip [1..] workspaceKeys]
--- >
 -- > spawnShell :: X ()
 -- > spawnShell = currentTopicDir myTopicConfig >>= spawnShellIn
 -- >
 -- > spawnShellIn :: Dir -> X ()
 -- > spawnShellIn dir = spawn $ "urxvt '(cd ''" ++ dir ++ "'' && " ++ myShell ++ " )'"
--- >
+-- > -- Some terminals support a working-directory option directly:
+-- > -- spawnShellIn dir = spawn $ "alacritty --working-directory " ++ dir
+--
+-- Next, we define some other other useful helper functions.  Note that some of
+-- these function make use of the 'workspacePrompt' function.  You will also
+-- have to have an already defined 'XPConfig' (here called @myXPConfig@).
+--
 -- > goto :: Topic -> X ()
 -- > goto = switchTopic myTopicConfig
 -- >
@@ -159,22 +196,51 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- > promptedShift :: X ()
 -- > promptedShift = workspacePrompt myXPConfig $ windows . W.shift
 -- >
+-- > -- Toggle between the two most recently used topics while filtering
+-- > -- out the scratchpad topic.
+-- > toggleTopic :: X ()
+-- > toggleTopic = switchNthLastFocusedExclude ["NSP"] myTopicConfig 1
+--
+-- Hopefully you've gotten a general feeling of how to define these kind of
+-- small helper functions using what's provided in this module.
+--
+-- Adding the appropriate keybindings works as it normally would:
+--
+-- > -- extend your keybindings
+-- > myKeys conf@XConfig{modMask=modm} =
+-- >   [ ((modm              , xK_n     ), spawnShell) -- %! Launch terminal
+-- >   , ((modm              , xK_a     ), currentTopicAction myTopicConfig)
+-- >   , ((modm              , xK_g     ), promptedGoto)
+-- >   , ((modm .|. shiftMask, xK_g     ), promptedShift)
+-- >   , ((modm .|. shiftMask, xK_space ), toggleTopic)
+-- >   {- more  keys ... -}
+-- >   ]
+-- >   ++
+-- >   -- Switching to recently used topics
+-- >   [ ((modm, k), switchNthLastFocused myTopicConfig i)
+-- >   | (i, k) <- zip [1..] workspaceKeys]
+--
+-- If you want a more "default" experience with regards to @M-1@ through @M-9@
+-- (i.e. switch to the first nine topics in `myTopics` instead of switching to
+-- the last used ones), you can replace the last list above with the following
+-- (using "EZConfig" syntax):
+--
+-- >   -- The following does two things:
+-- >   --   1. Switch topics (no modifier)
+-- >   --   2. Move focused window to topic N (shift modifier)
+-- >   [ ("M-" ++ m ++ k, f i)
+-- >   | (i, k) <- zip myTopics (map show [1 .. 9 :: Int])
+-- >   , (f, m) <- [(goto, ""), (windows . W.shift, "S-")]
+-- >   ]
+--
+-- We can now put the whole configuration together with the following (while
+-- also checking that we haven't made any mistakes):
+--
 -- > myConfig = do
 -- >     checkTopicConfig myTopics myTopicConfig
--- >     myLogHook <- makeMyLogHook
 -- >     return $ def
--- >          { borderWidth = 1 -- Width of the window border in pixels.
+-- >          { workspaces = myTopics
--- >          , workspaces = myTopics
+-- >          , keys       = myKeys
--- >          , layoutHook = myModifiers myLayout
--- >          , manageHook = myManageHook
--- >          , logHook = myLogHook
--- >          , handleEventHook = myHandleEventHook
--- >          , terminal = myTerminal -- The preferred terminal program.
--- >          , normalBorderColor = "#3f3c6d"
--- >          , focusedBorderColor = "#4f66ff"
--- >          , XMonad.modMask = mod1Mask
--- >          , keys = myKeys
--- >          , mouseBindings = myMouseBindings
 -- >          }
 -- >
 -- > main :: IO ()
@@ -188,85 +254,80 @@ infix >*>
 -- | 'Topic' is just an alias for 'WorkspaceId'
 type Topic = WorkspaceId
 
--- | 'Dir' is just an alias for 'FilePath' but should points to a directory.
+-- | 'Dir' is just an alias for 'FilePath', but should point to a directory.
 type Dir = FilePath
 
 -- | Here is the topic space configuration area.
 data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
-                                 -- ^ This mapping associate a directory to each topic.
+                                 -- ^ This mapping associates a directory to each topic.
                                , topicActions       :: M.Map Topic (X ())
-                                 -- ^ This mapping associate an action to trigger when
+                                 -- ^ This mapping associates an action to trigger when
                                  -- switching to a given topic which workspace is empty.
                                , defaultTopicAction :: Topic -> X ()
                                  -- ^ This is the default topic action.
                                , defaultTopic       :: Topic
-                                 -- ^ This is the default topic.
+                                 -- ^ This is the default (= fallback) topic.
                                , maxTopicHistory    :: Int
-                                 -- ^ This setups the maximum depth of topic history, usually
+                                 -- ^ This specifies the maximum depth of the topic history;
-                                 -- 10 is a good default since we can bind all of them using
+                                 -- usually 10 is a good default since we can bind all of
-                                 -- numeric keypad.
+                                 -- them using numeric keypad.
                                }
 
 instance Default TopicConfig where
-    def            = TopicConfig { topicDirs = M.empty
+  def            = TopicConfig { topicDirs = M.empty
-                                 , topicActions = M.empty
+                               , topicActions = M.empty
-                                 , defaultTopicAction = const (ask >>= spawn . terminal . config)
+                               , defaultTopicAction = const (ask >>= spawn . terminal . config)
-                                 , defaultTopic = "1"
+                               , defaultTopic = "1"
-                                 , maxTopicHistory = 10
+                               , maxTopicHistory = 10
-                                 }
+                               }
 
-{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
+-- | Return the (possibly empty) list of last focused topics.
-defaultTopicConfig :: TopicConfig
+getLastFocusedTopics :: X [Topic]
-defaultTopicConfig = def
+getLastFocusedTopics = workspaceHistory
 
-newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
+-- | Like 'getLastFocusedTopics', but group the topics by their screen-id's.
-instance ExtensionClass PrevTopics where
+getLastFocusedTopicsByScreen :: X [(ScreenId, [Topic])]
-    initialValue = PrevTopics []
+getLastFocusedTopicsByScreen = workspaceHistoryByScreen
-    extensionType = PersistentExtension
 
--- | Returns the list of last focused workspaces the empty list otherwise.
+-- | Given a 'TopicConfig', a topic, and a predicate to select topics that one
-getLastFocusedTopics :: X [String]
+-- wants to keep, this function will cons the topic in front of the list of
-getLastFocusedTopics = XS.gets getPrevTopics
+-- last focused topics and filter it according to the predicate.  Note that we
-
+-- prune the list in case that its length exceeds 'maxTopicHistory'.
--- | Given a 'TopicConfig', the last focused topic, and a predicate that will
+setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
--- select topics that one want to keep, this function will set the property
+setLastFocusedTopic tc w predicate = do
--- of last focused topics.
+  sid <- gets $ W.screen . W.current . windowset
-setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
+  workspaceHistoryModify $
-setLastFocusedTopic w predicate =
+    take (maxTopicHistory tc) . nub . filter (predicate . snd) . ((sid, w) :)
-  XS.modify $ PrevTopics
-    . seqList . nub . (w:) . filter predicate
-    . getPrevTopics
-  where seqList xs = length xs `seq` xs
 
 -- | Reverse the list of "last focused topics"
 reverseLastFocusedTopics :: X ()
-reverseLastFocusedTopics =
+reverseLastFocusedTopics = workspaceHistoryModify reverse
-  XS.modify $ PrevTopics . reverse . getPrevTopics
 
 -- | This function is a variant of 'DL.pprWindowSet' which takes a topic configuration
 -- and a pretty-printing record 'PP'. It will show the list of topics sorted historically
--- and highlighting topics with urgent windows.
+-- and highlight topics with urgent windows.
 pprWindowSet :: TopicConfig -> PP -> X String
 pprWindowSet tg pp = do
-    winset <- gets windowset
+  winset <- gets windowset
-    urgents <- readUrgents
+  urgents <- readUrgents
-    let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
+  let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
-        maxDepth = maxTopicHistory tg
+      maxDepth = maxTopicHistory tg
-    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
+  setLastFocusedTopic tg
-                        (`notElem` empty_workspaces)
+                      (W.tag . W.workspace . W.current $ winset)
-    lastWs <- getLastFocusedTopics
+                      (`notElem` empty_workspaces)
-    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
+  lastWs <- getLastFocusedTopics
-        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
+  let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
-        pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
+      add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
-        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
+      pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
-    return $ DL.pprWindowSet sortWindows urgents pp' winset
+      sortWindows = take maxDepth . sortOn (depth . W.tag)
+  return $ DL.pprWindowSet sortWindows urgents pp' winset
 
--- | Given a prompt configuration and a topic configuration, triggers the action associated with
+-- | Given a prompt configuration and a topic configuration, trigger the action associated with
 -- the topic given in prompt.
 topicActionWithPrompt :: XPConfig -> TopicConfig -> X ()
-topicActionWithPrompt xp tg = workspacePrompt xp (liftM2 (>>) (switchTopic tg) (topicAction tg))
+topicActionWithPrompt xp tg = workspacePrompt xp (liftA2 (>>) (switchTopic tg) (topicAction tg))
 
--- | Given a configuration and a topic, triggers the action associated with the given topic.
+-- | Given a configuration and a topic, trigger the action associated with the given topic.
 topicAction :: TopicConfig -> Topic -> X ()
 topicAction tg topic = fromMaybe (defaultTopicAction tg topic) $ M.lookup topic $ topicActions tg
 
@@ -276,42 +337,74 @@ currentTopicAction tg = topicAction tg =<< gets (W.tag . W.workspace . W.current
 
 -- | Switch to the given topic.
 switchTopic :: TopicConfig -> Topic -> X ()
-switchTopic tg topic = do
+switchTopic = switchTopicWith (const True)
+
+-- | Like 'switchTopic', but give a custom filtering function to
+-- 'setLastFocusedTopic'.
+switchTopicWith :: (Topic -> Bool) -> TopicConfig -> Topic -> X ()
+switchTopicWith predicate tg topic = do
+  -- Switch to topic and add it to the last seen topics
   windows $ W.greedyView topic
+  setLastFocusedTopic tg topic predicate
+
+  -- If applicable, execute the topic action
   wins <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
   when (null wins) $ topicAction tg topic
 
--- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
+-- | Switch to the Nth last focused topic or fall back to the 'defaultTopic'.
 switchNthLastFocused :: TopicConfig -> Int -> X ()
-switchNthLastFocused tg depth = do
+switchNthLastFocused = switchNthLastFocusedExclude []
-  lastWs <- getLastFocusedTopics
-  switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth
 
--- | Shift the focused window to the Nth last focused topic, or fallback to doing nothing.
+-- | Like 'switchNthLastFocused', but also filter out certain topics.
+switchNthLastFocusedExclude :: [Topic] -> TopicConfig -> Int -> X ()
+switchNthLastFocusedExclude excludes tc depth = do
+  lastWs <- filter (`notElem` excludes) <$> getLastFocusedTopics
+  switchTopic tc $ (lastWs ++ repeat (defaultTopic tc)) !! depth
+
+-- | Like 'switchNthLastFocused', but only consider topics that used to
+-- be on the current screen.
+--
+-- For example, the following function allows one to toggle between the
+-- currently focused and the last used topic, while treating different
+-- screens completely independently from one another.
+--
+-- > toggleTopicScreen = switchNthLastFocusedByScreen myTopicConfig 1
+switchNthLastFocusedByScreen :: TopicConfig -> Int -> X ()
+switchNthLastFocusedByScreen tc depth = do
+  sid <- gets $ W.screen . W.current . windowset
+  sws <- fromMaybe []
+       . listToMaybe
+       . map snd
+       . filter ((== sid) . fst)
+     <$> getLastFocusedTopicsByScreen
+  switchTopic tc $ (sws ++ repeat (defaultTopic tc)) !! depth
+
+-- | Shift the focused window to the Nth last focused topic, or fall back to doing nothing.
 shiftNthLastFocused :: Int -> X ()
 shiftNthLastFocused n = do
   ws <- fmap (listToMaybe . drop n) getLastFocusedTopics
   whenJust ws $ windows . W.shift
 
--- | Returns the directory associated with current topic returns the empty string otherwise.
+-- | Return the directory associated with the current topic, or return the empty
-currentTopicDir :: TopicConfig -> X String
+-- string if the topic could not be found.
+currentTopicDir :: TopicConfig -> X FilePath
 currentTopicDir tg = do
   topic <- gets (W.tag . W.workspace . W.current . windowset)
   return . fromMaybe "" . M.lookup topic $ topicDirs tg
 
--- | Check the given topic configuration for duplicates topics or undefined topics.
+-- | Check the given topic configuration for duplicate or undefined topics.
 checkTopicConfig :: [Topic] -> TopicConfig -> IO ()
 checkTopicConfig tags tg = do
-    -- tags <- gets $ map W.tag . workspaces . windowset
+  -- tags <- gets $ map W.tag . workspaces . windowset
 
-    let
+  let
-      seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
+    seenTopics = nub $ sort $ M.keys (topicDirs tg) ++ M.keys (topicActions tg)
-      dups       = tags \\ nub tags
+    dups       = tags \\ nub tags
-      diffTopic  = seenTopics \\ sort tags
+    diffTopic  = seenTopics \\ sort tags
-      check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
+    check lst msg = unless (null lst) $ xmessage $ msg ++ " (tags): " ++ show lst
 
-    check diffTopic "Seen but missing topics/workspaces"
+  check diffTopic "Seen but missing topics/workspaces"
-    check dups      "Duplicate topics/workspaces"
+  check dups      "Duplicate topics/workspaces"
 
 -- | Display the given message using the @xmessage@ program.
 xmessage :: String -> IO ()

XMonad/Actions/TreeSelect.hs

@@ -599,7 +599,7 @@ drawNode ix iy TSNode{..} col = do
     colormap <- gets tss_colormap
     visual   <- gets tss_visual
     liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
-        (ix * ts_indent) (iy * ts_node_height)
+        (ix * ts_indent + ts_originX) (iy * ts_node_height + ts_originY)
         ts_node_width ts_node_height
 
     -- TODO: draw extra text (transparent background? or ts_background)

XMonad/Actions/WindowBringer.hs

@@ -21,17 +21,16 @@ module XMonad.Actions.WindowBringer (
                     WindowBringerConfig(..),
                     gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
                     bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
-                    windowMap, windowMap', bringWindow, actionMenu
+                    windowMap, windowAppMap, windowMap', bringWindow, actionMenu
                    ) where
 
-import Control.Applicative((<$>))
 import qualified Data.Map as M
 
 import qualified XMonad.StackSet as W
 import XMonad
 import qualified XMonad as X
 import XMonad.Util.Dmenu (menuMapArgs)
-import XMonad.Util.NamedWindows (getName)
+import XMonad.Util.NamedWindows (getName, getNameWMClass)
 
 -- $usage
 --
@@ -137,6 +136,10 @@ actionMenu WindowBringerConfig{ menuCommand = cmd
 windowMap :: X (M.Map String Window)
 windowMap = windowMap' decorateName
 
+-- | A map from application executable names to Windows.
+windowAppMap :: X (M.Map String Window)
+windowAppMap = windowMap' decorateAppName
+
 -- | A map from window names to Windows, given a windowTitler function.
 windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
 windowMap' titler = do
@@ -152,3 +155,11 @@ decorateName :: X.WindowSpace -> Window -> X String
 decorateName ws w = do
   name <- show <$> getName w
   return $ name ++ " [" ++ W.tag ws ++ "]"
+
+-- | Returns the window name as will be listed in dmenu.  This will
+-- return the executable name of the window along with it's workspace
+-- ID.
+decorateAppName :: X.WindowSpace -> Window -> X String
+decorateAppName ws w = do
+  name <- show <$> getNameWMClass w
+  return $ name ++ " [" ++ W.tag ws ++ "]"

XMonad/Actions/WindowNavigation.hs

@@ -43,7 +43,6 @@ import XMonad
 import XMonad.Util.Types (Direction2D(..))
 import qualified XMonad.StackSet as W
 
-import Control.Applicative ((<$>))
 import Control.Arrow (second)
 import Data.IORef
 import Data.List (sortBy)
@@ -137,11 +136,11 @@ withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
       setPosition posRef pos targetRect
 
 trackMovement :: IORef WNState -> X ()
-trackMovement posRef = fromCurrentPoint posRef $ \win pos -> do
+trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
                            windowRect win >>= flip whenJust (setPosition posRef pos . snd)
 
 fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
-fromCurrentPoint posRef f = withFocused $ \win -> do
+fromCurrentPoint posRef f = withFocused $ \win ->
                                 currentPosition posRef >>= f win
 
 -- Gets the current position from the IORef passed in, or if nothing (say, from

XMonad/Actions/WorkspaceCursors.hs

@@ -48,8 +48,8 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                     LayoutModifier(handleMess, redoLayout))
 import XMonad(Typeable, Message, WorkspaceId, X, XState(windowset),
               fromMessage, sendMessage, windows, gets)
-import Control.Monad((<=<), guard, liftM, liftM2, when)
+import Control.Applicative (liftA2)
-import Control.Applicative((<$>))
+import Control.Monad((<=<), guard, when)
 import Data.Foldable(Foldable(foldMap), toList)
 import Data.Maybe(fromJust, listToMaybe)
 import Data.Monoid(Monoid(mappend, mconcat))
@@ -161,12 +161,12 @@ focusDepth (Cons x) = 1 + focusDepth (W.focus x)
 focusDepth (End  _) = 0
 
 descend :: Monad m =>(W.Stack (Cursors a) -> m (W.Stack (Cursors a)))-> Int-> Cursors a-> m (Cursors a)
-descend f 1 (Cons x) = Cons `liftM` f x
+descend f 1 (Cons x) = Cons <$> f x
-descend f n (Cons x) | n > 1 = liftM Cons $ descend f (pred n) `onFocus` x
+descend f n (Cons x) | n > 1 = fmap Cons $ descend f (pred n) `onFocus` x
 descend _ _ x = return x
 
 onFocus :: (Monad m) => (a1 -> m a1) -> W.Stack a1 -> m (W.Stack a1)
-onFocus f st = (\x -> st { W.focus = x}) `liftM` f (W.focus st)
+onFocus f st = (\x -> st { W.focus = x}) <$> f (W.focus st)
 
 -- | @modifyLayer@ is used to change the focus at a given depth
 modifyLayer :: (W.Stack (Cursors String) -> W.Stack (Cursors String)) -> Int -> X ()
@@ -192,7 +192,7 @@ modifyLayer' :: (W.Stack (Cursors String) -> X (W.Stack (Cursors String))) -> In
 modifyLayer' f depth = modifyCursors (descend f depth)
 
 modifyCursors ::  (Cursors String -> X (Cursors String)) -> X ()
-modifyCursors = sendMessage . ChangeCursors . (liftM2 (>>) updateXMD return <=<)
+modifyCursors = sendMessage . ChangeCursors . (liftA2 (>>) updateXMD return <=<)
 
 data WorkspaceCursors a = WorkspaceCursors (Cursors String)
     deriving (Typeable,Read,Show)

XMonad/Actions/WorkspaceNames.hs

@@ -37,7 +37,10 @@ module XMonad.Actions.WorkspaceNames (
     swapWithCurrent,
 
     -- * Workspace prompt
-    workspaceNamePrompt
+    workspaceNamePrompt,
+
+    -- * EwmhDesktops integration
+    workspaceNamesListTransform
     ) where
 
 import XMonad
@@ -101,17 +104,16 @@ getWorkspaceNames' = do
 -- workspaces with a name, and to @\"t\"@ otherwise.
 getWorkspaceNames :: X (WorkspaceId -> String)
 getWorkspaceNames = do
-    lookup <- getWorkspaceNames'
+    lookup' <- getWorkspaceNames'
-    return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)
+    return $ \wks -> wks ++ maybe "" (':' :) (lookup' wks)
 
 -- | Gets the name of a workspace, if set, otherwise returns nothing.
 getWorkspaceName :: WorkspaceId -> X (Maybe String)
-getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
+getWorkspaceName w = ($ w) <$> getWorkspaceNames'
 
 -- | Gets the name of the current workspace. See 'getWorkspaceName'
 getCurrentWorkspaceName :: X (Maybe String)
-getCurrentWorkspaceName = do
+getCurrentWorkspaceName = getWorkspaceName =<< gets (W.currentTag . windowset)
-    getWorkspaceName =<< gets (W.currentTag . windowset)
 
 -- | Sets the name of a workspace. Empty string makes the workspace unnamed
 -- again.
@@ -129,7 +131,7 @@ setCurrentWorkspaceName name = do
 
 -- | Prompt for a new name for the current workspace and set it.
 renameWorkspace :: XPConfig -> X ()
-renameWorkspace conf = do
+renameWorkspace conf =
     mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
     where pr = Wor "Workspace name: "
 
@@ -185,3 +187,14 @@ workspaceNamePrompt conf job = do
                                 Just i -> i
         contains completions input =
           return $ filter (Data.List.isInfixOf input) completions
+
+-- | Workspace list transformation for
+-- 'XMonad.Hooks.EwmhDesktops.ewmhDesktopsLogHookCustom' that exposes
+-- workspace names to pagers and other EWMH-aware clients.
+--
+-- Usage:
+-- > logHook = (workspaceNamesListTransform >>= ewmhDesktopsLogHookCustom) <+> …
+workspaceNamesListTransform :: X ([WindowSpace] -> [WindowSpace])
+workspaceNamesListTransform = do
+    names <- getWorkspaceNames
+    return $ map $ \ws -> ws{ W.tag = names $ W.tag ws }

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

@@ -58,6 +58,7 @@ import XMonad
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Util.Cursor
+import qualified XMonad.StackSet as W
 
 import qualified Data.Map as M
 
@@ -167,6 +168,7 @@ import qualified Data.Map as M
 desktopConfig = docks $ ewmh def
     { startupHook     = setDefaultCursor xC_left_ptr <+> startupHook def
     , layoutHook      = desktopLayoutModifiers $ layoutHook def
+    , logHook         = desktopLogHook <+> logHook def
     , keys            = desktopKeys <+> keys def }
 
 desktopKeys (XConfig {modMask = modm}) = M.fromList $
@@ -174,3 +176,8 @@ desktopKeys (XConfig {modMask = modm}) = M.fromList $
 
 desktopLayoutModifiers layout = avoidStruts layout
 
+-- | 'logHook' preserving old 'ewmh' behavior to switch workspace and focus to
+-- activated window.
+desktopLogHook :: X ()
+desktopLogHook      = activateLogHook (reader W.focusWindow >>= doF)
+

XMonad/Config/Example.hs

@@ -30,7 +30,8 @@ main = do
     { modMask    = mod4Mask -- Use the "Win" key for the mod key
     , manageHook = myManageHook <+> manageHook desktopConfig
     , layoutHook = desktopLayoutModifiers $ myLayouts
-    , logHook    = dynamicLogString def >>= xmonadPropLog
+    , logHook    = (dynamicLogString def >>= xmonadPropLog)
+                    <+> logHook desktopConfig
     }
 
     `additionalKeysP` -- Add some extra key bindings:

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.
@@ -72,7 +72,7 @@ gnomeRun = withDisplay $ \dpy -> do
 -- > gconftool-2 -s /desktop/gnome/session/required_components/windowmanager xmonad --type string
 gnomeRegister :: MonadIO m => m ()
 gnomeRegister = io $ do
-    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
+    x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
     whenJust x $ \sessionId -> safeSpawn "dbus-send"
             ["--session"
             ,"--print-reply=literal"

XMonad/Config/Mate.hs

@@ -77,7 +77,7 @@ mateRun = withDisplay $ \dpy -> do
 -- (the extra quotes are required by dconf)
 mateRegister :: MonadIO m => m ()
 mateRegister = io $ do
-    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
+    x <- lookup "DESKTOP_AUTOSTART_ID" <$> getEnvironment
     whenJust x $ \sessionId -> safeSpawn "dbus-send"
             ["--session"
             ,"--print-reply=literal"

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/Doc/Extending.hs

@@ -467,7 +467,7 @@ Here is a list of the modules found in @XMonad.Hooks@:
 * "XMonad.Hooks.DebugStack":
     Dump the state of the StackSet. A logHook and handleEventHook are also provided.
 
-* "Xmonad.Hooks.DynamicBars":
+* "XMonad.Hooks.DynamicBars":
     Manage per-screen status bars.
 
 * "XMonad.Hooks.DynamicHooks":
@@ -572,6 +572,11 @@ Here is a list of the modules found in @XMonad.Hooks@:
 * "XMonad.Hooks.WorkspaceHistory":
     Keeps track of workspace viewing order.
 
+* "XMonad.Hooks.WindowSwallowing"
+    A handleEventHook that implements window swallowing:
+    Hide parent windows like terminals when opening other programs (like image viewers) from within them,
+    restoring them once the child application closes.
+
 * "XMonad.Hooks.XPropManage":
     A ManageHook matching on XProperties.
 
@@ -899,6 +904,10 @@ For more information on using those modules for customizing your
     More useful tiled layout that allows you to change a width\/height of window.
     See also "XMonad.Layout.MouseResizableTile".
 
+* "XMonad.Layout.ResizableThreeColumns":
+    The same layout as ThreeColumns but, similar to ResizableTile, allows you
+    to change the width\/height of the slave windows.
+
 * "XMonad.Layout.ResizeScreen":
     A layout transformer to have a layout respect a given screen
     geometry. Mostly used with "Decoration" (the Horizontal and the
@@ -1043,6 +1052,9 @@ These are the available prompts:
     intended mostly as an example of using "XMonad.Prompt.Input" to
     build an action requiring user input.
 
+* "XMonad.Prompt.FuzzyMatch":
+    A module for fuzzy completion matching in prompts akin to emacs ido mode
+
 * "XMonad.Prompt.Input":
     A generic framework for prompting the user for input and passing it
     along to some other action.
@@ -1076,6 +1088,9 @@ These are the available prompts:
 * "XMonad.Prompt.Theme":
     A prompt for changing the theme of the current workspace
 
+* "XMonad.Prompt.Unicode":
+    A prompt for inputting Unicode characters
+
 * "XMonad.Prompt.Window":
     xprompt operations to bring windows to you, and bring you to windows.
 
@@ -1102,6 +1117,15 @@ external utilities.
 
 A non complete list with a brief description:
 
+* "XMonad.Util.ActionCycle":
+    Provides a way to implement cycling actions. This can be used to implement
+    things like alternating, toggle-style keybindings.
+
+* "XMonad.Util.ClickableWorkspaces":
+    Provides clickablePP, which when applied to the PP pretty-printer used by
+    'XMonad.Hooks.DynamicLog.dynamicLogWithPP', will make the workspace tags
+    clickable in XMobar (for switching focus).
+
 * "XMonad.Util.Cursor": configure the default cursor/pointer glyph.
 
 * "XMonad.Util.CustomKeys": configure key bindings (see

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
@@ -189,7 +190,7 @@ debugEventsHook' (ClientMessageEvent    {ev_window       = w
                   ta <- getAtom ta'
                   return (ta,b,l)
   let wl = bytes b
-  vs <- io $ take (l * wl) `fmap` splitCInt vs'
+  vs <- io $ take (l * wl) <$> splitCInt vs'
   s <- dumpProperty' w a n ta b vs 0 (10 + length n)
   say "  message" $ n ++ s
 
@@ -198,7 +199,7 @@ debugEventsHook' _                      = return ()
 -- | Emit information about an atom.
 atomName   :: Atom -> X String
 atomName a =  withDisplay $ \d ->
-  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") `fmap` getAtomName d a
+  io $ fromMaybe ("(unknown atom " ++ show a ++ ")") <$> getAtomName d a
 
 -- | Emit an atom with respect to the current event.
 atomEvent     :: String -> Atom -> X ()
@@ -312,9 +313,9 @@ dumpProperty a n w i  =  do
               vsp
     case rc of
       0 -> do
-        fmt <- fromIntegral `fmap` peek fmtp
+        fmt <- fromIntegral <$> peek fmtp
         vs' <-                     peek vsp
-        sz  <- fromIntegral `fmap` peek szp
+        sz  <- fromIntegral <$> peek szp
         case () of
           () | fmt == none     -> xFree vs' >> return (Left   "(property deleted)"   )
              | sz < 0          -> xFree vs' >> return (Left $ "(illegal bit size " ++
@@ -324,9 +325,9 @@ dumpProperty a n w i  =  do
                                                               show sz              ++
                                                               ")"                    )
              | otherwise       -> do
-                 len <- fromIntegral `fmap` peek lenp
+                 len <- fromIntegral <$> peek lenp
                  -- that's as in "ack! it's fugged!"
-                 ack <- fromIntegral `fmap` peek ackp
+                 ack <- fromIntegral <$> peek ackp
                  vs <- peekArray (len * bytes sz) vs'
                  _ <- xFree vs'
                  return $ Right (fmt,sz,ack,vs)
@@ -526,7 +527,7 @@ dumpProp a _ | a == wM_NAME                           =  dumpString
              | a == sECONDARY                         =  dumpSelection
                -- this is gross
              | a == wM_TRANSIENT_FOR                  =  do
-                 root <- fromIntegral `fmap` inX (asks theRoot)
+                 root <- fromIntegral <$> inX (asks theRoot)
                  w <- asks window
                  WMHints {wmh_window_group = group} <-
                    inX $ asks display >>= io . flip getWMHints w
@@ -696,30 +697,31 @@ dumpList'' m ((l,p,t):ps) sep = do
 dumpString :: Decoder Bool
 dumpString =  do
   fmt <- asks pType
-  [cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
+  x <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
-  case () of
+  case x of
-    () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
+    [cOMPOUND_TEXT,uTF8_STRING] -> case () of
-       | fmt == sTRING        -> guardSize  8 $ do
+      () | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
-                                   vs <- gets value
+         | fmt == sTRING        -> guardSize  8 $ do
-                                   modify (\r -> r {value = []})
+                                     vs <- gets value
-                                   let ss = flip unfoldr (map twiddle vs) $
+                                     modify (\r -> r {value = []})
-                                            \s -> if null s
+                                     let ss = flip unfoldr (map twiddle vs) $
-                                                  then Nothing
+                                              \s -> if null s
-                                                  else let (w,s'') = break (== '\NUL') s
+                                                    then Nothing
-                                                           s'      = if null s''
+                                                    else let (w,s'') = break (== '\NUL') s
-                                                                     then s''
+                                                             s'      = if null s''
-                                                                     else tail s''
+                                                                       then s''
-                                                        in Just (w,s')
+                                                                       else tail s''
-                                   case ss of
+                                                          in Just (w,s')
-                                     [s] -> append $ show s
+                                     case ss of
-                                     ss' -> let go (s:ss'') c = append c        >>
+                                       [s] -> append $ show s
-                                                                append (show s) >>
+                                       ss' -> let go (s:ss'') c = append c        >>
-                                                                go ss'' ","
+                                                                  append (show s) >>
-                                                go []       _ = append "]"
+                                                                  go ss'' ","
-                                             in append "[" >> go ss' ""
+                                                  go []       _ = append "]"
-       | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
+                                               in append "[" >> go ss' ""
-       | otherwise            -> (inX $ atomName fmt) >>=
+         | fmt == uTF8_STRING   -> dumpUTF -- duplicate type test instead of code :)
-                                 failure . ("unrecognized string type " ++)
+         | otherwise            -> (inX $ atomName fmt) >>=
+                                   failure . ("unrecognized string type " ++)
 
 -- show who owns a selection
 dumpSelection :: Decoder Bool
@@ -738,7 +740,7 @@ dumpSelection =  do
 -- for now, not querying Xkb
 dumpXKlInds :: Decoder Bool
 dumpXKlInds =  guardType iNTEGER $ do
-                 n <- fmap fromIntegral `fmap` getInt' 32
+                 n <- fmap fromIntegral <$> getInt' 32
                  case n of
                    Nothing -> propShortErr
                    Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])
@@ -847,7 +849,7 @@ dumpPixmap =  guardType pIXMAP $ do
                   Just p  -> do
                     append $ "pixmap " ++ showHex p ""
                     g' <- inX $ withDisplay $ \d -> io $
-                            Just `fmap` getGeometry d (fromIntegral p)
+                            (Just <$> getGeometry d (fromIntegral p))
                             `E.catch`
                             \e -> case fromException e of
                                     Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
@@ -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
 
@@ -943,7 +945,7 @@ dumpPid =  guardType cARDINAL $ do
                       case o of
                         Nothing -> append $ "pid " ++ pid
                         Just p' -> do
-                                  prc <- io $ lines `fmap` hGetContents p'
+                                  prc <- io $ lines <$> hGetContents p'
                                   -- deliberately forcing it
                                   append $ if length prc < 2
                                            then "pid " ++ pid
@@ -1005,7 +1007,7 @@ dumpMDBlocks _ =  propSimple "(drop site info)" -- @@@ maybe later if needed
 
 dumpMotifEndian :: Decoder Bool
 dumpMotifEndian =  guardType cARDINAL $ guardSize 8 $ do
-  c <- map twiddle `fmap` eat 1
+  c <- map twiddle <$> eat 1
   case c of
     ['l'] -> append "little"
     ['B'] -> append "big"
@@ -1164,7 +1166,7 @@ getInt' 64 =  guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
                 return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)
 getInt' w  =  guardR width w  (\a e -> propSizeErr a e >> return Nothing) $
               guardSize' (bytes w) (propShortErr >> return Nothing)       $
-              Just `fmap` inhale w
+              Just <$> inhale w
 
 -- parse an integral value and feed it to a show-er of some kind
 getInt     :: Int -> (Integer -> String) -> Decoder Bool
@@ -1176,25 +1178,28 @@ getInt w f =  getInt' w >>= maybe (return False) (append . f)
 -- @@@@@@@@@ evil beyond evil.  there *has* to be a better way
 inhale    :: Int -> Decoder Integer
 inhale  8 =  do
-               [b] <- eat 1
+               x <- eat 1
-               return $ fromIntegral b
+               case x of
+                 [b] -> return $ fromIntegral b
 inhale 16 =  do
-               [b0,b1] <- eat 2
+               x <- eat 2
-               io $ allocaArray 2 $ \p -> do
+               case x of
-                 pokeArray p [b0,b1]
+                 [b0,b1] -> io $ allocaArray 2 $ \p -> do
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word16)
+                              pokeArray p [b0,b1]
-                 return $ fromIntegral v
+                              [v] <- peekArray 1 (castPtr p :: Ptr Word16)
+                              return $ fromIntegral v
 inhale 32 =  do
-               [b0,b1,b2,b3] <- eat 4
+               x <- eat 4
-               io $ allocaArray 4 $ \p -> do
+               case x of
-                 pokeArray p [b0,b1,b2,b3]
+                 [b0,b1,b2,b3] -> io $ allocaArray 4 $ \p -> do
-                 [v] <- peekArray 1 (castPtr p :: Ptr Word32)
+                                    pokeArray p [b0,b1,b2,b3]
-                 return $ fromIntegral v
+                                    [v] <- peekArray 1 (castPtr p :: Ptr Word32)
+                                    return $ fromIntegral v
 inhale  b =  error $ "inhale " ++ show b
 
 eat   :: Int -> Decoder Raw
 eat n =  do
-  (bs,rest) <- splitAt n `fmap` gets value
+  (bs,rest) <- splitAt n <$> gets value
   modify (\r -> r {value = rest})
   return bs
 

XMonad/Hooks/DynamicLog.hs

@@ -24,8 +24,10 @@ module XMonad.Hooks.DynamicLog (
 
     -- * Drop-in loggers
     dzen,
+    dzenWithFlags,
     xmobar,
     statusBar,
+    statusBar',
     dynamicLog,
     dynamicLogXinerama,
 
@@ -35,15 +37,15 @@ module XMonad.Hooks.DynamicLog (
     -- * Build your own formatter
     dynamicLogWithPP,
     dynamicLogString,
-    PP(..), defaultPP, def,
+    PP(..), def,
 
     -- * Example formatters
     dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
 
     -- * Formatting utilities
-    wrap, pad, trim, shorten,
+    wrap, pad, trim, shorten, shortenLeft,
-    xmobarColor, xmobarStrip,
+    xmobarColor, xmobarAction, xmobarBorder,
-    xmobarStripTags,
+    xmobarRaw, xmobarStrip, xmobarStripTags,
     dzenColor, dzenEscape, dzenStrip,
 
     -- * Internal formatting functions
@@ -58,10 +60,11 @@ module XMonad.Hooks.DynamicLog (
 -- Useful imports
 
 import Codec.Binary.UTF8.String (encodeString)
-import Control.Monad (liftM2, msum)
+import Control.Applicative (liftA2)
+import Control.Monad (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 +153,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 +188,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'"
@@ -197,14 +224,27 @@ statusBar :: LayoutClass l Window
                        -- ^ the desired key binding to toggle bar visibility
           -> XConfig l -- ^ the base config
           -> IO (XConfig (ModifiedLayout AvoidStruts l))
-statusBar cmd pp k conf = do
+statusBar cmd pp = statusBar' cmd (return pp)
+
+-- | Like 'statusBar' with the pretty printing options embedded in the
+-- X monad. The X PP value is re-executed every time the 'logHook' runs.
+-- Useful if printing options need to be modified dynamically.
+statusBar' :: LayoutClass l Window
+           => String       -- ^ the command line to launch the status bar
+           -> X PP         -- ^ the pretty printing options
+           -> (XConfig Layout -> (KeyMask, KeySym))
+                           -- ^ the desired key binding to toggle bar visibility
+           -> XConfig l    -- ^ the base config
+           -> IO (XConfig (ModifiedLayout AvoidStruts l))
+statusBar' cmd xpp k conf = do
     h <- spawnPipe cmd
     return $ docks $ conf
         { layoutHook = avoidStruts (layoutHook conf)
         , logHook = do
                         logHook conf
+                        pp <- xpp
                         dynamicLogWithPP pp { ppOutput = hPutStrLn h }
-        , keys       = liftM2 M.union keys' (keys conf)
+        , keys       = liftA2 M.union keys' (keys conf)
         }
  where
     keys' = (`M.singleton` sendMessage ToggleStruts) . k
@@ -295,7 +335,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                                       = liftA2 fromMaybe ppVisible ppVisibleNoWindows
                         | isJust (S.stack w)                                            = ppHidden
                         | otherwise                                                     = ppHiddenNoWindows
 
@@ -350,6 +391,14 @@ shorten n xs | length xs < n = xs
  where
     end = "..."
 
+-- | Like 'shorten', but truncate from the left instead of right.
+shortenLeft :: Int -> String -> String
+shortenLeft n xs | l < n     = xs
+                 | otherwise = end ++ (drop (l - n + length end) xs)
+ where
+    end = "..."
+    l = length xs
+
 -- | Output a list of strings, ignoring empty ones and separating the
 --   rest with the given separator.
 sepBy :: String   -- ^ separator
@@ -392,6 +441,43 @@ 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>"
+
+-- | Use xmobar box to add a border to an arbitrary string.
+xmobarBorder :: String -- ^ Border type. Possible values: VBoth, HBoth, Full,
+                       -- Top, Bottom, Left or Right
+             -> String -- ^ color: a color name, or #rrggbb format
+             -> Int    -- ^ width in pixels
+             -> String -- ^ output string
+             -> String
+xmobarBorder border color width = wrap prefix "</box>"
+  where
+    prefix = "<box type=" ++ border ++ " width=" ++ show width ++ " color="
+      ++ color ++ ">"
+
+-- | 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 +521,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
@@ -478,15 +566,12 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
              }
 
 -- | The default pretty printing options, as seen in 'dynamicLog'.
-{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-}
-defaultPP :: PP
-defaultPP = def
-
 instance Default PP where
     def   = PP { ppCurrent         = wrap "[" "]"
                , ppVisible         = wrap "<" ">"
                , ppHidden          = id
                , ppHiddenNoWindows = const ""
+               , ppVisibleNoWindows= Nothing
                , ppUrgent          = id
                , ppSep             = " : "
                , ppWsSep           = " "

XMonad/Hooks/EwmhDesktops.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveDataTypeable     #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.EwmhDesktops
@@ -19,24 +21,34 @@ module XMonad.Hooks.EwmhDesktops (
     ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
+    NetActivated (..),
+    activated,
+    activateLogHook,
     ewmhDesktopsEventHook,
     ewmhDesktopsEventHookCustom,
-    fullscreenEventHook
+    ewmhFullscreen,
+    fullscreenEventHook,
+    fullscreenStartup
     ) where
 
 import Codec.Binary.UTF8.String (encode)
+import Data.Bits
 import Data.List
 import Data.Maybe
 import Data.Monoid
+import qualified Data.Map.Strict as M
+import System.IO.Unsafe
 
 import XMonad
 import Control.Monad
 import qualified XMonad.StackSet as W
 
 import XMonad.Hooks.SetWMName
+import qualified XMonad.Util.ExtensibleState as E
 import XMonad.Util.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.WindowProperties (getProp32)
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -44,19 +56,47 @@ import XMonad.Util.WindowProperties (getProp32)
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > main = xmonad $ ewmh def{ handleEventHook =
+-- > main = xmonad $ ewmhFullscreen $ ewmh def
--- >            handleEventHook def <+> fullscreenEventHook }
+--
+-- or, if fullscreen handling is not desired, just
+--
+-- > main = xmonad $ ewmh def
 --
 -- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
-
+--
+-- __/NOTE:/__ 'ewmh' function will call 'logHook' for handling activated
+-- window.
+--
+-- And now by default window activation will do nothing: neither switch
+-- workspace, nor focus. You can use regular 'ManageHook' combinators for
+-- changing window activation behavior and then add resulting 'ManageHook'
+-- using 'activateLogHook' to your 'logHook'. Also, you may be interested in
+-- "XMonad.Hooks.Focus", which provides additional predicates for using in
+-- 'ManageHook'.
+--
+-- To get back old 'ewmh' window activation behavior (switch workspace and
+-- focus to activated window) you may use:
+--
+-- > import XMonad
+-- >
+-- > import XMonad.Hooks.EwmhDesktops
+-- > import qualified XMonad.StackSet as W
+-- >
+-- > main :: IO ()
+-- > main = do
+-- >         let acMh :: ManageHook
+-- >             acMh = reader W.focusWindow >>= doF
+-- >             xcf = ewmh $ def
+-- >                    { modMask = mod4Mask
+-- >                    , logHook = activateLogHook acMh <+> logHook def
+-- >                    }
+-- >         xmonad xcf
 
 -- | Add EWMH functionality to the given config.  See above for an example.
 ewmh :: XConfig a -> XConfig a
-ewmh c = c { startupHook     = startupHook c +++ ewmhDesktopsStartup
+ewmh c = c { startupHook     = ewmhDesktopsStartup <+> startupHook c
-           , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook
+           , handleEventHook = ewmhDesktopsEventHook <+> handleEventHook c
-           , logHook         = logHook c +++ ewmhDesktopsLogHook }
+           , logHook         = ewmhDesktopsLogHook <+> logHook c }
- -- @@@ will fix this correctly later with the rewrite
- where x +++ y = mappend y x
 
 -- |
 -- Initializes EwmhDesktops and advertises EWMH support to the X
@@ -69,6 +109,58 @@ ewmhDesktopsStartup = setSupported
 -- of the current state of workspaces and windows.
 ewmhDesktopsLogHook :: X ()
 ewmhDesktopsLogHook = ewmhDesktopsLogHookCustom id
+
+-- |
+-- Cached desktop names (e.g. @_NET_NUMBER_OF_DESKTOPS@ and
+-- @_NET_DESKTOP_NAMES@).
+newtype DesktopNames = DesktopNames [String]
+                     deriving (Eq)
+
+instance ExtensionClass DesktopNames where
+    initialValue = DesktopNames []
+
+-- |
+-- Cached client list (e.g. @_NET_CLIENT_LIST@).
+newtype ClientList = ClientList [Window]
+                   deriving (Eq)
+
+instance ExtensionClass ClientList where
+    initialValue = ClientList [none]
+
+-- |
+-- Cached current desktop (e.g. @_NET_CURRENT_DESKTOP@).
+newtype CurrentDesktop = CurrentDesktop Int
+                       deriving (Eq)
+
+instance ExtensionClass CurrentDesktop where
+    initialValue = CurrentDesktop (-1)
+
+-- |
+-- Cached window-desktop assignments (e.g. @_NET_CLIENT_LIST_STACKING@).
+newtype WindowDesktops = WindowDesktops (M.Map Window Int)
+                       deriving (Eq)
+
+instance ExtensionClass WindowDesktops where
+    initialValue = WindowDesktops (M.singleton none (-1))
+
+-- |
+-- The value of @_NET_ACTIVE_WINDOW@, cached to avoid unnecessary property
+-- updates.
+newtype ActiveWindow = ActiveWindow Window
+                     deriving (Eq)
+
+instance ExtensionClass ActiveWindow where
+    initialValue = ActiveWindow (complement none)
+
+-- | Compare the given value against the value in the extensible state. Run the
+-- action if it has changed.
+whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
+whenChanged v action = do
+    v0 <- E.get
+    unless (v == v0) $ do
+        action
+        E.put v
+
 -- |
 -- Generalized version of ewmhDesktopsLogHook that allows an arbitrary
 -- user-specified function to transform the workspace list (post-sorting)
@@ -77,38 +169,32 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
     sort' <- getSortByIndex
     let ws = f $ sort' $ W.workspaces s
 
-    -- Number of Workspaces
+    -- Set number of workspaces and names thereof
-    setNumberOfDesktops (length ws)
+    let desktopNames = map W.tag ws
+    whenChanged (DesktopNames desktopNames) $ do
+        setNumberOfDesktops (length desktopNames)
+        setDesktopNames desktopNames
 
-    -- Names thereof
+    -- Set client list; all windows, with focused windows last
-    setDesktopNames (map W.tag ws)
+    let clientList = nub . concatMap (maybe [] (\(W.Stack x l r) -> reverse l ++ r ++ [x]) . W.stack) $ ws
+    whenChanged (ClientList clientList) $ setClientList clientList
 
-    -- all windows, with focused windows last
+    -- Remap the current workspace to handle any renames that f might be doing.
-    let wins =  nub . concatMap (maybe [] (\(W.Stack x l r)-> reverse l ++ r ++ [x]) . W.stack) $ ws
+    let maybeCurrent' = W.tag <$> listToMaybe (f [W.workspace $ W.current s])
-    setClientList wins
+        current = join (flip elemIndex (map W.tag ws) <$> maybeCurrent')
+    whenChanged (CurrentDesktop $ fromMaybe 0 current) $
+        mapM_ setCurrentDesktop current
 
-    -- Current desktop
+    -- Set window-desktop mapping
-    case (elemIndex (W.currentTag s) $ map W.tag ws) of
+    let windowDesktops =
-      Nothing -> return ()
+          let f wsId workspace = M.fromList [ (winId, wsId) | winId <- W.integrate' $ W.stack workspace ]
-      Just curr -> do
+          in M.unions $ zipWith f [0..] ws
-        setCurrentDesktop curr
+    whenChanged (WindowDesktops windowDesktops) $
+        mapM_ (uncurry setWindowDesktop) (M.toList windowDesktops)
 
-        -- Per window Desktop
+    -- Set active window
-        -- To make gnome-panel accept our xinerama stuff, we display
+    let activeWindow' = fromMaybe none (W.peek s)
-        -- all visible windows on the current desktop.
+    whenChanged (ActiveWindow activeWindow') $ setActiveWindow activeWindow'
-        forM_ (W.current s : W.visible s) $ \x ->
-            forM_ (W.integrate' (W.stack (W.workspace x))) $ \win -> do
-                setWindowDesktop win curr
-
-    forM_ (W.hidden s) $ \w ->
-        case elemIndex (W.tag w) (map W.tag ws) of
-          Nothing -> return ()
-          Just wn -> forM_ (W.integrate' (W.stack w)) $ \win -> do
-                         setWindowDesktop win wn
-
-    setActiveWindow
-
-    return ()
 
 -- |
 -- Intercepts messages from pagers and similar applications and reacts on them.
@@ -128,6 +214,40 @@ ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
 ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
 ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
 
+-- | Whether new window _NET_ACTIVE_WINDOW activated or not. I should keep
+-- this value in global state, because i use 'logHook' for handling activated
+-- windows and i need a way to tell 'logHook' what window is activated.
+newtype NetActivated    = NetActivated {netActivated :: Maybe Window}
+  deriving (Show, Typeable)
+instance ExtensionClass NetActivated where
+    initialValue        = NetActivated Nothing
+
+-- | Was new window @_NET_ACTIVE_WINDOW@ activated?
+activated :: Query Bool
+activated           = fmap (isJust . netActivated) (liftX XS.get)
+
+-- | Run supplied 'ManageHook' for activated windows /only/. If you want to
+-- run this 'ManageHook' for new windows too, add it to 'manageHook'.
+--
+-- __/NOTE:/__ 'activateLogHook' will work only _once_. I.e. if several
+-- 'activateLogHook'-s was used, only first one will actually run (because it
+-- resets 'NetActivated' at the end and others won't know, that window is
+-- activated).
+activateLogHook :: ManageHook -> X ()
+activateLogHook mh  = XS.get >>= maybe (return ()) go . netActivated
+  where
+    go :: Window -> X ()
+    go w            = do
+        f <- runQuery mh w
+        -- I should reset 'NetActivated' here, because:
+        --  * 'windows' calls 'logHook' and i shouldn't go here the second
+        --  time for one window.
+        --  * if i reset 'NetActivated' before running 'logHook' once,
+        --  then 'activated' predicate won't match.
+        -- Thus, here is the /only/ correct place.
+        XS.put NetActivated{netActivated = Nothing}
+        windows (appEndo f)
+
 handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
 handle f (ClientMessageEvent {
                ev_window = w,
@@ -153,17 +273,36 @@ handle f (ClientMessageEvent {
                        windows $ W.shiftWin (W.tag (ws !! fi n)) w
                  else  trace $ "Bad _NET_DESKTOP with data[0]="++show n
         else if mt == a_aw then do
-               windows $ W.focusWindow w
+               lh <- asks (logHook . config)
-        else if mt == a_cw then do
+               XS.put (NetActivated (Just w))
+               lh
+        else if mt == a_cw then
                killWindow w
-        else if mt `elem` a_ignore then do
+        else if mt `elem` a_ignore then
            return ()
-        else do
+        else
           -- The Message is unknown to us, but that is ok, not all are meant
           -- to be handled by the window manager
           return ()
 handle _ _ = return ()
 
+-- | Add EWMH fullscreen functionality to the given config.
+--
+-- This must be applied after 'ewmh', like so:
+--
+-- > main = xmonad $ ewmhFullscreen $ ewmh def
+--
+-- NOT:
+--
+-- > main = xmonad $ ewmh $ ewmhFullscreen def
+ewmhFullscreen :: XConfig a -> XConfig a
+ewmhFullscreen c = c { startupHook     = startupHook c <+> fullscreenStartup
+                     , handleEventHook = handleEventHook c <+> fullscreenEventHook }
+
+-- | Advertises EWMH fullscreen support to the X server.
+fullscreenStartup :: X ()
+fullscreenStartup = setFullscreenSupported
+
 -- |
 -- An event hook to handle applications that wish to fullscreen using the
 -- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
@@ -174,7 +313,7 @@ fullscreenEventHook :: Event -> X All
 fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
   wmstate <- getAtom "_NET_WM_STATE"
   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
-  wstate <- fromMaybe [] `fmap` getProp32 wmstate win
+  wstate <- fromMaybe [] <$> getProp32 wmstate win
 
   let isFull = fromIntegral fullsc `elem` wstate
 
@@ -182,8 +321,7 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
       remove = 0
       add = 1
       toggle = 2
-      ptype = 4 -- The atom property type for changeProperty
+      chWstate f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)
-      chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
 
   when (typ == wmstate && fi fullsc `elem` dats) $ do
     when (action == add || (action == toggle && not isFull)) $ do
@@ -200,16 +338,14 @@ fullscreenEventHook _ = return $ All True
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do
     a <- getAtom "_NET_NUMBER_OF_DESKTOPS"
-    c <- getAtom "CARDINAL"
     r <- asks theRoot
-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral n]
+    io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral n]
 
 setCurrentDesktop :: (Integral a) => a -> X ()
 setCurrentDesktop i = withDisplay $ \dpy -> do
     a <- getAtom "_NET_CURRENT_DESKTOP"
-    c <- getAtom "CARDINAL"
     r <- asks theRoot
-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral i]
+    io $ changeProperty32 dpy r a cARDINAL propModeReplace [fromIntegral i]
 
 setDesktopNames :: [String] -> X ()
 setDesktopNames names = withDisplay $ \dpy -> do
@@ -224,23 +360,20 @@ setClientList :: [Window] -> X ()
 setClientList wins = withDisplay $ \dpy -> do
     -- (What order do we really need? Something about age and stacking)
     r <- asks theRoot
-    c <- getAtom "WINDOW"
     a <- getAtom "_NET_CLIENT_LIST"
-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral wins)
+    io $ changeProperty32 dpy r a wINDOW propModeReplace (fmap fromIntegral wins)
     a' <- getAtom "_NET_CLIENT_LIST_STACKING"
-    io $ changeProperty32 dpy r a' c propModeReplace (fmap fromIntegral wins)
+    io $ changeProperty32 dpy r a' wINDOW propModeReplace (fmap fromIntegral wins)
 
 setWindowDesktop :: (Integral a) => Window -> a -> X ()
 setWindowDesktop win i = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_DESKTOP"
-    c <- getAtom "CARDINAL"
+    io $ changeProperty32 dpy win a cARDINAL propModeReplace [fromIntegral i]
-    io $ changeProperty32 dpy win a c propModeReplace [fromIntegral i]
 
 setSupported :: X ()
 setSupported = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_SUPPORTED"
-    c <- getAtom "ATOM"
     supp <- mapM getAtom ["_NET_WM_STATE_HIDDEN"
                          ,"_NET_NUMBER_OF_DESKTOPS"
                          ,"_NET_CLIENT_LIST"
@@ -251,14 +384,26 @@ setSupported = withDisplay $ \dpy -> do
                          ,"_NET_WM_DESKTOP"
                          ,"_NET_WM_STRUT"
                          ]
-    io $ changeProperty32 dpy r a c propModeReplace (fmap fromIntegral supp)
+    io $ changeProperty32 dpy r a aTOM propModeReplace (fmap fromIntegral supp)
 
     setWMName "xmonad"
 
-setActiveWindow :: X ()
+-- TODO: use in SetWMName, UrgencyHook
-setActiveWindow = withWindowSet $ \s -> withDisplay $ \dpy -> do
+addSupported :: [String] -> X ()
-    let w = fromMaybe none (W.peek s)
+addSupported props = withDisplay $ \dpy -> do
+    r <- asks theRoot
+    a <- getAtom "_NET_SUPPORTED"
+    fs <- getAtom "_NET_WM_STATE_FULLSCREEN"
+    newSupportedList <- mapM (fmap fromIntegral . getAtom) props
+    io $ do
+        supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy a r
+        changeProperty32 dpy r a aTOM propModeReplace (nub $ newSupportedList ++ supportedList)
+
+setFullscreenSupported :: X ()
+setFullscreenSupported = addSupported ["_NET_WM_STATE", "_NET_WM_STATE_FULLSCREEN"]
+
+setActiveWindow :: Window -> X ()
+setActiveWindow w = withDisplay $ \dpy -> do
     r <- asks theRoot
     a <- getAtom "_NET_ACTIVE_WINDOW"
-    c <- getAtom "WINDOW"
+    io $ changeProperty32 dpy r a wINDOW propModeReplace [fromIntegral w]
-    io $ changeProperty32 dpy r a c propModeReplace [fromIntegral w]

XMonad/Hooks/FadeInactive.hs

@@ -28,6 +28,7 @@ module XMonad.Hooks.FadeInactive (
 
 import XMonad
 import qualified XMonad.StackSet as W
+import Control.Applicative (liftA2)
 import Control.Monad
 
 -- $usage
@@ -64,8 +65,7 @@ rationalToOpacity perc
 setOpacity :: Window -> Rational -> X ()
 setOpacity w t = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_WINDOW_OPACITY"
-    c <- getAtom "CARDINAL"
+    io $ changeProperty32 dpy w a cARDINAL propModeReplace [rationalToOpacity t]
-    io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
 -- | Fades a window out by setting the opacity
 fadeOut :: Rational -> Window -> X ()
@@ -112,4 +112,4 @@ fadeOutLogHook :: Query Rational -> X ()
 fadeOutLogHook qry = withWindowSet $ \s -> do
     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
                       concatMap (W.integrate' . W.stack . W.workspace) (W.visible s)
-    forM_ visibleWins $ liftM2 (=<<) setOpacity (runQuery qry)
+    forM_ visibleWins $ liftA2 (=<<) setOpacity (runQuery qry)

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

@@ -0,0 +1,581 @@
+{-# LANGUAGE FlexibleContexts       #-}
+{-# LANGUAGE MultiParamTypeClasses  #-}
+{-# LANGUAGE DeriveDataTypeable     #-}
+{-# OPTIONS_HADDOCK show-extensions #-}
+
+-- |
+-- Module:      XMonad.Hooks.Focus
+-- Copyright:   sgf-dma, 2016
+-- Maintainer:  sgf.dma@gmail.com
+--
+
+module XMonad.Hooks.Focus
+    (
+      -- $main
+
+      -- * FocusQuery.
+      --
+      -- $focusquery
+      Focus (..)
+    , FocusLock (..)
+    , toggleLock
+    , focusLockOn
+    , focusLockOff
+    , FocusQuery
+    , runFocusQuery
+    , FocusHook
+
+      -- * Lifting into FocusQuery.
+      --
+      -- $lift
+    , liftQuery
+    , new
+    , focused
+    , focused'
+    , focusedOn
+    , focusedOn'
+    , focusedCur
+    , focusedCur'
+    , newOn
+    , newOnCur
+    , unlessFocusLock
+
+      -- * Commonly used actions for modifying focus.
+      --
+      -- $common
+    , keepFocus
+    , switchFocus
+    , keepWorkspace
+    , switchWorkspace
+
+      -- * Running FocusQuery.
+      --
+      -- $running
+    , manageFocus
+
+      -- * Example configurations.
+      --
+      -- $examples
+    , activateSwitchWs
+    , activateOnCurrentWs
+    , activateOnCurrentKeepFocus
+    )
+  where
+
+import Data.Maybe
+import Data.Monoid
+import qualified Data.Semigroup as S
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Reader
+import Control.Arrow hiding ((<+>))
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Hooks.ManageHelpers (currentWs)
+import XMonad.Hooks.EwmhDesktops (activated, NetActivated(..))
+
+
+-- $main
+--
+-- This module provides monad on top of Query monad providing additional
+-- information about new window:
+--
+--  - workspace, where new window will appear;
+--  - focused window on workspace, where new window will appear;
+--  - current workspace;
+--
+-- And a property in extensible state:
+--
+--  - is focus lock enabled? Focus lock instructs all library's 'FocusHook'
+--  functions to not move focus or switch workspace.
+--
+-- Lifting operations for standard 'ManageHook' EDSL combinators into
+-- 'FocusQuery' monad allowing to run these combinators on focused window and
+-- common actions for keeping focus and\/or workspace, switching focus and\/or
+-- workspace are also provided.
+--
+-- == Quick start.
+--
+-- I may use one of predefined configurations.
+--
+-- 1. Default window activation behavior is to switch to workspace with
+--    activated window and switch focus to it:
+--
+--      > import XMonad
+--      >
+--      > import XMonad.Hooks.EwmhDesktops
+--      > import XMonad.Hooks.Focus
+--      >
+--      > main :: IO ()
+--      > main = do
+--      >         let mh :: ManageHook
+--      >             mh = activateSwitchWs
+--      >             xcf = ewmh $ def
+--      >                     { modMask = mod4Mask
+--      >                     , logHook = activateLogHook mh <+> logHook def
+--      >                     }
+--      >         xmonad xcf
+--
+-- 2. Or i may move activated window to current workspace and switch focus to
+--    it:
+--
+--      >         let mh :: ManageHook
+--      >             mh = activateOnCurrentWs
+--
+-- 3. Or move activated window to current workspace, but keep focus unchanged:
+--
+--      >         let mh :: ManageHook
+--      >             mh = activateOnCurrentKeepFocus
+--
+-- 4. I may use regular 'ManageHook' combinators for filtering, which windows
+--    may activate. E.g. activate all windows, except firefox:
+--
+--      >         let mh :: ManageHook
+--      >             mh  = not <$> (className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel")
+--      >                     --> activateSwitchWs
+--
+-- 5. Or even use 'FocusHook' combinators. E.g. activate all windows, unless
+--    xterm is focused on /current/ workspace:
+--
+--      >         let mh :: ManageHook
+--      >             mh  = manageFocus (not <$> focusedCur (className =? "XTerm")
+--      >                     --> liftQuery activateSwitchWs)
+--
+--      or activate all windows, unless focused window on the workspace,
+--      /where activated window is/, is not a xterm:
+--
+--      >         let mh :: ManageHook
+--      >             mh  = manageFocus (not <$> focused (className =? "XTerm")
+--      >                     --> liftQuery activateSwitchWs)
+--
+-- == Defining FocusHook.
+--
+-- I may define my own 'FocusHook' like:
+--
+-- >    activateFocusHook :: FocusHook
+-- >    activateFocusHook = composeAll
+-- >            -- If 'gmrun' is focused on workspace, on which
+-- >            -- /activated window/ is, keep focus unchanged. But i
+-- >            -- may still switch workspace (thus, i use 'composeAll').
+-- >            -- See 'keepFocus' properties in the docs below.
+-- >            [ focused (className =? "Gmrun")
+-- >                            --> keepFocus
+-- >            -- Default behavior for activated windows: switch
+-- >            -- workspace and focus.
+-- >            , return True   --> switchWorkspace <+> switchFocus
+-- >            ]
+-- >
+-- >    newFocusHook :: FocusHook
+-- >    newFocusHook      = composeOne
+-- >            -- Always switch focus to 'gmrun'.
+-- >            [ new (className =? "Gmrun")        -?> switchFocus
+-- >            -- And always keep focus on 'gmrun'. Note, that
+-- >            -- another 'gmrun' will steal focus from already
+-- >            -- running one.
+-- >            , focused (className =? "Gmrun")    -?> keepFocus
+-- >            -- If firefox dialog prompt (e.g. master password
+-- >            -- prompt) is focused on current workspace and new
+-- >            -- window appears here too, keep focus unchanged
+-- >            -- (note, used predicates: @newOnCur <&&> focused@ is
+-- >            -- the same as @newOnCur <&&> focusedCur@, but is
+-- >            -- /not/ the same as just 'focusedCur' )
+-- >            , newOnCur <&&> focused
+-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
+-- >                                                -?> keepFocus
+-- >            -- Default behavior for new windows: switch focus.
+-- >            , return True                       -?> switchFocus
+-- >            ]
+--
+-- And then use it:
+--
+-- >    import XMonad
+-- >    import XMonad.Util.EZConfig
+-- >
+-- >    import XMonad.Hooks.EwmhDesktops
+-- >    import XMonad.Hooks.ManageHelpers
+-- >    import XMonad.Hooks.Focus
+-- >
+-- >
+-- >    main :: IO ()
+-- >    main = do
+-- >            let newFh :: ManageHook
+-- >                newFh = manageFocus newFocusHook
+-- >                acFh :: X ()
+-- >                acFh = activateLogHook (manageFocus activateFocusHook)
+-- >                xcf = ewmh $ def
+-- >                             { manageHook   = newFh <+> manageHook def
+-- >                             , logHook      = acFh  <+> logHook def
+-- >                             , modMask      = mod4Mask
+-- >                             }
+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
+-- >            xmonad xcf
+--
+-- Note:
+--
+--  - /mod4Mask+v/ key toggles focus lock (when enabled, neither focus nor
+--  workspace won't be switched).
+--  - I need 'XMonad.Hooks.EwmhDesktops' module for enabling window
+--  activation.
+--  - 'FocusHook' in 'manageHook' will be called /only/ for new windows.
+--  - 'FocusHook' in 'logHook' will be called /only/ for activated windows.
+--
+--  Alternatively, i may construct a single 'FocusHook' for both new and
+--  activated windows and then just add it to both 'manageHook' and 'logHook':
+--
+-- >            let fh :: ManageHook
+-- >                fh = manageFocus $ (composeOne
+-- >                        [ liftQuery activated -?> activateFocusHook
+-- >                        , Just <$> newFocusHook
+-- >                        ])
+-- >                xcf = ewmh $ def
+-- >                             { manageHook   = fh <+> manageHook def
+-- >                             , logHook      = activateLogHook fh <+> logHook def
+-- >                             , modMask      = mod4Mask
+-- >                             }
+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
+--
+-- Note:
+--  - Predicate 'activated' will be 'True' for activated window.
+--  - The order, when constructing final 'FocusHook': 'FocusHook' without
+--  'activated' predicate will match to activated windows too, thus i should
+--  place it after one with 'activated' (so the latter will have a chance to
+--  handle activated window first).
+--
+-- And more technical notes:
+--
+--  - 'FocusHook' will run /many/ times, so it usually should not keep state
+--  or save results. Precisely, it may do anything, but it must be idempotent
+--  to operate properly.
+--  - 'FocusHook' will see new window at workspace, where functions on the
+--  /right/ from it in 'ManageHook' monoid place it.  In other words, in
+--  @(Endo WindowSet)@ monoid i may see changes only from functions applied
+--  /before/ (more to the right in function composition). Thus, it's better to
+--  add 'FocusHook' the last.
+--  - 'FocusHook' functions won't see window shift to another workspace made
+--  by function from 'FocusHook' itself: new window workspace is determined
+--  /before/ running 'FocusHook' and even if later one of 'FocusHook'
+--  functions moves window to another workspace, predicates ('focused',
+--  'newOn', etc) will still think new window is at workspace it was before.
+--  This can be worked around by splitting 'FocusHook' into several different
+--  values and evaluating each one separately, like:
+--
+--      > (FH2 -- manageFocus --> MH2) <+> (FH1 -- manageFocus --> MH1) <+> ..
+--
+--      E.g.
+--
+--      > manageFocus FH2 <+> manageFocus FH1 <+> ..
+--
+--      now @FH2@ will see window shift made by @FH1@.
+--
+--      Also, note, that if several 'activateLogHook'-s are sequenced, only
+--      /first/ one (leftmost) will run. Thus, to make above working,
+--      'mappend' all 'ManageHook'-s first, and then run by /single/
+--      'activateLogHook' (see next example).
+--
+-- Another interesting example is moving all activated windows to current
+-- workspace by default, and applying 'FocusHook' after:
+--
+-- >    import XMonad
+-- >    import XMonad.Util.EZConfig
+-- >
+-- >    import XMonad.Hooks.EwmhDesktops
+-- >    import XMonad.Hooks.ManageHelpers
+-- >    import XMonad.Hooks.Focus
+-- >
+-- >    main :: IO ()
+-- >    main = do
+-- >            let fh :: ManageHook
+-- >                fh = manageFocus $ (composeOne
+-- >                        [ liftQuery activated -?> (newOnCur --> keepFocus)
+-- >                        , Just <$> newFocusHook
+-- >                        ])
+-- >                xcf = ewmh $ def
+-- >                             { manageHook = fh <+> manageHook def
+-- >                             , logHook    = activateLogHook (fh <+> activateOnCurrentWs) <+> logHook def
+-- >                             , modMask    = mod4Mask
+-- >                             }
+-- >                        `additionalKeys` [((mod4Mask, xK_v), toggleLock)]
+-- >            xmonad xcf
+-- >
+-- >    newFocusHook :: FocusHook
+-- >    newFocusHook      = composeOne
+-- >            -- Always switch focus to 'gmrun'.
+-- >            [ new (className =? "Gmrun")        -?> switchFocus
+-- >            -- And always keep focus on 'gmrun'. Note, that
+-- >            -- another 'gmrun' will steal focus from already
+-- >            -- running one.
+-- >            , focused (className =? "Gmrun")    -?> keepFocus
+-- >            -- If firefox dialog prompt (e.g. master password
+-- >            -- prompt) is focused on current workspace and new
+-- >            -- window appears here too, keep focus unchanged
+-- >            -- (note, used predicates: @newOnCur <&&> focused@ is
+-- >            -- the same as @newOnCur <&&> focusedCur@, but is
+-- >            -- /not/ the same as just 'focusedCur' )
+-- >            , newOnCur <&&> focused
+-- >                ((className =? "Firefox" <||> className =? "Firefox-esr" <||> className =? "Iceweasel") <&&> isDialog)
+-- >                                                -?> keepFocus
+-- >            -- Default behavior for new windows: switch focus.
+-- >            , return True                       -?> switchFocus
+-- >            ]
+--
+-- Note here:
+--
+--  - i keep focus, when activated window appears on current workspace, in
+--  this example.
+--  - when @liftQuery activated -?> (newOnCur --> keepFocus)@ runs, activated
+--  window will be /already/ on current workspace, thus, if i do not want to
+--  move some activated windows, i should filter them out before applying
+--  @activateOnCurrentWs@ 'FocusHook'.
+--  - i 'mappend' all 'ManageHook'-s and run 'activateLogHook' only once.
+
+
+-- FocusQuery.
+-- $focusquery
+
+-- | Information about current workspace and focus.
+data Focus          = Focus
+                        { -- | Workspace, where new window appears.
+                          newWorkspace      :: WorkspaceId
+                          -- | Focused window on workspace, where new window
+                          -- appears.
+                        , focusedWindow     :: Maybe Window
+                          -- | Current workspace.
+                        , currentWorkspace  :: WorkspaceId
+                        }
+  deriving (Show)
+instance Default Focus where
+    def             = Focus
+                        { focusedWindow     = Nothing
+                        , newWorkspace      = ""
+                        , currentWorkspace  = ""
+                        }
+
+newtype FocusLock   = FocusLock {getFocusLock :: Bool}
+  deriving (Show, Typeable)
+instance ExtensionClass FocusLock where
+    initialValue    = FocusLock False
+
+-- | Toggle stored focus lock state.
+toggleLock :: X ()
+toggleLock          = XS.modify (\(FocusLock b) -> FocusLock (not b))
+
+-- | Lock focus.
+focusLockOn :: X ()
+focusLockOn         = XS.modify (const (FocusLock True))
+
+-- | Unlock focus.
+focusLockOff :: X ()
+focusLockOff        = XS.modify (const (FocusLock False))
+
+-- | Monad on top of 'Query' providing additional information about new
+-- window.
+newtype FocusQuery a = FocusQuery (ReaderT Focus Query a)
+instance Functor FocusQuery where
+    fmap f (FocusQuery x) = FocusQuery (fmap f x)
+instance Applicative FocusQuery where
+    pure x                              = FocusQuery (pure x)
+    (FocusQuery f) <*> (FocusQuery mx)  = FocusQuery (f <*> mx)
+instance Monad FocusQuery where
+    return x                = FocusQuery (return x)
+    (FocusQuery mx) >>= f   = FocusQuery $ mx >>= \x ->
+                              let FocusQuery y = f x in y
+instance MonadReader Focus FocusQuery where
+    ask                     = FocusQuery ask
+    local f (FocusQuery mx) = FocusQuery (local f mx)
+instance MonadIO FocusQuery where
+    liftIO mx       = FocusQuery (liftIO mx)
+instance S.Semigroup a => S.Semigroup (FocusQuery a) where
+    (<>)            = liftM2 (S.<>)
+instance Monoid a => Monoid (FocusQuery a) where
+    mempty          = return mempty
+    mappend         = (<>)
+
+runFocusQuery :: FocusQuery a -> Focus -> Query a
+runFocusQuery (FocusQuery m)    = runReaderT m
+
+type FocusHook      = FocusQuery (Endo WindowSet)
+
+
+-- Lifting into 'FocusQuery'.
+-- $lift
+
+-- | Lift 'Query' into 'FocusQuery' monad. The same as 'new'.
+liftQuery :: Query a -> FocusQuery a
+liftQuery           = FocusQuery . lift
+
+-- | Run 'Query' on new window.
+new :: Query a -> FocusQuery a
+new                 = liftQuery
+
+-- | Run 'Query' on focused window on workspace, where new window appears. If
+-- there is no focused window, return 'False'.
+focused :: Query Bool -> FocusQuery Bool
+focused m           = getAny <$> focused' (Any <$> m)
+-- | More general version of 'focused'.
+focused' :: Monoid a => Query a -> FocusQuery a
+focused' m          = do
+    mw <- asks focusedWindow
+    liftQuery (maybe mempty (flip local m . const) mw)
+
+-- | Run 'Query' on window focused at particular workspace. If there is no
+-- focused window, return 'False'.
+focusedOn :: WorkspaceId -> Query Bool -> FocusQuery Bool
+focusedOn i m       = getAny <$> focusedOn' i (Any <$> m)
+-- | More general version of 'focusedOn'.
+focusedOn' :: Monoid a => WorkspaceId -> Query a -> FocusQuery a
+focusedOn' i m      = liftQuery $ do
+    mw <- liftX $ withWindowSet (return . W.peek . W.view i)
+    maybe mempty (flip local m . const) mw
+
+-- | Run 'Query' on focused window on current workspace. If there is no
+-- focused window, return 'False'.  Note,
+--
+-- > focused <&&> newOnCur != focusedCur
+--
+-- The first will affect only new or activated window appearing on current
+-- workspace, while the last will affect any window: focus even for windows
+-- appearing on other workpsaces will depend on focus on /current/ workspace.
+focusedCur :: Query Bool -> FocusQuery Bool
+focusedCur m        = getAny <$> focusedCur' (Any <$> m)
+-- | More general version of 'focusedCur'.
+focusedCur' :: Monoid a => Query a -> FocusQuery a
+focusedCur' m       = asks currentWorkspace >>= \i -> focusedOn' i m
+
+-- | Does new window appear at particular workspace?
+newOn :: WorkspaceId -> FocusQuery Bool
+newOn i             = (i ==) <$> asks newWorkspace
+-- | Does new window appear at current workspace?
+newOnCur :: FocusQuery Bool
+newOnCur            = asks currentWorkspace >>= newOn
+
+-- | Execute 'Query', unless focus is locked.
+unlessFocusLock :: Monoid a => Query a -> Query a
+unlessFocusLock m   = do
+    FocusLock b <- liftX XS.get
+    when' (not b) m
+
+-- Commonly used actions for modifying focus.
+--
+-- $common
+-- Operations in each pair 'keepFocus' and 'switchFocus', 'keepWorkspace' and
+-- 'switchWorkspace' overwrite each other (the letftmost will determine what
+-- happened):
+--
+-- prop> keepFocus       <+> switchFocus     = keepFocus
+-- prop> switchFocus     <+> keepFocus       = switchFocus
+-- prop> keepWorkspace   <+> switchWorkspace = keepWorkspace
+-- prop> switchWorkspace <+> keepWorkspace   = switchWorkspace
+--
+-- and operations from different pairs are commutative:
+--
+-- prop> keepFocus   <+> switchWorkspace = switchWorkspace <+> keepFocus
+-- prop> switchFocus <+> switchWorkspace = switchWorkspace <+> switchFocus
+--
+-- etc.
+
+-- | Keep focus on workspace (may not be current), where new window appears.
+-- Workspace will not be switched. This operation is idempotent and
+-- effectively returns focus to window focused on that workspace before
+-- applying @(Endo WindowSet)@ function.
+keepFocus :: FocusHook
+keepFocus           = focused' $ ask >>= \w -> doF $ \ws ->
+                        W.view (W.currentTag ws) . W.focusWindow w $ ws
+
+-- | Switch focus to new window on workspace (may not be current), where new
+-- window appears. Workspace will not be switched. This operation is
+-- idempotent.
+switchFocus :: FocusHook
+switchFocus         = do
+    FocusLock b <- liftQuery . liftX $ XS.get
+    if b
+      -- When focus lock is enabled, call 'keepFocus' explicitly (still no
+      -- 'keepWorkspace') to overwrite default behavior.
+      then keepFocus
+      else new $ ask >>= \w -> doF $ \ws ->
+            W.view (W.currentTag ws) . W.focusWindow w $ ws
+
+-- | Keep current workspace. Focus will not be changed at either current or
+-- new window's  workspace. This operation is idempotent and effectively
+-- switches to workspace, which was current before applying @(Endo WindowSet)@
+-- function.
+keepWorkspace :: FocusHook
+keepWorkspace       = do
+    ws <- asks currentWorkspace
+    liftQuery . doF $ W.view ws
+
+-- | Switch workspace to one, where new window appears. Focus will not be
+-- changed at either current or new window's workspace. This operation is
+-- idempotent.
+switchWorkspace :: FocusHook
+switchWorkspace     = do
+    FocusLock b <- liftQuery . liftX $ XS.get
+    if b
+      -- When focus lock is enabled, call 'keepWorkspace' explicitly (still no
+      -- 'keepFocus') to overwrite default behavior.
+      then keepWorkspace
+      else do
+        ws <- asks newWorkspace
+        liftQuery . doF $ W.view ws
+
+-- Running FocusQuery.
+-- $running
+
+-- | I don't know at which workspace new window will appear until @(Endo
+-- WindowSet)@ function from 'windows' in "XMonad.Operations" actually run,
+-- but in @(Endo WindowSet)@ function i can't already execute monadic actions,
+-- because it's pure. So, i compute result for every workspace here and just
+-- use it later in @(Endo WindowSet)@ function.  Note, though, that this will
+-- execute monadic actions many times, and therefore assume, that result of
+-- 'FocusHook' does not depend on the number of times it was executed.
+manageFocus :: FocusHook -> ManageHook
+manageFocus m       = do
+    fws <- liftX . withWindowSet $ return
+      . map (W.tag &&& fmap W.focus . W.stack) . W.workspaces
+    ct  <- currentWs
+    let r = def {currentWorkspace = ct}
+    hs <- forM fws $ \(i, mw) -> do
+      f <- runFocusQuery m (r {focusedWindow = mw, newWorkspace = i})
+      return (i, f)
+    reader (selectHook hs) >>= doF
+  where
+    -- | Select and apply @(Endo WindowSet)@ function depending on which
+    -- workspace new window appeared now.
+    selectHook :: [(WorkspaceId, Endo WindowSet)] -> Window -> WindowSet -> WindowSet
+    selectHook cfs nw ws    = fromMaybe ws $ do
+        i <- W.findTag nw ws
+        f <- lookup i cfs
+        return (appEndo f ws)
+
+when' :: (Monad m, Monoid a) => Bool -> m a -> m a
+when' b mx
+  | b               = mx
+  | otherwise       = return mempty
+
+-- Exmaple configurations.
+-- $examples
+
+-- | Default EWMH window activation behavior: switch to workspace with
+-- activated window and switch focus to it.
+activateSwitchWs :: ManageHook
+activateSwitchWs    = manageFocus (liftQuery activated -->
+                        switchWorkspace <+> switchFocus)
+
+-- | Move activated window to current workspace.
+activateOnCurrent' :: ManageHook
+activateOnCurrent'  = activated --> currentWs >>= unlessFocusLock . doShift
+
+-- | Move activated window to current workspace and switch focus to it. Note,
+-- that i need to explicitly call 'switchFocus' here, because otherwise, when
+-- activated window is /already/ on current workspace, focus won't be
+-- switched.
+activateOnCurrentWs :: ManageHook
+activateOnCurrentWs = manageFocus (liftQuery activated <&&> newOnCur --> switchFocus)
+                        <+> activateOnCurrent'
+
+-- | Move activated window to current workspace, but keep focus unchanged.
+activateOnCurrentKeepFocus :: ManageHook
+activateOnCurrentKeepFocus  = manageFocus (liftQuery activated <&&> newOnCur --> keepFocus)
+                        <+> activateOnCurrent'
+

XMonad/Hooks/InsertPosition.hs

@@ -22,7 +22,6 @@ module XMonad.Hooks.InsertPosition (
 
 import XMonad(ManageHook, MonadReader(ask))
 import qualified XMonad.StackSet as W
-import Control.Applicative((<$>))
 import Data.Maybe(fromMaybe)
 import Data.List(find)
 import Data.Monoid(Endo(Endo))

XMonad/Hooks/ManageDocks.hs

@@ -15,7 +15,7 @@
 module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
-    docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docks, manageDocks, checkDock, AvoidStruts(..), avoidStruts, avoidStrutsOn,
     docksEventHook, docksStartupHook,
     ToggleStruts(..),
     SetStruts(..),
@@ -104,11 +104,11 @@ instance ExtensionClass StrutCache where
   initialValue = StrutCache M.empty
 
 updateStrutCache :: Window -> [Strut] -> X Bool
-updateStrutCache w strut = do
+updateStrutCache w strut =
   XS.modified $ StrutCache . M.insert w strut . fromStrutCache
 
 deleteFromStructCache :: Window -> X Bool
-deleteFromStructCache w = do
+deleteFromStructCache w =
   XS.modified $ StrutCache . M.delete w . fromStrutCache
 
 -- | Detects if the given window is of type DOCK and if so, reveals
@@ -116,7 +116,7 @@ deleteFromStructCache w = do
 manageDocks :: ManageHook
 manageDocks = checkDock --> (doIgnore <+> setDocksMask)
     where setDocksMask = do
-            ask >>= \win -> liftX $ withDisplay $ \dpy -> do
+            ask >>= \win -> liftX $ withDisplay $ \dpy ->
                 io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
             mempty
 
@@ -167,7 +167,7 @@ getStrut w = do
     msp <- getProp32s "_NET_WM_STRUT_PARTIAL" w
     case msp of
         Just sp -> return $ parseStrutPartial sp
-        Nothing -> fmap (maybe [] parseStrut) $ getProp32s "_NET_WM_STRUT" w
+        Nothing -> maybe [] parseStrut <$> getProp32s "_NET_WM_STRUT" w
  where
     parseStrut xs@[_, _, _, _] = parseStrutPartial . take 12 $ xs ++ cycle [minBound, maxBound]
     parseStrut _ = []
@@ -182,7 +182,7 @@ getStrut w = do
 calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
 calcGap ss = withDisplay $ \dpy -> do
     rootw <- asks theRoot
-    struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)
+    struts <- (filter careAbout . concat) <$> XS.gets (M.elems . fromStrutCache)
 
     -- we grab the window attributes of the root window rather than checking
     -- the width of the screen because xlib caches this info and it tends to

XMonad/Hooks/ManageHelpers.hs

@@ -46,6 +46,7 @@ module XMonad.Hooks.ManageHelpers (
     doFloatAt,
     doFloatDep,
     doHideIgnore,
+    doSink,
     Match,
 ) where
 
@@ -73,8 +74,8 @@ data Match a = Match Bool a
 -- | An alternative 'ManageHook' composer. Unlike 'composeAll' it stops as soon as
 -- a candidate returns a 'Just' value, effectively running only the first match
 -- (whereas 'composeAll' continues and executes all matching rules).
-composeOne :: [MaybeManageHook] -> ManageHook
+composeOne :: (Monoid a, Monad m) => [m (Maybe a)] -> m a
-composeOne = foldr try idHook
+composeOne = foldr try (return mempty)
     where
     try q z = do
         x <- q
@@ -85,17 +86,17 @@ composeOne = foldr try idHook
 infixr 0 -?>, -->>, -?>>
 
 -- | q \/=? x. if the result of q equals x, return False
-(/=?) :: Eq a => Query a -> a -> Query Bool
+(/=?) :: (Eq a, Functor m) => m a -> a -> m Bool
 q /=? x = fmap (/= x) q
 
 -- | q <==? x. if the result of q equals x, return True grouped with q
-(<==?) :: Eq a => Query a -> a -> Query (Match a)
+(<==?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
 q <==? x = fmap (`eq` x) q
     where
     eq q' x' = Match (q' == x') q'
 
 -- | q <\/=? x. if the result of q notequals x, return True grouped with q
-(</=?) :: Eq a => Query a -> a -> Query (Match a)
+(</=?) :: (Eq a, Functor m) => m a -> a -> m (Match a)
 q </=? x = fmap (`neq` x) q
     where
     neq q' x' = Match (q' /= x') q'
@@ -103,19 +104,19 @@ q </=? x = fmap (`neq` x) q
 -- | A helper operator for use in 'composeOne'. It takes a condition and an action;
 -- if the condition fails, it returns 'Nothing' from the 'Query' so 'composeOne' will
 -- go on and try the next rule.
-(-?>) :: Query Bool -> ManageHook -> MaybeManageHook
+(-?>) :: (Functor m, Monad m) => m Bool -> m a -> m (Maybe a)
 p -?> f = do
     x <- p
     if x then fmap Just f else return Nothing
 
 -- | A helper operator for use in 'composeAll'. It takes a condition and a function taking a grouped datum to action.  If 'p' is true, it executes the resulting action.
-(-->>) :: Query (Match a) -> (a -> ManageHook) -> ManageHook
+(-->>) :: (Monoid b, Monad m) => m (Match a) -> (a -> m b) -> m b
 p -->> f = do
     Match b m <- p
-    if b then (f m) else mempty
+    if b then (f m) else return mempty
 
 -- | A helper operator for use in 'composeOne'.  It takes a condition and a function taking a groupdatum to action.  If 'p' is true, it executes the resulting action.  If it fails, it returns 'Nothing' from the 'Query' so 'composeOne' will go on and try the next rule.
-(-?>>) :: Query (Match a) -> (a -> ManageHook) -> MaybeManageHook
+(-?>>) :: (Functor m, Monad m) => m (Match a) -> (a -> m b) -> m (Maybe b)
 p -?>> f = do
     Match b m <- p
     if b then fmap  Just (f m) else return Nothing
@@ -179,7 +180,7 @@ transience' :: ManageHook
 transience' = maybeToDefinite transience
 
 -- | converts 'MaybeManageHook's to 'ManageHook's
-maybeToDefinite :: MaybeManageHook -> ManageHook
+maybeToDefinite :: (Monoid a, Functor m) => m (Maybe a) -> m a
 maybeToDefinite = fmap (fromMaybe mempty)
 
 
@@ -226,3 +227,7 @@ doCenterFloat = doSideFloat C
 -- | Hides window and ignores it.
 doHideIgnore :: ManageHook
 doHideIgnore = ask >>= \w -> liftX (hide w) >> doF (W.delete w)
+
+-- | Sinks a window
+doSink :: ManageHook
+doSink = reader (Endo . W.sink)

XMonad/Hooks/PositionStoreHooks.hs

@@ -40,7 +40,6 @@ import XMonad.Hooks.ManageDocks
 import XMonad.Layout.Decoration
 
 import System.Random(randomRIO)
-import Control.Applicative((<$>))
 import Control.Monad(when)
 import Data.Maybe
 import Data.Monoid
@@ -100,7 +99,7 @@ positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
 
 positionStoreEventHook :: Event -> X All
 positionStoreEventHook (DestroyWindowEvent {ev_window = w, ev_event_type = et}) = do
-    when (et == destroyNotify) $ do
+    when (et == destroyNotify) $
         modifyPosStore (\ps -> posStoreRemove ps w)
     return (All True)
 positionStoreEventHook _ = return (All True)

XMonad/Hooks/RefocusLast.hs

@@ -0,0 +1,295 @@
+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, MultiWayIf #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.RefocusLast
+-- Description :  Hooks and actions to refocus the previous window.
+-- Copyright   :  (c) 2018  L. S. Leary
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  L. S. Leary
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides hooks and actions that keep track of recently focused windows on a
+-- per workspace basis and automatically refocus the last window on loss of the
+-- current (if appropriate as determined by user specified criteria).
+--------------------------------------------------------------------------------
+
+-- --< Imports & Exports >-- {{{
+
+module XMonad.Hooks.RefocusLast (
+  -- * Usage
+  -- $Usage
+  -- * Hooks
+  refocusLastLogHook,
+  refocusLastLayoutHook,
+  refocusLastWhen,
+  -- ** Predicates
+  -- $Predicates
+  refocusingIsActive,
+  isFloat,
+  -- * Actions
+  toggleRefocusing,
+  toggleFocus,
+  swapWithLast,
+  refocusWhen,
+  shiftRLWhen,
+  updateRecentsOn,
+  -- * Types
+  -- $Types
+  RecentWins(..),
+  RecentsMap(..),
+  RefocusLastLayoutHook(..),
+  RefocusLastToggle(..)
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Stack (findS, mapZ_)
+import XMonad.Layout.LayoutModifier
+
+import Data.Maybe (fromMaybe)
+import Data.Monoid (All(..))
+import Data.Foldable (asum)
+import qualified Data.Map.Strict as M
+import Control.Monad (when)
+
+-- }}}
+
+-- --< Usage >-- {{{
+
+-- $Usage
+-- To use this module, you must either include 'refocusLastLogHook' in your log
+-- hook __or__ 'refocusLastLayoutHook' in your layout hook; don't use both.
+-- This suffices to make use of both 'toggleFocus' and 'shiftRLWhen' but will
+-- not refocus automatically upon loss of the current window; for that you must
+-- include in your event hook @'refocusLastWhen' pred@ for some valid @pred@.
+--
+-- The event hooks that trigger refocusing only fire when a window is lost
+-- completely, not when it's simply e.g. moved to another workspace. Hence you
+-- will need to use @'shiftRLWhen' pred@ or @'refocusWhen' pred@ as appropriate
+-- if you want the same behaviour in such cases.
+--
+-- Example configuration:
+--
+-- > import XMonad
+-- > import XMonad.Hooks.RefocusLast
+-- > import qualified Data.Map.Strict as M
+-- >
+-- > main :: IO ()
+-- > main = xmonad def
+-- >     { handleEventHook = refocusLastWhen myPred <+> handleEventHook def
+-- >     , logHook         = refocusLastLogHook     <+> logHook         def
+-- > --  , layoutHook      = refocusLastLayoutHook   $  layoutHook      def
+-- >     , keys            = refocusLastKeys        <+> keys            def
+-- >     } where
+-- >         myPred = refocusingIsActive <||> isFloat
+-- >         refocusLastKeys cnf
+-- >           = M.fromList
+-- >           $ ((modMask cnf              , xK_a), toggleFocus)
+-- >           : ((modMask cnf .|. shiftMask, xK_a), swapWithLast)
+-- >           : ((modMask cnf              , xK_b), toggleRefocusing)
+-- >           : [ ( (modMask cnf .|. shiftMask, n)
+-- >               , windows =<< shiftRLWhen myPred wksp
+-- >               )
+-- >             | (n, wksp) <- zip [xK_1..xK_9] (workspaces cnf)
+-- >             ]
+--
+
+-- }}}
+
+-- --< Types >-- {{{
+
+-- $Types
+-- The types and constructors used in this module are exported principally to
+-- aid extensibility; typical users will have nothing to gain from this section.
+
+-- | Data type holding onto the previous and current @Window@.
+data RecentWins = Recent { previous :: !Window, current :: !Window }
+  deriving (Show, Read, Eq)
+
+-- | Newtype wrapper for a @Map@ holding the @RecentWins@ for each workspace.
+--   Is an instance of @ExtensionClass@ with persistence of state.
+newtype RecentsMap = RecentsMap (M.Map WorkspaceId RecentWins)
+  deriving (Show, Read, Eq, Typeable)
+
+instance ExtensionClass RecentsMap where
+  initialValue = RecentsMap M.empty
+  extensionType = PersistentExtension
+
+-- | A 'LayoutModifier' that updates the 'RecentWins' for a workspace upon
+--   relayout.
+data RefocusLastLayoutHook a = RefocusLastLayoutHook
+  deriving (Show, Read)
+
+instance LayoutModifier RefocusLastLayoutHook a where
+  modifyLayout _ w@(W.Workspace tg _ _) r = updateRecentsOn tg >> runLayout w r
+
+-- | A newtype on @Bool@ to act as a universal toggle for refocusing.
+newtype RefocusLastToggle = RefocusLastToggle { refocusing :: Bool }
+  deriving (Show, Read, Eq, Typeable)
+
+instance ExtensionClass RefocusLastToggle where
+  initialValue  = RefocusLastToggle { refocusing = True }
+  extensionType = PersistentExtension
+
+-- }}}
+
+-- --< Public Hooks >-- {{{
+
+-- | A log hook recording the current workspace's most recently focused windows
+--   into extensible state.
+refocusLastLogHook :: X ()
+refocusLastLogHook = withWindowSet (updateRecentsOn . W.currentTag)
+
+-- | Records a workspace's recently focused windows into extensible state upon
+--   relayout. Potentially a less wasteful alternative to @refocusLastLogHook@,
+--   as it does not run on @WM_NAME@ @propertyNotify@ events.
+refocusLastLayoutHook :: l a -> ModifiedLayout RefocusLastLayoutHook l a
+refocusLastLayoutHook = ModifiedLayout RefocusLastLayoutHook
+
+-- | Given a predicate on the event window determining whether or not to act,
+--   construct an event hook that runs iff the core xmonad event handler will
+--   unmanage the window, and which shifts focus to the last focused window on
+--   the appropriate workspace if desired.
+refocusLastWhen :: Query Bool -> Event -> X All
+refocusLastWhen p event = All True <$ case event of
+  UnmapEvent { ev_send_event = synth, ev_window = w } -> do
+    e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
+    when (synth || e == 0) (refocusLast w)
+  DestroyWindowEvent {                ev_window = w } -> refocusLast w
+  _                                                   -> return ()
+  where
+    refocusLast w = whenX (runQuery p w) . withWindowSet $ \ws ->
+      whenJust (W.findTag w ws) $ \tag ->
+        withRecentsIn tag () $ \lw cw ->
+          when (w == cw) . modify $ \xs ->
+            xs { windowset = tryFocusIn tag [lw] ws }
+
+-- }}}
+
+-- --< Predicates >-- {{{
+
+-- $Predicates
+-- Impure @Query Bool@ predicates on event windows for use as arguments to
+-- 'refocusLastWhen', 'shiftRLWhen' and 'refocusWhen'. Can be combined with
+-- '<||>' or '<&&>'. Use like e.g.
+--
+-- > , handleEventHook = refocusLastWhen refocusingIsActive
+--
+-- or in a keybinding:
+--
+-- > windows =<< shiftRLWhen (refocusingIsActive <&&> isFloat) "3"
+--
+-- It's also valid to use a property lookup like @className =? "someProgram"@ as
+-- a predicate, and it should function as expected with e.g. @shiftRLWhen@.
+-- In the event hook on the other hand, the window in question has already been
+-- unmapped or destroyed, so external lookups to X properties don't work:
+-- only the information fossilised in xmonad's state is available.
+
+-- | Holds iff refocusing is toggled active.
+refocusingIsActive :: Query Bool
+refocusingIsActive = (liftX . XS.gets) refocusing
+
+-- | Holds iff the event window is a float.
+isFloat :: Query Bool
+isFloat = ask >>= \w -> (liftX . gets) (M.member w . W.floating . windowset)
+
+-- }}}
+
+-- --< Public Actions >-- {{{
+
+-- | Toggle automatic refocusing at runtime. Has no effect unless the
+--   @refocusingIsActive@ predicate has been used.
+toggleRefocusing :: X ()
+toggleRefocusing = XS.modify (RefocusLastToggle . not . refocusing)
+
+-- | Refocuses the previously focused window; acts as a toggle.
+--   Is not affected by @toggleRefocusing@.
+toggleFocus :: X ()
+toggleFocus = withRecents $ \lw cw ->
+  when (cw /= lw) . windows $ tryFocus [lw]
+
+-- | Swaps the current and previous windows of the current workspace.
+--   Is not affected by @toggleRefocusing@.
+swapWithLast :: X ()
+swapWithLast = withRecents $ \lw cw ->
+  when (cw /= lw) . windows . modify''. mapZ_ $ \w ->
+    if | (w == lw) -> cw
+       | (w == cw) -> lw
+       | otherwise ->  w
+  where modify'' f = W.modify (f Nothing) (f . Just)
+
+-- | Given a target workspace and a predicate on its current window, produce a
+--   'windows' suitable function that will refocus that workspace appropriately.
+--   Allows you to hook refocusing into any action you can run through
+--   @windows@. See the implementation of @shiftRLWhen@ for a straight-forward
+--   usage example.
+refocusWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
+refocusWhen p tag = withRecentsIn tag id $ \lw cw -> do
+  b <- runQuery p cw
+  return (if b then tryFocusIn tag [cw, lw] else id)
+
+-- | Sends the focused window to the specified workspace, refocusing the last
+--   focused window if the predicate holds on the current window. Note that the
+--   native version of this, @windows . W.shift@, has a nice property that this
+--   does not: shifting a window to another workspace then shifting it back
+--   preserves its place in the stack. Can be used in a keybinding like e.g.
+--
+-- > windows =<< shiftRLWhen refocusingIsActive "3"
+--
+--   or
+--
+-- > (windows <=< shiftRLWhen refocusingIsActive) "3"
+--
+--   where '<=<' is imported from "Control.Monad".
+shiftRLWhen :: Query Bool -> WorkspaceId -> X (WindowSet -> WindowSet)
+shiftRLWhen p to = withWindowSet $ \ws -> do
+  refocus <- refocusWhen p (W.currentTag ws)
+  let shift = maybe id (W.shiftWin to) (W.peek ws)
+  return (refocus . shift)
+
+-- | Perform an update to the 'RecentWins' for the specified workspace.
+--   The RefocusLast log and layout hooks are both implemented trivially in
+--   terms of this function. Only exported to aid extensibility.
+updateRecentsOn :: WorkspaceId -> X ()
+updateRecentsOn tag = withWindowSet $ \ws ->
+  whenJust (W.peek $ W.view tag ws) $ \fw -> do
+    m <- getRecentsMap
+    let insertRecent l c = XS.put . RecentsMap $ M.insert tag (Recent l c) m
+    case M.lookup tag m of
+      Just (Recent _ cw) -> when (cw /= fw) (insertRecent cw fw)
+      Nothing            ->                  insertRecent fw fw
+
+-- }}}
+
+-- --< Private Utilities >-- {{{
+
+-- | Focuses the first window in the list it can find on the current workspace.
+tryFocus :: [Window] -> WindowSet -> WindowSet
+tryFocus wins = W.modify' $ \s ->
+  fromMaybe s . asum $ (\w -> findS (== w) s) <$> wins
+
+-- | Operate the above on a specified workspace.
+tryFocusIn :: WorkspaceId -> [Window] -> WindowSet -> WindowSet
+tryFocusIn tag wins ws =
+  W.view (W.currentTag ws) . tryFocus wins . W.view tag $ ws
+
+-- | Get the RecentsMap out of extensible state and remove its newtype wrapper.
+getRecentsMap :: X (M.Map WorkspaceId RecentWins)
+getRecentsMap = XS.get >>= \(RecentsMap m) -> return m
+
+-- | Perform an X action dependent on successful lookup of the RecentWins for
+--   the specified workspace, or return a default value.
+withRecentsIn :: WorkspaceId -> a -> (Window -> Window -> X a) -> X a
+withRecentsIn tag dflt f = M.lookup tag <$> getRecentsMap
+                       >>= maybe (return dflt) (\(Recent lw cw) -> f lw cw)
+
+-- | The above specialised to the current workspace and unit.
+withRecents :: (Window -> Window -> X ()) -> X ()
+withRecents f = withWindowSet $ \ws -> withRecentsIn (W.currentTag ws) () f
+
+-- }}}
+

XMonad/Hooks/ScreenCorners.hs

@@ -65,7 +65,7 @@ addScreenCorner corner xF = do
     (win,xFunc) <- case find (\(_,(sc,_)) -> sc == corner) (M.toList m) of
 
                         Just (w, (_,xF')) -> return (w, xF' >> xF) -- chain X actions
-                        Nothing           -> flip (,) xF `fmap` createWindowAt corner
+                        Nothing           -> flip (,) xF <$> createWindowAt corner
 
     XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
 
@@ -179,7 +179,7 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
 --
 -- > myStartupHook = do
 -- >     ...
--- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
+-- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
 -- >     addScreenCorners [ (SCLowerRight, nextWS)
 -- >                      , (SCLowerLeft,  prevWS)
 -- >                      ]

XMonad/Hooks/SetWMName.hs

@@ -36,7 +36,10 @@
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.SetWMName (
-    setWMName) where
+      setWMName
+    , getWMName
+    )
+  where
 
 import Control.Monad (join)
 import Data.Char (ord)
@@ -61,26 +64,26 @@ setWMName name = do
     dpy <- asks display
     io $ do
         -- _NET_SUPPORTING_WM_CHECK atom of root and support windows refers to the support window
-        mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW 0 [fromIntegral supportWindow]) [root, supportWindow]
+        mapM_ (\w -> changeProperty32 dpy w atom_NET_SUPPORTING_WM_CHECK wINDOW propModeReplace [fromIntegral supportWindow]) [root, supportWindow]
         -- set WM_NAME in supportWindow (now only accepts latin1 names to eliminate dependency on utf8 encoder)
-        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING 0 (latin1StringToCCharList name)
+        changeProperty8 dpy supportWindow atom_NET_WM_NAME atom_UTF8_STRING propModeReplace (latin1StringToCCharList name)
         -- declare which _NET protocols are supported (append to the list if it exists)
-        supportedList <- fmap (join . maybeToList) $ getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
+        supportedList <- join . maybeToList <$> getWindowProperty32 dpy atom_NET_SUPPORTED_ATOM root
-        changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM 0 (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
+        changeProperty32 dpy root atom_NET_SUPPORTED_ATOM aTOM propModeReplace (nub $ fromIntegral atom_NET_SUPPORTING_WM_CHECK : fromIntegral atom_NET_WM_NAME : supportedList)
   where
-    netSupportingWMCheckAtom :: X Atom
-    netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
-
     latin1StringToCCharList :: String -> [CChar]
     latin1StringToCCharList str = map (fromIntegral . ord) str
 
-    getSupportWindow :: X Window
+netSupportingWMCheckAtom :: X Atom
-    getSupportWindow = withDisplay $ \dpy -> do
+netSupportingWMCheckAtom = getAtom "_NET_SUPPORTING_WM_CHECK"
-        atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
-        root <- asks theRoot
-        supportWindow <- fmap (join . fmap listToMaybe) $ io $ getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root
-        validateWindow (fmap fromIntegral supportWindow)
 
+getSupportWindow :: X Window
+getSupportWindow = withDisplay $ \dpy -> do
+    atom_NET_SUPPORTING_WM_CHECK <- netSupportingWMCheckAtom
+    root <- asks theRoot
+    supportWindow <- (listToMaybe =<<) <$> io (getWindowProperty32 dpy atom_NET_SUPPORTING_WM_CHECK root)
+    validateWindow (fmap fromIntegral supportWindow)
+  where
     validateWindow :: Maybe Window -> X Window
     validateWindow w = do
         valid <- maybe (return False) isValidWindow w
@@ -110,3 +113,8 @@ setWMName name = do
         io $ mapWindow dpy window   -- not sure if this is needed
         io $ lowerWindow dpy window -- not sure if this is needed
         return window
+
+-- | Get WM name.
+getWMName :: X String
+getWMName = getSupportWindow >>= runQuery title
+

XMonad/Hooks/ToggleHook.hs

@@ -42,7 +42,6 @@ import XMonad
 import qualified XMonad.Util.ExtensibleState as XS
 
 import Control.Monad (join,guard)
-import Control.Applicative ((<$>))
 import Control.Arrow (first, second)
 
 import Data.Map

XMonad/Hooks/UrgencyHook.hs

@@ -81,7 +81,6 @@ import XMonad.Util.NamedWindows (getName)
 import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
 import XMonad.Util.WindowProperties (getProp32)
 
-import Control.Applicative ((<$>))
 import Control.Monad (when)
 import Data.Bits (testBit)
 import Data.List (delete, (\\))
@@ -321,9 +320,8 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
 changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
 changeNetWMState dpy w f = do
    wmstate <- getAtom "_NET_WM_STATE"
-   wstate  <- fromMaybe [] `fmap` getProp32 wmstate w
+   wstate  <- fromMaybe [] <$> getProp32 wmstate w
-   let ptype = 4 -- atom property type for changeProperty
+   io $ changeProperty32 dpy w wmstate aTOM propModeReplace (f wstate)
-   io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
    return ()
 
 -- | Add an atom to the _NET_WM_STATE property.
@@ -338,7 +336,7 @@ removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom
 getNetWMState :: Window -> X [CLong]
 getNetWMState w = do
     a_wmstate <- getAtom "_NET_WM_STATE"
-    fromMaybe [] `fmap` getProp32 a_wmstate w
+    fromMaybe [] <$> getProp32 a_wmstate w
 
 
 -- The Non-ICCCM Manifesto:
@@ -357,7 +355,7 @@ handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
 handleEvent wuh event =
     case event of
      -- WM_HINTS urgency flag
-      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
+      PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } ->
           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
               if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w

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/)
@@ -217,7 +221,7 @@ layerCommand (rect, path) = do
   res <- getPicRes path
   return $ case needsRotation rect <$> res of
     Nothing -> ""
-    Just rotate ->
+    Just rotate -> let size = show (rect_width rect) ++ "x" ++ show (rect_height rect) in
                      " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
-                      ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
+                      ++ " -scale "++size++"^ -gravity center -extent "++size++" +gravity \\)"
                       ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "

XMonad/Hooks/WindowSwallowing.hs

@@ -0,0 +1,245 @@
+{-# LANGUAGE NamedFieldPuns #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.WindowSwallowing
+-- Copyright   :  (c) 2020 Leon Kowarschick
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Leon Kowarschick. <thereal.elkowar@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides a handleEventHook that implements window swallowing.
+--
+-- If you open a GUI-window (i.e. feh) from the terminal,
+-- the terminal will normally still be shown on screen, unnecessarily
+-- taking up space on the screen.
+-- With window swallowing, can detect that you opened a window from within another
+-- window, and allows you "swallow" that parent window for the time the new
+-- window is running.
+--
+-- __NOTE__: This module depends on @pstree@ to analyze the process hierarchy, so make
+-- sure that is on your @$PATH@.
+--
+-- __NOTE__ that this does not always work perfectly:
+--
+-- - Because window swallowing needs to check the process hierarchy, it requires
+--   both the child and the parent to be distinct processes. This means that
+--   applications which implement instance sharing cannot be supported by window swallowing.
+--   Most notably, this excludes some terminal emulators as well as tmux
+--   from functioning as the parent process. It also excludes a good amount of
+--   child programs, because many graphical applications do implement instance sharing.
+--   For example, window swallowing will probably not work with your browser.
+--
+-- - To check the process hierarchy, we need to be able to get the process ID
+--   by looking at the window. This requires the @_NET_WM_PID@ X-property to be set.
+--   If any application you want to use this with does not provide the @_NET_WM_PID@,
+--   there is not much you can do except for reaching out to the author of that
+--   application and asking them to set that property.
+-----------------------------------------------------------------------------
+module XMonad.Hooks.WindowSwallowing
+  ( -- * Usage
+    -- $usage
+    swallowEventHook
+  )
+where
+import           XMonad
+import qualified XMonad.StackSet               as W
+import qualified XMonad.Util.ExtensibleState   as XS
+import           XMonad.Util.WindowProperties
+import           XMonad.Util.Run                ( runProcessWithInput )
+import           Data.Semigroup                 ( All(..) )
+import qualified Data.Map.Strict               as M
+import           Data.List                      ( isInfixOf )
+import           Control.Monad                  ( when )
+
+-- $usage
+-- You can use this module by including  the following in your @~\/.xmonad/xmonad.hs@:
+--
+-- > import XMonad.Hooks.WindowSwallowing
+--
+-- and using 'swallowEventHook' somewhere in your 'handleEventHook', for example:
+--
+-- > myHandleEventHook = swallowEventHook (className =? "Alacritty" <||> className =? "Termite") (return True)
+--
+-- For more information on editing your handleEventHook and key bindings,
+-- see "XMonad.Doc.Extending".
+
+
+-- | handleEventHook that will swallow child windows when they are
+-- opened from another window.
+swallowEventHook
+  :: Query Bool -- ^ query the parent window has to match for window swallowing to occur.
+                --   Set this to @return True@ to run swallowing for every parent.
+  -> Query Bool -- ^ query the child window has to match for window swallowing to occur.
+                --   Set this to @return True@ to run swallowing for every child
+  -> Event      -- ^ The event to handle.
+  -> X All
+swallowEventHook parentQueries childQueries event = do
+  case event of
+    -- This is called right before a window gets opened. We intercept that
+    -- call to possibly open the window ourselves, swapping out
+    -- it's parent processes window for the new window in the stack.
+    MapRequestEvent { ev_window = childWindow } ->
+      -- For a window to be opened from within another window, that other window
+      -- must be focused. Thus the parent window that would be swallowed has to be
+      -- the currently focused window.
+      withFocused $ \parentWindow -> do
+        -- First verify that both windows match the given queries
+        parentMatches <- runQuery parentQueries parentWindow
+        childMatches  <- runQuery childQueries childWindow
+        when (parentMatches && childMatches) $ do
+          -- read the windows _NET_WM_PID properties
+          childWindowPid  <- getProp32s "_NET_WM_PID" childWindow
+          parentWindowPid <- getProp32s "_NET_WM_PID" parentWindow
+          case (parentWindowPid, childWindowPid) of
+            (Just (parentPid : _), Just (childPid : _)) -> do
+              -- check if the new window is a child process of the last focused window
+              -- using the process ids.
+              isChild <- liftIO $ fi childPid `isChildOf` fi parentPid
+              when isChild $ do
+                -- We set the newly opened window as the focused window, replacing the parent window.
+                -- If the parent window was floating, we transfer that data to the child,
+                -- such that it shows up at the same position, with the same dimensions.
+
+                windows
+                  ( W.modify' (\x -> x { W.focus = childWindow })
+                  . moveFloatingState parentWindow childWindow
+                  )
+                XS.modify (addSwallowedParent parentWindow childWindow)
+            _ -> return ()
+          return ()
+
+
+    -- This is called in many circumstances, most notably for us:
+    -- right before a window gets closed. We store the current
+    -- state of the window stack here, such that we know where the
+    -- child window was on the screen when restoring the swallowed parent process.
+    ConfigureEvent{} -> withWindowSet $ \ws -> do
+      XS.modify . setStackBeforeWindowClosing . currentStack $ ws
+      XS.modify . setFloatingBeforeWindowClosing . W.floating $ ws
+
+    -- This is called right after any window closes.
+    DestroyWindowEvent { ev_event = eventId, ev_window = childWindow } ->
+      -- Because DestroyWindowEvent is emitted a lot more often then you think,
+      -- this check verifies that the event is /actually/ about closing a window.
+      when (eventId == childWindow) $ do
+        -- we get some data from the extensible state, most notably we ask for
+        -- the \"parent\" window of the now closed window.
+        maybeSwallowedParent <- XS.gets (getSwallowedParent childWindow)
+        maybeOldStack        <- XS.gets stackBeforeWindowClosing
+        oldFloating          <- XS.gets floatingBeforeClosing
+        case (maybeSwallowedParent, maybeOldStack) of
+          (Just parent, Just oldStack) -> do
+            -- If there actually is a corresponding swallowed parent window for this window,
+            -- we will try to restore it.
+            -- because there are some cases where the stack-state is not stored correctly in the ConfigureEvent hook,
+            -- we have to first check if the stack-state is valid.
+            -- if it is, we can restore the parent exactly where the child window was before being closed
+            -- if the stored stack-state is invalid however, we still restore the window
+            -- by just inserting it as the focused window in the stack.
+            stackStoredCorrectly <- do
+              curStack <- withWindowSet (return . currentStack)
+              let oldLen = length (W.integrate oldStack)
+              let curLen = length (W.integrate' curStack)
+              return (oldLen - 1 == curLen && childWindow == W.focus oldStack)
+
+            if stackStoredCorrectly
+              then windows
+                (\ws ->
+                  updateCurrentStack
+                      (const $ Just $ oldStack { W.focus = parent })
+                    $ moveFloatingState childWindow parent
+                    $ ws { W.floating = oldFloating }
+                )
+              else windows (insertIntoStack parent)
+            -- after restoring, we remove the information about the swallowing from the state.
+            XS.modify $ removeSwallowed childWindow
+            XS.modify $ setStackBeforeWindowClosing Nothing
+          _ -> return ()
+        return ()
+    _ -> return ()
+  return $ All True
+
+
+-- | insert a window as focused into the current stack, moving the previously focused window down the stack
+insertIntoStack :: a -> W.StackSet i l a sid sd -> W.StackSet i l a sid sd
+insertIntoStack win = W.modify
+  (Just $ W.Stack win [] [])
+  (\s -> Just $ s { W.focus = win, W.down = W.focus s : W.down s })
+
+
+-- | run a pure transformation on the Stack of the currently focused workspace.
+updateCurrentStack
+  :: (Maybe (W.Stack a) -> Maybe (W.Stack a))
+  -> W.StackSet i l a sid sd
+  -> W.StackSet i l a sid sd
+updateCurrentStack f = W.modify (f Nothing) (f . Just)
+
+currentStack :: W.StackSet i l a sid sd -> Maybe (W.Stack a)
+currentStack = W.stack . W.workspace . W.current
+
+
+-- | move the floating state from one window to another, sinking the original window
+moveFloatingState
+  :: Ord a
+  => a -- ^ window to move from
+  -> a -- ^ window to move to
+  -> W.StackSet i l a s sd
+  -> W.StackSet i l a s sd
+moveFloatingState from to ws = ws
+  { W.floating = M.delete from $ maybe (M.delete to (W.floating ws))
+                                       (\r -> M.insert to r (W.floating ws))
+                                       (M.lookup from (W.floating ws))
+  }
+
+
+-- | check if a given process is a child of another process. This depends on "pstree" being in the PATH
+-- NOTE: this does not work if the child process does any kind of process-sharing.
+isChildOf
+  :: Int -- ^ child PID
+  -> Int -- ^ parent PID
+  -> IO Bool
+isChildOf child parent = do
+  output <- runProcessWithInput "pstree" ["-T", "-p", show parent] ""
+  return $ any (show child `isInfixOf`) $ lines output
+
+
+data SwallowingState =
+  SwallowingState
+    { currentlySwallowed       :: M.Map Window Window         -- ^ mapping from child window window to the currently swallowed parent window
+    , stackBeforeWindowClosing :: Maybe (W.Stack Window)      -- ^ current stack state right before DestroyWindowEvent is sent
+    , floatingBeforeClosing    :: M.Map Window W.RationalRect -- ^ floating map of the stackset right before DestroyWindowEvent is sent
+    } deriving (Typeable, Show)
+
+getSwallowedParent :: Window -> SwallowingState -> Maybe Window
+getSwallowedParent win SwallowingState { currentlySwallowed } =
+  M.lookup win currentlySwallowed
+
+addSwallowedParent :: Window -> Window -> SwallowingState -> SwallowingState
+addSwallowedParent parent child s@SwallowingState { currentlySwallowed } =
+  s { currentlySwallowed = M.insert child parent currentlySwallowed }
+
+removeSwallowed :: Window -> SwallowingState -> SwallowingState
+removeSwallowed child s@SwallowingState { currentlySwallowed } =
+  s { currentlySwallowed = M.delete child currentlySwallowed }
+
+setStackBeforeWindowClosing
+  :: Maybe (W.Stack Window) -> SwallowingState -> SwallowingState
+setStackBeforeWindowClosing stack s = s { stackBeforeWindowClosing = stack }
+
+setFloatingBeforeWindowClosing
+  :: M.Map Window W.RationalRect -> SwallowingState -> SwallowingState
+setFloatingBeforeWindowClosing x s = s { floatingBeforeClosing = x }
+
+instance ExtensionClass SwallowingState where
+  initialValue = SwallowingState { currentlySwallowed       = mempty
+                                 , stackBeforeWindowClosing = Nothing
+                                 , floatingBeforeClosing    = mempty
+                                 }
+
+
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+

XMonad/Hooks/WorkspaceByPos.hs

@@ -25,7 +25,6 @@ import qualified XMonad.StackSet as W
 import XMonad.Util.XUtils (fi)
 
 import Data.Maybe
-import Control.Applicative((<$>))
 import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
 
 -- $usage

XMonad/Hooks/WorkspaceHistory.hs

@@ -25,6 +25,7 @@ module XMonad.Hooks.WorkspaceHistory (
   , workspaceHistoryWithScreen
     -- * Handling edits
   , workspaceHistoryTransaction
+  , workspaceHistoryModify
   ) where
 
 import           Control.Applicative
@@ -101,3 +102,7 @@ updateLastActiveOnEachScreen StackSet {current = cur, visible = vis} wh =
       let newEntry = (sid, wid)
           alreadyCurrent = maybe False (== newEntry) $ firstOnScreen sid curr
       in if alreadyCurrent then curr else newEntry:delete newEntry curr
+
+-- | Modify a the workspace history with a given pure function.
+workspaceHistoryModify :: ([(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]) -> X ()
+workspaceHistoryModify action = XS.modify $ WorkspaceHistory . action . history

XMonad/Layout/AutoMaster.hs

@@ -73,7 +73,7 @@ autoLayout k bias wksp rect = do
     let n = length ws
     if null ws then
         runLayout wksp rect
-        else do
+        else
           if (n<=k) then
               return ((divideRow rect ws),Nothing)
               else do

XMonad/Layout/AvoidFloats.hs

@@ -108,10 +108,10 @@ instance LayoutModifier AvoidFloats Window where
     modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
         floating <- gets $ W.floating . windowset
         case cache lm of
-            Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer
+            Just (key, mer) | key == (floating,r) -> flip (,) Nothing <$> runLayout w mer
-            _ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
+            _ -> do rs <- io $ map toRect <$> mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
                     let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
-                    flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer
+                    flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) <$> runLayout w mer
         where
             toRect :: WindowAttributes -> Rectangle
             toRect wa = let b = fi $ wa_border_width wa

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

@@ -6,6 +6,7 @@
 -- Module      :  XMonad.Layout.BinarySpacePartition
 -- Copyright   :  (c) 2013 Ben Weitzman    <benweitzman@gmail.com>
 --                    2015 Anton Pirogov   <anton.pirogov@gmail.com>
+--                    2019 Mateusz Karbowy <obszczymucha@gmail.com
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Ben Weitzman <benweitzman@gmail.com>
@@ -29,6 +30,7 @@ module XMonad.Layout.BinarySpacePartition (
   , FocusParent(..)
   , SelectMoveNode(..)
   , Direction2D(..)
+  , SplitShiftDirectional(..)
   ) where
 
 import XMonad
@@ -66,19 +68,21 @@ import Data.Ratio ((%))
 --
 -- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
 --
--- > , ((modm .|. altMask,               xK_l     ), sendMessage $ ExpandTowards R)
+-- > , ((modm .|. altMask,                 xK_l     ), sendMessage $ ExpandTowards R)
--- > , ((modm .|. altMask,               xK_h     ), sendMessage $ ExpandTowards L)
+-- > , ((modm .|. altMask,                 xK_h     ), sendMessage $ ExpandTowards L)
--- > , ((modm .|. altMask,               xK_j     ), sendMessage $ ExpandTowards D)
+-- > , ((modm .|. altMask,                 xK_j     ), sendMessage $ ExpandTowards D)
--- > , ((modm .|. altMask,               xK_k     ), sendMessage $ ExpandTowards U)
+-- > , ((modm .|. altMask,                 xK_k     ), sendMessage $ ExpandTowards U)
--- > , ((modm .|. altMask .|. ctrlMask , xK_l     ), sendMessage $ ShrinkFrom R)
+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_l     ), sendMessage $ ShrinkFrom R)
--- > , ((modm .|. altMask .|. ctrlMask , xK_h     ), sendMessage $ ShrinkFrom L)
+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_h     ), sendMessage $ ShrinkFrom L)
--- > , ((modm .|. altMask .|. ctrlMask , xK_j     ), sendMessage $ ShrinkFrom D)
+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_j     ), sendMessage $ ShrinkFrom D)
--- > , ((modm .|. altMask .|. ctrlMask , xK_k     ), sendMessage $ ShrinkFrom U)
+-- > , ((modm .|. altMask .|. ctrlMask ,   xK_k     ), sendMessage $ ShrinkFrom U)
--- > , ((modm,                           xK_r     ), sendMessage Rotate)
+-- > , ((modm,                             xK_r     ), sendMessage Rotate)
--- > , ((modm,                           xK_s     ), sendMessage Swap)
+-- > , ((modm,                             xK_s     ), sendMessage Swap)
--- > , ((modm,                           xK_n     ), sendMessage FocusParent)
+-- > , ((modm,                             xK_n     ), sendMessage FocusParent)
--- > , ((modm .|. ctrlMask,              xK_n     ), sendMessage SelectNode)
+-- > , ((modm .|. ctrlMask,                xK_n     ), sendMessage SelectNode)
--- > , ((modm .|. shiftMask,             xK_n     ), sendMessage MoveNode)
+-- > , ((modm .|. shiftMask,               xK_n     ), sendMessage MoveNode)
+-- > , ((modm .|. shiftMask .|. ctrlMask , xK_j     ), sendMessage $ SplitShift Prev)
+-- > , ((modm .|. shiftMask .|. ctrlMask , xK_k     ), sendMessage $ SplitShift Next)
 --
 -- Here's an alternative key mapping, this time using additionalKeysP,
 -- arrow keys, and slightly different behavior when resizing windows
@@ -92,7 +96,9 @@ import Data.Ratio ((%))
 -- > , ("M-M1-C-<Up>",    sendMessage $ ShrinkFrom D)
 -- > , ("M-M1-C-<Down>",  sendMessage $ ExpandTowards D)
 -- > , ("M-s",            sendMessage $ BSP.Swap)
--- > , ("M-M1-s",         sendMessage $ Rotate) ]
+-- > , ("M-M1-s",         sendMessage $ Rotate)
+-- > , ("M-S-C-j",        sendMessage $ SplitShift Prev)
+-- > , ("M-S-C-k",        sendMessage $ SplitShift Next)
 --
 -- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
 -- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
@@ -133,6 +139,10 @@ instance Message SelectMoveNode
 
 data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
 
+-- |Message for shifting window by splitting its neighbour
+data SplitShiftDirectional = SplitShift Direction1D deriving Typeable
+instance Message SplitShiftDirectional
+
 oppositeDirection :: Direction2D -> Direction2D
 oppositeDirection U = D
 oppositeDirection D = U
@@ -273,6 +283,42 @@ swapCurrent :: Zipper a -> Maybe (Zipper a)
 swapCurrent l@(_, []) = Just l
 swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
 
+insertLeftLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
+insertLeftLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Node x l r), crumb:cs)
+insertLeftLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf n) (Leaf x), crumb:cs)
+insertLeftLeaf (Node _ _ _) z = Just z
+
+insertRightLeaf :: Tree Split -> Zipper Split -> Maybe (Zipper Split)
+insertRightLeaf (Leaf n) ((Node x l r), crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Node x l r) (Leaf n), crumb:cs)
+insertRightLeaf (Leaf n) (Leaf x, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf x) (Leaf n), crumb:cs)
+insertRightLeaf (Node _ _ _) z = Just z
+
+findRightLeaf :: Zipper Split -> Maybe (Zipper Split)
+findRightLeaf n@(Node _ _ _, _) = goRight n >>= findRightLeaf
+findRightLeaf l@(Leaf _, _) = Just l
+
+findLeftLeaf :: Zipper Split -> Maybe (Zipper Split)
+findLeftLeaf n@(Node _ _ _, _) = goLeft n
+findLeftLeaf l@(Leaf _, _) = Just l
+
+findTheClosestLeftmostLeaf :: Zipper Split -> Maybe (Zipper Split)
+findTheClosestLeftmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= goLeft >>= findRightLeaf
+findTheClosestLeftmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= findTheClosestLeftmostLeaf
+
+findTheClosestRightmostLeaf :: Zipper Split -> Maybe (Zipper Split)
+findTheClosestRightmostLeaf s@(_, (RightCrumb _ _):_) = goUp s >>= findTheClosestRightmostLeaf
+findTheClosestRightmostLeaf s@(_, (LeftCrumb _ _):_) = goUp s >>= goRight >>= findLeftLeaf
+
+splitShiftLeftCurrent :: Zipper Split -> Maybe (Zipper Split)
+splitShiftLeftCurrent l@(_, []) = Just l
+splitShiftLeftCurrent l@(_, (RightCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
+splitShiftLeftCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestLeftmostLeaf >>= insertRightLeaf n
+
+splitShiftRightCurrent :: Zipper Split -> Maybe (Zipper Split)
+splitShiftRightCurrent l@(_, []) = Just l
+splitShiftRightCurrent l@(_, (LeftCrumb _ _):_) = Just l -- Do nothing. We can swap windows instead.
+splitShiftRightCurrent l@(n, c:cs) = removeCurrent l >>= findTheClosestRightmostLeaf >>= insertLeftLeaf n
+
 isAllTheWay :: Direction2D -> Zipper Split -> Bool
 isAllTheWay _ (_, []) = True
 isAllTheWay R (_, LeftCrumb s _:_)
@@ -513,6 +559,12 @@ swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
 swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
 swapNth b = doToNth swapCurrent b
 
+splitShiftNth :: Direction1D -> BinarySpacePartition a -> BinarySpacePartition a
+splitShiftNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
+splitShiftNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
+splitShiftNth Prev b = doToNth splitShiftLeftCurrent b
+splitShiftNth Next b = doToNth splitShiftRightCurrent b
+
 growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
 growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
 growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
@@ -687,6 +739,7 @@ instance LayoutClass BinarySpacePartition Window where
                               , fmap rotateTr      (fromMessage m)
                               , fmap (balanceTr r) (fromMessage m)
                               , fmap move          (fromMessage m)
+                              , fmap splitShift    (fromMessage m)
                               ]
           resize (ExpandTowards dir) = growNthTowards dir b
           resize (ShrinkFrom dir) = shrinkNthFrom dir b
@@ -699,6 +752,7 @@ instance LayoutClass BinarySpacePartition Window where
           balanceTr r Balance  = resetFoc $ rebalanceNth b r
           move MoveNode = resetFoc $ moveNode b
           move SelectNode = b --should not happen here, is done above, as we need X monad
+          splitShift (SplitShift dir) = resetFoc $ splitShiftNth dir b
 
           b = numerateLeaves b_orig
           resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}

XMonad/Layout/BoringWindows.hs

@@ -18,8 +18,10 @@ module XMonad.Layout.BoringWindows (
                                    -- * Usage
                                    -- $usage
                                    boringWindows, boringAuto,
-                                   markBoring, clearBoring,
+                                   markBoring, markBoringEverywhere,
-                                   focusUp, focusDown, focusMaster,
+                                   clearBoring, focusUp, focusDown,
+                                   focusMaster, swapUp, swapDown,
+                                   siftUp, siftDown,
 
                                    UpdateBoring(UpdateBoring),
                                    BoringMessage(Replace,Merge),
@@ -33,8 +35,7 @@ module XMonad.Layout.BoringWindows (
 import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                     LayoutModifier(handleMessOrMaybeModifyIt, redoLayout))
 import XMonad(Typeable, LayoutClass, Message, X, fromMessage,
-              sendMessage, windows, withFocused, Window)
+              broadcastMessage, sendMessage, windows, withFocused, Window)
-import Control.Applicative((<$>))
 import Data.List((\\), union)
 import Data.Maybe(fromMaybe, listToMaybe, maybeToList)
 import qualified Data.Map as M
@@ -65,6 +66,10 @@ import qualified XMonad.StackSet as W
 data BoringMessage = FocusUp | FocusDown | FocusMaster | IsBoring Window | ClearBoring
                      | Replace String [Window]
                      | Merge String [Window]
+                     | SwapUp
+                     | SwapDown
+                     | SiftUp
+                     | SiftDown
                      deriving ( Read, Show, Typeable )
 
 instance Message BoringMessage
@@ -75,12 +80,21 @@ data UpdateBoring = UpdateBoring
     deriving (Typeable)
 instance Message UpdateBoring
 
-markBoring, clearBoring, focusUp, focusDown, focusMaster :: X ()
+markBoring, clearBoring, focusUp, focusDown, focusMaster, swapUp, swapDown, siftUp, siftDown :: X ()
 markBoring = withFocused (sendMessage . IsBoring)
 clearBoring = sendMessage ClearBoring
 focusUp = sendMessage UpdateBoring >> sendMessage FocusUp
 focusDown = sendMessage UpdateBoring >> sendMessage FocusDown
 focusMaster = sendMessage UpdateBoring >> sendMessage FocusMaster
+swapUp = sendMessage UpdateBoring >> sendMessage SwapUp
+swapDown = sendMessage UpdateBoring >> sendMessage SwapDown
+siftUp = sendMessage UpdateBoring >> sendMessage SiftUp
+siftDown = sendMessage UpdateBoring >> sendMessage SiftDown
+
+-- | Mark current focused window boring for all layouts.
+-- This is useful in combination with the 'XMonad.Actions.CopyWindow' module.
+markBoringEverywhere :: X ()
+markBoringEverywhere = withFocused (broadcastMessage . IsBoring)
 
 data BoringWindows a = BoringWindows
     { namedBoring :: M.Map String [a] -- ^ store borings with a specific source
@@ -125,12 +139,30 @@ instance LayoutModifier BoringWindows Window where
                                             . skipBoring W.focusUp'   -- no boring window gets the focus
                                             . focusMaster'
                                return Nothing
-        where skipBoring f st = fromMaybe st $ listToMaybe
+        | Just SwapUp <- fromMessage m =
-                                $ filter ((`notElem` W.focus st:bs) . W.focus)
+                            do windows $ W.modify' skipBoringSwapUp
-                                $ take (length $ W.integrate st)
+                               return Nothing
-                                $ iterate f st
+        | Just SwapDown <- fromMessage m =
+                            do windows $ W.modify' (reverseStack . skipBoringSwapUp . reverseStack)
+                               return Nothing
+        | Just SiftUp <- fromMessage m =
+                            do windows $ W.modify' (siftUpSkipping bs)
+                               return Nothing
+        | Just SiftDown <- fromMessage m =
+                            do windows $ W.modify' (reverseStack . siftUpSkipping bs . reverseStack)
+                               return Nothing
+        where skipBoring = skipBoring' ((`notElem` bs) . W.focus)
+              skipBoringSwapUp = skipBoring'
+                                   (maybe True (`notElem` bs) . listToMaybe . W.down)
+                                   swapUp'
+              skipBoring' p f st = fromMaybe st $ listToMaybe
+                                   $ filter p
+                                   $ drop 1
+                                   $ take (length $ W.integrate st)
+                                   $ iterate f st
               bs = concat $ cbs:maybeToList lbs ++ M.elems nbs
               rjl = return . Just . Left
+              reverseStack (W.Stack t ls rs) = W.Stack t rs ls
     handleMessOrMaybeModifyIt _ _ = return Nothing
 
 -- | Variant of 'focusMaster' that works on a
@@ -139,6 +171,19 @@ focusMaster' :: W.Stack a -> W.Stack a
 focusMaster' c@(W.Stack _ [] _) = c
 focusMaster' (W.Stack t ls rs) = W.Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
 
+swapUp' :: W.Stack a -> W.Stack a
+swapUp' (W.Stack t (l:ls) rs) = W.Stack t ls (l:rs)
+swapUp' (W.Stack t []     rs) = W.Stack t (reverse rs) []
+
+siftUpSkipping :: Eq a => [a] -> W.Stack a -> W.Stack a
+siftUpSkipping bs (W.Stack t ls rs)
+  | (skips, l:ls') <- spanLeft  = W.Stack t ls' (reverse skips ++ l : rs)
+  | (skips, r:rs') <- spanRight = W.Stack t (rs' ++ r : ls) (reverse skips)
+  | otherwise                   = W.Stack t ls rs
+  where
+    spanLeft  = span (`elem` bs) ls
+    spanRight = span (`elem` bs) (reverse rs)
+
 {- $simplest
 
 An alternative to 'Full' is "XMonad.Layout.Simplest".  Less windows are

XMonad/Layout/Combo.hs

@@ -77,14 +77,14 @@ combineTwo = C2 [] []
 instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a)
     => LayoutClass (CombineTwo (l ()) l1 l2) a where
     runLayout (Workspace _ (C2 f w2 super l1 l2) s) rinput = arrange (integrate' s)
-        where arrange [] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
+        where arrange [] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
-                              l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
+                              l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
-                              super' <- maybe super id `fmap`
+                              super' <- maybe super id <$>
                                         handleMessage super (SomeMessage ReleaseResources)
                               return ([], Just $ C2 [] [] super' l1' l2')
-              arrange [w] = do l1' <- maybe l1 id `fmap` handleMessage l1 (SomeMessage ReleaseResources)
+              arrange [w] = do l1' <- maybe l1 id <$> handleMessage l1 (SomeMessage ReleaseResources)
-                               l2' <- maybe l2 id `fmap` handleMessage l2 (SomeMessage ReleaseResources)
+                               l2' <- maybe l2 id <$> handleMessage l2 (SomeMessage ReleaseResources)
-                               super' <- maybe super id `fmap`
+                               super' <- maybe super id <$>
                                          handleMessage super (SomeMessage ReleaseResources)
                                return ([(w,rinput)], Just $ C2 [w] [w] super' l1' l2')
               arrange origws =
@@ -106,13 +106,13 @@ instance (LayoutClass l (), LayoutClass l1 a, LayoutClass l2 a, Read a, Show a,
     handleMessage (C2 f ws2 super l1 l2) m
         | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
           w1 `notElem` ws2,
-          w2 `elem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
+          w2 `elem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
-                             l2' <- maybe l2 id `fmap` handleMessage l2 m
+                             l2' <- maybe l2 id <$> handleMessage l2 m
                              return $ Just $ C2 f (w1:ws2) super l1' l2'
         | Just (MoveWindowToWindow w1 w2) <- fromMessage m,
           w1 `elem` ws2,
-          w2 `notElem` ws2 = do l1' <- maybe l1 id `fmap` handleMessage l1 m
+          w2 `notElem` ws2 = do l1' <- maybe l1 id <$> handleMessage l1 m
-                                l2' <- maybe l2 id `fmap` handleMessage l2 m
+                                l2' <- maybe l2 id <$> handleMessage l2 m
                                 let ws2' = case delete w1 ws2 of [] -> [w2]
                                                                  x -> x
                                 return $ Just $ C2 f ws2' super l1' l2'

XMonad/Layout/Decoration.hs

@@ -17,7 +17,7 @@ module XMonad.Layout.Decoration
     ( -- * Usage:
       -- $usage
       decoration
-    , Theme (..), defaultTheme, def
+    , Theme (..), def
     , Decoration
     , DecorationMsg (..)
     , DecorationStyle (..)
@@ -68,24 +68,28 @@ decoration s t ds = ModifiedLayout (Decoration (I Nothing) s t ds)
 --
 -- For a collection of 'Theme's see "XMonad.Util.Themes"
 data Theme =
-    Theme { activeColor        :: String                   -- ^ Color of the active window
+    Theme { activeColor         :: String                  -- ^ Color of the active window
-          , inactiveColor       :: String                   -- ^ Color of the inactive window
+          , inactiveColor       :: String                  -- ^ Color of the inactive window
-          , urgentColor         :: String                   -- ^ Color of the urgent window
+          , urgentColor         :: String                  -- ^ Color of the urgent window
-          , activeBorderColor   :: String                   -- ^ Color of the border of the active window
+          , activeBorderColor   :: String                  -- ^ Color of the border of the active window
-          , inactiveBorderColor :: String                   -- ^ Color of the border of the inactive window
+          , inactiveBorderColor :: String                  -- ^ Color of the border of the inactive window
-          , urgentBorderColor   :: String                   -- ^ Color of the border of the urgent window
+          , urgentBorderColor   :: String                  -- ^ Color of the border of the urgent window
-          , activeTextColor     :: String                   -- ^ Color of the text of the active window
+          , activeBorderWidth   :: Dimension               -- ^ Width of the border of the active window
-          , inactiveTextColor   :: String                   -- ^ Color of the text of the inactive window
+          , inactiveBorderWidth :: Dimension               -- ^ Width of the border of the inactive window
-          , urgentTextColor     :: String                   -- ^ Color of the text of the urgent window
+          , urgentBorderWidth   :: Dimension               -- ^ Width of the border of the urgent window
-          , fontName            :: String                   -- ^ Font name
+          , activeTextColor     :: String                  -- ^ Color of the text of the active window
-          , decoWidth           :: Dimension                -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
+          , inactiveTextColor   :: String                  -- ^ Color of the text of the inactive window
-          , decoHeight          :: Dimension                -- ^ Height of the decorations
+          , urgentTextColor     :: String                  -- ^ Color of the text of the urgent window
+          , fontName            :: String                  -- ^ Font name
+          , decoWidth           :: Dimension               -- ^ Maximum width of the decorations (if supported by the 'DecorationStyle')
+          , decoHeight          :: Dimension               -- ^ Height of the decorations
           , windowTitleAddons   :: [(String, Align)]       -- ^ Extra text to appear in a window's title bar.
                                                            --    Refer to for a use "XMonad.Layout.ImageButtonDecoration"
           , windowTitleIcons    :: [([[Bool]], Placement)] -- ^ Extra icons to appear in a window's title bar.
                                                            --    Inner @[Bool]@ is a row in a icon bitmap.
           } deriving (Show, Read)
 
+-- | The default xmonad 'Theme'.
 instance Default Theme where
   def =
     Theme { activeColor         = "#999999"
@@ -94,6 +98,9 @@ instance Default Theme where
           , activeBorderColor   = "#FFFFFF"
           , inactiveBorderColor = "#BBBBBB"
           , urgentBorderColor   = "##00FF00"
+          , activeBorderWidth   = 1
+          , inactiveBorderWidth = 1
+          , urgentBorderWidth   = 1
           , activeTextColor     = "#FFFFFF"
           , inactiveTextColor   = "#BFBFBF"
           , urgentTextColor     = "#FF0000"
@@ -104,11 +111,6 @@ instance Default Theme where
           , windowTitleIcons    = []
           }
 
-{-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-}
--- | The default xmonad 'Theme'.
-defaultTheme :: Theme
-defaultTheme = def
-
 -- | A 'Decoration' layout modifier will handle 'SetTheme', a message
 -- to dynamically change the decoration 'Theme'.
 data DecorationMsg = SetTheme Theme deriving ( Typeable )
@@ -313,7 +315,7 @@ handleMouseFocusDrag ds (DS dwrs _) ButtonEvent { ev_window     = ew
             distFromLeft = ex - fi dx
             distFromRight = fi dwh - (ex - fi dx)
         dealtWith <- decorationCatchClicksHook ds mainw (fi distFromLeft) (fi distFromRight)
-        when (not dealtWith) $ do
+        when (not dealtWith) $
             mouseDrag (\x y -> focus mainw >> decorationWhileDraggingHook ds ex ey (mainw, r) x y)
                         (decorationAfterDraggingHook ds (mainw, r) ew)
 handleMouseFocusDrag _ _ _ = return ()
@@ -394,10 +396,11 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
                                                        _ | focusw == win -> ac
                                                          | win `elem` ur -> uc
                                                          | otherwise     -> ic) . W.peek)
-                                `fmap` gets windowset
+                                <$> gets windowset
-  (bc,borderc,tc) <- focusColor w (inactiveColor t, inactiveBorderColor t, inactiveTextColor t)
+  (bc,borderc,borderw,tc) <-
-                                  (activeColor   t, activeBorderColor   t, activeTextColor   t)
+    focusColor w (inactiveColor t, inactiveBorderColor t, inactiveBorderWidth t, inactiveTextColor t)
-                                  (urgentColor   t, urgentBorderColor   t, urgentTextColor   t)
+                 (activeColor   t, activeBorderColor   t, activeBorderWidth   t, activeTextColor   t)
+                 (urgentColor   t, urgentBorderColor   t, urgentBorderWidth   t, urgentTextColor   t)
   let s = shrinkIt sh
   name <- shrinkWhile s (\n -> do size <- io $ textWidthXMF dpy fs n
                                   return $ size > fromIntegral wh - fromIntegral (ht `div` 2)) (show nw)
@@ -405,7 +408,7 @@ updateDeco sh t fs ((w,_),(Just dw,Just (Rectangle _ _ wh ht))) = do
       strs = name : map fst (windowTitleAddons t)
       i_als = map snd (windowTitleIcons t)
       icons = map fst (windowTitleIcons t)
-  paintTextAndIcons dw fs wh ht 1 bc borderc tc bc als strs i_als icons
+  paintTextAndIcons dw fs wh ht borderw bc borderc tc bc als strs i_als icons
 updateDeco _ _ _ (_,(Just w,Nothing)) = hideWindow w
 updateDeco _ _ _ _ = return ()
 

XMonad/Layout/DecorationAddons.hs

@@ -30,7 +30,6 @@ import XMonad.Hooks.ManageDocks
 import XMonad.Util.Font
 import XMonad.Util.PositionStore
 
-import Control.Applicative((<$>))
 import Data.Maybe
 import qualified Data.Set as S
 

XMonad/Layout/DecorationMadness.hs

@@ -82,7 +82,7 @@ module XMonad.Layout.DecorationMadness
     , floatDwmStyle
     , floatSimpleTabbed
     , floatTabbed
-    , def, defaultTheme, shrinkText
+    , def, shrinkText
     ) where
 
 import XMonad

XMonad/Layout/DragPane.hs

@@ -81,14 +81,14 @@ handleMess d@(DragPane mb@(I (Just (win,_,ident))) ty delta split) x
     -- layout specific messages
     | Just Shrink <- fromMessage x = return $ Just (DragPane mb ty delta (split - delta))
     | Just Expand <- fromMessage x = return $ Just (DragPane mb ty delta (split + delta))
-    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident = do
+    | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
                                      return $ Just (DragPane mb ty delta frac)
 handleMess _ _ = return Nothing
 
 handleEvent :: DragPane a -> Event -> X ()
 handleEvent (DragPane (I (Just (win,r,ident))) ty _ _)
             (ButtonEvent {ev_window = thisw, ev_subwindow = thisbw, ev_event_type = t })
-    | t == buttonPress && thisw == win || thisbw == win  = do
+    | t == buttonPress && thisw == win || thisbw == win  =
   mouseDrag (\ex ey -> do
              let frac = case ty of
                         Vertical   -> (fromIntegral ex - (fromIntegral $ rect_x r))/(fromIntegral $ rect_width  r)

XMonad/Layout/DwmStyle.hs

@@ -18,7 +18,6 @@ module XMonad.Layout.DwmStyle
       dwmStyle
     , Theme (..)
     , def
-    , defaultTheme
     , DwmStyle (..)
     , shrinkText, CustomShrink(CustomShrink)
     , Shrinker(..)

XMonad/Layout/FixedColumn.hs

@@ -84,7 +84,7 @@ instance LayoutClass FixedColumn Window where
 widthCols :: Int -> Int -> Window -> X Int
 widthCols inc n w = withDisplay $ \d -> io $ do
     sh <- getWMNormalHints d w
-    bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
+    bw <- fromIntegral . wa_border_width <$> getWindowAttributes d w
     let widthHint f = f sh >>= return . fromIntegral . fst
         oneCol      = fromMaybe inc $ widthHint sh_resize_inc
         base        = fromMaybe 0 $ widthHint sh_base_size

XMonad/Layout/Fullscreen.hs

@@ -30,17 +30,20 @@ module XMonad.Layout.Fullscreen
     ,FullscreenFloat, FullscreenFocus, FullscreenFull
     ) where
 
-import XMonad
+import           XMonad
-import XMonad.Layout.LayoutModifier
+import           XMonad.Layout.LayoutModifier
-import XMonad.Util.WindowProperties
+import           XMonad.Hooks.EwmhDesktops      (fullscreenStartup)
-import XMonad.Hooks.ManageHelpers (isFullscreen)
+import           XMonad.Hooks.ManageHelpers     (isFullscreen)
-import qualified XMonad.StackSet as W
+import           XMonad.Util.WindowProperties
-import Data.List
+import qualified XMonad.Util.Rectangle          as R
-import Data.Maybe
+import qualified XMonad.StackSet                as W
-import Data.Monoid
+
-import qualified Data.Map as M
+import           Data.List
-import Control.Monad
+import           Data.Maybe
-import Control.Arrow (second)
+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
@@ -75,7 +78,8 @@ fullscreenSupport :: LayoutClass l Window =>
 fullscreenSupport c = c {
     layoutHook = fullscreenFull $ layoutHook c,
     handleEventHook = handleEventHook c <+> fullscreenEventHook,
-    manageHook = manageHook c <+> fullscreenManageHook
+    manageHook = manageHook c <+> fullscreenManageHook,
+    startupHook = startupHook c <+> fullscreenStartup
   }
 
 -- | Messages that control the fullscreen state of the window.
@@ -107,9 +111,12 @@ instance LayoutModifier FullscreenFull Window where
     _ -> Nothing
 
   pureModifier (FullscreenFull frect fulls) rect _ list =
-    (map (flip (,) rect') visfulls ++ rest, Nothing)
+    (visfulls' ++ rest', Nothing)
-    where visfulls = intersect fulls $ map fst list
+    where (visfulls,rest) = partition (flip elem fulls . fst) list
-          rest = filter (flip notElem visfulls . fst) list
+          visfulls' = map (second $ const rect') visfulls
+          rest' = if null visfulls'
+                  then rest
+                  else filter (not . R.supersetOf rect' . snd) rest
           rect' = scaleRationalRect rect frect
 
 instance LayoutModifier FullscreenFocus Window where
@@ -122,14 +129,14 @@ 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)
 
 instance LayoutModifier FullscreenFloat Window where
   handleMess (FullscreenFloat frect fulls) m = case fromMessage m of
     Just (AddFullscreen win) -> do
-      mrect <- (M.lookup win . W.floating) `fmap` gets windowset
+      mrect <- (M.lookup win . W.floating) <$> gets windowset
       return $ case mrect of
         Just rect -> Just $ FullscreenFloat frect $ M.insert win (rect,True) fulls
         Nothing -> Nothing
@@ -191,15 +198,14 @@ fullscreenEventHook :: Event -> X All
 fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
   wmstate <- getAtom "_NET_WM_STATE"
   fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
-  wstate <- fromMaybe [] `fmap` getProp32 wmstate win
+  wstate <- fromMaybe [] <$> getProp32 wmstate win
   let fi :: (Integral i, Num n) => i -> n
       fi = fromIntegral
       isFull = fi fullsc `elem` wstate
       remove = 0
       add = 1
       toggle = 2
-      ptype = 4
+      chWState f = io $ changeProperty32 dpy win wmstate aTOM propModeReplace (f wstate)
-      chWState f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
   when (typ == wmstate && fi fullsc `elem` dats) $ do
     when (action == add || (action == toggle && not isFull)) $ do
       chWState (fi fullsc:)
@@ -215,7 +221,7 @@ fullscreenEventHook (DestroyWindowEvent {ev_window = w}) = do
   -- When a window is destroyed, the layouts should remove that window
   -- from their states.
   broadcastMessage $ RemoveFullscreen w
-  cw <- (W.workspace . W.current) `fmap` gets windowset
+  cw <- (W.workspace . W.current) <$> gets windowset
   sendMessageWithNoRefresh FullscreenChanged cw
   return $ All True
 
@@ -236,7 +242,10 @@ fullscreenManageHook' isFull = isFull --> do
   w <- ask
   liftX $ do
     broadcastMessage $ AddFullscreen w
-    cw <- (W.workspace . W.current) `fmap` gets windowset
+    cw <- (W.workspace . W.current) <$> gets windowset
     sendMessageWithNoRefresh FullscreenChanged cw
   idHook
 
+-- | Applies a pair of predicates to a pair of operands, combining them with ||.
+orP :: (a -> Bool) -> (b -> Bool) -> (a, b) -> Bool
+orP f g (x, y) = f x || g y

XMonad/Layout/Gaps.hs

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

XMonad/Layout/Grid.hs

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

XMonad/Layout/Groups.hs

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

XMonad/Layout/Groups/Examples.hs

@@ -37,7 +37,6 @@ module XMonad.Layout.Groups.Examples ( -- * Usage
                                      , fullTabs
                                      , TiledTabsConfig(..)
                                      , def
-                                     , defaultTiledTabsConfig
                                      , increaseNMasterGroups
                                      , decreaseNMasterGroups
                                      , shrinkMasterGroups
@@ -48,7 +47,6 @@ module XMonad.Layout.Groups.Examples ( -- * Usage
                                        -- * Useful re-exports and utils
                                      , module XMonad.Layout.Groups.Helpers
                                      , shrinkText
-                                     , defaultTheme
                                      , GroupEQ(..)
                                      , zoomRowG
                                      ) where
@@ -205,10 +203,6 @@ data TiledTabsConfig s = TTC { vNMaster :: Int
 instance s ~ DefaultShrinker => Default (TiledTabsConfig s) where
     def = TTC 1 0.5 (3/100) 1 0.5 (3/100) shrinkText def
 
-{-# DEPRECATED defaultTiledTabsConfig "Use def (from Data.Default, and re-exported by XMonad.Layout.Groups) instead." #-}
-defaultTiledTabsConfig :: TiledTabsConfig DefaultShrinker
-defaultTiledTabsConfig = def
-
 fullTabs c = _tab c $ G.group _tabs $ Full ||| _vert c ||| _horiz c
 
 tallTabs c = _tab c $ G.group _tabs $ _vert c ||| _horiz c ||| Full

XMonad/Layout/Groups/Helpers.hs

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

XMonad/Layout/Groups/Wmii.hs

@@ -31,7 +31,6 @@ module XMonad.Layout.Groups.Wmii ( -- * Usage
                                    -- * Useful re-exports
                                  , shrinkText
                                  , def
-                                 , defaultTheme
                                  , module XMonad.Layout.Groups.Helpers ) where
 
 import XMonad hiding ((|||))

XMonad/Layout/Hidden.hs

@@ -20,11 +20,13 @@
 module XMonad.Layout.Hidden
        ( -- * Usage
          -- $usage
-         HiddenMsg (..)
+         HiddenWindows
+       , HiddenMsg (..)
        , hiddenWindows
        , hideWindow
        , popOldestHiddenWindow
        , popNewestHiddenWindow
+       , popHiddenWindow
        ) where
 
 --------------------------------------------------------------------------------
@@ -62,9 +64,10 @@ data HiddenWindows a = HiddenWindows [Window] deriving (Show, Read)
 
 --------------------------------------------------------------------------------
 -- | Messages for the @HiddenWindows@ layout modifier.
-data HiddenMsg = HideWindow Window       -- ^ Hide a window.
+data HiddenMsg = HideWindow Window                -- ^ Hide a window.
-               | PopNewestHiddenWindow   -- ^ Restore window (FILO).
+               | PopNewestHiddenWindow            -- ^ Restore window (FILO).
-               | PopOldestHiddenWindow   -- ^ Restore window (FIFO).
+               | PopOldestHiddenWindow            -- ^ Restore window (FIFO).
+               | PopSpecificHiddenWindow Window   -- ^ Restore specific window.
                deriving (Typeable, Eq)
 
 instance Message HiddenMsg
@@ -72,10 +75,11 @@ instance Message HiddenMsg
 --------------------------------------------------------------------------------
 instance LayoutModifier HiddenWindows Window where
   handleMess h@(HiddenWindows hidden) mess
-    | Just (HideWindow win)        <- fromMessage mess = hideWindowMsg h win
+    | Just (HideWindow win)              <- fromMessage mess = hideWindowMsg h win
-    | Just (PopNewestHiddenWindow) <- fromMessage mess = popNewestMsg h
+    | Just (PopNewestHiddenWindow)       <- fromMessage mess = popNewestMsg h
-    | Just (PopOldestHiddenWindow) <- fromMessage mess = popOldestMsg h
+    | Just (PopOldestHiddenWindow)       <- fromMessage mess = popOldestMsg h
-    | Just ReleaseResources        <- fromMessage mess = doUnhook
+    | Just (PopSpecificHiddenWindow win) <- fromMessage mess = popSpecificMsg win h
+    | Just ReleaseResources              <- fromMessage mess = doUnhook
     | otherwise                                        = return Nothing
     where doUnhook = do mapM_ restoreWindow hidden
                         return Nothing
@@ -107,6 +111,9 @@ popOldestHiddenWindow = sendMessage PopOldestHiddenWindow
 popNewestHiddenWindow :: X ()
 popNewestHiddenWindow = sendMessage PopNewestHiddenWindow
 
+popHiddenWindow :: Window -> X ()
+popHiddenWindow = sendMessage . PopSpecificHiddenWindow
+
 --------------------------------------------------------------------------------
 hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
 hideWindowMsg (HiddenWindows hidden) win = do
@@ -128,7 +135,16 @@ popOldestMsg (HiddenWindows (win:rest)) = do
   restoreWindow win
   return . Just . HiddenWindows $ rest
 
+--------------------------------------------------------------------------------
+popSpecificMsg :: Window -> HiddenWindows a -> X (Maybe (HiddenWindows a))
+popSpecificMsg _   (HiddenWindows []) = return Nothing
+popSpecificMsg win (HiddenWindows hiddenWins) = if win `elem` hiddenWins
+  then do
+    restoreWindow win
+    return . Just . HiddenWindows $ filter (/= win) hiddenWins
+  else 
+    return . Just . HiddenWindows $ hiddenWins
+  
 --------------------------------------------------------------------------------
 restoreWindow :: Window -> X ()
-restoreWindow win =
+restoreWindow = windows . W.insertUp
-  modify (\s -> s { windowset = W.insertUp win $ windowset s })

XMonad/Layout/IfMax.hs

@@ -23,7 +23,6 @@ module XMonad.Layout.IfMax
     , ifMax
     ) where
 
-import Control.Applicative((<$>))
 import Control.Arrow
 import qualified Data.List as L
 import qualified Data.Map  as M

XMonad/Layout/IndependentScreens.hs

@@ -29,7 +29,7 @@ module XMonad.Layout.IndependentScreens (
 ) where
 
 -- for the screen stuff
-import Control.Applicative((<*), liftA2)
+import Control.Applicative(liftA2)
 import Control.Arrow hiding ((|||))
 import Control.Monad
 import Data.List (nub, genericLength)
@@ -54,7 +54,7 @@ import XMonad.Hooks.DynamicLog
 -- to specific workspace names.  In the default configuration, only
 -- the keybindings for changing workspace do this:
 --
--- > keyBindings conf = let m = modMask conf in fromList $
+-- > keyBindings conf = let modm = modMask conf in fromList $
 -- >     {- lots of other keybindings -}
 -- >     [((m .|. modm, k), windows $ f i)
 -- >         | (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]
@@ -62,7 +62,7 @@ import XMonad.Hooks.DynamicLog
 --
 -- This should change to
 --
--- > keyBindings conf = let m = modMask conf in fromList $
+-- > keyBindings conf = let modm = modMask conf in fromList $
 -- >     {- lots of other keybindings -}
 -- >     [((m .|. modm, k), windows $ onCurrentScreen f i)
 -- >         | (i, k) <- zip (workspaces' conf) [xK_1 .. xK_9]
@@ -121,7 +121,7 @@ onCurrentScreen f vws = screen . current >>= f . flip marshall vws
 -- >     }
 --
 countScreens :: (MonadIO m, Integral i) => m i
-countScreens = liftM genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
+countScreens = fmap genericLength . liftIO $ openDisplay "" >>= liftA2 (<*) getScreenInfo closeDisplay
 
 -- | This turns a naive pretty-printer into one that is aware of the
 -- independent screens. That is, you can write your pretty printer to behave

XMonad/Layout/LayoutBuilder.hs

@@ -259,7 +259,7 @@ relBox x y w h = SubBox (Rel x) (Rel y) (Rel w) (Rel h)
 
 --------------------------------------------------------------------------------
 instance ( LayoutClass l1 a, LayoutClass l2 a
-         , Read a, Show a, Show p, Eq a, Typeable a, Predicate p a
+         , Read a, Show a, Show p, Typeable p, Eq a, Typeable a, Predicate p a
          ) => LayoutClass (LayoutB l1 l2 p) a where
 
     -- | Update window locations.
@@ -370,7 +370,7 @@ sendFocus l@(LayoutB subFocus _ _ _ _ _ _) m = do
 -- | Check to see if the given window is currently focused.
 isFocus :: (Show a) => Maybe a -> X Bool
 isFocus Nothing = return False
-isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset
                       return $ maybe False (\s -> show w == show (W.focus s)) ms
 
 --------------------------------------------------------------------------------

XMonad/Layout/LayoutBuilderP.hs

@@ -78,7 +78,7 @@ layoutAll box sub =
   let a = alwaysTrue (Proxy :: Proxy a)
   in  LayoutP Nothing Nothing a box Nothing sub Nothing
 
-instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p) =>
+instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) =>
     LayoutClass (LayoutP p l1 l2) w where
 
         -- | Update window locations.
@@ -147,7 +147,7 @@ sendFocus l@(LayoutP subf _ _ _ _ _ _) m = do foc <- isFocus subf
 
 isFocus :: (Show a) => Maybe a -> X Bool
 isFocus Nothing = return False
-isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) `fmap` gets windowset
+isFocus (Just w) = do ms <- (W.stack . W.workspace . W.current) <$> gets windowset
                       return $ maybe False (\s -> show w == (show $ W.focus s)) ms
 
 

XMonad/Layout/LayoutCombinators.hs

@@ -214,7 +214,7 @@ infixr 5 |||
 -- layouts, and use those.
 --
 -- For the ability to select a layout from a prompt, see
--- "Xmonad.Prompt.Layout".
+-- "XMonad.Prompt.Layout".
 
 -- | A reimplementation of the combinator of the same name from the
 --   xmonad core, providing layout choice, and the ability to support
@@ -234,32 +234,32 @@ instance Message JumpToLayout
 
 instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a where
     runLayout (Workspace i (NewSelect True l1 l2) ms) r = do (wrs, ml1') <- runLayout (Workspace i l1 ms) r
-                                                             return (wrs, (\l1' -> NewSelect True l1' l2) `fmap` ml1')
+                                                             return (wrs, (\l1' -> NewSelect True l1' l2) <$> ml1')
 
     runLayout (Workspace i (NewSelect False l1 l2) ms) r = do (wrs, ml2') <- runLayout (Workspace i l2 ms) r
-                                                              return (wrs, (\l2' -> NewSelect False l1 l2') `fmap` ml2')
+                                                              return (wrs, (\l2' -> NewSelect False l1 l2') <$> ml2')
     description (NewSelect True l1 _) = description l1
     description (NewSelect False _ l2) = description l2
     handleMessage l@(NewSelect False _ _) m
-        | Just Wrap <- fromMessage m = fmap Just $ swap l >>= passOn m
+        | Just Wrap <- fromMessage m = Just <$> (swap l >>= passOn m)
     handleMessage l@(NewSelect amfirst _ _) m
         | Just NextLayoutNoWrap <- fromMessage m =
                   if amfirst then when' isNothing (passOnM m l) $
-                                  fmap Just $ swap l >>= passOn (SomeMessage Wrap)
+                                  Just <$> (swap l >>= passOn (SomeMessage Wrap))
                              else passOnM m l
     handleMessage l m
         | Just NextLayout <- fromMessage m = when' isNothing (passOnM (SomeMessage NextLayoutNoWrap) l) $
-                                             fmap Just $ swap l >>= passOn (SomeMessage Wrap)
+                                             Just <$> (swap l >>= passOn (SomeMessage Wrap))
     handleMessage l@(NewSelect True _ l2) m
-        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just `fmap` swap l
+        | Just (JumpToLayout d) <- fromMessage m, d == description l2 = Just <$> swap l
     handleMessage l@(NewSelect False l1 _) m
-        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just `fmap` swap l
+        | Just (JumpToLayout d) <- fromMessage m, d == description l1 = Just <$> swap l
     handleMessage l m
         | Just (JumpToLayout _) <- fromMessage m = when' isNothing (passOnM m l) $
                                                    do ml' <- passOnM m $ sw l
                                                       case ml' of
                                                         Nothing -> return Nothing
-                                                        Just l' -> Just `fmap` swap (sw l')
+                                                        Just l' -> Just <$> swap (sw l')
     handleMessage (NewSelect b l1 l2) m
         | Just ReleaseResources  <- fromMessage m =
         do ml1' <- handleMessage l1 m
@@ -270,21 +270,21 @@ instance (LayoutClass l1 a, LayoutClass l2 a) => LayoutClass (NewSelect l1 l2) a
     handleMessage l m = passOnM m l
 
 swap :: (LayoutClass l1 a, LayoutClass l2 a) => NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
-swap l = sw `fmap` passOn (SomeMessage Hide) l
+swap l = sw <$> passOn (SomeMessage Hide) l
 
 sw :: NewSelect l1 l2 a -> NewSelect l1 l2 a
 sw (NewSelect b lt lf) = NewSelect (not b) lt lf
 
 passOn :: (LayoutClass l1 a, LayoutClass l2 a) =>
           SomeMessage -> NewSelect l1 l2 a -> X (NewSelect l1 l2 a)
-passOn m l = maybe l id `fmap` passOnM m l
+passOn m l = maybe l id <$> passOnM m l
 
 passOnM :: (LayoutClass l1 a, LayoutClass l2 a) =>
            SomeMessage -> NewSelect l1 l2 a -> X (Maybe (NewSelect l1 l2 a))
 passOnM m (NewSelect True lt lf) = do mlt' <- handleMessage lt m
-                                      return $ (\lt' -> NewSelect True lt' lf) `fmap` mlt'
+                                      return $ (\lt' -> NewSelect True lt' lf) <$> mlt'
 passOnM m (NewSelect False lt lf) = do mlf' <- handleMessage lf m
-                                       return $ (\lf' -> NewSelect False lt lf') `fmap` mlf'
+                                       return $ (\lf' -> NewSelect False lt lf') <$> mlf'
 
 when' :: Monad m => (a -> Bool) -> m a -> m a -> m a
 when' f a b = do a1 <- a; if f a1 then b else return a1

XMonad/Layout/LayoutHints.hs

@@ -35,7 +35,6 @@ import XMonad.Layout.Decoration(isInStack)
 import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
                                     LayoutModifier(modifyLayout, redoLayout, modifierDescription))
 import XMonad.Util.Types(Direction2D(..))
-import Control.Applicative((<$>))
 import Control.Arrow(Arrow((***), first, second))
 import Control.Monad(join)
 import Data.Function(on)

XMonad/Layout/LayoutModifier.hs

@@ -122,7 +122,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
                            -> Workspace WorkspaceId (l a) a
                            -> Rectangle
                            -> X (([(a,Rectangle)], Maybe (l a)), Maybe (m a))
-    modifyLayoutWithUpdate m w r = flip (,) Nothing `fmap` modifyLayout m w r
+    modifyLayoutWithUpdate m w r = flip (,) Nothing <$> modifyLayout m w r
 
     -- | 'handleMess' allows you to spy on messages to the underlying
     --   layout, in order to have an effect in the X monad, or alter
@@ -156,7 +156,7 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
     --   simply passes on the message to 'handleMess'.
     handleMessOrMaybeModifyIt :: m a -> SomeMessage -> X (Maybe (Either (m a) SomeMessage))
     handleMessOrMaybeModifyIt m mess = do mm' <- handleMess m mess
-                                          return (Left `fmap` mm')
+                                          return (Left <$> mm')
 
     -- | 'pureMess' allows you to spy on messages sent to the
     --   underlying layout, in order to possibly change the layout
@@ -250,13 +250,13 @@ class (Show (m a), Read (m a)) => LayoutModifier m a where
 
 -- | The 'LayoutClass' instance for a 'ModifiedLayout' defines the
 --   semantics of a 'LayoutModifier' applied to an underlying layout.
-instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m l) a where
+instance (LayoutModifier m a, LayoutClass l a, Typeable m) => LayoutClass (ModifiedLayout m l) a where
     runLayout (Workspace i (ModifiedLayout m l) ms) r =
         do ((ws, ml'),mm')  <- modifyLayoutWithUpdate m (Workspace i l ms) r
            (ws', mm'') <- redoLayout (maybe m id mm') r ms ws
            let ml'' = case mm'' `mplus` mm' of
                         Just m' -> Just $ (ModifiedLayout m') $ maybe l id ml'
-                        Nothing -> ModifiedLayout m `fmap` ml'
+                        Nothing -> ModifiedLayout m <$> ml'
            return (ws', ml'')
 
     handleMessage (ModifiedLayout m l) mess =
@@ -266,7 +266,7 @@ instance (LayoutModifier m a, LayoutClass l a) => LayoutClass (ModifiedLayout m
                   _ -> handleMessage l mess
            return $ case mm' of
                     Just (Left m') -> Just $ (ModifiedLayout m') $ maybe l id ml'
-                    _ -> (ModifiedLayout m) `fmap` ml'
+                    _ -> (ModifiedLayout m) <$> ml'
     description (ModifiedLayout m l) = modifyDescription m l
 
 -- | A 'ModifiedLayout' is simply a container for a layout modifier

XMonad/Layout/LimitWindows.hs

@@ -38,7 +38,6 @@ import XMonad.Layout.LayoutModifier
 import XMonad
 import qualified XMonad.StackSet as W
 import Control.Monad((<=<),guard)
-import Control.Applicative((<$>))
 import Data.Maybe(fromJust)
 
 -- $usage

XMonad/Layout/MagicFocus.hs

@@ -105,4 +105,4 @@ followOnlyIf _ _ = return $ All True
 
 -- | Disables focusFollow on the given workspaces:
 disableFollowOnWS :: [WorkspaceId] -> X Bool
-disableFollowOnWS wses = (`notElem` wses) `fmap` gets (W.currentTag . windowset)
+disableFollowOnWS wses = (`notElem` wses) <$> gets (W.currentTag . windowset)

XMonad/Layout/Magnifier.hs

@@ -23,6 +23,7 @@ module XMonad.Layout.Magnifier
       magnifier,
       magnifier',
       magnifierOff,
+      maxMagnifierOff,
       magnifiercz,
       magnifiercz',
       maximizeVertical,
@@ -98,6 +99,10 @@ magnifier' = ModifiedLayout (Mag 1 (1.5,1.5) On NoMaster)
 magnifierOff :: l a -> ModifiedLayout Magnifier l a
 magnifierOff = ModifiedLayout (Mag 1 (1.5,1.5) Off All)
 
+-- | A magnifier that greatly magnifies with defaults to Off
+maxMagnifierOff :: l a -> ModifiedLayout Magnifier l a
+maxMagnifierOff = ModifiedLayout (Mag 1 (1000,1000) Off All)
+
 -- | Increase the size of the window that has focus by a custom zoom,
 -- unless if it is one of the the master windows.
 magnifiercz' :: Rational -> l a -> ModifiedLayout Magnifier l a

XMonad/Layout/Master.hs

@@ -90,7 +90,7 @@ data FixMaster a = FixMaster (AddMaster a) deriving (Show, Read)
 instance LayoutModifier FixMaster Window where
     modifyLayout (FixMaster (AddMaster k d f)) = applyMaster True k d f
     modifierDescription (FixMaster a) = "Fix" ++ modifierDescription a
-    pureMess (FixMaster a) m = liftM FixMaster (pureMess a m)
+    pureMess (FixMaster a) m = fmap FixMaster (pureMess a m)
 
 fixMastered :: (LayoutClass l a) =>
        Rational -- ^ @delta@, the ratio of the screen to resize by
@@ -113,7 +113,7 @@ applyMaster f k _ frac wksp rect = do
     let st= S.stack wksp
     let ws = S.integrate' $ st
     let n = length ws + fromEnum f
-    if n > 1 then do
+    if n > 1 then
         if(n<=k) then
              return ((divideCol rect ws), Nothing)
              else do

XMonad/Layout/MessageControl.hs

@@ -32,7 +32,6 @@ import XMonad.StackSet (Workspace(..))
 import XMonad.Layout.LayoutModifier (LayoutModifier(..), ModifiedLayout(..))
 
 import Data.Typeable (Typeable)
-import Control.Applicative ((<$>))
 import Control.Arrow (second)
 
 -- $usage

XMonad/Layout/Minimize.hs

@@ -17,6 +17,7 @@
 module XMonad.Layout.Minimize (
         -- * Usage
         -- $usage
+        Minimize,
         minimize,
     ) where
 

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
@@ -117,7 +118,7 @@ instance LayoutClass Mosaic a where
         nextIx (ov,ix,mix)
                 | mix <= 0 || ov = fromIntegral $ nls `div` 2
                 | otherwise = max 0 $ (*fi (pred nls)) $ min 1 $ ix / fi mix
-        rect = rects !! maybe (nls `div` 2) round (nextIx `fmap` state)
+        rect = rects !! maybe (nls `div` 2) round (nextIx <$> state)
         state' = fmap (\x@(ov,_,_) -> (ov,nextIx x,pred nls)) state
                     `mplus` Just (True,fromIntegral nls / 2,pred nls)
         ss' = maybe ss (const ss `either` const ssExt) $ zipRemain ss ssExt
@@ -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/MouseResizableTile.hs

@@ -36,7 +36,7 @@ module XMonad.Layout.MouseResizableTile (
 import XMonad hiding (tile, splitVertically, splitHorizontallyBy)
 import qualified XMonad.StackSet as W
 import XMonad.Util.XUtils
-import Control.Applicative((<$>))
+import Graphics.X11 as X
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -190,9 +190,18 @@ draggerGeometry :: DraggerType -> X DraggerGeometry
 draggerGeometry (FixedDragger g d) =
     return (fromIntegral $ g `div` 2, g, fromIntegral $ d `div` 2, d)
 draggerGeometry BordersDragger = do
-    w <- asks (borderWidth . config)
+    wins <- gets windowset
+    w <- case W.peek wins of
+          Just win -> getBorderWidth win
+          _        -> asks (borderWidth . config)
     return (0, 0, fromIntegral w, 2*w)
 
+getBorderWidth :: Window -> X Dimension
+getBorderWidth win = do
+    d <- asks display
+    (_,_,_,_,_,w,_) <- io $ X.getGeometry d win
+    return w
+
 adjustForMirror :: Bool -> DraggerWithRect -> DraggerWithRect
 adjustForMirror False dragger = dragger
 adjustForMirror True (draggerRect, draggerCursor, draggerInfo) =

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