twin/xmonad-contrib
1
0
Fork 0
mirror of https://github.com/xmonad/xmonad-contrib.git synced 2025-05-19 11:30:22 -07:00
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: twin:master
Branches Tags
twin:master
twin:feature/fix-PR9
twin:v0.18.1
twin:v0.18.0
twin:v0.17.1
twin:v0.17.0
twin:v0.16
twin:v0.15
twin:v0.14
twin:v0.13
twin:v0.12
twin:v0.11
twin:v0.10
twin:v0.9.1
twin:v0.9
twin:v0.8.1
twin:v0.8
twin:v0.7
twin:v0.6
twin:v0.5
twin:v0.4
twin:v0.3
..
compare: twin:v0.17.1
Branches Tags
twin:master
twin:feature/fix-PR9
twin:v0.18.1
twin:v0.18.0
twin:v0.17.1
twin:v0.17.0
twin:v0.16
twin:v0.15
twin:v0.14
twin:v0.13
twin:v0.12
twin:v0.11
twin:v0.10
twin:v0.9.1
twin:v0.9
twin:v0.8.1
twin:v0.8
twin:v0.7
twin:v0.6
twin:v0.5
twin:v0.4
twin:v0.3

No commits in common. "master" and "v0.17.1" have entirely different histories.
master ... v0.17.1

301 changed files with 2871 additions and 9516 deletions
Show Stats Expand all files Collapse all files

6
.github/dependabot.yml vendored
View File

@ -1,6 +0,0 @@
version: 2
updates:
- package-ecosystem: "github-actions"
directory: "/"
schedule:
interval: "weekly"

34
.github/workflows/haskell-ci-hackage.patch vendored
View File

