Merge pull request #935 from xmonad/haskell-ci-update

ci: Regenerate haskell-ci

.github/workflows/haskell-ci-hackage.patch

@@ -38,13 +38,13 @@ set in GitHub repository secrets.
    linux:
      name: Haskell-CI - Linux - ${{ matrix.compiler }}
 @@ -33,6 +40,7 @@
-             compilerVersion: 9.8.1
+             compilerVersion: 9.8.4
              setup-method: ghcup
              allow-failure: false
 +            upload: true
-           - compiler: ghc-9.6.4
+           - compiler: ghc-9.6.7
              compilerKind: ghc
-             compilerVersion: 9.6.4
+             compilerVersion: 9.6.7
 @@ -257,6 +265,10 @@
        - name: haddock
          run: |
@@ -56,19 +56,24 @@ set in GitHub repository secrets.
        - name: unconstrained build
          run: |
            rm -f cabal.project.local
-@@ -267,3 +279,75 @@
+@@ -267,3 +279,80 @@
          with:
            key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
            path: ~/.cabal/store
-+      - name: upload artifacts (sdist)
++      # must be separate artifacts because GitHub Actions are still broken:
++      # https://github.com/actions/upload-artifact/issues/441
++      # https://github.com/actions/upload-artifact/issues/457
++      - name: upload artifact (sdist)
 +        if: matrix.upload
-+        uses: actions/upload-artifact@v3
++        uses: actions/upload-artifact@v4
 +        with:
