Add a stack.yaml file for testing and easy Hackage upload

Better completion when using `alwaysHighlight'

.github/ISSUE_TEMPLATE.md

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

.github/PULL_REQUEST_TEMPLATE.md

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

.gitignore

@@ -0,0 +1,26 @@
+.cabal-sandbox/
+cabal.sandbox.config
+.hpc/
+*.hi
+*.o
+*.p_hi
+*.prof
+*.tix
+cabal.config
+dist
+dist-*
+
+# editor temp files
+
+*#
+.#*
+*~
+.*.swp
+
+# TAGS files
+TAGS
+tags
+
+# stack artifacts
+/.stack-work/
+/cabal.project.local

.mailmap

@@ -0,0 +1,102 @@
+Alejandro Serrano Mena <trupill@gmail.com>
+Alexandre Buisse <buisse@cs.chalmers.se>
+Anders Engstrom <ankaan@gmail.com>
+Antoine R. Dumont <eniotna.t@gmail.com>
+Anton Pirogov <anton.pirogov@gmail.com>
+Anton Pirogov <anton.pirogov@gmail.com> anton.pirogov at gmail . com <unknown>
+Arjun Comar <nrujac@gmail.com>
+Audun Skaugen <audun@skaugen.name> <audunskaugen@gmail.com>
+Bas van Dijk <v.dijk.bas@gmail.com>
+Ben Boeckel <mathstuf@gmail.com>
+Ben Weitzman <benweitzman@gmail.com>
+Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
+Brandon S Allbery KF8NH <allbery.b@gmail.com>
+Brandon S Allbery KF8NH <allbery.b@gmail.com> <allbery@ece.cmu.edu>
+Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
+Carlos Lopez-Camey <c.lopez@kmels.net>
+Carsten Otto <xmonad@c-otto.de>
+Christian Dietrich <stettberger@dokucode.de>
+Christian Wills <cwills.dev@gmail.com>
+Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
+Daniel Schoepe <daniel.schoepe@googlemail.com> <asgaroth_@gmx.de>
+Daniel Schoepe <daniel.schoepe@googlemail.com> <daniel.schoepe@gmail.com>
+Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
+Dave Harrison <dave@nullcube.com>
+David Glasser <glasser@mit.edu>
+David McLean <gopsychonauts@gmail.com>
+Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
+Dominik Bruhn <dominik@dbruhn.de>
+Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
+Don Stewart <dons00@gmail.com> <dons@galois.com>
+Edward Z. Yang <ezyang@cs.stanford.edu>
+Gwern Branwen <gwern@gwern.net>
+Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
+Henrique Abreu <hgabreu@gmail.com>
+Ilya Portnov <portnov84@rambler.ru>
+intrigeri <intrigeri@boum.org>
+Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
+Jan-David Quesel <quesel@informatik.uni-oldenburg.de>
+Jens Petersen <juhp@community.haskell.org> <petersen@haskell.org>
+Jeremy Apthorp <nornagon@gmail.com>
+Joachim Breitner <mail@joachim-breitner.de>
+Joachim Fasting <joachim.fasting@gmail.com>
+Joel Suovaniemi <joel.suovaniemi@iki.fi>
+Joe Thornber <joe.thornber@gmail.com>
+Johann Giwer <johanngiwer@web.de>
+Jussi Maki <joamaki@gmail.com>
+Konstantin Sobolev <konstantin.sobolev@gmail.com>
+Lanny Ripple <lan3ny@gmail.com>
+Lei Chen <linxray@gmail.com>
+Leonardo Serra <leoserra@minaslivre.org>
+Luis Cabellos <zhen.sydow@gmail.com>
+Lukas Mai <l.mai@web.de>
+Mario Pastorelli <pastorelli.mario@gmail.com>
+Mathias Stearn <redbeard0531@gmail.com>
+Matt Brown <deadguysfrom@gmail.com>
+Matthew Hague <matthewhague@zoho.com>
+Nathaniel Filardo <nwfilardo@gmail.com>
+Nelson Elhage <nelhage@mit.edu>
+Nicolas Dudebout <nicolas.dudebout@gatech.edu>
+Nicolas Pouillard <nicolas.pouillard@gmail.com>
+Nils Schweinsberg <mail@n-sch.de>
+Norbert Zeh <nzeh@cs.dal.ca>
+Peter Olson <polson2@hawk.iit.edu>
+Quentin Moser <moserq@gmail.com>
+Quentin Moser <quentin.moser@unifr.ch>
+Rickard Gustafsson <acura@allyourbase.se>
+Robert Marlow <bobstopper@bobturf.org>
+Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
+Rohan Jain <crodjer@gmail.com>
+Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
+Sean Escriva <sean.escriva@gmail.com>
+Sean McEligot <seanmce33@gmail.com>
+Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
+Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
+Tom Rauchenwald <its.sec@gmx.net>
+Tony Morris <haskell@tmorris.net>
+Valery V. Vorotyntsev <valery.vv@gmail.com>
+Will Farrington <wcfarrington@gmail.com>
+Wirt Wolff <wirtwolff@gmail.com>
+Yaakov Nemoy <loupgaroublond@gmail.com>
+
+brian <brian@lorf.org>
+cardboard42 <cardboard42@gmail.com>
+daedalusinfinity <daedalusinfinity@gmail.com>
+hexago.nl <xmonad-contrib@hexago.nl>
+intrigeri <intrigeri@boum.org>
+jakob <jakob@pipefour.org>
+kedals0 <kedals0@gmail.com>
+lithis <xmonad@selg.hethrael.org>
+lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
+longpoke <longpoke@gmail.com>
+md143rbh7f <md143rbh7f@gmail.com>
+perlkat <perlkat@katspace.org>
+rupa <rupa@lrrr.us> <rupa@lrrr.us>
+timthelion <tim.thelion@gmail.com>
+
+# for core only
+Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>, Neil Mitchell
+Nick Burlett <nickburlett@mac.com>
+Sam Hughes   <hughes@rpi.edu>
+Shae Erisson <shae@ScannedInAvian.com>
+Conrad Irwin <conrad.irwin@gmail.com>

.travis.yml

@@ -0,0 +1,91 @@
+# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
+language: c
+sudo: false
+
+cache:
+  directories:
+    - $HOME/.cabsnap
+    - $HOME/.cabal/packages
+
+before_cache:
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
+  - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
+
+matrix:
+  include:
+    - env: CABALVER=1.16 GHCVER=7.6.3
+      compiler: ": #GHC 7.6.3"
+      addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
+    - env: CABALVER=1.18 GHCVER=7.8.4
+      compiler: ": #GHC 7.8.4"
+      addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
+    - env: CABALVER=1.22 GHCVER=7.10.3
+      compiler: ": #GHC 7.10.3"
+      addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3], sources: [hvr-ghc]}}
+    - env: CABALVER=1.24 GHCVER=8.0.1
+      compiler: ": #GHC 8.0.1"
+      addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.1], sources: [hvr-ghc]}}
+
+before_install:
+ - unset CC
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ # build xmonad from HEAD
+ - git clone https://github.com/xmonad/xmonad.git
+
+ - cabal --version
+ - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
+ - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
+   then
+     zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
+          $HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
+   fi
+ - travis_retry cabal update -v
+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
+
+# check whether current requested install-plan matches cached package-db snapshot
+ - if diff -u $HOME/.cabsnap/installplan.txt installplan.txt;
+   then
+     echo "cabal build-cache HIT";
+     rm -rfv .ghc;
+     cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
+     cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
+   else
+     echo "cabal build-cache MISS";
+     rm -rf $HOME/.cabsnap;
+     mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
+     cabal install --only-dependencies --enable-tests --enable-benchmarks;
+   fi
+
+# snapshot package-db on cache miss
+ - if [ ! -d $HOME/.cabsnap ];
+   then
+      echo "snapshotting package-db to build-cache";
+      mkdir $HOME/.cabsnap;
+      cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
+      cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
+   fi
+
+ - cabal install xmonad/
+
+# Here starts the actual work to be performed for the package under test;
+# any command which exits with a non-zero exit code causes the build to fail.
+script:
+ - if [ -f configure.ac ]; then autoreconf -i; fi
+ - cabal configure --enable-tests --enable-benchmarks -v2  # -v2 provides useful information for debugging
+ - cabal build   # this builds all libraries and executables (including tests/benchmarks)
+ - cabal test
+# - cabal check   # complains about -Werror even though it is
+                  # hidden behind a manual flag with default false
+ - cabal sdist   # tests that a source-distribution can be generated
+
+# Check that the resulting source distribution can be built & installed.
+# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
+# `cabal install --force-reinstalls dist/*-*.tar.gz`
+ - SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
+   (cd dist && cabal install --force-reinstalls "$SRC_TGZ")
+
+# EOF

CHANGES.md

@@ -0,0 +1,299 @@
+# Change Log / Release Notes
+
+## 0.13 (February 10, 2017)
+
+### Breaking Changes
+
+  * The type of `completionKey` (of `XPConfig` record) has been
+    changed from `KeySym` to `(KeyMask, KeySym)`. The default value
+    for this is still bound to the `Tab` key.
+
+  * New constructor `CenteredAt Rational Rational` added for
+    `XMonad.Prompt.XPPosition`.
+
+  * `XMonad.Prompt` now stores its history file in the XMonad cache
+    directory in a file named `prompt-history`.
+
+### New Modules
+
+  * `XMonad.Layout.SortedLayout`
+
+    A new LayoutModifier that sorts a given layout by a list of
+    properties. The order of properties in the list determines
+    the order of windows in the final layout. Any unmatched windows
+    go to the end of the order.
+
+  * `XMonad.Prompt.Unicode`
+
+    A prompt to search a unicode character by its name, and put it into the
+    clipboard.
+
+  * `XMonad.Util.Ungrab`
+
+    Release xmonad's keyboard and pointer grabs immediately, so
+    screen grabbers and lock utilities, etc. will work. Replaces
+    the short sleep hackaround.
+
+  * `XMonad.Util.Loggers.NamedScratchpad`
+
+    A collection of Loggers (see `XMonad.Util.Loggers`) for NamedScratchpads
+    (see `XMonad.Util.NamedScratchpad`).
+
+  * `XMonad.Util.NoTaskbar`
+
+    Utility function and `ManageHook` to mark a window to be ignored by
+    EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
+    you will usually be taken to the `NSP` workspace by them.
+
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Hooks.ManageDocks`,
+
+    - Fix a very annoying bug where taskbars/docs would be
+      covered by windows.
+
+    - Also fix a bug that caused certain Gtk and Qt application to
+      have issues displaying menus and popups.
+
+  * `XMonad.Layout.LayoutBuilder`
+
+    Merge all functionality from `XMonad.Layout.LayoutBuilderP` into
+    `XMonad.Layout.LayoutBuilder`.
+
+  * `XMonad.Actions.WindowGo`
+
+    - Fix `raiseNextMaybe` cycling between 2 workspaces only.
+
+  * `XMonad.Actions.UpdatePointer`
+
+    - Fix bug when cursor gets stuck in one of the corners.
+
+  * `XMonad.Actions.Submap`
+
+    Establish pointer grab to avoid freezing X, when button press occurs after
+    submap key press.  And terminate submap at button press in the same way,
+    as we do for wrong key press.
+
+  * `XMonad.Actions.DynamicProjects`
+
+    - Switching away from a dynamic project that contains no windows
+      automatically deletes that project's workspace.
+
+      The project itself was already being deleted, this just deletes
+      the workspace created for it as well.
+
+    - Added function to change the working directory (`changeProjectDirPrompt`)
+
+    - All of the prompts are now multiple mode prompts.  Try using the
+      `changeModeKey` in a prompt and see what happens!
+
+## 0.12 (December 14, 2015)
+
+### Breaking Changes
+
+  * `XMonad.Actions.UpdatePointer.updatePointer` arguments were
+    changed. This allows including aspects of both of the
+    `TowardsCentre` and `Relative` methods. To keep the same behavior,
+    replace the entry in the left column with the entry on the right:
+
+    | < 0.12                              |   >= 0.12                        |
+    |-------------------------------------|----------------------------------|
+    | `updatePointer Nearest`             | `updatePointer (0.5, 0.5) (1,1)` |
+    | `updatePointer (Relative x y)`      | `updatePointer (x,y) (0,0)`      |
+    | `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)`  |
+
+### New Modules
+
+  * `XMonad.Actions.AfterDrag`
+
+    Perform an action after the current mouse drag is completed.
+
+  * `XMonad.Actions.DynamicProjects`
+
+    Imbues workspaces with additional features so they can be treated
+    as individual project areas.
+
+  * `XMonad.Actions.LinkWorkspaces`
+
+    Provides bindings to add and delete links between workspaces. It
+    is aimed at providing useful links between workspaces in a
+    multihead setup. Linked workspaces are viewed at the same time.
+
+  * `XMonad.Config.Bepo`
+
+    This module fixes some of the keybindings for the francophone
+    among you who use a BEPO keyboard layout. Based on
+    `XMonad.Config.Azerty`
+
+  * `XMonad.Config.Dmwit`
+
+    Daniel Wagner's configuration.
+
+  * `XMonad.Config.Mate`
+
+    This module provides a config suitable for use with the MATE
+    desktop environment.
+
+  * `XMonad.Config.Prime`
+
+    A draft of a brand new config syntax for xmonad.
+
+  * `XMonad.Hooks.DynamicProperty`
+
+    Module to apply a `ManageHook` to an already-mapped window when a
+    property changes. This would commonly be used to match browser
+    windows by title, since the final title will only be set after (a)
+    the window is mapped, (b) its document has been loaded, (c) all
+    load-time scripts have run.
+
+  * `XMonad.Hooks.ManageDebug`
+
+    A `manageHook` and associated `logHook` for debugging `ManageHook`s.
+    Simplest usage: wrap your xmonad config in the `debugManageHook`
+    combinator.  Or use `debugManageHookOn` for a triggerable version,
+    specifying the triggering key sequence in `XMonad.Util.EZConfig`
+    syntax. Or use the individual hooks in whatever way you see fit.
+
+  * `XMonad.Hooks.WallpaperSetter`
+
+    Log hook which changes the wallpapers depending on visible
+    workspaces.
+
+  * `XMonad.Hooks.WorkspaceHistory`
+
+    Keeps track of workspace viewing order.
+
+  * `XMonad.Layout.AvoidFloats`
+
+    Find a maximum empty rectangle around floating windows and use
+    that area to display non-floating windows.
+
+  * `XMonad.Layout.BinarySpacePartition`
+
+    Layout where new windows will split the focused window in half,
+    based off of BSPWM.
+
+  * `XMonad.Layout.Dwindle`
+
+    Three layouts: The first, `Spiral`, is a reimplementation of
+    `XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive
+    semantics.  The second, `Dwindle`, is inspired by a similar layout
+    in awesome and produces the same sequence of decreasing window
+    sizes as Spiral but pushes the smallest windows into a screen
+    corner rather than the centre.  The third, `Squeeze` arranges all
+    windows in one row or in one column, with geometrically decreasing
+    sizes.
+
+  * `XMonad.Layout.Hidden`
+
+    Similar to `XMonad.Layout.Minimize` but completely removes windows
+    from the window set so `XMonad.Layout.BoringWindows` isn't
+    necessary.  Perfect companion to `XMonad.Layout.BinarySpacePartition`
+    since it can be used to move windows to another part of the BSP tree.
+
+  * `XMonad.Layout.IfMax`
+
+    Provides `IfMax` layout, which will run one layout if there are
+    maximum `N` windows on workspace, and another layout, when number
+    of windows is greater than `N`.
+
+  * `XMonad.Layout.PerScreen`
+
+    Configure layouts based on the width of your screen; use your
+    favorite multi-column layout for wide screens and a full-screen
+    layout for small ones.
+
+  * `XMonad.Layout.Stoppable`
+
+    This module implements a special kind of layout modifier, which when
+    applied to a layout, causes xmonad to stop all non-visible processes.
+    In a way, this is a sledge-hammer for applications that drain power.
+    For example, given a web browser on a stoppable workspace, once the
+    workspace is hidden the web browser will be stopped.
+
+  * `XMonad.Prompt.ConfirmPrompt`
+
+    A module for setting up simple confirmation prompts for
+    keybindings.
+
+  * `XMonad.Prompt.Pass`
+
+    This module provides 3 `XMonad.Prompt`s to ease passwords
+    manipulation (generate, read, remove) via [pass][].
+
+  * `XMonad.Util.RemoteWindows`
+
+    This module implements a proper way of finding out whether the
+    window is remote or local.
+
+  * `XMonad.Util.SpawnNamedPipe`
+
+    A module for spawning a pipe whose `Handle` lives in the xmonad state.
+
+  * `XMonad.Util.WindowState`
+
+    Functions for saving per-window data.
+
+### Miscellaneous Changes
+
+  * Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored,
+    defaults to `isPrefixOf`
+
+  * Fix moveHistory when alwaysHighlight is enabled
+
+  * `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup`
+
+  * Side tabs were added to the tabbed layout
+
+  * `XMonad/Layout/IndependentScreens` now exports `marshallSort`
+
+  * `XMonad/Hooks/UrgencyHook` now exports `clearUrgency`
+
+  * Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell`
+
+  * Switched to `Data.Default` wherever possible
+
+  * `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn`
+
+  * `XMonad.Util.NamedActions` now exports `addDescrKeys'`
+
+  * EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook`
+
+  * New `useTransientFor` modifier in `XMonad.Layout.TrackFloating`
+
+  * Added the ability to remove arbitrary workspaces
+
+## 0.9 (October 26, 2009)
+
+### Updates that Require Changes in `xmonad.hs`
+
+  * `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the
+    `ewmhDesktopsLayout` modifier has been removed from
+    xmonad-contrib. It uses `logHook`, `handleEventHook`, and
+    `startupHook` instead and provides a convenient function `ewmh` to
+    add EWMH support to a `defaultConfig`.
+
+  * Most `DynamicLog` users can continue with configs unchanged, but
+    users of the quickbar functions `xmobar` or `dzen` will need to
+    change `xmonad.hs`: their types have changed to allow easier
+    composition with other `XConfig` modifiers. The `dynamicLogDzen`
+    and `dynamicLogXmobar` functions have been removed.
+
+  * `WindowGo` or `safeSpawn` users may need to change command lines
+    due to `safeSpawn` changes.
+
+  * People explicitly referencing the "SP" scratchpad workspace should
+    change it to "NSP" which is also used by the new
+    `Util.NamedScratchpad` module.
+
+  * (Optional) People who explicitly use `swapMaster` in key or mouse
+    bindings should change it to `shiftMaster`. It's the current
+    default used where `swapMaster` had been used previously. It works
+    better than `swapMaster` when using floating and tiled windows
+    together on the same workspace.
+
+## See Also
+
+<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
+
+[pass]: http://www.passwordstore.org/

README

@@ -1,82 +0,0 @@
-  xmonad-contrib : third party extensions to the xmonad window manager
-
-                           http://xmonad.org
-
-    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, the documents included with the xmonad source
-    distribution, and online haddock documentation:
-
-    http://www.xmonad.org/xmonad-docs
-
-------------------------------------------------------------------------
-
-Changelogs
-
-    For a list of changes since the 0.8.x releases, see:
-
-http://www.haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8
-
-------------------------------------------------------------------------
-
-Updates to XMonadContrib-0.9 that may Require Changes to ~/.xmonad/xmonad.hs
-
-    Please see the Changelogs and xmonad-contrib haddock documentation
-    links for further details regarding the following changes.
-
-    * XMonad.Hooks.EwmhDesktops no longer uses layoutHook, the
-    ewmhDesktopsLayout modifier has been removed from xmonad-contrib. It
-    uses logHook, handleEventHook, and startupHook instead and provides
-    a convenient function 'ewmh' to add EWMH support to a defaultConfig.
-
-    * Most DynamicLog users can continue with configs unchanged, but users
-    of the quickbar functions 'xmobar' or 'dzen' will need to change
-    xmonad.hs: their types have changed to allow easier composition with
-    other XConfig modifiers. The 'dynamicLogDzen' and 'dynamicLogXmobar'
-    functions have been removed.
-
-    * WindowGo or safeSpawn users may need to change command lines due to
-    safeSpawn changes.
-
-    * People explicitly referencing the "SP" scratchpad workspace should
-    change it to "NSP" which is also used by the new Util.NamedScratchpad.
-
-    * (Optional) People who explicitly use swapMaster in key or mouse
-    bindings should change it to shiftMaster. It's the current default
-    used where swapMaster had been used previously. It works better than
-    swapMaster when using floating and tiled windows together on the
-    same workspace.
-
-------------------------------------------------------------------------
-
-Getting or updating XMonadContrib
-
-    latest release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib
-
-    darcs version:  darcs get http://code.haskell.org/XMonadContrib
-
-    (To use darcs xmonad-contrib you must also use the darcs version
-    of xmonad.)
-
-------------------------------------------------------------------------
-
-Contributing
-
-    Haskell code contributed to this repo should live under the
-    appropriate subdivision of the 'XMonad.' namespace (currently
-    includes Actions, Config, Hooks, Layout, Prompt, and Util). For
-    example, to use the Grid layout, one would import:
-
-        XMonad.Layout.Grid
-
-    For further details, see the documentation for the
-    XMonad.Doc.Developing module and http://xmonad.org website.
-
-------------------------------------------------------------------------
-
-Code submitted to the contrib repo is licensed under the same license as
-xmonad itself, with copyright held by the authors.
-
-------------------------------------------------------------------------

README.md

@@ -0,0 +1,42 @@
+# 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)
+
+You need the ghc compiler and xmonad window manager installed in
+order to use these extensions.
+
+For installation and configuration instructions, please see the
+[xmonad website] [xmonad], the documents included with the
+[xmonad source distribution] [xmonad-git], and the
+[online haddock documentation] [xmonad-docs].
+
+## Getting or Updating XMonadContrib
+
+  * Latest release: <https://hackage.haskell.org/package/xmonad-contrib>
+
+  * Git version: <https://github.com/xmonad/xmonad-contrib>
+
+(To use git xmonad-contrib you must also use the
+[git version of xmonad] [xmonad-git].)
+
+## Contributing
+
+Haskell code contributed to this repo should live under the
+appropriate subdivision of the `XMonad` namespace (currently includes
+`Actions`, `Config`, `Hooks`, `Layout`, `Prompt`, and `Util`). For
+example, to use the Grid layout, one would import:
+
+    XMonad.Layout.Grid
+
+For further details, see the [documentation] [developing] for the
+`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
+
+## License
+
+Code submitted to the contrib repo is licensed under the same license as
+xmonad itself, with copyright held by the authors.
+
+[xmonad]: http://xmonad.org
+[xmonad-git]: https://github.com/xmonad/xmonad
+[xmonad-docs]: http://www.xmonad.org/xmonad-docs
+[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html

XMonad/Actions/AfterDrag.hs

@@ -0,0 +1,71 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.AfterDrag
+-- Copyright   :  (c) 2014 Anders Engstrom <ankaan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Perform an action after the current mouse drag is completed.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.AfterDrag (
+                -- * Usage
+                -- $usage
+                afterDrag,
+                ifClick,
+                ifClick') where
+
+import XMonad
+import System.Time
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.AfterDrag
+--
+-- Then add appropriate mouse bindings, for example:
+--
+-- >        , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1)))
+--
+-- This will allow you to resize windows as usual, but if you instead of
+-- draging click the mouse button the window will be automatically resized to
+-- fill the whole screen.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+--
+-- More practical examples are available in "XMonad.Actions.FloatSnap".
+
+-- | Schedule a task to take place after the current dragging is completed.
+afterDrag
+    :: X () -- ^ The task to schedule.
+    -> X ()
+afterDrag task = do drag <- gets dragging
+                    case drag of
+                        Nothing -> return () -- Not dragging
+                        Just (motion, cleanup) -> modify $ \s -> s { dragging = Just(motion, cleanup >> task) }
+
+-- | Take an action if the current dragging can be considered a click,
+--   supposing the drag just started before this function is called.
+--   A drag is considered a click if it is completed within 300 ms.
+ifClick
+  :: X ()   -- ^ The action to take if the dragging turned out to be a click.
+  -> X () 
+ifClick action = ifClick' 300 action (return ())
+
+-- | Take an action if the current dragging is completed within a certain time (in milliseconds.)
+ifClick'
+  :: Int    -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)
+  -> X ()   -- ^ The action to take if the dragging turned out to be a click.
+  -> X ()   -- ^ The action to take if the dragging turned out to not be a click.
+  -> X () 
+ifClick' ms click drag = do
+  start <- io $ getClockTime
+  afterDrag $ do 
+    stop <- io $ getClockTime
+    if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }
+      then click
+      else drag

XMonad/Actions/BluetileCommands.hs

@@ -36,7 +36,7 @@ import System.Exit
 --
 -- Then edit your @handleEventHook@:
 --
--- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands }
+-- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands }
 --
 -- See the documentation of "XMonad.Hooks.ServerMode" for details on
 -- how to actually invoke the commands from external programs.

XMonad/Actions/CopyWindow.hs

@@ -26,7 +26,6 @@ module XMonad.Actions.CopyWindow (
 
 import XMonad
 import Control.Arrow ((&&&))
-import Control.Monad
 import qualified Data.List as L
 
 import XMonad.Actions.WindowGo
@@ -88,7 +87,7 @@ import qualified XMonad.StackSet as W
 -- >
 -- > main = do
 -- >    h <- spawnPipe "xmobar"
--- >    xmonad defaultConfig { logHook = sampleLogHook h }
+-- >    xmonad def { logHook = sampleLogHook h }
 
 -- | Copy the focused window to a workspace.
 copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
@@ -146,7 +145,9 @@ killAllOtherCopies = do ss <- gets windowset
       delFromAllButCurrent w ss = foldr ($) ss $
                                   map (delWinFromWorkspace w . W.tag) $
                                   W.hidden ss ++ map W.workspace (W.visible ss)
-      delWinFromWorkspace w wid = W.modify Nothing (W.filter (/= w)) . W.view wid
+      delWinFromWorkspace w wid = viewing wid $ W.modify Nothing (W.filter (/= w))
+
+      viewing wis f ss = W.view (W.currentTag ss) $ f $ W.view wis ss
 
 -- | A list of hidden workspaces containing a copy of the focused window.
 wsContainingCopies :: X [WorkspaceId]

XMonad/Actions/CycleWS.hs

@@ -46,6 +46,7 @@ module XMonad.Actions.CycleWS (
                                 -- * Toggling the previous workspace
                                 -- $toggling
                               , toggleWS
+                              , toggleWS'
                               , toggleOrView
 
                                 -- * Moving between screens (xinerama)
@@ -65,6 +66,7 @@ module XMonad.Actions.CycleWS (
 
                               , shiftTo
                               , moveTo
+                              , doTo
 
                                 -- * The mother-combinator
 
@@ -72,13 +74,15 @@ module XMonad.Actions.CycleWS (
                               , toggleOrDoSkip
                               , skipTags
 
+                              , screenBy
+
                              ) where
 
-import Control.Monad ( unless )
-import Data.List ( findIndex )
+import Data.List ( find, findIndex )
 import Data.Maybe ( isNothing, isJust )
 
 import XMonad hiding (workspaces)
+import qualified XMonad.Hooks.WorkspaceHistory as WH
 import XMonad.StackSet hiding (filter)
 import XMonad.Util.Types
 import XMonad.Util.WorkspaceCompare
@@ -115,6 +119,10 @@ import XMonad.Util.WorkspaceCompare
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- When using the toggle functions, in order to ensure that the workspace
+-- to which you switch is the previously viewed workspace, use the
+-- 'logHook' in "XMonad.Hooks.WorkspaceHistory".
 
 {- $moving
 
@@ -147,9 +155,14 @@ shiftToPrev = shiftBy (-1)
 
 -- | Toggle to the workspace displayed previously.
 toggleWS :: X ()
-toggleWS = do
-    hs <- gets (hidden . windowset)
-    unless (null hs) (windows . view . tag $ head hs)
+toggleWS = toggleWS' []
+
+-- | Toggle to the previous workspace while excluding some workspaces.
+--
+-- > -- Ignore the scratchpad workspace while toggling:
+-- > ("M-b", toggleWS' ["NSP"])
+toggleWS' :: [WorkspaceId] -> X ()
+toggleWS' skips = lastViewedHiddenExcept skips >>= flip whenJust (windows . view)
 
 -- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view
 -- the previously displayed workspace ala weechat. Change @greedyView@ to
@@ -159,9 +172,8 @@ toggleWS = do
 toggleOrView :: WorkspaceId -> X ()
 toggleOrView = toggleOrDoSkip [] greedyView
 
--- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\") while
--- finding the previously displayed workspace, or choice of different actions,
--- like view, shift, etc.  For example:
+-- | Allows ignoring listed workspace tags (such as scratchpad's \"NSP\"), and
+-- running other actions such as view, shift, etc.  For example:
 --
 -- > import qualified XMonad.StackSet as W
 -- > import XMonad.Actions.CycleWS
@@ -174,10 +186,9 @@ toggleOrView = toggleOrDoSkip [] greedyView
 toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
                                   -> WorkspaceId -> X ()
 toggleOrDoSkip skips f toWS = do
-    ws <- gets windowset
-    let hs' = hidden ws `skipTags` skips
-    if toWS == (tag . workspace $ current ws)
-        then unless (null hs') (windows . f . tag $ head hs')
+    cur <- gets (currentTag . windowset)
+    if toWS == cur
+        then lastViewedHiddenExcept skips >>= flip whenJust (windows . f)
         else windows (f toWS)
 
 -- | List difference ('\\') for workspaces and tags. Removes workspaces
@@ -185,6 +196,17 @@ toggleOrDoSkip skips f toWS = do
 skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a]
 skipTags wss ids = filter ((`notElem` ids) . tag) wss
 
+-- | Ignoring the skips, find the best candidate for the last viewed hidden
+-- workspace.
+lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
+lastViewedHiddenExcept skips = do
+    hs <- gets $ map tag . flip skipTags skips . hidden . windowset
+    vs <- WH.workspaceHistory
+    return $ choose hs (find (`elem` hs) vs)
+    where choose []    _           = Nothing
+          choose (h:_) Nothing     = Just h
+          choose _     vh@(Just _) = vh
+
 switchWorkspace :: Int -> X ()
 switchWorkspace d = wsBy d >>= windows . greedyView
 
@@ -217,6 +239,7 @@ data WSType = EmptyWS     -- ^ cycle through empty workspaces
             | NonEmptyWS  -- ^ cycle through non-empty workspaces
             | HiddenWS    -- ^ cycle through non-visible workspaces
             | HiddenNonEmptyWS  -- ^ cycle through non-empty non-visible workspaces
+            | HiddenEmptyWS  -- ^ cycle through empty non-visible workspaces
             | AnyWS       -- ^ cycle through all workspaces
             | WSTagGroup Char
                           -- ^ cycle through workspaces in the same group, the
@@ -235,6 +258,9 @@ wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)
 wsTypeToPred HiddenNonEmptyWS  = do ne <- wsTypeToPred NonEmptyWS
                                     hi <- wsTypeToPred HiddenWS
                                     return (\w -> hi w && ne w)
+wsTypeToPred HiddenEmptyWS  = do ne <- wsTypeToPred EmptyWS
+                                 hi <- wsTypeToPred HiddenWS
+                                 return (\w -> hi w && ne w)
 wsTypeToPred AnyWS      = return (const True)
 wsTypeToPred (WSTagGroup sep) = do cur <- (groupName.workspace.current) `fmap` gets windowset
                                    return $ (cur ==).groupName
@@ -244,12 +270,17 @@ wsTypeToPred (WSIs p)   = p
 -- | View the next workspace in the given direction that satisfies
 --   the given condition.
 moveTo :: Direction1D -> WSType -> X ()
-moveTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . greedyView
+moveTo dir t = doTo dir t getSortByIndex (windows . greedyView)
 
 -- | Move the currently focused window to the next workspace in the
 --   given direction that satisfies the given condition.
 shiftTo :: Direction1D -> WSType -> X ()
-shiftTo dir t = findWorkspace getSortByIndex dir t 1 >>= windows . shift
+shiftTo dir t = doTo dir t getSortByIndex (windows . shift)
+
+-- | Using the given sort, find the next workspace in the given
+-- direction of the given type, and perform the given action on it.
+doTo :: Direction1D -> WSType -> X WorkspaceSort -> (WorkspaceId -> X ()) -> X ()
+doTo dir t srt act = findWorkspace srt dir t 1 >>= act
 
 -- | Given a function @s@ to sort workspaces, a direction @dir@, a
 --   predicate @p@ on workspaces, and an integer @n@, find the tag of
@@ -307,6 +338,17 @@ switchScreen d = do s <- screenBy d
                          Nothing -> return ()
                          Just ws -> windows (view ws)
 
+{- | Get the 'ScreenId' /d/ places over. Example usage is a variation of the
+the default screen keybindings:
+
+>     -- mod-{w,e}, Switch to previous/next Xinerama screen
+>     -- mod-shift-{w,e}, Move client to previous/next Xinerama screen
+>     --
+>     [((m .|. modm, key), sc >>= screenWorkspace >>= flip whenJust (windows . f))
+>         | (key, sc) <- zip [xK_w, xK_e] [(screenBy (-1)),(screenBy 1)]
+>         , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
+
+-}
 screenBy :: Int -> X (ScreenId)
 screenBy d = do ws <- gets windowset
                 --let ss = sortBy screen (screens ws)

XMonad/Actions/CycleWindows.hs

@@ -226,8 +226,10 @@ rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwis
            (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
 
 -- $generic
--- Generic list rotations
+-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
+-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
+-- @id@ for null or singleton lists.
 rotUp :: [a] -> [a]
-rotUp   l = tail l ++ [head l]
+rotUp   l = drop 1 l ++ take 1 l
 rotDown :: [a] -> [a]
-rotDown l = last l : init l
+rotDown = reverse . rotUp . reverse

XMonad/Actions/DynamicProjects.hs

@@ -0,0 +1,363 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicProjects
+-- Copyright   :  (c) Peter J. Jones
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Peter Jones <pjones@devalot.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Imbues workspaces with additional features so they can be treated
+-- as individual project areas.
+--------------------------------------------------------------------------------
+module XMonad.Actions.DynamicProjects
+       ( -- * Overview
+         -- $overview
+
+         -- * Usage
+         -- $usage
+
+         -- * Types
+         Project (..)
+       , ProjectName
+
+         -- * Hooks
+       , dynamicProjects
+
+         -- * Bindings
+       , switchProjectPrompt
+       , shiftToProjectPrompt
+       , renameProjectPrompt
+       , changeProjectDirPrompt
+
+         -- * Helper Functions
+       , switchProject
+       , shiftToProject
+       , lookupProject
+       , currentProject
+       , activateProject
+       ) where
+
+--------------------------------------------------------------------------------
+import Control.Applicative ((<|>))
+import Control.Monad (when, unless)
+import Data.Char (isSpace)
+import Data.List (sort, union, stripPrefix)
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import Data.Maybe (fromMaybe, isNothing)
+import Data.Monoid ((<>))
+import System.Directory (setCurrentDirectory, getHomeDirectory)
+import XMonad
+import XMonad.Actions.DynamicWorkspaces
+import XMonad.Prompt
+import XMonad.Prompt.Directory
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+--------------------------------------------------------------------------------
+-- $overview
+-- Inspired by @TopicSpace@, @DynamicWorkspaces@, and @WorkspaceDir@,
+-- @DynamicProjects@ treats workspaces as projects while maintaining
+-- compatibility with all existing workspace-related functionality in
+-- XMonad.
+--
+-- Instead of using generic workspace names such as @3@ or @work@,
+-- @DynamicProjects@ allows you to dedicate workspaces to specific
+-- projects and then switch between projects easily.
+--
+-- A project is made up of a name, working directory, and a start-up
+-- hook.  When you switch to a workspace, @DynamicProjects@ changes
+-- the working directory to the one configured for the matching
+-- project.  If the workspace doesn't have any windows, the project's
+-- start-up hook is executed.  This allows you to launch applications
+-- or further configure the workspace/project.
+--
+-- When using the @switchProjectPrompt@ function, workspaces are
+-- created as needed.  This means you can create new project spaces
+-- (and therefore workspaces) on the fly.  (These dynamic projects are
+-- not preserved across restarts.)
+--
+-- Additionally, frequently used projects can be configured statically
+-- in your XMonad configuration.  Doing so allows you to configure the
+-- per-project start-up hook.
+
+--------------------------------------------------------------------------------
+-- $usage
+-- To use @DynamicProjects@ you need to add it to your XMonad
+-- configuration and then configure some optional key bindings.
+--
+-- > import XMonad.Actions.DynamicProjects
+--
+-- Start by defining some projects:
+--
+-- > projects :: [Project]
+-- > projects =
+-- >   [ Project { projectName      = "scratch"
+-- >             , projectDirectory = "~/"
+-- >             , projectStartHook = Nothing
+-- >             }
+-- >
+-- >   , Project { projectName      = "browser"
+-- >             , projectDirectory = "~/download"
+-- >             , projectStartHook = Just $ do spawn "conkeror"
+-- >                                            spawn "chromium"
+-- >             }
+-- >   ]
+--
+-- Then inject @DynamicProjects@ into your XMonad configuration:
+--
+-- > main = xmonad $ dynamicProjects projects def
+--
+-- And finally, configure some optional key bindings:
+--
+-- >  , ((modm, xK_space), switchProjectPrompt)
+-- >  , ((modm, xK_slash), shiftToProjectPrompt)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+--------------------------------------------------------------------------------
+type ProjectName  = String
+type ProjectTable = Map ProjectName Project
+
+--------------------------------------------------------------------------------
+-- | Details about a workspace that represents a project.
+data Project = Project
+  { projectName      :: !ProjectName    -- ^ Workspace name.
+  , projectDirectory :: !FilePath       -- ^ Working directory.
+  , projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
+  } deriving Typeable
+
+--------------------------------------------------------------------------------
+-- | Internal project state.
+data ProjectState = ProjectState
+  { projects        :: !ProjectTable
+  , previousProject :: !(Maybe WorkspaceId)
+  } deriving Typeable
+
+--------------------------------------------------------------------------------
+instance ExtensionClass ProjectState where
+  initialValue = ProjectState Map.empty Nothing
+
+--------------------------------------------------------------------------------
+-- Internal types for working with XPrompt.
+data ProjectPrompt = ProjectPrompt ProjectMode [ProjectName]
+data ProjectMode = SwitchMode | ShiftMode | RenameMode | DirMode
+
+instance XPrompt ProjectPrompt where
+  showXPrompt (ProjectPrompt submode _) =
+    case submode of
+      SwitchMode -> "Switch or Create Project: "
+      ShiftMode  -> "Send Window to Project: "
+      RenameMode -> "New Project Name: "
+      DirMode    -> "Change Project Directory: "
+
+  completionFunction (ProjectPrompt RenameMode _) = return . (:[])
+  completionFunction (ProjectPrompt DirMode _) =
+    let xpt = directoryMultipleModes "" (const $ return ())
+    in completionFunction xpt
+  completionFunction (ProjectPrompt _ ns) = mkComplFunFromList' ns
+
+  modeAction (ProjectPrompt SwitchMode _) buf auto = do
+    let name = if null auto then buf else auto
+    ps <- XS.gets projects
+
+    case Map.lookup name ps of
+      Just p              -> switchProject p
+      Nothing | null name -> return ()
+              | otherwise -> switchProject (defProject name)
+
+  modeAction (ProjectPrompt ShiftMode _) buf auto = do
+    let name = if null auto then buf else auto
+    ps <- XS.gets projects
+    shiftToProject . fromMaybe (defProject name) $ Map.lookup name ps
+
+  modeAction (ProjectPrompt RenameMode _) name _ =
+    when (not (null name) && not (all isSpace name)) $ do
+      renameWorkspaceByName name
+      modifyProject (\p -> p { projectName = name })
+
+  modeAction (ProjectPrompt DirMode _) buf auto = do
+    let dir = if null auto then buf else auto
+    modifyProject (\p -> p { projectDirectory = dir })
+
+--------------------------------------------------------------------------------
+-- | Add dynamic projects support to the given config.
+dynamicProjects :: [Project] -> XConfig a -> XConfig a
+dynamicProjects ps c =
+  c { startupHook     = dynamicProjectsStartupHook ps <> startupHook c
+    , logHook         = dynamicProjectsLogHook        <> logHook c
+    }
+
+--------------------------------------------------------------------------------
+-- | Log hook for tracking workspace changes.
+dynamicProjectsLogHook :: X ()
+dynamicProjectsLogHook = do
+  name   <- gets (W.tag . W.workspace . W.current . windowset)
+  xstate <- XS.get
+
+  unless (Just name == previousProject xstate) $ do
+    XS.put (xstate {previousProject = Just name})
+    activateProject . fromMaybe (defProject name) $
+      Map.lookup name (projects xstate)
+
+--------------------------------------------------------------------------------
+-- | Start-up hook for recording configured projects.
+dynamicProjectsStartupHook :: [Project] -> X ()
+dynamicProjectsStartupHook ps = XS.modify go
+  where
+    go :: ProjectState -> ProjectState
+    go s = s {projects = update $ projects s}
+
+    update :: ProjectTable -> ProjectTable
+    update = Map.union (Map.fromList $ map entry ps)
+
+    entry :: Project -> (ProjectName, Project)
+    entry p = (projectName p, addDefaultHook p)
+
+    -- Force the hook to be a @Just@ so that it doesn't automatically
+    -- get deleted when switching away from a workspace with no
+    -- windows.
+    addDefaultHook :: Project -> Project
+    addDefaultHook p = p { projectStartHook = projectStartHook p <|>
+                                              Just (return ())
+                         }
+
+--------------------------------------------------------------------------------
+-- | Find a project based on its name.
+lookupProject :: ProjectName -> X (Maybe Project)
+lookupProject name = Map.lookup name `fmap` XS.gets projects
+
+--------------------------------------------------------------------------------
+-- | Fetch the current project (the one being used for the currently
+-- active workspace).
+currentProject :: X Project
+currentProject = do
+  name <- gets (W.tag . W.workspace . W.current . windowset)
+  proj <- lookupProject name
+  return $ fromMaybe (defProject name) proj
+
+--------------------------------------------------------------------------------
+-- | Modify the current project using a pure function.
+modifyProject :: (Project -> Project) -> X ()
+modifyProject f = do
+  p  <- currentProject
+  ps <- XS.gets projects
+
+  -- If a project is renamed to match another project, the old project
+  -- will be removed and replaced with this one.
+  let new = f p
+      ps' = Map.insert (projectName new) new $ Map.delete (projectName p) ps
+
+  XS.modify $ \s -> s {projects = ps'}
+  activateProject new
+
+--------------------------------------------------------------------------------
+-- | Switch to the given project.
+switchProject :: Project -> X ()
+switchProject p = do
+  oldws <- gets (W.workspace . W.current . windowset)
+  oldp <- currentProject
+
+  let name = W.tag oldws
+      ws   = W.integrate' (W.stack oldws)
+
+  -- If the project we are switching away from has no windows, and
+  -- it's a dynamic project, remove it from the configuration.
+  when (null ws && isNothing (projectStartHook oldp)) $ do
+    removeWorkspaceByTag name -- also remove the old workspace
+    XS.modify (\s -> s {projects = Map.delete name $ projects s})
+
+  appendWorkspace (projectName p)
+
+--------------------------------------------------------------------------------
+-- | Prompt for a project name and then switch to it.  Automatically
+-- creates a project if a new name is returned from the prompt.
+switchProjectPrompt :: XPConfig -> X ()
+switchProjectPrompt = projectPrompt [ SwitchMode
+                                    , ShiftMode
+                                    , RenameMode
+                                    , DirMode
+                                    ]
+
+--------------------------------------------------------------------------------
+-- | Shift the currently focused window to the given project.
+shiftToProject :: Project -> X ()
+shiftToProject p = do
+  addHiddenWorkspace (projectName p)
+  windows (W.shift $ projectName p)
+
+--------------------------------------------------------------------------------
+-- | Prompts for a project name and then shifts the currently focused
+-- window to that project.
+shiftToProjectPrompt :: XPConfig -> X ()
+shiftToProjectPrompt = projectPrompt [ ShiftMode
+                                     , RenameMode
+                                     , SwitchMode
+                                     , DirMode
+                                     ]
+
+--------------------------------------------------------------------------------
+-- | Rename the current project.
+renameProjectPrompt :: XPConfig -> X ()
+renameProjectPrompt = projectPrompt [ RenameMode
+                                    , DirMode
+                                    , SwitchMode
+                                    , ShiftMode
+                                    ]
+
+--------------------------------------------------------------------------------
+-- | Change the working directory used for the current project.
+--
+-- NOTE: This will only affect new processed started in this project.
+-- Existing processes will maintain the previous working directory.
+changeProjectDirPrompt :: XPConfig -> X ()
+changeProjectDirPrompt = projectPrompt [ DirMode
+                                       , SwitchMode
+                                       , ShiftMode
+                                       , RenameMode
+                                       ]
+
+--------------------------------------------------------------------------------
+-- | Prompt for a project name.
+projectPrompt :: [ProjectMode] -> XPConfig -> X ()
+projectPrompt submodes c = do
+  ws <- map W.tag `fmap` gets (W.workspaces . windowset)
+  ps <- XS.gets projects
+
+  let names = sort (Map.keys ps `union` ws)
+      modes = map (\m -> XPT $ ProjectPrompt m names) submodes
+
+  mkXPromptWithModes modes c
+
+--------------------------------------------------------------------------------
+-- | Activate a project by updating the working directory and
+-- possibly running its start-up hook.  This function is automatically
+-- invoked when the workspace changes.
+activateProject :: Project -> X ()
+activateProject p = do
+    ws   <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
+    home <- io getHomeDirectory
+
+    -- Change to the project's directory.
+    catchIO (setCurrentDirectory $ expandHome home $ projectDirectory p)
+
+    -- Possibly run the project's startup hook.
+    when (null ws) $ fromMaybe (return ()) (projectStartHook p)
+
+  where
+
+    -- Replace an initial @~@ character with the home directory.
+    expandHome :: FilePath -> FilePath -> FilePath
+    expandHome home dir = case stripPrefix "~" dir of
+      Nothing -> dir
+      Just xs -> home ++ xs
+
+--------------------------------------------------------------------------------
+-- | Default project.
+defProject :: ProjectName -> Project
+defProject name = Project name "~/" Nothing

XMonad/Actions/DynamicWorkspaceGroups.hs

@@ -0,0 +1,147 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceGroups
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Dynamically manage \"workspace groups\", sets of workspaces being
+-- used together for some common task or purpose, to allow switching
+-- between workspace groups in a single action.  Note that this only
+-- makes sense for multi-head setups.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceGroups
+    ( -- * Usage
+      -- $usage
+
+      WSGroupId
+
+    , addRawWSGroup
+    , addWSGroup
+    , addCurrentWSGroup
+    , forgetWSGroup
+    , viewWSGroup
+
+    , promptWSGroupView
+    , promptWSGroupAdd
+    , promptWSGroupForget
+
+    , WSGPrompt
+    ) where
+
+import Data.List (find)
+import Control.Arrow ((&&&))
+import qualified Data.Map as M
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Prompt
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import XMonad.Actions.DynamicWorkspaceGroups
+--
+-- Then add keybindings like the following (this example uses
+-- "XMonad.Util.EZConfig"-style keybindings, but this is not necessary):
+--
+-- >    , ("M-y n", promptWSGroupAdd myXPConfig "Name this group: ")
+-- >    , ("M-y g", promptWSGroupView myXPConfig "Go to group: ")
+-- >    , ("M-y d", promptWSGroupForget myXPConfig "Forget group: ")
+--
+
+type WSGroup = [(ScreenId,WorkspaceId)]
+
+type WSGroupId = String
+
+data WSGroupStorage = WSG { unWSG :: M.Map WSGroupId WSGroup }
+  deriving (Typeable, Read, Show)
+
+withWSG :: (M.Map WSGroupId WSGroup -> M.Map WSGroupId WSGroup) -> WSGroupStorage -> WSGroupStorage
+withWSG f = WSG . f . unWSG
+
+instance ExtensionClass WSGroupStorage where
+  initialValue = WSG $ M.empty
+  extensionType = PersistentExtension
+
+-- | Add a new workspace group of the given name, mapping to an
+--   explicitly specified association between screen IDs and workspace
+--   names.  This function could be useful for, say, creating some
+--   standard workspace groups in your startup hook.
+addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X ()
+addRawWSGroup name = XS.modify . withWSG . M.insert name
+
+-- | Add a new workspace group with the given name.
+addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
+addWSGroup name wids = withWindowSet $ \w -> do
+  let wss  = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
+      wmap = mapM (strength . (flip lookup wss &&& id)) wids
+  case wmap of
+    Just ps -> addRawWSGroup name ps
+    Nothing -> return ()
+ where strength (ma, b) = ma >>= \a -> return (a,b)
+
+-- | Give a name to the current workspace group.
+addCurrentWSGroup :: WSGroupId -> X ()
+addCurrentWSGroup name = withWindowSet $ \w ->
+  addWSGroup name $ map (W.tag . W.workspace) (reverse $ W.current w : W.visible w)
+
+-- | Delete the named workspace group from the list of workspace
+--   groups.  Note that this has no effect on the workspaces involved;
+--   it simply forgets the given name.
+forgetWSGroup :: WSGroupId -> X ()
+forgetWSGroup = XS.modify . withWSG . M.delete
+
+-- | View the workspace group with the given name.
+viewWSGroup :: WSGroupId -> X ()
+viewWSGroup name = do
+  WSG m <- XS.get
+  case M.lookup name m of
+    Just grp -> mapM_ (uncurry viewWS) grp
+    Nothing -> return ()
+
+-- | View the given workspace on the given screen.
+viewWS :: ScreenId -> WorkspaceId -> X ()
+viewWS sid wid = do
+  mw <- findScreenWS sid
+  case mw of
+    Just w -> do
+      windows $ W.view w
+      windows $ W.greedyView wid
+    Nothing -> return ()
+
+-- | Find the workspace which is currently on the given screen.
+findScreenWS :: ScreenId -> X (Maybe WorkspaceId)
+findScreenWS sid = withWindowSet $
+  return . fmap (W.tag . W.workspace) . find ((==sid) . W.screen) . W.screens
+
+data WSGPrompt = WSGPrompt String
+
+instance XPrompt WSGPrompt where
+  showXPrompt (WSGPrompt s) = s
+
+-- | Prompt for a workspace group to view.
+promptWSGroupView :: XPConfig -> String -> X ()
+promptWSGroupView xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) viewWSGroup
+
+-- | Prompt for a name for the current workspace group.
+promptWSGroupAdd :: XPConfig -> String -> X ()
+promptWSGroupAdd xp s =
+  mkXPrompt (WSGPrompt s) xp (const $ return []) addCurrentWSGroup
+
+-- | Prompt for a workspace group to forget.
+promptWSGroupForget :: XPConfig -> String -> X ()
+promptWSGroupForget xp s = do
+  gs <- fmap (M.keys . unWSG) XS.get
+  mkXPrompt (WSGPrompt s) xp (mkComplFunFromList' gs) forgetWSGroup

XMonad/Actions/DynamicWorkspaceOrder.hs

@@ -0,0 +1,178 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaceOrder
+-- Copyright   :  (c) Brent Yorgey 2009
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  <byorgey@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Remember a dynamically updateable ordering on workspaces, together
+-- with tools for using this ordering with "XMonad.Actions.CycleWS"
+-- and "XMonad.Hooks.DynamicLog".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaceOrder
+    ( -- * Usage
+      -- $usage
+
+      getWsCompareByOrder
+    , getSortByOrder
+    , swapWith
+
+    , moveTo
+    , moveToGreedy
+    , shiftTo
+
+    , withNthWorkspace
+
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Util.WorkspaceCompare (WorkspaceCompare, WorkspaceSort, mkWsSort)
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), doTo)
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe (fromJust, fromMaybe)
+import Data.Ord (comparing)
+
+-- $usage
+-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
+--
+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
+--
+-- Then add keybindings to swap the order of workspaces (these
+-- examples use "XMonad.Util.EZConfig" emacs-style keybindings):
+--
+-- >        , ("M-C-<R>",   DO.swapWith Next NonEmptyWS)
+-- >        , ("M-C-<L>",   DO.swapWith Prev NonEmptyWS)
+--
+-- See "XMonad.Actions.CycleWS" for information on the possible
+-- arguments to 'swapWith'.
+--
+-- However, by itself this will do nothing; 'swapWith' does not change
+-- the actual workspaces in any way.  It simply keeps track of an
+-- auxiliary ordering on workspaces.  Anything which cares about the
+-- order of workspaces must be updated to use the auxiliary ordering.
+--
+-- To change the order in which workspaces are displayed by
+-- "XMonad.Hooks.DynamicLog", use 'getSortByOrder' in your
+-- 'XMonad.Hooks.DynamicLog.ppSort' field, for example:
+--
+-- >   ... dynamicLogWithPP $ byorgeyPP {
+-- >     ...
+-- >     , ppSort = DO.getSortByOrder
+-- >     ...
+-- >   }
+--
+-- To use workspace cycling commands like those from
+-- "XMonad.Actions.CycleWS", use the versions of 'moveTo',
+-- 'moveToGreedy', and 'shiftTo' exported by this module.  For example:
+--
+-- >     , ("M-S-<R>",   DO.shiftTo Next HiddenNonEmptyWS)
+-- >     , ("M-S-<L>",   DO.shiftTo Prev HiddenNonEmptyWS)
+-- >     , ("M-<R>",     DO.moveTo Next HiddenNonEmptyWS)
+-- >     , ("M-<L>",     DO.moveTo Prev HiddenNonEmptyWS)
+--
+-- For slight variations on these, use the source for examples and
+-- tweak as desired.
+
+-- | Extensible state storage for the workspace order.
+data WSOrderStorage = WSO { unWSO :: Maybe (M.Map WorkspaceId Int) }
+  deriving (Typeable, Read, Show)
+
+instance ExtensionClass WSOrderStorage where
+  initialValue = WSO Nothing
+  extensionType = PersistentExtension
+
+-- | Lift a Map function to a function on WSOrderStorage.
+withWSO :: (M.Map WorkspaceId Int -> M.Map WorkspaceId Int)
+           -> (WSOrderStorage -> WSOrderStorage)
+withWSO f = WSO . fmap f . unWSO
+
+-- | Update the ordering storage: initialize if it doesn't yet exist;
+-- add newly created workspaces at the end as necessary.
+updateOrder :: X ()
+updateOrder = do
+  WSO mm <- XS.get
+  case mm of
+    Nothing -> do
+      -- initialize using ordering of workspaces from the user's config
+      ws <- asks (workspaces . config)
+      XS.put . WSO . Just . M.fromList $ zip ws [0..]
+    Just m -> do
+      -- check for new workspaces and add them at the end
+      curWs <- gets (S.fromList . map W.tag . W.workspaces . windowset)
+      let mappedWs  = M.keysSet m
+          newWs     = curWs `S.difference` mappedWs
+          nextIndex = 1 + maximum (-1 : M.elems m)
+          newWsIxs  = zip (S.toAscList newWs) [nextIndex..]
+      XS.modify . withWSO . M.union . M.fromList $ newWsIxs
+
+-- | A comparison function which orders workspaces according to the
+-- stored dynamic ordering.
+getWsCompareByOrder :: X WorkspaceCompare
+getWsCompareByOrder = do
+  updateOrder
+  -- after the call to updateOrder we are guaranteed that the dynamic
+  -- workspace order is initialized and contains all existing
+  -- workspaces.
+  WSO (Just m) <- XS.get
+  return $ comparing (fromMaybe 1000 . flip M.lookup m)
+
+-- | Sort workspaces according to the stored dynamic ordering.
+getSortByOrder :: X WorkspaceSort
+getSortByOrder = mkWsSort getWsCompareByOrder
+
+-- | Swap the current workspace with another workspace in the stored
+-- dynamic order.
+swapWith :: Direction1D -> WSType -> X ()
+swapWith dir which = findWorkspace getSortByOrder dir which 1 >>= swapWithCurrent
+
+-- | Swap the given workspace with the current one.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent w = do
+  cur <- gets (W.currentTag . windowset)
+  swapOrder w cur
+
+-- | Swap the two given workspaces in the dynamic order.
+swapOrder :: WorkspaceId -> WorkspaceId -> X ()
+swapOrder w1 w2 = do
+  io $ print (w1,w2)
+  WSO (Just m) <- XS.get
+  let [i1,i2] = map (fromJust . flip M.lookup m) [w1,w2]
+  XS.modify (withWSO (M.insert w1 i2 . M.insert w2 i1))
+  windows id  -- force a status bar update
+
+-- | 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 ()
+moveTo dir t = doTo dir t getSortByOrder (windows . W.view)
+
+-- | Same as 'moveTo', but using 'greedyView' instead of 'view'.
+moveToGreedy :: Direction1D -> WSType -> X ()
+moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
+
+-- | Shift the currently focused window to the next workspace of the
+-- given type in the given direction, using the dynamic workspace order.
+shiftTo :: Direction1D -> WSType -> X ()
+shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
+
+-- | 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
+  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

@@ -1,3 +1,5 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.DynamicWorkspaces
@@ -16,53 +18,98 @@ module XMonad.Actions.DynamicWorkspaces (
                                          -- * Usage
                                          -- $usage
                                          addWorkspace, addWorkspacePrompt,
+                                         appendWorkspace, appendWorkspacePrompt,
+                                         addWorkspaceAt,
                                          removeWorkspace,
+                                         removeWorkspaceByTag,
                                          removeEmptyWorkspace,
+                                         removeEmptyWorkspaceByTag,
                                          removeEmptyWorkspaceAfter,
                                          removeEmptyWorkspaceAfterExcept,
-                                         addHiddenWorkspace,
+                                         addHiddenWorkspace, addHiddenWorkspaceAt,
                                          withWorkspace,
                                          selectWorkspace, renameWorkspace,
-                                         toNthWorkspace, withNthWorkspace
+                                         renameWorkspaceByName,
+                                         toNthWorkspace, withNthWorkspace,
+                                         setWorkspaceIndex, withWorkspaceIndex,
+                                         WorkspaceIndex
                                        ) where
 
 import XMonad hiding (workspaces)
 import XMonad.StackSet hiding (filter, modify, delete)
-import XMonad.Prompt.Workspace
-import XMonad.Prompt ( XPConfig, mkXPrompt, XPrompt(..) )
+import XMonad.Prompt.Workspace ( Wor(Wor), workspacePrompt )
+import XMonad.Prompt ( XPConfig, mkXPrompt )
 import XMonad.Util.WorkspaceCompare ( getSortByIndex )
 import Data.List (find)
 import Data.Maybe (isNothing)
 import Control.Monad (when)
+import qualified Data.Map.Strict as Map
+import qualified XMonad.Util.ExtensibleState as XS
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.DynamicWorkspaces
+-- > import XMonad.Actions.CopyWindow(copy)
 --
 -- Then add keybindings like the following:
 --
 -- >   , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace)
--- >   , ((modm .|. shiftMask, xK_v      ), selectWorkspace defaultXPConfig)
--- >   , ((modm, xK_m                    ), withWorkspace defaultXPConfig (windows . W.shift))
--- >   , ((modm .|. shiftMask, xK_m      ), withWorkspace defaultXPConfig (windows . copy))
--- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace defaultXPConfig)
+-- >   , ((modm .|. shiftMask, xK_v      ), selectWorkspace def)
+-- >   , ((modm, xK_m                    ), withWorkspace def (windows . W.shift))
+-- >   , ((modm .|. shiftMask, xK_m      ), withWorkspace def (windows . copy))
+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def)
 --
--- > -- mod-[1..9]       %! Switch to workspace N
--- > -- mod-shift-[1..9] %! Move client to workspace N
+-- > -- mod-[1..9]       %! Switch to workspace N in the list of workspaces
+-- > -- mod-shift-[1..9] %! Move client to workspace N in the list of workspaces
 -- >    ++
 -- >    zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
 -- >    ++
 -- >    zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
 --
+-- Alternatively, you can associate indexes (which don't depend of the
+-- workspace list order) to workspaces by using following keybindings:
+--
+-- > -- mod-[1..9]         %! Switch to workspace of index N
+-- > -- mod-control-[1..9] %! Set index N to the current workspace
+-- >    ++
+-- >    zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withWorkspaceIndex W.greedyView) [1..])
+-- >    ++
+-- >    zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..])
+--
 -- For detailed instructions on editing your key bindings, see
--- "XMonad.Doc.Extending#Editing_key_bindings".
+-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
+-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.
 
+type WorkspaceTag = String
+-- | The workspace index is mapped to a workspace tag by the user and
+-- can be updated.
+type WorkspaceIndex  = Int
 
-data Wor = Wor String
+-- | Internal dynamic project state that stores a mapping between
+--   workspace indexes and workspace tags.
+data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
+  deriving (Typeable, Read, Show)
+
+instance ExtensionClass DynamicWorkspaceState where
+  initialValue = DynamicWorkspaceState Map.empty
+  extensionType = PersistentExtension
+
+-- | Set the index of the current workspace.
+setWorkspaceIndex :: WorkspaceIndex -> X ()
+setWorkspaceIndex widx = do
+  wtag  <- gets (currentTag . windowset)
+  wmap <- XS.gets workspaceIndexMap
+  XS.modify $ \s -> s {workspaceIndexMap = Map.insert widx wtag wmap}
+
+withWorkspaceIndex :: (String -> WindowSet -> WindowSet) -> WorkspaceIndex -> X ()
+withWorkspaceIndex job widx = do
+  wtag <- ilookup widx
+  maybe (return ()) (windows . job) wtag
+    where
+      ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
+      ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
 
-instance XPrompt Wor where
-    showXPrompt (Wor x) = x
 
 mkCompl :: [String] -> String -> IO [String]
 mkCompl l s = return $ filter (\x -> take (length s) x == s) l
@@ -76,11 +123,18 @@ withWorkspace c job = do ws <- gets (workspaces . windowset)
                          mkXPrompt (Wor "") c (mkCompl ts) job'
 
 renameWorkspace :: XPConfig -> X ()
-renameWorkspace conf = workspacePrompt conf $ \w ->
-                       windows $ \s -> let sett wk = wk { tag = w }
-                                           setscr scr = scr { workspace = sett $ workspace scr }
-                                           sets q = q { current = setscr $ current q }
-                                       in sets $ removeWorkspace' w s
+renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
+
+renameWorkspaceByName :: String -> X ()
+renameWorkspaceByName w = do old  <- gets (currentTag . windowset)
+			     windows $ \s -> let sett wk = wk { tag = w }
+						 setscr scr = scr { workspace = sett $ workspace scr }
+						 sets q = q { current = setscr $ current q }
+                                             in sets $ removeWorkspace' w s
+			     updateIndexMap old w
+  where updateIndexMap old new = do
+          wmap <- XS.gets workspaceIndexMap
+          XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == old then new else t) wmap}
 
 toNthWorkspace :: (String -> X ()) -> Int -> X ()
 toNthWorkspace job wnum = do sort <- getSortByIndex
@@ -107,20 +161,41 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
 --   workspace with the given name already exists; then switch to the
 --   newly created workspace.
 addWorkspace :: String -> X ()
-addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
+addWorkspace = addWorkspaceAt (:)
+
+-- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces
+appendWorkspace :: String -> X()
+appendWorkspace = addWorkspaceAt (flip (++) . return)
+
+-- | Adds a new workspace with the given name to the current list of workspaces.
+--   This function allows the user to pass a function that inserts an element
+--   into a list at an arbitrary spot.
+addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
+addWorkspaceAt add newtag = addHiddenWorkspaceAt add newtag >> windows (greedyView newtag)
 
 -- | Prompt for the name of a new workspace, add it if it does not
 --   already exist, and switch to it.
 addWorkspacePrompt :: XPConfig -> X ()
 addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace
 
+-- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces
+--   if it does not already exist, and switch to it.
+appendWorkspacePrompt :: XPConfig -> X ()
+appendWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) appendWorkspace
+
+-- | Add a new hidden workspace with the given name, or do nothing if
+--   a workspace with the given name already exists. Takes a function to insert
+--   the workspace at an arbitrary spot in the list.
+addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
+addHiddenWorkspaceAt add newtag =
+  whenX (gets (not . tagMember newtag . windowset)) $ do
+    l <- asks (layoutHook . config)
+    windows (addHiddenWorkspace' add newtag l)
+
 -- | Add a new hidden workspace with the given name, or do nothing if
 --   a workspace with the given name already exists.
 addHiddenWorkspace :: String -> X ()
-addHiddenWorkspace newtag =
-  whenX (gets (not . tagMember newtag . windowset)) $ do
-    l <- asks (layoutHook . config)
-    windows (addHiddenWorkspace' newtag l)
+addHiddenWorkspace = addHiddenWorkspaceAt (:)
 
 -- | Remove the current workspace if it contains no windows.
 removeEmptyWorkspace :: X ()
@@ -130,12 +205,11 @@ removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByT
 removeWorkspace :: X ()
 removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
 
--- | Remove workspace with specific tag if it contains no windows. Only works
---   on the current or the last workspace.
+-- | Remove workspace with specific tag if it contains no windows.
 removeEmptyWorkspaceByTag :: String -> X ()
 removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t
 
--- | Remove workspace with specific tag. Only works on the current or the last workspace.
+-- | Remove workspace with specific tag.
 removeWorkspaceByTag :: String -> X ()
 removeWorkspaceByTag torem = do
     s <- gets windowset
@@ -153,7 +227,7 @@ removeEmptyWorkspaceAfter :: X () -> X ()
 removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
 
 -- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
---   whose entries will never be removed. 
+--   whose entries will never be removed.
 removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
 removeEmptyWorkspaceAfterExcept sticky f = do
     before <- gets (currentTag . windowset)
@@ -166,16 +240,21 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
                let mws = find (\ws -> tag ws == t) wsl
                return $ maybe True (isNothing . stack) mws
 
-addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
-addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
+addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
+addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
 
+-- | Remove the hidden workspace with the given tag from the StackSet, if
+--   it exists. All the windows in that workspace are moved to the current
+--   workspace.
 removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
 removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
-                                   , hidden = (w:ws) })
-    | tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
-                         , hidden = ws }
+                                   , hidden = hs })
+    = let (xs, ys) = break ((== torem) . tag) hs
+      in removeWorkspace'' xs ys
    where meld Nothing Nothing = Nothing
          meld x Nothing = x
          meld Nothing x = x
          meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
-removeWorkspace' _ s = s
+         removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
+                                         , hidden = xs ++ ys }
+         removeWorkspace'' _  _      = s

XMonad/Actions/FindEmptyWorkspace.hs

@@ -15,7 +15,7 @@
 module XMonad.Actions.FindEmptyWorkspace (
     -- * Usage
     -- $usage
-    viewEmptyWorkspace, tagToEmptyWorkspace
+    viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
   ) where
 
 import Data.List
@@ -65,3 +65,8 @@ viewEmptyWorkspace = withEmptyWorkspace (windows . view)
 -- all workspaces are in use.
 tagToEmptyWorkspace :: X ()
 tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w
+
+-- | Send current window to an empty workspace. Do nothing if
+-- all workspaces are in use.
+sendToEmptyWorkspace :: X ()
+sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w

XMonad/Actions/FlexibleManipulate.hs

@@ -23,6 +23,8 @@ module XMonad.Actions.FlexibleManipulate (
 ) where
 
 import XMonad
+import qualified Prelude as P
+import Prelude (($), (.), fst, snd, uncurry, const, id, Ord(..), Monad(..), fromIntegral, Double, Integer, map, round, otherwise)
 
 -- $usage
 -- First, add this import to your @~\/.xmonad\/xmonad.hs@:
@@ -84,7 +86,7 @@ mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
 
     let uv = (pointer - wpos) / wsize
         fc = mapP f uv
-        mul = mapP (\x -> 2 - 2 * abs(x - 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
+        mul = mapP (\x -> 2 P.- 2 P.* P.abs(x P.- 0.5)) fc --Fudge factors: interpolation between 1 when on edge, 2 in middle
         atl = ((1, 1) - fc) * mul
         abr = fc * mul
     mouseDrag (\ex ey -> io $ do
@@ -121,14 +123,13 @@ zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
 minP :: Ord a => (a,a) -> (a,a) -> (a,a)
 minP = zipP min
 
-instance Num Pnt where
-    (+) = zipP (+)
-    (-) = zipP (-)
-    (*) = zipP (*)
-    abs = mapP abs
-    signum = mapP signum
-    fromInteger = const undefined
+infixl 6  +, -
+infixl 7  *, /
+
+(+), (-), (*) :: (P.Num a) => (a,a) -> (a,a) -> (a,a)
+(+) = zipP (P.+)
+(-) = zipP (P.-)
+(*) = zipP (P.*)
+(/) :: (P.Fractional a) => (a,a) -> (a,a) -> (a,a)
+(/) = zipP (P./)
 
-instance Fractional Pnt where
-    fromRational = const undefined
-    recip = mapP recip

XMonad/Actions/FlexibleResize.hs

@@ -20,6 +20,7 @@ module XMonad.Actions.FlexibleResize (
 ) where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
 import Foreign.C.Types
 
 -- $usage
@@ -76,6 +77,3 @@ mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
                       Just True ->  (0, (fi k + fi p -).fi, (fi k + fi p -).fi)
                       Nothing ->    (k `div` 2, const p, const $ fi k)
                       Just False -> (k, const p, subtract (fi p) . fi)
-
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral

XMonad/Actions/FloatKeys.hs

@@ -17,7 +17,9 @@ module XMonad.Actions.FloatKeys (
                 keysMoveWindow,
                 keysMoveWindowTo,
                 keysResizeWindow,
-                keysAbsResizeWindow) where
+                keysAbsResizeWindow,
+                P, G,
+                ) where
 
 import XMonad
 

XMonad/Actions/FloatSnap.hs

@@ -21,18 +21,21 @@ module XMonad.Actions.FloatSnap (
                 snapShrink,
                 snapMagicMove,
                 snapMagicResize,
-                snapMagicMouseResize) where
+                snapMagicMouseResize,
+                afterDrag,
+                ifClick,
+                ifClick') where
 
 import XMonad
 import Control.Applicative((<$>))
 import Data.List (sort)
 import Data.Maybe (listToMaybe,fromJust,isNothing)
 import qualified XMonad.StackSet as W
+import qualified Data.Set as S
 
 import XMonad.Hooks.ManageDocks (calcGap)
 import XMonad.Util.Types (Direction2D(..))
-
-import qualified Data.Set as S
+import XMonad.Actions.AfterDrag
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -53,17 +56,24 @@ import qualified Data.Set as S
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 --
--- And possibly add an appropriate mouse binding, for example:
+-- And possibly add appropriate mouse bindings, for example:
 --
--- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
--- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
--- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
+-- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w)))
+-- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
+-- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w)))
 --
 -- For detailed instructions on editing your mouse bindings, see
 -- "XMonad.Doc.Extending#Editing_mouse_bindings".
 --
 -- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
--- Note that the order in which the commands are applied in the mouse bindings are important.
+-- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing
+-- functions, such as those from "XMonad.Actions.FlexibleResize"
+--
+-- An alternative set of mouse bindings that will always snap after the drag is:
+--
+-- >        , ((modm,               button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w)))
+-- >        , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
+-- >        , ((modm,               button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w)))
 --
 -- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
 -- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).

XMonad/Actions/FocusNth.hs

@@ -14,7 +14,8 @@
 module XMonad.Actions.FocusNth (
                  -- * Usage
                  -- $usage
-                 focusNth,focusNth') where
+                 focusNth,focusNth',
+                 swapNth,swapNth') where
 
 import XMonad.StackSet
 import XMonad
@@ -41,6 +42,17 @@ focusNth' :: Int -> Stack a -> Stack a
 focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
                               | otherwise = listToStack n (integrate s)
 
+-- | Swap current window with nth. Focus stays in the same position
+swapNth :: Int -> X ()
+swapNth = windows . modify' . swapNth'
+
+swapNth' :: Int -> Stack a -> Stack a
+swapNth' n s@(Stack c l r)
+  | (n < 0) || (n > length l + length r) || (n == length l) = s
+  | n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
+  | otherwise    = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
+                                                                          
+
 listToStack :: Int -> [a] -> Stack a
 listToStack n l = Stack t ls rs
  where

XMonad/Actions/GridSelect.hs

@@ -27,8 +27,8 @@ module XMonad.Actions.GridSelect (
 
     -- * Configuration
     GSConfig(..),
+    def,
     defaultGSConfig,
-    NavigateMap,
     TwoDPosition,
     buildDefaultGSConfig,
 
@@ -39,6 +39,7 @@ module XMonad.Actions.GridSelect (
     bringSelected,
     goToSelected,
     gridselectWorkspace,
+    gridselectWorkspace',
     spawnSelected,
     runSelectedAction,
 
@@ -46,13 +47,42 @@ module XMonad.Actions.GridSelect (
     HasColorizer(defaultColorizer),
     fromClassName,
     stringColorizer,
-    colorRangeFromClassName
+    colorRangeFromClassName,
+
+    -- * Navigation Mode assembly
+    TwoD,
+    makeXEventhandler,
+    shadowWithKeymap,
+
+    -- * Built-in Navigation Mode
+    defaultNavigation,
+    substringSearch,
+    navNSearch,
+
+    -- * Navigation Components
+    setPos,
+    move,
+    moveNext, movePrev,
+    select,
+    cancel,
+    transformSearchString,
+
+    -- * Rearrangers
+    -- $rearrangers
+    Rearranger,
+    noRearranger,
+    searchStringRearrangerGenerator,
 
     -- * Screenshots
     -- $screenshots
+
+    -- * Types
+    TwoDState,
     ) where
 import Data.Maybe
 import Data.Bits
+import Data.Char
+import Data.Ord (comparing)
 import Control.Applicative
 import Control.Monad.State
 import Control.Arrow
@@ -118,53 +148,62 @@ import Data.Word (Word8)
 
 -- $keybindings
 --
--- Adding more keybindings for gridselect to listen to is similar:
+-- You can build you own navigation mode and submodes by combining the
+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
 --
--- At the top of your config:
+-- > myNavigation :: TwoD a (Maybe a)
+-- > myNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+-- >  where navKeyMap = M.fromList [
+-- >           ((0,xK_Escape), cancel)
+-- >          ,((0,xK_Return), select)
+-- >          ,((0,xK_slash) , substringSearch myNavigation)
+-- >          ,((0,xK_Left)  , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_h)     , move (-1,0)  >> myNavigation)
+-- >          ,((0,xK_Right) , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_l)     , move (1,0)   >> myNavigation)
+-- >          ,((0,xK_Down)  , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_j)     , move (0,1)   >> myNavigation)
+-- >          ,((0,xK_Up)    , move (0,-1)  >> myNavigation)
+-- >          ,((0,xK_y)     , move (-1,-1) >> myNavigation)
+-- >          ,((0,xK_i)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_n)     , move (-1,1)  >> myNavigation)
+-- >          ,((0,xK_m)     , move (1,-1)  >> myNavigation)
+-- >          ,((0,xK_space) , setPos (0,0) >> myNavigation)
+-- >          ]
+-- >        -- The navigation handler ignores unknown key symbols
+-- >        navDefaultHandler = const myNavigation
 --
--- > {-# LANGAUGE NoMonomorphismRestriction #-}
--- > import XMonad
--- > import qualified Data.Map as M
+-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
 --
--- Then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
---
--- > gsconfig3 = defaultGSConfig
+-- > gsconfig3 = def
 -- >    { gs_cellheight = 30
 -- >    , gs_cellwidth = 100
--- >    , gs_navigate = M.unions
--- >            [reset
--- >            ,nethackKeys
--- >            ,gs_navigate                               -- get the default navigation bindings
--- >                $ defaultGSConfig `asTypeOf` gsconfig3 -- needed to fix an ambiguous type variable
--- >            ]
+-- >    , gs_navigate = myNavigation
 -- >    }
--- >   where addPair (a,b) (x,y) = (a+x,b+y)
--- >         nethackKeys = M.map addPair $ M.fromList
--- >                               [((0,xK_y),(-1,-1))
--- >                               ,((0,xK_i),(1,-1))
--- >                               ,((0,xK_n),(-1,1))
--- >                               ,((0,xK_m),(1,1))
--- >                               ]
--- >         -- jump back to the center with the spacebar, regardless of the current position.
--- >         reset = M.singleton (0,xK_space) (const (0,0))
 
 -- $screenshots
 --
 -- Selecting a workspace:
 --
--- <<http://haskell.org/sitewiki/images/a/a9/Xmonad-gridselect-workspace.png>>
+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
 --
 -- Selecting a window by title:
 --
--- <<http://haskell.org/sitewiki/images/3/35/Xmonad-gridselect-window-aavogt.png>>
+-- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>
 
+-- | The 'Default' instance gives a basic configuration for 'gridselect', with
+-- the colorizer chosen based on the type.
+--
+-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
+-- instead of 'def' to avoid ambiguous type variables.
 data GSConfig a = GSConfig {
       gs_cellheight :: Integer,
       gs_cellwidth :: Integer,
       gs_cellpadding :: Integer,
       gs_colorizer :: a -> Bool -> X (String, String),
       gs_font :: String,
-      gs_navigate :: NavigateMap,
+      gs_navigate :: TwoD a (Maybe a),
+      gs_rearranger :: Rearranger a,
       gs_originFractX :: Double,
       gs_originFractY :: Double
 }
@@ -187,28 +226,68 @@ instance HasColorizer a where
         let getColor = if isFg then focusedBorderColor else normalBorderColor
         in asks $ flip (,) "black" . getColor . config
 
--- | A basic configuration for 'gridselect', with the colorizer chosen based on the type.
---
--- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
--- instead, to avoid ambiguous type variables.
-defaultGSConfig :: HasColorizer a => GSConfig a
-defaultGSConfig = buildDefaultGSConfig defaultColorizer
+instance HasColorizer a => Default (GSConfig a) where
+    def = buildDefaultGSConfig defaultColorizer
 
-type NavigateMap = M.Map (KeyMask,KeySym) (TwoDPosition -> TwoDPosition)
+{-# 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))]
 
 data TwoDState a = TwoDState { td_curpos :: TwoDPosition
-                             , td_elementmap :: TwoDElementMap a
+                             , td_availSlots :: [TwoDPosition]
+                             , td_elements :: [(String,a)]
                              , td_gsconfig :: GSConfig a
                              , td_font :: XMonadFont
                              , td_paneX :: Integer
                              , td_paneY :: Integer
                              , td_drawingWin :: Window
+                             , td_searchString :: String
+                             , td_elementmap :: TwoDElementMap a
                              }
 
+generateElementmap :: TwoDState a -> X (TwoDElementMap a)
+generateElementmap s = do
+    rearrangedElements <- rearranger searchString sortedElements
+    return $ zip positions rearrangedElements
+  where
+    TwoDState {td_availSlots = positions,
+               td_gsconfig = gsconfig,
+               td_searchString = searchString} = s
+    GSConfig {gs_rearranger = rearranger} = gsconfig
+    -- Filter out any elements that don't contain the searchString (case insensitive)
+    filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s)
+    -- Sorts the elementmap
+    sortedElements = orderElementmap searchString filteredElements
+    -- Case Insensitive version of isInfixOf
+    needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
+    upper = map toUpper
+
+
+-- | We enforce an ordering such that we will always get the same result. If the
+-- elements position changes from call to call of gridselect, then the shown
+-- positions will also change when you search for the same string. This is
+-- especially the case when using gridselect for showing and switching between
+-- workspaces, as workspaces are usually shown in order of last visited.  The
+-- chosen ordering is "how deep in the haystack the needle is" (number of
+-- characters from the beginning of the string and the needle).
+orderElementmap :: String  -> [(String,a)] -> [(String,a)]
+orderElementmap searchString elements = if not $ null searchString then sortedElements else elements
+  where
+    upper = map toUpper
+    -- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.
+    calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element)
+                        , element)
+    -- Use the score and then the string as the parameters for comparing, making
+    -- it consistent even when two strings that score the same, as it will then be
+    -- sorted by the strings, making it consistent.
+    compareScore = comparing (\(score, (str,_)) -> (score, str))
+    sortedElements = map snd . sortBy compareScore $ map calcScore elements
+
+
 newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
     deriving (Monad,Functor,MonadState (TwoDState a))
 
@@ -222,14 +301,16 @@ liftX = TwoD . lift
 evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
 evalTwoD m s = flip evalStateT s $ unTwoD m
 
-diamondLayer :: (Enum b', Num b') => b' -> [(b', b')]
--- FIXME remove nub
-diamondLayer n = let ul = [ (x,n-x) | x <- [0..n] ]
-        in nub $ ul ++ (map (negate *** id) ul) ++
-           (map (negate *** negate) ul) ++
-           (map (id *** negate) ul)
+diamondLayer :: (Enum a, Num a, Eq a) => a -> [(a, a)]
+diamondLayer 0 = [(0,0)]
+diamondLayer n =
+  -- tr = top right
+  --  r = ur ++ 90 degree clock-wise rotation of ur
+  let tr = [ (x,n-x) | x <- [0..n-1] ]
+      r  = tr ++ (map (\(x,y) -> (y,-x)) tr)
+  in r ++ (map (negate *** negate) r)
 
-diamond :: (Enum a, Num a) => [(a, a)]
+diamond :: (Enum a, Num a, Eq a) => [(a, a)]
 diamond = concatMap diamondLayer [0..]
 
 diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
@@ -266,11 +347,23 @@ drawWinBox win font (fg,bg) ch cw text x y cp =
 updateAllElements :: TwoD a ()
 updateAllElements =
     do
-      TwoDState { td_elementmap = els } <- get
-      updateElements els
+      s <- get
+      updateElements (td_elementmap s)
+
+grayoutElements :: Int -> TwoD a ()
+grayoutElements skip =
+    do
+      s <- get
+      updateElementsWithColorizer grayOnly $ drop skip (td_elementmap s)
+    where grayOnly _ _ = return ("#808080", "#808080")
 
 updateElements :: TwoDElementMap a -> TwoD a ()
 updateElements elementmap = do
+      s <- get
+      updateElementsWithColorizer (gs_colorizer (td_gsconfig s)) elementmap
+
+updateElementsWithColorizer :: (a -> Bool -> X (String, String)) -> TwoDElementMap a -> TwoD a ()
+updateElementsWithColorizer colorizer elementmap = do
     TwoDState { td_curpos = curpos,
                 td_drawingWin = win,
                 td_gsconfig = gsconfig,
@@ -282,7 +375,7 @@ updateElements elementmap = do
         paneX' = div (paneX-cellwidth) 2
         paneY' = div (paneY-cellheight) 2
         updateElement (pos@(x,y),(text, element)) = liftX $ do
-            colors <- gs_colorizer gsconfig element (pos == curpos)
+            colors <- colorizer element (pos == curpos)
             drawWinBox win font
                        colors
                        cellheight
@@ -293,52 +386,186 @@ updateElements elementmap = do
                        (gs_cellpadding gsconfig)
     mapM_ updateElement elementmap
 
-eventLoop :: TwoD a (Maybe a)
-eventLoop = do
-  (keysym,string,event) <- liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
-                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
-                             ev <- getEvent e
-                             (ks,s) <- if ev_event_type ev == keyPress
-                                       then lookupString $ asKeyEvent e
-                                       else return (Nothing, "")
-                             return (ks,s,ev)
-  handle (fromMaybe xK_VoidSymbol keysym,string) event
-
-handle ::  (KeySym, t) -> Event -> TwoD a (Maybe a)
-handle (ks,_) (KeyEvent {ev_event_type = t, ev_state = m })
-    | t == keyPress && ks == xK_Escape = return Nothing
-    | t == keyPress && ks == xK_Return = do
-       (TwoDState { td_curpos = pos, td_elementmap = elmap }) <- get
-       return $ fmap (snd . snd) $ findInElementMap pos elmap
-    | t == keyPress = do
-        m' <- liftX (cleanMask m)
-        keymap <- gets (gs_navigate . td_gsconfig)
-        maybe eventLoop diffAndRefresh . M.lookup (m',ks) $ keymap
-  where diffAndRefresh diff = do
-          state <- get
-          let elmap = td_elementmap state
-              oldPos = td_curpos state
-              newPos = diff oldPos
-              newSelectedEl = findInElementMap newPos elmap
-          when (isJust newSelectedEl) $ do
-                                put state { td_curpos =  newPos }
-                                updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
-          eventLoop
-
-handle _ (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y })
+stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
+stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
     | t == buttonRelease = do
-        (TwoDState { td_elementmap = elmap, td_paneX = px, td_paneY = py,
-                     td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) }) <- get
+        s @  TwoDState { td_paneX = px, td_paneY = py,
+                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get
         let gridX = (fi x - (px - cw) `div` 2) `div` cw
             gridY = (fi y - (py - ch) `div` 2) `div` ch
-        case lookup (gridX,gridY) elmap of
+        case lookup (gridX,gridY) (td_elementmap s) of
              Just (_,el) -> return (Just el)
-             Nothing -> eventLoop
-    | otherwise = eventLoop
+             Nothing -> contEventloop
+    | otherwise = contEventloop
 
-handle _ (ExposeEvent { }) = updateAllElements >> eventLoop
+stdHandle (ExposeEvent { }) contEventloop = updateAllElements >> contEventloop
+
+stdHandle _ contEventloop = contEventloop
+
+-- | Embeds a key handler into the X event handler that dispatches key
+-- events to the key handler, while non-key event go to the standard
+-- handler.
+makeXEventhandler :: ((KeySym, String, KeyMask) -> TwoD a (Maybe a)) -> TwoD a (Maybe a)
+makeXEventhandler keyhandler = fix $ \me -> join $ liftX $ withDisplay $ \d -> liftIO $ allocaXEvent $ \e -> do
+                             maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+                             ev <- getEvent e
+                             if ev_event_type ev == keyPress
+                               then do
+                                  (ks,s) <- lookupString $ asKeyEvent e
+                                  return $ do
+                                      mask <- liftX $ cleanMask (ev_state ev)
+                                      keyhandler (fromMaybe xK_VoidSymbol ks, s, mask)
+                               else
+                                  return $ stdHandle ev me
+
+-- | When the map contains (KeySym,KeyMask) tuple for the given event,
+-- the associated action in the map associated shadows the default key
+-- handler
+shadowWithKeymap :: M.Map (KeyMask, KeySym) a -> ((KeySym, String, KeyMask) -> a) -> (KeySym, String, KeyMask) -> a
+shadowWithKeymap keymap dflt keyEvent@(ks,_,m') = fromMaybe (dflt keyEvent) (M.lookup (m',ks) keymap)
+
+-- Helper functions to use for key handler functions
+
+-- | Closes gridselect returning the element under the cursor
+select :: TwoD a (Maybe a)
+select = do
+  s <- get
+  return $ fmap (snd . snd) $ findInElementMap (td_curpos s) (td_elementmap s)
+
+-- | Closes gridselect returning no element.
+cancel :: TwoD a (Maybe a)
+cancel = return Nothing
+
+-- | Sets the absolute position of the cursor.
+setPos :: (Integer, Integer) -> TwoD a ()
+setPos newPos = do
+  s <- get
+  let elmap = td_elementmap s
+      newSelectedEl = findInElementMap newPos (td_elementmap s)
+      oldPos = td_curpos s
+  when (isJust newSelectedEl && newPos /= oldPos) $ do
+    put s { td_curpos = newPos }
+    updateElements (catMaybes [(findInElementMap oldPos elmap), newSelectedEl])
+
+-- | Moves the cursor by the offsets specified
+move :: (Integer, Integer) -> TwoD a ()
+move (dx,dy) = do
+  s <- get
+  let (x,y) = td_curpos s
+      newPos = (x+dx,y+dy)
+  setPos newPos
+
+moveNext :: TwoD a ()
+moveNext = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just k | k == n-1 -> Just 0
+                      | otherwise -> Just (k+1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+movePrev :: TwoD a ()
+movePrev = do
+  position <- gets td_curpos
+  elems <- gets td_elementmap
+  let n = length elems
+      m = case findIndex (\p -> fst p == position) elems of
+               Nothing -> Nothing
+               Just 0  -> Just (n-1)
+               Just k  -> Just (k-1)
+  whenJust m $ \i ->
+      setPos (fst $ elems !! i)
+
+-- | Apply a transformation function the current search string
+transformSearchString :: (String -> String) -> TwoD a ()
+transformSearchString f = do
+          s <- get
+          let oldSearchString = td_searchString s
+              newSearchString = f oldSearchString
+          when (newSearchString /= oldSearchString) $ do
+            -- FIXME curpos might end up outside new bounds
+            let s' = s { td_searchString = newSearchString }
+            m <- liftX $ generateElementmap s'
+            let s'' = s' { td_elementmap = m }
+                oldLen = length $ td_elementmap s
+                newLen = length $ td_elementmap s''
+            -- All the elements in the previous element map should be
+            -- grayed out, except for those which will be covered by
+            -- elements in the new element map.
+            when (newLen < oldLen) $ grayoutElements newLen
+            put s''
+            updateAllElements
+
+-- | By default gridselect used the defaultNavigation action, which
+-- binds left,right,up,down and vi-style h,l,j,k navigation. Return
+-- quits gridselect, returning the selected element, while Escape
+-- cancels the selection. Slash enters the substring search mode. In
+-- substring search mode, every string-associated keystroke is
+-- added to a search string, which narrows down the object
+-- selection. Substring search mode comes back to regular navigation
+-- via Return, while Escape cancels the search. If you want that
+-- navigation style, add 'defaultNavigation' as 'gs_navigate' to your
+-- 'GSConfig' object. This is done by 'buildDefaultGSConfig' automatically.
+defaultNavigation :: TwoD a (Maybe a)
+defaultNavigation = makeXEventhandler $ shadowWithKeymap navKeyMap navDefaultHandler
+  where navKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_slash)      , substringSearch defaultNavigation)
+          ,((0,xK_Left)       , move (-1,0) >> defaultNavigation)
+          ,((0,xK_h)          , move (-1,0) >> defaultNavigation)
+          ,((0,xK_Right)      , move (1,0) >> defaultNavigation)
+          ,((0,xK_l)          , move (1,0) >> defaultNavigation)
+          ,((0,xK_Down)       , move (0,1) >> defaultNavigation)
+          ,((0,xK_j)          , move (0,1) >> defaultNavigation)
+          ,((0,xK_Up)         , move (0,-1) >> defaultNavigation)
+          ,((0,xK_k)          , move (0,-1) >> defaultNavigation)
+          ,((0,xK_Tab)        , moveNext >> defaultNavigation)
+          ,((0,xK_n)          , moveNext >> defaultNavigation)
+          ,((shiftMask,xK_Tab), movePrev >> defaultNavigation)
+          ,((0,xK_p)          , movePrev >> defaultNavigation)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navDefaultHandler = const defaultNavigation
+
+-- | This navigation style combines navigation and search into one mode at the cost of losing vi style
+-- navigation. With this style, there is no substring search submode,
+-- but every typed character is added to the substring search.
+navNSearch :: TwoD a (Maybe a)
+navNSearch = makeXEventhandler $ shadowWithKeymap navNSearchKeyMap navNSearchDefaultHandler
+  where navNSearchKeyMap = M.fromList [
+           ((0,xK_Escape)     , cancel)
+          ,((0,xK_Return)     , select)
+          ,((0,xK_Left)       , move (-1,0) >> navNSearch)
+          ,((0,xK_Right)      , move (1,0) >> navNSearch)
+          ,((0,xK_Down)       , move (0,1) >> navNSearch)
+          ,((0,xK_Up)         , move (0,-1) >> navNSearch)
+          ,((0,xK_Tab)        , moveNext >> navNSearch)
+          ,((shiftMask,xK_Tab), movePrev >> navNSearch)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> navNSearch)
+          ]
+        -- The navigation handler ignores unknown key symbols, therefore we const
+        navNSearchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          navNSearch
+
+-- | Navigation submode used for substring search. It returns to the
+-- first argument navigation style when the user hits Return.
+substringSearch :: TwoD a (Maybe a) -> TwoD a (Maybe a)
+substringSearch returnNavigation = fix $ \me ->
+  let searchKeyMap = M.fromList [
+           ((0,xK_Escape)   , transformSearchString (const "") >> returnNavigation)
+          ,((0,xK_Return)   , returnNavigation)
+          ,((0,xK_BackSpace), transformSearchString (\s -> if (s == "") then "" else init s) >> me)
+          ]
+      searchDefaultHandler (_,s,_) = do
+          transformSearchString (++ s)
+          me
+  in makeXEventhandler $ shadowWithKeymap searchKeyMap searchDefaultHandler
 
-handle _ _ = eventLoop
 
 -- FIXME probably move that into Utils?
 -- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
@@ -417,19 +644,19 @@ stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
 -- select an element with cursors keys. The selected element is returned.
 gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
 gridselect _ [] = return Nothing
-gridselect gsconfig elmap =
+gridselect gsconfig elements =
  withDisplay $ \dpy -> do
     rootw <- asks theRoot
-    s <- gets $ screenRect . W.screenDetail . W.current . windowset
+    scr <- gets $ screenRect . W.screenDetail . W.current . windowset
     win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
-                    (rect_x s) (rect_y s) (rect_width s) (rect_height s)
+                    (rect_x scr) (rect_y scr) (rect_width scr) (rect_height scr)
     liftIO $ mapWindow dpy win
     liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
     status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
-    io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
+    io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
     font <- initXMF (gs_font gsconfig)
-    let screenWidth = toInteger $ rect_width s;
-        screenHeight = toInteger $ rect_height s;
+    let screenWidth = toInteger $ rect_width scr
+        screenHeight = toInteger $ rect_height scr
     selectedElement <- if (status == grabSuccess) then do
                             let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
                                 restrictX = floor $ restriction screenWidth gs_cellwidth
@@ -437,21 +664,25 @@ gridselect gsconfig elmap =
                                 originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
                                 originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
                                 coords = diamondRestrict restrictX restrictY originPosX originPosY
-                                elmap' = zip coords elmap
-
-                            evalTwoD (updateAllElements >> eventLoop)
-                                (TwoDState (head coords)
-                                            elmap'
-                                            gsconfig
-                                            font
-                                            screenWidth
-                                            screenHeight
-                                            win)
+                                s = TwoDState { td_curpos = (head coords),
+                                                td_availSlots = coords,
+                                                td_elements = elements,
+                                                td_gsconfig = gsconfig,
+                                                td_font = font,
+                                                td_paneX = screenWidth,
+                                                td_paneY = screenHeight,
+                                                td_drawingWin = win,
+                                                td_searchString = "",
+                                                td_elementmap = [] }
+                            m <- generateElementmap s
+                            evalTwoD (updateAllElements >> (gs_navigate gsconfig))
+                                     (s { td_elementmap = m })
                       else
                           return Nothing
     liftIO $ do
       unmapWindow dpy win
       destroyWindow dpy win
+      ungrabPointer dpy currentTime
       sync dpy False
     releaseXMF font
     return selectedElement
@@ -483,19 +714,7 @@ decorateName' w = do
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultGSNav (1/2) (1/2)
-
-defaultGSNav :: NavigateMap
-defaultGSNav = M.map (\(x,y) (a,b) -> (x+a,y+b)) $ M.fromList
-    [((0,xK_Left) ,(-1,0))
-    ,((0,xK_h)    ,(-1,0))
-    ,((0,xK_Right),(1,0))
-    ,((0,xK_l)    ,(1,0))
-    ,((0,xK_Down) ,(0,1))
-    ,((0,xK_j)    ,(0,1))
-    ,((0,xK_Up)   ,(0,-1))
-    ,((0,xK_k)    ,(0,-1))
-    ]
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2)
 
 borderColor :: String
 borderColor = "white"
@@ -531,6 +750,44 @@ runSelectedAction conf actions = do
 -- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)
 gridselectWorkspace :: GSConfig WorkspaceId ->
                           (WorkspaceId -> WindowSet -> WindowSet) -> X ()
-gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
+gridselectWorkspace conf viewFunc = gridselectWorkspace' conf (windows . viewFunc)
+
+-- | Select a workspace and run an arbitrary action on it.
+gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
+gridselectWorkspace' conf func = withWindowSet $ \ws -> do
     let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws)
-    gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)
+    gridselect conf (zip wss wss) >>= flip whenJust func
+
+-- $rearrangers
+--
+-- Rearrangers allow for arbitrary post-filter rearranging of the grid
+-- elements.
+--
+-- For example, to be able to switch to a new dynamic workspace by typing
+-- in its name, you can use the following keybinding action:
+--
+-- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
+-- >
+-- > gridselectWorkspace' defaultGSConfig
+-- >                          { gs_navigate   = navNSearch
+-- >                          , gs_rearranger = searchStringRearrangerGenerator id
+-- >                          }
+-- >                      addWorkspace
+
+-- | A function taking the search string and a list of elements, and
+-- returning a potentially rearranged list of elements.
+type Rearranger a = String -> [(String, a)] -> X [(String, a)]
+
+-- | A rearranger that leaves the elements unmodified.
+noRearranger :: Rearranger a
+noRearranger _ = return
+
+-- | A generator for rearrangers that append a single element based on the
+-- search string, if doing so would not be redundant (empty string or value
+-- already present).
+searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
+searchStringRearrangerGenerator f =
+    let r "" xs                       = return $ xs
+        r s  xs | s `elem` map fst xs = return $ xs
+                | otherwise           = return $ xs ++ [(s, f s)]
+    in r

XMonad/Actions/GroupNavigation.hs

@@ -0,0 +1,218 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+----------------------------------------------------------------------
+-- |
+-- Module      : XMonad.Actions.GroupNavigation
+-- Copyright   : (c) nzeh@cs.dal.ca
+-- License     : BSD3-style (see LICENSE)
+--
+-- Maintainer  : nzeh@cs.dal.ca
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Provides methods for cycling through groups of windows across
+-- workspaces, ignoring windows that do not belong to this group.  A
+-- group consists of all windows matching a user-provided boolean
+-- query.
+--
+-- Also provides a method for jumping back to the most recently used
+-- window in any given group.
+--
+----------------------------------------------------------------------
+
+module XMonad.Actions.GroupNavigation ( -- * Usage
+                                        -- $usage
+                                        Direction (..)
+                                      , nextMatch
+                                      , nextMatchOrDo
+                                      , nextMatchWithThis
+                                      , historyHook
+                                      ) where
+
+import Control.Monad.Reader
+import Data.Foldable as Fold
+import Data.Map as Map
+import Data.Sequence as Seq
+import Data.Set as Set
+import Graphics.X11.Types
+import Prelude hiding (concatMap, drop, elem, filter, null, reverse)
+import XMonad.Core
+import XMonad.ManageHook
+import XMonad.Operations (windows, withFocused)
+import qualified XMonad.StackSet as SS
+import qualified XMonad.Util.ExtensibleState as XS
+
+{- $usage
+
+Import the module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.GroupNavigation
+
+To support cycling forward and backward through all xterm windows, add
+something like this to your keybindings:
+
+> , ((modm              , xK_t), nextMatch Forward  (className =? "XTerm"))
+> , ((modm .|. shiftMask, xK_t), nextMatch Backward (className =? "XTerm"))
+
+These key combinations do nothing if there is no xterm window open.
+If you rather want to open a new xterm window if there is no open
+xterm window, use 'nextMatchOrDo' instead:
+
+> , ((modm              , xK_t), nextMatchOrDo Forward  (className =? "XTerm") (spawn "xterm"))
+> , ((modm .|. shiftMask, xK_t), nextMatchOrDo Backward (className =? "XTerm") (spawn "xterm"))
+
+You can use 'nextMatchWithThis' with an arbitrary query to cycle
+through all windows for which this query returns the same value as the
+current window.  For example, to cycle through all windows in the same
+window class as the current window use:
+
+> , ((modm , xK_f), nextMatchWithThis Forward  className)
+> , ((modm , xK_b), nextMatchWithThis Backward className)
+
+Finally, you can define keybindings to jump to the most recent window
+matching a certain Boolean query.  To do this, you need to add
+'historyHook' to your logHook:
+
+> main = xmonad $ def { logHook = historyHook }
+
+Then the following keybindings, for example, allow you to return to
+the most recent xterm or emacs window or to simply to the most recent
+window:
+
+> , ((modm .|. controlMask, xK_e),         nextMatch History (className =? "Emacs"))
+> , ((modm .|. controlMask, xK_t),         nextMatch History (className =? "XTerm"))
+> , ((modm                , xK_BackSpace), nextMatch History (return True))
+
+Again, you can use 'nextMatchOrDo' instead of 'nextMatch' if you want
+to execute an action if no window matching the query exists. -}
+
+--- Basic cyclic navigation based on queries -------------------------
+
+-- | The direction in which to look for the next match
+data Direction = Forward  -- ^ Forward from current window or workspace
+               | Backward -- ^ Backward from current window or workspace
+               | History  -- ^ Backward in history
+
+-- | Focuses the next window for which the given query produces the
+-- same result as the currently focused window.  Does nothing if there
+-- is no focused window (i.e., the current workspace is empty).
+nextMatchWithThis :: Eq a => Direction -> Query a -> X ()
+nextMatchWithThis dir qry = withFocused $ \win -> do
+  prop <- runQuery qry win
+  nextMatch dir (qry =? prop)
+
+-- | Focuses the next window that matches the given boolean query.
+-- Does nothing if there is no such window.  This is the same as
+-- 'nextMatchOrDo' with alternate action @return ()@.
+nextMatch :: Direction -> Query Bool -> X ()
+nextMatch dir qry = nextMatchOrDo dir qry (return ())
+
+-- | Focuses the next window that matches the given boolean query.  If
+-- there is no such window, perform the given action instead.
+nextMatchOrDo :: Direction -> Query Bool -> X () -> X ()
+nextMatchOrDo dir qry act = orderedWindowList dir
+                            >>= focusNextMatchOrDo qry act
+
+-- Produces the action to perform depending on whether there's a
+-- matching window
+focusNextMatchOrDo :: Query Bool -> X () -> Seq Window -> X ()
+focusNextMatchOrDo qry act = findM (runQuery qry)
+                             >=> maybe act (windows . SS.focusWindow)
+
+-- 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 dir     = withWindowSet $ \ss -> do
+  wsids <- asks (Seq.fromList . workspaces . config)
+  let wspcs = orderedWorkspaceList ss wsids
+      wins  = dirfun dir
+              $ Fold.foldl' (><) Seq.empty
+              $ fmap (Seq.fromList . SS.integrate' . SS.stack) wspcs
+      cur   = SS.peek ss
+  return $ maybe wins (rotfun wins) cur
+  where
+    dirfun Backward = Seq.reverse
+    dirfun _        = id
+    rotfun wins x   = rotate $ rotateTo (== x) wins
+
+-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
+orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
+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
+      isCurWS ws = SS.tag ws == SS.tag (SS.workspace $ SS.current ss)
+
+--- History navigation, requires a layout modifier -------------------
+
+-- The state extension that holds the history information
+data HistoryDB = HistoryDB (Maybe Window) -- currently focused window
+                           (Seq Window)   -- previously focused windows
+               deriving (Read, Show, Typeable)
+
+instance ExtensionClass HistoryDB where
+
+    initialValue  = HistoryDB Nothing Seq.empty
+    extensionType = PersistentExtension
+
+-- | Action that needs to be executed as a logHook to maintain the
+-- focus history of all windows as the WindowSet changes.
+historyHook :: X ()
+historyHook = XS.get >>= updateHistory >>= XS.put
+
+-- Updates the history in response to a WindowSet change
+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)
+  return $ HistoryDB newcur (del newcur newhist)
+  where
+    ins x xs = maybe xs (<| xs) x
+    del x xs = maybe xs (\x' -> flt (/= x') xs) x
+
+--- Two replacements for Seq.filter and Seq.breakl available only in
+--- containers-0.3.0.0, which only ships with ghc 6.12.  Once we
+--- decide to no longer support ghc < 6.12, these should be replaced
+--- with Seq.filter and Seq.breakl.
+
+flt :: (a -> Bool) -> Seq a -> Seq a
+flt p = Fold.foldl (\xs x -> if p x then xs |> x else xs) Seq.empty
+
+brkl :: (a -> Bool) -> Seq a -> (Seq a, Seq a)
+brkl p xs = flip Seq.splitAt xs
+            $ snd
+            $ Fold.foldr (\x (i, j) -> if p x then (i-1, i-1) else (i-1, j)) (l, l) xs
+  where
+    l = Seq.length xs
+
+--- Some sequence helpers --------------------------------------------
+
+-- Rotates the sequence by one position
+rotate :: Seq a -> Seq a
+rotate xs = rotate' (viewl xs)
+  where
+    rotate' EmptyL      = Seq.empty
+    rotate' (x' :< xs') = xs' |> x'
+
+-- Rotates the sequence until an element matching the given condition
+-- is at the beginning of the sequence.
+rotateTo :: (a -> Bool) -> Seq a -> Seq a
+rotateTo cond xs = let (lxs, rxs) = brkl cond xs in rxs >< lxs
+
+--- A monadic find ---------------------------------------------------
+
+-- Applies the given action to every sequence element in turn until
+-- the first element is found for which the action returns true.  The
+-- remaining elements in the sequence are ignored.
+findM :: Monad m => (a -> m Bool) -> Seq a -> m (Maybe a)
+findM cond xs = findM' cond (viewl xs)
+  where
+    findM' _   EmptyL      = return Nothing
+    findM' qry (x' :< xs') = do
+      isMatch <- qry x'
+      if isMatch
+        then return (Just x')
+        else findM qry xs'

XMonad/Actions/KeyRemap.hs

@@ -0,0 +1,156 @@
+ {-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.KeyRemap
+-- Copyright   :  (c) Christian Dietrich
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  stettberger@dokucde.de
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Remap Keybinding on the fly, e.g having Dvorak char, but everything with Control/Shift
+-- is left us Layout
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.KeyRemap (
+  -- * Usage
+  -- $usage
+  setKeyRemap,
+  buildKeyRemapBindings,
+  setDefaultKeyRemap,
+
+  KeymapTable (KeymapTable),
+  emptyKeyRemap,
+  dvorakProgrammerKeyRemap
+  ) where
+
+import XMonad
+import XMonad.Util.Paste
+import Data.List
+
+import qualified XMonad.Util.ExtensibleState as XS
+import Control.Monad
+
+
+data KeymapTable = KeymapTable [((KeyMask, KeySym), (KeyMask, KeySym))] deriving (Typeable, Show)
+
+instance ExtensionClass KeymapTable where
+   initialValue = KeymapTable []
+
+-- $usage
+-- Provides the possibility to remap parts of the keymap to generate different keys
+--
+-- * E.g You want to type Programmers Dvorak, but your keybindings should be the normal us layout
+--   after all
+--
+-- First, you must add all possible keybindings for all layout you want to use:
+--
+-- >   keys = myKeys ++ buildKeyRemapBindings [dvorakProgrammerKeyRemap,emptyKeyRemap]
+--
+-- Then you must add setDefaultKeyRemap to your startup hook (e.g. you want to set the
+-- empty keyremap (no remapping is done) as default after startup):
+--
+-- > myStartupHook :: X()
+-- > myStartupHook = do
+-- >   setWMName "LG3D"
+-- >   setDefaultKeyRemap emptyKeyRemap [dvorakProgrammerKeyRemap, emptyKeyRemap]
+--
+-- Then you add keybindings for changing keyboard layouts;
+--
+-- > , ((0                    , xK_F1    ), setKeyRemap emptyKeyRemap)
+-- > , ((0                    , xK_F2    ), setKeyRemap dvorakProgrammerKeyRemap)
+--
+-- When defining your own keymappings, please be aware of:
+--
+-- * If you want to emulate a key that is shifted on us you must emulate that keypress:
+--
+-- > KeymapTable [((0, xK_a), (shiftMask, xK_5))] -- would bind 'a' to '%'
+-- > KeymapTable [((shiftMask, xK_a), (0, xK_5))] -- would bind 'A' to '5'
+--
+-- * the dvorakProgrammerKeyRemap uses the original us layout as lookuptable to generate
+--   the KeymapTable
+--
+-- * KeySym and (ord Char) are incompatible, therefore the magic numbers in dvorakProgrammerKeyRemap
+--   are nessesary
+
+doKeyRemap :: KeyMask -> KeySym -> X()
+doKeyRemap mask sym = do
+  table <- XS.get
+  let (insertMask, insertSym) = extractKeyMapping table mask sym
+  sendKey insertMask insertSym
+
+-- | Using this in the keybindings to set the actual Key Translation table
+setKeyRemap :: KeymapTable -> X()
+setKeyRemap table = do
+  let KeymapTable newtable = table
+  KeymapTable oldtable <- XS.get
+  XConf { display = dpy, theRoot = rootw } <- ask
+
+  let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
+  let ungrab kc m = io $ ungrabKey dpy kc m rootw
+
+  forM_ oldtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ ungrab kc mask
+
+  forM_ newtable $ \((mask, sym), _) -> do
+    kc <- io $ keysymToKeycode dpy sym
+    -- "If the specified KeySym is not defined for any KeyCode,
+    -- XKeysymToKeycode() returns zero."
+    when (kc /= 0) $ grab kc mask
+
+  XS.put table
+
+-- | Adding this to your startupHook, to select your default Key Translation table.
+--   You also must give it all the KeymapTables you are willing to use
+setDefaultKeyRemap  :: KeymapTable -> [KeymapTable] -> X()
+setDefaultKeyRemap dflt keyremaps = do
+  XS.put (KeymapTable mappings)
+  setKeyRemap dflt
+  where
+    mappings = nub (keyremaps >>= \(KeymapTable table) -> table)
+
+extractKeyMapping :: KeymapTable -> KeyMask -> KeySym -> (KeyMask, KeySym)
+extractKeyMapping (KeymapTable table) mask sym =
+  insertKey filtered
+  where filtered = filter (\((m, s),_) -> m == mask && s == sym) table
+        insertKey [] = (mask, sym)
+        insertKey ((_, to):_) = to
+
+-- | Append the output of this function to your keybindings with ++
+buildKeyRemapBindings :: [KeymapTable] -> [((KeyMask, KeySym), X ())]
+buildKeyRemapBindings keyremaps =
+  [((mask, sym), doKeyRemap mask sym) | (mask, sym) <- bindings]
+  where mappings = concat (map (\(KeymapTable table) -> table) keyremaps)
+        bindings = nub (map (\binding -> fst binding) mappings)
+
+
+-- Here come the Keymappings
+-- | The empty KeymapTable, does no translation
+emptyKeyRemap :: KeymapTable
+emptyKeyRemap = KeymapTable []
+
+-- | The dvorak Programmers keymap, translates from us keybindings to dvorak programmers
+dvorakProgrammerKeyRemap :: KeymapTable
+dvorakProgrammerKeyRemap =
+  KeymapTable [((charToMask maskFrom, from), (charToMask maskTo, to)) |
+               (maskFrom, from, maskTo, to) <- (zip4 layoutUsShift layoutUsKey layoutDvorakShift layoutDvorakKey)]
+  where
+
+    layoutUs    = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./~!@#$%^&*()_+QWERTYUIOP{}|ASDFGHJKL:\"ZXCVBNM<>?"  :: [KeySym]
+    layoutUsKey = map (fromIntegral . fromEnum) "`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./`1234567890-=qwertyuiop[]\\asdfghjkl;'zxcvbnm,./"  :: [KeySym]
+    layoutUsShift = "0000000000000000000000000000000000000000000000011111111111111111111111111111111111111111111111"
+
+    layoutDvorak = map (fromIntegral . fromEnum) "$&[{}(=*)+]!#;,.pyfgcrl/@\\aoeuidhtns-'qjkxbmwvz~%7531902468`:<>PYFGCRL?^|AOEUIDHTNS_\"QJKXBMWVZ" :: [KeySym]
+
+    layoutDvorakShift = map getShift layoutDvorak
+    layoutDvorakKey   = map getKey layoutDvorak
+    getKey  char = let Just index = elemIndex char layoutUs
+                    in layoutUsKey !! index
+    getShift char = let Just index = elemIndex char layoutUs
+                    in layoutUsShift !! index
+    charToMask char = if [char] == "0" then 0 else shiftMask

XMonad/Actions/Launcher.hs

@@ -0,0 +1,123 @@
+{- |
+Module      :  XMonad.Actions.Launcher
+Copyright   :  (C) 2012 Carlos López-Camey
+License     :  None; public domain
+
+Maintainer  :  <c.lopez@kmels.net>
+Stability   :  unstable
+
+A set of prompts for XMonad
+-}
+
+module XMonad.Actions.Launcher(
+  -- * Description and use
+  -- $description
+  defaultLauncherModes
+  , ExtensionActions
+  , LauncherConfig(..)
+  , launcherPrompt
+) where
+
+import           Data.List       (find, findIndex, isPrefixOf, tails)
+import qualified Data.Map        as M
+import           Data.Maybe      (isJust)
+import           XMonad          hiding (config)
+import           XMonad.Prompt
+import           XMonad.Util.Run
+
+{- $description
+    This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes:
+
+       * Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock.
+
+       * Calc: Uses the program calc to do calculations.
+
+    To test it, modify your local .xmonad:
+
+    > import XMonad.Prompt(def)
+    > import XMonad.Actions.Launcher
+
+    > ((modm .|. controlMask, xK_l), launcherPrompt def $ defaultLauncherModes launcherConfig)
+
+    A LauncherConfig contains settings for the default modes, modify them accordingly.
+
+    > launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"}
+
+Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up.
+
+ If you used the default 'XPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'.
+ -}
+
+data HoogleMode = HMode FilePath String --path to hoogle and browser
+data CalculatorMode = CalcMode
+
+data LauncherConfig = LauncherConfig {
+  browser        :: String
+  , pathToHoogle :: String
+}
+
+type ExtensionActions = M.Map String (String -> X())
+
+-- | Uses the command `calc` to compute arithmetic expressions
+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
+    fmap 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
+instance XPrompt HoogleMode where
+  showXPrompt _ = "hoogle %s> "
+  commandToComplete _ = id
+  completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]
+  -- This action calls hoogle again to find the URL corresponding to the autocompleted item
+  modeAction (HMode pathToHoogleBin'' browser') query result = do
+    completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]
+    let link = do
+          s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink
+          i <- findSeqIndex s "http://"
+          return $ drop i s
+    case link of
+       Just l -> spawn $ browser' ++ " " ++ l
+       _      -> return ()
+    where
+      -- | Receives a sublist and a list. It returns the index where the sublist appears in the list.
+      findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int
+      findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs
+
+-- | 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 ""
+
+-- | Creates a prompt with the given modes
+launcherPrompt :: XPConfig -> [XPMode] -> X()
+launcherPrompt config modes = mkXPromptWithModes modes config
+
+-- | Create a list of modes based on :
+-- a list of extensions mapped to actions
+-- the path to hoogle
+defaultLauncherModes :: LauncherConfig -> [XPMode]
+defaultLauncherModes cnf = let
+  ph           = pathToHoogle cnf
+  in [ hoogleMode ph $ browser cnf
+     , calcMode]
+
+hoogleMode :: FilePath -> String -> XPMode
+hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser'
+calcMode :: XPMode
+calcMode = XPT CalcMode
+
+{-
+
+  -- ideas for XMonad.Prompt running on mode XPMultipleModes
+     * Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g)
+
+     * Support for actions of type String -> X a
+
+  -- ideas for this module
+
+     * Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?)
+
+     * Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json)
+-}

XMonad/Actions/LinkWorkspaces.hs

@@ -0,0 +1,169 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.LinkWorkspaces
+-- Copyright   :  (c) Jan-David Quesel <quesel@gmail.org>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  none
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to add and delete links between workspaces. It is aimed
+-- at providing useful links between workspaces in a multihead setup. Linked
+-- workspaces are view at the same time.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable  #-}
+module XMonad.Actions.LinkWorkspaces (
+                                         -- * Usage
+                                         -- $usage
+                                        switchWS,
+                                        removeAllMatchings,
+                                        unMatch,
+                                        toggleLinkWorkspaces,
+                                        defaultMessageConf,
+                                        MessageConfig(..)
+                                       ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.IndependentScreens(countScreens)
+import qualified XMonad.Util.ExtensibleState as XS (get, put)
+import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen')
+import qualified Data.Map as M
+    ( insert, delete, Map, lookup, empty, filter )
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.LinkWorkspaces
+--
+-- and add a function to print messages like
+--
+-- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1)
+-- > message_color_func c1 c2 msg = dzenColor c1 c2 msg
+-- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen
+--
+-- alternatively you can use the noMessages function as the argument
+--
+-- Then add keybindings like the following:
+--
+-- > ,((modm, xK_p), toggleLinkWorkspaces message)
+-- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message)
+--
+-- >   [ ((modm .|. m, k), a i)
+-- >       | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)]
+-- >       , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+data MessageConfig = MessageConfig {  messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
+                    , foreground :: [Char]
+                    , alertedForeground :: [Char]
+                    , background :: [Char]
+                   }
+
+defaultMessageConf :: MessageConfig
+defaultMessageConf = MessageConfig { messageFunction = noMessageFn
+                     , background = "#000000"
+                     , alertedForeground = "#ff7701"
+                     , foreground = "#00ff00" }
+
+noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
+noMessageFn _ _ _ _ = return () :: X ()
+
+-- | Stuff for linking workspaces
+data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
+instance ExtensionClass WorkspaceMap 
+    where initialValue = WorkspaceMap M.empty
+          extensionType = PersistentExtension
+
+switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
+switchWS f m ws = switchWS' f m ws Nothing
+
+-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
+-- | we already did switching on
+switchWS' :: (WorkspaceId -> X ()) -> MessageConfig  -> WorkspaceId -> (Maybe ScreenId) -> X ()
+switchWS' switchFn message workspace stopAtScreen = do
+  ws <- gets windowset
+  nScreens <- countScreens
+  let now = W.screen (W.current ws)
+  let next = ((now + 1) `mod` nScreens)
+  switchFn workspace
+  case stopAtScreen of
+    Nothing -> sTM now next (Just now)
+    Just sId -> if sId == next then return () else sTM now next (Just sId)
+  where sTM = switchToMatching (switchWS' switchFn message) message workspace
+
+-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
+-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
+switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId 
+    -> ScreenId -> (Maybe ScreenId) -> X ()
+switchToMatching f message t now next stopAtScreen = do
+    WorkspaceMap matchings <- XS.get :: X WorkspaceMap
+    case (M.lookup t matchings) of
+        Nothing -> return () :: X()
+        Just newWorkspace -> do
+            onScreen' (f newWorkspace stopAtScreen) FocusCurrent next 
+            messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))
+
+-- | Insert a mapping between t1 and t2 or remove it was already present
+toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
+toggleMatching message t1 t2 = do
+    WorkspaceMap matchings <- XS.get :: X WorkspaceMap
+    case (M.lookup t1 matchings) of
+        Nothing -> setMatching message t1 t2 matchings
+        Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
+    return ()
+
+-- | Insert a mapping between t1 and t2 and display a message
+setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
+setMatching message t1 t2 matchings = do
+   ws <- gets windowset
+   let now = W.screen (W.current ws)
+   XS.put $ WorkspaceMap $ M.insert t1 t2 matchings
+   messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2))
+
+-- currently this function is called manually this means that if workspaces
+-- were deleted, some links stay in the RAM even though they are not used
+-- anymore... because of the small amount of memory used for those there is no
+-- special cleanup so far
+removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
+removeMatching' message t1 t2 matchings = do
+   ws <- gets windowset
+   let now = W.screen (W.current ws)
+   XS.put $ WorkspaceMap $ M.delete t1 matchings
+   messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2)
+
+-- | Remove all maps between workspaces
+removeAllMatchings :: MessageConfig -> X ()
+removeAllMatchings message = do
+   ws <- gets windowset
+   let now = W.screen (W.current ws)
+   XS.put $ WorkspaceMap $ M.empty
+   messageFunction message now (alertedForeground message) (background message) "All links removed!"
+
+-- | remove all matching regarding a given workspace
+unMatch :: WorkspaceId -> X ()
+unMatch workspace = do
+    WorkspaceMap matchings <- XS.get :: X WorkspaceMap
+    XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings)
+
+-- | Toggle the currently displayed workspaces as matching. Starting from the one with focus
+-- | a linked list of workspaces is created that will later be iterated by switchToMatching.
+toggleLinkWorkspaces :: MessageConfig -> X ()
+toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message
+
+toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
+toggleLinkWorkspaces' first message = do
+    ws <- gets windowset
+    nScreens <- countScreens
+    let now = W.screen (W.current ws)
+    let next = (now + 1) `mod` nScreens
+    if next == first then return () else do -- this is also the case if there is only one screen
+        case (W.lookupWorkspace next ws) of
+            Nothing -> return ()
+            Just name -> toggleMatching message (W.currentTag ws) (name)
+        onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next

XMonad/Actions/MessageFeedback.hs

@@ -1,10 +1,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.MessageFeedback
--- Copyright    : (c) Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright    : (c) Quentin Moser <moserq@gmail.com>
 -- License      : BSD3
 --
--- Maintainer   : None
+-- Maintainer   : orphaned
 -- Stability    : unstable
 -- Portability  : unportable
 --

XMonad/Actions/MouseResize.hs

@@ -23,12 +23,8 @@ module XMonad.Actions.MouseResize
     , MouseResize (..)
     ) where
 
-import Control.Monad
-import Data.Maybe
-
 import XMonad
 import XMonad.Layout.Decoration
-import XMonad.Layout.LayoutModifier
 
 import XMonad.Layout.WindowArranger
 import XMonad.Util.XUtils
@@ -47,11 +43,11 @@ import XMonad.Util.XUtils
 --
 -- Then edit your @layoutHook@ by modifying a given layout:
 --
--- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig
+-- > myLayout = mouseResize $ windowArrange $ layoutHook def
 --
 -- and then:
 --
--- > main = xmonad defaultConfig { layoutHook = myLayout }
+-- > main = xmonad def { layoutHook = myLayout }
 --
 -- For more detailed instructions on editing the layoutHook see:
 --
@@ -114,6 +110,11 @@ createInputWindow ((w,r),mr) = do
     Just tr  -> withDisplay $ \d -> do
                   tw <- mkInputWindow d tr
                   io $ selectInput d tw (exposureMask .|. buttonPressMask)
+
+                  cursor <- io $ createFontCursor d xC_bottom_right_corner
+                  io $ defineCursor d tw cursor
+                  io $ freeCursor d cursor
+
                   showWindow tw
                   return ((w,r), Just tw)
     Nothing ->    return ((w,r), Nothing)

XMonad/Actions/Navigation2D.hs

@@ -0,0 +1,884 @@
+{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.Navigation2D
+-- Copyright   :  (c) 2011  Norbert Zeh <nzeh@cs.dal.ca>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Norbert Zeh <nzeh@cs.dal.ca>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Navigation2D is an xmonad extension that allows easy directional
+-- navigation of windows and screens (in a multi-monitor setup).
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Navigation2D ( -- * Usage
+                                     -- $usage
+
+                                     -- * Finer points
+                                     -- $finer_points
+
+                                     -- * Alternative directional navigation modules
+                                     -- $alternatives
+
+                                     -- * Incompatibilities
+                                     -- $incompatibilities
+
+                                     -- * Detailed technical discussion
+                                     -- $technical
+
+                                     -- * Exported functions and types
+                                     -- #Exports#
+
+                                     navigation2D
+                                   , navigation2DP
+                                   , additionalNav2DKeys
+                                   , additionalNav2DKeysP
+                                   , withNavigation2DConfig
+                                   , Navigation2DConfig(..)
+                                   , def
+                                   , defaultNavigation2DConfig
+                                   , Navigation2D
+                                   , lineNavigation
+                                   , centerNavigation
+                                   , hybridNavigation
+                                   , fullScreenRect
+                                   , singleWindowRect
+                                   , switchLayer
+                                   , windowGo
+                                   , windowSwap
+                                   , windowToScreen
+                                   , screenGo
+                                   , screenSwap
+                                   , Direction2D(..)
+                                   ) where
+
+import Control.Applicative
+import qualified Data.List as L
+import qualified Data.Map as M
+import Data.Maybe
+import XMonad hiding (Screen)
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
+import XMonad.Util.Types
+
+-- $usage
+-- #Usage#
+-- Navigation2D provides directional navigation (go left, right, up, down) for
+-- windows and screens.  It treats floating and tiled windows as two separate
+-- layers and provides mechanisms to navigate within each layer and to switch
+-- between layers.  Navigation2D provides two different navigation strategies
+-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
+-- natural but may make it impossible to navigate to a given window from the
+-- current window, particularly in the floating layer.  /Center navigation/
+-- feels less natural in certain situations but ensures that all windows can be
+-- reached without the need to involve the mouse. A third option is to use
+-- /Hybrid navigation/, which automatically chooses between the two whenever
+-- navigation is attempted.  Navigation2D allows different navigation strategies
+-- to be used in the two layers and allows customization of the navigation strategy
+-- for the tiled layer based on the layout currently in effect.
+--
+-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Navigation2D
+--
+-- Then add the configuration of the module to your main function:
+--
+-- > main = xmonad $ navigation2D def
+-- >                              (xK_Up, xK_Left, xK_Down, xK_Right)
+-- >                              [(mod4Mask,               windowGo  ),
+-- >                               (mod4Mask .|. shiftMask, windowSwap)]
+-- >                              False
+-- >               $ def
+--
+-- Alternatively, you can use navigation2DP:
+--
+-- > main = xmonad $ navigation2D def
+-- >                              ("<Up>", "<Left>", "<Down>", "<Right>")
+-- >                              [("M-",   windowGo  ),
+-- >                               ("M-S-", windowSwap)]
+-- >                              False
+-- >               $ def
+--
+-- That's it. If instead you'd like more control, you can combine
+-- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:
+--
+-- > main = xmonad $ withNavigation2DConfig def
+-- >               $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
+-- >                                     [(mod4Mask,               windowGo  ),
+-- >                                      (mod4Mask .|. shiftMask, windowSwap)]
+-- >                                     False
+-- >               $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r)
+-- >                                     [(mod4Mask,               screenGo  ),
+-- >                                      (mod4Mask .|. shiftMask, screenSwap)]
+-- >                                     False
+-- >               $ def
+--
+-- Or you can add the configuration of the module to your main function:
+--
+-- > main = xmonad $ withNavigation2DConfig def $ def
+--
+-- And specify your keybindings normally:
+--
+-- >    -- Switch between layers
+-- >    , ((modm,                 xK_space), switchLayer)
+-- >
+-- >    -- Directional navigation of windows
+-- >    , ((modm,                 xK_Right), windowGo R False)
+-- >    , ((modm,                 xK_Left ), windowGo L False)
+-- >    , ((modm,                 xK_Up   ), windowGo U False)
+-- >    , ((modm,                 xK_Down ), windowGo D False)
+-- >
+-- >    -- Swap adjacent windows
+-- >    , ((modm .|. controlMask, xK_Right), windowSwap R False)
+-- >    , ((modm .|. controlMask, xK_Left ), windowSwap L False)
+-- >    , ((modm .|. controlMask, xK_Up   ), windowSwap U False)
+-- >    , ((modm .|. controlMask, xK_Down ), windowSwap D False)
+-- >
+-- >    -- Directional navigation of screens
+-- >    , ((modm,                 xK_r    ), screenGo R False)
+-- >    , ((modm,                 xK_l    ), screenGo L False)
+-- >    , ((modm,                 xK_u    ), screenGo U False)
+-- >    , ((modm,                 xK_d    ), screenGo D False)
+-- >
+-- >    -- Swap workspaces on adjacent screens
+-- >    , ((modm .|. controlMask, xK_r    ), screenSwap R False)
+-- >    , ((modm .|. controlMask, xK_l    ), screenSwap L False)
+-- >    , ((modm .|. controlMask, xK_u    ), screenSwap U False)
+-- >    , ((modm .|. controlMask, xK_d    ), screenSwap D False)
+-- >
+-- >    -- Send window to adjacent screen
+-- >    , ((modm .|. mod1Mask,    xK_r    ), windowToScreen R False)
+-- >    , ((modm .|. mod1Mask,    xK_l    ), windowToScreen L False)
+-- >    , ((modm .|. mod1Mask,    xK_u    ), windowToScreen U False)
+-- >    , ((modm .|. mod1Mask,    xK_d    ), windowToScreen D False)
+--
+-- For detailed instruction on editing the key binding see:
+--
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- $finer_points
+-- #Finer_Points#
+-- The above should get you started.  Here are some finer points:
+--
+-- Navigation2D has the ability to wrap around at screen edges.  For example, if
+-- you navigated to the rightmost window on the rightmost screen and you
+-- continued to go right, this would get you to the leftmost window on the
+-- leftmost screen.  This feature may be useful for switching between screens
+-- that are far apart but may be confusing at least to novice users.  Therefore,
+-- it is disabled in the above example (e.g., navigation beyond the rightmost
+-- window on the rightmost screen is not possible and trying to do so will
+-- simply not do anything.)  If you want this feature, change all the 'False'
+-- values in the above example to 'True'.  You could also decide you want
+-- wrapping only for a subset of the operations and no wrapping for others.
+--
+-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
+-- in the 'Navigation2DConfig' (by default, line navigation is used).  To
+-- override this behaviour for some layouts, add a pair (\"layout name\",
+-- navigation strategy) to the 'layoutNavigation' list in the
+-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
+-- layout's description method (normally what is shown as the layout name in
+-- your status bar).  For example, all navigation strategies normally allow only
+-- navigation between mapped windows.  The first step to overcome this, for
+-- example, for the Full layout, is to switch to center navigation for the Full
+-- layout:
+--
+-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] }
+-- >
+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
+-- >               $ def
+--
+-- The navigation between windows is based on their screen rectangles, which are
+-- available /and meaningful/ only for mapped windows.  Thus, as already said,
+-- the default is to allow navigation only between mapped windows.  However,
+-- there are layouts that do not keep all windows mapped.  One example is the
+-- Full layout, which unmaps all windows except the one that has the focus,
+-- thereby preventing navigation to any other window in the layout.  To make
+-- navigation to unmapped windows possible, unmapped windows need to be assigned
+-- rectangles to pretend they are mapped, and a natural way to do this for the
+-- Full layout is to pretend all windows occupy the full screen and are stacked
+-- on top of each other so that only the frontmost one is visible.  This can be
+-- done as follows:
+--
+-- > myNavigation2DConfig = def { layoutNavigation   = [("Full", centerNavigation)]
+-- >                            , unmappedWindowRect = [("Full", singleWindowRect)]
+-- >                            }
+-- >
+-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
+-- >               $ def
+--
+-- With this setup, Left/Up navigation behaves like standard
+-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
+-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
+-- layout.
+--
+-- In general, each entry in the 'unmappedWindowRect' association list is a pair
+-- (\"layout description\", function), where the function computes a rectangle
+-- for each unmapped window from the screen it is on and the window ID.
+-- Currently, Navigation2D provides only two functions of this type:
+-- 'singleWindowRect' and 'fullScreenRect'.
+--
+-- With per-layout navigation strategies, if different layouts are in effect on
+-- different screens in a multi-monitor setup, and different navigation
+-- strategies are defined for these active layouts, the most general of these
+-- navigation strategies is used across all screens (because Navigation2D does
+-- not distinguish between windows on different workspaces), where center
+-- navigation is more general than line navigation, as discussed formally under
+-- <#Technical_Discussion>.
+
+-- $alternatives
+-- #Alternatives#
+--
+-- There exist two alternatives to Navigation2D:
+-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
+-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
+-- window that would receive the focus in each navigation direction, but it does
+-- not support navigation across multiple monitors, does not support directional
+-- navigation of floating windows, and has a very unintuitive definition of
+-- which window receives the focus next in each direction.  X.A.WindowNavigation
+-- does support navigation across multiple monitors but does not provide window
+-- colouring while retaining the unintuitive navigational semantics of
+-- X.L.WindowNavigation.  This makes it very difficult to predict which window
+-- receives the focus next.  Neither X.A.WindowNavigation nor
+-- X.L.WindowNavigation supports directional navigation of screens.
+
+-- $technical
+-- #Technical_Discussion#
+-- An in-depth discussion of the navigational strategies implemented in
+-- Navigation2D, including formal proofs of their properties, can be found
+-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.
+
+-- $incompatibilities
+-- #Incompatibilities#
+-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
+-- it should work well with any other tiled layout.  My hope is to address the
+-- incompatibility with tabbed layouts in a future version.  The navigation to
+-- unmapped windows, for example in a Full layout, by assigning rectangles to
+-- unmapped windows is more a workaround than a clean solution.  Figuring out
+-- how to deal with tabbed layouts may also lead to a more general and cleaner
+-- solution to query the layout for a window's rectangle that may make this
+-- workaround unnecessary.  At that point, the 'unmappedWindowRect' field of the
+-- 'Navigation2DConfig' will disappear.
+
+-- | A rectangle paired with an object
+type Rect a = (a, Rectangle)
+
+-- | A shorthand for window-rectangle pairs.  Reduces typing.
+type WinRect = Rect Window
+
+-- | A shorthand for workspace-rectangle pairs.  Reduces typing.
+type WSRect = Rect WorkspaceId
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                        PUBLIC INTERFACE                                        --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Encapsulates the navigation strategy
+data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
+
+runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
+runNav (N _ nav) = nav
+
+-- | Score that indicates how general a navigation strategy is
+type Generality = Int
+
+instance Eq Navigation2D where
+  (N x _) == (N y _) = x == y
+
+instance Ord Navigation2D where
+  (N x _) <= (N y _) = x <= y
+
+-- | Line navigation.  To illustrate this navigation strategy, consider
+-- navigating to the left from the current window.  In this case, we draw a
+-- horizontal line through the center of the current window and consider all
+-- windows that intersect this horizontal line and whose right boundaries are to
+-- the left of the left boundary of the current window.  From among these
+-- windows, we choose the one with the rightmost right boundary.
+lineNavigation :: Navigation2D
+lineNavigation = N 1 doLineNavigation
+
+-- | Center navigation.  Again, consider navigating to the left.  Then we
+-- consider the cone bounded by the two rays shot at 45-degree angles in
+-- north-west and south-west direction from the center of the current window.  A
+-- window is a candidate to receive the focus if its center lies in this cone.
+-- We choose the window whose center has minimum L1-distance from the current
+-- window center.  The tie breaking strategy for windows with the same distance
+-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
+-- windows can be reached and that windows with the same center are traversed in
+-- their order in the window stack, that is, in the order
+-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
+-- them.
+centerNavigation :: Navigation2D
+centerNavigation = N 2 doCenterNavigation
+
+-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
+-- navigation if it does not find any suitable target windows. This is useful since
+-- Line navigation tends to fail on gaps, but provides more intuitive motions
+-- when it succeeds—provided there are no floating windows.
+hybridNavigation :: Navigation2D
+hybridNavigation = N 2 doHybridNavigation
+
+-- | Stores the configuration of directional navigation. The 'Default' instance
+-- uses line navigation for the tiled layer and for navigation between screens,
+-- and center navigation for the float layer.  No custom navigation strategies
+-- or rectangles for unmapped windows are defined for individual layouts.
+data Navigation2DConfig = Navigation2DConfig
+  { defaultTiledNavigation :: Navigation2D             -- ^ default navigation strategy for the tiled layer
+  , floatNavigation        :: Navigation2D             -- ^ navigation strategy for the float layer
+  , screenNavigation       :: Navigation2D             -- ^ strategy for navigation between screens
+  , layoutNavigation       :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
+                                                       -- for different layouts in the tiled layer.  Each pair
+                                                       -- is of the form (\"layout description\", navigation
+                                                       -- strategy).  If there is no pair in this list whose first
+                                                       -- component is the name of the current layout, the
+                                                       -- 'defaultTiledNavigation' strategy is used.
+  , unmappedWindowRect     :: [(String, Screen -> Window -> X (Maybe Rectangle))]
+                                                       -- ^ list associating functions to calculate rectangles
+                                                       -- for unmapped windows with layouts to which they are
+                                                       -- to be applied.  Each pair in this list is of
+                                                       -- the form (\"layout description\", function), where the
+                                                       -- function calculates a rectangle for a given unmapped
+                                                       -- window from the screen it is on and its window ID.
+                                                       -- See <#Finer_Points> for how to use this.
+  } deriving Typeable
+
+-- | Shorthand for the tedious screen type
+type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
+
+-- | Convenience function for enabling Navigation2D with typical keybindings.
+-- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from
+-- modifier key to action, and a bool to indicate if wrapping should occur, and
+-- returns a function from XConfig to XConfig.
+-- Example:
+--
+-- >  navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
+navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
+                Bool -> XConfig l -> XConfig l
+navigation2D navConfig (u, l, d, r) modifiers wrap xconfig =
+  additionalNav2DKeys (u, l, d, r) modifiers wrap $
+  withNavigation2DConfig navConfig xconfig
+
+-- | Convenience function for enabling Navigation2D with typical keybindings,
+-- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a
+-- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key
+-- prefix to action, and a bool to indicate if wrapping should occur, and
+-- returns a function from XConfig to XConfig. Example:
+--
+-- >  navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
+navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
+                 Bool -> XConfig l -> XConfig l
+navigation2DP navConfig (u, l, d, r) modifiers wrap xconfig =
+  additionalNav2DKeysP (u, l, d, r) modifiers wrap $
+  withNavigation2DConfig navConfig xconfig
+
+-- | Convenience function for adding keybindings. Takes an (up, left, down,
+-- right) tuple, a mapping from key prefix to action, and a bool to indicate if
+-- wrapping should occur, and returns a function from XConfig to XConfig.
+-- Example:
+--
+-- >  additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
+additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
+                       Bool -> XConfig l -> XConfig l
+additionalNav2DKeys (u, l, d, r) modifiers wrap =
+  flip additionalKeys [((modif, k), func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
+  where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
+
+-- | Convenience function for adding keybindings, using the syntax defined in
+-- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a
+-- mapping from key prefix to action, and a bool to indicate if wrapping should
+-- occur, and returns a function from XConfig to XConfig. Example:
+--
+-- >  additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
+additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
+                        Bool -> XConfig l -> XConfig l
+additionalNav2DKeysP (u, l, d, r) modifiers wrap =
+  flip additionalKeysP [(modif ++ k, func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
+  where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
+
+-- So we can store the configuration in extensible state
+instance ExtensionClass Navigation2DConfig where
+  initialValue = def
+
+-- | Modifies the xmonad configuration to store the Navigation2D configuration
+withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
+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
+                                               , screenNavigation       = lineNavigation
+                                               , layoutNavigation       = []
+                                               , unmappedWindowRect     = []
+                                               }
+
+-- | Switches focus to the closest window in the other layer (floating if the
+-- current window is tiled, tiled if the current window is floating).  Closest
+-- means that the L1-distance between the centers of the windows is minimized.
+switchLayer :: X ()
+switchLayer = actOnLayer otherLayer
+                         ( \ _ cur wins -> windows
+                           $ doFocusClosestWindow cur wins
+                         )
+                         ( \ _ cur wins -> windows
+                           $ doFocusClosestWindow cur wins
+                         )
+                         ( \ _ _ _ -> return () )
+                         False
+
+-- | Moves the focus to the next window in the given direction and in the same
+-- layer as the current window.  The second argument indicates whether
+-- navigation should wrap around (e.g., from the left edge of the leftmost
+-- screen to the right edge of the rightmost screen).
+windowGo :: Direction2D -> Bool -> X ()
+windowGo dir wrap = actOnLayer thisLayer
+                               ( \ conf cur wins -> windows
+                                 $ doTiledNavigation conf dir W.focusWindow cur wins
+                               )
+                               ( \ conf cur wins -> windows
+                                 $ doFloatNavigation conf dir W.focusWindow cur wins
+                               )
+                               ( \ conf cur wspcs -> windows
+                                 $ doScreenNavigation conf dir W.view cur wspcs
+                               )
+                               wrap
+
+-- | Swaps the current window with the next window in the given direction and in
+-- the same layer as the current window.  (In the floating layer, all that
+-- changes for the two windows is their stacking order if they're on the same
+-- screen.  If they're on different screens, each window is moved to the other
+-- window's screen but retains its position and size relative to the screen.)
+-- The second argument indicates wrapping (see 'windowGo').
+windowSwap :: Direction2D -> Bool -> X ()
+windowSwap dir wrap = actOnLayer thisLayer
+                                 ( \ conf cur wins -> windows
+                                   $ doTiledNavigation conf dir swap cur wins
+                                 )
+                                 ( \ conf cur wins -> windows
+                                   $ doFloatNavigation conf dir swap cur wins
+                                 )
+                                 ( \ _ _ _ -> return () )
+                                 wrap
+
+-- | Moves the current window to the next screen in the given direction.  The
+-- second argument indicates wrapping (see 'windowGo').
+windowToScreen :: Direction2D -> Bool -> X ()
+windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                         $ doScreenNavigation conf dir W.shift cur wspcs
+                                       )
+                                       wrap
+
+-- | Moves the focus to the next screen in the given direction.  The second
+-- argument indicates wrapping (see 'windowGo').
+screenGo :: Direction2D -> Bool -> X ()
+screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                   $ doScreenNavigation conf dir W.view cur wspcs
+                                 )
+                                 wrap
+
+-- | Swaps the workspace on the current screen with the workspace on the screen
+-- in the given direction.  The second argument indicates wrapping (see
+-- 'windowGo').
+screenSwap :: Direction2D -> Bool -> X ()
+screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
+                                     $ doScreenNavigation conf dir W.greedyView cur wspcs
+                                   )
+                                   wrap
+
+-- | Maps each window to a fullscreen rect.  This may not be the same rectangle the
+-- window maps to under the Full layout or a similar layout if the layout
+-- respects statusbar struts.  In such cases, it may be better to use
+-- 'singleWindowRect'.
+fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
+fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)
+
+-- | Maps each window to the rectangle it would receive if it was the only
+-- window in the layout.  Useful, for example, for determining the default
+-- rectangle for unmapped windows in a Full layout that respects statusbar
+-- struts.
+singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
+singleWindowRect scr win  =  listToMaybe
+                          .  map snd
+                          .  fst
+                         <$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })
+                                       (screenRect . W.screenDetail $ scr)
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                       PRIVATE X ACTIONS                                        --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Acts on the appropriate layer using the given action functions
+actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect])                -- ^ Chooses which layer to operate on, relative
+                                                                   -- to the current window (same or other layer)
+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
+           -> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
+           -> (Navigation2DConfig -> WSRect  -> [WSRect]  -> X ()) -- ^ The action if the current workspace is empty
+           -> Bool                                                 -- ^ Should navigation wrap around screen edges?
+           -> X ()
+actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do
+  conf <- XS.get
+  (floating, tiled) <- navigableWindows conf wrap winset
+  let cur = W.peek winset
+  case cur of
+    Nothing                                   -> actOnScreens wsact wrap
+    Just w | Just rect <- L.lookup w tiled    -> tiledact conf (w, rect) (choice tiled floating)
+           | Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)
+           | otherwise                        -> return ()
+
+-- | Returns the list of windows on the currently visible workspaces
+navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
+navigableWindows conf wrap winset  =  L.partition (\(win, _) -> M.member win (W.floating winset))
+                                   .  addWrapping winset wrap
+                                   .  catMaybes
+                                   .  concat
+                                  <$>
+                                   (  mapM ( \scr -> mapM (maybeWinRect scr)
+                                                   $ W.integrate'
+                                                   $ W.stack
+                                                   $ W.workspace scr
+                                           )
+                                   .  sortedScreens
+                                   )  winset
+  where
+    maybeWinRect scr win = do
+      winrect <- windowRect win
+      rect <- case winrect of
+                Just _  -> return winrect
+                Nothing -> maybe (return Nothing)
+                                 (\f -> f scr win)
+                                 (L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))
+      return ((,) win <$> rect)
+
+-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
+windowRect :: Window -> X (Maybe Rectangle)
+windowRect win = withDisplay $ \dpy -> do
+  mp <- isMapped win
+  if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
+                return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
+                `catchX` return Nothing
+        else return Nothing
+
+-- | Acts on the screens using the given action function
+actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
+             -> Bool  -- ^ Should wrapping be used?
+             -> X ()
+actOnScreens act wrap = withWindowSet $ \winset -> do
+  conf <- XS.get
+  let wsrects = visibleWorkspaces winset wrap
+      cur     = W.tag . W.workspace . W.current $ winset
+      rect    = fromJust $ L.lookup cur wsrects
+  act conf (cur, rect) wsrects
+
+-- | Determines whether a given window is mapped
+isMapped :: Window -> X Bool
+isMapped win  =  withDisplay
+              $  \dpy -> io
+              $  (waIsUnmapped /=)
+              .  wa_map_state
+             <$> getWindowAttributes dpy win
+
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+--                                                                                                --
+--                                     PRIVATE PURE FUNCTIONS                                     --
+--                                                                                                --
+----------------------------------------------------------------------------------------------------
+----------------------------------------------------------------------------------------------------
+
+-- | Finds the window closest to the given window and focuses it. Ties are
+-- broken by choosing the first window in the window stack among the tied
+-- windows.  (The stack order is the one produced by integrate'ing each visible
+-- workspace's window stack and concatenating these lists for all visible
+-- workspaces.)
+doFocusClosestWindow :: WinRect
+                     -> [WinRect]
+                     -> (WindowSet -> WindowSet)
+doFocusClosestWindow (cur, rect) winrects
+  | null winctrs = id
+  | otherwise    = W.focusWindow . fst $ L.foldl1' closer winctrs
+  where
+    ctr     = centerOf rect
+    winctrs = filter ((cur /=) . fst)
+            $ map (\(w, r) -> (w, centerOf r)) winrects
+    closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
+                                   | otherwise                   = wc1
+
+-- | Implements navigation for the tiled layer
+doTiledNavigation :: Navigation2DConfig
+                  -> Direction2D
+                  -> (Window -> WindowSet -> WindowSet)
+                  -> WinRect
+                  -> [WinRect]
+                  -> (WindowSet -> WindowSet)
+doTiledNavigation conf dir act cur winrects winset
+  | Just win <- runNav nav dir cur winrects = act win winset
+  | otherwise                               = winset
+  where
+    layouts = map (description . W.layout . W.workspace)
+            $ W.screens winset
+    nav     = maximum
+            $ map ( fromMaybe (defaultTiledNavigation conf)
+                  . flip L.lookup (layoutNavigation conf)
+                  )
+            $ layouts
+
+-- | Implements navigation for the float layer
+doFloatNavigation :: Navigation2DConfig
+                  -> Direction2D
+                  -> (Window -> WindowSet -> WindowSet)
+                  -> WinRect
+                  -> [WinRect]
+                  -> (WindowSet -> WindowSet)
+doFloatNavigation conf dir act cur winrects
+  | Just win <- runNav nav dir cur winrects = act win
+  | otherwise                               = id
+  where
+    nav = floatNavigation conf
+
+-- | Implements navigation between screens
+doScreenNavigation :: Navigation2DConfig
+                   -> Direction2D
+                   -> (WorkspaceId -> WindowSet -> WindowSet)
+                   -> WSRect
+                   -> [WSRect]
+                   -> (WindowSet -> WindowSet)
+doScreenNavigation conf dir act cur wsrects
+  | Just ws <- runNav nav dir cur wsrects = act ws
+  | otherwise                             = id
+  where
+    nav = screenNavigation conf
+
+-- | Implements line navigation.  For layouts without overlapping windows, there
+-- is no need to break ties between equidistant windows.  When windows do
+-- overlap, even the best tie breaking rule cannot make line navigation feel
+-- natural.  Thus, we fairly arbtitrarily break ties by preferring the window
+-- that comes first in the window stack.  (The stack order is the one produced
+-- by integrate'ing each visible workspace's window stack and concatenating
+-- these lists for all visible workspaces.)
+doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+doLineNavigation dir (cur, rect) winrects
+  | null winrects' = Nothing
+  | otherwise      = Just . fst $ L.foldl1' closer winrects'
+  where
+    -- The current window's center
+    ctr@(xc, yc)  = centerOf rect
+
+    -- The list of windows that are candidates to receive focus.
+    winrects'     = filter dirFilter
+                  $ filter ((cur /=) . fst)
+                  $ winrects
+
+    -- Decides whether a given window matches the criteria to be a candidate to
+    -- receive the focus.
+    dirFilter (_, r) =  (dir == L && leftOf r rect && intersectsY yc r)
+                     || (dir == R && leftOf rect r && intersectsY yc r)
+                     || (dir == U && above  r rect && intersectsX xc r)
+                     || (dir == D && above  rect r && intersectsX xc r)
+
+    -- Decide whether r1 is left of/above r2.
+    leftOf r1 r2 = rect_x r1 + fi (rect_width  r1) <= rect_x r2
+    above  r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2
+
+    -- Check whether r's x-/y-range contains the given x-/y-coordinate.
+    intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width  r) >= x
+    intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y
+
+    -- Decides whether r1 is closer to the current window's center than r2
+    closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2
+                                   | otherwise                 = wr1
+
+    -- Returns the distance of r from the point (x, y)
+    dist (x, y) r | dir == L  = x - rect_x r - fi (rect_width r)
+                  | dir == R  = rect_x r - x
+                  | dir == U  = y - rect_y r - fi (rect_height r)
+                  | otherwise = rect_y r - y
+
+-- | Implements center navigation
+doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+doCenterNavigation dir (cur, rect) winrects
+  | ((w, _):_) <- onCtr' = Just w
+  | otherwise            = closestOffCtr
+  where
+    -- The center of the current window
+    (xc, yc) = centerOf rect
+
+    -- All the windows with their center points relative to the current
+    -- center rotated so the right cone becomes the relevant cone.
+    -- The windows are ordered in the order they should be preferred
+    -- when they are otherwise tied.
+    winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
+            $ stackTransform
+            $ winrects
+
+    -- Give preference to windows later in the stack for going left or up and to
+    -- windows earlier in the stack for going right or down.  (The stack order
+    -- is the one produced by integrate'ing each visible workspace's window
+    -- stack and concatenating these lists for all visible workspaces.)
+    stackTransform | dir == L || dir == U = reverse
+                   | otherwise            = id
+
+    -- Transform a point into a difference to the current window center and
+    -- rotate it so that the relevant cone becomes the right cone.
+    dirTransform (x, y) | dir == R  = (  x - xc ,   y - yc )
+                        | dir == L  = (-(x - xc), -(y - yc))
+                        | dir == D  = (  y - yc ,   x - xc )
+                        | otherwise = (-(y - yc), -(x - xc))
+
+    -- Partition the points into points that coincide with the center
+    -- and points that do not.
+    (onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs
+
+    -- All the points that coincide with the current center and succeed it
+    -- in the (appropriately ordered) window stack.
+    onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
+             -- tail should be safe here because cur should be in onCtr
+
+    -- All the points that do not coincide with the current center and which
+    -- lie in the (rotated) right cone.
+    offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr
+
+    -- The off-center point closest to the center and
+    -- closest to the bottom ray of the cone.  Nothing if no off-center
+    -- point is in the cone
+    closestOffCtr = if null offCtr' then Nothing
+                                    else Just $ fst $ L.foldl1' closest offCtr'
+
+    closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))
+      | lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p
+      | lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p
+      | yq < yp                         = wq -- q is closer to the bottom ray than p
+      | otherwise                       = wp -- q is farther away from the bottom ray than p
+                                             -- or it has the same distance but comes later
+                                             -- in the window stack
+
+-- | Implements Hybrid navigation. This attempts Line navigation first,
+-- then falls back on Center navigation if it finds no suitable target window.
+doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
+doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
+    where
+        applyToBoth f g h a b c = f (g a b c) (h a b c)
+
+-- | Swaps the current window with the window given as argument
+swap :: Window -> WindowSet -> WindowSet
+swap win winset = W.focusWindow cur
+                $ L.foldl' (flip W.focusWindow) newwinset newfocused
+  where
+    -- The current window
+    cur      = fromJust $ W.peek winset
+
+    -- All screens
+    scrs     = W.screens winset
+
+    -- All visible workspaces
+    visws    = map W.workspace scrs
+
+    -- The focused windows of the visible workspaces
+    focused  = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
+
+    -- The window lists of the visible workspaces
+    wins     = map (W.integrate' . W.stack) visws
+
+    -- Update focused windows and window lists to reflect swap of windows.
+    newfocused = map swapWins focused
+    newwins    = map (map swapWins) wins
+
+    -- Replaces the current window with the argument window and vice versa.
+    swapWins x | x == cur  = win
+               | x == win  = cur
+               | otherwise = x
+
+    -- Reconstruct the workspaces' window stacks to reflect the swap.
+    newvisws  = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
+    newscrs   = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
+    newwinset = winset { W.current = head newscrs
+                       , W.visible = tail newscrs
+                       }
+
+-- | Calculates the center of a rectangle
+centerOf :: Rectangle -> (Position, Position)
+centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
+
+-- | Shorthand for integer conversions
+fi :: (Integral a, Num b) => a -> b
+fi = fromIntegral
+
+-- | Functions to choose the subset of windows to operate on
+thisLayer, otherLayer :: a -> a -> a
+thisLayer  = curry fst
+otherLayer = curry snd
+
+-- | Returns the list of visible workspaces and their screen rects
+visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
+visibleWorkspaces winset wrap = addWrapping winset wrap
+                              $ map ( \scr -> ( W.tag . W.workspace         $ scr
+                                              , screenRect . W.screenDetail $ scr
+                                              )
+                                    )
+                              $ sortedScreens winset
+
+-- | Creates five copies of each (window/workspace, rect) pair in the input: the
+-- original and four offset one desktop size (desktop = collection of all
+-- screens) to the left, to the right, up, and down.  Wrap-around at desktop
+-- edges is implemented by navigating into these displaced copies.
+addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
+            -> Bool      -- ^ Should wrapping be used?  Do nothing if not.
+            -> [Rect a]  -- ^ Input set of (window/workspace, rect) pairs
+            -> [Rect a]
+addWrapping _      False wrects = wrects
+addWrapping winset True  wrects = [ (w, r { rect_x = rect_x r + fi x
+                                          , rect_y = rect_y r + fi y
+                                          }
+                                    )
+                                  | (w, r) <- wrects
+                                  , (x, y)  <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]
+                                  ]
+  where
+    (xoff, yoff) = wrapOffsets winset
+
+-- | Calculates the offsets for window/screen coordinates for the duplication
+-- of windows/workspaces that implements wrap-around.
+wrapOffsets :: WindowSet -> (Integer, Integer)
+wrapOffsets winset = (max_x - min_x, max_y - min_y)
+  where
+    min_x = fi $ minimum $ map rect_x rects
+    min_y = fi $ minimum $ map rect_y rects
+    max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width  r)) rects
+    max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
+    rects = map snd $ visibleWorkspaces winset False
+
+
+-- | Returns the list of screens sorted primarily by their centers'
+-- x-coordinates and secondarily by their y-coordinates.
+sortedScreens :: WindowSet -> [Screen]
+sortedScreens winset = L.sortBy cmp
+                     $ W.screens winset
+  where
+    cmp s1 s2 | x1 < x2   = LT
+              | x1 > x2   = GT
+              | y1 < x2   = LT
+              | y1 > y2   = GT
+              | otherwise = EQ
+      where
+        (x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
+        (x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
+
+
+-- | Calculates the L1-distance between two points.
+lDist :: (Position, Position) -> (Position, Position) -> Int
+lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)

XMonad/Actions/OnScreen.hs

@@ -26,7 +26,6 @@ module XMonad.Actions.OnScreen (
     ) where
 
 import XMonad
-import XMonad.Core
 import XMonad.StackSet hiding (new)
 
 import Control.Monad (guard)
@@ -181,7 +180,7 @@ toggleOrView' f i st = fromMaybe (f i st) $ do
 --
 -- A more basic version inside the default keybindings would be:
 --
--- >        , ((modm .|. controlMask, xK_1) windows (viewOnScreen 0 "1"))
+-- >        , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1"))
 --
 -- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
 --

XMonad/Actions/PhysicalScreens.hs

@@ -19,15 +19,14 @@ module XMonad.Actions.PhysicalScreens (
                                       , getScreen
                                       , viewScreen
                                       , sendToScreen
+                                      , onNextNeighbour
+                                      , onPrevNeighbour
                                       ) where
 
 import XMonad
 import qualified XMonad.StackSet as W
 
-import qualified Graphics.X11.Xlib as X
-import Graphics.X11.Xinerama
-
-import Data.List (sortBy)
+import Data.List (sortBy,findIndex)
 import Data.Function (on)
 
 {- $usage
@@ -42,7 +41,12 @@ and then left-to-right.
 
 Example usage in your @~\/.xmonad\/xmonad.hs@ file:
 
-> import XMonad.Actions.PhysicalSCreens
+> import XMonad.Actions.PhysicalScreens
+
+> , ((modMask, xK_a), onPrevNeighbour W.view)
+> , ((modMask, xK_o), onNextNeighbour W.view)
+> , ((modMask .|. shiftMask, xK_a), onPrevNeighbour W.shift)
+> , ((modMask .|. shiftMask, xK_o), onNextNeighbour W.shift)
 
 > --
 > -- mod-{w,e,r}, Switch to physical/Xinerama screens 1, 2, or 3
@@ -61,12 +65,12 @@ newtype PhysicalScreen = P Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real
 
 -- | Translate a physical screen index to a "ScreenId"
 getScreen :: PhysicalScreen -> X (Maybe ScreenId)
-getScreen (P i) = withDisplay $ \dpy -> do
-                    screens <- io $ getScreenInfo dpy
-                    if i >= length screens
-                     then return Nothing
-                     else let ss = sortBy (cmpScreen `on` fst) $ zip screens [0..]
-                          in return $ Just $ snd $ ss !! i
+getScreen (P i) = do w <- gets windowset
+                     let screens = W.current w : W.visible w
+                     if i<0 || i >= length screens
+                      then return Nothing
+                      else let ss = sortBy (cmpScreen `on` (screenRect . W.screenDetail)) screens
+                           in return $ Just $ W.screen $ ss !! i
 
 -- | Switch to a given physical screen
 viewScreen :: PhysicalScreen -> X ()
@@ -85,4 +89,26 @@ sendToScreen p = do i <- getScreen p
 -- | Compare two screens by their top-left corners, ordering
 -- | top-to-bottom and then left-to-right.
 cmpScreen :: Rectangle -> Rectangle -> Ordering
-cmpScreen  (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+cmpScreen (Rectangle x1 y1 _ _) (Rectangle x2 y2 _ _) = compare (y1,x1) (y2,x2)
+
+
+-- | Get ScreenId for neighbours of the current screen based on position offset.
+getNeighbour :: Int -> X ScreenId
+getNeighbour d = do w <- gets windowset
+                    let ss = map W.screen $ sortBy (cmpScreen `on` (screenRect . W.screenDetail)) $ W.current w : W.visible w
+                        curPos = maybe 0 id $ findIndex (== W.screen (W.current w)) ss
+                        pos = (curPos + d) `mod` length ss
+                    return $ ss !! pos
+
+neighbourWindows :: Int -> (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+neighbourWindows d f = do s <- getNeighbour d
+                          w <- screenWorkspace s
+                          whenJust w $ windows . f
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the next screen in the physical order as parameter.
+onNextNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onNextNeighbour = neighbourWindows 1
+
+-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
+onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+onPrevNeighbour = neighbourWindows (-1)

XMonad/Actions/Plane.hs

@@ -51,12 +51,13 @@ import XMonad.Util.Run
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
 --
 -- > import XMonad.Actions.Plane
+-- > import Data.Map (union)
 -- >
--- > main = xmonad defaultConfig {keys = myKeys}
+-- > main = xmonad def {keys = myKeys}
 -- >
--- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf
+-- > myKeys conf = union (keys def conf) $ myNewKeys conf
 -- >
--- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
+-- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
 --
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
@@ -110,7 +111,7 @@ plane ::
     (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
     X ()
 plane function numberLines_ limits direction = do
-    state <- get
+    st <- get
     xconf <- ask
 
     numberLines <-
@@ -205,7 +206,7 @@ plane function numberLines_ limits direction = do
         preColumns = div areas numberLines
 
         mCurrentWS :: Maybe Int
-        mCurrentWS = elemIndex (currentTag $ windowset state) areaNames
+        mCurrentWS = elemIndex (currentTag $ windowset st) areaNames
 
         areas :: Int
         areas = length areaNames
@@ -226,4 +227,4 @@ gconftool :: String
 gconftool = "gconftool-2"
 
 parameters :: [String]
-parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]
+parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]

XMonad/Actions/Search.hs

@@ -44,25 +44,36 @@ module XMonad.Actions.Search (   -- * Usage
                                  lucky,
                                  maps,
                                  mathworld,
+                                 openstreetmap,
                                  scholar,
+                                 stackage,
                                  thesaurus,
                                  wayback,
                                  wikipedia,
                                  wiktionary,
                                  youtube,
-                                 multi
+                                 vocabulary,
+                                 duckduckgo,
+                                 multi,
                                   -- * Use case: searching with a submap
                                   -- $tip
+
+                                  -- * Types
+                                 Browser, Site, Query, Name, Search
                           ) where
 
-import Data.Char (chr, ord, isAlpha, isMark, isDigit)
-import Data.List (isPrefixOf)
-import Numeric (showIntAtBase)
-import XMonad (X(), MonadIO, liftIO)
-import XMonad.Prompt (XPrompt(showXPrompt), mkXPrompt, XPConfig(), historyCompletionP)
-import XMonad.Prompt.Shell (getBrowser)
-import XMonad.Util.Run (safeSpawn)
-import XMonad.Util.XSelection (getSelection)
+import           Codec.Binary.UTF8.String (encode)
+import           Data.Char                (isAlphaNum, isAscii)
+import           Data.List                (isPrefixOf)
+import           Text.Printf
+import           XMonad                   (X (), liftIO)
+import           XMonad.Prompt            (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),
+                                           getNextCompletion,
+                                           historyCompletionP, mkXPrompt)
+import           XMonad.Prompt.Shell      (getBrowser)
+import           XMonad.Util.Run          (safeSpawn)
+import           XMonad.Util.XSelection   (getSelection)
+
 
 {- $usage
 
@@ -108,6 +119,8 @@ import XMonad.Util.XSelection (getSelection)
 
 * 'hoogle' -- Hoogle, the Haskell libraries API search engine.
 
+* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
+
 * 'images' -- Google images.
 
 * 'imdb'   -- the Internet Movie Database.
@@ -120,6 +133,8 @@ import XMonad.Util.XSelection (getSelection)
 
 * 'mathworld' -- Wolfram MathWorld search.
 
+* 'openstreetmap' -- OpenStreetMap free wiki world map.
+
 * 'scholar' -- Google scholar academic search.
 
 * 'thesaurus' -- thesaurus.reference.com search.
@@ -130,6 +145,10 @@ import XMonad.Util.XSelection (getSelection)
 
 * 'youtube' -- Youtube video search.
 
+* 'vocabulary' -- Dictionary search
+
+* 'duckduckgo' -- DuckDuckGo search engine.
+
 * 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.
 
 Feel free to add more! -}
@@ -149,7 +168,7 @@ Then add the following to your key bindings:
 
 > ...
 > -- Search commands
-> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig)
+> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def)
 > , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)
 >
 > ...
@@ -165,7 +184,7 @@ Or in combination with XMonad.Util.EZConfig:
 > ...
 > ] -- end of regular keybindings
 > -- Search commands
-> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ]
+> ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ]
 > ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ]
 >
 > ...
@@ -194,31 +213,18 @@ Happy searching! -}
 data Search = Search Name
 instance XPrompt Search where
     showXPrompt (Search name)= "Search [" ++ name ++ "]: "
+    nextCompletion _ = getNextCompletion
+    commandToComplete _ c = c
 
--- | Escape the search string so search engines understand it.
--- Note that everything is escaped; we could be smarter and use 'isAllowedInURI'
--- but then that'd be hard enough to copy-and-paste we'd need to depend on @network@.
+-- | Escape the search string so search engines understand it. Only
+-- digits and ASCII letters are not encoded. All non ASCII characters
+-- which are encoded as UTF8
 escape :: String -> String
-escape = escapeURIString (\c -> isAlpha c || isDigit c || isMark c)
-         where -- Copied from Network.URI.
-           escapeURIString ::
-               (Char -> Bool)      -- a predicate which returns 'False' if should escape
-               -> String           -- the string to process
-               -> String           -- the resulting URI string
-           escapeURIString = concatMap . escapeURIChar
-           escapeURIChar :: (Char->Bool) -> Char -> String
-           escapeURIChar p c
-               | p c       = [c]
-               | otherwise = '%' : myShowHex (ord c) ""
-               where
-                 myShowHex :: Int -> ShowS
-                 myShowHex n r =  case showIntAtBase 16 toChrHex n r of
-                                    []  -> "00"
-                                    [ch] -> ['0',ch]
-                                    cs  -> cs
-                 toChrHex d
-                   | d < 10    = chr (ord '0' + fromIntegral d)
-                   | otherwise = chr (ord 'A' + fromIntegral (d - 10))
+escape = concatMap escapeURIChar
+
+escapeURIChar :: Char -> String
+escapeURIChar c | isAscii c && isAlphaNum c = [c]
+                | otherwise                 = concatMap (printf "%%%02X") $ encode [c]
 
 type Browser      = FilePath
 type Query        = String
@@ -258,8 +264,8 @@ searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
    inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
 
 > searchFunc :: String -> String
-> searchFunc s | s `isPrefixOf` "wiki:"   = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
->              | s `isPrefixOf` "http://" = s
+> searchFunc s | "wiki:"   `isPrefixOf` s = "http://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
+>              | "http://" `isPrefixOf` s = s
 >              | otherwise               = (use google) s
 > myNewEngine = searchEngineF "mymulti" searchFunc
 
@@ -276,33 +282,37 @@ searchEngineF = SearchEngine
 
 -- The engines.
 amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
-  images, imdb, isohunt, lucky, maps, mathworld, scholar, thesaurus, wayback, wikipedia, wiktionary,
-  youtube :: SearchEngine
-amazon     = searchEngine "amazon"     "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
-alpha      = searchEngine "alpha"      "http://www.wolframalpha.com/input/?i="
-codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
-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/"
-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="
-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="
-lucky      = searchEngine "lucky"      "http://www.google.com/search?btnI&q="
-maps       = searchEngine "maps"       "http://maps.google.com/maps?q="
-mathworld  = searchEngine "mathworld"  "http://mathworld.wolfram.com/search/?query="
-scholar    = searchEngine "scholar"    "http://scholar.google.com/scholar?q="
-thesaurus  = searchEngine "thesaurus"  "http://thesaurus.reference.com/search?q="
-wikipedia  = searchEngine "wiki"       "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
-wiktionary = searchEngine "wikt"       "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
-youtube    = searchEngine "youtube"    "http://www.youtube.com/results?search_type=search_videos&search_query="
-wayback    = searchEngineF "wayback"   ("http://web.archive.org/web/*/"++)
+  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="
+alpha         = searchEngine "alpha"         "http://www.wolframalpha.com/input/?i="
+codesearch    = searchEngine "codesearch"    "http://www.google.com/codesearch?q="
+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/"
+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="
+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="
+lucky         = searchEngine "lucky"         "http://www.google.com/search?btnI&q="
+maps          = searchEngine "maps"          "http://maps.google.com/maps?q="
+mathworld     = searchEngine "mathworld"     "http://mathworld.wolfram.com/search/?query="
+openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
+scholar       = searchEngine "scholar"       "http://scholar.google.com/scholar?q="
+stackage      = searchEngine "stackage"      "www.stackage.org/lts/hoogle?q="
+thesaurus     = searchEngine "thesaurus"     "http://thesaurus.reference.com/search?q="
+wikipedia     = searchEngine "wiki"          "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
+wiktionary    = searchEngine "wikt"          "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
+youtube       = searchEngine "youtube"       "http://www.youtube.com/results?search_type=search_videos&search_query="
+wayback       = searchEngineF "wayback"      ("http://web.archive.org/web/*/"++)
+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, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
+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)]
 
 {- | 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
@@ -331,14 +341,14 @@ removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
   \"mathworld:integral\" will search mathworld, and everything else will fall back to
   google. The use of intelligent will make sure that URLs are opened directly. -}
 (!>) :: SearchEngine -> SearchEngine -> SearchEngine
-(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if s `isPrefixOf` (name1++":") then site1 (removeColonPrefix s) else site2 s)
+(SearchEngine name1 site1) !> (SearchEngine name2 site2) = searchEngineF (name1 ++ "/" ++ name2) (\s -> if (name1++":") `isPrefixOf` s then site1 (removeColonPrefix s) else site2 s)
 
 {- | Makes a search engine prefix-aware. Especially useful together with '!>'.
    It will automatically remove the prefix from a query so that you don\'t end
      up searching for google:xmonad if google is your fallback engine and you
      explicitly add the prefix. -}
 prefixAware :: SearchEngine -> SearchEngine
-prefixAware (SearchEngine name site) = SearchEngine name (\s -> if s `isPrefixOf` (name++":") then site $ removeColonPrefix s else site s)
+prefixAware (SearchEngine name site) = SearchEngine name (\s -> if (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s)
 
 {- | Changes search engine's name -}
 namedEngine :: Name -> SearchEngine -> SearchEngine

XMonad/Actions/ShowText.hs

@@ -0,0 +1,121 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.ShowText
+-- Copyright   :  (c) Mario Pastorelli (2012)
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  pastorelli.mario@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"
+-- which offers more features (currently)
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.ShowText
+    ( -- * Usage
+      -- $usage
+      def
+    , defaultSTConfig
+    , handleTimerEvent
+    , flashText
+    , ShowTextConfig(..)
+    ) where
+
+import Control.Monad (when)
+import Data.Map (Map,empty,insert,lookup)
+import Data.Monoid (mempty, All)
+import Prelude hiding (lookup)
+import XMonad
+import XMonad.StackSet (current,screen)
+import XMonad.Util.Font (Align(AlignCenter)
+                       , initXMF
+                       , releaseXMF
+                       , textExtentsXMF
+                       , textWidthXMF)
+import XMonad.Util.Timer (startTimer)
+import XMonad.Util.XUtils (createNewWindow
+                         , deleteWindow
+                         , fi
+                         , showWindow
+                         , paintAndWrite)
+import qualified XMonad.Util.ExtensibleState as ES
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.ShowText
+--
+-- Then add the event hook handler:
+--
+-- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
+--
+-- You can then use flashText in your keybindings:
+--
+-- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS)
+--
+
+-- | ShowText contains the map with timers as keys and created windows as values
+newtype ShowText = ShowText (Map Atom Window)
+    deriving (Read,Show,Typeable)
+
+instance ExtensionClass ShowText where
+    initialValue = ShowText empty
+
+-- | Utility to modify a ShowText
+modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
+modShowText f (ShowText m) = ShowText $ f m
+
+data ShowTextConfig =
+    STC { st_font :: String -- ^ Font name
+        , st_bg   :: String -- ^ Background color
+        , st_fg   :: String -- ^ Foreground color
+    }
+
+instance Default ShowTextConfig where
+  def =
+    STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
+        , st_bg   = "black"
+        , 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
+    (ShowText m) <- ES.get :: X ShowText
+    a <- io $ internAtom dis "XMONAD_TIMER" False
+    when (mtyp == a && length d >= 1)
+         (whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
+    mempty
+handleTimerEvent _ = mempty
+
+-- | Shows a window in the center of the screen with the given text
+flashText :: ShowTextConfig
+    -> Rational -- ^ number of seconds
+    -> String -- ^ text to display
+    -> X ()
+flashText c i s = do
+  f <- initXMF (st_font c)
+  d <- asks display
+  sc <- gets $ fi . screen . current . windowset
+  width <- textWidthXMF d f s
+  (as,ds) <- textExtentsXMF f s
+  let hight = as + ds
+      ht    = displayHeight d sc
+      wh    = displayWidth d sc
+      y     = (fi ht - hight + 2) `div` 2
+      x     = (fi wh - width + 2) `div` 2
+  w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight))
+                      Nothing "" True
+  showWindow w
+  paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) ""
+                (st_fg c) (st_bg c) [AlignCenter] [s]
+  releaseXMF f
+  io $ sync d False
+  t <- startTimer i
+  ES.modify $ modShowText (insert (fromIntegral t) w)

XMonad/Actions/SpawnOn.hs

@@ -20,6 +20,7 @@ module XMonad.Actions.SpawnOn (
     -- $usage
     Spawner,
     manageSpawn,
+    manageSpawnWithGC,
     spawnHere,
     spawnOn,
     spawnAndDo,
@@ -44,16 +45,16 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- >    import XMonad.Actions.SpawnOn
 --
 -- >    main = do
--- >      xmonad defaultConfig {
+-- >      xmonad def {
 -- >         ...
--- >         manageHook = manageSpawn <+> manageHook defaultConfig
+-- >         manageHook = manageSpawn <+> manageHook def
 -- >         ...
 -- >      }
 --
 -- To ensure that application appears on a workspace it was launched at, add keybindings like:
 --
 -- >  , ((mod1Mask,xK_o), spawnHere "urxvt")
--- >  , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig)
+-- >  , ((mod1Mask,xK_s), shellPromptHere def)
 --
 -- The module can also be used to apply other manage hooks to the window of
 -- the spawned application(e.g. float or resize it).
@@ -66,8 +67,6 @@ newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeab
 instance ExtensionClass Spawner where
     initialValue = Spawner []
 
-maxPids :: Int
-maxPids = 5
 
 -- | Get the current Spawner or create one if it doesn't exist.
 modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
@@ -76,20 +75,26 @@ modifySpawner f = XS.modify (Spawner . f . pidsRef)
 -- | Provides a manage hook to react on process spawned with
 -- 'spawnOn', 'spawnHere' etc.
 manageSpawn :: ManageHook
-manageSpawn = do
+manageSpawn = manageSpawnWithGC (return . take 20)
+
+manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
+        -- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@
+       -> ManageHook
+manageSpawnWithGC garbageCollect = do
     Spawner pids <- liftX XS.get
     mp <- pid
     case flip lookup pids =<< mp of
         Nothing -> idHook
         Just mh  -> do
-            whenJust mp $ \p ->
-                liftX . modifySpawner $ filter ((/= p) . fst)
+            whenJust mp $ \p -> liftX $ do
+                ps <- XS.gets pidsRef
+                XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
             mh
 
 mkPrompt :: (String -> X ()) -> XPConfig -> X ()
 mkPrompt cb c = do
     cmds <- io $ getCommands
-    mkXPrompt Shell c (getShellCompl cmds) cb
+    mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
 
 -- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
 -- application on current workspace.
@@ -115,7 +120,7 @@ spawnOn ws cmd = spawnAndDo (doShift ws) cmd
 spawnAndDo :: ManageHook -> String -> X ()
 spawnAndDo mh cmd = do
     p <- spawnPID $ mangle cmd
-    modifySpawner $ (take maxPids . ((p,mh) :))
+    modifySpawner $ ((p,mh) :)
  where
     -- TODO this is silly, search for a better solution
     mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs

XMonad/Actions/Submap.hs

@@ -16,9 +16,11 @@ module XMonad.Actions.Submap (
                              -- * Usage
                              -- $usage
                              submap,
-                             submapDefault
+                             submapDefault,
+                             submapDefaultWithKey
                             ) where
 import Data.Bits
+import Data.Maybe (fromMaybe)
 import XMonad hiding (keys)
 import qualified Data.Map as M
 import Control.Monad.Fix (fix)
@@ -58,24 +60,38 @@ For detailed instructions on editing your key bindings, see
 --   corresponding action, or does nothing if the key is not found in
 --   the map.
 submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
-submap keys = submapDefault (return ()) keys
+submap = submapDefault (return ())
 
 -- | Like 'submap', but executes a default action if the key did not match.
 submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
-submapDefault def keys = do
+submapDefault = submapDefaultWithKey . const
+
+-- | Like 'submapDefault', but sends the unmatched key to the default
+-- action as argument.
+submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())
+                     -> M.Map (KeyMask, KeySym) (X ())
+                     -> X ()
+submapDefaultWithKey defAction keys = do
     XConf { theRoot = root, display = d } <- ask
 
     io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+    io $ grabPointer d root False buttonPressMask grabModeAsync grabModeAsync
+                     none none currentTime
 
     (m, s) <- io $ allocaXEvent $ \p -> fix $ \nextkey -> do
-        maskEvent d keyPressMask p
-        KeyEvent { ev_keycode = code, ev_state = m } <- getEvent p
-        keysym <- keycodeToKeysym d code 0
-        if isModifierKey keysym
-            then nextkey
-            else return (m, keysym)
+        maskEvent d (keyPressMask .|. buttonPressMask) p
+        ev <- getEvent p
+        case ev of
+          KeyEvent { ev_keycode = code, ev_state = m } -> do
+            keysym <- keycodeToKeysym d code 0
+            if isModifierKey keysym
+                then nextkey
+                else return (m, keysym)
+          _ -> return (0, 0)
     -- Remove num lock mask and Xkb group state bits
     m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
-    maybe def id (M.lookup (m', s) keys)
 
+    io $ ungrabPointer d currentTime
     io $ ungrabKeyboard d currentTime
+
+    fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)

XMonad/Actions/SwapWorkspaces.hs

@@ -25,7 +25,6 @@ module XMonad.Actions.SwapWorkspaces (
 import XMonad (windows, X())
 import XMonad.StackSet
 import XMonad.Actions.CycleWS
-import XMonad.Util.Types
 import XMonad.Util.WorkspaceCompare
 
 

XMonad/Actions/TagWindows.hs

@@ -22,17 +22,22 @@ module XMonad.Actions.TagWindows (
                  focusDownTagged, focusDownTaggedGlobal,
                  shiftHere, shiftToScreen,
                  tagPrompt,
-                 tagDelPrompt
+                 tagDelPrompt,
+                 TagPrompt,
                  ) where
 
-import Data.List (nub,concat,sortBy)
+import Data.List (nub,sortBy)
 import Control.Monad
+import Control.Exception as E
 
 import XMonad.StackSet hiding (filter)
 
 import XMonad.Prompt
 import XMonad hiding (workspaces)
 
+econst :: Monad m => a -> IOException -> m a
+econst = const . return
+
 -- $usage
 --
 -- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
@@ -48,12 +53,12 @@ import XMonad hiding (workspaces)
 -- >   , ((modm,                 xK_d  ), withTaggedP "abc" (W.shiftWin "2"))
 -- >   , ((modm .|. shiftMask,   xK_d  ), withTaggedGlobalP "abc" shiftHere)
 -- >   , ((modm .|. controlMask, xK_d  ), focusUpTaggedGlobal "abc")
--- >   , ((modm,                 xK_g  ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))
--- >   , ((modm .|. controlMask, xK_g  ), tagDelPrompt defaultXPConfig)
--- >   , ((modm .|. shiftMask,   xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
--- >   , ((modWinMask,                xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2")))
--- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
--- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s))
+-- >   , ((modm,                 xK_g  ), tagPrompt def (\s -> withFocused (addTag s)))
+-- >   , ((modm .|. controlMask, xK_g  ), tagDelPrompt def)
+-- >   , ((modm .|. shiftMask,   xK_g  ), tagPrompt def (\s -> withTaggedGlobal s float))
+-- >   , ((modWinMask,                xK_g  ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2")))
+-- >   , ((modWinMask .|. shiftMask,  xK_g  ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere))
+-- >   , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s))
 --
 -- NOTE: Tags are saved as space separated strings and split with
 --       'unwords'. Thus if you add a tag \"a b\" the window will have
@@ -76,10 +81,10 @@ setTag s w = withDisplay $ \d ->
 --   reads from the \"_XMONAD_TAGS\" window property
 getTags :: Window -> X [String]
 getTags w = withDisplay $ \d ->
-    io $ catch (internAtom d "_XMONAD_TAGS" False >>=
+    io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
                 getTextProperty d w >>=
                 wcTextPropertyToTextList d)
-               (\_ -> return [[]])
+               (econst [[]])
     >>= return . words . unwords
 
 -- | check a window for the given tag

XMonad/Actions/TopicSpace.hs

@@ -22,9 +22,11 @@ module XMonad.Actions.TopicSpace
    Topic
   , Dir
   , TopicConfig(..)
+  , def
   , defaultTopicConfig
   , getLastFocusedTopics
   , setLastFocusedTopic
+  , reverseLastFocusedTopics
   , pprWindowSet
   , topicActionWithPrompt
   , topicAction
@@ -41,13 +43,12 @@ where
 import XMonad
 
 import Data.List
-import Data.Maybe (fromMaybe, isNothing, listToMaybe)
+import Data.Maybe (fromMaybe, isNothing, listToMaybe, fromJust)
 import Data.Ord
 import qualified Data.Map as M
-import Control.Monad ((=<<),liftM2,when,unless,replicateM_)
+import Control.Monad (liftM2,when,unless,replicateM_)
 import System.IO
 
-import XMonad.Operations
 import qualified XMonad.StackSet as W
 
 import XMonad.Prompt
@@ -89,7 +90,7 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- >   ]
 -- >
 -- > myTopicConfig :: TopicConfig
--- > myTopicConfig = defaultTopicConfig
+-- > myTopicConfig = def
 -- >   { topicDirs = M.fromList $
 -- >       [ ("conf", "w/conf")
 -- >       , ("dashboard", "Desktop")
@@ -161,7 +162,7 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- > myConfig = do
 -- >     checkTopicConfig myTopics myTopicConfig
 -- >     myLogHook <- makeMyLogHook
--- >     return $ defaultConfig
+-- >     return $ def
 -- >          { borderWidth = 1 -- Width of the window border in pixels.
 -- >          , workspaces = myTopics
 -- >          , layoutHook = myModifiers myLayout
@@ -206,14 +207,18 @@ data TopicConfig = TopicConfig { topicDirs          :: M.Map Topic Dir
                                  -- numeric keypad.
                                }
 
-defaultTopicConfig :: TopicConfig
-defaultTopicConfig = TopicConfig { topicDirs = M.empty
+instance Default TopicConfig where
+    def            = TopicConfig { topicDirs = M.empty
                                  , topicActions = M.empty
                                  , defaultTopicAction = const (ask >>= spawn . terminal . config)
                                  , defaultTopic = "1"
                                  , maxTopicHistory = 10
                                  }
 
+{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
+defaultTopicConfig :: TopicConfig
+defaultTopicConfig = def
+
 newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
 instance ExtensionClass PrevTopics where
     initialValue = PrevTopics []
@@ -226,11 +231,17 @@ getLastFocusedTopics = XS.gets getPrevTopics
 -- | Given a 'TopicConfig', the last focused topic, and a predicate that will
 -- select topics that one want to keep, this function will set the property
 -- of last focused topics.
-setLastFocusedTopic :: TopicConfig -> Topic -> (Topic -> Bool) -> X ()
-setLastFocusedTopic tg w predicate =
+setLastFocusedTopic :: Topic -> (Topic -> Bool) -> X ()
+setLastFocusedTopic w predicate =
   XS.modify $ PrevTopics
-    . take (maxTopicHistory tg) . nub . (w:) . filter predicate
+    . seqList . nub . (w:) . filter predicate
     . getPrevTopics
+  where seqList xs = length xs `seq` xs
+
+-- | Reverse the list of "last focused topics"
+reverseLastFocusedTopics :: X ()
+reverseLastFocusedTopics =
+  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
@@ -241,13 +252,13 @@ pprWindowSet tg pp = do
     urgents <- readUrgents
     let empty_workspaces = map W.tag $ filter (isNothing . W.stack) $ W.workspaces winset
         maxDepth = maxTopicHistory tg
-    setLastFocusedTopic tg (W.tag . W.workspace . W.current $ winset)
-                           (`notElem` empty_workspaces)
+    setLastFocusedTopic (W.tag . W.workspace . W.current $ winset)
+                        (`notElem` empty_workspaces)
     lastWs <- getLastFocusedTopics
-    let depth topic = elemIndex topic lastWs
-        add_depth proj topic = proj pp $ maybe topic (((topic++":")++) . show) $ depth topic
+    let depth topic = fromJust $ elemIndex topic (lastWs ++ [topic])
+        add_depth proj topic = proj pp . (((topic++":")++) . show) . depth $ topic
         pp' = pp { ppHidden = add_depth ppHidden, ppVisible = add_depth ppVisible }
-        sortWindows = take (maxDepth - 1) . sortBy (comparing $ fromMaybe maxDepth . depth . W.tag)
+        sortWindows = take maxDepth . sortBy (comparing $ depth . W.tag)
     return $ DL.pprWindowSet sortWindows urgents pp' winset
 
 -- | Given a prompt configuration and a topic configuration, triggers the action associated with
@@ -271,7 +282,7 @@ switchTopic tg topic = do
   when (null wins) $ topicAction tg topic
 
 -- | Switch to the Nth last focused topic or failback to the 'defaultTopic'.
-switchNthLastFocused ::TopicConfig -> Int -> X ()
+switchNthLastFocused :: TopicConfig -> Int -> X ()
 switchNthLastFocused tg depth = do
   lastWs <- getLastFocusedTopics
   switchTopic tg $ (lastWs ++ repeat (defaultTopic tg)) !! depth

XMonad/Actions/TreeSelect.hs

@@ -0,0 +1,657 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE RecordWildCards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.TreeSelect
+-- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Tom Smeets <tom.tsmeets@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+--
+-- TreeSelect displays your workspaces or actions in a Tree-like format.
+-- You can select the desired workspace/action with the cursor or hjkl keys.
+--
+-- This module is fully configurable and very useful if you like to have a
+-- lot of workspaces.
+--
+-- Only the nodes up to the currently selected are displayed.
+-- This will be configurable in the near future by changing 'ts_hidechildren' to @False@, this is not yet implemented.
+--
+-- <<https://wiki.haskell.org/wikiupload/thumb/0/0b/Treeselect-Workspace.png/800px-Treeselect-Workspace.png>>
+--
+-----------------------------------------------------------------------------
+module XMonad.Actions.TreeSelect
+    (
+      -- * Usage
+      -- $usage
+      treeselectWorkspace
+    , toWorkspaces
+    , treeselectAction
+
+      -- * Configuring
+      -- $config
+    , Pixel
+      -- $pixel
+
+    , TSConfig(..)
+    , tsDefaultConfig
+
+      -- * Navigation
+      -- $navigation
+    , defaultNavigation
+    , select
+    , cancel
+    , moveParent
+    , moveChild
+    , moveNext
+    , movePrev
+    , moveHistBack
+    , moveHistForward
+    , moveTo
+
+      -- * Advanced usage
+      -- $advusage
+    , TSNode(..)
+    , treeselect
+    , treeselectAt
+    ) where
+
+import Control.Applicative
+import Control.Monad.Reader
+import Control.Monad.State
+import Data.List (find)
+import Data.Maybe
+import Data.Tree
+import Foreign
+import System.IO
+import System.Posix.Process (forkProcess, executeFile)
+import XMonad hiding (liftX)
+import XMonad.StackSet as W
+import XMonad.Util.Font
+import XMonad.Util.NamedWindows
+import XMonad.Util.TreeZipper
+import XMonad.Hooks.WorkspaceHistory
+import qualified Data.Map as M
+
+#ifdef XFT
+import Graphics.X11.Xft
+import Graphics.X11.Xrender
+#endif
+
+-- $usage
+--
+-- These imports are used in the following example
+--
+-- > import Data.Tree
+-- > import XMonad.Actions.TreeSelect
+-- > import XMonad.Hooks.WorkspaceHistory
+-- > import qualified XMonad.StackSet as W
+--
+-- For selecting Workspaces, you need to define them in a tree structure using 'Data.Tree.Node' instead of just a standard list
+--
+-- Here is an example workspace-tree
+--
+-- > myWorkspaces :: Forest String
+-- > myWorkspaces = [ Node "Browser" [] -- a workspace for your browser
+-- >                , Node "Home"       -- for everyday activity's
+-- >                    [ Node "1" []   --  with 4 extra sub-workspaces, for even more activity's
+-- >                    , Node "2" []
+-- >                    , Node "3" []
+-- >                    , Node "4" []
+-- >                    ]
+-- >                , Node "Programming" -- for all your programming needs
+-- >                    [ Node "Haskell" []
+-- >                    , Node "Docs"    [] -- documentation
+-- >                    ]
+-- >                ]
+--
+-- Then add it to your 'XMonad.Core.workspaces' using the 'toWorkspaces' function.
+--
+-- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
+--
+-- > xmonad $ defaultConfig { ...
+-- >                        , workspaces = toWorkspaces myWorkspaces
+-- >                        , logHook = workspaceHistoryHook
+-- >                        }
+--
+-- After that you still need to bind buttons to 'treeselectWorkspace' to start selecting a workspaces and moving windows
+--
+-- you could bind @Mod-f@ to switch workspace
+--
+-- >  , ((modMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.greedyView)
+--
+-- and bind @Mod-Shift-f@ to moving the focused windows to a workspace
+--
+-- >  , ((modMask .|. shiftMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.shift)
+
+-- $config
+-- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
+--
+-- The default config defined as 'tsDefaultConfig'
+--
+-- > tsDefaultConfig = TSConfig { ts_hidechildren = True
+-- >                            , ts_background   = 0xc0c0c0c0
+-- >                            , ts_font         = "xft:Sans-16"
+-- >                            , ts_node         = (0xff000000, 0xff50d0db)
+-- >                            , ts_nodealt      = (0xff000000, 0xff10b8d6)
+-- >                            , ts_highlight    = (0xffffffff, 0xffff0000)
+-- >                            , ts_extra        = 0xff000000
+-- >                            , ts_node_width   = 200
+-- >                            , ts_node_height  = 30
+-- >                            , ts_originX      = 0
+-- >                            , ts_originY      = 0
+-- >                            , ts_indent       = 80
+-- >                            , ts_navigate     = defaultNavigation
+-- >                            }
+
+-- $pixel
+--
+-- The 'Pixel' Color format is in the form of @0xaarrggbb@
+--
+-- Note that transparency is only supported if you have a window compositor running like <https://github.com/chjj/compton compton>
+--
+-- Some Examples:
+--
+-- @
+-- white       = 0xffffffff
+-- black       = 0xff000000
+-- red         = 0xffff0000
+-- blue        = 0xff00ff00
+-- green       = 0xff0000ff
+-- transparent = 0x00000000
+-- @
+
+-- $navigation
+--
+-- Keybindings for navigations can also be modified
+--
+-- This is the definition of 'defaultNavigation'
+--
+-- > defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
+-- > defaultNavigation = M.fromList
+-- >     [ ((0, xK_Escape), cancel)
+-- >     , ((0, xK_Return), select)
+-- >     , ((0, xK_space),  select)
+-- >     , ((0, xK_Up),     movePrev)
+-- >     , ((0, xK_Down),   moveNext)
+-- >     , ((0, xK_Left),   moveParent)
+-- >     , ((0, xK_Right),  moveChild)
+-- >     , ((0, xK_k),      movePrev)
+-- >     , ((0, xK_j),      moveNext)
+-- >     , ((0, xK_h),      moveParent)
+-- >     , ((0, xK_l),      moveChild)
+-- >     , ((0, xK_o),      moveHistBack)
+-- >     , ((0, xK_i),      moveHistForward)
+-- >     ]
+
+-- $advusage
+-- This module can also be used to select any other action
+
+-- | Extensive configuration for displaying the tree.
+--
+-- This class also has a 'Default' instance
+data TSConfig a = TSConfig { ts_hidechildren :: Bool -- ^ when enabled, only the parents (and their first children) of the current node will be shown (This feature is not yet implemented!)
+                           , ts_background :: Pixel -- ^ background color filling the entire screen.
+
+                           , ts_font :: String -- ^ XMF font for drawing the node name extra text
+
+                           , ts_node      :: (Pixel, Pixel) -- ^ node foreground (text) and background color when not selected
+                           , ts_nodealt   :: (Pixel, Pixel) -- ^ every other node will use this color instead of 'ts_node'
+                           , ts_highlight :: (Pixel, Pixel) -- ^ node foreground (text) and background color when selected
+
+                           , ts_extra :: Pixel -- ^ extra text color
+
+                           , ts_node_width   :: Int -- ^ node width in pixels
+                           , ts_node_height  :: Int -- ^ node height in pixels
+                           , ts_originX :: Int -- ^ tree X position on the screen in pixels
+                           , ts_originY :: Int -- ^ tree Y position on the screen in pixels
+
+                           , ts_indent :: Int -- ^ indentation amount for each level in pixels
+
+                           , ts_navigate :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) -- ^ key bindings for navigating the tree
+                           }
+
+instance Default (TSConfig a) where
+    def = TSConfig { ts_hidechildren = True
+                   , ts_background   = 0xc0c0c0c0
+                   , ts_font         = "xft:Sans-16"
+                   , ts_node         = (0xff000000, 0xff50d0db)
+                   , ts_nodealt      = (0xff000000, 0xff10b8d6)
+                   , ts_highlight    = (0xffffffff, 0xffff0000)
+                   , ts_extra        = 0xff000000
+                   , ts_node_width   = 200
+                   , ts_node_height  = 30
+                   , ts_originX      = 0
+                   , ts_originY      = 0
+                   , ts_indent       = 80
+                   , ts_navigate     = defaultNavigation
+                   }
+
+-- | Default navigation
+--
+-- * navigation using either arrow key or vi style hjkl
+-- * Return or Space to confirm
+-- * Escape or Backspace to cancel to
+defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
+defaultNavigation = M.fromList
+    [ ((0, xK_Escape), cancel)
+    , ((0, xK_Return), select)
+    , ((0, xK_space),  select)
+    , ((0, xK_Up),     movePrev)
+    , ((0, xK_Down),   moveNext)
+    , ((0, xK_Left),   moveParent)
+    , ((0, xK_Right),  moveChild)
+    , ((0, xK_k),      movePrev)
+    , ((0, xK_j),      moveNext)
+    , ((0, xK_h),      moveParent)
+    , ((0, xK_l),      moveChild)
+    , ((0, xK_o),      moveHistBack)
+    , ((0, xK_i),      moveHistForward)
+    ]
+
+-- | Default configuration.
+--
+-- Using nice alternating blue nodes
+tsDefaultConfig :: TSConfig a
+tsDefaultConfig = def
+
+-- | Tree Node With a name and extra text
+data TSNode a = TSNode { tsn_name  :: String
+                       , tsn_extra :: String -- ^ extra text, displayed next to the node name
+                       , tsn_value :: a      -- ^ value to return when this node is selected
+                       }
+
+-- | State used by TreeSelect.
+--
+-- Contains all needed information such as the window, font and a zipper over the tree.
+data TSState a = TSState { tss_tree     :: TreeZipper (TSNode a)
+                         , tss_window   :: Window
+                         , tss_display  :: Display
+                         , tss_size     :: (Int, Int) -- ^ size of 'tz_window'
+                         , tss_xfont    :: XMonadFont
+                         , tss_gc       :: GC
+                         , tss_visual   :: Visual
+                         , tss_colormap :: Colormap
+                         , tss_history  :: ([[String]], [[String]]) -- ^ history zipper, navigated with 'moveHistBack' and 'moveHistForward'
+                         }
+
+-- | State monad transformer using 'TSState'
+newtype TreeSelect a b = TreeSelect { runTreeSelect :: ReaderT (TSConfig a) (StateT (TSState a) X) b }
+    deriving (Monad, Applicative, Functor, MonadState (TSState a),  MonadReader (TSConfig a), MonadIO)
+
+-- | Lift the 'X' action into the 'XMonad.Actions.TreeSelect.TreeSelect' monad
+liftX :: X a -> TreeSelect b a
+liftX = TreeSelect . lift . lift
+
+-- | Run Treeselect with a given config and tree.
+-- This can be used for selectiong anything
+--
+-- * for switching workspaces and moving windows use 'treeselectWorkspace'
+-- * for selecting actions use 'treeselectAction'
+treeselect :: TSConfig a         -- ^ config file
+           -> Forest (TSNode a)  -- ^ a list of 'Data.Tree.Tree's to select from.
+           -> X (Maybe a)
+treeselect c t = treeselectAt c (fromForest t) []
+
+-- | Same as 'treeselect' but ad a specific starting position
+treeselectAt :: TSConfig a         -- ^ config file
+             -> TreeZipper (TSNode a)  -- ^ tree structure with a cursor position (starting node)
+             -> [[String]] -- ^ list of paths that can be navigated with 'moveHistBack' and 'moveHistForward' (bound to the 'o' and 'i' keys)
+             -> X (Maybe a)
+treeselectAt conf@TSConfig{..} zipper hist = withDisplay $ \display -> do
+    -- create a window on the currently focused screen
+    rootw <- asks theRoot
+    Rectangle{..} <- gets $ screenRect . W.screenDetail . W.current . windowset
+
+    Just vinfo <- liftIO $ matchVisualInfo display (defaultScreen display) 32 4
+
+    colormap <- liftIO $ createColormap display rootw (visualInfo_visual vinfo) allocNone
+
+    win <- liftIO $ allocaSetWindowAttributes $ \attributes -> do
+        set_override_redirect attributes True
+        set_colormap attributes colormap
+        set_background_pixel attributes ts_background
+        set_border_pixel attributes 0
+        createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
+
+    liftIO $ do
+        -- TODO: move below?
+        -- make the window visible
+        mapWindow display win
+
+        -- listen to key and mouse button events
+        selectInput display win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
+
+        -- TODO: enable mouse select?
+        -- and mouse button 1
+        grabButton display button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
+
+    -- grab the keyboard
+    status <- liftIO $ grabKeyboard display win True grabModeAsync grabModeAsync currentTime
+
+    r <- if status == grabSuccess
+        then do
+            -- load the XMF font
+            gc <- liftIO $ createGC display win
+            xfont <- initXMF ts_font
+
+            -- run the treeselect Monad
+            ret <- evalStateT (runReaderT (runTreeSelect (redraw >> navigate)) conf)
+                TSState{ tss_tree     = zipper
+                       , tss_window   = win
+                       , tss_display  = display
+                       , tss_xfont    = xfont
+                       , tss_size     = (fromIntegral rect_width, fromIntegral rect_height)
+                       , tss_gc       = gc
+                       , tss_visual   = visualInfo_visual vinfo
+                       , tss_colormap = colormap
+                       , tss_history = ([], hist)
+                       }
+
+            -- release the XMF font
+            releaseXMF xfont
+            liftIO $ freeGC display gc
+            return ret
+
+        else return Nothing
+
+    -- destroy the window
+    liftIO $ do
+        unmapWindow display win
+        destroyWindow display win
+        freeColormap display colormap
+        -- Flush the output buffer and wait for all the events to be processed
+        -- TODO: is this needed?
+        sync display False
+    return r
+
+-- | Select a workspace and execute a \"view\" function from "XMonad.StackSet" on it.
+treeselectWorkspace :: TSConfig WorkspaceId
+                    -> Forest String -- ^ your tree of workspace-names
+                    -> (WorkspaceId -> WindowSet -> WindowSet) -- ^ the \"view\" function.
+                                                               -- Instances can be 'W.greedyView' for switching to a workspace
+                                                               -- and/or 'W.shift' for moving the focused window to a selected workspace.
+                                                               --
+                                                               -- These actions can also be combined by doing
+                                                               --
+                                                               -- > \i -> W.greedyView i . W.shift i
+                    -> X ()
+treeselectWorkspace c xs f = do
+    -- get all defined workspaces
+    -- They have to be set with 'toWorkspaces'!
+    ws <- gets (W.workspaces . windowset)
+
+    -- check the 'XConfig.workspaces'
+    if all (`elem` map tag ws) (toWorkspaces xs)
+      then do
+        -- convert the 'Forest WorkspaceId' to 'Forest (TSNode WorkspaceId)'
+        wsf <- forMForest (mkPaths xs) $ \(n, i) -> maybe (return (TSNode n "Does not exist!" "")) (mkNode n) (find (\w -> i == tag w) ws)
+
+        -- get the current workspace path
+        me <- gets (W.tag . W.workspace . W.current . windowset)
+        hist <- workspaceHistory
+        treeselectAt c (fromJust $ followPath tsn_name (splitPath me) $ fromForest wsf) (map splitPath hist) >>= maybe (return ()) (windows . f)
+
+      else liftIO $ do
+        -- error!
+        let msg = unlines $ [ "Please add:"
+                            , "    workspaces = toWorkspaces myWorkspaces"
+                            , "to your XMonad config!"
+                            , ""
+                            , "XConfig.workspaces: "
+                            ] ++ map tag ws
+        hPutStrLn stderr msg
+        _ <- forkProcess $ executeFile "xmessage" True [msg] Nothing
+        return ()
+  where
+    mkNode n w = do
+        -- find the focused window's name on this workspace
+        name <- maybe (return "") (fmap show . getName . W.focus) $ stack w
+        return $ TSNode n name (tag w)
+
+-- | Convert the workspace-tree to a flat list of paths such that XMonad can use them
+--
+-- The Nodes will be separated by a dot (\'.\') character
+toWorkspaces :: Forest String -> [WorkspaceId]
+toWorkspaces = map snd . concatMap flatten . mkPaths
+
+mkPaths :: Forest String -> Forest (String, WorkspaceId)
+mkPaths = map (\(Node n ns) -> Node (n, n) (map (f n) ns))
+  where
+    f pth (Node x xs) = let pth' = pth ++ '.' : x
+                         in Node (x, pth') (map (f pth') xs)
+
+splitPath :: WorkspaceId -> [String]
+splitPath i = case break (== '.') i of
+    (x,   []) -> [x]
+    (x, _:xs) -> x : splitPath xs
+
+-- | Select from a Tree of 'X' actions
+--
+-- <<https://wiki.haskell.org/wikiupload/thumb/9/9b/Treeselect-Action.png/800px-Treeselect-Action.png>>
+--
+-- Each of these actions have to be specified inside a 'TSNode'
+--
+-- Example
+--
+-- > treeselectAction myTreeConf
+-- >    [ Node (TSNode "Hello"    "displays hello"      (spawn "xmessage hello!")) []
+-- >    , Node (TSNode "Shutdown" "Poweroff the system" (spawn "shutdown")) []
+-- >    , Node (TSNode "Brightness" "Sets screen brightness using xbacklight" (return ()))
+-- >        [ Node (TSNode "Bright" "FULL POWER!!"            (spawn "xbacklight -set 100")) []
+-- >        , Node (TSNode "Normal" "Normal Brightness (50%)" (spawn "xbacklight -set 50"))  []
+-- >        , Node (TSNode "Dim"    "Quite dark"              (spawn "xbacklight -set 10"))  []
+-- >        ]
+-- >    ]
+treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
+treeselectAction c xs = treeselect c xs >>= \x -> case x of
+    Just a  -> a >> return ()
+    Nothing -> return ()
+
+forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
+forMForest x g = mapM (mapMTree g) x
+
+mapMTree :: (Functor m, Applicative m, Monad m) => (a -> m b) -> Tree a -> m (Tree b)
+mapMTree f (Node x xs) = Node <$> f x <*>  mapM (mapMTree f) xs
+
+
+-- | Quit returning the currently selected node
+select :: TreeSelect a (Maybe a)
+select = Just <$> gets (tsn_value . cursor . tss_tree)
+
+-- | Quit without returning anything
+cancel :: TreeSelect a (Maybe a)
+cancel = return Nothing
+
+-- TODO: redraw only what is necessary.
+-- Examples: redrawAboveCursor, redrawBelowCursor and redrawCursor
+
+-- | Move the cursor to its parent node
+moveParent :: TreeSelect a (Maybe a)
+moveParent = moveWith parent >> redraw >> navigate
+
+-- | Move the cursor one level down, highlighting its first child-node
+moveChild :: TreeSelect a (Maybe a)
+moveChild = moveWith children >> redraw >> navigate
+
+-- | Move the cursor to the next child-node
+moveNext :: TreeSelect a (Maybe a)
+moveNext = moveWith nextChild >> redraw >> navigate
+
+-- | Move the cursor to the previous child-node
+movePrev :: TreeSelect a (Maybe a)
+movePrev = moveWith previousChild >> redraw >> navigate
+
+-- | Move backwards in history
+moveHistBack :: TreeSelect a (Maybe a)
+moveHistBack = do
+    s <- get
+    case tss_history s of
+        (xs, a:y:ys) -> do
+            put s{tss_history = (a:xs, y:ys)}
+            moveTo y
+        _ -> navigate
+
+-- | Move forward in history
+moveHistForward :: TreeSelect a (Maybe a)
+moveHistForward = do
+    s <- get
+    case tss_history s of
+        (x:xs, ys) -> do
+            put s{tss_history = (xs, x:ys)}
+            moveTo x
+        _ -> navigate
+
+-- | Move to a specific node
+moveTo :: [String] -- ^ path, always starting from the top
+       -> TreeSelect a (Maybe a)
+moveTo i = moveWith (followPath tsn_name i . rootNode) >> redraw >> navigate
+
+-- | Apply a transformation on the internal 'XMonad.Util.TreeZipper.TreeZipper'.
+moveWith :: (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))) -> TreeSelect a ()
+moveWith f = do
+    s <- get
+    case f (tss_tree s) of
+        -- TODO: redraw cursor only?
+        Just t -> put s{ tss_tree = t }
+        Nothing -> return ()
+
+-- | wait for keys and run navigation
+navigate :: TreeSelect a (Maybe a)
+navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do
+    maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
+
+    ev <- getEvent e
+
+    if ev_event_type ev == keyPress
+      then do
+        (ks, _) <- lookupString $ asKeyEvent e
+        return $ do
+            mask <- liftX $ cleanMask (ev_state ev)
+            f <- asks ts_navigate
+            fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f
+      else return navigate
+
+-- | Request a full redraw
+redraw :: TreeSelect a ()
+redraw = do
+    win <- gets tss_window
+    dpy <- gets tss_display
+
+    -- clear window
+    -- TODO: not always needed!
+    liftIO $ clearWindow dpy win
+
+    t <- gets tss_tree
+    _ <- drawLayers 0 0 (reverse $ (tz_before t, cursor t, tz_after t) : tz_parents t)
+    return ()
+
+drawLayers :: Int -- ^ indentation level
+           -> Int -- ^ height
+           -> [(Forest (TSNode a), TSNode a, Forest (TSNode a))] -- ^ node layers (from top to bottom!)
+           -> TreeSelect a Int
+drawLayers _ yl [] = return yl
+drawLayers xl yl ((bs, c, as):xs) = do
+    TSConfig{..} <- ask
+
+    let nodeColor y = if odd y then ts_node else ts_nodealt
+
+    -- draw nodes above
+    forM_ (zip [yl ..] (reverse bs)) $ \(y, Node n _) ->
+        drawNode xl y n (nodeColor y)
+        -- drawLayers (xl + 1) (y + 1) ns
+        -- TODO: draw rest? if not ts_hidechildren
+        -- drawLayers (xl + 1) (y + 1) ns
+
+    -- draw the current / parent node
+    -- if this is the last (currently focused) we use the 'ts_highlight' color
+    let current_level = yl + length bs
+    drawNode xl current_level c $
+        if null xs then ts_highlight
+                   else nodeColor current_level
+
+    l2 <- drawLayers (xl + 1) (current_level + 1) xs
+
+    -- draw nodes below
+    forM_ (zip [l2 ..] as) $ \(y, Node n _) ->
+        drawNode xl y n (nodeColor y)
+        -- TODO: draw rest? if not ts_hidechildren
+        -- drawLayers (xl + 1) (y + 1) ns
+    return (l2 + length as)
+
+
+-- | Draw a node at a given indentation and height level
+drawNode :: Int -- ^ indentation level (not in pixels)
+         -> Int -- ^ height level (not in pixels)
+         -> TSNode a -- ^ node to draw
+         -> (Pixel, Pixel) -- ^ node foreground (font) and background color
+         -> TreeSelect a ()
+drawNode ix iy TSNode{..} col = do
+    TSConfig{..} <- ask
+    window       <- gets tss_window
+    display      <- gets tss_display
+    font         <- gets tss_xfont
+    gc           <- gets tss_gc
+    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)
+        ts_node_width ts_node_height
+
+    -- TODO: draw extra text (transparent background? or ts_background)
+    -- drawWinBox window fnt col2 nodeH (scW-x) (mes) (x+nodeW) y 8
+
+-- | Draw a simple box with text
+drawWinBox :: Window -> Display -> Visual -> Colormap -> GC -> XMonadFont -> (Pixel, Pixel) -> String -> Pixel -> String -> Int -> Int -> Int -> Int -> IO ()
+drawWinBox win display visual colormap gc font (fg, bg) text fg2 text2 x y w h = do
+    -- draw box
+    setForeground display gc bg
+    fillRectangle display win gc (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
+
+    -- dreaw text
+    drawStringXMF display win visual colormap gc font fg
+        (fromIntegral $ x + 8)
+        (fromIntegral $ y + h - 8)
+        text
+
+    -- dreaw extra text
+    drawStringXMF display win visual colormap gc font fg2
+        (fromIntegral $ x + w + 8)
+        (fromIntegral $ y + h - 8)
+        text2
+
+-- | Modified version of 'XMonad.Util.Font.printStringXMF' that uses 'Pixel' as color format
+drawStringXMF :: Display -> Drawable -> Visual -> Colormap -> GC
+              -> XMonadFont -- ^ XMF Font
+              -> Pixel -- ^ font color
+              -> Position   -- ^ x-position
+              -> Position   -- ^ y-position
+              -> String -- ^ string text
+              -> IO ()
+drawStringXMF display window visual colormap gc font col x y text = case font of
+    Core fnt -> do
+        setForeground display gc col
+        setFont display gc $ fontFromFontStruct fnt
+        drawImageString display window gc x y text
+    Utf8 fnt -> do
+        setForeground display gc col
+        wcDrawImageString display window fnt gc x y text
+#ifdef XFT
+    Xft fnt -> do
+        withXftDraw display window visual colormap $
+            \ft_draw -> withXftColorValue display visual colormap (fromARGB col) $
+            \ft_color -> xftDrawString ft_draw ft_color fnt x y text
+
+-- | Convert 'Pixel' to 'XRenderColor'
+--
+-- Note that it uses short to represent its components
+fromARGB :: Pixel -> XRenderColor
+fromARGB x = XRenderColor (fromIntegral $ 0xff00 .&. shiftR x 8)  -- red
+                          (fromIntegral $ 0xff00 .&. x)           -- green
+                          (fromIntegral $ 0xff00 .&. shiftL x 8)  -- blue
+                          (fromIntegral $ 0xff00 .&. shiftR x 16) -- alpha
+#endif

XMonad/Actions/UpdateFocus.hs

@@ -21,7 +21,6 @@ module XMonad.Actions.UpdateFocus (
 
 import XMonad
 import qualified XMonad.StackSet as W
-import Graphics.X11.Xlib.Extras
 import Control.Monad (when)
 import Data.Monoid
 
@@ -30,7 +29,7 @@ import Data.Monoid
 -- following to your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Actions.UpdateFocus
--- > xmonad $ defaultConfig {
+-- > xmonad $ def {
 -- >   ..
 -- >   startupHook = adjustEventInput
 -- >   handleEventHook = focusOnMouseMove
@@ -45,10 +44,10 @@ focusOnMouseMove (MotionEvent { ev_x = x, ev_y = y, ev_window = root }) = do
     -- check only every 15 px to avoid excessive calls to translateCoordinates
     when (x `mod` 15 == 0 || y `mod` 15 == 0) $ do
       dpy <- asks display
-      Just foc <- withWindowSet $ return . W.peek
+      foc <- withWindowSet $ return . W.peek
       -- get the window under the pointer:
       (_,_,_,w) <- io $ translateCoordinates dpy root root (fromIntegral x) (fromIntegral y)
-      when (foc /= w) $ focus w
+      when (foc /= Just w) $ focus w
     return (All True)
 focusOnMouseMove _ = return (All True)
 
@@ -58,4 +57,4 @@ adjustEventInput = withDisplay $ \dpy -> do
   rootw <- asks theRoot
   io $ selectInput dpy rootw $  substructureRedirectMask .|. substructureNotifyMask
                                 .|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
-                                .|. buttonPressMask .|. pointerMotionMask
+                                .|. buttonPressMask .|. pointerMotionMask

XMonad/Actions/UpdatePointer.hs

@@ -1,7 +1,8 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonadContrib.UpdatePointer
--- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>
+-- Copyright   :  (c) Robert Marlow <robreim@bobturf.org>, 2015 Evgeny Kurnevsky
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  Robert Marlow <robreim@bobturf.org>
@@ -19,14 +20,16 @@ module XMonad.Actions.UpdatePointer
      -- * Usage
      -- $usage
      updatePointer
-     , PointerPosition (..)
     )
     where
 
 import XMonad
+import XMonad.Util.XUtils (fi)
+import Control.Arrow
 import Control.Monad
 import XMonad.StackSet (member, peek, screenDetail, current)
 import Data.Maybe
+import Control.Exception
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -34,74 +37,74 @@ import Data.Maybe
 -- > import XMonad
 -- > import XMonad.Actions.UpdatePointer
 --
--- Enable it by including it in your logHook definition. Eg:
+-- Enable it by including it in your logHook definition, e.g.:
 --
--- > logHook = updatePointer Nearest
+-- > logHook = updatePointer (0.5, 0.5) (1, 1)
 --
--- which will move the pointer to the nearest point of a newly focused window, or
+-- which will move the pointer to the nearest point of a newly focused
+-- window. The first argument establishes a reference point within the
+-- newly-focused window, while the second argument linearly interpolates
+-- between said reference point and the edges of the newly-focused window to
+-- obtain a bounding box for the pointer.
 --
--- > logHook = updatePointer (Relative 0.5 0.5)
---
--- which will move the pointer to the center of a newly focused window.
+-- > logHook = updatePointer (0.5, 0.5) (0, 0) -- exact centre of window
+-- > logHook = updatePointer (0.25, 0.25) (0.25, 0.25) -- near the top-left
+-- > logHook = updatePointer (0.5, 0.5) (1.1, 1.1) -- within 110% of the edge
 --
 -- To use this with an existing logHook, use >> :
 --
 -- > logHook = dynamicLog
--- >           >> updatePointer (Relative 1 1)
+-- >           >> updatePointer (1, 1) (0, 0)
 --
 -- which moves the pointer to the bottom-right corner of the focused window.
 
-data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational
-    deriving (Read,Show)
-
 -- | Update the pointer's location to the currently focused
 -- window or empty screen unless it's already there, or unless the user was changing
 -- focus with the mouse
-updatePointer :: PointerPosition -> X ()
-updatePointer p = do
+updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
+updatePointer refPos ratio = do
   ws <- gets windowset
   dpy <- asks display
+  let defaultRect = screenRect $ screenDetail $ current ws
   rect <- case peek ws of
-        Nothing -> return $ (screenRect . screenDetail .current) ws
-        Just w  -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
+        Nothing -> return defaultRect
+        Just w  -> do tryAttributes <- io $ try $ getWindowAttributes dpy w
+                      return $ case tryAttributes of
+                        Left (_ :: SomeException) -> defaultRect
+                        Right attributes          -> windowAttributesToRectangle attributes
   root <- asks theRoot
   mouseIsMoving <- asks mouseFocused
-  (_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
+  (_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
   drag <- gets dragging
-  unless (pointWithin (fi rootx) (fi rooty) rect
+  unless (pointWithin (fi rootX) (fi rootY) rect
           || mouseIsMoving
           || isJust drag
-          || not (currentWindow `member` ws || currentWindow == none)) $
-    case p of
-    Nearest -> do
-      let x = moveWithin (fi rootx) (rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))
-          y = moveWithin (fi rooty) (rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
-      io $ warpPointer dpy none root 0 0 0 0 x y
-    TowardsCentre xfrc yfrc -> do
-      let cx = fi (rect_width rect) / 2 + fi (rect_x rect)
-          cy = fi (rect_height rect) / 2 + fi (rect_y rect)
-          x,y,cx,cy :: Rational
-          x = moveWithin (fi rootx) (fi $ rect_x rect) (fi (rect_x rect) + fi (rect_width  rect))
-          y = moveWithin (fi rooty) (fi $ rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
-      io $ warpPointer dpy none root 0 0 0 0 (round $ x + xfrc*(cx-x)) (round $ y + yfrc*(cy-y))
-    Relative h v ->
-      io $ warpPointer dpy none root 0 0 0 0
-           (rect_x rect + fraction h (rect_width rect))
-           (rect_y rect + fraction v (rect_height rect))
-        where fraction x y = floor (x * fromIntegral y)
+          || not (currentWindow `member` ws || currentWindow == none)) $ let
+    -- focused rectangle
+    (rectX, rectY) = (rect_x &&& rect_y) rect
+    (rectW, rectH) = (fi . rect_width &&& fi . rect_height) rect
+    -- reference position, with (0,0) and (1,1) being top-left and bottom-right
+    refX = lerp (fst refPos) rectX (rectX + rectW)
+    refY = lerp (snd refPos) rectY (rectY + rectH)
+    -- final pointer bounds, lerped *outwards* from reference position
+    boundsX = join (***) (lerp (fst ratio) refX) (rectX, rectX + rectW)
+    boundsY = join (***) (lerp (snd ratio) refY) (rectY, rectY + rectH)
+    -- ideally we ought to move the pointer in a straight line towards the
+    -- reference point until it is within the above bounds, but…
+    in io $ warpPointer dpy none root 0 0 0 0
+        (round . clip boundsX $ fi rootX)
+        (round . clip boundsY $ fi rootY)
 
 windowAttributesToRectangle :: WindowAttributes -> Rectangle
 windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))
                                            (fi (wa_y wa))
                                            (fi (wa_width wa + 2 * wa_border_width wa))
                                            (fi (wa_height wa + 2 * wa_border_width wa))
-moveWithin :: Ord a => a -> a -> a -> a
-moveWithin now lower upper =
-    if now < lower
-    then lower
-    else if now > upper
-         then upper
-         else now
 
-fi :: (Num b, Integral a) => a -> b
-fi = fromIntegral
+lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
+lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
+
+clip :: Ord a => (a, a) -> a -> a
+clip (lower, upper) x = if x < lower then lower
+    else if x > upper then upper else x
+

XMonad/Actions/Warp.hs

@@ -22,7 +22,6 @@ module XMonad.Actions.Warp (
                            warpToWindow
                           ) where
 
-import Data.Ratio
 import Data.List
 import XMonad
 import XMonad.StackSet as W

XMonad/Actions/WindowBringer.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE TupleSections #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WindowBringer
@@ -17,17 +18,19 @@
 module XMonad.Actions.WindowBringer (
                     -- * Usage
                     -- $usage
-                    gotoMenu, gotoMenu', bringMenu, windowMap,
-                    bringWindow
+                    WindowBringerConfig(..),
+                    gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
+                    bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
+                    windowMap, windowMap', bringWindow, actionMenu
                    ) where
 
-import Data.Char (toLower)
+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 (menuMap)
+import XMonad.Util.Dmenu (menuMapArgs)
 import XMonad.Util.NamedWindows (getName)
 
 -- $usage
@@ -44,19 +47,74 @@ import XMonad.Util.NamedWindows (getName)
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 
+data WindowBringerConfig = WindowBringerConfig
+    { menuCommand :: String -- ^ The shell command that will handle window selection
+    , menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
+    , windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
+    }
+
+instance Default WindowBringerConfig where
+    def = WindowBringerConfig{ menuCommand = "dmenu"
+                             , menuArgs = ["-i"]
+                             , windowTitler = decorateName
+                             }
 
 -- | Pops open a dmenu with window titles. Choose one, and you will be
 --   taken to the corresponding workspace.
 gotoMenu :: X ()
-gotoMenu = actionMenu W.focusWindow
+gotoMenu = gotoMenuConfig def
 
+-- | Pops open a dmenu with window titles. Choose one, and you will be
+--   taken to the corresponding workspace. This version accepts a configuration
+--   object.
+gotoMenuConfig :: WindowBringerConfig -> X ()
+gotoMenuConfig wbConfig = actionMenu wbConfig W.focusWindow
+
+-- | Pops open a dmenu with window titles. Choose one, and you will be
+--   taken to the corresponding workspace. This version takes a list of
+--   arguments to pass to dmenu.
+gotoMenuArgs :: [String] -> X ()
+gotoMenuArgs args = gotoMenuConfig def { menuArgs = args }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace.
 gotoMenu' :: String -> X ()
-gotoMenu' menuCmd = actionMenu' menuCmd W.focusWindow
+gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and you will be taken to the corresponding workspace. This version takes a
+--   list of arguments to pass to dmenu.
+gotoMenuArgs' :: String -> [String] -> X ()
+gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
 
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
-bringMenu = actionMenu bringWindow
+bringMenu = bringMenuArgs def
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   dragged, kicking and screaming, into your current workspace. This version
+--   accepts a configuration object.
+bringMenuConfig :: WindowBringerConfig -> X ()
+bringMenuConfig wbConfig = actionMenu wbConfig bringWindow
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   dragged, kicking and screaming, into your current workspace. This version
+--   takes a list of arguments to pass to dmenu.
+bringMenuArgs :: [String] -> X ()
+bringMenuArgs args = bringMenuConfig def { menuArgs = args }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace.
+bringMenu' :: String -> X ()
+bringMenu' cmd = bringMenuConfig def { menuArgs = [], menuCommand = cmd }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be dragged, kicking and screaming, into your current
+--   workspace. This version allows arguments to the chooser to be specified.
+bringMenuArgs' :: String -> [String] -> X ()
+bringMenuArgs' cmd args = bringMenuConfig def { menuArgs = args, menuCommand = cmd }
 
 -- | Brings the specified window into the current workspace.
 bringWindow :: Window -> X.WindowSet -> X.WindowSet
@@ -64,28 +122,33 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
 
 -- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
 --   if found.
-actionMenu :: (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu action = actionMenu' "dmenu" action
-
-actionMenu' :: String -> (Window -> X.WindowSet -> X.WindowSet) -> X()
-actionMenu' menuCmd action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
+actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
+actionMenu WindowBringerConfig{ menuCommand = cmd
+                              , menuArgs = args
+                              , windowTitler = titler
+                              } action
+    = windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)
     where
       menuMapFunction :: M.Map String a -> X (Maybe a)
-      menuMapFunction selectionMap = menuMap menuCmd selectionMap
+      menuMapFunction = menuMapArgs cmd args
+
 
 -- | A map from window names to Windows.
 windowMap :: X (M.Map String Window)
-windowMap = do
+windowMap = windowMap' decorateName
+
+-- | 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
   ws <- gets X.windowset
-  M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
+  M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
  where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
-       keyValuePair ws w = flip (,) w `fmap` decorateName ws w
+       keyValuePair ws w = flip (,) w <$> titler ws w
 
 -- | Returns the window name as will be listed in dmenu.
---   Lowercased, for your convenience (since dmenu is case-sensitive).
 --   Tagged with the workspace ID, to guarantee uniqueness, and to let the user
 --   know where he's going.
 decorateName :: X.WindowSpace -> Window -> X String
 decorateName ws w = do
-  name <- fmap (map toLower . show) $ getName w
+  name <- show <$> getName w
   return $ name ++ " [" ++ W.tag ws ++ "]"

XMonad/Actions/WindowGo.hs

@@ -21,6 +21,7 @@ module XMonad.Actions.WindowGo (
                  runOrRaiseNext,
                  raiseMaybe,
                  raiseNextMaybe,
+                 raiseNextMaybeCustomFocus,
 
                  raiseBrowser,
                  raiseEditor,
@@ -37,13 +38,14 @@ module XMonad.Actions.WindowGo (
 
 import Control.Monad
 import Data.Char (toLower)
+import qualified Data.List as L (nub,sortBy)
 import Data.Monoid
-import XMonad (Query(), X(), ManageHook, withWindowSet, runQuery, liftIO, ask)
+import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
 import Graphics.X11 (Window)
 import XMonad.ManageHook
 import XMonad.Operations (windows)
 import XMonad.Prompt.Shell (getBrowser, getEditor)
-import qualified XMonad.StackSet as W (allWindows, peek, swapMaster, focusWindow)
+import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
 import XMonad.Util.Run (safeSpawnProg)
 {- $usage
 
@@ -65,12 +67,20 @@ appropriate one, or cover your bases by using instead something like:
 For detailed instructions on editing your key bindings, see
 "XMonad.Doc.Extending#Editing_key_bindings". -}
 
+-- | Get the list of workspaces sorted by their tag
+workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]
+workspacesSorted s = L.sortBy (\u t -> W.tag u `compare` W.tag t) $ W.workspaces s
+
+-- | Get a list of all windows in the 'StackSet' with an absolute ordering of workspaces
+allWindowsSorted :: Ord i => Eq a => W.StackSet i l a s sd -> [a]
+allWindowsSorted = L.nub . concatMap (W.integrate' . W.stack) . workspacesSorted
+
 -- | If windows that satisfy the query exist, apply the supplied
 -- function to them, otherwise run the action given as
 -- second parameter.
 ifWindows :: Query Bool -> ([Window] -> X ()) -> X () -> X ()
 ifWindows qry f el = withWindowSet $ \wins -> do
-  matches <- filterM (runQuery qry) $ W.allWindows wins
+  matches <- filterM (runQuery qry) $ allWindowsSorted wins
   case matches of
     [] -> el
     ws -> f ws
@@ -80,8 +90,11 @@ ifWindows qry f el = withWindowSet $ \wins -> do
 ifWindow :: Query Bool -> ManageHook -> X () -> X ()
 ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
 
--- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
---   Presumably this executable is the same one that you were looking for.
+{- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
+   Presumably this executable is the same one that you were looking for.
+   Note that this does not go through the shell. If you wish to run an arbitrary IO action
+   (such as 'spawn', which will run its String argument through the shell), then you will want to use
+   'raiseMaybe' directly. -}
 runOrRaise :: String -> Query Bool -> X ()
 runOrRaise = raiseMaybe . safeSpawnProg
 
@@ -111,7 +124,7 @@ raise = raiseMaybe $ return ()
    Mutt which you just did for Firefox - but Mutt runs inside a terminal window?
    No problem: you search for a terminal window calling itself \"mutt\", and if
    there isn't you run a terminal with a command to run Mutt! Here's an example
-   (borrowing 'runInTerm' from "XMonad.Utils.Run"):
+   (borrowing 'runInTerm' from "XMonad.Util.Run"):
 
   > , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
 -}
@@ -134,16 +147,21 @@ raiseNext = raiseNextMaybe $ return ()
      'raiseNextMaybe' is an alternative version that allows cycling
      through the matching windows. If the focused window matches the
      query the next matching window is raised. If no matches are found
-     the function f is executed.
--}
-
+     the function f is executed. -}
 raiseNextMaybe :: X () -> Query Bool -> X ()
-raiseNextMaybe f qry = flip (ifWindows qry) f $ \ws -> do
+raiseNextMaybe = raiseNextMaybeCustomFocus W.focusWindow
+
+{- | See 'raiseMaybe' and 'raiseNextMaybe'.
+     In addition to all of the options offered by 'raiseNextMaybe'
+     'raiseNextMaybeCustomFocus' allows the user to supply the function that
+     should be used to shift the focus to any window that is found. -}
+raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query Bool -> X()
+raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
   foc <- withWindowSet $ return . W.peek
   case foc of
     Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
-                            in windows $ W.focusWindow y
-    _ -> windows . W.focusWindow . head $ ws
+                            in windows $ focusFn y
+    _ -> windows . focusFn . head $ ws
 
 -- | Given a function which gets us a String, we try to raise a window with that classname,
 --   or we then interpret that String as a executable name.
@@ -160,11 +178,12 @@ raiseEditor  = raiseVar getEditor
 {- | If the window is found the window is focused and the third argument is called
      otherwise, the first argument is called
      See 'raiseMaster' for an example. -}
-raiseAndDo :: X () -> Query Bool -> (Window -> X ())-> X ()
+raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X ()
 raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f
     where afterRaise = ask >>= (>> idHook) . liftX . after
 
-{- | If a window matching the second arugment is found, the window is focused and the third argument is called;
+{- | If a window matching the second argument is found, the window is focused and
+     the third argument is called;
      otherwise, the first argument is called. -}
 runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()
 runOrRaiseAndDo = raiseAndDo . safeSpawnProg
@@ -179,7 +198,6 @@ raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> window
 {- |  If the window is found the window is focused and set to master
       otherwise, action is run.
 
-      > runOrRaiseMaster "firefox" (className =? "Firefox"))
-  -}
+      > runOrRaiseMaster "firefox" (className =? "Firefox")) -}
 runOrRaiseMaster :: String -> Query Bool -> X ()
 runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster)

XMonad/Actions/WindowMenu.hs

@@ -41,6 +41,14 @@ import XMonad.Util.XUtils (fi)
 --
 -- >    , ((modm,               xK_o ), windowMenu)
 
+colorizer :: a -> Bool -> X (String, String)
+colorizer _ isFg = do
+    fBC <- asks (focusedBorderColor . config)
+    nBC <- asks (normalBorderColor . config)
+    return $ if isFg
+                then (fBC, nBC)
+                else (nBC, fBC)
+
 windowMenu :: X ()
 windowMenu = withFocused $ \w -> do
     tags <- asks (workspaces . config)
@@ -48,13 +56,13 @@ windowMenu = withFocused $ \w -> do
     Rectangle sx sy swh sht <- gets $ screenRect . W.screenDetail . W.current . windowset
     let originFractX = (fi x - fi sx + fi wh / 2) / fi swh
         originFractY = (fi y - fi sy + fi ht / 2) / fi sht
-        gsConfig = defaultGSConfig
+        gsConfig = (buildDefaultGSConfig colorizer)
                     { gs_originFractX = originFractX
                     , gs_originFractY = originFractY }
         actions = [ ("Cancel menu", return ())
                   , ("Close"      , kill)
                   , ("Maximize"   , sendMessage $ maximizeRestore w)
-                  , ("Minimize"   , sendMessage $ MinimizeWin w)
+                  , ("Minimize"   , minimizeWindow w)
                   ] ++
                   [ ("Move to " ++ tag, windows $ W.shift tag)
                     | tag <- tags ]

XMonad/Actions/WindowNavigation.hs

@@ -36,7 +36,7 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
-                                       Direction2D(..)
+                                       Direction2D(..), WNState,
                                        ) where
 
 import XMonad
@@ -52,7 +52,6 @@ import qualified Data.Map as M
 import Data.Maybe (catMaybes, fromMaybe, listToMaybe)
 import Data.Ord (comparing)
 import qualified Data.Set as S
-import Graphics.X11.Xlib
 
 -- $usage
 --
@@ -63,7 +62,7 @@ import Graphics.X11.Xlib
 --
 -- > main = do
 -- >     config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
--- >             $ defaultConfig { ... }
+-- >             $ def { ... }
 -- >     xmonad config
 --
 -- Here, we pass in the keys for navigation in counter-clockwise order from up.

XMonad/Actions/WithAll.hs

@@ -18,8 +18,6 @@ module XMonad.Actions.WithAll (
 import Data.Foldable hiding (foldr)
 
 import XMonad
-import XMonad.Core
-import XMonad.Operations
 import XMonad.StackSet
 
 -- $usage

XMonad/Actions/Workscreen.hs

@@ -0,0 +1,110 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module     :  XMonad.Actions.Workscreen
+-- Copyright  :  (c) 2012 kedals0
+-- License    :  BSD3-style (see LICENSE)
+--
+-- Maintainer :  Dal <kedasl0@gmail.com>
+-- Stability  :  unstable
+-- Portability:  unportable
+--
+-- A workscreen permits to display a set of workspaces on several
+-- screens. In xinerama mode, when a workscreen is viewed, workspaces
+-- associated to all screens are visible.
+--
+-- The first workspace of a workscreen is displayed on first screen,
+-- second on second screen, etc. Workspace position can be easily
+-- changed. If the current workscreen is called again, workspaces are
+-- shifted.
+--
+-- This also permits to see all workspaces of a workscreen even if just
+-- one screen is present, and to move windows from workspace to workscreen.
+-----------------------------------------------------------------------------
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.Workscreen (
+  -- * Usage
+  -- $usage
+  configWorkscreen
+  ,viewWorkscreen
+  ,Workscreen(..)
+  ,shiftToWorkscreen
+  ,fromWorkspace
+  ,expandWorkspace
+  ,WorkscreenId
+  ) where
+
+import XMonad hiding (workspaces)
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Actions.OnScreen
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.Workscreen
+-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
+-- >                in Workscreen.expandWorkspace 2 myOldWorkspaces
+-- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)
+-- >                    return ()
+--
+-- Then, replace normal workspace view and shift keybinding:
+--
+-- > [((m .|. modm, k), f i)
+-- >      | (i, k) <- zip [0..] [1..12]
+-- >      , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)
+type WorkscreenId=Int
+
+data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)
+instance ExtensionClass WorkscreenStorage where
+  initialValue = WorkscreenStorage 0 []
+
+-- | Helper to group workspaces. Multiply workspace by screens number.
+expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
+expandWorkspace nscr ws = concat $ map expandId ws
+  where expandId wsId = let t = wsId ++ "_"
+                        in map ((++) t . show ) [1..nscr]
+
+-- | Create workscreen list from workspace list. Group workspaces to
+-- packets of screens number size.
+fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
+fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
+fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
+fromWorkspace' _ [] = []
+fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
+
+-- | Initial configuration of workscreens
+configWorkscreen :: [Workscreen] -> X ()
+configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn)
+
+-- | View workscreen of index @WorkscreenId@. If current workscreen is asked
+-- workscreen, workscreen's workspaces are shifted.
+viewWorkscreen :: WorkscreenId -> X ()
+viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get
+                           let wscr = if wscrId == c
+                                          then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)
+                                          else a !! wscrId
+                               (x,_:ys) = splitAt wscrId a
+                               newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)
+                           windows (viewWorkscreen' wscr)
+                           XS.put newWorkscreenStorage
+
+viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
+viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws)
+  where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s
+
+shiftWs :: [WorkspaceId] -> [WorkspaceId]
+shiftWs a = drop 1 a ++ take 1 a
+
+-- | Shift a window on the first workspace of workscreen
+-- @WorkscreenId@.
+shiftToWorkscreen :: WorkscreenId -> X ()
+shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
+                              let ws = head . workspaces $ a !! wscrId
+                              windows $ W.shift ws

XMonad/Actions/WorkspaceCursors.hs

@@ -32,10 +32,13 @@ module XMonad.Actions.WorkspaceCursors
 
     -- * Functions to pass to 'modifyLayer'
     ,focusNth'
-    ,noWrapUp,noWrapDown
+    ,noWrapUp,noWrapDown,
 
     -- * Todo
     -- $todo
+
+    -- * Types
+    Cursors,
     ) where
 
 import qualified XMonad.StackSet as W
@@ -66,8 +69,8 @@ import Data.Traversable(sequenceA)
 -- >     x <- xmobar conf
 -- >     xmonad x
 -- >
--- > conf = additionalKeysP defaultConfig
--- >        { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig
+-- > conf = additionalKeysP def
+-- >        { layoutHook = workspaceCursors myCursors $ layoutHook def
 -- >        , workspaces = toList myCursors } $
 -- >        [("M-"++shift++control++[k], f direction depth)
 -- >          | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]

XMonad/Actions/WorkspaceNames.hs

@@ -0,0 +1,187 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.WorkspaceNames
+-- Copyright   :  (c) Tomas Janousek <tomi@nomi.cz>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Tomas Janousek <tomi@nomi.cz>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+-- Provides bindings to rename workspaces, show these names in DynamicLog and
+-- swap workspaces along with their names. These names survive restart.
+-- Together with "XMonad.Layout.WorkspaceDir" this provides for a fully
+-- dynamic topic space workflow.
+--
+-----------------------------------------------------------------------------
+
+{-# LANGUAGE DeriveDataTypeable #-}
+
+module XMonad.Actions.WorkspaceNames (
+    -- * Usage
+    -- $usage
+
+    -- * Workspace naming
+    renameWorkspace,
+    workspaceNamesPP,
+    getWorkspaceNames',
+    getWorkspaceNames,
+    getWorkspaceName,
+    getCurrentWorkspaceName,
+    setWorkspaceName,
+    setCurrentWorkspaceName,
+
+    -- * Workspace swapping
+    swapTo,
+    swapTo',
+    swapWithCurrent,
+
+    -- * Workspace prompt
+    workspaceNamePrompt
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import qualified XMonad.Util.ExtensibleState as XS
+
+import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..))
+import qualified XMonad.Actions.SwapWorkspaces as Swap
+import XMonad.Hooks.DynamicLog (PP(..))
+import XMonad.Prompt (mkXPrompt, XPConfig)
+import XMonad.Prompt.Workspace (Wor(Wor))
+import XMonad.Util.WorkspaceCompare (getSortByIndex)
+
+import qualified Data.Map as M
+import Data.Maybe (fromMaybe)
+import Data.List (isInfixOf)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.WorkspaceNames
+--
+-- Then add keybindings like the following:
+--
+-- >   , ((modm .|. shiftMask, xK_r      ), renameWorkspace def)
+--
+-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
+--
+-- > myLogHook =
+-- >     workspaceNamesPP xmobarPP >>= dynamicLogString >>= xmonadPropLog
+--
+-- We also provide a modification of "XMonad.Actions.SwapWorkspaces"\'s
+-- functionality, which may be used this way:
+--
+-- >   , ((modMask .|. shiftMask, xK_Left  ), swapTo Prev)
+-- >   , ((modMask .|. shiftMask, xK_Right ), swapTo Next)
+--
+-- > [((modm .|. controlMask, k), swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+
+
+-- | Workspace names container.
+newtype WorkspaceNames = WorkspaceNames (M.Map WorkspaceId String)
+    deriving (Typeable, Read, Show)
+
+instance ExtensionClass WorkspaceNames where
+    initialValue = WorkspaceNames M.empty
+    extensionType = PersistentExtension
+
+-- | Returns a lookup function that maps workspace tags to workspace names.
+getWorkspaceNames' :: X (WorkspaceId -> Maybe String)
+getWorkspaceNames' = do
+    WorkspaceNames m <- XS.get
+    return (`M.lookup` m)
+
+-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
+-- workspaces with a name, and to @\"t\"@ otherwise.
+getWorkspaceNames :: X (WorkspaceId -> String)
+getWorkspaceNames = do
+    lookup <- getWorkspaceNames'
+    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'
+
+-- | Gets the name of the current workspace. See 'getWorkspaceName'
+getCurrentWorkspaceName :: X (Maybe String)
+getCurrentWorkspaceName = do
+    getWorkspaceName =<< gets (W.currentTag . windowset)
+
+-- | Sets the name of a workspace. Empty string makes the workspace unnamed
+-- again.
+setWorkspaceName :: WorkspaceId -> String -> X ()
+setWorkspaceName w name = do
+    WorkspaceNames m <- XS.get
+    XS.put $ WorkspaceNames $ if null name then M.delete w m else M.insert w name m
+    refresh
+
+-- | Sets the name of the current workspace. See 'setWorkspaceName'.
+setCurrentWorkspaceName :: String -> X ()
+setCurrentWorkspaceName name = do
+    current <- gets (W.currentTag . windowset)
+    setWorkspaceName current name
+
+-- | Prompt for a new name for the current workspace and set it.
+renameWorkspace :: XPConfig -> X ()
+renameWorkspace conf = do
+    mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
+    where pr = Wor "Workspace name: "
+
+-- | Modify "XMonad.Hooks.DynamicLog"\'s pretty-printing format to show
+-- workspace names as well.
+workspaceNamesPP :: PP -> X PP
+workspaceNamesPP pp = do
+    names <- getWorkspaceNames
+    return $
+        pp {
+            ppCurrent         = ppCurrent         pp . names,
+            ppVisible         = ppVisible         pp . names,
+            ppHidden          = ppHidden          pp . names,
+            ppHiddenNoWindows = ppHiddenNoWindows pp . names,
+            ppUrgent          = ppUrgent          pp . names
+        }
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
+swapTo :: Direction1D -> X ()
+swapTo dir = swapTo' dir AnyWS
+
+-- | Swap with the previous or next workspace of the given type.
+swapTo' :: Direction1D -> WSType -> X ()
+swapTo' dir which = findWorkspace getSortByIndex dir which 1 >>= swapWithCurrent
+
+-- | See 'XMonad.Actions.SwapWorkspaces.swapWithCurrent'. This is almost the
+-- same with names.
+swapWithCurrent :: WorkspaceId -> X ()
+swapWithCurrent t = do
+    current <- gets (W.currentTag . windowset)
+    swapNames t current
+    windows $ Swap.swapWorkspaces t current
+
+-- | Swap names of the two workspaces.
+swapNames :: WorkspaceId -> WorkspaceId -> X ()
+swapNames w1 w2 = do
+    WorkspaceNames m <- XS.get
+    let getname w = fromMaybe "" $ M.lookup w m
+        set w name m' = if null name then M.delete w m' else M.insert w name m'
+    XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
+
+-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
+workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()
+workspaceNamePrompt conf job = do
+    myWorkspaces <- gets $ map W.tag . W.workspaces . windowset
+    myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
+    let pairs = zip myWorkspacesName myWorkspaces
+    mkXPrompt (Wor "Select workspace: ") conf
+              (contains myWorkspacesName)
+              (job . toWsId pairs)
+  where toWsId pairs name = case lookup name pairs of
+                                Nothing -> ""
+                                Just i -> i
+        contains completions input =
+          return $ filter (Data.List.isInfixOf input) completions

XMonad/Config/Arossato.hs

@@ -36,7 +36,6 @@ import XMonad.Layout.NoBorders
 import XMonad.Layout.SimpleFloat
 import XMonad.Layout.Tabbed
 import XMonad.Layout.WindowArranger
-import XMonad.Prompt
 import XMonad.Prompt.Shell
 import XMonad.Prompt.Ssh
 import XMonad.Prompt.Theme
@@ -86,7 +85,7 @@ import XMonad.Util.Themes
 
 arossatoConfig = do
     xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed!
-    return $ defaultConfig
+    return $ def
          { workspaces         = ["home","var","dev","mail","web","doc"] ++
                                 map show [7 .. 9 :: Int]
          , logHook            = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
@@ -120,7 +119,7 @@ arossatoConfig = do
       newManageHook = myManageHook
 
       -- xmobar
-      myDynLog    h = dynamicLogWithPP defaultPP
+      myDynLog    h = dynamicLogWithPP def
                       { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
                       , ppTitle   = xmobarColor "green"  "" . shorten 40
                       , ppVisible = wrap "(" ")"
@@ -128,7 +127,7 @@ arossatoConfig = do
                       }
 
       -- key bindings stuff
-      defKeys    = keys defaultConfig
+      defKeys    = keys def
       delKeys x  = foldr M.delete           (defKeys x) (toRemove x)
       newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)
       -- remove some of the default key bindings
@@ -144,12 +143,12 @@ arossatoConfig = do
           [(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]
       -- These are my personal key bindings
       toAdd x   =
-          [ ((modMask x              , xK_F12   ), xmonadPrompt      defaultXPConfig     )
-          , ((modMask x              , xK_F3    ), shellPrompt       defaultXPConfig     )
-          , ((modMask x              , xK_F4    ), sshPrompt         defaultXPConfig     )
-          , ((modMask x              , xK_F5    ), themePrompt       defaultXPConfig     )
-          , ((modMask x              , xK_F6    ), windowPromptGoto  defaultXPConfig     )
-          , ((modMask x              , xK_F7    ), windowPromptBring defaultXPConfig     )
+          [ ((modMask x              , xK_F12   ), xmonadPrompt      def                 )
+          , ((modMask x              , xK_F3    ), shellPrompt       def                 )
+          , ((modMask x              , xK_F4    ), sshPrompt         def                 )
+          , ((modMask x              , xK_F5    ), themePrompt       def                 )
+          , ((modMask x              , xK_F6    ), windowPromptGoto  def                 )
+          , ((modMask x              , xK_F7    ), windowPromptBring def                 )
           , ((modMask x              , xK_comma ), prevWS                                )
           , ((modMask x              , xK_period), nextWS                                )
           , ((modMask x              , xK_Right ), windows W.focusDown                   )

XMonad/Config/Azerty.hs

@@ -36,9 +36,9 @@ import qualified Data.Map as M
 -- If you prefer, an azertyKeys function is provided which you can use as so:
 --
 -- > import qualified Data.Map as M
--- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
+-- > main = xmonad someConfig { keys = \c -> azertyKeys c <+> keys someConfig c }
 
-azertyConfig = defaultConfig { keys = \c -> azertyKeys c `M.union` keys defaultConfig c }
+azertyConfig = def { keys = azertyKeys <+> keys def }
 
 azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
     [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
@@ -46,3 +46,9 @@ azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
     [((m .|. modm, k), windows $ f i)
         | (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
           (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
+    ++
+    -- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
+    -- mod-shift-{z,e,r} %! Move client to screen 1, 2, or 3
+    [((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f))
+        | (key, sc) <- zip [xK_z, xK_e, xK_r] [0..],
+          (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]

XMonad/Config/Bepo.hs

@@ -0,0 +1,47 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Bepo
+-- Copyright    : (c) Yorick Laupa <yo.eight@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Yorick Laupa <yo.eight@gmail.com>
+-- Stability    : stable
+-- Portability  : unportable
+--
+-- This module fixes some of the keybindings for the francophone among you who
+-- use a BEPO keyboard layout. Based on XMonad.Config.Azerty
+
+module XMonad.Config.Bepo (
+    -- * Usage
+    -- $usage
+    bepoConfig, bepoKeys
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import qualified Data.Map as M
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Bepo
+-- >
+-- > main = xmonad bepoConfig
+--
+-- If you prefer, an bepoKeys function is provided which you can use as so:
+--
+-- > import qualified Data.Map as M
+-- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c }
+
+bepoConfig = def { keys = bepoKeys <+> keys def }
+
+bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
+    [((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
+    ++
+    [((m .|. modm, k), windows $ f i)
+        | (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
+          (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]

XMonad/Config/Bluetile.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE FlexibleContexts #-}
 {-# OPTIONS -fno-warn-missing-signatures #-}
 ----------------------------------------------------------------------------
 -- |
@@ -26,7 +27,6 @@ module XMonad.Config.Bluetile (
 
 import XMonad hiding ( (|||) )
 
-import XMonad.Layout hiding ( (|||) )
 import XMonad.Layout.BorderResize
 import XMonad.Layout.BoringWindows
 import XMonad.Layout.ButtonDecoration
@@ -49,8 +49,9 @@ import XMonad.Actions.WindowMenu
 import XMonad.Hooks.CurrentWorkspaceOnTop
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
 import XMonad.Hooks.PositionStoreHooks
-import XMonad.Hooks.RestoreMinimized
+import XMonad.Hooks.Minimize
 import XMonad.Hooks.ServerMode
 import XMonad.Hooks.WorkspaceByPos
 
@@ -118,8 +119,8 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
     , ((modMask'              , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
 
     -- quit, or restart
-    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit bluetile
-    , ((modMask'              , xK_q     ), spawn "bluetile --restart") -- %! Restart bluetile
+    , ((modMask' .|. shiftMask, xK_q     ), io (exitWith ExitSuccess)) -- %! Quit
+    , ((modMask'              , xK_q     ), restart "xmonad" True) -- %! Restart
 
     -- Metacity-like workspace switching
     , ((mod1Mask .|. controlMask, xK_Left), prevWS)
@@ -141,7 +142,7 @@ bluetileKeys conf@(XConfig {XMonad.modMask = modMask'}) = M.fromList $
     , ((modMask'              , xK_z), withFocused (sendMessage . maximizeRestore))
 
     -- Minimizing
-    , ((modMask',               xK_m     ), withFocused (\f -> sendMessage (MinimizeWin f)))
+    , ((modMask',               xK_m     ), withFocused minimizeWindow)
     , ((modMask' .|. shiftMask, xK_m     ), sendMessage RestoreNextMinimizedWin)
     ]
     ++
@@ -177,11 +178,11 @@ isFloating w = do
 
 bluetileManageHook :: ManageHook
 bluetileManageHook = composeAll
-               [ workspaceByPos, positionStoreManageHook
+               [ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)
                 , className =? "MPlayer" --> doFloat
-                , manageDocks]
+                , isFullscreen --> doFullFloat]
 
-bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ (
+bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
                         named "Floating" floating |||
                         named "Tiled1" tiled1 |||
                         named "Tiled2" tiled2 |||
@@ -197,19 +198,21 @@ bluetileLayoutHook = avoidStruts $ boringAuto $ minimize $ (
             floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
 
 bluetileConfig =
-    defaultConfig
+    docks $
+    def
         { modMask = mod4Mask,   -- logo key
           manageHook = bluetileManageHook,
           layoutHook = bluetileLayoutHook,
           logHook = currentWorkspaceOnTop >> ewmhDesktopsLogHook,
           handleEventHook = ewmhDesktopsEventHook
-                                `mappend` restoreMinimizedEventHook
+                                `mappend` fullscreenEventHook
+                                `mappend` minimizeEventHook
                                 `mappend` serverModeEventHook' bluetileCommands
                                 `mappend` positionStoreEventHook,
           workspaces = bluetileWorkspaces,
           keys = bluetileKeys,
           mouseBindings = bluetileMouseBindings,
-          focusFollowsMouse  = False,
-          focusedBorderColor = "#ff5500",
+          focusFollowsMouse = False,
+          focusedBorderColor = "#000000",
           terminal = "gnome-terminal"
         }

XMonad/Config/Desktop.hs

@@ -22,7 +22,8 @@ module XMonad.Config.Desktop (
     -- the DE via a subset of the Extended Window Manager Hints (EWMH)
     -- specification. Extra xmonad settings unique to specific DE's are
     -- added by overriding or modifying @desktopConfig@ fields in the
-    -- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@.
+    -- same way that the default configuration is customized in
+    -- @~\/.xmonad/xmonad.hs@.
     --
     -- For more information about EWMH see:
     --
@@ -54,7 +55,6 @@ module XMonad.Config.Desktop (
     ) where
 
 import XMonad
-import XMonad.Config (defaultConfig)
 import XMonad.Hooks.ManageDocks
 import XMonad.Hooks.EwmhDesktops
 import XMonad.Util.Cursor
@@ -70,7 +70,7 @@ import qualified Data.Map as M
 -- <http://haskell.org/haskellwiki/Xmonad>
 --
 -- To configure xmonad for use with a DE or with DE tools like panels
--- and pagers, in place of @defaultConfig@ in your @~\/.xmonad/xmonad.hs@,
+-- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,
 -- use @desktopConfig@ or one of the other desktop configs from the
 -- @XMonad.Config@ namespace. The following setup and customization examples
 -- work the same way for the other desktop configs as for @desktopConfig@.
@@ -89,7 +89,7 @@ import qualified Data.Map as M
 
 -- $customizing
 -- To customize a desktop config, modify its fields as is illustrated with
--- @defaultConfig@ in "XMonad.Doc.Extending#Extending xmonad".
+-- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".
 
 -- $layouts
 -- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
@@ -127,7 +127,7 @@ import qualified Data.Map as M
 -- To add to the logHook while still sending workspace and window information
 -- to DE apps use something like:
 --
--- >  , logHook = myLogHook >> logHook desktopConfig
+-- >  , logHook = myLogHook <+> logHook desktopConfig
 --
 -- Or for more elaborate logHooks you can use @do@:
 --
@@ -139,25 +139,23 @@ import qualified Data.Map as M
 
 -- $eventHook
 -- To customize xmonad's event handling while still having it respond
--- to EWMH events from pagers, task bars, etc. add to your imports:
+-- to EWMH events from pagers, task bars:
 --
--- > import Data.Monoid
+-- >  , handleEventHook = myEventHooks <+> handleEventHook desktopConfig
 --
--- and use 'Data.Monoid.mappend' to combine event hooks (right to left application like @\<+\>@)
---
--- >  , handleEventHook = mappend myEventHooks (handleEventHook desktopConfig)
---
--- or 'Data.Monoid.mconcat' (like @composeAll@)
+-- or 'mconcat' if you write a list event of event hooks
 --
 -- >  , handleEventHook = mconcat
 -- >        [ myMouseHandler
 -- >        , myMessageHandler
 -- >        , handleEventHook desktopConfig ]
 --
+-- Note that the event hooks are run left to right (in contrast to
+-- 'ManageHook'S which are right to left)
 
 -- $startupHook
 -- To run the desktop startupHook, plus add further actions to be run each
--- time xmonad starts or restarts, use '>>' to combine actions as in the
+-- time xmonad starts or restarts, use '<+>' to combine actions as in the
 -- logHook example, or something like:
 --
 -- >  , startupHook = do
@@ -166,11 +164,10 @@ import qualified Data.Map as M
 -- >        adjustEventInput
 --
 
-desktopConfig = ewmh defaultConfig
-    { startupHook     = setDefaultCursor xC_left_ptr
-    , layoutHook      = desktopLayoutModifiers $ layoutHook defaultConfig
-    , manageHook      = manageHook defaultConfig <+> manageDocks
-    , keys            = \c -> desktopKeys c `M.union` keys defaultConfig c }
+desktopConfig = docks $ ewmh def
+    { startupHook     = setDefaultCursor xC_left_ptr <+> startupHook def
+    , layoutHook      = desktopLayoutModifiers $ layoutHook def
+    , keys            = desktopKeys <+> keys def }
 
 desktopKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm, xK_b), sendMessage ToggleStruts) ]

XMonad/Config/Dmwit.hs

@@ -0,0 +1,322 @@
+-- boilerplate {{{
+{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
+module XMonad.Config.Dmwit where
+
+-- system imports
+import Control.Applicative
+import Control.Monad
+import Control.Monad.Trans
+import Data.Char
+import Data.List
+import Data.Map (Map, fromList)
+import Data.Ratio
+import Data.Word
+import GHC.Real
+import System.Environment
+import System.Exit
+import System.IO
+import System.Process
+
+-- xmonad core
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+
+-- xmonad contrib
+import XMonad.Actions.SpawnOn
+import XMonad.Actions.Warp
+import XMonad.Hooks.DynamicLog
+import XMonad.Hooks.ManageDocks
+import XMonad.Hooks.ManageHelpers
+import XMonad.Layout.Grid
+import XMonad.Layout.IndependentScreens
+import XMonad.Layout.Magnifier
+import XMonad.Layout.NoBorders
+import XMonad.Util.Dzen hiding (x, y)
+import XMonad.Util.SpawnOnce
+-- }}}
+-- volume {{{
+outputOf :: String -> IO String
+outputOf s = do
+    uninstallSignalHandlers
+    (hIn, hOut, hErr, p) <- runInteractiveCommand s
+    mapM_ hClose [hIn, hErr]
+    hGetContents hOut <* waitForProcess p <* installSignalHandlers
+
+geomMean :: Floating a => [a] -> a
+geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
+
+arithMean :: Floating a => [a] -> a
+arithMean xs = sum xs / fromIntegral (length xs)
+
+namedNumbers n s = do
+    l <- lines s
+    guard (sentinel `isPrefixOf` l)
+    return (drop (length sentinel) l)
+    where sentinel = n ++ " #"
+
+-- Data.List.Split.splitOn ":", but without involving an extra dependency
+splitColon xs = case break (==':') xs of
+    (a, ':':b) -> a : splitColon b
+    (a, _)     -> [a]
+
+parse s = arithMean $ do
+    l <- lines s
+    guard ("\tVolume: " `isPrefixOf` l)
+    part <- splitColon l
+    (n,'%':_) <- reads part
+    return n
+
+modVolume :: String -> Integer -> IO Double
+modVolume kind n = do
+    is <- namedNumbers parseKind <$> outputOf listCommand
+    forM_ is (outputOf . setCommand)
+    parse <$> outputOf listCommand
+    where
+    sign | n > 0 = "+" | otherwise = "-"
+    ctlKind      = map (\c -> if c == ' ' then '-' else c) kind
+    parseKind    = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind
+    setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"
+    listCommand  = "pactl list " ++ ctlKind ++ "s"
+-- }}}
+-- convenient actions {{{
+centerMouse = warpToWindow (1/2) (1/2)
+statusBarMouse = warpToScreen 0 (5/1600) (5/1200)
+withScreen s f = screenWorkspace s >>= flip whenJust (windows . f)
+
+makeLauncher yargs run exec close = concat
+    ["exe=`yeganesh ", yargs, "` && ", run, " ", exec, "$exe", close]
+launcher     = makeLauncher "" "eval" "\"exec " "\""
+termLauncher = makeLauncher "-p withterm" "exec urxvt -e" "" ""
+viewShift  i = view i . shift i
+floatAll     = composeAll . map (\s -> className =? s --> doFloat)
+sinkFocus    = peek >>= maybe id sink
+showMod  k n = liftIO (modVolume k n) >>= volumeDzen . show . round
+volumeDzen   = dzenConfig $ onCurr (center 170 66) >=> font "-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*"
+-- }}}
+altMask = mod1Mask
+bright  = "#80c0ff"
+dark    = "#13294e"
+-- manage hooks for mplayer {{{
+fullscreen43on169 = expand $ RationalRect 0 (-1/6) 1 (4/3) where
+    expand (RationalRect x y w h) = RationalRect (x - bwx) (y - bwy) (w + 2 * bwx) (h + 2 * bwy)
+    bwx = 2 / 1920 -- borderwidth
+    bwy = 2 / 1080
+
+fullscreenMPlayer = className =? "MPlayer" --> do
+    dpy   <- liftX $ asks display
+    win   <- ask
+    hints <- liftIO $ getWMNormalHints dpy win
+    case fmap (approx . fst) (sh_aspect hints) of
+        Just ( 4 :% 3)  -> viewFullOn 0 "5" win
+        Just (16 :% 9)  -> viewFullOn 1 "5" win
+        _               -> doFloat
+    where
+    fi               = fromIntegral :: Dimension -> Double
+    approx (n, d)    = approxRational (fi n / fi d) (1/100)
+
+operationOn f s n w = do
+    let ws = marshall s n
+    currws <- liftX $ screenWorkspace s
+    doF $ view ws . maybe id view currws . shiftWin ws w . f w
+
+viewFullOn = operationOn sink
+centerWineOn = operationOn (`XMonad.StackSet.float` RationalRect (79/960) (-1/540) (401/480) (271/270))
+-- }}}
+-- debugging {{{
+class Show a => PPrint a where
+    pprint :: Int -> a -> String
+    pprint _ = show
+
+data PPrintable = forall a. PPrint a => P a
+instance Show   PPrintable where show     (P x) = show x
+instance PPrint PPrintable where pprint n (P x) = pprint n x
+
+record :: String -> Int -> [(String, PPrintable)] -> String
+record s n xs = preamble ++ intercalate newline fields ++ postlude where
+    indentation = '\n' : replicate n '\t'
+    preamble    = s ++ " {" ++ indentation
+    postlude    = indentation ++ "}"
+    newline     = ',' : indentation
+    fields      = map (\(name, value) -> name ++ " = " ++ pprint (n+1) value) xs
+
+instance PPrint a => PPrint (Maybe a) where
+    pprint n (Just x) = "Just (" ++ pprint n x ++ ")"
+    pprint _ x        = show x
+
+instance PPrint a => PPrint [a] where
+    pprint _ [] = "[]"
+    pprint n xs = preamble ++ intercalate newline allLines ++ postlude where
+        indentation = '\n' : replicate n '\t'
+        preamble    = "[" ++ indentation
+        allLines    = map (pprint (n+1)) xs
+        newline     = ',' : indentation
+        postlude    = indentation ++ "]"
+
+instance PPrint Rectangle where
+    pprint n x = record "Rectangle" n [
+        ("rect_x", P (rect_x x)),
+        ("rect_y", P (rect_y x)),
+        ("rect_width", P (rect_width x)),
+        ("rect_height", P (rect_height x))
+        ]
+
+instance PPrint a => PPrint (Stack a) where
+    pprint n x = record "Stack" n [
+        ("focus", P (XMonad.StackSet.focus x)),
+        ("up", P (up x)),
+        ("down", P (down x))
+        ]
+
+instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where
+    pprint n x = record "Workspace" n [
+        ("tag", P (tag x)),
+        ("layout", P (layout x)),
+        ("stack", P (stack x))
+        ]
+
+instance PPrint ScreenDetail where
+    pprint n x = record "SD" n [("screenRect", P (screenRect x))]
+
+instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where
+    pprint n x = record "Screen" n [
+        ("workspace", P (workspace x)),
+        ("screen", P (screen x)),
+        ("screenDetail", P (screenDetail x))
+        ]
+
+instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where
+    pprint n x = record "StackSet" n [
+        ("current", P (current x)),
+        ("visible", P (visible x)),
+        ("hidden", P (hidden x)),
+        ("floating", P (floating x))
+        ]
+
+instance PPrint (Layout a)
+instance PPrint Int
+instance PPrint XMonad.Screen
+instance PPrint Integer
+instance PPrint Position
+instance PPrint Dimension
+instance PPrint Char
+instance PPrint Word64
+instance PPrint ScreenId
+instance (Show a, Show b) => PPrint (Map a b)
+-- }}}
+-- main {{{
+dmwitConfig nScreens = docks $ def {
+    borderWidth             = 2,
+    workspaces              = withScreens nScreens (map show [1..5]),
+    terminal                = "urxvt",
+    normalBorderColor       = dark,
+    focusedBorderColor      = bright,
+    modMask                 = mod4Mask,
+    keys                    = keyBindings,
+    layoutHook              = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,
+    manageHook              =     (title =? "CGoban: Main Window" --> doF sinkFocus)
+                              <+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
+                              <+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
+                              <+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one
+                              <+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
+                              <+> fullscreenMPlayer
+                              <+> floatAll ["Gimp", "Wine"]
+                              <+> manageSpawn,
+    logHook                 = allPPs nScreens,
+    startupHook             = refresh
+                           >> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]
+    }
+
+main = countScreens >>= xmonad . dmwitConfig
+-- }}}
+-- keybindings {{{
+keyBindings conf = let m = modMask conf in fromList . anyMask $ [
+    ((m                , xK_BackSpace  ), spawnHere "urxvt"),
+    ((m                , xK_p          ), spawnHere launcher),
+    ((m .|. shiftMask  , xK_p          ), spawnHere termLauncher),
+    ((m .|. shiftMask  , xK_c          ), kill),
+    ((m                , xK_q          ), restart "xmonad" True),
+    ((m .|. shiftMask  , xK_q          ), io (exitWith ExitSuccess)),
+    ((m                , xK_grave      ), sendMessage NextLayout),
+    ((m .|. shiftMask  , xK_grave      ), setLayout $ layoutHook conf),
+    ((m                , xK_o          ), sendMessage Toggle),
+    ((m                , xK_x          ), withFocused (windows . sink)),
+    ((m                , xK_Home       ), windows focusUp),
+    ((m .|. shiftMask  , xK_Home       ), windows swapUp),
+    ((m                , xK_End        ), windows focusDown),
+    ((m .|. shiftMask  , xK_End        ), windows swapDown),
+    ((m                , xK_a          ), windows focusMaster),
+    ((m .|. shiftMask  , xK_a          ), windows swapMaster),
+    ((m                , xK_Control_L  ), withScreen 0 view),
+    ((m .|. shiftMask  , xK_Control_L  ), withScreen 0 viewShift),
+    ((m                , xK_Alt_L      ), withScreen 1 view),
+    ((m .|. shiftMask  , xK_Alt_L      ), withScreen 1 viewShift),
+    ((m                , xK_u          ), centerMouse),
+    ((m .|. shiftMask  , xK_u          ), statusBarMouse),
+    ((m                , xK_s          ), spawnHere "chromium --password-store=gnome"),
+    ((m                , xK_n          ), spawnHere "gvim todo"),
+    ((m                , xK_t          ), spawnHere "mpc toggle"),
+    ((m                , xK_h          ), spawnHere "urxvt -e alsamixer"),
+    ((m                , xK_d          ), spawnHere "wyvern"),
+    ((m                , xK_l          ), spawnHere "urxvt -e sup"),
+    ((m                , xK_r          ), spawnHere "urxvt -e ncmpcpp"),
+    ((m                , xK_c          ), spawnHere "urxvt -e ghci"),
+    ((m                , xK_g          ), spawnHere "slock" >> spawnHere "xscreensaver-command -lock"),
+    ((m                , xK_f          ), spawnHere "gvim ~/.xmonad/xmonad.hs"),
+    ((      noModMask  , xK_F8         ), showMod "sink input" (-4)),
+    ((      noModMask  , xK_F9         ), showMod "sink input"   4 ),
+    ((      shiftMask  , xK_F8         ), showMod "sink"       (-4)),
+    ((      shiftMask  , xK_F9         ), showMod "sink"         4 ),
+    ((      noModMask  , xK_Super_L    ), return ()) -- make VirtualBox ignore stray hits of the Windows key
+    ] ++ [
+    ((m .|. e          , key           ), windows (onCurrentScreen f ws))
+    | (key, ws) <- zip [xK_1..xK_9] (workspaces' conf)
+    , (e, f)    <- [(0, view), (shiftMask, viewShift)]
+    ]
+
+atSchool school home = do
+    host <- liftIO (getEnv "HOST")
+    return $ case host of
+        "sorghum"   -> home
+        "buckwheat" -> home
+        _           -> school
+
+anyMask xs = do
+    ((mask, key), action) <- xs
+    extraMask             <- [0, controlMask, altMask, controlMask .|. altMask]
+    return ((mask .|. extraMask, key), action)
+-- }}}
+-- logHook {{{
+pipeName n s = "/home/dmwit/.xmonad/pipe-" ++ n ++ "-" ++ show s
+
+xmobarCommand (S s) = unwords ["xmobar",
+    "-x", show s,
+    "-t", template s,
+    "-C", pipeReader
+    ]
+    where
+    template 0 = "}%focus%{%workspaces%"
+    template _ = "%date%}%focus%{%workspaces%"
+    pipeReader = "'[\
+        \Run PipeReader \"" ++ pipeName "focus"      s ++ "\" \"focus\",\
+        \Run PipeReader \"" ++ pipeName "workspaces" s ++ "\" \"workspaces\"\
+        \]'"
+
+allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]]
+color c = xmobarColor c ""
+
+ppFocus s@(S s_) = whenCurrentOn s def {
+    ppOrder  = \(_:_:windowTitle:_) -> [windowTitle],
+    ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
+    }
+
+ppWorkspaces s@(S s_) = marshallPP s def {
+    ppCurrent           = color "white",
+    ppVisible           = color "white",
+    ppHiddenNoWindows   = color dark,
+    ppUrgent            = color "red",
+    ppSep               = "",
+    ppOrder             = \(wss:_layout:_title:_) -> [wss],
+    ppOutput            = appendFile (pipeName "workspaces" s_) . (++"\n")
+    }
+-- }}}

XMonad/Config/Droundy.hs

@@ -1,4 +1,5 @@
-{-# OPTIONS_GHC -fno-warn-missing-signatures -fglasgow-exts -fno-warn-orphans #-}
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
 -----------------------------------------------------------------------------
 -- |
 -- Copyright   :  (c) Spencer Janssen 2007
@@ -10,13 +11,12 @@ module XMonad.Config.Droundy ( config, mytab ) where
 
 import XMonad hiding (keys, config, (|||))
 import qualified XMonad (keys)
-import XMonad.Config ( defaultConfig )
 
 import qualified XMonad.StackSet as W
 import qualified Data.Map as M
 import System.Exit ( exitWith, ExitCode(ExitSuccess) )
 
-import XMonad.Layout.Tabbed ( tabbed, defaultTheme,
+import XMonad.Layout.Tabbed ( tabbed,
                               shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
 import XMonad.Layout.Combo ( combineTwo )
 import XMonad.Layout.Named ( named )
@@ -32,7 +32,7 @@ import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
 import XMonad.Layout.ShowWName ( showWName )
 import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
 
-import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )
+import XMonad.Prompt ( font, height, XPConfig )
 import XMonad.Prompt.Layout ( layoutPrompt )
 import XMonad.Prompt.Shell ( shellPrompt )
 
@@ -42,12 +42,12 @@ import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
 import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
                                 Direction1D( Prev, Next) )
 
-import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
+import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
 import XMonad.Hooks.EwmhDesktops ( ewmh )
 
 myXPConfig :: XPConfig
-myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
-                             ,height=22}
+myXPConfig = def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
+                 ,height=22}
 
 
 ------------------------------------------------------------------------
@@ -117,7 +117,7 @@ keys x = M.fromList $
     ++
     zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
 
-config = ewmh defaultConfig
+config = docks $ ewmh def
          { borderWidth = 1 -- Width of the window border in pixels.
          , XMonad.workspaces = ["mutt","iceweasel"]
          , layoutHook = showWName $ workspaceDir "~" $
@@ -129,7 +129,6 @@ config = ewmh defaultConfig
                         named "widescreen" ((mytab *||* mytab)
                                                 ****//* combineTwo Square mytab mytab) --   |||
                         --mosaic 0.25 0.5
-         , manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
          , terminal = "xterm" -- The preferred terminal program.
          , normalBorderColor = "#222222" -- Border color for unfocused windows.
          , focusedBorderColor = "#00ff00" -- Border color for focused windows.
@@ -137,7 +136,7 @@ config = ewmh defaultConfig
          , XMonad.keys = keys
          }
 
-mytab = tabbed CustomShrink defaultTheme
+mytab = tabbed CustomShrink def
 
 instance Shrinker CustomShrink where
     shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s'

XMonad/Config/Gnome.hs

@@ -18,7 +18,8 @@ module XMonad.Config.Gnome (
     -- $usage
     gnomeConfig,
     gnomeRun,
-    gnomeRegister
+    gnomeRegister,
+    desktopLayoutModifiers
     ) where
 
 import XMonad
@@ -41,7 +42,7 @@ import System.Environment (getEnvironment)
 
 gnomeConfig = desktopConfig
     { terminal = "gnome-terminal"
-    , keys     = \c -> gnomeKeys c `M.union` keys desktopConfig c
+    , keys     = gnomeKeys <+> keys desktopConfig
     , startupHook = gnomeRegister >> startupHook desktopConfig }
 
 gnomeKeys (XConfig {modMask = modm}) = M.fromList $
@@ -74,7 +75,7 @@ gnomeRegister = io $ do
     x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
     whenJust x $ \sessionId -> safeSpawn "dbus-send"
             ["--session"
-            ,"--print-reply=string"
+            ,"--print-reply=literal"
             ,"--dest=org.gnome.SessionManager"
             ,"/org/gnome/SessionManager"
             ,"org.gnome.SessionManager.RegisterClient"

XMonad/Config/Kde.hs

@@ -17,7 +17,8 @@ module XMonad.Config.Kde (
     -- * Usage
     -- $usage
     kdeConfig,
-    kde4Config
+    kde4Config,
+    desktopLayoutModifiers
     ) where
 
 import XMonad
@@ -40,11 +41,11 @@ import qualified Data.Map as M
 
 kdeConfig = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kdeKeys c `M.union` keys desktopConfig c }
+    , keys     = kdeKeys <+> keys desktopConfig }
 
 kde4Config = desktopConfig
     { terminal = "konsole"
-    , keys     = \c -> kde4Keys c `M.union` keys desktopConfig c }
+    , keys     = kde4Keys <+> keys desktopConfig }
 
 kdeKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "dcop kdesktop default popupExecuteCommand")

XMonad/Config/Mate.hs

@@ -0,0 +1,88 @@
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Config.Mate
+-- Copyright    : (c) Brandon S Allbery KF8NH, 2014
+-- License      : BSD
+--
+-- Maintainer   : allbery.b@gmail.com
+-- Stability    :  unstable
+-- Portability  :  unportable
+--
+-- This module provides a config suitable for use with the MATE desktop
+-- environment.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Config.Mate (
+    -- * Usage
+    -- $usage
+    mateConfig,
+    mateRun,
+    mateRegister,
+    desktopLayoutModifiers
+    ) where
+
+import XMonad
+import XMonad.Config.Desktop
+import XMonad.Util.Run (safeSpawn)
+
+import qualified Data.Map as M
+
+import System.Environment (getEnvironment)
+
+-- $usage
+-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad
+-- > import XMonad.Config.Mate
+-- >
+-- > main = xmonad mateConfig
+--
+-- For examples of how to further customize @mateConfig@ see "XMonad.Config.Desktop".
+
+mateConfig = desktopConfig
+    { terminal = "mate-terminal"
+    , keys     = mateKeys <+> keys desktopConfig
+    , startupHook = mateRegister >> startupHook desktopConfig }
+
+mateKeys (XConfig {modMask = modm}) = M.fromList $
+    [ ((modm, xK_p), mateRun)
+    , ((modm .|. shiftMask, xK_q), spawn "mate-session-save --logout-dialog") ]
+
+-- | Launch the "Run Application" dialog.  mate-panel must be running for this
+-- to work.
+mateRun :: X ()
+mateRun = withDisplay $ \dpy -> do
+    rw <- asks theRoot
+    mate_panel <- getAtom "_MATE_PANEL_ACTION"
+    panel_run  <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG"
+
+    io $ allocaXEvent $ \e -> do
+        setEventType e clientMessage
+        setClientMessageEvent e rw mate_panel 32 panel_run 0
+        sendEvent dpy rw False structureNotifyMask e
+        sync dpy False
+
+-- | Register xmonad with mate. 'dbus-send' must be in the $PATH with which
+-- xmonad is started.
+--
+-- This action reduces a delay on startup only if you have configured
+-- mate-session to start xmonad with a command such as (check local
+-- documentation):
+--
+-- > dconf write /org/mate/desktop/session/required_components/windowmanager "'xmonad'"
+--
+-- (the extra quotes are required by dconf)
+mateRegister :: MonadIO m => m ()
+mateRegister = io $ do
+    x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
+    whenJust x $ \sessionId -> safeSpawn "dbus-send"
+            ["--session"
+            ,"--print-reply=literal"
+            ,"--dest=org.mate.SessionManager"
+            ,"/org/mate/SessionManager"
+            ,"org.mate.SessionManager.RegisterClient"
+            ,"string:xmonad"
+            ,"string:"++sessionId]

XMonad/Config/Prime.hs

@@ -0,0 +1,689 @@
+{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Config.Prime
+-- Copyright   :  Devin Mullins <devin.mullins@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <devin.mullins@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This is a draft of a brand new config syntax for xmonad. It aims to be:
+--
+--  * easier to copy/paste snippets from the docs
+--
+--  * easier to get the gist for what's going on, for you imperative programmers
+--
+-- It's brand new, so it's pretty much guaranteed to break or change syntax.
+-- But what's the worst that could happen? Xmonad crashes and logs you out?
+-- It probably won't do that. Give it a try.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Config.Prime (
+-- Note: The identifiers here are listed in the order that makes the most sense
+-- for a user, while the definitions below are listed in the order that makes
+-- the most sense for a developer.
+
+-- * Start here
+-- $start_here
+xmonad,
+nothing,
+-- * Attributes you can set
+-- $settables
+normalBorderColor,
+focusedBorderColor,
+terminal,
+modMask,
+borderWidth,
+focusFollowsMouse,
+clickJustFocuses,
+SettableClass(..),
+UpdateableClass(..),
+
+-- * Attributes you can add to
+-- $summables
+manageHook,
+handleEventHook,
+workspaces,
+logHook,
+startupHook,
+clientMask,
+rootMask,
+SummableClass(..),
+
+-- * Attributes you can add to or remove from
+-- $removables
+keys,
+mouseBindings,
+RemovableClass(..),
+
+-- * Modifying the list of workspaces
+-- $workspaces
+withWorkspaces,
+wsNames,
+wsKeys,
+wsActions,
+wsSetName,
+
+-- * Modifying the screen keybindings
+-- $screens
+withScreens,
+sKeys,
+sActions,
+onScreens,
+
+-- * Modifying the layoutHook
+-- $layout
+addLayout,
+resetLayout,
+modifyLayout,
+
+-- * Updating the XConfig en masse
+-- $update
+startWith,
+apply,
+applyIO,
+
+-- * The rest of the world
+-- | Everything you know and love from the core "XMonad" module is available
+-- for use in your config file, too.
+module XMonad,
+-- | (Almost) everything you know and love from the Haskell "Prelude" is
+-- available for use in your config file. Note that '>>' has been overriden, so
+-- if you want to create do-blocks for normal monads, you'll need some let
+-- statements or a separate module. (See the Troubleshooting section.)
+module Prelude,
+
+-- * Core
+-- | These are the building blocks on which the config language is built.
+-- Regular people shouldn't need to know about these.
+Prime,
+Arr,
+(>>),
+ifThenElse,
+
+-- * Example config
+-- $example
+
+-- * Troubleshooting
+-- $troubleshooting
+) where
+
+import Prelude hiding ((>>), mod)
+import qualified Prelude as P ((>>=), (>>))
+
+import Data.Monoid (All)
+
+import XMonad hiding (xmonad, XConfig(..))
+import XMonad (XConfig(XConfig))
+import qualified XMonad.StackSet as W
+import qualified XMonad as X (xmonad, XConfig(..))
+
+import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)
+
+-- $start_here
+-- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this:
+--
+-- > {-# LANGUAGE RebindableSyntax #-}
+-- > import XMonad.Config.Prime
+-- >
+-- > -- Imports go here.
+-- >
+-- > main = xmonad $ do
+-- >   nothing
+-- >   -- Configs go here.
+--
+-- This will give you a default xmonad install, with room to grow. The lines
+-- starting with double dashes are comments. You may delete them. Note that
+-- Haskell is a bit precise about indentation. Make sure all the statements in
+-- your do-block start at the same column, and make sure that any multi-line
+-- statements are formatted with a hanging indent. (For an example, see the
+-- 'keys =+' statement in the /Example config/ section, below.)
+--
+-- After changing your config file, restart xmonad with mod-q (where, by
+-- default, "mod" == "alt").
+
+--
+-- The Prime "Monad"
+--
+
+-- | A Prime is a function that transforms an XConfig. It's not a monad, but we
+-- turn on RebindableSyntax so we can abuse the pretty do notation.
+type Prime l l' = Arr (XConfig l) (XConfig l')
+
+-- | An Arr is a generalization of Prime. Don't reference the type, if you can
+-- avoid it. It might go away in the future.
+type Arr x y = x -> IO y
+
+-- | Composes two Arrs using 'Prelude.>>=' from "Prelude".
+(>>) :: Arr x y -> Arr y z -> Arr x z
+(>>) x y c = (P.>>=) (x c) y
+
+-- | Because of RebindableSyntax, this is necessary to enable you to use
+-- if-then-else expressions. No need to call it directly.
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse True  a _ = a
+ifThenElse False _ b = b
+
+-- | This is the xmonad main function. It passes 'XMonad.Config.def' (the
+-- default 'XConfig') into your do-block, takes the modified config out of your
+-- do-block, and then runs xmonad.
+--
+-- The do-block is a 'Prime'. Advanced readers can skip right to that
+-- definition.
+
+xmonad :: (Default a, Read (l Window), LayoutClass l Window) =>
+          (a -> IO (XConfig l)) -> IO ()
+xmonad prime = (P.>>=) (prime def) X.xmonad
+
+-- | This doesn't modify the config in any way. It's just here for your initial
+-- config because Haskell doesn't allow empty do-blocks. Feel free to delete it
+-- once you've added other stuff.
+nothing :: Prime l l
+nothing = return
+
+-- $settables
+-- These are a bunch of attributes that you can set. Syntax looks like this:
+--
+-- >   terminal =: "urxvt"
+--
+-- Strings are double quoted, Dimensions are unquoted integers, booleans are
+-- 'True' or 'False' (case-sensitive), and 'modMask' is usually 'mod1Mask' or
+-- 'mod4Mask'.
+
+class UpdateableClass s x y | s -> x y where
+  -- | This lets you apply a function to an attribute (i.e. read, modify, write).
+  (=.) :: s c -> (x -> y) -> Arr c c
+
+class SettableClass s x y | s -> x y where
+  -- | This lets you modify an attribute.
+  (=:) :: s c -> y -> Arr c c
+
+-- Undecideable instance. But it's nice to leave open the possibility to write
+-- fields you can't read (e.g. `wmName =: ...`).
+instance UpdateableClass s x y => SettableClass s x y where
+  s =: y = s =. const y
+
+data Settable x c = Settable (c -> x)      -- getter
+                             (x -> c -> c) -- setter
+
+instance UpdateableClass (Settable x) x x where
+  (Settable g s =. f) c = return $ s (f $ g c) c
+
+-- | Non-focused windows border color. Default: @\"#dddddd\"@
+normalBorderColor :: Settable String (XConfig l)
+normalBorderColor = Settable X.normalBorderColor (\x c -> c { X.normalBorderColor = x })
+
+-- | Focused windows border color. Default: @\"#ff0000\"@
+focusedBorderColor :: Settable String (XConfig l)
+focusedBorderColor = Settable X.focusedBorderColor (\x c -> c { X.focusedBorderColor = x })
+
+-- | The preferred terminal application. Default: @\"xterm\"@
+terminal :: Settable String (XConfig l)
+terminal = Settable X.terminal (\x c -> c { X.terminal = x })
+
+-- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is
+-- probably alt on your computer).
+modMask :: Settable KeyMask (XConfig l)
+modMask = Settable X.modMask (\x c -> c { X.modMask = x })
+
+-- | The border width (in pixels). Default: @1@
+borderWidth :: Settable Dimension (XConfig l)
+borderWidth = Settable X.borderWidth (\x c -> c { X.borderWidth = x })
+
+-- | Whether window focus follows the mouse cursor on move, or requires a mouse
+-- click. (Mouse? What's that?) Default: @True@
+focusFollowsMouse :: Settable Bool (XConfig l)
+focusFollowsMouse = Settable X.focusFollowsMouse (\x c -> c { X.focusFollowsMouse = x })
+
+-- | If True, a mouse click on an inactive window focuses it, but the click is
+-- not passed to the window. If False, the click is also passed to the window.
+-- Default @True@
+clickJustFocuses :: Settable Bool (XConfig l)
+clickJustFocuses = Settable X.clickJustFocuses (\x c -> c { X.clickJustFocuses = x })
+
+-- $summables
+-- In addition to being able to set these attributes, they have a special
+-- syntax for being able to add to them. The operator is @=+@ (the plus comes
+-- /after/ the equals), but each attribute has a different syntax for what
+-- comes after the operator.
+
+class SummableClass s y | s -> y where
+  -- | This lets you add to an attribute.
+  (=+) :: s c -> y -> Arr c c
+  infix 0 =+
+
+data Summable x y c = Summable (c -> x)      -- getter
+                               (x -> c -> c) -- setter
+                               (x -> y -> x) -- accumulator
+
+instance UpdateableClass (Summable x y) x x where
+  (Summable g s _ =. f) c = return $ s (f $ g c) c
+
+instance SummableClass (Summable x y) y where
+  (Summable g s a =+ y) c = return $ s (g c `a` y) c
+
+-- | The action to run when a new window is opened. Default:
+--
+-- >   manageHook =: composeAll [className =? "MPlayer" --> doFloat, className =? "Gimp" --> doFloat]
+--
+-- To add more rules to this list, you can say, for instance:
+--
+-- > import XMonad.StackSet
+-- > ...
+-- >   manageHook =+ (className =? "Emacs" --> doF kill)
+-- >   manageHook =+ (className =? "Vim" --> doF shiftMaster)
+--
+-- Note that operator precedence mandates the parentheses here.
+manageHook :: Summable ManageHook ManageHook (XConfig l)
+manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>)
+
+-- | Custom X event handler. Return @All True@ if the default handler should
+-- also be run afterwards. Default does nothing. To add an event handler:
+--
+-- > import XMonad.Hooks.ServerMode
+-- > ...
+-- >   handleEventHook =+ serverModeEventHook
+handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
+handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>)
+
+-- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding
+-- appends to the end:
+--
+-- >   workspaces =+ ["0"]
+--
+-- This is useless unless you also create keybindings for this.
+workspaces :: Summable [String] [String] (XConfig l)
+workspaces = Summable X.workspaces (\x c -> c { X.workspaces = x }) (++)
+
+-- | The action to perform when the windows set is changed. This happens
+-- whenever focus change, a window is moved, etc. @logHook =+@ takes an @X ()@
+-- and appends it via '(>>)'. For instance:
+--
+-- > import XMonad.Hooks.ICCCMFocus
+-- > ...
+-- >   logHook =+ takeTopFocus
+--
+-- Note that if your expression is parametrically typed (e.g. of type
+-- @MonadIO m => m ()@), you'll need to explicitly annotate it, like so:
+--
+-- >   logHook =+ (io $ putStrLn "Hello, world!" :: X ())
+logHook :: Summable (X ()) (X ()) (XConfig l)
+logHook = Summable X.logHook (\x c -> c { X.logHook = x }) (P.>>)
+
+-- | The action to perform on startup. @startupHook =+@ takes an @X ()@ and
+-- appends it via '(>>)'. For instance:
+--
+-- > import XMonad.Hooks.SetWMName
+-- > ...
+-- >   startupHook =+ setWMName "LG3D"
+--
+-- Note that if your expression is parametrically typed (e.g. of type
+-- @MonadIO m => m ()@), you'll need to explicitly annotate it, as documented
+-- in 'logHook'.
+startupHook :: Summable (X ()) (X ()) (XConfig l)
+startupHook = Summable X.startupHook (\x c -> c { X.startupHook = x }) (P.>>)
+
+-- | The client events that xmonad is interested in. This is useful in
+-- combination with handleEventHook. Default: @structureNotifyMask .|.
+-- enterWindowMask .|. propertyChangeMask@
+--
+-- >   clientMask =+ keyPressMask .|. keyReleaseMask
+clientMask :: Summable EventMask EventMask (XConfig l)
+clientMask = Summable X.clientMask (\x c -> c { X.clientMask = x }) (.|.)
+
+-- | The root events that xmonad is interested in. This is useful in
+-- combination with handleEventHook. Default: @substructureRedirectMask .|.
+-- substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|.
+-- structureNotifyMask .|. buttonPressMask@
+rootMask :: Summable EventMask EventMask (XConfig l)
+rootMask = Summable X.rootMask (\x c -> c { X.rootMask = x }) (.|.)
+
+-- $removables
+-- The following support the the @=+@ for adding items and the @=-@ operator
+-- for removing items.
+
+class RemovableClass r y | r -> y where
+  -- | This lets you remove from an attribute.
+  (=-) :: r c -> y -> Arr c c
+  infix 0 =-
+
+data Keys c = Keys { kAdd :: [(String, X ())] -> c -> c,
+                     kRemove :: [String] -> c -> c }
+
+instance SummableClass Keys [(String, X ())] where
+  Keys { kAdd = a } =+ newKeys = return . a newKeys
+
+instance RemovableClass Keys [String] where
+  Keys { kRemove = r } =- sadKeys = return . r sadKeys
+
+-- | Key bindings to 'X' actions. Default: see @`man xmonad`@. 'keys'
+-- takes a list of keybindings specified emacs-style, as documented in
+-- 'XMonad.Util.EZConfig.mkKeyMap'. For example, to change the "kill window"
+-- key:
+--
+-- >   keys =- ["M-S-c"]
+-- >   keys =+ [("M-M1-x", kill)]
+keys :: Keys (XConfig l)
+keys = Keys {
+  -- Note that since checkKeymap happens on newKeys, it doesn't check for
+  -- duplicates between repeated applications. Probably OK. (Especially since
+  -- overriding defaults is a common behavior.) Also note that there's no
+  -- reference cycle here. Yay!
+  kAdd = \newKeys c -> (c `additionalKeysP` newKeys) { X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) },
+  kRemove = flip removeKeysP
+}
+
+data MouseBindings c = MouseBindings { mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c,
+                                       mRemove :: [(ButtonMask, Button)] -> c -> c }
+
+instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where
+  MouseBindings { mAdd = a } =+ newBindings = return . a newBindings
+
+instance RemovableClass MouseBindings [(ButtonMask, Button)] where
+  MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings
+
+-- | Mouse button bindings to an 'X' actions on a window. Default: see @`man
+-- xmonad`@. To make mod-<scrollwheel> switch workspaces:
+--
+-- > import XMonad.Actions.CycleWS (nextWS, prevWS)
+-- > ...
+-- >   mouseBindings =+ [((mod4Mask, button4), const prevWS),
+-- >                     ((mod4Mask, button5), const nextWS)]
+--
+-- Note that you need to specify the numbered mod-mask e.g. 'mod4Mask' instead
+-- of just 'modMask'.
+mouseBindings :: MouseBindings (XConfig l)
+mouseBindings = MouseBindings {
+  mAdd = flip additionalMouseBindings,
+  mRemove = flip removeMouseBindings
+}
+
+-- $workspaces
+-- Workspaces can be configured through 'workspaces', but then the 'keys' need
+-- to be set, and this can be a bit laborious. 'withWorkspaces' provides a
+-- convenient mechanism for common workspace updates.
+
+-- | Configure workspaces through a Prime-like interface. Example:
+--
+-- >   withWorkspaces $ do
+-- >     wsKeys =+ ["0"]
+-- >     wsActions =+ [("M-M1-", windows . swapWithCurrent)]
+-- >     wsSetName 1 "mail"
+--
+-- This will set 'workspaces' and add the necessary keybindings to 'keys'. Note
+-- that it won't remove old keybindings; it's just not that clever.
+withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
+withWorkspaces wsarr xconf = (P.>>=) (wsarr def) $ \wsconf -> wsprime wsconf xconf
+  where wsprime :: WorkspaceConfig -> Prime l l
+        wsprime wsconf =
+          (workspaces =: allNames) >>
+          (keys =+ [(mod ++ key, action name) | (name, key) <- zip allNames (wsKeys_ wsconf),
+                                                (mod, action) <- wsActions_ wsconf])
+          where allNames = zipWith chooseName (wsNames_ wsconf) (wsKeys_ wsconf)
+                chooseName name keyspec = if not (null name) then name else keyspec
+
+data WorkspaceConfig = WorkspaceConfig {
+  wsNames_ :: [String],
+  wsKeys_ :: [String],
+  wsActions_ :: [(String, String -> X ())]
+}
+
+instance Default WorkspaceConfig where
+  def = WorkspaceConfig {
+    wsNames_ = repeat "",
+    wsKeys_ = map (:[]) ['1'..'9'], -- The hungry monkey eats dots and turns them into numbers.
+    wsActions_ = [("M-", windows . W.greedyView),
+                  ("M-S-", windows . W.shift)]
+  }
+
+-- | The list of workspace names, like 'workspaces' but with two differences:
+--
+--   1. If any entry is the empty string, it'll be replaced with the
+--      corresponding entry in 'wsKeys'.
+--   2. The list is truncated to the size of 'wsKeys'.
+--
+-- The default value is @'repeat' ""@.
+--
+-- If you'd like to create workspaces without associated keyspecs, you can do
+-- that afterwards, outside the 'withWorkspaces' block, with @'workspaces' =+@.
+wsNames :: Settable [String] WorkspaceConfig
+wsNames = Settable wsNames_ (\x c -> c { wsNames_ = x })
+
+-- | The list of workspace keys. These are combined with the modifiers in
+-- 'wsActions' to form the keybindings for navigating to workspaces. Default:
+-- @["1","2",...,"9"]@.
+wsKeys :: Summable [String] [String] WorkspaceConfig
+wsKeys = Summable wsKeys_ (\x c -> c { wsKeys_ = x }) (++)
+
+-- | Mapping from key prefix to command. Its type is @[(String, String ->
+-- X())]@. The key prefix may be a modifier such as @\"M-\"@, or a submap
+-- prefix such as @\"M-a \"@, or both, as in @\"M-a M-\"@. The command is a
+-- function that takes a workspace name and returns an @X ()@. 'withWorkspaces'
+-- creates keybindings for the cartesian product of 'wsKeys' and 'wsActions'.
+--
+-- Default:
+--
+-- > [("M-", windows . W.greedyView),
+-- >  ("M-S-", windows . W.shift)]
+wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig
+wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++)
+
+-- | A convenience for just modifying one entry in 'wsNames', in case you only
+-- want a few named workspaces. Example:
+--
+-- >     wsSetName 1 "mail"
+-- >     wsSetName 2 "web"
+wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
+wsSetName index newName = wsNames =. (map maybeSet . zip [0..])
+  where maybeSet (i, oldName) | i == (index - 1) = newName
+                              | otherwise = oldName
+
+-- $screens
+-- 'withScreens' provides a convenient mechanism to set keybindings for moving
+-- between screens, much like 'withWorkspaces'.
+
+-- | Configure screen keys through a Prime-like interface:
+--
+-- >   withScreens $ do
+-- >     sKeys =: ["e", "r"]
+--
+-- This will add the necessary keybindings to 'keys'. Note that it won't remove
+-- old keybindings; it's just not that clever.
+withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
+withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
+  where sprime :: ScreenConfig -> Prime l l
+        sprime sconf =
+          (keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
+                                               (mod, action) <- sActions_ sconf])
+
+data ScreenConfig = ScreenConfig {
+  sKeys_ :: [String],
+  sActions_ :: [(String, ScreenId -> X ())]
+}
+
+instance Default ScreenConfig where
+  def = ScreenConfig {
+    sKeys_ = ["w", "e", "r"],
+    sActions_ = [("M-", windows . onScreens W.view),
+                 ("M-S-", windows . onScreens W.shift)]
+  }
+
+
+-- | The list of screen keys. These are combined with the modifiers in
+-- 'sActions' to form the keybindings for navigating to workspaces. Default:
+-- @["w","e","r"]@.
+sKeys :: Summable [String] [String] ScreenConfig
+sKeys = Summable sKeys_ (\x c -> c { sKeys_ = x }) (++)
+
+-- | Mapping from key prefix to command. Its type is @[(String, ScreenId ->
+-- X())]@. Works the same as 'wsActions' except for a different function type.
+--
+-- Default:
+--
+-- > [("M-", windows . onScreens W.view),
+-- >  ("M-S-", windows . onScreens W.shift)]
+sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig
+sActions = Summable sActions_ (\x c -> c { sActions_ = x }) (++)
+
+-- | Converts a stackset transformer parameterized on the workspace type into one
+-- parameterized on the screen type. For example, you can use @onScreens W.view
+-- 0@ to navigate to the workspace on the 0th screen. If the screen id is not
+-- recognized, the returned transformer acts as an identity function.
+onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) ->
+                     s -> W.StackSet i l a s sd -> W.StackSet i l a s sd
+onScreens f sc ws = maybe id f (W.lookupWorkspace sc ws) ws
+
+-- $layout
+-- Layouts are special. You can't modify them using the @=:@ or @=.@ operator.
+-- You need to use the following functions.
+
+-- | Add a layout to the list of layouts choosable with mod-space. For instance:
+--
+-- > import XMonad.Layout.Tabbed
+-- > ...
+-- >   addLayout simpleTabbed
+addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r)
+addLayout r c = return c { X.layoutHook = X.layoutHook c ||| r }
+
+-- | Reset the layoutHook from scratch. For instance, to get rid of the wide
+-- layout:
+--
+-- >   resetLayout $ Tall 1 (3/100) (1/2) ||| Full
+--
+-- (The dollar is like an auto-closing parenthesis, so all the stuff to the
+-- right of it is treated like an argument to resetLayout.)
+resetLayout :: (LayoutClass r Window) => r Window -> Prime l r
+resetLayout r c = return c { X.layoutHook = r }
+
+-- | Modify your 'layoutHook' with some wrapper function. You probably want to call
+-- this after you're done calling 'addLayout'. Example:
+--
+-- > import XMonad.Layout.NoBorders
+-- > ...
+-- >   modifyLayout smartBorders
+modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r
+modifyLayout f c = return c { X.layoutHook = f $ X.layoutHook c }
+
+-- $update
+-- Finally, there are a few contrib modules that bundle multiple attribute
+-- updates together. There are three types: 1) wholesale replacements for the
+-- default config, 2) pure functions on the config, and 3) IO actions on the
+-- config. The syntax for each is different. Examples:
+--
+-- 1) To start with a 'XMonad.Config.Gnome.gnomeConfig' instead of the default,
+-- we use 'startWith':
+--
+-- > import XMonad.Config.Gnome
+-- > ...
+-- >   startWith gnomeConfig
+--
+-- 2) 'XMonad.Hooks.UrgencyHook.withUrgencyHook' is a pure function, so we need
+-- to use 'apply':
+--
+-- > import XMonad.Hooks.UrgencyHook
+-- > ...
+-- >   apply $ withUrgencyHook dzenUrgencyHook
+--
+-- 3) 'XMonad.Hooks.DynamicLog.xmobar' returns an @IO (XConfig l)@, so we need
+-- to use 'applyIO':
+--
+-- > import XMonad.Hooks.DynamicLog
+-- > ...
+-- >   applyIO xmobar
+
+-- | Replace the current 'XConfig' with the given one. If you use this, you
+-- probably want it to be the first line of your config.
+startWith :: XConfig l' -> Prime l l'
+startWith = const . return
+
+-- | Turns a pure function on 'XConfig' into a 'Prime'.
+apply :: (XConfig l -> XConfig l') -> Prime l l'
+apply f = return . f
+
+-- | Turns an IO function on 'XConfig' into a 'Prime'.
+applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l'
+applyIO = id  -- This is here in case we want to change the Prime type later.
+
+-- $example
+-- As an example, I've included below a subset of my current config. Note that
+-- my import statements specify individual identifiers in parentheticals.
+-- That's optional. The default is to import the entire module. I just find it
+-- helpful to remind me where things came from.
+--
+-- > {-# LANGUAGE RebindableSyntax #-}
+-- > import XMonad.Config.Prime
+-- >
+-- > import XMonad.Actions.CycleWS (prevWS, nextWS)
+-- > import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
+-- > import XMonad.Actions.WindowNavigation (withWindowNavigation)
+-- > import XMonad.Layout.Fullscreen (fullscreenSupport)
+-- > import XMonad.Layout.NoBorders (smartBorders)
+-- > import XMonad.Layout.Tabbed (simpleTabbed)
+-- >
+-- > main = xmonad $ do
+-- >   modMask =: mod4Mask
+-- >   normalBorderColor =: "#222222"
+-- >   terminal =: "urxvt"
+-- >   focusFollowsMouse =: False
+-- >   resetLayout $ Tall 1 (3/100) (1/2) ||| simpleTabbed
+-- >   modifyLayout smartBorders
+-- >   apply fullscreenSupport
+-- >   applyIO $ withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
+-- >   withWorkspaces $ do
+-- >     wsKeys =+ ["0"]
+-- >     wsActions =+ [("M-M1-", windows . swapWithCurrent)]
+-- >   keys =+ [
+-- >       ("M-,",                      sendMessage $ IncMasterN (-1)),
+-- >       ("M-.",                      sendMessage $ IncMasterN 1),
+-- >       ("M-M1-d",                   spawn "date | dzen2 -fg '#eeeeee' -p 2"),
+-- >       ("C-S-q",                    return ()),
+-- >       ("<XF86AudioLowerVolume>",   spawn "amixer set Master 5%-"),
+-- >       ("<XF86AudioRaiseVolume>",   spawn "amixer set Master 5%+"),
+-- >       ("M-M1-x",                   kill),
+-- >       ("M-i",                      prevWS),
+-- >       ("M-o",                      nextWS)
+-- >     ]
+
+-- $troubleshooting
+-- === Only the last line of my config seems to take effect. What gives?
+-- You're missing the @{-\# LANGUAGE RebindableSyntax \#-}@ line at the top.
+--
+-- === How do I do use normal monads like 'X' or 'IO'?
+-- Here are a couple of ways:
+--
+-- > import qualified Prelude as P
+-- > ...
+-- > test1, test2 :: X ()
+-- > test1 = spawn "echo Hi" P.>> spawn "echo Bye"
+-- > test2 = do spawn "echo Hi"
+-- >            spawn "echo Bye"
+-- >   where (>>) = (P.>>)
+--
+-- === How do I use the old keyboard syntax?
+-- You can use 'apply' and supply your own Haskell function. For instance:
+--
+-- > apply $ flip additionalKeys $ [((mod1Mask, xK_z), spawn "date | dzen2 -fg '#eeeeee' -p 2")]
+--
+-- === How do I run a command before xmonad starts (like 'spawnPipe')?
+-- If you're using it for a status bar, see if 'XMonad.Hooks.DynamicLog.dzen'
+-- or 'XMonad.Hooks.DynamicLog.xmobar' does what you want. If so, you can apply
+-- it with 'applyIO'.
+--
+-- If not, you can write your own @XConfig l -> IO (XConfig l)@ and apply it
+-- with 'applyIO'. When writing this function, see the above tip about using
+-- normal monads.
+--
+-- Alternatively, you could do something like this this:
+--
+-- > import qualified Prelude as P (>>)
+-- >
+-- > main =
+-- >   openFile ".xmonad.log" AppendMode >>= \log ->
+-- >   hSetBuffering log LineBuffering P.>>
+-- >   (xmonad $ do
+-- >      nothing -- Prime config here.
+-- >   )

XMonad/Config/Sjanssen.hs

@@ -6,7 +6,6 @@ import qualified XMonad.StackSet as W
 import XMonad.Actions.CopyWindow
 import XMonad.Layout.Tabbed
 import XMonad.Layout.HintedTile
-import XMonad.Config (defaultConfig)
 import XMonad.Layout.NoBorders
 import XMonad.Hooks.DynamicLog
 import XMonad.Hooks.ManageDocks
@@ -22,21 +21,21 @@ import XMonad.Layout.TwoPane
 import qualified Data.Map as M
 
 sjanssenConfig =
-    ewmh $ defaultConfig
+    docks $ ewmh $ def
         { terminal = "exec urxvt"
         , workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
         , mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
                 [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
                 , ((modm, button2), (\w -> focus w >> windows W.swapMaster))
                 , ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
-        , keys = \c -> mykeys c `M.union` keys defaultConfig c
+        , keys = \c -> mykeys c `M.union` keys def c
         , logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
         , layoutHook  = modifiers layouts
         , manageHook  = composeAll [className =? x --> doShift w
                                     | (x, w) <- [ ("Firefox", "web")
                                                 , ("Ktorrent", "7")
                                                 , ("Amarokapp", "7")]]
-                        <+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
+                        <+> manageHook def <+> manageSpawn
                         <+> (isFullscreen --> doFullFloat)
         , startupHook = mapM_ spawnOnce spawns
         }
@@ -63,8 +62,8 @@ sjanssenConfig =
         ]
 
     myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
-    myTheme = defaultTheme { fontName = myFont }
-    myPromptConfig = defaultXPConfig
+    myTheme = def { fontName = myFont }
+    myPromptConfig = def
                         { position = Top
                         , font = myFont
                         , showCompletionOnTab = True

XMonad/Config/Xfce.hs

@@ -16,7 +16,8 @@
 module XMonad.Config.Xfce (
     -- * Usage
     -- $usage
-    xfceConfig
+    xfceConfig,
+    desktopLayoutModifiers
     ) where
 
 import XMonad
@@ -36,7 +37,7 @@ import qualified Data.Map as M
 
 xfceConfig = desktopConfig
     { terminal = "Terminal"
-    , keys     = \c -> xfceKeys c `M.union` keys desktopConfig c }
+    , keys     = xfceKeys <+> keys desktopConfig }
 
 xfceKeys (XConfig {modMask = modm}) = M.fromList $
     [ ((modm,               xK_p), spawn "xfrun4")

XMonad/Config/dmwit.xmobarrc

@@ -0,0 +1,10 @@
+Config {
+    font         = "xft:Monospace:pixelsize=14,-*-*-*-r-*-*-16-*-*-*-*-*-*-*",
+    bgColor      = "#000040",
+    fgColor      = "#80c0ff",
+    position     = TopSize C 100 26,
+    lowerOnStart = True,
+    commands     = [ Run Com "date" ["+%H:%M"] "" 30 ],
+    sepChar      = "%",
+    alignSep     = "}{"
+}

XMonad/Doc.hs

@@ -49,9 +49,9 @@ import XMonad.Doc.Developing ()
 xmonad is a tiling window manager for X. The xmonad-contrib library
 collects third party tiling algorithms, hooks, configurations,
 scripts, and other extensions to xmonad.  The source for this library
-is available from <http://code.haskell.org/XMonadContrib> via darcs:
+is available from <https://github.com/xmonad/xmonad-contrib> via git:
 
-> darcs get http://code.haskell.org/XMonadContrib
+> git clone https://github.com/xmonad/xmonad-contrib.git
 
 Each stable release of xmonad is accompanied by a stable release of
 the contrib library, which you should use if (and only if) you're

XMonad/Doc/Configuring.hs

@@ -84,7 +84,7 @@ some colours:
 >
 >    import XMonad
 >
->    main = xmonad $ defaultConfig
+>    main = xmonad $ def
 >        { borderWidth        = 2
 >        , terminal           = "urxvt"
 >        , normalBorderColor  = "#cccccc"

XMonad/Doc/Developing.hs

@@ -256,6 +256,9 @@ xmonad contributed extensions.
 * Code should be compilable with "ghc-options: -Wall -Werror" set in the
 xmonad-contrib.cabal file. There should be no warnings.
 
+* Code should be free of any warnings or errors from the Hlint tool; use your
+  best judgement on some warnings like eta-reduction or bracket removal, though.
+
 * Partial functions should be avoided: the window manager should not
   crash, so never call 'error' or 'undefined'.
 

XMonad/Doc/Extending.hs

@@ -102,7 +102,7 @@ For more information about any particular module, just click on its
 name to view its Haddock documentation; each module should come with
 extensive documentation.  If you find a module that could be better
 documented, or has incorrect documentation, please report it as a bug
-(<http://code.google.com/p/xmonad/issues/list>)!
+(<https://github.com/xmonad/xmonad/issues>)!
 
 -}
 
@@ -116,6 +116,13 @@ beyond the standard keybindings provided by xmonad.
 See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to
 edit your key bindings.
 
+* "XMonad.Actions.AfterDrag":
+    Allows you to add actions dependent on the current mouse drag.
+
+* "XMonad.Actions.BluetileCommands":
+    External commands for interfacing the [Bluetile](https://hackage.haskell.org/package/bluetile)
+    tiling window manager with Xmonad.
+
 * "XMonad.Actions.Commands":
     Allows you to run internal xmonad commands (X () actions) using
     a dmenu menu in addition to key bindings.  Requires dmenu and
@@ -159,6 +166,20 @@ edit your key bindings.
     master, swap it with the next window in the stack. Focus stays in the
     master.
 
+* "XMonad.Actions.DynamicProjects":
+    Imbues workspaces with additional features so they can be treated as
+    individual project areas.
+
+* "XMonad.Actions.DynamicWorkspaceGroups":
+    Dynamically manage "workspace groups", sets of workspaces being used
+    together for some common task or purpose, to allow switching between
+    workspace groups in a single action. Note that this only makes sense for
+    multi-head setups.
+
+* "XMonad.Actions.DynamicWorkspaceOrder":
+    Remember a dynamically updateable ordering on workspaces, together with
+    tools for using this ordering with "XMonad.Actions.CycleWS" and "XMonad.Hooks.DynamicLog".
+
 * "XMonad.Actions.DynamicWorkspaces":
     Provides bindings to add and delete workspaces.  Note that you may only
     delete a workspace that is already empty.
@@ -175,7 +196,7 @@ edit your key bindings.
 * "XMonad.Actions.FloatKeys":
     Move and resize floating windows.
 
-* "XMonad.Layout.FloatSnap":
+* "XMonad.Actions.FloatSnap":
     Move and resize floating windows using other windows and the edge of the
     screen as guidelines.
 
@@ -186,6 +207,24 @@ edit your key bindings.
     GridSelect displays items(e.g. the opened windows) in a 2D grid and lets
     the user select from it with the cursor/hjkl keys or the mouse.
 
+* "XMonad.Actions.GroupNavigation":
+    Provides methods for cycling through groups of windows across workspaces,
+    ignoring windows that do not belong to this group. A group consists of all
+    windows matching a user-provided boolean query. Also provides a method for
+    jumping back to the most recently used window in any given group.
+
+* "XMonad.Actions.KeyRemap":
+    Remap Keybinding on the fly, e.g having Dvorak char,
+    but everything with Control/Shift is left US Layout.
+
+* "XMonad.Actions.Launcher":
+    A set of prompts for XMonad.
+
+* "XMonad.Actions.LinkWorkspaces":
+    Provides bindings to add and delete links between workspaces. It is aimed at
+    providing useful links between workspaces in a multihead setup.
+    Linked workspaces are view at the same time.
+
 * "XMonad.Actions.MessageFeedback":
     Alternative to 'XMonad.Operations.sendMessage' that provides knowledge
     of whether the message was handled, and utility functions based on
@@ -198,6 +237,10 @@ edit your key bindings.
     A layout modifier to resize windows with the mouse by grabbing the
     window's lower right corner.
 
+* "XMonad.Actions.Navigation2D":
+    Navigation2D is an xmonad extension that allows easy directional navigation
+    of windows and screens (in a multi-monitor setup).
+
 * "XMonad.Actions.NoBorders":
     This module provides helper functions for dealing with window borders.
 
@@ -228,6 +271,10 @@ edit your key bindings.
     A module for easily running Internet searches on web sites through xmonad.
     Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
 
+* "XMonad.Actions.ShowText":
+    ShowText displays text for sometime on the screen similar to
+    "XMonad.Util.Dzen" which offers more features (currently).
+
 * "XMonad.Actions.SimpleDate":
     An example external contrib module for XMonad.
     Provides a simple binding to dzen2 to print the date as a popup menu.
@@ -254,10 +301,16 @@ edit your key bindings.
 * "XMonad.Actions.TopicSpace":
     Turns your workspaces into a more topic oriented system.
 
+* "XMonad.Actions.TreeSelect":
+    TreeSelect displays your workspaces or actions in a Tree-like format.
+    You can select the desired workspace/action with the cursor or hjkl keys.
+    This module is fully configurable and very useful if you like to have a
+    lot of workspaces.
+
 * "XMonad.Actions.UpdateFocus":
     Updates the focus on mouse move in unfocused windows.
 
-* "XMonadContrib.UpdatePointer":
+* "XMonad.Actions.UpdatePointer":
     Causes the pointer to follow whichever window focus changes to.
 
 * "XMonad.Actions.Warp":
@@ -283,9 +336,23 @@ edit your key bindings.
     Provides functions for performing a given action on all windows of
     the current workspace.
 
+* "XMonad.Actions.Workscreen":
+    A workscreen permits to display a set of workspaces on several screens. In
+    xinerama mode, when a workscreen is viewed, workspaces associated to all
+    screens are visible. The first workspace of a workscreen is displayed on
+    first screen, second on second screen, etc. Workspace position can be easily
+    changed. If the current workscreen is called again, workspaces are shifted.
+    This also permits to see all workspaces of a workscreen even if just one screen
+    is present, and to move windows from workspace to workscreen.
+
 * "XMonad.Actions.WorkspaceCursors":
     Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
 
+* "XMonad.Actions.WorkspaceNames":
+    Provides bindings to rename workspaces, show these names in DynamicLog and
+    swap workspaces along with their names. These names survive restart. Together
+    with "XMonad.Layout.WorkspaceDir" this provides for a fully dynamic topic
+    space workflow.
 -}
 
 {- $configs
@@ -297,25 +364,56 @@ configuration; you can also simply import them and use them as your
 own configuration, possibly with some modifications.
 
 
-* "XMonad.Config.Arossato"
+* "XMonad.Config.Arossato":
     This module specifies my xmonad defaults.
 
-* "XMonad.Config.Azerty"
+* "XMonad.Config.Azerty":
     Fixes some keybindings for users of French keyboard layouts.
 
-* "XMonad.Config.Desktop"
+* "XMonad.Config.Bepo":
+    This module fixes some of the keybindings for the francophone among you who
+    use a BEPO keyboard layout. Based on "XMonad.Config.Azerty".
+
+* "XMonad.Config.Bluetile":
+    This is the default configuration of [Bluetile](http://projects.haskell.org/bluetile/).
+    If you are migrating from Bluetile to xmonad or want to create a similar setup,
+    then this will give you pretty much the same thing, except for Bluetile's
+    helper applications such as the dock.
+
+* "XMonad.Config.Desktop":
     This module provides core desktop environment settings used
     in the Gnome, Kde, and Xfce config configs. It is also useful
     for people using other environments such as lxde, or using
     tray or panel applications without full desktop environments.
 
-* "XMonad.Config.Gnome"
+* "XMonad.Config.Dmwit":
+    [dmwit](https://github.com/dmwit)'s xmonad configs and helpers.
 
-* "XMonad.Config.Kde"
+* "XMonad.Config.Droundy":
+    Droundy's xmonad config.
 
-* "XMonad.Config.Sjanssen"
+* "XMonad.Config.Gnome":
+    This module provides a config suitable for use with the GNOME desktop environment.
 
-* "XMonad.Config.Xfce"
+* "XMonad.Config.Kde":
+    This module provides a config suitable for use with the KDE desktop environment.
+
+* "XMonad.Config.Mate":
+    This module provides a config suitable for use with the MATE desktop environment.
+
+* "XMonad.Config.Prime":
+    This is a draft of a brand new config syntax for xmonad. It aims to be
+    1) easier to copy/paste snippets from the docs 2) easier to get the gist
+    for what's going on, for you imperative programmers. It's brand new, so it's
+    pretty much guaranteed to break or change syntax. But what's the worst that
+    could happen? Xmonad crashes and logs you out? It probably won't do that.
+    Give it a try.
+
+* "XMonad.Config.Sjanssen":
+    [spencerjanssen](https://github.com/spencerjanssen)'s xmonad configs.
+
+* "XMonad.Config.Xfce":
+    This module provides a config suitable for use with the Xfce desktop environment.
 
 -}
 
@@ -349,6 +447,29 @@ occur. The two most important hooks are:
 
 Here is a list of the modules found in @XMonad.Hooks@:
 
+* "XMonad.Hooks.CurrentWorkspaceOnTop":
+    Ensures that the windows of the current workspace are always in front of
+    windows that are located on other visible screens. This becomes important if
+    you use decoration and drag windows from one screen to another.
+    Using this module, the dragged window will always be in front of other windows.
+
+* "XMonad.Hooks.DebugEvents":
+    Module to dump diagnostic information about X11 events received by xmonad.
+    This is incomplete due to "Event" being incomplete and not providing
+    information about a number of events, and enforcing artificial constraints
+    on others (for example ClientMessage); the X11 package will require a number
+    of changes to fix these problems.
+
+* "XMonad.Hooks.DebugKeyEvents":
+    A debugging module to track key events, useful when you can't tell whether
+    xmonad is processing some or all key events.
+
+* "XMonad.Hooks.DebugStack":
+    Dump the state of the StackSet. A logHook and handleEventHook are also provided.
+
+* "Xmonad.Hooks.DynamicBars":
+    Manage per-screen status bars.
+
 * "XMonad.Hooks.DynamicHooks":
     One-shot and permanent ManageHooks that can be updated at runtime.
 
@@ -367,14 +488,28 @@ Here is a list of the modules found in @XMonad.Hooks@:
     which causes those windows to become slightly translucent if something
     like xcompmgr is running
 
+* "XMonad.Hooks.FadeWindows":
+    A more flexible and general compositing interface than FadeInactive. Windows
+    can be selected and opacity specified by means of FadeHooks, which are very
+    similar to ManageHooks and use the same machinery.
+
 * "XMonad.Hooks.FloatNext":
     Hook and keybindings for automatically sending the next
     spawned window(s) to the floating layer.
 
+* "XMonad.Hooks.ICCCMFocus":
+    Deprecated.
+
 * "XMonad.Hooks.InsertPosition":
     Configure where new windows should be added and which window should be
     focused.
 
+* "XMonad.Hooks.ManageDebug":
+    A manageHook and associated logHook for debugging "ManageHooks". Simplest
+    usage: wrap your xmonad config in the debugManageHook combinator. Or use
+    debugManageHookOn for a triggerable version, specifying the triggering key
+    sequence in "EZConfig" syntax. Or use the individual hooks in whatever way you see fit.
+
 * "XMonad.Hooks.ManageDocks":
     This module provides tools to automatically manage 'dock' type programs,
     such as gnome-panel, kicker, dzen, and xmobar.
@@ -382,38 +517,61 @@ Here is a list of the modules found in @XMonad.Hooks@:
 * "XMonad.Hooks.ManageHelpers": provide helper functions to be used
   in @manageHook@.
 
+* "XMonad.Hooks.Minimize":
+    Handles window manager hints to minimize and restore windows. Use
+    this with XMonad.Layout.Minimize.
+
 * "XMonad.Hooks.Place":
     Automatic placement of floating windows.
 
+* "XMonad.Hooks.PositionStoreHooks":
+    This module contains two hooks for the PositionStore (see XMonad.Util.PositionStore) -
+    a ManageHook and an EventHook. The ManageHook can be used to fill the
+    PositionStore with position and size information about new windows. The advantage
+    of using this hook is, that the information is recorded independent of the
+    currently active layout. So the floating shape of the window can later be restored
+    even if it was opened in a tiled layout initially. The EventHook makes sure
+    that windows are deleted from the PositionStore when they are closed.
+
 * "XMonad.Hooks.RestoreMinimized":
-    Lets you restore minimized windows (see "XMonad.Layout.Minimize")
-    by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
-    and WM_CHANGE_STATE).
+    (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized
+    windows (see "XMonad.Layout.Minimize") by selecting them on a
+    taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).
+
+* "XMonad.Hooks.ScreenCorners":
+    Run X () actions by touching the edge of your screen with your mouse.
 
 * "XMonad.Hooks.Script":
     Provides a simple interface for running a ~\/.xmonad\/hooks script with the
     name of a hook.
 
-* "XMonad.Hooks.ServerMode": Allows sending commands to a running xmonad process.
-
-* "XMonad.Hooks.SetCursor":
-    Set a default mouse cursor on startup.
+* "XMonad.Hooks.ServerMode":
+    Allows sending commands to a running xmonad process.
 
 * "XMonad.Hooks.SetWMName":
     Sets the WM name to a given string, so that it could be detected using
     _NET_SUPPORTING_WM_CHECK protocol.  May be useful for making Java GUI
     programs work.
 
+* "XMonad.Hooks.ToggleHook":
+    Hook and keybindings for toggling hook behavior.
+
 * "XMonad.Hooks.UrgencyHook":
     UrgencyHook lets you configure an action to occur when a window demands
     your attention. (In traditional WMs, this takes the form of \"flashing\"
     on your \"taskbar.\" Blech.)
 
+* "XMonad.Hooks.WallpaperSetter":
+    Log hook which changes the wallpapers depending on visible workspaces.
+
 * "XMonad.Hooks.WorkspaceByPos":
     Useful in a dual-head setup: Looks at the requested geometry of
     new windows and moves them to the workspace of the non-focused
     screen if necessary.
 
+* "XMonad.Hooks.WorkspaceHistory":
+    Keeps track of workspace viewing order.
+
 * "XMonad.Hooks.XPropManage":
     A ManageHook matching on XProperties.
 
@@ -446,6 +604,13 @@ For more information on using those modules for customizing your
     master and slave. Size of slave area automatically changes depending on
     number of slave windows.
 
+* "XMonad.Layout.AvoidFloats":
+    Find a maximum empty rectangle around floating windows and use that area to
+    display non-floating windows.
+
+* "XMonad.Layout.BinarySpacePartition":
+    Layout where new windows will split the focused window in half, based off of BSPWM.
+
 * "XMonad.Layout.BorderResize":
     This layout modifier will allow to resize windows by dragging their
     borders with the mouse. However, it only works in layouts or modified
@@ -456,6 +621,11 @@ For more information on using those modules for customizing your
 * "XMonad.Layout.BoringWindows":
     BoringWindows is an extension to allow windows to be marked boring
 
+* "XMonad.Layout.ButtonDecoration":
+    A decoration that includes small buttons on both ends which invoke various
+    actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),
+    minimize, maximize or close the window.
+
 * "XMonad.Layout.CenteredMaster":
     Two layout modifiers. centerMaster places master window at center,
     on top of all other windows, which are managed by base layout.
@@ -484,6 +654,11 @@ For more information on using those modules for customizing your
     A layout modifier and a class for easily creating decorated
     layouts.
 
+* "XMonad.Layout.DecorationAddons":
+    Various stuff that can be added to the decoration. Most of it is intended to
+    be used by other modules. See "XMonad.Layout.ButtonDecoration" for a module
+    that makes use of this.
+
 * "XMonad.Layout.DecorationMadness":
     A collection of decorated layouts: some of them may be nice, some
     usable, others just funny.
@@ -498,6 +673,24 @@ For more information on using those modules for customizing your
     the other is either the currently focused window or the second window in
     layout order. See also "XMonad.Layout.MouseResizableTall"
 
+* "XMonad.Layout.DraggingVisualizer":
+    A helper module to visualize the process of dragging a window by making it
+    follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" for a
+    module that makes use of this.
+
+* "XMonad.Layout.Drawer":
+    A layout modifier that puts some windows in a "drawer" which retracts and
+    expands depending on whether any window in it has focus. Useful for music
+    players, tool palettes, etc.
+
+* "XMonad.Layout.Dwindle":
+    Three layouts: The first, Spiral, is a reimplementation of spiral with, at
+    least to me, more intuitive semantics. The second, Dwindle, is inspired by
+    a similar layout in awesome and produces the same sequence of decreasing
+    window sizes as Spiral but pushes the smallest windows into a screen corner
+    rather than the centre. The third, Squeeze arranges all windows in one row
+    or in one column, with geometrically decreasing sizes.
+
 * "XMonad.Layout.DwmStyle":
     A layout modifier for decorating windows in a dwm like style.
 
@@ -507,6 +700,10 @@ For more information on using those modules for customizing your
     split. This is useful when you usually leave a text editor or
     terminal in the master pane and like it to be 80 columns wide.
 
+* "XMonad.Layout.Fullscreen":
+    Hooks for sending messages about fullscreen windows to layouts, and a few
+    example layout modifier that implement fullscreen windows.
+
 * "XMonad.Layout.Gaps":
     Create manually-sized gaps along edges of the screen which will not
     be used for tiling, along with support for toggling gaps on and
@@ -522,6 +719,25 @@ For more information on using those modules for customizing your
     master area and uses an aspect-ratio-specified layout for the
     slaves.
 
+* "XMonad.Layout.Groups":
+    Two-level layout with windows split in individual layout groups, themselves
+    managed by a user-provided layout.
+
+*   * "XMonad.Layout.Groups.Examples":
+        Example layouts for "XMonad.Layout.Groups".
+
+*   * "XMonad.Layout.Groups.Helpers":
+        Utility functions for "XMonad.Layout.Groups".
+
+*   * "XMonad.Layout.Groups.Wmii":
+        A wmii-like layout algorithm.
+
+* "XMonad.Layout.Hidden":
+    Similar to XMonad.Layout.Minimize but completely removes windows from the
+    window set so XMonad.Layout.BoringWindows isn't necessary. Perfect companion
+    to XMonad.Layout.BinarySpacePartition since it can be used to move windows
+    to another part of the BSP tree.
+
 * "XMonad.Layout.HintedGrid":
     A not so simple layout that attempts to put all windows in a square grid
     while obeying their size hints.
@@ -534,6 +750,16 @@ For more information on using those modules for customizing your
     Layout modfier suitable for workspace with multi-windowed instant messenger
     (like Psi or Tkabber).
 
+* "XMonad.Layout.IfMax":
+    Provides IfMax layout, which will run one layout if there are maximum N
+    windows on workspace, and another layout, when number of windows is greater
+    than N.
+
+* "XMonad.Layout.ImageButtonDecoration":
+    A decoration that includes small image buttons on both ends which invoke
+    various actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),
+    minimize, maximize or close the window.
+
 * "XMonad.Layout.IndependentScreens":
     Utility functions for simulating independent sets of workspaces on
     each screen (like dwm's workspace model), using internal tags to
@@ -609,12 +835,19 @@ For more information on using those modules for customizing your
     A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option
     to use the mouse to adjust the layout.
 
+* "XMonad.Layout.MultiColumns":
+    This layout tiles windows in a growing number of columns. The number of
+    windows in each column can be controlled by messages.
+
 * "XMonad.Layout.MultiToggle":
     Dynamically apply and unapply transformers to your window layout. This can
     be used to rotate your window layout by 90 degrees, or to make the
     currently focused window occupy the whole screen (\"zoom in\") then undo
     the transformation (\"zoom out\").
 
+*   * "XMonad.Layout.MultiToggle.Instances":
+        Some convenient common instances of the Transformer class, for use with "XMonad.Layout.MultiToggle".
+
 * "XMonad.Layout.Named":
     A module for assigning a name to a given layout.
 
@@ -630,17 +863,38 @@ For more information on using those modules for customizing your
     result in title bars that span the entire window instead of being only the
     length of the window title.
 
+* "XMonad.Layout.OnHost":
+    Configure layouts on a per-host basis: use layouts and apply layout modifiers
+    selectively, depending on the host. Heavily based on "XMonad.Layout.PerWorkspace"
+    by Brent Yorgey.
+
 * "XMonad.Layout.OneBig":
     Places one (master) window at top left corner of screen, and other (slave)
     windows at the top.
 
+* "XMonad.Layout.PerScreen":
+    Configure layouts based on the width of your screen; use your favorite
+    multi-column layout for wide screens and a full-screen layout for small ones.
+
 * "XMonad.Layout.PerWorkspace":
     Configure layouts on a per-workspace basis: use layouts and apply
     layout modifiers selectively, depending on the workspace.
 
+* "XMonad.Layout.PositionStoreFloat":
+    A floating layout which has been designed with a dual-head setup in mind.
+    It makes use of "XMonad.Util.PositionStore" as well as "XMonad.Hooks.PositionStoreHooks".
+    Since there is currently no way to move or resize windows with the keyboard
+    alone in this layout, it is adviced to use it in combination with a decoration
+    such as "XMonad.Layout.NoFrillsDecoration" (to move windows) and the layout
+    modifier "XMonad.Layout.BorderResize" (to resize windows).
+
 * "XMonad.Layout.Reflect":
     Reflect a layout horizontally or vertically.
 
+* "XMonad.Layout.Renamed":
+    Layout modifier that can modify the description of its underlying layout on
+    a (hopefully) flexible way.
+
 * "XMonad.Layout.ResizableTile":
     More useful tiled layout that allows you to change a width\/height of window.
     See also "XMonad.Layout.MouseResizableTile".
@@ -672,6 +926,12 @@ For more information on using those modules for customizing your
 * "XMonad.Layout.SimplestFloat":
     A basic floating layout like SimpleFloat but without the decoration.
 
+* "XMonad.Layout.SortedLayout":
+    A new LayoutModifier that sorts a given layout by a list of
+    properties. The order of properties in the list determines
+    the order of windows in the final layout. Any unmatched windows
+    go to the end of the order.
+
 * "XMonad.Layout.Spacing":
     Add a configurable amount of space around windows.
 
@@ -690,6 +950,13 @@ For more information on using those modules for customizing your
     A stacking layout, like dishes but with the ability to resize master pane.
     Mostly useful on small screens.
 
+* "XMonad.Layout.Stoppable":
+    This module implements a special kind of layout modifier, which when applied
+    to a layout, causes xmonad to stop all non-visible processes. In a way,
+    this is a sledge-hammer for applications that drain power. For example, given
+    a web browser on a stoppable workspace, once the workspace is hidden the web
+    browser will be stopped.
+
 * "XMonad.Layout.SubLayouts":
     A layout combinator that allows layouts to be nested.
 
@@ -720,6 +987,10 @@ For more information on using those modules for customizing your
     WindowNavigation is an extension to allow easy navigation of a workspace.
     See also "XMonad.Actions.WindowNavigation".
 
+* "XMonad.Layout.WindowSwitcherDecoration":
+    A decoration that allows to switch the position of windows by dragging them
+    onto each other.
+
 * "XMonad.Layout.WorkspaceDir":
     WorkspaceDir is an extension to set the current directory in a workspace.
     Actually, it sets the current directory in a layout, since there's no way I
@@ -753,6 +1024,9 @@ These are the available prompts:
     you're doing.
     Who knows, it might be useful for other purposes as well!
 
+* "XMonad.Prompt.ConfirmPrompt":
+    A module for setting up simple confirmation prompts for keybindings.
+
 * "XMonad.Prompt.DirExec":
     A directory file executables prompt for XMonad. This might be useful if you
     don't want to have scripts in your PATH environment variable (same
@@ -782,6 +1056,13 @@ These are the available prompts:
     * narrow completions by section number, if the one is specified
     (like @\/etc\/bash_completion@ does)
 
+* "XMonad.Prompt.Pass":
+    This module provides 3 combinators for ease passwords manipulation (generate, read, remove):
+    1) one to lookup passwords in the password-storage.
+    2) one to generate a password for a given password label that the user inputs.
+    3) one to delete a stored password for a given password label that the user inputs.
+
+
 * "XMonad.Prompt.RunOrRaise":
     A prompt for XMonad which will run a program, open a file,
     or raise an already running program, depending on context.
@@ -826,6 +1107,10 @@ A non complete list with a brief description:
 * "XMonad.Util.CustomKeys": configure key bindings (see
   "XMonad.Doc.Extending#Editing_key_bindings").
 
+* "XMonad.Util.DebugWindow":
+    Module to dump window information for diagnostic/debugging purposes. See
+    "XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.
+
 * "XMonad.Util.Dmenu":
     A convenient binding to dmenu.
     Requires the process-1.0 package
@@ -833,11 +1118,19 @@ A non complete list with a brief description:
 * "XMonad.Util.Dzen":
     Handy wrapper for dzen. Requires dzen >= 0.2.4.
 
-* "XMonad.Util.EZConfig": configure key bindings easily, including a
-  parser for writing key bindings in "M-C-x" style.
+* "XMonad.Util.EZConfig":
+    Configure key bindings easily, including a
+    parser for writing key bindings in "M-C-x" style.
 
-* "XMonad.Util.Font": A module for abstracting a font facility over
-  Core fonts and Xft
+* "XMonad.Util.ExtensibleState":
+    Module for storing custom mutable state in xmonad.
+
+* "XMonad.Util.Font":
+    A module for abstracting a font facility over
+    Core fonts and Xft.
+
+* "XMonad.Util.Image":
+    Utilities for manipulating [[Bool]] as images.
 
 * "XMonad.Util.Invisible":
     A data type to store the layout state
@@ -848,6 +1141,10 @@ A non complete list with a brief description:
     a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog"
     for more information.
 
+*   * "XMonad.Util.Loggers.NamedScratchpad":
+        A collection of Loggers (see "XMonad.Util.Loggers") for NamedScratchpads
+        (see "XMonad.Util.NamedScratchpad").
+
 * "XMonad.Util.NamedActions":
     A wrapper for keybinding configuration that can list the available
     keybindings.
@@ -860,10 +1157,22 @@ A non complete list with a brief description:
     This module allows you to associate the X titles of windows with
     them.
 
+* "XMonad.Util.NoTaskbar":
+    Utility function and 'ManageHook` to mark a window to be ignored by
+    EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
+    you will usually be taken to the `NSP` workspace by them.
+
 * "XMonad.Util.Paste":
     A module for sending key presses to windows. This modules provides generalized
     and specialized functions for this task.
 
+* "XMonad.Util.PositionStore":
+    A utility module to store information about position and size of a window.
+    See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.
+
+* "XMonad.Util.RemoteWindows":
+    This module implements a proper way of finding out whether the window is remote or local.
+
 * "XMonad.Util.Replace":
     Implements a @--replace@ flag outside of core.
 
@@ -876,6 +1185,16 @@ A non complete list with a brief description:
 * "XMonad.Util.Scratchpad":
     Very handy hotkey-launched toggleable floating terminal window.
 
+* "XMonad.Util.SpawnNamedPipe":
+    A module for spawning a pipe whose Handle lives in the Xmonad state.
+
+* "XMonad.Util.SpawnOnce":
+    A module for spawning a command once, and only once. Useful to start status
+    bars and make session settings inside startupHook.
+
+* "XMonad.Util.Stack":
+    Utility functions for manipulating Maybe Stacks.
+
 * "XMonad.Util.StringProp":
     Internal utility functions for storing Strings with the root window.
     Used for global state like IORefs with string keys, but more latency,
@@ -890,10 +1209,21 @@ A non complete list with a brief description:
 * "XMonad.Util.Types":
     Miscellaneous commonly used types.
 
+* "XMonad.Util.Ungrab":
+    Release xmonad's keyboard and pointer grabs immediately, so
+    screen grabbers and lock utilities, etc. will work. Replaces
+    the short sleep hackaround.
+
 * "XMonad.Util.WindowProperties":
     EDSL for specifying window properties; various utilities related to window
     properties.
 
+* "XMonad.Util.WindowState":
+    Functions for saving per-window data.
+
+* "XMonad.Util.WorkspaceCompare":
+    Functions for examining, comparing, and sorting workspaces.
+
 * "XMonad.Util.XSelection":
     A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).
     'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils
@@ -928,20 +1258,22 @@ example, you could write:
 
 >    import XMonad
 >
->    main = xmonad $ defaultConfig { keys = myKeys }
+>    main = xmonad $ def { keys = myKeys }
 
 and provide an appropriate definition of @myKeys@, such as:
 
-> myKeys conf@(XConfig {XMonad.modMask = modm}) =
->             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
->             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
+> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
+>             [ ((modm, xK_F12), xmonadPrompt def)
+>             , ((modm, xK_F3 ), shellPrompt  def)
 >             ]
 
 This particular definition also requires importing "XMonad.Prompt",
-"XMonad.Prompt.Shell", and "XMonad.Prompt.XMonad":
+"XMonad.Prompt.Shell", "XMonad.Prompt.XMonad", and "Data.Map":
 
-> import XMonadPrompt
-> import ...  -- and so on
+> import qualified Data.Map as M
+> import XMonad.Prompt
+> import XMonad.Prompt.Shell
+> import XMonad.Prompt.XMonad
 
 For a list of the names of particular keys (such as xK_F12, and so
 on), see
@@ -977,20 +1309,26 @@ module, before starting we must first import this modules:
 For instance, if you have defined some additional key bindings like
 these:
 
->    myKeys conf@(XConfig {XMonad.modMask = modm}) =
->             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
->             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
+>             [ ((modm, xK_F12), xmonadPrompt def)
+>             , ((modm, xK_F3 ), shellPrompt  def)
 >             ]
 
 then you can create a new key bindings map by joining the default one
 with yours:
 
->    newKeys x  = M.union (keys defaultConfig x) (M.fromList (myKeys x))
+>    newKeys x  = myKeys x `M.union` keys def x
 
 Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field
 of the configuration:
 
->    main = xmonad $ defaultConfig { keys = newKeys }
+>    main = xmonad $ def { keys = newKeys }
+
+Alternatively, the '<+>' operator can be used which in this usage does exactly
+the same as the explicit usage of 'M.union' and propagation of the config
+argument, thanks to appropriate instances in "Data.Monoid".
+
+>    main = xmonad $ def { keys = myKeys <+> keys def }
 
 All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
 
@@ -1006,13 +1344,11 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
 >    import XMonad.Prompt.XMonad
 >
 >    main :: IO ()
->    main = xmonad $ defaultConfig { keys = newKeys }
+>    main = xmonad $ def { keys = myKeys <+> keys def }
 >
->    newKeys x = M.union (keys defaultConfig x) (M.fromList (myKeys x))
->
->    myKeys conf@(XConfig {XMonad.modMask = modm}) =
->             [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
->             , ((modm, xK_F3 ), shellPrompt  defaultXPConfig)
+>    myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
+>             [ ((modm, xK_F12), xmonadPrompt def)
+>             , ((modm, xK_F3 ), shellPrompt  def)
 >             ]
 
 There are much simpler ways to accomplish this, however, if you are
@@ -1034,10 +1370,10 @@ For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
 to define @newKeys@ as a 'Data.Map.difference' between the default
 map and the map of the key bindings you want to remove.  Like so:
 
->    newKeys x = M.difference (keys defaultConfig x) (M.fromList $ keysToRemove x)
+>    newKeys x = keys def x `M.difference` keysToRemove x
 >
->    keysToRemove :: XConfig Layout ->    [((KeyMask, KeySym),X ())]
->    keysToRemove x =
+>    keysToRemove :: XConfig Layout ->    M.Map (KeyMask, KeySym) (X ())
+>    keysToRemove x = M.fromList
 >             [ ((modm              , xK_q ), return ())
 >             , ((modm .|. shiftMask, xK_q ), return ())
 >             ]
@@ -1050,7 +1386,7 @@ It is also possible to simply define a list of keys we want to unbind
 and then use 'Data.Map.delete' to remove them. In that case we would
 write something like:
 
->    newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)
+>    newKeys x = foldr M.delete (keys def x) (keysToRemove x)
 >
 >    keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]
 >    keysToRemove x =
@@ -1071,7 +1407,7 @@ Adding and removing key bindings requires simply combining the steps
 for removing and adding.  Here is an example from
 "XMonad.Config.Arossato":
 
->    defKeys    = keys defaultConfig
+>    defKeys    = keys def
 >    delKeys x  = foldr M.delete           (defKeys x) (toRemove x)
 >    newKeys x  = foldr (uncurry M.insert) (delKeys x) (toAdd    x)
 >    -- remove some of the default key bindings
@@ -1087,8 +1423,8 @@ for removing and adding.  Here is an example from
 >        [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]]
 >    -- These are my personal key bindings
 >    toAdd XConfig{modMask = modm} =
->        [ ((modm              , xK_F12   ), xmonadPrompt defaultXPConfig )
->        , ((modm              , xK_F3    ), shellPrompt  defaultXPConfig )
+>        [ ((modm              , xK_F12   ), xmonadPrompt def )
+>        , ((modm              , xK_F3    ), shellPrompt  def )
 >        ] ++
 >        -- Use modm .|. shiftMask .|. controlMask 1-9 instead
 >        [( (m .|. modm, k), windows $ f i)
@@ -1115,9 +1451,9 @@ the window you click on like so:
 >
 >    myMouse x  = [ (0, button4), (\w -> focus w >> kill) ]
 >
->    newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))
+>    newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x))
 >
->    main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }
+>    main = xmonad $ def { ..., mouseBindings = newMouse, ... }
 
 Overriding or deleting mouse bindings works similarly.  You can also
 configure mouse bindings much more easily using the
@@ -1164,13 +1500,13 @@ Suppose we want a list with the 'XMonad.Layout.Full',
 
 Then we create the combination of layouts we need:
 
->    mylayoutHook = Full ||| tabbed shrinkText defaultTConf ||| Accordion
+>    mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion
 
 
 Now, all we need to do is change the 'XMonad.Core.layoutHook'
 field of the 'XMonad.Core.XConfig' record, like so:
 
->    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
+>    main = xmonad $ def { layoutHook = mylayoutHook }
 
 Thanks to the new combinator, we can apply a layout modifier to a
 whole combination of layouts, instead of applying it to each one. For
@@ -1178,11 +1514,11 @@ example, suppose we want to use the
 'XMonad.Layout.NoBorders.noBorders' layout modifier, from the
 "XMonad.Layout.NoBorders" module (which must be imported):
 
->    mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTConf ||| Accordion)
+>    mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion)
 
 If we want only the tabbed layout without borders, then we may write:
 
->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion
 
 Our @~\/.xmonad\/xmonad.hs@ will now look like this:
 
@@ -1192,9 +1528,9 @@ Our @~\/.xmonad\/xmonad.hs@ will now look like this:
 >    import XMonad.Layout.Accordion
 >    import XMonad.Layout.NoBorders
 >
->    mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTConf) ||| Accordion
+>    mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion
 >
->    main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
+>    main = xmonad $ def { layoutHook = mylayoutHook }
 
 That's it!
 
@@ -1246,7 +1582,7 @@ This is another example of 'XMonad.Config.manageHook', taken from
 >                               , resource =? "win"          --> doF (W.shift "doc") -- xpdf
 >                               , resource =? "firefox-bin"  --> doF (W.shift "web")
 >                               ]
->    newManageHook = myManageHook <+> manageHook defaultConfig
+>    newManageHook = myManageHook <+> manageHook def
 
 
 Again we use 'XMonad.ManageHook.composeAll' to compose a list of
@@ -1308,14 +1644,14 @@ Then we create our own 'XMonad.Config.manageHook':
 We can now use the 'XMonad.ManageHook.<+>' combinator to add our
 'XMonad.Config.manageHook' to the default one:
 
->    newManageHook = myManageHook <+> manageHook defaultConfig
+>    newManageHook = myManageHook <+> manageHook def
 
 (Of course, if we wanted to completely replace the default
 'XMonad.Config.manageHook', this step would not be necessary.) Now,
 all we need to do is change the 'XMonad.Core.manageHook' field of the
 'XMonad.Core.XConfig' record, like so:
 
->    main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }
+>    main = xmonad def { ..., manageHook = newManageHook, ... }
 
 And we are done.
 
@@ -1377,7 +1713,7 @@ Then you just need to update the 'XMonad.Core.logHook' field of the
 'XMonad.Core.XConfig' record with one of the provided functions. For
 example:
 
->    main = xmonad defaultConfig { logHook = dynamicLog }
+>    main = xmonad def { logHook = dynamicLog }
 
 More interesting configurations are also possible; see the
 "XMonad.Hooks.DynamicLog" module for more possibilities.

XMonad/Hooks/CurrentWorkspaceOnTop.hs

@@ -26,13 +26,14 @@ import XMonad
 import qualified XMonad.StackSet as S
 import qualified XMonad.Util.ExtensibleState as XS
 import Control.Monad(when)
+import qualified Data.Map as M
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Hooks.CurrentWorkspaceOnTop
 -- >
--- > main = xmonad $ defaultConfig {
+-- > main = xmonad $ def {
 -- >    ...
 -- >    logHook = currentWorkspaceOnTop
 -- >    ...
@@ -50,12 +51,18 @@ currentWorkspaceOnTop = withDisplay $ \d -> do
     (CWOTS lastTag) <- XS.get
     let curTag = S.tag . S.workspace . S.current $ ws
     when (curTag /= lastTag) $ do
+        -- the following is more or less a reimplementation of what's happening in "XMonad.Operation"
         let s = S.current ws
             wsp = S.workspace s
             viewrect = screenRect $ S.screenDetail s
-            tmpStack = S.stack . S.workspace $ s
-        (rs, _) <- runLayout wsp { S.stack = tmpStack } viewrect
-        let wins = map fst rs
+            tmpStack = (S.stack wsp) >>= S.filter (`M.notMember` S.floating ws)
+        (rs, ml') <- runLayout wsp { S.stack = tmpStack } viewrect
+        updateLayout curTag ml'
+        let this = S.view curTag ws
+            fltWins = filter (flip M.member (S.floating ws)) $ S.index this
+            wins = fltWins ++ (map fst rs)  -- order: first all floating windows, then the order the layout returned
+        -- end of reimplementation
+
         when (not . null $ wins) $ do
             io $ raiseWindow d (head wins)  -- raise first window of current workspace to the very top,
             io $ restackWindows d wins      -- then use restackWindows to let all other windows from the workspace follow

XMonad/Hooks/DebugKeyEvents.hs

@@ -0,0 +1,112 @@
+{-# LANGUAGE CPP #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.DebugKeyEvents
+-- Copyright    : (c) 2011 Brandon S Allbery <allbery.b@gmail.com>
+-- License      : BSD
+--
+-- Maintainer   : Brandon S Allbery <allbery.b@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- A debugging module to track key events, useful when you can't tell whether
+-- xmonad is processing some or all key events.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugKeyEvents (-- * Usage
+                                    -- $usage
+                                    debugKeyEvents
+                                   ) where
+
+import           XMonad.Core
+import           XMonad.Operations               (cleanMask)
+
+import           Graphics.X11.Xlib
+import           Graphics.X11.Xlib.Extras
+
+import           Control.Monad.State             (gets)
+import           Data.Bits
+import           Data.List                       (intercalate)
+import           Data.Monoid
+import           Numeric                         (showHex)
+import           System.IO                       (hPutStrLn
+                                                 ,stderr)
+
+-- $usage
+-- Add this to your handleEventHook to print received key events to the
+-- log (the console if you use @startx@/@xinit@, otherwise usually
+-- @~/.xsession-errors@).
+--
+-- >      , handleEventHook = debugKeyEvents
+--
+-- If you already have a handleEventHook then you should append it:
+--
+-- >      , handleEventHook = ... <+> debugKeyEvents
+--
+-- Logged key events look like:
+--
+-- @keycode 53 sym 120 (0x78, "x") mask 0x0 () clean 0x0 ()@
+--
+-- The @mask@ and @clean@ indicate the modifiers pressed along with
+-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after
+-- sanitizing it (removing @numberLockMask@, etc.)
+--
+-- For more detailed instructions on editing the logHook see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+
+-- | Print key events to stderr for debugging
+debugKeyEvents :: Event -> X All
+debugKeyEvents (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
+  | t == keyPress =
+      withDisplay $ \dpy -> do
+        sym <- io $ keycodeToKeysym dpy code 0
+        msk <- cleanMask m
+        nl <- gets numberlockMask
+        io $ hPutStrLn stderr $ intercalate " " ["keycode"
+                                                ,show code
+                                                ,"sym"
+                                                ,show sym
+                                                ," ("
+                                                ,hex sym
+                                                ," \""
+                                                ,keysymToString sym
+                                                ,"\") mask"
+                                                ,hex m
+                                                ,"(" ++ vmask nl m ++ ")"
+                                                ,"clean"
+                                                ,hex msk
+                                                ,"(" ++ vmask nl msk ++ ")"
+                                                ]
+        return (All True)
+debugKeyEvents _ = return (All True)
+
+-- | Convenient showHex variant
+hex :: (Integral n, Show n) => n -> String
+hex v = "0x" ++ showHex v ""
+
+-- | Convert a modifier mask into a useful string
+vmask                 :: KeyMask -> KeyMask -> String
+vmask numLockMask msk =  intercalate " " $
+                         reverse $
+                         fst $
+                         foldr vmask' ([],msk) masks
+    where
+
+#if __GLASGOW_HASKELL__ < 707
+      finiteBitSize x = bitSize x
+#endif
+      masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++
+              [(numLockMask,"num"  )
+              ,(   lockMask,"lock" )
+              ,(controlMask,"ctrl" )
+              ,(  shiftMask,"shift")
+              ,(   mod5Mask,"mod5" )
+              ,(   mod4Mask,"mod4" )
+              ,(   mod3Mask,"mod3" )
+              ,(   mod2Mask,"mod2" )
+              ,(   mod1Mask,"mod1" )
+              ]
+      vmask'   _   a@( _,0)                = a
+      vmask' (m,s)   (ss,v) | v .&. m == m = (s:ss,v .&. complement m)
+      vmask'   _        r                  = r

XMonad/Hooks/DebugStack.hs

@@ -0,0 +1,110 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DebugStack
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2014
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Dump the state of the 'StackSet'. A @logHook@ and @handleEventHook@ are
+-- also provided.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DebugStack (debugStack
+                               ,debugStackFull
+                               ,debugStackString
+                               ,debugStackFullString
+                               ,debugStackLogHook
+                               ,debugStackFullLogHook
+                               ,debugStackEventHook
+                               ,debugStackFullEventHook
+                               ) where
+
+import           XMonad.Core
+import qualified XMonad.StackSet                                       as W
+
+import           XMonad.Util.DebugWindow
+
+import           Graphics.X11.Types                  (Window)
+import           Graphics.X11.Xlib.Extras            (Event)
+
+import           Control.Monad                       (foldM)
+import           Data.Map                            (member)
+import           Data.Monoid                         (All(..))
+import           Data.List                           (intercalate)
+
+-- | Print the state of the current window stack for the current workspace to
+--   @stderr@, which for most installations goes to @~/.xsession-errors@.
+--   "XMonad.Util.DebugWindow" is used to display the individual windows.
+debugStack :: X ()
+debugStack =  debugStackString >>= trace
+
+-- | Print the state of the current window stack for all workspaces to
+--   @stderr@, which for most installations goes to @~/.xsession-errors@.
+--   "XMonad.Util.DebugWindow" is used to display the individual windows.
+debugStackFull :: X ()
+debugStackFull =  debugStackFullString >>= trace
+
+-- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.)
+debugStackLogHook :: X ()
+debugStackLogHook =  debugStack
+
+-- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.)
+debugStackFullLogHook :: X ()
+debugStackFullLogHook =  debugStackFull
+
+-- | 'debugStack' packaged as a 'handleEventHook'. You almost certainly do not
+--   want to use this unconditionally, as it will cause massive amounts of
+--   output and possibly slow @xmonad@ down severely.
+
+debugStackEventHook   :: Event -> X All
+debugStackEventHook _ =  debugStack >> return (All True)
+
+-- | 'debugStackFull' packaged as a 'handleEventHook'. You almost certainly do
+--   not want to use this unconditionally, as it will cause massive amounts of
+--   output and possibly slow @xmonad@ down severely.
+
+debugStackFullEventHook   :: Event -> X All
+debugStackFullEventHook _ =  debugStackFull >> return (All True)
+
+-- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'.
+debugStackString :: X String
+debugStackString =  withWindowSet $ debugStackWs . W.workspace . W.current
+
+-- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'.
+-- @@@ this is in stackset order, which is roughly lru-ish
+debugStackFullString :: X String
+debugStackFullString =  withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces
+
+-- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'.
+--   @
+--   Workspace "foo::
+--     mm
+--   * ww
+--    ^ww
+--   @
+--   * indicates the focused window, ^ indicates a floating window
+debugStackWs   :: W.Workspace String (Layout Window) Window -> X String
+debugStackWs w =  withWindowSet $ \ws -> do
+  let cur = if wt == W.currentTag ws then " (current)" else ""
+      wt  = W.tag w
+  s <- emit ws $ W.integrate' . W.stack $ w
+  return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s
+  where
+    emit       :: WindowSet -> [Window] -> X [String]
+    emit _  [] =  return ["    -empty workspace-"]
+    emit ww ws = do
+      (_,ss) <- foldM emit' (ww,[]) ws
+      return ss
+
+    emit' :: (WindowSet,[String])
+          -> Window
+          -> X (WindowSet,[String])
+    emit' (ws,a) w' = do
+      let focus = if Just w' == W.peek ws then '*' else ' '
+          float = if w' `member` W.floating ws then '^' else ' '
+      s <- debugWindow w'
+      return (ws,(focus:float:s):a)

XMonad/Hooks/DynamicBars.hs

@@ -0,0 +1,186 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DynamicBars
+-- Copyright   :  (c) Ben Boeckel 2012
+-- License     :  BSD-style (as xmonad)
+--
+-- Maintainer  :  mathstuf@gmail.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Manage per-screen status bars.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicBars (
+  -- * Usage
+  -- $usage
+    DynamicStatusBar
+  , DynamicStatusBarCleanup
+  , DynamicStatusBarPartialCleanup
+  , dynStatusBarStartup
+  , dynStatusBarStartup'
+  , dynStatusBarEventHook
+  , dynStatusBarEventHook'
+  , multiPP
+  , multiPPFormat
+  ) where
+
+import Prelude
+
+import Control.Monad
+import Control.Monad.Trans (lift)
+import Control.Monad.Writer (WriterT, execWriterT, tell)
+
+import Data.List
+import Data.Maybe
+import Data.Monoid
+import Data.Foldable (traverse_)
+
+import Graphics.X11.Xinerama
+import Graphics.X11.Xlib
+import Graphics.X11.Xlib.Extras
+import Graphics.X11.Xrandr
+
+import System.IO
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Hooks.DynamicLog
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- Provides a few helper functions to manage per-screen status bars while
+-- dynamically responding to screen changes. A startup action, event hook, and
+-- a way to separate PP styles based on the screen's focus are provided:
+--
+-- * The 'dynStatusBarStartup' hook which initializes the status bars. The
+-- first argument is an `ScreenId -> IO Handle` which spawns a status bar on the
+-- given screen and returns the pipe which the string should be written to.
+-- The second argument is a `IO ()` to shut down all status bars. This should
+-- be placed in your `startupHook`.
+--
+-- * The 'dynStatusBarEventHook' hook which respawns status bars when the
+-- number of screens changes. The arguments are the same as for the
+-- `dynStatusBarStartup` function. This should be placed in your
+-- `handleEventHook`.
+--
+-- * Each of the above functions have an alternate form
+-- (`dynStatusBarStartup'` and `dynStatusBarEventHook'`) which use a cleanup
+-- function which takes an additional `ScreenId` argument which allows for
+-- more fine-grained control for shutting down a specific screen's status bar.
+--
+-- * The 'multiPP' function which allows for different output based on whether
+-- the screen for the status bar has focus (the first argument) or not (the
+-- second argument). This is for use in your `logHook`.
+--
+-- * The 'multiPPFormat' function is the same as the 'multiPP' function, but it
+-- also takes in a function that can customize the output to status bars.
+--
+-- The hooks take a 'DynamicStatusBar' function which is given the id of the
+-- screen to start up and returns the 'Handle' to the pipe to write to. The
+-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It
+-- is called when the number of screens changes and on startup.
+--
+
+data DynStatusBarInfo = DynStatusBarInfo
+  { dsbInfo :: [(ScreenId, Handle)]
+  } deriving (Typeable)
+
+instance ExtensionClass DynStatusBarInfo where
+  initialValue = DynStatusBarInfo []
+
+type DynamicStatusBar = ScreenId -> IO Handle
+type DynamicStatusBarCleanup = IO ()
+type DynamicStatusBarPartialCleanup = ScreenId -> IO ()
+
+dynStatusBarSetup :: X ()
+dynStatusBarSetup = do
+  dpy <- asks display
+  root <- asks theRoot
+  io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
+
+dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+dynStatusBarStartup sb cleanup = do
+  dynStatusBarSetup
+  updateStatusBars sb cleanup
+
+dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
+dynStatusBarStartup' sb cleanup = do
+  dynStatusBarSetup
+  updateStatusBars' sb cleanup
+
+dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
+dynStatusBarEventHook sb cleanup = dynStatusBarRun (updateStatusBars sb cleanup)
+
+dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All
+dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)
+
+dynStatusBarRun :: X () -> Event -> X All
+dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)
+dynStatusBarRun _      _                              = return (All True)
+
+updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
+updateStatusBars sb cleanup = do
+  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
+  screens <- getScreens
+  when (screens /= dsbInfoScreens) $ do
+      newHandles <- liftIO $ do
+          hClose `mapM_` dsbInfoHandles
+          cleanup
+          mapM sb screens
+      XS.put $ DynStatusBarInfo (zip screens newHandles)
+
+updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
+updateStatusBars' sb cleanup = do
+  (dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
+  screens <- getScreens
+  when (screens /= dsbInfoScreens) $ do
+      let oldInfo = zip dsbInfoScreens dsbInfoHandles
+      let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
+      newInfo <- liftIO $ do
+          mapM_ hClose $ map snd infoToClose
+          mapM_ cleanup $ map fst infoToClose
+          let newScreens = screens \\ dsbInfoScreens
+          newHandles <- mapM sb newScreens
+          return $ zip newScreens newHandles
+      XS.put . DynStatusBarInfo $ infoToKeep ++ newInfo
+
+-----------------------------------------------------------------------------
+-- The following code is from adamvo's xmonad.hs file.
+-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs
+
+multiPP :: PP -- ^ The PP to use if the screen is focused
+        -> PP -- ^ The PP to use otherwise
+        -> X ()
+multiPP = multiPPFormat dynamicLogString
+
+multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
+multiPPFormat dynlStr focusPP unfocusPP = do
+  (_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
+  multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
+
+multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
+multiPP' dynlStr focusPP unfocusPP handles = do
+  st <- get
+  let pickPP :: WorkspaceId -> WriterT (Last XState) X String
+      pickPP ws = do
+        let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st
+        put st{ windowset = W.view ws $ windowset st }
+        out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
+        when isFoc $ get >>= tell . Last . Just
+        return out
+  traverse_ put . getLast
+    =<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
+    =<< mapM screenWorkspace (zipWith const [0 .. ] handles)
+
+getScreens :: MonadIO m => m [ScreenId]
+getScreens = liftIO $ do
+  screens <- do
+    dpy <- openDisplay ""
+    rects <- getScreenInfo dpy
+    closeDisplay dpy
+    return rects
+  let ids = zip [0 .. ] screens
+  return $ map fst ids

XMonad/Hooks/DynamicLog.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleContexts, PatternGuards #-}
 
 -----------------------------------------------------------------------------
 -- |
@@ -29,12 +29,13 @@ module XMonad.Hooks.DynamicLog (
     dynamicLog,
     dynamicLogXinerama,
 
+    xmonadPropLog',
     xmonadPropLog,
 
     -- * Build your own formatter
     dynamicLogWithPP,
     dynamicLogString,
-    PP(..), defaultPP,
+    PP(..), defaultPP, def,
 
     -- * Example formatters
     dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
@@ -42,6 +43,7 @@ module XMonad.Hooks.DynamicLog (
     -- * Formatting utilities
     wrap, pad, trim, shorten,
     xmobarColor, xmobarStrip,
+    xmobarStripTags,
     dzenColor, dzenEscape, dzenStrip,
 
     -- * Internal formatting functions
@@ -53,27 +55,26 @@ module XMonad.Hooks.DynamicLog (
 
   ) where
 
---
 -- Useful imports
---
-import XMonad
-import Control.Monad
+
+import Codec.Binary.UTF8.String (encodeString)
+import Control.Monad (liftM2, msum)
 import Data.Char ( isSpace, ord )
-import Data.Maybe ( isJust, catMaybes )
-import Data.List
-import qualified Data.Map as M
+import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
+import Data.Maybe ( isJust, catMaybes, mapMaybe )
 import Data.Ord ( comparing )
+import qualified Data.Map as M
 import qualified XMonad.StackSet as S
-import System.IO
 
 import Foreign.C (CChar)
 
+import XMonad
+
 import XMonad.Util.WorkspaceCompare
 import XMonad.Util.NamedWindows
 import XMonad.Util.Run
 
 import XMonad.Layout.LayoutModifier
-import XMonad.Util.Font
 import XMonad.Hooks.UrgencyHook
 import XMonad.Hooks.ManageDocks
 
@@ -88,7 +89,7 @@ import XMonad.Hooks.ManageDocks
 --
 -- > main = xmonad =<< xmobar myConfig
 -- >
--- > myConfig = defaultConfig { ... }
+-- > myConfig = def { ... }
 --
 -- There is also 'statusBar' if you'd like to use another status bar, or would
 -- like to use different formatting options.  The 'xmobar', 'dzen', and
@@ -99,7 +100,7 @@ import XMonad.Hooks.ManageDocks
 -- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the
 -- appropriate function, for instance:
 --
--- > main = xmonad $ defaultConfig {
+-- > main = xmonad $ def {
 -- >    ...
 -- >    logHook = dynamicLog
 -- >    ...
@@ -124,9 +125,9 @@ import XMonad.Hooks.ManageDocks
 -- >
 -- > main = do
 -- >     h <- spawnPipe "xmobar -options -foo -bar"
--- >     xmonad $ defaultConfig {
+-- >     xmonad $ def {
 -- >       ...
--- >       logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h }
+-- >       logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }
 --
 -- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of
 -- your pretty-printer as in the example above; by default the status
@@ -153,7 +154,7 @@ import XMonad.Hooks.ManageDocks
 --
 -- > main = xmonad =<< dzen myConfig
 -- >
--- > myConfig = defaultConfig { ... }
+-- > myConfig = def { ... }
 --
 -- The intent is that the above config file should provide a nice
 -- status bar with minimal effort.
@@ -178,7 +179,7 @@ dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
 --
 -- > main = xmonad =<< xmobar myConfig
 -- >
--- > myConfig = defaultConfig { ... }
+-- > myConfig = def { ... }
 --
 -- This works pretty much the same as 'dzen' function above.
 --
@@ -198,31 +199,34 @@ statusBar :: LayoutClass l Window
           -> IO (XConfig (ModifiedLayout AvoidStruts l))
 statusBar cmd pp k conf = do
     h <- spawnPipe cmd
-    return $ conf
+    return $ docks $ conf
         { layoutHook = avoidStruts (layoutHook conf)
         , logHook = do
                         logHook conf
                         dynamicLogWithPP pp { ppOutput = hPutStrLn h }
-        , manageHook = manageHook conf <+> manageDocks
         , keys       = liftM2 M.union keys' (keys conf)
         }
  where
     keys' = (`M.singleton` sendMessage ToggleStruts) . k
 
--- | Write a string to the property _XMONAD_LOG on the root window.  This
--- property is of type UTF8_STRING. The string must have been processed by
--- encodeString (dynamicLogString does this).
-xmonadPropLog :: String -> X ()
-xmonadPropLog msg = do
+-- | Write a string to a property on the root window.  This property is of
+-- type UTF8_STRING. The string must have been processed by encodeString
+-- (dynamicLogString does this).
+xmonadPropLog' :: String -> String -> X ()
+xmonadPropLog' prop msg = do
     d <- asks display
     r <- asks theRoot
-    xlog <- getAtom "_XMONAD_LOG"
+    xlog <- getAtom prop
     ustring <- getAtom "UTF8_STRING"
     io $ changeProperty8 d r xlog ustring propModeReplace (encodeCChar msg)
  where
     encodeCChar :: String -> [CChar]
     encodeCChar = map (fromIntegral . ord)
 
+-- | Write a string to the _XMONAD_LOG property on the root window.
+xmonadPropLog :: String -> X ()
+xmonadPropLog = xmonadPropLog' "_XMONAD_LOG"
+
 -- |
 -- Helper function which provides ToggleStruts keybinding
 --
@@ -242,7 +246,7 @@ toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b )
 -- To customize the output format, see 'dynamicLogWithPP'.
 --
 dynamicLog :: X ()
-dynamicLog = dynamicLogWithPP defaultPP
+dynamicLog = dynamicLogWithPP def
 
 -- | Format the current status using the supplied pretty-printing format,
 --   and write it to stdout.
@@ -270,12 +274,12 @@ dynamicLogString pp = do
     wt <- maybe (return "") (fmap show . getName) . S.peek $ winset
 
     -- run extra loggers, ignoring any that generate errors.
-    extras <- sequence $ map (flip catchX (return Nothing)) $ ppExtras pp
+    extras <- mapM (flip catchX (return Nothing)) $ ppExtras pp
 
-    return $ encodeOutput . sepBy (ppSep pp) . ppOrder pp $
+    return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
                         [ ws
                         , ppLayout pp ld
-                        , ppTitle  pp wt
+                        , ppTitle  pp $ ppTitleSanitize pp wt
                         ]
                         ++ catMaybes extras
 
@@ -303,10 +307,15 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
 -- where 1, 9, and 3 are the workspaces on screens 1, 2 and 3, respectively,
 -- and 2 and 7 are non-visible, non-empty workspaces.
 --
--- Unfortunately, at the present time, the current layout and window title
--- are not shown, and there is no way to incorporate the xinerama
--- workspace format shown above with 'dynamicLogWithPP'.  Hopefully this
--- will change soon.
+-- At the present time, the current layout and window title
+-- are not shown.  The xinerama workspace format shown above can be (mostly) replicated
+-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from
+-- "XMonad.Util.WorkspaceCompare".  For example,
+--
+-- > def { ppCurrent = dzenColor "red" "#efebe7"
+-- >     , ppVisible = wrap "[" "]"
+-- >     , ppSort    = getSortByXineramaRule
+-- >     }
 dynamicLogXinerama :: X ()
 dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
 
@@ -337,7 +346,7 @@ trim = f . f
 -- | Limit a string to a certain length, adding "..." if truncated.
 shorten :: Int -> String -> String
 shorten n xs | length xs < n = xs
-             | otherwise     = (take (n - length end) xs) ++ end
+             | otherwise     = take (n - length end) xs ++ end
  where
     end = "..."
 
@@ -385,16 +394,33 @@ xmobarColor fg bg = wrap t "</fc>"
 
 -- ??? add an xmobarEscape function?
 
--- | Strip xmobar markup.
+-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
+-- the matching tags like </fc>.
 xmobarStrip :: String -> String
-xmobarStrip = strip [] where
+xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) where
+
+converge :: (Eq a) => (a -> a) -> a -> a
+converge f a = let xs = iterate f a
+    in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs
+
+xmobarStripTags :: [String] -- ^ tags
+        -> String -> String -- ^ with all <tag>...</tag> removed
+xmobarStripTags tags = strip [] where
+    strip keep [] = keep
     strip keep x
-      | null x                 = keep
-      | "<fc="  `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= '>') $ x)
-      | "</fc>" `isPrefixOf` x = strip keep (drop 5  x)
-      | '<' == head x          = strip (keep ++ "<") (tail x)
-      | otherwise              = let (good,x') = span (/= '<') x
-                                 in strip (keep ++ good) x'
+        | rest: _ <- mapMaybe dropTag tags = strip keep rest
+
+
+        | '<':xs <- x = strip (keep ++ "<") xs
+        | (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags
+      where dropTag :: String -> Maybe String
+            dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),
+                                                   closeTag tag `stripPrefix` x]
+
+    dropTilClose, openTag, closeTag :: String -> String
+    dropTilClose = drop 1 . dropWhile (/= '>')
+    openTag str = "<" ++ str ++ "="
+    closeTag str = "</" ++ str ++ ">"
 
 -- | The 'PP' type allows the user to customize the formatting of
 --   status information.
@@ -418,6 +444,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
                -- ^ separator to use between workspace tags
              , ppTitle :: String -> String
                -- ^ window title format
+             , ppTitleSanitize :: String -> String
+              -- ^  escape / sanitizes input to 'ppTitle'
              , ppLayout :: String -> String
                -- ^ layout name format
              , ppOrder :: [String] -> [String]
@@ -450,8 +478,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 = PP { ppCurrent         = wrap "[" "]"
+defaultPP = def
+
+instance Default PP where
+    def   = PP { ppCurrent         = wrap "[" "]"
                , ppVisible         = wrap "<" ">"
                , ppHidden          = id
                , ppHiddenNoWindows = const ""
@@ -459,6 +491,7 @@ defaultPP = PP { ppCurrent         = wrap "[" "]"
                , ppSep             = " : "
                , ppWsSep           = " "
                , ppTitle           = shorten 80
+               , ppTitleSanitize   = xmobarStrip . dzenEscape
                , ppLayout          = id
                , ppOrder           = id
                , ppOutput          = putStrLn
@@ -468,7 +501,7 @@ defaultPP = PP { ppCurrent         = wrap "[" "]"
 
 -- | Settings to emulate dwm's statusbar, dzen only.
 dzenPP :: PP
-dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
+dzenPP = def { ppCurrent  = dzenColor "white" "#2b4f98" . pad
                    , ppVisible  = dzenColor "black" "#999999" . pad
                    , ppHidden   = dzenColor "black" "#cccccc" . pad
                    , ppHiddenNoWindows = const ""
@@ -476,18 +509,18 @@ dzenPP = defaultPP { ppCurrent  = dzenColor "white" "#2b4f98" . pad
                    , ppWsSep    = ""
                    , ppSep      = ""
                    , ppLayout   = dzenColor "black" "#cccccc" .
-                                  (\ x -> case x of
-                                            "TilePrime Horizontal" -> " TTT "
-                                            "TilePrime Vertical"   -> " []= "
-                                            "Hinted Full"          -> " [ ] "
-                                            _                      -> pad x
+                                  (\ x -> pad $ case x of
+                                            "TilePrime Horizontal" -> "TTT"
+                                            "TilePrime Vertical"   -> "[]="
+                                            "Hinted Full"          -> "[ ]"
+                                            _                      -> x
                                   )
                    , ppTitle    = ("^bg(#324c80) " ++) . dzenEscape
                    }
 
 -- | Some nice xmobar defaults.
 xmobarPP :: PP
-xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
+xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
                      , ppTitle   = xmobarColor "green"  "" . shorten 40
                      , ppVisible = wrap "(" ")"
                      , ppUrgent  = xmobarColor "red" "yellow"
@@ -495,24 +528,23 @@ xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
 
 -- | The options that sjanssen likes to use with xmobar, as an
 -- example.  Note the use of 'xmobarColor' and the record update on
--- 'defaultPP'.
+-- 'def'.
 sjanssenPP :: PP
-sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black"
-                       , ppTitle = xmobarColor "#00ee00" "" . shorten 120
-                       }
+sjanssenPP = def { ppCurrent = xmobarColor "white" "black"
+                 , ppTitle = xmobarColor "#00ee00" "" . shorten 120
+                 }
 
 -- | The options that byorgey likes to use with dzen, as another example.
 byorgeyPP :: PP
-byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
-                      , ppHidden  = dzenColor "black"  "#a8a3f7" . pad
-                      , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
-                      , ppUrgent  = dzenColor "red"    "yellow"  . pad
-                      , ppSep     = " | "
-                      , ppWsSep   = ""
-                      , ppTitle   = shorten 70
-                      , ppOrder   = reverse
-                      }
+byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces
+                , ppHidden  = dzenColor "black"  "#a8a3f7" . pad
+                , ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
+                , ppUrgent  = dzenColor "red"    "yellow"  . pad
+                , ppSep     = " | "
+                , ppWsSep   = ""
+                , ppTitle   = shorten 70
+                , ppOrder   = reverse
+                }
   where showNamedWorkspaces wsId = if any (`elem` wsId) ['a'..'z']
                                        then pad wsId
                                        else ""
-

XMonad/Hooks/DynamicProperty.hs

@@ -0,0 +1,71 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.DynamicProperty
+-- Copyright   :  (c) Brandon S Allbery, 2015
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Module to apply a ManageHook to an already-mapped window when a property
+-- changes. This would commonly be used to match browser windows by title,
+-- since the final title will only be set after (a) the window is mapped,
+-- (b) its document has been loaded, (c) all load-time scripts have run.
+-- (Don't blame browsers for this; it's inherent in HTML and the DOM. And
+-- changing title dynamically is explicitly permitted by ICCCM and EWMH;
+-- you don't really want to have your editor window umapped/remapped to
+-- show the current document and modified state in the titlebar, do you?)
+--
+-- This is a handleEventHook that triggers on a PropertyChange event. It
+-- currently ignores properties being removed, in part because you can't
+-- do anything useful in a ManageHook involving nonexistence of a property.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.DynamicProperty where
+
+import XMonad
+import Data.Monoid
+import Control.Applicative
+import Control.Monad (when)
+
+-- |
+-- Run a 'ManageHook' when a specific property is changed on a window. Note
+-- that this will run on any window which changes the property, so you should
+-- be very specific in your 'MansgeHook' matching (lots of windows change
+-- their titles on the fly!):
+--
+-- dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2")
+-- 
+-- Note that the fixity of (-->) won't allow it to be mixed with ($), so you
+-- can't use the obvious $ shorthand.
+--
+-- > dynamicPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work!
+--
+-- Consider instead phrasing it like any
+-- other 'ManageHook':
+--
+-- >      , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig
+-- > 
+-- >    {- ... -}
+-- > 
+-- >    myDynHook = composeAll [...]
+--
+dynamicPropertyChange :: String -> ManageHook -> Event -> X All
+dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do
+  pa <- getAtom prop
+  when (ps == propertyNewValue && a == pa) $ do
+    g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)
+    windows g
+  return mempty -- so anything else also processes it
+dynamicPropertyChange _ _ _ = return mempty
+
+-- | A shorthand for the most common case, dynamic titles
+dynamicTitle :: ManageHook -> Event -> X All
+-- strictly, this should also check _NET_WM_NAME. practically, both will
+-- change and each gets its own PropertyEvent, so we'd need to record that
+-- we saw the event for that window and ignore the second one. Instead, just
+-- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false,
+-- since there's always someone who can't bother being compliant.)
+dynamicTitle = dynamicPropertyChange "WM_NAME"

XMonad/Hooks/EwmhDesktops.hs

@@ -19,7 +19,9 @@ module XMonad.Hooks.EwmhDesktops (
     ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
     ewmhDesktopsLogHookCustom,
-    ewmhDesktopsEventHook
+    ewmhDesktopsEventHook,
+    ewmhDesktopsEventHookCustom,
+    fullscreenEventHook
     ) where
 
 import Codec.Binary.UTF8.String (encode)
@@ -34,6 +36,7 @@ import qualified XMonad.StackSet as W
 import XMonad.Hooks.SetWMName
 import XMonad.Util.XUtils (fi)
 import XMonad.Util.WorkspaceCompare
+import XMonad.Util.WindowProperties (getProp32)
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -41,9 +44,10 @@ import XMonad.Util.WorkspaceCompare
 -- > import XMonad
 -- > import XMonad.Hooks.EwmhDesktops
 -- >
--- > main = xmonad $ ewmh defaultConfig
+-- > main = xmonad $ ewmh def{ handleEventHook =
+-- >            handleEventHook def <+> fullscreenEventHook }
 --
--- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks.
+-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
 
 
 -- | Add EWMH functionality to the given config.  See above for an example.
@@ -51,7 +55,8 @@ ewmh :: XConfig a -> XConfig a
 ewmh c = c { startupHook     = startupHook c +++ ewmhDesktopsStartup
            , handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook
            , logHook         = logHook c +++ ewmhDesktopsLogHook }
- where x +++ y = mappend x y
+ -- @@@ will fix this correctly later with the rewrite
+ where x +++ y = mappend y x
 
 -- |
 -- Initializes EwmhDesktops and advertises EWMH support to the X
@@ -114,18 +119,23 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
 --  * _NET_WM_DESKTOP (move windows to other desktops)
 --
 --  * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
---
 ewmhDesktopsEventHook :: Event -> X All
-ewmhDesktopsEventHook e = handle e >> return (All True)
+ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
 
-handle :: Event -> X ()
-handle ClientMessageEvent {
+-- |
+-- Generalized version of ewmhDesktopsEventHook that allows an arbitrary
+-- user-specified function to transform the workspace list (post-sorting)
+ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
+ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
+
+handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
+handle f (ClientMessageEvent {
                ev_window = w,
                ev_message_type = mt,
                ev_data = d
-       } = withWindowSet $ \s -> do
+       }) = withWindowSet $ \s -> do
        sort' <- getSortByIndex
-       let ws = sort' $ W.workspaces s
+       let ws = f $ sort' $ W.workspaces s
 
        a_cd <- getAtom "_NET_CURRENT_DESKTOP"
        a_d <- getAtom "_NET_WM_DESKTOP"
@@ -152,8 +162,40 @@ handle ClientMessageEvent {
           -- The Message is unknown to us, but that is ok, not all are meant
           -- to be handled by the window manager
           return ()
-handle _ = return ()
+handle _ _ = return ()
 
+-- |
+-- An event hook to handle applications that wish to fullscreen using the
+-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
+-- function, such as Totem, Evince and OpenOffice.org.
+--
+-- Note this is not included in 'ewmh'.
+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
+
+  let isFull = fromIntegral fullsc `elem` wstate
+
+      -- Constants for the _NET_WM_STATE protocol:
+      remove = 0
+      add = 1
+      toggle = 2
+      ptype = 4 -- The atom property type for changeProperty
+      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:)
+      windows $ W.float win $ W.RationalRect 0 0 1 1
+    when (action == remove || (action == toggle && isFull)) $ do
+      chWstate $ delete (fi fullsc)
+      windows $ W.sink win
+
+  return $ All True
+
+fullscreenEventHook _ = return $ All True
 
 setNumberOfDesktops :: (Integral a) => a -> X ()
 setNumberOfDesktops n = withDisplay $ \dpy -> do

XMonad/Hooks/FadeInactive.hs

@@ -17,10 +17,12 @@ module XMonad.Hooks.FadeInactive (
     -- $usage
     setOpacity,
     isUnfocused,
+    isUnfocusedOnCurrentWS,
     fadeIn,
     fadeOut,
     fadeIf,
     fadeInactiveLogHook,
+    fadeInactiveCurrentWSLogHook,
     fadeOutLogHook
     ) where
 
@@ -38,7 +40,7 @@ import Control.Monad
 -- > myLogHook = fadeInactiveLogHook fadeAmount
 -- >     where fadeAmount = 0.8
 -- >
--- > main = xmonad defaultConfig { logHook = myLogHook }
+-- > main = xmonad def { logHook = myLogHook }
 --
 -- fadeAmount can be any rational between 0 and 1.
 -- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
@@ -58,18 +60,18 @@ rationalToOpacity perc
     | perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability
     | otherwise = round $ perc * 0xffffffff
 
--- | sets the opacity of a window
+-- | Sets the opacity of a window
 setOpacity :: Window -> Rational -> X ()
 setOpacity w t = withDisplay $ \dpy -> do
     a <- getAtom "_NET_WM_WINDOW_OPACITY"
     c <- getAtom "CARDINAL"
     io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
 
--- | fades a window out by setting the opacity
+-- | Fades a window out by setting the opacity
 fadeOut :: Rational -> Window -> X ()
 fadeOut = flip setOpacity
 
--- | makes a window completely opaque
+-- | Makes a window completely opaque
 fadeIn :: Window -> X ()
 fadeIn = fadeOut 1
 
@@ -78,15 +80,34 @@ fadeIn = fadeOut 1
 fadeIf :: Query Bool -> Rational -> Query Rational
 fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1
 
--- | sets the opacity of inactive windows to the specified amount
+-- | Sets the opacity of inactive windows to the specified amount
 fadeInactiveLogHook :: Rational -> X ()
 fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused
 
--- | returns True if the window doesn't have the focus.
+-- | Set the opacity of inactive windows, on the current workspace, to the
+-- specified amount. This is specifically usefull in a multi monitor setup. See
+-- 'isUnfocusedOnCurrentWS'.
+fadeInactiveCurrentWSLogHook :: Rational -> X ()
+fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS
+
+-- | Returns True if the window doesn't have the focus.
 isUnfocused :: Query Bool
 isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset
 
--- | fades out every window by the amount returned by the query.
+-- | Returns True if the window doesn't have the focus, and the window is on the
+-- current workspace. This is specifically handy in a multi monitor setup
+-- (xinerama) where multiple workspaces are visible. Using this, non-focused
+-- workspaces are are not faded out making it easier to look and read the
+-- content on them.
+isUnfocusedOnCurrentWS :: Query Bool
+isUnfocusedOnCurrentWS = do
+  w <- ask
+  ws <- liftX $ gets windowset
+  let thisWS = w `elem` W.index ws
+      unfocused = maybe True (w /=) $ W.peek ws
+  return $ thisWS && unfocused
+
+-- | Fades out every window by the amount returned by the query.
 fadeOutLogHook :: Query Rational -> X ()
 fadeOutLogHook qry = withWindowSet $ \s -> do
     let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++

XMonad/Hooks/FadeWindows.hs

@@ -0,0 +1,221 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.FadeWindows
+-- Copyright   :  Brandon S Allbery KF8NH <allbery.b@gmail.com>
+-- License     :  BSD
+--
+-- Maintainer  :  Brandon S Allbery KF8NH
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A more flexible and general compositing interface than FadeInactive.
+-- Windows can be selected and opacity specified by means of FadeHooks,
+-- which are very similar to ManageHooks and use the same machinery.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.FadeWindows (-- * Usage
+                                 -- $usage
+
+                                 -- * The 'logHook' for window fading
+                                 fadeWindowsLogHook
+
+                                 -- * The 'FadeHook'
+                                ,FadeHook
+                                ,Opacity
+                                ,idFadeHook
+
+                                 -- * Predefined 'FadeHook's
+                                ,opaque
+                                ,solid
+                                ,transparent
+                                ,invisible
+                                ,transparency
+                                ,translucence
+                                ,fadeBy
+                                ,opacity
+                                ,fadeTo
+
+                                -- * 'handleEventHook' for mapped/unmapped windows
+                                ,fadeWindowsEventHook
+
+                                -- * 'doF' for simple hooks
+                                ,doS
+
+                                -- * Useful 'Query's for 'FadeHook's
+                                ,isFloating
+                                ,isUnfocused
+                                ) where
+
+import           XMonad.Core
+import           XMonad.ManageHook                       (liftX)
+import qualified XMonad.StackSet             as W
+
+import           XMonad.Hooks.FadeInactive               (setOpacity
+                                                         ,isUnfocused
+                                                         )
+
+import           Control.Monad                           (forM_)
+import           Control.Monad.Reader                    (ask
+                                                         ,asks)
+import           Control.Monad.State                     (gets)
+import qualified Data.Map                    as M
+import           Data.Monoid
+
+import           Graphics.X11.Xlib.Extras                (Event(..))
+
+-- $usage
+-- To use this module, make sure your @xmonad@ core supports generalized
+-- 'ManageHook's (check the type of 'idHook'; if it's @ManageHook@ then
+-- your @xmonad@ is too old) and then add @fadeWindowsLogHook@ to your
+-- 'logHook' and @fadeWindowsEventHook@ to your 'handleEventHook':
+--
+-- >     , logHook = fadeWindowsLogHook myFadeHook
+-- >     , handleEventHook = fadeWindowsEventHook
+-- >     {- ... -}
+-- >
+-- > myFadeHook = composeAll [isUnfocused --> transparency 0.2
+-- >                         ,                opaque
+-- >                         ]
+--
+-- The above is like FadeInactive with a fade value of 0.2.
+--
+-- FadeHooks do not accumulate; instead, they compose from right to
+-- left like 'ManageHook's, so the above example @myFadeHook@ will
+-- render unfocused windows at 4/5 opacity and the focused window
+-- as opaque.  The 'opaque' hook above is optional, by the way, as any
+-- unmatched window will be opaque by default.
+--
+-- This module is best used with "XMonad.Hooks.MoreManageHelpers", which
+-- exports a number of Queries that can be used in either @ManageHook@
+-- or @FadeHook@.
+--
+-- Note that you need a compositing manager such as @xcompmgr@,
+-- @dcompmgr@, or @cairo-compmgr@ for window fading to work.  If you
+-- aren't running a compositing manager, the opacity will be recorded
+-- but won't take effect until a compositing manager is started.
+--
+-- For more detailed instructions on editing the 'logHook' see:
+--
+-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
+--
+-- For more detailed instructions on editing the 'handleEventHook',
+-- see:
+--
+-- "XMonad.Doc.Extending#Editing_the_event_hook"
+-- (which sadly doesnt exist at the time of writing...)
+--
+-- /WARNING:/  This module is very good at triggering bugs in
+-- compositing managers.  Symptoms range from windows not being
+-- repainted until the compositing manager is restarted or the
+-- window is unmapped and remapped, to the machine becoming sluggish
+-- until the compositing manager is restarted (at which point a
+-- popup/dialog will suddenly appear; apparently it's getting into
+-- a tight loop trying to fade the popup in).  I find it useful to
+-- have a key binding to restart the compositing manager; for example,
+--
+-- main = xmonad $ def {
+--                   {- ... -}
+--                 }
+--                 `additionalKeysP`
+--                 [("M-S-4",spawn "killall xcompmgr; sleep 1; xcompmgr -cCfF &")]
+--                 {- ... -}
+--                 ]
+--
+-- (See "XMonad.Util.EZConfig" for 'additionalKeysP'.)
+
+-- a window opacity to be carried in a Query.  OEmpty is sort of a hack
+-- to make it obay the monoid laws
+data Opacity = Opacity Rational | OEmpty
+
+instance Monoid Opacity where
+  mempty                  = OEmpty
+  r      `mappend` OEmpty = r
+  _      `mappend` r      = r
+
+-- | A FadeHook is similar to a ManageHook, but records window opacity.
+type FadeHook = Query Opacity
+
+-- | Render a window fully opaque.
+opaque :: FadeHook
+opaque =  doS (Opacity 1)
+
+-- | Render a window fully transparent.
+transparent :: FadeHook
+transparent =  doS (Opacity 0)
+
+-- | Specify a window's transparency.
+transparency :: Rational -- ^ The window's transparency as a fraction.
+                         --   @transparency 1@ is the same as 'transparent',
+                         --   whereas @transparency 0@ is the same as 'opaque'.
+             -> FadeHook
+transparency =  doS . Opacity . (1-) . clampRatio
+
+-- | Specify a window's opacity; this is the inverse of 'transparency'.
+opacity :: Rational -- ^ The opacity of a window as a fraction.
+                    --   @opacity 1@ is the same as 'opaque',
+                    --   whereas @opacity 0@ is the same as 'transparent'.
+        -> FadeHook
+opacity =  doS . Opacity . clampRatio
+
+fadeTo, translucence, fadeBy :: Rational -> FadeHook
+-- ^ An alias for 'transparency'.
+fadeTo       = transparency
+-- ^ An alias for 'transparency'.
+translucence = transparency
+-- ^ An alias for 'transparency'.
+fadeBy       = opacity
+
+invisible, solid :: FadeHook
+-- ^ An alias for 'transparent'.
+invisible    = transparent
+-- ^ An alias for 'opaque'.
+solid        = opaque
+
+-- | Like 'doF', but usable with 'ManageHook'-like hooks that
+-- aren't 'Query' wrapped around transforming functions ('Endo').
+doS :: Monoid m => m -> Query m
+doS =  return
+
+-- | The identity 'FadeHook', which renders windows 'opaque'.
+idFadeHook :: FadeHook
+idFadeHook =  opaque
+
+-- | A Query to determine if a window is floating.
+isFloating :: Query Bool
+isFloating =  ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
+
+-- boring windows can't be seen outside of a layout, so we watch messages with
+-- a dummy LayoutModifier and stow them in a persistent bucket.  this is not
+-- entirely reliable given that boringAuto still isn't observable; we just hope
+-- those aren't visible and won;t be affected anyway
+-- @@@ punted for now, will be a separate module.  it's still slimy, though
+
+-- | A 'logHook' to fade windows under control of a 'FadeHook', which is
+--   similar to but not identical to 'ManageHook'.
+fadeWindowsLogHook   :: FadeHook -> X ()
+fadeWindowsLogHook h =  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 $ \w -> do
+    o <- userCodeDef (Opacity 1) (runQuery h w)
+    setOpacity w $ case o of
+                     OEmpty    -> 0.93
+                     Opacity r -> r
+
+-- | A 'handleEventHook' to handle fading and unfading of newly mapped
+--   or unmapped windows; this avoids problems with layouts such as
+--   "XMonad.Layout.Full" or "XMonad.Layout.Tabbed".  This hook may
+--   also be useful with "XMonad.Hooks.FadeInactive".
+fadeWindowsEventHook                     :: Event -> X All
+fadeWindowsEventHook (MapNotifyEvent {}) =
+  -- we need to run the fadeWindowsLogHook.  only one way...
+  asks config >>= logHook >> return (All True)
+fadeWindowsEventHook _                   =  return (All True)
+
+-- A utility to clamp opacity fractions to the range (0,1)
+clampRatio   :: Rational         -> Rational
+clampRatio r |  r >= 0 && r <= 1 =  r
+             |  r < 0            =  0
+             |  otherwise        =  1

XMonad/Hooks/FloatNext.hs

@@ -2,10 +2,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.FloatNext
--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
--- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -36,38 +36,11 @@ module XMonad.Hooks.FloatNext ( -- * Usage
                               , willFloatAllNewPP
                               , runLogHook ) where
 
-import Prelude hiding (all)
-
 import XMonad
-import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Hooks.ToggleHook
 
-import Control.Monad (join,guard)
-import Control.Applicative ((<$>))
-import Control.Arrow (first, second)
-
-{- Helper functions -}
-
-_set :: ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
-_set f b = modify' (f $ const b)
-
-_toggle :: ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
-_toggle f = modify' (f not)
-
-_get :: ((Bool, Bool) -> a) -> X a
-_get f = XS.gets (f . getFloatMode)
-
-_pp :: ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
-_pp f s st = (\b -> guard b >> Just (st s)) <$> _get f
-
-{- The current state is kept here -}
-
-data FloatMode = FloatMode { getFloatMode :: (Bool,Bool) } deriving (Typeable)
-
-instance ExtensionClass FloatMode where
-    initialValue = FloatMode (False,False)
-
-modify' :: ((Bool,Bool) -> (Bool,Bool)) -> X ()
-modify' f = XS.modify (FloatMode . f . getFloatMode)
+hookName :: String
+hookName = "__float"
 
 -- $usage
 -- This module provides actions (that can be set as keybindings)
@@ -80,7 +53,7 @@ modify' f = XS.modify (FloatMode . f . getFloatMode)
 --
 -- and adding 'floatNextHook' to your 'ManageHook':
 --
--- > myManageHook = floatNextHook <+> manageHook defaultConfig
+-- > myManageHook = floatNextHook <+> manageHook def
 --
 -- The 'floatNext' and 'toggleFloatNext' functions can be used in key
 -- bindings to float the next spawned window:
@@ -95,33 +68,31 @@ modify' f = XS.modify (FloatMode . f . getFloatMode)
 -- | This 'ManageHook' will selectively float windows as set
 -- by 'floatNext' and 'floatAllNew'.
 floatNextHook :: ManageHook
-floatNextHook = do (next, all) <- liftX $ XS.gets getFloatMode
-                   liftX $ XS.put $ FloatMode (False, all)
-                   if next || all then doFloat else idHook
+floatNextHook = toggleHook hookName doFloat
 
 -- | @floatNext True@ arranges for the next spawned window to be
 -- sent to the floating layer, @floatNext False@ cancels it.
 floatNext :: Bool -> X ()
-floatNext = _set first
+floatNext = hookNext hookName
 
 toggleFloatNext :: X ()
-toggleFloatNext = _toggle first
+toggleFloatNext = toggleHookNext hookName
 
 -- | @floatAllNew True@ arranges for new windows to be
 -- sent to the floating layer, @floatAllNew False@ cancels it
 floatAllNew :: Bool -> X ()
-floatAllNew = _set second
+floatAllNew = hookAllNew hookName
 
 toggleFloatAllNew :: X ()
-toggleFloatAllNew = _toggle second
+toggleFloatAllNew = toggleHookAllNew hookName
 
 -- | Whether the next window will be set floating
 willFloatNext :: X Bool
-willFloatNext = _get fst
+willFloatNext = willHookNext hookName
 
 -- | Whether new windows will be set floating
 willFloatAllNew :: X Bool
-willFloatAllNew = _get snd
+willFloatAllNew = willHookAllNew hookName
 
 -- $pp
 -- The following functions are used to display the current
@@ -143,10 +114,7 @@ willFloatAllNew = _get snd
 -- pass them 'id'.
 
 willFloatNextPP :: (String -> String) -> X (Maybe String)
-willFloatNextPP = _pp fst "Next"
+willFloatNextPP = willHookNextPP hookName
 
 willFloatAllNewPP :: (String -> String) -> X (Maybe String)
-willFloatAllNewPP = _pp snd "All"
-
-runLogHook :: X ()
-runLogHook = join $ asks $ logHook . config
+willFloatAllNewPP = willHookAllNewPP hookName

XMonad/Hooks/ICCCMFocus.hs

@@ -0,0 +1,42 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Hooks.ICCCMFocus
+-- License      : BSD
+--
+-- Maintainer   : Tony Morris <haskell@tmorris.net>
+--
+-- Implemented in your @logHook@, Java swing applications will not misbehave
+-- when it comes to taking and losing focus.
+--
+-- This has been done by taking the patch in <http://code.google.com/p/xmonad/issues/detail?id=177> and refactoring it so that it can be included in @~\/.xmonad\/xmonad.hs@.
+--
+-- @
+--    conf' =
+--      conf {
+--        logHook = takeTopFocus
+--      }
+-- @
+-----------------------------------------------------------------------------
+module XMonad.Hooks.ICCCMFocus
+{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-}
+(
+  atom_WM_TAKE_FOCUS
+, takeFocusX
+, takeTopFocus
+) where
+
+import XMonad
+import XMonad.Hooks.SetWMName
+import qualified XMonad.StackSet as W
+
+takeFocusX ::
+  Window
+  -> X ()
+takeFocusX _w = return ()
+
+-- | The value to add to your log hook configuration.
+takeTopFocus ::
+  X ()
+takeTopFocus =
+  (withWindowSet $ maybe (setFocusX =<< asks theRoot) takeFocusX . W.peek) >> setWMName "LG3D"
+

XMonad/Hooks/InsertPosition.hs

@@ -31,7 +31,7 @@ import Data.Monoid(Endo(Endo))
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Hooks.InsertPosition
--- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook }
+-- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook }
 --
 -- You should you put the manageHooks that use 'doShift' to take effect
 -- /before/ 'insertPosition', so that the window order will be consistent.

XMonad/Hooks/ManageDebug.hs

@@ -0,0 +1,100 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ManageDebug
+-- Copyright   :  (c) Brandon S Allbery KF8NH, 2014
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  allbery.b@gmail.com
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's.
+-- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator.
+-- Or use @debugManageHookOn@ for a triggerable version, specifying the
+-- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the
+-- individual hooks in whatever way you see fit.
+--
+-----------------------------------------------------------------------------
+--
+--
+
+module XMonad.Hooks.ManageDebug (debugManageHook
+                                ,debugManageHookOn
+                                ,manageDebug
+                                ,maybeManageDebug
+                                ,manageDebugLogHook
+                                ,debugNextManagedWindow
+                                ) where
+
+import           XMonad
+import           XMonad.Hooks.DebugStack
+import           XMonad.Util.DebugWindow
+import           XMonad.Util.EZConfig
+import qualified XMonad.Util.ExtensibleState                                                 as XS
+import           Control.Monad                            (when)
+
+-- persistent state for manageHook debugging to trigger logHook debugging
+data ManageStackDebug = MSD (Bool,Bool) deriving Typeable
+instance ExtensionClass ManageStackDebug where
+  initialValue = MSD (False,False)
+
+-- | A combinator to add full 'ManageHook' debugging in a single operation.
+debugManageHook :: XConfig l -> XConfig l
+debugManageHook cf = cf {logHook    = manageDebugLogHook <+> logHook    cf
+                        ,manageHook = manageDebug        <+> manageHook cf
+                        }
+
+-- | A combinator to add triggerable 'ManageHook' debugging in a single operation.
+--   Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press
+--   this key before opening the window to get just that logged.
+debugManageHookOn :: String -> XConfig l -> XConfig l
+debugManageHookOn key cf = cf {logHook    = manageDebugLogHook <+> logHook    cf
+                              ,manageHook = maybeManageDebug   <+> manageHook cf
+                              }
+                           `additionalKeysP`
+                           [(key,debugNextManagedWindow)]
+
+-- | Place this at the start of a 'ManageHook', or possibly other places for a
+--   more limited view. It will show the current 'StackSet' state and the new
+--   window, and set a flag so that @manageDebugLogHook@ will display the
+--   final 'StackSet' state.
+--
+--   Note that the initial state shows only the current workspace; the final
+--   one shows all workspaces, since your 'ManageHook' might use e.g. 'doShift',
+manageDebug :: ManageHook
+manageDebug = do
+  w <- ask
+  liftX $ do
+    trace "== manageHook; current stack =="
+    debugStackString >>= trace
+    ws <- debugWindow w
+    trace $ "new:\n  " ++ ws
+    XS.modify $ \(MSD (_,key)) -> MSD (True,key)
+  idHook
+
+-- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@.
+maybeManageDebug :: ManageHook
+maybeManageDebug = do
+  go <- liftX $ do
+    MSD (log_,go') <- XS.get
+    XS.put $ MSD (log_,False)
+    return go'
+  if go then manageDebug else idHook
+
+-- | If @manageDebug@ has set the debug-stack flag, show the stack.
+manageDebugLogHook :: X ()
+manageDebugLogHook = do
+                       MSD (go,key) <- XS.get
+                       when go $ do
+                         trace "== manageHook; final stack =="
+                         debugStackFullString >>= trace
+                         XS.put $ MSD (False,key)
+                       idHook
+
+-- | Request that the next window to be managed be @manageDebug@-ed. This can
+--   be used anywhere an X action can, such as key bindings, mouse bindings
+--   (presumably with 'const'), 'startupHook', etc.
+debugNextManagedWindow :: X ()
+debugNextManagedWindow = XS.modify $ \(MSD (log_,_)) -> MSD (log_,True)

XMonad/Hooks/ManageDocks.hs

@@ -1,6 +1,4 @@
-{-# LANGUAGE PatternGuards, FlexibleInstances, MultiParamTypeClasses #-}
-{-# OPTIONS -fglasgow-exts #-}
--- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
+{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.ManageDocks
@@ -17,11 +15,18 @@
 module XMonad.Hooks.ManageDocks (
     -- * Usage
     -- $usage
-    manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
+    docksEventHook, docksStartupHook,
     ToggleStruts(..),
     SetStruts(..),
     module XMonad.Util.Types,
 
+#ifdef TESTING
+    r2c,
+    c2r,
+    RectC(..),
+#endif
+
     -- for XMonad.Actions.FloatSnap
     calcGap
     ) where
@@ -30,28 +35,29 @@ module XMonad.Hooks.ManageDocks (
 -----------------------------------------------------------------------------
 import XMonad
 import Foreign.C.Types (CLong)
-import Control.Monad
 import XMonad.Layout.LayoutModifier
 import XMonad.Util.Types
 import XMonad.Util.WindowProperties (getProp32s)
+import XMonad.Util.XUtils (fi)
+import qualified XMonad.Util.ExtensibleState as XS
+import Data.Monoid (All(..), mempty)
+import Data.Functor((<$>))
 
 import qualified Data.Set as S
+import qualified Data.Map as M
+import Control.Monad (when, forM_, filterM)
 
 -- $usage
 -- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Hooks.ManageDocks
 --
--- The first component is a 'ManageHook' which recognizes these
--- windows and de-manages them, so that xmonad does not try to tile
--- them.  To enable it:
+-- Wrap your xmonad config with a call to 'docks', like so:
 --
--- > manageHook = ... <+> manageDocks
+-- > main = xmonad $ docks def
 --
--- The second component is a layout modifier that prevents windows
--- from overlapping these dock windows.  It is intended to replace
--- xmonad's so-called \"gap\" support.  First, you must add it to your
--- list of layouts:
+-- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout
+-- to prevent windows from overlapping these windows.
 --
 -- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
 -- >                   where  tall = Tall 1 (3/100) (1/2)
@@ -75,22 +81,44 @@ import qualified Data.Set as S
 --
 -- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
 --
--- /Important note/: if you are switching from manual gaps
--- (defaultGaps in your config) to avoidStruts (recommended, since
--- manual gaps will probably be phased out soon), be sure to switch
--- off all your gaps (with mod-b) /before/ reloading your config with
--- avoidStruts!  Toggling struts with a 'ToggleStruts' message will
--- not work unless your gaps are set to zero.
---
 -- For detailed instructions on editing your key bindings, see
 -- "XMonad.Doc.Extending#Editing_key_bindings".
 --
 
+-- | Add docks functionality to the given config.  See above for an example.
+docks :: XConfig a -> XConfig a
+docks c = c { startupHook     = docksStartupHook <+> startupHook c
+            , handleEventHook = docksEventHook <+> handleEventHook c
+            , manageHook      = manageDocks <+> manageHook c }
+
+newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] }
+    deriving (Eq, Typeable)
+
+data UpdateDocks = UpdateDocks deriving Typeable
+instance Message UpdateDocks
+
+refreshDocks :: X ()
+refreshDocks = sendMessage UpdateDocks
+
+instance ExtensionClass StrutCache where
+  initialValue = StrutCache M.empty
+
+updateStrutCache :: Window -> [Strut] -> X Bool
+updateStrutCache w strut = do
+  XS.modified $ StrutCache . M.insert w strut . fromStrutCache
+
+deleteFromStructCache :: Window -> X Bool
+deleteFromStructCache w = do
+  XS.modified $ StrutCache . M.delete w . fromStrutCache
+
 -- | Detects if the given window is of type DOCK and if so, reveals
---   it, but does not manage it. If the window has the STRUT property
---   set, adjust the gap accordingly.
+--   it, but does not manage it.
 manageDocks :: ManageHook
-manageDocks = checkDock --> doIgnore
+manageDocks = checkDock --> (doIgnore <+> setDocksMask)
+    where setDocksMask = do
+            ask >>= \win -> liftX $ withDisplay $ \dpy -> do
+                io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
+            mempty
 
 -- | Checks if a window is a DOCK or DESKTOP window
 checkDock :: Query Bool
@@ -99,8 +127,39 @@ checkDock = ask >>= \w -> liftX $ do
     desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
     mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
     case mbr of
-        Just [r] -> return $ elem (fromIntegral r) [dock, desk]
-        _        -> return False
+        Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)
+        _       -> return False
+
+-- | Whenever a new dock appears, refresh the layout immediately to avoid the
+-- new dock.
+docksEventHook :: Event -> X All
+docksEventHook (MapNotifyEvent { ev_window = w }) = do
+    whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do
+        strut <- getStrut w
+        whenX (updateStrutCache w strut) refreshDocks
+    return (All True)
+docksEventHook (PropertyEvent { ev_window = w
+                              , ev_atom = a }) = do
+    nws <- getAtom "_NET_WM_STRUT"
+    nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
+    when (a == nws || a == nwsp) $ do
+        strut <- getStrut w
+        whenX (updateStrutCache w strut) refreshDocks
+    return (All True)
+docksEventHook (DestroyWindowEvent {ev_window = w}) = do
+    whenX (deleteFromStructCache w) refreshDocks
+    return (All True)
+docksEventHook _ = return (All True)
+
+docksStartupHook :: X ()
+docksStartupHook = withDisplay $ \dpy -> do
+    rootw <- asks theRoot
+    (_,_,wins) <- io $ queryTree dpy rootw
+    docks <- filterM (runQuery checkDock) wins
+    forM_ docks $ \win -> do
+        strut <- getStrut win
+        updateStrutCache win strut
+    refreshDocks
 
 -- | Gets the STRUT config, if present, in xmonad gap order
 getStrut :: Window -> X [Strut]
@@ -123,9 +182,7 @@ getStrut w = do
 calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
 calcGap ss = withDisplay $ \dpy -> do
     rootw <- asks theRoot
-    -- We don't keep track of dock like windows, so we find all of them here
-    (_,_,wins) <- io $ queryTree dpy rootw
-    struts <- (filter careAbout . concat) `fmap` mapM getStrut wins
+    struts <- (filter careAbout . concat) `fmap` 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
@@ -147,7 +204,7 @@ avoidStrutsOn :: LayoutClass l a =>
                  [Direction2D]
               -> l a
               -> ModifiedLayout AvoidStruts l a
-avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss
+avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss)
 
 data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
 
@@ -187,21 +244,30 @@ instance Message SetStruts
 
 instance LayoutModifier AvoidStruts a where
     modifyLayout (AvoidStruts ss) w r = do
-        nr <- fmap ($ r) (calcGap ss)
-        runLayout w nr
+        srect <- fmap ($ r) (calcGap ss)
+        -- Ensure _NET_WORKAREA is not set.
+        -- See: https://github.com/xmonad/xmonad-contrib/pull/79
+        rmWorkarea
+        runLayout w srect
 
-    pureMess (AvoidStruts ss) m
+    pureMess as@(AvoidStruts ss) m
         | Just ToggleStruts    <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
         | Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
         | Just (SetStruts n k) <- fromMessage m
         , let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
         , newSS /= ss = Just $ AvoidStruts newSS
+        | Just UpdateDocks <- fromMessage m = Just as
         | otherwise = Nothing
       where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
                         | otherwise = S.empty
             toggleOne x xs | x `S.member` xs = S.delete x xs
                            | otherwise   = x `S.insert` xs
 
+rmWorkarea :: X ()
+rmWorkarea = withDisplay $ \dpy -> do
+    a <- getAtom "_NET_WORKAREA"
+    r <- asks theRoot
+    io (deleteProperty dpy r a)
 
 -- | (Direction, height\/width, initial pixel, final pixel).
 
@@ -210,32 +276,22 @@ type Strut = (Direction2D, CLong, CLong, CLong)
 -- | (Initial x pixel, initial y pixel,
 --    final x pixel, final y pixel).
 
-type RectC = (CLong, CLong, CLong, CLong)
-
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
+newtype RectC = RectC (CLong, CLong, CLong, CLong) deriving (Eq,Show)
 
 -- | Invertible conversion.
 
 r2c :: Rectangle -> RectC
-r2c (Rectangle x y w h) = (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
+r2c (Rectangle x y w h) = RectC (fi x, fi y, fi x + fi w - 1, fi y + fi h - 1)
 
 -- | Invertible conversion.
 
 c2r :: RectC -> Rectangle
-c2r (x1, y1, x2, y2) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
+c2r (RectC (x1, y1, x2, y2)) = Rectangle (fi x1) (fi y1) (fi $ x2 - x1 + 1) (fi $ y2 - y1 + 1)
 
--- TODO: Add these QuickCheck properties to the test suite, along with
--- suitable Arbitrary instances.
-
--- prop_r2c_c2r :: RectC -> Bool
--- prop_r2c_c2r r = r2c (c2r r) == r
-
--- prop_c2r_r2c :: Rectangle -> Bool
--- prop_c2r_r2c r = c2r (r2c r) == r
 
 reduce :: RectC -> Strut -> RectC -> RectC
-reduce (sx0, sy0, sx1, sy1) (s, n, l, h) (x0, y0, x1, y1) = case s of
+reduce (RectC (sx0, sy0, sx1, sy1)) (s, n, l, h) (RectC (x0, y0, x1, y1)) =
+ RectC $ case s of
     L | p (y0, y1) && qh x1     -> (mx x0 sx0, y0       , x1       , y1       )
     R | p (y0, y1) && qv sx1 x0 -> (x0       , y0       , mn x1 sx1, y1       )
     U | p (x0, x1) && qh y1     -> (x0       , mx y0 sy0, x1       , y1       )

XMonad/Hooks/ManageHelpers.hs

@@ -13,7 +13,7 @@
 --
 -- > import XMonad.Hooks.ManageHelpers
 -- > main =
--- >     xmonad defaultConfig{
+-- >     xmonad def{
 -- >         ...
 -- >         manageHook = composeOne [
 -- >             isKDETrayWindow -?> doIgnore,
@@ -45,7 +45,8 @@ module XMonad.Hooks.ManageHelpers (
     doSideFloat,
     doFloatAt,
     doFloatDep,
-    doHideIgnore
+    doHideIgnore,
+    Match,
 ) where
 
 import XMonad

XMonad/Hooks/Minimize.hs

@@ -0,0 +1,53 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.Minimize
+-- Copyright   :  (c) Justin Bogner 2010
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Justin Bogner <mail@justinbogner.com>
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- Handles window manager hints to minimize and restore windows. Use
+-- this with "XMonad.Layout.Minimize".
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.Minimize
+    ( -- * Usage
+      -- $usage
+      minimizeEventHook
+    ) where
+
+import Data.Monoid
+import Control.Monad(when)
+
+import XMonad
+import XMonad.Layout.Minimize
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.Minimize
+-- > import XMonad.Layout.Minimize
+-- >
+-- > myHandleEventHook = minimizeEventHook
+-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
+-- > main = xmonad def { layoutHook = myLayout
+-- >                   , handleEventHook = myHandleEventHook }
+
+minimizeEventHook :: Event -> X All
+minimizeEventHook (ClientMessageEvent {ev_window = w,
+                                       ev_message_type = mt,
+                                       ev_data = dt}) = do
+    a_aw <- getAtom "_NET_ACTIVE_WINDOW"
+    a_cs <- getAtom "WM_CHANGE_STATE"
+
+    when (mt == a_aw) $ sendMessage (RestoreMinimizedWin w)
+    when (mt == a_cs) $ do
+      let message = fromIntegral . head $ dt
+      when (message == normalState) $ sendMessage (RestoreMinimizedWin w)
+      when (message == iconicState) $ minimizeWindow w
+
+    return (All True)
+minimizeEventHook _ = return (All True)

XMonad/Hooks/Place.hs

@@ -1,10 +1,10 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.Place
--- Copyright   :  Quentin Moser <quentin.moser@unifr.ch>
+-- Copyright   :  Quentin Moser <moserq@gmail.com>
 -- License     :  BSD-style (see LICENSE)
 --
--- Maintainer  :  Quentin Moser <quentin.moser@unifr.ch>
+-- Maintainer  :  orphaned
 -- Stability   :  unstable
 -- Portability :  unportable
 --
@@ -38,11 +38,12 @@ import qualified XMonad.StackSet as S
 
 import XMonad.Layout.WindowArranger
 import XMonad.Actions.FloatKeys
+import XMonad.Util.XUtils
 
 import qualified Data.Map as M
 import Data.Ratio ((%))
 import Data.List (sortBy, minimumBy, partition)
-import Data.Maybe (maybe, fromMaybe, catMaybes)
+import Data.Maybe (fromMaybe, catMaybes)
 import Data.Monoid (Endo(..))
 import Control.Monad (guard, join)
 import Control.Monad.Trans (lift)
@@ -58,8 +59,8 @@ import Control.Monad.Trans (lift)
 --
 -- and adding 'placeHook' to your 'manageHook', for example:
 --
--- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart
--- >                                              <+> manageHook defaultConfig }
+-- > main = xmonad $ def { manageHook = placeHook simpleSmart
+-- >                                    <+> manageHook def }
 --
 -- Note that 'placeHook' should be applied after most other hooks, especially hooks
 -- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from
@@ -262,8 +263,6 @@ checkBounds (Rectangle x1 y1 w1 h1) (Rectangle x2 y2 w2 h2)
 scale :: (RealFrac a, Integral b) => a -> b -> b -> b
 scale r n1 n2 = truncate $ r * fi n2 + (1 - r) * fi n1
 
-fi :: (Integral a, Num b) => a -> b
-fi = fromIntegral
 
 r2rr :: Rectangle -> Rectangle -> S.RationalRect
 r2rr (Rectangle x0 y0 w0 h0) (Rectangle x y w h)

XMonad/Hooks/PositionStoreHooks.hs

@@ -36,13 +36,15 @@ module XMonad.Hooks.PositionStoreHooks (
 import XMonad
 import qualified XMonad.StackSet as W
 import XMonad.Util.PositionStore
-import XMonad.Util.XUtils (fi)
+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
+import qualified Data.Set as S
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -50,21 +52,27 @@ import Data.Monoid
 -- > import XMonad.Hooks.PositionStoreHooks
 --
 -- and adding 'positionStoreManageHook' to your 'ManageHook' as well
--- as 'positionStoreEventHook' to your event hooks:
+-- as 'positionStoreEventHook' to your event hooks. To be accurate
+-- about window sizes, the module needs to know if any decoration is in effect.
+-- This is specified with the first argument: Supply 'Nothing' for no decoration,
+-- otherwise use 'Just def' or similar to inform the module about the
+-- decoration theme used.
 --
--- > myManageHook = positionStoreManageHook <+> manageHook defaultConfig
+-- > myManageHook = positionStoreManageHook Nothing <+> manageHook def
 -- > myHandleEventHook = positionStoreEventHook
 -- >
--- > main = xmonad defaultConfig { manageHook = myManageHook
--- >                             , handleEventHook = myHandleEventHook
--- >                             }
+-- > main = xmonad def { manageHook = myManageHook
+-- >                   , handleEventHook = myHandleEventHook
+-- >                   }
 --
 
-positionStoreManageHook :: ManageHook
-positionStoreManageHook = ask >>= liftX . positionStoreInit >> idHook
+positionStoreManageHook :: Maybe Theme -> ManageHook
+positionStoreManageHook mDecoTheme = ask >>= liftX . positionStoreInit mDecoTheme >> idHook
 
-positionStoreInit :: Window -> X ()
-positionStoreInit w = withDisplay $ \d -> do
+positionStoreInit :: Maybe Theme -> Window -> X ()
+positionStoreInit mDecoTheme w  = withDisplay $ \d -> do
+        let decoH = maybe 0 decoHeight mDecoTheme   -- take decoration into account, which - in its current
+                                                    -- form - makes windows smaller to make room for it
         wa <- io $ getWindowAttributes d w
         ws <- gets windowset
         arbitraryOffsetX <- randomIntOffset
@@ -76,13 +84,16 @@ positionStoreInit w = withDisplay $ \d -> do
                                         (Rectangle (srX + fi arbitraryOffsetX)
                                                    (srY + fi arbitraryOffsetY)
                                                     (fi $ wa_width wa)
-                                                    (fi $ wa_height wa)) sr )
+                                                    (decoH + fi (wa_height wa))) sr )
             else do
                 sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
                 let sr = screenRect . W.screenDetail $ sc
+                sr' <- fmap ($ sr) (calcGap $ S.fromList [minBound .. maxBound]) -- take docks into account, accepting
+                                                                                       -- a somewhat unfortunate inter-dependency
+                                                                                       -- with 'XMonad.Hooks.ManageDocks'
                 modifyPosStore (\ps -> posStoreInsert ps w
-                                        (Rectangle (fi $ wa_x wa) (fi $ wa_y wa)
-                                            (fi $ wa_width wa) (fi $ wa_height wa)) sr )
+                                        (Rectangle (fi $ wa_x wa) (fi (wa_y wa) - fi decoH)
+                                            (fi $ wa_width wa) (decoH + fi (wa_height wa))) sr' )
     where
         randomIntOffset :: X (Int)
         randomIntOffset = io $ randomRIO (42, 242)

XMonad/Hooks/RestoreMinimized.hs

@@ -8,9 +8,9 @@
 -- Stability   :  unstable
 -- Portability :  not portable
 --
--- Lets you restore minimized windows (see "XMonad.Layout.Minimize")
--- by selecting them on a taskbar (listens for _NET_ACTIVE_WINDOW
--- and WM_CHANGE_STATE).
+-- (Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized
+-- windows (see "XMonad.Layout.Minimize") by selecting them on a
+-- taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).
 --
 -----------------------------------------------------------------------------
 
@@ -34,7 +34,7 @@ import XMonad.Layout.Minimize
 -- >
 -- > myHandleEventHook = restoreMinimizedEventHook
 -- >
--- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook }
+-- > main = xmonad def { handleEventHook = myHandleEventHook }
 
 data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
 

XMonad/Hooks/ScreenCorners.hs

@@ -0,0 +1,199 @@
+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ScreenCorners
+-- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Run @X ()@ actions by touching the edge of your screen with your mouse.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ScreenCorners
+    (
+    -- * Usage
+    -- $usage
+
+    -- * Adding screen corners
+      ScreenCorner (..)
+    , addScreenCorner
+    , addScreenCorners
+
+    -- * Event hook
+    , screenCornerEventHook
+
+    -- * Layout hook
+    , screenCornerLayoutHook
+    ) where
+
+import Data.Monoid
+import Data.List (find)
+import XMonad
+import XMonad.Util.XUtils (fi)
+import XMonad.Layout.LayoutModifier
+
+import qualified Data.Map as M
+import qualified XMonad.Util.ExtensibleState as XS
+
+data ScreenCorner = SCUpperLeft
+                  | SCUpperRight
+                  | SCLowerLeft
+                  | SCLowerRight
+                  deriving (Eq, Ord, Show)
+
+
+
+--------------------------------------------------------------------------------
+-- ExtensibleState modifications
+--------------------------------------------------------------------------------
+
+newtype ScreenCornerState = ScreenCornerState (M.Map Window (ScreenCorner, X ()))
+    deriving Typeable
+
+instance ExtensionClass ScreenCornerState where
+    initialValue = ScreenCornerState M.empty
+
+-- | Add one single @X ()@ action to a screen corner
+addScreenCorner :: ScreenCorner -> X () -> X ()
+addScreenCorner corner xF = do
+
+    ScreenCornerState m <- XS.get
+    (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
+
+    XS.modify $ \(ScreenCornerState m') -> ScreenCornerState $ M.insert win (corner,xFunc) m'
+
+-- | Add a list of @(ScreenCorner, X ())@ tuples
+addScreenCorners :: [ (ScreenCorner, X ()) ] -> X ()
+addScreenCorners = mapM_ (\(corner, xF) -> addScreenCorner corner xF)
+
+
+--------------------------------------------------------------------------------
+-- Xlib functions
+--------------------------------------------------------------------------------
+
+-- "Translate" a ScreenCorner to real (x,y) Positions
+createWindowAt :: ScreenCorner -> X Window
+createWindowAt SCUpperLeft = createWindowAt' 0 0
+createWindowAt SCUpperRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) 0
+
+createWindowAt SCLowerLeft = withDisplay $ \dpy ->
+    let h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' 0 (fi h)
+
+createWindowAt SCLowerRight = withDisplay $ \dpy ->
+    let w = displayWidth  dpy (defaultScreen dpy) - 1
+        h = displayHeight dpy (defaultScreen dpy) - 1
+    in createWindowAt' (fi w) (fi h)
+
+-- Create a new X window at a (x,y) Position
+createWindowAt' :: Position -> Position -> X Window
+createWindowAt' x y = withDisplay $ \dpy -> io $ do
+
+    rootw <- rootWindow dpy (defaultScreen dpy)
+
+    let
+        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
+        attrmask = cWOverrideRedirect
+
+    w <- allocaSetWindowAttributes $ \attributes -> do
+
+        set_override_redirect attributes True
+        createWindow dpy        -- display
+                     rootw      -- parent window
+                     x          -- x
+                     y          -- y
+                     1          -- width
+                     1          -- height
+                     0          -- border width
+                     0          -- depth
+                     inputOnly  -- class
+                     visual     -- visual
+                     attrmask   -- valuemask
+                     attributes -- attributes
+
+    -- we only need mouse entry events
+    selectInput dpy w enterWindowMask
+    mapWindow dpy w
+    sync dpy False
+    return w
+
+
+--------------------------------------------------------------------------------
+-- Event hook
+--------------------------------------------------------------------------------
+
+-- | Handle screen corner events
+screenCornerEventHook :: Event -> X All
+screenCornerEventHook CrossingEvent { ev_window = win } = do
+
+    ScreenCornerState m <- XS.get
+
+    case M.lookup win m of
+         Just (_, xF) -> xF
+         Nothing      -> return ()
+
+    return (All True)
+
+screenCornerEventHook _ = return (All True)
+
+
+--------------------------------------------------------------------------------
+-- Layout hook
+--------------------------------------------------------------------------------
+
+data ScreenCornerLayout a = ScreenCornerLayout
+    deriving ( Read, Show )
+
+instance LayoutModifier ScreenCornerLayout a where
+    hook ScreenCornerLayout = withDisplay $ \dpy -> do
+        ScreenCornerState m <- XS.get
+        io $ mapM_ (raiseWindow dpy) $ M.keys m
+    unhook = hook
+
+screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
+screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
+
+
+--------------------------------------------------------------------------------
+-- $usage
+--
+-- This extension adds KDE-like screen corners to XMonad. By moving your cursor
+-- into one of your screen corners you can trigger an @X ()@ action, for
+-- example @"XMonad.Actions.GridSelect".goToSelected@ or
+-- @"XMonad.Actions.CycleWS".nextWS@ etc.
+--
+-- To use it, import it on top of your @xmonad.hs@:
+--
+-- > import XMonad.Hooks.ScreenCorners
+--
+-- Then add your screen corners in our startup hook:
+--
+-- > myStartupHook = do
+-- >     ...
+-- >     addScreenCorner SCUpperRight (goToSelected defaultGSConfig { gs_cellwidth = 200})
+-- >     addScreenCorners [ (SCLowerRight, nextWS)
+-- >                      , (SCLowerLeft,  prevWS)
+-- >                      ]
+--
+-- Then add layout hook:
+--
+-- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where
+-- >     tiled   = Tall nmaster delta ratio
+-- >     nmaster = 1
+-- >     ratio   = 1 / 2
+-- >     delta   = 3 / 100
+--
+-- And finally wait for screen corner events in your event hook:
+--
+-- > myEventHook e = do
+-- >     ...
+-- >     screenCornerEventHook e

XMonad/Hooks/Script.hs

@@ -26,9 +26,6 @@ module XMonad.Hooks.Script (
 --
 import XMonad
 
-import Control.Monad.Trans
-import System.Directory
-
 -- $usage
 --
 -- This module allows you to run a centrally located script with the text
@@ -37,7 +34,7 @@ import System.Directory
 -- For example, if you wanted to run the hook "startup" in your script every
 -- time your startup hook ran, you could modify your xmonad config as such:
 --
--- > main = xmonad $ defaultConfig {
+-- > main = xmonad $ def {
 -- >   ...
 -- >   startupHook = execScriptHook "startup"
 -- >   ...
@@ -48,7 +45,7 @@ import System.Directory
 
 -- | Execute a named script hook
 execScriptHook :: MonadIO m => String -> m ()
-execScriptHook hook = io $ do
-  home <- getHomeDirectory
-  let script = home ++ "/.xmonad/hooks "
+execScriptHook hook = do
+  xmonadDir <- getXMonadDir
+  let script = xmonadDir ++ "/hooks "
   spawn (script ++ hook)

XMonad/Hooks/ServerMode.hs

@@ -1,70 +1,104 @@
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Hooks.ServerMode
--- Copyright   :  (c) Andrea Rossato and David Roundy 2007
+-- Copyright   :  (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
 -- License     :  BSD-style (see xmonad/LICENSE)
 --
--- Maintainer  :  andrea.rossato@unibz.it
+-- Maintainer  :  polson2@hawk.iit.edu
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- This is an 'EventHook' that will receive commands from an external
--- client.
+-- client. Also consider "XMonad.Hooks.EwmhDesktops" together with
+-- @wmctrl@.
 --
 -- This is the example of a client:
 --
 -- > import Graphics.X11.Xlib
 -- > import Graphics.X11.Xlib.Extras
 -- > import System.Environment
+-- > import System.IO
 -- > import Data.Char
--- >
--- > usage :: String -> String
--- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad"
--- >
+-- > 
 -- > main :: IO ()
--- > main = do
--- >   args <- getArgs
--- >   pn <- getProgName
--- >   let com = case args of
--- >               [] -> error $ usage pn
--- >               w -> (w !! 0)
--- >   sendCommand com
--- >
--- > sendCommand :: String -> IO ()
--- > sendCommand s = do
+-- > main = parse True "XMONAD_COMMAND" =<< getArgs
+-- > 
+-- > parse :: Bool -> String -> [String] -> IO ()
+-- > parse input addr args = case args of
+-- >         ["--"] | input -> repl addr
+-- >                | otherwise -> return ()
+-- >         ("--":xs) -> sendAll addr xs
+-- >         ("-a":a:xs) -> parse input a xs
+-- >         ("-h":_) -> showHelp
+-- >         ("--help":_) -> showHelp
+-- >         ("-?":_) -> showHelp
+-- >         (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)
+-- > 
+-- >         (x:xs) -> sendCommand addr x >> parse False addr xs
+-- >         [] | input -> repl addr
+-- >            | otherwise -> return ()
+-- > 
+-- > 
+-- > repl :: String -> IO ()
+-- > repl addr = do e <- isEOF
+-- >                case e of
+-- >                 True -> return ()
+-- >                 False -> do l <- getLine
+-- >                             sendCommand addr l
+-- >                             repl addr
+-- > 
+-- > sendAll :: String -> [String] -> IO ()
+-- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss
+-- > 
+-- > sendCommand :: String -> String -> IO ()
+-- > sendCommand addr s = do
 -- >   d   <- openDisplay ""
 -- >   rw  <- rootWindow d $ defaultScreen d
--- >   a <- internAtom d "XMONAD_COMMAND" False
+-- >   a <- internAtom d addr False
+-- >   m <- internAtom d s False
 -- >   allocaXEvent $ \e -> do
 -- >                   setEventType e clientMessage
--- >                   setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime
+-- >                   setClientMessageEvent e rw a 32 m currentTime
 -- >                   sendEvent d rw False structureNotifyMask e
 -- >                   sync d False
+-- > 
+-- > showHelp :: IO ()
+-- > showHelp = do pn <- getProgName
+-- >               putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.")
 --
--- compile with: @ghc --make sendCommand.hs@
+--
+-- compile with: @ghc --make xmonadctl.hs@
 --
 -- run with
 --
--- > sendCommand command number
+-- > xmonadctl command
 --
--- For instance:
+-- or with
 --
--- > sendCommand 0
+-- > $ xmonadctl
+-- > command1
+-- > command2
+-- > .
+-- > .
+-- > .
+-- > ^D
+--
+-- Usage will change depending on which event hook(s) you use. More examples are shown below.
 --
---  will ask to xmonad to print the list of command numbers in
--- stderr (so you can read it in @~\/.xsession-errors@).
 -----------------------------------------------------------------------------
 
 module XMonad.Hooks.ServerMode
     ( -- * Usage
       -- $usage
-      ServerMode (..)
-    , serverModeEventHook
+      serverModeEventHook
     , serverModeEventHook'
+    , serverModeEventHookCmd
+    , serverModeEventHookCmd'
+    , serverModeEventHookF
     ) where
 
 import Control.Monad (when)
-import Data.List
+import Data.Maybe
 import Data.Monoid
 import System.IO
 
@@ -76,31 +110,64 @@ import XMonad.Actions.Commands
 -- @~\/.xmonad\/xmonad.hs@:
 --
 -- > import XMonad.Hooks.ServerMode
--- > import XMonad.Actions.Commands
 --
--- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
---
--- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
---
-
-data ServerMode = ServerMode deriving ( Show, Read )
+-- Then edit your @handleEventHook@ by adding the appropriate event hook from below
 
 -- | Executes a command of the list when receiving its index via a special ClientMessageEvent
--- (indexing starts at 1)
+-- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers
+-- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default.
+--
+-- > main = xmonad def { handleEventHook = serverModeEventHook }
+-- 
+-- > xmonadctl 0 # tells xmonad to output command list
+-- > xmonadctl 1 # tells xmonad to switch to workspace 1
+--
 serverModeEventHook :: Event -> X All
 serverModeEventHook = serverModeEventHook' defaultCommands
 
 -- | serverModeEventHook' additionally takes an action to generate the list of
 -- commands.
 serverModeEventHook' :: X [(String,X ())] -> Event -> X All
-serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
+serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
+        where helper cmd = do cl <- cmdAction
+                              case lookup cmd (zip (map show [1 :: Integer ..]) cl) of
+                                Just (_,action) -> action
+                                Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+              listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl
+
+
+-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
+-- Uses "XMonad.Actions.Commands#defaultCommands" as the default.
+--
+-- > main = xmonad def { handleEventHook = serverModeEventHookCmd }
+--
+-- > xmonadctl run # Tells xmonad to generate a run prompt
+--
+serverModeEventHookCmd :: Event -> X All
+serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands
+
+-- | Additionally takes an action to generate the list of commands
+serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
+serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
+        where helper cmd = do cl <- cmdAction
+                              fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
+
+-- | Listens for an atom, then executes a callback function whenever it hears it.
+-- A trivial example that prints everything supplied to it on xmonad's standard out:
+--
+-- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) }
+--
+-- > xmonadctl -a XMONAD_PRINT "hello world"
+--
+serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
+serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
         d <- asks display
-        a <- io $ internAtom d "XMONAD_COMMAND" False
-        when (mt == a && dt /= []) $ do
-             cl <- cmdAction
-             let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
-             case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
-                  Just (_,action) -> action
-                  Nothing         -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
+        atm <- io $ internAtom d key False
+        when (mt == atm && dt /= []) $ do
+         let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^(32::Int))) dt
+         cmd <- io $ getAtomName d atom
+         case cmd of
+              Just command -> func command
+              Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))
         return (All True)
-serverModeEventHook' _ _ = return (All True)
+serverModeEventHookF _ _ _ = return (All True)

XMonad/Hooks/ToggleHook.hs

@@ -0,0 +1,170 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.ToggleHook
+-- Copyright   :  Ben Boeckel <mathstuf@gmail.com>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Ben Boeckel <mathstuf@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Hook and keybindings for toggling hook behavior.
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.ToggleHook ( -- * Usage
+                                 -- $usage
+
+                                 -- * The hook
+                                 toggleHook
+                               , toggleHook'
+
+                                 -- * Actions
+                               , hookNext
+                               , toggleHookNext
+                               , hookAllNew
+                               , toggleHookAllNew
+
+                                 -- * Queries
+                               , willHook
+                               , willHookNext
+                               , willHookAllNew
+
+                                 -- * 'DynamicLog' utilities
+                                 -- $pp
+                               , willHookNextPP
+                               , willHookAllNewPP
+                               , runLogHook ) where
+
+import Prelude hiding (all)
+
+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
+
+{- Helper functions -}
+
+_set :: String -> ((a -> a) -> (Bool, Bool) -> (Bool, Bool)) -> a -> X ()
+_set n f b = modify' n (f $ const b)
+
+_toggle :: String -> ((Bool -> Bool) -> (Bool, Bool) -> (Bool, Bool)) -> X ()
+_toggle n f = modify' n (f not)
+
+_get :: String -> ((Bool, Bool) -> a) -> X a
+_get n f = XS.gets $ f . (findWithDefault (False, False) n . hooks)
+
+_pp :: String -> ((Bool, Bool) -> Bool) -> String -> (String -> String) -> X (Maybe String)
+_pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
+
+{- The current state is kept here -}
+
+data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
+
+instance ExtensionClass HookState where
+    initialValue = HookState empty
+    extensionType = PersistentExtension
+
+modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
+modify' n f = XS.modify (HookState . setter . hooks)
+    where
+        setter m = insert n (f (findWithDefault (False, False) n m)) m
+
+-- $usage
+-- This module provides actions (that can be set as keybindings)
+-- to be able to cause hooks to be occur on a conditional basis.
+--
+-- You can use it by including the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.ToggleHook
+--
+-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
+-- name of the hook and @hook@ is the hook to execute based on the state.
+--
+-- > myManageHook = toggleHook "float" doFloat <+> manageHook def
+--
+-- Additionally, toggleHook' is provided to toggle between two hooks (rather
+-- than on/off).
+--
+-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def
+--
+-- The 'hookNext' and 'toggleHookNext' functions can be used in key
+-- bindings to set whether the hook is applied or not.
+--
+-- > , ((modm, xK_e), toggleHookNext "float")
+--
+-- 'hookAllNew' and 'toggleHookAllNew' are similar but float all
+-- spawned windows until disabled again.
+--
+-- > , ((modm, xK_r), toggleHookAllNew "float")
+
+-- | This 'ManageHook' will selectively apply a hook as set
+-- by 'hookNext' and 'hookAllNew'.
+toggleHook :: String -> ManageHook -> ManageHook
+toggleHook n h = toggleHook' n h idHook
+
+toggleHook' :: String -> ManageHook -> ManageHook -> ManageHook
+toggleHook' n th fh = do m <- liftX $ XS.gets hooks
+                         (next, all) <- return $ findWithDefault (False, False) n m
+                         liftX $ XS.put $ HookState $ insert n (False, all) m
+                         if next || all then th else fh
+
+-- | @hookNext name True@ arranges for the next spawned window to
+-- have the hook @name@ applied, @hookNext name False@ cancels it.
+hookNext :: String -> Bool -> X ()
+hookNext n = _set n first
+
+toggleHookNext :: String -> X ()
+toggleHookNext n = _toggle n first
+
+-- | @hookAllNew name True@ arranges for new windows to
+-- have the hook @name@ applied, @hookAllNew name False@ cancels it
+hookAllNew :: String -> Bool -> X ()
+hookAllNew n = _set n second
+
+toggleHookAllNew :: String -> X ()
+toggleHookAllNew n = _toggle n second
+
+-- | Query what will happen at the next ManageHook call for the hook @name@.
+willHook :: String -> X Bool
+willHook n = willHookNext n <||> willHookAllNew n
+
+-- | Whether the next window will trigger the hook @name@.
+willHookNext :: String -> X Bool
+willHookNext n = _get n fst
+
+-- | Whether new windows will trigger the hook @name@.
+willHookAllNew :: String -> X Bool
+willHookAllNew n = _get n snd
+
+-- $pp
+-- The following functions are used to display the current
+-- state of 'hookNext' and 'hookAllNew' in your
+-- 'XMonad.Hooks.DynamicLog.dynamicLogWithPP'.
+-- 'willHookNextPP' and 'willHookAllNewPP' should be added
+-- to the 'XMonad.Hooks.DynamicLog.ppExtras' field of your
+-- 'XMonad.Hooks.DynamicLog.PP'.
+--
+-- Use 'runLogHook' to refresh the output of your 'logHook', so
+-- that the effects of a 'hookNext'/... will be visible
+-- immediately:
+--
+-- > , ((modm, xK_e), toggleHookNext "float" >> runLogHook)
+--
+-- The @String -> String@ parameters to 'willHookNextPP' and
+-- 'willHookAllNewPP' will be applied to their output, you
+-- can use them to set the text color, etc., or you can just
+-- pass them 'id'.
+
+willHookNextPP :: String -> (String -> String) -> X (Maybe String)
+willHookNextPP n = _pp n fst "Next"
+
+willHookAllNewPP :: String -> (String -> String) -> X (Maybe String)
+willHookAllNewPP n = _pp n snd "All"
+
+runLogHook :: X ()
+runLogHook = join $ asks $ logHook . config

XMonad/Hooks/UrgencyHook.hs

@@ -59,13 +59,17 @@ module XMonad.Hooks.UrgencyHook (
                                  dzenUrgencyHook,
                                  DzenUrgencyHook(..),
                                  NoUrgencyHook(..),
+                                 BorderUrgencyHook(..),
                                  FocusHook(..),
+                                 filterUrgencyHook,
                                  minutes, seconds,
                                  -- * Stuff for developers:
                                  readUrgents, withUrgents,
                                  StdoutUrgencyHook(..),
                                  SpawnUrgencyHook(..),
-                                 UrgencyHook(urgencyHook)
+                                 UrgencyHook(urgencyHook),
+                                 Interval,
+                                 borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook
                                  ) where
 
 import XMonad
@@ -75,13 +79,16 @@ import XMonad.Util.Dzen (dzenWithArgs, seconds)
 import qualified XMonad.Util.ExtensibleState as XS
 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)
-import Data.Maybe (listToMaybe, maybeToList)
+import Data.List (delete, (\\))
+import Data.Maybe (listToMaybe, maybeToList, fromMaybe)
 import qualified Data.Set as S
+import System.IO (hPutStrLn, stderr)
+import Foreign.C.Types (CLong)
 
 -- $usage
 --
@@ -100,7 +107,7 @@ import qualified Data.Set as S
 -- 'withUrgencyHook'. For example:
 --
 -- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
--- >               $ defaultConfig
+-- >               $ def
 --
 -- This will pop up a dzen bar for five seconds telling you you've got an
 -- urgent window.
@@ -112,7 +119,7 @@ import qualified Data.Set as S
 -- extra popup, install NoUrgencyHook, as so:
 --
 -- > main = xmonad $ withUrgencyHook NoUrgencyHook
--- >               $ defaultConfig
+-- >               $ def
 --
 -- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent
 -- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,
@@ -253,7 +260,7 @@ minutes secs = secs * 60
 
 -- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.
 -- Use a variation of this in your config just as you use a variation of
--- defaultConfig for your xmonad definition.
+-- 'def' for your xmonad definition.
 urgencyConfig :: UrgencyConfig
 urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
 
@@ -306,12 +313,34 @@ readReminders = XS.get
 adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
 adjustReminders = XS.modify
 
-clearUrgency :: Window -> X ()
-clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
 
 data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
     deriving (Read, Show)
 
+-- | Change the _NET_WM_STATE property by applying a function to the list of atoms.
+changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
+changeNetWMState dpy w f = do
+   wmstate <- getAtom "_NET_WM_STATE"
+   wstate  <- fromMaybe [] `fmap` getProp32 wmstate w
+   let ptype = 4 -- atom property type for changeProperty
+   io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
+   return ()
+
+-- | Add an atom to the _NET_WM_STATE property.
+addNetWMState :: Display -> Window -> Atom -> X ()
+addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)
+
+-- | Remove an atom from the _NET_WM_STATE property.
+removeNetWMState :: Display -> Window -> Atom -> X ()
+removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom)
+
+-- | Get the _NET_WM_STATE propertly as a [CLong]
+getNetWMState :: Window -> X [CLong]
+getNetWMState w = do
+    a_wmstate <- getAtom "_NET_WM_STATE"
+    fromMaybe [] `fmap` getProp32 a_wmstate w
+
+
 -- The Non-ICCCM Manifesto:
 -- Note: Some non-standard choices have been made in this implementation to
 -- account for the fact that things are different in a tiling window manager:
@@ -327,20 +356,40 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
 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
           when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
               WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
-              if (testBit flags urgencyHintBit) then do
-                  adjustUrgents (\ws -> if elem w ws then ws else w : ws)
-                  callUrgencyHook wuh w
-                else
-                  clearUrgency w
-              userCodeDef () =<< asks (logHook . config)
+              if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w
+      -- Window destroyed
       DestroyWindowEvent {ev_window = w} ->
-          clearUrgency w
+          markNotUrgent w
+      -- _NET_WM_STATE_DEMANDS_ATTENTION requested by client
+      ClientMessageEvent {ev_event_display = dpy, ev_window = w, ev_message_type = t, ev_data = action:atoms} -> do
+          a_wmstate <- getAtom "_NET_WM_STATE"
+          a_da      <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
+          wstate    <- getNetWMState w
+          let demandsAttention = fromIntegral a_da `elem` wstate
+              remove = 0
+              add    = 1
+              toggle = 2
+          when (t == a_wmstate && fromIntegral a_da `elem` atoms) $ do
+            when (action == add || (action == toggle && not demandsAttention)) $ do
+              markUrgent w
+              addNetWMState dpy w a_da
+            when (action == remove || (action == toggle && demandsAttention)) $ do
+              markNotUrgent w
+              removeNetWMState dpy w a_da
       _ ->
           mapM_ handleReminder =<< readReminders
       where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
+            markUrgent w = do
+                adjustUrgents (\ws -> if elem w ws then ws else w : ws)
+                callUrgencyHook wuh w
+                userCodeDef () =<< asks (logHook . config)
+            markNotUrgent w = do
+                adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
+                userCodeDef () =<< asks (logHook . config)
 
 callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
 callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =
@@ -372,7 +421,12 @@ shouldSuppress :: SuppressWhen -> Window -> X Bool
 shouldSuppress sw w = elem w <$> suppressibleWindows sw
 
 cleanupUrgents :: SuppressWhen -> X ()
-cleanupUrgents sw = mapM_ clearUrgency =<< suppressibleWindows sw
+cleanupUrgents sw = do
+    sw' <- suppressibleWindows sw
+    a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
+    dpy <- withDisplay (\dpy -> return dpy)
+    mapM_ (\w -> removeNetWMState dpy w a_da) sw'
+    adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
 
 suppressibleWindows :: SuppressWhen -> X [Window]
 suppressibleWindows Visible  = gets $ S.toList . mapped
@@ -385,9 +439,12 @@ suppressibleWindows Never    = return []
 
 -- | The class definition, and some pre-defined instances.
 
-class (Read h, Show h) => UrgencyHook h where
+class UrgencyHook h where
     urgencyHook :: h -> Window -> X ()
 
+instance UrgencyHook (Window -> X ()) where
+    urgencyHook = id
+
 data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
 
 instance UrgencyHook NoUrgencyHook where
@@ -415,11 +472,40 @@ instance UrgencyHook DzenUrgencyHook where
 
   > withUrgencyHook FocusHook $ myconfig { ...
 -}
+focusHook :: Window -> X ()
+focusHook = urgencyHook FocusHook
 data FocusHook = FocusHook deriving (Read, Show)
 
 instance UrgencyHook FocusHook where
     urgencyHook _ _ = focusUrgent
 
+-- | A hook that sets the border color of an urgent window.  The color
+--   will remain until the next time the window gains or loses focus, at
+--   which point the standard border color from the XConfig will be applied.
+--   You may want to use suppressWhen = Never with this:
+--
+--   > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ...
+--
+--   (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration".
+--   @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt".  We need to
+--   think a bit more about namespacing issues, maybe.)
+
+borderUrgencyHook :: String -> Window -> X ()
+borderUrgencyHook = urgencyHook . BorderUrgencyHook
+data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
+                       deriving (Read, Show)
+
+instance UrgencyHook BorderUrgencyHook where
+  urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
+    withDisplay $ \dpy -> do
+      c' <- io (initColor dpy cs)
+      case c' of
+        Just c -> setWindowBorderWithFallback dpy w cs c
+        _      -> io $ hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
+                                                 ,show cs
+                                                 ," in BorderUrgencyHook"
+                                                 ]
+
 -- | Flashes when a window requests your attention and you can't see it.
 -- Defaults to a duration of five seconds, and no extra args to dzen.
 -- See 'DzenUrgencyHook'.
@@ -429,13 +515,31 @@ dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }
 -- | Spawn a commandline thing, appending the window id to the prefix string
 -- you provide. (Make sure to add a space if you need it.) Do your crazy
 -- xcompmgr thing.
+spawnUrgencyHook :: String -> Window -> X ()
+spawnUrgencyHook = urgencyHook . SpawnUrgencyHook
 newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)
 
 instance UrgencyHook SpawnUrgencyHook where
     urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w
 
 -- | For debugging purposes, really.
+stdoutUrgencyHook :: Window -> X ()
+stdoutUrgencyHook = urgencyHook StdoutUrgencyHook
 data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
 
 instance UrgencyHook StdoutUrgencyHook where
     urgencyHook    _ w = io $ putStrLn $ "Urgent: " ++ show w
+
+-- | urgencyhook such that windows on certain workspaces
+-- never get urgency set.
+--
+-- Useful for scratchpad workspaces perhaps:
+--
+-- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) defaultConfig)
+filterUrgencyHook :: [WorkspaceId] -> Window -> X ()
+filterUrgencyHook skips w = do
+    ws <- gets windowset
+    case W.findTag w ws of
+        Just tag -> when (tag `elem` skips)
+                        $ adjustUrgents (delete w)
+        _ -> return ()

XMonad/Hooks/WallpaperSetter.hs

@@ -0,0 +1,223 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------
+-- |
+-- Module      : XMonad.Hooks.WallpaperSetter
+-- Copyright   : (c) Anton Pirogov, 2014
+-- License     : BSD3
+--
+-- Maintainer  : Anton Pirogov <anton.pirogov@gmail.com>
+-- Stability   : unstable
+-- Portability : unportable
+--
+-- Log hook which changes the wallpapers depending on visible workspaces.
+-----------------------------------
+module XMonad.Hooks.WallpaperSetter (
+  -- * Usage
+  -- $usage
+  wallpaperSetter
+, WallpaperConf(..)
+, Wallpaper(..)
+, WallpaperList(..)
+, defWallpaperConf
+, defWPNames
+  -- *TODO
+  -- $todo
+) where
+import XMonad
+import qualified XMonad.StackSet as S
+import qualified XMonad.Util.ExtensibleState as XS
+
+import System.IO
+import System.Process
+import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents)
+import System.FilePath ((</>))
+import System.Random (randomRIO)
+
+import qualified Data.Map as M
+import Data.List (intersperse, sortBy)
+import Data.Char (isAlphaNum)
+import Data.Ord (comparing)
+
+import Control.Monad
+import Control.Applicative
+import Data.Maybe
+import Data.Monoid
+
+-- $usage
+-- This module requires imagemagick and feh to be installed, as these are utilized
+-- for the required image transformations and the actual setting of the wallpaper.
+--
+-- This was especially tested with multi-head setups - if you have two monitors and swap
+-- the workspaces, the wallpapers will be swapped too, scaled accordingly and rotated if necessary
+-- (e.g. if you are using your monitor rotated but only have wide wallpapers).
+--
+-- Add a log hook like this:
+--
+-- > myWorkspaces = ["1:main","2:misc","3","4"]
+-- > ...
+-- > main = xmonad $ defaultConfig {
+-- >   logHook = wallpaperSetter defWallpaperConf {
+-- >                                wallpapers = defWPNames myWorkspaces
+-- >                                          <> WallpaperList [("1:main",WallpaperDir "1")]
+-- >                             }
+-- >   }
+-- > ...
+
+-- $todo
+-- * implement a kind of image cache like in wallpaperd to remove or at least reduce the lag
+--
+-- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory)
+
+-- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call
+data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable
+instance ExtensionClass WCState where
+  initialValue = WCState Nothing Nothing
+
+-- | Represents a wallpaper
+data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper
+               | WallpaperDir FilePath -- ^ Random wallpaper from this subdirectory
+               deriving (Eq, Show, Read)
+
+newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]
+  deriving (Show,Read)
+
+instance Monoid WallpaperList where
+  mempty = WallpaperList []
+  mappend (WallpaperList w1) (WallpaperList w2) =
+    WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
+
+-- | Complete wallpaper configuration passed to the hook
+data WallpaperConf = WallpaperConf {
+    wallpaperBaseDir :: FilePath  -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)
+  , wallpapers :: WallpaperList   -- ^ List of the wallpaper associations for workspaces
+  } deriving (Show, Read)
+
+-- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg
+defWallpaperConf :: WallpaperConf
+defWallpaperConf = WallpaperConf "" $ WallpaperList []
+
+instance Default WallpaperConf where
+    def = defWallpaperConf
+
+-- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted)
+defWPNames :: [WorkspaceId] -> WallpaperList
+defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x++".jpg"))) xs
+
+-- | Add this to your log hook with the workspace configuration as argument.
+wallpaperSetter :: WallpaperConf -> X ()
+wallpaperSetter wpconf = do
+  WCState oldws h <- XS.get
+  visws <- getVisibleWorkspaces
+  when (Just visws /= oldws) $ do
+
+    wpconf' <- completeWPConf wpconf
+    wspicpaths <- getPicPathsAndWSRects wpconf'
+
+    -- terminate old call if any to prevent unnecessary CPU overload when switching WS too fast
+    case h of
+      Nothing -> return ()
+      Just pid -> liftIO $ terminateProcess pid
+
+    handle <- applyWallpaper wspicpaths
+    XS.put $ WCState (Just visws) $ Just handle
+
+-- Helper functions
+-------------------
+
+-- | Picks a random element from a list
+pickFrom :: [a] -> IO a
+pickFrom list = do
+  i <- randomRIO (0,length list - 1)
+  return $ list !! i
+
+-- | get absolute picture path of the given wallpaper picture
+-- or select a random one if it is a directory
+getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe FilePath)
+getPicPath conf (WallpaperDir dir) = do
+  direxists <- doesDirectoryExist $ wallpaperBaseDir conf </> dir
+  if direxists
+    then do files <- getDirectoryContents $ wallpaperBaseDir conf </> dir
+            let files' = filter ((/='.').head) files
+            file <- pickFrom files'
+            return $ Just $ wallpaperBaseDir conf </> dir </> file
+    else return Nothing
+getPicPath conf (WallpaperFix file) = do
+  exist <- doesFileExist path
+  return $ if exist then Just path else Nothing
+  where path = wallpaperBaseDir conf </> file
+
+-- | Take a path to a picture, return (width, height) if the path is a valid picture
+-- (requires imagemagick tool identify to be installed)
+getPicRes :: FilePath -> IO (Maybe (Int,Int))
+getPicRes picpath = do
+  (_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe }
+  output <- hGetContents outh
+  return $ case map reads (words output) of
+    -- mapM Text.Read.readMaybe is better but only in ghc>=7.6
+    [[(w,"")],[(h,"")]] -> Just (w,h)
+    _ -> Nothing
+
+
+-- |complete unset fields to default values (wallpaper directory = ~/.wallpapers,
+--  expects a file "NAME.jpg" for each workspace named NAME)
+completeWPConf :: WallpaperConf -> X WallpaperConf
+completeWPConf (WallpaperConf dir (WallpaperList ws)) = do
+  home <- liftIO getHomeDirectory
+  winset <- gets windowset
+  let tags = map S.tag $ S.workspaces winset
+      dir' = if null dir then home </> ".wallpapers" else dir
+      ws'  = if null ws then defWPNames tags else WallpaperList ws
+  return (WallpaperConf dir' ws')
+
+getVisibleWorkspaces :: X [WorkspaceId]
+getVisibleWorkspaces = do
+  winset <- gets windowset
+  return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset
+
+getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
+getPicPathsAndWSRects wpconf = do
+  winset <- gets windowset
+  paths <- liftIO getPicPaths
+  visws <- getVisibleWorkspaces
+  let visscr = S.current winset : S.visible winset
+      visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr
+      hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)
+      getRect tag = screenRect $ fromJust $ M.lookup tag visrects
+      foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
+  return foundpaths
+  where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y
+                             >>= \p -> return (x,p)) wl
+        WallpaperList wl   = wallpapers wpconf
+
+-- | Gets a list of geometry rectangles and filenames, builds and sets wallpaper
+applyWallpaper :: [(Rectangle, FilePath)] -> X ProcessHandle
+applyWallpaper parts = do
+  winset <- gets windowset
+  let (vx,vy) = getVScreenDim winset
+  layers <- liftIO $ mapM layerCommand parts
+  let basepart ="convert -size "++show vx++"x"++show vy++" xc:black "
+      endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"
+      cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart
+  liftIO $ runCommand cmd
+
+
+getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer)
+getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens
+  where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx
+                                            , fromIntegral ((fromIntegral y)+h) `max` my )
+
+needsRotation :: Rectangle -> (Int,Int) -> Bool
+needsRotation rect (px,py) = let wratio, pratio :: Double
+                                 wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect)
+                                 pratio = fromIntegral px / fromIntegral py
+                             in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1
+
+layerCommand :: (Rectangle, FilePath) -> IO String
+layerCommand (rect, path) = do
+  res <- getPicRes path
+  return $ case needsRotation rect <$> res of
+    Nothing -> ""
+    Just rotate ->
+                     " \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
+                      ++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
+                      ++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "

XMonad/Hooks/WorkspaceByPos.hs

@@ -33,9 +33,9 @@ import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
 --
 -- > import XMonad.Hooks.WorkspaceByPos
 -- >
--- > myManageHook = workspaceByPos <+> manageHook defaultConfig
+-- > myManageHook = workspaceByPos <+> manageHook def
 -- >
--- > main = xmonad defaultConfig { manageHook = myManageHook }
+-- > main = xmonad def { manageHook = myManageHook }
 
 workspaceByPos :: ManageHook
 workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask

XMonad/Hooks/WorkspaceHistory.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Hooks.WorkspaceHistory
+-- Copyright   :  (c) 2013 Dmitri Iouchtchenko
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Dmitri Iouchtchenko <johnnyspoon@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Keeps track of workspace viewing order.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Hooks.WorkspaceHistory
+    ( -- * Usage
+      -- $usage
+
+      -- * Hooking
+      workspaceHistoryHook
+
+      -- * Querying
+    , workspaceHistory
+
+    ) where
+
+import XMonad
+import XMonad.StackSet (currentTag)
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- To record the order in which you view workspaces, you can use this
+-- module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook)
+--
+-- Then add the hook to your 'logHook':
+--
+-- >  main = xmonad $ def
+-- >      { ...
+-- >      , logHook = ... >> workspaceHistoryHook >> ...
+-- >      , ...
+-- >      }
+--
+-- To make use of the collected data, a query function is provided.
+
+data WorkspaceHistory =
+    WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.
+                     }
+    deriving (Typeable, Read, Show)
+
+instance ExtensionClass WorkspaceHistory where
+    initialValue = WorkspaceHistory []
+    extensionType = PersistentExtension
+
+-- | A 'logHook' that keeps track of the order in which workspaces have
+-- been viewed.
+workspaceHistoryHook :: X ()
+workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)
+
+-- | A list of workspace tags in the order they have been viewed, with the
+-- most recent first. No duplicates are present, but not all workspaces are
+-- guaranteed to appear, and there may be workspaces that no longer exist.
+workspaceHistory :: X [WorkspaceId]
+workspaceHistory = XS.gets history
+
+
+-- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not
+-- already there, or move it to the front if it is.
+makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory
+makeFirst w v = let (xs, ys) = break (w ==) $ history v
+                in v { history = w : (xs ++ drop 1 ys) }

XMonad/Hooks/XPropManage.hs

@@ -1,3 +1,4 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Hooks.XPropManage
@@ -17,14 +18,13 @@ module XMonad.Hooks.XPropManage (
                  xPropManageHook, XPropMatch, pmX, pmP
                  ) where
 
+import Control.Exception as E
 import Data.Char (chr)
-import Data.List (concat)
 import Data.Monoid (mconcat, Endo(..))
 
 import Control.Monad.Trans (lift)
 
 import XMonad
-import XMonad.ManageHook ((-->))
 
 -- $usage
 -- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
@@ -75,7 +75,7 @@ xPropManageHook tms = mconcat $ map propToHook tms
 
 getProp :: Display -> Window -> Atom -> X ([String])
 getProp d w p = do
-    prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\_ -> return [[]])
+    prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
     let filt q | q == wM_COMMAND = concat . map splitAtNull
                | otherwise       = id
     return (filt p prop)