@ -37,43 +37,33 @@ set in GitHub repository secrets.
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
@@ -33,6 +40,7 @@
compilerVersion: 9.8.4
@@ -31,6 +38,7 @@
compilerVersion: 9.0.2
setup-method: ghcup
allow-failure: false
+ upload: true
- compiler: ghc-9.6.7
- compiler: ghc-8.10.7
compilerKind: ghc
compilerVersion: 9.6.7
@@ -257,6 +265,10 @@
compilerVersion: 8.10.7
@@ -209,8 +217,80 @@
${CABAL} -vnormal check
- name: haddock
run: |
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
+ - name: haddock for hackage
+ if: matrix.upload
+ run: |
- $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
+ $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
- name: unconstrained build
run: |
rm -f cabal.project.local
@@ -267,3 +279,80 @@
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
+ # 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)
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
+ - name: upload artifacts (sdist)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ uses: actions/upload-artifact@v2
+ with:
+ name: sdist
+ path: ${{ github.workspace }}/sdist/*.tar.gz
+ - name: upload artifact (haddock)
+ - name: upload artifacts (haddock)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ uses: actions/upload-artifact@v2
+ 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 != ''

155
.github/workflows/haskell-ci.yml vendored
View File

@ -8,9 +8,9 @@
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
# version: 0.19.20250506
# version: 0.14.3
#
# REGENDATA ("0.19.20250506",["github","cabal.project"])
# REGENDATA ("0.14.3",["github","cabal.project"])
#
name: Haskell-CI
on:
@ -26,44 +26,18 @@ on:
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
runs-on: ubuntu-24.04
runs-on: ubuntu-18.04
timeout-minutes:
60
container:
image: buildpack-deps:jammy
image: buildpack-deps:bionic
continue-on-error: ${{ matrix.allow-failure }}
strategy:
matrix:
include:
- compiler: ghc-9.12.2
- compiler: ghc-9.2.2
compilerKind: ghc
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.7
compilerKind: ghc
compilerVersion: 9.6.7
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.4.8
compilerKind: ghc
compilerVersion: 9.4.8
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.2.8
compilerKind: ghc
compilerVersion: 9.2.8
compilerVersion: 9.2.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.0.2
@ -71,6 +45,7 @@ jobs:
compilerVersion: 9.0.2
setup-method: ghcup
allow-failure: false
upload: true
- compiler: ghc-8.10.7
compilerKind: ghc
compilerVersion: 8.10.7
@ -79,34 +54,41 @@ jobs:
- compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: ghcup
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: hvr-ppa
allow-failure: false
- compiler: ghc-8.4.4
compilerKind: ghc
compilerVersion: 8.4.4
setup-method: hvr-ppa
allow-failure: false
fail-fast: false
steps:
- name: apt-get install
- name: apt
run: |
apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
- name: Install GHCup
run: |
mkdir -p "$HOME/.ghcup/bin"
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"
- name: Install cabal-install
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"
if [ "${{ matrix.setup-method }}" = ghcup ]; then
mkdir -p "$HOME/.ghcup/bin"
curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
apt-get update
apt-get install -y libx11-dev libxext-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
else
apt-add-repository -y 'ppa:hvr/ghc'
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.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
chmod a+x "$HOME/.ghcup/bin/ghcup"
"$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
fi
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
@ -117,12 +99,28 @@ 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/$HCKIND-$HCVER
echo "HC=$HC" >> "$GITHUB_ENV"
echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.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.6.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 }}
@ -162,17 +160,28 @@ jobs:
- name: update cabal index
run: |
$CABAL v2-update -v
- name: cache (tools)
uses: actions/cache@v2
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-tools-c0dbbd39
path: ~/.haskell-ci-tools
- name: install cabal-plan
run: |
mkdir -p $HOME/.cabal/bin
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
rm -f cabal-plan.xz
chmod a+x $HOME/.cabal/bin/cabal-plan
cabal-plan --version
- name: install hlint
run: |
if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then HLINTVER=$(cd /tmp && (${CABAL} v2-install -v $ARG_COMPILER --dry-run hlint --constraint='hlint >=3.4 && <3.5' | perl -ne 'if (/\bhlint-(\d+(\.\d+)*)\b/) { print "$1"; last; }')); echo "HLint version $HLINTVER" ; fi
if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then if [ ! -e $HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint ]; then echo "Downloading HLint version $HLINTVER"; mkdir -p $HOME/.haskell-ci-tools; curl --write-out 'Status Code: %{http_code} Redirects: %{num_redirects} Total time: %{time_total} Total Dsize: %{size_download}\n' --silent --location --output $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz "https://github.com/ndmitchell/hlint/releases/download/v$HLINTVER/hlint-$HLINTVER-x86_64-linux.tar.gz"; tar -xzv -f $HOME/.haskell-ci-tools/hlint-$HLINTVER.tar.gz -C $HOME/.haskell-ci-tools; fi ; fi
if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then mkdir -p $CABAL_DIR/bin && ln -sf "$HOME/.haskell-ci-tools/hlint-$HLINTVER/hlint" $CABAL_DIR/bin/hlint ; fi
if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then hlint --version ; fi
- name: checkout
uses: actions/checkout@v4
uses: actions/checkout@v2
with:
path: source
- name: initial cabal.project for sdist
@ -210,15 +219,15 @@ jobs:
flags: +pedantic
ghc-options: -j
EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(xmonad-contrib)$/; }' >> cabal.project.local
cat cabal.project
cat cabal.project.local
- name: dump install plan
run: |
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
cabal-plan
- name: restore cache
uses: actions/cache/restore@v4
- name: cache
uses: actions/cache@v2
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
@ -236,41 +245,29 @@ jobs:
- name: tests
run: |
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
- name: hlint
run: |
if [ $((HCNUMVER >= 90000 && HCNUMVER < 90200)) -ne 0 ] ; then (cd ${PKGDIR_xmonad_contrib} && hlint -h ${GITHUB_WORKSPACE}/source/.hlint.yaml -XHaskell2010 .) ; fi
- name: cabal check
run: |
cd ${PKGDIR_xmonad_contrib} || false
${CABAL} -vnormal check
- name: haddock
run: |
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
- name: haddock for hackage
if: matrix.upload
run: |
$CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
- name: unconstrained build
run: |
rm -f cabal.project.local
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
- name: save cache
if: always()
uses: actions/cache/save@v4
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
# 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)
- name: upload artifacts (sdist)
if: matrix.upload
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v2
with:
name: sdist
path: ${{ github.workspace }}/sdist/*.tar.gz
- name: upload artifact (haddock)
- name: upload artifacts (haddock)
if: matrix.upload
uses: actions/upload-artifact@v4
uses: actions/upload-artifact@v2
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 != ''

22
.github/workflows/hlint.yaml vendored
View File

@ -1,22 +0,0 @@
name: hlint
on:
push:
pull_request:
jobs:
hlint:
runs-on: ubuntu-latest
steps:
- uses: actions/checkout@v4
- name: 'Set up HLint'
uses: haskell-actions/hlint-setup@v2
with:
version: '3.5'
- name: 'Run HLint'
uses: haskell-actions/hlint-run@v2
with:
path: '["XMonad/", "tests/", "scripts/"]'
fail-on: status

14
.github/workflows/nix.yml vendored
View File

@ -12,15 +12,17 @@ jobs:
contents: read
steps:
- name: Install Nix
uses: cachix/install-nix-action@v31
uses: cachix/install-nix-action@v13
with:
github_access_token: ${{ secrets.GITHUB_TOKEN }}
install_url: https://nixos-nix-install-tests.cachix.org/serve/i6laym9jw3wg9mw6ncyrk6gjx4l34vvx/install
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
uses: actions/checkout@v2
- 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-update -O0 -j
nix develop -c cabal v2-build -O0 -j
run: nix develop -c cabal v2-build -O0 -j

15
.github/workflows/packdeps.yml vendored
View File

@ -13,16 +13,16 @@ jobs:
steps:
- name: Clone project
uses: actions/checkout@v4
uses: actions/checkout@v2
- name: Setup Haskell
uses: haskell-actions/setup@v2
uses: haskell/actions/setup@v1
with:
# packdeps doesn't build with newer as of 2021-10
ghc-version: '8.8'
- name: Install packdeps
run: |
set -ex
cd # go somewhere without a cabal.project
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
cabal install packdeps
- name: Check package bounds (all)
continue-on-error: true
@ -42,9 +42,10 @@ jobs:
*.cabal
workflow-keepalive:
if: github.event_name == 'schedule'
runs-on: ubuntu-latest
permissions:
actions: write
steps:
- uses: liskin/gh-workflow-keepalive@v1
- name: Re-enable workflow
env:
GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }}
run: |
gh api -X PUT repos/${{ github.repository }}/actions/workflows/packdeps.yml/enable

48
.github/workflows/stack.yml vendored
View File

@ -12,33 +12,41 @@ jobs:
fail-fast: false
matrix:
include:
- resolver: lts-16 # GHC 8.8
- resolver: lts-12
ghc: 8.4.4
yaml: stack.yaml
- resolver: lts-16 # GHC 8.8
- resolver: lts-12
ghc: 8.4.4
yaml: stack-master.yaml
- resolver: lts-18 # GHC 8.10
- resolver: lts-14
ghc: 8.6.5
yaml: stack-master.yaml
- resolver: lts-19 # GHC 9.0
- resolver: lts-16
ghc: 8.8.4
yaml: stack-master.yaml
- resolver: lts-20 # GHC 9.2
- resolver: lts-18
ghc: 8.10.7
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
- resolver: lts-19
ghc: 9.0.2
yaml: stack.yaml
- resolver: lts-23 # GHC 9.8
- resolver: lts-19
ghc: 9.0.2
yaml: stack-master.yaml
steps:
- name: Clone project
uses: actions/checkout@v4
uses: actions/checkout@v2
- name: Prepare apt sources
run: |
set -ex
sudo add-apt-repository -y ppa:hvr/ghc
sudo apt update -y
- name: Install C dependencies
run: |
set -ex
sudo apt update -y
sudo apt install -y \
libx11-dev \
libxext-dev \
@ -48,6 +56,14 @@ jobs:
libxss-dev \
#
- name: Install GHC
# use system ghc (if available) in stack, don't waste GH Actions cache space
continue-on-error: true
run: |
set -ex
sudo apt install -y ghc-${{ matrix.ghc }}
echo /opt/ghc/${{ matrix.ghc }}/bin >> $GITHUB_PATH
- name: Refresh caches once a month
id: cache-date
# GHA writes caches on the first miss and then never updates them again;
@ -55,16 +71,16 @@ jobs:
# date is prefixed with an epoch number to let us manually refresh the
# cache when needed. This is a workaround for https://github.com/actions/cache/issues/2
run: |
date +date=1-%Y-%m >> $GITHUB_OUTPUT
echo "::set-output name=date::1-$(date +%Y-%m)"
- name: Cache Haskell package metadata
uses: actions/cache@v4
uses: actions/cache@v2
with:
path: ~/.stack/pantry
key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
- name: Cache Haskell dependencies
uses: actions/cache@v4
uses: actions/cache@v2
with:
path: |
~/.stack/*

2
.gitignore vendored
View File

@ -27,6 +27,4 @@ tags
stack.yaml.lock
# nix artifacts
result
flake.lock

5
.mailmap
View File

@ -103,7 +103,6 @@ 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>
Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
Tony Zorman <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
Tony Zorman <soliditsallgood@mailbox.org>
slotThe <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
slotThe <soliditsallgood@mailbox.org> <soliditsallgood@tuta.io>
spoonm <spoonm@spoonm.org>

493
CHANGES.md
View File

@ -1,473 +1,6 @@
# 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
* Deprecated `XMonad.Layout.Cross` due to bitrot; refer to
`XMonad.Layout.Circle` and `XMonad.Layout.ThreeColumns` for
alternatives.
* Deprecated the `XMonad.Layout.StateFull` module and
`XMonad.Layout.TrackFloating.(t|T)rackFloating` in favour of
`XMonad.Layout.FocusTracking`.
* Dropped support for GHC 8.4.
* `XMonad.Util.ExclusiveScratchpads`
- Deprecated the module in favour of the (new) exclusive scratchpad
functionality of `XMonad.Util.NamedScratchpad`.
* `XMonad.Actions.CycleWorkspaceByScreen`
- The type of `repeatableAction` has changed, and it's deprecated in
favour of `X.A.Repeatable.repeatable`.
* `XMonad.Hooks.DynamicProperty`
- Deprecated the module in favour of the more aptly named
`XMonad.Hooks.OnPropertyChange`.
* `XMonad.Util.Scratchpad`:
- Deprecated the module; use `XMonad.Util.NamedScratchpad` instead.
* `XMonad.Actions.Navigation2D`
- Removed deprecated function `hybridNavigation`.
* `XMonad.Layout.Spacing`
- Removed deprecated functions `SpacingWithEdge`, `SmartSpacing`,
`SmartSpacingWithEdge`, `ModifySpacing`, `setSpacing`, and
`incSpacing`.
* `XMonad.Actions.MessageFeedback`
- Removed deprecated functions `send`, `sendSM`, `sendSM_`,
`tryInOrder`, `tryInOrder_`, `tryMessage`, and `tryMessage_`.
* `XMonad.Prompt.Window`
- Removed deprecated functions `windowPromptGoto`,
`windowPromptBring`, and `windowPromptBringCopy`.
* `XMonad.Hooks.ICCCMFocus`
- Removed deprecated module. This was merged into xmonad.
* `XMonad.Layout.LayoutBuilderP`
- Removed deprecated module; use `XMonad.Layout.LayoutBuilder`
instead.
* `XMonad.Hooks.RestoreMinimized`
- Removed deprecated module; use `XMonad.Hooks.Minimize` instead.
* `XMonad.Layout.Named`
- Deprecated the entire module, use `XMonad.Layout.Renamed` (which newly
provides `named` for convenience) instead.
* `XMonad.Actions.SinkAll`
- Deprecated the entire module, use `XMonad.Actions.WithAll`
instead.
* `XMonad.Layout.Circle`:
- Deprecated the entire module, use the `circle` function from
`XMonad.Layout.CircleEx` instead.
* `XMonad.Hooks.EwmhDesktops`
- `_NET_CLIENT_LIST_STACKING` puts windows in the current workspace at the
top in bottom-to-top order, followed by visible workspaces, followed by
invisible workspaces. Within visible and invisible groups, workspaces are
ordered lexicographically, as before. Currently focused window will
always be the topmost, meaning the last in the list.
* `XMonad.Util.NamedScratchpad`
- Added `nsSingleScratchpadPerWorkspace`—a logHook to allow only one
active scratchpad per workspace.
* `XMonad.Util.EZConfig`
- The function `readKeySequence` now returns a non-empty list if it
succeeded.
* Deprecate `XMonad.Util.Ungrab`; it was moved to `XMonad.Operations`
in core.
### New Modules
* `XMonad.Layout.CenterMainFluid`
- A three column layout with main column in the center and two stack
column surrounding it. Master window will be on center column and
spaces on the sides are reserved.
* `XMonad.Layout.FocusTracking`.
- Replaces `X.L.StateFull` and half of `X.L.TrackFloating`.
* `XMonad.Actions.MostRecentlyUsed`
- Tab through windows by recency of use. Based on the Alt+Tab behaviour
common outside of xmonad.
* `XMonad.Util.History`
- Track history in *O(log n)* time. Provides `History`, a variation on a
LIFO stack with a uniqueness property. In order to achieve the desired
asymptotics, the data type is implemented as an ordered Map.
* `XMonad.Actions.Repeatable`
- Actions you'd like to repeat. Factors out the shared logic of
`X.A.CycleRecentWS`, `X.A.CycleWorkspaceByScreen` and `X.A.CycleWindows`.
* `XMonad.Hooks.OnPropertyChange`:
- A new module replicating the functionality of
`XMonad.Hooks.DynamicProperty`, but with more discoverable names.
* `XMonad.Actions.ToggleFullFloat`:
- Fullscreen (float) a window while remembering its original state.
There's both an action to be bound to a key, and hooks that plug into
`XMonad.Hooks.EwmhDesktops`.
* `XMonad.Layout.CircleEx`:
- A new window layout, similar to X.L.Circle, but with more
possibilities for customisation.
* `XMonad.Layout.DecorationEx`:
- A new, more extensible, mechanism for window decorations, and some
standard types of decorations, including usual bar on top of window,
tabbed decorations and dwm-like decorations.
### Bug Fixes and Minor Changes
* `XMonad.Layout.Magnifier`
- Added `magnifyxy` to allow for different magnification in the
horizontal and vertical directions. Added `magnifierxy`,
`magnifierxy'`, `magnifierxyOff`, and `magnifierxyOff'` as
particular combinators.
* `XMonad.Util.Loggers`
- Added `logClassname`, `logClassnames`, `logClassnames'`,
`logClassnameOnScreen`, `logClassnamesOnScreen`, `logClassnamesOnScreen'`,
and `ClassnamesFormat`. These are all equivalents of their `Title`
counterparts, allowing logging the window classname instead.
* `XMonad.Hooks.StatusBar.PP`
- `dynamicLogString` now forces its result and produces an error string if
it throws an exception. Use `dynamicLogString'` if for some reason you
need the old behavior.
* `XMonad.Util.EZConfig`
- Added `remapKeysP`, which remaps keybindings from one binding to
another.
- Made `additionalKeys{,P}`, `removeKeys{,P}`, `remapKeysP`, and
`{additional,remove}MouseBindings` `infixl 4` so they can more easily
be concatenated with `(++)`.
* `XMonad.Util.NamedScratchpad`
- Added `addExclusives`, `resetFocusedNSP`, `setNoexclusive`,
`resizeNoexclusive`, and `floatMoveNoexclusive` in order to augment
named scratchpads with the exclusive scratchpad functionality of
`XMonad.Util.ExclusiveScratchpads`.
* `XMonad.Layout.BorderResize`
- Added `borderResizeNear` as a variant of `borderResize` that can
control how many pixels near a border resizing still works.
* `XMonad.Util.Run`
- It is now ensured that all arguments of `execute` and `eval` are
quoted. Likewise, `executeNoQuote` is added as a version of
`execute` that does not do that.
- Added `findFile` as a shorthand to call `find-file`.
- Added `list` and `saveExcursion` to the list of Emacs commands.
- Added `toList` to easily lift a `String` to an `X Input`.
- Added `>&&>` and `>||>` to glue together different inputs.
* `XMonad.Util.Parser`
- Added the `gather`, `count`, `between`, `option`, `optionally`,
`skipMany`, `skipMany1`, `chainr`, `chainr1`, `chainl`, `chainl1`,
and `manyTill` functions, in order to achieve feature parity with
`Text.ParserCombinators.ReadP`.
* `XMonad.Actions.FloatKeys`
- Added `directionMoveWindow` and `directionMoveWindow` as more
alternatives to the existing functions.
* `XMonad.Hooks.InsertPosition`
- Added `setupInsertPosition` as a combinator alternative to
`insertPosition`.
* `XMonad.Actions.Navigation2D`
- Added `sideNavigation` as a fallback to the default tiling strategy,
in case `lineNavigation` can't find a window. This benefits
especially users who use `XMonad.Layout.Spacing`.
* `XMonad.Prompt.OrgMode`
- Added `orgPromptRefile` and `orgPromptRefileTo` for interactive
and targeted refiling of the entered note into some existing tree
of headings, respectively.
- Allowed the time specification in `HHMM` format.
* `XMonad.Actions.Search`
- Added `aur`, `flora`, `ncatlab`, `protondb`, `rosettacode`, `sourcehut`,
`steam`, `voidpgks_x86_64`, `voidpgks_x86_64_musl`, `arXiv`,
`clojureDocs`, `cratesIo`, `rustStd`, `noogle`, `nixos`, `homeManager`,
and `zbmath` search engines.
* `XMonad.Layout.ResizableThreeColumns`
- Fixed an issue where the bottom right window would not respond to
`MirrorShrink` and `MirrorExpand` messages.
* `XMonad.Hooks.EwmhDesktops`
- Added `disableEwmhManageDesktopViewport` to avoid setting the
`_NET_DESKTOP_VIEWPORT` property, as it can lead to issues with
some status bars (see this
[polybar issue](https://github.com/polybar/polybar/issues/2603)).
- Added `setEwmhFullscreenHooks` to override the default fullfloat/sink
behaviour of `_NET_WM_STATE_FULLSCREEN` requests. See also
`XMonad.Actions.ToggleFullFloat` for a float-restoring implementation of
fullscreening.
- Added `ewmhDesktops(Maybe)ManageHook` that places windows in their
preferred workspaces. This is useful when restoring a browser session
after a restart.
* `XMonad.Hooks.StatusBar`
- Added `startAllStatusBars` to start the configured status bars.
* `XMonad.Util.NamedActions`
- Changed `addDescrKeys` and `addDescrKeys'` to not discard the
keybindings in the current config.
* `XMonad.Prompt`
- The `emacsLikeXPKeymap` and `vimLikeXPKeymap` keymaps now treat
`C-m` the same as `Return`.
- Added `prevCompletionKey` to `XPConfig`, facilitating the ability
to cycle through the completions backwards. This is bound to
`S-<TAB>` by default.
- The `vimLikeXPKeymap` now accepts the prompt upon pressing enter
in normal mode.
* `XMonad.Actions.Prefix`
- Added `orIfPrefixed`, a combinator to decide upon an action based
on whether any prefix argument was given.
* `XMonad.Actions.WorkspaceNames`
- Enabled prompt completion (from history) in `renameWorkspace`.
* `XMonad.Prompt.Pass`
- Added `passOTPTypePrompt` to type out one-time-passwords via
`xdotool`.
* `XMonad.Util.Stack`
- Added `zipperFocusedAtFirstOf` to differentiate two lists into a
zipper.
## 0.17.1 (September 3, 2022)
## 0.17.1 (September 3, 2021)
### Breaking Changes
@ -480,10 +13,9 @@
* `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](https://xmonad.org/configurations.html)
modules may still be found [on the website].
* `XMonad.Util.NamedScratchpad`
* `XMonad.Util.NamedScratchpad`
- Scratchpads are now only based on the argument given to
`namedScratchpadManageHook`; all other scratchpad arguments are,
@ -502,6 +34,8 @@
- 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`
@ -545,7 +79,7 @@
A module for adding a keybinding to repeat the last action, similar
to Vim's `.` or Emacs's `dot-mode`.
* `XMonad.Util.Grab`
* `XMonad.Util.Grab`
Utilities for making grabbing and ungrabbing keys more convenient.
@ -576,8 +110,7 @@
`todo +d 12 02 2024` work.
- Added the ability to specify alphabetic (`#A`, `#B`, and `#C`)
[priorities](https://orgmode.org/manual/Priorities.html) at the end of
the input note.
[priorities] at the end of the input note.
* `XMonad.Prompt.Unicode`
@ -671,8 +204,7 @@
- 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](https://github.com/xmonad/xmonad-contrib/pull/744)
variable support, comment on [this PR].
* `XMonad.Util.XUtils`
@ -711,6 +243,9 @@
- 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
@ -2236,8 +1771,8 @@
* `XMonad.Prompt.Pass`
This module provides 3 `XMonad.Prompt`s to ease passwords manipulation
(generate, read, remove) via [pass](http://www.passwordstore.org/).
This module provides 3 `XMonad.Prompt`s to ease passwords
manipulation (generate, read, remove) via [pass][].
* `XMonad.Util.RemoteWindows`
@ -2313,3 +1848,5 @@
## See Also
<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
[pass]: http://www.passwordstore.org/

57
NIX.md
View File

@ -16,24 +16,6 @@ pkgs: devInputs: devInputs // {
}
```
## Selecting a Compiler
A `comp.nix` file can be used to set the compiler used for `nix build` etc. E.g.
```nix
{ compiler = "ghc924"; }
```
Note that you must `git add comp.nix`, or it will be invisible to the flake.
There is also a `prefix` option (see documentation below) but it doesn't really
work in this context, since the xmonad flakes don't see the effects of your
system overlays. Instead try the `--override-input` flag, e.g.
```sh
$ nix develop . --override-input nixpkgs 'github:NixOS/nixpkgs/nixos-unstable'
```
## NixOS Modules
The core and contrib flakes provide NixOS configuration modules.
@ -43,42 +25,24 @@ You can bring them into your system flake like so:
{
inputs = {
nixpkgs.url = github:NixOS/nixpkgs/nixos-<version>;
# The xmonad-contrib flake depends upon and re-exports from the xmonad
# flake. As such, you don't need to use the latter directly. If you wish to
# use /only/ the xmonad flake, you should beware that the version of
# contrib you get from nixpkgs might not build against it.
xmonad.url = github:xmonad/xmonad;
xmonad-contrib.url = github:xmonad/xmonad-contrib;
};
outputs = { self, nixpkgs, xmonad-contrib }: {
outputs = { self, nixpkgs, xmonad, xmonad-contrib }: {
nixosConfigurations.<hostname> = nixpkgs.lib.nixosSystem rec {
system = <system>;
# NixOS module composition is /not/ commutative; order matters.
# To avoid issues, add `xmonad-contrib.nixosModules` after your standard
# configuration, but before `modernise` or any module overlaying in a
# "prefix".
system = <arch>;
modules = [
./configuration.nix
./hardware-configuration.nix
<myMiscConfigModule>
] ++ xmonad-contrib.nixosModules ++ [
# `modernise` replaces the standard xmonad module and wrapper script
# with those from unstable. This is currently a necessary workaround to
# make Mod-q recompilation work.
xmonad-contrib.modernise.${system}
<myPrefixModule>
xmonad.nixosModule
xmonad-contrib.nixosModule
];
};
};
}
```
Note that `<thing>` should be replaced with a user-supplied `thing`.
`<version>`, `<hostname>` and `<system>` are necessary, while
` <myMiscConfigModule>` and `<myPrefixModule>` are entirely optional.
Having brought in `xmonad-contrib.nixosModules`, you can then set the provided
options in your `configuration.nix` under `flake`:
Then you can set the provided options in your `configuration.nix` under `flake`:
```nix
services.xserver.windowManager.xmonad = {
@ -87,7 +51,7 @@ options in your `configuration.nix` under `flake`:
flake = {
enable = true;
# prefix = "unstable";
compiler = "ghc924";
compiler = "ghc921";
};
};
```
@ -95,12 +59,11 @@ options in your `configuration.nix` under `flake`:
This will use core and contrib from git for your system xmonad, building your
config with the compiler of your choice.
With the flake enabled, the `xmonad.haskellPackages` option is not used
directly, and is instead set by the `flake.compiler` option. When `compiler` is
unset, the default `pkgs.haskellPackages` is used.
With the flake enabled, the `xmonad.haskellPackages` option is not used directly,
and is instead set by the `flake.compiler` option. When `compiler` is unset,
the default `pkgs.haskellPackages` is used.
The `prefix` option is used if you wish to select your haskell packages from
within, e.g., unstable overlaid into `pkgs` as `pkgs.unstable`.
See the flakes themselves and nix flake documentation for full detail.
Additionally, a semi-walkthrough is available [here](https://tony-zorman.com/posts/xmonad-on-nixos.html).

6
README.md
View File

@ -6,9 +6,9 @@
<a href="https://github.com/xmonad/xmonad-contrib/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad-contrib"></a>
<a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a>
<br>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/stack.yml?label=Stack&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/haskell-ci.yml?label=Cabal&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad-contrib/nix.yml?label=Nix&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Stack?label=Stack&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad-contrib/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad-contrib/Nix?label=Nix&logo=githubactions&logoColor=white"></a>
<br>
<a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>
<a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>

2
XMonad/Actions/AfterDrag.hs
View File

@ -24,7 +24,7 @@ import XMonad
import Data.Time (NominalDiffTime, diffUTCTime, getCurrentTime)
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.AfterDrag
--

2
XMonad/Actions/BluetileCommands.hs
View File

@ -29,7 +29,7 @@ import System.Exit
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.ServerMode
-- > import XMonad.Actions.BluetileCommands

4
XMonad/Actions/Commands.hs
View File

@ -37,7 +37,7 @@ import XMonad.Prelude
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Commands
--
@ -57,7 +57,7 @@ import XMonad.Prelude
-- bindings!)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Create a 'Data.Map.Map' from @String@s to xmonad actions from a
-- list of pairs.

2
XMonad/Actions/ConstrainedResize.hs
View File

@ -26,7 +26,7 @@ import XMonad
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified XMonad.Actions.ConstrainedResize as Sqr
--

4
XMonad/Actions/CopyWindow.hs
View File

@ -37,7 +37,7 @@ import qualified XMonad.StackSet as W
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CopyWindow
--
@ -77,7 +77,7 @@ import qualified XMonad.StackSet as W
-- > , ((modm .|. shiftMask, xK_v ), killAllOtherCopies) -- @@ Toggle window state back
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- $logHook
--

39
XMonad/Actions/CycleRecentWS.hs
View File

@ -1,7 +1,6 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.CycleRecentWS
@ -36,25 +35,21 @@ module XMonad.Actions.CycleRecentWS (
#endif
) where
import XMonad.Actions.Repeatable (repeatableSt)
import XMonad hiding (workspaces)
import XMonad.Prelude (void, when)
import XMonad.StackSet hiding (filter, modify)
import XMonad.StackSet hiding (filter)
import Control.Arrow ((&&&))
import Data.Function (on)
import Control.Monad.State (lift)
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleRecentWS
-- >
-- > , ((modm, xK_Tab), cycleRecentWS [xK_Alt_L] xK_Tab xK_grave)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Cycle through most recent workspaces with repeated presses of a key, while
-- a modifier key is held down. The recency of workspaces previewed while browsing
@ -116,15 +111,25 @@ cycleWindowSets :: (WindowSet -> [WorkspaceId]) -- ^ A function used to create a
-> X ()
cycleWindowSets genOptions mods keyNext keyPrev = do
(options, unView') <- gets $ (genOptions &&& unView) . windowset
let
preview = do
i <- get
lift $ windows (view (options !! (i `mod` n)) . unView')
where n = length options
void . repeatableSt (-1) mods keyNext $ \t s -> when (t == keyPress) $ if
| s == keyNext -> modify succ >> preview
| s == keyPrev -> modify pred >> preview
| otherwise -> pure ()
XConf {theRoot = root, display = d} <- ask
let event = allocaXEvent $ \p -> do
maskEvent d (keyPressMask .|. keyReleaseMask) p
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
s <- keycodeToKeysym d c 0
return (t, s)
let setOption n = do windows $ view (options `cycref` n) . unView'
(t, s) <- io event
case () of
() | t == keyPress && s == keyNext -> setOption (n+1)
| t == keyPress && s == keyPrev -> setOption (n-1)
| t == keyRelease && s `elem` mods -> return ()
| otherwise -> setOption n
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
setOption 0
io $ ungrabKeyboard d currentTime
where
cycref :: [a] -> Int -> a
cycref l i = l !! (i `mod` length l)
-- | Given an old and a new 'WindowSet', which is __exactly__ one
-- 'view' away from the old one, restore the workspace order of the

7
XMonad/Actions/CycleSelectedLayouts.hs
View File

@ -23,7 +23,7 @@ import XMonad.Prelude (elemIndex, fromMaybe)
import qualified XMonad.StackSet as S
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Actions.CycleSelectedLayouts
@ -39,9 +39,8 @@ cycleToNext lst a = do
-- | If the current layout is in the list, cycle to the next layout. Otherwise,
-- apply the first layout from list.
cycleThroughLayouts :: [String] -> X ()
cycleThroughLayouts [] = pure ()
cycleThroughLayouts lst@(x: _) = do
cycleThroughLayouts lst = do
winset <- gets windowset
let ld = description . S.layout . S.workspace . S.current $ winset
let newld = fromMaybe x (cycleToNext lst ld)
let newld = fromMaybe (head lst) (cycleToNext lst ld)
sendMessage $ JumpToLayout newld

4
XMonad/Actions/CycleWS.hs
View File

@ -92,7 +92,7 @@ import XMonad.Util.Types
import XMonad.Util.WorkspaceCompare
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleWS
-- >
@ -122,7 +122,7 @@ import XMonad.Util.WorkspaceCompare
-- > windows . view $ t )
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- When using the toggle functions, in order to ensure that the workspace
-- to which you switch is the previously viewed workspace, use the

52
XMonad/Actions/CycleWindows.hs
View File

@ -1,4 +1,4 @@
{-# LANGUAGE ViewPatterns, MultiWayIf #-}
{-# LANGUAGE ViewPatterns #-}
--------------------------------------------------------------------------------
-- |
@ -50,6 +50,7 @@ module XMonad.Actions.CycleWindows (
-- $pointer
-- * Generic list rotations
-- $generic
rotUp, rotDown
) where
@ -58,13 +59,11 @@ import XMonad.Prelude
import qualified XMonad.StackSet as W
import qualified Data.List.NonEmpty as NE
import XMonad.Actions.RotSlaves
import XMonad.Actions.Repeatable (repeatableSt)
import Control.Arrow (second)
import Control.Monad.Trans (lift)
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.CycleWindows
-- > -- config
@ -80,7 +79,7 @@ import Control.Monad.Trans (lift)
--
-- Also, if you use focus follows mouse, you will want to read the section
-- on updating the mouse pointer below. For detailed instructions on
-- editing your key bindings, see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
{- $pointer
With FocusFollowsMouse == True, the focus is updated after binding
actions, possibly focusing a window you didn't intend to focus. Most
@ -140,19 +139,27 @@ cycleStacks' :: (W.Stack Window -> [W.Stack Window]) -- ^ A function to a finite
-> KeySym -- ^ Key used to select a \"previous\" stack.
-> X ()
cycleStacks' filteredPerms mods keyNext keyPrev = do
stacks <- gets $ maybe [] filteredPerms
. W.stack . W.workspace . W.current . windowset
let
preview = do
i <- get
lift . windows . W.modify' . const $ stacks !! (i `mod` n)
where n = length stacks
void $ repeatableSt 0 mods keyNext $ \t s -> if
| t == keyPress && s == keyNext -> modify succ
| t == keyPress && s == keyPrev -> modify pred
| t == keyPress && s `elem` [xK_0..xK_9] -> put (numKeyToN s)
| otherwise -> preview
where numKeyToN = subtract 48 . read . show
XConf {theRoot = root, display = d} <- ask
stacks <- gets $ maybe [] filteredPerms . W.stack . W.workspace . W.current . windowset
let evt = allocaXEvent $
\p -> do maskEvent d (keyPressMask .|. keyReleaseMask) p
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
s <- keycodeToKeysym d c 0
return (t, s)
choose n (t, s)
| t == keyPress && s == keyNext = io evt >>= choose (n+1)
| t == keyPress && s == keyPrev = io evt >>= choose (n-1)
| t == keyPress && s `elem` [xK_0..xK_9] = io evt >>= choose (numKeyToN s)
| t == keyRelease && s `elem` mods = return ()
| otherwise = doStack n >> io evt >>= choose n
doStack n = windows . W.modify' . const $ stacks `cycref` n
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
io evt >>= choose 1
io $ ungrabKeyboard d currentTime
where cycref l i = l !! (i `mod` length l) -- modify' ensures l is never [], but must also be finite
numKeyToN = subtract 48 . read . show
-- | Given a stack element and a stack, shift or insert the element (window)
-- at the currently focused position.
@ -222,3 +229,12 @@ rotUnfocused' f s@(W.Stack _ [] _ ) = rotSlaves' f s -- Master h
rotUnfocused' f (W.Stack t ls rs) = W.Stack t (reverse revls') rs' -- otherwise
where (master :| revls) = NE.reverse (let l:ll = ls in l :| ll)
(revls',rs') = splitAt (length ls) (f $ master:revls ++ rs)
-- $generic
-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
-- @id@ for null or singleton lists.
rotUp :: [a] -> [a]
rotUp l = drop 1 l ++ take 1 l
rotDown :: [a] -> [a]
rotDown = reverse . rotUp . reverse

25
XMonad/Actions/CycleWorkspaceByScreen.hs
View File

@ -25,10 +25,11 @@ module XMonad.Actions.CycleWorkspaceByScreen (
import Data.IORef
import Graphics.X11.Xlib.Extras
import XMonad
import XMonad.Prelude
import XMonad.Hooks.WorkspaceHistory
import XMonad.Actions.Repeatable (repeatable)
import qualified XMonad.StackSet as W
-- $usage
@ -52,9 +53,22 @@ import qualified XMonad.StackSet as W
--
-- > , ((mod4Mask, xK_slash), cycleWorkspaceOnCurrentScreen [xK_Super_L] xK_slash xK_p)
{-# DEPRECATED repeatableAction "Use XMonad.Actions.Repeatable.repeatable" #-}
repeatableAction :: [KeySym] -> KeySym -> (EventType -> KeySym -> X ()) -> X ()
repeatableAction = repeatable
repeatableAction :: [KeySym] -> (EventType -> KeySym -> X ()) -> X ()
repeatableAction mods pressHandler = do
XConf {theRoot = root, display = d} <- ask
let getNextEvent = io $ allocaXEvent $ \p ->
do
maskEvent d (keyPressMask .|. keyReleaseMask) p
KeyEvent {ev_event_type = t, ev_keycode = c} <- getEvent p
s <- io $ keycodeToKeysym d c 0
return (t, s)
handleEvent (t, s)
| t == keyRelease && s `elem` mods = return ()
| otherwise = pressHandler t s >> getNextEvent >>= handleEvent
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
getNextEvent >>= handleEvent
io $ ungrabKeyboard d currentTime
handleKeyEvent :: EventType
-> KeySym
@ -95,7 +109,8 @@ cycleWorkspaceOnScreen screenId mods nextKey prevKey = workspaceHistoryTransacti
return $ cycleWorkspaces !! current
focusIncrement i = io (getAndIncrementWS i) >>= (windows . W.greedyView)
repeatable mods nextKey $
focusIncrement 1 -- Do the first workspace cycle
repeatableAction mods $
runFirst
[ handleKeyEvent keyPress nextKey $ focusIncrement 1
, handleKeyEvent keyPress prevKey $ focusIncrement (-1)

4
XMonad/Actions/DeManage.hs
View File

@ -39,7 +39,7 @@ import qualified XMonad.StackSet as W
import XMonad
-- $usage
-- To use demanage, add this import to your @xmonad.hs@:
-- To use demanage, add this import to your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.DeManage
--
@ -48,7 +48,7 @@ import XMonad
-- > , ((modm, xK_d ), withFocused demanage)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Stop managing the currently focused window.
demanage :: Window -> X ()

4
XMonad/Actions/DwmPromote.hs
View File

@ -31,7 +31,7 @@ import qualified Data.List.NonEmpty as NE
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.DwmPromote
--
@ -40,7 +40,7 @@ import qualified Data.List.NonEmpty as NE
-- > , ((modm, xK_Return), dwmpromote)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Swap the focused window with the master window. If focus is in
-- the master, swap it with the next window in the stack. Focus

25
XMonad/Actions/DynamicProjects.hs
View File

@ -69,9 +69,7 @@ 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. To close a project,
-- you can use the functions provided by "XMonad.Actions.DynamicWorkspaces",
-- such as @removeWorkspace@ or @removeWorkspaceByTag@.
-- or further configure the workspace/project.
--
-- When using the @switchProjectPrompt@ function, workspaces are
-- created as needed. This means you can create new project spaces
@ -115,7 +113,7 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > , ((modm, xK_slash), shiftToProjectPrompt def)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
--------------------------------------------------------------------------------
type ProjectName = String
@ -232,9 +230,7 @@ lookupProject name = Map.lookup name <$> XS.gets projects
--------------------------------------------------------------------------------
-- | Fetch the current project (the one being used for the currently
-- active workspace). If the workspace doesn't have a project, a
-- default project is returned, using the workspace name as the
-- project name.
-- active workspace).
currentProject :: X Project
currentProject = do
name <- gets (W.tag . W.workspace . W.current . windowset)
@ -259,7 +255,20 @@ modifyProject f = do
--------------------------------------------------------------------------------
-- | Switch to the given project.
switchProject :: Project -> X ()
switchProject p = appendWorkspace (projectName p)
switchProject p = do
oldws <- gets (W.workspace . W.current . windowset)
oldp <- currentProject
let name = W.tag oldws
ws = W.integrate' (W.stack oldws)
-- If the project we are switching away from has no windows, and
-- it's a dynamic project, remove it from the configuration.
when (null ws && isNothing (projectStartHook oldp)) $ do
removeWorkspaceByTag name -- also remove the old workspace
XS.modify (\s -> s {projects = Map.delete name $ projects s})
appendWorkspace (projectName p)
--------------------------------------------------------------------------------
-- | Prompt for a project name and then switch to it. Automatically

2
XMonad/Actions/DynamicWorkspaceGroups.hs
View File

@ -51,7 +51,7 @@ import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.TopicSpace
-- $usage
-- You can use this module by importing it into your @xmonad.hs@ file:
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import XMonad.Actions.DynamicWorkspaceGroups
--

2
XMonad/Actions/DynamicWorkspaceOrder.hs
View File

@ -49,7 +49,7 @@ import XMonad.Prelude (fromJust, fromMaybe)
import Data.Ord (comparing)
-- $usage
-- You can use this module by importing it into your @xmonad.hs@ file:
-- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
--
-- > import qualified XMonad.Actions.DynamicWorkspaceOrder as DO
--

4
XMonad/Actions/DynamicWorkspaces.hs
View File

@ -44,7 +44,7 @@ import qualified Data.Map.Strict as Map
import qualified XMonad.Util.ExtensibleState as XS
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.DynamicWorkspaces
-- > import XMonad.Actions.CopyWindow(copy)
@ -75,7 +75,7 @@ import qualified XMonad.Util.ExtensibleState as XS
-- > zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..])
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>. See also the documentation for
-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.
type WorkspaceTag = String

4
XMonad/Actions/EasyMotion.hs
View File

@ -51,7 +51,7 @@ import qualified Data.Map.Strict as M (Map, elems, map, mapWithKey)
-- $usage
--
-- You can use this module's basic functionality with the following in your
-- @xmonad.hs@:
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.EasyMotion (selectWindow)
--
@ -387,5 +387,5 @@ handleKeyboard dpy drawFn cancel selected deselected = do
_ -> handleKeyboard dpy drawFn cancel (trim fg) (clear bg) >>= retryBackspace
where
(fg, bg) = partition ((== Just keySym) . listToMaybe . chord) selected
trim = map (\o -> o { chord = drop 1 $ chord o })
trim = map (\o -> o { chord = tail $ chord o })
clear = map (\o -> o { chord = [] })

4
XMonad/Actions/FindEmptyWorkspace.hs
View File

@ -25,7 +25,7 @@ import XMonad.StackSet
-- $usage
--
-- To use, import this module into your @xmonad.hs@:
-- To use, import this module into your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.FindEmptyWorkspace
--
@ -38,7 +38,7 @@ import XMonad.StackSet
-- will tag the current window to an empty workspace and view it.
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Find the first hidden empty workspace in a StackSet. Returns
-- Nothing if all workspaces are in use. Function searches currently

2
XMonad/Actions/FlexibleManipulate.hs
View File

@ -29,7 +29,7 @@ import qualified Prelude as P
import Prelude (Double, Integer, Ord (..), const, fromIntegral, fst, id, otherwise, round, snd, uncurry, ($))
-- $usage
-- First, add this import to your @xmonad.hs@:
-- First, add this import to your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified XMonad.Actions.FlexibleManipulate as Flex
--

2
XMonad/Actions/FlexibleResize.hs
View File

@ -25,7 +25,7 @@ import XMonad.Prelude (fi)
import Foreign.C.Types
-- $usage
-- To use, first import this module into your @xmonad.hs@ file:
-- To use, first import this module into your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import qualified XMonad.Actions.FlexibleResize as Flex
--

36
XMonad/Actions/FloatKeys.hs
View File

@ -19,18 +19,14 @@ module XMonad.Actions.FloatKeys (
keysMoveWindowTo,
keysResizeWindow,
keysAbsResizeWindow,
directionMoveWindow,
directionResizeWindow,
Direction2D(..),
P, G, ChangeDim
) where
import XMonad
import XMonad.Prelude (fi)
import XMonad.Util.Types
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.FloatKeys
--
@ -42,36 +38,8 @@ import XMonad.Util.Types
-- > , ((modm .|. shiftMask, xK_s ), withFocused (keysAbsResizeWindow (10,10) (1024,752)))
-- > , ((modm, xK_a ), withFocused (keysMoveWindowTo (512,384) (1%2,1%2)))
--
-- Using "XMonad.Util.EZConfig" syntax, we can easily build keybindings
-- where @M-\<arrow-keys\>@ moves the currently focused window and
-- @M-S-\<arrow-keys\>@ resizes it using 'directionMoveWindow' and
-- 'directionResizeWindow':
--
-- > [ ("M-" <> m <> k, withFocused $ f i)
-- > | (i, k) <- zip [U, D, R, L] ["<Up>", "<Down>", "<Right>", "<Left>"]
-- > , (f, m) <- [(directionMoveWindow 10, ""), (directionResizeWindow 10, "S-")]
-- > ]
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- | @directionMoveWindow delta dir win@ moves the window @win@ by
-- @delta@ pixels in direction @dir@.
directionMoveWindow :: Int -> Direction2D -> Window -> X ()
directionMoveWindow delta dir win = case dir of
U -> keysMoveWindow (0, -delta) win
D -> keysMoveWindow (0, delta) win
R -> keysMoveWindow (delta, 0) win
L -> keysMoveWindow (-delta, 0) win
-- | @directionResizeWindow delta dir win@ resizes the window @win@ by
-- @delta@ pixels in direction @dir@.
directionResizeWindow :: Int -> Direction2D -> Window -> X ()
directionResizeWindow delta dir win = case dir of
U -> keysResizeWindow (0, -delta) (0, 0) win
D -> keysResizeWindow (0, delta) (0, 0) win
R -> keysResizeWindow (delta, 0) (0, 0) win
L -> keysResizeWindow (-delta, 0) (0, 0) win
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | @keysMoveWindow (dx, dy)@ moves the window by @dx@ pixels to the
-- right and @dy@ pixels down.

4
XMonad/Actions/FloatSnap.hs
View File

@ -37,7 +37,7 @@ import XMonad.Util.Types (Direction2D(..))
import XMonad.Actions.AfterDrag
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.FloatSnap
--
@ -53,7 +53,7 @@ import XMonad.Actions.AfterDrag
-- > , ((modm .|. shiftMask, xK_Down), withFocused $ snapGrow D Nothing)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
--
-- And possibly add appropriate mouse bindings, for example:
--

4
XMonad/Actions/FocusNth.hs
View File

@ -25,7 +25,7 @@ import XMonad.Prelude
import XMonad.StackSet
-- $usage
-- Add the import to your @xmonad.hs@:
-- Add the import to your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.FocusNth
--
@ -36,7 +36,7 @@ import XMonad.StackSet
-- > | (i, k) <- zip [0 .. 8] [xK_1 ..]]
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Give focus to the nth window of the current workspace.
focusNth :: Int -> X ()

37
XMonad/Actions/GridSelect.hs
View File

@ -97,11 +97,10 @@ import XMonad.Actions.WindowBringer (bringWindow)
import Text.Printf
import System.Random (mkStdGen, randomR)
import Data.Word (Word8)
import qualified Data.List.NonEmpty as NE
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.GridSelect
--
@ -143,8 +142,8 @@ import qualified Data.List.NonEmpty as NE
--
-- Then you can bind to:
--
-- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer)
-- > ,((modm, xK_p), spawnSelected (gsconfig2 defaultColorizer) ["xterm","gvim"])
-- > ,((modm, xK_g), goToSelected $ gsconfig2 myWinColorizer)
-- > ,((modm, xK_p), spawnSelected $ spawnSelected defaultColorizer)
-- $keybindings
--
@ -203,13 +202,10 @@ 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_cancelOnEmptyClick :: Bool
-- ^ When True, click on empty space will cancel GridSelect
gs_bordercolor :: String
}
-- | That is 'fromClassName' if you are selecting a 'Window', or
@ -306,14 +302,14 @@ diamondLayer n =
r = tr ++ map (\(x,y) -> (y,-x)) tr
in r ++ map (negate *** negate) r
diamond :: (Enum a, Num a, Eq a) => Stream (a, a)
diamond = fromList $ concatMap diamondLayer [0..]
diamond :: (Enum a, Num a, Eq a) => [(a, a)]
diamond = concatMap diamondLayer [0..]
diamondRestrict :: Integer -> Integer -> Integer -> Integer -> [(Integer, Integer)]
diamondRestrict x y originX originY =
L.filter (\(x',y') -> abs x' <= x && abs y' <= y) .
map (\(x', y') -> (x' + fromInteger originX, y' + fromInteger originY)) .
takeS 1000 $ diamond
take 1000 $ diamond
findInElementMap :: (Eq a) => a -> [(a, b)] -> Maybe (a, b)
findInElementMap pos = find ((== pos) . fst)
@ -389,20 +385,13 @@ 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
, td_gsconfig = GSConfig{ gs_cellheight = ch
, gs_cellwidth = cw
, gs_cancelOnEmptyClick = cancelOnEmptyClick
}
} <- get
s@TwoDState { td_paneX = px, td_paneY = py,
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _ _) } <- get
let gridX = (fi x - (px - cw) `div` 2) `div` cw
gridY = (fi y - (py - ch) `div` 2) `div` ch
case lookup (gridX,gridY) (td_elementmap s) of
Just (_,el) -> return (Just el)
Nothing -> if cancelOnEmptyClick
then return Nothing
else contEventloop
Nothing -> contEventloop
| otherwise = contEventloop
stdHandle ExposeEvent{} contEventloop = updateAllElements >> contEventloop
@ -658,7 +647,7 @@ gridselect gsconfig elements =
liftIO $ mapWindow dpy win
liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
void $ io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
font <- initXMF (gs_font gsconfig)
let screenWidth = toInteger $ rect_width scr
screenHeight = toInteger $ rect_height scr
@ -669,7 +658,7 @@ gridselect gsconfig elements =
originPosX = floor $ (gs_originFractX gsconfig - (1/2)) * 2 * fromIntegral restrictX
originPosY = floor $ (gs_originFractY gsconfig - (1/2)) * 2 * fromIntegral restrictY
coords = diamondRestrict restrictX restrictY originPosX originPosY
s = TwoDState { td_curpos = NE.head (notEmpty coords),
s = TwoDState { td_curpos = head coords,
td_availSlots = coords,
td_elements = elements,
td_gsconfig = gsconfig,
@ -716,7 +705,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" True
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2) "white"
-- | Brings selected window to the current workspace.
bringSelected :: GSConfig Window -> X ()

12
XMonad/Actions/GroupNavigation.hs
View File

@ -33,8 +33,8 @@ module XMonad.Actions.GroupNavigation ( -- * Usage
, isOnAnyVisibleWS
) where
import Control.Monad.Reader (ask, asks)
import Control.Monad.State (gets)
import Control.Monad.Reader
import Control.Monad.State
import Control.DeepSeq
import Data.Map ((!))
import qualified Data.Map as Map
@ -47,13 +47,13 @@ import Prelude hiding (drop, elem, filter, null, reverse)
import XMonad.Core
import XMonad.ManageHook
import XMonad.Operations (windows, withFocused)
import XMonad.Prelude (elem, foldl', (>=>))
import XMonad.Prelude (elem, foldl')
import qualified XMonad.StackSet as SS
import qualified XMonad.Util.ExtensibleState as XS
{- $usage
Import the module into your @xmonad.hs@:
Import the module into your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.GroupNavigation
@ -129,7 +129,7 @@ focusNextMatchOrDo qry act = findM (runQuery qry)
>=> maybe act (windows . SS.focusWindow)
-- Returns the list of windows ordered by workspace as specified in
-- @xmonad.hs@.
-- ~/.xmonad/xmonad.hs
orderedWindowList :: Direction -> X (Seq Window)
orderedWindowList History = fmap (\(HistoryDB w ws) -> maybe ws (ws |>) w) XS.get
orderedWindowList dir = withWindowSet $ \ss -> do
@ -145,7 +145,7 @@ orderedWindowList dir = withWindowSet $ \ss -> do
dirfun _ = id
rotfun wins x = rotate $ rotateTo (== x) wins
-- Returns the ordered workspace list as specified in @xmonad.hs@.
-- Returns the ordered workspace list as specified in ~/.xmonad/xmonad.hs
orderedWorkspaceList :: WindowSet -> Seq String -> Seq WindowSpace
orderedWorkspaceList ss wsids = rotateTo isCurWS wspcs'
where

4
XMonad/Actions/LinkWorkspaces.hs
View File

@ -36,7 +36,7 @@ import qualified Data.Map as M
( insert, delete, Map, lookup, empty, filter )
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.LinkWorkspaces
--
@ -58,7 +58,7 @@ import qualified Data.Map as M
-- > , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
data MessageConfig = MessageConfig { messageFunction :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
, foreground :: [Char]

53
XMonad/Actions/MessageFeedback.hs
View File

@ -42,18 +42,24 @@ module XMonad.Actions.MessageFeedback
-- ** Aliases
, sm
-- * Backwards Compatibility
-- $backwardsCompatibility
, send, sendSM, sendSM_
, tryInOrder, tryInOrder_
, tryMessage, tryMessage_
) where
import XMonad ( Window )
import XMonad.Core ( X(), Message, SomeMessage(..), LayoutClass(..), windowset, catchX, WorkspaceId, Layout, whenJust )
import XMonad.Operations ( updateLayout, windowBracket, modifyWindowSet )
import XMonad.Prelude
import XMonad.Prelude ( isJust, liftA2, void )
import XMonad.StackSet ( Workspace, current, workspace, layout, tag )
import Control.Monad.State ( gets )
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MessageFeedback
--
@ -224,3 +230,46 @@ tryMessageWithNoRefreshToCurrent m = void . tryMessageWithNoRefreshToCurrentB m
-- | Convenience shorthand for 'SomeMessage'.
sm :: Message a => a -> SomeMessage
sm = SomeMessage
--------------------------------------------------------------------------------
-- Backwards Compatibility:
--------------------------------------------------------------------------------
{-# DEPRECATED send "Use sendMessageB instead." #-}
{-# DEPRECATED sendSM "Use sendSomeMessageB instead." #-}
{-# DEPRECATED sendSM_ "Use sendSomeMessage instead." #-}
{-# DEPRECATED tryInOrder "Use tryInOrderWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryInOrder_ "Use tryInOrderWithNoRefreshToCurrent instead." #-}
{-# DEPRECATED tryMessage "Use tryMessageWithNoRefreshToCurrentB instead." #-}
{-# DEPRECATED tryMessage_ "Use tryMessageWithNoRefreshToCurrent instead." #-}
-- $backwardsCompatibility
-- The following functions exist solely for compatibility with pre-0.14
-- releases.
-- | See 'sendMessageWithNoRefreshToCurrentB'.
send :: Message a => a -> X Bool
send = sendMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrentB'.
sendSM :: SomeMessage -> X Bool
sendSM = sendSomeMessageWithNoRefreshToCurrentB
-- | See 'sendSomeMessageWithNoRefreshToCurrent'.
sendSM_ :: SomeMessage -> X ()
sendSM_ = sendSomeMessageWithNoRefreshToCurrent
-- | See 'tryInOrderWithNoRefreshToCurrentB'.
tryInOrder :: [SomeMessage] -> X Bool
tryInOrder = tryInOrderWithNoRefreshToCurrentB
-- | See 'tryInOrderWithNoRefreshToCurrent'.
tryInOrder_ :: [SomeMessage] -> X ()
tryInOrder_ = tryInOrderWithNoRefreshToCurrent
-- | See 'tryMessageWithNoRefreshToCurrentB'.
tryMessage :: (Message a, Message b) => a -> b -> X Bool
tryMessage = tryMessageWithNoRefreshToCurrentB
-- | See 'tryMessageWithNoRefreshToCurrent'.
tryMessage_ :: (Message a, Message b) => a -> b -> X ()
tryMessage_ = tryMessageWithNoRefreshToCurrent

2
XMonad/Actions/Minimize.hs
View File

@ -12,7 +12,7 @@
-- Adds actions for minimizing and maximizing windows
--
-- This module should be used with "XMonad.Layout.Minimize". Add 'minimize' to your
-- layout modifiers as described in "XMonad.Layout.Minimize" and use actions from
-- layout modifiers as described in "XMonad.Layout.Minimized" and use actions from
-- this module
--
-- Possible keybindings:

205
XMonad/Actions/MostRecentlyUsed.hs
View File

@ -1,205 +0,0 @@
{-# LANGUAGE NamedFieldPuns, GeneralizedNewtypeDeriving #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.MostRecentlyUsed
-- Description : Tab through windows by recency of use.
-- Copyright : (c) 2022 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : @LSLeary (on github)
-- Stability : unstable
-- Portability : unportable
--
-- Based on the Alt+Tab behaviour common outside of xmonad.
--
-----------------------------------------------------------------------------
-- --< Imports & Exports >-- {{{
module XMonad.Actions.MostRecentlyUsed (
-- * Usage
-- $usage
-- * Interface
configureMRU,
mostRecentlyUsed,
withMostRecentlyUsed,
Location(..),
) where
-- base
import Data.List.NonEmpty (nonEmpty)
import Data.IORef (newIORef, readIORef, writeIORef, modifyIORef)
import Control.Monad.IO.Class (MonadIO)
-- mtl
import Control.Monad.Trans (lift)
import Control.Monad.State (get, put, gets)
-- containers
import qualified Data.Map.Strict as M
-- xmonad
import XMonad
( Window, KeySym, keyPress, io
, Event (DestroyWindowEvent, UnmapEvent, ev_send_event, ev_window)
)
import XMonad.Core
( X, XConfig(..), windowset, WorkspaceId, ScreenId
, ExtensionClass(..), StateExtension(..)
, waitingUnmap
)
import XMonad.Operations (screenWorkspace)
import qualified XMonad.StackSet as W
-- xmonad-contrib
import qualified XMonad.Util.ExtensibleConf as XC
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.PureX
(handlingRefresh, curScreenId, curTag, greedyView, view, peek, focusWindow)
import XMonad.Util.History (History, origin, event, erase, ledger)
import XMonad.Actions.Repeatable (repeatableSt)
import XMonad.Prelude
-- }}}
-- --< Core Data Types: WindowHistory & Location >-- {{{
data WindowHistory = WinHist
{ busy :: !Bool
, hist :: !(History Window Location)
} deriving (Show, Read)
instance ExtensionClass WindowHistory where
initialValue = WinHist
{ busy = False
, hist = origin
}
extensionType = PersistentExtension
data Location = Location
{ workspace :: !WorkspaceId
, screen :: !ScreenId
} deriving (Show, Read, Eq, Ord)
-- }}}
-- --< Interface >-- {{{
-- $usage
--
-- 'configureMRU' must be applied to your config in order for 'mostRecentlyUsed'
-- to work.
--
-- > main :: IO ()
-- > main = xmonad . configureMRU . ... $ def
-- > { ...
-- > }
--
-- Once that's done, it can be used normally in keybinds:
--
-- > , ((mod1Mask, xK_Tab), mostRecentlyUsed [xK_Alt_L, xK_Alt_R] xK_Tab)
--
-- N.B.: This example assumes that 'mod1Mask' corresponds to alt, which is not
-- always the case, depending on how your system is configured.
-- | Configure xmonad to support 'mostRecentlyUsed'.
configureMRU :: XConfig l -> XConfig l
configureMRU = XC.once f (MRU ()) where
f cnf = cnf
{ logHook = logHook cnf <> logWinHist
, handleEventHook = handleEventHook cnf <> winHistEH
}
newtype MRU = MRU () deriving Semigroup
-- | An action to browse through the history of focused windows, taking
-- another step back with each tap of the key.
mostRecentlyUsed
:: [KeySym] -- ^ The 'KeySym's corresponding to the modifier to which the
-- action is bound.
-> KeySym -- ^ The 'KeySym' corresponding to the key to which the action
-- is bound.
-> X ()
mostRecentlyUsed mods key = do
(toUndo, undo) <- undoer
let undoably curThing withThing thing = curThing >>= \cur ->
when (cur /= thing) $ withThing thing >> toUndo (withThing cur)
withMostRecentlyUsed mods key $ \win Location{workspace,screen} ->
handlingRefresh $ do
undo
undoably curScreenId viewScreen screen
undoably curTag greedyView workspace
mi <- gets (W.findTag win . windowset)
for_ mi $ \i -> do
undoably curTag greedyView i
mfw <- peek
for_ mfw $ \fw -> do
undoably (pure fw) focusWindow win
where
undoer :: (MonadIO m, Monoid a) => m (m a -> m (), m a)
undoer = do
ref <- io . newIORef $ pure mempty
let toUndo = io . modifyIORef ref . liftA2 (<>)
undo = join (io $ readIORef ref)
<* io (writeIORef ref $ pure mempty)
pure (toUndo, undo)
viewScreen :: ScreenId -> X Any
viewScreen scr = screenWorkspace scr >>= foldMap view
-- | A version of 'mostRecentlyUsed' that allows you to customise exactly what
-- is done with each window you tab through (the default being to visit its
-- previous 'Location' and give it focus).
withMostRecentlyUsed
:: [KeySym] -- ^ The 'KeySym's corresponding to the
-- modifier to which the action is bound.
-> KeySym -- ^ The 'KeySym' corresponding to the key to
-- which the action is bound.
-> (Window -> Location -> X ()) -- ^ The function applied to each window.
-> X ()
withMostRecentlyUsed mods tab preview = do
wh@WinHist{busy,hist} <- XS.get
unless busy $ do
XS.put wh{ busy = True }
for_ (nonEmpty $ ledger hist) $ \ne -> do
mfw <- gets (W.peek . windowset)
let iSt = case cycleS ne of
(w, _) :~ s | mfw == Just w -> s
s -> s
repeatableSt iSt mods tab $ \t s ->
when (t == keyPress && s == tab) (pop >>= lift . uncurry preview)
XS.modify $ \ws@WinHist{} -> ws{ busy = False }
logWinHist
where
pop = do
h :~ t <- get
put t $> h
-- }}}
-- --< Raw Config >-- {{{
logWinHist :: X ()
logWinHist = do
wh@WinHist{busy,hist} <- XS.get
unless busy $ do
cs <- gets (W.current . windowset)
let cws = W.workspace cs
for_ (W.stack cws) $ \st -> do
let location = Location{ workspace = W.tag cws, screen = W.screen cs }
XS.put wh{ hist = event (W.focus st) location hist }
winHistEH :: Event -> X All
winHistEH ev = All True <$ case ev of
UnmapEvent{ ev_send_event = synth, ev_window = w } -> do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
when (synth || e == 0) (collect w)
DestroyWindowEvent{ ev_window = w } -> collect w
_ -> pure ()
where collect w = XS.modify $ \wh@WinHist{hist} -> wh{ hist = erase w hist }
-- }}}

2
XMonad/Actions/MouseGestures.hs
View File

@ -32,7 +32,7 @@ import Data.Map (Map)
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MouseGestures
-- > import qualified XMonad.StackSet as W

8
XMonad/Actions/MouseResize.hs
View File

@ -37,7 +37,7 @@ import XMonad.Util.XUtils
-- "XMonad.Layout.SimpleFloat" or "XMonad.Layout.DecorationMadness".
--
-- You can use this module with the following in your
-- @xmonad.hs@:
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.MouseResize
-- > import XMonad.Layout.WindowArranger
@ -50,9 +50,9 @@ import XMonad.Util.XUtils
--
-- > main = xmonad def { layoutHook = myLayout }
--
-- For more detailed instructions on editing the layoutHook see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial> and
-- "XMonad.Doc.Extending#Editing_the_layout_hook".
-- For more detailed instructions on editing the layoutHook see:
--
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
mouseResize :: l a -> ModifiedLayout MouseResize l a
mouseResize = ModifiedLayout (MR [])

49
XMonad/Actions/Navigation2D.hs
View File

@ -46,6 +46,7 @@ module XMonad.Actions.Navigation2D ( -- * Usage
, sideNavigation
, sideNavigationWithBias
, hybridOf
, hybridNavigation
, fullScreenRect
, singleWindowRect
, switchLayer
@ -66,7 +67,6 @@ import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
import XMonad.Util.Types
import qualified Data.List.NonEmpty as NE
-- $usage
-- #Usage#
@ -85,7 +85,7 @@ import qualified Data.List.NonEmpty as NE
-- layers and allows customization of the navigation strategy for the tiled
-- layer based on the layout currently in effect.
--
-- You can use this module with (a subset of) the following in your @xmonad.hs@:
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Navigation2D
--
@ -98,15 +98,7 @@ import qualified Data.List.NonEmpty as NE
-- > False
-- > $ def
--
-- /NOTE/: the @def@ argument to 'navigation2D' contains the strategy
-- that decides which windows actually get selected. While the default
-- behaviour tries to keep them into account, if you use modules that
-- influence tiling in some way, like "XMonad.Layout.Spacing" or
-- "XMonad.Layout.Gaps", you should think about using a different
-- strategy, if you find the default behaviour to be unnatural. Check
-- out the [finer points](#g:Finer_Points) below for more information.
--
-- Alternatively to 'navigation2D', you can use 'navigation2DP':
-- Alternatively, you can use navigation2DP:
--
-- > main = xmonad $ navigation2DP def
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
@ -116,7 +108,7 @@ import qualified Data.List.NonEmpty as NE
-- > $ def
--
-- That's it. If instead you'd like more control, you can combine
-- 'withNavigation2DConfig' and 'additionalNav2DKeys' or 'additionalNav2DKeysP':
-- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:
--
-- > main = xmonad $ withNavigation2DConfig def
-- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
@ -170,7 +162,7 @@ import qualified Data.List.NonEmpty as NE
--
-- For detailed instruction on editing the key binding see:
--
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- $finer_points
-- #Finer_Points#
@ -187,19 +179,9 @@ import qualified Data.List.NonEmpty as NE
-- values in the above example to 'True'. You could also decide you want
-- wrapping only for a subset of the operations and no wrapping for others.
--
-- By default, all layouts use the 'defaultTiledNavigation' strategy
-- specified in the 'Navigation2DConfig' (by default, line navigation is
-- used). Many more navigation strategies are available; some may feel
-- more natural, depending on the layout and user:
--
-- * 'lineNavigation'
-- * 'centerNavigation'
-- * 'sideNavigation'
-- * 'sideNavigationWithBias'
--
-- There is also the ability to combine two strategies with 'hybridOf'.
--
-- To override the default behaviour for some layouts, add a pair (\"layout name\",
-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
-- in the 'Navigation2DConfig' (by default, line navigation is used). To
-- override this behaviour for some layouts, add a pair (\"layout name\",
-- navigation strategy) to the 'layoutNavigation' list in the
-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
-- layout's description method (normally what is shown as the layout name in
@ -345,7 +327,7 @@ centerNavigation = N 2 doCenterNavigation
-- and push it to the right until it intersects with at least one other window.
-- Of those windows, one with a point that is the closest to the centre of the
-- line (+1) is selected. This is probably the most intuitive strategy for the
-- tiled layer when using "XMonad.Layout.Spacing".
-- tiled layer when using XMonad.Layout.Spacing.
sideNavigation :: Navigation2D
sideNavigation = N 1 (doSideNavigationWithBias 1)
@ -377,6 +359,10 @@ hybridOf (N g1 s1) (N g2 s2) = N (max g1 g2) $ applyToBoth s1 s2
where
applyToBoth f g a b c = f a b c <|> g a b c
{-# DEPRECATED hybridNavigation "Use hybridOf with lineNavigation and centerNavigation as arguments." #-}
hybridNavigation :: Navigation2D
hybridNavigation = hybridOf lineNavigation centerNavigation
-- | Stores the configuration of directional navigation. The 'Default' instance
-- uses line navigation for the tiled layer and for navigation between screens,
-- and center navigation for the float layer. No custom navigation strategies
@ -465,7 +451,7 @@ withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf
}
instance Default Navigation2DConfig where
def = Navigation2DConfig { defaultTiledNavigation = hybridOf lineNavigation sideNavigation
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
, floatNavigation = centerNavigation
, screenNavigation = lineNavigation
, layoutNavigation = []
@ -784,7 +770,8 @@ doCenterNavigation dir (cur, rect) winrects
-- All the points that coincide with the current center and succeed it
-- in the (appropriately ordered) window stack.
onCtr' = L.drop 1 $ L.dropWhile ((cur /=) . fst) onCtr
onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
-- tail should be safe here because cur should be in onCtr
-- All the points that do not coincide with the current center and which
-- lie in the (rotated) right cone.
@ -884,8 +871,8 @@ swap win winset = W.focusWindow cur
-- Reconstruct the workspaces' window stacks to reflect the swap.
newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
newwinset = winset { W.current = NE.head (notEmpty newscrs) -- Always at least one screen.
, W.visible = drop 1 newscrs
newwinset = winset { W.current = head newscrs
, W.visible = tail newscrs
}
-- | Calculates the center of a rectangle

226
XMonad/Actions/OnScreen.hs
View File

@ -1,187 +1,155 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.OnScreen
-- Description : Control workspaces on different screens (in xinerama mode).
-- Copyright : (c) 2009-2025 Nils Schweinsberg
-- Copyright : (c) 2009 Nils Schweinsberg
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : Nils Schweinsberg <mail@nils.cc>
-- Maintainer : Nils Schweinsberg <mail@n-sch.de>
-- 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',
Focus (..),
viewOnScreen,
greedyViewOnScreen,
onlyOnScreen,
toggleOnScreen,
toggleGreedyOnScreen,
)
where
onScreen
, onScreen'
, Focus(..)
, viewOnScreen
, greedyViewOnScreen
, onlyOnScreen
, toggleOnScreen
, toggleGreedyOnScreen
) where
import XMonad
import XMonad.Prelude (empty, fromMaybe, guard)
import XMonad.Prelude (fromMaybe, guard)
import XMonad.StackSet hiding (new)
-- | Focus data definitions
data Focus
= -- | always focus the new screen
FocusNew
| -- | 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
data Focus = FocusNew -- ^ always focus the new screen
| FocusCurrent -- ^ always keep the focus on the current screen
| FocusTag WorkspaceId -- ^ always focus tag i on the new stack
| FocusTagVisible WorkspaceId -- ^ focus tag i only if workspace with tag i is visible on the old stack
-- | Run any function that modifies the stack on a given screen. This function
-- will also need to know which Screen to focus after the function has been
-- run.
onScreen ::
-- | function to run
(WindowSet -> WindowSet) ->
-- | what to do with the focus
Focus ->
-- | screen id
ScreenId ->
-- | current stack
WindowSet ->
WindowSet
onScreen :: (WindowSet -> WindowSet) -- ^ function to run
-> Focus -- ^ what to do with the focus
-> ScreenId -- ^ screen id
-> WindowSet -- ^ current stack
-> WindowSet
onScreen f foc sc st = fromMaybe st $ do
ws <- lookupWorkspace sc st
ws <- lookupWorkspace sc st
let fStack = f $ view ws st
let fStack = f $ view ws st
return $ setFocus foc st fStack
return $ setFocus foc st fStack
-- set focus for new stack
setFocus ::
Focus ->
-- | old stack
WindowSet ->
-- | new stack
WindowSet ->
WindowSet
setFocus FocusNew _ new = new
setFocus FocusCurrent old new =
case lookupWorkspace (screen $ current old) new of
Nothing -> new
Just i -> view i new
setFocus (FocusTag i) _ new = view i new
setFocus :: Focus
-> WindowSet -- ^ old stack
-> WindowSet -- ^ new stack
-> WindowSet
setFocus FocusNew _ new = new
setFocus FocusCurrent old new =
case lookupWorkspace (screen $ current old) new of
Nothing -> new
Just i -> view i new
setFocus (FocusTag i) _ new = view i new
setFocus (FocusTagVisible i) old new =
if i `elem` map (tag . workspace) (visible old)
then setFocus (FocusTag i) old new
else setFocus FocusCurrent old new
if i `elem` map (tag . workspace) (visible old)
then setFocus (FocusTag i) old new
else setFocus FocusCurrent old new
-- | A variation of @onScreen@ which will take any @X ()@ function and run it
-- on the given screen.
-- Warning: This function will change focus even if the function it's supposed
-- to run doesn't succeed.
onScreen' ::
-- | X function to run
X () ->
-- | focus
Focus ->
-- | screen id
ScreenId ->
X ()
onScreen' :: X () -- ^ X function to run
-> Focus -- ^ focus
-> ScreenId -- ^ screen id
-> X ()
onScreen' x foc sc = do
st <- gets windowset
case lookupWorkspace sc st of
Nothing -> return ()
Just ws -> do
windows $ view ws
x
windows $ setFocus foc st
st <- gets windowset
case lookupWorkspace sc st of
Nothing -> return ()
Just ws -> do
windows $ view ws
x
windows $ setFocus foc st
-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible use @view@ to
-- switch focus to the workspace @i@.
viewOnScreen ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
viewOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> WindowSet
viewOnScreen sid i =
onScreen (view i) (FocusTag i) sid
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 ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
greedyViewOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> WindowSet
greedyViewOnScreen sid i =
onScreen (greedyView i) (FocusTagVisible i) sid
onScreen (greedyView i) (FocusTagVisible i) sid
-- | Switch to workspace @i@ on screen @sc@. If @i@ is visible do nothing.
onlyOnScreen ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
onlyOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> WindowSet
onlyOnScreen sid i =
onScreen (view i) FocusCurrent sid
onScreen (view i) FocusCurrent sid
-- | @toggleOrView@ as in "XMonad.Actions.CycleWS" for @onScreen@ with view
toggleOnScreen ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> WindowSet
toggleOnScreen sid i =
onScreen (toggleOrView' view i) FocusCurrent sid
onScreen (toggleOrView' view i) FocusCurrent sid
-- | @toggleOrView@ from "XMonad.Actions.CycleWS" for @onScreen@ with greedyView
toggleGreedyOnScreen ::
-- | screen id
ScreenId ->
-- | index of the workspace
WorkspaceId ->
-- | current stack
WindowSet ->
WindowSet
toggleGreedyOnScreen :: ScreenId -- ^ screen id
-> WorkspaceId -- ^ index of the workspace
-> WindowSet -- ^ current stack
-> WindowSet
toggleGreedyOnScreen sid i =
onScreen (toggleOrView' greedyView i) FocusCurrent sid
onScreen (toggleOrView' greedyView i) FocusCurrent sid
-- a \"pure\" version of X.A.CycleWS.toggleOrDoSkip
toggleOrView' ::
-- | function to run
(WorkspaceId -> WindowSet -> WindowSet) ->
-- | tag to look for
WorkspaceId ->
-- | current stackset
WindowSet ->
WindowSet
toggleOrView' :: (WorkspaceId -> WindowSet -> WindowSet) -- ^ function to run
-> WorkspaceId -- ^ tag to look for
-> WindowSet -- ^ current stackset
-> WindowSet
toggleOrView' f i st = fromMaybe (f i st) $ do
let st' = hidden st
-- make sure we actually have to do something
guard $ i == (tag . workspace $ current st)
case st' of
[] -> empty
(h : _) -> return $ f (tag h) st -- finally, toggle!
let st' = hidden st
-- make sure we actually have to do something
guard $ i == (tag . workspace $ current st)
guard $ not (null st')
-- finally, toggle!
return $ f (tag . head $ st') st
-- $usage
--
-- This module provides an easy way to control, what you see on other screens in
-- xinerama mode without having to focus them. Put this into your
-- @xmonad.hs@:
-- @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.OnScreen
--
@ -215,4 +183,4 @@ toggleOrView' f i st = fromMaybe (f i st) $ do
-- where 0 is the first screen and \"1\" the workspace with the tag \"1\".
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".

4
XMonad/Actions/PerLayoutKeys.hs
View File

@ -25,14 +25,14 @@ import XMonad.StackSet as S
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.PerLayoutKeys
--
-- > ,((0, xK_F2), bindByLayout [("Tall", spawn "rxvt"), ("Mirror Tall", spawn "xeyes"), ("", spawn "xmessage hello")])
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Uses supplied function to decide which action to run depending on current layout name.
chooseActionByLayout :: (String->X()) -> X()

4
XMonad/Actions/PerWindowKeys.hs
View File

@ -24,7 +24,7 @@ import XMonad
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.PerWindowKeys
--
@ -41,7 +41,7 @@ import XMonad
-- doThisIfTheOthersFail)]@.
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Run an action if a Query holds true. Doesn't stop at the first one that
-- does, however, and could potentially run all actions.

4
XMonad/Actions/PerWorkspaceKeys.hs
View File

@ -25,14 +25,14 @@ import XMonad.StackSet as S
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.PerWorkspaceKeys
--
-- > ,((0, xK_F2), bindOn [("1", spawn "rxvt"), ("2", spawn "xeyes"), ("", spawn "xmessage hello")])
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Uses supplied function to decide which action to run depending on current workspace name.
chooseAction :: (String->X()) -> X()

65
XMonad/Actions/PhysicalScreens.hs
View File

@ -1,6 +1,4 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ParallelListComp #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.PhysicalScreens
@ -30,13 +28,10 @@ module XMonad.Actions.PhysicalScreens (
, getScreenIdAndRectangle
, screenComparatorById
, screenComparatorByRectangle
, rescreen
) where
import Data.List.NonEmpty (nonEmpty)
import XMonad hiding (rescreen)
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy, NonEmpty((:|)))
import qualified Data.List.NonEmpty as NE
import XMonad
import XMonad.Prelude (elemIndex, fromMaybe, on, sortBy)
import qualified XMonad.StackSet as W
{- $usage
@ -51,7 +46,7 @@ To create a screen comparator you can use screenComparatorByRectangle or screenC
The default ScreenComparator orders screens by the upper-left-most corner, from top-to-bottom
and then left-to-right.
Example usage in your @xmonad.hs@ file:
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
> import XMonad.Actions.PhysicalScreens
> import Data.Default
@ -70,7 +65,7 @@ Example usage in your @xmonad.hs@ file:
> , (f, mask) <- [(viewScreen def, 0), (sendToScreen def, shiftMask)]]
For detailed instructions on editing your key bindings, see
<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
"XMonad.Doc.Extending#Editing_key_bindings".
-}
-- | The type of the index of a screen by location
@ -80,7 +75,7 @@ getScreenIdAndRectangle :: W.Screen i l a ScreenId ScreenDetail -> (ScreenId, Re
getScreenIdAndRectangle screen = (W.screen screen, rect) where
rect = screenRect $ W.screenDetail screen
-- | Translate a physical screen index to a 'ScreenId'
-- | Translate a physical screen index to a "ScreenId"
getScreen:: ScreenComparator -> PhysicalScreen -> X (Maybe ScreenId)
getScreen (ScreenComparator cmpScreen) (P i) = do w <- gets windowset
let screens = W.current w : W.visible w
@ -151,53 +146,3 @@ 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.

6
XMonad/Actions/Plane.hs
View File

@ -41,13 +41,13 @@ module XMonad.Actions.Plane
import Data.Map (Map, fromList)
import XMonad.Prelude hiding (fromList)
import XMonad.Prelude
import XMonad
import XMonad.StackSet hiding (workspaces)
import XMonad.Util.Run
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.Plane
-- > import Data.Map (union)
@ -59,7 +59,7 @@ import XMonad.Util.Run
-- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Direction to go in the plane.
data Direction = ToLeft | ToUp | ToRight | ToDown deriving Enum

30
XMonad/Actions/Prefix.hs
View File

@ -29,7 +29,6 @@ module XMonad.Actions.Prefix
, withPrefixArgument
, isPrefixRaw
, isPrefixNumeric
, orIfPrefixed
, ppFormatPrefix
) where
@ -41,13 +40,11 @@ import XMonad.Util.ExtensibleState as XS
import XMonad.Util.Paste (sendKey)
import XMonad.Actions.Submap (submapDefaultWithKey)
import XMonad.Util.EZConfig (readKeySequence)
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty ((<|))
{- $usage
This module implements Emacs-style prefix argument. The argument
comes in two flavours, 'Raw' and 'Numeric'.
comes in two flavours, "Raw" and "Numeric".
To initiate the "prefix mode" you hit the prefix keybinding (default
C-u). This sets the Raw argument value to 1. Repeatedly hitting this
@ -75,7 +72,7 @@ Binding it in your config
> ((modm, xK_a), withPrefixArgument addMaybeClean)
Hitting MOD-a will add the @\<file\>@ to the playlist while C-u MOD-a will
Hitting MOD-a will add the <file> to the playlist while C-u MOD-a will
clear the playlist and then add the file.
You can of course use an anonymous action, like so:
@ -131,11 +128,11 @@ usePrefixArgument :: LayoutClass l Window
-> XConfig l
-> XConfig l
usePrefixArgument prefix conf =
conf{ keys = M.insert binding (handlePrefixArg (binding :| [])) . keys conf }
conf{ keys = M.insert binding (handlePrefixArg [binding]) . keys conf }
where
binding = case readKeySequence conf prefix of
Just (key :| []) -> key
_ -> (controlMask, xK_u)
Just [key] -> key
_ -> (controlMask, xK_u)
-- | Set Prefix up with default prefix key (C-u).
useDefaultPrefixArgument :: LayoutClass l Window
@ -143,7 +140,7 @@ useDefaultPrefixArgument :: LayoutClass l Window
-> XConfig l
useDefaultPrefixArgument = usePrefixArgument "C-u"
handlePrefixArg :: NonEmpty (KeyMask, KeySym) -> X ()
handlePrefixArg :: [(KeyMask, KeySym)] -> X ()
handlePrefixArg events = do
ks <- asks keyActions
logger <- asks (logHook . config)
@ -164,19 +161,19 @@ handlePrefixArg events = do
Raw _ -> XS.put $ Numeric x
Numeric a -> XS.put $ Numeric $ a * 10 + x
None -> return () -- should never happen
handlePrefixArg (key <| events)
handlePrefixArg (key:events)
else do
prefix <- XS.get
mapM_ (uncurry sendKey) $ case prefix of
Raw a -> replicate a (NE.head events) ++ [key]
_ -> reverse (key : toList events)
Raw a -> replicate a (head events) ++ [key]
_ -> reverse (key:events)
keyToNum = (xK_0, 0) : zip [xK_1 .. xK_9] [1..9]
-- | Turn a prefix-aware X action into an X-action.
--
-- First, fetch the current prefix, then pass it as argument to the
-- original function. You should use this to "run" your commands.
withPrefixArgument :: (PrefixArgument -> X a) -> X a
withPrefixArgument :: (PrefixArgument -> X ()) -> X ()
withPrefixArgument = (>>=) XS.get
-- | Test if 'PrefixArgument' is 'Raw' or not.
@ -189,13 +186,6 @@ isPrefixNumeric :: PrefixArgument -> Bool
isPrefixNumeric (Numeric _) = True
isPrefixNumeric _ = False
-- | Execute the first action, unless any prefix argument is given,
-- in which case the second action is chosen instead.
--
-- > action1 `orIfPrefixed` action2
orIfPrefixed :: X a -> X a -> X a
orIfPrefixed xa xb = withPrefixArgument $ bool xa xb . isPrefixRaw
-- | Format the prefix using the Emacs convetion for use in a
-- statusbar, like xmobar.
--

545
XMonad/Actions/Profiles.hs
View File

@ -1,545 +0,0 @@
{-# 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

4
XMonad/Actions/Promote.hs
View File

@ -28,7 +28,7 @@ import XMonad.StackSet
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Promote
--
@ -37,7 +37,7 @@ import XMonad.StackSet
-- > , ((modm, xK_Return), promote)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Move the focused window to the master pane. All other windows
-- retain their order. If focus is in the master, swap it with the

89
XMonad/Actions/Repeatable.hs
View File

@ -1,89 +0,0 @@
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.Repeatable
-- Description : Actions you'd like to repeat.
-- Copyright : (c) 2022 L. S. Leary
-- License : BSD3-style (see LICENSE)
--
-- Maintainer : @LSLeary (on github)
-- Stability : unstable
-- Portability : unportable
--
-- This module factors out the shared logic of "XMonad.Actions.CycleRecentWS",
-- "XMonad.Actions.CycleWorkspaceByScreen", "XMonad.Actions.CycleWindows" and
-- "XMonad.Actions.MostRecentlyUsed".
--
-- See the source of these modules for usage examples.
--
-----------------------------------------------------------------------------
module XMonad.Actions.Repeatable
( repeatable
, repeatableSt
, repeatableM
) where
-- mtl
import Control.Monad.State (StateT(..))
-- X11
import Graphics.X11.Xlib.Extras
-- xmonad
import XMonad
-- | An action that temporarily usurps and responds to key press/release events,
-- concluding when one of the modifier keys is released.
repeatable
:: [KeySym] -- ^ The list of 'KeySym's under the
-- modifiers used to invoke the action.
-> KeySym -- ^ The keypress that invokes the action.
-> (EventType -> KeySym -> X ()) -- ^ The keypress handler.
-> X ()
repeatable = repeatableM id
-- | A more general variant of 'repeatable' with a stateful handler,
-- accumulating a monoidal return value throughout the events.
repeatableSt
:: Monoid a
=> s -- ^ Initial state.
-> [KeySym] -- ^ The list of 'KeySym's under the
-- modifiers used to invoke the
-- action.
-> KeySym -- ^ The keypress that invokes the
-- action.
-> (EventType -> KeySym -> StateT s X a) -- ^ The keypress handler.
-> X (a, s)
repeatableSt iSt = repeatableM $ \m -> runStateT m iSt
-- | A more general variant of 'repeatable' with an arbitrary monadic handler,
-- accumulating a monoidal return value throughout the events.
repeatableM
:: (MonadIO m, Monoid a)
=> (m a -> X b) -- ^ How to run the monad in 'X'.
-> [KeySym] -- ^ The list of 'KeySym's under the
-- modifiers used to invoke the action.
-> KeySym -- ^ The keypress that invokes the action.
-> (EventType -> KeySym -> m a) -- ^ The keypress handler.
-> X b
repeatableM run mods key pressHandler = do
XConf{ theRoot = root, display = d } <- ask
run (repeatableRaw d root mods key pressHandler)
repeatableRaw
:: (MonadIO m, Monoid a)
=> Display -> Window
-> [KeySym] -> KeySym -> (EventType -> KeySym -> m a) -> m a
repeatableRaw d root mods key pressHandler = do
io (grabKeyboard d root False grabModeAsync grabModeAsync currentTime)
handleEvent (keyPress, key) <* io (ungrabKeyboard d currentTime)
where
getNextEvent = io $ allocaXEvent $ \p -> do
maskEvent d (keyPressMask .|. keyReleaseMask) p
KeyEvent{ ev_event_type = t, ev_keycode = c } <- getEvent p
s <- keycodeToKeysym d c 0
return (t, s)
handleEvent (t, s)
| t == keyRelease && s `elem` mods = pure mempty
| otherwise = (<>) <$> pressHandler t s <*> (getNextEvent >>= handleEvent)

25
XMonad/Actions/RotSlaves.hs
View File

@ -17,11 +17,7 @@
module XMonad.Actions.RotSlaves (
-- $usage
rotSlaves', rotSlavesUp, rotSlavesDown,
rotAll', rotAllUp, rotAllDown,
-- * Generic list rotations
-- $generic
rotUp, rotDown
rotAll', rotAllUp, rotAllDown
) where
import XMonad
@ -43,13 +39,13 @@ import XMonad.Prelude
-- TwoPane layout (see "XMonad.Layout.TwoPane").
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Rotate the windows in the current stack, excluding the first one
-- (master).
rotSlavesUp,rotSlavesDown :: X ()
rotSlavesUp = windows $ modify' (rotSlaves' rotUp)
rotSlavesDown = windows $ modify' (rotSlaves' rotDown)
rotSlavesUp = windows $ modify' (rotSlaves' (\l -> tail l++[head l]))
rotSlavesDown = windows $ modify' (rotSlaves' (\l -> last l : init l))
-- | The actual rotation, as a pure function on the window stack.
rotSlaves' :: ([a] -> [a]) -> Stack a -> Stack a
@ -61,19 +57,10 @@ rotSlaves' f s@(Stack _ ls _ ) = Stack t' (reverse revls') rs' -- otherwise
-- | Rotate all the windows in the current stack.
rotAllUp,rotAllDown :: X ()
rotAllUp = windows $ modify' (rotAll' rotUp)
rotAllDown = windows $ modify' (rotAll' rotDown)
rotAllUp = windows $ modify' (rotAll' (\l -> tail l++[head l]))
rotAllDown = windows $ modify' (rotAll' (\l -> last l : init l))
-- | The actual rotation, as a pure function on the window stack.
rotAll' :: ([a] -> [a]) -> Stack a -> Stack a
rotAll' f s = Stack r (reverse revls) rs
where (revls, notEmpty -> r :| rs) = splitAt (length (up s)) (f (integrate s))
-- $generic
-- Generic list rotations such that @rotUp [1..4]@ is equivalent to
-- @[2,3,4,1]@ and @rotDown [1..4]@ to @[4,1,2,3]@. They both are
-- @id@ for null or singleton lists.
rotUp :: [a] -> [a]
rotUp l = drop 1 l ++ take 1 l
rotDown :: [a] -> [a]
rotDown = reverse . rotUp . reverse

2
XMonad/Actions/RotateSome.hs
View File

@ -35,7 +35,7 @@ import XMonad.StackSet (Screen (Screen), Stack (Stack), current, floating, modif
import XMonad.Util.Stack (reverseS)
{- $usage
You can use this module with the following in your @xmonad.hs@:
You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.RotateSome

111
XMonad/Actions/Search.hs
View File

@ -31,50 +31,33 @@ module XMonad.Actions.Search ( -- * Usage
prefixAware,
namedEngine,
alpha,
amazon,
arXiv,
aur,
clojureDocs,
alpha,
codesearch,
cratesIo,
deb,
debbts,
debpts,
dictionary,
duckduckgo,
ebay,
flora,
github,
google,
hackage,
homeManager,
hoogle,
images,
imdb,
lucky,
maps,
mathworld,
ncatlab,
nixos,
noogle,
openstreetmap,
protondb,
rosettacode,
rustStd,
scholar,
sourcehut,
stackage,
steam,
thesaurus,
vocabulary,
voidpgks_x86_64,
voidpgks_x86_64_musl,
wayback,
wikipedia,
wiktionary,
youtube,
zbmath,
vocabulary,
duckduckgo,
multi,
-- * Use case: searching with a submap
-- $tip
@ -119,20 +102,12 @@ import XMonad.Util.XSelection (getSelection)
The currently available search engines are:
* 'alpha' -- Wolfram|Alpha query.
* 'amazon' -- Amazon keyword search.
* 'arXiv' -- Open-access preprint archive.
* 'aur' -- Arch User Repository.
* 'clojureDocs' -- Documentation and examples repository for Clojure.
* 'alpha' -- Wolfram|Alpha query.
* 'codesearch' -- Google Labs Code Search search.
* 'cratesIo' -- Rust crate registry.
* 'deb' -- Debian package search.
* 'debbts' -- Debian Bug Tracking System.
@ -141,22 +116,18 @@ import XMonad.Util.XSelection (getSelection)
* 'dictionary' -- dictionary.reference.com search.
* 'duckduckgo' -- DuckDuckGo search engine.
* 'ebay' -- Ebay keyword search.
* 'flora' -- Prettier Haskell package database.
* 'github' -- GitHub keyword search.
* 'google' -- basic Google search.
* 'hackage' -- Hackage, the Haskell package database.
* 'homeManager' -- Search Nix's home-manager's options.
* 'hoogle' -- Hoogle, the Haskell libraries API search engine.
* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
* 'images' -- Google images.
* 'imdb' -- the Internet Movie Database.
@ -167,45 +138,21 @@ import XMonad.Util.XSelection (getSelection)
* 'mathworld' -- Wolfram MathWorld search.
* 'ncatlab' -- Higer Algebra, Homotopy and Category Theory Wiki.
* 'nixos' -- Search NixOS packages and options.
* 'noogle' -- 'hoogle'-like Nix API search engine.
* 'openstreetmap' -- OpenStreetMap free wiki world map.
* 'protondb' -- Steam Proton Game Database.
* 'rosettacode' -- Programming chrestomathy wiki.
* 'rustStd' -- Rust standard library documentation.
* 'scholar' -- Google scholar academic search.
* 'sourcehut' -- Sourcehut projects search.
* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
* 'steam' -- Steam games search.
* 'thesaurus' -- thesaurus.com search.
* 'vocabulary' -- Dictionary search.
* 'voidpgks_x86_64' -- Void Linux packages search for @x86_64@.
* 'voidpgks_x86_64_musl' -- Void Linux packages search for @x86_64-musl@.
* 'wayback' -- the Wayback Machine.
* 'wikipedia' -- basic Wikipedia search.
* 'wiktionary' -- Wiktionary search.
* 'youtube' -- Youtube video search.
* 'zbmath' -- Open alternative to MathSciNet.
* 'vocabulary' -- Dictionary search
* 'duckduckgo' -- DuckDuckGo search engine.
* 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.
@ -322,7 +269,7 @@ searchEngine name site = searchEngineF name (\s -> site ++ escape s)
inside of a URL instead of in the end) you can use the alternative 'searchEngineF' function.
> searchFunc :: String -> String
> searchFunc s | "wiki:" `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ drop 1 $ snd $ break (==':') s)
> searchFunc s | "wiki:" `isPrefixOf` s = "https://en.wikipedia.org/wiki/" ++ (escape $ tail $ snd $ break (==':') s)
> | "https://" `isPrefixOf` s = s
> | otherwise = (use google) s
> myNewEngine = searchEngineF "mymulti" searchFunc
@ -339,57 +286,39 @@ searchEngineF :: Name -> Site -> SearchEngine
searchEngineF = SearchEngine
-- The engines.
alpha, amazon, arXiv, aur, clojureDocs, codesearch, cratesIo, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora,
github, google, hackage, homeManager, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, nixos, noogle, openstreetmap, protondb,
rosettacode, rustStd, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback,
wikipedia, wiktionary, youtube, zbmath :: SearchEngine
alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i="
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle,
images, imdb, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
youtube, duckduckgo :: SearchEngine
amazon = searchEngine "amazon" "https://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
arXiv = searchEngineF "arXiv" (\s -> "https://arxiv.org/search/?query=" <> s <> "&searchtype=all")
aur = searchEngine "aur" "https://aur.archlinux.org/packages?&K="
clojureDocs = searchEngine "clojureDocs" "https://clojuredocs.org/search?q="
alpha = searchEngine "alpha" "https://www.wolframalpha.com/input/?i="
codesearch = searchEngine "codesearch" "https://developers.google.com/s/results/code-search?q="
cratesIo = searchEngine "cratesIo" "https://crates.io/search?q="
deb = searchEngine "deb" "https://packages.debian.org/"
debbts = searchEngine "debbts" "https://bugs.debian.org/"
debpts = searchEngine "debpts" "https://packages.qa.debian.org/"
dictionary = searchEngine "dict" "https://dictionary.reference.com/browse/"
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
ebay = searchEngine "ebay" "https://www.ebay.com/sch/i.html?_nkw="
flora = searchEngine "flora" "https://flora.pm/search?q="
github = searchEngine "github" "https://github.com/search?q="
google = searchEngine "google" "https://www.google.com/search?q="
hackage = searchEngine "hackage" "https://hackage.haskell.org/package/"
homeManager = searchEngine "homeManager" "https://mipmip.github.io/home-manager-option-search/?query="
hoogle = searchEngine "hoogle" "https://hoogle.haskell.org/?hoogle="
images = searchEngine "images" "https://images.google.fr/images?q="
imdb = searchEngine "imdb" "https://www.imdb.com/find?s=all&q="
lucky = searchEngine "lucky" "https://www.google.com/search?btnI&q="
maps = searchEngine "maps" "https://maps.google.com/maps?q="
mathworld = searchEngine "mathworld" "https://mathworld.wolfram.com/search/?query="
ncatlab = searchEngine "ncatlab" "https://ncatlab.org/nlab/search?query="
nixos = searchEngine "nixos" "https://search.nixos.org/packages?channel=unstable&from=0&size=200&sort=relevance&type=packages&query="
noogle = searchEngineF "noogle" (\s -> "https://noogle.dev/?search=" <> s <> "&page=1&to=any&from=any")
openstreetmap = searchEngine "openstreetmap" "https://www.openstreetmap.org/search?query="
protondb = searchEngine "protondb" "https://www.protondb.com/search?q="
rosettacode = searchEngine "rosettacode" "https://rosettacode.org/w/index.php?search="
rustStd = searchEngine "rustStd" "https://doc.rust-lang.org/std/index.html?search="
scholar = searchEngine "scholar" "https://scholar.google.com/scholar?q="
sourcehut = searchEngine "sourcehut" "https://sr.ht/projects?search="
stackage = searchEngine "stackage" "https://www.stackage.org/lts/hoogle?q="
steam = searchEngine "steam" "https://store.steampowered.com/search/?term="
thesaurus = searchEngine "thesaurus" "https://thesaurus.com/browse/"
vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q="
voidpgks_x86_64 = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64&q="
voidpgks_x86_64_musl = searchEngine "voidpackages" "https://voidlinux.org/packages/?arch=x86_64-musl&q="
wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++)
wikipedia = searchEngine "wiki" "https://en.wikipedia.org/wiki/Special:Search?go=Go&search="
wiktionary = searchEngine "wikt" "https://en.wiktionary.org/wiki/Special:Search?go=Go&search="
youtube = searchEngine "youtube" "https://www.youtube.com/results?search_type=search_videos&search_query="
zbmath = searchEngine "zbmath" "https://zbmath.org/?q="
wayback = searchEngineF "wayback" ("https://web.archive.org/web/*/"++)
vocabulary = searchEngine "vocabulary" "https://www.vocabulary.com/search?q="
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
multi :: SearchEngine
multi = namedEngine "multi" $ foldr1 (!>) [alpha, amazon, aur, codesearch, deb, debbts, debpts, dictionary, duckduckgo, ebay, flora, github, hackage, hoogle, images, imdb, lucky, maps, mathworld, ncatlab, openstreetmap, protondb, rosettacode, scholar, sourcehut, stackage, steam, thesaurus, vocabulary, voidpgks_x86_64, voidpgks_x86_64_musl, wayback, wikipedia, wiktionary, youtube, prefixAware google]
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, ebay, github, google, hackage, hoogle, images, imdb, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, prefixAware google]
{- | This function wraps up a search engine and creates a new one, which works
like the argument, but goes directly to a URL if one is given rather than
@ -437,14 +366,14 @@ namedEngine name (SearchEngine _ site) = searchEngineF name site
browser. -}
promptSearchBrowser :: XPConfig -> Browser -> SearchEngine -> X ()
promptSearchBrowser config browser (SearchEngine name site) = do
hc <- historyCompletionP config ("Search [" `isPrefixOf`)
hc <- historyCompletionP ("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 config (searchName `isPrefixOf`)
hc <- historyCompletionP (searchName `isPrefixOf`)
mkXPrompt (Search name) config hc $ search browser site
where
searchName = showXPrompt (Search name)

10
XMonad/Actions/ShowText.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE MultiWayIf #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Actions.ShowText
@ -27,7 +26,7 @@ module XMonad.Actions.ShowText
import Data.Map (Map,empty,insert,lookup)
import Prelude hiding (lookup)
import XMonad
import XMonad.Prelude (All, fi, listToMaybe)
import XMonad.Prelude (All, fi, when)
import XMonad.StackSet (current,screen)
import XMonad.Util.Font (Align(AlignCenter)
, initXMF
@ -42,7 +41,7 @@ import XMonad.Util.XUtils (createNewWindow
import qualified XMonad.Util.ExtensibleState as ES
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.ShowText
--
@ -88,9 +87,8 @@ handleTimerEvent :: Event -> X All
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
(ShowText m) <- ES.get :: X ShowText
a <- io $ internAtom dis "XMONAD_TIMER" False
if | mtyp == a, Just dh <- listToMaybe d ->
whenJust (lookup (fromIntegral dh) m) deleteWindow
| otherwise -> pure ()
when (mtyp == a && not (null d))
(whenJust (lookup (fromIntegral $ head d) m) deleteWindow)
mempty
handleTimerEvent _ = mempty

2
XMonad/Actions/Sift.hs
View File

@ -28,7 +28,7 @@ import XMonad.StackSet (Stack (Stack), StackSet, modify')
import XMonad.Util.Stack (reverseS)
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Sift
--

4
XMonad/Actions/SimpleDate.hs
View File

@ -24,7 +24,7 @@ import XMonad.Core
import XMonad.Util.Run
-- $usage
-- To use, import this module into @xmonad.hs@:
-- To use, import this module into @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.SimpleDate
--
@ -35,7 +35,7 @@ import XMonad.Util.Run
-- In this example, a popup date menu will now be bound to @mod-d@.
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
date :: X ()
date = unsafeSpawn "(date; sleep 10) | dzen2"

6
XMonad/Actions/SinkAll.hs
View File

@ -13,7 +13,7 @@
-- 'sinkAll' function for backwards compatibility.
-----------------------------------------------------------------------------
module XMonad.Actions.SinkAll {-# DEPRECATED "Use XMonad.Actions.WithAll instead" #-} (
module XMonad.Actions.SinkAll (
-- * Usage
-- $usage
@ -23,7 +23,7 @@ import XMonad.Actions.WithAll (sinkAll)
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.SinkAll
--
@ -32,4 +32,4 @@ import XMonad.Actions.WithAll (sinkAll)
-- > , ((modm .|. shiftMask, xK_t), sinkAll)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".

4
XMonad/Actions/SpawnOn.hs
View File

@ -43,7 +43,7 @@ import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Util.Process (getPPIDChain)
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.SpawnOn
--
@ -63,7 +63,7 @@ import XMonad.Util.Process (getPPIDChain)
-- the spawned application(e.g. float or resize it).
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]}

49
XMonad/Actions/Submap.hs
View File

@ -18,7 +18,6 @@ module XMonad.Actions.Submap (
-- $usage
submap,
visualSubmap,
visualSubmapSorted,
submapDefault,
submapDefaultWithKey,
@ -33,7 +32,10 @@ import XMonad.Util.XUtils
{- $usage
First, import this module into your @xmonad.hs@:
First, import this module into your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.Submap
@ -54,7 +56,7 @@ because that is a special value passed to XGrabKey() and not an actual
modifier.
For detailed instructions on editing your key bindings, see
<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
"XMonad.Doc.Extending#Editing_key_bindings".
-}
@ -74,47 +76,30 @@ submap = submapDefault (return ())
-- >
-- > gotoLayout :: [(String, X ())] -- for use with EZConfig
-- > gotoLayout = -- assumes you have a layout named "Tall" and one named "Full".
-- > [("M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a)))
-- > [ (xK_t, "Tall", switchToLayout "Tall") -- "M-l t" switches to "Tall"
-- > , (xK_r, "Full", switchToLayout "Full") -- "M-l r" switches to "full"
-- > ])]
-- > ["M-l", visualSubmap def $ Map.fromList $ map (\(k, s, a) -> ((0, k), (s, a)))
-- > [ (xK_t, "Tall", switchToLayout "Tall") -- "M-l t" switches to "Tall"
-- > , (xK_r, "Full", switchToLayout "Full") -- "M-l r" switches to "full"
-- > ]]
--
-- One could alternatively also write @gotoLayout@ as
--
-- > gotoLayout = [("M-l", visualSubmap def $ Map.fromList $
-- > [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall")
-- > , ((0, xK_r), subName "Full" $ switchToLayout "Full")
-- > ])]
-- > gotoLayout = ["M-l", visualSubmap def $ Map.fromList $
-- > [ ((0, xK_t), subName "Tall" $ switchToLayout "Tall")
-- > , ((0, xK_r), subName "Full" $ switchToLayout "Full")
-- > ]]
visualSubmap :: WindowConfig -- ^ The config for the spawned window.
-> M.Map (KeyMask, KeySym) (String, X ())
-- ^ A map @keybinding -> (description, action)@.
-> X ()
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 =
visualSubmap wc keys =
withSimpleWindow wc descriptions waitForKeyPress >>= \(m', s) ->
maybe (pure ()) snd (M.lookup (m', s) keys)
where
descriptions :: [String]
descriptions =
map (\(key, desc) -> keyToString key <> ": " <> desc)
. sorted
$ zip (M.keys keys) (map fst (M.elems keys))
zipWith (\key desc -> keyToString key <> ": " <> desc)
(M.keys keys)
(map fst (M.elems keys))
-- | Give a name to an action.
subName :: String -> X () -> (String, X ())

7
XMonad/Actions/SwapPromote.hs
View File

@ -63,7 +63,6 @@ import qualified XMonad.Util.ExtensibleState as XS
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Arrow
import qualified Data.List.NonEmpty as NE
-- $usage
@ -100,7 +99,7 @@ import qualified Data.List.NonEmpty as NE
-- So far floating windows have been treated no differently than tiled windows
-- even though their positions are independent of the stack. Often, yanking
-- floating windows in and out of the workspace will obliterate the stack
-- history - particularly frustrating with "XMonad.Util.Scratchpad" since it is
-- history - particularly frustrating with 'XMonad.Util.Scratchpad' since it is
-- toggled so frequenty and always replaces the master window. That's why the
-- swap functions accept a boolean argument; when @True@ non-focused floating
-- windows will be ignored.
@ -241,8 +240,8 @@ swapApply ignoreFloats swapFunction = do
(r,s2) = stackSplit s1 fl' :: ([(Int,Window)],W.Stack Window)
(b,s3) = swapFunction pm s2
s4 = stackMerge s3 r
mh = let w = NE.head . notEmpty . W.integrate $ s3
in const $ w : delete w ch
mh = let w = head . W.integrate $ s3
in const $ w : delete w ch
in (b,Just s4,mh)
(x,y,z) = maybe (False,Nothing,id) swapApply' st
-- Any floating master windows will be added to the history when 'windows'

4
XMonad/Actions/SwapWorkspaces.hs
View File

@ -30,7 +30,7 @@ import XMonad.Util.WorkspaceCompare
-- $usage
-- Add this import to your @xmonad.hs@:
-- Add this import to your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.SwapWorkspaces
--
@ -44,7 +44,7 @@ import XMonad.Util.WorkspaceCompare
-- will swap workspaces 1 and 5.
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Swaps the currently focused workspace with the given workspace tag, via
-- @swapWorkspaces@.

9
XMonad/Actions/TagWindows.hs
View File

@ -39,7 +39,7 @@ econst = const . return
-- $usage
--
-- To use window tags, import this module into your @xmonad.hs@:
-- To use window tags, import this module into your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.TagWindows
-- > import XMonad.Prompt -- to use tagPrompt
@ -64,7 +64,7 @@ econst = const . return
-- the tags \"a\" and \"b\" but not \"a b\".
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | set multiple tags for a window at once (overriding any previous tags)
setTags :: [String] -> Window -> X ()
@ -134,6 +134,11 @@ focusTagged' :: (WindowSet -> [Window]) -> String -> X ()
focusTagged' wl t = gets windowset >>= findM (hasTag t) . wl >>=
maybe (return ()) (windows . focusWindow)
findM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
findM _ [] = return Nothing
findM p (x:xs) = do b <- p x
if b then return (Just x) else findM p xs
-- | apply a pure function to windows with a tag
withTaggedP, withTaggedGlobalP :: String -> (Window -> WindowSet -> WindowSet) -> X ()
withTaggedP t f = withTagged' t (winMap f)

2
XMonad/Actions/TiledWindowDragging.hs
View File

@ -27,7 +27,7 @@ import qualified XMonad.StackSet as W
import XMonad.Layout.DraggingVisualizer
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.TiledWindowDragging
-- > import XMonad.Layout.DraggingVisualizer

122
XMonad/Actions/ToggleFullFloat.hs
View File

@ -1,122 +0,0 @@
-- |
-- Module : XMonad.Actions.ToggleFullFloat
-- Description : Fullscreen (float) a window while remembering its original state.
-- Copyright : (c) 2022 Tomáš Janoušek <tomi@nomi.cz>
-- License : BSD3
-- Maintainer : Tomáš Janoušek <tomi@nomi.cz>
--
module XMonad.Actions.ToggleFullFloat (
-- * Usage
-- $usage
toggleFullFloatEwmhFullscreen,
toggleFullFloat,
fullFloat,
unFullFloat,
gcToggleFullFloat,
) where
import qualified Data.Map.Strict as M
import XMonad
import XMonad.Prelude
import XMonad.Hooks.EwmhDesktops (setEwmhFullscreenHooks)
import XMonad.Hooks.ManageHelpers
import qualified XMonad.StackSet as W
import qualified XMonad.Util.ExtensibleState as XS
-- ---------------------------------------------------------------------
-- $usage
--
-- The main use-case is to make 'ewmhFullscreen' (re)store the size and
-- position of floating windows instead of just unconditionally sinking them
-- into the floating layer. To enable this, you'll need this in your
-- @xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Actions.ToggleFullFloat
-- > import XMonad.Hooks.EwmhDesktops
-- >
-- > main = xmonad $ … . toggleFullFloatEwmhFullscreen . ewmhFullscreen . ewmh . … $ def{…}
--
-- Additionally, this "smart" fullscreening can be bound to a key and invoked
-- manually whenever one needs a larger window temporarily:
--
-- > , ((modMask .|. shiftMask, xK_t), withFocused toggleFullFloat)
newtype ToggleFullFloat = ToggleFullFloat{ fromToggleFullFloat :: M.Map Window (Maybe W.RationalRect) }
deriving (Show, Read)
instance ExtensionClass ToggleFullFloat where
extensionType = PersistentExtension
initialValue = ToggleFullFloat mempty
-- | Full-float a window, remembering its state (tiled/floating and
-- position/size).
fullFloat :: Window -> X ()
fullFloat = windows . appEndo <=< runQuery doFullFloatSave
-- | Restore window to its remembered state.
unFullFloat :: Window -> X ()
unFullFloat = windows . appEndo <=< runQuery doFullFloatRestore
-- | Full-float a window, if it's not already full-floating. Otherwise,
-- restore its original state.
toggleFullFloat :: Window -> X ()
toggleFullFloat w = ifM (isFullFloat w) (unFullFloat w) (fullFloat w)
isFullFloat :: Window -> X Bool
isFullFloat w = gets $ (Just fullRect ==) . M.lookup w . W.floating . windowset
where
fullRect = W.RationalRect 0 0 1 1
doFullFloatSave :: ManageHook
doFullFloatSave = do
w <- ask
liftX $ do
f <- gets $ M.lookup w . W.floating . windowset
-- @M.insertWith const@ = don't overwrite stored original state
XS.modify' $ ToggleFullFloat . M.insertWith const w f . fromToggleFullFloat
doFullFloat
doFullFloatRestore :: ManageHook
doFullFloatRestore = do
w <- ask
mf <- liftX $ do
mf <- XS.gets $ M.lookup w . fromToggleFullFloat
XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
pure mf
doF $ case mf of
Just (Just f) -> W.float w f -- was floating before
Just Nothing -> W.sink w -- was tiled before
Nothing -> W.sink w -- fallback when not found in ToggleFullFloat
-- | Install ToggleFullFloat garbage collection hooks.
--
-- Note: This is included in 'toggleFullFloatEwmhFullscreen', only needed if
-- using the 'toggleFullFloat' separately from the EWMH hook.
gcToggleFullFloat :: XConfig a -> XConfig a
gcToggleFullFloat c = c { startupHook = startupHook c <> gcToggleFullFloatStartupHook
, handleEventHook = handleEventHook c <> gcToggleFullFloatEventHook }
-- | ToggleFullFloat garbage collection: drop windows when they're destroyed.
gcToggleFullFloatEventHook :: Event -> X All
gcToggleFullFloatEventHook DestroyWindowEvent{ev_window = w} = do
XS.modify' $ ToggleFullFloat . M.delete w . fromToggleFullFloat
mempty
gcToggleFullFloatEventHook _ = mempty
-- | ToggleFullFloat garbage collection: restrict to existing windows at
-- startup.
gcToggleFullFloatStartupHook :: X ()
gcToggleFullFloatStartupHook = withWindowSet $ \ws ->
XS.modify' $ ToggleFullFloat . M.filterWithKey (\w _ -> w `W.member` ws) . fromToggleFullFloat
-- | Hook this module into 'XMonad.Hooks.EwmhDesktops.ewmhFullscreen'. This
-- makes windows restore their original state (size and position if floating)
-- instead of unconditionally sinking into the tiling layer.
--
-- ('gcToggleFullFloat' is included here.)
toggleFullFloatEwmhFullscreen :: XConfig a -> XConfig a
toggleFullFloatEwmhFullscreen =
setEwmhFullscreenHooks doFullFloatSave doFullFloatRestore .
gcToggleFullFloat

5
XMonad/Actions/TopicSpace.hs
View File

@ -103,12 +103,9 @@ import XMonad.Hooks.WorkspaceHistory
-- display your topics in an historical way using a custom `pprWindowSet'
-- function. You can also easily switch to recent topics using this history
-- of last focused topics.
--
-- A blog post highlighting some features of this module can be found
-- <https://tony-zorman.com/posts/topic-space/2022-09-11-topic-spaces.html here>.
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import qualified Data.Map.Strict as M
-- > import qualified XMonad.StackSet as W

169
XMonad/Actions/UpKeys.hs
View File

@ -1,169 +0,0 @@
{-# 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 ()

2
XMonad/Actions/UpdateFocus.hs
View File

@ -27,7 +27,7 @@ import qualified XMonad.StackSet as W
-- $usage
-- To make the focus update on mouse movement within an unfocused window, add the
-- following to your @xmonad.hs@:
-- following to your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.UpdateFocus
-- > xmonad $ def {

2
XMonad/Actions/UpdatePointer.hs
View File

@ -31,7 +31,7 @@ import XMonad.StackSet (member, peek, screenDetail, current)
import Control.Arrow ((&&&), (***))
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Actions.UpdatePointer

4
XMonad/Actions/Warp.hs
View File

@ -28,7 +28,7 @@ import XMonad
import XMonad.StackSet as W
{- $usage
You can use this module with the following in your @xmonad.hs@:
You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.Warp
@ -45,7 +45,7 @@ Note that warping to a particular screen may change the focus.
-}
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
data Corner = UpperLeft | UpperRight | LowerLeft | LowerRight

40
XMonad/Actions/WindowBringer.hs
View File

@ -22,7 +22,6 @@ 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
@ -34,11 +33,10 @@ import XMonad
import qualified XMonad as X
import XMonad.Util.Dmenu (menuMapArgs)
import XMonad.Util.NamedWindows (getName, getNameWMClass)
import XMonad.Actions.CopyWindow (copyWindow)
-- $usage
--
-- Import the module into your @xmonad.hs@:
-- Import the module into your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.WindowBringer
--
@ -46,10 +44,9 @@ import XMonad.Actions.CopyWindow (copyWindow)
--
-- > , ((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>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
data WindowBringerConfig = WindowBringerConfig
{ menuCommand :: String -- ^ The shell command that will handle window selection
@ -93,37 +90,6 @@ 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 ()
@ -193,7 +159,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 its workspace
-- return the executable name of the window along with it's workspace
-- ID.
decorateAppName :: X.WindowSpace -> Window -> X String
decorateAppName ws w = do

15
XMonad/Actions/WindowGo.hs
View File

@ -48,11 +48,9 @@ import XMonad.Operations (windows)
import XMonad.Prompt.Shell (getBrowser, getEditor)
import qualified XMonad.StackSet as W (peek, swapMaster, focusWindow, workspaces, StackSet, Workspace, integrate', tag, stack)
import XMonad.Util.Run (safeSpawnProg)
import qualified Data.List.NonEmpty as NE
{- $usage
Import the module into your @xmonad.hs@:
Import the module into your @~\/.xmonad\/xmonad.hs@:
> import XMonad.Actions.WindowGo
@ -68,8 +66,7 @@ appropriate one, or cover your bases by using instead something like:
> (className =? "Firefox" <||> className =? "Firefox-bin")
For detailed instructions on editing your key bindings, see
<https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-}
"XMonad.Doc.Extending#Editing_key_bindings". -}
-- | Get the list of workspaces sorted by their tag
workspacesSorted :: Ord i => W.StackSet i l a s sd -> [W.Workspace i l a]
@ -92,10 +89,7 @@ ifWindows qry f el = withWindowSet $ \wins -> do
-- | The same as ifWindows, but applies a ManageHook to the first match
-- instead and discards the other matches
ifWindow :: Query Bool -> ManageHook -> X () -> X ()
ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . NE.head . notEmpty)
-- ifWindows guarantees that the list given to the function is
-- non-empty. This should really use Data.List.NonEmpty, but, alas,
-- that would be a breaking change.
ifWindow qry mh = ifWindows qry (windows . appEndo <=< runQuery mh . head)
{- | 'action' is an executable to be run via 'safeSpawnProg' (of "XMonad.Util.Run") if the Window cannot be found.
Presumably this executable is the same one that you were looking for.
@ -170,8 +164,7 @@ raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
let (notEmpty -> _ :| (notEmpty -> y :| _)) = dropWhile (/=w) $ cycle ws
-- cannot fail to match
in windows $ focusFn y
_ -> windows . focusFn . NE.head . notEmpty $ ws
-- ws is non-empty by ifWindows's definition.
_ -> windows . focusFn . head $ ws
-- | Given a function which gets us a String, we try to raise a window with that classname,
-- or we then interpret that String as a executable name.

2
XMonad/Actions/WindowMenu.hs
View File

@ -34,7 +34,7 @@ import XMonad.Prelude (fi)
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.WindowMenu
--

361
XMonad/Actions/WindowNavigation.hs
View File

@ -1,12 +1,10 @@
{-# 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>,
-- Platon Pronko <platon7pronko@gmail.com>
-- Maintainer : Devin Mullins <me@twifkak.com>
-- License : BSD3-style (see LICENSE)
-- Stability : unstable
-- Portability : unportable
@ -39,19 +37,17 @@ module XMonad.Actions.WindowNavigation (
withWindowNavigationKeys,
WNAction(..),
go, swap,
goPure, swapPure,
Direction2D(..), WNState,
) where
import XMonad hiding (state)
import XMonad.Prelude (catMaybes, fromMaybe, sortOn)
import XMonad
import XMonad.Prelude (catMaybes, fromMaybe, listToMaybe, 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
@ -105,60 +101,27 @@ withWindowNavigation (u,l,d,r) conf@XConfig{modMask=modm} =
withWindowNavigationKeys :: [((KeyMask, KeySym), WNAction)] -> XConfig l -> IO (XConfig l)
withWindowNavigationKeys wnKeys conf = do
stateRef <- newIORef M.empty
return conf { keys = \cnf -> M.fromList (map (second (fromWNAction stateRef)) wnKeys)
posRef <- newIORef M.empty
return conf { keys = \cnf -> M.fromList (map (second (fromWNAction posRef)) wnKeys)
`M.union` keys conf cnf,
logHook = logHook conf >> trackMovement stateRef }
where fromWNAction stateRef (WNGo dir) = go stateRef dir
fromWNAction stateRef (WNSwap dir) = swap stateRef dir
logHook = logHook conf >> trackMovement posRef }
where fromWNAction posRef (WNGo dir) = go posRef dir
fromWNAction posRef (WNSwap dir) = swap posRef dir
data WNAction = WNGo Direction2D | WNSwap Direction2D
type WNState = Map WorkspaceId Point
-- | Focus window in the given direction.
-- go:
-- 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 stateRef dir = runPureAction stateRef (goPure dir)
go = withTargetWindow W.focusWindow
-- | 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 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
swap = withTargetWindow swapWithFocused
where swapWithFocused targetWin winSet =
case W.peek winSet of
Just currentWin -> W.focusWindow currentWin $
@ -172,249 +135,87 @@ swapPure = withTargetWindow swapWithFocused
| win == win2 = win1
| otherwise = win
-- | Select a target window in the given direction and modify the WindowSet.
-- 1. Get current position, verifying it matches the current window (exit if no focused window).
-- 2. Get the target window.
-- 3. Execute an action on the target window and windowset.
-- 4. Set the new position.
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)
withTargetWindow :: (Window -> WindowSet -> WindowSet) -> IORef WNState -> Direction2D -> X ()
withTargetWindow adj posRef dir = fromCurrentPoint posRef $ \win pos -> do
targets <- filter ((/= win) . fst) <$> navigableTargets pos dir
whenJust (listToMaybe targets) $ \(targetWin, targetRect) -> do
windows (adj targetWin)
setPosition posRef pos targetRect
-- | Update position on outside changes in windows.
trackMovement :: IORef WNState -> X ()
trackMovement stateRef = do
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
trackMovement posRef = fromCurrentPoint posRef $ \win pos ->
windowRect win >>= flip whenJust (setPosition posRef pos . snd)
-- | Get focused window and current position.
getCurrentWindow :: Monad x => WNInput x -> x (Maybe (Window, Rectangle, Point))
getCurrentWindow input@(_, oldWindowSet, _, _) =
whenJust' (pure $ W.peek oldWindowSet) Nothing $ \window -> do
(pos, rect) <- currentPosition input
return $ Just (window, rect, pos)
fromCurrentPoint :: IORef WNState -> (Window -> Point -> X ()) -> X ()
fromCurrentPoint posRef f = withFocused $ \win ->
currentPosition posRef >>= f win
-- | Gets the current position from the state passed in, or if nothing
-- (say, from a restart), derives the current position from the current window.
-- Also, verifies that the position is congruent with the current window
-- (say, if you moved focus using mouse or something).
-- Returns the window rectangle for convenience, since we'll need it later anyway.
currentPosition :: Monad x => WNInput x -> x (Point, Rectangle)
currentPosition (state, oldWindowSet, _, windowRect) = do
currentRect <- fromMaybe (Rectangle 0 0 0 0) <$> maybe (pure Nothing) windowRect (W.peek oldWindowSet)
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)
-- Gets the current position from the IORef passed in, or if nothing (say, from
-- a restart), derives the current position from the current window. Also,
-- verifies that the position is congruent with the current window (say, if you
-- used mod-j/k or mouse or something).
currentPosition :: IORef WNState -> X Point
currentPosition posRef = do
root <- asks theRoot
currentWindow <- gets (W.peek . windowset)
currentRect <- maybe (Rectangle 0 0 0 0) snd <$> windowRect (fromMaybe root currentWindow)
-- | Inserts new position into the state.
modifyState :: WindowSet -> Point -> WNState -> WNState
modifyState oldWindowSet =
M.insert (W.currentTag oldWindowSet)
wsid <- gets (W.currentTag . windowset)
mp <- M.lookup wsid <$> io (readIORef posRef)
-- | "Jumps" the current position into the middle of target rectangle.
-- (keeps the position as-is if it is already inside the target rectangle)
centerPosition :: Rectangle -> Point -> Point
centerPosition r@(Rectangle rx ry rw rh) pos@(Point x y) = do
if pointWithin x y r
then pos
else Point (midPoint rx rw) (midPoint ry rh)
return $ maybe (middleOf currentRect) (`inside` currentRect) mp
where middleOf (Rectangle x y w h) = Point (midPoint x w) (midPoint y h)
setPosition :: IORef WNState -> Point -> Rectangle -> X ()
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
midPoint :: Position -> Dimension -> Position
midPoint pos dim = pos + fromIntegral dim `div` 2
-- | Make a list of target windows we can navigate to,
-- 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
navigableTargets :: Point -> Direction2D -> X [(Window, Rectangle)]
navigableTargets point dir = navigable dir point <$> windowRects
pos = pointTransform dir currentPos
wr = rectTransform dir currentRect
-- Filters and sorts the windows in terms of what is closest from the Point in
-- the Direction2D.
navigable :: Direction2D -> Point -> [(Window, Rectangle)] -> [(Window, Rectangle)]
navigable d pt = sortby d . filter (inr d pt . snd)
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) &&
((rect_o1 r >= rect_o1 wr && rect_o1 r < rect_o2 wr && rect_o2 r > rect_o1 wr && rect_o2 r <= rect_o2 wr) ||
(rect_o1 r <= rect_o1 wr && rect_o2 r >= rect_o2 wr)) -- include windows that fully overlaps current on the orthogonal axis
sortByP2 = sortOn (rect_p2 . snd)
posBeforeEdge r = point_p pos < rect_p2 r
-- Produces a list of normal-state windows, on any screen. Rectangles are
-- adjusted based on screen position relative to the current screen, because I'm
-- bad like that.
windowRects :: X [(Window, Rectangle)]
windowRects = fmap catMaybes . mapM windowRect . S.toList =<< gets mapped
rectOverlapsEdge r = rect_p1 r <= rect_p2 wr && rect_p2 r > rect_p2 wr &&
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
windowRect :: Window -> X (Maybe (Window, Rectangle))
windowRect win = withDisplay $ \dpy -> do
(_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
return $ Just (win, Rectangle x y (w + 2 * bw) (h + 2 * bw))
`catchX` return Nothing
-- Maybe below functions can be replaced with some standard helper functions?
-- Modified from droundy's implementation of WindowNavigation:
-- | Execute a monadic action on the contents if Just, otherwise wrap default value and return it.
whenJust' :: Monad x => x (Maybe a) -> b -> (a -> x b) -> x b
whenJust' monadMaybeValue deflt f = do
maybeValue <- monadMaybeValue
case maybeValue of
Nothing -> return deflt
Just value -> f value
inr :: Direction2D -> Point -> Rectangle -> Bool
inr D (Point px py) (Rectangle rx ry w h) = px >= rx && px < rx + fromIntegral w &&
py < ry + fromIntegral h
inr U (Point px py) (Rectangle rx ry w _) = px >= rx && px < rx + fromIntegral w &&
py > ry
inr R (Point px py) (Rectangle rx ry w h) = px < rx + fromIntegral w &&
py >= ry && py < ry + fromIntegral h
inr L (Point px py) (Rectangle rx ry _ h) = px > rx &&
py >= ry && py < ry + fromIntegral h
-- | Filter a list of tuples on the second tuple member.
filterSnd :: (b -> Bool) -> [(a, b)] -> [(a, b)]
filterSnd f = filter (f . snd)
-- | Map a second tuple member in a list of tuples.
mapSnd :: (b -> b') -> [(a, b)] -> [(a, b')]
mapSnd f = map (second f)
sortby :: Direction2D -> [(a,Rectangle)] -> [(a,Rectangle)]
sortby D = sortOn (rect_y . snd)
sortby R = sortOn (rect_x . snd)
sortby U = reverse . sortby D
sortby L = reverse . sortby R

4
XMonad/Actions/WithAll.hs
View File

@ -24,7 +24,7 @@ import XMonad.StackSet
-- $usage
--
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.WithAll
--
@ -33,7 +33,7 @@ import XMonad.StackSet
-- , ((modm .|. shiftMask, xK_t), sinkAll)
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
-- | Un-float all floating windows on the current workspace.
sinkAll :: X ()

9
XMonad/Actions/Workscreen.hs
View File

@ -43,7 +43,7 @@ import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Actions.OnScreen
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Actions.Workscreen
-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
@ -58,7 +58,7 @@ import XMonad.Actions.OnScreen
-- > , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show)
@ -109,6 +109,5 @@ shiftWs a = drop 1 a ++ take 1 a
-- @WorkscreenId@.
shiftToWorkscreen :: WorkscreenId -> X ()
shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
case workspaces (a !! wscrId) of
[] -> pure ()
(w : _) -> windows $ W.shift w
let ws = head . workspaces $ a !! wscrId
windows $ W.shift ws

10
XMonad/Actions/WorkspaceCursors.hs
View File

@ -50,7 +50,7 @@ import XMonad.Layout.LayoutModifier(ModifiedLayout(..),
import XMonad(Message, WorkspaceId, X, XState(windowset),
fromMessage, sendMessage, windows, gets)
import XMonad.Util.Stack (reverseS)
import XMonad.Prelude
import XMonad.Prelude (find, fromJust, guard, liftA2, toList, when, (<=<))
-- $usage
--
@ -95,10 +95,10 @@ import XMonad.Prelude
-- | makeCursors requires a nonempty string, and each sublist must be nonempty
makeCursors :: [[String]] -> Cursors String
makeCursors [] = error "Workspace Cursors cannot be empty"
makeCursors (a : as) = concat . reverse <$> foldl addDim x xs
where x = end $ map return a
xs = map (map return) as
makeCursors [] = error "Workspace Cursors cannot be empty"
makeCursors a = concat . reverse <$> foldl addDim x xs
where x = end $ map return $ head a
xs = map (map return) $ tail a
-- this could probably be simplified, but this true:
-- toList . makeCursors == map (concat . reverse) . sequence . reverse . map (map (:[]))
-- the strange order is used because it makes the regular M-1..9

14
XMonad/Actions/WorkspaceNames.hs
View File

@ -51,14 +51,14 @@ import XMonad.Actions.CycleWS (findWorkspace, WSType(..), Direction1D(..), anyWS
import qualified XMonad.Actions.SwapWorkspaces as Swap
import XMonad.Hooks.StatusBar.PP (PP(..))
import XMonad.Hooks.EwmhDesktops (addEwmhWorkspaceRename)
import XMonad.Prompt (mkXPrompt, XPConfig, historyCompletionP)
import XMonad.Prompt (mkXPrompt, XPConfig)
import XMonad.Prompt.Workspace (Wor(Wor))
import XMonad.Util.WorkspaceCompare (getSortByIndex)
import qualified Data.Map as M
-- $usage
-- You can use this module with the following in your @xmonad.hs@ file:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
--
-- > import XMonad.Actions.WorkspaceNames
--
@ -88,7 +88,7 @@ import qualified Data.Map as M
-- > | (i, k) <- zip workspaces [xK_1 ..]]
--
-- For detailed instructions on editing your key bindings, see
-- <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
-- "XMonad.Doc.Extending#Editing_key_bindings".
@ -137,11 +137,9 @@ setCurrentWorkspaceName name = do
-- | Prompt for a new name for the current workspace and set it.
renameWorkspace :: XPConfig -> X ()
renameWorkspace conf = do
completion <- historyCompletionP conf (prompt ==)
mkXPrompt (Wor prompt) conf completion setCurrentWorkspaceName
where
prompt = "Workspace name: "
renameWorkspace conf =
mkXPrompt pr conf (const (return [])) setCurrentWorkspaceName
where pr = Wor "Workspace name: "
-- | See 'XMonad.Actions.SwapWorkspaces.swapTo'. This is the same with names.
swapTo :: Direction1D -> X ()

4
XMonad/Config/Arossato.hs
View File

@ -47,7 +47,7 @@ import XMonad.Util.Themes
-- $usage
-- The simplest way to use this configuration module is to use an
-- @xmonad.hs@ like this:
-- @~\/.xmonad\/xmonad.hs@ like this:
--
-- > module Main (main) where
-- >
@ -64,7 +64,7 @@ import XMonad.Util.Themes
--
-- You can use this module also as a starting point for writing your
-- own configuration module from scratch. Save it as your
-- @xmonad.hs@ and:
-- @~\/.xmonad\/xmonad.hs@ and:
--
-- 1. Change the module name from
--

2
XMonad/Config/Azerty.hs
View File

@ -27,7 +27,7 @@ import qualified XMonad.StackSet as W
import qualified Data.Map as M
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Azerty

2
XMonad/Config/Bepo.hs
View File

@ -26,7 +26,7 @@ import qualified XMonad.StackSet as W
import qualified Data.Map as M
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Bepo

14
XMonad/Config/Bluetile.hs
View File

@ -29,7 +29,7 @@ module XMonad.Config.Bluetile (
import XMonad
import XMonad.Layout.BorderResize
import XMonad.Layout.BoringWindows hiding (Replace)
import XMonad.Layout.BoringWindows
import XMonad.Layout.ButtonDecoration
import XMonad.Layout.Decoration
import XMonad.Layout.DecorationAddons
@ -37,7 +37,7 @@ import XMonad.Layout.DraggingVisualizer
import XMonad.Layout.Maximize
import XMonad.Layout.Minimize
import XMonad.Layout.MouseResizableTile
import XMonad.Layout.Renamed
import XMonad.Layout.Named
import XMonad.Layout.NoBorders
import XMonad.Layout.PositionStoreFloat
import XMonad.Layout.WindowSwitcherDecoration
@ -65,7 +65,7 @@ import System.Exit
import XMonad.Prelude(when)
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Bluetile
@ -183,10 +183,10 @@ bluetileManageHook = composeAll
, isFullscreen --> doFullFloat]
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $
renamed [Replace "Floating"] floating |||
renamed [Replace "Tiled1"] tiled1 |||
renamed [Replace "Tiled2"] tiled2 |||
renamed [Replace "Fullscreen"] fullscreen
named "Floating" floating |||
named "Tiled1" tiled1 |||
named "Tiled2" tiled2 |||
named "Fullscreen" fullscreen
where
floating = floatingDeco $ maximize $ borderResize positionStoreFloat
tiled1 = tilingDeco $ maximize mouseResizableTileMirrored

6
XMonad/Config/Desktop.hs
View File

@ -24,7 +24,7 @@ module XMonad.Config.Desktop (
-- specification. Extra xmonad settings unique to specific DE's are
-- added by overriding or modifying @desktopConfig@ fields in the
-- same way that the default configuration is customized in
-- @xmonad.hs@.
-- @~\/.xmonad/xmonad.hs@.
--
-- For more information about EWMH see:
--
@ -72,7 +72,7 @@ import qualified Data.Map as M
-- <http://haskell.org/haskellwiki/Xmonad>
--
-- To configure xmonad for use with a DE or with DE tools like panels
-- and pagers, in place of @def@ in your @xmonad.hs@,
-- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,
-- use @desktopConfig@ or one of the other desktop configs from the
-- @XMonad.Config@ namespace. The following setup and customization examples
-- work the same way for the other desktop configs as for @desktopConfig@.
@ -91,7 +91,7 @@ import qualified Data.Map as M
-- $customizing
-- To customize a desktop config, modify its fields as is illustrated with
-- the default configuration @def@ in <https://xmonad.org/TUTORIAL.html the tutorial>.
-- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".
-- $layouts
-- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.

2
XMonad/Config/Dmwit.hs
View File

@ -34,7 +34,7 @@ import XMonad.Layout.Grid
import XMonad.Layout.IndependentScreens hiding (withScreen)
import XMonad.Layout.Magnifier
import XMonad.Layout.NoBorders
import XMonad.Prelude hiding (fromList)
import XMonad.Prelude
import XMonad.Util.Dzen hiding (x, y)
import XMonad.Util.SpawnOnce
-- }}}

15
XMonad/Config/Droundy.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TupleSections #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
@ -21,7 +20,7 @@ import System.Exit ( exitSuccess )
import XMonad.Layout.Tabbed ( tabbed,
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
import XMonad.Layout.Combo ( combineTwo )
import XMonad.Layout.Renamed ( Rename(Replace), renamed )
import XMonad.Layout.Named ( named )
import XMonad.Layout.LayoutCombinators
import XMonad.Layout.Square ( Square(Square) )
import XMonad.Layout.WindowNavigation ( Navigate(Move,Swap,Go), Direction2D(U,D,R,L),
@ -115,9 +114,9 @@ keys x = M.fromList $
]
++
zip (map (modMask x,) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
zip (zip (repeat $ modMask x) [xK_F1..xK_F12]) (map (withNthWorkspace W.greedyView) [0..])
++
zip (map (modMask x .|. shiftMask,) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
config = docks $ ewmh def
{ borderWidth = 1 -- Width of the window border in pixels.
@ -125,10 +124,10 @@ config = docks $ ewmh def
, layoutHook = showWName $ workspaceDir "~" $
boringWindows $ smartBorders $ windowNavigation $
maximizeVertical $ toggleLayouts Full $ avoidStruts $
renamed [Replace "tabbed"] mytab |||
renamed [Replace "xclock"] (mytab ****//* combineTwo Square mytab mytab) |||
renamed [Replace "three"] (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
renamed [Replace "widescreen"] ((mytab *||* mytab)
named "tabbed" mytab |||
named "xclock" (mytab ****//* combineTwo Square mytab mytab) |||
named "three" (mytab **//* mytab *//* combineTwo Square mytab mytab) |||
named "widescreen" ((mytab *||* mytab)
****//* combineTwo Square mytab mytab) -- |||
--mosaic 0.25 0.5
, terminal = "xterm" -- The preferred terminal program.

2
XMonad/Config/Gnome.hs
View File

@ -32,7 +32,7 @@ import qualified Data.Map as M
import System.Environment (getEnvironment)
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Gnome

2
XMonad/Config/Kde.hs
View File

@ -28,7 +28,7 @@ import XMonad.Config.Desktop
import qualified Data.Map as M
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Kde

2
XMonad/Config/LXQt.hs
View File

@ -27,7 +27,7 @@ import XMonad.Config.Desktop
import qualified Data.Map as M
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.LXQt

19
XMonad/Config/Mate.hs
View File

@ -1,7 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
-- TODO: Remove when we depend on a version of xmonad that has unGrab.
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-dodgy-imports #-}
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.Config.Mate
@ -30,17 +28,18 @@ module XMonad.Config.Mate (
desktopLayoutModifiers
) where
import System.Environment (getEnvironment)
import XMonad
import XMonad.Config.Desktop
import XMonad.Util.Run (safeSpawn)
import XMonad.Util.Ungrab
import XMonad.Prelude (toUpper)
import qualified Data.Map as M
import XMonad hiding (unGrab)
import XMonad.Config.Desktop
import XMonad.Prelude (toUpper)
import XMonad.Util.Run (safeSpawn)
import XMonad.Util.Ungrab (unGrab)
import System.Environment (getEnvironment)
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Mate

5
XMonad/Config/Prime.hs
View File

@ -1,4 +1,3 @@
{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, UndecidableInstances #-}
-----------------------------------------------------------------------------
@ -127,7 +126,7 @@ import qualified XMonad as X (xmonad, XConfig(..))
import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)
-- $start_here
-- To start with, create a @xmonad.hs@ that looks like this:
-- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this:
--
-- > {-# LANGUAGE RebindableSyntax #-}
-- > import XMonad.Config.Prime
@ -389,7 +388,7 @@ instance RemovableClass MouseBindings [(ButtonMask, Button)] where
MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings
-- | Mouse button bindings to an 'X' actions on a window. Default: see @`man
-- xmonad`@. To make @mod-\<scrollwheel\>@ switch workspaces:
-- xmonad`@. To make mod-<scrollwheel> switch workspaces:
--
-- > import XMonad.Actions.CycleWS (nextWS, prevWS)
-- > ...

2
XMonad/Config/Xfce.hs
View File

@ -27,7 +27,7 @@ import XMonad.Config.Desktop
import qualified Data.Map as M
-- $usage
-- To use this module, start with the following @xmonad.hs@:
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad
-- > import XMonad.Config.Xfce

4
XMonad/Doc/Configuring.hs
View File

@ -14,9 +14,7 @@
-- <https://xmonad.org/TUTORIAL.html xmonad website>.
--
-- For more detailed instructions on extending xmonad with the
-- xmonad-contrib library, see
-- <https://xmonad.org/TUTORIAL.html the tutorial>
-- and "XMonad.Doc.Extending".
-- xmonad-contrib library, see "XMonad.Doc.Extending".
--
-----------------------------------------------------------------------------

6
XMonad/Doc/Developing.hs
View File

@ -86,7 +86,7 @@ customize the window manager to fit her needs.
Basically, xmonad and the xmonad-contrib libraries let users write
their own window manager in just a few lines of code. While
@xmonad.hs@ at first seems to be simply a configuration
@~\/.xmonad\/xmonad.hs@ at first seems to be simply a configuration
file, it is actually a complete Haskell program which uses the xmonad
and xmonad-contrib libraries to create a custom window manager.
@ -106,13 +106,13 @@ manager you are writing in any way you see fit.
xmonad installs a binary, @xmonad@, which must be executed by the
Xsession starting script. This binary, whose code can be read in
@Main.hs@ of the xmonad source tree, will use 'XMonad.Core.recompile'
to run @ghc@ in order to build a binary from @xmonad.hs@.
to run @ghc@ in order to build a binary from @~\/.xmonad\/xmonad.hs@.
If this compilation process fails, for any reason, a default @main@
entry point will be used, which calls the 'XMonad.Main.xmonad'
function with a default configuration.
Thus, the real @main@ entry point, the one that even the users' custom
window manager application in @xmonad.hs@ must call, is
window manager application in @~\/.xmonad\/xmonad.hs@ must call, is
the 'XMonad.Main.xmonad' function. This function takes a configuration
as its only argument, whose type ('XMonad.Core.XConfig')
is defined in "XMonad.Core".

208
XMonad/Doc/Extending.hs
View File

@ -71,15 +71,20 @@ module XMonad.Doc.Extending
-- *** Removing key bindings
-- $keyDel
-- *** Adding and removing key bindings
-- $keyAddDel
-- ** Editing mouse bindings
-- $mouse
-- ** Editing the layout hook #LayoutHook#
-- ** Editing the layout hook
-- $layoutHook
-- ** Editing the manage hook #ManageHook#
-- ** Editing the manage hook
-- $manageHook
-- ** The log hook and external status bars
-- $logHook
) where
--------------------------------------------------------------------------------
@ -103,8 +108,8 @@ For more information about any particular module, go to the root of
the documentation and just click on its name to view its Haddock
documentation; each module should come with extensive documentation.
If you find a module that could be better documented, or has incorrect
documentation, please
<https://github.com/xmonad/xmonad-contrib/issues report it as a bug>!
documentation, please report it as a bug
(<https://github.com/xmonad/xmonad-contrib/issues>)!
First and foremost, xmonad defines its own prelude for commonly used
functions, as well as re-exports from @base@.
@ -132,31 +137,33 @@ A list of the contrib modules can be found at
In the @XMonad.Actions@ namespace you can find modules exporting
various functions that are usually intended to be bound to key
combinations or mouse actions, in order to provide functionality
beyond the standard keybindings offered by xmonad.
beyond the standard keybindings provided by xmonad.
-}
{- $hooks
In the @XMonad.Hooks@ namespace you can find modules exporting
hooks—actions that xmonad performs when certain events occur.
The three most important hooks are:
hooks. Hooks are actions that xmonad performs when certain events
occur. The three most important hooks are:
* 'XMonad.Core.manageHook': this hook is called when a new window that
xmonad must take care of is created. This is a very powerful hook,
since it lets us examine the new window's properties and act
accordingly. For instance, we can configure xmonad to put windows
belonging to a given application in the float layer, not to manage
dock applications, or open them in a given workspace. See [Editing the
manage hook](#g:Editing_the_manage_hook) for more information on
customizing 'XMonad.Core.manageHook'.
dock applications, or open them in a given workspace. See
"XMonad.Doc.Extending#Editing_the_manage_hook" for more information
on customizing 'XMonad.Core.manageHook'.
* 'XMonad.Core.logHook': this hook is called when the stack of windows
managed by xmonad changes; for example, this is invoked at the end of
the 'XMonad.Operations.windows' function. A big application for this
is to display some information about xmonad in a status bar. The aptly
named "XMonad.Hooks.StatusBar" will produce a string (whose format can
be configured) to be written, for example, to an X11 property.
managed by xmonad has been changed; for example, this is invoked at
the end of the 'XMonad.Operations.windows' function. For instance
"XMonad.Hooks.DynamicLog" will produce a string (whose format can be
configured) to be printed to the standard output. This can be used
to display some information about the xmonad state in a status bar.
See "XMonad.Doc.Extending#The_log_hook_and_external_status_bars" for
more information.
* 'XMonad.Core.handleEventHook': this hook is called on all events handled
by xmonad, thus it is extremely powerful. See "Graphics.X11.Xlib.Extras"
@ -180,13 +187,13 @@ interface for writing layout modifiers is implemented in
"XMonad.Layout.LayoutModifier".
For more information on using those modules for customizing your
'XMonad.Core.layoutHook' see [Editing the layout hook](#g:LayoutHook).
'XMonad.Core.layoutHook' see "XMonad.Doc.Extending#Editing_the_layout_hook".
-}
{- $prompts
In the @XMonad.Prompt@ namespace you can find modules providing
In the @XMonad.Prompt@ name space you can find modules providing
graphical prompts for getting user input and using it to perform
various actions.
@ -199,7 +206,7 @@ prompts.
In the @XMonad.Util@ namespace you can find modules exporting various
utility functions that are used by the other modules of the
@xmonad-contrib@ library.
xmonad-contrib library.
There are also utilities for helping in configuring xmonad or using
external utilities.
@ -215,7 +222,7 @@ external utilities.
{- $extending
#Extending_xmonad#
Since the @xmonad.hs@ file is just another Haskell program, you may
Since the @xmonad.hs@ file is just another Haskell module, you may
import and use any Haskell code or libraries you wish, such as
extensions from the xmonad-contrib library, or other code you write
yourself.
@ -381,74 +388,83 @@ extend xmonad an scratch a particular itch!
{- $keyDel
#Removing_key_bindings#
As we've learned, XMonad stores keybindings inside of a
'Data.Map.Strict.Map', which means that removing keybindings requires
modifying it. This can be done with 'Data.Map.difference' or with
'Data.Map.Strict.delete'.
Removing key bindings requires modifying the 'Data.Map.Strict.Map' which
stores the key bindings. This can be done with 'Data.Map.difference' or
with 'Data.Map.Strict.delete'.
For example, suppose you want to entirely rid yourself of @"M-q"@ and
@"M-s-q"@ (you just want to leave xmonad running forever). To do this
with bare @xmonad@, you need to define @newKeys@ as a
'Data.Map.Strict.difference' between the default map and the map of the
key bindings you want to remove. Like so:
For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
(you just want to leave xmonad running forever). To do this you need to
define @newKeys@ as a 'Data.Map.Strict.difference' between the default
map and the map of the key bindings you want to remove. Like so:
> newKeys :: XConfig l -> Map (KeyMask, KeySym) (X ())
> newKeys x = keys def x `M.difference` keysToRemove x
> newKeys x = keys def x `M.difference` keysToRemove x
>
> keysToRemove :: XConfig l -> Map (KeyMask, KeySym) (X ())
> keysToRemove x = M.fromList
> [ ((modm , xK_q ), return ())
> , ((modm .|. shiftMask, xK_q ), return ())
> ]
> keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
> keysToRemove x = M.fromList
> [ ((modm , xK_q ), return ())
> , ((modm .|. shiftMask, xK_q ), return ())
> ]
As you can see, it doesn't matter what actions we associate with the
keys listed in @keysToRemove@, so we just use @return ()@ (the \"null\"
action). Since @newKeys@ contains all of the default keys, you can
simply pass it to 'XMonad.Core.XConfig' as your map of keybindings:
keys listed in @keysToRemove@, so we just use @return ()@ (the
\"null\" action).
> main :: IO ()
> main = xmonad $ def { keys = newKeys }
It is also possible to simply define a list of keys we want to unbind
and then use 'Data.Map.Strict.delete' to remove them. In that case we
would write something like:
However, having to manually type @return ()@ every time seems like a
drag, doesn't it? And this approach isn't at all compatible with adding
custom keybindings via 'XMonad.Util.EZConfig.additionalKeysP'! Well,
good thing "XMonad.Util.EZConfig" also sports
'XMonad.Util.EZConfig.removeKeysP'. You can use it as you would expect.
> newKeys x = foldr M.delete (keys def x) (keysToRemove x)
>
> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]
> keysToRemove x =
> [ (modm , xK_q )
> , (modm .|. shiftMask, xK_q )
> ]
> main :: IO ()
> main = xmonad $ def
> { … }
> `removeKeysP` ["M-q", "M-S-q"]
Another even simpler possibility is the use of some of the utilities
provided by the xmonad-contrib library. Look, for instance, at
'XMonad.Util.EZConfig.removeKeys'.
Can you guess how 'XMonad.Util.EZConfig.removeKeysP' works? It's almost
the same code we wrote above, just accepting a list of keybindings. Try
to see if you can come up with an implementation of
-}
> removeKeysP :: XConfig l -> [String] -> XConfig l
{- $keyAddDel
#Adding_and_removing_key_bindings#
If you're done, just click on @# Source@ when viewing the
'XMonad.Util.EZConfig.removeKeysP' documentation (did you know that
Haddock lets you do that for every function?) and compare.
Adding and removing key bindings requires simply combining the steps
for removing and adding. Here is an example from
"XMonad.Config.Arossato":
By the way, one can conveniently combine
'XMonad.Util.EZConfig.additionalKeysP' and
'XMonad.Util.EZConfig.removeKeysP' by just intuitively chaining them:
> defKeys = keys def
> delKeys x = foldr M.delete (defKeys x) (toRemove x)
> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x)
> -- remove some of the default key bindings
> toRemove XConfig{modMask = modm} =
> [ (modm , xK_j )
> , (modm , xK_k )
> , (modm , xK_p )
> , (modm .|. shiftMask, xK_p )
> , (modm .|. shiftMask, xK_q )
> , (modm , xK_q )
> ] ++
> -- I want modm .|. shiftMask 1-9 to be free!
> [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]]
> -- These are my personal key bindings
> toAdd XConfig{modMask = modm} =
> [ ((modm , xK_F12 ), xmonadPrompt def )
> , ((modm , xK_F3 ), shellPrompt def )
> ] ++
> -- Use modm .|. shiftMask .|. controlMask 1-9 instead
> [( (m .|. modm, k), windows $ f i)
> | (i, k) <- zip (workspaces x) [xK_1 .. xK_9]
> , (f, m) <- [(W.greedyView, 0), (W.shift, shiftMask .|. controlMask)]
> ]
> main :: IO ()
> main = xmonad $ def
> { … }
> `additionalKeysP myKeys
> `removeKeysP` ["M-q", "M-S-q"]
If you don't use the @P@ alternatives of EZConfig, there is also an
aptly named 'XMonad.Util.EZConfig.removeKeys'. Again, can you try to
come up with an implementation yourself that has the correct signature?
> removeKeys :: XConfig a -> [(KeyMask, KeySym)] -> XConfig a
In addition to 'Data.Map.Strict.delete', you will probably need to use
'foldr'.
You can achieve the same result using the "XMonad.Util.CustomKeys"
module; take a look at the 'XMonad.Util.CustomKeys.customKeys'
function in particular.
NOTE: modm is defined as the modMask you defined (or left as the default) in
your config.
-}
{- $mouse
@ -490,7 +506,8 @@ xmonad will use for laying out windows on the screen(s).
The problem is that the layout subsystem is implemented with an
advanced feature of the Haskell programming language: type classes.
This allows us to very easily write new layouts, combine or modify
existing layouts, create layouts with internal state, etc. This
existing layouts, create layouts with internal state, etc. See
"XMonad.Doc.Extending#The_LayoutClass" for more information. This
means that we cannot simply have a list of layouts: a list requires
every member to belong to the same type!
@ -500,7 +517,7 @@ with a specific layout combinator: 'XMonad.Layout.|||'.
Suppose we want a list with the 'XMonad.Layout.Full',
'XMonad.Layout.Tabbed.tabbed' and
'XMonad.Layout.Accordion.Accordion' layouts. First we import, in our
@xmonad.hs@, all the needed modules:
@~\/.xmonad\/xmonad.hs@, all the needed modules:
> import XMonad
>
@ -529,7 +546,7 @@ If we want only the tabbed layout without borders, then we may write:
> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion
Our @xmonad.hs@ will now look like this:
Our @~\/.xmonad\/xmonad.hs@ will now look like this:
> import XMonad
>
@ -694,3 +711,42 @@ For additional rules and actions you can use in your manageHook, check
out the contrib module "XMonad.Hooks.ManageHelpers".
-}
{- $logHook
#The_log_hook_and_external_status_bars#
When the stack of the windows managed by xmonad changes for any
reason, xmonad will call 'XMonad.Core.logHook', which can be used to
output some information about the internal state of xmonad, such as the
layout that is presently in use, the workspace we are in, the focused
window's title, and so on.
Extracting information about the internal xmonad state can be somewhat
difficult if you are not familiar with the source code. Therefore,
it's usually easiest to use a module that has been designed
specifically for logging some of the most interesting information
about the internal state of xmonad: "XMonad.Hooks.DynamicLog". This
module can be used with an external status bar to print the produced
logs in a convenient way; the most commonly used status bars are dzen
and xmobar. The module "XMonad.Hooks.StatusBar" offers another interface
to interact with status bars, that might be more convenient to use.
By default the 'XMonad.Core.logHook' doesn't produce anything. To
enable it you need first to import "XMonad.Hooks.DynamicLog":
> import XMonad.Hooks.DynamicLog
Then you just need to update the 'XMonad.Core.logHook' field of the
'XMonad.Core.XConfig' record with one of the provided functions. For
example:
> main = xmonad def { logHook = dynamicLog }
More interesting configurations are also possible; see the
"XMonad.Hooks.DynamicLog" module for more possibilities.
You may now enjoy your extended xmonad experience.
Have fun!
-}

15
XMonad/Hooks/CurrentWorkspaceOnTop.hs
View File

@ -22,15 +22,14 @@ module XMonad.Hooks.CurrentWorkspaceOnTop (
currentWorkspaceOnTop
) where
import qualified Data.List.NonEmpty as NE (nonEmpty)
import qualified Data.Map as M
import XMonad
import XMonad.Prelude (NonEmpty ((:|)), when)
import qualified XMonad.StackSet as S
import qualified XMonad.Util.ExtensibleState as XS
import XMonad.Prelude (unless, when)
import qualified Data.Map as M
-- $usage
-- You can use this module with the following in your @xmonad.hs@:
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Hooks.CurrentWorkspaceOnTop
-- >
@ -64,9 +63,7 @@ currentWorkspaceOnTop = withDisplay $ \d -> do
wins = fltWins ++ map fst rs -- order: first all floating windows, then the order the layout returned
-- end of reimplementation
case NE.nonEmpty wins of
Nothing -> pure ()
Just (w :| ws') -> do
io $ raiseWindow d w -- raise first window of current workspace to the very top,
io $ restackWindows d (w : ws') -- then use restackWindows to let all other windows from the workspace follow
unless (null wins) $ do
io $ raiseWindow d (head wins) -- raise first window of current workspace to the very top,
io $ restackWindows d wins -- then use restackWindows to let all other windows from the workspace follow
XS.put(CWOTS curTag)

295
XMonad/Hooks/DebugEvents.hs
View File

@ -33,16 +33,16 @@ 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
import Foreign hiding (void)
import Foreign
import Foreign.C.Types
import Numeric (showHex)
import System.Exit
import System.IO
import System.Process
import GHC.Stack (HasCallStack, prettyCallStack, callStack)
-- | Event hook to dump all received events. You should probably not use this
-- unconditionally; it will produce massive amounts of output.
@ -203,7 +203,7 @@ windowEvent l w = debugWindow w >>= say l
-- | Helper to emit tagged event information.
say :: String -> String -> X ()
say l s = XMonad.trace $ l ++ ' ':s
say l s = trace $ l ++ ' ':s
-- | Deconstuct a list of 'CInt's into raw bytes
splitCInt :: [CInt] -> IO Raw
@ -240,7 +240,7 @@ data DecodeState = DecS {value :: Raw -- unconsumed raw property value
}
newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)
#ifndef __HADDOCK__
deriving (Functor
,Applicative
,Monad
@ -249,12 +249,12 @@ newtype Decoder a = Decoder (ReaderT Decode (StateT DecodeState X) a)
,MonadState DecodeState
,MonadReader Decode
)
#endif
-- | Retrive, parse, and dump a window property. As all the high-level property
-- interfaces lose information necessary to decode properties correctly, we
-- work at the lowest level available.
dumpProperty :: HasCallStack => Atom -> String -> Window -> Int -> X String
dumpProperty :: Atom -> String -> Window -> Int -> X String
dumpProperty a n w i = do
prop <- withDisplay $ \d ->
io $
@ -279,7 +279,7 @@ dumpProperty a n w i = do
case rc of
0 -> do
fmt <- fromIntegral <$> peek fmtp
vs' <- peek vsp
vs' <- peek vsp
sz <- fromIntegral <$> peek szp
case () of
() | fmt == none -> xFree vs' >> return (Left "(property deleted)" )
@ -303,8 +303,7 @@ dumpProperty a n w i = do
-- @@@ am I better off passing in the Decode and DecodeState?
-- | Parse and dump a property (or a 'ClientMessage').
dumpProperty' :: HasCallStack
=> Window -- source window
dumpProperty' :: Window -- source window
-> Atom -- property id
-> String -- property name
-> Atom -- property type
@ -335,11 +334,11 @@ dumpProperty' w a n fmt sz vs ack i = do
(_,ds') <- runDecode dec ds $ dumpProp a n
let fin = length (value ds')
len = length vs
lost = if ack == 0 then "" else " and " ++ show ack ++ " lost bytes"
lost = if ack == 0 then "" else "and " ++ show ack ++ " lost bytes"
unk = case () of
() | fin == len -> "undecodeable "
| fin == 0 -> "."
| otherwise -> " and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"
| otherwise -> "and remainder (" ++ show (len - fin) ++ '/':show len ++ ")"
(_,ds'') <- if fin == 0
then return (True,ds')
else runDecode dec' (withJoint' unk ds' ) $ dumpArray dump8
@ -350,7 +349,7 @@ dumpProperty' w a n fmt sz vs ack i = do
-- | A simplified version of 'dumpProperty\'', to format random values from
-- events.
quickFormat :: (HasCallStack, Storable i, Integral i) => [i] -> Decoder Bool -> X String
quickFormat :: (Storable i, Integral i) => [i] -> Decoder Bool -> X String
quickFormat v f = do
let vl = length v
vs <- io $
@ -383,7 +382,7 @@ bytes w = w `div` 8
-- | The top level property decoder, for a wide variety of standard ICCCM and
-- EWMH window properties. We pass part of the 'ReaderT' as arguments for
-- pattern matching.
dumpProp :: HasCallStack => Atom -> String -> Decoder Bool
dumpProp :: Atom -> String -> Decoder Bool
dumpProp _ "CLIPBOARD" = dumpSelection
dumpProp _ "_NET_SUPPORTED" = dumpArray dumpAtom
@ -427,13 +426,10 @@ dumpProp _ "_NET_WM_NAME" = dumpUTF
dumpProp _ "_NET_WM_VISIBLE_NAME" = dumpUTF
dumpProp _ "_NET_WM_ICON_NAME" = dumpUTF
dumpProp _ "_NET_WM_VISIBLE_ICON_NAME" = dumpUTF
-- @@@ the property is CARDINAL; the message is _NET_WM_DESKTOP of 5 dump32s
-- [desktop/all, source indication, 3 zeroes]
-- dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")]
-- dump32
dumpProp _ "_NET_WM_DESKTOP" = dumpSetDesktop
dumpProp _ "_NET_WM_DESKTOP" = dumpExcept [(0xFFFFFFFF,"all")]
dump32
dumpProp _ "_NET_WM_WINDOW_TYPE" = dumpArray dumpAtom
dumpProp _ "_NET_WM_STATE" = dumpNWState
dumpProp _ "_NET_WM_STATE" = dumpArray dumpAtom
dumpProp _ "_NET_WM_ALLOWED_ACTIONS" = dumpArray dumpAtom
dumpProp _ "_NET_WM_STRUT" = dumpList [("left gap" ,dump32)
,("right gap" ,dump32)
@ -471,12 +467,6 @@ dumpProp _ "_NET_FRAME_EXTENTS" = dumpList [("left" ,dum
]
dumpProp _ "_NET_WM_SYNC_REQUEST_COUNTER" = dumpExcept [(0,"illegal value 0")]
dump64
dumpProp _ "_NET_WM_OPAQUE_REGION" = dumpArray $ dumpList [("x",dump32)
,("y",dump32)
,("w",dump32)
,("h",dump32)
]
dumpProp _ "_NET_WM_BYPASS_COMPOSITOR" = dumpEnum cpState
dumpProp _ "_NET_STARTUP_ID" = dumpUTF
dumpProp _ "WM_PROTOCOLS" = dumpArray dumpAtom
dumpProp _ "WM_COLORMAP_WINDOWS" = dumpArray dumpWindow
@ -531,8 +521,8 @@ dumpProp a _ | a == wM_NAME = dumpString
]
)
]
| a == wM_NORMAL_HINTS = dumpSizeHints
| a == wM_ZOOM_HINTS = dumpSizeHints
| a == wM_NORMAL_HINTS = (...)
| a == wM_ZOOM_HINTS = (...) -- same as previous
| a == rGB_DEFAULT_MAP = (...) -- XStandardColormap
| a == rGB_BEST_MAP = (...) -- "
| a == rGB_RED_MAP = (...) -- "
@ -577,12 +567,12 @@ withIndent :: Int -> Decoder a -> Decoder a
withIndent w = local (\r -> r {indent = indent r + w})
-- dump an array of items. this dumps the entire property
dumpArray :: HasCallStack => Decoder Bool -> Decoder Bool
dumpArray :: Decoder Bool -> Decoder Bool
dumpArray item = do
withIndent 1 $ append "[" >> withJoint "" (dumpArray' item "")
-- step through values as an array, ending on parse error or end of list
dumpArray' :: HasCallStack => Decoder Bool -> String -> Decoder Bool
dumpArray' :: Decoder Bool -> String -> Decoder Bool
dumpArray' item pfx = do
vs <- gets value
if null vs
@ -592,12 +582,12 @@ dumpArray' item pfx = do
-- keep parsing until a parse step fails
-- @@@ which points out that all my uses of @whenX (return ...)@ are actually 'when',
-- which suggests that 'whenX' is *also* the same function... yep. ISAGN
whenD :: (HasCallStack, Monad m) => m Bool -> m Bool -> m Bool
whenD :: Monad m => m Bool -> m Bool -> m Bool
whenD p f = p >>= \b -> if b then f else return False
-- verify a decoder parameter, else call error reporter
-- once again, it's more general than I originally wrote
guardR :: (HasCallStack, MonadReader r m, Eq v)
guardR :: (MonadReader r m, Eq v)
=> (r -> v) -- value selector
-> v -- expected value
-> (v -> v -> m a) -- error reporter
@ -608,47 +598,43 @@ guardR sel val err good = do
if v == val then good else err v val
-- this is kinda dumb
fi :: HasCallStack => Bool -> a -> a -> a
fi :: Bool -> a -> a -> a
fi p n y = if p then y else n -- flip (if' p), if that existed
-- verify we have the expected word size
guardSize :: HasCallStack => Int -> Decoder Bool -> Decoder Bool
guardSize :: Int -> Decoder Bool -> Decoder Bool
-- see XSync documentation for this insanity
guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 (propShortErr' 1)
guardSize w = guardR width w propSizeErr . guardSize' (bytes w) (propShortErr' 2)
guardSize 64 = guardR width 32 propSizeErr . guardSize' 8 propShortErr
guardSize w = guardR width w propSizeErr . guardSize' (bytes w) propShortErr
guardSize' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a
guardSize' l n y = gets value >>= \vs -> fi (length vs >= bytes l) n y
-- @guardSize@ doesn't work with empty arrays
guardSize'' :: HasCallStack => Int -> Decoder a -> Decoder a -> Decoder a
guardSize'' l n y = gets value >>= \vs -> fi (null vs || length vs >= bytes l) n y
guardSize' :: Int -> Decoder a -> Decoder a -> Decoder a
guardSize' l n y = gets value >>= \vs -> fi (length vs >= l) n y
-- verify we have the expected property type
guardType :: HasCallStack => Atom -> Decoder Bool -> Decoder Bool
guardType :: Atom -> Decoder Bool -> Decoder Bool
guardType t = guardR pType t propTypeErr
-- dump a structure as a named tuple
dumpList :: HasCallStack => [(String,Decoder Bool)] -> Decoder Bool
dumpList :: [(String,Decoder Bool)] -> Decoder Bool
dumpList proto = do
a <- asks pType
dumpList'' (maxBound :: CULong) (map (\(s,d) -> (s,d,a)) proto) "("
-- same but elements have their own distinct types
dumpList' :: HasCallStack => [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpList' :: [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpList' proto = dumpList'' (maxBound :: CULong) proto "("
-- same but only dump elements identified by provided mask
dumpListByMask :: HasCallStack => CULong -> [(String,Decoder Bool)] -> Decoder Bool
dumpListByMask :: CULong -> [(String,Decoder Bool)] -> Decoder Bool
dumpListByMask m p = do
a <- asks pType
dumpList'' m (map (\(s,d) -> (s,d,a)) p) "("
-- and the previous two combined
dumpListByMask' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpListByMask' :: CULong -> [(String,Decoder Bool,Atom)] -> Decoder Bool
dumpListByMask' m p = dumpList'' m p "("
dumpList'' :: HasCallStack => CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
dumpList'' :: CULong -> [(String,Decoder Bool,Atom)] -> String -> Decoder Bool
dumpList'' _ [] _ = append ")" >> return True
dumpList'' 0 _ _ = append ")" >> return True
dumpList'' m ((l,p,t):ps) sep = do
@ -673,20 +659,22 @@ dumpList'' m ((l,p,t):ps) sep = do
-- do the getTextProperty dance, the hard way.
-- @@@ @COMPOUND_TEXT@ not supported yet.
dumpString :: HasCallStack => Decoder Bool
dumpString :: Decoder Bool
dumpString = do
fmt <- asks pType
[cOMPOUND_TEXT,uTF8_STRING] <- inX $ mapM getAtom ["COMPOUND_TEXT","UTF8_STRING"]
case () of
() | fmt == cOMPOUND_TEXT -> guardSize'' 16 (propShortErr' 3) ( ... )
| fmt == sTRING -> guardSize'' 8 (propShortErr' 4) $ do
() | fmt == cOMPOUND_TEXT -> guardSize 16 (...)
| fmt == sTRING -> guardSize 8 $ do
vs <- gets value
modify (\r -> r {value = []})
let ss = flip unfoldr (map twiddle vs) $
\s -> if null s
then Nothing
else let (w,s'') = break (== '\NUL') s
s' = drop 1 s''
s' = if null s''
then s''
else tail s''
in Just (w,s')
case ss of
[s] -> append $ show s
@ -700,7 +688,7 @@ dumpString = do
failure . ("unrecognized string type " ++)
-- show who owns a selection
dumpSelection :: HasCallStack => Decoder Bool
dumpSelection :: Decoder Bool
dumpSelection = do
-- system selections contain a window ID; others are random
-- note that the window ID will be the same as the owner, so
@ -714,14 +702,14 @@ dumpSelection = do
append $ "owned by " ++ w
-- for now, not querying Xkb
dumpXKlInds :: HasCallStack => Decoder Bool
dumpXKlInds :: Decoder Bool
dumpXKlInds = guardType iNTEGER $ do
n <- fmap fromIntegral <$> getInt' 32
case n of
Nothing -> propShortErr' 5
Nothing -> propShortErr
Just is -> append $ "indicators " ++ unwords (dumpInds is 1 1 [])
where
dumpInds :: HasCallStack => Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds :: Word32 -> Word32 -> Int -> [String] -> [String]
dumpInds n bt c bs | n == 0 && c == 1 = ["none"]
| n == 0 = bs
| n .&. bt /= 0 = dumpInds (n .&. complement bt)
@ -734,20 +722,9 @@ dumpXKlInds = guardType iNTEGER $ do
bs
-- decode an Atom
dumpAtom :: HasCallStack => Decoder Bool
dumpAtom = dumpAtom'' aTOM
{-
dumpAtom' :: HasCallStack => String -> Decoder Bool
dumpAtom' t' = do
t <- inX $ getAtom t'
dumpAtom'' t
-}
dumpAtom'' :: HasCallStack => Atom -> Decoder Bool
dumpAtom'' t =
guardType t $ do
dumpAtom :: Decoder Bool
dumpAtom =
guardType aTOM $ do
a <- getInt' 32
case a of
Nothing -> return False
@ -755,16 +732,15 @@ dumpAtom'' t =
an <- inX $ atomName $ fromIntegral a'
append an
dumpWindow :: HasCallStack => Decoder Bool
dumpWindow :: Decoder Bool
dumpWindow = guardSize 32 $ guardType wINDOW $ do
w <- getInt' 32
case w of
Nothing -> return False
Just 0 -> append "none"
Just w' -> inX (debugWindow (fromIntegral w')) >>= append
-- a bit of a hack; as a Property it's a wINDOW, as a ClientMessage it's a list
dumpActiveWindow :: HasCallStack => Decoder Bool
dumpActiveWindow :: Decoder Bool
dumpActiveWindow = guardSize 32 $ do
t <- asks pType
nAW <- inX $ getAtom "_NET_ACTIVE_WINDOW"
@ -778,87 +754,49 @@ dumpActiveWindow = guardSize 32 $ do
t' <- inX $ atomName t
failure $ concat ["(bad type "
,t'
,"; expected WINDOW or _NET_ACTIVE_WINDOW)"
,"; expected WINDOW or _NET_ACTIVE_WINDOW"
]
-- likewise but for _NET_WM_DESKTOP
dumpSetDesktop :: HasCallStack => Decoder Bool
dumpSetDesktop = guardSize 32 $ do
t <- asks pType
nWD <- inX $ getAtom "_NET_WM_DESKTOP"
case () of
() | t == cARDINAL -> dumpExcept [(0xFFFFFFFF,"all")]
dump32
| t == nWD -> dumpList' [("desktop",dumpExcept [(0xFFFFFFFF,"all")]
dump32 ,cARDINAL)
,("source" ,dumpEnum awSource ,cARDINAL)
]
_ -> do
t' <- inX $ atomName t
failure $ concat ["(bad type "
,t'
,"; expected CARDINAL or _NET_WM_DESKTOP)"
]
-- and again for _NET_WM_STATE
dumpNWState :: HasCallStack => Decoder Bool
dumpNWState = guardSize'' 32 propShortErr $ do
t <- asks pType
nWS <- inX $ getAtom "_NET_WM_STATE"
case () of
() | t == aTOM -> dumpArray dumpAtom
| t == nWS -> dumpList' [("action",dumpEnum nwAction,cARDINAL)
,("atom1" ,dumpAtom ,aTOM)
,("atom2" ,dumpAtom ,aTOM)
]
_ -> do
t' <- inX $ atomName t
failure $ concat ["(bad type "
,t'
,"; expected ATOM or _NET_WM_STATE)"
]
-- dump a generic CARDINAL value
dumpInt :: HasCallStack => Int -> Decoder Bool
dumpInt :: Int -> Decoder Bool
dumpInt w = guardSize w $ guardType cARDINAL $ getInt w show
-- INTEGER is the signed version of CARDINAL
dumpInteger :: HasCallStack => Int -> Decoder Bool
dumpInteger :: Int -> Decoder Bool
dumpInteger w = guardSize w $ guardType iNTEGER $ getInt w (show . signed w)
-- reinterpret an unsigned as a signed
signed :: HasCallStack => Int -> Integer -> Integer
signed :: Int -> Integer -> Integer
signed w i = bit (w + 1) - i
-- and wrappers to keep the parse list in bounds
dump64 :: HasCallStack => Decoder Bool
dump64 :: Decoder Bool
dump64 = dumpInt 64
dump32 :: HasCallStack => Decoder Bool
dump32 :: Decoder Bool
dump32 = dumpInt 32
{- not used in standard properties
dump16 :: HasCallStack => Decoder Bool
dump16 :: Decoder Bool
dump16 = dumpInt 16
-}
dump8 :: HasCallStack => Decoder Bool
dump8 :: Decoder Bool
dump8 = dumpInt 8
-- I am assuming for the moment that this is a single string.
-- This might be false; consider the way the STRING properties
-- handle lists.
dumpUTF :: HasCallStack => Decoder Bool
dumpUTF :: Decoder Bool
dumpUTF = do
uTF8_STRING <- inX $ getAtom "UTF8_STRING"
guardType uTF8_STRING $ guardSize'' 8 propShortErr $ do
guardType uTF8_STRING $ guardSize 8 $ do
s <- gets value
modify (\r -> r {value = []})
append . show . decode . map fromIntegral $ s
return True
-- dump an enumerated value using a translation table
dumpEnum' :: HasCallStack => [String] -> Atom -> Decoder Bool
dumpEnum' :: [String] -> Atom -> Decoder Bool
dumpEnum' ss fmt = guardType fmt $
getInt 32 $
\r -> case () of
@ -867,12 +805,11 @@ dumpEnum' ss fmt = guardType fmt $
| otherwise -> genericIndex ss r
-- we do not, unlike @xev@, try to ascii-art pixmaps.
dumpPixmap :: HasCallStack => Decoder Bool
dumpPixmap :: Decoder Bool
dumpPixmap = guardType pIXMAP $ do
p' <- getInt' 32
case p' of
Nothing -> return False
Just 0 -> append "none"
Just p -> do
append $ "pixmap " ++ showHex p ""
g' <- inX $ withDisplay $ \d -> io $
@ -896,80 +833,46 @@ dumpPixmap = guardType pIXMAP $ do
,")"
]
dumpOLAttrs :: HasCallStack => Decoder Bool
dumpOLAttrs :: Decoder Bool
dumpOLAttrs = do
pt <- inX $ getAtom "_OL_WIN_ATTR"
guardType pt $ do
msk <- getInt' 32
case msk of
Nothing -> propShortErr' 7
Nothing -> propShortErr
Just msk' -> dumpListByMask (fromIntegral msk') [("window type" ,dumpAtom )
,("menu" ,dump32 ) -- @@@ unk
,("pushpin" ,dumpEnum bool)
,("limited menu",dump32 ) -- @@@ unk
]
dumpMwmHints :: HasCallStack => Decoder Bool
dumpMwmHints :: Decoder Bool
dumpMwmHints = do
ta <- asks property
guardType ta $ do
msk <- getInt' 32
case msk of
Nothing -> propShortErr' 8
Just msk' -> dumpListByMask' (fromIntegral msk') [("functions" ,dumpBits mwmFuncs ,cARDINAL)
,("decorations",dumpBits mwmDecos ,cARDINAL)
,("input mode" ,dumpEnum mwmInputMode,cARDINAL) -- @@@ s/b iNTEGER?
,("status" ,dumpBits mwmState ,cARDINAL)
]
Nothing -> propShortErr
Just msk' -> dumpListByMask (fromIntegral msk') [("functions" ,dumpBits mwmFuncs )
,("decorations",dumpBits mwmDecos )
,("input mode" ,dumpEnum mwmInputMode)
,("status" ,dumpBits mwmState )
]
dumpMwmInfo :: HasCallStack => Decoder Bool
dumpMwmInfo :: Decoder Bool
dumpMwmInfo = do
ta <- asks property
guardType ta $ dumpList' [("flags" ,dumpBits mwmHints,cARDINAL)
,("window",dumpWindow ,wINDOW )
]
dumpSizeHints :: HasCallStack => Decoder Bool
dumpSizeHints = do
guardType wM_SIZE_HINTS $ do
-- flags, 4 unused CARD32s, fields as specified by flags
msk <- fmap fromIntegral <$> getInt' 32
eat (4 * 4) >> pure False
case msk of
Nothing -> propShortErr' 9
Just msk' -> dumpListByMask' msk' [("min size" ,dumpSize ,cARDINAL)
,("max size" ,dumpSize ,cARDINAL)
,("increment" ,dumpSize ,cARDINAL)
,("aspect ratio",dumpAspect,cARDINAL)
,("base size" ,dumpSize ,cARDINAL)
,("gravity" ,dumpGrav ,cARDINAL)
]
dumpSize :: HasCallStack => Decoder Bool
dumpSize = append "(" >> dump32 >> append "," >> dump32 >> append ")"
dumpAspect :: HasCallStack => Decoder Bool
dumpAspect = do
-- have to do this manually since it doesn't really fit
append "min = "
dump32
append "/"
dump32
append ", max = "
dump32
append "/"
dump32
dumpGrav :: HasCallStack => Decoder Bool
dumpGrav = dumpEnum wmGravity
-- the most common case
dumpEnum :: HasCallStack => [String] -> Decoder Bool
dumpEnum :: [String] -> Decoder Bool
dumpEnum ss = dumpEnum' ss cARDINAL
-- implement exceptional cases atop a normal dumper
-- @@@ there's gotta be a better way
dumpExcept :: HasCallStack => [(Integer,String)] -> Decoder Bool -> Decoder Bool
dumpExcept :: [(Integer,String)] -> Decoder Bool -> Decoder Bool
dumpExcept xs item = do
-- this horror brought to you by reparsing to get the right value for our use
sp <- get
@ -984,8 +887,7 @@ dumpExcept xs item = do
-- and after all that, we can process the exception list
dumpExcept' xs that v
dumpExcept' :: HasCallStack
=> [(Integer,String)]
dumpExcept' :: [(Integer,String)]
-> DecodeState
-> Integer
-> Decoder Bool
@ -995,7 +897,7 @@ dumpExcept' ((exc,str):xs) that val | exc == val = append str
-- use @ps@ to get process information.
-- @@@@ assumes a POSIX @ps@, not a BSDish one.
dumpPid :: HasCallStack => Decoder Bool
dumpPid :: Decoder Bool
dumpPid = guardType cARDINAL $ do
n <- getInt' 32
case n of
@ -1013,17 +915,17 @@ dumpPid = guardType cARDINAL $ do
then "pid " ++ pid
else prc !! 1
dumpTime :: HasCallStack => Decoder Bool
dumpTime :: Decoder Bool
dumpTime = append "server event # " >> dump32
dumpState :: HasCallStack => Decoder Bool
dumpState :: Decoder Bool
dumpState = do
wM_STATE <- inX $ getAtom "WM_STATE"
guardType wM_STATE $ dumpList' [("state" ,dumpEnum wmState,cARDINAL)
,("icon window",dumpWindow ,wINDOW )
]
dumpMotifDragReceiver :: HasCallStack => Decoder Bool
dumpMotifDragReceiver :: Decoder Bool
dumpMotifDragReceiver = do
ta <- inX $ getAtom "_MOTIF_DRAG_RECEIVER_INFO"
guardType ta $ dumpList' [("endian" ,dumpMotifEndian,cARDINAL)
@ -1031,11 +933,11 @@ dumpMotifDragReceiver = do
,("style" ,dumpMDropStyle ,cARDINAL) -- @@@ dummy
]
dumpMDropStyle :: HasCallStack => Decoder Bool
dumpMDropStyle :: Decoder Bool
dumpMDropStyle = do
d <- getInt' 8
pad 1 $ case d of
Nothing -> propShortErr' 9
Nothing -> propShortErr
Just ps | ps == 0 -> pad 12 $ append "none"
| ps == 1 -> pad 12 $ append "drop only"
| ps == 2 -> append "prefer preregister " >> dumpMDPrereg
@ -1045,7 +947,7 @@ dumpMDropStyle = do
| ps == 6 -> pad 12 $ append "prefer receiver"
| otherwise -> failure $ "unknown drop style " ++ show ps
dumpMDPrereg :: HasCallStack => Decoder Bool
dumpMDPrereg :: Decoder Bool
dumpMDPrereg = do
-- this is a bit ugly; we pretend to be extending the above dumpList'
append ","
@ -1055,7 +957,7 @@ dumpMDPrereg = do
append "drop sites = "
dsc' <- getInt' 16
case dsc' of
Nothing -> propShortErr' 10
Nothing -> propShortErr
Just dsc -> do
withIndent 13 $ append (show dsc)
pad 2 $ do
@ -1067,7 +969,7 @@ dumpMDPrereg = do
dumpMDBlocks :: Int -> Decoder Bool
dumpMDBlocks _ = propSimple "(drop site info)" -- @@@ maybe later if needed
dumpMotifEndian :: HasCallStack => Decoder Bool
dumpMotifEndian :: Decoder Bool
dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do
c <- map twiddle <$> eat 1
case c of
@ -1075,14 +977,14 @@ dumpMotifEndian = guardType cARDINAL $ guardSize 8 $ do
['B'] -> append "big"
_ -> failure "bad endian flag"
pad :: HasCallStack => Int -> Decoder Bool -> Decoder Bool
pad :: Int -> Decoder Bool -> Decoder Bool
pad n p = do
vs <- gets value
if length vs < n
then propShortErr' 11
then propShortErr
else modify (\r -> r {value = drop n vs}) >> p
dumpPercent :: HasCallStack => Decoder Bool
dumpPercent :: Decoder Bool
dumpPercent = guardType cARDINAL $ do
n <- getInt' 32
case n of
@ -1092,7 +994,7 @@ dumpPercent = guardType cARDINAL $ do
pct :: Double
in append $ show (round pct :: Integer) ++ "%"
dumpWmHints :: HasCallStack => Decoder Bool
dumpWmHints :: Decoder Bool
dumpWmHints =
guardType wM_HINTS $ do
msk <- getInt' 32
@ -1109,7 +1011,7 @@ dumpWmHints =
,("window_group" ,dumpWindow ,wINDOW )
]
dumpBits :: HasCallStack => [String] -> Decoder Bool
dumpBits :: [String] -> Decoder Bool
dumpBits bs = guardType cARDINAL $ do
n <- getInt' 32
case n of
@ -1167,9 +1069,6 @@ awSource = ["unspecified"
,"pager/task list"
]
cpState :: [String]
cpState = ["no preference","disable compositing","force compositing"]
{- eventually...
wmHintsFlags :: [String]
wmHintsFlags = ["Input"
@ -1213,12 +1112,6 @@ nwmOrigin = nwmEnum Nothing ["TOPLEFT","TOPRIGHT","BOTTOMRIGHT","BOTTOMLEFT"]
wmState :: [String]
wmState = ["Withdrawn","Normal","Zoomed (obsolete)","Iconified","Inactive"]
nwAction :: [String]
nwAction = ["Clear", "Set", "Toggle"]
wmGravity :: [String]
wmGravity = ["forget/unmap","NW","N","NE","W","C","E","SW","S","SE","static"]
nwmEnum :: Maybe String
-> [String]
-> [String]
@ -1228,7 +1121,7 @@ nwmEnum (Just prefix) vs = map (("_NET_WM_" ++ prefix ++ "_") ++) vs
-- and the lowest level coercions --
-- parse and return an integral value
getInt' :: HasCallStack => Int -> Decoder (Maybe Integer)
getInt' :: Int -> Decoder (Maybe Integer)
-- see XSync documentation for this insanity
getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
guardSize' 8 (propShortErr >> return Nothing) $ do
@ -1236,7 +1129,7 @@ getInt' 64 = guardR width 32 (\a e -> propSizeErr a e >> return Nothing) $
hi <- inhale 32
return $ Just $ lo + hi * (fromIntegral (maxBound :: Word32) + 1)
getInt' w = guardR width w (\a e -> propSizeErr a e >> return Nothing) $
guardSize' (bytes w) (propShortErr' 13 >> return Nothing) $
guardSize' (bytes w) (propShortErr >> return Nothing) $
Just <$> inhale w
-- parse an integral value and feed it to a show-er of some kind
@ -1278,8 +1171,8 @@ append :: String -> Decoder Bool
append = append' True
-- and the same but for errors
failure :: HasCallStack => String -> Decoder Bool
failure = append' False . (++ prettyCallStack callStack)
failure :: String -> Decoder Bool
failure = append' False
-- common appender
append' :: Bool -> String -> Decoder Bool
@ -1293,13 +1186,9 @@ propSimple :: String -> Decoder Bool
propSimple s = modify (\r -> r {value = []}) >> append s
-- report various errors
propShortErr :: HasCallStack => Decoder Bool
propShortErr :: Decoder Bool
propShortErr = failure "(property ended prematurely)"
-- debug version
propShortErr' :: HasCallStack => Int -> Decoder Bool
propShortErr' n = failure $ "(short prop " ++ show n ++ ")"
propSizeErr :: Int -> Int -> Decoder Bool
propSizeErr e a = failure $ "(bad bit width " ++
show a ++

5
XMonad/Hooks/DebugKeyEvents.hs
View File

@ -51,8 +51,9 @@ import System.IO (hPutStrLn
-- the key; @mask@ is raw, and @clean@ is what @xmonad@ sees after
-- sanitizing it (removing @numberLockMask@, etc.)
--
-- For more detailed instructions on editing the logHook see
-- <https://xmonad.org/TUTORIAL.html#make-xmonad-and-xmobar-talk-to-each-other the tutorial>.
-- For more detailed instructions on editing the logHook see:
--
-- "XMonad.Doc.Extending#The_log_hook_and_external_status_bars"
-- | Print key events to stderr for debugging
debugKeyEvents :: Event -> X All

Some files were not shown because too many files have changed in this diff Show More