++          name: sdist
 +          path: ${{ github.workspace }}/sdist/*.tar.gz
-+      - name: upload artifacts (haddock)
++      - name: upload artifact (haddock)
 +        if: matrix.upload
-+        uses: actions/upload-artifact@v3
++        uses: actions/upload-artifact@v4
 +        with:
++          name: haddock
 +          path: ${{ github.workspace }}/haddock/*-docs.tar.gz
 +      - name: hackage upload (candidate)
 +        if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''

.github/workflows/haskell-ci.yml

@@ -8,9 +8,9 @@
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.17.20240109
+# version: 0.19.20250506
 #
-# REGENDATA ("0.17.20240109",["github","cabal.project"])
+# REGENDATA ("0.19.20250506",["github","cabal.project"])
 #
 name: Haskell-CI
 on:
@@ -26,24 +26,34 @@ on:
 jobs:
   linux:
     name: Haskell-CI - Linux - ${{ matrix.compiler }}
-    runs-on: ubuntu-20.04
+    runs-on: ubuntu-24.04
     timeout-minutes:
       60
     container:
-      image: buildpack-deps:bionic
+      image: buildpack-deps:jammy
     continue-on-error: ${{ matrix.allow-failure }}
     strategy:
       matrix:
         include:
-          - compiler: ghc-9.8.1
+          - compiler: ghc-9.12.2
             compilerKind: ghc
-            compilerVersion: 9.8.1
+            compilerVersion: 9.12.2
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.10.2
+            compilerKind: ghc
+            compilerVersion: 9.10.2
+            setup-method: ghcup
+            allow-failure: false
+          - compiler: ghc-9.8.4
+            compilerKind: ghc
+            compilerVersion: 9.8.4
             setup-method: ghcup
             allow-failure: false
             upload: true
-          - compiler: ghc-9.6.4
+          - compiler: ghc-9.6.7
             compilerKind: ghc
-            compilerVersion: 9.6.4
+            compilerVersion: 9.6.7
             setup-method: ghcup
             allow-failure: false
           - compiler: ghc-9.4.8
@@ -69,36 +79,34 @@ jobs:
           - compiler: ghc-8.8.4
             compilerKind: ghc
             compilerVersion: 8.8.4
-            setup-method: hvr-ppa
+            setup-method: ghcup
-            allow-failure: false
-          - compiler: ghc-8.6.5
-            compilerKind: ghc
-            compilerVersion: 8.6.5
-            setup-method: hvr-ppa
             allow-failure: false
       fail-fast: false
     steps:
-      - name: apt
+      - name: apt-get install
         run: |
           apt-get update
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
-          if [ "${{ matrix.setup-method }}" = ghcup ]; then
-            mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
-            chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
-            apt-get update
           apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
-          else
+      - name: Install GHCup
-            apt-add-repository -y 'ppa:hvr/ghc'
+        run: |
-            apt-get update
-            apt-get install -y "$HCNAME" libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
           mkdir -p "$HOME/.ghcup/bin"
-            curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup"
+          curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
           chmod a+x "$HOME/.ghcup/bin/ghcup"
-            "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+      - name: Install cabal-install
-          fi
+        run: |
+          "$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
+          echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
+      - name: Install GHC (GHCup)
+        if: matrix.setup-method == 'ghcup'
+        run: |
+          "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
+          HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
+          HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
+          HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
+          echo "HC=$HC" >> "$GITHUB_ENV"
+          echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
+          echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -109,30 +117,12 @@ jobs:
           echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
           echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
           echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
-          HCDIR=/opt/$HCKIND/$HCVER
-          if [ "${{ matrix.setup-method }}" = ghcup ]; then
-            HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
-            HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
-            HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
-            echo "HC=$HC" >> "$GITHUB_ENV"
-            echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
-            echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
-            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
-          else
-            HC=$HCDIR/bin/$HCKIND
-            echo "HC=$HC" >> "$GITHUB_ENV"
-            echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
-            echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
-            echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
-          fi
-
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
           echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
           echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
           echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
           echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
-          echo "GHCJSARITH=0" >> "$GITHUB_ENV"
         env:
           HCKIND: ${{ matrix.compilerKind }}
           HCNAME: ${{ matrix.compiler }}
@@ -182,7 +172,7 @@ jobs:
           chmod a+x $HOME/.cabal/bin/cabal-plan
           cabal-plan --version
       - name: checkout
-        uses: actions/checkout@v3
+        uses: actions/checkout@v4
         with:
           path: source
       - name: initial cabal.project for sdist
@@ -220,7 +210,7 @@ jobs:
             flags:       +pedantic
             ghc-options: -j
           EOF
-          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
+          $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
           cat cabal.project
           cat cabal.project.local
       - name: dump install plan
@@ -228,7 +218,7 @@ jobs:
           $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
           cabal-plan
       - name: restore cache
-        uses: actions/cache/restore@v3
+        uses: actions/cache/restore@v4
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
@@ -262,20 +252,25 @@ jobs:
           rm -f cabal.project.local
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
       - name: save cache
-        uses: actions/cache/save@v3
         if: always()
+        uses: actions/cache/save@v4
         with:
           key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
-      - name: upload artifacts (sdist)
+      # must be separate artifacts because GitHub Actions are still broken:
+      # https://github.com/actions/upload-artifact/issues/441
+      # https://github.com/actions/upload-artifact/issues/457
+      - name: upload artifact (sdist)
         if: matrix.upload
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
+          name: sdist
           path: ${{ github.workspace }}/sdist/*.tar.gz
-      - name: upload artifacts (haddock)
+      - name: upload artifact (haddock)
         if: matrix.upload
-        uses: actions/upload-artifact@v3
+        uses: actions/upload-artifact@v4
         with:
+          name: haddock
           path: ${{ github.workspace }}/haddock/*-docs.tar.gz
       - name: hackage upload (candidate)
         if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''

.github/workflows/nix.yml

@@ -6,23 +6,21 @@ on:
 
 jobs:
   build:
-    runs-on: ubuntu-20.04  # FIXME
+    runs-on: ubuntu-latest
     name: Nix Flake - Linux
     permissions:
       contents: read
     steps:
       - name: Install Nix
-        uses: cachix/install-nix-action@v25
+        uses: cachix/install-nix-action@v31
         with:
-          install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
+          github_access_token: ${{ secrets.GITHUB_TOKEN }}
-          install_options: '--tarball-url-prefix https://nixos-nix-install-tests.cachix.org/serve'
-          extra_nix_config: |
-            experimental-features = nix-command flakes
-            access-tokens = github.com=${{ secrets.GITHUB_TOKEN }}
       - name: Clone project
         uses: actions/checkout@v4
       - name: Build
         # "nix build" builds with full optimization and includes a profiling
         # build, so just the build of xmonad-contrib itself takes 3 minutes.
         # As a workaround, we invoke cabal manually here.
-        run: nix develop -c cabal v2-build -O0 -j
+        run: |
+          nix develop -c cabal v2-update -O0 -j
+          nix develop -c cabal v2-build -O0 -j

.github/workflows/packdeps.yml

@@ -42,10 +42,9 @@ jobs:
             *.cabal
 
   workflow-keepalive:
+    if: github.event_name == 'schedule'
     runs-on: ubuntu-latest
+    permissions:
+      actions: write
     steps:
-      - name: Re-enable workflow
+      - uses: liskin/gh-workflow-keepalive@v1
-        env:
-          GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
-        run: |
-          gh api -X PUT repos/${{ github.repository }}/actions/workflows/packdeps.yml/enable

.github/workflows/stack.yml

@@ -12,10 +12,8 @@ jobs:
       fail-fast: false
       matrix:
         include:
-          - resolver: lts-14  # GHC 8.6
+          - resolver: lts-16  # GHC 8.8
             yaml: stack.yaml
-          - resolver: lts-14  # GHC 8.6
-            yaml: stack-master.yaml
           - resolver: lts-16  # GHC 8.8
             yaml: stack-master.yaml
           - resolver: lts-18  # GHC 8.10
@@ -25,8 +23,12 @@ jobs:
           - resolver: lts-20  # GHC 9.2
             yaml: stack-master.yaml
           - resolver: lts-21  # GHC 9.4
+            yaml: stack-master.yaml
+          - resolver: lts-22  # GHC 9.6
+            yaml: stack-master.yaml
+          - resolver: lts-23  # GHC 9.8
             yaml: stack.yaml
-          - resolver: lts-21  # GHC 9.4
+          - resolver: lts-23  # GHC 9.8
             yaml: stack-master.yaml
 
     steps:

.mailmap

@@ -103,6 +103,7 @@ hexago.nl <xmonad-contrib@hexago.nl>
 lithis <xmonad@selg.hethrael.org>
 lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
 sam-barr <mail@samf.bar> <samfbarr@outlook.com>
-slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
+Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
-slotThe <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
+Tony Zorman <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
+Tony Zorman <soliditsallgood@mailbox.org>
 spoonm <spoonm@spoonm.org>

CHANGES.md

@@ -1,5 +1,165 @@
 # Change Log / Release Notes
 
+## _unreleased_
+
+### Breaking Changes
+
+  * Drop support for GHC 8.6
+
+### Bug Fixes and Minor Changes
+
+  * `XMonad.Util.EZConfig`
+
+    - Added `XF86WLAN` and `Menu` to the list of supported special keys.
+
+  * `XMonad.Actions.DynamicProjects`
+
+    - No longer autodelete projects when `switchProject` is called from
+      an empty workspace. This also fixes a bug where static workspaces
+      would be deleted when switching to a dynamic project.
+    - Improved documentation on how to close a project.
+
+  * `XMonad.Hooks.Rescreen`
+
+    - Allow overriding the `rescreen` operation itself. Additionally, the
+      `XMonad.Actions.PhysicalScreens` module now provides an alternative
+      implementation of `rescreen` that avoids reshuffling the workspaces if
+      the number of screens doesn't change and only their locations do (which
+      is especially common if one uses `xrandr --setmonitor` to split an
+      ultra-wide display in two).
+
+    - Added an optional delay when waiting for events to settle. This may be
+      used to avoid flicker and unnecessary workspace reshuffling if multiple
+      `xrandr` commands are used to reconfigure the display layout.
+
+  * `XMonad.Layout.NoBorders`
+
+    - It's no longer necessary to use `borderEventHook` to garbage collect
+      `alwaysHidden`/`neverHidden` lists. The layout listens to
+      `DestroyWindowEvent` messages instead, which are broadcast to layouts
+      since xmonad v0.17.0.
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    - Added a customization option for the action that gets executed when
+      a client sends a **_NET_CURRENT_DESKTOP** request. It is now possible
+      to change it using the `setEwmhSwitchDesktopHook`.
+    - Added a customization option for mapping hidden workspaces to screens
+      when setting the **_NET_DESKTOP_VIEWPORT**. This can be done using
+      the `setEwmhHiddenWorkspaceToScreenMapping`.
+
+  * `XMonad.Layout.IndependentScreens`
+
+    - Added `focusWorkspace` for focusing workspaces on the screen that they
+      belong to.
+    - Added `doFocus'` hook as an alternative for `doFocus` when using
+      IndependentScreens.
+    - Added `screenOnMonitor` for getting the active screen for a monitor.
+
+  * `XMonad.Util.NamedScratchPad`
+
+    - Fix unintended window hiding in `nsSingleScratchpadPerWorkspace`.
+      Only hide the previously active scratchpad.
+
+## 0.18.1 (August 20, 2024)
+
+### Breaking Changes
+
+  * `XMonad.Hooks.StatusBars`
+
+    - Move status bar functions from the `IO` to the `X` monad to
+      allow them to look up information from `X`, like the screen
+      width. Existing configurations may need to use `io` from
+      `XMonad.Core` or `liftIO` from `Control.Monad.IO.Class` in
+      order to lift any existing `IO StatusBarConfig` values into
+      `X StatusBarConfig` values.
+
+  * `XMonad.Prompt`
+
+    - Added an additional `XPConfig` argument to `historyCompletion` and
+      `historyCompletionP`. Calls along the lines of `historyCompletionP
+      myFunc` should be changed to `historyCompletionP myConf myFunc`.
+      If not `myConf` is lying around, `def` can be used instead.
+
+  * `XMonad.Actions.GridSelect`
+
+    - Added the `gs_cancelOnEmptyClick` field to `GSConfig`, which makes
+      mouse clicks into "empty space" cancel the current grid-select.
+      Users explicitly defining their own `GSConfig` record will have to
+      add this to their definitions. Additionally, the field defaults to
+      `True`—to retain the old behaviour, set it to `False`.
+
+### New Modules
+
+  * `XMonad.Actions.Profiles`
+
+    - Group workspaces by similarity. Useful when one has lots
+      of workspaces and uses only a couple per unit of work.
+
+  * `XMonad.Hooks.FloatConfigureReq`
+
+    - Customize handling of floating windows' move/resize/restack requests
+      (ConfigureRequest). Useful as a workaround for some misbehaving client
+      applications (Steam, rxvt-unicode, anything that tries to restore
+      absolute position of floats).
+
+  * `XMonad.Layout.Columns`
+
+    - Organize windows in columns. This layout allows to move/resize windows in
+      every directions.
+
+  * `XMonad.Prompt.WindowBringer`
+
+    - Added `copyMenu`, a convenient way to copy a window to the current workspace.
+
+### Bug Fixes and Minor Changes
+
+  * Fix build-with-cabal.sh when XDG_CONFIG_HOME is defined.
+
+  * `XMonad.Util.EZConfig`
+
+    - Fixed `checkKeymap` warning that all keybindings are duplicates.
+
+  * `XMonad.Hooks.ManageHelpers`
+
+    - Added `isNotification` predicate to check for windows with
+      `_NET_WM_WINDOW_TYPE` property of `_NET_WM_WINDOW_TYPE_NOTIFICATION`.
+
+  * `XMonad.Prompt.OrgMode`
+
+    - Added `HH:MM-HH:MM` and `HH:MM+HH` syntax to specify time spans.
+
+  * `XMonad.Prompt`
+
+    - The history file is not extraneously read and written anymore if
+      the `historySize` is set to 0.
+
+  * `XMonad.Hooks.EwmhDesktops`
+
+    - Requests for unmanaged windows no longer cause a refresh. This avoids
+      flicker and also fixes disappearing menus in the Steam client and
+      possibly a few other client applications.
+
+      (See also `XMonad.Hooks.FloatConfigureReq` and/or `XMonad.Util.Hacks`
+      for additional Steam client workarounds.)
+
+  * `XMonad.Actions.Submap`
+
+    - Added `visualSubmapSorted` to enable sorting of the keymap
+      descriptions.
+
+  * `XMonad.Hooks.ScreenCorners`
+
+    - Added screen edge support with `SCTop`, `SCBottom`, `SCLeft` and
+      `SCRight`. Now both corners and edges are supported.
+
+  * `XMonad.Actions.WindowNavigation`
+
+    - Improve navigation in presence of floating windows.
+    - Handle window switching when in `Full` layout.
+
+### Other changes
+
 ## 0.18.0 (February 3, 2024)
 
 ### Breaking Changes
@@ -307,8 +467,6 @@
     - Added `zipperFocusedAtFirstOf` to differentiate two lists into a
       zipper.
 
-### Other changes
-
 ## 0.17.1 (September 3, 2022)
 
 ### Breaking Changes
@@ -322,7 +480,8 @@
   * `XMonad.Config.{Arossato,Dmwit,Droundy,Monad,Prime,Saegesser,Sjanssen}`
 
     - Deprecated all of these modules.  The user-specific configuration
-      modules may still be found [on the website].
+      modules may still be found [on the
+      website](https://xmonad.org/configurations.html)
 
   * `XMonad.Util.NamedScratchpad`
 
@@ -343,8 +502,6 @@
     - Deprecated `urgencyConfig`; use `def` from the new `Default`
       instance of `UrgencyConfig` instead.
 
-[on the website]: https://xmonad.org/configurations.html
-
 ### New Modules
 
   * `XMonad.Actions.PerLayoutKeys`
@@ -419,7 +576,8 @@
       `todo +d 12 02 2024` work.
 
     - Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)
-      [priorities] at the end of the input note.
+      [priorities](https://orgmode.org/manual/Priorities.html) at the end of
+      the input note.
 
   * `XMonad.Prompt.Unicode`
 
@@ -513,7 +671,8 @@
 
     - Modified `mkAbsolutePath` to support a leading environment variable, so
       things like `$HOME/NOTES` work. If you want more general environment
-      variable support, comment on [this PR].
+      variable support, comment on [this
+      PR](https://github.com/xmonad/xmonad-contrib/pull/744)
 
   * `XMonad.Util.XUtils`
 
@@ -552,9 +711,6 @@
 
     - Added a `Default` instance for `UrgencyConfig` and `DzenUrgencyHook`.
 
-[this PR]: https://github.com/xmonad/xmonad-contrib/pull/744
-[priorities]: https://orgmode.org/manual/Priorities.html
-
 ### Other changes
 
   * Migrated the sample build scripts from the deprecated `xmonad-testing` repo to
@@ -2080,8 +2236,8 @@
 
   * `XMonad.Prompt.Pass`
 
-    This module provides 3 `XMonad.Prompt`s to ease passwords
+    This module provides 3 `XMonad.Prompt`s to ease passwords manipulation
-    manipulation (generate, read, remove) via [pass][].
+    (generate, read, remove) via [pass](http://www.passwordstore.org/).
 
   * `XMonad.Util.RemoteWindows`
 
@@ -2157,5 +2313,3 @@
 ## See Also
 
 <https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
-
-[pass]: http://www.passwordstore.org/

XMonad/Actions/DynamicProjects.hs

@@ -69,7 +69,9 @@ import qualified XMonad.Util.ExtensibleState as XS
 -- 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.
+-- or further configure the workspace/project. To close a project,
+-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",
+-- such as @removeWorkspace@ or @removeWorkspaceByTag@.
 --
 -- When using the @switchProjectPrompt@ function, workspaces are
 -- created as needed.  This means you can create new project spaces
@@ -230,7 +232,9 @@ lookupProject name = Map.lookup name <$> XS.gets projects
 
 --------------------------------------------------------------------------------
 -- | Fetch the current project (the one being used for the currently
--- active workspace).
+-- active workspace). If the workspace doesn't have a project, a
+-- default project is returned, using the workspace name as the
+-- project name.
 currentProject :: X Project
 currentProject = do
   name <- gets (W.tag . W.workspace . W.current . windowset)
@@ -255,20 +259,7 @@ modifyProject f = do
 --------------------------------------------------------------------------------
 -- | Switch to the given project.
 switchProject :: Project -> X ()
-switchProject p = do
+switchProject p = appendWorkspace (projectName p)
-  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

XMonad/Actions/GridSelect.hs

@@ -203,10 +203,13 @@ data GSConfig a = GSConfig {
       gs_colorizer :: a -> Bool -> X (String, String),
       gs_font :: String,
       gs_navigate :: TwoD a (Maybe a),
+      -- ^ Customize key bindings for a GridSelect
       gs_rearranger :: Rearranger a,
       gs_originFractX :: Double,
       gs_originFractY :: Double,
-      gs_bordercolor :: String
+      gs_bordercolor :: String,
+      gs_cancelOnEmptyClick :: Bool
+      -- ^ When True, click on empty space will cancel GridSelect
 }
 
 -- | That is 'fromClassName' if you are selecting a 'Window', or
@@ -386,13 +389,20 @@ updateElementsWithColorizer colorizer elementmap = do
 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,
+        s@TwoDState{ td_paneX = px
-                         td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
+                   , td_paneY = py
+                   , td_gsconfig = GSConfig{ gs_cellheight = ch
+                                           , gs_cellwidth = cw
+                                           , gs_cancelOnEmptyClick = cancelOnEmptyClick
+                                           }
+                   } <- 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
+             Nothing     -> if cancelOnEmptyClick
+                            then return Nothing
+                            else contEventloop
     | otherwise = contEventloop
 
 stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
@@ -648,7 +658,7 @@ gridselect gsconfig elements =
     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
+    void $ 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
@@ -706,7 +716,7 @@ decorateName' w = do
 
 -- | Builds a default gs config from a colorizer function.
 buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
-buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
+buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white" True
 
 -- | Brings selected window to the current workspace.
 bringSelected :: GSConfig Window -> X ()

XMonad/Actions/OnScreen.hs

@@ -1,51 +1,56 @@
------------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.OnScreen
 -- Description :  Control workspaces on different screens (in xinerama mode).
--- Copyright   :  (c) 2009 Nils Schweinsberg
+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- Control workspaces on different screens (in xinerama mode).
---
+module XMonad.Actions.OnScreen
------------------------------------------------------------------------------
+  ( -- * Usage
-
-module XMonad.Actions.OnScreen (
-    -- * Usage
     -- $usage
-      onScreen
+    onScreen,
-    , onScreen'
+    onScreen',
-    , Focus(..)
+    Focus (..),
-    , viewOnScreen
+    viewOnScreen,
-    , greedyViewOnScreen
+    greedyViewOnScreen,
-    , onlyOnScreen
+    onlyOnScreen,
-    , toggleOnScreen
+    toggleOnScreen,
-    , toggleGreedyOnScreen
+    toggleGreedyOnScreen,
-    ) where
+  )
+where
 
 import XMonad
-import XMonad.Prelude (fromMaybe, guard, empty)
+import XMonad.Prelude (empty, fromMaybe, guard)
 import XMonad.StackSet hiding (new)
 
-
 -- | Focus data definitions
-data Focus = FocusNew                       -- ^ always focus the new screen
+data Focus
-           | FocusCurrent                   -- ^ always keep the focus on the current screen
+  = -- | always focus the new screen
-           | FocusTag WorkspaceId           -- ^ always focus tag i on the new stack
+    FocusNew
-           | FocusTagVisible WorkspaceId    -- ^ focus tag i only if workspace with tag i is visible on the old stack
+  | -- | always keep the focus on the current screen
-
+    FocusCurrent
+  | -- | always focus tag i on the new stack
+    FocusTag WorkspaceId
+  | -- | focus tag i only if workspace with tag i is visible on the old stack
+    FocusTagVisible WorkspaceId
 
 -- | 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
+onScreen ::
-         -> Focus                    -- ^ what to do with the focus
+  -- | function to run
-         -> ScreenId                 -- ^ screen id
+  (WindowSet -> WindowSet) ->
-         -> WindowSet                -- ^ current stack
+  -- | what to do with the focus
-         -> WindowSet
+  Focus ->
+  -- | screen id
+  ScreenId ->
+  -- | current stack
+  WindowSet ->
+  WindowSet
 onScreen f foc sc st = fromMaybe st $ do
   ws <- lookupWorkspace sc st
 
@@ -53,12 +58,14 @@ onScreen f foc sc st = fromMaybe st $ do
 
   return $ setFocus foc st fStack
 
-
 -- set focus for new stack
-setFocus :: Focus
+setFocus ::
-         -> WindowSet -- ^ old stack
+  Focus ->
-         -> WindowSet -- ^ new stack
+  -- | old stack
-         -> WindowSet
+  WindowSet ->
+  -- | new stack
+  WindowSet ->
+  WindowSet
 setFocus FocusNew _ new = new
 setFocus FocusCurrent old new =
   case lookupWorkspace (screen $ current old) new of
@@ -74,10 +81,14 @@ setFocus (FocusTagVisible i) old new =
 -- 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
+onScreen' ::
-          -> Focus      -- ^ focus
+  -- | X function to run
-          -> ScreenId   -- ^ screen id
+  X () ->
-          -> X ()
+  -- | focus
+  Focus ->
+  -- | screen id
+  ScreenId ->
+  X ()
 onScreen' x foc sc = do
   st <- gets windowset
   case lookupWorkspace sc st of
@@ -87,55 +98,77 @@ onScreen' x foc sc = do
       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
+viewOnScreen ::
-             -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-             -> WindowSet   -- ^ current stack
+  ScreenId ->
-             -> WindowSet
+  -- | index of the workspace
+  WorkspaceId ->
+  -- | current stack
+  WindowSet ->
+  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
+greedyViewOnScreen ::
-                   -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-                   -> WindowSet   -- ^ current stack
+  ScreenId ->
-                   -> WindowSet
+  -- | index of the workspace
+  WorkspaceId ->
+  -- | current stack
+  WindowSet ->
+  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
+onlyOnScreen ::
-             -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-             -> WindowSet   -- ^ current stack
+  ScreenId ->
-             -> WindowSet
+  -- | index of the workspace
+  WorkspaceId ->
+  -- | current stack
+  WindowSet ->
+  WindowSet
 onlyOnScreen sid i =
   onScreen (view i) FocusCurrent sid
 
 -- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
-toggleOnScreen :: ScreenId    -- ^ screen id
+toggleOnScreen ::
-               -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-               -> WindowSet   -- ^ current stack
+  ScreenId ->
-               -> WindowSet
+  -- | index of the workspace
+  WorkspaceId ->
+  -- | current stack
+  WindowSet ->
+  WindowSet
 toggleOnScreen sid i =
   onScreen (toggleOrView' view i) FocusCurrent sid
 
 -- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
-toggleGreedyOnScreen :: ScreenId    -- ^ screen id
+toggleGreedyOnScreen ::
-                     -> WorkspaceId -- ^ index of the workspace
+  -- | screen id
-                     -> WindowSet   -- ^ current stack
+  ScreenId ->
-                     -> WindowSet
+  -- | index of the workspace
+  WorkspaceId ->
+  -- | current stack
+  WindowSet ->
+  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
+toggleOrView' ::
-              -> WorkspaceId                               -- ^ tag to look for
+  -- | function to run
-              -> WindowSet                                 -- ^ current stackset
+  (WorkspaceId -> WindowSet -> WindowSet) ->
-              -> WindowSet
+  -- | tag to look for
+  WorkspaceId ->
+  -- | current stackset
+  WindowSet ->
+  WindowSet
 toggleOrView' f i st = fromMaybe (f i st) $ do
   let st' = hidden st
   -- make sure we actually have to do something

XMonad/Actions/PhysicalScreens.hs

@@ -1,4 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ParallelListComp #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module       : XMonad.Actions.PhysicalScreens
@@ -28,10 +30,13 @@ module XMonad.Actions.PhysicalScreens (
                                       , getScreenIdAndRectangle
                                       , screenComparatorById
                                       , screenComparatorByRectangle
+                                      , rescreen
                                       ) where
 
-import XMonad
+import Data.List.NonEmpty (nonEmpty)
-import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
+import XMonad hiding (rescreen)
+import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|)))
+import qualified Data.List.NonEmpty as NE
 import qualified XMonad.StackSet as W
 
 {- $usage
@@ -146,3 +151,53 @@ 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)
+
+-- | An alternative to 'XMonad.Operations.rescreen' that avoids reshuffling
+-- the workspaces if the number of screens doesn't change and only their
+-- locations do. Useful for users of @xrandr --setmonitor@.
+--
+-- See 'XMonad.Hooks.Rescreen.setRescreenWorkspacesHook', which lets you
+-- replace the builtin rescreen handler.
+rescreen :: ScreenComparator -> X ()
+rescreen (ScreenComparator cmpScreen) = withDisplay (fmap nonEmpty . getCleanedScreenInfo) >>= \case
+    Nothing -> trace "getCleanedScreenInfo returned []"
+    Just xinescs -> windows $ rescreen' xinescs
+  where
+    rescreen' :: NonEmpty Rectangle -> WindowSet -> WindowSet
+    rescreen' xinescs ws
+      | NE.length xinescs == length (W.visible ws) + 1 = rescreenSameLength xinescs ws
+      | otherwise = rescreenCore xinescs ws
+
+    -- the 'XMonad.Operations.rescreen' implementation from core as a fallback
+    rescreenCore :: NonEmpty Rectangle -> WindowSet -> WindowSet
+    rescreenCore (xinesc :| xinescs) ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } =
+        let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
+            a = W.Screen (W.workspace v) 0 (SD xinesc)
+            as = zipWith3 W.Screen xs [1..] $ map SD xinescs
+        in  ws{ W.current = a
+              , W.visible = as
+              , W.hidden  = ys }
+
+    -- sort both existing screens and the screens we just got from xinerama
+    -- using cmpScreen, and then replace the rectangles in the WindowSet,
+    -- keeping the order of current/visible workspaces intact
+    rescreenSameLength :: NonEmpty Rectangle -> WindowSet -> WindowSet
+    rescreenSameLength xinescs ws =
+        ws{ W.current = (W.current ws){ W.screenDetail = SD newCurrentRect }
+          , W.visible = [ w{ W.screenDetail = SD r } | w <- W.visible ws | r <- newVisibleRects ]
+          }
+      where
+        undoSort =
+            NE.map fst $
+            NE.sortBy (cmpScreen `on` (getScreenIdAndRectangle . snd)) $
+            NE.zip ((0 :: Int) :| [1..]) $ -- add indices to undo the sort later
+            W.current ws :| W.visible ws
+        newCurrentRect :| newVisibleRects =
+            NE.map snd $ NE.sortWith fst $ NE.zip undoSort $ -- sort back into current:visible order
+            NE.map snd $ NE.sortBy cmpScreen $ NE.zip (0 :| [1..]) xinescs
+
+    -- TODO:
+    -- If number of screens before and after isn't the same, we might still
+    -- try to match locations and avoid changing the workspace for those that
+    -- didn't move, while making sure that the current workspace is still
+    -- visible somewhere.

XMonad/Actions/Profiles.hs

@@ -0,0 +1,545 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE DerivingVia   #-}
+
+
+--------------------------------------------------------------------------------
+-- |
+-- Module      :  XMonad.Actions.Profiles
+-- Description :  Group your workspaces by similarity.
+-- Copyright   :  (c) Mislav Zanic
+-- License     :  BSD3-style (see LICENSE)
+--
+-- Maintainer  :  Mislav Zanic <mislavzanic3@gmail.com>
+-- Stability   :  experimental
+-- Portability :  unportable
+--
+--------------------------------------------------------------------------------
+
+module XMonad.Actions.Profiles
+  ( -- * Overview
+    -- $overview
+
+    -- * Usage
+    -- $usage
+
+    -- * Types
+    ProfileId
+  , Profile(..)
+  , ProfileConfig(..)
+
+  -- * Hooks
+  , addProfiles
+  , addProfilesWithHistory
+
+  -- * Switching profiles
+  , switchToProfile
+
+  -- * Workspace navigation and keybindings
+  , wsFilter
+  , bindOn
+
+  -- * Loggers and pretty printers
+  , excludeWSPP
+  , profileLogger
+
+  -- * Prompts
+  , switchProfilePrompt
+  , addWSToProfilePrompt
+  , removeWSFromProfilePrompt
+  , switchProfileWSPrompt
+  , shiftProfileWSPrompt
+
+  -- * Utilities
+  , currentProfile
+  , profileIds
+  , previousProfile
+  , profileHistory
+  , allProfileWindows
+  , profileWorkspaces
+  )where
+
+--------------------------------------------------------------------------------
+import Data.Map.Strict (Map)
+import Data.List
+import qualified Data.Map.Strict as Map
+
+import Control.DeepSeq
+
+import XMonad
+import XMonad.Prelude
+import qualified XMonad.StackSet as W
+
+import XMonad.Actions.CycleWS
+
+import qualified XMonad.Util.ExtensibleState as XS
+import XMonad.Util.Loggers (Logger)
+import XMonad.Prompt.Window (XWindowMap)
+import XMonad.Actions.WindowBringer (WindowBringerConfig(..))
+import XMonad.Actions.OnScreen (greedyViewOnScreen)
+import XMonad.Hooks.Rescreen (addAfterRescreenHook)
+import XMonad.Hooks.DynamicLog (PP(ppRename))
+import XMonad.Prompt 
+
+--------------------------------------------------------------------------------
+-- $overview
+-- This module allows you to group your workspaces into 'Profile's based on certain similarities.
+-- The idea is to expand upon the philosophy set by "XMonad.Actions.TopicSpace"
+-- which states that you can look at a topic/workspace as a
+-- single unit of work instead of multiple related units of work.
+-- This comes in handy if you have lots of workspaces with windows open and need only to
+-- work with a few of them at a time. With 'Profile's, you can focus on those few workspaces that
+-- require your attention by not displaying, or allowing you to switch to the rest of the workspaces.
+-- The best example is having a profile for development and a profile for leisure activities.
+
+--------------------------------------------------------------------------------
+-- $usage
+-- To use @Profiles@ you need to add it to your XMonad configuration
+-- and configure your profiles.
+--  
+-- First you'll need to handle the imports.
+--  
+-- > import XMonad.Actions.Profiles 
+-- > import XMonad.Util.EZConfig -- for keybindings
+-- > import qualified XMonad.StackSet as W
+-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO -- for workspace navigation
+--
+-- Next you'll need to define your profiles.
+--
+-- > myStartingProfile :: ProfileId
+-- > myStartingProfile = "Work"
+-- >
+-- > myProfiles :: [Profile]
+-- > myProfiles =
+-- >  [ Profile { profileId = "Home"
+-- >            , profileWS = [ "www"
+-- >                          , "rss"
+-- >                          , "vid"
+-- >                          , "vms"
+-- >                          , "writing"
+-- >                          , "notes"
+-- >                          ]
+-- >            }
+-- >  , Profile { profileId = "Work"
+-- >            , profileWS = [ "www"
+-- >                          , "slack"
+-- >                          , "dev"
+-- >                          , "k8s"
+-- >                          , "notes"
+-- >                          ]
+-- >            }
+-- >  ]
+-- 
+-- So, while using @Home@ 'Profile', you'll only be able to see, navigate to and 
+-- do actions with @["www", "rss", "vid", "vms", "writing", "notes"]@ workspaces.
+--
+-- You may also need to define some keybindings. Since @M-1@ .. @M-9@ are
+-- sensible keybindings for switching workspaces, you'll need to use
+-- 'bindOn' to have different keybindings per profile.
+-- Here, we'll use "XMonad.Util.EZConfig" syntax:
+-- 
+-- > myKeys :: [(String, X())]
+-- > myKeys = 
+-- >   [ ("M-p",  switchProfilePrompt   xpConfig)
+-- >   , ("M-g",  switchProfileWSPrompt xpConfig)
+-- >   , ("M1-j", DO.moveTo Next wsFilter)
+-- >   , ("M1-k", DO.moveTo Prev wsFilter)
+-- >   ]
+-- >   <>
+-- >   [ ("M-" ++ m ++ k, bindOn $ map (\x -> (fst x, f $ snd x)) i)
+-- >   | (i, k) <- map (\(x:xs) -> (map fst (x:xs), snd x)) $ sortGroupBy snd tupleList
+-- >   , (f, m) <- [(mby $ windows . W.greedyView, ""), (mby $ windows . W.shift, "S-")]
+-- >   ]
+-- >   where
+-- >     mby f wid = if wid == "" then return () else f wid
+-- >     sortGroupBy f = groupBy (\ x y -> f x == f y) . sortBy (\x y -> compare (f x) (f y))
+-- >     tupleList = concatMap (\p -> zip (map (\wid -> (profileId p, wid)) (profileWS p <> repeat "")) (map show [1..9 :: Int])) myProfiles
+-- 
+-- After that, you'll need to hook @Profiles@ into your XMonad config:
+-- 
+-- > main = xmonad $ addProfiles def { profiles        = myProfiles
+-- >                                 , startingProfile = myStartingProfile
+-- >                                 }
+-- >               $ def `additionalKeysP` myKeys
+-- 
+
+--------------------------------------------------------------------------------
+type ProfileId  = String
+type ProfileMap = Map ProfileId Profile
+
+--------------------------------------------------------------------------------
+-- | Profile representation.
+data Profile = Profile
+  { profileId :: !ProfileId     -- ^ Profile name.
+  , profileWS :: ![WorkspaceId] -- ^ A list of workspaces contained within a profile.
+  }
+
+--------------------------------------------------------------------------------
+-- | Internal profile state.
+data ProfileState = ProfileState
+  { profilesMap :: !ProfileMap
+  , current     :: !(Maybe Profile)
+  , previous    :: !(Maybe ProfileId)
+  }
+
+--------------------------------------------------------------------------------
+-- | User config for profiles.
+data ProfileConfig = ProfileConfig
+  { workspaceExcludes :: ![WorkspaceId] -- ^ A list of workspaces to exclude from the @profileHistoryHook@.
+  , profiles          :: ![Profile]     -- ^ A list of user-defined profiles.
+  , startingProfile   :: !ProfileId     -- ^ Profile shown on startup.
+  }
+
+--------------------------------------------------------------------------------
+instance Default ProfileConfig where
+  def            = ProfileConfig { workspaceExcludes = []
+                                 , profiles          = []
+                                 , startingProfile   = ""
+                                 }
+
+--------------------------------------------------------------------------------
+instance ExtensionClass ProfileState where
+  initialValue = ProfileState Map.empty Nothing Nothing
+
+--------------------------------------------------------------------------------
+-- Internal type for history tracking.
+-- Main problem with @XMonad.Hooks.HistoryHook@ is that it isn't profile aware.
+-- Because of that, when switching to a previous workspace, you might switch to
+-- a workspace
+newtype ProfileHistory = ProfileHistory
+  { history :: Map ProfileId [(ScreenId, WorkspaceId)]
+  }
+  deriving (Read, Show)
+  deriving NFData via Map ProfileId [(Int, WorkspaceId)]
+
+--------------------------------------------------------------------------------
+instance ExtensionClass ProfileHistory where
+  extensionType = PersistentExtension
+  initialValue = ProfileHistory Map.empty
+
+--------------------------------------------------------------------------------
+newtype ProfilePrompt = ProfilePrompt String
+
+--------------------------------------------------------------------------------
+instance XPrompt ProfilePrompt where
+  showXPrompt (ProfilePrompt x) = x
+
+--------------------------------------------------------------------------------
+defaultProfile :: Profile
+defaultProfile = defaultProfile
+
+--------------------------------------------------------------------------------
+-- | Returns current profile.
+currentProfile :: X ProfileId
+currentProfile = profileId . fromMaybe defaultProfile . current <$> XS.get
+
+--------------------------------------------------------------------------------
+-- | Returns previous profile.
+previousProfile :: X (Maybe ProfileId)
+previousProfile = XS.gets previous
+
+--------------------------------------------------------------------------------
+-- | Returns the history of viewed workspaces per profile.
+profileHistory :: X (Map ProfileId [(ScreenId, WorkspaceId)])
+profileHistory = XS.gets history
+
+--------------------------------------------------------------------------------
+profileMap :: X ProfileMap
+profileMap = XS.gets profilesMap
+
+--------------------------------------------------------------------------------
+-- | Returns ids of all profiles.
+profileIds :: X [ProfileId]
+profileIds = Map.keys <$> XS.gets profilesMap
+
+--------------------------------------------------------------------------------
+currentProfileWorkspaces :: X [WorkspaceId]
+currentProfileWorkspaces = XS.gets current <&> profileWS . fromMaybe defaultProfile
+
+--------------------------------------------------------------------------------
+-- | Hook profiles into XMonad. This function adds a startup hook that
+-- sets up ProfileState. Also adds an afterRescreenHook for viewing correct
+-- workspaces when adding new screens.
+addProfiles :: ProfileConfig -> XConfig a -> XConfig a
+addProfiles profConf conf = addAfterRescreenHook hook $ conf
+  { startupHook = profileStartupHook' <> startupHook conf
+  }
+ where
+   profileStartupHook' :: X()
+   profileStartupHook' = profilesStartupHook (profiles profConf) (startingProfile profConf)
+   hook = currentProfile >>= switchWSOnScreens
+
+--------------------------------------------------------------------------------
+-- | Hooks profiles into XMonad and enables Profile history logging.
+addProfilesWithHistory :: ProfileConfig -> XConfig a -> XConfig a
+addProfilesWithHistory profConf conf = conf'
+  { logHook = profileHistoryHookExclude (workspaceExcludes profConf) <> logHook conf
+  }
+  where
+   conf' = addProfiles profConf conf
+
+--------------------------------------------------------------------------------
+profileHistoryHookExclude :: [WorkspaceId] -> X()
+profileHistoryHookExclude ews = do
+  cur <- gets $ W.current . windowset
+  vis <- gets $ W.visible . windowset
+  pws <- currentProfileWorkspaces
+  p <- currentProfile
+
+  updateHist p $ workspaceScreenPairs $ filterWS pws $ cur:vis
+  where
+    workspaceScreenPairs wins = zip (W.screen <$> wins) (W.tag . W.workspace <$> wins)
+    filterWS pws = filter ((\wid -> (wid `elem` pws) && (wid `notElem` ews)) . W.tag . W.workspace)
+
+--------------------------------------------------------------------------------
+updateHist :: ProfileId -> [(ScreenId, WorkspaceId)] -> X()
+updateHist pid xs = profileWorkspaces pid >>= XS.modify' . update
+  where
+    update pws hs = force $ hs { history = doUpdate pws $ history hs }
+
+    doUpdate pws hist = foldl (\acc (sid, wid) -> Map.alter (f pws sid wid) pid acc) hist xs
+
+    f pws sid wid val = case val of
+      Nothing -> pure [(sid, wid)]
+      Just hs -> pure $ let new = (sid, wid) in new:filterWS pws new hs
+
+    filterWS :: [WorkspaceId] -> (ScreenId, WorkspaceId) -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
+    filterWS pws new = filter (\x -> snd x `elem` pws && x /= new)
+
+--------------------------------------------------------------------------------
+-- | Adds profiles to ProfileState and sets current profile using .
+
+profilesStartupHook :: [Profile] -> ProfileId -> X ()
+profilesStartupHook ps pid = XS.modify go >> switchWSOnScreens pid
+  where
+    go :: ProfileState -> ProfileState
+    go s = s {profilesMap = update $ profilesMap s, current = setCurrentProfile $ Map.fromList $ map entry ps}
+
+    update :: ProfileMap -> ProfileMap
+    update = Map.union (Map.fromList $ map entry ps)
+
+    entry :: Profile -> (ProfileId, Profile)
+    entry p = (profileId p, p)
+
+    setCurrentProfile :: ProfileMap -> Maybe Profile
+    setCurrentProfile s = case Map.lookup pid s of
+      Nothing -> Just $ Profile pid []
+      Just pn -> Just pn
+
+--------------------------------------------------------------------------------
+setPrevious :: ProfileId -> X()
+setPrevious name = XS.modify update
+  where
+    update ps = ps { previous = doUpdate ps }
+    doUpdate ps = case Map.lookup name $ profilesMap ps of
+      Nothing -> previous ps
+      Just p -> Just $ profileId p
+
+--------------------------------------------------------------------------------
+setProfile :: ProfileId -> X ()
+setProfile p = currentProfile >>= setPrevious >> setProfile' p
+
+--------------------------------------------------------------------------------
+setProfile' :: ProfileId -> X ()
+setProfile' name = XS.modify update
+  where
+    update ps = ps { current = doUpdate ps }
+    doUpdate ps = case Map.lookup name $ profilesMap ps of
+      Nothing -> current ps
+      Just p -> Just p
+
+--------------------------------------------------------------------------------
+-- | Switch to a profile.
+switchToProfile :: ProfileId -> X()
+switchToProfile pid = setProfile pid >> switchWSOnScreens pid
+
+--------------------------------------------------------------------------------
+-- | Returns the workspace ids associated with a profile id.
+profileWorkspaces :: ProfileId -> X [WorkspaceId]
+profileWorkspaces pid = profileMap >>= findPWs
+  where
+    findPWs pm = return . profileWS . fromMaybe defaultProfile $ Map.lookup pid pm
+
+--------------------------------------------------------------------------------
+-- | Prompt for adding a workspace id to a profile.
+addWSToProfilePrompt :: XPConfig -> X()
+addWSToProfilePrompt c = do
+  ps <- profileIds
+  mkXPrompt (ProfilePrompt "Add ws to profile:") c (mkComplFunFromList' c ps) f
+  where
+   f :: String -> X()
+   f p = do
+     vis <- gets $ fmap (W.tag . W.workspace) . W.visible . windowset
+     cur <- gets $ W.tag . W.workspace . W.current . windowset
+     hid <- gets $ fmap W.tag . W.hidden . windowset
+     let
+       arr = cur:(vis <> hid)
+       in mkXPrompt (ProfilePrompt "Ws to add to profile:") c (mkComplFunFromList' c arr) (`addWSToProfile` p)
+
+--------------------------------------------------------------------------------
+-- | Prompt for switching profiles.
+switchProfilePrompt :: XPConfig -> X()
+switchProfilePrompt c = do
+  ps <- profileIds
+  mkXPrompt (ProfilePrompt "Profile: ") c (mkComplFunFromList' c ps) switchToProfile
+     
+--------------------------------------------------------------------------------
+-- | Prompt for switching workspaces.
+switchProfileWSPrompt :: XPConfig -> X ()
+switchProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
+  where
+    mkPrompt pws = mkXPrompt (ProfilePrompt "Switch to workspace:") c (mkComplFunFromList' c pws) mbygoto 
+    mbygoto wid = do
+      pw <- profileWorkspaces =<< currentProfile
+      unless (wid `notElem` pw) (windows . W.greedyView $ wid)
+
+--------------------------------------------------------------------------------
+-- | Prompt for shifting windows to a different workspace.
+shiftProfileWSPrompt :: XPConfig -> X ()
+shiftProfileWSPrompt c = mkPrompt =<< currentProfileWorkspaces
+  where
+    mkPrompt pws = mkXPrompt (ProfilePrompt "Send window to workspace:") c (mkComplFunFromList' c pws) mbyshift
+    mbyshift wid = do
+      pw <- profileWorkspaces =<< currentProfile
+      unless (wid `notElem` pw) (windows . W.shift $ wid)
+
+--------------------------------------------------------------------------------
+addWSToProfile :: WorkspaceId -> ProfileId -> X()
+addWSToProfile wid pid = XS.modify go
+  where
+   go :: ProfileState -> ProfileState
+   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
+
+   update :: ProfileMap -> ProfileMap
+   update mp = case Map.lookup pid mp of
+     Nothing -> mp
+     Just p  -> if wid `elem` profileWS p then mp else Map.adjust f pid mp
+
+   f :: Profile -> Profile
+   f p = Profile pid (wid : profileWS p)
+
+   update' :: Profile -> Maybe Profile
+   update' cp = if profileId cp == pid && wid `notElem` profileWS cp then Just (Profile pid $ wid:profileWS cp) else Just cp
+
+--------------------------------------------------------------------------------
+-- | Prompt for removing a workspace from a profile.
+removeWSFromProfilePrompt :: XPConfig -> X()
+removeWSFromProfilePrompt c = do
+  ps <- profileIds
+  mkXPrompt (ProfilePrompt "Remove ws from profile:") c (mkComplFunFromList' c ps) f
+  where
+   f :: String -> X()
+   f p = do
+     arr <- profileWorkspaces p
+     mkXPrompt (ProfilePrompt "Ws to remove from profile:") c (mkComplFunFromList' c arr) $
+       \ws -> do
+         cp <- currentProfile
+         ws `removeWSFromProfile` p 
+         when (cp == p) $ currentProfile >>= switchWSOnScreens
+
+--------------------------------------------------------------------------------
+removeWSFromProfile :: WorkspaceId -> ProfileId -> X()
+removeWSFromProfile wid pid = XS.modify go
+  where
+   go :: ProfileState -> ProfileState
+   go ps = ps {profilesMap = update $ profilesMap ps, current = update' $ fromMaybe defaultProfile $ current ps}
+
+   update :: ProfileMap -> ProfileMap
+   update mp = case Map.lookup pid mp of
+     Nothing -> mp
+     Just p  -> if wid `elem` profileWS p then Map.adjust f pid mp else mp
+
+   f :: Profile -> Profile
+   f p = Profile pid (delete wid $ profileWS p)
+
+   update' :: Profile -> Maybe Profile
+   update' cp = if profileId cp == pid && wid `elem` profileWS cp then Just (Profile pid $ delete wid $ profileWS cp) else Just cp
+
+--------------------------------------------------------------------------------
+-- | Pretty printer for a bar. Prints workspace ids of current profile.
+excludeWSPP :: PP -> X PP
+excludeWSPP pp = modifyPP <$> currentProfileWorkspaces
+  where
+    modifyPP pws = pp { ppRename = ppRename pp . printTag pws }
+    printTag pws tag = if tag `elem` pws then tag else ""
+
+--------------------------------------------------------------------------------
+-- | For cycling through workspaces associated with the current.
+wsFilter :: WSType
+wsFilter = WSIs $ currentProfileWorkspaces >>= (\ws -> return $ (`elem` ws) . W.tag)
+
+--------------------------------------------------------------------------------
+-- Takes care of placing correct workspaces on their respective screens.
+-- It does this by reducing the history of a Profile until it gets an array of length
+-- equal to the number of screens with pairs that have unique workspace ids.
+switchWSOnScreens :: ProfileId -> X()
+switchWSOnScreens pid = do
+  hist <- profileHistory
+  vis <- gets $ W.visible . windowset
+  cur <- gets $ W.current . windowset
+  pws <- profileMap <&> (profileWS . fromMaybe (Profile pid []) . Map.lookup pid)
+  case Map.lookup pid hist of
+    Nothing -> switchScreens $ zip (W.screen <$> (cur:vis)) pws
+    Just xs -> compareAndSwitch (f (W.screen <$> cur:vis) xs) (cur:vis) pws
+  where
+    f :: [ScreenId] -> [(ScreenId, WorkspaceId)] -> [(ScreenId, WorkspaceId)]
+    f sids = reorderUniq . reorderUniq . reverse . filter ((`elem` sids) . fst)
+
+    reorderUniq :: (Ord k, Ord v) => [(k,v)] -> [(v,k)]
+    reorderUniq = map (\(x,y) -> (y,x)) . uniq
+
+    uniq :: (Ord k, Ord v) => [(k,v)] -> [(k,v)]
+    uniq = Map.toList . Map.fromList
+
+    viewWS fview sid wid = windows $ fview sid wid
+
+    switchScreens = mapM_ (uncurry $ viewWS greedyViewOnScreen)
+
+    compareAndSwitch hist wins pws | length hist < length wins = switchScreens $ hist <> populateScreens hist wins pws
+                                   | otherwise                 = switchScreens hist
+
+    populateScreens hist wins pws = zip (filter (`notElem` map fst hist) $ W.screen <$> wins) (filter (`notElem` map snd hist) pws)
+
+--------------------------------------------------------------------------------
+chooseAction :: (String -> X ()) -> X ()
+chooseAction f = XS.gets current <&> (profileId . fromMaybe defaultProfile) >>= f
+
+--------------------------------------------------------------------------------
+-- | Create keybindings per profile.
+bindOn :: [(String, X ())] -> X ()
+bindOn bindings = chooseAction chooser
+  where
+    chooser profile = case lookup profile bindings of
+        Just action -> action
+        Nothing -> case lookup "" bindings of
+            Just action -> action
+            Nothing -> return ()
+
+--------------------------------------------------------------------------------
+-- | Loggs currentProfile and all profiles with hidden workspaces
+--   (workspaces that aren't shown on a screen but have windows).
+profileLogger :: (String -> String) -> (String -> String) -> Logger
+profileLogger formatFocused formatUnfocused = do
+  hws <- gets $ W.hidden . windowset
+  p <- currentProfile
+  hm <- map fst
+      . filter (\(p', xs) -> any ((`elem` htags hws) . snd) xs || p' == p)
+      . Map.toList <$> profileHistory
+  return $ Just $ foldl (\a b -> a ++ " " ++ b) "" $ format p <$> hm
+  where
+    format p a = if a == p then formatFocused a else formatUnfocused a
+    htags wins = W.tag <$> filter (isJust . W.stack) wins
+
+--------------------------------------------------------------------------------
+-- | @XWindowMap@ of all windows contained in a profile.
+allProfileWindows :: XWindowMap
+allProfileWindows = allProfileWindows' def
+
+--------------------------------------------------------------------------------
+allProfileWindows' :: WindowBringerConfig -> XWindowMap
+allProfileWindows' WindowBringerConfig{ windowTitler = titler, windowFilter = include } = do
+  pws <- currentProfileWorkspaces
+  windowSet <- gets windowset
+  Map.fromList . concat <$> mapM keyValuePairs (filter ((`elem` pws) . W.tag) $ W.workspaces windowSet)
+   where keyValuePairs ws = let wins = W.integrate' (W.stack ws)
+                           in mapM (keyValuePair ws) =<< filterM include wins
+         keyValuePair ws w = (, w) <$> titler ws w

XMonad/Actions/Search.hs

@@ -437,14 +437,14 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
    browser. -}
 promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearchBrowser config browser (SearchEngine name site) = do
-    hc <- historyCompletionP ("Search [" `isPrefixOf`)
+    hc <- historyCompletionP config ("Search [" `isPrefixOf`)
     mkXPrompt (Search name) config hc $ search browser site
 
 {- | Like 'promptSearchBrowser', but only suggest previous searches for the
    given 'SearchEngine' in the prompt. -}
 promptSearchBrowser' :: XPConfig -> Browser -> SearchEngine -> X ()
 promptSearchBrowser' config browser (SearchEngine name site) = do
-    hc <- historyCompletionP (searchName `isPrefixOf`)
+    hc <- historyCompletionP config (searchName `isPrefixOf`)
     mkXPrompt (Search name) config hc $ search browser site
   where
     searchName = showXPrompt (Search name)

XMonad/Actions/Submap.hs

@@ -18,6 +18,7 @@ module XMonad.Actions.Submap (
                              -- $usage
                              submap,
                              visualSubmap,
+                             visualSubmapSorted,
                              submapDefault,
                              submapDefaultWithKey,
 
@@ -88,15 +89,32 @@ visualSubmap :: WindowConfig -- ^ The config for the spawned window.
              -> M.Map (KeyMask, KeySym) (String, X ())
                              -- ^ A map @keybinding -> (description, action)@.
              -> X ()
-visualSubmap wc keys =
+visualSubmap = visualSubmapSorted id
+
+-- | Like 'visualSubmap', but is able to sort the descriptions.
+-- For example,
+--
+-- > import Data.Ord (comparing, Down)
+-- >
+-- > visualSubmapSorted (sortBy (comparing Down)) def
+--
+-- would sort the @(key, description)@ pairs by their keys in descending
+-- order.
+visualSubmapSorted :: ([((KeyMask, KeySym), String)] -> [((KeyMask, KeySym), String)])
+                             -- ^ A function to resort the descriptions
+             -> WindowConfig -- ^ The config for the spawned window.
+             -> M.Map (KeyMask, KeySym) (String, X ())
+                             -- ^ A map @keybinding -> (description, action)@.
+             -> X ()
+visualSubmapSorted sorted wc keys =
     withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) ->
         maybe (pure ()) snd (M.lookup (m', s) keys)
   where
     descriptions :: [String]
     descriptions =
-        zipWith (\key desc -> keyToString key <> ": " <> desc)
+        map (\(key, desc) -> keyToString key <> ": " <> desc)
-                (M.keys keys)
+            . sorted
-                (map fst (M.elems keys))
+            $ zip (M.keys keys) (map fst (M.elems keys))
 
 -- | Give a name to an action.
 subName :: String -> X () -> (String, X ())

XMonad/Actions/UpKeys.hs

@@ -0,0 +1,169 @@
+{-# LANGUAGE BlockArguments #-}
+{-# LANGUAGE InstanceSigs #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE TypeApplications #-}
+{- |
+   Module      : XMonad.Actions.UpKeys
+   Description : Bind an action to the release of a key
+   Copyright   : (c) Tony Zorman, 2024
+   License     : BSD-3
+   Maintainer  : Tony Zorman <soliditsallgood@mailbox.org>
+
+A combinator for binding an action to the release of a key. This can be
+useful for hold-type buttons, where the press of a key engages some
+functionality, and its release… releases it again.
+-}
+module XMonad.Actions.UpKeys
+  ( -- * Usage
+    -- $usage
+    useUpKeys,
+    UpKeysConfig (..),
+    ezUpKeys,
+  )
+where
+
+import Data.Map.Strict (Map)
+import qualified Data.Map.Strict as Map
+import XMonad
+import XMonad.Prelude
+import XMonad.Util.EZConfig (mkKeymap)
+import qualified XMonad.Util.ExtensibleConf as XC
+
+{- $usage
+You can use this module with the following in your @xmonad.hs@:
+
+> import XMonad.Actions.UpKeys
+
+Next, define the keys and actions you want to have happen on the release
+of a key:
+
+> myUpKeys = ezUpKeys $
+>   [ ("M-z", myAction)
+>   , ("M-a", myAction2)
+>   ]
+
+All that's left is to plug this definition into the 'useUpKeys'
+combinator that this module provides:
+
+> main :: IO ()
+> main = xmonad
+>      . useUpKeys (def{ grabKeys = True, upKeys = myUpKeys })
+>      $ myConfig
+
+Note the presence of @'grabKeys' = True@; this is for situations where
+you don't have any of these keys bound to do something upon pressing
+them; i.e., you use them solely for their release actions. If you want
+something to happen in both cases, remove that part (@'grabKeys' =
+False@ is the default) and bind the keys to actions as you normally
+would.
+
+==== __Examples__
+
+As an extended example, consider the case where you want all of your
+docks (e.g., status bar) to "pop up" when you press the super key, and
+then vanish again once that keys is released.
+
+Since docks are not generally part of XMonad's window-set—otherwise, we
+would have to manage them—we first need a way to access and manipulate
+all docks.
+
+> onAllDocks :: (Display -> Window -> IO ()) -> X ()
+> onAllDocks act = withDisplay \dpy -> do
+>   rootw <- asks theRoot
+>   (_, _, wins) <- io $ queryTree dpy rootw
+>   traverse_ (io . act dpy) =<< filterM (runQuery checkDock) wins
+
+This is also the place where one could filter for just status bar,
+trayer, and so on.
+
+Now we have to decide what kinds of keys we want to watch out for. Since
+you most likely use left super as your modifier key, this is a little
+bit more complicated than for other keys, as you will most likely see
+the key both as a @KeyMask@, as well as a @KeySym@. One could think a
+bit and probably come up with an elegant solution for this—or one could
+grab all possible key combinations by brute-force!
+
+> dockKeys :: X () -> [((KeyMask, KeySym), X ())]
+> dockKeys act = map (actKey . foldr1 (.|.)) . combinations $ keyMasks
+>  where
+>   actKey :: KeyMask -> ((KeyMask, KeySym), X ())
+>   actKey mask = ((mask, xK_Super_L), act)
+>
+>   keyMasks :: [KeyMask]
+>   keyMasks = [ noModMask, shiftMask, lockMask, controlMask, mod1Mask, mod2Mask, mod3Mask, mod4Mask, mod5Mask ]
+>
+>   -- Return all combinations of a sequence of values.
+>   combinations :: [a] -> [[a]]
+>   combinations xs = concat [combs i xs | i <- [1 .. length xs]]
+>    where
+>     combs 0 _      = [[]]
+>     combs _ []     = []
+>     combs n (x:xs) = map (x:) (combs (n-1) xs) <> combs n xs
+
+Given some action, like lowering or raising the window, we generate all
+possible combinations of modifiers that may be pressed with the super
+key. This is a good time to say that this is just for demonstrative
+purposes, btw—please don't actually do this.
+
+All that's left is to plug everything into the machinery of this module,
+and we're done!
+
+> import qualified Data.Map.Strict as Map
+>
+> main :: IO ()
+> main = xmonad
+>      . … -- other combinators
+>      . useUpKeys (def { upKeys = Map.fromList $ dockKeys (onAllDocks lowerWindow) })
+>      $ myConfig `additionalKeys` dockKeys (onAllDocks raiseWindow)
+>
+> myConfig = …
+-}
+
+data UpKeysConfig = UpKeysConfig
+  { -- | Whether to grab all keys that are not already grabbed.
+    grabKeys :: !Bool
+    -- | The keys themselves.
+  , upKeys :: !(Map (KeyMask, KeySym) (X ()))
+  }
+
+-- | The default 'UpKeysConfig'; keys are not grabbed, and no upkeys are
+-- specified.
+instance Default UpKeysConfig where
+  def :: UpKeysConfig
+  def = UpKeysConfig { grabKeys = False, upKeys = mempty }
+
+instance Semigroup UpKeysConfig where
+  (<>) :: UpKeysConfig -> UpKeysConfig -> UpKeysConfig
+  UpKeysConfig g u <> UpKeysConfig g' u' = UpKeysConfig (g && g') (u <> u')
+
+-- | Bind actions to keys upon their release.
+useUpKeys :: UpKeysConfig -> (XConfig l -> XConfig l)
+useUpKeys upKeysConf = flip XC.once upKeysConf \conf -> conf
+  { handleEventHook = handleEventHook conf <> (\e -> handleKeyUp e $> All True)
+  , startupHook     = startupHook     conf <> when (grabKeys upKeysConf) grabUpKeys
+  }
+ where
+  grabUpKeys :: X ()
+  grabUpKeys = do
+    XConf{ display = dpy, theRoot = rootw } <- ask
+    realKeys <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig
+    let grab :: (KeyMask, KeyCode) -> X ()
+        grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
+    traverse_ grab =<< mkGrabs (Map.keys realKeys)
+
+-- | Parse the given EZConfig-style keys into the internal keymap
+-- representation.
+--
+-- This is just 'mkKeymap' with a better name.
+ezUpKeys :: XConfig l -> [(String, X ())] -> Map (KeyMask, KeySym) (X ())
+ezUpKeys = mkKeymap
+
+-- | A handler for key-up events.
+handleKeyUp :: Event -> X ()
+handleKeyUp KeyEvent{ ev_event_type, ev_state, ev_keycode }
+  | ev_event_type == keyRelease = withDisplay \dpy -> do
+      s   <- io $ keycodeToKeysym dpy ev_keycode 0
+      cln <- cleanMask ev_state
+      ks  <- maybe mempty upKeys <$> XC.ask @X @UpKeysConfig
+      userCodeDef () $ whenJust (ks Map.!? (cln, s)) id
+handleKeyUp _ = pure ()

XMonad/Actions/WindowBringer.hs

@@ -22,6 +22,7 @@ module XMonad.Actions.WindowBringer (
                     WindowBringerConfig(..),
                     gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
                     bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
+                    copyMenu, copyMenuConfig, copyMenu', copyMenuArgs, copyMenuArgs',
                     windowMap, windowAppMap, windowMap', bringWindow, actionMenu
                    ) where
 
@@ -33,6 +34,7 @@ import XMonad
 import qualified XMonad as X
 import XMonad.Util.Dmenu (menuMapArgs)
 import XMonad.Util.NamedWindows (getName, getNameWMClass)
+import XMonad.Actions.CopyWindow (copyWindow)
 
 -- $usage
 --
@@ -44,6 +46,7 @@ import XMonad.Util.NamedWindows (getName, getNameWMClass)
 --
 -- > , ((modm .|. shiftMask, xK_g     ), gotoMenu)
 -- > , ((modm .|. shiftMask, xK_b     ), bringMenu)
+-- > , ((modm .|. shiftMask, xK_y     ), copyMenu)
 --
 -- For detailed instructions on editing your key bindings, see
 -- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
@@ -90,6 +93,37 @@ gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
 gotoMenuArgs' :: String -> [String] -> X ()
 gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
 
+-- | Pops open a dmenu with window titles. Choose one, and it will be copied into your current workspace.
+copyMenu :: X ()
+copyMenu = copyMenuArgs def
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   copied into your current workspace. This version
+--   accepts a configuration object.
+copyMenuConfig :: WindowBringerConfig -> X ()
+copyMenuConfig wbConfig = actionMenu wbConfig copyBringWindow
+
+-- | Pops open a dmenu with window titles. Choose one, and it will be
+--   copied into your current workspace. This version
+--   takes a list of arguments to pass to dmenu.
+copyMenuArgs :: [String] -> X ()
+copyMenuArgs args = copyMenuConfig def { menuArgs = args }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be copied into your current workspace.
+copyMenu' :: String -> X ()
+copyMenu' cmd = copyMenuConfig def { menuArgs = [], menuCommand = cmd }
+
+-- | Pops open an application with window titles given over stdin. Choose one,
+--   and it will be copied into your current
+--   workspace. This version allows arguments to the chooser to be specified.
+copyMenuArgs' :: String -> [String] -> X ()
+copyMenuArgs' cmd args = copyMenuConfig def { menuArgs = args, menuCommand = cmd }
+
+-- | Brings a copy of the specified window into the current workspace.
+copyBringWindow :: Window -> X.WindowSet -> X.WindowSet
+copyBringWindow w ws = copyWindow w (W.currentTag ws) ws
+
 -- | Pops open a dmenu with window titles. Choose one, and it will be
 --   dragged, kicking and screaming, into your current workspace.
 bringMenu :: X ()
@@ -159,7 +193,7 @@ decorateName ws w = do
   return $ name ++ " [" ++ W.tag ws ++ "]"
 
 -- | Returns the window name as will be listed in dmenu.  This will
--- return the executable name of the window along with it's workspace
+-- return the executable name of the window along with its workspace
 -- ID.
 decorateAppName :: X.WindowSpace -> Window -> X String
 decorateAppName ws w = do

XMonad/Actions/WindowNavigation.hs

@@ -1,10 +1,12 @@
+{-# LANGUAGE TupleSections #-} -- I didn't want this, it's hlint's "suggestion" and it's apparently non-negotiable
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Actions.WindowNavigation
 -- Description :  Experimental rewrite of "XMonad.Layout.WindowNavigation".
 -- Copyright   :  (c) 2007  David Roundy <droundy@darcs.net>,
 --                          Devin Mullins <me@twifkak.com>
--- Maintainer  :  Devin Mullins <me@twifkak.com>
+-- Maintainer  :  Devin Mullins <me@twifkak.com>,
+--                Platon Pronko <platon7pronko@gmail.com>
 -- License     :  BSD3-style (see LICENSE)
 -- Stability   :  unstable
 -- Portability :  unportable
@@ -37,17 +39,19 @@ module XMonad.Actions.WindowNavigation (
                                        withWindowNavigationKeys,
                                        WNAction(..),
                                        go, swap,
+                                       goPure, swapPure,
                                        Direction2D(..), WNState,
                                        ) where
 
-import XMonad
+import XMonad hiding (state)
-import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, sortOn)
+import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
 import XMonad.Util.Types (Direction2D(..))
 import qualified XMonad.StackSet as W
 
 import Control.Arrow (second)
 import Data.IORef
 import Data.Map (Map())
+import Data.List (partition, find)
 import qualified Data.Map as M
 import qualified Data.Set as S
 
@@ -101,27 +105,60 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} =
 
 withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
 withWindowNavigationKeys wnKeys conf = do
-    posRef <- newIORef M.empty
+    stateRef <- newIORef M.empty
-    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
+    return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)
                                  `M.union` keys conf cnf,
-                  logHook = logHook conf >> trackMovement posRef }
+                  logHook = logHook conf >> trackMovement stateRef }
-  where fromWNAction posRef (WNGo dir)   = go   posRef dir
+  where fromWNAction stateRef (WNGo dir)   = go   stateRef dir
-        fromWNAction posRef (WNSwap dir) = swap posRef dir
+        fromWNAction stateRef (WNSwap dir) = swap stateRef dir
 
 data WNAction = WNGo Direction2D | WNSwap Direction2D
 
 type WNState = Map WorkspaceId Point
 
--- go:
+-- | Focus window in the given direction.
--- 1. get current position, verifying it matches the current window
--- 2. get target windowrect
--- 3. focus window
--- 4. set new position
 go :: IORef WNState -> Direction2D -> X ()
-go = withTargetWindow W.focusWindow
+go stateRef dir = runPureAction stateRef (goPure dir)
 
+-- | Swap current window with the window in the given direction.
+-- Note: doesn't work with floating windows (don't think it makes much sense to swap floating windows).
 swap :: IORef WNState -> Direction2D -> X ()
-swap = withTargetWindow swapWithFocused
+swap stateRef dir = runPureAction stateRef (swapPure dir)
+
+type WindowRectFn x = (Window -> x (Maybe Rectangle))
+-- | (state, oldWindowSet, mappedWindows, windowRect)
+type WNInput x = (WNState, WindowSet, S.Set Window, WindowRectFn x)
+type WNOutput = (WNState, WindowSet)
+
+-- | Run the pure action inside X monad.
+runPureAction :: IORef WNState -> (WNInput X -> X WNOutput) -> X ()
+runPureAction stateRef action = do
+  oldState <- io (readIORef stateRef)
+  oldWindowSet <- gets windowset
+  mappedWindows <- gets mapped
+  (newState, newWindowSet) <- action (oldState, oldWindowSet, mappedWindows, windowRectX)
+  windows (const newWindowSet)
+  io $ writeIORef stateRef newState
+
+-- | Version of `go` not dependent on X monad (needed for testing).
+goPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
+goPure dir input@(oldState, oldWindowSet, mappedWindows, _) =
+  if length (filter (`S.member` mappedWindows) $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet) == 1
+  then
+    -- Handle the special case of Full layout, when there's only one mapped window on a screen.
+    return ( oldState
+           , case dir of
+               U -> W.focusUp oldWindowSet
+               L -> W.focusDown oldWindowSet
+               D -> W.focusDown oldWindowSet
+               R -> W.focusUp oldWindowSet
+           )
+  else
+    withTargetWindow W.focusWindow dir input
+
+-- | Version of `swap` not dependent on X monad (needed for testing).
+swapPure :: Monad x => Direction2D -> WNInput x -> x WNOutput
+swapPure = withTargetWindow swapWithFocused
   where swapWithFocused targetWin winSet =
             case W.peek winSet of
                 Just currentWin -> W.focusWindow currentWin $
@@ -135,87 +172,249 @@ swap = withTargetWindow swapWithFocused
           | win == win2 = win1
           | otherwise = win
 
-withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
+-- | Select a target window in the given direction and modify the WindowSet.
-withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
+-- 1. Get current position, verifying it matches the current window (exit if no focused window).
-    targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
+-- 2. Get the target window.
-    whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
+-- 3. Execute an action on the target window and windowset.
-      windows (adj targetWin)
+-- 4. Set the new position.
-      setPosition posRef pos targetRect
+withTargetWindow :: Monad x => (Window -> WindowSet -> WindowSet) -> Direction2D -> WNInput x -> x WNOutput
+withTargetWindow adj dir input@(oldState, oldWindowSet, _, _) = do
+  whenJust' (getCurrentWindow input) (oldState, oldWindowSet) $ \(win, winRect, pos) -> do
+    targetMaybe <- find ((/= win) . fst) <$> navigableTargets input dir winRect pos
+    whenJust' (pure targetMaybe) (oldState, oldWindowSet) $ \(targetWin, newPos) ->
+      let newWindowSet = adj targetWin oldWindowSet
+      in return (modifyState newWindowSet newPos oldState, newWindowSet)
 
+-- | Update position on outside changes in windows.
 trackMovement :: IORef WNState -> X ()
-trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
+trackMovement stateRef = do
-                           windowRect win >>= flip whenJust (setPosition posRef pos . snd)
+  oldState <- io (readIORef stateRef)
+  oldWindowSet <- gets windowset
+  mappedWindows <- gets mapped
+  whenJust' (getCurrentWindow (oldState, oldWindowSet, mappedWindows, windowRectX)) () $ \(_, _, pos) -> do
+      io $ writeIORef stateRef $ modifyState oldWindowSet pos oldState
 
-fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
+-- | Get focused window and current position.
-fromCurrentPoint posRef f = withFocused $ \win ->
+getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
-                                currentPosition posRef >>= f win
+getCurrentWindow input@(_, oldWindowSet, _, _) =
+  whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do
+    (pos, rect) <- currentPosition input
+    return $ Just (window, rect, pos)
 
--- Gets the current position from the IORef passed in, or if nothing (say, from
+-- | Gets the current position from the state passed in, or if nothing
--- a restart), derives the current position from the current window. Also,
+-- (say, from a restart), derives the current position from the current window.
--- verifies that the position is congruent with the current window (say, if you
+-- Also, verifies that the position is congruent with the current window
--- used mod-j/k or mouse or something).
+-- (say, if you moved focus using mouse or something).
-currentPosition :: IORef WNState -> X Point
+-- Returns the window rectangle for convenience, since we'll need it later anyway.
-currentPosition posRef = do
+currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
-    root <- asks theRoot
+currentPosition (state, oldWindowSet, _, windowRect) = do
-    currentWindow <- gets (W.peek . windowset)
+  currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)
-    currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
+  let posMaybe = M.lookup (W.currentTag oldWindowSet) state
+      middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
+  return $ case posMaybe of
+    Nothing -> (middleOf currentRect, currentRect)
+    Just pos -> (centerPosition currentRect pos, currentRect)
 
-    wsid <- gets (W.currentTag . windowset)
+-- | Inserts new position into the state.
-    mp <- M.lookup wsid <$> io (readIORef posRef)
+modifyState :: WindowSet -> Point -> WNState -> WNState
+modifyState oldWindowSet =
+  M.insert (W.currentTag oldWindowSet)
 
-    return $ maybe (middleOf currentRect) (`inside` currentRect) mp
+-- | "Jumps" the current position into the middle of target rectangle.
-
+-- (keeps the position as-is if it is already inside the target rectangle)
-  where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
+centerPosition :: Rectangle -> Point -> Point
-
+centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do
-setPosition :: IORef WNState -> Point -> Rectangle -> X ()
+  if pointWithin x y r
-setPosition posRef oldPos newRect = do
-    wsid <- gets (W.currentTag . windowset)
-    io $ modifyIORef posRef $ M.insert wsid (oldPos `inside` newRect)
-
-inside :: Point -> Rectangle -> Point
-Point x y `inside` Rectangle rx ry rw rh =
-    Point (x `within` (rx, rw)) (y `within` (ry, rh))
-  where pos `within` (lower, dim) = if pos >= lower && pos < lower + fromIntegral dim
   then pos
-                                    else midPoint lower dim
+  else Point (midPoint rx rw) (midPoint ry rh)
 
 midPoint :: Position -> Dimension -> Position
 midPoint pos dim = pos + fromIntegral dim `div` 2
 
-navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
+-- | Make a list of target windows we can navigate to,
-navigableTargets point dir = navigable dir point <$> windowRects
+-- sorted by desirability of navigation.
+navigableTargets :: Monad x => WNInput x -> Direction2D -> Rectangle -> Point -> x [(Window, Point)]
+navigableTargets input@(_, oldWindowSet, _, _) dir currentRect currentPos = do
+  allScreensWindowsAndRectangles <- mapSnd (rectTransform dir) <$> windowRects input
+  let
+    screenWindows = S.fromList $ W.integrate' $ W.stack $ W.workspace $ W.current oldWindowSet
+    (thisScreenWindowsAndRectangles, otherScreensWindowsAndRectangles) = partition (\(w, _) -> S.member w screenWindows) allScreensWindowsAndRectangles
 
--- Filters and sorts the windows in terms of what is closest from the Point in
+    pos = pointTransform dir currentPos
--- the Direction2D.
+    wr = rectTransform dir currentRect
-navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
-navigable d pt = sortby d . filter (inr d pt . snd)
 
--- Produces a list of normal-state windows, on any screen. Rectangles are
+    rectInside r = (rect_p1 r >= rect_p1 wr && rect_p1 r < rect_p2 wr && rect_p2 r > rect_p1 wr && rect_p2 r <= rect_p2 wr) &&
--- adjusted based on screen position relative to the current screen, because I'm
+                   ((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||
--- bad like that.
+                    (rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis
-windowRects :: X [(Window, Rectangle)]
+    sortByP2 = sortOn (rect_p2 . snd)
-windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
+    posBeforeEdge r = point_p pos < rect_p2 r
 
-windowRect :: Window -> X (Maybe (Window, Rectangle))
+    rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&
-windowRect win = withDisplay $ \dpy -> do
+                         rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr
+    rectOverlapsOneEdge r = rectOverlapsEdge r && rect_p1 r > rect_p1 wr
+    rectOverlapsBothEdges r = rectOverlapsEdge r &&
+                              rect_o1 r > rect_o1 wr && rect_o2 r < rect_o2 wr && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
+    distanceToRectEdge r = max (max 0 (rect_o1 r - point_o pos)) (max 0 (point_o pos + 1 - rect_o2 r))
+    distanceToRectCenter r =
+      let distance = (rect_o1 r + rect_o2 r) `div` 2 - point_o pos
+      in if distance <= 0
+         then distance + 1
+         else distance
+    sortByPosDistance = sortOn ((\r -> (rect_p1 r, distanceToRectEdge r, distanceToRectCenter r)) . snd)
+
+    rectOutside r = rect_p1 r < rect_p1 wr && rect_p2 r > rect_p2 wr &&
+                    rect_o1 r < rect_o1 wr && rect_o2 r > rect_o2 wr
+    sortByLength = sortOn (rect_psize . snd)
+
+    rectAfterEdge r = rect_p1 r > rect_p2 wr
+
+    -- Modified from David Roundy and Devin Mullins original implementation of WindowNavigation:
+    inr r = point_p pos < rect_p2 r && point_o pos >= rect_o1 r && point_o pos < rect_o2 r
+
+    clamp v v1 v2 | v < v1 = v1
+                  | v >= v2 = v2 - 1
+                  | otherwise = v
+    dragPos r = DirPoint (max (point_p pos) (rect_p1 r)) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))
+
+  return $ mapSnd (inversePointTransform dir) $ concat
+    [
+      -- First, navigate to windows that are fully inside current window
+      -- and have higher coordinate bigger than current position.
+      -- ┌──────────────────┐
+      -- │   current        │  (all examples assume direction=R)
+      -- │    ┌──────────┐  │
+      -- │  ──┼─► inside │  │
+      -- │    └──────────┘  │
+      -- └──────────────────┘
+      -- Also include windows fully overlapping current on the orthogonal axis:
+      --             ┌──────────────┐
+      --             │ overlapping  │
+      -- ┌───────────┤              ├────┐
+      -- │ current ──┼─►            │    │
+      -- └───────────┤              ├────┘
+      --             └──────────────┘
+      mapSnd dragPos $ sortByP2 $ filterSnd posBeforeEdge $ filterSnd rectInside thisScreenWindowsAndRectangles
+
+      -- Then navigate to windows that touch or overlap the edge of current window in the chosen direction.
+      -- ┌──────────────┬─────────────┐   ┌───────────┐                   ┌─────────────┐
+      -- │ current      │ adjacent    │   │ current   │                   │ current     │
+      -- │            ──┼─►           │   │       ┌───┴───────────────┐   │         ┌───┴─────────────┐
+      -- │              │             │   │     ──┼─► │   overlapping │   │       ──┼─►               │
+      -- │              ├─────────────┘   │       └───┬───────────────┘   └─────────┤     overlapping │
+      -- │              │                 │           │                             │                 │
+      -- └──────────────┘                 └───────────┘                             └─────────────────┘
+    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectOverlapsOneEdge thisScreenWindowsAndRectangles
+
+      -- Windows fully overlapping current window "in the middle" on the parallel axis are also included,
+      -- if position is inside them:
+      --     ┌───────────┐
+      --     │  current  │
+      -- ┌───┤-----------├────────────────┐
+      -- │   │     *   ──┼─►  overlapping │
+      -- └───┤-----------├────────────────┘
+      --     └───────────┘
+    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByPosDistance $ filterSnd rectOverlapsBothEdges thisScreenWindowsAndRectangles
+
+      -- Then navigate to windows that fully encompass the current window.
+      -- ┌─────────────────────┐
+      -- │    outer            │
+      -- │  ┌─────────────┐    │
+      -- │  │  current  ──┼─►  │
+      -- │  └─────────────┘    │
+      -- └─────────────────────┘
+    , mapSnd (\_ -> DirPoint (rect_p2 wr) (point_o pos)) $ sortByLength $ filterSnd rectOutside thisScreenWindowsAndRectangles
+
+      -- Then navigate to windows that are fully after current window in the chosen direction.
+      -- ┌──────────────┐
+      -- │ current      │  ┌────────────────┐
+      -- │              │  │                │
+      -- │            ──┼──┼─► not adjacent │
+      -- │              │  │                │
+      -- │              │  └────────────────┘
+      -- └──────────────┘
+    , mapSnd dragPos $ sortByPosDistance $ filterSnd rectAfterEdge thisScreenWindowsAndRectangles
+
+      -- Cast a ray from the current position, jump to the first window (on another screen) that intersects this ray.
+    , mapSnd dragPos $ sortByPosDistance $ filterSnd inr otherScreensWindowsAndRectangles
+
+      -- If everything else fails, then navigate to the window that is fully inside current window,
+      -- but is before the current position.
+      -- This can happen when we are at the last window on a screen, and attempt to navigate even further.
+      -- In this case it seems okay to jump to the remaining inner windows, since we don't have any other choice anyway,
+      -- and user is probably not so fully aware of the precise position anyway.
+    , mapSnd (\r -> DirPoint (rect_p2 r - 1) (clamp (point_o pos) (rect_o1 r) (rect_o2 r))) $
+      sortByP2 $ filterSnd (not . posBeforeEdge) $ filterSnd rectInside thisScreenWindowsAndRectangles
+    ]
+
+-- Structs for direction-independent space - equivalent to rotating points and rectangles such that
+-- navigation direction points to the right.
+-- Allows us to abstract over direction in the navigation functions.
+data DirPoint = DirPoint
+  { point_p :: Position -- coordinate parallel to the direction
+  , point_o :: Position -- coordinate orthogonal to the direction
+  }
+data DirRectangle = DirRectangle
+  { rect_p1 :: Position -- lower rectangle coordinate parallel to the direction
+  , rect_p2 :: Position -- higher rectangle coordinate parallel to the direction
+  , rect_o1 :: Position -- lower rectangle coordinate orthogonal to the direction
+  , rect_o2 :: Position -- higher rectangle coordinate orthogonal to the direction
+  }
+{- HLINT ignore "Use camelCase" -}
+rect_psize :: DirRectangle -> Dimension
+rect_psize r = fromIntegral (rect_p2 r - rect_p1 r)
+
+-- | Transform a point from screen space into direction-independent space.
+pointTransform :: Direction2D -> Point -> DirPoint
+pointTransform dir (Point x y) = case dir of
+  U -> DirPoint (negate y - 1) x
+  L -> DirPoint (negate x - 1) (negate y - 1)
+  D -> DirPoint y (negate x - 1)
+  R -> DirPoint x y
+
+-- | Transform a point from direction-independent space back into screen space.
+inversePointTransform :: Direction2D -> DirPoint -> Point
+inversePointTransform dir p = case dir of
+  U -> Point (point_o p) (negate $ point_p p + 1)
+  L -> Point (negate $ point_p p + 1) (negate $ point_o p + 1)
+  D -> Point (negate $ point_o p + 1) (point_p p)
+  R -> Point (point_p p) (point_o p)
+
+-- | Transform a rectangle from screen space into direction-independent space.
+rectTransform :: Direction2D -> Rectangle -> DirRectangle
+rectTransform dir (Rectangle x y w h) = case dir of
+  U -> DirRectangle (negate $ y + fromIntegral h) (negate y) x (x + fromIntegral w)
+  L -> DirRectangle (negate $ x + fromIntegral w) (negate x) (negate $ y + fromIntegral h) (negate y)
+  D -> DirRectangle y (y + fromIntegral h) (negate $ x + fromIntegral w) (negate x)
+  R -> DirRectangle x (x + fromIntegral w) y (y + fromIntegral h)
+
+-- | Produces a list of normal-state windows on all screens, excluding currently focused window.
+windowRects :: Monad x => WNInput x -> x [(Window, Rectangle)]
+windowRects (_, oldWindowSet, mappedWindows, windowRect) =
+  let
+    allWindows = filter (\w -> w `notElem` W.peek oldWindowSet) $ S.toList mappedWindows
+    windowRect2 w = fmap (w,) <$> windowRect w
+  in catMaybes <$> mapM windowRect2 allWindows
+
+windowRectX :: Window -> X (Maybe Rectangle)
+windowRectX win = withDisplay $ \dpy -> do
     (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
-    return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
+    return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
     `catchX` return Nothing
 
--- Modified from droundy's implementation of WindowNavigation:
+-- Maybe below functions can be replaced with some standard helper functions?
 
-inr :: Direction2D -> Point -> Rectangle -> Bool
+-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
-inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
+whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
-                                                        py < ry + fromIntegral h
+whenJust' monadMaybeValue deflt f = do
-inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
+  maybeValue <- monadMaybeValue
-                                            py >  ry
+  case maybeValue of
-inr R (Point px py) (Rectangle rx ry w h) =             px < rx + fromIntegral w &&
+    Nothing -> return deflt
-                                            py >= ry && py < ry + fromIntegral h
+    Just value -> f value
-inr L (Point px py) (Rectangle rx ry _ h) = px >  rx &&
-                                            py >= ry && py < ry + fromIntegral h
 
-sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
+-- | Filter a list of tuples on the second tuple member.
-sortby D = sortOn (rect_y . snd)
+filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
-sortby R = sortOn (rect_x . snd)
+filterSnd f = filter (f . snd)
-sortby U = reverse . sortby D
+
-sortby L = reverse . sortby R
+-- | Map a second tuple member in a list of tuples.
+mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
+mapSnd f = map (second f)

XMonad/Actions/WorkspaceNames.hs

@@ -138,7 +138,7 @@ setCurrentWorkspaceName name = do
 -- | Prompt for a new name for the current workspace and set it.
 renameWorkspace :: XPConfig -> X ()
 renameWorkspace conf = do
-    completion <- historyCompletionP (prompt ==)
+    completion <- historyCompletionP conf (prompt ==)
     mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
   where
     prompt = "Workspace name: "

XMonad/Config/Prime.hs

@@ -1,3 +1,4 @@
+{-# OPTIONS_HADDOCK hide #-}
 {-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
 
 -----------------------------------------------------------------------------

XMonad/Hooks/DebugEvents.hs

@@ -33,7 +33,6 @@ import           XMonad.Util.DebugWindow                     (debugWindow)
 -- import           Graphics.X11.Xlib.Extras.GetAtomName        (getAtomName)
 
 import           Control.Exception                    as E
-import           Control.Monad.Fail
 import           Control.Monad.State
 import           Control.Monad.Reader
 import           Codec.Binary.UTF8.String

XMonad/Hooks/EwmhDesktops.hs

@@ -42,6 +42,10 @@ module XMonad.Hooks.EwmhDesktops (
     -- $customActivate
     setEwmhActivateHook,
 
+    -- ** Workspace switching
+    -- $customWorkspaceSwitch
+    setEwmhSwitchDesktopHook,
+
     -- ** Fullscreen
     -- $customFullscreen
     setEwmhFullscreenHooks,
@@ -50,6 +54,9 @@ module XMonad.Hooks.EwmhDesktops (
     -- $customManageDesktopViewport
     disableEwmhManageDesktopViewport,
 
+    -- $customHiddenWorkspaceMapper
+    setEwmhHiddenWorkspaceToScreenMapping,
+
     -- * Standalone hooks (deprecated)
     ewmhDesktopsStartup,
     ewmhDesktopsLogHook,
@@ -114,8 +121,12 @@ data EwmhDesktopsConfig =
             -- ^ configurable handling of window activation requests
         , fullscreenHooks :: (ManageHook, ManageHook)
             -- ^ configurable handling of fullscreen state requests
+        , switchDesktopHook :: WorkspaceId -> WindowSet -> WindowSet
+            -- ^ configurable action for handling _NET_CURRENT_DESKTOP
         , manageDesktopViewport :: Bool
             -- ^ manage @_NET_DESKTOP_VIEWPORT@?
+        , hiddenWorkspaceToScreen :: WindowSet -> WindowSpace -> WindowScreen
+            -- ^ map hidden workspaces to screens for @_NET_DESKTOP_VIEWPORT@
         }
 
 instance Default EwmhDesktopsConfig where
@@ -124,7 +135,10 @@ instance Default EwmhDesktopsConfig where
         , workspaceRename = pure pure
         , activateHook = doFocus
         , fullscreenHooks = (doFullFloat, doSink)
+        , switchDesktopHook = W.view
         , manageDesktopViewport = True
+        -- Hidden workspaces are mapped to the current screen by default.
+        , hiddenWorkspaceToScreen = \winset _ -> W.current winset
         }
 
 
@@ -231,8 +245,8 @@ setEwmhWorkspaceRename f = XC.modifyDef $ \c -> c{ workspaceRename = f }
 -- >   [ className =? "Google-chrome" <||> className =? "google-chrome" -?> doAskUrgent
 -- >   , pure True -?> doFocus ]
 --
--- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers" and "XMonad.Hooks.Focus"
+-- See "XMonad.ManageHook", "XMonad.Hooks.ManageHelpers", "XMonad.Hooks.Focus" and
--- for functions that can be useful here.
+-- "XMonad.Layout.IndependentScreens" for functions that can be useful here.
 
 -- | Set (replace) the hook which is invoked when a client sends a
 -- @_NET_ACTIVE_WINDOW@ request to activate a window. The default is 'doFocus'
@@ -245,6 +259,31 @@ setEwmhActivateHook :: ManageHook -> XConfig l -> XConfig l
 setEwmhActivateHook h = XC.modifyDef $ \c -> c{ activateHook = h }
 
 
+-- $customWorkspaceSwitch
+-- When a client sends a @_NET_CURRENT_DESKTOP@ request to switch to a workspace,
+-- the default action used to do that is the 'W.view' function.
+-- This may not be the desired behaviour in all configurations.
+--
+-- For example if using the "XMonad.Layout.IndependentScreens" the default action
+-- might move a workspace to a screen that it isn't supposed to be on.
+-- This behaviour can be fixed using the following:
+--
+-- > import XMonad.Actions.OnScreen
+-- > import XMonad.Layout.IndependentScreens
+-- >
+-- > main = xmonad $ ... . setEwmhSwitchDesktopHook focusWorkspace . ewmh . ... $
+-- >  def{
+-- >    ...
+-- >      workspaces = withScreens 2 (workspaces def)
+-- >    ...
+-- >  }
+
+-- | Set (replace) the action which is invoked when a client sends a
+-- @_NET_CURRENT_DESKTOP@ request to switch workspace.
+setEwmhSwitchDesktopHook :: (WorkspaceId -> WindowSet -> WindowSet) -> XConfig l -> XConfig l
+setEwmhSwitchDesktopHook action = XC.modifyDef $ \c -> c{ switchDesktopHook = action }
+
+
 -- $customFullscreen
 -- When a client sends a @_NET_WM_STATE@ request to add\/remove\/toggle the
 -- @_NET_WM_STATE_FULLSCREEN@ state, 'ewmhFullscreen' uses a pair of hooks to
@@ -284,6 +323,34 @@ disableEwmhManageDesktopViewport :: XConfig l -> XConfig l
 disableEwmhManageDesktopViewport = XC.modifyDef $ \c -> c{ manageDesktopViewport = False }
 
 
+-- $customHiddenWorkspaceMapper
+--
+-- Mapping the hidden workspaces to the current screen is a good default behavior,
+-- but it makes the assumption that workspaces don't belong to a sepcific screen.
+-- If the default behaviour is undesired, for example when using "XMonad.Layout.IndependentScreens",
+-- it can be customized.
+--
+-- The following example demonstrates a way to configure the mapping when using "XMonad.Layout.IndependentScreens":
+--
+-- > import XMonad.Layout.IndependentScreens
+-- >
+-- > customMapper :: WindowSet -> (WindowSpace -> WindowScreen)
+-- > customMapper winset (Workspace wsid _ _) = fromMaybe (W.current winset) maybeMappedScreen
+-- >  where
+-- >    screenId = unmarshallS wsid
+-- >    maybeMappedScreen = screenOnMonitor screenId winset
+-- >
+-- >
+-- > main = xmonad $ ... . setEwmhHiddenWorkspaceToScreenMapping customMapper . ewmh . ... $ def{...}
+
+-- | Set (replace) the function responsible for mapping the hidden workspaces to screens.
+setEwmhHiddenWorkspaceToScreenMapping :: (WindowSet -> (WindowSpace -> WindowScreen))
+                                        -- ^ Function that given the current WindowSet
+                                        -- produces a function to maps a (hidden) workspace to a screen.
+                                        -> XConfig l -> XConfig l
+setEwmhHiddenWorkspaceToScreenMapping mapper = XC.modifyDef $ \c -> c{ hiddenWorkspaceToScreen = mapper }
+
+
 -- | Initializes EwmhDesktops and advertises EWMH support to the X server.
 {-# DEPRECATED ewmhDesktopsStartup "Use ewmh instead." #-}
 ewmhDesktopsStartup :: X ()
@@ -358,7 +425,7 @@ whenChanged :: (Eq a, ExtensionClass a) => a -> X () -> X ()
 whenChanged = whenX . XS.modified . const
 
 ewmhDesktopsLogHook' :: EwmhDesktopsConfig -> X ()
-ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport} = withWindowSet $ \s -> do
+ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDesktopViewport, hiddenWorkspaceToScreen} = withWindowSet $ \s -> do
     sort' <- workspaceSort
     let ws = sort' $ W.workspaces s
 
@@ -423,18 +490,20 @@ ewmhDesktopsLogHook' EwmhDesktopsConfig{workspaceSort, workspaceRename, manageDe
     when manageDesktopViewport $ do
         let visibleScreens = W.current s : W.visible s
             currentTags    = map (W.tag . W.workspace) visibleScreens
-        whenChanged (MonitorTags currentTags) $ mkViewPorts s (map W.tag ws)
+        whenChanged (MonitorTags currentTags) $ mkViewPorts s hiddenWorkspaceToScreen (map W.tag ws)
 
 -- | Create the viewports from the current 'WindowSet' and a list of
 -- already sorted workspace IDs.
-mkViewPorts :: WindowSet -> [WorkspaceId] -> X ()
+mkViewPorts :: WindowSet -> (WindowSet -> WindowSpace -> WindowScreen) -> [WorkspaceId] -> X ()
-mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
+mkViewPorts winset hiddenWorkspaceMapper = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
   where
     foc = W.current winset
-    -- Hidden workspaces are mapped to the current screen's viewport.
     viewPorts :: M.Map WorkspaceId [Position]
     viewPorts = M.fromList $ map mkVisibleViewPort (foc : W.visible winset)
-                          ++ map (mkViewPort foc)  (W.hidden winset)
+                          ++ map (uncurry mkViewPort) hiddenWorkspacesWithScreens
+
+    hiddenWorkspacesWithScreens :: [(WindowScreen,WindowSpace)]
+    hiddenWorkspacesWithScreens = map (\x -> (hiddenWorkspaceMapper winset x, x)) (W.hidden winset)
 
     mkViewPort :: WindowScreen -> WindowSpace -> (WorkspaceId, [Position])
     mkViewPort scr w = (W.tag w, mkPos scr)
@@ -449,7 +518,7 @@ mkViewPorts winset = setDesktopViewport . concat . mapMaybe (viewPorts M.!?)
 ewmhDesktopsEventHook' :: Event -> EwmhDesktopsConfig -> X All
 ewmhDesktopsEventHook'
         ClientMessageEvent{ev_window = w, ev_message_type = mt, ev_data = d}
-        EwmhDesktopsConfig{workspaceSort, activateHook} =
+        EwmhDesktopsConfig{workspaceSort, activateHook, switchDesktopHook} =
     withWindowSet $ \s -> do
         sort' <- workspaceSort
         let ws = sort' $ W.workspaces s
@@ -459,10 +528,17 @@ ewmhDesktopsEventHook'
         a_aw <- getAtom "_NET_ACTIVE_WINDOW"
         a_cw <- getAtom "_NET_CLOSE_WINDOW"
 
-        if  | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
+        if  | mt == a_cw ->
-                if W.currentTag s == W.tag ww then mempty else windows $ W.view (W.tag ww)
+                killWindow w
+            | mt == a_cd, n : _ <- d, Just ww <- ws !? fi n ->
+                if W.currentTag s == W.tag ww then mempty else windows $ switchDesktopHook (W.tag ww)
             | mt == a_cd ->
                 trace $ "Bad _NET_CURRENT_DESKTOP with data=" ++ show d
+            | not (w `W.member` s) ->
+                -- do nothing for unmanaged windows; it'd be just a useless
+                -- refresh which breaks menus/popups of misbehaving apps that
+                -- send _NET_ACTIVE_WINDOW requests for override-redirect wins
+                mempty
             | mt == a_d, n : _ <- d, Just ww <- ws !? fi n ->
                 if W.findTag w s == Just (W.tag ww) then mempty else windows $ W.shiftWin (W.tag ww) w
             | mt == a_d ->
@@ -473,8 +549,6 @@ ewmhDesktopsEventHook'
                 if W.peek s == Just w then mempty else windows $ W.focusWindow w
             | mt == a_aw -> do
                 if W.peek s == Just w then mempty else windows . appEndo =<< runQuery activateHook w
-            | mt == a_cw ->
-                killWindow w
             | otherwise ->
                 -- The Message is unknown to us, but that is ok, not all are meant
                 -- to be handled by the window manager

XMonad/Hooks/FloatConfigureReq.hs

@@ -0,0 +1,126 @@
+{-# LANGUAGE LambdaCase #-}
+-- |
+-- Module      :  XMonad.Hooks.FloatConfigureReq
+-- Description :  Customize handling of floating windows' move\/resize\/restack requests (ConfigureRequest).
+-- Copyright   :  (c) 2024 Tomáš Janoušek <tomi@nomi.cz>
+-- License     :  BSD3
+-- Maintainer  :  Tomáš Janoušek <tomi@nomi.cz>
+--
+-- xmonad normally honours those requests by doing exactly what the client
+-- application asked, and refreshing. There are some misbehaving clients,
+-- however, that:
+--
+-- * try to move their window to the last known absolute position regardless
+--   of the current xrandr/xinerama layout
+--
+-- * move their window to 0, 0 for no particular reason (e.g. rxvt-unicode)
+--
+-- * issue lots of no-op requests causing flickering (e.g. Steam)
+--
+-- This module provides a replacement handler for 'ConfigureRequestEvent' to
+-- work around such misbehaviours.
+--
+module XMonad.Hooks.FloatConfigureReq (
+    -- * Usage
+    -- $usage
+    MaybeMaybeManageHook,
+    floatConfReqHook,
+
+    -- * Known workarounds
+    fixSteamFlicker,
+    fixSteamFlickerMMMH,
+    ) where
+
+import qualified Data.Map.Strict as M
+import XMonad
+import XMonad.Hooks.ManageHelpers
+import XMonad.Prelude
+import qualified XMonad.StackSet as W
+
+-- $usage
+-- To use this, include the following in your @xmonad.hs@:
+--
+-- > import XMonad.Hooks.FloatConfigureReq
+-- > import XMonad.Hooks.ManageHelpers
+--
+-- > myFloatConfReqHook :: MaybeMaybeManageHook
+-- > myFloatConfReqHook = composeAll
+-- >     [ … ]
+--
+-- > myEventHook :: Event -> X All
+-- > myEventHook = mconcat
+-- >     [ …
+-- >     , floatConfReqHook myFloatConfReqHook
+-- >     , … ]
+--
+-- > main = xmonad $ …
+-- >               $ def{ handleEventHook = myEventHook
+-- >                    , … }
+--
+-- Then fill the @myFloatConfReqHook@ with whatever custom rules you need.
+--
+-- As an example, the following will prevent rxvt-unicode from moving its
+-- (floating) window to 0, 0 after a font change but still ensure its size
+-- increment hints are respected:
+--
+-- > className =? "URxvt" -?> pure <$> doFloat
+--
+-- Another example that avoids flickering and xmonad slowdowns caused by the
+-- Steam client (completely ignore all its requests, none of which are
+-- meaningful in the context of a tiling WM):
+--
+-- > map toLower `fmap` className =? "steam" -?> mempty
+--
+-- (this example is also available as 'fixSteamFlickerMMMH' to be added to
+-- one's @myFloatConfReqHook@ and also 'fixSteamFlicker' to be added directly
+-- to one's 'handleEventHook')
+
+-- | A variant of 'MaybeManageHook' that additionally may or may not make
+-- changes to the 'WindowSet'.
+type MaybeMaybeManageHook = Query (Maybe (Maybe (Endo WindowSet)))
+
+-- | Customizable handler for a 'ConfigureRequestEvent'. If the event's
+-- 'ev_window' is a managed floating window, the provided
+-- 'MaybeMaybeManageHook' is consulted and its result interpreted as follows:
+--
+--  * @Nothing@ - no match, fall back to the default handler
+--
+--  * @Just Nothing@ - match but ignore, no refresh, just send ConfigureNotify
+--
+--  * @Just (Just a)@ - match, modify 'WindowSet', refresh, send ConfigureNotify
+floatConfReqHook :: MaybeMaybeManageHook -> Event -> X All
+floatConfReqHook mh ConfigureRequestEvent{ev_window = w} =
+    runQuery (join <$> (isFloatQ -?> mh)) w >>= \case
+        Nothing -> mempty
+        Just e -> do
+            whenJust e (windows . appEndo)
+            sendConfEvent
+            pure (All False)
+  where
+    sendConfEvent = withDisplay $ \dpy ->
+        withWindowAttributes dpy w $ \wa -> do
+            io . allocaXEvent $ \ev -> do
+                -- We may have made no changes to the window size/position
+                -- and thus the X server didn't emit any ConfigureNotify,
+                -- so we need to send the ConfigureNotify ourselves to make
+                -- sure there is a reply to this ConfigureRequestEvent and the
+                -- window knows we (possibly) ignored its request.
+                setEventType ev configureNotify
+                setConfigureEvent ev w w
+                    (wa_x wa) (wa_y wa) (wa_width wa)
+                    (wa_height wa) (wa_border_width wa) none (wa_override_redirect wa)
+                sendEvent dpy w False 0 ev
+floatConfReqHook _ _ = mempty
+
+-- | A 'Query' to determine if a window is floating.
+isFloatQ :: Query Bool
+isFloatQ = ask >>= \w -> liftX . gets $ M.member w . W.floating . windowset
+
+-- | A pre-packaged 'floatConfReqHook' that fixes flickering of the Steam client by ignoring 'ConfigureRequestEvent's on any of its floating windows.
+--
+-- To use this, add 'fixSteamFlicker' to your 'handleEventHook'.
+fixSteamFlicker :: Event -> X All
+fixSteamFlicker = floatConfReqHook fixSteamFlickerMMMH
+
+fixSteamFlickerMMMH :: MaybeMaybeManageHook
+fixSteamFlickerMMMH = map toLower `fmap` className =? "steam" -?> mempty

XMonad/Hooks/ManageHelpers.hs

@@ -51,6 +51,7 @@ module XMonad.Hooks.ManageHelpers (
     isFullscreen,
     isMinimized,
     isDialog,
+    isNotification,
     pid,
     desktop,
     transientTo,
@@ -191,9 +192,18 @@ isMinimized :: Query Bool
 isMinimized = isInProperty "_NET_WM_STATE" "_NET_WM_STATE_HIDDEN"
 
 -- | A predicate to check whether a window is a dialog.
+--
+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
 isDialog :: Query Bool
 isDialog = isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_DIALOG"
 
+-- | A predicate to check whether a window is a notification.
+--
+-- See <https://specifications.freedesktop.org/wm-spec/wm-spec-1.5.html#idm46485863906176>.
+isNotification :: Query Bool
+isNotification =
+  isInProperty "_NET_WM_WINDOW_TYPE" "_NET_WM_WINDOW_TYPE_NOTIFICATION"
+
 -- | This function returns 'Just' the @_NET_WM_PID@ property for a
 -- particular window if set, 'Nothing' otherwise.
 --

XMonad/Hooks/OnPropertyChange.hs

@@ -41,13 +41,13 @@ import XMonad.Prelude
 -- $usage
 -- You can use this module with the following in your @xmonad.hs@:
 --
--- > import XMonad.Hooks.DynamicProperty
+-- > import XMonad.Hooks.OnPropertyChange
 --
 -- Enable it by including in you handleEventHook definition:
 --
 -- >  main = xmonad $ def
 -- >      { ...
--- >      , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5"))
+-- >      , handleEventHook = onXPropertyChange "WM_NAME" (title =? "Spotify" --> doShift "5")
 -- >      , ...
 -- >      }
 --

XMonad/Hooks/Rescreen.hs

@@ -15,10 +15,13 @@ module XMonad.Hooks.Rescreen (
     -- $usage
     addAfterRescreenHook,
     addRandrChangeHook,
+    setRescreenWorkspacesHook,
+    setRescreenDelay,
     RescreenConfig(..),
     rescreenHook,
     ) where
 
+import Control.Concurrent (threadDelay)
 import Graphics.X11.Xrandr
 import XMonad
 import XMonad.Prelude
@@ -59,16 +62,21 @@ import qualified XMonad.Util.ExtensibleConf as XC
 data RescreenConfig = RescreenConfig
     { afterRescreenHook :: X () -- ^ hook to invoke after 'rescreen'
     , randrChangeHook :: X () -- ^ hook for other randr changes, e.g. (dis)connects
+    , rescreenWorkspacesHook :: Last (X ()) -- ^ hook to invoke instead of 'rescreen'
+    , rescreenDelay :: Last Int -- ^ delay (in microseconds) to wait for events to settle
     }
 
 instance Default RescreenConfig where
     def = RescreenConfig
         { afterRescreenHook = mempty
         , randrChangeHook = mempty
+        , rescreenWorkspacesHook = mempty
+        , rescreenDelay = mempty
         }
 
 instance Semigroup RescreenConfig where
-    RescreenConfig arh rch <> RescreenConfig arh' rch' = RescreenConfig (arh <> arh') (rch <> rch')
+    RescreenConfig arh rch rwh rd <> RescreenConfig arh' rch' rwh' rd' =
+        RescreenConfig (arh <> arh') (rch <> rch') (rwh <> rwh') (rd <> rd')
 
 instance Monoid RescreenConfig where
     mempty = def
@@ -89,20 +97,45 @@ instance Monoid RescreenConfig where
 -- 'randrChangeHook' may be used to automatically trigger xrandr (or perhaps
 -- autorandr) when outputs are (dis)connected.
 --
+-- 'rescreenWorkspacesHook' allows tweaking the 'rescreen' implementation,
+-- to change the order workspaces are assigned to physical screens for
+-- example.
+--
+-- 'rescreenDelay' makes xmonad wait a bit for events to settle (after the
+-- first event is received) — useful when multiple @xrandr@ invocations are
+-- being used to change the screen layout.
+--
 -- Note that 'rescreenHook' is safe to use several times, 'rescreen' is still
--- done just once and hooks are invoked in sequence, also just once.
+-- done just once and hooks are invoked in sequence (except
+-- 'rescreenWorkspacesHook', which has a replace rather than sequence
+-- semantics), also just once.
 rescreenHook :: RescreenConfig -> XConfig l -> XConfig l
-rescreenHook = XC.once $ \c -> c
+rescreenHook = XC.once hook . catchUserCode
+  where
+    hook c = c
         { startupHook = startupHook c <> rescreenStartupHook
         , handleEventHook = handleEventHook c <> rescreenEventHook }
+    catchUserCode rc@RescreenConfig{..} = rc
+        { afterRescreenHook = userCodeDef () afterRescreenHook
+        , randrChangeHook = userCodeDef () randrChangeHook
+        , rescreenWorkspacesHook = flip catchX rescreen <$> rescreenWorkspacesHook
+        }
 
 -- | Shortcut for 'rescreenHook'.
 addAfterRescreenHook :: X () -> XConfig l -> XConfig l
-addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = userCodeDef () h }
+addAfterRescreenHook h = rescreenHook def{ afterRescreenHook = h }
 
 -- | Shortcut for 'rescreenHook'.
 addRandrChangeHook :: X () -> XConfig l -> XConfig l
-addRandrChangeHook h = rescreenHook def{ randrChangeHook = userCodeDef () h }
+addRandrChangeHook h = rescreenHook def{ randrChangeHook = h }
+
+-- | Shortcut for 'rescreenHook'.
+setRescreenWorkspacesHook :: X () -> XConfig l -> XConfig l
+setRescreenWorkspacesHook h = rescreenHook def{ rescreenWorkspacesHook = pure h }
+
+-- | Shortcut for 'rescreenHook'.
+setRescreenDelay :: Int -> XConfig l -> XConfig l
+setRescreenDelay d = rescreenHook def{ rescreenDelay = pure d }
 
 -- | Startup hook to listen for @RRScreenChangeNotify@ events.
 rescreenStartupHook :: X ()
@@ -126,13 +159,14 @@ handleEvent :: Event -> X ()
 handleEvent e = XC.with $ \RescreenConfig{..} -> do
     -- Xorg emits several events after every change, clear them to prevent
     -- triggering the hook multiple times.
+    whenJust (getLast rescreenDelay) (io . threadDelay)
     moreConfigureEvents <- clearTypedWindowEvents (ev_window e) configureNotify
     _ <- clearTypedWindowRREvents (ev_window e) rrScreenChangeNotify
     -- If there were any ConfigureEvents, this is an actual screen
     -- configuration change, so rescreen and fire rescreenHook. Otherwise,
     -- this is just a connect/disconnect, fire randrChangeHook.
     if ev_event_type e == configureNotify || moreConfigureEvents
-        then rescreen >> afterRescreenHook
+        then fromMaybe rescreen (getLast rescreenWorkspacesHook) >> afterRescreenHook
         else randrChangeHook
 
 -- | Remove all X events of a given window and type from the event queue,

XMonad/Hooks/ScreenCorners.hs

@@ -1,47 +1,50 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, TupleSections #-}
+{-# LANGUAGE FlexibleInstances #-}
------------------------------------------------------------------------------
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections #-}
+
 -- |
 -- Module      :  XMonad.Hooks.ScreenCorners
 -- Description :  Run X () actions by touching the edge of your screen with your mouse.
--- Copyright   :  (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky
+-- Copyright   :  (c) 2009-2025 Nils Schweinsberg, 2015 Evgeny Kurnevsky, 2024 Yuanle Song
 -- License     :  BSD3-style (see LICENSE)
 --
--- Maintainer  :  Nils Schweinsberg <mail@n-sch.de>
+-- Maintainer  :  Nils Schweinsberg <mail@nils.cc>
 -- Stability   :  unstable
 -- Portability :  unportable
 --
 -- Run @X ()@ actions by touching the edge of your screen with your mouse.
---
------------------------------------------------------------------------------
-
 module XMonad.Hooks.ScreenCorners
-    (
+  ( -- * Usage
-    -- * Usage
     -- $usage
 
     -- * Adding screen corners
-      ScreenCorner (..)
+    ScreenCorner (..),
-    , addScreenCorner
+    addScreenCorner,
-    , addScreenCorners
+    addScreenCorners,
 
     -- * Event hook
-    , screenCornerEventHook
+    screenCornerEventHook,
 
     -- * Layout hook
-    , screenCornerLayoutHook
+    screenCornerLayoutHook,
-    ) where
+  )
-
+where
-import XMonad.Prelude
-import XMonad
-import XMonad.Layout.LayoutModifier
 
 import qualified Data.Map as M
+import XMonad
+import XMonad.Layout.LayoutModifier
+import XMonad.Prelude
 import qualified XMonad.Util.ExtensibleState as XS
 
-data ScreenCorner = SCUpperLeft
+data ScreenCorner
+  = SCUpperLeft
   | SCUpperRight
   | SCLowerLeft
   | SCLowerRight
+  | SCTop
+  | SCBottom
+  | SCLeft
+  | SCRight
   deriving (Eq, Ord, Show)
 
 --------------------------------------------------------------------------------
@@ -56,10 +59,8 @@ instance ExtensionClass ScreenCornerState where
 -- | Add one single @X ()@ action to a screen corner
 addScreenCorner :: ScreenCorner -> X () -> X ()
 addScreenCorner corner xF = do
-
   ScreenCornerState m <- XS.get
   (win, xFunc) <- case find (\(_, (sc, _)) -> sc == corner) (M.toList m) of
-
     Just (w, (_, xF')) -> return (w, xF' >> xF) -- chain X actions
     Nothing -> (,xF) <$> createWindowAt corner
 
@@ -69,46 +70,61 @@ addScreenCorner corner xF = do
 addScreenCorners :: [(ScreenCorner, X ())] -> X ()
 addScreenCorners = mapM_ (uncurry addScreenCorner)
 
-
 --------------------------------------------------------------------------------
 -- Xlib functions
 --------------------------------------------------------------------------------
 
--- "Translate" a ScreenCorner to real (x,y) Positions
+-- "Translate" a ScreenCorner to real (x,y) Positions with proper width and
+-- height.
 createWindowAt :: ScreenCorner -> X Window
-createWindowAt SCUpperLeft = createWindowAt' 0 0
+createWindowAt SCUpperLeft = createWindowAt' 0 0 1 1
 createWindowAt SCUpperRight = withDisplay $ \dpy ->
   let w = displayWidth dpy (defaultScreen dpy) - 1
-    in createWindowAt' (fi w) 0
+   in createWindowAt' (fi w) 0 1 1
-
 createWindowAt SCLowerLeft = withDisplay $ \dpy ->
   let h = displayHeight dpy (defaultScreen dpy) - 1
-    in createWindowAt' 0 (fi h)
+   in createWindowAt' 0 (fi h) 1 1
-
 createWindowAt SCLowerRight = withDisplay $ \dpy ->
   let w = displayWidth dpy (defaultScreen dpy) - 1
       h = displayHeight dpy (defaultScreen dpy) - 1
-    in createWindowAt' (fi w) (fi h)
+   in createWindowAt' (fi w) (fi h) 1 1
-
+createWindowAt SCTop = withDisplay $ \dpy ->
--- Create a new X window at a (x,y) Position
+  let w = displayWidth dpy (defaultScreen dpy) - 1
-createWindowAt' :: Position -> Position -> X Window
+      -- leave some gap so corner and edge can work nicely when they overlap
-createWindowAt' x y = withDisplay $ \dpy -> io $ do
+      threshold = 150
+   in createWindowAt' threshold 0 (fi $ fi w - threshold * 2) 1
+createWindowAt SCBottom = withDisplay $ \dpy ->
+  let w = displayWidth dpy (defaultScreen dpy) - 1
+      h = displayHeight dpy (defaultScreen dpy) - 1
+      threshold = 150
+   in createWindowAt' threshold (fi h) (fi $ fi w - threshold * 2) 1
+createWindowAt SCLeft = withDisplay $ \dpy ->
+  let h = displayHeight dpy (defaultScreen dpy) - 1
+      threshold = 150
+   in createWindowAt' 0 threshold 1 (fi $ fi h - threshold * 2)
+createWindowAt SCRight = withDisplay $ \dpy ->
+  let w = displayWidth dpy (defaultScreen dpy) - 1
+      h = displayHeight dpy (defaultScreen dpy) - 1
+      threshold = 150
+   in createWindowAt' (fi w) threshold 1 (fi $ fi h - threshold * 2)
 
+-- Create a new X window at a (x,y) Position, with given width and height.
+createWindowAt' :: Position -> Position -> Dimension -> Dimension -> X Window
+createWindowAt' x y width height = withDisplay $ \dpy -> io $ do
   rootw <- rootWindow dpy (defaultScreen dpy)
 
-    let
+  let visual = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
-        visual   = defaultVisualOfScreen $ defaultScreenOfDisplay dpy
       attrmask = cWOverrideRedirect
 
   w <- allocaSetWindowAttributes $ \attributes -> do
-
     set_override_redirect attributes True
-        createWindow dpy        -- display
+    createWindow
+      dpy -- display
       rootw -- parent window
       x -- x
       y -- y
-                     1          -- width
+      width -- width
-                     1          -- height
+      height -- height
       0 -- border width
       0 -- depth
       inputOnly -- class
@@ -122,7 +138,6 @@ createWindowAt' x y = withDisplay $ \dpy -> io $ do
   sync dpy False
   return w
 
-
 --------------------------------------------------------------------------------
 -- Event hook
 --------------------------------------------------------------------------------
@@ -130,7 +145,6 @@ createWindowAt' x y = withDisplay $ \dpy -> io $ do
 -- | Handle screen corner events
 screenCornerEventHook :: Event -> X All
 screenCornerEventHook CrossingEvent {ev_window = win} = do
-
   ScreenCornerState m <- XS.get
 
   case M.lookup win m of
@@ -138,10 +152,8 @@ screenCornerEventHook CrossingEvent { ev_window = win } = do
     Nothing -> return ()
 
   return (All True)
-
 screenCornerEventHook _ = return (All True)
 
-
 --------------------------------------------------------------------------------
 -- Layout hook
 --------------------------------------------------------------------------------
@@ -158,13 +170,14 @@ instance LayoutModifier ScreenCornerLayout a where
 screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
 screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
 
-
 --------------------------------------------------------------------------------
+
 -- $usage
 --
--- This extension adds KDE-like screen corners to XMonad. By moving your cursor
+-- This extension adds KDE-like screen corners and GNOME Hot Edge like
--- into one of your screen corners you can trigger an @X ()@ action, for
+-- features to XMonad. By moving your cursor into one of your screen corners
--- example @"XMonad.Actions.GridSelect".goToSelected@ or
+-- or edges, you can trigger an @X ()@ action, for example
+-- @"XMonad.Actions.GridSelect".goToSelected@ or
 -- @"XMonad.Actions.CycleWS".nextWS@ etc.
 --
 -- To use it, import it on top of your @xmonad.hs@:
@@ -176,6 +189,7 @@ screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
 -- > myStartupHook = do
 -- >     ...
 -- >     addScreenCorner SCUpperRight (goToSelected def { gs_cellwidth = 200})
+-- >     addScreenCorner SCBottom (goToSelected def)
 -- >     addScreenCorners [ (SCLowerRight, nextWS)
 -- >                      , (SCLowerLeft,  prevWS)
 -- >                      ]

XMonad/Hooks/StatusBar.hs

@@ -426,12 +426,12 @@ statusBarPipe cmd xpp = do
 -- > xmobarBottom = statusBarPropTo "_XMONAD_LOG_2" "xmobar -x 0 ~/.config/xmobar/xmobarrc_bottom" (pure ppBottom)
 -- > xmobar1      = statusBarPropTo "_XMONAD_LOG_3" "xmobar -x 1 ~/.config/xmobar/xmobarrc1"       (pure pp1)
 -- >
--- > barSpawner :: ScreenId -> IO StatusBarConfig
+-- > barSpawner :: ScreenId -> StatusBarConfig
--- > barSpawner 0 = pure $ xmobarTop <> xmobarBottom -- two bars on the main screen
+-- > barSpawner 0 = xmobarTop <> xmobarBottom -- two bars on the main screen
--- > barSpawner 1 = pure $ xmobar1
+-- > barSpawner 1 = xmobar1
 -- > barSpawner _ = mempty -- nothing on the rest of the screens
 -- >
--- > main = xmonad $ dynamicSBs barSpawner (def { ... })
+-- > main = xmonad $ dynamicSBs (pure . barSpawner) (def { ... })
 --
 -- Make sure you specify which screen to place the status bar on (in xmobar,
 -- this is achieved by the @-x@ argument). In addition to making sure that your
@@ -452,7 +452,7 @@ instance ExtensionClass ActiveSBs where
 -- 'avoidStruts', check 'dynamicEasySBs'.
 --
 -- Heavily inspired by "XMonad.Hooks.DynamicBars"
-dynamicSBs :: (ScreenId -> IO StatusBarConfig) -> XConfig l -> XConfig l
+dynamicSBs :: (ScreenId -> X StatusBarConfig) -> XConfig l -> XConfig l
 dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
   { startupHook = startupHook conf >> killAllStatusBars >> updateSBs f
   , logHook     = logHook conf >> logSBs
@@ -462,7 +462,7 @@ dynamicSBs f conf = addAfterRescreenHook (updateSBs f) $ conf
 -- resulting config and adds 'avoidStruts' to the
 -- layout.
 dynamicEasySBs :: LayoutClass l Window
-               => (ScreenId -> IO StatusBarConfig)
+               => (ScreenId -> X StatusBarConfig)
                -> XConfig l
                -> XConfig (ModifiedLayout AvoidStruts l)
 dynamicEasySBs f conf =
@@ -471,7 +471,7 @@ dynamicEasySBs f conf =
 -- | Given the function to create status bars, update
 -- the status bars by killing those that shouldn't be
 -- visible anymore and creates any missing status bars
-updateSBs :: (ScreenId -> IO StatusBarConfig) -> X ()
+updateSBs :: (ScreenId -> X StatusBarConfig) -> X ()
 updateSBs f = do
   actualScreens    <- withWindowSet $ return . map W.screen . W.screens
   (toKeep, toKill) <-
@@ -480,7 +480,7 @@ updateSBs f = do
   cleanSBs (map snd toKill)
   -- Create new status bars if needed
   let missing = actualScreens \\ map fst toKeep
-  added <- io $ traverse (\s -> (s,) <$> f s) missing
+  added <- traverse (\s -> (s,) <$> f s) missing
   traverse_ (sbStartupHook . snd) added
   XS.put (ASB (toKeep ++ added))
 

XMonad/Layout/AutoMaster.hs

@@ -35,7 +35,7 @@ import Control.Arrow (first)
 -- in one row, in slave area underlying layout is run. Size of slave area
 -- automatically increases when number of slave windows is increasing.
 --
--- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.AutoMaster
 --

XMonad/Layout/CenteredMaster.hs

@@ -38,7 +38,7 @@ import Control.Arrow (first)
 -- All other windows in background are managed by base layout.
 -- topRightMaster is like centerMaster, but places master window in top right corner instead of center.
 --
--- Yo can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.CenteredMaster
 --

XMonad/Layout/CircleEx.hs

@@ -116,7 +116,7 @@ data CircleExMsg
   = Rotate !Double            -- ^ Rotate secondary windows by specific angle
   | IncStackRatio !Rational   -- ^ Increase (or decrease, with negative value) sizes of secondary windows
   | IncMultiplier !Rational   -- ^ Increase 'cMultiplier'.
-  deriving (Eq, Show, Typeable)
+  deriving (Eq, Show)
 
 instance Message CircleExMsg
 

XMonad/Layout/Column.hs

@@ -11,7 +11,7 @@
 -- Portability :  unportable
 --
 -- Provides Column layout that places all windows in one column. Windows
--- heights are calculated from equation: H1/H2 = H2/H3 = ... = q, where q is
+-- heights are calculated from the equation: H1/H2 = H2/H3 = ... = q, where q is
 -- given. With Shrink/Expand messages you can change the q value.
 --
 -----------------------------------------------------------------------------
@@ -25,12 +25,12 @@ import XMonad
 import qualified XMonad.StackSet as W
 
 -- $usage
--- This module defines layot named Column. It places all windows in one
+-- This module defines layout named Column. It places all windows in one
--- column. Windows heights are calculated from equation: H1/H2 = H2/H3 = ... =
+-- column. Windows heights are calculated from the equation: H1/H2 = H2/H3 = ... =
 -- q, where `q' is given (thus, windows heights are members of geometric
 -- progression). With Shrink/Expand messages one can change the `q' value.
 --
--- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.Column
 --

XMonad/Layout/Columns.hs

@@ -0,0 +1,480 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TupleSections #-}
+
+-- |
+-- Module: XMonad.Layout.Columns
+-- Description: A layout which tiles the windows in columns.
+-- Copyright: Jean-Charles Quillet
+-- License: BSD-style (see LICENSE)
+--
+-- Maintainer: none
+-- Stability: unstable
+-- Portability: unportable
+--
+-- A layout which tiles the windows in columns. The windows can be moved and
+-- resized in every directions.
+--
+-- The first window appears in a single column in the center of the screen. Its
+-- width is configurable (See 'coOneWindowWidth').
+--
+-- The second window appears in a second column. Starting with two columns, they
+-- fill up the screen.
+--
+-- Subsequent windows appear on the bottom of the last columns.
+module XMonad.Layout.Columns
+  ( -- * Usage
+    -- $usage
+    ColumnsLayout (..),
+
+    -- * Messages
+    Focus (..),
+    Move (..),
+    Resize (..),
+
+    -- * Tools
+    focusDown,
+    focusUp,
+  )
+where
+
+import Control.Applicative ((<|>))
+import Control.Arrow (Arrow (first), second)
+import Control.Monad (guard)
+import Control.Monad.State (modify)
+import Control.Monad.Trans.Maybe (MaybeT (..))
+import Data.Foldable (Foldable (..))
+import Data.List (scanl')
+import Data.Maybe (listToMaybe)
+import Data.Ratio ((%))
+import XMonad
+  ( LayoutClass (..),
+    Message,
+    Rectangle (..),
+    SomeMessage,
+    Window,
+    WindowSet,
+    X,
+    XState (..),
+    fromMessage,
+    gets,
+    scaleRationalRect,
+    sendMessage,
+  )
+import qualified XMonad.Operations as O
+import XMonad.StackSet
+  ( RationalRect (..),
+    Screen (..),
+    Stack (..),
+    StackSet (..),
+    integrate,
+    peek,
+  )
+import qualified XMonad.StackSet as StackSet
+
+-- $usage
+-- Add 'Columns' to your @layoutHook@ with an initial empty state:
+--
+-- > myLayout = Full ||| Columns 1 []
+--
+-- Here is an example of keybindings:
+--
+-- > -- Focus up/down
+-- > ((modm, xK_Tab), focusDown),
+-- > ((modm .|. shiftMask, xK_Tab), focusUp),
+-- > -- Move windows around
+-- > ((modm .|. shiftMask, xK_l), sendMessage MoveRight),
+-- > ((modm .|. shiftMask, xK_h), sendMessage MoveLeft),
+-- > ((modm .|. shiftMask, xK_k), sendMessage MoveUp),
+-- > ((modm .|. shiftMask, xK_j), sendMessage MoveDown),
+-- > -- Resize them
+-- > ((modm .|. controlMask, xK_l), sendMessage HorizontalExpand),
+-- > ((modm .|. controlMask, xK_h), sendMessage HorizontalShrink),
+-- > ((modm .|. controlMask, xK_k), sendMessage VerticalExpand),
+-- > ((modm .|. controlMask, xK_j), sendMessage VerticalShrink),
+--
+-- This layout is known to work with:
+--
+-- * "XMonad.Layout.WindowNavigation" for changing focus with a direction using
+-- 'XMonad.Layout.WindowNavigation.Go' messages.
+-- * 'XMonad.Layout.SubLayouts.subTabbed' for docking windows together with
+-- tabs. Note that sometimes when undocking windows, the layout is reset. This is
+-- a minor annoyance caused by the difficulty to track windows in the sublayout.
+
+-- | The windows can be moved in every directions.
+--
+-- Horizontally, a window alone in its column cannot be moved before the first
+-- or after the last column. If not alone, moving the window outside those
+-- limits will create a new column.
+-- The windows can also be moved vertically in their column.
+data Move = MoveLeft | MoveRight | MoveUp | MoveDown deriving (Show, Read)
+
+instance Message Move
+
+-- | The windows can be resized in every directions.
+--
+-- When resizing horizontally:
+--
+-- * if the window to be resized is not in the last column
+--
+--      * then the right side of the window will be moved
+--      * the last column will compensate the size change
+--
+-- * if the window is in the last column
+--
+--      * then the left side of the window will be moved
+--      * the column on the left of the current one will compensate the size change
+--
+-- The same applies when resizing vertically using the bottom side of the
+-- window unless it is the last window in the column in which case we use the
+-- top side.
+data Resize
+  = VerticalShrink
+  | VerticalExpand
+  | HorizontalShrink
+  | HorizontalExpand
+  deriving (Show, Read)
+
+instance Message Resize
+
+-- | The layout handles focus change messages.
+--
+-- Built-in focus cannot be used here because @XMonad@ does not make it easy to
+-- change the order of windows in the focus list. See also 'focusUp' and
+-- 'focusDown' functions.
+data Focus = FocusUp | FocusDown
+  deriving (Show, Read)
+
+instance Message Focus
+
+-- | A column is a list of windows with their relative vertical dimensions.
+type Column = [(Rational, Window)]
+
+-- | The layout is a list of 'Column' with their relative horizontal dimensions.
+type Columns = [(Rational, Column)]
+
+data ColumnsLayout a = Columns
+  { -- | With of the first column when there is only one window. Usefull on wide
+    -- screens.
+    coOneWindowWidth :: Rational,
+    -- | The current state
+    coColumns :: Columns
+  }
+  deriving (Show, Read)
+
+instance LayoutClass ColumnsLayout Window where
+  description _ = layoutDescription
+
+  doLayout (Columns oneWindowWidth columns) rectangle stack =
+    pure (rectangles, Just (Columns oneWindowWidth columns'))
+    where
+      hackedColumns = hackForTabs columns stack
+      columns' = updateWindowList hackedColumns stack
+      rectangles = toRectangles rectangle' columns'
+      -- If there is only one window, we set the destination rectangle according
+      -- to the width in the layout setting.
+      rectangle'
+        | (length . toList $ stack) == 1 =
+            scaleRationalRect rectangle singleColumnRR
+        | otherwise = rectangle
+      singleColumnOffset = (1 - oneWindowWidth) / 2
+      singleColumnRR = RationalRect singleColumnOffset 0 oneWindowWidth 1
+
+  handleMessage layout@(Columns oneWindowWidth columns) message = do
+    mbStack <- runMaybeT $ handleFocus' =<< getStack
+    changedFocus <- traverse updateStack' mbStack
+
+    movedOrResized <-
+      runMaybeT $
+        Columns oneWindowWidth
+          <$> (handleMoveOrResize' =<< peekFocus)
+
+    pure $ movedOrResized <|> changedFocus
+    where
+      getStack = MaybeT . gets $ StackSet.stack . workspace . current . windowset
+      handleFocus' = hoistMaybe . handleFocus columns message
+      -- A 'Just' needs to be return for the new stack to be taken into account
+      updateStack' s = modify (setStack s) >> pure layout
+      peekFocus = MaybeT . gets $ peek . windowset
+      handleMoveOrResize' = hoistMaybe . handleMoveOrResize columns message
+      hoistMaybe = MaybeT . pure
+
+layoutDescription :: String
+layoutDescription = "Columns"
+
+-- | Change the keyboard focus to the previous window
+focusUp :: X ()
+focusUp =
+  sendMsgOrOnWindowsSet FocusUp StackSet.focusUp
+    =<< getCurrentLayoutDescription
+
+-- | Change the keyboard focus to the next window
+focusDown :: X ()
+focusDown =
+  sendMsgOrOnWindowsSet FocusDown StackSet.focusDown
+    =<< getCurrentLayoutDescription
+
+sendMsgOrOnWindowsSet :: (Message a) => a -> (WindowSet -> WindowSet) -> String -> X ()
+sendMsgOrOnWindowsSet message f description'
+  | description' == layoutDescription = sendMessage message
+  | otherwise = O.windows f
+
+getCurrentLayoutDescription :: X String
+getCurrentLayoutDescription =
+  gets
+    ( description
+        . StackSet.layout
+        . workspace
+        . current
+        . windowset
+    )
+
+setStack :: Stack Window -> XState -> XState
+setStack stack state =
+  state
+    { windowset =
+        (windowset state)
+          { current =
+              (current $ windowset state)
+                { workspace =
+                    (workspace . current $ windowset state)
+                      { StackSet.stack = Just stack
+                      }
+                }
+          }
+    }
+
+handleFocus :: Columns -> SomeMessage -> Stack Window -> Maybe (Stack Window)
+handleFocus columns message stack
+  | Just FocusDown <- fromMessage message = setFocus' stack <$> mbNext
+  | Just FocusUp <- fromMessage message = setFocus' stack <$> mbPrevious
+  | otherwise = Nothing
+  where
+    focused = focus stack
+    windows = columnsToWindows columns
+    exists = focused `elem` windows
+    mbNext = guard exists >> next focused windows
+    mbPrevious = guard exists >> previous focused windows
+    setFocus' = flip setFocus
+    previous a = next a . reverse
+    setFocus w = until ((==) w . focus) StackSet.focusDown'
+    next _ [] = Nothing
+    next a (x : xs)
+      | a == x = listToMaybe xs
+      | otherwise = next a (xs <> [x])
+
+oldNewWindows :: Columns -> Stack Window -> ([Window], [Window])
+oldNewWindows columns stack = (old, new)
+  where
+    old = filter (`notElem` stackList) windows
+    new = filter (`notElem` windows) stackList
+    stackList = toList stack
+    windows = columnsToWindows columns
+
+-- | Add the new windows to the layout and remove the old ones.
+updateWindowList :: Columns -> Stack Window -> Columns
+updateWindowList columns stack = addWindows newWindows (removeWindows oldWindows columns)
+  where
+    (oldWindows, newWindows) = oldNewWindows columns stack
+
+-- | If one window disappeared and another appeared, we assume that the sublayout
+-- tabs just changed focused.
+hackForTabs :: Columns -> Stack Window -> Columns
+hackForTabs columns stack = mapWindow replace columns
+  where
+    replace window
+      | (w1 : _, [w2]) <- oldNewWindows columns stack =
+          if window == w1
+            then w2
+            else window
+      | otherwise = window
+
+toRectangles :: Rectangle -> [(Rational, [(Rational, a)])] -> [(a, Rectangle)]
+toRectangles rectangle columns =
+  second (scaleRationalRect rectangle) <$> windowsAndRectangles
+  where
+    offsetsAndRatios = toOffsetRatio (second toOffsetRatio <$> columns)
+    windowsAndRectangles = foldMap toWindowAndRectangle offsetsAndRatios
+    toWindowAndRectangle (x, w, cs) = (\(y, h, ws) -> (ws, RationalRect x y w h)) <$> cs
+
+onFocused :: (a -> a) -> Stack a -> Stack a
+onFocused f (Stack a before after) = Stack (f a) before after
+
+onFocusedM :: (Monad m) => (a -> m a) -> Stack a -> m (Stack a)
+onFocusedM f (Stack a before after) = Stack <$> f a <*> pure before <*> pure after
+
+onFocusedOrPrevious :: (a -> a) -> Stack a -> Stack a
+onFocusedOrPrevious f (Stack a (a' : others) []) = Stack a (f a' : others) []
+onFocusedOrPrevious f stack = onFocused f stack
+
+handleMoveOrResize :: Columns -> SomeMessage -> Window -> Maybe Columns
+handleMoveOrResize columns message window
+  | Just msg <- fromMessage message = move msg window columns
+  | Just HorizontalShrink <- fromMessage message =
+      onFocusedOrPrevious' shrink <$> findInColumns window columns
+  | Just HorizontalExpand <- fromMessage message =
+      onFocusedOrPrevious' expand <$> findInColumns window columns
+  | Just VerticalExpand <- fromMessage message =
+      onFocusedM'
+        (fmap (onFocusedOrPrevious' shrink) . findInColumn window)
+        =<< findInColumns window columns
+  | Just VerticalShrink <- fromMessage message =
+      onFocusedM'
+        (fmap (onFocusedOrPrevious' expand) . findInColumn window)
+        =<< findInColumns window columns
+  | otherwise = Nothing
+  where
+    expand = first $ flip (+) (3 / 100)
+    shrink = first $ flip (-) (3 / 100)
+    onFocusedM' f = fmap integrate . onFocusedM (sequence . second f)
+    onFocusedOrPrevious' f = sanitize . integrate . onFocusedOrPrevious f
+
+move :: Move -> Window -> Columns -> Maybe Columns
+move direction window columns =
+  case (direction, findInColumns window columns) of
+    (MoveRight, Just (Stack (_, [(_, _)]) _ [])) -> Nothing
+    (MoveLeft, Just (Stack (_, [(_, _)]) [] _)) -> Nothing
+    (MoveRight, Just (Stack column@(_, [(_, _)]) before (next : others))) ->
+      let (column', next') = swapWindowBetween window column next
+       in Just . integrate $ Stack column' before (next' : others)
+    (MoveLeft, Just (Stack column@(_, [(_, _)]) (previous : others) after)) ->
+      let (column', previous') = swapWindowBetween window column previous
+       in Just . integrate $ Stack column' (previous' : others) after
+    (MoveRight, Just stack) ->
+      let (newColumns', Stack column before after) = rationalize newColumns stack
+          windows = removeWindow window column
+       in Just . integrate $ Stack windows before (newColumns' <> after)
+    (MoveLeft, Just stack) ->
+      let (newColumns', Stack column before after) = rationalize newColumns stack
+          windows = removeWindow window column
+       in Just . integrate $ Stack windows (newColumns' <> before) after
+    (MoveUp, Just stack) -> integrate <$> onFocusedM (swapWindowUp window) stack
+    (MoveDown, Just stack) -> integrate <$> onFocusedM (swapWindowDown window) stack
+    _ -> Nothing
+  where
+    newColumns = [[(1, window)]]
+
+mapWindow :: (Window -> Window) -> Columns -> Columns
+mapWindow = fmap . fmap . fmap . fmap
+
+columnsToWindows :: Columns -> [Window]
+columnsToWindows = foldMap ((: []) . snd) . foldMap snd
+
+swapWindowBetween ::
+  Window ->
+  (Rational, Column) ->
+  (Rational, Column) ->
+  ((Rational, Column), (Rational, Column))
+swapWindowBetween window from to = (removed, added)
+  where
+    removed = removeWindow window from
+    added = appendWindows [window] to
+
+swapWindowUp :: Window -> (Rational, Column) -> Maybe (Rational, Column)
+swapWindowUp window (width, column)
+  | Just (Stack (height, _) (previous : before') after) <- findInColumn window column =
+      Just (width, integrate $ Stack previous ((height, window) : before') after)
+  | otherwise = Nothing
+
+swapWindowDown :: Window -> (Rational, Column) -> Maybe (Rational, Column)
+swapWindowDown window (width, column)
+  | Just (Stack (height, _) before (next : others)) <- findInColumn window column =
+      Just (width, integrate $ Stack next before ((height, window) : others))
+  | otherwise = Nothing
+
+-- | Adjust the ratio of a list or a stack of elts so that when adding new
+--  elements:
+-- - the new elements are distributed according to the total number of elements
+-- - the existing elements keep their proportion in the remaining space
+rationalize ::
+  (Functor f, Foldable f) =>
+  [a] ->
+  f (Rational, a) ->
+  ([(Rational, a)], f (Rational, a))
+rationalize new existing = (new', existing')
+  where
+    nbNew = fromIntegral $ length new
+    nbInColumn = fromIntegral $ length existing
+    newRatio = nbNew % (nbNew + nbInColumn)
+    existingRatio = 1 - newRatio
+    new' = fitElements newRatio new
+    existing' = first (* existingRatio) <$> existing
+
+append :: [a] -> [(Rational, a)] -> [(Rational, a)]
+append new existing = uncurry (flip mappend) (rationalize new existing)
+
+appendWindows ::
+  [Window] ->
+  (Rational, [(Rational, Window)]) ->
+  (Rational, [(Rational, Window)])
+appendWindows windows = second (append windows)
+
+fitElements :: Rational -> [a] -> [(Rational, a)]
+fitElements dimension elts = (dimension',) <$> elts
+  where
+    dimension' = dimension / fromIntegral (length elts)
+
+singleColumn :: Rational -> Rational -> [Window] -> Columns
+singleColumn width height windows = [(width, fitElements height windows)]
+
+findElement' :: (a -> Bool) -> [(Rational, a)] -> Maybe (Stack (Rational, a))
+findElement' predicate list
+  | (before, c : after) <- break (predicate . snd) list =
+      Just $ Stack c (reverse before) after
+  | otherwise = Nothing
+
+findInColumns :: Window -> Columns -> Maybe (Stack (Rational, Column))
+findInColumns window = findElement' (any ((== window) . snd))
+
+findInColumn :: Window -> Column -> Maybe (Stack (Rational, Window))
+findInColumn window = findElement' (== window)
+
+removeWindows :: [Window] -> Columns -> Columns
+removeWindows windows = removeEmptyColumns . fmap (second removeWindows')
+  where
+    inWindows (_, window) = window `notElem` windows
+    removeWindows' = normalize . filter inWindows
+    removeEmptyColumns = normalize . filter (not . null . snd)
+
+removeWindow :: Window -> (Rational, Column) -> (Rational, Column)
+removeWindow window = second (normalize . filter ((/= window) . snd))
+
+addWindows :: [Window] -> Columns -> Columns
+addWindows [] columns = columns
+-- When there is only one column, create a new one on the right
+addWindows windows [(_, windows')] = (1 % 2, windows') : singleColumn (1 % 2) 1 windows
+-- When there is more, append the windows to the last column
+addWindows windows columns
+  | Just (columns', column) <- unsnoc columns =
+      sanitizeColumns $ columns' <> [appendWindows windows column]
+  | otherwise = singleColumn 1 1 windows
+
+-- | Make sure the sum of all dimensions is 1
+normalize :: [(Rational, a)] -> [(Rational, a)]
+normalize elts = fmap (first (/ total)) elts
+  where
+    total = sum (fst <$> elts)
+
+-- | Update the last dimension so that the sum of all dimensions is 1
+sanitize :: [(Rational, a)] -> [(Rational, a)]
+sanitize list
+  | Just (elts, (_, a)) <- unsnoc list = elts <> [(1 - sum (fst <$> elts), a)]
+  | otherwise = []
+
+-- | Same on the whole layout
+sanitizeColumns :: Columns -> Columns
+sanitizeColumns = sanitize . fmap (second sanitize)
+
+toOffsetRatio :: [(Rational, a)] -> [(Rational, Rational, a)]
+toOffsetRatio ra = zipWith toTruple ra positions
+  where
+    toTruple (dimension, a) position = (position, dimension, a)
+    positions = scanl' (\position (dimension, _) -> position + dimension) 0 ra
+
+unsnoc :: [a] -> Maybe ([a], a)
+unsnoc [] = Nothing
+unsnoc (x : xs)
+  | Just (is, l) <- unsnoc xs = Just (x : is, l)
+  | otherwise = Just ([], x)

XMonad/Layout/FixedAspectRatio.hs

@@ -158,6 +158,5 @@ data ManageAspectRatio =
     FixRatio Rational Window    -- ^ Set the aspect ratio for the window
   | ResetRatio Window           -- ^ Remove the aspect ratio for the window
   | ToggleRatio Rational Window -- ^ Toggle the reatio
-  deriving Typeable
 
 instance Message ManageAspectRatio

XMonad/Layout/Hidden.hs

@@ -118,7 +118,7 @@ popHiddenWindow = sendMessage . PopSpecificHiddenWindow
 --------------------------------------------------------------------------------
 hideWindowMsg :: HiddenWindows a -> Window -> X (Maybe (HiddenWindows a))
 hideWindowMsg (HiddenWindows hidden) win = do
-  modify (\s -> s { windowset = W.delete' win $ windowset s })
+  modifyWindowSet $ W.delete' win
   return . Just . HiddenWindows $ hidden ++ [win]
 
 --------------------------------------------------------------------------------

XMonad/Layout/IfMax.hs

@@ -36,7 +36,7 @@ import qualified XMonad.StackSet as W
 -- IfMax layout will run one layout if number of windows on workspace is as
 -- maximum N, and else will run another layout.
 --
--- You can use this module by adding folowing in your @xmonad.hs@:
+-- You can use this module by adding following in your @xmonad.hs@:
 --
 -- > import XMonad.Layout.IfMax
 --

XMonad/Layout/IndependentScreens.hs

@@ -26,8 +26,8 @@ module XMonad.Layout.IndependentScreens (
     marshallPP,
     whenCurrentOn,
     countScreens,
-    workspacesOn,
+    workspacesOn, screenOnMonitor,
-    workspaceOnScreen, focusWindow', focusScreen, nthWorkspace, withWspOnScreen,
+    workspaceOnScreen, focusWindow', doFocus', focusScreen, focusWorkspace, nthWorkspace, withWspOnScreen,
     -- * Converting between virtual and physical workspaces
     -- $converting
     marshall, unmarshall, unmarshallS, unmarshallW,
@@ -40,6 +40,7 @@ import XMonad
 import XMonad.Hooks.StatusBar.PP
 import XMonad.Prelude
 import qualified XMonad.StackSet as W
+import XMonad.Actions.OnScreen (viewOnScreen)
 
 -- $usage
 -- You can use this module with the following in your @xmonad.hs@:
@@ -147,7 +148,7 @@ withWspOnScreen screenId operation ws = case workspaceOnScreen screenId ws of
     Just wsp -> operation wsp ws
     Nothing -> ws
 
--- | Get the workspace that is active on a given screen.
+-- | Get the screen that is active on a given monitor.
 screenOnMonitor :: ScreenId -> WindowSet -> Maybe WindowScreen
 screenOnMonitor screenId ws = find ((screenId ==) . W.screen) (W.current ws : W.visible ws)
 
@@ -159,10 +160,20 @@ focusWindow' window ws
       Just tag -> W.focusWindow window $ focusScreen (unmarshallS tag) ws
       Nothing -> ws
 
+-- | ManageHook to focus a window, switching workspace on the correct Xinerama screen if neccessary.
+-- Useful in 'XMonad.Hooks.EwmhDesktops.setActivateHook' when using this module.
+doFocus' :: ManageHook
+doFocus' = doF . focusWindow' =<< ask
+
 -- | Focus a given screen.
 focusScreen :: ScreenId -> WindowSet -> WindowSet
 focusScreen screenId = withWspOnScreen screenId W.view
 
+-- | Focus the given workspace on the correct Xinerama screen.
+-- An example usage can be found at `XMonad.Hooks.EwmhDesktops.setEwmhSwitchDesktopHook`
+focusWorkspace :: WorkspaceId -> WindowSet -> WindowSet
+focusWorkspace workspaceId = viewOnScreen (unmarshallS workspaceId) workspaceId
+
 -- | Get the nth virtual workspace
 nthWorkspace :: Int -> X (Maybe VirtualWorkspace)
 nthWorkspace n = (!? n) . workspaces' <$> asks config

XMonad/Layout/NoBorders.hs

@@ -143,10 +143,8 @@ data ConfigurableBorder p w = ConfigurableBorder
 
 -- | Only necessary with 'BorderMessage' - remove non-existent windows from the
 -- 'alwaysHidden' or 'neverHidden' lists.
+{-# DEPRECATED borderEventHook "No longer needed." #-}
 borderEventHook :: Event -> X All
-borderEventHook DestroyWindowEvent{ ev_window = w } = do
-    broadcastMessage $ ResetBorder w
-    return $ All True
 borderEventHook _ = return $ All True
 
 instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder p) Window where
@@ -167,14 +165,17 @@ instance (Read p, Show p, SetsAmbiguous p) => LayoutModifier (ConfigurableBorder
             in  ConfigurableBorder gh <$> consNewIf ah (not b)
                                         <*> consNewIf nh b
                                         <*> pure ch
-        | Just (ResetBorder w) <- fromMessage m =
+        | Just (ResetBorder w) <- fromMessage m = resetBorder w
+        | Just DestroyWindowEvent { ev_window = w } <- fromMessage m = resetBorder w
+        | otherwise = Nothing
+      where
+        resetBorder w =
             let delete' e l = if e `elem` l then (True,delete e l) else (False,l)
                 (da,ah') = delete' w ah
                 (dn,nh') = delete' w nh
             in  if da || dn
                 then Just cb { alwaysHidden = ah', neverHidden = nh' }
                 else Nothing
-        | otherwise = Nothing
 
 -- | SetsAmbiguous allows custom actions to generate lists of windows that
 -- should not have borders drawn through 'ConfigurableBorder'

XMonad/Layout/OnHost.hs

@@ -1,5 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
-
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  XMonad.Layout.OnHost
@@ -27,10 +28,12 @@ module XMonad.Layout.OnHost (-- * Usage
 
 import           XMonad
 import qualified XMonad.StackSet              as W
+import           XMonad.Prelude
 
 import           XMonad.Layout.LayoutModifier
 
-import           Data.Maybe                        (fromMaybe)
+import           Foreign                           (allocaArray0)
+import           Foreign.C
 import           System.Posix.Env                  (getEnv)
 
 -- $usage
@@ -56,11 +59,13 @@ import           System.Posix.Env                  (getEnv)
 --
 -- > layoutHook = A ||| B ||| onHost "foo" D C
 --
--- Note that we rely on '$HOST' being set in the environment, as is true on most
+-- Note that we rely on either @$HOST@ being set in the environment, or
--- modern systems; if it's not, you may want to use a wrapper around xmonad or
+-- <https://linux.die.net/man/2/gethostname gethostname> returning something
--- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'.
+-- useful, as is true on most modern systems; if this is not the case for you,
--- This is to avoid dragging in the network package as an xmonad dependency.
+-- you may want to use a wrapper around xmonad or perhaps use
--- If '$HOST' is not defined, it will behave as if the host name never matches.
+-- 'System.Posix.Env.setEnv' (or 'putEnv') to set @$HOST@ in 'main'. If
+-- neither of the two methods work, the module will behave as if the host name
+-- never matches.
 --
 -- Also note that '$HOST' is usually a fully qualified domain name, not a short name.
 -- If you use a short name, this code will try to truncate $HOST to match; this may
@@ -116,16 +121,16 @@ data OnHost l1 l2 a = OnHost [String]
 
 instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where
     runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do
-      h <- io $ getEnv "HOST"
+      h <- io $ getEnv "HOST" <|> getHostName
       if maybe False (`elemFQDN` hosts) h
         then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r
                 return (wrs, Just $ mkNewOnHostT p mlt')
         else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r
                 return (wrs, Just $ mkNewOnHostF p mlt')
 
-    handleMessage (OnHost hosts bool lt lf) m
+    handleMessage (OnHost hosts choice lt lf) m
-        | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf)
+        | choice    = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts choice nt lf)
-        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts bool lt)
+        | otherwise = handleMessage lf m >>= maybe (return Nothing) (return . Just . OnHost hosts choice lt)
 
     description (OnHost _ True  l1 _) = description l1
     description (OnHost _ _     _ l2) = description l2
@@ -154,3 +159,17 @@ eqFQDN a b
   | '.' `elem` a                 = takeWhile (/= '.') a ==                    b
   |                 '.' `elem` b =                    a == takeWhile (/= '.') b
   | otherwise                    =                    a ==                    b
+
+-----------------------------------------------------------------------
+-- cbits
+
+foreign import ccall "gethostname" gethostname :: CString -> CSize -> IO CInt
+
+getHostName :: IO (Maybe String)
+getHostName = allocaArray0 size $ \cstr -> do
+  throwErrnoIfMinus1_ "getHostName" $ gethostname cstr (fromIntegral size)
+  peekCString cstr <&> \case
+    "" -> Nothing
+    s  -> Just s
+ where
+  size = 256

XMonad/Layout/TabBarDecoration.hs

@@ -46,8 +46,8 @@ import XMonad.Prompt ( XPPosition (..) )
 -- 'tabBar' will give you the possibility of setting a custom shrinker
 -- and a custom theme.
 --
--- The deafult theme can be dynamically change with the xmonad theme
+-- The default theme can be dynamically changed with the xmonad theme
--- selector. See "XMonad.Prompt.Theme". For more themse, look at
+-- selector. See "XMonad.Prompt.Theme". For more themes, look at
 -- "XMonad.Util.Themes"
 
 -- | Add, on the top of the screen, a simple bar of tabs to a given

XMonad/Prelude.hs

@@ -313,6 +313,7 @@ specialKeys =
   , ("KP_7"       , xK_KP_7)
   , ("KP_8"       , xK_KP_8)
   , ("KP_9"       , xK_KP_9)
+  , ("Menu"       , xK_Menu)
   ]
 
 -- | List of multimedia keys. If Xlib does not know about some keysym
@@ -472,6 +473,7 @@ multimediaKeys = filter ((/= noSymbol) . snd) . map (id &&& stringToKeysym) $
   , "XF86_Next_VMode"
   , "XF86_Prev_VMode"
   , "XF86Bluetooth"
+  , "XF86WLAN"
   ]
 
 -- | The specialized 'W.Screen' derived from 'WindowSet'.

XMonad/Prompt.hs

@@ -562,7 +562,7 @@ mkXPromptImplementation historyKey conf om = do
   s <- gets $ screenRect . W.screenDetail . W.current . windowset
   cleanMask <- cleanKeyMask
   cachedir <- asks (cacheDir . directories)
-  hist <- io $ readHistory cachedir
+  hist <- io $ readHistory conf cachedir
   fs <- initXMF (font conf)
   let width = getWinWidth s (position conf)
   st' <- io $
@@ -582,7 +582,7 @@ mkXPromptImplementation historyKey conf om = do
   releaseXMF fs
   when (successful st') $ do
     let prune = take (historySize conf)
-    io $ writeHistory cachedir $
+    io $ writeHistory conf cachedir $
       M.insertWith
       (\xs ys -> prune . historyFilter conf $ xs ++ ys)
       historyKey
@@ -1690,16 +1690,18 @@ emptyHistory = M.empty
 getHistoryFile :: FilePath -> FilePath
 getHistoryFile cachedir = cachedir ++ "/prompt-history"
 
-readHistory :: FilePath -> IO History
+readHistory :: XPConfig -> FilePath -> IO History
-readHistory cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
+readHistory (XPC { historySize = 0 }) _ = return emptyHistory
+readHistory _ cachedir = readHist `E.catch` \(SomeException _) -> return emptyHistory
  where
     readHist = do
         let path = getHistoryFile cachedir
         xs <- withFile path ReadMode hGetLine
         readIO xs
 
-writeHistory :: FilePath -> History -> IO ()
+writeHistory :: XPConfig -> FilePath -> History -> IO ()
-writeHistory cachedir hist = do
+writeHistory (XPC { historySize = 0 }) _ _ = return ()
+writeHistory _ cachedir hist = do
   let path = getHistoryFile cachedir
       filtered = M.filter (not . null) hist
   writeFile path (show filtered) `E.catch` \(SomeException e) ->
@@ -1793,17 +1795,17 @@ breakAtSpace s
 -- | 'historyCompletion' provides a canned completion function much like
 --   'getShellCompl'; you pass it to mkXPrompt, and it will make completions work
 --   from the query history stored in the XMonad cache directory.
-historyCompletion :: X ComplFunction
+historyCompletion :: XPConfig -> X ComplFunction
-historyCompletion = historyCompletionP (const True)
+historyCompletion conf = historyCompletionP conf (const True)
 
 -- | Like 'historyCompletion' but only uses history data from Prompts whose
 -- name satisfies the given predicate.
-historyCompletionP :: (String -> Bool) -> X ComplFunction
+historyCompletionP :: XPConfig -> (String -> Bool) -> X ComplFunction
-historyCompletionP p = do
+historyCompletionP conf p = do
     cd <- asks (cacheDir . directories)
     pure $ \x ->
         let toComplList = deleteConsecutive . filter (isInfixOf x) . M.foldr (++) []
-         in toComplList . M.filterWithKey (const . p) <$> readHistory cd
+         in toComplList . M.filterWithKey (const . p) <$> readHistory conf cd
 
 -- | Sort a list and remove duplicates. Like 'deleteAllDuplicates', but trades off
 --   laziness and stability for efficiency.

XMonad/Prompt/OrgMode.hs

@@ -53,6 +53,7 @@ module XMonad.Prompt.OrgMode (
     Date (..),
     Time (..),
     TimeOfDay (..),
+    OrgTime (..),
     DayOfWeek (..),
 #endif
 
@@ -122,7 +123,9 @@ Monday and you schedule something for Monday, you will actually schedule
 it for the /next/ Monday (the one in seven days).
 
 The time is specified in the @HH:MM@ or @HHMM@ format.  The minutes may
-be omitted, in which case we assume a full hour is specified.
+be omitted, in which case we assume a full hour is specified.  It is also
+possible to enter a time span using the syntax @HH:MM-HH:MM@ or @HH:MM+HH@.
+In the former case, minutes may be omitted.
 
 A few examples are probably in order.  Suppose we have bound the key
 above, pressed it, and are now confronted with a prompt:
@@ -137,6 +140,10 @@ above, pressed it, and are now confronted with a prompt:
   - @hello +d today 12:30@ works just like above, but creates a
     deadline.
 
+  - @hello +d today 12:30-14:30@ works like the above, but gives the
+    event a duration of two hours.  An alternative way to specify
+    this would be @hello +d today 12:30+2@.
+
   - @hello +s thu@ would schedule the note for next thursday.
 
   - @hello +s 11@ would schedule it for the 11th of this month and this
@@ -356,21 +363,30 @@ refile (asString -> parent) (asString -> fp) =
 -- @HH:MM@ time.
 data Time = Time
   { date :: Date
-  , tod  :: Maybe TimeOfDay
+  , tod  :: Maybe OrgTime
   }
   deriving (Eq, Show)
 
 -- | The time in HH:MM.
-data TimeOfDay = TimeOfDay Int Int
+data TimeOfDay = HHMM Int Int
   deriving (Eq)
 
 instance Show TimeOfDay where
   show :: TimeOfDay -> String
-  show (TimeOfDay h m) = pad h <> ":" <> pad m
+  show (HHMM h m) = pad h <> ":" <> pad m
    where
     pad :: Int -> String
     pad n = (if n <= 9 then "0" else "") <> show n
 
+-- | The time—possibly as a span—in HH:MM format.
+data OrgTime = MomentInTime TimeOfDay | TimeSpan TimeOfDay TimeOfDay
+  deriving (Eq)
+
+instance Show OrgTime where
+  show :: OrgTime -> String
+  show (MomentInTime tod)  = show tod
+  show (TimeSpan tod tod') = show tod <> "-" <> show tod'
+
 -- | Type for specifying exactly which day one wants.
 data Date
   = Today
@@ -383,7 +399,7 @@ data Date
     -- ^ Manual date entry in the format DD [MM] [YYYY]
   deriving (Eq, Ord, Show)
 
-toOrgFmt :: Maybe TimeOfDay -> Day -> String
+toOrgFmt :: Maybe OrgTime -> Day -> String
 toOrgFmt tod day =
   mconcat ["<", isoDay, " ", take 3 $ show (dayOfWeek day), time, ">"]
  where
@@ -498,8 +514,8 @@ ppNote clp todo = \case
 -- | Parse the given string into a 'Note'.
 pInput :: String -> Maybe Note
 pInput inp = (`runParser` inp) . choice $
-  [ Scheduled <$> getLast "+s" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
+  [ Scheduled <$> (getLast "+s" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
-  , Deadline  <$> getLast "+d" <*> (Time <$> pDate <*> pTimeOfDay) <*> pPriority
+  , Deadline  <$> (getLast "+d" <* " ") <*> join (fixTime <$> pDate <*> pOrgTime) <*> pPriority
   , do s <- munch1 (pure True)
        let (s', p) = splitAt (length s - 3) s
        pure $ case tryPrio p of
@@ -507,6 +523,12 @@ pInput inp = (`runParser` inp) . choice $
          Nothing   -> NormalMsg s                   NoPriority
   ]
  where
+  fixTime :: Maybe Date -> Maybe OrgTime -> Parser Time
+  fixTime d tod = case (d, tod) of
+    (Nothing, Nothing) -> mempty                -- no day and no time
+    (Nothing, Just{})  -> pure (Time Today tod) -- no day, but a time
+    (Just d', _)       -> pure (Time d'    tod) -- day given
+
   tryPrio :: String -> Maybe Priority
   tryPrio [' ', '#', x]
     | x `elem` ("Aa" :: String) = Just A
@@ -533,21 +555,33 @@ pInput inp = (`runParser` inp) . choice $
 -- | Parse a 'Priority'.
 pPriority :: Parser Priority
 pPriority = option NoPriority $
-  " " *> skipSpaces *> choice
+  skipSpaces *> choice
     [ "#" *> foldCase "a" $> A
     , "#" *> foldCase "b" $> B
     , "#" *> foldCase "c" $> C
     ]
 
 -- | Try to parse a 'Time'.
-pTimeOfDay :: Parser (Maybe TimeOfDay)
+pOrgTime :: Parser (Maybe OrgTime)
-pTimeOfDay = option Nothing $
+pOrgTime = option Nothing $
-  skipSpaces >> Just <$> choice
+  between skipSpaces (void " " <|> eof) $
-    [ TimeOfDay <$> pHour <* ":" <*> pMinute -- HH:MM
+    Just <$> choice
-    , pHHMM                                  -- HHMM
+      [ TimeSpan <$> (pTimeOfDay <* ("--" <|> "-" <|> "–")) <*> pTimeOfDay
-    , TimeOfDay <$> pHour        <*> pure 0  -- HH
+      -- Org is not super smart around times with this syntax, so
+      -- we pretend not to be as well.
+      , do from@(HHMM h m) <- pTimeOfDay <* "+"
+           off <- pHour
+           pure $ TimeSpan from (HHMM (h + off) m)
+      , MomentInTime <$> pTimeOfDay
       ]
  where
+  pTimeOfDay :: Parser TimeOfDay
+  pTimeOfDay = choice
+    [ HHMM <$> pHour <* ":" <*> pMinute -- HH:MM
+    , pHHMM                             -- HHMM
+    , HHMM <$> pHour        <*> pure 0  -- HH
+    ]
+
   pHHMM :: Parser TimeOfDay
   pHHMM = do
     let getTwo = count 2 (satisfy isDigit)
@@ -555,18 +589,19 @@ pTimeOfDay = option Nothing $
     guard (hh >= 0 && hh <= 23)
     mm <- read <$> getTwo
     guard (mm >= 0 && mm <= 59)
-    pure $ TimeOfDay hh mm
+    pure $ HHMM hh mm
+
   pHour   :: Parser Int = pNumBetween 0 23
   pMinute :: Parser Int = pNumBetween 0 59
 
--- | Parse a 'Date'.
+-- | Try to parse a 'Date'.
-pDate :: Parser Date
+pDate :: Parser (Maybe Date)
-pDate = skipSpaces *> choice
+pDate = skipSpaces *> optional (choice
   [ pPrefix "tod" "ay"    Today
   , pPrefix "tom" "orrow" Tomorrow
   , Next <$> pNext
   , Date <$> pDate'
-  ]
+  ])
  where
   pNext :: Parser DayOfWeek = choice
     [ pPrefix "m"  "onday"    Monday   , pPrefix "tu" "esday"  Tuesday
@@ -585,7 +620,7 @@ pDate = skipSpaces *> choice
 
   pDate' :: Parser (Int, Maybe Int, Maybe Integer)
   pDate' =
-    (,,) <$> pNumBetween 1 31               -- day
+    (,,) <$> (pNumBetween 1 31 <* (void " " <|> eof))  -- day
          <*> optional (skipSpaces *> choice
                [ pPrefix "ja"  "nuary"    1 , pPrefix "f"   "ebruary" 2
                , pPrefix "mar" "ch"       3 , pPrefix "ap"  "ril"     4

XMonad/Util/EZConfig.hs

@@ -419,6 +419,7 @@ infixl 4 `removeMouseBindings`
 -- > <XF86_Next_VMode>
 -- > <XF86_Prev_VMode>
 -- > <XF86Bluetooth>
+-- > <XF86WLAN>
 
 mkKeymap :: XConfig l -> [(String, X ())] -> M.Map (KeyMask, KeySym) (X ())
 mkKeymap c = M.fromList . mkSubmaps . readKeymap c
@@ -552,8 +553,8 @@ doKeymapCheck :: XConfig l -> [(String,a)] -> ([String], [String])
 doKeymapCheck conf km = (bad,dups)
   where ks = map ((readKeySequence conf &&& id) . fst) km
         bad = nub . map snd . filter (isNothing . fst) $ ks
-        dups = map (snd . NE.head)
+        dups = map (snd . NE.head . notEmpty)
-             . mapMaybe nonEmpty
+             . filter ((>1) . length)
              . groupBy ((==) `on` fst)
              . sortBy (comparing fst)
              . map (first fromJust)

XMonad/Util/Grab.hs

@@ -29,15 +29,12 @@ module XMonad.Util.Grab
   ) where
 
 -- core
-import           XMonad                         hiding (mkGrabs)
+import           XMonad
 
 import           Control.Monad                  ( when )
-import           Data.Bits                      ( setBit )
 import           Data.Foldable                  ( traverse_ )
 -- base
-import qualified Data.Map.Strict               as M
 import           Data.Semigroup                 ( All(..) )
-import           Data.Traversable               ( for )
 
 -- }}}
 
@@ -70,9 +67,8 @@ grabUngrab
   -> [(KeyMask, KeySym)] -- ^ Keys to ungrab
   -> X ()
 grabUngrab gr ugr = do
-  f <- mkGrabs
+  traverse_ (uncurry ungrabKP) =<< mkGrabs ugr
-  traverse_ (uncurry ungrabKP) (f ugr)
+  traverse_ (uncurry grabKP)   =<< mkGrabs gr
-  traverse_ (uncurry grabKP)   (f gr)
 
 -- | A convenience function to grab keys. This also ungrabs all
 -- previously grabbed keys.
@@ -88,49 +84,9 @@ customRegrabEvHook regr = \case
   e@MappingNotifyEvent{} -> do
     io (refreshKeyboardMapping e)
     when (ev_request e `elem` [mappingKeyboard, mappingModifier])
-      $  setNumlockMask
+      $  cacheNumlockMask
       >> regr
     pure (All False)
   _ -> pure (All True)
 
 -- }}}
-
--- --< Private Utils >-- {{{
-
--- | Private action shamelessly copied and restyled from XMonad.Main source.
-setNumlockMask :: X ()
-setNumlockMask = withDisplay $ \dpy -> do
-  ms <- io (getModifierMapping dpy)
-  xs <- sequence
-    [ do
-        ks <- io (keycodeToKeysym dpy kc 0)
-        pure $ if ks == xK_Num_Lock
-          then setBit 0 (fromIntegral m)
-          else 0 :: KeyMask
-    | (m, kcs) <- ms
-    , kc       <- kcs
-    , kc /= 0
-    ]
-  modify $ \s -> s { numberlockMask = foldr (.|.) 0 xs }
-
--- | Private function shamelessly copied and refactored from XMonad.Main source.
-mkGrabs :: X ([(KeyMask, KeySym)] -> [(KeyMask, KeyCode)])
-mkGrabs = withDisplay $ \dpy -> do
-  let (minCode, maxCode) = displayKeycodes dpy
-      allCodes           = [fromIntegral minCode .. fromIntegral maxCode]
-  syms <- io . for allCodes $ \code -> keycodeToKeysym dpy code 0
-  let keysymMap = M.fromListWith (++) (zip syms $ pure <$> allCodes)
-      keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
-  extraMods <- extraModifiers
-  pure $ \ks -> do
-    (mask, sym) <- ks
-    keycode     <- keysymToKeycodes sym
-    extraMod    <- extraMods
-    pure (mask .|. extraMod, keycode)
-
--- }}}
-
-
--- NOTE: there is some duplication between this module and core. The
--- latter probably will never change, but this needs to be kept in sync
--- with any potential bugs that might arise.

XMonad/Util/Hacks.hs

@@ -40,10 +40,14 @@ module XMonad.Util.Hacks (
   trayerPaddingXmobarEventHook,
   trayPaddingXmobarEventHook,
   trayPaddingEventHook,
+
+  -- * Steam flickering fix
+  fixSteamFlicker,
   ) where
 
 
 import XMonad
+import XMonad.Hooks.FloatConfigureReq (fixSteamFlicker)
 import XMonad.Hooks.StatusBar (xmonadPropLog')
 import XMonad.Prelude (All (All), fi, filterM, when)
 import System.Posix.Env (putEnv)

XMonad/Util/NamedScratchpad.hs

@@ -309,7 +309,7 @@ nsSingleScratchpadPerWorkspace :: NamedScratchpads -> X ()
 nsSingleScratchpadPerWorkspace scratches =
     nsHideOnCondition $ \ _lastFocus curFocus winSet hideScratch -> do
         allScratchesButCurrent <-
-            filterM (liftA2 (<||>) (pure . (/= curFocus)) (`isNSP` scratches))
+            filterM (liftA2 (<&&>) (pure . (/= curFocus)) (`isNSP` scratches))
                     (W.index winSet)
         whenX (isNSP curFocus scratches) $
             for_ allScratchesButCurrent hideScratch

XMonad/Util/Rectangle.hs

@@ -67,7 +67,7 @@ data PointRectangle a = PointRectangle
 -- @[N,N+1]@, as though each real-valued coordinate had been rounded (either
 -- down or up) to the nearest integers. So each pixel, from zero, is listed as:
 -- @[0,0]@, @[1,1]@, @[2,2]@, and so on. Rather than a coordinate system, this
--- considers pixels as row/colum indices.  While easiest to reason with,
+-- considers pixels as row/column indices.  While easiest to reason with,
 -- indices are unable to represent zero-dimension rectangles.
 --
 -- Consider pixels as indices. Do not use this on empty rectangles.

flake.nix

@@ -2,9 +2,9 @@
 # See NIX.md for an overview of module usage.
 {
   inputs = {
-    flake-utils.url = github:numtide/flake-utils;
+    flake-utils.url = "github:numtide/flake-utils";
-    git-ignore-nix.url = github:hercules-ci/gitignore.nix/master;
+    git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master";
-    xmonad.url = github:xmonad/xmonad;
+    xmonad.url = "github:xmonad/xmonad";
   };
   outputs = { self, flake-utils, nixpkgs, git-ignore-nix, xmonad }:
   with xmonad.lib;

scripts/build/build-with-cabal.sh

@@ -15,7 +15,7 @@ output="$1"
 
 if [ "$SRC_DIR" = "" ]; then
     # look for the config directory, fall back to the old one
-    SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config/xmonad}}"
+    SRC_DIR="${XMONAD_CONFIG_DIR:-${XDG_CONFIG_HOME:-$HOME/.config}/xmonad}"
     if test -f "$SRC_DIR/build"; then
 	:
     else

stack.yaml

@@ -8,7 +8,7 @@ packages:
 
 extra-deps:
 - X11-1.10.2
-- xmonad-0.17.0
+- xmonad-0.18.0
 
 nix:
   packages:

tests/Main.hs

@@ -14,6 +14,7 @@ import qualified CycleRecentWS
 import qualified OrgMode
 import qualified GridSelect
 import qualified EZConfig
+import qualified WindowNavigation
 
 main :: IO ()
 main = hspec $ do
@@ -53,3 +54,4 @@ main = hspec $ do
     context "OrgMode"        OrgMode.spec
     context "GridSelect"     GridSelect.spec
     context "EZConfig"       EZConfig.spec
+    context "WindowNavigation" WindowNavigation.spec

tests/OrgMode.hs

@@ -45,7 +45,7 @@ spec = do
         `shouldBe` Just
           ( Deadline
               "todo"
-              (Time {date = Date (1, Nothing, Nothing), tod = Just $ TimeOfDay 1 1})
+              (Time {date = Date (1, Nothing, Nothing), tod = Just $ MomentInTime(HHMM 1 1)})
               NoPriority
           )
     it "works with todo +d 22 jan 2021 01:01 #b" $ do
@@ -53,9 +53,23 @@ spec = do
         `shouldBe` Just
           ( Deadline
                 "todo"
-                (Time {date = Date (22, Just 1, Just 2021), tod = Just $ TimeOfDay 1 1})
+                (Time {date = Date (22, Just 1, Just 2021), tod = Just $ MomentInTime(HHMM 1 1)})
                 B
           )
+    it "parses no day as today when given a time" $ do
+      pInput "todo +s 12:00"
+        `shouldBe` Just (Scheduled "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 12 0)}) NoPriority)
+      pInput "todo +d 14:05 #B"
+        `shouldBe` Just (Deadline "todo" (Time {date = Today, tod = Just $ MomentInTime(HHMM 14 5)}) B)
+    it "parses `blah+d`, `blah +d`, `blah +d `, and `blah +d #B` as normal messages" $ do
+      pInput "blah+d"
+        `shouldBe` Just (NormalMsg "blah+d" NoPriority)
+      pInput "blah +d"
+        `shouldBe` Just (NormalMsg "blah +d" NoPriority)
+      pInput "blah +d "
+        `shouldBe` Just (NormalMsg "blah +d " NoPriority)
+      pInput "blah +d #B"
+        `shouldBe` Just (NormalMsg "blah +d" B)
 
   context "no priority#b" $ do
     it "parses to the correct thing" $
@@ -100,10 +114,10 @@ ppPrio = \case
   prio       -> " #" <> show prio
 
 ppTime :: Time -> String
-ppTime (Time d t) = ppDate d <> ppTOD t
+ppTime (Time d t) = ppDate d <> ppOrgTime t
  where
-  ppTOD :: Maybe TimeOfDay -> String
+  ppOrgTime :: Maybe OrgTime -> String
-  ppTOD = maybe "" ((' ' :) . show)
+  ppOrgTime = maybe "" ((' ' :) . show)
 
   ppDate :: Date -> String
   ppDate dte = case days !? dte of
@@ -179,7 +193,7 @@ instance Arbitrary Date where
     [ pure Today
     , pure Tomorrow
     , Next . toEnum <$> choose (0, 6)
-    , do d <- posInt
+    , do d <- posInt `suchThat` (<= 31)
          m <- mbPos `suchThat` (<= Just 12)
          Date . (d, m, ) <$> if   isNothing m
                              then pure Nothing
@@ -188,7 +202,14 @@ instance Arbitrary Date where
 
 instance Arbitrary TimeOfDay where
   arbitrary :: Gen TimeOfDay
-  arbitrary = TimeOfDay <$> hourInt <*> minuteInt
+  arbitrary = HHMM <$> hourInt <*> minuteInt
+
+instance Arbitrary OrgTime where
+  arbitrary :: Gen OrgTime
+  arbitrary = oneof
+    [ MomentInTime <$> arbitrary
+    , TimeSpan <$> arbitrary <*> arbitrary
+    ]
 
 ------------------------------------------------------------------------
 -- Util

tests/WindowNavigation.hs

@@ -0,0 +1,635 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+module WindowNavigation where
+
+import Test.Hspec
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Functor.Identity
+
+import XMonad
+import XMonad.Util.Types (Direction2D(..))
+import XMonad.Actions.WindowNavigation (goPure, swapPure, WNState)
+import qualified XMonad.StackSet as W
+
+spec :: Spec
+spec = do
+  it "two-window adjacent go right (empty state)" $ do
+    -- Simplest case - just move the focus once.
+    -- ┌─────┬──────┐
+    -- │ 1 ──┼─►  2 │
+    -- └─────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
+    runNav R M.empty (mkws 1 [] [2])
+      `shouldBe` (mkstate 960 640, mkws 2 [1] [])
+
+  it "two-window adjacent go right (populated state)" $ do
+    -- Like the previous test, but this time internal stat is already populated with a position.
+    -- ┌─────┬──────┐
+    -- │ 1 ──┼─►  2 │
+    -- └─────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
+    runNav R (mkstate 100 100) (mkws 1 [] [2])
+      `shouldBe` (mkstate 960 100, mkws 2 [1] [])
+
+  it "two-window adjacent go right (incorrectly-populated state)" $ do
+    -- This time we set the position incorrectly, testing if it will be reset to the center of focused window.
+    -- ┌─────┬──────┐
+    -- │ 1 ──┼─►  2 │
+    -- └─────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2], windowRect)
+    runNav R (mkstate 1000 100) (mkws 1 [] [2])
+      `shouldBe` (mkstate 960 640, mkws 2 [1] [])
+
+  it "swap windows" $ do
+    -- Swap windows around.
+    -- ┌─────┬──────┐
+    -- │ 1 ◄─┼─►  2 │
+    -- └─────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          ]
+    runIdentity (swapPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
+      `shouldBe` (mkstate 960 640, mkws 1 [2] [])
+
+  it "tall layout, go up" $ do
+    -- ┌─────┬─────┐
+    -- │     │ 2 ▲ │
+    -- │  1  ├───┼─┤
+    -- │     │ 3 │ │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 640)
+          , (3, Rectangle 960 640 960 640)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1, 2, 3], windowRect)
+    runNav U M.empty (mkws 3 [] [1, 2])
+      `shouldBe` (mkstate 1440 639, mkws 2 [1, 3] [])
+
+  it "tall layout, go down" $ do
+    -- ┌─────┬─────┐
+    -- │     │ 2   │
+    -- │     ├─────┤
+    -- │  1  │ 3 │ │
+    -- │     ├───┼─┤
+    -- │     │ 4 ▼ │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    runNav D M.empty (mkws 3 [] [1, 2, 4])
+      `shouldBe` (mkstate 1440 800, mkws 4 [2, 1, 3] [])
+
+  it "tall layout, go left" $ do
+    -- ┌─────┬─────┐
+    -- │   ◄─┼── 2 │
+    -- │     ├─────┤
+    -- │ 1   │   3 │
+    -- │     ├─────┤
+    -- │     │   4 │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    runNav L M.empty (mkws 2 [] [1, 3, 4])
+      `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
+
+  it "tall layout, go left and then right (window 2)" $ do
+    -- ┌─────┬─────┐
+    -- │   ◄─┼── 2 │
+    -- │   ──┼─►   │
+    -- │     ├─────┤
+    -- │ 1   │   3 │
+    -- │     ├─────┤
+    -- │     │   4 │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav L M.empty (mkws 2 [] [1, 3, 4])
+    (st2, ws2) `shouldBe` (mkstate 959 200, mkws 1 [2] [3, 4])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 200, mkws 2 [] [1, 3, 4])
+
+  it "tall layout, go left and then right (window 3)" $ do
+    -- ┌─────┬─────┐
+    -- │     │   2 │
+    -- │     ├─────┤
+    -- │ 1 ◄─┼── 3 │
+    -- │   ──┼─►   │
+    -- │     ├─────┤
+    -- │     │   4 │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav L M.empty (mkws 3 [] [1, 2, 4])
+    (st2, ws2) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 600, mkws 3 [] [1, 2, 4])
+
+  it "tall layout, go left and then right (window 4)" $ do
+    -- ┌─────┬─────┐
+    -- │     │   2 │
+    -- │     ├─────┤
+    -- │ 1   │   3 │
+    -- │     ├─────┤
+    -- │   ◄─┼── 4 │
+    -- │   ──┼─►   │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav L M.empty (mkws 4 [] [1, 2, 3])
+    (st2, ws2) `shouldBe` (mkstate 959 1040, mkws 1 [4] [2, 3])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 1040, mkws 4 [] [1, 2, 3])
+
+  it "grid layout, go in a circle" $ do
+    -- ┌─────┬─────┐
+    -- │ 1 ──┼─► 2 │
+    -- │     │     │
+    -- │ ▲   │   │ │
+    -- ├─┼───┼───┼─┤
+    -- │ │   │   ▼ │
+    -- │     │     │
+    -- │ 3 ◄─┼── 4 │
+    -- └─────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 640)
+          , (2, Rectangle 960 0 960 640)
+          , (3, Rectangle 0 640 960 640)
+          , (4, Rectangle 960 640 960 640)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3, 4])
+    (st2, ws2) `shouldBe` (mkstate 960 320, mkws 2 [1] [3, 4])
+    let (st3, ws3) = runNav D st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [3, 2, 1] [])
+    let (st4, ws4) = runNav L st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 959 640, mkws 3 [2, 1] [4])
+    let (st5, ws5) = runNav U st4 ws4
+    (st5, ws5) `shouldBe` (mkstate 959 639, mkws 1 [] [2, 3, 4])
+
+  it "ignore window that fully overlaps the current window in parallel direction when pos is outside it" $ do
+    -- ┌─────┬──────┬──────┐
+    -- │ ┌───┴──────┴────┐ │
+    -- │ │   |  4   |    │ │
+    -- │ └───┬──────┬────┘ │
+    -- │  1  │  2 ──┼─► 3  │
+    -- └─────┴──────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 600 1280)
+          , (2, Rectangle 600 0 600 1280)
+          , (3, Rectangle 1200 0 720 1280)
+          , (4, Rectangle 200 200 1520 400)
+          ]
+    runIdentity (goPure R (mkstate 900 900, mkws 2 [] [1, 3, 4], S.fromList [1..4], windowRect))
+      `shouldBe` (mkstate 1200 900, mkws 3 [1,2] [4])
+
+  it "go to window that fully overlaps the current window in parallel direction when pos is inside it" $ do
+    -- ┌─────────────────┐
+    -- │     ┌──────┐    │
+    -- │  1  │      │    │
+    -- ├─────┤------├────┤
+    -- │     │      │    │
+    -- │  2  │  4 ──┼─►  │
+    -- │     │      │    │
+    -- ├─────┤------├────┤
+    -- │  3  │      │    │
+    -- │     └──────┘    │
+    -- └─────────────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 1920 400)
+          , (2, Rectangle 0 400 1920 400)
+          , (3, Rectangle 0 800 1920 480)
+          , (4, Rectangle 800 200 400 880)
+          ]
+    runIdentity (goPure R (mkstate 1000 600, mkws 4 [] [1, 2, 3], S.fromList [1..4], windowRect))
+      `shouldBe` (mkstate 1200 600, mkws 2 [1,4] [3])
+
+  it "go from inner window to outer" $ do
+    -- ┌───────────────┐
+    -- │      ┌──────┐ │
+    -- │  1 ◄─┼── 2  │ │
+    -- │      └──────┘ │
+    -- └───────────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 1920 1280)
+          , (2, Rectangle 600 600 600 600)
+          ]
+    runIdentity (goPure L (M.empty, mkws 2 [] [1], S.fromList [1, 2], windowRect))
+      `shouldBe` (mkstate 599 900, mkws 1 [2] [])
+
+  it "if there are multiple outer windows, go to the smaller one" $ do
+    -- ┌────────────────────────┐
+    -- │  ┌───────────────┐     │
+    -- │  │      ┌──────┐ │     │
+    -- │  │  2 ◄─┼── 3  │ │  1  │
+    -- │  │      └──────┘ │     │
+    -- │  └───────────────┘     │
+    -- └────────────────────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 1920 1280)
+          , (2, Rectangle 200 200 1520 880)
+          , (3, Rectangle 400 400 400 400)
+          ]
+    runIdentity (goPure L (M.empty, mkws 3 [] [1, 2], S.fromList [1..3], windowRect))
+      `shouldBe` (mkstate 399 600, mkws 2 [1, 3] [])
+
+  it "two tiled and one floating, floating fully inside" $ do
+    -- ┌───────────────────┬─────┐
+    -- │   ┌───────┐       │     │
+    -- │ ──┼─►   ──┼─►   ──┼─►   │
+    -- │   │   3   │   1   │   2 │
+    -- │   │     ◄─┼──   ◄─┼──   │
+    -- │   └───────┘       │     │
+    -- └───────────────────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          , (3, Rectangle 400 400 400 400)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
+    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3])
+    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 3 [2, 1] [])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 800 400, mkws 1 [] [2, 3])
+    let (st4, ws4) = runNav R st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1] [3])
+    let (st5, ws5) = runNav L st4 ws4
+    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [] [2, 3])
+    let (st6, ws6) = runNav L st5 ws5
+    (st6, ws6) `shouldBe` (mkstate 799 400, mkws 3 [2, 1] [])
+
+  it "two floating windows inside one big tiled one" $ do
+    -- ┌─────────┐
+    -- │    │    │
+    -- │ ┌──┼──┐ │
+    -- │ │  ▼  │ │
+    -- │ │  3  │ │
+    -- │ └──┼──┘ │
+    -- │    ▼    │
+    -- │    1    │
+    -- │ ┌──┼──┐ │
+    -- │ │  ▼  │ │
+    -- │ │  4  │ │
+    -- │ └──┼──┘ │
+    -- │    ▼    │
+    -- ├────┼────┤
+    -- │    ▼    │
+    -- │    2    │
+    -- └─────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 1920 640)
+          , (2, Rectangle 0 640 1920 640)
+          , (3, Rectangle 200 200 100 100)
+          , (4, Rectangle 1000 400 100 100)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav D (mkstate 1000 250) (mkws 1 [] [2, 3, 4])
+    (st2, ws2) `shouldBe` (mkstate 299 250, mkws 3 [2, 1] [4])
+    let (st3, ws3) = runNav D st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 299 300, mkws 1 [] [2, 3, 4])
+    let (st4, ws4) = runNav D st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 1000 400, mkws 4 [3, 2, 1] [])
+    let (st5, ws5) = runNav D st4 ws4
+    (st5, ws5) `shouldBe` (mkstate 1000 500, mkws 1 [] [2, 3, 4])
+    let (st6, ws6) = runNav D st5 ws5
+    (st6, ws6) `shouldBe` (mkstate 1000 640, mkws 2 [1] [3, 4])
+
+  it "floating window between two tiled ones" $ do
+    -- ┌───────┬────────┐
+    -- │ 1 ┌───┴───┐  2 │
+    -- │ ──┼─► 3 ──┼─►  │
+    -- │   └───┬───┘    │
+    -- └───────┴────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          , (3, Rectangle 860 540 200 200)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
+    let (st2, ws2) = runNav R M.empty (mkws 1 [] [2, 3])
+    (st2, ws2) `shouldBe` (mkstate 860 640, mkws 3 [2, 1] [])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 2 [1] [3])
+
+  it "floating window overlapping four tiled ones" $ do
+    -- ┌───────┬───────┐
+    -- │   ┌───┴───┐   │
+    -- │ 1 │       │ 2 │
+    -- ├───┤       ├───┤
+    -- │ ──┼─► 5 ──┼─► │
+    -- │ 3 └───┬───┘ 4 │
+    -- └───────┴───────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 640)
+          , (2, Rectangle 960 0 960 640)
+          , (3, Rectangle 0 640 960 640)
+          , (4, Rectangle 960 640 960 640)
+          , (5, Rectangle 760 440 400 400)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
+    let (st2, ws2) = runNav R (mkstate 480 640) (mkws 3 [] [1, 2, 4, 5])
+    (st2, ws2) `shouldBe` (mkstate 760 640, mkws 5 [4, 2, 1, 3] [])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 960 640, mkws 4 [2, 1, 3] [5])
+
+  it "sequential inner floating windows" $ do
+    -- ┌───────────────────────────────────┬──────┐
+    -- │   ┌───────┐                       │      │
+    -- │   │       │       ┌───────┐       │      │
+    -- │ ──┼─► 3 ──┼─► 1 ──┼─► 4 ──┼─►   ──┼─► 2  │
+    -- │ ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──   ◄─┼──    │
+    -- │   └───────┘       │       │       │      │
+    -- │                   └───────┘       │      │
+    -- └───────────────────────────────────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          , (3, Rectangle 200 200 200 200)
+          , (4, Rectangle 600 600 200 200)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav R (mkstate 100 100) (mkws 1 [] [2, 3, 4])
+    (st2, ws2) `shouldBe` (mkstate 200 200, mkws 3 [2,1] [4])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 400 200, mkws 1 [] [2, 3, 4])
+    let (st4, ws4) = runNav R st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 600 600, mkws 4 [3, 2, 1] [])
+    let (st5, ws5) = runNav R st4 ws4
+    (st5, ws5) `shouldBe` (mkstate 800 600, mkws 1 [] [2, 3, 4])
+    let (st6, ws6) = runNav R st5 ws5
+    (st6, ws6) `shouldBe` (mkstate 960 600, mkws 2 [1] [3, 4])
+    let (st7, ws7) = runNav L st6 ws6
+    (st7, ws7) `shouldBe` (mkstate 959 600, mkws 1 [] [2, 3, 4])
+    let (st8, ws8) = runNav L st7 ws7
+    (st8, ws8) `shouldBe` (mkstate 799 600, mkws 4 [3, 2, 1] [])
+    let (st9, ws9) = runNav L st8 ws8
+    (st9, ws9) `shouldBe` (mkstate 599 600, mkws 1 [] [2, 3, 4])
+    let (st10, ws10) = runNav L st9 ws9
+    (st10, ws10) `shouldBe` (mkstate 399 399, mkws 3 [2, 1] [4])
+    let (st11, ws11) = runNav L st10 ws10
+    (st11, ws11) `shouldBe` (mkstate 199 399, mkws 1 [] [2, 3, 4])
+
+  it "overlapping inner floating windows" $ do
+    -- ┌─────────────────────┬──────┐
+    -- │ ┌─────────┐         │      │
+    -- │ │  3 ┌────┴─┐       │      │
+    -- │ │  ──┼─►  ──┼─► 1 ──┼─►  2 │
+    -- │ │  ◄─┼──  ◄─┼──   ◄─┼──    │
+    -- │ │    │  4   │       │      │
+    -- │ └────┤      │       │      │
+    -- │      └──────┘       │      │
+    -- └─────────────────────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          , (3, Rectangle 200 200 400 400)
+          , (4, Rectangle 300 300 400 400)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..4], windowRect)
+    let (st2, ws2) = runNav R M.empty (mkws 3 [] [1, 2, 4])
+    (st2, ws2) `shouldBe` (mkstate 400 400, mkws 4 [2, 1, 3] [])
+    let (st3, ws3) = runNav R st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 700 400, mkws 1 [3] [2, 4])
+    let (st4, ws4) = runNav R st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 960 400, mkws 2 [1, 3] [4])
+    let (st5, ws5) = runNav L st4 ws4
+    (st5, ws5) `shouldBe` (mkstate 959 400, mkws 1 [3] [2, 4])
+    let (st6, ws6) = runNav L st5 ws5
+    (st6, ws6) `shouldBe` (mkstate 699 400, mkws 4 [2, 1, 3] [])
+    let (st7, ws7) = runNav L st6 ws6
+    (st7, ws7) `shouldBe` (mkstate 599 400, mkws 3 [] [1, 2, 4])
+
+  it "bounce back from the wall to the floating window" $ do
+    -- ┌────────────────┬─────┐
+    -- │  1   ┌──────┐  │     │
+    -- │  ┌───┼─►  3 │  │  2  │
+    -- │  └── │      │  │     │
+    -- │      └──────┘  │     │
+    -- └────────────────┴─────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 1280)
+          , (3, Rectangle 400 400 200 200)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..3], windowRect)
+    runNav L (mkstate 100 640) (mkws 1 [] [2, 3])
+      `shouldBe` (mkstate 400 599, mkws 3 [2, 1] [])
+
+  it "jump between screens" $ do
+    -- ┌─────┬──────┐  ┌────────┐
+    -- │     │  2   │  │    5   │
+    -- │     ├──────┤  ├────────┤
+    -- │  1  │  3 ──┼──┼─►  6   │
+    -- │     ├──────┤  └────────┘
+    -- │     │  4   │
+    -- └─────┴──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          , (5, Rectangle 1920 0 1280 384)
+          , (6, Rectangle 1920 384 1280 384)
+          ]
+        initWindowSet =
+          W.StackSet
+          { W.current =
+              W.Screen
+              { W.workspace =
+                  W.Workspace
+                  { W.tag = "A"
+                  , W.layout = Layout NullLayout
+                  , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
+                  }
+              , W.screen = 1
+              , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
+              }
+          , W.visible =
+              [ W.Screen
+                { W.workspace =
+                    W.Workspace
+                    { W.tag = "B"
+                    , W.layout = Layout NullLayout
+                    , W.stack = Just $ W.Stack { W.focus = 5, W.up = [], W.down = [6] }
+                    }
+                , W.screen = 2
+                , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
+                }
+              ]
+          , W.hidden = []
+          , W.floating = M.empty
+          }
+        expectedWindowSet =
+          W.StackSet
+          { W.current =
+              W.Screen
+              { W.workspace =
+                  W.Workspace
+                  { W.tag = "B"
+                  , W.layout = Layout NullLayout
+                  , W.stack = Just $ W.Stack { W.focus = 6, W.up = [5], W.down = [] }
+                  }
+              , W.screen = 2
+              , W.screenDetail = SD { screenRect = Rectangle 1920 0 1280 768 }
+              }
+          , W.visible =
+              [ W.Screen
+                { W.workspace =
+                    W.Workspace
+                    { W.tag = "A"
+                    , W.layout = Layout NullLayout
+                    , W.stack = Just $ W.Stack { W.focus = 3, W.up = [], W.down = [1, 2, 4] }
+                    }
+                , W.screen = 1
+                , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
+                }
+              ]
+          , W.hidden = []
+          , W.floating = M.empty
+          }
+
+    runIdentity (goPure R (M.empty, initWindowSet, S.fromList [1..6], windowRect))
+      `shouldBe` (M.fromList [("B", Point 1920 600)], expectedWindowSet)
+
+  it "floating window overlapping fully in the orthogonal direction" $ do
+    -- ┌─────┬──────────────────┐
+    -- │     │      ┌───────┐   │
+    -- │     │    2 │       │   │
+    -- │     ├──────┤-------├───┤
+    -- │  1  │    3 │       │ 3 │
+    -- │   ◄─┼──  ◄─┼── 5 ◄─┼── │
+    -- │     ├──────┤-------├───┤
+    -- │     │    4 │       │   │
+    -- │     │      └───────┘   │
+    -- └─────┴──────────────────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 960 0 960 400)
+          , (3, Rectangle 960 400 960 400)
+          , (4, Rectangle 960 800 960 480)
+          , (5, Rectangle 1360 200 200 800)
+          ]
+        runNav dir st ws = runIdentity $ goPure dir (st, ws, S.fromList [1..5], windowRect)
+    let (st2, ws2) = runNav L (mkstate 1800 600) (mkws 3 [] [1, 2, 4, 5])
+    (st2, ws2) `shouldBe` (mkstate 1559 600, mkws 5 [4, 2, 1, 3] [])
+    let (st3, ws3) = runNav L st2 ws2
+    (st3, ws3) `shouldBe` (mkstate 1359 600, mkws 3 [] [1, 2, 4, 5])
+    let (st4, ws4) = runNav L st3 ws3
+    (st4, ws4) `shouldBe` (mkstate 959 600, mkws 1 [3] [2, 4, 5])
+
+  it "navigation to free-floating windows on the same screen" $ do
+    -- ┌──────┐
+    -- │      │  ┌──────┐
+    -- │      │  │      │
+    -- │    ──┼──┼─►  2 │
+    -- │      │  │      │
+    -- │   1  │  └──────┘
+    -- │      │
+    -- │      │
+    -- └──────┘
+    let windowRect w =
+          Identity $ M.lookup w $ M.fromList
+          [ (1, Rectangle 0 0 960 1280)
+          , (2, Rectangle 1200 400 400 400)
+          ]
+    runIdentity (goPure R (M.empty, mkws 1 [] [2], S.fromList [1, 2], windowRect))
+      `shouldBe` (mkstate 1200 640, mkws 2 [1] [])
+
+  it "switch between windows in Full layout" $ do
+    let windowRect w = Identity $ M.lookup w $ M.fromList [(1, Rectangle 0 0 1920 1280)]
+    runIdentity (goPure D (M.empty, mkws 1 [] [2, 3], S.fromList [1], windowRect))
+      `shouldBe` (M.empty, mkws 2 [1] [3])
+
+data NullLayout a = NullLayout deriving (Show, Read, Eq)
+instance LayoutClass NullLayout a
+
+-- to make WindowSets comparable
+instance Eq (Layout w) where
+  (==) a b = show a == show b
+  (/=) a b = show a /= show b
+
+-- make a state with a position for a single workspace
+mkstate :: Position -> Position -> WNState
+mkstate px py = M.fromList [("A", Point px py)]
+
+-- make a single-workspace WindowSet
+mkws :: Window -> [Window] -> [Window] -> WindowSet
+mkws focusedWindow upWindows downWindows = W.StackSet
+  { W.current = W.Screen
+    { W.workspace = W.Workspace
+      { W.tag = "A"
+      , W.layout = Layout NullLayout
+      , W.stack = Just $ W.Stack { W.focus = focusedWindow, W.up = upWindows, W.down = downWindows }
+      }
+    , W.screen = 1
+    , W.screenDetail = SD { screenRect = Rectangle 0 0 1920 1280 }
+    }
+  , W.visible = []
+  , W.hidden = []
+  , W.floating = M.empty
+  }

xmonad-contrib.cabal

@@ -1,5 +1,5 @@
 name:               xmonad-contrib
-version:            0.18.0
+version:            0.18.1.9
 -- ^ also update cpp-options: -DXMONAD_CONTRIB_VERSION_*
 
 homepage:           https://xmonad.org/
@@ -38,7 +38,7 @@ cabal-version:      1.12
 build-type:         Simple
 bug-reports:        https://github.com/xmonad/xmonad-contrib/issues
 
-tested-with:        GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.4 || == 9.8.1
+tested-with:        GHC == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.2 || == 9.12.2
 
 source-repository head
   type:     git
@@ -54,32 +54,33 @@ flag pedantic
   manual:      True
 
 library
-    build-depends: base >= 4.11 && < 5,
+    build-depends: base >= 4.12 && < 5,
                    bytestring >= 0.10 && < 0.13,
-                   containers >= 0.5 && < 0.8,
+                   containers >= 0.5 && < 0.9,
                    directory,
                    filepath,
-                   time >= 1.8 && < 1.13,
+                   time >= 1.8 && < 1.15,
                    process,
                    random,
                    mtl >= 1 && < 3,
+                   transformers,
                    unix,
                    X11 >= 1.10 && < 1.11,
-                   xmonad >= 0.16.99999 && < 0.19,
+                   xmonad >= 0.18.0 && < 0.19,
                    utf8-string,
                    deepseq
     default-language: Haskell2010
 
     cpp-options:   -DXMONAD_CONTRIB_VERSION_MAJOR=0
                    -DXMONAD_CONTRIB_VERSION_MINOR=18
-                   -DXMONAD_CONTRIB_VERSION_PATCH=0
+                   -DXMONAD_CONTRIB_VERSION_PATCH=1
     ghc-options:   -Wall -Wno-unused-do-bind
 
     if flag(pedantic)
-       ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
+       ghc-options: -Werror -Wwarn=deprecations
 
     -- Keep this in sync with the oldest version in 'tested-with'
-    if impl(ghc > 8.6.5)
+    if impl(ghc > 8.8.4)
        -- don't treat unused-imports warning as errors, they may be necessary
        -- for compatibility with older versions of base (or other deps)
        ghc-options: -Wwarn=unused-imports
@@ -130,6 +131,7 @@ library
                         XMonad.Actions.PhysicalScreens
                         XMonad.Actions.Plane
                         XMonad.Actions.Prefix
+                        XMonad.Actions.Profiles
                         XMonad.Actions.Promote
                         XMonad.Actions.RandomBackground
                         XMonad.Actions.RepeatAction
@@ -152,6 +154,7 @@ library
                         XMonad.Actions.TreeSelect
                         XMonad.Actions.UpdateFocus
                         XMonad.Actions.UpdatePointer
+                        XMonad.Actions.UpKeys
                         XMonad.Actions.Warp
                         XMonad.Actions.WindowBringer
                         XMonad.Actions.WindowGo
@@ -191,6 +194,7 @@ library
                         XMonad.Hooks.EwmhDesktops
                         XMonad.Hooks.FadeInactive
                         XMonad.Hooks.FadeWindows
+                        XMonad.Hooks.FloatConfigureReq
                         XMonad.Hooks.FloatNext
                         XMonad.Hooks.Focus
                         XMonad.Hooks.InsertPosition
@@ -234,6 +238,7 @@ library
                         XMonad.Layout.Circle
                         XMonad.Layout.CircleEx
                         XMonad.Layout.Column
+                        XMonad.Layout.Columns
                         XMonad.Layout.Combo
                         XMonad.Layout.ComboP
                         XMonad.Layout.Cross
@@ -425,7 +430,9 @@ test-suite tests
                   RotateSome
                   Selective
                   SwapWorkspaces
+                  WindowNavigation
                   Utils
+                  XMonad.Actions.CopyWindow
                   XMonad.Actions.CycleRecentWS
                   XMonad.Actions.CycleWS
                   XMonad.Actions.FocusNth
@@ -437,10 +444,13 @@ test-suite tests
                   XMonad.Actions.SwapWorkspaces
                   XMonad.Actions.TagWindows
                   XMonad.Actions.WindowBringer
+                  XMonad.Actions.WindowGo
+                  XMonad.Actions.WindowNavigation
                   XMonad.Hooks.ManageDocks
                   XMonad.Hooks.ManageHelpers
                   XMonad.Hooks.UrgencyHook
                   XMonad.Hooks.WorkspaceHistory
+                  XMonad.Hooks.StatusBar.PP
                   XMonad.Layout.Decoration
                   XMonad.Layout.LayoutModifier
                   XMonad.Layout.LimitWindows
@@ -474,13 +484,13 @@ test-suite tests
                   XMonad.Util.XUtils
                   XPrompt
   hs-source-dirs: tests, .
-  build-depends: base
+  build-depends: base >= 4.12 && < 5
                , QuickCheck >= 2
                , X11 >= 1.10 && < 1.11
                , bytestring >= 0.10 && < 0.13
                , containers
                , directory
-               , time >= 1.8 && < 1.13
+               , time >= 1.8 && < 1.15
                , hspec >= 2.4.0 && < 3
                , mtl
                , random
@@ -494,10 +504,10 @@ test-suite tests
   default-language: Haskell2010
 
   if flag(pedantic)
-     ghc-options: -Werror -Wwarn=deprecations -Wwarn=dodgy-imports
+     ghc-options: -Werror -Wwarn=deprecations
 
   -- Keep this in sync with the oldest version in 'tested-with'
-  if impl(ghc > 8.6.5)
+  if impl(ghc > 8.8.4)
      -- don't treat unused-imports warning as errors, they may be necessary
      -- for compatibility with older versions of base (or other deps)
      ghc-options: -Wwarn=unused-imports