Merge pull request #275 from LSLeary/point14

0.14

.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,104 @@
+# 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: GHCVER=8.4.3  CABALVER=2.2
+      compiler: ": #GHC 8.4.3"
+      addons: { apt: { packages: [cabal-install-2.2,  ghc-8.4.3,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=8.2.2  CABALVER=2.0
+      compiler: ": #GHC 8.2.2"
+      addons: { apt: { packages: [cabal-install-2.0,  ghc-8.2.2,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=8.0.1  CABALVER=1.24
+      compiler: ": #GHC 8.0.1"
+      addons: { apt: { packages: [cabal-install-1.24, ghc-8.0.1,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=7.10.3 CABALVER=1.22
+      compiler: ": #GHC 7.10.3"
+      addons: { apt: { packages: [cabal-install-1.22, ghc-7.10.3, libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+    - env: GHCVER=7.8.4  CABALVER=1.18
+      compiler: ": #GHC 7.8.4"
+      addons: { apt: { packages: [cabal-install-1.18, ghc-7.8.4,  libxrandr-dev]
+                     , sources:  [hvr-ghc]
+                     } }
+
+before_install:
+ - unset CC
+ - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
+
+install:
+ - 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
+
+ # build xmonad from HEAD
+ - git clone https://github.com/xmonad/xmonad.git
+ - cabal install xmonad/
+
+ - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
+ - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
+
+# check whether current requested install-plan matches cached package-db snapshot
+ - if diff -u $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;
+   fi
+ - cabal install --only-dependencies --enable-tests --enable-benchmarks;
+
+# 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
+
+# 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

Accordion.hs

@@ -1,49 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Accordion
--- Copyright   :  (c) glasser@mit.edu
--- License     :  BSD
---
--- Maintainer  :  glasser@mit.edu
--- Stability   :  unstable
--- Portability :  unportable
---
--- Layout that puts non-focused windows in ribbons at the top and bottom
--- of the screen.
------------------------------------------------------------------------------
-
-module XMonadContrib.Accordion (
-    -- * Usage
-    -- $usage
-    accordion) where
-
-import XMonad
-import Operations
-import qualified StackSet as W
-import Graphics.X11.Xlib
-import Data.Ratio
-import XMonadContrib.LayoutHelpers ( idModify )
-
--- $usage
--- > import XMonadContrib.Accordion
--- > defaultLayouts = [ accordion ]
-
-accordion :: Eq a => Layout a
-accordion = Layout { doLayout = accordionLayout, modifyLayout = idModify }
-
-accordionLayout :: Eq a => Rectangle -> W.Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
-accordionLayout sc ws = return ((zip ups tops) ++
-                                [(W.focus ws, mainPane)] ++
-                                (zip dns bottoms)
-                               ,Nothing)
- where ups    = W.up ws
-       dns    = W.down ws
-       (top, allButTop) = splitVerticallyBy (1%8) sc
-       (center, bottom) = splitVerticallyBy (6%7) allButTop
-       (allButBottom, _) = splitVerticallyBy (7%8) sc
-       mainPane | ups /= [] && dns /= [] = center
-                | ups /= []              = allButTop
-                | dns /= []              = allButBottom
-                | otherwise              = sc
-       tops   = if ups /= [] then splitVertically (length ups) top else []
-       bottoms= if dns /= [] then splitVertically (length dns) bottom else []

Anneal.hs

@@ -1,87 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Anneal
--- Copyright   :  (c) David Roundy
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.org>
--- Stability   :  unstable
--- Portability :  unportable
---
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Anneal ( Rated(Rated), the_value, the_rating
-                            , anneal, annealMax ) where
-
-import System.Random ( StdGen, Random, mkStdGen, randomR )
-import Control.Monad.State ( State, runState, put, get, gets, modify )
-
-data Rated a b = Rated !a !b
-                 deriving ( Show )
-instance Functor (Rated a) where
-    f `fmap` (Rated v a) = Rated v (f a)
-
-the_value :: Rated a b -> b
-the_value (Rated _ b) = b
-the_rating :: Rated a b -> a
-the_rating (Rated a _) = a
-
-instance Eq a => Eq (Rated a b) where
-    (Rated a _) == (Rated a' _) = a == a'
-instance Ord a => Ord (Rated a b) where
-    compare (Rated a _) (Rated a' _) = compare a a'
-
-anneal :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
-anneal st r sel = runAnneal st r (do_anneal sel)
-
-annealMax :: a -> (a -> Double) -> (a -> [a]) -> Rated Double a
-annealMax st r sel = runAnneal st (negate . r) (do_anneal sel)
-
-do_anneal :: (a -> [a]) -> State (Anneal a) (Rated Double a)
-do_anneal sel = do sequence_ $ replicate 100 da
-                   gets best
-    where da = do select_metropolis sel
-                  modify $ \s -> s { temperature = temperature s *0.99 }
-
-data Anneal a = A { g :: StdGen
-                  , best :: Rated Double a
-                  , current :: Rated Double a
-                  , rate :: a -> Rated Double a
-                  , temperature :: Double }
-
-runAnneal :: a -> (a -> Double) -> State (Anneal a) b -> b
-runAnneal start r x = fst $ runState x (A { g = mkStdGen 137
-                                          , best = Rated (r start) start
-                                          , current = Rated (r start) start
-                                          , rate = \xx -> Rated (r xx) xx
-                                          , temperature = 1.0 })
-
-select_metropolis :: (a -> [a]) -> State (Anneal a) ()
-select_metropolis x = do c <- gets current
-                         a <- select $ x $ the_value c
-                         metropolis a
-
-metropolis :: a -> State (Anneal a) ()
-metropolis x = do r <- gets rate
-                  c <- gets current
-                  t <- gets temperature
-                  let rx = r x
-                      boltz = exp $ (the_rating c - the_rating rx) / t
-                  if rx < c then do modify $ \s -> s { current = rx, best = rx }
-                            else do p <- getOne (0,1)
-                                    if p < boltz
-                                       then modify $ \s -> s { current = rx }
-                                       else return ()
-
-select :: [a] -> State (Anneal a) a
-select [] = the_value `fmap` gets best
-select [x] = return x
-select xs = do n <- getOne (0,length xs - 1)
-               return (xs !! n)
-
-getOne :: (Random a) => (a,a) -> State (Anneal x) a
-getOne bounds = do s <- get
-                   (x,g') <- return $ randomR bounds (g s)
-                   put $ s { g = g' }
-                   return x

CHANGES.md

@@ -0,0 +1,651 @@
+# Change Log / Release Notes
+
+## 0.14
+
+### Breaking Changes
+
+  * `XMonad.Layout.Spacing`
+
+    Rewrite `XMonad.Layout.Spacing`. Borders are no longer uniform but composed
+    of four sides each with its own border width. The screen and window borders
+    are now separate and can be independently toggled on/off. The screen border
+    examines the window/rectangle list resulting from 'runLayout' rather than
+    the stack, which makes it compatible with layouts such as the builtin
+    `Full`. The child layout will always be called with the screen border. If
+    only a single window is displayed (and `smartBorder` enabled), it will be
+    expanded into the original layout rectangle. Windows that are displayed but
+    not part of the stack, such as those created by 'XMonad.Layout.Decoration',
+    will be shifted out of the way, but not scaled (not possible for windows
+    created by XMonad). This isn't perfect, so you might want to disable
+    `Spacing` on such layouts.
+
+  * `XMonad.Util.SpawnOnce`
+
+    - Added `spawnOnOnce`, `spawnNOnOnce` and `spawnAndDoOnce`. These are useful in startup hooks
+      to shift spawned windows to a specific workspace.
+
+  * Adding handling of modifySpacing message in smartSpacing and smartSpacingWithEdge layout modifier
+
+  * `XMonad.Actions.GridSelect`
+
+    - Added field `gs_bordercolor` to `GSConfig` to specify border color.
+
+  * `XMonad.Layout.Minimize`
+
+     Though the interface it offers is quite similar, this module has been
+     almost completely rewritten. The new `XMonad.Actions.Minimize` contains
+     several functions that allow interaction with minimization window state.
+     If you are using this module, you must upgrade your configuration to import
+     `X.A.Minimize` and use `maximizeWindow` and `withLastMinimized` instead of
+     sending messages to `Minimized` layout. `XMonad.Hooks.RestoreMinimized` has
+     been completely deprecated, and its functions have no effect.
+
+  * `XMonad.Prompt.Unicode`
+
+    - `unicodePrompt :: String -> XPConfig -> X ()` now additionally takes a
+      filepath to the `UnicodeData.txt` file containing unicode data.
+
+  * `XMonad.Actions.PhysicalScreens`
+
+    `getScreen`, `viewScreen`, `sendToScreen`, `onNextNeighbour`, `onPrevNeighbour` now need a extra parameter
+    of type `ScreenComparator`. This allow the user to specify how he want his screen to be ordered default
+    value are:
+
+     - `def`(same as verticalScreenOrderer) will keep previous behavior
+     - `verticalScreenOrderer`
+     - `horizontalScreenOrderer`
+
+    One can build his custom ScreenOrderer using:
+     - `screenComparatorById` (allow to order by Xinerama id)
+     - `screenComparatorByRectangle` (allow to order by screen coordonate)
+     - `ScreenComparator` (allow to mix ordering by screen coordonate and xinerama id)
+
+  * `XMonad.Util.WorkspaceCompare`
+
+    `getXineramaPhysicalWsCompare` now need a extra argument of type `ScreenComparator` defined in
+    `XMonad.Actions.PhysicalScreens` (see changelog of this module for more information)
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    - Simplify ewmhDesktopsLogHookCustom, and remove the gnome-panel specific
+      remapping of all visible windows to the active workspace (#216).
+    - Handle workspace renames that might be occuring in the custom function
+      that is provided to ewmhDesktopsLogHookCustom.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Support xmobar's \<action> and \<raw> tags; see `xmobarAction` and
+      `xmobarRaw`.
+
+  * `XMonad.Layout.NoBorders`
+
+    The layout now maintains a list of windows that never have borders, and a
+    list of windows that always have borders. Use `BorderMessage` to manage
+    these lists and the accompanying event hook (`borderEventHook`) to remove
+    destroyed windows from them. Also provides the `hasBorder` manage hook.
+
+    Two new conditions have been added to `Ambiguity`: `OnlyLayoutFloat` and
+    `OnlyLayoutFloatBelow`; `OnlyFloat` was renamed to `OnlyScreenFloat`.  See
+    the documentation for more information.
+
+    The type signature of `hiddens` was changed to accept a new `Rectangle`
+    parameter representing the bounds of the parent layout, placed after the
+    `WindowSet` parameter. Anyone defining a new instance of `SetsAmbiguous`
+    will need to update their configuration. For example, replace "`hiddens amb
+    wset mst wrs =`" either with "`hiddens amb wset _ mst wrs =`" or to make
+    use of the new parameter with "`hiddens amb wset lr mst wrs =`".
+
+  * `XMonad.Actions.MessageFeedback`
+
+    - Follow the naming conventions of `XMonad.Operations`. Functions returning
+      `X ()` are named regularly (previously these ended in underscore) while
+      those returning `X Bool` are suffixed with an uppercase 'B'.
+    - Provide all `X Bool` and `SomeMessage` variations for `sendMessage` and
+      `sendMessageWithNoRefresh`, not just `sendMessageWithNoRefreshToCurrent`
+      (renamed from `send`).
+    - The new `tryInOrderB` and `tryMessageB` functions accept a parameter of
+      type `SomeMessage -> X Bool`, which means you are no longer constrained
+      to the behavior of the `sendMessageWithNoRefreshToCurrent` dispatcher.
+    - The `send*Messages*` family of funtions allows for sequencing arbitrary
+      sets of messages with minimal refresh. It makes little sense for these
+      functions to support custom message dispatchers.
+    - Remain backwards compatible. Maintain deprecated aliases of all renamed
+      functions:
+      - `send`          -> `sendMessageWithNoRefreshToCurrentB`
+      - `sendSM`        -> `sendSomeMessageWithNoRefreshToCurrentB`
+      - `sendSM_`       -> `sendSomeMessageWithNoRefreshToCurrent`
+      - `tryInOrder`    -> `tryInOrderWithNoRefreshToCurrentB`
+      - `tryInOrder_`   -> `tryInOrderWithNoRefreshToCurrent`
+      - `tryMessage`    -> `tryMessageWithNoRefreshToCurrentB`
+      - `tryMessage_`   -> `tryMessageWithNoRefreshToCurrent`
+
+### New Modules
+
+  * `XMonad.Layout.MultiToggle.TabBarDecoration`
+
+    Provides a simple transformer for use with `XMonad.Layout.MultiToggle` to
+    dynamically toggle `XMonad.Layout.TabBarDecoration`.
+
+  * `XMonad.Layout.StateFull`
+
+    Provides `StateFull`: a stateful form of `Full` that does not misbehave when
+    floats are focused, and the `FocusTracking` layout transformer by means of
+    which `StateFull` is implemented. `FocusTracking` simply holds onto the last
+    true focus it was given and continues to use it as the focus for the
+    transformed layout until it sees another. It can be used to improve the
+    behaviour of a child layout that has not been given the focused window.
+
+  * `XMonad.Actions.SwapPromote`
+
+    Module for tracking master window history per workspace, and associated
+    functions for manipulating the stack using such history.
+
+  * `XMonad.Actions.CycleWorkspaceByScreen`
+
+    A new module that allows cycling through previously viewed workspaces in the
+    order they were viewed most recently on the screen where cycling is taking
+    place.
+
+    Also provides the `repeatableAction` helper function which can be used to
+    build actions that can be repeated while a modifier key is held down.
+
+  * `XMonad.Prompt.FuzzyMatch`
+
+    Provides a predicate `fuzzyMatch` that is much more lenient in matching
+    completions in `XMonad.Prompt` than the default prefix match.  Also provides
+    a function `fuzzySort` that allows sorting the fuzzy matches by "how well"
+    they match.
+
+  * `XMonad.Utils.SessionStart`
+
+    A new module that allows to query if this is the first time xmonad is
+    started of the session, or a xmonad restart.
+
+    Currently needs manual setting of the session start flag. This could be
+    automated when this moves to the core repository.
+
+  * `XMonad.Layout.MultiDishes`
+
+    A new layout based on Dishes, however it accepts additional configuration
+    to allow multiple windows within a single stack.
+
+  * `XMonad.Util.Rectangle`
+
+    A new module for handling pixel rectangles.
+
+  * `XMonad.Layout.BinaryColumn`
+
+    A new module which provides a simple grid layout, halving the window
+    sizes of each window after master.
+
+    This is similar to Column, but splits the window in a way
+    that maintains window sizes upon adding & removing windows as well as the
+    option to specify a minimum window size.
+
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Layout.Grid`
+
+    Fix as per issue #223; Grid will no longer calculate more columns than there
+    are windows.
+
+  * `XMonad.Hooks.FadeWindows`
+
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
+    Monoids
+
+  * `XMonad.Hooks.WallpaperSetter`
+
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
+    Monoids
+
+  * `XMonad.Hooks.Mosaic`
+
+    Added support for GHC version 8.4.x by adding a Semigroup instance for
+    Monoids
+
+  * `XMonad.Actions.Navigation2D`
+
+    Added `sideNavigation` and a parameterised variant, providing a navigation
+    strategy with fewer quirks for tiled layouts using X.L.Spacing.
+
+  * `XMonad.Layout.Fullscreen`
+
+    The fullscreen layouts will now not render any window that is totally
+    obscured by fullscreen windows.
+
+  * `XMonad.Layout.Gaps`
+
+    Extended the sendMessage interface with `ModifyGaps` to allow arbitrary
+    modifications to the `GapSpec`.
+
+  * `XMonad.Layout.Groups`
+
+    Added a new `ModifyX` message type that allows the modifying
+    function to return values in the `X` monad.
+
+  * `XMonad.Actions.Navigation2D`
+
+    Generalised (and hence deprecated) hybridNavigation to hybridOf.
+
+  * `XMonad.Layout.LayoutHints`
+
+    Preserve the window order of the modified layout, except for the focused
+    window that is placed on top. This fixes an issue where the border of the
+    focused window in certain situations could be rendered below borders of
+    unfocused windows. It also has a lower risk of interfering with the
+    modified layout.
+
+  * `XMonad.Layout.MultiColumns`
+
+    The focused window is placed above the other windows if they would be made to
+    overlap due to a layout modifier. (As long as it preserves the window order.)
+
+  * `XMonad.Actions.GridSelect`
+
+    - The vertical centring of text in each cell has been improved.
+
+  * `XMonad.Actions.SpawnOn`
+
+    - Bind windows spawns by child processes of the original window to the same
+      workspace as the original window.
+
+  * `XMonad.Util.WindowProperties`
+
+    - Added the ability to test if a window has a tag from
+      `XMonad.Actions.TagWindows`
+
+  * `XMonad.Layout.Magnifier`
+
+    - Handle `IncMasterN` messages.
+
+  * `XMonad.Util.EZConfig`
+
+    - Can now parse Latin1 keys, to better accommodate users with
+      non-US keyboards.
+
+  * `XMonad.Actions.Submap`
+
+    Establish pointer grab to avoid freezing X, when button press occurs after
+    submap key press.  And terminate submap at button press in the same way,
+    as we do for wrong key press.
+
+  * `XMonad.Hooks.SetWMName`
+
+    Add function `getWMName`.
+
+  * `XMonad.Hooks.ManageHelpers`
+
+    Make type of ManageHook combinators more general.
+
+  * `XMonad.Prompt`
+
+    Export `insertString`.
+
+  * `XMonad.Prompt.Window`
+
+    - New function: `windowMultiPrompt` for using `mkXPromptWithModes`
+      with window prompts.
+
+  * `XMonad.Hooks.WorkspaceHistory`
+
+    - Now supports per screen history.
+
+  * `XMonad.Layout.ComboP`
+
+    - New `PartitionWins` message to re-partition all windows into the
+      configured sub-layouts.  Useful when window properties have
+      changed and you want to re-sort windows into the appropriate
+      sub-layout.
+
+  * `XMonad.Actions.Minimize`
+
+    - Now has `withFirstMinimized` and `withFirstMinimized'` so you can perform
+      actions with both the last and first minimized windows easily.
+
+  * `XMonad.Config.Gnome`
+
+    - Update logout key combination (modm+shift+Q) to work with modern
+
+  * `XMonad.Prompt.Pass`
+
+    - New function `passTypePrompt` which uses `xdotool` to type in a password
+      from the store, bypassing the clipboard.
+    - Now handles password labels with spaces and special characters inside
+      them.
+
+  * `XMonad.Prompt.Unicode`
+
+    - Persist unicode data cache across XMonad instances due to
+      `ExtensibleState` now used instead of `unsafePerformIO`.
+    - `typeUnicodePrompt :: String -> XPConfig -> X ()` provided to insert the
+      Unicode character via `xdotool` instead of copying it to the paste buffer.
+    - `mkUnicodePrompt :: String -> [String] -> String -> XPConfig -> X ()`
+      acts as a generic function to pass the selected Unicode character to any
+      program.
+
+  * `XMonad.Prompt.AppendFile`
+
+    - New function `appendFilePrompt'` which allows for transformation of the
+      string passed by a user before writing to a file.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added a new function `dzenWithFlags` which allows specifying the arguments
+    passed to `dzen2` invocation. The behaviour of current `dzen` function is
+    unchanged.
+
+  * `XMonad.Util.Dzen`
+
+    - Now provides functions `fgColor` and `bgColor` to specify foreground and
+    background color, `align` and `slaveAlign` to set text alignment, and
+    `lineCount` to enable a second (slave) window that displays lines beyond
+    the initial (title) one.
+
+  * `XMonad.Hooks.DynamicLog`
+
+    - Added optional `ppVisibleNoWindows` to differentiate between empty
+      and non-empty visible workspaces in pretty printing.
+
+  * `XMonad.Actions.DynamicWorkspaceOrder`
+
+    - Added `updateName` and `removeName` to better control ordering when
+      workspace names are changed or workspaces are removed.
+
+  * `XMonad.Config.Azerty`
+
+    * Added `belgianConfig` and `belgianKeys` to support Belgian AZERTY
+      keyboards, which are slightly different from the French ones in the top
+      row.
+
+## 0.13 (February 10, 2017)
+
+### Breaking Changes
+
+  * The type of `completionKey` (of `XPConfig` record) has been
+    changed from `KeySym` to `(KeyMask, KeySym)`. The default value
+    for this is still 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.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/

Combo.hs

@@ -1,74 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Combo
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout that combines multiple layouts.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Combo (
-                            -- * Usage
-                            -- $usage 
-                            combo
-                           ) where
-
-import Control.Arrow ( first )
-import Data.Maybe ( isJust )
-import XMonad
-import StackSet ( integrate, differentiate )
-
--- $usage
---
--- To use this layout write, in your Config.hs:
--- 
--- > import XMonadContrib.Combo 
--- > import XMonadContrib.SimpleStacking
--- 
--- and add something like
--- 
--- > simpleStacking $ combo (twoPane 0.03 0.5) [(full,1),(tabbed shrinkText,1)]
---
--- to your defaultLayouts.
---
--- The first argument to combo is a Layout that will divide the screen into
--- one or more subscreens.  The second argument is a list of layouts which
--- will be used to lay out the contents of each of those subscreents.
--- Paired with each of these layouts is an integer giving the number of
--- windows this section should hold.  This number is ignored for the last
--- layout, which will hold any excess windows.
-
-combo :: Layout (Layout a, Int) -> [(Layout a, Int)] -> Layout a
-combo super origls = Layout { doLayout = \r s -> arrange r (integrate s), modifyLayout = message }
-    where arrange _ [] = return ([], Nothing)
-          arrange r [w] = return ([(w,r)], Nothing)
-          arrange rinput origws =
-              do (lrs, msuper') <- runLayout super rinput (differentiate $ take (length origws) origls)
-                 let super' = maybe super id msuper'
-                     lwrs [] _ = []
-                     lwrs [((l,_),r)] ws = [((l,r),differentiate ws)]
-                     lwrs (((l,n),r):xs) ws = ((l,r),differentiate $ take len1 ws) : lwrs xs (drop len1 ws)
-                         where len1 = min n (length ws - length xs)
-                 out <- mapM (uncurry $ uncurry runLayout) $ lwrs lrs origws
-                 let origls' = zipWith foo (out++repeat ([],Nothing)) origls
-                     foo (_, Nothing) x = x
-                     foo (_, Just l') (_, n) = (l', n)
-                 return (concat $ map fst out, Just $ combo super' origls')
-          message m = do mls <- broadcastPrivate m (map fst origls)
-                         let mls' = (\x->zipWith first (map const x) origls) `fmap` mls
-                         msuper <- broadcastPrivate m [super]
-                         case msuper of
-                           Just [super'] -> return $ Just $ combo super' $ maybe origls id mls'
-                           _ -> return $ combo super `fmap` mls'
-
-broadcastPrivate :: SomeMessage -> [Layout b] -> X (Maybe [Layout b])
-broadcastPrivate a ol = do nml <- mapM f ol
-                           if any isJust nml
-                              then return $ Just $ zipWith ((flip maybe) id) ol nml
-                              else return Nothing
-    where f l = modifyLayout l a `catchX` return Nothing

Commands.hs

@@ -1,101 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Commands
--- Copyright   :  (c) David Glasser 2007
--- License     :  BSD3
--- 
--- Maintainer  :  glasser@mit.edu
--- Stability   :  stable
--- Portability :  portable
---
--- Allows you to run internal xmonad commands (X () actions) using
--- a dmenu menu in addition to key bindings.  Requires dmenu and
--- the Dmenu XMonadContrib module.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Commands (
-                             -- * Usage
-                             -- $usage
-                             commandMap,
-                             runCommand,
-                             runCommand',
-                             workspaceCommands,
-                             screenCommands,
-                             defaultCommands
-                              ) where
-
-import XMonad
-import Operations
-import XMonadContrib.Dmenu (dmenu)
-import {-# SOURCE #-} Config (workspaces)
-
-import qualified Data.Map as M
-import System.Exit
-import Data.Maybe
-
--- $usage
---
--- To use, modify your Config.hs to:
---
--- >    import XMonadContrib.Commands
---
--- and add a keybinding to the runCommand action:
---
--- >    , ((modMask .|. controlMask, xK_y), runCommand)
---
--- and define the list commands:
---
--- >    commands :: [(String, X ())]
--- >    commands = defaultCommands
---
--- A popup menu of internal xmonad commands will appear.  You can
--- change the commands by changing the contents of the list
--- 'commands'.  (If you like it enough, you may even want to get rid
--- of many of your other key bindings!)
-
-commandMap :: [(String, X ())] -> M.Map String (X ())
-commandMap c = M.fromList c
-
-workspaceCommands :: [(String, X ())]
-workspaceCommands = [((m ++ show i), f i)
-                         | i <- workspaces
-                         , (f, m) <- [(view, "view"), (shift, "shift")]
-                    ]
-
-screenCommands :: [(String, X ())]
-screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust f)
-                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
-                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]
-                 ]
-
-defaultCommands :: [(String, X ())]
-defaultCommands = workspaceCommands ++ screenCommands
-                  ++ [ ("shrink", sendMessage Shrink)
-                     , ("expand", sendMessage Expand)
-                     , ("restart-wm", restart Nothing True)
-                     , ("restart-wm-no-resume", restart Nothing False)
-                     , ("layout", switchLayout)
-                     , ("xterm", spawn "xterm")
-                     , ("run", spawn "exe=`dmenu_path | dmenu -b` && exec $exe")
-                     , ("kill", kill)
-                     , ("refresh", refresh)
-                     , ("focus-up", focusUp)
-                     , ("focus-down", focusDown)
-                     , ("swap-up", swapUp)
-                     , ("swap-down", swapDown)
-                     , ("swap-master", swapMaster)
-                     , ("sink", withFocused sink)
-                     , ("quit-wm", io $ exitWith ExitSuccess)
-                     ]
-
-runCommand :: [(String, X ())] -> X ()
-runCommand cl = do
-  let m = commandMap cl
-  choice <- dmenu (M.keys m)
-  fromMaybe (return ()) (M.lookup choice m)
-
-runCommand' :: String -> X ()
-runCommand' c = do
-  let m = commandMap defaultCommands
-  fromMaybe (return ()) (M.lookup c m)

CopyWindow.hs

@@ -1,89 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.CopyWindow
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides a binding to duplicate a window on multiple workspaces,
--- providing dwm-like tagging functionality.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.CopyWindow (
-                                 -- * Usage
-                                 -- $usage
-                                 copy, kill1
-                                ) where
-
-import Prelude hiding ( filter )
-import Control.Monad.State ( gets )
-import qualified Data.List as L
-import XMonad
-import Operations ( windows, kill )
-import StackSet
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.CopyWindow
---
--- > -- mod-[1..9] @@ Switch to workspace N
--- > -- mod-shift-[1..9] @@ Move client to workspace N
--- > -- mod-control-shift-[1..9] @@ Copy client to workspace N
--- > [((m .|. modMask, k), f i)
--- >     | (i, k) <- zip workspaces [xK_1 ..]
--- >     , (f, m) <- [(view, 0), (shift, shiftMask), (copy, shiftMask .|. controlMask)]]
---
--- you may also wish to redefine the binding to kill a window so it only
--- removes it from the current workspace, if it's present elsewhere:
---
--- >  , ((modMask .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
-
--- | copy. Copy a window to a new workspace.
-copy :: WorkspaceId -> X ()
-copy n = windows (copy' n)
-
-copy' :: (Ord a, Eq s, Eq i) => i -> StackSet i a s sd -> StackSet i a s sd
-copy' n s = if n `tagMember` s && n /= tag (workspace (current s))
-            then maybe s go (peek s)
-            else s
-    where go w = view (tag (workspace (current s))) $ insertUp' w $ view n s
-
- 
--- |
--- /O(n)/. (Complexity due to check if element is in current stack.) Insert
--- a new element into the stack, above the currently focused element.
---
--- The new element is given focus, and is set as the master window.
--- The previously focused element is moved down.  The previously
--- 'master' element is forgotten. (Thus, 'insert' will cause a retiling).
---
--- If the element is already in the current stack, it is shifted to the
--- focus position, as if it had been removed and then added.
---
--- Semantics in Huet's paper is that insert doesn't move the cursor.
--- However, we choose to insert above, and move the focus.
-
-insertUp' :: Eq a => a -> StackSet i a s sd -> StackSet i a s sd
-insertUp' a s = modify (Just $ Stack a [] [])
-                (\(Stack t l r) -> Just $ Stack a (L.delete a l) (L.delete a (t:r))) s
-
-delete' :: Ord a => a -> StackSet i a s sd -> StackSet i a s sd
-delete' w = sink w . modify Nothing (filter (/= w))
-
--- | Remove the focussed window from this workspace.  If it's present in no
--- other workspace, then kill it instead. If we do kill it, we'll get a
--- delete notify back from X.
---
--- There are two ways to delete a window. Either just kill it, or if it
--- supports the delete protocol, send a delete event (e.g. firefox)
---
-kill1 :: X ()
-kill1 = do ss <- gets windowset
-           whenJust (peek ss) $ \w -> if member w $ delete' w ss
-                                      then windows $ delete' w
-                                      else kill

DeManage.hs

@@ -1,56 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DeManage
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- This module provides a method to cease management of a window, without
--- unmapping it.  This is especially useful for applications like kicker and
--- gnome-panel.
---
--- To make a panel display correctly with xmonad:
---
---  * Determine the pixel size of the panel, add that value to defaultGaps
---
---  * Launch the panel
---
---  * Give the panel window focus, then press mod-d
---
---  * Convince the panel to move\/resize to the correct location.  Changing the
---  panel's position setting several times seems to work.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DeManage (
-                                 -- * Usage
-                                 -- $usage
-                                 demanage
-                                ) where
-
-import qualified StackSet as W
-import XMonad
-import Operations
-import Control.Monad.State
-import Graphics.X11 (Window)
-
--- $usage
--- To use demanage, add this import:
---
--- >     import XMonadContrib.DeManage
---
--- And add a keybinding to it:
---
--- > , ((modMask,               xK_d     ), withFocused demanage)
---
-
--- | Stop managing the current focused window.
-demanage :: Window -> X ()
-demanage w = do
-    -- use modify to defeat automatic 'unmanage' calls.
-    modify (\s -> s { windowset = W.delete w (windowset s) })
-    refresh

Decoration.hs

@@ -1,74 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Decoration
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module to be used to easily define decorations.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Decoration (
-                                 -- * Usage
-                                 -- $usage 
-                                 newDecoration 
-                                ) where
-
-import Data.Bits ( (.|.) )
-import Control.Monad.Reader ( asks )
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras ( Event(AnyEvent,ButtonEvent), ev_subwindow, ev_event_type, ev_window )
-
-import XMonadContrib.LayoutHelpers ( ModLay, layoutModify, idModDo )
-
-import XMonad
-import Operations ( UnDoLayout(UnDoLayout) )
-
--- $usage
--- You can use this module for writing other extensions.
--- See, for instance, "XMonadContrib.Tabbed"
-
-newDecoration :: Window -> Rectangle -> Int -> Pixel -> Pixel -> String
-              -> (Display -> Window -> GC -> FontStruct -> X ())
-              -> X () -> Layout a -> X (Layout a)
-newDecoration decfor (Rectangle x y w h) th fg bg fn draw click l = do
-    d <- asks display
-    rt <- asks theRoot
-    win <- io $ createSimpleWindow d rt x y w h (fromIntegral th) fg bg
-    io $ selectInput d win $ exposureMask .|. buttonPressMask
-    io $ mapWindow d win
-    io $ restackWindows d $ decfor : [win]
-
-    let hook :: SomeMessage -> X (Maybe (ModLay a))
-        hook sm  | Just e <- fromMessage sm           = handle_event e >> return Nothing
-                 | Just UnDoLayout == fromMessage sm  = io (destroyWindow d win) >> return (Just id)
-                 | otherwise                          = return Nothing
-
-        handle_event (ButtonEvent {ev_subwindow = thisw,ev_event_type = t})
-            | t == buttonPress && thisw == win        = click
-        handle_event (ButtonEvent {ev_window = thisw,ev_event_type = t})
-            | t == buttonPress && thisw == win        = click
-        handle_event (AnyEvent {ev_window = thisw, ev_event_type = t})
-            | thisw == win    && t == expose          = withGC win fn draw
-            | thisw == decfor && t == propertyNotify  = withGC win fn draw
-        handle_event _ = return ()
-
-    return $ layoutModify idModDo hook l
-
--- FIXME: withGC should use bracket (but can't, unless draw is an IO thing)
-withGC :: Drawable -> String -> (Display -> Drawable -> GC -> FontStruct -> X ()) -> X ()
-withGC w fn f = withDisplay $ \d -> do gc <- io $ createGC d w
-                                       let fontname = if fn == "" 
-                                                      then "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                                      else fn
-                                       font <- io $ catch (loadQueryFont d fontname)
-                                                          (const $ loadQueryFont d "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*")
-                                       io $ setFont d gc (fontFromFontStruct font)
-                                       f d w gc font
-                                       io $ freeGC d gc
-                                       io $ freeFont d font

DirectoryPrompt.hs

@@ -1,42 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DirectoryPrompt
--- Copyright   :  (C) 2007 Andrea Rossato, David Roundy
--- License     :  BSD3
--- 
--- Maintainer  :  droundy@darcs.net
--- Stability   :  unstable
--- Portability :  unportable
---
--- A directory prompt for XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DirectoryPrompt (
-                             -- * Usage
-                             -- $usage
-                             directoryPrompt
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-import XMonadContrib.Dmenu ( runProcessWithInput )
-
--- $usage
--- For an example usage see "XMonadContrib.WorkspaceDir"
-
-data Dir = Dir String
-
-instance XPrompt Dir where
-    showXPrompt (Dir x) = x
-
-directoryPrompt :: XPConfig -> String -> (String -> X ()) -> X ()
-directoryPrompt c prom job = mkXPrompt (Dir prom) c getDirCompl job
-
-getDirCompl :: String -> IO [String]
-getDirCompl s = (filter notboring . lines) `fmap`
-                runProcessWithInput "/bin/bash" [] ("compgen -A directory " ++ s ++ "\n")
-
-notboring ('.':'.':_) = True
-notboring ('.':_) = False
-notboring _ = True

Dmenu.hs

@@ -1,54 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Dmenu
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A convenient binding to dmenu.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Dmenu (
-                            -- * Usage
-                            -- $usage 
-                            dmenu, dmenuXinerama, 
-                            runProcessWithInput
-                           ) where
-
-import XMonad
-import qualified StackSet as W
-import System.Process
-import System.IO
-import Control.Monad.State
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.Dmenu
-
-runProcessWithInput :: FilePath -> [String] -> String -> IO String
-runProcessWithInput cmd args input = do
-    (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
-    hPutStr pin input
-    hClose pin
-    output <- hGetContents pout
-    when (output==output) $ return ()
-    hClose pout
-    hClose perr
-    waitForProcess ph
-    return output
-    
--- | Starts dmenu on the current screen. Requires this patch to dmenu:
--- <http://www.jcreigh.com/dmenu/dmenu-3.2-xinerama.patch>
-dmenuXinerama :: [String] -> X String
-dmenuXinerama opts = do
-    curscreen <- (fromIntegral . W.screen . W.current) `liftM` gets windowset :: X Int
-    io $ runProcessWithInput "dmenu" ["-xs", show (curscreen+1)] (unlines opts)
-
-dmenu :: [String] -> X String
-dmenu opts = io $ runProcessWithInput "dmenu" [] (unlines opts)
-

DragPane.hs

@@ -1,119 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DragPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
---                    David Roundy <droundy@darcs.net>,
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
-
--- Layouts that splits the screen either horizontally or vertically and
--- shows two windows.  The first window is always the master window, and
--- the other is either the currently focused window or the second window in
--- layout order.
-
------------------------------------------------------------------------------
-
-module XMonadContrib.DragPane (
-                               -- * Usage
-                               -- $usage
-                               dragPane, dragUpDownPane
-                              ) where
-
-import Control.Monad.Reader ( asks )
-import Graphics.X11.Xlib ( Rectangle( Rectangle ) )
-import XMonad
-import XMonadContrib.Decoration ( newDecoration )
-import Operations ( Resize(..), splitHorizontallyBy, splitVerticallyBy, initColor, mouseDrag, sendMessage )
-import StackSet ( focus, up, down)
-
--- $usage
---
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.DragPane
---
---  and add, to the list of layouts:
---
--- > dragPane "" (fromRational delta) (fromRational delta)
-
-halfHandleWidth :: Integral a => a
-halfHandleWidth = 2
-
-handleColor :: String
-handleColor = "#000000"
-
-dragPane :: String -> Double -> Double -> Layout a
-dragPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
- where
-    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
-                   root <- asks theRoot
-                   let (left', right') = splitHorizontallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle x _ _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ w _ -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y (w-halfHandleWidth) h
-                       right = case right' of
-                               Rectangle x y w h -> Rectangle (x+halfHandleWidth) y (w-halfHandleWidth) h
-                       handr = case left' of
-                               Rectangle x y w h ->
-                                 Rectangle (x + fromIntegral w - halfHandleWidth) y (2*halfHandleWidth) h
-                       wrs = case reverse (up s) of
-                             (master:_) -> [(master,left),(focus s,right)]
-                             [] -> case down s of
-                                   (next:_) -> [(focus s,left),(next,right)]
-                                   [] -> [(focus s, r)]
-                       handle = newDecoration root handr 0 handlec handlec
-                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\ex _ ->
-                                        sendMessage (SetFrac ident ((fromIntegral ex - leftmost)/widt)))
-                                        (return ())
-                                        
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragPane ident delta split)
-                                            else return Nothing
-                   return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragPane ident delta (split + delta))
-              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragPane ident delta frac)
-    message _ = Nothing
-
-dragUpDownPane :: String -> Double -> Double -> Layout a
-dragUpDownPane ident delta split = Layout { doLayout = dolay, modifyLayout = return . message }
- where
-    dolay r s = do handlec <- withDisplay $ \dpy -> io $ initColor dpy handleColor
-                   root <- asks theRoot
-                   let (left', right') = splitVerticallyBy split r
-                       leftmost = fromIntegral $ case r of Rectangle _ x _ _ -> x
-                       widt = fromIntegral $ case r of Rectangle _ _ _ w -> w
-                       left = case left' of Rectangle x y w h -> Rectangle x y w (h-halfHandleWidth)
-                       right = case right' of
-                               Rectangle x y w h -> Rectangle x (y+halfHandleWidth) w (h-halfHandleWidth)
-                       handr = case left' of
-                               Rectangle x y w h ->
-                                 Rectangle x (y + fromIntegral h - halfHandleWidth) w (2*halfHandleWidth)
-                       wrs = case reverse (up s) of
-                             (master:_) -> [(master,left),(focus s,right)]
-                             [] -> case down s of
-                                   (next:_) -> [(focus s,left),(next,right)]
-                                   [] -> [(focus s, r)]
-                       handle = newDecoration root handr 0 handlec handlec
-                                "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-                                (const $ const $ const $ const $ return ()) (doclick)
-                       doclick = mouseDrag (\_ ey ->
-                                        sendMessage (SetFrac ident ((fromIntegral ey - leftmost)/widt)))
-                                        (return ())
-                                        
-                   ml' <- if length wrs > 1 then Just `fmap` handle (dragUpDownPane ident delta split)
-                                            else return Nothing
-                   return (wrs, ml')
-    message x | Just Shrink <- fromMessage x = Just (dragUpDownPane ident delta (split - delta))
-              | Just Expand <- fromMessage x = Just (dragUpDownPane ident delta (split + delta))
-              | Just (SetFrac ident' frac) <- fromMessage x, ident' == ident =
-                                              Just (dragUpDownPane ident delta frac)
-    message _ = Nothing
-
-data SetFrac = SetFrac String Double deriving ( Show, Read, Eq, Typeable )
-instance Message SetFrac

DwmPromote.hs

@@ -1,46 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DwmPromote
--- Copyright   :  (c) Miikka Koskinen 2007
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  arcatan@kapsi.fi
--- Stability   :  unstable
--- Portability :  unportable
---
--- Dwm-like swap function for xmonad.
--- 
--- Swaps focused window with the master window. If focus is in the
--- master, swap it with the next window in the stack. Focus stays in the
--- master.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DwmPromote (
-                                 -- * Usage
-                                 -- $usage 
-                                 dwmpromote
-                                ) where
-
-import XMonad
-import Operations (windows)
-import StackSet
-
--- $usage
---
--- To use, modify your Config.hs to:
---
--- >    import XMonadContrib.DwmPromote
---
--- and add a keybinding or substitute promote with dwmpromote:
---
--- >   , ((modMask,               xK_Return), dwmpromote)
-
-dwmpromote :: X ()
-dwmpromote = windows swap
-
-swap :: StackSet i a s sd -> StackSet i a s sd
-swap = modify' $ \c -> case c of
-    Stack _ [] []     -> c
-    Stack t [] (x:rs) -> Stack x [] (t:rs)
-    Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls

DynamicLog.hs

@@ -1,89 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DynamicLog
--- Copyright   :  (c) Don Stewart <dons@cse.unsw.edu.au>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Don Stewart <dons@cse.unsw.edu.au>
--- Stability   :  unstable
--- Portability :  unportable
---
--- DynamicLog
---
--- Log events in:
---
--- >     1 2 [3] 4 8
---
--- format. suitable to pipe into dzen.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DynamicLog (
-    -- * Usage
-    -- $usage 
-    dynamicLog, dynamicLogXinerama, pprWindowSet, pprWindowSetXinerama
-  ) where
-
--- 
--- Useful imports
---
-import XMonad
-import Data.Maybe ( isJust )
-import Data.List
-import Data.Ord ( comparing )
-import qualified StackSet as S
-
--- $usage 
---
--- To use, set:
---
--- >    import XMonadContrib.DynamicLog
--- >    logHook = dynamicLog
-
-
--- |
--- Perform an arbitrary action on each state change.
--- Examples include:
---      * do nothing
---      * log the state to stdout
---
--- An example logger, print a status bar output to dzen, in the form:
---
--- > 1 2 [3] 4 7
---  
-
-dynamicLog :: X ()
-dynamicLog = withWindowSet $ io . putStrLn . pprWindowSet
-
-pprWindowSet :: WindowSet -> String
-pprWindowSet s =  concatMap fmt $ sortBy (comparing S.tag)
-            (map S.workspace (S.current s : S.visible s) ++ S.hidden s)
-   where this     = S.tag (S.workspace (S.current s))
-         visibles = map (S.tag . S.workspace) (S.visible s)
-
-         fmt w | S.tag w == this         = "[" ++ pprTag w ++ "]"
-               | S.tag w `elem` visibles = "<" ++ pprTag w ++ ">"
-               | isJust (S.stack w)      = " " ++ pprTag w ++ " "
-               | otherwise               = ""
-
--- |
--- Workspace logger with a format designed for Xinerama:
---
--- > [1 9 3] 2 7
---
--- 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
---
-dynamicLogXinerama :: X ()
-dynamicLogXinerama = withWindowSet $ io . putStrLn . pprWindowSetXinerama
-
-pprWindowSetXinerama :: WindowSet -> String
-pprWindowSetXinerama ws = "[" ++ unwords onscreen ++ "] " ++ unwords offscreen
-  where onscreen  = map (pprTag . S.workspace)
-                        . sortBy (comparing S.screen) $ S.current ws : S.visible ws
-        offscreen = map pprTag . filter (isJust . S.stack)
-                        . sortBy (comparing S.tag) $ S.hidden ws
-
--- util functions
-pprTag :: Integral i => S.Workspace i a -> String
-pprTag = show . (+(1::Int)) . fromIntegral . S.tag

DynamicWorkspaces.hs

@@ -1,71 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.DynamicWorkspaces
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides bindings to add and delete workspaces.  Note that you may only
--- delete a workspace that is already empty.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.DynamicWorkspaces (
-                                         -- * Usage
-                                         -- $usage
-                                         addWorkspace, removeWorkspace
-                                       ) where
-
-import Control.Monad.State ( gets, modify )
-
-import XMonad ( X, XState(..), Layout, trace )
-import Operations ( windows, view )
-import StackSet ( tagMember, StackSet(..), Screen(..), Workspace(..),
-                  integrate, differentiate )
-import Data.Map ( delete, insert )
-import Graphics.X11.Xlib ( Window )
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.DynamicWorkspaces
---
--- >   , ((modMask .|. shiftMask, xK_Up), addWorkspace defaultLayouts)
--- >   , ((modMask .|. shiftMask, xK_Down), removeWorkspace)
-
-addWorkspace :: [Layout Window] -> X ()
-addWorkspace (l:ls) = do s <- gets windowset
-                         let newtag:_ = filter (not . (`tagMember` s)) [0..]
-                         modify $ \st -> st { layouts = insert newtag (l,ls) $ layouts st }
-                         windows (addWorkspace' newtag)
-addWorkspace [] = trace "bad layouts in XMonadContrib.DynamicWorkspaces.addWorkspace\n"
-
-removeWorkspace :: X ()
-removeWorkspace = do s <- gets windowset
-                     case s of
-                       StackSet { current = Screen { workspace = torem }
-                                , hidden = (w:_) }
-                           -> do view $ tag w
-                                 modify $ \st -> st { layouts = delete (tag torem) $ layouts st }
-                                 windows (removeWorkspace' (tag torem))
-                       _ -> return ()
-
-addWorkspace' :: i -> StackSet i a sid sd -> StackSet i a sid sd
-addWorkspace' newtag s@(StackSet { current = scr@(Screen { workspace = w })
-                                 , hidden = ws })
-    = s { current = scr { workspace = Workspace newtag Nothing }
-        , hidden = w:ws }
-
-removeWorkspace' :: (Eq i) => i -> StackSet i a sid sd -> StackSet i 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 }
-   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

Dzen.hs

@@ -1,63 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Dzen
--- Copyright   :  (c) glasser@mit.edu
--- License     :  BSD
---
--- Maintainer  :  glasser@mit.edu
--- Stability   :  unstable
--- Portability :  unportable
---
--- Handy wrapper for dzen.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Dzen (dzen, dzenScreen) where
-
-import System.Posix.Process (forkProcess, getProcessStatus, createSession)
-import System.IO
-import System.Process
-import System.Exit
-import Control.Concurrent (threadDelay)
-import Control.Monad.State
-
-import qualified StackSet as W
-import XMonad
-
--- wait is in us
-runProcessWithInputAndWait :: FilePath -> [String] -> String -> Int -> IO ()
-runProcessWithInputAndWait cmd args input timeout = do
-    pid <- forkProcess $ do
-       forkProcess $ do -- double fork it over to init
-         createSession
-         (pin, pout, perr, ph) <- runInteractiveProcess cmd args Nothing Nothing
-         hPutStr pin input
-         hFlush pin
-         threadDelay timeout
-         hClose pin
-         --     output <- hGetContents pout
-         --     when (output==output) $ return ()
-         hClose pout
-         hClose perr
-         waitForProcess ph
-         return ()
-       exitWith ExitSuccess
-       return ()
-    getProcessStatus True False pid
-    return ()
-
-
-curScreen :: X ScreenId
-curScreen =  (W.screen . W.current) `liftM` gets windowset
-
-toXineramaArg :: ScreenId -> String
-toXineramaArg n = show ( ((fromIntegral n)+1)::Int )
-
--- Requires dzen >= 0.2.4.
-
-dzen :: String -> X ()
-dzen str = curScreen >>= \sc -> dzenScreen sc str
-
-dzenScreen :: ScreenId -> String -> X()
-dzenScreen sc str = io $ (runProcessWithInputAndWait "dzen2" ["-xs", screen] str 5000000)
-    where screen = toXineramaArg sc

FlexibleManipulate.hs

@@ -1,118 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.FlexibleManipulate
--- Copyright   :  (c) Michael Sloan
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  <mgsloan@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Lets you move and resize floating windows without warping the mouse.
---
------------------------------------------------------------------------------
-
--- Based on the FlexibleResize code by Lukas Mai (Mauke)
-
-module XMonadContrib.FlexibleManipulate (
-	-- * Usage
-	-- $usage
-	mouseWindow, discrete, linear, resize, position
-) where
-
-import XMonad
-import Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
--- $usage
--- Add this import to your Config.hs file:
---
--- > import qualified XMonadContrib.FlexibleManipulate as Flex
---
--- Set one of the mouse button bindings up like this:
---
--- > mouseBindings = M.fromList
--- >     [ ((modMask, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w)) ], ...
---
--- Flex.linear indicates that positions between the edges and the middle
---    indicate a combination scale\/position.
--- Flex.discrete indicates that there are discrete pick regions. (window
---    is divided by thirds for each axis)
--- Flex.resize performs only resize of the window, based on which quadrant
---    the mouse is in
--- Flex.position is similar to the builtin mouseMoveWindow
---
--- You can also write your own function for this parameter. It should take
--- a value between 0 and 1 indicating position, and return a value indicating
--- the corresponding position if plain Flex.linear was used.
-
-discrete, linear, resize, position :: Double -> Double
-
-discrete x | x < 0.33 = 0
-           | x > 0.66 = 1
-           | otherwise = 0.5
-
-linear = id
-
-resize x = if x < 0.5 then 0 else 1
-position = const 0.5
-
-mouseWindow :: (Double -> Double) -> Window -> X ()
-mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
-    sh <- io $ getWMNormalHints d w
-    pointer <- io $ queryPointer d w >>= return . pointerPos
-
-    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
-        atl = ((1, 1) - fc) * mul
-        abr = fc * mul
-    mouseDrag (\ex ey -> io $ do
-        let offset = (fromIntegral ex, fromIntegral ey) - pointer
-            npos = wpos + offset * atl
-            nbr = (wpos + wsize) + offset * abr
-            ntl = minP (nbr - (32, 32)) npos    --minimum size
-            nwidth = applySizeHints sh $ mapP round (nbr - ntl)
-        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
-        return ())
-        (float w)
-
-    float w
-    
-  where
-    pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
-    winAttrs :: WindowAttributes -> [Pnt]
-    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
-
-
--- I'd rather I didn't have to do this, but I hate writing component 2d math
-type Pnt = (Double, Double)
-
-pairUp :: [a] -> [(a,a)]
-pairUp [] = []
-pairUp [_] = []
-pairUp (x:y:xs) = (x, y) : (pairUp xs)
-
-mapP :: (a -> b) -> (a, a) -> (b, b)
-mapP f (x, y) = (f x, f y)
-zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c) 
-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
-
-instance Fractional Pnt where
-    fromRational = const undefined
-    recip = mapP recip

FlexibleResize.hs

@@ -1,64 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.FlexibleResize
--- Copyright   :  (c) Lukas Mai
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  <l.mai@web.de>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Lets you resize floating windows from any corner.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.FlexibleResize (
-	-- * Usage
-	-- $usage
-	XMonadContrib.FlexibleResize.mouseResizeWindow
-) where
-
-import XMonad
-import Operations
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Foreign.C.Types
-
--- $usage
--- Put something like this in your Config.hs file:
---
--- > import qualified XMonadContrib.FlexibleResize as Flex
--- > mouseBindings = M.fromList
--- >     [ ...
--- >     , ((modMask, button3), (\w -> focus w >> Flex.mouseResizeWindow w)) ]
-
-mouseResizeWindow :: Window -> X ()
-mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
-    io $ raiseWindow d w
-    wa <- io $ getWindowAttributes d w
-    sh <- io $ getWMNormalHints d w
-    (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
-    let
-        [pos_x, pos_y, width, height] = map (fromIntegral . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
-        west  = firstHalf ix width
-        north = firstHalf iy height
-        (cx, fx, gx) = mkSel west  width  pos_x
-        (cy, fy, gy) = mkSel north height pos_y
-    io $ warpPointer d none w 0 0 0 0 cx cy
-    mouseDrag (\ex ey -> do
-                 wa' <- io $ getWindowAttributes d w
-                 let [px, py] = map (fromIntegral . ($ wa')) [wa_x, wa_y]
-                 io $ moveResizeWindow d w (fx px (fromIntegral ex))
-                                           (fy py (fromIntegral ey))
-                            `uncurry` applySizeHints sh (gx $ fromIntegral ex, gy $ fromIntegral ey))
-              (float w)
-    where
-    firstHalf :: CInt -> Position -> Bool
-    firstHalf a b = fromIntegral a * 2 <= b
-    cfst = curry fst
-    csnd = curry snd
-    mkSel :: Bool -> Position -> Position -> (Position, a -> a -> a, CInt -> Dimension)
-    mkSel b k p =
-        if b
-            then (0, csnd, fromIntegral . max 1 . ((k + p) -) . fromIntegral)
-            else (k, cfst, fromIntegral . max 1 . subtract p  . fromIntegral)

FocusNth.hs

@@ -1,42 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.FocusNth
--- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
--- License      : BSD
---
--- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
--- Stability    : unstable
--- Portability  : unportable
---
--- Focus the n'th window on the screen.
------------------------------------------------------------------------------
-
-module XMonadContrib.FocusNth (
-                 -- * Usage
-                 -- $usage
-                 focusNth) where
-
-import StackSet
-import Operations
-import XMonad
-
--- $usage
--- > import XMonadContrib.FocusNth
-
--- > -- mod4-[1..9] @@ Switch to window N
--- > ++ [((mod4Mask, k), focusNth i)
--- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
-
-focusNth :: Int -> X ()
-focusNth = windows . modify' . focusNth'
-
-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)
-
-listToStack :: Int -> [a] -> Stack a
-listToStack n l = Stack t ls rs
-	where	(t:rs)	= drop n l
-		ls	= reverse (take n l)
-
-

HintedTile.hs

@@ -1,94 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.HintedTile
--- Copyright   :  (c) Peter De Wachter <pdewacht@gmail.com>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A gapless tiled layout that attempts to obey window size hints, 
--- rather than simply ignoring them.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.HintedTile (
-                                 -- * Usage
-                                 -- $usage
-                                 tall, wide) where
-
-import XMonad
-import Operations (Resize(..), IncMasterN(..), applySizeHints)
-import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Control.Monad
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import qualified XMonadContrib.HintedTile
---
--- > defaultLayouts = [ XMonadContrib.HintedTile.tall nmaster delta ratio, ... ]
-
--- this sucks
-addBorder, substractBorder :: (Dimension, Dimension) -> (Dimension, Dimension)
-addBorder (w, h) = (w + 2 * borderWidth, h + 2 * borderWidth)
-substractBorder (w, h) = (w - 2 * borderWidth, h - 2 * borderWidth)
-
-
-tall, wide :: Int -> Rational -> Rational -> Layout Window
-wide = tile splitVertically divideHorizontally
-tall = tile splitHorizontally divideVertically
-
-tile split divide nmaster delta frac =
-    Layout { doLayout     = \r w' -> let w = W.integrate w'
-                                     in do { hints <- sequence (map getHints w)
-                                           ; return (zip w (tiler frac r `uncurry` splitAt nmaster hints)
-                                                    , Nothing) }
-           , modifyLayout = \m -> return $ fmap resize     (fromMessage m) `mplus`
-                                           fmap incmastern (fromMessage m) }
-
-    where resize Shrink = tile split divide nmaster delta (frac-delta)
-          resize Expand = tile split divide nmaster delta (frac+delta)
-          incmastern (IncMasterN d) = tile split divide (max 0 (nmaster+d)) delta frac
-
-          tiler f r masters slaves = if null masters || null slaves
-              then divide (masters ++ slaves) r
-              else split f r (divide masters) (divide slaves)
-
-getHints :: Window -> X SizeHints
-getHints w = withDisplay $ \d -> io $ getWMNormalHints d w
-
---
--- Divide the screen vertically (horizontally) into n subrectangles
---
-divideVertically, divideHorizontally :: [SizeHints] -> Rectangle -> [Rectangle]
-divideVertically [] _ = [] -- there's a fold here, struggling to get out
-divideVertically (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divideVertically rest (Rectangle sx (sy + fromIntegral h) sw (sh - h)))
-    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
-                   (sw, sh `div` fromIntegral (1 + (length rest)))
-
-divideHorizontally [] _ = []
-divideHorizontally (hints:rest) (Rectangle sx sy sw sh) = (Rectangle sx sy w h) :
-      (divideHorizontally rest (Rectangle (sx + fromIntegral w) sy (sw - w) sh))
-    where (w, h) = addBorder $ applySizeHints hints $ substractBorder
-                   (sw `div` fromIntegral (1 + (length rest)), sh)
-
-
--- Split the screen into two rectangles, using a rational to specify the ratio
-splitHorizontally, splitVertically :: Rational -> Rectangle -> (Rectangle -> [Rectangle]) -> (Rectangle -> [Rectangle]) -> [Rectangle]
-splitHorizontally f (Rectangle sx sy sw sh) left right = leftRects ++ rightRects
-    where leftw = floor $ fromIntegral sw * f
-          leftRects = left $ Rectangle sx sy leftw sh
-          rightx = (maximum . map rect_width) leftRects
-          rightRects = right $ Rectangle (sx + fromIntegral rightx) sy (sw - rightx) sh
-
-splitVertically f (Rectangle sx sy sw sh) top bottom = topRects ++ bottomRects
-    where toph = floor $ fromIntegral sh * f
-          topRects = top $ Rectangle sx sy sw toph
-          bottomy = (maximum . map rect_height) topRects
-          bottomRects = bottom $ Rectangle sx (sy + fromIntegral bottomy) sw (sh - bottomy)

LayoutHelpers.hs

@@ -1,62 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHelpers
--- Copyright    : (c) David Roundy <droundy@darcs.net>
--- License      : BSD
---
--- Maintainer   : David Roundy <droundy@darcs.net>
--- Stability    : unstable
--- Portability  : portable
---
--- A module for writing easy Layouts
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutHelpers (
-    -- * Usage
-    -- $usage
-    DoLayout, ModDo, ModMod, ModLay,
-    layoutModify,
-    l2lModDo, idModify,
-    idModDo, idModMod,
-    ) where
-
-import Graphics.X11.Xlib ( Rectangle )
-import XMonad
-import StackSet ( Stack, integrate )
-
--- $usage
--- Use LayoutHelpers to help write easy Layouts.
-
-type DoLayout a = Rectangle -> Stack a -> X ([(a, Rectangle)], Maybe (Layout a))
-type ModifyLayout a = SomeMessage -> X (Maybe (Layout a))
-
-type ModDo a = Rectangle -> Stack a -> [(a, Rectangle)] -> X ([(a, Rectangle)], Maybe (ModLay a))
-type ModMod a = SomeMessage -> X (Maybe (ModLay a))
-
-type ModLay a = Layout a -> Layout a
-
-layoutModify :: ModDo a -> ModMod a -> ModLay a
-layoutModify fdo fmod l = Layout { doLayout = dl, modifyLayout = modl }
-    where dl r s = do (ws, ml') <- doLayout l r s
-                      (ws', mmod') <- fdo r s ws
-                      let ml'' = case mmod' of
-                                 Just mod' -> Just $ mod' $ maybe l id ml'
-                                 Nothing -> layoutModify fdo fmod `fmap` ml'
-                      return (ws', ml'')
-          modl m = do ml' <- modifyLayout l m
-                      mmod' <- fmod m
-                      return $ case mmod' of
-                               Just mod' -> Just $ mod' $ maybe l id ml'
-                               Nothing -> layoutModify fdo fmod `fmap` ml'
-
-l2lModDo :: (Rectangle -> [a] -> [(a,Rectangle)]) -> DoLayout a
-l2lModDo dl r s = return (dl r $ integrate s, Nothing)
-
-idModDo :: ModDo a
-idModDo _ _ wrs = return (wrs, Nothing)
-
-idModify :: ModifyLayout a
-idModify _ = return Nothing
-
-idModMod :: ModMod a
-idModMod _ = return Nothing

LayoutHints.hs

@@ -1,43 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHints
--- Copyright    : (c) David Roundy <droundy@darcs.net>
--- License      : BSD
---
--- Maintainer   : David Roundy <droundy@darcs.net>
--- Stability    : unstable
--- Portability  : portable
---
--- Make layouts respect size hints.
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutHints (
-    -- * usage
-    -- $usage
-    layoutHints) where
-
-import Operations ( applySizeHints, D )
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras ( getWMNormalHints )
-import {-#SOURCE#-} Config (borderWidth)
-import XMonad hiding ( trace )
-import XMonadContrib.LayoutHelpers ( layoutModify, idModMod )
-
--- $usage
--- > import XMonadContrib.LayoutHints
--- > defaultLayouts = [ layoutHints tiled , layoutHints $ mirror tiled ]
-
--- | Expand a size by the given multiple of the border width.  The
--- multiple is most commonly 1 or -1.
-adjBorders             :: Dimension -> D -> D
-adjBorders mult (w,h)  = (w+2*mult*borderWidth, h+2*mult*borderWidth)
-
-layoutHints :: Layout Window -> Layout Window
-layoutHints = layoutModify applyHints idModMod
-    where applyHints _ _ xs = do xs' <- mapM applyHint xs
-                                 return (xs', Nothing)
-          applyHint (w,Rectangle a b c d) =
-              withDisplay $ \disp ->
-                  do sh <- io $ getWMNormalHints disp w
-                     let (c',d') = adjBorders 1 . applySizeHints sh . adjBorders (-1) $ (c,d)
-                     return (w, Rectangle a b c' d')

LayoutHooks.hs

@@ -1,44 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.LayoutHooks
--- Copyright    : (c) Stefan O'Rear <stefanor@cox.net>
--- License      : BSD
---
--- Maintainer   : Stefan O'Rear <stefanor@cox.net>
--- Stability    : unstable
--- Portability  : portable
---
--- General layout-level hooks.
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutHooks ( addLayoutMessageHook ) where
-
-import qualified Data.Map as M  ( adjust  )
-import Control.Arrow            ( first   )
-import Control.Monad.State      ( modify  )
-
-import XMonad
-import qualified StackSet as W
-
-install :: (SomeMessage -> X Bool) -> Layout a -> Layout a
-install hk lay = lay{ modifyLayout = mod' }
-  where
-    mod' msg = do reinst  <- hk msg
-                  nlay    <- modifyLayout lay msg
-
-                  return $ cond_reinst reinst nlay
-
-    -- no need to make anything change
-    cond_reinst True   Nothing      = Nothing
-    -- reinstall
-    cond_reinst True   (Just nlay)  = Just (install hk nlay)
-    -- restore inner layout
-    cond_reinst False  Nothing      = Just lay
-    -- let it rot
-    cond_reinst False  (Just nlay)  = Just nlay
-
--- Return True each time you want the hook reinstalled
-addLayoutMessageHook     :: (SomeMessage -> X Bool) -> X ()
-addLayoutMessageHook hk  = modify $ \ s ->
-    let nr = W.tag . W.workspace . W.current . windowset $ s
-      in s { layouts = M.adjust (first $ install hk) nr (layouts s) }

LayoutScreens.hs

@@ -1,60 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.LayoutScreens
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
------------------------------------------------------------------------------
-
-module XMonadContrib.LayoutScreens (
-                                    -- * Usage
-                                    -- $usage
-                                    layoutScreens
-                                   ) where
-
-import Control.Monad.Reader ( asks )
-
-import XMonad
-import qualified StackSet as W
-import qualified Operations as O
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-
--- $usage
--- This module allows you to pretend that you have more than one screen by
--- dividing a single screen into multiple screens that xmonad will treat as
--- separate screens.  This should definitely be useful for testing the
--- behavior of xmonad under Xinerama, and it's possible that it'd also be
--- handy for use as an actual user interface, if you've got a very large
--- sceen and long for greater flexibility (e.g. being able to see your
--- email window at all times, a crude mimic of sticky windows).
---
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.LayoutScreens
---
--- >   , ((modMask .|. shiftMask, xK_space), layoutScreens 2 (twoPane 0.5 0.5))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_space), rescreen)
-
-layoutScreens :: Int -> Layout Int -> X ()
-layoutScreens nscr _ | nscr < 1 = trace $ "Can't layoutScreens with only " ++ show nscr ++ " screens."
-layoutScreens nscr l =
-    do rtrect <- asks theRoot >>= getWindowRectangle
-       (wss, _) <- doLayout l rtrect W.Stack { W.focus=1, W.up=[],W.down=[1..nscr-1] }
-       O.windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
-           let (x:xs, ys) = splitAt nscr $ map W.workspace (v:vs) ++ hs
-               gaps = map (statusGap . W.screenDetail) $ v:vs
-               (s:ss, g:gg) = (map snd wss, take nscr $ gaps ++ repeat (head gaps))
-           in  ws { W.current = W.Screen x 0 (SD s g)
-                  , W.visible = zipWith3 W.Screen xs [1 ..] $ zipWith SD ss gg
-                  , W.hidden  = ys }
-
-getWindowRectangle :: Window -> X Rectangle
-getWindowRectangle w = withDisplay $ \d ->
-    do a <- io $ getWindowAttributes d w
-       return $ Rectangle (fromIntegral $ wa_x a)     (fromIntegral $ wa_y a)
-                          (fromIntegral $ wa_width a) (fromIntegral $ wa_height a)

MagicFocus.hs

@@ -1,33 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.MagicFocus
--- Copyright    : (c) Peter De Wachter <pdewacht@gmail.com>
--- License      : BSD
---
--- Maintainer   : Peter De Wachter <pdewacht@gmail.com>
--- Stability    : unstable
--- Portability  : unportable
---
--- Automagically put the focused window in the master area.
------------------------------------------------------------------------------
-
-module XMonadContrib.MagicFocus (
-                 -- * Usage
-                 -- $usage
-                 magicFocus) where
-
-import Graphics.X11.Xlib (Window)
-import XMonad
-import StackSet
-
--- $usage
--- > import XMonadContrib.MagicFocus
--- > defaultLayouts = [ magicFocus tiled , magicFocus $ mirror tiled ]
-
-magicFocus :: Layout Window -> Layout Window
-magicFocus l = l { doLayout = \r s -> withWindowSet (return . peek) >>= (doLayout l) r . swap s
-                 , modifyLayout = \x -> fmap magicFocus `fmap` modifyLayout l x }
-
-swap :: (Eq a) => Stack a -> Maybe a -> Stack a
-swap (Stack f u d) focused | Just f == focused = Stack f [] (reverse u ++ d)
-                           | otherwise         = Stack f u d

Magnifier.hs

@@ -1,64 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Magnifier
--- Copyright   :  (c) Peter De Wachter 2007
--- License     :  BSD-style (see xmonad/LICENSE)
--- 
--- Maintainer  :  Peter De Wachter <pdewacht@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Screenshot  :  <http://caladan.rave.org/magnifier.png>
---
--- This layout hack increases the size of the window that has focus.
---
------------------------------------------------------------------------------
-
-
-module XMonadContrib.Magnifier (
-    -- * Usage
-    -- $usage
-    magnifier, magnifier') where
-
-import Graphics.X11.Xlib (Window, Rectangle(..))
-import XMonad
-import StackSet
-import XMonadContrib.LayoutHelpers
-
--- $usage
--- > import XMonadContrib.Magnifier
--- > defaultLayouts = [ magnifier tiled , magnifier $ mirror tiled ]
-
--- | Increase the size of the window that has focus, unless it is the master window.
-magnifier :: Layout Window -> Layout Window
-magnifier = layoutModify (unlessMaster applyMagnifier) idModMod
-
--- | Increase the size of the window that has focus, even if it is the master window.
-magnifier' :: Layout Window -> Layout Window
-magnifier' = layoutModify applyMagnifier idModMod
-
-unlessMaster :: ModDo Window -> ModDo Window
-unlessMaster mainmod r s wrs = if null (up s) then return (wrs, Nothing)
-                                              else mainmod r s wrs
-
-applyMagnifier :: ModDo Window
-applyMagnifier r _ wrs = do focused <- withWindowSet (return . peek)
-                            let mag (w,wr) ws | focused == Just w = ws ++ [(w, shrink r $ magnify wr)]
-                                              | otherwise         = (w,wr) : ws
-                            return (reverse $ foldr mag [] wrs, Nothing)
-
-magnify :: Rectangle -> Rectangle
-magnify (Rectangle x y w h) = Rectangle x' y' w' h'
-    where x' = x - fromIntegral (w' - w) `div` 2
-          y' = y - fromIntegral (h' - h) `div` 2
-          w' = round $ fromIntegral w * zoom
-          h' = round $ fromIntegral h * zoom
-          zoom = 1.5 :: Double
-
-shrink :: Rectangle -> Rectangle -> Rectangle
-shrink (Rectangle sx sy sw sh) (Rectangle x y w h) = Rectangle x' y' w' h'
-    where x' = max sx x 
-          y' = max sy y
-          w' = min w (fromIntegral sx + sw - fromIntegral x')
-          h' = min h (fromIntegral sy + sh - fromIntegral y')

MetaModule.hs

@@ -1,71 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.MetaModule
--- Copyright   :  (c) 2007  Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- This is an artificial dependency on all the XMonadContrib.* modules.  It is
--- intended to help xmonad hackers ensure that contrib modules build after API
--- changes.
---
--- Please add new modules to this list (in alphabetical order).
---
------------------------------------------------------------------------------
-
-
-module XMonadContrib.MetaModule () where
-
-import XMonadContrib.Accordion ()
-import XMonadContrib.Anneal ()
-import XMonadContrib.Circle ()
-import XMonadContrib.Commands ()
-import XMonadContrib.Combo ()
-import XMonadContrib.CopyWindow ()
-import XMonadContrib.Decoration ()
-import XMonadContrib.DeManage ()
-import XMonadContrib.DirectoryPrompt ()
-import XMonadContrib.Dmenu ()
-import XMonadContrib.DragPane ()
-import XMonadContrib.DwmPromote ()
-import XMonadContrib.DynamicLog ()
-import XMonadContrib.DynamicWorkspaces ()
-import XMonadContrib.Dzen ()
-import XMonadContrib.FindEmptyWorkspace ()
-import XMonadContrib.FlexibleResize ()
-import XMonadContrib.FlexibleManipulate ()
-import XMonadContrib.FocusNth ()
-import XMonadContrib.HintedTile ()
-import XMonadContrib.LayoutHelpers ()
-import XMonadContrib.LayoutHints ()
-import XMonadContrib.LayoutHooks ()
-import XMonadContrib.LayoutScreens ()
-import XMonadContrib.MagicFocus ()
-import XMonadContrib.Magnifier ()
-import XMonadContrib.Mosaic ()
-import XMonadContrib.NamedWindows ()
-import XMonadContrib.NoBorders ()
-import XMonadContrib.Roledex ()
-import XMonadContrib.RotSlaves ()
-import XMonadContrib.RotView ()
--- XMonadContrib.ShellPrompt depends on readline
---import XMonadContrib.ShellPrompt ()
-import XMonadContrib.SimpleDate ()
-import XMonadContrib.SimpleStacking ()
-import XMonadContrib.SinkAll ()
-import XMonadContrib.Spiral ()
-import XMonadContrib.Square ()
-import XMonadContrib.SshPrompt ()
-import XMonadContrib.Submap ()
-import XMonadContrib.SwitchTrans ()
-import XMonadContrib.Tabbed ()
-import XMonadContrib.ThreeColumns ()
-import XMonadContrib.TwoPane ()
-import XMonadContrib.ViewPrev ()
-import XMonadContrib.XMonadPrompt ()
-import XMonadContrib.XPrompt ()
-import XMonadContrib.Warp ()
-import XMonadContrib.WorkspaceDir ()

Mosaic.hs

@@ -1,396 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Mosaic
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- This module defines a \"mosaic\" layout, which tries to give each window a
--- user-configurable relative area, while also trying to give them aspect
--- ratios configurable at run-time by the user.
---
------------------------------------------------------------------------------
-module XMonadContrib.Mosaic (
-                             -- * Usage
-                             -- $usage
-                             mosaic, expandWindow, shrinkWindow, squareWindow, myclearWindow,
-                             tallWindow, wideWindow, flexibleWindow,
-                             getName, withNamedWindow ) where
-
-import Control.Monad.State ( State, put, get, runState )
-import System.Random ( StdGen, mkStdGen )
-
-import Data.Ratio
-import Graphics.X11.Xlib
-import XMonad hiding ( trace )
-import Operations ( full, Resize(Shrink, Expand) )
-import qualified StackSet as W
-import qualified Data.Map as M
-import Data.List ( sort )
-import Data.Typeable ( Typeable )
-import Control.Monad ( mplus )
-
-import XMonadContrib.NamedWindows
-import XMonadContrib.Anneal
-
--- $usage
---
--- Key bindings:
--- 
--- You can use this module with the following in your config file:
---
--- > import XMonadContrib.Mosaic
---
--- > defaultLayouts :: [Layout Window]
--- > defaultLayouts = [ mosaic 0.25 0.5 M.empty, full ]
---
--- In the key-bindings, do something like:
---
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_h), withNamedWindow (sendMessage . tallWindow))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_l), withNamedWindow (sendMessage . wideWindow))
--- >   , ((modMask .|. shiftMask, xK_h     ), withNamedWindow (sendMessage . shrinkWindow))
--- >   , ((modMask .|. shiftMask, xK_l     ), withNamedWindow (sendMessage . expandWindow))
--- >   , ((modMask .|. shiftMask, xK_s     ), withNamedWindow (sendMessage . squareWindow))
--- >   , ((modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . myclearWindow))
--- >   , ((controlMask .|. modMask .|. shiftMask, xK_o     ), withNamedWindow (sendMessage . flexibleWindow))
--- 
-
-data HandleWindow = ExpandWindow NamedWindow | ShrinkWindow NamedWindow
-                  | SquareWindow NamedWindow | ClearWindow NamedWindow
-                  | TallWindow NamedWindow | WideWindow NamedWindow
-                  | FlexibleWindow NamedWindow
-                    deriving ( Typeable, Eq )
-
-instance Message HandleWindow
-
-expandWindow, shrinkWindow, squareWindow, flexibleWindow, myclearWindow,tallWindow, wideWindow :: NamedWindow -> HandleWindow
-expandWindow = ExpandWindow
-shrinkWindow = ShrinkWindow
-squareWindow = SquareWindow
-flexibleWindow = FlexibleWindow
-myclearWindow = ClearWindow
-tallWindow = TallWindow
-wideWindow = WideWindow
-
-largeNumber :: Int
-largeNumber = 50
-
-defaultArea :: Double
-defaultArea = 1
-
-flexibility :: Double
-flexibility = 0.1
-
-mosaic :: Double -> Double -> M.Map NamedWindow [WindowHint] -> Layout Window
-mosaic delta tileFrac hints = full { doLayout = \r -> mosaicL tileFrac hints r . W.integrate
-                                   , modifyLayout = return . mlayout }
-    where mlayout x = (m1 `fmap` fromMessage x) `mplus` (m2 `fmap` fromMessage x)
-          m1 Shrink = mosaic delta (tileFrac/(1+delta)) hints
-          m1 Expand = mosaic delta (tileFrac*(1+delta)) hints
-          m2 (ExpandWindow w) = mosaic delta tileFrac (multiply_area (1+delta) w hints)
-          m2 (ShrinkWindow w) = mosaic delta tileFrac (multiply_area (1/(1+ delta)) w hints)
-          m2 (SquareWindow w) = mosaic delta tileFrac (set_aspect_ratio 1 w hints)
-          m2 (FlexibleWindow w) = mosaic delta tileFrac (make_flexible w hints)
-          m2 (TallWindow w) = mosaic delta tileFrac (multiply_aspect (1/(1+delta)) w hints)
-          m2 (WideWindow w) = mosaic delta tileFrac (multiply_aspect (1+delta) w hints)
-          m2 (ClearWindow w) = mosaic delta tileFrac (M.delete w hints)
-
-multiply_area :: Double -> NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
-multiply_area a = alterlist f where f [] = [RelArea (defaultArea*a)]
-                                    f (RelArea a':xs) = RelArea (a'*a) : xs
-                                    f (x:xs) = x : f xs
-
-set_aspect_ratio :: Double -> NamedWindow
-                 -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
-set_aspect_ratio r = alterlist f where f [] = [AspectRatio r]
-                                       f (FlexibleAspectRatio _:x) = AspectRatio r:x
-                                       f (AspectRatio _:x) = AspectRatio r:x
-                                       f (x:xs) = x:f xs
-
-make_flexible :: NamedWindow
-              -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
-make_flexible = alterlist (map f) where f (AspectRatio r) = FlexibleAspectRatio r
-                                        f (FlexibleAspectRatio r) = AspectRatio r
-                                        f x = x
-
-multiply_aspect :: Double -> NamedWindow
-                -> M.Map NamedWindow [WindowHint] -> M.Map NamedWindow [WindowHint]
-multiply_aspect r = alterlist f where f [] = [FlexibleAspectRatio r]
-                                      f (AspectRatio r':x) = AspectRatio (r*r'):x
-                                      f (FlexibleAspectRatio r':x) = FlexibleAspectRatio (r*r'):x
-                                      f (x:xs) = x:f xs
-
-findlist :: Ord k => k -> M.Map k [a] -> [a]
-findlist = M.findWithDefault []
-
-alterlist :: (Ord k, Ord a) => ([a] -> [a]) -> k -> M.Map k [a] -> M.Map k [a]
-alterlist f k = M.alter f' k
-    where f' Nothing = f' (Just [])
-          f' (Just xs) = case f xs of
-                           [] -> Nothing
-                           xs' -> Just xs'
-
-mosaicL :: Double -> M.Map NamedWindow [WindowHint]
-        -> Rectangle -> [Window] -> X ([(Window, Rectangle)],Maybe (Layout Window))
-mosaicL _ _ _ [] = return ([], Nothing)
-mosaicL f hints origRect origws
-    = do namedws <- mapM getName origws
-         let sortedws = reverse $ map the_value $ sort $ map (\w -> Rated (sumareas [w]) w) namedws
-             -- TODO: remove all this dead code
-             myv = runCountDown largeNumber $ mosaic_splits even_split origRect Vertical sortedws
-             myv2 = mc_mosaic sortedws Vertical
-             myh2 = mc_mosaic sortedws Horizontal
---             myv2 = maxL $ runCountDown largeNumber $
---                    sequence $ replicate mediumNumber $
---                    mosaic_splits one_split origRect Vertical sortedws
-             myh = runCountDown largeNumber $ mosaic_splits even_split origRect Horizontal sortedws
---             myh2 = maxL $ runCountDown largeNumber $
---                    sequence $ replicate mediumNumber $
---                    mosaic_splits one_split origRect Horizontal sortedws
-         return (map (\(nw,r)->(--trace ("rate1:"++ unlines [show nw,
-                                 --                           show $ rate f meanarea (findlist nw hints) r,
-                                 --                           show r,
-                                 --                           show $ area r/meanarea,
-                                 --                           show $ findlist nw hints]) $
-                                 unName nw,crop' (findlist nw hints) r)) $
-                flattenMosaic $ the_value $ maxL [myh,myv,myh2,myv2], Nothing)
-    where mosaic_splits _ _ _ [] = return $ Rated 0 $ M []
-          mosaic_splits _ r _ [w] = return $ Rated (rate f meanarea (findlist w hints) r) $ OM (w,r)
-          mosaic_splits spl r d ws = maxL `fmap` mapCD (spl r d) (init $ allsplits ws)
-          even_split :: Rectangle -> CutDirection -> [[NamedWindow]]
-                     -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle)))
-          even_split r d [ws] = even_split r d $ map (:[]) ws
-          even_split r d wss =
-              do let areas = map sumareas wss
-                 let wsr_s :: [([NamedWindow], Rectangle)]
-                     wsr_s = zip wss (partitionR d r areas)
-                 submosaics <- mapM (\(ws',r') ->
-                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s
-                 return $ fmap M $ catRated submosaics
-          {-
-          another_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
-          another_mosaic ws d = rate_mosaic ratew $
-                                rect_mosaic origRect d $
-                                zipML (example_mosaic ws) (map findarea ws)
-          -}
-          mc_mosaic :: [NamedWindow] -> CutDirection
-                         -> Rated Double (Mosaic (NamedWindow,Rectangle))
-          mc_mosaic ws d = fmap (rect_mosaic origRect d) $
-                           annealMax (zipML (example_mosaic ws) (map findarea ws))
-                           (the_rating . rate_mosaic ratew . rect_mosaic origRect d )
-                           changeMosaic
-
-          ratew :: (NamedWindow,Rectangle) -> Double
-          ratew (w,r) = rate f meanarea (findlist w hints) r
-          example_mosaic :: [NamedWindow] -> Mosaic NamedWindow
-          example_mosaic ws = M (map OM ws)
-          rect_mosaic :: Rectangle -> CutDirection -> Mosaic (a,Double) -> Mosaic (a,Rectangle)
-          rect_mosaic r _ (OM (w,_)) = OM (w,r)
-          rect_mosaic r d (M ws) = M $ zipWith (\w' r' -> rect_mosaic r' d' w') ws rs
-              where areas = map (sum . map snd . flattenMosaic) ws
-                    rs = partitionR d r areas
-                    d' = otherDirection d
-          rate_mosaic :: ((NamedWindow,Rectangle) -> Double)
-                      -> Mosaic (NamedWindow,Rectangle) -> Rated Double (Mosaic (NamedWindow,Rectangle))
-          rate_mosaic r m = catRatedM $ fmap (\x -> Rated (r x) x) m
-{-
-          one_split :: Rectangle -> CutDirection -> [[NamedWindow]]
-                    -> State CountDown (Rated Double (Mosaic (NamedWindow, Rectangle)))
-          one_split r d [ws] = one_split r d $ map (:[]) ws
-          one_split r d wss =
-              do rnd <- mapM (const (fractional resolutionNumber)) [1..length wss]
-                 let wsr_s :: [([NamedWindow], Rectangle)]
-                     wsr_s = zip wss (partitionR d r rnd)
-                 submosaics <- mapM (\(ws',r') ->
-                                     mosaic_splits even_split r' (otherDirection d) ws') wsr_s
-                 return $ fmap M $ catRated submosaics
--}
-          partitionR :: CutDirection -> Rectangle -> [Double] -> [Rectangle]
-          partitionR _ _ [] = []
-          partitionR _ r [_] = [r]
-          partitionR d r (a:ars) = r1 : partitionR d r2 ars
-              where totarea = sum (a:ars)
-                    (r1,r2) = split d (a/totarea) r
-          theareas = hints2area `fmap` hints
-          sumareas ws = sum $ map findarea ws
-          findarea :: NamedWindow -> Double
-          findarea w = M.findWithDefault 1 w theareas
-          meanarea =  area origRect / fromIntegral (length origws)
-
-maxL :: Ord a => [a] -> a
-maxL [] = error "maxL on empty list"
-maxL [a] = a
-maxL (a:b:c) = maxL (max a b:c)
-
-catRated :: Floating v => [Rated v a] -> Rated v [a]
-catRated xs = Rated (product $ map the_rating xs) (map the_value xs)
-
-catRatedM :: Floating v => Mosaic (Rated v a) -> Rated v (Mosaic a)
-catRatedM (OM (Rated v x)) =  Rated v (OM x)
-catRatedM (M xs) = case catRated $ map catRatedM xs of Rated v xs' -> Rated v (M xs')
-
-data CountDown = CD !StdGen !Int
-
-tries_left :: State CountDown Int
-tries_left = do CD _ n <- get
-                return (max 0 n)
-
-mapCD :: (a -> State CountDown b) -> [a] -> State CountDown [b]
-mapCD f xs = do n <- tries_left
-                let len = length xs
-                mapM (run_with_only ((n `div` len)+1) . f) $ take (n+1) xs
-
-run_with_only :: Int -> State CountDown a -> State CountDown a
-run_with_only limit j =
-    do CD g n <- get
-       let leftover = n - limit
-       if leftover < 0 then j
-                       else do put $ CD g limit
-                               x <- j
-                               CD g' n' <- get
-                               put $ CD g' (leftover + n')
-                               return x
-
-data WindowHint = RelArea Double
-                | AspectRatio Double
-                | FlexibleAspectRatio Double
-                  deriving ( Show, Read, Eq, Ord )
-
-fixedAspect :: [WindowHint] -> Bool
-fixedAspect [] = False
-fixedAspect (AspectRatio _:_) = True
-fixedAspect (_:x) = fixedAspect x
-
-rate :: Double -> Double -> [WindowHint] -> Rectangle -> Double
-rate defaulta meanarea xs rr
-    | fixedAspect xs = (area (crop xs rr) / meanarea) ** weight
-    | otherwise = (area rr / meanarea)**(weight-flexibility)
-                  * (area (crop (xs++[FlexibleAspectRatio defaulta]) rr) / meanarea)**flexibility
-     where weight = hints2area xs
-
-crop :: [WindowHint] -> Rectangle -> Rectangle
-crop (AspectRatio f:_) = cropit f
-crop (FlexibleAspectRatio f:_) = cropit f
-crop (_:hs) = crop hs
-crop [] = id
-
-crop' :: [WindowHint] -> Rectangle -> Rectangle
-crop' (AspectRatio f:_) = cropit f
-crop' (_:hs) = crop' hs
-crop' [] = id
-
-cropit :: Double -> Rectangle -> Rectangle
-cropit f (Rectangle a b w h) | w -/- h > f = Rectangle a b (ceiling $ h -* f) h
-                             | otherwise = Rectangle a b w (ceiling $ w -/ f)
-
-hints2area :: [WindowHint] -> Double
-hints2area [] = defaultArea
-hints2area (RelArea r:_) = r
-hints2area (_:x) = hints2area x
-
-area :: Rectangle -> Double
-area (Rectangle _ _ w h) = fromIntegral w * fromIntegral h
-
-(-/-) :: (Integral a, Integral b) => a -> b -> Double
-a -/- b = fromIntegral a / fromIntegral b
-
-(-/) :: (Integral a) => a -> Double -> Double
-a -/ b = fromIntegral a / b
-
-(-*) :: (Integral a) => a -> Double -> Double
-a -* b = fromIntegral a * b
-
-split :: CutDirection -> Double -> Rectangle -> (Rectangle, Rectangle)
-split Vertical frac (Rectangle sx sy sw sh) = (Rectangle sx sy sw h,
-                                               Rectangle sx (sy+fromIntegral h) sw (sh-h))
-    where h = floor $ fromIntegral sh * frac
-split Horizontal frac (Rectangle sx sy sw sh) = (Rectangle sx sy w sh,
-                                                 Rectangle (sx+fromIntegral w) sy (sw-w) sh)
-    where w = floor $ fromIntegral sw * frac
-
-data CutDirection = Vertical | Horizontal
-otherDirection :: CutDirection -> CutDirection
-otherDirection Vertical = Horizontal
-otherDirection Horizontal = Vertical
-
-data Mosaic a = M [Mosaic a] | OM a
-          deriving ( Show )
-
-instance Functor Mosaic where
-    fmap f (OM x) = OM (f x)
-    fmap f (M xs) = M (map (fmap f) xs)
-
-zipMLwith :: (a -> b -> c) -> Mosaic a -> [b] -> Mosaic c
-zipMLwith f (OM x) (y:_) = OM (f x y)
-zipMLwith _ (OM _) [] = error "bad zipMLwith"
-zipMLwith f (M xxs) yys = makeM $ foo xxs yys
-    where foo (x:xs) ys = zipMLwith f x (take (lengthM x) ys) :
-                          foo xs (drop (lengthM x) ys)
-          foo [] _ = []
-
-zipML :: Mosaic a -> [b] -> Mosaic (a,b)
-zipML = zipMLwith (\a b -> (a,b))
-
-lengthM :: Mosaic a -> Int
-lengthM (OM _) = 1
-lengthM (M x) = sum $ map lengthM x
-
-changeMosaic :: Mosaic a -> [Mosaic a]
-changeMosaic (OM _) = []
-changeMosaic (M xs) = map makeM (concatenations xs) ++
-                      map makeM (splits xs) ++
-                      map M (tryAll changeMosaic xs)
-
-tryAll :: (a -> [a]) -> [a] -> [[a]]
-tryAll _ [] = []
-tryAll f (x:xs) = map (:xs) (f x) ++ map (x:) (tryAll f xs)
-
-splits :: [Mosaic a] -> [[Mosaic a]]
-splits [] = []
-splits (OM x:y) = map (OM x:) $ splits y
-splits (M (x:y):z) = (x:makeM y:z) : map (makeM (x:y) :) (splits z)
-splits (M []:x) = splits x
-
-concatenations :: [Mosaic a] -> [[Mosaic a]]
-concatenations (x:y:z) = (concatenateMosaic x y:z):(map (x:) $ concatenations (y:z))
-concatenations _ = []
-
-concatenateMosaic :: Mosaic a -> Mosaic a -> Mosaic a
-concatenateMosaic (OM a) (OM b) = M [OM a, OM b]
-concatenateMosaic (OM a) (M b) = M (OM a:b)
-concatenateMosaic (M a) (OM b) = M (a++[OM b])
-concatenateMosaic (M a) (M b) = M (a++b)
-
-makeM :: [Mosaic a] -> Mosaic a
-makeM [m] = m
-makeM [] = error "makeM []"
-makeM ms = M ms
-
-flattenMosaic :: Mosaic a -> [a]
-flattenMosaic (OM a) = [a]
-flattenMosaic (M xs) = concatMap flattenMosaic xs
-
-allsplits :: [a] -> [[[a]]]
-allsplits [] = [[[]]]
-allsplits [a] = [[[a]]]
-allsplits (x:xs) = (map ([x]:) splitsrest) ++ (map (maphead (x:)) splitsrest)
-    where splitsrest = allsplits' xs
-
-allsplits' :: [a] -> [[[a]]]
-allsplits' [] = [[[]]]
-allsplits' [a] = [[[a]]]
-allsplits' (x:xs) = (map (maphead (x:)) splitsrest) ++ (map ([x]:) splitsrest)
-    where splitsrest = allsplits xs
-
-maphead :: (a->a) -> [a] -> [a]
-maphead f (x:xs) = f x : xs
-maphead _ [] = []
-
-runCountDown :: Int -> State CountDown a -> a
-runCountDown n x = fst $ runState x (CD (mkStdGen n) n)

NoBorders.hs

@@ -1,57 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.NoBorders
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Make a given layout display without borders.  This is useful for
--- full-screen or tabbed layouts, where you don't really want to waste a
--- couple of pixels of real estate just to inform yourself that the visible
--- window has focus.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.NoBorders (
-                                -- * Usage
-                                -- $usage
-                                noBorders, 
-                                withBorder 
-                               ) where
-
-import Control.Monad.State ( gets )
-import Graphics.X11.Xlib
-
-import XMonad
-import Operations ( UnDoLayout(UnDoLayout) )
-import qualified StackSet as W
-import {-# SOURCE #-} Config (borderWidth)
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.NoBorders
---
--- and modify the defaultLayouts to call noBorders on the layouts you want to lack
--- borders
---
--- > defaultLayouts = [ noBorders full, ... ]
-
-noBorders :: Layout a -> Layout a
-noBorders = withBorder 0
-
-withBorder :: Dimension -> Layout a -> Layout a
-withBorder bd l = l { doLayout = \r x -> setborders bd >> doLayout l r x
-                    , modifyLayout = ml }
-    where ml m | Just UnDoLayout == fromMessage m
-                   = do setborders borderWidth
-                        fmap (withBorder bd) `fmap` (modifyLayout l) m
-               | otherwise = fmap (withBorder bd) `fmap` (modifyLayout l) m
-
-setborders :: Dimension -> X ()
-setborders bw = withDisplay $ \d ->
-                do ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
-                   mapM_ (\w -> io $ setWindowBorderWidth d w bw) ws

README

@@ -1,20 +0,0 @@
-3rd party xmonad extensions and contributions.
-
-This repository can be overlayed on an xmonad repository.
-Users may then import Haskell src from here, to extend their config
-files.
-
-scripts/ contains further external programs useful with xmonad.
-
-Haskell code contributed to this repo should live under the
-
-    XMonadContrib.
-
-name space. For example:
-
-    XMonadContrib.Mosaic
-
-------------------------------------------------------------------------
-
-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,43 @@
+# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
+
+[![Build Status](https://travis-ci.org/xmonad/xmonad-contrib.svg?branch=master)](https://travis-ci.org/xmonad/xmonad-contrib)
+[![Open Source Helpers](https://www.codetriage.com/xmonad/xmonad-contrib/badges/users.svg)](https://www.codetriage.com/xmonad/xmonad-contrib)
+
+You need the ghc compiler and xmonad window manager installed in
+order to use these extensions.
+
+For installation and configuration instructions, please see the
+[xmonad website][xmonad], the documents included with the
+[xmonad source distribution][xmonad-git], and the
+[online haddock documentation][xmonad-docs].
+
+## 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, XMonad's [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)  and the [xmonad website][xmonad].
+
+## License
+
+Code submitted to the contrib repo is licensed under the same license as
+xmonad itself, with copyright held by the authors.
+ 
+[xmonad]: http://xmonad.org
+[xmonad-git]: https://github.com/xmonad/xmonad
+[xmonad-docs]: http://hackage.haskell.org/package/xmonad
+[developing]: http://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Doc-Developing.html

RotSlaves.hs

@@ -1,46 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XMonadContrib.RotSlaves
--- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
--- License      : BSD3-style (see LICENSE)
---
--- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
--- Stability    : unstable
--- Portability  : unportable
---
--- Rotate all windows except the master window 
--- and keep the focus in place.
------------------------------------------------------------------------------
-module XMonadContrib.RotSlaves (
-	-- $usage
-	rotSlaves', rotSlavesUp, rotSlavesDown
-	) where
-
-import StackSet
-import Operations
-import XMonad
-
--- $usage
---
--- To use this module, import it with:
---
--- > import XMonadContrib.RotSlaves
---
--- and add a keybinding:
---
--- > , ((modMask .|. shiftMask, xK_Tab   ), rotSlavesUp) 
---
---
--- This operation will rotate all windows except the master window, while the focus
--- stays where it is. It is usefull together with the TwoPane-Layout (see XMonadContrib.TwoPane).
-
-rotSlavesUp,rotSlavesDown :: X ()
-rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
-rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
-
-rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
-rotSlaves' _ s@(Stack _ [] []) = s
-rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus
-rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise
-    where  (master:ws)     = integrate s
-           (revls',t':rs') = splitAt (length ls) (master:(f ws))

RotView.hs

@@ -1,45 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.RotView
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
---
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- Provides bindings to cycle through non-empty workspaces.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.RotView (
-                              -- * Usage
-                              -- $usage
-                              rotView
-                             ) where
-
-import Control.Monad.State ( gets )
-import Data.List ( sortBy )
-import Data.Maybe ( listToMaybe, isJust )
-import Data.Ord ( comparing )
-
-import XMonad
-import StackSet hiding (filter)
-import qualified Operations as O
-
--- $usage
--- You can use this module with the following in your Config.hs file:
--- 
--- > import XMonadContrib.RotView
---
--- >   , ((modMask .|. shiftMask, xK_Right), rotView True)
--- >   , ((modMask .|. shiftMask, xK_Left), rotView False)
-
-rotView :: Bool -> X ()
-rotView b = do
-    ws <- gets windowset
-    let m = tag . workspace . current $ ws
-        sortWs = sortBy (comparing tag)
-        pivoted = uncurry (flip (++)) . span ((< m) . tag) . sortWs . hidden $ ws
-        nextws = listToMaybe . filter (isJust . stack) . (if b then id else reverse) $ pivoted
-    whenJust nextws (O.view . tag)

RunInXTerm.hs

@@ -1,31 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.RunInXTerm
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
--- 
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A simple module to launch commands in an X terminal 
--- from XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.RunInXTerm (
-                             -- * Usage
-                             -- $usage
-                             runInXTerm
-                              ) where
-
-import XMonad
-import System.Environment
-
--- $usage
--- For an example usage see "XMonadContrib.SshPrompt"
-
-runInXTerm :: String -> X ()
-runInXTerm com = do
-  c <- io $ catch (getEnv "XTERMCMD") (const $ return "xterm")
-  spawn ("exec " ++ c ++ " -e " ++ com)

Setup.lhs

@@ -0,0 +1,3 @@
+#!/usr/bin/env runhaskell
+> import Distribution.Simple
+> main = defaultMain

ShellPrompt.hs

@@ -1,91 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.ShellPrompt
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
--- 
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A shell prompt for XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.ShellPrompt (
-                             -- * Usage
-                             -- $usage
-                             shellPrompt
-                             , rmPath
-                             , split
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-
-import Control.Monad
-import Data.List
-import System.Console.Readline
-import System.Environment
-
--- $usage
---
--- 1. In xmonad.cabal change: 
---
--- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0
---
--- to
---
--- > build-depends:      base>=2.0, X11>=1.2.1, X11-extras>=0.2, mtl>=1.0, unix>=1.0, readline >= 1.0
---
--- 2. In Config.hs add:
---
--- > import XMonadContrib.XPrompt
--- > import XMonadContrib.ShellPrompt
---
--- 3. In your keybindings add something like:
---
--- >   , ((modMask .|. controlMask, xK_x), shellPrompt defaultXPConfig)
---
-
-data Shell = Shell
-
-instance XPrompt Shell where
-    showXPrompt Shell = "Run:   "
-
-
-shellPrompt :: XPConfig -> X ()
-shellPrompt c = mkXPrompt Shell c getShellCompl spawn
-
-getShellCompl :: String -> IO [String]
-getShellCompl s 
-    | s /= "" && last s /= ' ' = do
-  fl <- filenameCompletionFunction s
-  c <- commandCompletionFunction s
-  return $ sort . nub $ fl ++ c
-    | otherwise = return []
-
-commandCompletionFunction :: String -> IO [String]
-commandCompletionFunction str 
-    | '/' `elem` str = return []
-    | otherwise = do
-  p <- getEnv "PATH"
-  cl p
-    where
-      cl = liftM (nub . rmPath . concat) . mapM fCF . map addToPath . split ':'  
-      addToPath = flip (++) ("/" ++ str)
-      fCF = filenameCompletionFunction
-
-rmPath :: [String] -> [String]
-rmPath s = 
-    map (reverse . fst . break  (=='/') . reverse) s
-
-split :: Eq a => a -> [a] -> [[a]]
-split _ [] = []
-split e l =
-    f : split e (rest ls)
-        where 
-          (f,ls) = span (/=e) l
-          rest s | s == [] = []
-                 | otherwise = tail s
-

SimpleStacking.hs

@@ -1,44 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SimpleStacking
--- Copyright   :  (c) David Roundy <droundy@darcs.net>
--- License     :  BSD-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module to be used to obtain a simple "memory" of stacking order.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.SimpleStacking (
-                                     -- * Usage
-                                     -- $usage 
-                                     simpleStacking
-                                    ) where
-
-import Data.Maybe ( catMaybes )
-
-import Data.List ( nub, lookup )
-import StackSet ( focus, up, down )
-import Graphics.X11.Xlib ( Window )
-
-import XMonad
-import XMonadContrib.LayoutHelpers
-
--- $usage
--- You can use this module for 
--- See, for instance, "XMonadContrib.Tabbed"
-
-simpleStacking :: Layout Window -> Layout Window
-simpleStacking = simpleStacking' []
-
-simpleStacking' :: [Window] -> Layout Window -> Layout Window
-simpleStacking' st = layoutModify dl idModMod
-    where dl _ s wrs = let m = map (\ (w,rr) -> (w,(w,rr))) wrs
-                           wrs' = catMaybes $ map ((flip lookup) m) $
-                                  nub (focus s : st ++ map fst wrs)
-                           st' = focus s:filter (`elem` (up s++down s)) st
-                       in return (wrs', Just (simpleStacking' st'))

SinkAll.hs

@@ -1,34 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module       : XmonadContrib.SinkAll
--- License      : BSD3-style (see LICENSE)
--- Stability    : unstable
--- Portability  : unportable
---
--- Provides a simple binding that pushes all floating windows on the current
--- workspace back into tiling.
------------------------------------------------------------------------------
-
-module XMonadContrib.SinkAll (
-    -- * Usage
-    -- $usage
-    sinkAll) where
-
-import Operations
-import XMonad
-import StackSet hiding (sink)
-
-import Control.Monad.State
-import Graphics.X11.Xlib
-
--- $usage
--- > import XMonadContrib.SinkAll
--- > keys = [ ((modMask .|. shiftMask, xK_t), sinkAll) ]
-
-sinkAll :: X ()
-sinkAll = withAll sink
-
--- Apply a function to all windows on current workspace.
-withAll :: (Window -> X a) -> X ()
-withAll f = gets (integrate' . stack . workspace . current . windowset) >>=
-    mapM_ f

SshPrompt.hs

@@ -1,60 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SshPrompt
--- Copyright   :  (C) 2007 Andrea Rossato
--- License     :  BSD3
--- 
--- Maintainer  :  andrea.rossato@unibz.it
--- Stability   :  unstable
--- Portability :  unportable
---
--- A ssh prompt for XMonad
---
------------------------------------------------------------------------------
-
-module XMonadContrib.SshPrompt (
-                             -- * Usage
-                             -- $usage
-                             sshPrompt
-                              ) where
-
-import XMonad
-import XMonadContrib.XPrompt
-import XMonadContrib.RunInXTerm
-
-import Control.Monad
-import System.Directory
-import System.Environment
-
--- $usage
--- 1. In Config.hs add:
---
--- > import XMonadContrib.XPrompt
--- > import XMonadContrib.SshPrompt
---
--- 3. In your keybindings add something like:
---
--- >   , ((modMask .|. controlMask, xK_x), xmonadPrompt defaultXPConfig)
---
-
-data Ssh = Ssh
-
-instance XPrompt Ssh where
-    showXPrompt Ssh = "SSH to:   "
-
-sshPrompt :: XPConfig -> X ()
-sshPrompt c = do
-  sc <- io $ sshComplList
-  mkXPrompt Ssh c (mkComplFunFromList sc) ssh
-
-ssh :: String -> X ()
-ssh s = runInXTerm ("ssh " ++ s)
- 
-sshComplList :: IO [String]
-sshComplList = do
-  h <- getEnv "HOME"
-  let kh = h ++ "/.ssh/known_hosts"
-  f <- doesFileExist kh
-  if f then do l <- readFile kh
-               return $ map (takeWhile (/= ',') . concat . take 1 . words) (lines l)
-       else return []

Submap.hs

@@ -1,62 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Submap
--- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Jason Creighton <jcreigh@gmail.com>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module that allows the user to create a sub-mapping of keys bindings.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Submap (
-                             -- * Usage
-                             -- $usage
-                             submap
-                            ) where
-
-import Control.Monad.Reader
-
-import XMonad
-import Operations (cleanMask)
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import qualified Data.Map as M
-
-{- $usage
-Allows you to create a sub-mapping of keys. Example:
-
->    , ((modMask, xK_a), submap . M.fromList $
->        [ ((0, xK_n),     spawn "mpc next")
->        , ((0, xK_p),     spawn "mpc prev")
->        , ((0, xK_z),     spawn "mpc random")
->        , ((0, xK_space), spawn "mpc toggle")
->        ])
-
-So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to trigger the
-submapping) and then 'n' to run that action. (0 means \"no modifier\"). You are,
-of course, free to use any combination of modifiers in the submapping. However,
-anyModifier will not work, because that is a special value passed to XGrabKey()
-and not an actual modifier.
--}
-
-submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
-submap keys = do
-    XConf { theRoot = root, display = d } <- ask
-
-    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
-
-    keyspec <- 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 (cleanMask m, keysym)
-
-    io $ ungrabKeyboard d currentTime
-
-    whenJust (M.lookup keyspec keys) id

SwitchTrans.hs

@@ -1,161 +0,0 @@
-{-# OPTIONS_GHC -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.SwitchTrans
--- Copyright   :  (c) Lukas Mai
--- License     :  BSD-style (see LICENSE)
---
--- Maintainer  :  <l.mai@web.de>
--- Stability   :  unstable
--- Portability :  unportable
---
---
--- Ordinary layout transformers are simple and easy to use but inflexible.
--- This module provides a more structured interface to them.
---
--- The basic idea is to have a base layout and a set of layout transformers,
--- of which at most one is active at any time. Enabling another transformer
--- first disables any currently active transformer; i.e. it works like
--- a group of radio buttons.
---
--- A side effect of this meta-layout is that layout transformers no longer
--- receive any messages; any message not handled by @SwitchTrans@ itself
--- will undo the current layout transformer, pass the message on to the base
--- layout, then reapply the transformer.
---
--- Here's how you might use this in Config.hs:
---
--- > defaultLayouts =
--- >     map (
--- >         mkSwitch (M.singleton "full" (const $ noBorders full)) .
--- >         mkSwitch (M.singleton "mirror" mirror)
--- >     ) [ tiled ]
---
--- (The noBorders transformer is from "XMonadContrib.NoBorders".)
---
--- This example is probably overkill but it's very close to what I actually use.
--- Anyway, this layout behaves like the default @tiled@ layout, until you send it
--- @Enable@\/@Disable@\/@Toggle@ messages. From the definition of @keys@:
---
--- > ...
--- >    , ((modMask,               xK_f     ), sendMessage $ Toggle "full")
--- >    , ((modMask,               xK_r     ), sendMessage $ Toggle "mirror")
---
--- (You may want to use other keys. I don't use Xinerama so the default mod-r
--- binding is useless to me.)
---
--- After this, pressing @mod-f@ switches the current window to fullscreen mode.
--- Pressing @mod-f@ again switches it back. Similarly, @mod-r@ rotates the layout
--- by 90 degrees (and back). The nice thing is that your changes are kept:
--- Rotating first then changing the size of the master area then rotating back
--- does not undo the master area changes.
---
--- The reason I use two stacked @SwitchTrans@ transformers instead of
--- @mkSwitch (M.fromList [("full", const $ noBorders full), ("mirror", mirror)])@
--- is that I use @mod-f@ to \"zoom in\" on interesting windows, no matter what other
--- layout transformers may be active. Having an extra fullscreen mode on top of
--- everything else means I can zoom in and out without implicitly undoing \"normal\"
--- layout transformers, like @mirror@. Remember, inside a @SwitchTrans@ there can
--- be at most one active layout transformer.
------------------------------------------------------------------------------
-
-module XMonadContrib.SwitchTrans (
-    Toggle(..),
-    Enable(..),
-    Disable(..),
-    mkSwitch
-) where
-
-import XMonad
-import Operations
-
-import qualified Data.Map as M
-import Data.Map (Map)
-
--- | Toggle the specified layout transformer.
-data Toggle = Toggle String deriving (Eq, Typeable)
-instance Message Toggle
--- | Enable the specified transformer.
-data Enable = Enable String deriving (Eq, Typeable)
-instance Message Enable
--- | Disable the specified transformer.
-data Disable = Disable String deriving (Eq, Typeable)
-instance Message Disable
-
-data State a = State {
-    base :: Layout a,
-    currTag :: Maybe String,
-    currLayout :: Layout a,
-    currFilt :: Layout a -> Layout a,
-    filters :: Map String (Layout a -> Layout a)
-}
-
--- | Take a transformer table and a base layout, and return a
--- SwitchTrans layout.
-mkSwitch :: Map String (Layout a -> Layout a) -> Layout a -> Layout a
-mkSwitch fs b = switched st
-    where
-    st = State{
-        base = b,
-        currTag = Nothing,
-        currLayout = b,
-        currFilt = id,
-        filters = fs }
-        
-provided :: Bool -> X (Maybe a) -> X (Maybe a)
-provided c x
-    | c = x
-    | otherwise = return Nothing
-
-switched :: State a -> Layout a
-switched
-    state@State{
-        base = b,
-        currTag = ct,
-        currLayout = cl,
-        currFilt = cf,
-        filters = fs
-    } = Layout {doLayout = dl, modifyLayout = ml}
-    where
-    enable tag alt = do
-        modifyLayout cl (SomeMessage UnDoLayout)
-        return . Just . switched $ state{
-            currTag = Just tag,
-            currFilt = alt,
-            currLayout = alt b }
-    disable = do
-        modifyLayout cl (SomeMessage UnDoLayout)
-        return . Just . switched $ state{
-            currTag = Nothing,
-            currFilt = id,
-            currLayout = b }
-    dl r s = do
-        (x, _) <- doLayout cl r s
-        return (x, Nothing)  -- sorry Dave, I can't let you do that
-    ml m
-        | Just (Disable tag) <- fromMessage m
-        , M.member tag fs
-        = provided (ct == Just tag) $ disable
-        | Just (Enable tag) <- fromMessage m
-        , Just alt <- M.lookup tag fs
-        = provided (ct /= Just tag) $ enable tag alt
-        | Just (Toggle tag) <- fromMessage m
-        , Just alt <- M.lookup tag fs
-        =
-            if (ct == Just tag) then
-                disable
-            else
-                enable tag alt
-        | Just UnDoLayout <- fromMessage m
-        = do
-            modifyLayout cl m
-            return Nothing
-        | otherwise = do
-            x <- modifyLayout b m
-            case x of
-                Nothing -> return Nothing
-                Just b' -> do
-                    modifyLayout cl (SomeMessage UnDoLayout)
-                    return . Just $ switched state{
-                        base = b',
-                        currLayout = cf b' }

Tabbed.hs

@@ -1,143 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Tabbed
--- Copyright   :  (c) David Roundy
--- License     :  BSD-style (see xmonad/LICENSE)
--- 
--- Maintainer  :  email@address.com
--- Stability   :  unstable
--- Portability :  unportable
---
--- A tabbed layout for the Xmonad Window Manager 
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Tabbed ( 
-                             -- * Usage:
-                             -- $usage
-                              tabbed
-                            , Shrinker, shrinkText
-                            , TConf (..), defaultTConf
-                            ) where
-
-import Control.Monad.State ( gets )
-
-import Graphics.X11.Xlib
-import XMonad
-import XMonadContrib.Decoration
-import Operations ( focus, initColor )
-import qualified StackSet as W
-
-import XMonadContrib.NamedWindows
-import XMonadContrib.SimpleStacking ( simpleStacking )
-import XMonadContrib.LayoutHelpers ( idModify )
-
--- $usage
--- You can use this module with the following in your configuration file:
---
--- > import XMonadContrib.Tabbed
---
--- > defaultLayouts :: [Layout Window]
--- > defaultLayouts = [ tabbed shrinkText defaultTConf
--- >                  , ... ]
---
--- You can also edit the default configuration options.
---
--- > myconfig = defaultTConf { inactiveBolderColor = "#FF0000"
--- >                         , activeTextColor = "#00FF00"}
---
--- and
---
--- > defaultLayouts = [ tabbed shrinkText myconfig
--- >                  , ... ]
-
-data TConf = 
-    TConf { activeColor :: String
-          , inactiveColor :: String
-          , activeBorderColor :: String
-          , inactiveTextColor :: String
-          , inactiveBorderColor :: String
-          , activeTextColor :: String
-          , fontName :: String
-          , tabSize :: Int
-          } deriving (Show, Read)
-
-defaultTConf :: TConf
-defaultTConf = 
-    TConf { activeColor ="#999999"
-          , inactiveColor = "#666666"
-          , activeBorderColor = "#FFFFFF"
-          , inactiveBorderColor = "#BBBBBB"
-          , activeTextColor = "#FFFFFF"
-          , inactiveTextColor = "#BFBFBF"
-          , fontName = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*"
-          , tabSize = 20
-          }
-
-tabbed :: Shrinker -> TConf -> Layout Window
-tabbed s t = simpleStacking $ tabbed' s t
-
-tabbed' :: Shrinker -> TConf -> Layout Window
-tabbed' shrinkT config =  Layout { doLayout = dolay shrinkT config, modifyLayout = idModify }
-
-dolay :: Shrinker -> TConf
-      -> Rectangle -> W.Stack Window -> X ([(Window, Rectangle)], Maybe (Layout Window))
-dolay _ _ sc (W.Stack w [] []) = return ([(w,sc)], Nothing)
-dolay shr conf sc@(Rectangle x y wid _) s = withDisplay $ \dpy ->
-    do ac   <- io $ initColor dpy $ activeColor conf
-       ic <- io $ initColor dpy $ inactiveColor conf
-       abc <- io $ initColor dpy $ activeBorderColor conf
-       ibc <- io $ initColor dpy $ inactiveBorderColor conf
-       atc <- io $ initColor dpy $ activeTextColor conf 
-       itc <- io $ initColor dpy $ inactiveTextColor conf
-       let ws = W.integrate s
-           ts = gentabs conf x y wid (length ws)
-           tws = zip ts ws
-           focusColor w incol actcol = (maybe incol (\focusw -> if focusw == w 
-                                                                then actcol else incol) . W.peek) 
-                                       `fmap` gets windowset
-           make_tabs [] l = return l
-           make_tabs (tw':tws') l = do bc <- focusColor (snd tw') ibc abc
-                                       l' <- maketab tw' bc l
-                                       make_tabs tws' l'
-           maketab (t,ow) bg = newDecoration ow t 1 bg ac
-                                (fontName conf) (drawtab t ow) (focus ow)
-           drawtab r@(Rectangle _ _ wt ht) ow d w' gc fn =
-               do nw <- getName ow
-                  (fc,tc) <- focusColor ow (ic,itc) (ac,atc)
-                  io $ setForeground d gc fc
-                  io $ fillRectangles d w' gc [Rectangle 0 0 wt ht]
-                  io $ setForeground d gc tc
-                  centerText d w' gc fn r (show nw)
-           centerText d w' gc fontst (Rectangle _ _ wt ht) name =
-               do let (_,asc,_,_) = textExtents fontst name
-                      name' = shrinkWhile shr (\n -> textWidth fontst n >
-                                                     fromIntegral wt - fromIntegral (ht `div` 2)) name
-                      width = textWidth fontst name'
-                  io $ drawString d w' gc
-                         (fromIntegral (wt `div` 2) - fromIntegral (width `div` 2))
-                         ((fromIntegral ht + fromIntegral asc) `div` 2) name'
-       l' <- make_tabs tws $ tabbed shr conf
-       return (map (\w -> (w,shrink conf sc)) ws, Just l')
-
-type Shrinker = String -> [String]
-
-shrinkWhile :: Shrinker -> (String -> Bool) -> String -> String
-shrinkWhile sh p x = sw $ sh x
-    where sw [n] = n
-          sw [] = ""
-          sw (n:ns) | p n = sw ns
-                    | otherwise = n
-
-shrinkText :: Shrinker
-shrinkText "" = [""]
-shrinkText cs = cs : shrinkText (init cs)
-
-shrink :: TConf -> Rectangle -> Rectangle
-shrink c (Rectangle x y w h) = Rectangle x (y + fromIntegral (tabSize c)) w (h - fromIntegral (tabSize c))
-
-gentabs :: TConf -> Position -> Position -> Dimension -> Int -> [Rectangle]
-gentabs _ _ _ _ 0 = []
-gentabs c x y w num = Rectangle x y (wid - 2) (fromIntegral (tabSize c) - 2)
-                      : gentabs c (x + fromIntegral wid) y (w - wid) (num - 1)
-                          where wid = w `div` (fromIntegral num)

ThreeColumns.hs

@@ -1,72 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.ThreeColumns
--- Copyright   :  (c) Kai Grossjohann <kai@emptydomain.de>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  ?
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout similar to tall but with three columns.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.ThreeColumns (
-                              -- * Usage
-                              -- $usage
-                              threeCol
-                             ) where
-
-import XMonad
-import qualified StackSet as W
-import Operations ( Resize(..), IncMasterN(..), splitVertically, splitHorizontallyBy )
-
-import Data.Ratio
-
---import Control.Monad.State
-import Control.Monad.Reader
-
-import Graphics.X11.Xlib
-
--- $usage
---
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.ThreeColumns
---
---  and add, to the list of layouts:
---
--- > threeCol
-
-threeCol :: Int -> Rational -> Rational -> Layout a
-threeCol nmaster delta frac =
-    Layout { doLayout     = \r -> return . (\x->(x,Nothing)) .
-                                  ap zip (tile3 frac r nmaster . length) . W.integrate
-           , modifyLayout = \m -> return $ msum [fmap resize     (fromMessage m)
-                                                ,fmap incmastern (fromMessage m)] }
-
-    where resize Shrink = threeCol nmaster delta (max 0 $ frac-delta)
-          resize Expand = threeCol nmaster delta (min 1 $ frac+delta)
-          incmastern (IncMasterN d) = threeCol (max 0 (nmaster+d)) delta frac
-
--- | tile3.  Compute window positions using 3 panes
-tile3 :: Rational -> Rectangle -> Int -> Int -> [Rectangle]
-tile3 f r nmaster n 
-    | n <= nmaster || nmaster == 0 = splitVertically n r
-    | n <= nmaster+1 = splitVertically nmaster s1 ++ splitVertically (n-nmaster) s2
-    | otherwise = splitVertically nmaster r1 ++ splitVertically nmid r2 ++ splitVertically nright r3
-  where (r1, r2, r3) = split3HorizontallyBy f r
-        (s1, s2) = splitHorizontallyBy f r
-        nslave = (n - nmaster)
-        nmid = ceiling (nslave % 2)
-        nright = (n - nmaster - nmid)
-
-split3HorizontallyBy :: Rational -> Rectangle -> (Rectangle, Rectangle, Rectangle)
-split3HorizontallyBy f (Rectangle sx sy sw sh) =
-    ( Rectangle sx sy leftw sh
-    , Rectangle (sx + fromIntegral leftw) sy midw sh
-    , Rectangle (sx + fromIntegral leftw + fromIntegral midw) sy rightw sh )
-  where leftw = ceiling $ fromIntegral sw * (2/3) * f
-        midw = ceiling ( (sw - leftw) % 2 )
-        rightw = sw - leftw - midw

TwoPane.hs

@@ -1,50 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.TwoPane
--- Copyright   :  (c) Spencer Janssen <sjanssen@cse.unl.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Spencer Janssen <sjanssen@cse.unl.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A layout that splits the screen horizontally and shows two windows.  The
--- left window is always the master window, and the right is either the
--- currently focused window or the second window in layout order.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.TwoPane (
-                              -- * Usage
-                              -- $usage
-                              twoPane
-                             ) where
-
-import XMonad
-import Operations ( Resize(..), splitHorizontallyBy )
-import StackSet ( focus, up, down)
-
--- $usage
---
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.TwoPane
---
---  and add, to the list of layouts:
---
--- > twoPane defaultDelta (1%2)
-
-twoPane :: Rational -> Rational -> Layout a
-twoPane delta split = Layout { doLayout = \r s -> return (arrange r s,Nothing), modifyLayout = message }
- where
-    arrange rect st = case reverse (up st) of
-                        (master:_) -> [(master,left),(focus st,right)]
-                        [] -> case down st of
-                                (next:_) -> [(focus st,left),(next,right)]
-                                [] -> [(focus st, rect)]
-        where (left, right) = splitHorizontallyBy split rect
-
-    message x = return $ case fromMessage x of
-                    Just Shrink -> Just (twoPane delta (split - delta))
-                    Just Expand -> Just (twoPane delta (split + delta))
-                    _           -> Nothing

ViewPrev.hs

@@ -1,28 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.ViewPrev
--- Copyright   :  (c) Nelson Elhage <nelhage@mit.edu>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  Nelson Elhage <nelhage@mit.edu>
--- Stability   :  unstable
--- Portability :  unportable
---
--- A module that implements a command to switch to the previously
--- viewed workspace
---
------------------------------------------------------------------------------
-
-module XMonadContrib.ViewPrev (
-                               viewPrev
-                              ) where
-
-import XMonad
-import Operations 
-import qualified StackSet as W
-
-viewPrev' :: (Eq a, Eq s, Eq i) => W.StackSet i a s sd -> W.StackSet i a s sd
-viewPrev' x = W.view (W.tag . head . W.hidden $ x) x
-
-viewPrev :: X ()
-viewPrev = windows viewPrev'

Warp.hs

@@ -1,71 +0,0 @@
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.Warp
--- Copyright   :  (c) daniel@wagner-home.com
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  daniel@wagner-home.com
--- Stability   :  unstable
--- Portability :  unportable
---
--- This can be used to make a keybinding that warps the pointer to a given
--- window or screen.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.Warp (
-                           -- * Usage
-                           -- $usage
-                           warpToScreen, 
-                           warpToWindow
-                          ) where
-
-import Data.Ratio
-import Data.Maybe
-import Data.List
-import Control.Monad.RWS
-import Graphics.X11.Xlib
-import Graphics.X11.Xlib.Extras
-import Operations
-import XMonad
-import StackSet as W
-
-{- $usage
-This can be used to make a keybinding that warps the pointer to a given
-window or screen.  For example, I've added the following keybindings to
-my Config.hs:
-
-> , ((modMask,   xK_z     ), warpToWindow (1%2) (1%2)) -- @@ Move pointer to currently focused window
-> 
->-- mod-ctrl-{w,e,r} @@ Move mouse pointer to screen 1, 2, or 3
->   
->   [((modMask .|. controlMask, key), warpToScreen sc (1%2) (1%2))
->       | (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]]
-
-Note that warping to a particular screen may change the focus.
--}
-
-fraction :: (Integral a, Integral b) => Rational -> a -> b
-fraction f x = floor (f * fromIntegral x)
-
-ix :: Int -> [a] -> Maybe a
-ix n = listToMaybe . take 1 . drop n
-
-warp :: Window -> Position -> Position -> X ()
-warp w x y = withDisplay $ \d -> io $ warpPointer d none w 0 0 0 0 x y
-
-warpToWindow :: Rational -> Rational -> X ()
-warpToWindow h v =
-    withDisplay $ \d ->
-        withFocused $ \w -> do
-            wa <- io $ getWindowAttributes d w
-            warp w (fraction h (wa_width wa)) (fraction v (wa_height wa))
-
-warpToScreen :: ScreenId -> Rational -> Rational -> X ()
-warpToScreen n h v = do
-    root <- asks theRoot
-    (StackSet {current = x, visible = xs}) <- gets windowset
-    whenJust (fmap (screenRect . W.screenDetail) . find ((n==) . W.screen) $ x : xs)
-        $ \r ->
-            warp root (rect_x r + fraction h (rect_width  r))
-                      (rect_y r + fraction v (rect_height r))

WorkspaceDir.hs

@@ -1,64 +0,0 @@
-{-# OPTIONS -fglasgow-exts #-}
------------------------------------------------------------------------------
--- |
--- Module      :  XMonadContrib.WorkspaceDir
--- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>
--- License     :  BSD3-style (see LICENSE)
--- 
--- Maintainer  :  David Roundy <droundy@darcs.net>
--- Stability   :  unstable
--- Portability :  unportable
---
--- WorkspaceDir is an exstension to set the current directory in a workspace.
---
--- Actually, it sets the current directory in a layout, since there's no way I
--- know of to attach a behavior to a workspace.  This means that any terminals
--- (or other programs) pulled up in that workspace (with that layout) will
--- execute in that working directory.  Sort of handy, I think.
---
------------------------------------------------------------------------------
-
-module XMonadContrib.WorkspaceDir ( 
-                                   -- * Usage
-                                   -- $usage
-                                   workspaceDir, 
-                                   changeDir
-                                  ) where
-
-import System.Directory ( setCurrentDirectory )
-
-import XMonad
-import Operations ( sendMessage )
-import XMonadContrib.Dmenu ( runProcessWithInput )
-import XMonadContrib.XPrompt ( XPConfig )
-import XMonadContrib.DirectoryPrompt ( directoryPrompt )
-import XMonadContrib.LayoutHelpers ( layoutModify )
-import XMonadContrib.XPrompt ( defaultXPConfig )
-
--- $usage
--- You can use this module with the following in your Config.hs file:
---
--- > import XMonadContrib.WorkspaceDir
--- >
--- > defaultLayouts = map (workspaceDir "~") [ tiled, ... ]
---
--- In keybindings:
---
--- >  , ((modMask .|. shiftMask, xK_x     ), changeDir defaultXPConfig)
-
-
-data Chdir = Chdir String deriving ( Typeable )
-instance Message Chdir
-
-workspaceDir :: String -> Layout a -> Layout a
-workspaceDir wd = layoutModify dowd modwd
-    where dowd _ _ rws = scd wd >> return (rws, Nothing)
-          modwd m = return $ do Chdir wd' <- fromMessage m
-                                Just $ workspaceDir wd'
-
-scd :: String -> X ()
-scd x = do x' <- io (runProcessWithInput "bash" [] ("echo -n " ++ x) `catch` \_ -> return x)
-           catchIO $ setCurrentDirectory x'
-
-changeDir :: XPConfig -> X ()
-changeDir c = directoryPrompt c "Set working directory: " (sendMessage . Chdir)

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

@@ -0,0 +1,83 @@
+----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.BluetileCommands
+-- Copyright   :  (c) Jan Vornberger 2009
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
+-- Stability   :  unstable
+-- Portability :  not portable
+--
+-- This is a list of selected commands that can be made available using
+-- "XMonad.Hooks.ServerMode" to allow external programs to control
+-- the window manager. Bluetile (<http://projects.haskell.org/bluetile/>)
+-- uses this to enable its dock application to do things like changing
+-- workspaces and layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.BluetileCommands (
+    -- * Usage
+    -- $usage
+    bluetileCommands
+    ) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Layout.LayoutCombinators
+import System.Exit
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Hooks.ServerMode
+-- >    import XMonad.Actions.BluetileCommands
+--
+-- Then edit your @handleEventHook@:
+--
+-- > 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.
+
+workspaceCommands :: Int -> X [(String, X ())]
+workspaceCommands sid = asks (workspaces . config) >>= \spaces -> return
+                            [(("greedyView" ++ show i),
+                                activateScreen sid >> windows (W.greedyView i))
+                                | i <- spaces ]
+
+layoutCommands :: Int -> [(String, X ())]
+layoutCommands sid = [ ("layout floating"    , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Floating"))
+                     , ("layout tiled1"      , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Tiled1"))
+                     , ("layout tiled2"      , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Tiled2"))
+                     , ("layout fullscreen"  , activateScreen sid >>
+                                                    sendMessage (JumpToLayout "Fullscreen"))
+                     ]
+
+masterAreaCommands :: Int -> [(String, X ())]
+masterAreaCommands sid = [ ("increase master n", activateScreen sid >>
+                                                    sendMessage (IncMasterN 1))
+                         , ("decrease master n", activateScreen sid >>
+                                                    sendMessage (IncMasterN (-1)))
+                         ]
+
+quitCommands :: [(String, X ())]
+quitCommands = [ ("quit bluetile", io (exitWith ExitSuccess))
+               , ("quit bluetile and start metacity", restart "metacity" False)
+               ]
+
+bluetileCommands :: X [(String, X ())]
+bluetileCommands = do
+    let restartCommand = [ ("restart bluetile", restart "bluetile" True) ]
+    wscmds0 <- workspaceCommands 0
+    wscmds1 <- workspaceCommands 1
+    return $ restartCommand
+                ++ wscmds0 ++ layoutCommands 0 ++ masterAreaCommands 0 ++ quitCommands
+                ++ wscmds1 ++ layoutCommands 1 ++ masterAreaCommands 1 ++ quitCommands
+
+activateScreen :: Int -> X ()
+activateScreen sid = screenWorkspace (S sid) >>= flip whenJust (windows . W.view)

XMonad/Actions/Commands.hs

@@ -0,0 +1,127 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Commands
+-- Copyright   :  (c) David Glasser 2007
+-- License     :  BSD3
+--
+-- Maintainer  :  glasser@mit.edu
+-- Stability   :  stable
+-- Portability :  portable
+--
+-- Allows you to run internal xmonad commands (X () actions) using
+-- a dmenu menu in addition to key bindings.  Requires dmenu and
+-- the Dmenu XMonad.Actions module.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Commands (
+                             -- * Usage
+                             -- $usage
+                             commandMap,
+                             runCommand,
+                             runCommandConfig,
+                             runCommand',
+                             workspaceCommands,
+                             screenCommands,
+                             defaultCommands
+                              ) where
+
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+import XMonad.Util.Dmenu (dmenu)
+
+import qualified Data.Map as M
+import System.Exit
+import Data.Maybe
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.Commands
+--
+-- Then add a keybinding to the runCommand action:
+--
+-- >    , ((modm .|. controlMask, xK_y), commands >>= runCommand)
+--
+-- and define the list of commands you want to use:
+--
+-- >    commands :: X [(String, X ())]
+-- >    commands = defaultCommands
+--
+-- Whatever key you bound to will now cause a popup menu of internal
+-- xmonad commands to appear.  You can change the commands by changing
+-- the contents of the list returned by 'commands'.  (If you like it
+-- enough, you may even want to get rid of many of your other key
+-- bindings!)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
+--   list of pairs.
+commandMap :: [(String, X ())] -> M.Map String (X ())
+commandMap c = M.fromList c
+
+-- | Generate a list of commands to switch to\/send windows to workspaces.
+workspaceCommands :: X [(String, X ())]
+workspaceCommands = asks (workspaces . config) >>= \spaces -> return
+                            [((m ++ show i), windows $ f i)
+                                | i <- spaces
+                                , (f, m) <- [(view, "view"), (shift, "shift")] ]
+
+-- | Generate a list of commands dealing with multiple screens.
+screenCommands :: [(String, X ())]
+screenCommands = [((m ++ show sc), screenWorkspace (fromIntegral sc) >>= flip whenJust (windows . f))
+                      | sc <- [0, 1]::[Int] -- TODO: adapt to screen changes
+                      , (f, m) <- [(view, "screen"), (shift, "screen-to-")]
+                 ]
+
+-- | A nice pre-defined list of commands.
+defaultCommands :: X [(String, X ())]
+defaultCommands = do
+    wscmds <- workspaceCommands
+    return $ wscmds ++ screenCommands ++ otherCommands
+ where
+    otherCommands =
+        [ ("shrink"              , sendMessage Shrink                               )
+        , ("expand"              , sendMessage Expand                               )
+        , ("next-layout"         , sendMessage NextLayout                           )
+        , ("default-layout"      , asks (layoutHook . config) >>= setLayout         )
+        , ("restart-wm"          , restart "xmonad" True                            )
+        , ("restart-wm-no-resume", restart "xmonad" False                           )
+        , ("xterm"               , spawn =<< asks (terminal .  config)              )
+        , ("run"                 , spawn "exe=`dmenu_path | dmenu -b` && exec $exe" )
+        , ("kill"                , kill                                             )
+        , ("refresh"             , refresh                                          )
+        , ("focus-up"            , windows focusUp                                  )
+        , ("focus-down"          , windows focusDown                                )
+        , ("swap-up"             , windows swapUp                                   )
+        , ("swap-down"           , windows swapDown                                 )
+        , ("swap-master"         , windows swapMaster                               )
+        , ("sink"                , withFocused $ windows . sink                     )
+        , ("quit-wm"             , io $ exitWith ExitSuccess                        )
+        ]
+
+-- | Given a list of command\/action pairs, prompt the user to choose a
+--   command using dmenu and return the corresponding action.
+runCommand :: [(String, X ())] -> X ()
+runCommand = runCommandConfig dmenu
+
+
+-- | Given a list of command\/action pairs, prompt the user to choose a
+--   command using dmenu-compatible launcher and return the corresponding action.
+--   See X.U.Dmenu for compatible launchers.
+runCommandConfig :: ([String] -> X String) -> [(String, X ())] -> X()
+runCommandConfig f cl = do
+  let m = commandMap cl
+  choice <- f (M.keys m)
+  fromMaybe (return ()) (M.lookup choice m)
+
+-- | Given the name of a command from 'defaultCommands', return the
+--   corresponding action (or the null action if the command is not
+--   found).
+runCommand' :: String -> X ()
+runCommand' c = do
+  m <- fmap commandMap defaultCommands
+  fromMaybe (return ()) (M.lookup c m)

XMonad/Actions/ConstrainedResize.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.ConstrainedResize
+-- Copyright   :  (c) Dougal Stanton
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <dougal@dougalstanton.net>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Lets you constrain the aspect ratio of a floating
+-- window (by, say, holding shift while you resize).
+--
+-- Useful for making a nice circular XClock window.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.ConstrainedResize (
+        -- * Usage
+        -- $usage
+        XMonad.Actions.ConstrainedResize.mouseResizeWindow
+) where
+
+import XMonad
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import qualified XMonad.Actions.ConstrainedResize as Sqr
+--
+-- Then add something like the following to your mouse bindings:
+--
+-- >     , ((modm, button3),               (\w -> focus w >> Sqr.mouseResizeWindow w False))
+-- >     , ((modm .|. shiftMask, button3), (\w -> focus w >> Sqr.mouseResizeWindow w True ))
+--
+-- The line without the shiftMask replaces the standard mouse resize
+-- function call, so it's not completely necessary but seems neater
+-- this way.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+-- | Resize (floating) window with optional aspect ratio constraints.
+mouseResizeWindow :: Window -> Bool -> X ()
+mouseResizeWindow w c = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
+    mouseDrag (\ex ey -> do
+                 let x = ex - fromIntegral (wa_x wa)
+                     y = ey - fromIntegral (wa_y wa)
+                     sz = if c then (max x y, max x y) else (x,y)
+                 io $ resizeWindow d w `uncurry`
+                    applySizeHintsContents sh sz)
+              (float w)

XMonad/Actions/CopyWindow.hs

@@ -0,0 +1,165 @@
+{-# LANGUAGE PatternGuards #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CopyWindow
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>, Ivan Veselov <veselov@gmail.com>, Lanny Ripple <lan3ny@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  ???
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to duplicate a window on multiple workspaces,
+-- providing dwm-like tagging functionality.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CopyWindow (
+                                 -- * Usage
+                                 -- $usage
+                                 copy, copyToAll, copyWindow, runOrCopy
+                                 , killAllOtherCopies, kill1
+                                 -- * Highlight workspaces containing copies in logHook
+                                 -- $logHook
+                                 , wsContainingCopies
+                                ) where
+
+import XMonad
+import Control.Arrow ((&&&))
+import qualified Data.List as L
+
+import XMonad.Actions.WindowGo
+import qualified XMonad.StackSet as W
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CopyWindow
+--
+-- Then add something like this to your keybindings:
+--
+-- > -- mod-[1..9] @@ Switch to workspace N
+-- > -- mod-shift-[1..9] @@ Move client to workspace N
+-- > -- mod-control-shift-[1..9] @@ Copy client to workspace N
+-- > [((m .|. modm, k), windows $ f i)
+-- >     | (i, k) <- zip (workspaces x) [xK_1 ..]
+-- >     , (f, m) <- [(W.view, 0), (W.shift, shiftMask), (copy, shiftMask .|. controlMask)]]
+--
+-- To use the above key bindings you need also to import
+-- "XMonad.StackSet":
+--
+-- > import qualified XMonad.StackSet as W
+--
+-- You may also wish to redefine the binding to kill a window so it only
+-- removes it from the current workspace, if it's present elsewhere:
+--
+-- >  , ((modm .|. shiftMask, xK_c     ), kill1) -- @@ Close the focused window
+--
+-- Instead of copying a window from one workspace to another maybe you don't
+-- want to have to remember where you placed it.  For that consider:
+--
+-- >  , ((modm, xK_b    ), runOrCopy "firefox" (className =? "Firefox")) -- @@ run or copy firefox
+--
+-- Another possibility which this extension provides is 'making window
+-- always visible' (i.e. always on current workspace), similar to corresponding
+-- metacity functionality. This behaviour is emulated through copying given
+-- window to all the workspaces and then removing it when it's unneeded on
+-- all workspaces any more.
+--
+-- Here is the example of keybindings which provide these actions:
+--
+-- >  , ((modm, xK_v ), windows copyToAll) -- @@ Make focused window always visible
+-- >  , ((modm .|. shiftMask, xK_v ),  killAllOtherCopies) -- @@ Toggle window state back
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- $logHook
+-- To distinguish workspaces containing copies of the focused window use
+-- something like:
+--
+-- > sampleLogHook h = do
+-- >    copies <- wsContainingCopies
+-- >    let check ws | ws `elem` copies = pad . xmobarColor "red" "black" $ ws
+-- >                 | otherwise = pad ws
+-- >    dynamicLogWithPP myPP {ppHidden = check, ppOutput = hPutStrLn h}
+-- >
+-- > main = do
+-- >    h <- spawnPipe "xmobar"
+-- >    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
+copy n s | Just w <- W.peek s = copyWindow w n s
+         | otherwise = s
+
+-- | Copy the focused window to all workspaces.
+copyToAll :: (Eq s, Eq i, Eq a) => W.StackSet i l a s sd -> W.StackSet i l a s sd
+copyToAll s = foldr copy s $ map W.tag (W.workspaces s)
+
+-- | Copy an arbitrary window to a workspace.
+copyWindow :: (Eq a, Eq i, Eq s) => a -> i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
+copyWindow w n = copy'
+    where copy' s = if n `W.tagMember` s
+                    then W.view (W.currentTag s) $ insertUp' w $ W.view n s
+                    else s
+          insertUp' a s = W.modify (Just $ W.Stack a [] [])
+                          (\(W.Stack t l r) -> if a `elem` t:l++r
+                                             then Just $ W.Stack t l r
+                                             else Just $ W.Stack a (L.delete a l) (L.delete a (t:r))) s
+
+
+-- | runOrCopy will run the provided shell command unless it can
+--  find a specified window in which case it will copy the window to
+--  the current workspace.  Similar to (i.e., stolen from) "XMonad.Actions.WindowGo".
+runOrCopy :: String -> Query Bool -> X ()
+runOrCopy = copyMaybe . spawn
+
+-- | Copy a window if it exists, run the first argument otherwise.
+copyMaybe :: X () -> Query Bool -> X ()
+copyMaybe f qry = ifWindow qry copyWin f
+    where copyWin = ask >>= \w -> doF (\ws -> copyWindow w (W.currentTag ws) ws)
+
+-- | Remove the focused window from this workspace.  If it's present in no
+-- other workspace, then kill it instead. If we do kill it, we'll get a
+-- delete notify back from X.
+--
+-- There are two ways to delete a window. Either just kill it, or if it
+-- supports the delete protocol, send a delete event (e.g. firefox).
+kill1 :: X ()
+kill1 = do ss <- gets windowset
+           whenJust (W.peek ss) $ \w -> if W.member w $ delete'' w ss
+                                      then windows $ delete'' w
+                                      else kill
+    where delete'' w = W.modify Nothing (W.filter (/= w))
+
+-- | Kill all other copies of focused window (if they're present).
+-- 'All other' means here 'copies which are not on the current workspace'.
+killAllOtherCopies :: X ()
+killAllOtherCopies = do ss <- gets windowset
+                        whenJust (W.peek ss) $ \w -> windows $
+                                                   W.view (W.currentTag ss) .
+                                                   delFromAllButCurrent w
+    where
+      delFromAllButCurrent w ss = foldr ($) ss $
+                                  map (delWinFromWorkspace w . W.tag) $
+                                  W.hidden ss ++ map W.workspace (W.visible ss)
+      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]
+wsContainingCopies = do
+    ws <- gets windowset
+    return $ copiesOfOn (W.peek ws) (taggedWindows $ W.hidden ws)
+
+-- | Get a list of tuples (tag, [Window]) for each workspace.
+taggedWindows :: [W.Workspace i l a] -> [(i, [a])]
+taggedWindows = map $ W.tag &&& W.integrate' . W.stack
+
+-- | Get tags with copies of the focused window (if present.)
+copiesOfOn :: (Eq a) => Maybe a -> [(i, [a])] -> [i]
+copiesOfOn foc tw = maybe [] hasCopyOf foc
+  where hasCopyOf f = map fst $ filter ((f `elem` ) . snd) tw

XMonad/Actions/CycleRecentWS.hs

@@ -0,0 +1,85 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleRecentWS
+-- Copyright   :  (c) Michal Janeczek <janeczek@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Michal Janeczek <janeczek@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to cycle through most recently used workspaces
+-- with repeated presses of a single key (as long as modifier key is
+-- held down). This is similar to how many window managers handle
+-- window switching.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleRecentWS (
+                                -- * Usage
+                                -- $usage
+                                cycleRecentWS,
+                                cycleWindowSets
+) where
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleRecentWS
+-- >
+-- >   , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Cycle through most recent workspaces with repeated presses of a key, while
+--   a modifier key is held down. The recency of workspaces previewed while browsing
+--   to the target workspace is not affected. That way a stack of most recently used
+--   workspaces is maintained, similarly to how many window managers handle window
+--   switching. For best effects use the same modkey+key combination as the one used
+--   to invoke this action.
+cycleRecentWS :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                          --   As soon as one of them is released, the final switch is made.
+              -> KeySym   -- ^ Key used to switch to next (less recent) workspace.
+              -> KeySym   -- ^ Key used to switch to previous (more recent) workspace.
+                          --   If it's the same as the nextWorkspace key, it is effectively ignored.
+              -> X ()
+cycleRecentWS = cycleWindowSets options
+ where options w = map (view `flip` w) (recentTags w)
+       recentTags w = map tag $ tail (workspaces w) ++ [head (workspaces w)]
+
+
+cycref :: [a] -> Int -> a
+cycref l i = l !! (i `mod` length l)
+
+-- | Cycle through a finite list of WindowSets with repeated presses of a key, while
+--   a modifier key is held down. For best effects use the same modkey+key combination
+--   as the one used to invoke this action.
+cycleWindowSets :: (WindowSet -> [WindowSet]) -- ^ A function used to create a list of WindowSets to choose from
+                -> [KeySym]                   -- ^ A list of modifier keys used when invoking this action.
+                                              --   As soon as one of them is released, the final WindowSet is chosen and the action exits.
+                -> KeySym                     -- ^ Key used to preview next WindowSet from the list of generated options
+                -> KeySym                     -- ^ Key used to preview previous WindowSet from the list of generated options.
+                                              --   If it's the same as nextOption key, it is effectively ignored.
+                -> X ()
+cycleWindowSets genOptions mods keyNext keyPrev = do
+  options <- gets $ genOptions . windowset
+  XConf {theRoot = root, display = d} <- ask
+  let event = allocaXEvent $ \p -> do
+                maskEvent d (keyPressMask .|. keyReleaseMask) p
+                KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                s <- keycodeToKeysym d c 0
+                return (t, s)
+  let setOption n = do windows $ const $ options `cycref` n
+                       (t, s) <- io event
+                       case () of
+                         () | t == keyPress   && s == keyNext  -> setOption (n+1)
+                            | t == keyPress   && s == keyPrev  -> setOption (n-1)
+                            | t == keyRelease && s `elem` mods -> return ()
+                            | otherwise                        -> setOption n
+  io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+  setOption 0
+  io $ ungrabKeyboard d currentTime

XMonad/Actions/CycleSelectedLayouts.hs

@@ -0,0 +1,51 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleSelectedLayouts
+-- Copyright   :  (c) Roman Cheplyaka
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module allows to cycle through the given subset of layouts.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleSelectedLayouts (
+    -- * Usage
+    -- $usage
+    cycleThroughLayouts) where
+
+import XMonad
+import Data.List (findIndex)
+import Data.Maybe (fromMaybe)
+import XMonad.Layout.LayoutCombinators (JumpToLayout(..))
+import qualified XMonad.StackSet as S
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad hiding ((|||))
+-- > import XMonad.Layout.LayoutCombinators ((|||))
+-- > import XMonad.Actions.CycleSelectedLayouts
+--
+-- >   , ((modm,  xK_t ),   cycleThroughLayouts ["Tall", "Mirror Tall"])
+--
+-- Make sure you are using NewSelect from XMonad.Layout.LayoutCombinators,
+-- rather than the Select defined in xmonad core.
+
+cycleToNext :: (Eq a) => [a] -> a -> Maybe a
+cycleToNext lst a = do
+    -- not beautiful but simple and readable
+    ind <- findIndex (a==) lst
+    return $ lst !! if ind == length lst - 1 then 0 else ind+1
+
+-- | If the current layout is in the list, cycle to the next layout. Otherwise,
+--   apply the first layout from list.
+cycleThroughLayouts :: [String] -> X ()
+cycleThroughLayouts lst = do
+    winset <- gets windowset
+    let ld = description . S.layout . S.workspace . S.current $ winset
+    let newld = fromMaybe (head lst) (cycleToNext lst ld)
+    sendMessage $ JumpToLayout newld

XMonad/Actions/CycleWS.hs

@@ -0,0 +1,386 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.CycleWS
+-- Copyright   :  (c) Joachim Breitner <mail@joachim-breitner.de>,
+--                    Nelson Elhage <nelhage@mit.edu> (`toggleWS' function)
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Joachim Breitner <mail@joachim-breitner.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to cycle forward or backward through the list of
+-- workspaces, to move windows between workspaces, and to cycle
+-- between screens.  More general combinators provide ways to cycle
+-- through workspaces in various orders, to only cycle through some
+-- subset of workspaces, and to cycle by more than one workspace at a
+-- time.
+--
+-- Note that this module now subsumes the functionality of the former
+-- @XMonad.Actions.RotView@.  Former users of @rotView@ can simply replace
+-- @rotView True@ with @moveTo Next NonEmptyWS@, and so on.
+--
+-- If you want to exactly replicate the action of @rotView@ (cycling
+-- through workspace in order lexicographically by tag, instead of in
+-- the order specified in the config), it can be implemented as:
+--
+-- > rotView b  = do t <- findWorkspace getSortByTag (bToDir b) NonEmptyWS 1
+-- >                 windows . greedyView $ t
+-- >   where bToDir True  = Next
+-- >         bToDir False = Prev
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.CycleWS (
+                                -- * Usage
+                                -- $usage
+
+                                -- * Moving between workspaces
+                                -- $moving
+
+                                nextWS
+                              , prevWS
+                              , shiftToNext
+                              , shiftToPrev
+
+                                -- * Toggling the previous workspace
+                                -- $toggling
+                              , toggleWS
+                              , toggleWS'
+                              , toggleOrView
+
+                                -- * Moving between screens (xinerama)
+
+                              , nextScreen
+                              , prevScreen
+                              , shiftNextScreen
+                              , shiftPrevScreen
+                              , swapNextScreen
+                              , swapPrevScreen
+
+                                -- * Moving between workspaces, take two!
+                                -- $taketwo
+
+                              , Direction1D(..)
+                              , WSType(..)
+
+                              , shiftTo
+                              , moveTo
+                              , doTo
+
+                                -- * The mother-combinator
+
+                              , findWorkspace
+                              , toggleOrDoSkip
+                              , skipTags
+
+                              , screenBy
+
+                             ) where
+
+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
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleWS
+-- >
+-- > -- a basic CycleWS setup
+-- >
+-- >   , ((modm,               xK_Down),  nextWS)
+-- >   , ((modm,               xK_Up),    prevWS)
+-- >   , ((modm .|. shiftMask, xK_Down),  shiftToNext)
+-- >   , ((modm .|. shiftMask, xK_Up),    shiftToPrev)
+-- >   , ((modm,               xK_Right), nextScreen)
+-- >   , ((modm,               xK_Left),  prevScreen)
+-- >   , ((modm .|. shiftMask, xK_Right), shiftNextScreen)
+-- >   , ((modm .|. shiftMask, xK_Left),  shiftPrevScreen)
+-- >   , ((modm,               xK_z),     toggleWS)
+--
+-- If you want to follow the moved window, you can use both actions:
+--
+-- >   , ((modm .|. shiftMask, xK_Down), shiftToNext >> nextWS)
+-- >   , ((modm .|. shiftMask, xK_Up),   shiftToPrev >> prevWS)
+--
+-- You can also get fancier with 'moveTo', 'shiftTo', and 'findWorkspace'.
+-- For example:
+--
+-- >   , ((modm     , xK_f), moveTo Next EmptyWS)  -- find a free workspace
+-- >   , ((modm .|. controlMask, xK_Right),        -- a crazy keybinding!
+-- >         do t <- findWorkspace getSortByXineramaRule Next NonEmptyWS 2
+-- >            windows . view $ t                                         )
+--
+-- 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
+
+The following commands for moving the view and windows between
+workspaces are somewhat inflexible, but are very simple and probably
+Do The Right Thing for most users.
+
+All of the commands in this section cycle through workspaces in the
+order in which they are given in your config.
+
+-}
+
+-- | Switch to the next workspace.
+nextWS :: X ()
+nextWS = switchWorkspace 1
+
+-- | Switch to the previous workspace.
+prevWS :: X ()
+prevWS = switchWorkspace (-1)
+
+-- | Move the focused window to the next workspace.
+shiftToNext :: X ()
+shiftToNext = shiftBy 1
+
+-- | Move the focused window to the previous workspace.
+shiftToPrev :: X ()
+shiftToPrev = shiftBy (-1)
+
+-- $toggling
+
+-- | Toggle to the workspace displayed previously.
+toggleWS :: X ()
+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
+-- @toggleOrView@ in your workspace bindings as in the 'XMonad.StackSet.view'
+-- faq at <http://haskell.org/haskellwiki/Xmonad/Frequently_asked_questions>.
+-- For more flexibility see 'toggleOrDoSkip'.
+toggleOrView :: WorkspaceId -> X ()
+toggleOrView = toggleOrDoSkip [] greedyView
+
+-- | 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
+-- >
+-- > -- toggleOrView for people who prefer view to greedyView
+-- > toggleOrView' = toggleOrDoSkip [] W.view
+-- >
+-- > -- toggleOrView ignoring scratchpad and named scratchpad workspace
+-- > toggleOrViewNoSP = toggleOrDoSkip ["NSP"] W.greedyView
+toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
+                                  -> WorkspaceId -> X ()
+toggleOrDoSkip skips f toWS = do
+    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
+-- matching listed tags from the given workspace list.
+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
+
+shiftBy :: Int -> X ()
+shiftBy d = wsBy d >>= windows . shift
+
+wsBy :: Int -> X (WorkspaceId)
+wsBy = findWorkspace getSortByIndex Next AnyWS
+
+{- $taketwo
+
+A few more general commands are also provided, which allow cycling
+through subsets of workspaces.
+
+For example,
+
+>   moveTo Next EmptyWS
+
+will move to the first available workspace with no windows, and
+
+>   shiftTo Prev (WSIs $ return (('p' `elem`) . tag))
+
+will move the focused window backwards to the first workspace containing
+the letter 'p' in its name. =)
+
+-}
+
+-- | What type of workspaces should be included in the cycle?
+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
+                          --   group name is all characters up to the first
+                          --   separator character or the end of the tag
+            | WSIs (X (WindowSpace -> Bool))
+                          -- ^ cycle through workspaces satisfying
+                          --   an arbitrary predicate
+
+-- | Convert a WSType value to a predicate on workspaces.
+wsTypeToPred :: WSType -> X (WindowSpace -> Bool)
+wsTypeToPred EmptyWS    = return (isNothing . stack)
+wsTypeToPred NonEmptyWS = return (isJust . stack)
+wsTypeToPred HiddenWS   = do hs <- gets (map tag . hidden . windowset)
+                             return (\w -> tag w `elem` hs)
+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
+                                   where groupName = takeWhile (/=sep).tag
+wsTypeToPred (WSIs p)   = p
+
+-- | View the next workspace in the given direction that satisfies
+--   the given condition.
+moveTo :: Direction1D -> WSType -> X ()
+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 = 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
+--   the workspace which is @n@ away from the current workspace in
+--   direction @dir@ (wrapping around if necessary), among those
+--   workspaces, sorted by @s@, which satisfy @p@.
+--
+--   For some useful workspace sorting functions, see
+--   "XMonad.Util.WorkspaceCompare".
+--
+--   For ideas of what to do with a workspace tag once obtained, note
+--   that 'moveTo' and 'shiftTo' are implemented by applying @(>>=
+--   (windows . greedyView))@ and @(>>= (windows . shift))@, respectively,
+--   to the output of 'findWorkspace'.
+findWorkspace :: X WorkspaceSort -> Direction1D -> WSType -> Int -> X WorkspaceId
+findWorkspace s dir t n = findWorkspaceGen s (wsTypeToPred t) (maybeNegate dir n)
+  where
+    maybeNegate Next d = d
+    maybeNegate Prev d = (-d)
+
+findWorkspaceGen :: X WorkspaceSort -> X (WindowSpace -> Bool) -> Int -> X WorkspaceId
+findWorkspaceGen _ _ 0 = gets (currentTag . windowset)
+findWorkspaceGen sortX wsPredX d = do
+    wsPred <- wsPredX
+    sort   <- sortX
+    ws     <- gets windowset
+    let cur     = workspace (current ws)
+        sorted  = sort (workspaces ws)
+        pivoted = let (a,b) = span ((/= (tag cur)) . tag) sorted in b ++ a
+        ws'     = filter wsPred pivoted
+        mCurIx  = findWsIndex cur ws'
+        d'      = if d > 0 then d - 1 else d
+        next    = if null ws'
+                      then cur
+                      else case mCurIx of
+                            Nothing -> ws' !! (d' `mod` length ws')
+                            Just ix -> ws' !! ((ix + d) `mod` length ws')
+    return $ tag next
+
+findWsIndex :: WindowSpace -> [WindowSpace] -> Maybe Int
+findWsIndex ws wss = findIndex ((== tag ws) . tag) wss
+
+-- | View next screen
+nextScreen :: X ()
+nextScreen = switchScreen 1
+
+-- | View prev screen
+prevScreen :: X ()
+prevScreen = switchScreen (-1)
+
+switchScreen :: Int -> X ()
+switchScreen d = do s <- screenBy d
+                    mws <- screenWorkspace s
+                    case mws of
+                         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)
+                let now = screen (current ws)
+                return $ (now + fromIntegral d) `mod` fromIntegral (length (screens ws))
+
+-- | Swap current screen with next screen
+swapNextScreen :: X ()
+swapNextScreen = swapScreen 1
+
+-- | Swap current screen with previous screen
+swapPrevScreen :: X ()
+swapPrevScreen = swapScreen (-1)
+
+swapScreen :: Int -> X ()
+swapScreen d = do s <- screenBy d
+                  mws <- screenWorkspace s
+                  case mws of
+                    Nothing -> return ()
+                    Just ws -> windows (greedyView ws)
+
+-- | Move focused window to workspace on next screen
+shiftNextScreen :: X ()
+shiftNextScreen = shiftScreenBy 1
+
+-- | Move focused window to workspace on prev screen
+shiftPrevScreen :: X ()
+shiftPrevScreen = shiftScreenBy (-1)
+
+shiftScreenBy :: Int -> X ()
+shiftScreenBy d = do s <- screenBy d
+                     mws <- screenWorkspace s
+                     case mws of
+                         Nothing -> return ()
+                         Just ws -> windows (shift ws)

XMonad/Actions/CycleWindows.hs

@@ -0,0 +1,235 @@
+--------------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.CycleWindows
+-- Copyright    : (c) Wirt Wolff <wirtwolff@gmail.com>
+-- License      : BSD3-style (see LICENSE)
+--
+-- Maintainer   : Wirt Wolff <wirtwolff@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides bindings to cycle windows up or down on the current workspace
+-- stack while maintaining focus in place.
+--
+-- Bindings are available to:
+--
+-- * Cycle nearby or nth windows into the focused frame
+--
+-- * Cycle a window halfway around the stack
+--
+-- * Cycle windows through the focused position.
+--
+-- * Cycle unfocused windows.
+--
+-- These bindings are especially useful with layouts that hide some of
+-- the windows in the stack, such as Full, "XMonad.Layout.TwoPane" or
+-- when using "XMonad.Layout.LimitWindows" to only show three or four
+-- panes. See also "XMonad.Actions.RotSlaves" for related actions.
+-----------------------------------------------------------------------------
+module XMonad.Actions.CycleWindows (
+        -- * Usage
+        -- $usage
+
+        -- * Cycling nearby or nth window into current frame
+        -- $cycle
+        cycleRecentWindows,
+        cycleStacks',
+        -- * Cycling half the stack to get rid of a boring window
+        -- $opposite
+        rotOpposite', rotOpposite,
+        -- * Cycling windows through the current frame
+        -- $focused
+        rotFocused', rotFocusedUp, rotFocusedDown, shiftToFocus',
+        -- * Cycling windows through other frames
+        -- $unfocused
+        rotUnfocused', rotUnfocusedUp, rotUnfocusedDown,
+        -- * Updating the mouse pointer
+        -- $pointer
+
+        -- * Generic list rotations
+        -- $generic
+        rotUp, rotDown
+) where
+
+import XMonad
+import qualified XMonad.StackSet as W
+import XMonad.Actions.RotSlaves
+
+import Control.Arrow (second)
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.CycleWindows
+-- >    -- config
+-- >    -- other key bindings with x here your config
+-- >
+-- >              -- make sure mod matches keysym
+-- >  , ((mod4Mask,  xK_s), cycleRecentWindows [xK_Super_L] xK_s xK_w)
+-- >  , ((modm, xK_z), rotOpposite)
+-- >  , ((modm                , xK_i), rotUnfocusedUp)
+-- >  , ((modm                , xK_u), rotUnfocusedDown)
+-- >  , ((modm .|. controlMask, xK_i), rotFocusedUp)
+-- >  , ((modm .|. controlMask, xK_u), rotFocusedDown)
+--
+-- Also, if you use focus follows mouse, you will want to read the section
+-- on updating the mouse pointer below.  For detailed instructions on
+-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
+{- $pointer
+With FocusFollowsMouse == True, the focus is updated after binding
+actions, possibly focusing a window you didn't intend to focus. Most
+people using TwoPane probably already have a logHook causing the mouse
+to follow focus. (See "XMonad.Actions.UpdatePointer", or "XMonad.Actions.Warp")
+
+If you want this built into the key binding instead, use the appropriate
+action from one of those modules to also have your bindings move the pointer
+to the point of your choice on the current window:
+
+> import XMonad.Actions.UpdatePointer -- or Actions.Warp
+
+and either
+
+> -- modify the window rotation bindings
+> , ((modm .|. controlMask, xK_i   ), rotFocusedUp
+>                                            >> updatePointer (Relative 1 1))
+> , ((modm .|. controlMask, xK_u   ), rotFocusedDown
+>                                            >> updatePointer (Relative 1 1))
+>
+>    -- or add to xmonad's logHook
+>    , logHook = dynamicLogWithPP xmobarPP
+>                    >> updatePointer Nearest -- or your preference
+
+-}
+
+-- $cycle
+-- Cycle windows into focus from below or above the focused pane by pressing
+-- a key while one or more modifier keys is held down. The window order isn't
+-- changed until a modifier is released, leaving the previously focused window
+-- just below the new one, (or above if the window just above is chosen.) For
+-- best results use the same modifier + key combination as the one used to invoke
+-- the \"bring from below\" action.  Also, once cycling, pressing a number key n
+-- will focus the nth window, with 0 being the one originally focused.
+cycleRecentWindows :: [KeySym] -- ^ A list of modifier keys used when invoking this action.
+                               --   As soon as one of them is released, the final switch is made.
+                    -> KeySym  -- ^ Key used to shift windows from below the current choice into the current frame.
+                    -> KeySym  -- ^ Key used to shift windows from above the current choice into the current frame.
+                               --   If it's the same as the first key, it is effectively ignored.
+                    -> X ()
+cycleRecentWindows = cycleStacks' stacks where
+    stacks s = map (shiftToFocus' `flip` s) (wins s)
+    wins (W.Stack t l r) = t : r ++ reverse l
+
+
+-- | Cycle through a /finite/ list of window stacks with repeated presses
+--   of a key while a modifier key is held down. For best results use the same
+--   mod key + key combination as the one used to invoke the \"bring from below\"
+--   action. You could use cycleStacks' with a different stack permutations
+--   function to, for example, cycle from one below to one above to two below,
+--   etc. instead of in order. You are responsible for having it generate a
+--   finite list, though, or xmonad may hang seeking its length.
+cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite list of permutations of a given stack.
+                                    -> [KeySym]  -- ^ A list of modifier keys used to invoke 'cycleStacks''.
+                                                 --   As soon as any is released, we're no longer cycling on the [Stack Window]
+                                    -> KeySym    -- ^ Key used to select a \"next\" stack.
+                                    -> KeySym    -- ^ Key used to select a \"previous\" stack.
+                                    -> X ()
+cycleStacks' filteredPerms mods keyNext keyPrev = do
+    XConf {theRoot = root, display = d} <- ask
+    stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset
+
+    let evt = allocaXEvent $
+                  \p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p
+                           KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
+                           s <- keycodeToKeysym d c 0
+                           return (t, s)
+        choose n (t, s)
+              | t == keyPress   && s == keyNext  = io evt >>= choose (n+1)
+              | t == keyPress   && s == keyPrev  = io evt >>= choose (n-1)
+              | t == keyPress   && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)
+              | t == keyRelease && s `elem` mods = return ()
+              | otherwise                        = doStack n >> io evt >>= choose n
+        doStack n = windows . W.modify' . const $ stacks `cycref` n
+
+    io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
+    io evt >>= choose 1
+    io $ ungrabKeyboard d currentTime
+  where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite
+        numKeyToN = subtract 48 . read . show
+
+-- | Given a stack element and a stack, shift or insert the element (window)
+--   at the currently focused position.
+shiftToFocus' :: (Eq a, Show a, Read a) => a -> W.Stack a -> W.Stack a
+shiftToFocus' w s@(W.Stack _ ls _) = W.Stack w (reverse revls') rs'
+  where (revls', rs') = splitAt (length ls) . filter (/= w) $ W.integrate s
+
+
+-- $opposite
+-- Shifts the focused window as far as possible from the current focus,
+-- i.e. halfway around the stack. Windows above the focus up to the \"opposite\"
+-- position remain in place, while those above the insertion shift toward
+-- the current focus. This is useful for people who use lots of windows in Full,
+-- TwoPane, etc., to get rid of boring windows while cycling and swapping
+-- near the focus.
+rotOpposite :: X()
+rotOpposite = windows $ W.modify' rotOpposite'
+
+-- | The opposite rotation on a Stack.
+rotOpposite' :: W.Stack a -> W.Stack a
+rotOpposite' (W.Stack t l r) = W.Stack t' l' r'
+  where rrvl = r ++ reverse l
+        part = (length rrvl + 1) `div` 2
+        (l',t':r') =  second reverse . splitAt (length l) $
+                                reverse (take part rrvl ++ t : drop part rrvl)
+
+
+-- $focused
+-- Most people will want the @rotAllUp@ or @rotAllDown@ actions from
+-- "XMonad.Actions.RotSlaves" to cycle all windows in the stack.
+--
+-- The following actions keep the \"next\" window stable, which is
+-- mostly useful in two window layouts, or when you have a log viewer or
+-- buffer window you want to keep next to the cycled window.
+
+-- | Rotate windows through the focused frame, excluding the \"next\" window.
+-- With, e.g. TwoPane, this allows cycling windows through either the
+-- master or slave pane, without changing the other frame. When the master
+-- is focused, the window below is skipped, when a non-master window is
+-- focused, the master is skipped.
+rotFocusedUp :: X ()
+rotFocusedUp = windows . W.modify' $ rotFocused' rotUp
+rotFocusedDown :: X ()
+rotFocusedDown = windows . W.modify' $ rotFocused' rotDown
+
+-- | The focused rotation on a stack.
+rotFocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
+rotFocused' _ s@(W.Stack _ [] []) = s
+rotFocused' f   (W.Stack t [] (r:rs)) = W.Stack t' [] (r:rs') -- Master has focus
+    where (t':rs') = f (t:rs)
+rotFocused' f s@(W.Stack _ _ _) = rotSlaves' f s              -- otherwise
+
+
+-- $unfocused
+-- Rotate windows through the unfocused frames. This is similar to
+-- @rotSlaves@, from "XMonad.Actions.RotSlaves", but excludes the current
+-- frame rather than master.
+rotUnfocusedUp :: X ()
+rotUnfocusedUp = windows . W.modify' $ rotUnfocused' rotUp
+rotUnfocusedDown :: X ()
+rotUnfocusedDown = windows . W.modify' $ rotUnfocused' rotDown
+
+-- | The unfocused rotation on a stack.
+rotUnfocused' :: ([a] -> [a]) -> W.Stack a -> W.Stack a
+rotUnfocused' _ s@(W.Stack _ [] []) = s
+rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s                 -- Master has focus
+rotUnfocused' f   (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise
+    where  (master:revls)  = reverse ls
+           (revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
+
+-- $generic
+-- 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 = drop 1 l ++ take 1 l
+rotDown :: [a] -> [a]
+rotDown = reverse . rotUp . reverse

XMonad/Actions/CycleWorkspaceByScreen.hs

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

XMonad/Actions/DeManage.hs

@@ -0,0 +1,57 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DeManage
+-- Copyright   :  (c) Spencer Janssen <spencerjanssen@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- This module provides a method to cease management of a window
+-- without unmapping it.  This is especially useful for applications
+-- like kicker and gnome-panel.  See also "XMonad.Hooks.ManageDocks" for
+-- more a more automated solution.
+--
+-- To make a panel display correctly with xmonad:
+--
+--  * Determine the pixel size of the panel, add that value to
+--    'XMonad.Core.XConfig.defaultGaps'
+--
+--  * Launch the panel
+--
+--  * Give the panel window focus, then press @mod-d@ (or whatever key
+--    you have bound 'demanage' to)
+--
+--  * Convince the panel to move\/resize to the correct location.  Changing the
+--  panel's position setting several times seems to work.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DeManage (
+                                 -- * Usage
+                                 -- $usage
+                                 demanage
+                                ) where
+
+import qualified XMonad.StackSet as W
+import XMonad
+
+-- $usage
+-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:
+--
+-- >     import XMonad.Actions.DeManage
+--
+-- And add a keybinding, such as:
+--
+-- > , ((modm,               xK_d     ), withFocused demanage)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Stop managing the currently focused window.
+demanage :: Window -> X ()
+demanage w = do
+    -- use modify to defeat automatic 'unmanage' calls.
+    modify (\s -> s { windowset = W.delete w (windowset s) })
+    refresh

XMonad/Actions/DwmPromote.hs

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DwmPromote
+-- Copyright   :  (c) Miikka Koskinen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  arcatan@kapsi.fi
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Dwm-like swap function for xmonad.
+--
+-- Swaps focused window with the master window. If focus is in the
+-- master, swap it with the next window in the stack. Focus stays in the
+-- master.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DwmPromote (
+                                 -- * Usage
+                                 -- $usage
+                                 dwmpromote
+                                ) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.DwmPromote
+--
+-- then add a keybinding or substitute 'dwmpromote' in place of promote:
+--
+-- >   , ((modm,               xK_Return), dwmpromote)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Swap the focused window with the master window. If focus is in
+--   the master, swap it with the next window in the stack. Focus
+--   stays in the master.
+dwmpromote :: X ()
+dwmpromote = windows $ modify' $
+             \c -> case c of
+                   Stack _ [] []     -> c
+                   Stack t [] (x:rs) -> Stack x [] (t:rs)
+                   Stack t ls rs     -> Stack t [] (ys ++ x : rs) where (x:ys) = reverse ls

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,195 @@
+{-# 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
+    , updateName
+    , removeName
+
+    , 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
+
+-- | Update the name of a workspace in the stored order.
+updateName :: WorkspaceId -> WorkspaceId -> X ()
+updateName oldId newId = XS.modify . withWSO $ changeKey oldId newId
+
+-- | Remove a workspace from the stored order.
+removeName :: WorkspaceId -> X ()
+removeName = XS.modify . withWSO . M.delete
+
+-- | Update a key in a Map.
+changeKey :: Ord k => k -> k -> M.Map k a -> M.Map k a
+changeKey oldKey newKey oldMap =
+  case M.updateLookupWithKey (\_ _ -> Nothing) oldKey oldMap of
+    (Nothing, _) -> oldMap
+    (Just val, newMap) -> M.insert newKey val newMap
+
+-- | View the next workspace of the given type in the given direction,
+-- where \"next\" is determined using the dynamic workspace order.
+moveTo :: Direction1D -> WSType -> X ()
+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

@@ -0,0 +1,260 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.DynamicWorkspaces
+-- Copyright   :  (c) David Roundy <droundy@darcs.net>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  none
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Provides bindings to add and delete workspaces.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.DynamicWorkspaces (
+                                         -- * Usage
+                                         -- $usage
+                                         addWorkspace, addWorkspacePrompt,
+                                         appendWorkspace, appendWorkspacePrompt,
+                                         addWorkspaceAt,
+                                         removeWorkspace,
+                                         removeWorkspaceByTag,
+                                         removeEmptyWorkspace,
+                                         removeEmptyWorkspaceByTag,
+                                         removeEmptyWorkspaceAfter,
+                                         removeEmptyWorkspaceAfterExcept,
+                                         addHiddenWorkspace, addHiddenWorkspaceAt,
+                                         withWorkspace,
+                                         selectWorkspace, renameWorkspace,
+                                         renameWorkspaceByName,
+                                         toNthWorkspace, withNthWorkspace,
+                                         setWorkspaceIndex, withWorkspaceIndex,
+                                         WorkspaceIndex
+                                       ) where
+
+import XMonad hiding (workspaces)
+import XMonad.StackSet hiding (filter, modify, delete)
+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 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 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". 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
+
+-- | 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
+
+
+mkCompl :: [String] -> String -> IO [String]
+mkCompl l s = return $ filter (\x -> take (length s) x == s) l
+
+withWorkspace :: XPConfig -> (String -> X ()) -> X ()
+withWorkspace c job = do ws <- gets (workspaces . windowset)
+                         sort <- getSortByIndex
+                         let ts = map tag $ sort ws
+                             job' t | t `elem` ts = job t
+                                    | otherwise = addHiddenWorkspace t >> job t
+                         mkXPrompt (Wor "") c (mkCompl ts) job'
+
+renameWorkspace :: XPConfig -> X ()
+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
+                             ws <- gets (map tag . sort . workspaces . windowset)
+                             case drop wnum ws of
+                               (w:_) -> job w
+                               [] -> return ()
+
+withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
+withNthWorkspace job wnum = do sort <- getSortByIndex
+                               ws <- gets (map tag . sort . workspaces . windowset)
+                               case drop wnum ws of
+                                 (w:_) -> windows $ job w
+                                 [] -> return ()
+
+selectWorkspace :: XPConfig -> X ()
+selectWorkspace conf = workspacePrompt conf $ \w ->
+                       do s <- gets windowset
+                          if tagMember w s
+                            then windows $ greedyView w
+                            else addWorkspace w
+
+-- | Add a new workspace with the given name, or do nothing if a
+--   workspace with the given name already exists; then switch to the
+--   newly created workspace.
+addWorkspace :: String -> X ()
+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 = addHiddenWorkspaceAt (:)
+
+-- | Remove the current workspace if it contains no windows.
+removeEmptyWorkspace :: X ()
+removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByTag
+
+-- | Remove the current workspace.
+removeWorkspace :: X ()
+removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
+
+-- | 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.
+removeWorkspaceByTag :: String -> X ()
+removeWorkspaceByTag torem = do
+    s <- gets windowset
+    case s of
+        StackSet { current = Screen { workspace = cur }, hidden = (w:_) } -> do
+                when (torem==tag cur) $ windows $ view $ tag w
+                windows $ removeWorkspace' torem
+        _ -> return ()
+
+-- | Remove the current workspace after an operation if it is empty and hidden.
+--   Can be used to remove a workspace if it is empty when leaving it. The
+--   operation may only change workspace once, otherwise the workspace will not
+--   be removed.
+removeEmptyWorkspaceAfter :: X () -> X ()
+removeEmptyWorkspaceAfter = removeEmptyWorkspaceAfterExcept []
+
+-- | Like 'removeEmptyWorkspaceAfter' but use a list of sticky workspaces,
+--   whose entries will never be removed.
+removeEmptyWorkspaceAfterExcept :: [String] -> X () -> X ()
+removeEmptyWorkspaceAfterExcept sticky f = do
+    before <- gets (currentTag . windowset)
+    f
+    after <- gets (currentTag . windowset)
+    when (before/=after && before `notElem` sticky) $ removeEmptyWorkspaceByTag before
+
+isEmpty :: String -> X Bool
+isEmpty t = do wsl <- gets $ workspaces . windowset
+               let mws = find (\ws -> tag ws == t) wsl
+               return $ maybe True (isNothing . stack) mws
+
+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 = 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'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
+                                         , hidden = xs ++ ys }
+         removeWorkspace'' _  _      = s

XMonad/Actions/FindEmptyWorkspace.hs

@@ -1,52 +1,51 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.FindEmptyWorkspace
+-- Module      :  XMonad.Actions.FindEmptyWorkspace
 -- Copyright   :  (c) Miikka Koskinen 2007
 -- License     :  BSD3-style (see LICENSE)
 --
 -- Maintainer  :  arcatan@kapsi.fi
--- Stability   :  unstable
+-- Stability   :  stable
 -- Portability :  unportable
 --
--- Find an empty workspace in XMonad.
+-- Find an empty workspace.
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.FindEmptyWorkspace (
+module XMonad.Actions.FindEmptyWorkspace (
     -- * Usage
     -- $usage
-    viewEmptyWorkspace, tagToEmptyWorkspace
+    viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
   ) where
 
-import Control.Monad.State
 import Data.List
 import Data.Maybe ( isNothing )
 
 import XMonad
-import StackSet
-
-import qualified Operations as O
+import XMonad.StackSet
 
 -- $usage
--- 
--- To use, modify your Config.hs to:
 --
--- >   import XMonadContrib.FindEmptyWorkspace
+-- To use, import this module into your @~\/.xmonad\/xmonad.hs@:
 --
--- and add a keybinding:
+-- >   import XMonad.Actions.FindEmptyWorkspace
 --
---  >   , ((modMask,                xK_m    ), viewEmptyWorkspace)
---  >   , ((modMask .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
+-- and add the desired keybindings, for example:
 --
--- Now you can jump to an empty workspace with mod-m. Mod-shift-m will
--- tag the current window to an empty workspace and view it.
-
+--  >   , ((modm,                xK_m    ), viewEmptyWorkspace)
+--  >   , ((modm .|. shiftMask,  xK_m    ), tagToEmptyWorkspace)
+--
+-- Now you can jump to an empty workspace with @mod-m@. @Mod-shift-m@
+-- will tag the current window to an empty workspace and view it.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 -- | Find the first hidden empty workspace in a StackSet. Returns
 -- Nothing if all workspaces are in use. Function searches currently
 -- focused workspace, other visible workspaces (when in Xinerama) and
 -- hidden workspaces in this order.
-findEmptyWorkspace :: StackSet i a s sd -> Maybe (Workspace i a)
+findEmptyWorkspace :: StackSet i l a s sd -> Maybe (Workspace i l a)
 findEmptyWorkspace = find (isNothing . stack) . allWorkspaces
   where
     allWorkspaces ss = (workspace . current) ss :
@@ -60,9 +59,14 @@ withEmptyWorkspace f = do
 -- | Find and view an empty workspace. Do nothing if all workspaces are
 -- in use.
 viewEmptyWorkspace :: X ()
-viewEmptyWorkspace = withEmptyWorkspace O.view
+viewEmptyWorkspace = withEmptyWorkspace (windows . view)
 
 -- | Tag current window to an empty workspace and view it. Do nothing if
 -- all workspaces are in use.
 tagToEmptyWorkspace :: X ()
-tagToEmptyWorkspace = withEmptyWorkspace $ \w -> O.shift w >> O.view w
+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

@@ -0,0 +1,135 @@
+{-# LANGUAGE FlexibleInstances, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.FlexibleManipulate
+-- Copyright   :  (c) Michael Sloan
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <mgsloan@gmail.com>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- Move and resize floating windows without warping the mouse.
+--
+-----------------------------------------------------------------------------
+
+-- Based on the FlexibleResize code by Lukas Mai (mauke).
+
+module XMonad.Actions.FlexibleManipulate (
+        -- * Usage
+        -- $usage
+        mouseWindow, discrete, linear, resize, position
+) 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@:
+--
+-- > import qualified XMonad.Actions.FlexibleManipulate as Flex
+--
+-- Now set up the desired mouse binding, for example:
+--
+-- >     , ((modm, button1), (\w -> focus w >> Flex.mouseWindow Flex.linear w))
+--
+-- * Flex.'linear' indicates that positions between the edges and the
+--   middle indicate a combination scale\/position.
+--
+-- * Flex.'discrete' indicates that there are discrete pick
+--   regions. (The window is divided by thirds for each axis.)
+--
+-- * Flex.'resize' performs only a resize of the window, based on which
+--   quadrant the mouse is in.
+--
+-- * Flex.'position' is similar to the built-in
+--   'XMonad.Operations.mouseMoveWindow'.
+--
+-- You can also write your own function for this parameter. It should take
+-- a value between 0 and 1 indicating position, and return a value indicating
+-- the corresponding position if plain Flex.'linear' was used.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+discrete, linear, resize, position :: Double -> Double
+
+-- | Manipulate the window based on discrete pick regions; the window
+--   is divided into regions by thirds along each axis.
+discrete x | x < 0.33 = 0
+           | x > 0.66 = 1
+           | otherwise = 0.5
+
+-- | Scale\/reposition the window by factors obtained from the mouse
+--   position by linear interpolation. Dragging precisely on a corner
+--   resizes that corner; dragging precisely in the middle moves the
+--   window without resizing; anything else is an interpolation
+--   between the two.
+linear = id
+
+-- | Only resize the window, based on the window quadrant the mouse is in.
+resize x = if x < 0.5 then 0 else 1
+
+-- | Only reposition the window.
+position = const 0.5
+
+-- | Given an interpolation function, implement an appropriate window
+--   manipulation action.
+mouseWindow :: (Double -> Double) -> Window -> X ()
+mouseWindow f w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    [wpos, wsize] <- io $ getWindowAttributes d w >>= return . winAttrs
+    sh <- io $ getWMNormalHints d w
+    pointer <- io $ queryPointer d w >>= return . pointerPos
+
+    let uv = (pointer - wpos) / wsize
+        fc = mapP f uv
+        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
+        let offset = (fromIntegral ex, fromIntegral ey) - pointer
+            npos = wpos + offset * atl
+            nbr = (wpos + wsize) + offset * abr
+            ntl = minP (nbr - (32, 32)) npos    --minimum size
+            nwidth = applySizeHintsContents sh $ mapP (round :: Double -> Integer) (nbr - ntl)
+        moveResizeWindow d w (round $ fst ntl) (round $ snd ntl) `uncurry` nwidth
+        return ())
+        (float w)
+
+    float w
+
+  where
+    pointerPos (_,_,_,px,py,_,_,_) = (fromIntegral px,fromIntegral py) :: Pnt
+    winAttrs :: WindowAttributes -> [Pnt]
+    winAttrs x = pairUp $ map (fromIntegral . ($ x)) [wa_x, wa_y, wa_width, wa_height]
+
+
+-- I'd rather I didn't have to do this, but I hate writing component 2d math
+type Pnt = (Double, Double)
+
+pairUp :: [a] -> [(a,a)]
+pairUp [] = []
+pairUp [_] = []
+pairUp (x:y:xs) = (x, y) : (pairUp xs)
+
+mapP :: (a -> b) -> (a, a) -> (b, b)
+mapP f (x, y) = (f x, f y)
+zipP :: (a -> b -> c) -> (a,a) -> (b,b) -> (c,c)
+zipP f (ax,ay) (bx,by) = (f ax bx, f ay by)
+
+minP :: Ord a => (a,a) -> (a,a) -> (a,a)
+minP = zipP min
+
+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./)
+

XMonad/Actions/FlexibleResize.hs

@@ -0,0 +1,79 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.FlexibleResize
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Resize floating windows from any corner.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FlexibleResize (
+        -- * Usage
+        -- $usage
+        XMonad.Actions.FlexibleResize.mouseResizeWindow,
+        XMonad.Actions.FlexibleResize.mouseResizeEdgeWindow
+) where
+
+import XMonad
+import XMonad.Util.XUtils (fi)
+import Foreign.C.Types
+
+-- $usage
+-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import qualified XMonad.Actions.FlexibleResize as Flex
+--
+-- Then add an appropriate mouse binding:
+--
+-- >     , ((modm, button3), (\w -> focus w >> Flex.mouseResizeWindow w))
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+-- | Resize a floating window from whichever corner the mouse is
+--   closest to.
+mouseResizeWindow
+  :: Window -- ^ The window to resize.
+  -> X ()
+mouseResizeWindow = mouseResizeEdgeWindow 0
+
+
+-- | Resize a floating window from whichever corner or edge the mouse is
+--   closest to.
+mouseResizeEdgeWindow
+  :: Rational -- ^ The size of the area where only one edge is resized.
+  -> Window   -- ^ The window to resize.
+  -> X ()
+mouseResizeEdgeWindow edge w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    (_, _, _, _, _, ix, iy, _) <- io $ queryPointer d w
+    let
+        [pos_x, pos_y, width, height] = map (fi . ($ wa)) [wa_x, wa_y, wa_width, wa_height]
+        west  = findPos ix width
+        north = findPos iy height
+        (cx, fx, gx) = mkSel west  width  pos_x
+        (cy, fy, gy) = mkSel north height pos_y
+    io $ warpPointer d none w 0 0 0 0 cx cy
+    mouseDrag (\ex ey -> do let (nw,nh) = applySizeHintsContents sh (gx ex, gy ey)
+                            io $ moveResizeWindow d w (fx nw) (fy nh) nw nh)
+              (float w)
+    where
+    findPos :: CInt -> Position -> Maybe Bool
+    findPos m s = if p < 0.5 - edge/2
+                  then Just True
+                  else if p < 0.5 + edge/2
+                       then Nothing
+                       else Just False
+                  where p = fi m / fi s
+    mkSel :: Maybe Bool -> Position -> Position -> (Position, Dimension -> Position, Position -> Dimension)
+    mkSel b k p = case b of
+                      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)

XMonad/Actions/FloatKeys.hs

@@ -0,0 +1,123 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.FloatKeys
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : stable
+-- Portability  : unportable
+--
+-- Move and resize floating windows.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FloatKeys (
+                -- * Usage
+                -- $usage
+                keysMoveWindow,
+                keysMoveWindowTo,
+                keysResizeWindow,
+                keysAbsResizeWindow,
+                P, G,
+                ) where
+
+import XMonad
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.FloatKeys
+--
+-- Then add appropriate key bindings, for example:
+--
+-- >  , ((modm,               xK_d     ), withFocused (keysResizeWindow (-10,-10) (1,1)))
+-- >  , ((modm,               xK_s     ), withFocused (keysResizeWindow (10,10) (1,1)))
+-- >  , ((modm .|. shiftMask, xK_d     ), withFocused (keysAbsResizeWindow (-10,-10) (1024,752)))
+-- >  , ((modm .|. shiftMask, xK_s     ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
+-- >  , ((modm,               xK_a     ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
+--   right and @dy@ pixels down.
+keysMoveWindow :: D -> Window -> X ()
+keysMoveWindow (dx,dy) w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + dx))
+                        (fromIntegral (fromIntegral (wa_y wa) + dy))
+    float w
+
+-- | @keysMoveWindowTo (x, y) (gx, gy)@ moves the window relative
+--   point @(gx, gy)@ to the point @(x,y)@, where @(gx,gy)@ gives a
+--   position relative to the window border, i.e.  @gx = 0@ is the left
+--   border, @gx = 1@ is the right border, @gy = 0@ is the top border, and
+--   @gy = 1@ the bottom border.
+--
+--   For example, on a 1024x768 screen:
+--
+-- > keysMoveWindowTo (512,384) (1%2, 1%2) -- center the window on screen
+-- > keysMoveWindowTo (1024,0) (1, 0)      -- put window in the top right corner
+keysMoveWindowTo :: P -> G -> Window -> X ()
+keysMoveWindowTo (x,y) (gx, gy) w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    io $ moveWindow d w (x - round (gx * fromIntegral (wa_width wa)))
+                        (y - round (gy * fromIntegral (wa_height wa)))
+    float w
+
+type G = (Rational, Rational)
+type P = (Position, Position)
+
+-- | @keysResizeWindow (dx, dy) (gx, gy)@ changes the width by @dx@
+--   and the height by @dy@, leaving the window-relative point @(gx,
+--   gy)@ fixed.
+--
+--   For example:
+--
+-- > keysResizeWindow (10, 0) (0, 0)      -- make the window 10 pixels larger to the right
+-- > keysResizeWindow (10, 0) (0, 1%2)    -- does the same, unless sizeHints are applied
+-- > keysResizeWindow (10, 10) (1%2, 1%2) -- add 5 pixels on each side
+-- > keysResizeWindow (-10, -10) (0, 1)   -- shrink the window in direction of the bottom-left corner
+keysResizeWindow :: D -> G -> Window -> X ()
+keysResizeWindow = keysMoveResize keysResizeWindow'
+
+-- | @keysAbsResizeWindow (dx, dy) (ax, ay)@ changes the width by @dx@
+--   and the height by @dy@, leaving the screen absolute point @(ax,
+--   ay)@ fixed.
+--
+--   For example:
+--
+-- > keysAbsResizeWindow (10, 10) (0, 0)   -- enlarge the window; if it is not in the top-left corner it will also be moved down and to the right.
+keysAbsResizeWindow :: D -> D -> Window -> X ()
+keysAbsResizeWindow = keysMoveResize keysAbsResizeWindow'
+
+keysAbsResizeWindow' :: SizeHints -> P -> D -> D -> D -> (P,D)
+keysAbsResizeWindow' sh (x,y) (w,h) (dx,dy) (ax, ay) = ((round nx, round ny), (nw, nh))
+    where
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
+        nx :: Rational
+        nx = fromIntegral (ax * w + nw * (fromIntegral x - ax)) / fromIntegral w
+        ny :: Rational
+        ny = fromIntegral (ay * h + nh * (fromIntegral y - ay)) / fromIntegral h
+
+keysResizeWindow' :: SizeHints -> P -> D -> D -> G -> (P,D)
+keysResizeWindow' sh (x,y) (w,h) (dx,dy) (gx, gy) = ((nx, ny), (nw, nh))
+    where
+        (nw, nh) = applySizeHintsContents sh (w + dx, h + dy)
+        nx = round $ fromIntegral x + gx * fromIntegral w - gx * fromIntegral nw
+        ny = round $ fromIntegral y + gy * fromIntegral h - gy * fromIntegral nh
+
+keysMoveResize :: (SizeHints -> P -> D -> a -> b -> (P,D)) -> a -> b -> Window -> X ()
+keysMoveResize f move resize w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    sh <- io $ getWMNormalHints d w
+    let wa_dim = (fromIntegral $ wa_width wa, fromIntegral $ wa_height wa)
+        wa_pos = (fromIntegral $ wa_x wa, fromIntegral $ wa_y wa)
+        (wn_pos, wn_dim) = f sh wa_pos wa_dim move resize
+    io $ resizeWindow d w `uncurry` wn_dim
+    io $ moveWindow d w `uncurry` wn_pos
+    float w
+

XMonad/Actions/FloatSnap.hs

@@ -0,0 +1,338 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Layout.FloatSnap
+-- Copyright   :  (c) 2009 Anders Engstrom <ankaan@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Anders Engstrom <ankaan@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Move and resize floating windows using other windows and the edge of the
+-- screen as guidelines.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FloatSnap (
+                -- * Usage
+                -- $usage
+                Direction2D(..),
+                snapMove,
+                snapGrow,
+                snapShrink,
+                snapMagicMove,
+                snapMagicResize,
+                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 XMonad.Actions.AfterDrag
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.FloatSnap
+--
+-- Then add appropriate key bindings, for example:
+--
+-- >        , ((modm,               xK_Left),  withFocused $ snapMove L Nothing)
+-- >        , ((modm,               xK_Right), withFocused $ snapMove R Nothing)
+-- >        , ((modm,               xK_Up),    withFocused $ snapMove U Nothing)
+-- >        , ((modm,               xK_Down),  withFocused $ snapMove D Nothing)
+-- >        , ((modm .|. shiftMask, xK_Left),  withFocused $ snapShrink R Nothing)
+-- >        , ((modm .|. shiftMask, xK_Right), withFocused $ snapGrow R Nothing)
+-- >        , ((modm .|. shiftMask, xK_Up),    withFocused $ snapShrink D Nothing)
+-- >        , ((modm .|. shiftMask, xK_Down),  withFocused $ snapGrow D Nothing)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+--
+-- And possibly add appropriate mouse bindings, for example:
+--
+-- >        , ((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. 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).
+--
+-- For 'snapMagicMove', 'snapMagicResize' and 'snapMagicMouseResize', try instead setting it to the same as the maximum snapping distance.
+--
+-- When a value is specified it can be geometrically conceived as adding a border with the specified width around the window and then checking which
+-- windows it should collide with.
+
+-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen. Use the location of the
+--   mouse over the window to decide which edges to snap. In corners, the two adjoining edges will be snapped, along the middle of an edge only that edge
+--   will be snapped. In the center of the window all edges will snap. Intended to be used together with "XMonad.Actions.FlexibleResize" or
+--   "XMonad.Actions.FlexibleManipulate".
+snapMagicMouseResize
+    :: Rational  -- ^ How big the middle snap area of each axis should be.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window    -- ^ The window to move and resize.
+    -> X ()
+snapMagicMouseResize middle collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    wa <- io $ getWindowAttributes d w
+    (_, _, _, px, py, _, _, _) <- io $ queryPointer d w
+    let x = (fromIntegral px - wx wa)/(ww wa)
+        y = (fromIntegral py - wy wa)/(wh wa)
+        ml = if x <= (0.5 - middle/2) then [L] else []
+        mr = if x >  (0.5 + middle/2) then [R] else []
+        mu = if y <= (0.5 - middle/2) then [U] else []
+        md = if y >  (0.5 + middle/2) then [D] else []
+        mdir = ml++mr++mu++md
+        dir = if mdir == []
+              then [L,R,U,D]
+              else mdir
+    snapMagicResize dir collidedist snapdist w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+-- | Resize the window by each edge independently to snap against the closest part of other windows or the edge of the screen.
+snapMagicResize
+    :: [Direction2D] -- ^ The edges to snap.
+    -> Maybe Int   -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int   -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window      -- ^ The window to move and resize.
+    -> X ()
+snapMagicResize dir collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+
+    (xbegin,xend) <- handleAxis True d wa
+    (ybegin,yend) <- handleAxis False d wa
+
+    let xbegin' = if L `elem` dir then xbegin else (wx wa)
+        xend'   = if R `elem` dir then xend   else (wx wa + ww wa)
+        ybegin' = if U `elem` dir then ybegin else (wy wa)
+        yend'   = if D `elem` dir then yend   else (wy wa + wh wa)
+
+    io $ moveWindow d w (fromIntegral $ xbegin') (fromIntegral $ ybegin')
+    io $ resizeWindow d w (fromIntegral $ xend' - xbegin') (fromIntegral $ yend' - ybegin')
+    float w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+        handleAxis horiz d wa = do
+            ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
+            let begin = if bs
+                        then wpos wa
+                        else case (mbl,mbr) of
+                            (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
+                            (Just bl,Nothing) -> bl
+                            (Nothing,Just br) -> br
+                            (Nothing,Nothing) -> wpos wa
+                end = if fs
+                      then wpos wa + wdim wa
+                      else case (if mfl==(Just begin) then Nothing else mfl,mfr) of
+                          (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
+                          (Just fl,Nothing) -> fl
+                          (Nothing,Just fr) -> fr
+                          (Nothing,Nothing) -> wpos wa + wdim wa
+                begin' = if isNothing snapdist || abs (begin - wpos wa) <= fromJust snapdist then begin else (wpos wa)
+                end' = if isNothing snapdist || abs (end - wpos wa - wdim wa) <= fromJust snapdist then end else (wpos wa + wdim wa)
+            return (begin',end')
+            where
+                (wpos, wdim, _, _) = constructors horiz
+
+
+-- | Move a window by both axises in any direction to snap against the closest part of other windows or the edge of the screen.
+snapMagicMove
+    :: Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Maybe Int -- ^ The maximum distance to snap. Use Nothing to not impose any boundary.
+    -> Window    -- ^ The window to move.
+    -> X ()
+snapMagicMove collidedist snapdist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+
+    nx <- handleAxis True d wa
+    ny <- handleAxis False d wa
+
+    io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
+    float w
+    where
+        handleAxis horiz d wa = do
+            ((mbl,mbr,bs),(mfl,mfr,fs)) <- getSnap horiz collidedist d w
+            return $ if bs || fs
+                     then wpos wa
+                     else let b = case (mbl,mbr) of
+                                    (Just bl,Just br) -> if wpos wa - bl < br - wpos wa then bl else br
+                                    (Just bl,Nothing) -> bl
+                                    (Nothing,Just br) -> br
+                                    (Nothing,Nothing) -> wpos wa
+                              f = case (mfl,mfr) of
+                                    (Just fl,Just fr) -> if wpos wa + wdim wa - fl < fr - wpos wa - wdim wa then fl else fr
+                                    (Just fl,Nothing) -> fl
+                                    (Nothing,Just fr) -> fr
+                                    (Nothing,Nothing) -> wpos wa
+                              newpos = if abs (b - wpos wa) <= abs (f - wpos wa - wdim wa) then b else (f - wdim wa)
+                          in if isNothing snapdist || abs (newpos - wpos wa) <= fromJust snapdist then newpos else (wpos wa)
+            where
+                (wpos, wdim, _, _) = constructors horiz
+
+-- | Move a window in the specified direction until it snaps against another window or the edge of the screen.
+snapMove
+    :: Direction2D -- ^ What direction to move the window in.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to move.
+    -> X ()
+snapMove L = doSnapMove True True
+snapMove R = doSnapMove True False
+snapMove U = doSnapMove False True
+snapMove D = doSnapMove False False
+
+doSnapMove :: Bool -> Bool -> Maybe Int -> Window -> X ()
+doSnapMove horiz rev collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    ((bl,br,_),(fl,fr,_)) <- getSnap horiz collidedist d w
+
+    let (mb,mf) = if rev then (bl,fl)
+                         else (br,fr)
+
+        newpos = fromIntegral $ case (mb,mf) of
+                                    (Just b,Nothing) -> b
+                                    (Nothing,Just f) -> f - wdim wa
+                                    (Just b,Just f) -> if rev /= (b < f - wdim wa)
+                                                       then b
+                                                       else f - wdim wa
+                                    _ -> wpos wa
+
+    if horiz then io $ moveWindow d w newpos (fromIntegral $ wa_y wa)
+             else io $ moveWindow d w (fromIntegral $ wa_x wa) newpos
+    float w
+
+    where
+        (wpos, wdim, _, _) = constructors horiz
+
+-- | Grow the specified edge of a window until it snaps against another window or the edge of the screen.
+snapGrow
+    :: Direction2D -- ^ What edge of the window to grow.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to grow.
+    -> X ()
+snapGrow = snapResize True
+
+-- | Shrink the specified edge of a window until it snaps against another window or the edge of the screen.
+snapShrink
+    :: Direction2D -- ^ What edge of the window to shrink.
+    -> Maybe Int -- ^ The distance in the orthogonal axis to look for windows to snap against. Use Nothing to snap against every window.
+    -> Window    -- ^ The window to shrink.
+    -> X ()
+snapShrink = snapResize False
+
+snapResize :: Bool -> Direction2D -> Maybe Int -> Window -> X ()
+snapResize grow dir collidedist w = whenX (isClient w) $ withDisplay $ \d -> do
+    io $ raiseWindow d w
+    wa <- io $ getWindowAttributes d w
+    mr <- case dir of
+              L -> do ((mg,ms,_),(_,_,_)) <- getSnap True collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (v, wy wa, ww wa + wx wa - v, wh wa)
+                                   _ -> Nothing
+              R -> do ((_,_,_),(ms,mg,_)) <- getSnap True collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, wy wa, v - wx wa, wh wa)
+                                   _ -> Nothing
+              U -> do ((mg,ms,_),(_,_,_)) <- getSnap False collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, v, ww wa, wh wa + wy wa - v)
+                                   _ -> Nothing
+              D -> do ((_,_,_),(ms,mg,_)) <- getSnap False collidedist d w
+                      return $ case (if grow then mg else ms) of
+                                   Just v -> Just (wx wa, wy wa, ww wa, v - wy wa)
+                                   _ -> Nothing
+
+    case mr of
+        Nothing -> return ()
+        Just (nx,ny,nw,nh) -> if nw>0 && nh>0 then do io $ moveWindow d w (fromIntegral nx) (fromIntegral ny)
+                                                      io $ resizeWindow d w (fromIntegral nw) (fromIntegral nh)
+                                              else return ()
+    float w
+    where
+        wx = fromIntegral.wa_x
+        wy = fromIntegral.wa_y
+        ww = fromIntegral.wa_width
+        wh = fromIntegral.wa_height
+
+
+getSnap :: Bool -> Maybe Int -> Display -> Window -> X ((Maybe Int,Maybe Int,Bool),(Maybe Int,Maybe Int,Bool))
+getSnap horiz collidedist d w = do
+    wa <- io $ getWindowAttributes d w
+    screen <- W.current <$> gets windowset
+    let sr = screenRect $ W.screenDetail screen
+        wl = W.integrate' . W.stack $ W.workspace screen
+    gr <- fmap ($sr) $ calcGap $ S.fromList [minBound .. maxBound]
+    wla <- filter (collides wa) `fmap` (io $ mapM (getWindowAttributes d) $ filter (/=w) wl)
+
+    return ( neighbours (back wa sr gr wla) (wpos wa)
+           , neighbours (front wa sr gr wla) (wpos wa + wdim wa)
+           )
+
+    where
+        wborder = fromIntegral.wa_border_width
+
+        (wpos, wdim, rpos, rdim) = constructors horiz
+        (refwpos, refwdim, _, _) = constructors $ not horiz
+
+        back wa sr gr wla = dropWhile (< rpos sr) $
+                            takeWhile (< rpos sr + rdim sr) $
+                            sort $ (rpos sr):(rpos gr):(rpos gr + rdim gr):
+                                   foldr (\a as -> (wpos a):(wpos a + wdim a + wborder a + wborder wa):as) [] wla
+
+        front wa sr gr wla = dropWhile (<= rpos sr) $
+                             takeWhile (<= rpos sr + rdim sr) $
+                             sort $ (rpos gr - 2*wborder wa):(rpos gr + rdim gr - 2*wborder wa):(rpos sr + rdim sr - 2*wborder wa):
+                                    foldr (\a as -> (wpos a - wborder a - wborder wa):(wpos a + wdim a):as) [] wla
+
+        neighbours l v = ( listToMaybe $ reverse $ takeWhile (< v) l
+                         , listToMaybe $ dropWhile (<= v) l
+                         , v `elem` l
+                         )
+
+        collides wa oa = case collidedist of
+                             Nothing -> True
+                             Just dist -> (  refwpos oa - wborder oa < refwpos wa + refwdim wa + wborder wa + dist
+                                          && refwpos wa - wborder wa - dist < refwpos oa + refwdim oa + wborder oa )
+
+
+constructors :: Bool -> (WindowAttributes -> Int, WindowAttributes -> Int, Rectangle -> Int, Rectangle -> Int)
+constructors True = ( fromIntegral.wa_x
+                    , fromIntegral.wa_width
+                    , fromIntegral.rect_x
+                    , fromIntegral.rect_width
+                    )
+constructors False = ( fromIntegral.wa_y
+                     , fromIntegral.wa_height
+                     , fromIntegral.rect_y
+                     , fromIntegral.rect_height
+                     )

XMonad/Actions/FocusNth.hs

@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.FocusNth
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : stable
+-- Portability  : unportable
+--
+-- Focus the nth window of the current workspace.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.FocusNth (
+                 -- * Usage
+                 -- $usage
+                 focusNth,focusNth',
+                 swapNth,swapNth') where
+
+import XMonad.StackSet
+import XMonad
+
+-- $usage
+-- Add the import to your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.FocusNth
+--
+-- Then add appropriate keybindings, for example:
+--
+-- > -- mod4-[1..9] @@ Switch to window N
+-- > ++ [((modm, k), focusNth i)
+-- >     | (i, k) <- zip [0 .. 8] [xK_1 ..]]
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Give focus to the nth window of the current workspace.
+focusNth :: Int -> X ()
+focusNth = windows . modify' . focusNth'
+
+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
+    (t:rs)    = drop n l
+    ls        = reverse (take n l)
+
+

XMonad/Actions/GridSelect.hs

@@ -0,0 +1,795 @@
+{-# LANGUAGE ScopedTypeVariables, GeneralizedNewtypeDeriving, TypeSynonymInstances, FlexibleInstances, OverlappingInstances #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.GridSelect
+-- Copyright   :  Clemens Fruhwirth <clemens@endorphin.org>
+-- License     :  BSD-style (see LICENSE)
+--
+-- Maintainer  :  Clemens Fruhwirth <clemens@endorphin.org>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- 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.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.GridSelect (
+    -- * Usage
+    -- $usage
+
+    -- ** Customizing
+    -- *** Using a common GSConfig
+    -- $commonGSConfig
+
+    -- *** Custom keybindings
+    -- $keybindings
+
+    -- * Configuration
+    GSConfig(..),
+    def,
+    defaultGSConfig,
+    TwoDPosition,
+    buildDefaultGSConfig,
+
+    -- * Variations on 'gridselect'
+    gridselect,
+    gridselectWindow,
+    withSelectedWindow,
+    bringSelected,
+    goToSelected,
+    gridselectWorkspace,
+    gridselectWorkspace',
+    spawnSelected,
+    runSelectedAction,
+
+    -- * Colorizers
+    HasColorizer(defaultColorizer),
+    fromClassName,
+    stringColorizer,
+    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
+import Data.List as L
+import qualified Data.Map as M
+import XMonad hiding (liftX)
+import XMonad.Util.Font
+import XMonad.Prompt (mkUnmanagedWindow)
+import XMonad.StackSet as W
+import XMonad.Layout.Decoration
+import XMonad.Util.NamedWindows
+import XMonad.Actions.WindowBringer (bringWindow)
+import Text.Printf
+import System.Random (mkStdGen, genRange, next)
+import Data.Word (Word8)
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.GridSelect
+--
+-- Then add a keybinding, e.g.
+--
+-- >    , ((modm, xK_g), goToSelected defaultGSConfig)
+--
+-- This module also supports displaying arbitrary information in a grid and letting
+-- the user select from it. E.g. to spawn an application from a given list, you
+-- can use the following:
+--
+-- >   , ((modm, xK_s), spawnSelected defaultGSConfig ["xterm","gmplayer","gvim"])
+
+-- $commonGSConfig
+--
+-- It is possible to bind a @gsconfig@ at top-level in your configuration. Like so:
+--
+-- > -- the top of your config
+-- > {-# LANGUAGE NoMonomorphismRestriction #-}
+-- > import XMonad
+-- > ...
+-- > gsconfig1 = defaultGSConfig { gs_cellheight = 30, gs_cellwidth = 100 }
+--
+-- An example where 'buildDefaultGSConfig' is used instead of 'defaultGSConfig'
+-- in order to specify a custom colorizer is @gsconfig2@ (found in
+-- "XMonad.Actions.GridSelect#Colorizers"):
+--
+-- > gsconfig2 colorizer = (buildDefaultGSConfig colorizer) { gs_cellheight = 30, gs_cellwidth = 100 }
+--
+-- > -- | A green monochrome colorizer based on window class
+-- > greenColorizer = colorRangeFromClassName
+-- >                      black            -- lowest inactive bg
+-- >                      (0x70,0xFF,0x70) -- highest inactive bg
+-- >                      black            -- active bg
+-- >                      white            -- inactive fg
+-- >                      white            -- active fg
+-- >   where black = minBound
+-- >         white = maxBound
+--
+-- Then you can bind to:
+--
+-- >     ,((modm, xK_g), goToSelected  $ gsconfig2 myWinColorizer)
+-- >     ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)
+
+-- $keybindings
+--
+-- You can build you own navigation mode and submodes by combining the
+-- exported action ingredients and assembling them using 'makeXEventhandler' and 'shadowWithKeymap'.
+--
+-- > 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
+--
+-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
+--
+-- > gsconfig3 = def
+-- >    { gs_cellheight = 30
+-- >    , gs_cellwidth = 100
+-- >    , gs_navigate = myNavigation
+-- >    }
+
+-- $screenshots
+--
+-- Selecting a workspace:
+--
+-- <<http://haskell.org/wikiupload/a/a9/Xmonad-gridselect-workspace.png>>
+--
+-- Selecting a window by title:
+--
+-- <<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 :: TwoD a (Maybe a),
+      gs_rearranger :: Rearranger a,
+      gs_originFractX :: Double,
+      gs_originFractY :: Double,
+      gs_bordercolor :: String
+}
+
+-- | That is 'fromClassName' if you are selecting a 'Window', or
+-- 'defaultColorizer' if you are selecting a 'String'. The catch-all instance
+-- @HasColorizer a@ uses the 'focusedBorderColor' and 'normalBorderColor'
+-- colors.
+class HasColorizer a where
+    defaultColorizer :: a -> Bool -> X (String, String)
+
+instance HasColorizer Window where
+    defaultColorizer = fromClassName
+
+instance HasColorizer String where
+    defaultColorizer = stringColorizer
+
+instance HasColorizer a where
+    defaultColorizer _ isFg =
+        let getColor = if isFg then focusedBorderColor else normalBorderColor
+        in asks $ flip (,) "black" . getColor . config
+
+instance HasColorizer a => Default (GSConfig a) where
+    def = buildDefaultGSConfig defaultColorizer
+
+{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
+defaultGSConfig :: HasColorizer a => GSConfig a
+defaultGSConfig = def
+
+type TwoDPosition = (Integer, Integer)
+
+type TwoDElementMap a = [(TwoDPosition,(String,a))]
+
+data TwoDState a = TwoDState { td_curpos :: TwoDPosition
+                             , 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))
+
+instance Applicative (TwoD a) where
+    (<*>) = ap
+    pure = return
+
+liftX ::  X a1 -> TwoD a a1
+liftX = TwoD . lift
+
+evalTwoD ::  TwoD a1 a -> TwoDState a1 -> X a
+evalTwoD m s = flip evalStateT s $ unTwoD m
+
+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, Eq a) => [(a, a)]
+diamond = concatMap diamondLayer [0..]
+
+diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
+diamondRestrict x y originX originY =
+  L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
+  map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
+  take 1000 $ diamond
+
+findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
+findInElementMap pos = find ((== pos) . fst)
+
+drawWinBox :: Window -> XMonadFont -> (String, String) -> String -> Integer -> Integer -> String -> Integer -> Integer -> Integer -> X ()
+drawWinBox win font (fg,bg) bc ch cw text x y cp =
+  withDisplay $ \dpy -> do
+  gc <- liftIO $ createGC dpy win
+  bordergc <- liftIO $ createGC dpy win
+  liftIO $ do
+    Just fgcolor <- initColor dpy fg
+    Just bgcolor <- initColor dpy bg
+    Just bordercolor <- initColor dpy bc
+    setForeground dpy gc fgcolor
+    setBackground dpy gc bgcolor
+    setForeground dpy bordergc bordercolor
+    fillRectangle dpy win gc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
+    drawRectangle dpy win bordergc (fromInteger x) (fromInteger y) (fromInteger cw) (fromInteger ch)
+  stext <- shrinkWhile (shrinkIt shrinkText)
+           (\n -> do size <- liftIO $ textWidthXMF dpy font n
+                     return $ size > (fromInteger (cw-(2*cp))))
+           text
+  -- calculate the offset to vertically centre the text based on the ascender and descender
+  (asc,desc) <- liftIO $ textExtentsXMF font stext
+  let offset = ((ch - fromIntegral (asc + desc)) `div` 2) + fromIntegral asc
+  printStringXMF dpy win font gc bg fg (fromInteger (x+cp)) (fromInteger (y+offset)) stext
+  liftIO $ freeGC dpy gc
+  liftIO $ freeGC dpy bordergc
+
+updateAllElements :: TwoD a ()
+updateAllElements =
+    do
+      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,
+                td_font = font,
+                td_paneX = paneX,
+                td_paneY = paneY} <- get
+    let cellwidth = gs_cellwidth gsconfig
+        cellheight = gs_cellheight gsconfig
+        paneX' = div (paneX-cellwidth) 2
+        paneY' = div (paneY-cellheight) 2
+        updateElement (pos@(x,y),(text, element)) = liftX $ do
+            colors <- colorizer element (pos == curpos)
+            drawWinBox win font
+                       colors
+                       (gs_bordercolor gsconfig)
+                       cellheight
+                       cellwidth
+                       text
+                       (paneX'+x*cellwidth)
+                       (paneY'+y*cellheight)
+                       (gs_cellpadding gsconfig)
+    mapM_ updateElement elementmap
+
+stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
+stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
+    | t == buttonRelease = do
+        s @  TwoDState { td_paneX = px, td_paneY = py,
+                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
+        let gridX = (fi x - (px - cw) `div` 2) `div` cw
+            gridY = (fi y - (py - ch) `div` 2) `div` ch
+        case lookup (gridX,gridY) (td_elementmap s) of
+             Just (_,el) -> return (Just el)
+             Nothing -> contEventloop
+    | otherwise = contEventloop
+
+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
+
+
+-- FIXME probably move that into Utils?
+-- Conversion scheme as in http://en.wikipedia.org/wiki/HSV_color_space
+hsv2rgb :: Fractional a => (Integer,a,a) -> (a,a,a)
+hsv2rgb (h,s,v) =
+    let hi = (div h 60) `mod` 6 :: Integer
+        f = (((fromInteger h)/60) - (fromInteger hi)) :: Fractional a => a
+        q = v * (1-f)
+        p = v * (1-s)
+        t = v * (1-(1-f)*s)
+    in case hi of
+         0 -> (v,t,p)
+         1 -> (q,v,p)
+         2 -> (p,v,t)
+         3 -> (p,q,v)
+         4 -> (t,p,v)
+         5 -> (v,p,q)
+         _ -> error "The world is ending. x mod a >= a."
+
+-- | Default colorizer for Strings
+stringColorizer :: String -> Bool -> X (String, String)
+stringColorizer s active =
+    let seed x = toInteger (sum $ map ((*x).fromEnum) s) :: Integer
+        (r,g,b) = hsv2rgb ((seed 83) `mod` 360,
+                           (fromInteger ((seed 191) `mod` 1000))/2500+0.4,
+                           (fromInteger ((seed 121) `mod` 1000))/2500+0.4)
+    in if active
+         then return ("#faff69", "black")
+         else return ("#" ++ concat (map (twodigitHex.(round :: Double -> Word8).(*256)) [r, g, b] ), "white")
+
+-- | Colorize a window depending on it's className.
+fromClassName :: Window -> Bool -> X (String, String)
+fromClassName w active = runQuery className w >>= flip defaultColorizer active
+
+twodigitHex :: Word8 -> String
+twodigitHex a = printf "%02x" a
+
+-- | A colorizer that picks a color inside a range,
+-- and depending on the window's class.
+colorRangeFromClassName :: (Word8, Word8, Word8) -- ^ Beginning of the color range
+                        -> (Word8, Word8, Word8) -- ^ End of the color range
+                        -> (Word8, Word8, Word8) -- ^ Background of the active window
+                        -> (Word8, Word8, Word8) -- ^ Inactive text color
+                        -> (Word8, Word8, Word8) -- ^ Active text color
+                        -> Window -> Bool -> X (String, String)
+colorRangeFromClassName startC endC activeC inactiveT activeT w active =
+    do classname <- runQuery className w
+       if active
+         then return (rgbToHex activeC, rgbToHex activeT)
+         else return (rgbToHex $ mix startC endC
+                  $ stringToRatio classname, rgbToHex inactiveT)
+    where rgbToHex :: (Word8, Word8, Word8) -> String
+          rgbToHex (r, g, b) = '#':twodigitHex r
+                               ++twodigitHex g++twodigitHex b
+
+-- | Creates a mix of two colors according to a ratio
+-- (1 -> first color, 0 -> second color).
+mix :: (Word8, Word8, Word8) -> (Word8, Word8, Word8)
+        -> Double -> (Word8, Word8, Word8)
+mix (r1, g1, b1) (r2, g2, b2) r = (mix' r1 r2, mix' g1 g2, mix' b1 b2)
+    where  mix' a b = truncate $ (fi a * r) + (fi b * (1 - r))
+
+-- | Generates a Double from a string, trying to
+-- achieve a random distribution.
+-- We create a random seed from the sum of all characters
+-- in the string, and use it to generate a ratio between 0 and 1
+stringToRatio :: String -> Double
+stringToRatio "" = 0
+stringToRatio s = let gen = mkStdGen $ sum $ map fromEnum s
+                      range = (\(a, b) -> b - a) $ genRange gen
+                      randomInt = foldr1 combine $ replicate 20 next
+                      combine f1 f2 g = let (_, g') = f1 g in f2 g'
+                  in fi (fst $ randomInt gen) / fi range
+
+-- | Brings up a 2D grid of elements in the center of the screen, and one can
+-- select an element with cursors keys. The selected element is returned.
+gridselect :: GSConfig a -> [(String,a)] -> X (Maybe a)
+gridselect _ [] = return Nothing
+gridselect gsconfig elements =
+ withDisplay $ \dpy -> do
+    rootw <- asks theRoot
+    scr <- gets $ screenRect . W.screenDetail . W.current . windowset
+    win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
+                    (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 $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
+    font <- initXMF (gs_font gsconfig)
+    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
+                                restrictY = floor $ restriction screenHeight gs_cellheight
+                                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
+                                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
+
+-- | Like `gridSelect' but with the current windows and their titles as elements
+gridselectWindow :: GSConfig Window -> X (Maybe Window)
+gridselectWindow gsconf = windowMap >>= gridselect gsconf
+
+-- | Brings up a 2D grid of windows in the center of the screen, and one can
+-- select a window with cursors keys. The selected window is then passed to
+-- a callback function.
+withSelectedWindow :: (Window -> X ()) -> GSConfig Window -> X ()
+withSelectedWindow callback conf = do
+    mbWindow <- gridselectWindow conf
+    case mbWindow of
+        Just w -> callback w
+        Nothing -> return ()
+
+windowMap :: X [(String,Window)]
+windowMap = do
+    ws <- gets windowset
+    wins <- mapM keyValuePair (W.allWindows ws)
+    return wins
+ where keyValuePair w = flip (,) w `fmap` decorateName' w
+
+decorateName' :: Window -> X String
+decorateName' w = do
+  fmap show $ getName w
+
+-- | Builds a default gs config from a colorizer function.
+buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
+
+-- | Brings selected window to the current workspace.
+bringSelected :: GSConfig Window -> X ()
+bringSelected = withSelectedWindow $ \w -> do
+    windows (bringWindow w)
+    XMonad.focus w
+    windows W.shiftMaster
+
+-- | Switches to selected window's workspace and focuses that window.
+goToSelected :: GSConfig Window -> X ()
+goToSelected = withSelectedWindow $ windows . W.focusWindow
+
+-- | Select an application to spawn from a given list
+spawnSelected :: GSConfig String -> [String] -> X ()
+spawnSelected conf lst = gridselect conf (zip lst lst) >>= flip whenJust spawn
+
+-- | Select an action and run it in the X monad
+runSelectedAction :: GSConfig (X ()) -> [(String, X ())] -> X ()
+runSelectedAction conf actions = do
+    selectedActionM <- gridselect conf actions
+    case selectedActionM of
+        Just selectedAction -> selectedAction
+        Nothing -> return ()
+
+-- | Select a workspace and view it using the given function
+-- (normally 'W.view' or 'W.greedyView')
+--
+-- Another option is to shift the current window to the selected workspace:
+--
+-- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)
+gridselectWorkspace :: GSConfig WorkspaceId ->
+                          (WorkspaceId -> WindowSet -> WindowSet) -> X ()
+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 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

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

XMonad/Actions/Minimize.hs

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

XMonad/Actions/MouseGestures.hs

@@ -0,0 +1,137 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MouseGestures
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <l.mai@web.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Support for simple mouse gestures.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.MouseGestures (
+    -- * Usage
+    -- $usage
+    Direction2D(..),
+    mouseGestureH,
+    mouseGesture,
+    mkCollect
+) where
+
+import XMonad
+import XMonad.Util.Types (Direction2D(..))
+
+import Data.IORef
+import qualified Data.Map as M
+import Data.Map (Map)
+import Data.Maybe
+import Control.Monad
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.MouseGestures
+-- > import qualified XMonad.StackSet as W
+--
+-- then add an appropriate mouse binding:
+--
+-- >     , ((modm .|. shiftMask, button3), mouseGesture gestures)
+--
+-- where @gestures@ is a 'Data.Map.Map' from gestures to actions on
+-- windows, for example:
+--
+-- >     gestures = M.fromList
+-- >         [ ([], focus)
+-- >         , ([U], \w -> focus w >> windows W.swapUp)
+-- >         , ([D], \w -> focus w >> windows W.swapDown)
+-- >         , ([R, D], \_ -> sendMessage NextLayout)
+-- >         ]
+--
+-- This is just an example, of course; you can use any mouse button and
+-- gesture definitions you want.
+--
+-- For detailed instructions on editing your mouse bindings, see
+-- "XMonad.Doc.Extending#Editing_mouse_bindings".
+
+type Pos = (Position, Position)
+
+delta :: Pos -> Pos -> Position
+delta (ax, ay) (bx, by) = max (d ax bx) (d ay by)
+    where
+    d a b = abs (a - b)
+
+dir :: Pos -> Pos -> Direction2D
+dir (ax, ay) (bx, by) = trans . (/ pi) $ atan2 (fromIntegral $ ay - by) (fromIntegral $ bx - ax)
+    where
+    trans :: Double -> Direction2D
+    trans x
+        | rg (-3/4) (-1/4) x = D
+        | rg (-1/4)  (1/4) x = R
+        | rg  (1/4)  (3/4) x = U
+        | otherwise          = L
+    rg a z x = a <= x && x < z
+
+gauge :: (Direction2D -> X ()) -> Pos -> IORef (Maybe (Direction2D, Pos)) -> Position -> Position -> X ()
+gauge hook op st nx ny = do
+    let np = (nx, ny)
+    stx <- io $ readIORef st
+    let
+        (~(Just od), pivot) = case stx of
+            Nothing -> (Nothing, op)
+            Just (d, zp) -> (Just d, zp)
+        cont = do
+            guard $ significant np pivot
+            return $ do
+                let d' = dir pivot np
+                when (isNothing stx || od /= d') $ hook d'
+                io $ writeIORef st (Just (d', np))
+    fromMaybe (return ()) cont
+    where
+    significant a b = delta a b >= 10
+
+-- | @'mouseGestureH' moveHook endHook@ is a mouse button
+-- event handler. It collects mouse movements, calling @moveHook@ for each
+-- update; when the button is released, it calls @endHook@.
+mouseGestureH :: (Direction2D -> X ()) -> X () -> X ()
+mouseGestureH moveHook endHook = do
+    dpy <- asks display
+    root <- asks theRoot
+    (pos, acc) <- io $ do
+        (_, _, _, ix, iy, _, _, _) <- queryPointer dpy root
+        r <- newIORef Nothing
+        return ((fromIntegral ix, fromIntegral iy), r)
+    mouseDrag (gauge moveHook pos acc) endHook
+
+-- | A utility function on top of 'mouseGestureH'. It uses a 'Data.Map.Map' to
+-- look up the mouse gesture, then executes the corresponding action (if any).
+mouseGesture :: Map [Direction2D] (Window -> X ()) -> Window -> X ()
+mouseGesture tbl win = do
+    (mov, end) <- mkCollect
+    mouseGestureH (\d -> mov d >> return ()) $ end >>= \gest ->
+        case M.lookup gest tbl of
+            Nothing -> return ()
+            Just f -> f win
+
+-- | A callback generator for 'mouseGestureH'. 'mkCollect' returns two
+-- callback functions for passing to 'mouseGestureH'. The move hook will
+-- collect mouse movements (and return the current gesture as a list); the end
+-- hook will return a list of the completed gesture, which you can access with
+-- 'Control.Monad.>>='.
+mkCollect :: (MonadIO m, MonadIO m') => m (Direction2D -> m' [Direction2D], m' [Direction2D])
+mkCollect = liftIO $ do
+    acc <- newIORef []
+    let
+        mov d = liftIO $ do
+            ds <- readIORef acc
+            let ds' = d : ds
+            writeIORef acc ds'
+            return $ reverse ds'
+        end = liftIO $ do
+            ds <- readIORef acc
+            writeIORef acc []
+            return $ reverse ds
+    return (mov, end)

XMonad/Actions/MouseResize.hs

@@ -0,0 +1,134 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
+
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.MouseResize
+-- Copyright   :  (c) 2007 Andrea Rossato
+-- License     :  BSD-style (see xmonad/LICENSE)
+--
+-- Maintainer  :  andrea.rossato@unibz.it
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A layout modifier to resize windows with the mouse by grabbing the
+-- window's lower right corner.
+--
+-- This module must be used together with "XMonad.Layout.WindowArranger".
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.MouseResize
+    ( -- * Usage:
+      -- $usage
+      mouseResize
+    , MouseResize (..)
+    ) where
+
+import XMonad
+import XMonad.Layout.Decoration
+
+import XMonad.Layout.WindowArranger
+import XMonad.Util.XUtils
+
+-- $usage
+-- Usually this module is used to create layouts, but you can also use
+-- it to resize windows in any layout, together with the
+-- "XMonad.Layout.WindowArranger". For usage example see
+-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
+--
+-- You can use this module with the following in your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.MouseResize
+-- > import XMonad.Layout.WindowArranger
+--
+-- Then edit your @layoutHook@ by modifying a given layout:
+--
+-- > myLayout = mouseResize $ windowArrange $ layoutHook def
+--
+-- and then:
+--
+-- > main = xmonad def { layoutHook = myLayout }
+--
+-- For more detailed instructions on editing the layoutHook see:
+--
+-- "XMonad.Doc.Extending#Editing_the_layout_hook"
+
+mouseResize :: l a -> ModifiedLayout MouseResize l a
+mouseResize = ModifiedLayout (MR [])
+
+data MouseResize a = MR [((a,Rectangle),Maybe a)]
+instance Show (MouseResize a) where show        _ = ""
+instance Read (MouseResize a) where readsPrec _ s = [(MR [], s)]
+
+instance LayoutModifier MouseResize Window where
+    redoLayout _       _ Nothing  wrs = return (wrs, Nothing)
+    redoLayout (MR st) _ (Just s) wrs
+        | [] <- st  = initState    >>= \nst -> return (wrs, Just $ MR nst)
+        | otherwise = processState >>= \nst -> return (wrs, Just $ MR nst)
+        where
+          wrs'         = wrs_to_state [] . filter (isInStack s . fst) $ wrs
+          initState    = mapM createInputWindow wrs'
+          processState = mapM (deleteInputWin . snd) st >> mapM createInputWindow wrs'
+
+          inputRectangle (Rectangle x y wh ht) = Rectangle (x + fi wh - 5) (y + fi ht - 5) 10 10
+
+          wrs_to_state rs ((w,r):xs)
+              | ir `isVisible` rs = ((w,r),Just ir) : wrs_to_state (r:ir:rs) xs
+              | otherwise         = ((w,r),Nothing) : wrs_to_state (r:   rs) xs
+              where ir = inputRectangle r
+          wrs_to_state _ [] = []
+
+    handleMess (MR s) m
+        | Just e <- fromMessage m :: Maybe Event = handleResize s e >> return Nothing
+        | Just Hide             <- fromMessage m = releaseResources >> return (Just $ MR [])
+        | Just ReleaseResources <- fromMessage m = releaseResources >> return (Just $ MR [])
+        where releaseResources = mapM_ (deleteInputWin . snd) s
+    handleMess _ _ = return Nothing
+
+handleResize :: [((Window,Rectangle),Maybe Window)] -> Event -> X ()
+handleResize st ButtonEvent { ev_window = ew, ev_event_type = et }
+    | et == buttonPress
+    , Just (w,Rectangle wx wy _ _) <- getWin ew st = do
+                                        focus w
+                                        mouseDrag (\x y -> do
+                                                     let rect = Rectangle wx wy
+                                                                (max 1 . fi $ x - wx)
+                                                                (max 1 . fi $ y - wy)
+                                                     sendMessage (SetGeometry rect)) (return ())
+
+      where
+        getWin w (((win,r),tw):xs)
+            | Just w' <- tw
+            , w == w'   = Just (win,r)
+            | otherwise = getWin w xs
+        getWin _ []     = Nothing
+handleResize _ _ = return ()
+
+createInputWindow :: ((Window,Rectangle), Maybe Rectangle) -> X ((Window,Rectangle),Maybe Window)
+createInputWindow ((w,r),mr) = do
+  case mr of
+    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)
+
+deleteInputWin :: Maybe Window -> X ()
+deleteInputWin = maybe (return ()) deleteWindow
+
+mkInputWindow :: Display -> Rectangle -> X Window
+mkInputWindow d (Rectangle x y w h) = do
+  rw <- asks theRoot
+  let screen   = defaultScreenOfDisplay d
+      visual   = defaultVisualOfScreen screen
+      attrmask = cWOverrideRedirect
+  io $ allocaSetWindowAttributes $
+         \attributes -> do
+           set_override_redirect attributes True
+           createWindow d rw x y w h 0 0 inputOnly visual attrmask attributes

XMonad/Actions/Navigation2D.hs

@@ -0,0 +1,965 @@
+{-# 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
+                                   , sideNavigation
+                                   , sideNavigationWithBias
+                                   , hybridOf
+                                   , 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 Data.Ord (comparing)
+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 three different navigation strategies
+-- (see <#Technical_Discussion> for details): /Line navigation/ and
+-- /Side navigation/ feel rather natural but may make it impossible to navigate
+-- to a given window from the current window, particularly in the floating
+-- layer. /Center navigation/ feels less natural in certain situations but
+-- ensures that all windows can be reached without the need to involve the
+-- mouse. Another option is to use a /Hybrid/ of the three strategies,
+-- automatically choosing whichever first provides a suitable target window.
+-- Navigation2D allows different navigation strategies to be used in the two
+-- layers and allows customization of the navigation strategy for the tiled
+-- layer based on the layout currently in effect.
+--
+-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > 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 $ navigation2DP def
+-- >                               ("<Up>", "<Left>", "<Down>", "<Right>")
+-- >                               [("M-",   windowGo  ),
+-- >                                ("M-S-", windowSwap)]
+-- >                               False
+-- >               $ def
+--
+-- That's it. If instead you'd like more control, you can combine
+-- 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
+
+-- | Side navigation. Consider navigating to the right this time. The strategy
+-- is to take the line segment forming the right boundary of the current window,
+-- and push it to the right until it intersects with at least one other window.
+-- Of those windows, one with a point that is the closest to the centre of the
+-- line (+1) is selected. This is probably the most intuitive strategy for the
+-- tiled layer when using XMonad.Layout.Spacing.
+sideNavigation :: Navigation2D
+sideNavigation = N 1 (doSideNavigationWithBias 1)
+
+-- | Side navigation with bias. Consider a case where the screen is divided
+-- up into three vertical panes; the side panes occupied by one window each and
+-- the central pane split across the middle by two windows. By the criteria
+-- of side navigation, the two central windows are equally good choices when
+-- navigating inwards from one of the side panes. Hence in order to be
+-- equitable, symmetric and pleasant to use, different windows are chosen when
+-- navigating from different sides. In particular, the lower is chosen when
+-- going left and the higher when going right, causing L, L, R, R, L, L, etc to
+-- cycle through the four windows clockwise. This is implemented by using a bias
+-- of 1. /Bias/ is how many pixels off centre the vertical split can be before
+-- this behaviour is lost and the same window chosen every time. A negative bias
+-- swaps the preferred window for each direction. A bias of zero disables the
+-- behaviour.
+sideNavigationWithBias :: Int -> Navigation2D
+sideNavigationWithBias b = N 1 (doSideNavigationWithBias b)
+
+-- | Hybrid of two modes of navigation, preferring the motions of the first.
+-- Use this if you want to fall back on a second strategy whenever the first
+-- does not find a candidate window. E.g.
+-- @hybridOf lineNavigation centerNavigation@ is a good strategy for the
+-- floating layer, and @hybridOf sideNavigation centerNavigation@ will enable
+-- you to take advantage of some of the latter strategy's more interesting
+-- motions in the tiled layer.
+hybridOf :: Navigation2D -> Navigation2D -> Navigation2D
+hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
+  where
+    applyToBoth f g a b c = f a b c <|> g a b c
+
+{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
+hybridNavigation :: Navigation2D
+hybridNavigation = hybridOf lineNavigation centerNavigation
+
+-- | 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
+
+-- x -y w h format is a pain. Let's use side coordinates. We assume x1 <= x2 and
+-- y1 <= y2, and make the assumption valid by initialising SideRects with the
+-- property and carefully preserving it over any individual transformation.
+data SideRect = SideRect { x1 :: Int, x2 :: Int, y1 :: Int, y2 :: Int }
+  deriving Show
+
+-- Conversion from Rectangle format to SideRect.
+toSR :: Rectangle -> SideRect
+toSR (Rectangle x y w h) = SideRect (fi x) (fi x + fi w) (-fi y - fi h) (-fi y)
+
+-- Implements side navigation with bias.
+doSideNavigationWithBias ::
+  Eq a => Int -> Direction2D -> Rect a -> [Rect a] -> Maybe a
+doSideNavigationWithBias bias dir (cur, rect)
+  = fmap fst . listToMaybe
+  . L.sortBy (comparing dist) . foldr acClosest []
+  . filter (`toRightOf` (cur, transform rect))
+  . map (fmap transform)
+  where
+    -- Getting the center of the current window so we can make it the new origin.
+    cOf r = ((x1 r + x2 r) `div` 2, (y1 r + y2 r) `div` 2)
+    (x0, y0) = cOf . toSR $ rect
+
+    -- Translate the given SideRect by (-x0, -y0).
+    translate r = SideRect (x1 r - x0) (x2 r - x0) (y1 r - y0) (y2 r - y0)
+
+    -- Rotate the given SideRect 90 degrees counter-clockwise about the origin.
+    rHalfPiCC r = SideRect (-y2 r) (-y1 r) (x1 r) (x2 r)
+
+    -- Apply the above function until d becomes synonymous with R (wolog).
+    rotateToR d = let (_, _:l) = break (d ==) [U, L, D, R]
+                  in  foldr (const $ (.) rHalfPiCC) id l
+
+    transform = rotateToR dir . translate . toSR
+
+    -- (_, r) `toRightOf` (_, c) iff r has points to the right of c that aren't
+    -- below or above c, i.e. iff:
+    -- [x1 r, x2 r] x [y1 r, y2 r] intersects (x2 c, infinity) x (y1 c, y2 c)
+    toRightOf (_, r) (_, c) = (x2 r > x2 c) && (y2 r > y1 c) && (y1 r < y2 c)
+
+    -- Greedily accumulate the windows tied for the leftmost left side.
+    acClosest (w, r) l@((_, r'):_) | x1 r == x1 r' = (w, r) : l
+                                   | x1 r >  x1 r' =          l
+    acClosest (w, r) _                             = (w, r) : []
+
+    -- Given a (_, SideRect), calculate how far it is from the y=bias line.
+    dist (_, r) | (y1 r <= bias) && (bias <= y2 r) = 0
+                | otherwise = min (abs $ y1 r - bias) (abs $ y2 r - bias)
+
+-- | Swaps the current window with the window given as argument
+swap :: Window -> WindowSet -> WindowSet
+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/NoBorders.hs

@@ -0,0 +1,33 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.NoBorders
+-- Copyright   :  (c) Lukas Mai
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Lukas Mai <l.mai@web.de>
+-- Stability   :  stable
+-- Portability :  unportable
+--
+-- This module provides helper functions for dealing with window borders.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.NoBorders (
+    toggleBorder
+) where
+
+import XMonad
+
+-- | Toggle the border of the currently focused window. To use it, add a
+-- keybinding like so:
+--
+-- > , ((modm,  xK_g ),   withFocused toggleBorder)
+--
+toggleBorder :: Window -> X ()
+toggleBorder w = do
+    bw <- asks (borderWidth . config)
+    withDisplay $ \d -> io $ do
+        cw <- wa_border_width `fmap` getWindowAttributes d w
+        if cw == 0
+            then setWindowBorderWidth d w bw
+            else setWindowBorderWidth d w 0

XMonad/Actions/OnScreen.hs

@@ -0,0 +1,188 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.OnScreen
+-- Copyright   :  (c) 2009 Nils Schweinsberg
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Control workspaces on different screens (in xinerama mode).
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.OnScreen (
+    -- * Usage
+    -- $usage
+      onScreen
+    , onScreen'
+    , Focus(..)
+    , viewOnScreen
+    , greedyViewOnScreen
+    , onlyOnScreen
+    , toggleOnScreen
+    , toggleGreedyOnScreen
+    ) where
+
+import XMonad
+import XMonad.StackSet hiding (new)
+
+import Control.Monad (guard)
+-- import Control.Monad.State.Class (gets)
+import Data.Maybe (fromMaybe)
+
+
+-- | Focus data definitions
+data Focus = FocusNew                       -- ^ always focus the new screen
+           | FocusCurrent                   -- ^ always keep the focus on the current screen
+           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack
+           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack
+
+
+-- | Run any function that modifies the stack on a given screen. This function
+-- will also need to know which Screen to focus after the function has been
+-- run.
+onScreen :: (WindowSet -> WindowSet) -- ^ function to run
+         -> Focus                    -- ^ what to do with the focus
+         -> ScreenId                 -- ^ screen id
+         -> WindowSet                -- ^ current stack
+         -> WindowSet
+onScreen f foc sc st = fromMaybe st $ do
+    ws <- lookupWorkspace sc st
+
+    let fStack      = f $ view ws st
+
+    return $ setFocus foc st fStack
+
+
+-- set focus for new stack
+setFocus :: Focus
+         -> WindowSet -- ^ old stack
+         -> WindowSet -- ^ new stack
+         -> WindowSet
+setFocus FocusNew _ new             = new
+setFocus FocusCurrent old new        =
+    case lookupWorkspace (screen $ current old) new of
+         Nothing -> new
+         Just i -> view i new
+setFocus (FocusTag i) _ new         = view i new
+setFocus (FocusTagVisible i) old new =
+    if i `elem` map (tag . workspace) (visible old)
+       then setFocus (FocusTag i) old new
+       else setFocus FocusCurrent old new
+
+-- | A variation of @onScreen@ which will take any @X ()@ function and run it
+-- on the given screen.
+-- Warning: This function will change focus even if the function it's supposed
+-- to run doesn't succeed.
+onScreen' :: X ()       -- ^ X function to run
+          -> Focus      -- ^ focus
+          -> ScreenId   -- ^ screen id
+          -> X ()
+onScreen' x foc sc = do
+    st <- gets windowset
+    case lookupWorkspace sc st of
+         Nothing -> return ()
+         Just ws -> do
+             windows $ view ws
+             x
+             windows $ setFocus foc st
+
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to
+-- switch focus to the workspace @i@.
+viewOnScreen :: ScreenId    -- ^ screen id
+             -> WorkspaceId -- ^ index of the workspace
+             -> WindowSet   -- ^ current stack
+             -> WindowSet
+viewOnScreen sid i =
+    onScreen (view i) (FocusTag i) sid
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @greedyView@
+-- to switch the current workspace with workspace @i@.
+greedyViewOnScreen :: ScreenId    -- ^ screen id
+                   -> WorkspaceId -- ^ index of the workspace
+                   -> WindowSet   -- ^ current stack
+                   -> WindowSet
+greedyViewOnScreen sid i =
+    onScreen (greedyView i) (FocusTagVisible i) sid
+
+-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.
+onlyOnScreen :: ScreenId    -- ^ screen id
+             -> WorkspaceId -- ^ index of the workspace
+             -> WindowSet   -- ^ current stack
+             -> WindowSet
+onlyOnScreen sid i =
+    onScreen (view i) FocusCurrent sid
+
+-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
+toggleOnScreen :: ScreenId    -- ^ screen id
+               -> WorkspaceId -- ^ index of the workspace
+               -> WindowSet   -- ^ current stack
+               -> WindowSet
+toggleOnScreen sid i =
+    onScreen (toggleOrView' view i) FocusCurrent sid
+
+-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
+toggleGreedyOnScreen :: ScreenId    -- ^ screen id
+                     -> WorkspaceId -- ^ index of the workspace
+                     -> WindowSet   -- ^ current stack
+                     -> WindowSet
+toggleGreedyOnScreen sid i =
+    onScreen (toggleOrView' greedyView i) FocusCurrent sid
+
+
+-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip
+toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet)   -- ^ function to run
+              -> WorkspaceId                               -- ^ tag to look for
+              -> WindowSet                                 -- ^ current stackset
+              -> WindowSet
+toggleOrView' f i st = fromMaybe (f i st) $ do
+    let st' = hidden st
+    -- make sure we actually have to do something
+    guard $ i == (tag . workspace $ current st)
+    guard $ not (null st')
+    -- finally, toggle!
+    return $ f (tag . head $ st') st
+
+
+-- $usage
+--
+-- This module provides an easy way to control, what you see on other screens in
+-- xinerama mode without having to focus them. Put this into your
+-- @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.OnScreen
+--
+-- Then add the appropriate keybindings, for example replace your current keys
+-- to switch the workspaces with this at the bottom of your keybindings:
+--
+-- >     ++
+-- >     [ ((m .|. modm, k), windows (f i))
+-- >       | (i, k) <- zip (workspaces conf) ([xK_1 .. xK_9] ++ [xK_0])
+-- >       , (f, m) <- [ (viewOnScreen 0, 0)
+-- >                   , (viewOnScreen 1, controlMask)
+-- >                   , (greedyView, controlMask .|. shiftMask) ]
+-- >     ]
+--
+-- This will provide you with the following keybindings:
+--
+--      * modkey + 1-0:
+--      Switch to workspace 1-0 on screen 0
+--
+--      * modkey + control + 1-0:
+--      Switch to workspace 1-0 on screen 1
+--
+--      * modkey + control + shift + 1-0:
+--      Default greedyView behaviour
+--
+--
+-- A more basic version inside the default keybindings would be:
+--
+-- >        , ((modm .|. controlMask, xK_1), windows (viewOnScreen 0 "1"))
+--
+-- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".

XMonad/Actions/PerWorkspaceKeys.hs

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.PerWorkspaceKeys
+-- Copyright   :  (c) Roman Cheplyaka, 2008
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Roman Cheplyaka <roma@ro-che.info>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Define key-bindings on per-workspace basis.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.PerWorkspaceKeys (
+                                 -- * Usage
+                                 -- $usage
+                                 chooseAction,
+                                 bindOn
+                                ) where
+
+import XMonad
+import XMonad.StackSet as S
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >  import XMonad.Actions.PerWorkspaceKeys
+--
+-- >   ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")])
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Uses supplied function to decide which action to run depending on current workspace name.
+chooseAction :: (String->X()) -> X()
+chooseAction f = withWindowSet (f . S.currentTag)
+
+-- | If current workspace is listed, run appropriate action (only the first match counts!)
+-- If it isn't listed, then run default action (marked with empty string, \"\"), or do nothing if default isn't supplied.
+bindOn :: [(String, X())] -> X()
+bindOn bindings = chooseAction chooser where
+    chooser ws = case lookup ws bindings of
+        Just action -> action
+        Nothing -> case lookup "" bindings of
+            Just action -> action
+            Nothing -> return ()
+

XMonad/Actions/PhysicalScreens.hs

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

XMonad/Actions/Plane.hs

@@ -0,0 +1,230 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Plane
+-- Copyright   :  (c) Marco Túlio Gontijo e Silva <marcot@riseup.net>,
+--                    Leonardo Serra <leoserra@minaslivre.org>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Marco Túlio Gontijo e Silva <marcot@riseup.net>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- This module has functions to navigate through workspaces in a bidimensional
+-- manner.  It allows the organization of workspaces in lines, and provides
+-- functions to move and shift windows in all four directions (left, up, right
+-- and down) possible in a surface.
+--
+-- This functionality was inspired by GNOME (finite) and KDE (infinite)
+-- keybindings for workspace navigation, and by "XMonad.Actions.CycleWS" for
+-- the idea of applying this approach to XMonad.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Plane
+    (
+    -- * Usage
+    -- $usage
+
+    -- * Data types
+    Direction (..)
+    , Limits (..)
+    , Lines (..)
+
+    -- * Key bindings
+    , planeKeys
+
+    -- * Navigating through workspaces
+    , planeShift
+    , planeMove
+    )
+    where
+
+import Control.Monad
+import Data.List
+import Data.Map hiding (split)
+import Data.Maybe
+
+import XMonad
+import XMonad.StackSet hiding (workspaces)
+import XMonad.Util.Run
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
+--
+-- > import XMonad.Actions.Plane
+-- > import Data.Map (union)
+-- >
+-- > main = xmonad def {keys = myKeys}
+-- >
+-- > myKeys conf = union (keys def conf) $ myNewKeys conf
+-- >
+-- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Direction to go in the plane.
+data Direction =  ToLeft | ToUp | ToRight | ToDown deriving Enum
+
+-- | Defines the behaviour when you're trying to move out of the limits.
+data Limits
+    = Finite   -- ^ Ignore the function call, and keep in the same workspace.
+    | Circular -- ^ Get on the other side, like in the Snake game.
+    | Linear   -- ^ The plan comes as a row, so it goes to the next or prev if
+               -- the workspaces were numbered.
+    deriving Eq
+
+-- | The number of lines in which the workspaces will be arranged.  It's
+-- possible to use a number of lines that is not a divisor of the number of
+-- workspaces, but the results are better when using a divisor.  If it's not a
+-- divisor, the last line will have the remaining workspaces.
+data Lines
+    = GConf     -- ^ Use @gconftool-2@ to find out the number of lines.
+    | Lines Int -- ^ Specify the number of lines explicitly.
+
+-- | This is the way most people would like to use this module.  It attaches the
+-- 'KeyMask' passed as a parameter with 'xK_Left', 'xK_Up', 'xK_Right' and
+-- 'xK_Down', associating it with 'planeMove' to the corresponding 'Direction'.
+-- It also associates these bindings with 'shiftMask' to 'planeShift'.
+planeKeys :: KeyMask -> Lines -> Limits -> Map (KeyMask, KeySym) (X ())
+planeKeys modm ln limits =
+  fromList $
+  [ ((keyMask, keySym), function ln limits direction)
+  | (keySym, direction) <- zip [xK_Left .. xK_Down] $ enumFrom ToLeft
+  , (keyMask, function) <- [(modm, planeMove), (shiftMask .|. modm, planeShift)]
+  ]
+
+-- | Shift a window to the next workspace in 'Direction'.  Note that this will
+-- also move to the next workspace.  It's a good idea to use the same 'Lines'
+-- and 'Limits' for all the bindings.
+planeShift :: Lines -> Limits -> Direction -> X ()
+planeShift = plane shift'
+
+shift' ::
+    (Eq s, Eq i, Ord a) => i -> StackSet i l a s sd -> StackSet i l a s sd
+shift' area = greedyView area . shift area
+
+-- | Move to the next workspace in 'Direction'.
+planeMove :: Lines -> Limits -> Direction -> X ()
+planeMove = plane greedyView
+
+plane ::
+    (WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
+    X ()
+plane function numberLines_ limits direction = do
+    st <- get
+    xconf <- ask
+
+    numberLines <-
+        liftIO $
+        case numberLines_ of
+            Lines numberLines__ ->
+                return numberLines__
+            GConf               ->
+                do
+                    numberLines__ <-
+                        runProcessWithInput gconftool parameters ""
+                    case reads numberLines__ of
+                        [(numberRead, _)] -> return numberRead
+                        _                 ->
+                            do
+                                trace $
+                                    "XMonad.Actions.Plane: Could not parse the output of " ++ gconftool ++
+                                    unwords parameters ++ ": " ++ numberLines__ ++ "; assuming 1."
+                                return 1
+
+    let
+        notBorder :: Bool
+        notBorder = (replicate 2 (circular_ < currentWS) ++ replicate 2 (circular_ > currentWS)) !! fromEnum direction
+
+        circular_ :: Int
+        circular_ = circular currentWS
+
+        circular :: Int -> Int
+        circular =
+            [ onLine   pred
+            , onColumn pred
+            , onLine   succ
+            , onColumn succ
+            ]
+            !! fromEnum direction
+
+        linear :: Int -> Int
+        linear =
+            [ onLine   pred . onColumn pred
+            , onColumn pred . onLine pred
+            , onLine   succ . onColumn succ
+            , onColumn succ . onLine succ
+            ]
+            !! fromEnum direction
+
+        onLine :: (Int -> Int) -> Int -> Int
+        onLine f currentWS_
+            | line < areasLine = mod_ columns
+            | otherwise        = mod_ areasColumn
+            where
+                line, column :: Int
+                (line, column) = split currentWS_
+
+                mod_ :: Int -> Int
+                mod_ columns_ = compose line $ mod (f column) columns_
+
+        onColumn :: (Int -> Int) -> Int -> Int
+        onColumn f currentWS_
+            | column < areasColumn || areasColumn == 0  = mod_ numberLines
+            | otherwise                                 = mod_ $ pred numberLines
+            where
+                line, column :: Int
+                (line, column) = split currentWS_
+
+                mod_ :: Int -> Int
+                mod_ lines_ = compose (mod (f line) lines_) column
+
+        compose :: Int -> Int -> Int
+        compose line column = line * columns + column
+
+        split :: Int -> (Int, Int)
+        split currentWS_ =
+            (operation div, operation mod)
+            where
+                operation :: (Int -> Int -> Int) -> Int
+                operation f = f currentWS_ columns
+
+        areasLine :: Int
+        areasLine = div areas columns
+
+        areasColumn :: Int
+        areasColumn = mod areas columns
+
+        columns :: Int
+        columns =
+            if mod areas numberLines == 0 then preColumns else preColumns + 1
+
+        currentWS :: Int
+        currentWS = fromJust mCurrentWS
+
+        preColumns :: Int
+        preColumns = div areas numberLines
+
+        mCurrentWS :: Maybe Int
+        mCurrentWS = elemIndex (currentTag $ windowset st) areaNames
+
+        areas :: Int
+        areas = length areaNames
+
+        run :: (Int -> Int) -> X ()
+        run f = windows $ function $ areaNames !! f currentWS
+
+        areaNames :: [String]
+        areaNames = workspaces $ config xconf
+
+    when (isJust mCurrentWS) $
+        case limits of
+        Finite   -> when notBorder $ run circular
+        Circular -> run circular
+        Linear -> if notBorder then run circular else run linear
+
+gconftool :: String
+gconftool = "gconftool-2"
+
+parameters :: [String]
+parameters = ["--get", "/apps/panel/applets/workspace_switcher_screen0/prefs/num_rows"]

XMonad/Actions/Promote.hs

@@ -0,0 +1,49 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Promote
+-- Copyright   :  (c) Miikka Koskinen 2007
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  xmonad@s001.ethrael.com
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Alternate promote function for xmonad.
+--
+-- Moves the focused window to the master pane. All other windows
+-- retain their order. If focus is in the master, swap it with the
+-- next window in the stack. Focus stays in the master.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Promote (
+                                 -- * Usage
+                                 -- $usage
+                                 promote
+                                ) where
+
+import XMonad
+import XMonad.StackSet
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.Promote
+--
+-- then add a keybinding or substitute 'promote' in place of swapMaster:
+--
+-- >   , ((modm,               xK_Return), promote)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Move the focused window to the master pane. All other windows
+--   retain their order. If focus is in the master, swap it with the
+--   next windo in the stack. Focus stays in the master.
+promote :: X ()
+promote = windows $ modify' $
+          \c -> case c of
+                Stack _ [] []     -> c
+                Stack t [] (x:rs) -> Stack x [] (t:rs)
+                Stack t ls rs     -> Stack t [] (reverse ls ++ rs)

XMonad/Actions/RandomBackground.hs

@@ -0,0 +1,72 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.RandomBackground
+-- Copyright   :  (c) 2009 Anze Slosar
+--                translation to Haskell by Adam Vogt
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  <vogt.adam@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- An action to start terminals with a random background color
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.RandomBackground (
+    -- * Usage
+    -- $usage
+    randomBg',
+    randomBg,
+    RandomColor(HSV,RGB)
+    ) where
+
+import XMonad(X, XConf(config), XConfig(terminal), io, spawn,
+              MonadIO, asks)
+import System.Random
+import Control.Monad(liftM)
+import Numeric(showHex)
+
+-- $usage
+--
+-- Add to your keybindings something like:
+--
+-- > ,((modm .|. shiftMask, xK_Return), randomBg $ HSV 0xff 0x20
+
+-- | RandomColor fixes constraints when generating random colors. All
+-- parameters should be in the range 0 -- 0xff
+data RandomColor = RGB { _colorMin :: Int
+                       , _colorMax :: Int
+                       } -- ^ specify the minimum and maximum lowest values for each color channel.
+                 | HSV { _colorSaturation :: Double
+                       , _colorValue :: Double
+                       } -- ^ specify the saturation and value, leaving the hue random.
+
+toHex :: [Int] -> String
+toHex =  ("'#"++) . (++"'") . concatMap (ensure 2 . ($ "") . showHex)
+    where ensure x = reverse . take x . (++repeat '0') . reverse
+
+randPermutation ::  (RandomGen g) => [a] -> g -> [a]
+randPermutation xs g = swap $ zip (randoms g) xs
+  where
+    swap ((True,x):(c,y):ys) = y:swap ((c,x):ys)
+    swap ((False,x):ys) = x:swap ys
+    swap x = map snd x
+
+-- | @randomBg'@ produces a random hex number in the form @'#xxyyzz'@
+randomBg' ::  (MonadIO m) => RandomColor -> m String
+randomBg' (RGB l h) = io $ liftM (toHex . take 3 . randomRs (l,h)) newStdGen
+randomBg' (HSV s v) = io $ do
+    g <- newStdGen
+    let x = (^(2::Int)) $ fst $ randomR (0,sqrt $ pi / 3) g
+    return $ toHex $ map round $ randPermutation [v,(v-s)*x + s,s] g
+
+-- | @randomBg@ starts a terminal with the background color taken from 'randomBg''
+--
+-- This depends on the your 'terminal' configuration field accepting an
+-- argument like @-bg '#ff0023'@
+randomBg :: RandomColor -> X ()
+randomBg x = do
+    t <- asks (terminal . config)
+    c <- randomBg' x
+    spawn $ t ++ " -bg " ++ c

XMonad/Actions/RotSlaves.hs

@@ -0,0 +1,62 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.RotSlaves
+-- Copyright    : (c) Hans Philipp Annen <haphi@gmx.net>, Mischa Dieterle <der_m@freenet.de>
+-- License      : BSD3-style (see LICENSE)
+--
+-- Maintainer   : Hans Philipp Annen <haphi@gmx.net>
+-- Stability    : stable
+-- Portability  : unportable
+--
+-- Rotate all windows except the master window and keep the focus in
+-- place.
+-----------------------------------------------------------------------------
+module XMonad.Actions.RotSlaves (
+        -- $usage
+        rotSlaves', rotSlavesUp, rotSlavesDown,
+        rotAll', rotAllUp, rotAllDown
+        ) where
+
+import XMonad.StackSet
+import XMonad
+
+-- $usage
+--
+-- To use this module, import it with:
+--
+-- > import XMonad.Actions.RotSlaves
+--
+-- and add whatever keybindings you would like, for example:
+--
+-- > , ((modm .|. shiftMask, xK_Tab   ), rotSlavesUp)
+--
+-- This operation will rotate all windows except the master window,
+-- while the focus stays where it is. It is useful together with the
+-- TwoPane layout (see "XMonad.Layout.TwoPane").
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Rotate the windows in the current stack, excluding the first one
+--   (master).
+rotSlavesUp,rotSlavesDown :: X ()
+rotSlavesUp   = windows $ modify' (rotSlaves' (\l -> (tail l)++[head l]))
+rotSlavesDown = windows $ modify' (rotSlaves' (\l -> [last l]++(init l)))
+
+-- | The actual rotation, as a pure function on the window stack.
+rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
+rotSlaves' _ s@(Stack _ [] []) = s
+rotSlaves' f   (Stack t [] rs) = Stack t [] (f rs)                -- Master has focus
+rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs'    -- otherwise
+    where  (master:ws)     = integrate s
+           (revls',t':rs') = splitAt (length ls) (master:(f ws))
+
+-- | Rotate all the windows in the current stack.
+rotAllUp,rotAllDown :: X ()
+rotAllUp   = windows $ modify' (rotAll' (\l -> (tail l)++[head l]))
+rotAllDown = windows $ modify' (rotAll' (\l -> [last l]++(init l)))
+
+-- | The actual rotation, as a pure function on the window stack.
+rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
+rotAll' f s = Stack r (reverse revls) rs
+    where (revls,r:rs) = splitAt (length (up s)) (f (integrate s))

XMonad/Actions/Search.hs

@@ -0,0 +1,387 @@
+{- | Module      :  XMonad.Actions.Search
+   Copyright   :  (C) 2007 Gwern Branwen
+   License     :  None; public domain
+
+   Maintainer  :  <gwern0@gmail.com>
+   Stability   :  unstable
+   Portability :  unportable; depends on XSelection, XPrompt
+
+   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>.
+
+   Additional sites welcomed. -}
+module XMonad.Actions.Search (   -- * Usage
+                                 -- $usage
+                                 search,
+                                 SearchEngine(..),
+                                 searchEngine,
+                                 searchEngineF,
+                                 promptSearch,
+                                 promptSearchBrowser,
+                                 selectSearch,
+                                 selectSearchBrowser,
+                                 isPrefixOf,
+                                 escape,
+                                 use,
+                                 intelligent,
+                                 (!>),
+                                 prefixAware,
+                                 namedEngine,
+
+                                 amazon,
+                                 alpha,
+                                 codesearch,
+                                 deb,
+                                 debbts,
+                                 debpts,
+                                 dictionary,
+                                 google,
+                                 hackage,
+                                 hoogle,
+                                 images,
+                                 imdb,
+                                 isohunt,
+                                 lucky,
+                                 maps,
+                                 mathworld,
+                                 openstreetmap,
+                                 scholar,
+                                 stackage,
+                                 thesaurus,
+                                 wayback,
+                                 wikipedia,
+                                 wiktionary,
+                                 youtube,
+                                 vocabulary,
+                                 duckduckgo,
+                                 multi,
+                                  -- * Use case: searching with a submap
+                                  -- $tip
+
+                                  -- * Types
+                                 Browser, Site, Query, Name, Search
+                          ) where
+
+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
+
+   This module is intended to allow easy access to databases on the
+   Internet through xmonad's interface. The idea is that one wants to
+   run a search but the query string and the browser to use must come
+   from somewhere. There are two places the query string can come from
+   - the user can type it into a prompt which pops up, or the query
+   could be available already in the X Windows copy\/paste buffer
+   (perhaps you just highlighted the string of interest).
+
+   Thus, there are two main functions: 'promptSearch', and
+   'selectSearch' (implemented using the more primitive 'search'). To
+   each of these is passed an engine function; this is a function that
+   knows how to search a particular site.
+
+   For example, the 'google' function knows how to search Google, and
+   so on. You pass 'promptSearch' and 'selectSearch' the engine you
+   want, the browser you want, and anything special they might need;
+   this whole line is then bound to a key of you choosing in your
+   xmonad.hs. For specific examples, see each function.  This module
+   is easily extended to new sites by using 'searchEngine'.
+
+   The currently available search engines are:
+
+* 'amazon' -- Amazon keyword search.
+
+* 'alpha' -- Wolfram|Alpha query.
+
+* 'codesearch' -- Google Labs Code Search search.
+
+* 'deb'    -- Debian package search.
+
+* 'debbts' -- Debian Bug Tracking System.
+
+* 'debpts'  -- Debian Package Tracking System.
+
+* 'dictionary' -- dictionary.reference.com search.
+
+* 'google' -- basic Google search.
+
+* 'hackage' -- Hackage, the Haskell package database.
+
+* '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.
+
+* 'isohunt' -- isoHunt search.
+
+* 'lucky' -- Google "I'm feeling lucky" search.
+
+* 'maps'   -- Google maps.
+
+* 'mathworld' -- Wolfram MathWorld search.
+
+* 'openstreetmap' -- OpenStreetMap free wiki world map.
+
+* 'scholar' -- Google scholar academic search.
+
+* 'thesaurus' -- thesaurus.reference.com search.
+
+* 'wayback' -- the Wayback Machine.
+
+* 'wikipedia' -- basic Wikipedia search.
+
+* '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! -}
+
+{- $tip
+
+In combination with "XMonad.Actions.Submap" you can create a powerful
+and easy way to search without adding a whole bunch of bindings.
+
+First import the necessary modules:
+
+> import qualified XMonad.Prompt         as P
+> import qualified XMonad.Actions.Submap as SM
+> import qualified XMonad.Actions.Search as S
+
+Then add the following to your key bindings:
+
+> ...
+> -- Search commands
+> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def)
+> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)
+>
+> ...
+>
+> searchEngineMap method = M.fromList $
+>       [ ((0, xK_g), method S.google)
+>       , ((0, xK_h), method S.hoogle)
+>       , ((0, xK_w), method S.wikipedia)
+>       ]
+
+Or in combination with XMonad.Util.EZConfig:
+
+> ...
+> ] -- end of regular keybindings
+> -- Search commands
+> ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ]
+> ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ]
+>
+> ...
+>
+> searchList :: [(String, S.SearchEngine)]
+> searchList = [ ("g", S.google)
+>              , ("h", S.hoohle)
+>              , ("w", S.wikipedia)
+>              ]
+
+Make sure to set firefox to open new pages in a new window instead of
+in a new tab: @Firefox -> Edit -> Preferences -> Tabs -> New pages
+should be opened in...@
+
+Now /mod-s/ + /g/\//h/\//w/ prompts you for a search string, then
+opens a new firefox window that performs the search on Google, Hoogle
+or Wikipedia respectively.
+
+If you select something in whatever application and hit /mod-shift-s/ +
+/g/\//h/\//w/ it will search the selected string with the specified
+engine.
+
+Happy searching! -}
+
+-- | A customized prompt indicating we are searching, and the name of the site.
+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. Only
+-- digits and ASCII letters are not encoded. All non ASCII characters
+-- which are encoded as UTF8
+escape :: String -> String
+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
+type Site         = String -> String
+type Name         = String
+data SearchEngine = SearchEngine Name Site
+
+-- | Given an already defined search engine, extracts its transformation
+--   function, making it easy to create compound search engines.
+--   For an instance you can use @use google@ to get a function which
+--   makes the same transformation as the google search engine would.
+use :: SearchEngine -> Site
+use (SearchEngine _ engine) = engine
+
+-- | Given a browser, a search engine's transformation function, and a search term, perform the
+--   requested search in the browser.
+search :: Browser -> Site -> Query -> X ()
+search browser site query = safeSpawn browser [site query]
+
+{- | Given a base URL, create the 'SearchEngine' that escapes the query and
+   appends it to the base. You can easily define a new engine locally using
+   exported functions without needing to modify "XMonad.Actions.Search":
+
+> myNewEngine = searchEngine "site" "http://site.com/search="
+
+   The important thing is that the site has a interface which accepts the escaped query
+   string as part of the URL. Alas, the exact URL to feed searchEngine varies
+   from site to site, often considerably, so there\'s no general way to cover this.
+
+   Generally, examining the resultant URL of a search will allow you to reverse-engineer
+   it if you can't find the necessary URL already described in other projects such as Surfraw. -}
+searchEngine :: Name -> String -> SearchEngine
+searchEngine name site = searchEngineF name (\s -> site ++ (escape s))
+
+{- | If your search engine is more complex than this (you may want to identify
+   the kind of input and make the search URL dependent on the input or put the query
+   inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
+
+> searchFunc :: String -> String
+> 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
+
+   @searchFunc@ here searches for a word in wikipedia if it has a prefix
+   of \"wiki:\" (you can use the 'escape' function to escape any forbidden characters), opens an address
+   directly if it starts with \"http:\/\/\" and otherwise uses the provided google search engine.
+   You can use other engines inside of your own through the 'use' function as shown above to make
+   complex searches.
+
+   The user input will be automatically escaped in search engines created with 'searchEngine',
+   'searchEngineF', however, completely depends on the transformation function passed to it. -}
+searchEngineF :: Name -> Site -> SearchEngine
+searchEngineF = SearchEngine
+
+-- The engines.
+amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
+  images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
+  youtube, duckduckgo :: SearchEngine
+amazon        = searchEngine "amazon"        "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
+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, 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
+   searching.
+
+> myIntelligentGoogleEngine = intelligent google
+
+   Now if you search for http:\/\/xmonad.org it will directly open in your browser-}
+intelligent :: SearchEngine -> SearchEngine
+intelligent (SearchEngine name site) = searchEngineF name (\s -> if (fst $ break (==':') s) `elem` ["http", "https", "ftp"] then s else (site s))
+
+-- | > removeColonPrefix "foo://bar" ~> "//bar"
+-- > removeColonPrefix "foo//bar" ~> "foo//bar"
+removeColonPrefix :: String -> String
+removeColonPrefix s = if ':' `elem` s then drop 1 $ dropWhile (':' /=) s else s
+
+{- | Connects a few search engines into one. If the search engines\' names are
+   \"s1\", \"s2\" and \"s3\", then the resulting engine will use s1 if the query
+   is @s1:word@, s2 if you type @s2:word@ and s3 in all other cases.
+
+   Example:
+
+> multiEngine = intelligent (wikipedia !> mathworld !> (prefixAware google))
+
+  Now if you type \"wiki:Haskell\" it will search for \"Haskell\" in Wikipedia,
+  \"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 (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 (name++":") `isPrefixOf` s then site $ removeColonPrefix s else site s)
+
+{- | Changes search engine's name -}
+namedEngine :: Name -> SearchEngine -> SearchEngine
+namedEngine name (SearchEngine _ site) = searchEngineF name site
+
+{- | Like 'search', but for use with the output from a Prompt; it grabs the
+   Prompt's result, passes it to a given searchEngine and opens it in a given
+   browser. -}
+promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
+promptSearchBrowser config browser (SearchEngine name site) =
+    mkXPrompt (Search name) config (historyCompletionP ("Search [" `isPrefixOf`)) $ search browser site
+
+{- | Like 'search', but in this case, the string is not specified but grabbed
+ from the user's response to a prompt. Example:
+
+> , ((modm, xK_g), promptSearch greenXPConfig google)
+
+   This specializes "promptSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+promptSearch :: XPConfig -> SearchEngine -> X ()
+promptSearch config engine = liftIO getBrowser >>= \ browser -> promptSearchBrowser config browser engine
+
+-- | Like 'search', but for use with the X selection; it grabs the selection,
+--   passes it to a given searchEngine and opens it in a given browser.
+selectSearchBrowser :: Browser -> SearchEngine -> X ()
+selectSearchBrowser browser (SearchEngine _ site) = search browser site =<< getSelection
+
+{- | Like 'search', but for use with the X selection; it grabs the selection,
+   passes it to a given searchEngine and opens it in the default browser . Example:
+
+> , ((modm .|. shiftMask, xK_g), selectSearch google)
+
+   This specializes "selectSearchBrowser" by supplying the browser argument as
+   supplied by 'getBrowser' from "XMonad.Prompt.Shell". -}
+selectSearch :: SearchEngine -> X ()
+selectSearch engine = liftIO getBrowser >>= \browser -> selectSearchBrowser browser engine

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

@@ -1,9 +1,9 @@
 -----------------------------------------------------------------------------
 -- |
--- Module      :  XMonadContrib.SimpleDate
+-- Module      :  XMonad.Actions.SimpleDate
 -- Copyright   :  (c) Don Stewart 2007
 -- License     :  BSD3-style (see LICENSE)
--- 
+--
 -- Maintainer  :  dons@cse.unsw.edu.au
 -- Stability   :  stable
 -- Portability :  portable
@@ -13,24 +13,28 @@
 --
 -----------------------------------------------------------------------------
 
-module XMonadContrib.SimpleDate (
+module XMonad.Actions.SimpleDate (
                                  -- * Usage
                                  -- $usage
                                  date
                                 ) where
 
-import XMonad
+import XMonad.Core
+import XMonad.Util.Run
 
 -- $usage
--- To use, modify your Config.hs to:
+-- To use, import this module into @~\/.xmonad\/xmonad.hs@:
 --
--- >     import XMonadContrib.SimpleDate
+-- >     import XMonad.Actions.SimpleDate
 --
--- and add a keybinding:
+-- and add a keybinding, for example:
 --
--- >    , ((modMask,               xK_d     ), date)
+-- >    , ((modm,               xK_d     ), date)
 --
--- a popup date menu will now be bound to mod-d
+-- In this example, a popup date menu will now be bound to @mod-d@.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
 
 date :: X ()
-date = spawn "(date; sleep 10) | dzen2"
+date = unsafeSpawn "(date; sleep 10) | dzen2"

XMonad/Actions/SinkAll.hs

@@ -0,0 +1,34 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.SinkAll
+-- License      : BSD3-style (see LICENSE)
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides a simple binding that pushes all floating windows on the
+-- current workspace back into tiling.  Note that the functionality of
+-- this module has been folded into the more general
+-- "XMonad.Actions.WithAll"; this module simply re-exports the
+-- 'sinkAll' function for backwards compatibility.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SinkAll (
+    -- * Usage
+    -- $usage
+
+    sinkAll) where
+
+import XMonad.Actions.WithAll (sinkAll)
+
+-- $usage
+--
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.SinkAll
+--
+-- then add a keybinding; for example:
+--
+-- >   , ((modm .|. shiftMask, xK_t), sinkAll)
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".

XMonad/Actions/SpawnOn.hs

@@ -0,0 +1,161 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.SpawnOn
+-- Copyright    : (c) Spencer Janssen
+-- License      : BSD
+--
+-- Maintainer   : Spencer Janssen <spencerjanssen@gmail.com>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Provides a way to modify a window spawned by a command(e.g shift it to the workspace
+-- it was launched on) by using the _NET_WM_PID property that most windows set on creation.
+-- Hence this module won't work on applications that don't set this property.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SpawnOn (
+    -- * Usage
+    -- $usage
+    Spawner,
+    manageSpawn,
+    manageSpawnWithGC,
+    spawnHere,
+    spawnOn,
+    spawnAndDo,
+    shellPromptHere,
+    shellPromptOn
+) where
+
+import Control.Exception (tryJust)
+import Control.Monad (guard)
+import Data.List (isInfixOf)
+import Data.Maybe (isJust)
+import System.IO.Error (isDoesNotExistError)
+import System.IO.Unsafe (unsafePerformIO)
+import System.Posix.Types (ProcessID)
+import Text.Printf (printf)
+
+import XMonad
+import qualified XMonad.StackSet as W
+
+import XMonad.Hooks.ManageHelpers
+import XMonad.Prompt
+import XMonad.Prompt.Shell
+import qualified XMonad.Util.ExtensibleState as XS
+
+-- $usage
+-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
+--
+-- >    import XMonad.Actions.SpawnOn
+--
+-- >    main = do
+-- >      xmonad def {
+-- >         ...
+-- >         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 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).
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeable
+
+instance ExtensionClass Spawner where
+    initialValue = Spawner []
+
+
+getPPIDOf :: ProcessID -> Maybe ProcessID
+getPPIDOf pid =
+    case unsafePerformIO . tryJust (guard . isDoesNotExistError) . readFile . printf "/proc/%d/stat" $ toInteger pid of
+      Left _         -> Nothing
+      Right contents -> case lines contents of
+                          []        -> Nothing
+                          first : _ -> case words first of
+                                         _ : _ : _ : ppid : _ -> Just $ fromIntegral (read ppid :: Int)
+                                         _                    -> Nothing
+
+getPPIDChain :: ProcessID -> [ProcessID]
+getPPIDChain pid' = ppid_chain pid' []
+    where ppid_chain pid acc =
+              if pid == 0
+              then acc
+              else case getPPIDOf pid of
+                     Nothing   -> acc
+                     Just ppid -> ppid_chain ppid (ppid : acc)
+
+-- | Get the current Spawner or create one if it doesn't exist.
+modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
+modifySpawner f = XS.modify (Spawner . f . pidsRef)
+
+-- | Provides a manage hook to react on process spawned with
+-- 'spawnOn', 'spawnHere' etc.
+manageSpawn :: ManageHook
+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
+    let ppid_chain = case mp of
+                       Just winpid -> winpid : getPPIDChain winpid
+                       Nothing     -> []
+        known_window_handlers = [ mh
+                                | ppid <- ppid_chain
+                                , let mpid = lookup ppid pids
+                                , isJust mpid
+                                , let (Just mh) = mpid ]
+    case known_window_handlers of
+        [] -> idHook
+        (mh:_)  -> do
+            whenJust mp $ \p -> liftX $ do
+                ps <- XS.gets pidsRef
+                XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
+            mh
+
+mkPrompt :: (String -> X ()) -> XPConfig -> X ()
+mkPrompt cb c = do
+    cmds <- io $ getCommands
+    mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
+
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on current workspace.
+shellPromptHere :: XPConfig -> X ()
+shellPromptHere = mkPrompt spawnHere
+
+-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
+-- application on given workspace.
+shellPromptOn :: WorkspaceId -> XPConfig -> X ()
+shellPromptOn ws = mkPrompt (spawnOn ws)
+
+-- | Replacement for 'spawn' which launches
+-- application on current workspace.
+spawnHere :: String -> X ()
+spawnHere cmd = withWindowSet $ \ws -> spawnOn (W.currentTag ws) cmd
+
+-- | Replacement for 'spawn' which launches
+-- application on given workspace.
+spawnOn :: WorkspaceId -> String -> X ()
+spawnOn ws cmd = spawnAndDo (doShift ws) cmd
+
+-- | Spawn an application and apply the manage hook when it opens.
+spawnAndDo :: ManageHook -> String -> X ()
+spawnAndDo mh cmd = do
+    p <- spawnPID $ mangle cmd
+    modifySpawner $ ((p,mh) :)
+ where
+    -- TODO this is silly, search for a better solution
+    mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
+              | otherwise = "exec " ++ xs
+    metaChars = "&|;"

XMonad/Actions/Submap.hs

@@ -0,0 +1,97 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Submap
+-- Copyright   :  (c) Jason Creighton <jcreigh@gmail.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Jason Creighton <jcreigh@gmail.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- A module that allows the user to create a sub-mapping of key bindings.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.Submap (
+                             -- * Usage
+                             -- $usage
+                             submap,
+                             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)
+
+{- $usage
+
+
+
+
+First, import this module into your @~\/.xmonad\/xmonad.hs@:
+
+> import XMonad.Actions.Submap
+
+Allows you to create a sub-mapping of keys. Example:
+
+>    , ((modm, xK_a), submap . M.fromList $
+>        [ ((0, xK_n),     spawn "mpc next")
+>        , ((0, xK_p),     spawn "mpc prev")
+>        , ((0, xK_z),     spawn "mpc random")
+>        , ((0, xK_space), spawn "mpc toggle")
+>        ])
+
+So, for example, to run 'spawn \"mpc next\"', you would hit mod-a (to
+trigger the submapping) and then 'n' to run that action. (0 means \"no
+modifier\"). You are, of course, free to use any combination of
+modifiers in the submapping. However, anyModifier will not work,
+because that is a special value passed to XGrabKey() and not an actual
+modifier.
+
+For detailed instructions on editing your key bindings, see
+"XMonad.Doc.Extending#Editing_key_bindings".
+
+-}
+
+-- | Given a 'Data.Map.Map' from key bindings to X () actions, return
+--   an action which waits for a user keypress and executes the
+--   corresponding action, or does nothing if the key is not found in
+--   the map.
+submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
+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 = 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 .|. buttonPressMask) p
+        ev <- getEvent p
+        case ev of
+          KeyEvent { ev_keycode = code, ev_state = m } -> do
+            keysym <- keycodeToKeysym d code 0
+            if isModifierKey keysym
+                then nextkey
+                else return (m, keysym)
+          _ -> return (0, 0)
+    -- Remove num lock mask and Xkb group state bits
+    m' <- cleanMask $ m .&. ((1 `shiftL` 12) - 1)
+
+    io $ ungrabPointer d currentTime
+    io $ ungrabKeyboard d currentTime
+
+    fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)

XMonad/Actions/SwapPromote.hs

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

XMonad/Actions/SwapWorkspaces.hs

@@ -0,0 +1,64 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.SwapWorkspaces
+-- Copyright   :  (c) Devin Mullins <me@twifkak.com>
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Stability   :  unstable
+-- Portability :  unportable
+--
+-- Lets you swap workspace tags, so you can keep related ones next to
+-- each other, without having to move individual windows.
+--
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.SwapWorkspaces (
+                                     -- * Usage
+                                     -- $usage
+                                     swapWithCurrent,
+                                     swapTo,
+                                     swapWorkspaces,
+                                     Direction1D(..)
+                                    ) where
+
+import XMonad (windows, X())
+import XMonad.StackSet
+import XMonad.Actions.CycleWS
+import XMonad.Util.WorkspaceCompare
+
+
+-- $usage
+-- Add this import to your @~\/.xmonad\/xmonad.hs@:
+--
+-- > import XMonad.Actions.SwapWorkspaces
+--
+-- Then throw something like this in your keys definition:
+--
+-- > ++
+-- > [((modm .|. controlMask, k), windows $ swapWithCurrent i)
+-- >     | (i, k) <- zip workspaces [xK_1 ..]]
+--
+-- After installing this update, if you're on workspace 1, hitting mod-ctrl-5
+-- will swap workspaces 1 and 5.
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | Swaps the currently focused workspace with the given workspace tag, via
+--   @swapWorkspaces@.
+swapWithCurrent :: Eq i => i -> StackSet i l a s sd -> StackSet i l a s sd
+swapWithCurrent t s = swapWorkspaces t (currentTag s) s
+
+-- | Say @swapTo Next@ or @swapTo Prev@ to move your current workspace.
+-- This is an @X ()@ so can be hooked up to your keybindings directly.
+swapTo :: Direction1D -> X ()
+swapTo dir = findWorkspace getSortByIndex dir AnyWS 1 >>= windows . swapWithCurrent
+
+-- | Takes two workspace tags and an existing XMonad.StackSet and returns a new
+--   one with the two corresponding workspaces' tags swapped.
+swapWorkspaces :: Eq i => i -> i -> StackSet i l a s sd -> StackSet i l a s sd
+swapWorkspaces t1 t2 = mapWorkspace swap
+    where swap w = if      tag w == t1 then w { tag = t2 }
+                   else if tag w == t2 then w { tag = t1 }
+                   else w

XMonad/Actions/TagWindows.hs

@@ -0,0 +1,199 @@
+-----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Actions.TagWindows
+-- Copyright    : (c) Karsten Schoelzel <kuser@gmx.de>
+-- License      : BSD
+--
+-- Maintainer   : Karsten Schoelzel <kuser@gmx.de>
+-- Stability    : unstable
+-- Portability  : unportable
+--
+-- Functions for tagging windows and selecting them by tags.
+-----------------------------------------------------------------------------
+
+module XMonad.Actions.TagWindows (
+                 -- * Usage
+                 -- $usage
+                 addTag, delTag, unTag,
+                 setTags, getTags, hasTag,
+                 withTaggedP,  withTaggedGlobalP, withFocusedP,
+                 withTagged ,  withTaggedGlobal ,
+                 focusUpTagged,   focusUpTaggedGlobal,
+                 focusDownTagged, focusDownTaggedGlobal,
+                 shiftHere, shiftToScreen,
+                 tagPrompt,
+                 tagDelPrompt,
+                 TagPrompt,
+                 ) where
+
+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@:
+--
+-- > import XMonad.Actions.TagWindows
+-- > import XMonad.Prompt    -- to use tagPrompt
+--
+-- and add keybindings such as the following:
+--
+-- >   , ((modm,                 xK_f  ), withFocused (addTag "abc"))
+-- >   , ((modm .|. controlMask, xK_f  ), withFocused (delTag "abc"))
+-- >   , ((modm .|. shiftMask,   xK_f  ), withTaggedGlobalP "abc" W.sink)
+-- >   , ((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 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
+--       the tags \"a\" and \"b\" but not \"a b\".
+--
+-- For detailed instructions on editing your key bindings, see
+-- "XMonad.Doc.Extending#Editing_key_bindings".
+
+-- | set multiple tags for a window at once (overriding any previous tags)
+setTags :: [String] -> Window -> X ()
+setTags = setTag . unwords
+
+-- | set a tag for a window (overriding any previous tags)
+--   writes it to the \"_XMONAD_TAGS\" window property
+setTag :: String -> Window -> X ()
+setTag s w = withDisplay $ \d ->
+    io $ internAtom d "_XMONAD_TAGS" False >>= setTextProperty d w s
+
+-- | read all tags of a window
+--   reads from the \"_XMONAD_TAGS\" window property
+getTags :: Window -> X [String]
+getTags w = withDisplay $ \d ->
+    io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
+                getTextProperty d w >>=
+                wcTextPropertyToTextList d)
+               (econst [[]])
+    >>= return . words . unwords
+
+-- | check a window for the given tag
+hasTag :: String -> Window -> X Bool
+hasTag s w = (s `elem`) `fmap` getTags w
+
+-- | add a tag to the existing ones
+addTag :: String -> Window -> X ()
+addTag s w = do
+    tags <- getTags w
+    if (s `notElem` tags) then setTags (s:tags) w else return ()
+
+-- | remove a tag from a window, if it exists
+delTag :: String -> Window -> X ()
+delTag s w = do
+    tags <- getTags w
+    setTags (filter (/= s) tags) w
+
+-- | remove all tags
+unTag :: Window -> X ()
+unTag = setTag ""
+
+-- | Move the focus in a group of windows, which share the same given tag.
+--   The Global variants move through all workspaces, whereas the other
+--   ones operate only on the current workspace
+focusUpTagged, focusDownTagged, focusUpTaggedGlobal, focusDownTaggedGlobal :: String -> X ()
+focusUpTagged         = focusTagged' (reverse . wsToList)
+focusDownTagged       = focusTagged' wsToList
+focusUpTaggedGlobal   = focusTagged' (reverse . wsToListGlobal)
+focusDownTaggedGlobal = focusTagged' wsToListGlobal
+
+wsToList :: (Ord i) => StackSet i l a s sd -> [a]
+wsToList ws = crs ++ cls
+    where
+        (crs, cls) = (cms down, cms (reverse . up))
+        cms f = maybe [] f (stack . workspace . current $ ws)
+
+wsToListGlobal :: (Ord i) => StackSet i l a s sd -> [a]
+wsToListGlobal ws = concat ([crs] ++ rws ++ lws ++ [cls])
+    where
+        curtag = currentTag ws
+        (crs, cls) = (cms down, cms (reverse . up))
+        cms f = maybe [] f (stack . workspace . current $ ws)
+        (lws, rws) = (mws (<), mws (>))
+        mws cmp = map (integrate' . stack) . sortByTag . filter (\w -> tag w `cmp` curtag) . workspaces $ ws
+        sortByTag = sortBy (\x y -> compare (tag x) (tag y))
+
+focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
+focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
+    maybe (return ()) (windows . focusWindow)
+
+findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+findM _ []      = return Nothing
+findM p (x:xs)  = do b <- p x
+                     if b then return (Just x) else findM p xs
+
+-- | apply a pure function to windows with a tag
+withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
+withTaggedP       t f = withTagged'       t (winMap f)
+withTaggedGlobalP t f = withTaggedGlobal' t (winMap f)
+
+winMap :: (Window -> WindowSet -> WindowSet) -> [Window] -> X ()
+winMap f tw = when (tw /= []) (windows $ foldl1 (.) (map f tw))
+
+withTagged, withTaggedGlobal :: String -> (Window -> X ()) -> X ()
+withTagged       t f = withTagged'       t (mapM_ f)
+withTaggedGlobal t f = withTaggedGlobal' t (mapM_ f)
+
+withTagged' :: String -> ([Window] -> X ()) -> X ()
+withTagged' t m = gets windowset >>= filterM (hasTag t) . index >>= m
+
+withTaggedGlobal' :: String -> ([Window] -> X ()) -> X ()
+withTaggedGlobal' t m = gets windowset >>=
+    filterM (hasTag t) . concat . map (integrate' . stack) . workspaces >>= m
+
+withFocusedP :: (Window -> WindowSet -> WindowSet) -> X ()
+withFocusedP f = withFocused $ windows . f
+
+shiftHere :: (Ord a, Eq s, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftHere w s = shiftWin (currentTag s) w s
+
+shiftToScreen :: (Ord a, Eq s, Eq i) => s -> a -> StackSet i l a s sd -> StackSet i l a s sd
+shiftToScreen sid w s = case filter (\m -> sid /= screen m) ((current s):(visible s)) of
+                                []      -> s
+                                (t:_)   -> shiftWin (tag . workspace $ t) w s
+
+data TagPrompt = TagPrompt
+
+instance XPrompt TagPrompt where
+    showXPrompt TagPrompt = "Select Tag:   "
+
+
+tagPrompt :: XPConfig -> (String -> X ()) -> X ()
+tagPrompt c f = do
+  sc <- tagComplList
+  mkXPrompt TagPrompt c (mkComplFunFromList' sc) f
+
+tagComplList :: X [String]
+tagComplList = gets (concat . map (integrate' . stack) . workspaces . windowset) >>=
+    mapM getTags >>=
+    return . nub . concat
+
+
+tagDelPrompt :: XPConfig -> X ()
+tagDelPrompt c = do
+  sc <- tagDelComplList
+  if (sc /= [])
+    then mkXPrompt TagPrompt c (mkComplFunFromList' sc) (\s -> withFocused (delTag s))
+    else return ()
+
+tagDelComplList :: X [String]
+tagDelComplList = gets windowset >>= maybe (return []) getTags . peek