Compare commits

..

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

58 changed files with 1513 additions and 4952 deletions

View File

@ -1,16 +1,12 @@
### Problem Description ### Problem Description
Describe the problem you are having and what you expect to happen Describe the problem you are having, what you expect to happen
instead. instead, and how to reproduce the problem.
### Steps to Reproduce
Give detailed step-by-step instructions on how to reproduce the problem.
### Configuration File ### Configuration File
Please include the smallest _full_ configuration file that reproduces Please include the smallest configuration file that reproduces the
the problem you are experiencing: problem you are experiencing:
```haskell ```haskell
module Main (main) where module Main (main) where
@ -25,6 +21,4 @@ main = xmonad def
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md) - [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
- I tested my configuration - [ ] I tested my configuration with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
- [ ] With `xmonad` version XXX (commit XXX if using git)
- [ ] With `xmonad-contrib` version XXX (commit XXX if using git)

View File

@ -9,7 +9,6 @@ behind them.
- [ ] I've confirmed these changes don't belong in xmonad-contrib instead - [ ] I've confirmed these changes don't belong in xmonad-contrib instead
- [ ] I've considered how to best test these changes (property, unit, - [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
manually, ...) and concluded: XXX
- [ ] I updated the `CHANGES.md` file - [ ] I updated the `CHANGES.md` file

View File

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

View File

@ -1,33 +0,0 @@
name: Generate manpage
on:
push:
branches:
- master
jobs:
build:
runs-on: ubuntu-latest
steps:
- name: Clone project
uses: actions/checkout@v4
- name: Install dependencies
run: |
set -ex
sudo apt install -y pandoc
- name: Generate manpage
run: |
set -ex
for d in /opt/ghc/*/bin; do PATH="$d:$PATH"; break; done
make -B -C man
- name: Commit/push if changed
run: |
set -ex
git config user.name 'github-actions[bot]'
git config user.email '41898282+github-actions[bot]@users.noreply.github.com'
git diff --quiet --exit-code && exit
git commit -a -m 'man: Update'
git push

View File

@ -1,139 +0,0 @@
Piggy-back on the haskell-ci workflow for automatic releases to Hackage.
This extends the workflow with two additional triggers:
* When the Haskell-CI workflow is triggered manually with a non-empty version
input (matching the version in the cabal file), a candidate release is
uploaded to Hackage and docs are submitted for it as Hackage can't build
them itself (https://github.com/haskell/hackage-server/issues/925).
Note that promoting the candidate on Hackage discards the uploaded docs
(https://github.com/haskell/hackage-server/issues/70). Don't do that.
* When a release is created on GitHub, a final release is uploaded to Hackage
and docs are submitted for it.
The automation uses a special Hackage user: https://hackage.haskell.org/user/xmonad
and each repo (X11, xmonad, xmonad-contrib) has its own HACKAGE_API_KEY token
set in GitHub repository secrets.
--- .github/workflows/haskell-ci.yml.orig
+++ .github/workflows/haskell-ci.yml
@@ -14,8 +14,15 @@
#
name: Haskell-CI
on:
- - push
- - pull_request
+ push:
+ pull_request:
+ release:
+ types:
+ - published
+ workflow_dispatch:
+ inputs:
+ version:
+ description: candidate version (must match version in cabal file)
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
@@ -33,6 +40,7 @@
compilerVersion: 9.8.4
setup-method: ghcup
allow-failure: false
+ upload: true
- compiler: ghc-9.6.7
compilerKind: ghc
compilerVersion: 9.6.7
@@ -257,6 +265,10 @@
- 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
@@ -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)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ with:
+ name: sdist
+ path: ${{ github.workspace }}/sdist/*.tar.gz
+ - name: upload artifact (haddock)
+ if: matrix.upload
+ uses: actions/upload-artifact@v4
+ with:
+ name: haddock
+ path: ${{ github.workspace }}/haddock/*-docs.tar.gz
+ - name: hackage upload (candidate)
+ if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
+ shell: bash
+ run: |
+ set -ex
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
+ res=$(
+ curl \
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+ --header "Accept: text/plain" \
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
+ https://hackage.haskell.org/packages/candidates/
+ )
+ [[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
+ res=$(
+ curl \
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+ -X PUT \
+ --header "Accept: text/plain" \
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+ --header "Content-Type: application/x-tar" \
+ --header "Content-Encoding: gzip" \
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
+ )
+ [[ $res == 2?? ]]
+ env:
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
+ PACKAGE_NAME: ${{ github.event.repository.name }}
+ PACKAGE_VERSION: ${{ github.event.inputs.version }}
+ - name: hackage upload (release)
+ if: matrix.upload && github.event_name == 'release'
+ shell: bash
+ run: |
+ set -ex
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
+ res=$(
+ curl \
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+ --header "Accept: text/plain" \
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
+ https://hackage.haskell.org/packages/
+ )
+ [[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
+ res=$(
+ curl \
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
+ -X PUT \
+ --header "Accept: text/plain" \
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
+ --header "Content-Type: application/x-tar" \
+ --header "Content-Encoding: gzip" \
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
+ )
+ [[ $res == 2?? ]]
+ env:
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
+ PACKAGE_NAME: ${{ github.event.repository.name }}
+ PACKAGE_VERSION: ${{ github.event.release.tag_name }}

View File

@ -1,335 +0,0 @@
# This GitHub workflow config has been generated by a script via
#
# haskell-ci 'github' 'cabal.project'
#
# To regenerate the script (for example after adjusting tested-with) run
#
# haskell-ci regenerate
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
# version: 0.19.20250506
#
# REGENDATA ("0.19.20250506",["github","cabal.project"])
#
name: Haskell-CI
on:
push:
pull_request:
release:
types:
- published
workflow_dispatch:
inputs:
version:
description: candidate version (must match version in cabal file)
jobs:
linux:
name: Haskell-CI - Linux - ${{ matrix.compiler }}
runs-on: ubuntu-24.04
timeout-minutes:
60
container:
image: buildpack-deps:jammy
continue-on-error: ${{ matrix.allow-failure }}
strategy:
matrix:
include:
- compiler: ghc-9.12.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
setup-method: ghcup
allow-failure: false
- compiler: ghc-9.0.2
compilerKind: ghc
compilerVersion: 9.0.2
setup-method: ghcup
allow-failure: false
- compiler: ghc-8.10.7
compilerKind: ghc
compilerVersion: 8.10.7
setup-method: ghcup
allow-failure: false
- compiler: ghc-8.8.4
compilerKind: ghc
compilerVersion: 8.8.4
setup-method: ghcup
allow-failure: false
- compiler: ghc-8.6.5
compilerKind: ghc
compilerVersion: 8.6.5
setup-method: ghcup
allow-failure: false
fail-fast: false
steps:
- name: apt-get install
run: |
apt-get update
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
apt-get install -y libx11-dev libxext-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"
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: Set PATH and environment variables
run: |
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
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"
env:
HCKIND: ${{ matrix.compilerKind }}
HCNAME: ${{ matrix.compiler }}
HCVER: ${{ matrix.compilerVersion }}
- name: env
run: |
env
- name: write cabal config
run: |
mkdir -p $CABAL_DIR
cat >> $CABAL_CONFIG <<EOF
remote-build-reporting: anonymous
write-ghc-environment-files: never
remote-repo-cache: $CABAL_DIR/packages
logs-dir: $CABAL_DIR/logs
world-file: $CABAL_DIR/world
extra-prog-path: $CABAL_DIR/bin
symlink-bindir: $CABAL_DIR/bin
installdir: $CABAL_DIR/bin
build-summary: $CABAL_DIR/logs/build.log
store-dir: $CABAL_DIR/store
install-dirs user
prefix: $CABAL_DIR
repository hackage.haskell.org
url: http://hackage.haskell.org/
EOF
cat >> $CABAL_CONFIG <<EOF
program-default-options
ghc-options: $GHCJOBS +RTS -M3G -RTS
EOF
cat $CABAL_CONFIG
- name: versions
run: |
$HC --version || true
$HC --print-project-git-commit-id || true
$CABAL --version || true
- name: update cabal index
run: |
$CABAL v2-update -v
- 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 -
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: checkout
uses: actions/checkout@v4
with:
path: source
- name: initial cabal.project for sdist
run: |
touch cabal.project
echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
cat cabal.project
- name: sdist
run: |
mkdir -p sdist
$CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
- name: unpack
run: |
mkdir -p unpacked
find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
- name: generate cabal.project
run: |
PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')"
echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> "$GITHUB_ENV"
rm -f cabal.project cabal.project.local
touch cabal.project
touch cabal.project.local
echo "packages: ${PKGDIR_xmonad}" >> cabal.project
echo "package xmonad" >> cabal.project
echo " ghc-options: -Werror=missing-methods" >> cabal.project
cat >> cabal.project <<EOF
optimization: False
package xmonad
flags: +pedantic
EOF
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad)$/; }' >> 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
with:
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
path: ~/.cabal/store
restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
- name: install dependencies
run: |
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
- name: build w/o tests
run: |
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
- name: build
run: |
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
- name: tests
run: |
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
- name: cabal check
run: |
cd ${PKGDIR_xmonad} || 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)
if: matrix.upload
uses: actions/upload-artifact@v4
with:
name: sdist
path: ${{ github.workspace }}/sdist/*.tar.gz
- name: upload artifact (haddock)
if: matrix.upload
uses: actions/upload-artifact@v4
with:
name: haddock
path: ${{ github.workspace }}/haddock/*-docs.tar.gz
- name: hackage upload (candidate)
if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
shell: bash
run: |
set -ex
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
https://hackage.haskell.org/packages/candidates/
)
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
-X PUT \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--header "Content-Type: application/x-tar" \
--header "Content-Encoding: gzip" \
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
)
[[ $res == 2?? ]]
env:
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
PACKAGE_NAME: ${{ github.event.repository.name }}
PACKAGE_VERSION: ${{ github.event.inputs.version }}
- name: hackage upload (release)
if: matrix.upload && github.event_name == 'release'
shell: bash
run: |
set -ex
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
https://hackage.haskell.org/packages/
)
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
res=$(
curl \
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
-X PUT \
--header "Accept: text/plain" \
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
--header "Content-Type: application/x-tar" \
--header "Content-Encoding: gzip" \
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
)
[[ $res == 2?? ]]
env:
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
PACKAGE_NAME: ${{ github.event.repository.name }}
PACKAGE_VERSION: ${{ github.event.release.tag_name }}

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: '.'
fail-on: status

View File

@ -1,21 +0,0 @@
name: Nix
on:
push:
pull_request:
jobs:
build:
runs-on: ubuntu-latest
name: Nix Flake - Linux
permissions:
contents: read
steps:
- name: Install Nix
uses: cachix/install-nix-action@v31
with:
github_access_token: ${{ secrets.GITHUB_TOKEN }}
- name: Clone project
uses: actions/checkout@v4
- name: Build
run: nix build --print-build-logs

View File

@ -1,48 +0,0 @@
name: Packdeps
on:
workflow_dispatch:
schedule:
# Run every Saturday
- cron: '0 3 * * 6'
jobs:
packdeps:
name: Packdeps
runs-on: ubuntu-latest
steps:
- name: Clone project
uses: actions/checkout@v4
- name: Setup Haskell
uses: haskell-actions/setup@v2
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
cabal install packdeps
- name: Check package bounds (all)
continue-on-error: true
run: |
set -ex
packdeps \
--exclude X11 \
*.cabal
- name: Check package bounds (preferred)
run: |
set -ex
packdeps \
--preferred \
--exclude X11 \
*.cabal
workflow-keepalive:
if: github.event_name == 'schedule'
runs-on: ubuntu-latest
permissions:
actions: write
steps:
- uses: liskin/gh-workflow-keepalive@v1

View File

@ -1,79 +0,0 @@
name: Stack
on:
push:
pull_request:
jobs:
build:
name: Stack CI - Linux - ${{ matrix.resolver }}
runs-on: ubuntu-latest
strategy:
fail-fast: false
matrix:
include:
- resolver: lts-14 # GHC 8.6
- resolver: lts-16 # GHC 8.8
- resolver: lts-18 # GHC 8.10
- resolver: lts-19 # GHC 9.0
- resolver: lts-20 # GHC 9.2
- resolver: lts-21 # GHC 9.4
- resolver: lts-22 # GHC 9.6
- resolver: lts-23 # GHC 9.8
steps:
- name: Clone project
uses: actions/checkout@v4
- name: Install C dependencies
run: |
set -ex
sudo apt update -y
sudo apt install -y \
libx11-dev \
libxext-dev \
libxinerama-dev \
libxrandr-dev \
libxss-dev \
#
- name: Refresh caches once a month
id: cache-date
# GHA writes caches on the first miss and then never updates them again;
# force updating the cache at least once a month. Additionally, the
# 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
- name: Cache Haskell package metadata
uses: actions/cache@v4
with:
path: ~/.stack/pantry
key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
- name: Cache Haskell dependencies
uses: actions/cache@v4
with:
path: |
~/.stack/*
!~/.stack/pantry
!~/.stack/programs
key: stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles('stack.yaml') }}-${{ hashFiles('*.cabal') }}
restore-keys: |
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles('stack.yaml') }}-
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
- name: Update hackage index
# always update index to prevent the shared ~/.stack/pantry cache from being empty
run: |
set -ex
stack update
- name: Build and test
run: |
set -ex
stack test \
--fast --no-terminal \
--resolver=${{ matrix.resolver }} --system-ghc \
--flag=xmonad:pedantic

3
.gitignore vendored
View File

@ -27,6 +27,3 @@ tags
/cabal.sandbox.config /cabal.sandbox.config
/dist-newstyle/ /dist-newstyle/
/dist/ /dist/
# nix artifacts
result

View File

@ -1,2 +0,0 @@
# Ignore these warnings.
- ignore: {name: "Use camelCase"}

View File

@ -1,39 +0,0 @@
Adam Plaice <plaice.adam+github@gmail.com>
Brandon S Allbery KF8NH <allbery.b@gmail.com>
Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
Conrad Irwin <conrad.irwin@gmail.com>
Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
Daniel Schoepe <daniel.schoepe@gmail.com> <asgaroth_@gmx.de>
Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
David Glasser <glasser@mit.edu>
Deven Lahoti <deven.lahoti@gmail.com>
Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
Don Stewart <dons00@gmail.com> <dons@galois.com>
Felix Springer <felixspringer149@gmail.com> <39434424+jumper149@users.noreply.github.com>
Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
Lukas Mai <l.mai@web.de>
Marshall Lochbaum <mwlochbaum@gmail.com>
Michael G. Sloan <mgsloan@gmail.com>
Neil Mitchell <ndmitchell@gmail.com> <http://www.cs.york.ac.uk/~ndm/>
Neil Mitchell <ndmitchell@gmail.com> Neil Mitchell <unknown>
Nick Burlett <nickburlett@mac.com>
Nicolas Pouillard <nicolas.pouillard@gmail.com>
Nik Nyby <nnyby@columbia.edu>
Peter J. Jones <pjones@devalot.com>
Peter J. Jones <pjones@devalot.com> <pjones@pmade.com>
Robert Marlow <bobstopper@bobturf.org>
Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
Sam Hughes <hughes@rpi.edu>
Shae Erisson <shae@ScannedInAvian.com>
Sibi Prabakaran <sibi@psibi.in>
Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
Timothy Hobbs <tim.thelion@gmail.com>
Tomas Janousek <tomi@nomi.cz>
Valery V. Vorotyntsev <valery.vv@gmail.com>
Vanessa McHale <vamchale@gmail.com> <vanessa.mchale@reconfigure.io>
Wirt Wolff <wirtwolff@gmail.com>
Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
Tony Zorman <soliditsallgood@mailbox.org>

135
.travis.yml Normal file
View File

@ -0,0 +1,135 @@
# This Travis job script has been generated by a script via
#
# runghc make_travis_yml_2.hs '-o' '.travis.yml' 'xmonad.cabal' 'libxrandr-dev'
#
# For more information, see https://github.com/haskell-CI/haskell-ci
#
language: c
sudo: false
git:
submodules: false # whether to recursively clone submodules
cache:
directories:
- $HOME/.cabal/packages
- $HOME/.cabal/store
before_cache:
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
# remove files that are regenerated by 'cabal update'
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx
- rm -rfv $HOME/.cabal/packages/head.hackage
matrix:
include:
- compiler: "ghc-8.6.1"
env: GHCHEAD=true
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.6.1,libxrandr-dev], sources: [hvr-ghc]}}
- compiler: "ghc-8.4.3"
# env: TEST=--disable-tests BENCH=--disable-benchmarks
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3,libxrandr-dev], sources: [hvr-ghc]}}
- compiler: "ghc-8.2.2"
# env: TEST=--disable-tests BENCH=--disable-benchmarks
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2,libxrandr-dev], sources: [hvr-ghc]}}
- compiler: "ghc-8.0.2"
# env: TEST=--disable-tests BENCH=--disable-benchmarks
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2,libxrandr-dev], sources: [hvr-ghc]}}
allow_failures:
- compiler: "ghc-8.6.1"
before_install:
- HC=${CC}
- HCPKG=${HC/ghc/ghc-pkg}
- unset CC
- ROOTDIR=$(pwd)
- mkdir -p $HOME/.local/bin
- "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"
- HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
- echo $HCNUMVER
install:
- cabal --version
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
- BENCH=${BENCH---enable-benchmarks}
- TEST=${TEST---enable-tests}
- HADDOCK=${HADDOCK-true}
- UNCONSTRAINED=${UNCONSTRAINED-true}
- NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}
- GHCHEAD=${GHCHEAD-false}
- travis_retry cabal update -v
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
- rm -fv cabal.project cabal.project.local
# Overlay Hackage Package Index for GHC HEAD: https://github.com/hvr/head.hackage
- |
if $GHCHEAD; then
sed -i 's/-- allow-newer: .*/allow-newer: *:base/' ${HOME}/.cabal/config
for pkg in $($HCPKG list --simple-output); do pkg=$(echo $pkg | sed 's/-[^-]*$//'); sed -i "s/allow-newer: /allow-newer: *:$pkg, /" ${HOME}/.cabal/config; done
echo 'repository head.hackage' >> ${HOME}/.cabal/config
echo ' url: http://head.hackage.haskell.org/' >> ${HOME}/.cabal/config
echo ' secure: True' >> ${HOME}/.cabal/config
echo ' root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740' >> ${HOME}/.cabal/config
echo ' 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb' >> ${HOME}/.cabal/config
echo ' 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e' >> ${HOME}/.cabal/config
echo ' key-threshold: 3' >> ${HOME}/.cabal.config
grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
cabal new-update head.hackage -v
fi
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
- "printf 'packages: \".\"\\n' > cabal.project"
- "if [ $HCNUMVER -lt 80600 ]; then printf 'package xmonad\\n flags: +generatemanpage\n' >> cabal.project; fi"
- touch cabal.project.local
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- xmonad | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- cat cabal.project || true
- cat cabal.project.local || true
- if [ -f "./configure.ac" ]; then
(cd "." && autoreconf -i);
fi
- rm -f cabal.project.freeze
- cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
- cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
- rm -rf .ghc.environment.* "."/dist
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
# Here starts the actual work to be performed for the package under test;
# any command which exits with a non-zero exit code causes the build to fail.
script:
# test that source-distributions can be generated
- (cd "." && cabal sdist)
- mv "."/dist/xmonad-*.tar.gz ${DISTDIR}/
- cd ${DISTDIR} || false
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
- "printf 'packages: xmonad-*/*.cabal\\n' > cabal.project"
- "if [ $HCNUMVER -lt 80600 ]; then printf 'package xmonad\\n flags: +generatemanpage\n' >> cabal.project; fi"
- touch cabal.project.local
- "if ! $NOINSTALLEDCONSTRAINTS; then for pkg in $($HCPKG list --simple-output); do echo $pkg | grep -vw -- xmonad | sed 's/^/constraints: /' | sed 's/-[^-]*$/ installed/' >> cabal.project.local; done; fi"
- cat cabal.project || true
- cat cabal.project.local || true
# this builds all libraries and executables (without tests/benchmarks)
- cabal new-build -w ${HC} --disable-tests --disable-benchmarks all
# build & run tests, build benchmarks
- cabal new-build -w ${HC} ${TEST} ${BENCH} all
- if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
# cabal check
- (cd xmonad-* && cabal check)
# haddock
- rm -rf ./dist-newstyle
- if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi
# Build without installed constraints for packages in global-db
- if $UNCONSTRAINED; then rm -f cabal.project.local; echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks all; else echo "Not building without installed constraints"; fi
# REGENDATA ["-o",".travis.yml","xmonad.cabal","libxrandr-dev"]
# EOF

View File

@ -1,177 +1,6 @@
# Change Log / Release Notes # Change Log / Release Notes
## _unreleased_ ## unknown (unknown)
### Breaking Changes
* Use `cabal` for `--recompile` if there is a `.cabal` file in the config
directory and none of `build`, `stack.yaml`, `flake.nix`, nor `default.nix`
exist.
### Enhancements
### Bug Fixes
### Other
PR #404 (see last change in 0.17.1) has been reverted, because the affected
compilers are (hopefully) no longer being used.
All 9.0 releases of GHC, plus 9.2.1 and 9.2.2 have the join point bug.
Note that 9.0.x is known to also have GC issues and is officially deprecated,
and the only 9.2 release that should be used is 9.2.8. Additionally, GHC HQ
doesn't support releases before 9.6.6.
## 0.18.0 (February 3, 2024)
### Breaking Changes
* Dropped support for GHC 8.4.
### Enhancements
* Exported `sendRestart` and `sendReplace` from `XMonad.Operations`.
* Exported `buildLaunch` from `XMonad.Main`.
* `Tall` does not draw windows with zero area.
* `XMonad.Operations.floatLocation` now applies size hints. This means windows
will snap to these hints as soon as they're floated (mouse move, keybinding).
Previously that only happened on mouse resize.
* Recompilation now detects `flake.nix` and `default.nix` (can be a
symlink) and switches to using `nix build` as appropriate.
* Added `unGrab` to `XMonad.Operations`; this releases XMonad's passive
keyboard grab, so other applications (like `scrot`) can do their
thing.
### Bug Fixes
* Duplicated floats (e.g. from X.A.CopyToAll) no longer escape to inactive
screens.
## 0.17.2 (April 2, 2023)
### Bug Fixes
* Fixed the build with GHC 9.6.
## 0.17.1 (September 3, 2022)
### Enhancements
* Added custom cursor shapes for resizing and moving windows.
* Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`.
* Added `willFloat` function to `XMonad.ManageHooks` to detect whether the
(about to be) managed window will be a floating window or not.
### Bug Fixes
* Fixed border color of windows with alpha channel. Now all windows have the
same opaque border color.
* Change the main loop to try to avoid [GHC bug 21708] on systems
running GHC 9.2 up to version 9.2.3. The issue has been fixed in
[GHC 9.2.4] and all later releases.
[GHC bug 21708]: https://gitlab.haskell.org/ghc/ghc/-/issues/21708
[GHC 9.2.4]: https://discourse.haskell.org/t/ghc-9-2-4-released/4851
## 0.17.0 (October 27, 2021)
### Enhancements
* Migrated `X.L.LayoutCombinators.(|||)` into `XMonad.Layout`, providing the
ability to directly jump to a layout with the `JumpToLayout` message.
* Recompilation now detects `stack.yaml` (can be a symlink) alongside
`xmonad.hs` and switches to using `stack ghc`. We also updated INSTALL.md
with instructions for cabal-install that lead to correct recompilation.
Deprecation warnings during recompilation are no longer suppressed to make
it easier for us to clean up the codebase. These can still be suppressed
manually using an `OPTIONS_GHC` pragma with `-Wno-deprecations`.
* Improve handling of XDG directories.
1. If all three of xmonad's environment variables (`XMONAD_DATA_DIR,`
`XMONAD_CONFIG_DIR`, and `XMONAD_CACHE_DIR`) are set, use them.
2. If there is a build script called `build` (see [these build scripts]
for usage examples) or configuration `xmonad.hs` in `~/.xmonad`, set
all three directories to `~/.xmonad`.
3. Otherwise, use the `xmonad` directory in `XDG_DATA_HOME`,
`XDG_CONFIG_HOME`, and `XDG_CACHE_HOME` (or their respective
fallbacks). These directories are created if necessary.
In the cases of 1. and 3., the build script or executable is expected to be
in the config dir.
Additionally, the xmonad config binary and intermediate object files were
moved to the cache directory (only relevant if using XDG or
`XMONAD_CACHE_DIR`).
* Added `Foldable`, `Functor`, and `Traversable` instances for `Stack`.
* Added `Typeable layout` constraint to `LayoutClass`, making it possible to
cast `Layout` back into a concrete type and extract current layout state
from it.
* Export constructor for `Choose` and `CLR` from `Module.Layout` to allow
pattern-matching on the left and right sub-layouts of `Choose l r a`.
* Added `withUnfocused` function to `XMonad.Operations`, allowing for `X`
operations to be applied to unfocused windows.
[these build scripts]: https://github.com/xmonad/xmonad-testing/tree/master/build-scripts
### Bug Fixes
* Fixed a bug when using multiple screens with different dimensions, causing
some floating windows to be smaller/larger than the size they requested.
* Compatibility with GHC 9.0
* Fixed dunst notifications being obscured when moving floats.
https://github.com/xmonad/xmonad/issues/208
### Breaking Changes
* Made `(<&&>)` and `(<||>)` non-strict in their right operand; i.e., these
operators now implement short-circuit evaluation so the right operand is
evaluated only if the left operand does not suffice to determine the
result.
* Change `ScreenDetail` to a newtype and make `RationalRect` strict in its
contents.
* Added the `extensibleConf` field to `XConfig` which makes it easier for
contrib modules to have composable configuration (custom hooks, …).
* `util/GenerateManpage.hs` is no longer distributed in the tarball.
Instead, the manpage source is regenerated and manpage rebuilt
automatically in CI.
* `DestroyWindowEvent` is now broadcasted to layouts to let them know
window-specific resources can be discarded.
## 0.15 (September 30, 2018)
* Reimplement `sendMessage` to deal properly with windowset changes made
during handling.
* Add new library functions `windowBracket` and `modifyWindowSet` to
`XMonad.Operations`.
## 0.14.2 (August 21, 2018)
### Bug Fixes
* Add the sample configuration file xmonad.hs again to the release tarball.
[https://github.com/xmonad/xmonad/issues/181]
## 0.14.1 (August 20, 2018) ## 0.14.1 (August 20, 2018)

82
CONFIG Normal file
View File

@ -0,0 +1,82 @@
== Configuring xmonad ==
xmonad is configured by creating and editing the file:
~/.xmonad/xmonad.hs
xmonad then uses settings from this file as arguments to the window manager,
on startup. For a complete example of possible settings, see the file:
man/xmonad.hs
Further examples are on the website, wiki and extension documentation.
http://haskell.org/haskellwiki/Xmonad
== A simple example ==
Here is a basic example, which overrides the default border width,
default terminal, and some colours. This text goes in the file
$HOME/.xmonad/xmonad.hs :
import XMonad
main = xmonad $ def
{ borderWidth = 2
, terminal = "urxvt"
, normalBorderColor = "#cccccc"
, focusedBorderColor = "#cd8b00" }
You can find the defaults in the file:
XMonad/Config.hs
== Checking your xmonad.hs is correct ==
Place this text in ~/.xmonad/xmonad.hs, and then check that it is
syntactically and type correct by loading it in the Haskell
interpreter:
$ ghci ~/.xmonad/xmonad.hs
GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help
Loading package base ... linking ... done.
Ok, modules loaded: Main.
Prelude Main> :t main
main :: IO ()
Ok, looks good.
== Loading your configuration ==
To have xmonad start using your settings, type 'mod-q'. xmonad will
then load this new file, and run it. If it is unable to, the defaults
are used.
To load successfully, both 'xmonad' and 'ghc' must be in your $PATH
environment variable. If GHC isn't in your path, for some reason, you
can compile the xmonad.hs file yourself:
$ cd ~/.xmonad
$ ghc --make xmonad.hs
$ ls
xmonad xmonad.hi xmonad.hs xmonad.o
When you hit mod-q, this newly compiled xmonad will be used.
== Where are the defaults? ==
The default configuration values are defined in the source file:
XMonad/Config.hs
the XConfig data structure itself is defined in:
XMonad/Core.hs
== Extensions ==
Since the xmonad.hs file is just another Haskell module, you may import
and use any Haskell code or libraries you wish. For example, you can use
things from the xmonad-contrib library, or other code you write
yourself.

View File

@ -34,15 +34,9 @@ Awesome! Here are a few things to keep in mind:
nontrivial changes to xmonad. There are a couple of ways you can nontrivial changes to xmonad. There are a couple of ways you can
chat with us: chat with us:
- Join the [`#xmonad` IRC channel] on `irc.libera.chat` or the
official [matrix channel], which is linked to IRC. This is the
preferred (and fastest!) way to get into contact with us.
- Post a message to the [mailing list][ml]. - Post a message to the [mailing list][ml].
* [XMonad.Doc.Developing][xmonad-doc-developing] is a great - Join the `#xmonad` IRC channel on `chat.freenode.org`.
resource to get an overview of xmonad. Make sure to also check
it if you want more details on the coding style.
* Continue reading this document! * Continue reading this document!
@ -61,71 +55,87 @@ Here are some tips for getting your changes merged into xmonad:
* Your changes should include relevant entries in the `CHANGES.md` * Your changes should include relevant entries in the `CHANGES.md`
file. Help us communicate changes to the community. file. Help us communicate changes to the community.
* Make sure you test your changes against the most recent commit of * Make sure you test your changes using the [xmonad-testing][]
[xmonad][] (and [xmonad-contrib][], if you're contributing there). repository. Include a new configuration file that shows off your
If you're adding a new module or functionality, make sure to add an changes if possible by creating a PR on that repository as well.
example in the documentation and in the PR description.
* Make sure you run the automated tests. Both [xmonad-contrib][] * Make sure you read the section on rebasing and squashing commits
and [xmonad][] have test-suites that you could run with below.
`stack test` for example.
* When committing, try to follow existing practices. For more ## Rebasing and Squashing Commits
information on what good commit messages look like, see [How to
Write a Git Commit Message][commit-cbeams] and the [Kernel
documentation][commit-kernel] about committing logical changes
separately.
## Style Guidelines Under no circumstances should you ever merge the master branch into
your feature branch. This makes it nearly impossible to review your
changes and we *will not accept your PR* if you do this.
Below are some common style guidelines that all of the core modules Instead of merging you should rebase your changes on top of the master
follow. Before submitting a pull request, make sure that your code does branch. If a core team member asks you to "rebase your changes" this
as well! is what they are talking about.
* Comment every top level function (particularly exported functions), It's also helpful to squash all of your commits so that your pull
and provide a type signature; use Haddock syntax in the comments. request only contains a single commit. Again, this makes it easier to
review your changes and identify the changes later on in the Git
history.
* Follow the coding style of the module that you are making changes to ### How to Rebase Your Changes
(`n` spaces for indentation, where to break long type signatures, …).
* New code should not introduce any new warnings. If you want to The goal of rebasing is to bring recent changes from the master branch
check this yourself before submitting a pull request, there is the into your feature branch. This often helps resolve conflicts where
`pedantic` flag, which is enforced in our CI. You can enable it by you have changed a file that also changed in a recently merged pull
building your changes with `stack build --flag xmonad:pedantic` or request (i.e. the `CHANGES.md` file). Here is how you do that.
`cabal build --flag pedantic`.
* Likewise, your code should be free of [hlint] warnings; this is also 1. Make sure that you have a `git remote` configured for the main
enforced in our GitHub CI. repository. I like to call this remote `upstream`:
* Partial functions are to be avoided: the window manager should not $ git remote add upstream https://github.com/xmonad/xmonad-contrib.git
crash, so do not call `error` or `undefined`.
* Any pure function added to the core should have QuickCheck 2. Pull from upstream and rewrite your changes on top of master. For
properties precisely defining its behavior. this to work you should not have any modified files in your
working directory. Run these commands from within your feature
branch (the branch you are asking to be merged):
* New modules should identify the author, and be submitted under the $ git fetch --all
same license as xmonad (BSD3 license). $ git pull --rebase upstream master
## Keep rocking! 3. If the rebase was successful you can now push your feature branch
back to GitHub. You need to force the push since your commits
have been rewritten and have new IDs:
xmonad is a passion project created and maintained by the community. $ git push --force-with-lease
We'd love for you to maintain your own contributed modules (approve
changes from other contributors, review code, etc.). However, before 4. Your pull request should now be conflict-free and only contain the
we'd be comfortable adding you to the [xmonad GitHub changes that you actually made.
organization][xmonad-gh-org] we need to trust that you have sufficient
knowledge of Haskell and git; and have a way of chatting with you ([IRC, ### How to Squash Commits
Matrix, etc.][community]).
The goal of squashing commits is to produce a clean Git history where
each pull request contains just one commit.
1. Use `git log` to see how many commits you are including in your
pull request. (If you've already submitted your pull request you
can see this in the GitHub interface.)
2. Rebase all of those commits into a single commit. Assuming you
want to squash the last four (4) commits into a single commit:
$ git rebase -i HEAD~4
3. Git will open your editor and display the commits you are
rebasing with the word "pick" in front of them.
4. Leave the first listed commit as "pick" and change the remaining
commits from "pick" to "squash".
5. Save the file and exit your editor. Git will create a new commit
and open your editor so you can modify the commit message.
6. If everything was successful you can push your changed history
back up to GitHub:
$ git push --force-with-lease
[hlint]: https://github.com/ndmitchell/hlint
[xmonad]: https://github.com/xmonad/xmonad [xmonad]: https://github.com/xmonad/xmonad
[xmonad-contrib]: https://github.com/xmonad/xmonad-contrib [xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
[xmonad-testing]: https://github.com/xmonad/xmonad-testing [xmonad-testing]: https://github.com/xmonad/xmonad-testing
[x11]: https://github.com/xmonad/X11 [x11]: https://github.com/xmonad/X11
[ml]: https://mail.haskell.org/cgi-bin/mailman/listinfo/xmonad [ml]: https://mail.haskell.org/cgi-bin/mailman/listinfo/xmonad
[xmonad-doc-developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
[`#xmonad` IRC channel]: https://web.libera.chat/#xmonad
[matrix channel]: https://matrix.to/#/#xmonad:matrix.org
[commit-cbeams]: https://cbea.ms/git-commit/
[commit-kernel]: https://www.kernel.org/doc/html/v4.10/process/submitting-patches.html#separate-your-changes
[community]: https://xmonad.org/community.html
[xmonad-gh-org]: https://github.com/xmonad

View File

@ -1,402 +0,0 @@
# Install XMonad
On many systems xmonad is available as a binary package in your
distribution (Debian, Ubuntu, Fedora, Arch, Gentoo, …).
It's by far the easiest way to get xmonad, although you'll miss out on the
latest features and fixes that may not have been released yet.
If you do want the latest and greatest, continue reading.
Those who install from distro can skip this and go straight to
[the XMonad Configuration Tutorial](TUTORIAL.md).
<!-- https://github.com/frnmst/md-toc -->
<!-- regenerate via: md_toc -s1 -p github INSTALL.md -->
<!--TOC-->
- [Dependencies](#dependencies)
- [Preparation](#preparation)
- [Download XMonad sources](#download-xmonad-sources)
- [Build XMonad](#build-xmonad)
- [Build using Stack](#build-using-stack)
- [Build using cabal-install](#build-using-cabal-install)
- [Make XMonad your window manager](#make-xmonad-your-window-manager)
- [Custom Build Script](#custom-build-script)
<!--TOC-->
## Dependencies
#### Debian, Ubuntu
``` console
$ sudo apt install \
> git \
> libx11-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
```
#### Fedora
``` console
$ sudo dnf install \
> git \
> libX11-devel libXft-devel libXinerama-devel libXrandr-devel libXScrnSaver-devel
```
#### Arch
``` console
$ sudo pacman -S \
> git \
> xorg-server xorg-apps xorg-xinit xorg-xmessage \
> libx11 libxft libxinerama libxrandr libxss \
> pkgconf
```
#### Void
``` console
$ sudo xbps-install \
> git \
> ncurses-libtinfo-libs ncurses-libtinfo-devel \
> libX11-devel libXft-devel libXinerama-devel libXrandr-devel libXScrnSaver-devel \
> pkg-config
```
## Preparation
We'll use the [XDG] directory specifications here, meaning our
configuration will reside within `$XDG_CONFIG_HOME`, which is
`~/.config` on most systems. Let's create this directory and move to
it:
``` console
$ mkdir -p ~/.config/xmonad && cd ~/.config/xmonad
```
If you already have an `xmonad.hs` configuration, you can copy it over
now. If not, you can use the defaults: create a file called `xmonad.hs`
with the following content:
``` haskell
import XMonad
main :: IO ()
main = xmonad def
```
Older versions of xmonad used `~/.xmonad` instead.
This is still supported, but XDG is preferred.
## Download XMonad sources
Still in `~/.config/xmonad`, clone `xmonad` and `xmonad-contrib` repositories
using [git][]:
``` console
$ git clone https://github.com/xmonad/xmonad
$ git clone https://github.com/xmonad/xmonad-contrib
```
This will give you the latest `HEAD`; if you want you can also check
out a tagged release, e.g.:
``` console
$ git clone --branch v0.17.2 https://github.com/xmonad/xmonad
$ git clone --branch v0.17.1 https://github.com/xmonad/xmonad-contrib
```
(Sources and binaries don't usually go into `~/.config`. In our case,
however, it avoids complexities related to Haskell build tools and lets us
focus on the important bits of XMonad installation.)
## Build XMonad
There are two widely used Haskell build tools:
* [Stack][stack]
* [cabal-install][cabal-install]
We include instructions for both.
Unless you already know which one you prefer, use Stack, which is easier.
### Build using Stack
#### Install Stack
Probably one of the best ways to get [stack] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options.
You can also use your system's package
manager:
``` console
$ sudo apt install haskell-stack # Debian, Ubuntu
$ sudo dnf install stack # Fedora
$ sudo pacman -S stack # Arch
```
If you install stack via this method, it is advisable that you run
`stack upgrade` after installation. This will make sure that you are on
the most recent version of the program, regardless of which version your
distribution actually packages.
If your distribution does not package stack, you can also easily install
it via the following command (this is the recommended way to install
stack via its [documentation][stack]):
``` console
$ curl -sSL https://get.haskellstack.org/ | sh
```
#### Create a New Project
Let's create a stack project. Since we're already in the correct
directory (`~/.config/xmonad`) with `xmonad` and `xmonad-contrib`
subdirectories, starting a new stack project is as simple as running `stack
init`.
Stack should now inform you that it will use the relevant `stack` and
`cabal` files from `xmonad` and `xmonad-contrib` to generate its
`stack.yaml` file. At the time of writing, this looks a little bit like
this:
``` console
$ stack init
Looking for .cabal or package.yaml files to use to init the project.
Using cabal packages:
- xmonad-contrib/
- xmonad/
Selecting the best among 19 snapshots...
* Matches https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
Selected resolver: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
Initialising configuration using resolver: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
Total number of user packages considered: 2
Writing configuration to file: stack.yaml
All done.
```
If you look into your current directory now, you should see a freshly
generated `stack.yaml` file:
``` console
$ ls
xmonad xmonad-contrib stack.yaml xmonad.hs
```
The meat of that file (comments start with `#`, we've omitted them here)
will look a little bit like
``` yaml
resolver:
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
packages:
- xmonad
- xmonad-contrib
```
With `stack.yaml` alongside `xmonad.hs`, xmonad now knows that it needs to use
`stack ghc` instead of just `ghc` when (re)compiling its configuration.
If you want to keep xmonad sources and the stack project elsewhere, but still
use `xmonad --recompile`, symlink your real `stack.yaml` into the xmonad
configuration directory, or [use a custom build script](#custom-build-script).
#### Install Everything
Installing things is as easy as typing `stack install`. This will
install the correct version of GHC, as well as build all of the required
packages (`stack build`) and then copy the relevant executables
(`xmonad`, in our case) to `~/.local/bin`. Make sure to add that
directory to your `$PATH`! The command `which xmonad` should now return
that executable. In case it does not, check if you still have xmonad
installed via your package manager and uninstall it.
If you're getting build failures while building the `X11` package it may
be that you don't have the required C libraries installed. See
[above](#dependencies).
### Build using cabal-install
#### Install cabal-install
Probably one of the best ways to get [cabal-install] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options.
You can also use your system's package
manager:
``` console
$ sudo apt install cabal-install # Debian, Ubuntu
$ sudo dnf install cabal-install # Fedora
$ sudo pacman -S cabal-install # Arch
```
See also <https://www.haskell.org/cabal/#install-upgrade>.
#### Create a New Project
If you want to use `xmonad` or `xmonad-contrib` from git, you will need a
`cabal.project` file. If you want to use both from [Hackage][], you should
skip this step.
Create a file named `cabal.project` containing:
```
packages: */*.cabal
```
(If you do this step without using [git] checkouts, you will get an error from
cabal in the next step. Simply remove `cabal.project` and try again.)
#### Install Everything
You'll need to update the cabal package index, build xmonad and xmonad-contrib
libraries and then build the xmonad binary:
``` console
$ cabal update
$ cabal install --package-env=$HOME/.config/xmonad --lib base xmonad xmonad-contrib
$ cabal install --package-env=$HOME/.config/xmonad xmonad
```
This will create a GHC environment in `~/.config/xmonad` so that the libraries
are available for recompilation of the config file, and also install the
xmonad binary to `~/.cabal/bin/xmonad`. Make sure you have that directory in
your `$PATH`!
If you're getting build failures while building the `X11` package it may
be that you don't have the required C libraries installed. See
[above](#dependencies).
## Make XMonad your window manager
This step varies depending on your distribution and X display manager (if
any).
#### Debian, Ubuntu
`/etc/X11/xinit/xinitrc` runs `/etc/X11/Xsession` which runs `~/.xsession`, so
you probably want to put `exec xmonad` there (don't forget the shebang and chmod).
(Tested with `startx`, `xdm`, `lightdm`.)
By using `~/.xsession`, the distro takes care of stuff like dbus, ssh-agent, X
resources, etc. If you want a completely manual X session, use `~/.xinitrc`
instead. Or invoke `startx`/`xinit` with an explicit path.
Some newer display managers require an entry in `/usr/share/xsessions`.
To use your custom `~/.xsession`, put these lines to
`/usr/share/xsessions/default.desktop`:
```
[Desktop Entry]
Name=Default X session
Type=Application
Exec=default
```
(Tested with `sddm`.)
#### Fedora
`/etc/X11/xinit/xinitrc` runs `~/.Xclients`, so you probably want to put `exec
xmonad` there (don't forget the shebang and chmod). Like in Debian, this can
be overridden by having a completely custom `~/.xinitrc` or passing arguments
to `startx`/`xinit`.
X display managers (e.g. `lightdm`) usually invoke `/etc/X11/xinit/Xsession`
instead, which additionally redirects output to `~/.xsession-errors` and also
tries `~/.xsession` before `~/.Xclients`.
Newer display managers require an entry in `/usr/share/xsessions`, which is
available in the `xorg-x11-xinit-session` package.
#### Arch
`/etc/X11/xinit/xinitrc` runs `twm`, `xclock` and 3 `xterm`s; users are
meant to just copy that to `~/.xinitrc` and
[customize](https://wiki.archlinux.org/title/Xinit#xinitrc) it: replace the
last few lines with `exec xmonad`.
Display managers like `lightdm` have their own `Xsession` script which invokes
`~/.xsession`. Other display managers need an entry in
`/usr/share/xsessions`, <https://aur.archlinux.org/packages/xinit-xsession/>
provides one.
#### See also
* <https://xmonad.org/documentation.html#in-your-environment>
* [FAQ: How can I use xmonad with a display manager? (xdm, kdm, gdm)](https://wiki.haskell.org/Xmonad/Frequently_asked_questions#How_can_I_use_xmonad_with_a_display_manager.3F_.28xdm.2C_kdm.2C_gdm.29)
## Custom Build Script
If you need to customize what happens during `xmonad --recompile` (bound to
`M-q` by default), perhaps because your xmonad configuration is a whole
separate Haskell package, you need to create a so-called `build` file. This
is quite literally just a shell script called `build` in your xmonad directory
(which is `~/.config/xmonad` for us) that tells xmonad how it should build its
executable.
A good starting point (this is essentially [what xmonad would do][]
without a build file, with the exception that we are invoking `stack
ghc` instead of plain `ghc`) would be
``` shell
#!/bin/sh
exec stack ghc -- \
--make xmonad.hs \
-i \
-ilib \
-fforce-recomp \
-main-is main \
-v0 \
-o "$1"
```
Don't forget to mark the file as `+x`: `chmod +x build`!
Some example build scripts for `stack` and `cabal` are provided in the
`xmonad-contrib` distribution. You can see those online in the
[scripts/build][] directory. You might wish to use these if you have
special dependencies for your `xmonad.hs`, especially with cabal as
you must use a cabal file and often a `cabal.project` to specify them;
`cabal install --lib` above generally isn't enough, and when it is
it can be difficult to keep track of when you want to replicate your
configuration on another system.
#### Don't Recompile on Every Startup
By default, xmonad always recompiles itself when a build script is used
(because the build script could contain arbitrary code, so a simple
check whether the `xmonad.hs` file changed is not enough). If you find
that too annoying, then you can use the `xmonad-ARCH` executable that
`xmonad --recompile` generates instead of `xmonad` in your startup. For
example, instead of writing
``` shell
exec xmonad
```
in your `~/.xinitrc`, you would write
``` shell
exec $HOME/.cache/xmonad/xmonad-x86_64-linux
```
The `~/.cache` prefix is the `$XDG_CACHE_HOME` directory. Note that
if your xmonad configuration resides within `~/.xmonad`, then the
executable will also be within that directory and not in
`$XDG_CACHE_HOME`.
[XDG]: https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
[git]: https://git-scm.com/
[stack]: https://docs.haskellstack.org/en/stable/README/
[cabal-install]: https://www.haskell.org/cabal/
[GHCup]: https://www.haskell.org/ghcup/
[survey]: https://taylor.fausak.me/2022/11/18/haskell-survey-results/
[widely available]: https://www.haskell.org/ghcup/install/#supported-platforms
[what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667
[Hackage]: https://hackage.haskell.org/
[scripts/build]: https://github.com/xmonad/xmonad-contrib/blob/master/scripts/build

45
LICENSE
View File

@ -1,28 +1,31 @@
Copyright (c) 2007,2008 Spencer Janssen Copyright (c) 2007,2008 Spencer Janssen
Copyright (c) 2007,2008 Don Stewart Copyright (c) 2007,2008 Don Stewart
Copyright (c) The Xmonad Community. All rights reserved.
Redistribution and use in source and binary forms, with or without modification, All rights reserved.
are permitted provided that the following conditions are met:
1. Redistributions of source code must retain the above copyright notice, Redistribution and use in source and binary forms, with or without
this list of conditions and the following disclaimer. modification, are permitted provided that the following conditions
are met:
2. Redistributions in binary form must reproduce the above copyright notice, 1. Redistributions of source code must retain the above copyright
this list of conditions and the following disclaimer in the documentation notice, this list of conditions and the following disclaimer.
and/or other materials provided with the distribution.
3. Neither the name of the copyright holder nor the names of its contributors 2. Redistributions in binary form must reproduce the above copyright
may be used to endorse or promote products derived from this software without notice, this list of conditions and the following disclaimer in the
specific prior written permission. documentation and/or other materials provided with the distribution.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 3. Neither the name of the author nor the names of his contributors
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE may be used to endorse or promote products derived from this software
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE without specific prior written permission.
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
POSSIBILITY OF SUCH DAMAGE.

View File

@ -2,145 +2,82 @@
## The XMonad Core Team ## The XMonad Core Team
* Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`, [GPG][gpg:geekosaur] * Adam Vogt [GitHub][aavogt]
* Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`
* Brent Yorgey [GitHub][byorgey], IRC: `byorgey` * Brent Yorgey [GitHub][byorgey], IRC: `byorgey`
* Daniel Wagner [GitHub][dmwit], [Twitter][twitter:dmwit], IRC: `dmwit` * Daniel Wagner [GitHub][dmwit], IRC: `dmwit`
* Sibi Prabakaran [GitHub][psibi], [Twitter][twitter:psibi], IRC: `sibi` * David Lazar [GitHub][davidlazar]
* Tomáš Janoušek [GitHub][liskin], [Twitter][twitter:liskin], IRC: `liskin`, [GPG][gpg:liskin] * Devin Mullins [GitHub][twifkak]
* Tony Zorman [GitHub][slotThe], IRC: `Solid`, [GPG][gpg:slotThe] * Peter J. Jones [GitHub][pjones], [Twitter][twitter:pjones], [OpenPGP Key][pgp:pjones], IRC: `pmade`
[geekosaur]: https://github.com/geekosaur
[byorgey]: https://github.com/byorgey
[dmwit]: https://github.com/dmwit
[psibi]: https://github.com/psibi
[liskin]: https://github.com/liskin
[slotThe]: https://github.com/slotThe
[gpg:geekosaur]: https://github.com/geekosaur.gpg
[gpg:liskin]: https://github.com/liskin.gpg
[gpg:slotThe]: https://github.com/slotThe.gpg
[twitter:dmwit]: https://twitter.com/dmwit13
[twitter:psibi]: https://twitter.com/psibi
[twitter:liskin]: https://twitter.com/Liskni_si
## Hall of Fame (past maintainers/developers)
* Adam Vogt [GitHub](https://github.com/aavogt)
* Peter Simons [GitHub](https://github.com/peti), [Twitter](https://twitter.com/OriginalPeti)
* Spencer Janssen [GitHub](https://github.com/spencerjanssen)
* Don Stewart [GitHub](https://github.com/donsbot), [Twitter](https://twitter.com/donsbot)
* Jason Creighton [GitHub](https://github.com/JasonCreighton)
* David Roundy [GitHub](https://github.com/droundy)
* Daniel Schoepe [GitHub](https://github.com/dschoepe)
* Eric Mertens [GitHub](https://github.com/glguy)
* Nicolas Pouillard [GitHub](https://github.com/np)
* Roman Cheplyaka [GitHub](https://github.com/UnkindPartition)
* Gwern Branwen [GitHub](https://github.com/gwern)
* Lukas Mai [GitHub](https://github.com/mauke)
* Braden Shepherdson [GitHub](https://github.com/shepheb)
* Devin Mullins [GitHub](https://github.com/twifkak)
* David Lazar [GitHub](https://github.com/davidlazar)
* Peter J. Jones [GitHub](https://github.com/pjones)
## Release Procedures ## Release Procedures
When the time comes to release another version of xmonad and xmonad-contrib: When the time comes to release another version of XMonad and Contrib...
1. Update the version number in all the `*.cabal` files and let the CI 1. Create a release branch (e.g., `release-0.XX`).
verify that it all builds together.
2. Review documentation files and make sure they are accurate: This will allow you to separate the release process from main
development. Changes you make on this branch will be merged back
into `master` as one of the last steps.
- [`README.md`](README.md) 2. Update the version number in the `*.cabal` files and verify
- [`CHANGES.md`](CHANGES.md) (bump version, set date) dependencies and documentation. This includes the `tested-with:`
- [`INSTALL.md`](INSTALL.md) field.
- [`man/xmonad.1.markdown.in`](man/xmonad.1.markdown.in)
- [haddocks](https://xmonad.github.io/xmonad-docs/)
If the manpage changes, wait for the CI to rebuild the rendered outputs. 3. Use the [packdeps][] tool to ensure you have the dependency
versions correct. If you need to update the version of a
dependency then you should rebuild and retest.
3. Update the website: 4. Review documentation files and make sure they are accurate:
- Draft a [new release announcement][web-announce]. - `README.md`
- Check install instructions, guided tour, keybindings cheat sheet, … - `CHANGES.md`
- and the `example-config.hs` in the `xmonad-testing` repo
4. Make sure that `tested-with:` covers several recent releases of GHC, that 5. Generate the manpage:
`.github/workflows/haskell-ci.yml` had been updated to test all these GHC
versions and that `.github/workflows/stack.yml` tests with several recent
revisions of [Stackage][] LTS.
5. Trigger the Haskell-CI workflow and fill in the candidate version number. * `cabal configure` with the `-fgeneratemanpage` flag
This will upload a release candidate to Hackage. * Build the project
* Run the `generatemanpage` tool from the top level of this repo
* Review the man page: `man -l man/xmonad.1`
- https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml 6. Tag the repository with the release version (e.g., `v0.13`)
- https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml
Check that everything looks good. If not, push fixes and do another 7. Build the project tarballs (`cabal sdist`)
candidate. When everything's ready, create a release on GitHub:
- https://github.com/xmonad/xmonad/releases/new 8. Upload the packages to Hackage (`cabal upload`)
- https://github.com/xmonad/xmonad-contrib/releases/new
CI will automatically upload the final release to Hackage. 9. Merge the release branches into `master`
See [haskell-ci-hackage.patch][] for details about the Hackage automation. 10. Update the website:
6. Post announcement to: * Generate and push haddocks with `xmonad-web/gen-docs.sh`
- [xmonad.org website](https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts) * Check that `tour.html` and `intro.html` are up to date, and
- [XMonad mailing list](https://mail.haskell.org/mailman/listinfo/xmonad) mention all core bindings
- [Haskell Cafe](https://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe)
- [Haskell Discourse](https://discourse.haskell.org/)
- [Twitter](https://twitter.com/xmonad)
- [Reddit](https://www.reddit.com/r/xmonad/)
See [old announcements][old-announce] ([even older][older-announce]) for inspiration. 11. Update the topic for the IRC channel (`#xmonad`)
7. Trigger xmonad-docs build to generate and persist docs for the just 12. Send the `announce-0.XX.txt` file to:
released version:
- https://github.com/xmonad/xmonad-docs/actions/workflows/stack.yml - XMonad mailing list
- Haskell Cafe
8. Bump version for development (add `.9`) and prepare fresh sections in [packdeps]: http://hackage.haskell.org/package/packdeps
[`CHANGES.md`](CHANGES.md).
[packdeps]: https://hackage.haskell.org/package/packdeps [aavogt]: https://github.com/orgs/xmonad/people/aavogt
[Stackage]: https://www.stackage.org/ [geekosaur]: https://github.com/orgs/xmonad/people/geekosaur
[haskell-ci-hackage.patch]: .github/workflows/haskell-ci-hackage.patch [byorgey]: https://github.com/orgs/xmonad/people/byorgey
[web-announce]: https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts [dmwit]: https://github.com/orgs/xmonad/people/dmwit
[old-announce]: https://github.com/xmonad/xmonad-web/blob/gh-pages/news/_posts/2021-10-27-xmonad-0-17-0.md [davidlazar]: https://github.com/orgs/xmonad/people/davidlazar
[older-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768 [twifkak]: https://github.com/orgs/xmonad/people/twifkak
## Website and Other Accounts [pjones]: https://github.com/orgs/xmonad/people/pjones
[twitter:pjones]: https://twitter.com/contextualdev
* The [xmonad twitter] is tended to by [liskin]. [pgp:pjones]: http://pgp.mit.edu/pks/lookup?op=get&search=0x526722D1204284CB
* The [xmonad.org] domain is owned by [eyenx] and the website itself is
deployed via GitHub Pages. It can be updated by making a pull request
against the [xmonad-web] repository.
[eyenx]: https://github.com/eyenx
[xmonad-web]: https://github.com/xmonad/xmonad-web/
[xmonad.org]: https://xmonad.org/
[xmonad twitter]: https://twitter.com/xmonad

187
README.md
View File

@ -1,27 +1,8 @@
<p align="center"> # xmonad: A Tiling Window Manager
<a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a>
</p>
<p align="center">
<a href="https://hackage.haskell.org/package/xmonad"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell"></a>
<a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad"></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/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/stack.yml?label=Stack&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/haskell-ci.yml?label=Cabal&logo=githubactions&logoColor=white"></a>
<a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/nix.yml?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>
<br>
<a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>
<a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a>
</p>
# xmonad [![Build Status](https://travis-ci.org/xmonad/xmonad.svg?branch=master)](https://travis-ci.org/xmonad/xmonad)
**A tiling window manager for X11.** [xmonad][] is a tiling window manager for X. Windows are arranged
[XMonad][web:xmonad] is a tiling window manager for X11. Windows are arranged
automatically to tile the screen without gaps or overlap, maximising automatically to tile the screen without gaps or overlap, maximising
screen use. Window manager features are accessible from the keyboard: screen use. Window manager features are accessible from the keyboard:
a mouse is optional. xmonad is written, configured and extensible in a mouse is optional. xmonad is written, configured and extensible in
@ -31,74 +12,118 @@ dynamically, and different layouts may be used on each
workspace. Xinerama is fully supported, allowing windows to be tiled workspace. Xinerama is fully supported, allowing windows to be tiled
on several physical screens. on several physical screens.
This repository contains the [xmonad][hackage:xmonad] package, a minimal, ## Quick Start
stable, yet extensible core. It is accompanied by
[xmonad-contrib][gh:xmonad-contrib], a library of hundreds of additional
community-maintained tiling algorithms and extension modules. The two combined
make for a powerful X11 window-manager with endless customization
possibilities. They are, quite literally, libraries for creating your own
window manager.
## Installation * From hackage:
For installation and configuration instructions, please see: cabal update
cabal install xmonad xmonad-contrib
* [downloading and installing xmonad][web:download] * Alternatively, build from source using the following repositories:
* [installing latest xmonad snapshot from git][web:install]
* [configuring xmonad][web:tutorial]
If you run into any trouble, consult our [documentation][web:documentation] or - <https://github.com/xmonad/xmonad>
ask the [community][web:community] for help.
## Contributing - <https://github.com/xmonad/xmonad-contrib>
We welcome all forms of contributions: For the full story, read on.
* [bug reports and feature ideas][gh:xmonad:issues] ## Building
(also to [xmonad-contrib][gh:xmonad-contrib:issues])
* [bug fixes, new features, new extensions][gh:xmonad:pulls]
(usually to [xmonad-contrib][gh:xmonad-contrib:pulls])
* documentation fixes and improvements: [xmonad][gh:xmonad],
[xmonad-contrib][gh:xmonad-contrib], [xmonad-web][gh:xmonad-web]
* helping others in the [community][web:community]
* financial support: [GitHub Sponsors][gh:xmonad:sponsors],
[Open Collective][opencollective:xmonad]
Please do read the [CONTRIBUTING][gh:xmonad:contributing] document for more Building is quite straightforward, and requires a basic Haskell toolchain.
information about bug reporting and code contributions. For a brief overview On many systems xmonad is available as a binary package in your
of the architecture and code conventions, see the [documentation for the package system (e.g. on Debian or Gentoo). If at all possible, use this
`XMonad.Doc.Developing` module][doc:developing]. If in doubt, [talk to in preference to a source build, as the dependency resolution will be
us][web:community]. simpler.
We'll now walk through the complete list of toolchain dependencies.
* GHC: the Glasgow Haskell Compiler
You first need a Haskell compiler. Your distribution's package
system will have binaries of GHC (the Glasgow Haskell Compiler),
the compiler we use, so install that first. If your operating
system's package system doesn't provide a binary version of GHC
and the `cabal-install` tool, you can install both using the
[Haskell Platform][platform].
It shouldn't be necessary to compile GHC from source -- every common
system has a pre-build binary version. However, if you want to
build from source, the following links will be helpful:
- GHC: <http://haskell.org/ghc/>
- Cabal: <http://haskell.org/cabal/download.html>
* X11 libraries:
Since you're building an X application, you'll need the C X11
library headers. On many platforms, these come pre-installed. For
others, such as Debian, you can get them from your package manager:
# for xmonad
$ apt-get install libx11-dev libxinerama-dev libxext-dev libxrandr-dev libxss-dev
# for xmonad-contrib
$ apt-get install libxft-dev
Then build and install with:
$ cabal install
## Running xmonad
If you built XMonad using `cabal` then add:
exec $HOME/.cabal/bin/xmonad
to the last line of your `.xsession` or `.xinitrc` file.
## Configuring
See the [CONFIG][] document and the [example configuration file][example-config].
## XMonadContrib
There are many extensions to xmonad available in the XMonadContrib
(xmc) library. Examples include an ion3-like tabbed layout, a
prompt/program launcher, and various other useful modules.
XMonadContrib is available at:
* Latest release: <http://hackage.haskell.org/package/xmonad-contrib>
* Git version: <https://github.com/xmonad/xmonad-contrib>
## Other Useful Programs
A nicer xterm replacement, that supports resizing better:
* urxvt: <http://software.schmorp.de/pkg/rxvt-unicode.html>
For custom status bars:
* xmobar: <http://hackage.haskell.org/package/xmobar>
* taffybar: <https://github.com/travitch/taffybar>
* dzen: <http://gotmor.googlepages.com/dzen>
For a program dispatch menu:
* [XMonad.Prompt.Shell][xmc-prompt-shell]: (from [XMonadContrib][])
* dmenu: <http://www.suckless.org/download/>
* gmrun: (in your package system)
## Authors ## Authors
Started in 2007 by [Spencer Janssen][gh:spencerjanssen], [Don * Spencer Janssen
Stewart][gh:donsbot] and [Jason Creighton][gh:JasonCreighton], the * Don Stewart
[XMonad][web:xmonad] project lives on thanks to [new generations of * Jason Creighton
maintainers][gh:xmonad:maintainers] and [dozens of
contributors][gh:xmonad:contributors].
[gh:spencerjanssen]: https://github.com/spencerjanssen [xmonad]: http://xmonad.org
[gh:donsbot]: https://github.com/donsbot [xmonadcontrib]: https://hackage.haskell.org/package/xmonad-contrib
[gh:JasonCreighton]: https://github.com/JasonCreighton [xmc-prompt-shell]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Prompt-Shell.html
[platform]: http://haskell.org/platform/
[doc:developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html [example-config]: https://github.com/xmonad/xmonad-testing/blob/master/example-config.hs
[gh:xmonad-contrib:issues]: https://github.com/xmonad/xmonad-contrib/issues [config]: https://github.com/xmonad/xmonad/blob/master/CONFIG
[gh:xmonad-contrib:pulls]: https://github.com/xmonad/xmonad-contrib/pulls
[gh:xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
[gh:xmonad-web]: https://github.com/xmonad/xmonad-web
[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md
[gh:xmonad:contributors]: https://github.com/xmonad/xmonad/graphs/contributors
[gh:xmonad:issues]: https://github.com/xmonad/xmonad/issues
[gh:xmonad:maintainers]: https://github.com/xmonad/xmonad/blob/master/MAINTAINERS.md
[gh:xmonad:pulls]: https://github.com/xmonad/xmonad/pulls
[gh:xmonad:sponsors]: https://github.com/sponsors/xmonad
[gh:xmonad]: https://github.com/xmonad/xmonad
[hackage:xmonad]: https://hackage.haskell.org/package/xmonad
[opencollective:xmonad]: https://opencollective.com/xmonad
[web:community]: https://xmonad.org/community.html
[web:documentation]: https://xmonad.org/documentation.html
[web:download]: https://xmonad.org/download.html
[web:install]: https://xmonad.org/INSTALL.html
[web:tutorial]: https://xmonad.org/TUTORIAL.html
[web:xmonad]: https://xmonad.org/

22
STYLE Normal file
View File

@ -0,0 +1,22 @@
== Coding guidelines for contributing to
== xmonad and the xmonad contributed extensions
* Comment every top level function (particularly exported functions), and
provide a type signature; use Haddock syntax in the comments.
* Follow the coding style of the other modules.
* Code should be compilable with -Wall -Werror -fno-warn-unused-do-bind -fwarn-tabs.
There should be no warnings.
* Partial functions should be avoided: the window manager should not
crash, so do not call `error` or `undefined`
* Use 4 spaces for indenting.
* Any pure function added to the core should have QuickCheck properties
precisely defining its behavior.
* New modules should identify the author, and be submitted under
the same license as xmonad (BSD3 license or freer).

File diff suppressed because it is too large Load Diff

View File

@ -1,17 +0,0 @@
apt:
libx11-dev
libxext-dev
libxinerama-dev
libxrandr-dev
libxss-dev
github-patches:
.github/workflows/haskell-ci-hackage.patch
raw-project
optimization: False
package xmonad
flags: +pedantic
-- avoid --haddock-all which overwrites *-docs.tar.gz with tests docs
haddock-components: libs

View File

@ -1,4 +1 @@
-- cabal.project packages: ./
packages:
xmonad.cabal

106
flake.nix
View File

@ -1,106 +0,0 @@
# This file is maintained by @IvanMalison and @LSLeary (github)
# See xmonad-contrib/NIX.md for an overview of module usage.
{
inputs = {
flake-utils.url = "github:numtide/flake-utils";
git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master";
unstable.url = "github:NixOS/nixpkgs/nixos-unstable";
};
outputs = { self, flake-utils, nixpkgs, unstable, git-ignore-nix }:
let
hpath = { prefix ? null, compiler ? null }:
(if prefix == null then [] else [ prefix ]) ++
(if compiler == null
then [ "haskellPackages" ]
else [ "haskell" "packages" compiler ]
);
fromHOL = hol: comp: final: prev: with prev.lib; with attrsets;
let
path = hpath comp;
root = head path;
branch = tail path;
hpkgs' = (getAttrFromPath path prev).override (old: {
overrides = composeExtensions (old.overrides or (_: _: {}))
(hol final prev);
});
in {
${root} = recursiveUpdate prev.${root} (setAttrByPath branch hpkgs');
};
hoverlay = final: prev: hself: hsuper:
with prev.haskell.lib.compose; {
xmonad = hself.callCabal2nix "xmonad"
(git-ignore-nix.lib.gitignoreSource ./.) { };
};
defComp = if builtins.pathExists ./comp.nix
then import ./comp.nix
else { };
overlay = fromHOL hoverlay defComp;
overlays = [ overlay ];
nixosModule = { config, pkgs, lib, ... }: with lib; with attrsets;
let
cfg = config.services.xserver.windowManager.xmonad.flake;
comp = { inherit (cfg) prefix compiler; };
in {
options = {
services.xserver.windowManager.xmonad.flake = with types; {
enable = mkEnableOption "flake";
prefix = mkOption {
default = null;
type = nullOr str;
example = literalExpression "\"unstable\"";
description = ''
Specify a nested alternative <literal>pkgs</literal> by attrName.
'';
};
compiler = mkOption {
default = null;
type = nullOr str;
example = literalExpression "\"ghc922\"";
description = ''
Which compiler to build xmonad with.
Must be an attribute of <literal>pkgs.haskell.packages</literal>.
Sets <option>xmonad.haskellPackages</option> to match.
'';
};
};
};
config = mkIf cfg.enable {
nixpkgs.overlays = [ (fromHOL hoverlay comp) ];
services.xserver.windowManager.xmonad.haskellPackages =
getAttrFromPath (hpath comp) pkgs;
};
};
nixosModules = [ nixosModule ];
in flake-utils.lib.eachDefaultSystem (system:
let pkgs = import nixpkgs { inherit system overlays; };
hpkg = pkgs.lib.attrsets.getAttrFromPath (hpath defComp) pkgs;
modifyDevShell =
if builtins.pathExists ./develop.nix
then import ./develop.nix
else _: x: x;
in
rec {
devShell = hpkg.shellFor (modifyDevShell pkgs {
packages = p: [ p.xmonad ];
});
defaultPackage = hpkg.xmonad;
# An auxiliary NixOS module that modernises the standard xmonad NixOS module
# and wrapper script used, replacing them with versions from unstable.
# Currently, due to the NIX_GHC --> XMONAD_GHC env var change, this is
# necessary in order for Mod-q recompilation to work out-of-the-box.
modernise =
let
xmonadModFile = "services/x11/window-managers/xmonad.nix";
unpkgs = import unstable { inherit system; };
replaceWrapper = _: _:
{ xmonad-with-packages = unpkgs.xmonad-with-packages; };
in {
disabledModules = [ xmonadModFile ];
imports = [ (unstable + "/nixos/modules/" + xmonadModFile) ];
nixpkgs.overlays = [ replaceWrapper ];
};
}) // {
inherit hoverlay overlay overlays nixosModule nixosModules;
lib = { inherit hpath fromHOL; };
};
}

View File

@ -1,11 +0,0 @@
.PHONY: all
all: xmonad.1 xmonad.1.html
xmonad.1.markdown: xmonad.1.markdown.in
(cd .. && util/GenerateManpage.hs) <$< >$@
xmonad.1: xmonad.1.markdown
pandoc --from=markdown --to=man --standalone --output=$@ $<
xmonad.1.html: xmonad.1.markdown
pandoc --from=markdown --to=html --standalone --table-of-contents --output=$@ $<

View File

@ -1,27 +1,13 @@
.\" Automatically generated by Pandoc 3.1.3 .\" Automatically generated by Pandoc 2.2.1
.\" .\"
.\" Define V font for inline verbatim, using C font in formats .TH "XMONAD" "1" "20 August 2018" "Tiling Window Manager" ""
.\" that render this, and otherwise B font.
.ie "\f[CB]x\f[]"x" \{\
. ftr V B
. ftr VI BI
. ftr VB B
. ftr VBI BI
.\}
.el \{\
. ftr V CR
. ftr VI CI
. ftr VB CB
. ftr VBI CBI
.\}
.TH "XMONAD" "1" "27 October 2021" "Tiling Window Manager" ""
.hy .hy
.SH Name .SH Name
.PP .PP
xmonad - Tiling Window Manager xmonad \- Tiling Window Manager
.SH Description .SH Description
.PP .PP
\f[I]xmonad\f[R] is a minimalist tiling window manager for X, written in \f[I]xmonad\f[] is a minimalist tiling window manager for X, written in
Haskell. Haskell.
Windows are managed using automatic layout algorithms, which can be Windows are managed using automatic layout algorithms, which can be
dynamically reconfigured. dynamically reconfigured.
@ -29,14 +15,14 @@ At any time windows are arranged so as to maximize the use of screen
real estate. real estate.
All features of the window manager are accessible purely from the All features of the window manager are accessible purely from the
keyboard: a mouse is entirely optional. keyboard: a mouse is entirely optional.
\f[I]xmonad\f[R] is configured in Haskell, and custom layout algorithms \f[I]xmonad\f[] is configured in Haskell, and custom layout algorithms
may be implemented by the user in config files. may be implemented by the user in config files.
A principle of \f[I]xmonad\f[R] is predictability: the user should know A principle of \f[I]xmonad\f[] is predictability: the user should know
in advance precisely the window arrangement that will result from any in advance precisely the window arrangement that will result from any
action. action.
.PP .PP
By default, \f[I]xmonad\f[R] provides three layout algorithms: tall, By default, \f[I]xmonad\f[] provides three layout algorithms: tall, wide
wide and fullscreen. and fullscreen.
In tall or wide mode, windows are tiled and arranged to prevent overlap In tall or wide mode, windows are tiled and arranged to prevent overlap
and maximize screen use. and maximize screen use.
Sets of windows are grouped together on virtual screens, and each screen Sets of windows are grouped together on virtual screens, and each screen
@ -45,34 +31,34 @@ Multiple physical monitors are supported via Xinerama, allowing
simultaneous display of a number of screens. simultaneous display of a number of screens.
.PP .PP
By utilizing the expressivity of a modern functional language with a By utilizing the expressivity of a modern functional language with a
rich static type system, \f[I]xmonad\f[R] provides a complete, rich static type system, \f[I]xmonad\f[] provides a complete, featureful
featureful window manager in less than 1200 lines of code, with an window manager in less than 1200 lines of code, with an emphasis on
emphasis on correctness and robustness. correctness and robustness.
Internal properties of the window manager are checked using a Internal properties of the window manager are checked using a
combination of static guarantees provided by the type system, and combination of static guarantees provided by the type system, and
type-based automated testing. type\-based automated testing.
A benefit of this is that the code is simple to understand, and easy to A benefit of this is that the code is simple to understand, and easy to
modify. modify.
.SH Usage .SH Usage
.PP .PP
\f[I]xmonad\f[R] places each window into a \[lq]workspace\[rq]. \f[I]xmonad\f[] places each window into a \[lq]workspace\[rq].
Each workspace can have any number of windows, which you can cycle Each workspace can have any number of windows, which you can cycle
though with mod-j and mod-k. though with mod\-j and mod\-k.
Windows are either displayed full screen, tiled horizontally, or tiled Windows are either displayed full screen, tiled horizontally, or tiled
vertically. vertically.
You can toggle the layout mode with mod-space, which will cycle through You can toggle the layout mode with mod\-space, which will cycle through
the available modes. the available modes.
.PP .PP
You can switch to workspace N with mod-N. You can switch to workspace N with mod\-N.
For example, to switch to workspace 5, you would press mod-5. For example, to switch to workspace 5, you would press mod\-5.
Similarly, you can move the current window to another workspace with Similarly, you can move the current window to another workspace with
mod-shift-N. mod\-shift\-N.
.PP .PP
When running with multiple monitors (Xinerama), each screen has exactly When running with multiple monitors (Xinerama), each screen has exactly
1 workspace visible. 1 workspace visible.
mod-{w,e,r} switch the focus between screens, while shift-mod-{w,e,r} mod\-{w,e,r} switch the focus between screens, while shift\-mod\-{w,e,r}
move the current window to that screen. move the current window to that screen.
When \f[I]xmonad\f[R] starts, workspace 1 is on screen 1, workspace 2 is When \f[I]xmonad\f[] starts, workspace 1 is on screen 1, workspace 2 is
on screen 2, etc. on screen 2, etc.
When switching workspaces to one that is already visible, the current When switching workspaces to one that is already visible, the current
and visible workspaces are swapped. and visible workspaces are swapped.
@ -81,159 +67,221 @@ and visible workspaces are swapped.
xmonad has several flags which you may pass to the executable. xmonad has several flags which you may pass to the executable.
These flags are: These flags are:
.TP .TP
\[en]recompile .B \[en]recompile
Recompiles your \f[I]xmonad.hs\f[R] configuration Recompiles your configuration in \f[I]~/.xmonad/xmonad.hs\f[]
.RS
.RE
.TP .TP
\[en]restart .B \[en]restart
Causes the currently running \f[I]xmonad\f[R] process to restart Causes the currently running \f[I]xmonad\f[] process to restart
.RS
.RE
.TP .TP
\[en]replace .B \[en]replace
Replace the current window manager with xmonad Replace the current window manager with xmonad
.RS
.RE
.TP .TP
\[en]version .B \[en]version
Display version of \f[I]xmonad\f[R] Display version of \f[I]xmonad\f[]
.RS
.RE
.TP .TP
\[en]verbose-version .B \[en]verbose\-version
Display detailed version of \f[I]xmonad\f[R] Display detailed version of \f[I]xmonad\f[]
.SS Default keyboard bindings .RS
.RE
.PP
##Default keyboard bindings
.TP .TP
mod-shift-return .B mod\-shift\-return
Launch terminal Launch terminal
.RS
.RE
.TP .TP
mod-p .B mod\-p
Launch dmenu Launch dmenu
.RS
.RE
.TP .TP
mod-shift-p .B mod\-shift\-p
Launch gmrun Launch gmrun
.RS
.RE
.TP .TP
mod-shift-c .B mod\-shift\-c
Close the focused window Close the focused window
.RS
.RE
.TP .TP
mod-space .B mod\-space
Rotate through the available layout algorithms Rotate through the available layout algorithms
.RS
.RE
.TP .TP
mod-shift-space .B mod\-shift\-space
Reset the layouts on the current workspace to default Reset the layouts on the current workspace to default
.RS
.RE
.TP .TP
mod-n .B mod\-n
Resize viewed windows to the correct size Resize viewed windows to the correct size
.RS
.RE
.TP .TP
mod-tab .B mod\-tab
Move focus to the next window Move focus to the next window
.RS
.RE
.TP .TP
mod-shift-tab .B mod\-shift\-tab
Move focus to the previous window Move focus to the previous window
.RS
.RE
.TP .TP
mod-j .B mod\-j
Move focus to the next window Move focus to the next window
.RS
.RE
.TP .TP
mod-k .B mod\-k
Move focus to the previous window Move focus to the previous window
.RS
.RE
.TP .TP
mod-m .B mod\-m
Move focus to the master window Move focus to the master window
.RS
.RE
.TP .TP
mod-return .B mod\-return
Swap the focused window and the master window Swap the focused window and the master window
.RS
.RE
.TP .TP
mod-shift-j .B mod\-shift\-j
Swap the focused window with the next window Swap the focused window with the next window
.RS
.RE
.TP .TP
mod-shift-k .B mod\-shift\-k
Swap the focused window with the previous window Swap the focused window with the previous window
.RS
.RE
.TP .TP
mod-h .B mod\-h
Shrink the master area Shrink the master area
.RS
.RE
.TP .TP
mod-l .B mod\-l
Expand the master area Expand the master area
.RS
.RE
.TP .TP
mod-t .B mod\-t
Push window back into tiling Push window back into tiling
.RS
.RE
.TP .TP
mod-comma .B mod\-comma
Increment the number of windows in the master area Increment the number of windows in the master area
.RS
.RE
.TP .TP
mod-period .B mod\-period
Deincrement the number of windows in the master area Deincrement the number of windows in the master area
.RS
.RE
.TP .TP
mod-shift-q .B mod\-shift\-q
Quit xmonad Quit xmonad
.RS
.RE
.TP .TP
mod-q .B mod\-q
Restart xmonad Restart xmonad
.RS
.RE
.TP .TP
mod-shift-slash .B mod\-shift\-slash
Run xmessage with a summary of the default keybindings (useful for Run xmessage with a summary of the default keybindings (useful for
beginners) beginners)
.RS
.RE
.TP .TP
mod-question .B mod\-question
Run xmessage with a summary of the default keybindings (useful for Run xmessage with a summary of the default keybindings (useful for
beginners) beginners)
.RS
.RE
.TP .TP
mod-[1..9] .B mod\-[1..9]
Switch to workspace N Switch to workspace N
.RS
.RE
.TP .TP
mod-shift-[1..9] .B mod\-shift\-[1..9]
Move client to workspace N Move client to workspace N
.RS
.RE
.TP .TP
mod-{w,e,r} .B mod\-{w,e,r}
Switch to physical/Xinerama screens 1, 2, or 3 Switch to physical/Xinerama screens 1, 2, or 3
.RS
.RE
.TP .TP
mod-shift-{w,e,r} .B mod\-shift\-{w,e,r}
Move client to screen 1, 2, or 3 Move client to screen 1, 2, or 3
.RS
.RE
.TP .TP
mod-button1 .B mod\-button1
Set the window to floating mode and move by dragging Set the window to floating mode and move by dragging
.RS
.RE
.TP .TP
mod-button2 .B mod\-button2
Raise the window to the top of the stack Raise the window to the top of the stack
.RS
.RE
.TP .TP
mod-button3 .B mod\-button3
Set the window to floating mode and resize by dragging Set the window to floating mode and resize by dragging
.RS
.RE
.SH Examples .SH Examples
.PP .PP
To use xmonad as your window manager add to your To use xmonad as your window manager add to your \f[I]~/.xinitrc\f[]
\f[I]\[ti]/.xinitrc\f[R] file: file:
.RS .RS
.PP .PP
exec xmonad exec xmonad
.RE .RE
.SH Customization .SH Customization
.PP .PP
xmonad is customized in your \f[I]xmonad.hs\f[R], and then restarted xmonad is customized in ~/.xmonad/xmonad.hs, and then restarted with
with mod-q. mod\-q.
You can choose where your configuration file lives by
.IP "1." 3
Setting \f[V]XMONAD_DATA_DIR,\f[R] \f[V]XMONAD_CONFIG_DIR\f[R], and
\f[V]XMONAD_CACHE_DIR\f[R]; \f[I]xmonad.hs\f[R] is then expected to be
in \f[V]XMONAD_CONFIG_DIR\f[R].
.IP "2." 3
Creating \f[I]xmonad.hs\f[R] in \f[I]\[ti]/.xmonad\f[R].
.IP "3." 3
Creating \f[I]xmonad.hs\f[R] in \f[V]XDG_CONFIG_HOME\f[R].
Note that, in this case, xmonad will use \f[V]XDG_DATA_HOME\f[R] and
\f[V]XDG_CACHE_HOME\f[R] for its data and cache directory respectively.
.PP .PP
You can find many extensions to the core feature set in the xmonad- You can find many extensions to the core feature set in the xmonad\-
contrib package, available through your package manager or from contrib package, available through your package manager or from
xmonad.org (https://xmonad.org). xmonad.org (http://xmonad.org).
.SS Modular Configuration .SS Modular Configuration
.PP .PP
As of \f[I]xmonad-0.9\f[R], any additional Haskell modules may be placed As of \f[I]xmonad\-0.9\f[], any additional Haskell modules may be placed
in \f[I]\[ti]/.xmonad/lib/\f[R] are available in GHC\[cq]s searchpath. in \f[I]~/.xmonad/lib/\f[] are available in GHC's searchpath.
Hierarchical modules are supported: for example, the file Hierarchical modules are supported: for example, the file
\f[I]\[ti]/.xmonad/lib/XMonad/Stack/MyAdditions.hs\f[R] could contain: \f[I]~/.xmonad/lib/XMonad/Stack/MyAdditions.hs\f[] could contain:
.IP .IP
.nf .nf
\f[C] \f[C]
module XMonad.Stack.MyAdditions (function1) where module\ XMonad.Stack.MyAdditions\ (function1)\ where
function1 = error \[dq]function1: Not implemented yet!\[dq] \ \ function1\ =\ error\ "function1:\ Not\ implemented\ yet!"
\f[R] \f[]
.fi .fi
.PP .PP
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
module was contained within xmonad or xmonad-contrib. module was contained within xmonad or xmonad\-contrib.
.SH Bugs .SH Bugs
.PP .PP
Probably. Probably.

View File

@ -5,486 +5,240 @@
<meta name="generator" content="pandoc" /> <meta name="generator" content="pandoc" />
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" /> <meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
<meta name="author" content="" /> <meta name="author" content="" />
<meta name="dcterms.date" content="2021-10-27" /> <meta name="dcterms.date" content="2018-08-20" />
<title>XMONAD(1) Tiling Window Manager</title> <title>XMONAD(1) Tiling Window Manager</title>
<style> <style type="text/css">
html { code{white-space: pre-wrap;}
color: #1a1a1a; span.smallcaps{font-variant: small-caps;}
background-color: #fdfdfd; span.underline{text-decoration: underline;}
} div.column{display: inline-block; vertical-align: top; width: 50%;}
body {
margin: 0 auto;
max-width: 36em;
padding-left: 50px;
padding-right: 50px;
padding-top: 50px;
padding-bottom: 50px;
hyphens: auto;
overflow-wrap: break-word;
text-rendering: optimizeLegibility;
font-kerning: normal;
}
@media (max-width: 600px) {
body {
font-size: 0.9em;
padding: 12px;
}
h1 {
font-size: 1.8em;
}
}
@media print {
html {
background-color: white;
}
body {
background-color: transparent;
color: black;
font-size: 12pt;
}
p, h2, h3 {
orphans: 3;
widows: 3;
}
h2, h3, h4 {
page-break-after: avoid;
}
}
p {
margin: 1em 0;
}
a {
color: #1a1a1a;
}
a:visited {
color: #1a1a1a;
}
img {
max-width: 100%;
}
h1, h2, h3, h4, h5, h6 {
margin-top: 1.4em;
}
h5, h6 {
font-size: 1em;
font-style: italic;
}
h6 {
font-weight: normal;
}
ol, ul {
padding-left: 1.7em;
margin-top: 1em;
}
li > ol, li > ul {
margin-top: 0;
}
blockquote {
margin: 1em 0 1em 1.7em;
padding-left: 1em;
border-left: 2px solid #e6e6e6;
color: #606060;
}
code {
font-family: Menlo, Monaco, Consolas, 'Lucida Console', monospace;
font-size: 85%;
margin: 0;
hyphens: manual;
}
pre {
margin: 1em 0;
overflow: auto;
}
pre code {
padding: 0;
overflow: visible;
overflow-wrap: normal;
}
.sourceCode {
background-color: transparent;
overflow: visible;
}
hr {
background-color: #1a1a1a;
border: none;
height: 1px;
margin: 1em 0;
}
table {
margin: 1em 0;
border-collapse: collapse;
width: 100%;
overflow-x: auto;
display: block;
font-variant-numeric: lining-nums tabular-nums;
}
table caption {
margin-bottom: 0.75em;
}
tbody {
margin-top: 0.5em;
border-top: 1px solid #1a1a1a;
border-bottom: 1px solid #1a1a1a;
}
th {
border-top: 1px solid #1a1a1a;
padding: 0.25em 0.5em 0.25em 0.5em;
}
td {
padding: 0.125em 0.5em 0.25em 0.5em;
}
header {
margin-bottom: 4em;
text-align: center;
}
#TOC li {
list-style: none;
}
#TOC ul {
padding-left: 1.3em;
}
#TOC > ul {
padding-left: 0;
}
#TOC a:not(:hover) {
text-decoration: none;
}
code{white-space: pre-wrap;}
span.smallcaps{font-variant: small-caps;}
div.columns{display: flex; gap: min(4vw, 1.5em);}
div.column{flex: auto; overflow-x: auto;}
div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
/* The extra [class] is a hack that increases specificity enough to
override a similar rule in reveal.js */
ul.task-list[class]{list-style: none;}
ul.task-list li input[type="checkbox"] {
font-size: inherit;
width: 0.8em;
margin: 0 0.8em 0.2em -1.6em;
vertical-align: middle;
}
.display.math{display: block; text-align: center; margin: 0.5rem auto;}
/* CSS for syntax highlighting */
pre > code.sourceCode { white-space: pre; position: relative; }
pre > code.sourceCode > span { line-height: 1.25; }
pre > code.sourceCode > span:empty { height: 1.2em; }
.sourceCode { overflow: visible; }
code.sourceCode > span { color: inherit; text-decoration: inherit; }
div.sourceCode { margin: 1em 0; }
pre.sourceCode { margin: 0; }
@media screen {
div.sourceCode { overflow: auto; }
}
@media print {
pre > code.sourceCode { white-space: pre-wrap; }
pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }
}
pre.numberSource code
{ counter-reset: source-line 0; }
pre.numberSource code > span
{ position: relative; left: -4em; counter-increment: source-line; }
pre.numberSource code > span > a:first-child::before
{ content: counter(source-line);
position: relative; left: -1em; text-align: right; vertical-align: baseline;
border: none; display: inline-block;
-webkit-touch-callout: none; -webkit-user-select: none;
-khtml-user-select: none; -moz-user-select: none;
-ms-user-select: none; user-select: none;
padding: 0 4px; width: 4em;
color: #aaaaaa;
}
pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
div.sourceCode
{ }
@media screen {
pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }
}
code span.al { color: #ff0000; font-weight: bold; } /* Alert */
code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
code span.at { color: #7d9029; } /* Attribute */
code span.bn { color: #40a070; } /* BaseN */
code span.bu { color: #008000; } /* BuiltIn */
code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
code span.ch { color: #4070a0; } /* Char */
code span.cn { color: #880000; } /* Constant */
code span.co { color: #60a0b0; font-style: italic; } /* Comment */
code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
code span.do { color: #ba2121; font-style: italic; } /* Documentation */
code span.dt { color: #902000; } /* DataType */
code span.dv { color: #40a070; } /* DecVal */
code span.er { color: #ff0000; font-weight: bold; } /* Error */
code span.ex { } /* Extension */
code span.fl { color: #40a070; } /* Float */
code span.fu { color: #06287e; } /* Function */
code span.im { color: #008000; font-weight: bold; } /* Import */
code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
code span.kw { color: #007020; font-weight: bold; } /* Keyword */
code span.op { color: #666666; } /* Operator */
code span.ot { color: #007020; } /* Other */
code span.pp { color: #bc7a00; } /* Preprocessor */
code span.sc { color: #4070a0; } /* SpecialChar */
code span.ss { color: #bb6688; } /* SpecialString */
code span.st { color: #4070a0; } /* String */
code span.va { color: #19177c; } /* Variable */
code span.vs { color: #4070a0; } /* VerbatimString */
code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
</style> </style>
<style type="text/css">
a.sourceLine { display: inline-block; line-height: 1.25; }
a.sourceLine { pointer-events: none; color: inherit; text-decoration: inherit; }
a.sourceLine:empty { height: 1.2em; }
.sourceCode { overflow: visible; }
code.sourceCode { white-space: pre; position: relative; }
div.sourceCode { margin: 1em 0; }
pre.sourceCode { margin: 0; }
@media screen {
div.sourceCode { overflow: auto; }
}
@media print {
code.sourceCode { white-space: pre-wrap; }
a.sourceLine { text-indent: -1em; padding-left: 1em; }
}
pre.numberSource a.sourceLine
{ position: relative; left: -4em; }
pre.numberSource a.sourceLine::before
{ content: attr(data-line-number);
position: relative; left: -1em; text-align: right; vertical-align: baseline;
border: none; pointer-events: all; display: inline-block;
-webkit-touch-callout: none; -webkit-user-select: none;
-khtml-user-select: none; -moz-user-select: none;
-ms-user-select: none; user-select: none;
padding: 0 4px; width: 4em;
color: #aaaaaa;
}
pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
div.sourceCode
{ }
@media screen {
a.sourceLine::before { text-decoration: underline; }
}
code span.al { color: #ff0000; font-weight: bold; } /* Alert */
code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
code span.at { color: #7d9029; } /* Attribute */
code span.bn { color: #40a070; } /* BaseN */
code span.bu { } /* BuiltIn */
code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
code span.ch { color: #4070a0; } /* Char */
code span.cn { color: #880000; } /* Constant */
code span.co { color: #60a0b0; font-style: italic; } /* Comment */
code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
code span.do { color: #ba2121; font-style: italic; } /* Documentation */
code span.dt { color: #902000; } /* DataType */
code span.dv { color: #40a070; } /* DecVal */
code span.er { color: #ff0000; font-weight: bold; } /* Error */
code span.ex { } /* Extension */
code span.fl { color: #40a070; } /* Float */
code span.fu { color: #06287e; } /* Function */
code span.im { } /* Import */
code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
code span.kw { color: #007020; font-weight: bold; } /* Keyword */
code span.op { color: #666666; } /* Operator */
code span.ot { color: #007020; } /* Other */
code span.pp { color: #bc7a00; } /* Preprocessor */
code span.sc { color: #4070a0; } /* SpecialChar */
code span.ss { color: #bb6688; } /* SpecialString */
code span.st { color: #4070a0; } /* String */
code span.va { color: #19177c; } /* Variable */
code span.vs { color: #4070a0; } /* VerbatimString */
code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
</style>
<!--[if lt IE 9]>
<script src="//cdnjs.cloudflare.com/ajax/libs/html5shiv/3.7.3/html5shiv-printshiv.min.js"></script>
<![endif]-->
</head> </head>
<body> <body>
<header id="title-block-header"> <header>
<h1 class="title">XMONAD(1) Tiling Window Manager</h1> <h1 class="title">XMONAD(1) Tiling Window Manager</h1>
<p class="author"></p> <p class="author"></p>
<p class="date">27 October 2021</p> <p class="date">20 August 2018</p>
</header> </header>
<nav id="TOC" role="doc-toc"> <nav id="TOC">
<ul> <ul>
<li><a href="#name" id="toc-name">Name</a></li> <li><a href="#name">Name</a></li>
<li><a href="#description" id="toc-description">Description</a></li> <li><a href="#description">Description</a></li>
<li><a href="#usage" id="toc-usage">Usage</a> <li><a href="#usage">Usage</a><ul>
<ul> <li><a href="#flags">Flags</a></li>
<li><a href="#flags" id="toc-flags">Flags</a></li>
<li><a href="#default-keyboard-bindings"
id="toc-default-keyboard-bindings">Default keyboard bindings</a></li>
</ul></li> </ul></li>
<li><a href="#examples" id="toc-examples">Examples</a></li> <li><a href="#examples">Examples</a></li>
<li><a href="#customization" id="toc-customization">Customization</a> <li><a href="#customization">Customization</a><ul>
<ul> <li><a href="#modular-configuration">Modular Configuration</a></li>
<li><a href="#modular-configuration"
id="toc-modular-configuration">Modular Configuration</a></li>
</ul></li> </ul></li>
<li><a href="#bugs" id="toc-bugs">Bugs</a></li> <li><a href="#bugs">Bugs</a></li>
</ul> </ul>
</nav> </nav>
<h1 id="name">Name</h1> <h1 id="name">Name</h1>
<p>xmonad - Tiling Window Manager</p> <p>xmonad - Tiling Window Manager</p>
<h1 id="description">Description</h1> <h1 id="description">Description</h1>
<p><em>xmonad</em> is a minimalist tiling window manager for X, written <p><em>xmonad</em> is a minimalist tiling window manager for X, written in Haskell. Windows are managed using automatic layout algorithms, which can be dynamically reconfigured. At any time windows are arranged so as to maximize the use of screen real estate. All features of the window manager are accessible purely from the keyboard: a mouse is entirely optional. <em>xmonad</em> is configured in Haskell, and custom layout algorithms may be implemented by the user in config files. A principle of <em>xmonad</em> is predictability: the user should know in advance precisely the window arrangement that will result from any action.</p>
in Haskell. Windows are managed using automatic layout algorithms, which <p>By default, <em>xmonad</em> provides three layout algorithms: tall, wide and fullscreen. In tall or wide mode, windows are tiled and arranged to prevent overlap and maximize screen use. Sets of windows are grouped together on virtual screens, and each screen retains its own layout, which may be reconfigured dynamically. Multiple physical monitors are supported via Xinerama, allowing simultaneous display of a number of screens.</p>
can be dynamically reconfigured. At any time windows are arranged so as <p>By utilizing the expressivity of a modern functional language with a rich static type system, <em>xmonad</em> provides a complete, featureful window manager in less than 1200 lines of code, with an emphasis on correctness and robustness. Internal properties of the window manager are checked using a combination of static guarantees provided by the type system, and type-based automated testing. A benefit of this is that the code is simple to understand, and easy to modify.</p>
to maximize the use of screen real estate. All features of the window
manager are accessible purely from the keyboard: a mouse is entirely
optional. <em>xmonad</em> is configured in Haskell, and custom layout
algorithms may be implemented by the user in config files. A principle
of <em>xmonad</em> is predictability: the user should know in advance
precisely the window arrangement that will result from any action.</p>
<p>By default, <em>xmonad</em> provides three layout algorithms: tall,
wide and fullscreen. In tall or wide mode, windows are tiled and
arranged to prevent overlap and maximize screen use. Sets of windows are
grouped together on virtual screens, and each screen retains its own
layout, which may be reconfigured dynamically. Multiple physical
monitors are supported via Xinerama, allowing simultaneous display of a
number of screens.</p>
<p>By utilizing the expressivity of a modern functional language with a
rich static type system, <em>xmonad</em> provides a complete, featureful
window manager in less than 1200 lines of code, with an emphasis on
correctness and robustness. Internal properties of the window manager
are checked using a combination of static guarantees provided by the
type system, and type-based automated testing. A benefit of this is that
the code is simple to understand, and easy to modify.</p>
<h1 id="usage">Usage</h1> <h1 id="usage">Usage</h1>
<p><em>xmonad</em> places each window into a “workspace”. Each workspace <p><em>xmonad</em> places each window into a “workspace”. Each workspace can have any number of windows, which you can cycle though with mod-j and mod-k. Windows are either displayed full screen, tiled horizontally, or tiled vertically. You can toggle the layout mode with mod-space, which will cycle through the available modes.</p>
can have any number of windows, which you can cycle though with mod-j <p>You can switch to workspace N with mod-N. For example, to switch to workspace 5, you would press mod-5. Similarly, you can move the current window to another workspace with mod-shift-N.</p>
and mod-k. Windows are either displayed full screen, tiled horizontally, <p>When running with multiple monitors (Xinerama), each screen has exactly 1 workspace visible. mod-{w,e,r} switch the focus between screens, while shift-mod-{w,e,r} move the current window to that screen. When <em>xmonad</em> starts, workspace 1 is on screen 1, workspace 2 is on screen 2, etc. When switching workspaces to one that is already visible, the current and visible workspaces are swapped.</p>
or tiled vertically. You can toggle the layout mode with mod-space,
which will cycle through the available modes.</p>
<p>You can switch to workspace N with mod-N. For example, to switch to
workspace 5, you would press mod-5. Similarly, you can move the current
window to another workspace with mod-shift-N.</p>
<p>When running with multiple monitors (Xinerama), each screen has
exactly 1 workspace visible. mod-{w,e,r} switch the focus between
screens, while shift-mod-{w,e,r} move the current window to that screen.
When <em>xmonad</em> starts, workspace 1 is on screen 1, workspace 2 is
on screen 2, etc. When switching workspaces to one that is already
visible, the current and visible workspaces are swapped.</p>
<h2 id="flags">Flags</h2> <h2 id="flags">Flags</h2>
<p>xmonad has several flags which you may pass to the executable. These <p>xmonad has several flags which you may pass to the executable. These flags are:</p>
flags are:</p>
<dl> <dl>
<dt>recompile</dt> <dt>recompile</dt>
<dd> <dd>Recompiles your configuration in <em>~/.xmonad/xmonad.hs</em>
Recompiles your <em>xmonad.hs</em> configuration
</dd> </dd>
<dt>restart</dt> <dt>restart</dt>
<dd> <dd>Causes the currently running <em>xmonad</em> process to restart
Causes the currently running <em>xmonad</em> process to restart
</dd> </dd>
<dt>replace</dt> <dt>replace</dt>
<dd> <dd>Replace the current window manager with xmonad
Replace the current window manager with xmonad
</dd> </dd>
<dt>version</dt> <dt>version</dt>
<dd> <dd>Display version of <em>xmonad</em>
Display version of <em>xmonad</em>
</dd> </dd>
<dt>verbose-version</dt> <dt>verbose-version</dt>
<dd> <dd>Display detailed version of <em>xmonad</em>
Display detailed version of <em>xmonad</em>
</dd> </dd>
</dl> </dl>
<h2 id="default-keyboard-bindings">Default keyboard bindings</h2> <p>##Default keyboard bindings</p>
<dl> <dl>
<dt>mod-shift-return</dt> <dt>mod-shift-return</dt>
<dd> <dd>Launch terminal
Launch terminal
</dd> </dd>
<dt>mod-p</dt> <dt>mod-p</dt>
<dd> <dd>Launch dmenu
Launch dmenu
</dd> </dd>
<dt>mod-shift-p</dt> <dt>mod-shift-p</dt>
<dd> <dd>Launch gmrun
Launch gmrun
</dd> </dd>
<dt>mod-shift-c</dt> <dt>mod-shift-c</dt>
<dd> <dd>Close the focused window
Close the focused window
</dd> </dd>
<dt>mod-space</dt> <dt>mod-space</dt>
<dd> <dd>Rotate through the available layout algorithms
Rotate through the available layout algorithms
</dd> </dd>
<dt>mod-shift-space</dt> <dt>mod-shift-space</dt>
<dd> <dd>Reset the layouts on the current workspace to default
Reset the layouts on the current workspace to default
</dd> </dd>
<dt>mod-n</dt> <dt>mod-n</dt>
<dd> <dd>Resize viewed windows to the correct size
Resize viewed windows to the correct size
</dd> </dd>
<dt>mod-tab</dt> <dt>mod-tab</dt>
<dd> <dd>Move focus to the next window
Move focus to the next window
</dd> </dd>
<dt>mod-shift-tab</dt> <dt>mod-shift-tab</dt>
<dd> <dd>Move focus to the previous window
Move focus to the previous window
</dd> </dd>
<dt>mod-j</dt> <dt>mod-j</dt>
<dd> <dd>Move focus to the next window
Move focus to the next window
</dd> </dd>
<dt>mod-k</dt> <dt>mod-k</dt>
<dd> <dd>Move focus to the previous window
Move focus to the previous window
</dd> </dd>
<dt>mod-m</dt> <dt>mod-m</dt>
<dd> <dd>Move focus to the master window
Move focus to the master window
</dd> </dd>
<dt>mod-return</dt> <dt>mod-return</dt>
<dd> <dd>Swap the focused window and the master window
Swap the focused window and the master window
</dd> </dd>
<dt>mod-shift-j</dt> <dt>mod-shift-j</dt>
<dd> <dd>Swap the focused window with the next window
Swap the focused window with the next window
</dd> </dd>
<dt>mod-shift-k</dt> <dt>mod-shift-k</dt>
<dd> <dd>Swap the focused window with the previous window
Swap the focused window with the previous window
</dd> </dd>
<dt>mod-h</dt> <dt>mod-h</dt>
<dd> <dd>Shrink the master area
Shrink the master area
</dd> </dd>
<dt>mod-l</dt> <dt>mod-l</dt>
<dd> <dd>Expand the master area
Expand the master area
</dd> </dd>
<dt>mod-t</dt> <dt>mod-t</dt>
<dd> <dd>Push window back into tiling
Push window back into tiling
</dd> </dd>
<dt>mod-comma</dt> <dt>mod-comma</dt>
<dd> <dd>Increment the number of windows in the master area
Increment the number of windows in the master area
</dd> </dd>
<dt>mod-period</dt> <dt>mod-period</dt>
<dd> <dd>Deincrement the number of windows in the master area
Deincrement the number of windows in the master area
</dd> </dd>
<dt>mod-shift-q</dt> <dt>mod-shift-q</dt>
<dd> <dd>Quit xmonad
Quit xmonad
</dd> </dd>
<dt>mod-q</dt> <dt>mod-q</dt>
<dd> <dd>Restart xmonad
Restart xmonad
</dd> </dd>
<dt>mod-shift-slash</dt> <dt>mod-shift-slash</dt>
<dd> <dd>Run xmessage with a summary of the default keybindings (useful for beginners)
Run xmessage with a summary of the default keybindings (useful for
beginners)
</dd> </dd>
<dt>mod-question</dt> <dt>mod-question</dt>
<dd> <dd>Run xmessage with a summary of the default keybindings (useful for beginners)
Run xmessage with a summary of the default keybindings (useful for
beginners)
</dd> </dd>
<dt>mod-[1..9]</dt> <dt>mod-[1..9]</dt>
<dd> <dd>Switch to workspace N
Switch to workspace N
</dd> </dd>
<dt>mod-shift-[1..9]</dt> <dt>mod-shift-[1..9]</dt>
<dd> <dd>Move client to workspace N
Move client to workspace N
</dd> </dd>
<dt>mod-{w,e,r}</dt> <dt>mod-{w,e,r}</dt>
<dd> <dd>Switch to physical/Xinerama screens 1, 2, or 3
Switch to physical/Xinerama screens 1, 2, or 3
</dd> </dd>
<dt>mod-shift-{w,e,r}</dt> <dt>mod-shift-{w,e,r}</dt>
<dd> <dd>Move client to screen 1, 2, or 3
Move client to screen 1, 2, or 3
</dd> </dd>
<dt>mod-button1</dt> <dt>mod-button1</dt>
<dd> <dd>Set the window to floating mode and move by dragging
Set the window to floating mode and move by dragging
</dd> </dd>
<dt>mod-button2</dt> <dt>mod-button2</dt>
<dd> <dd>Raise the window to the top of the stack
Raise the window to the top of the stack
</dd> </dd>
<dt>mod-button3</dt> <dt>mod-button3</dt>
<dd> <dd>Set the window to floating mode and resize by dragging
Set the window to floating mode and resize by dragging
</dd> </dd>
</dl> </dl>
<h1 id="examples">Examples</h1> <h1 id="examples">Examples</h1>
<p>To use xmonad as your window manager add to your <em>~/.xinitrc</em> <p>To use xmonad as your window manager add to your <em>~/.xinitrc</em> file:</p>
file:</p>
<blockquote> <blockquote>
<p>exec xmonad</p> <p>exec xmonad</p>
</blockquote> </blockquote>
<h1 id="customization">Customization</h1> <h1 id="customization">Customization</h1>
<p>xmonad is customized in your <em>xmonad.hs</em>, and then restarted <p>xmonad is customized in ~/.xmonad/xmonad.hs, and then restarted with mod-q.</p>
with mod-q. You can choose where your configuration file lives by</p> <p>You can find many extensions to the core feature set in the xmonad- contrib package, available through your package manager or from <a href="http://xmonad.org">xmonad.org</a>.</p>
<ol type="1">
<li>Setting <code>XMONAD_DATA_DIR,</code>
<code>XMONAD_CONFIG_DIR</code>, and <code>XMONAD_CACHE_DIR</code>;
<em>xmonad.hs</em> is then expected to be in
<code>XMONAD_CONFIG_DIR</code>.</li>
<li>Creating <em>xmonad.hs</em> in <em>~/.xmonad</em>.</li>
<li>Creating <em>xmonad.hs</em> in <code>XDG_CONFIG_HOME</code>. Note
that, in this case, xmonad will use <code>XDG_DATA_HOME</code> and
<code>XDG_CACHE_HOME</code> for its data and cache directory
respectively.</li>
</ol>
<p>You can find many extensions to the core feature set in the xmonad-
contrib package, available through your package manager or from <a
href="https://xmonad.org">xmonad.org</a>.</p>
<h2 id="modular-configuration">Modular Configuration</h2> <h2 id="modular-configuration">Modular Configuration</h2>
<p>As of <em>xmonad-0.9</em>, any additional Haskell modules may be <p>As of <em>xmonad-0.9</em>, any additional Haskell modules may be placed in <em>~/.xmonad/lib/</em> are available in GHCs searchpath. Hierarchical modules are supported: for example, the file <em>~/.xmonad/lib/XMonad/Stack/MyAdditions.hs</em> could contain:</p>
placed in <em>~/.xmonad/lib/</em> are available in GHCs searchpath. <div class="sourceCode" id="cb1"><pre class="sourceCode haskell"><code class="sourceCode haskell"><a class="sourceLine" id="cb1-1" data-line-number="1"><span class="kw">module</span> <span class="dt">XMonad.Stack.MyAdditions</span> (function1) <span class="kw">where</span></a>
Hierarchical modules are supported: for example, the file <a class="sourceLine" id="cb1-2" data-line-number="2"> function1 <span class="fu">=</span> error <span class="st">&quot;function1: Not implemented yet!&quot;</span></a></code></pre></div>
<em>~/.xmonad/lib/XMonad/Stack/MyAdditions.hs</em> could contain:</p> <p>Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that module was contained within xmonad or xmonad-contrib.</p>
<div class="sourceCode" id="cb1"><pre
class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">XMonad.Stack.MyAdditions</span> (function1) <span class="kw">where</span></span>
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a> function1 <span class="ot">=</span> <span class="fu">error</span> <span class="st">&quot;function1: Not implemented yet!&quot;</span></span></code></pre></div>
<p>Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
module was contained within xmonad or xmonad-contrib.</p>
<h1 id="bugs">Bugs</h1> <h1 id="bugs">Bugs</h1>
<p>Probably. If you find any, please report them to the <a <p>Probably. If you find any, please report them to the <a href="https://github.com/xmonad/xmonad/issues">bugtracker</a></p>
href="https://github.com/xmonad/xmonad/issues">bugtracker</a></p>
</body> </body>
</html> </html>

View File

@ -1,6 +1,6 @@
% XMONAD(1) Tiling Window Manager % XMONAD(1) Tiling Window Manager
% %
% 27 October 2021 % 20 August 2018
# Name # Name
@ -58,7 +58,7 @@ xmonad has several flags which you may pass to the executable.
These flags are: These flags are:
--recompile --recompile
: Recompiles your _xmonad.hs_ configuration : Recompiles your configuration in _~/.xmonad/xmonad.hs_
--restart --restart
: Causes the currently running _xmonad_ process to restart : Causes the currently running _xmonad_ process to restart
@ -72,100 +72,9 @@ These flags are:
--verbose-version --verbose-version
: Display detailed version of _xmonad_ : Display detailed version of _xmonad_
## Default keyboard bindings ##Default keyboard bindings
mod-shift-return ___KEYBINDINGS___
: Launch terminal
mod-p
: Launch dmenu
mod-shift-p
: Launch gmrun
mod-shift-c
: Close the focused window
mod-space
: Rotate through the available layout algorithms
mod-shift-space
: Reset the layouts on the current workspace to default
mod-n
: Resize viewed windows to the correct size
mod-tab
: Move focus to the next window
mod-shift-tab
: Move focus to the previous window
mod-j
: Move focus to the next window
mod-k
: Move focus to the previous window
mod-m
: Move focus to the master window
mod-return
: Swap the focused window and the master window
mod-shift-j
: Swap the focused window with the next window
mod-shift-k
: Swap the focused window with the previous window
mod-h
: Shrink the master area
mod-l
: Expand the master area
mod-t
: Push window back into tiling
mod-comma
: Increment the number of windows in the master area
mod-period
: Deincrement the number of windows in the master area
mod-shift-q
: Quit xmonad
mod-q
: Restart xmonad
mod-shift-slash
: Run xmessage with a summary of the default keybindings (useful for beginners)
mod-question
: Run xmessage with a summary of the default keybindings (useful for beginners)
mod-[1..9]
: Switch to workspace N
mod-shift-[1..9]
: Move client to workspace N
mod-{w,e,r}
: Switch to physical/Xinerama screens 1, 2, or 3
mod-shift-{w,e,r}
: Move client to screen 1, 2, or 3
mod-button1
: Set the window to floating mode and move by dragging
mod-button2
: Raise the window to the top of the stack
mod-button3
: Set the window to floating mode and resize by dragging
# Examples # Examples
@ -174,16 +83,8 @@ To use xmonad as your window manager add to your _~/.xinitrc_ file:
> exec xmonad > exec xmonad
# Customization # Customization
xmonad is customized in your _xmonad.hs_, and then restarted with mod-q. xmonad is customized in ~/.xmonad/xmonad.hs, and then restarted
You can choose where your configuration file lives by with mod-q.
1. Setting `XMONAD_DATA_DIR,` `XMONAD_CONFIG_DIR`, and
`XMONAD_CACHE_DIR`; _xmonad.hs_ is then expected to be in
`XMONAD_CONFIG_DIR`.
2. Creating _xmonad.hs_ in _~/.xmonad_.
3. Creating _xmonad.hs_ in `XDG_CONFIG_HOME`. Note that, in this
case, xmonad will use `XDG_DATA_HOME` and `XDG_CACHE_HOME` for its
data and cache directory respectively.
You can find many extensions to the core feature set in the xmonad- You can find many extensions to the core feature set in the xmonad-
contrib package, available through your package manager or from contrib package, available through your package manager or from
@ -206,5 +107,5 @@ module was contained within xmonad or xmonad-contrib.
# Bugs # Bugs
Probably. If you find any, please report them to the [bugtracker] Probably. If you find any, please report them to the [bugtracker]
[xmonad.org]: https://xmonad.org [xmonad.org]: http://xmonad.org
[bugtracker]: https://github.com/xmonad/xmonad/issues [bugtracker]: https://github.com/xmonad/xmonad/issues

View File

@ -1,119 +0,0 @@
% XMONAD(1) Tiling Window Manager
%
% 27 October 2021
# Name
xmonad - Tiling Window Manager
# Description
_xmonad_ is a minimalist tiling window manager for X, written in Haskell.
Windows are managed using automatic layout algorithms, which can be
dynamically reconfigured. At any time windows are arranged so as to
maximize the use of screen real estate. All features of the window manager
are accessible purely from the keyboard: a mouse is entirely optional.
_xmonad_ is configured in Haskell, and custom layout algorithms may be
implemented by the user in config files. A principle of _xmonad_ is
predictability: the user should know in advance precisely the window
arrangement that will result from any action.
By default, _xmonad_ provides three layout algorithms: tall, wide and
fullscreen. In tall or wide mode, windows are tiled and arranged to prevent
overlap and maximize screen use. Sets of windows are grouped together on
virtual screens, and each screen retains its own layout, which may be
reconfigured dynamically. Multiple physical monitors are supported via
Xinerama, allowing simultaneous display of a number of screens.
By utilizing the expressivity of a modern functional language with a rich
static type system, _xmonad_ provides a complete, featureful window manager
in less than 1200 lines of code, with an emphasis on correctness and
robustness. Internal properties of the window manager are checked using a
combination of static guarantees provided by the type system, and
type-based automated testing. A benefit of this is that the code is simple
to understand, and easy to modify.
# Usage
_xmonad_ places each window into a "workspace". Each workspace can have
any number of windows, which you can cycle though with mod-j and mod-k.
Windows are either displayed full screen, tiled horizontally, or tiled
vertically. You can toggle the layout mode with mod-space, which will cycle
through the available modes.
You can switch to workspace N with mod-N. For example, to switch to
workspace 5, you would press mod-5. Similarly, you can move the current
window to another workspace with mod-shift-N.
When running with multiple monitors (Xinerama), each screen has exactly 1
workspace visible. mod-{w,e,r} switch the focus between screens, while
shift-mod-{w,e,r} move the current window to that screen. When _xmonad_
starts, workspace 1 is on screen 1, workspace 2 is on screen 2, etc. When
switching workspaces to one that is already visible, the current and
visible workspaces are swapped.
## Flags
xmonad has several flags which you may pass to the executable.
These flags are:
--recompile
: Recompiles your _xmonad.hs_ configuration
--restart
: Causes the currently running _xmonad_ process to restart
--replace
: Replace the current window manager with xmonad
--version
: Display version of _xmonad_
--verbose-version
: Display detailed version of _xmonad_
## Default keyboard bindings
___KEYBINDINGS___
# Examples
To use xmonad as your window manager add to your _~/.xinitrc_ file:
> exec xmonad
# Customization
xmonad is customized in your _xmonad.hs_, and then restarted with mod-q.
You can choose where your configuration file lives by
1. Setting `XMONAD_DATA_DIR,` `XMONAD_CONFIG_DIR`, and
`XMONAD_CACHE_DIR`; _xmonad.hs_ is then expected to be in
`XMONAD_CONFIG_DIR`.
2. Creating _xmonad.hs_ in _~/.xmonad_.
3. Creating _xmonad.hs_ in `XDG_CONFIG_HOME`. Note that, in this
case, xmonad will use `XDG_DATA_HOME` and `XDG_CACHE_HOME` for its
data and cache directory respectively.
You can find many extensions to the core feature set in the xmonad-
contrib package, available through your package manager or from
[xmonad.org].
## Modular Configuration
As of _xmonad-0.9_, any additional Haskell modules may be placed in
_~/.xmonad/lib/_ are available in GHC's searchpath. Hierarchical modules
are supported: for example, the file
_~/.xmonad/lib/XMonad/Stack/MyAdditions.hs_ could contain:
```haskell
module XMonad.Stack.MyAdditions (function1) where
function1 = error "function1: Not implemented yet!"
```
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
module was contained within xmonad or xmonad-contrib.
# Bugs
Probably. If you find any, please report them to the [bugtracker]
[xmonad.org]: https://xmonad.org
[bugtracker]: https://github.com/xmonad/xmonad/issues

View File

@ -123,13 +123,13 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
-- , ((modm , xK_b ), sendMessage ToggleStruts) -- , ((modm , xK_b ), sendMessage ToggleStruts)
-- Quit xmonad -- Quit xmonad
, ((modm .|. shiftMask, xK_q ), io exitSuccess) , ((modm .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
-- Restart xmonad -- Restart xmonad
, ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart") , ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart")
-- Run xmessage with a summary of the default keybindings (useful for beginners) -- Run xmessage with a summary of the default keybindings (useful for beginners)
, ((modm .|. shiftMask, xK_slash ), xmessage help) , ((modm .|. shiftMask, xK_slash ), spawn ("echo \"" ++ help ++ "\" | xmessage -file -"))
] ]
++ ++
@ -154,18 +154,18 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Mouse bindings: default actions bound to mouse events -- Mouse bindings: default actions bound to mouse events
-- --
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $
-- mod-button1, Set the window to floating mode and move by dragging -- mod-button1, Set the window to floating mode and move by dragging
[ ((modm, button1), \w -> focus w >> mouseMoveWindow w [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
>> windows W.shiftMaster) >> windows W.shiftMaster))
-- mod-button2, Raise the window to the top of the stack -- mod-button2, Raise the window to the top of the stack
, ((modm, button2), \w -> focus w >> windows W.shiftMaster) , ((modm, button2), (\w -> focus w >> windows W.shiftMaster))
-- mod-button3, Set the window to floating mode and resize by dragging -- mod-button3, Set the window to floating mode and resize by dragging
, ((modm, button3), \w -> focus w >> mouseResizeWindow w , ((modm, button3), (\w -> focus w >> mouseResizeWindow w
>> windows W.shiftMaster) >> windows W.shiftMaster))
-- you may also bind events to the mouse scroll wheel (button4 and button5) -- you may also bind events to the mouse scroll wheel (button4 and button5)
] ]
@ -293,7 +293,6 @@ help = unlines ["The default modifier key is 'alt'. Default keybindings:",
"mod-Space Rotate through the available layout algorithms", "mod-Space Rotate through the available layout algorithms",
"mod-Shift-Space Reset the layouts on the current workSpace to default", "mod-Shift-Space Reset the layouts on the current workSpace to default",
"mod-n Resize/refresh viewed windows to the correct size", "mod-n Resize/refresh viewed windows to the correct size",
"mod-Shift-/ Show this help message with the default keybindings",
"", "",
"-- move focus up or down the window stack", "-- move focus up or down the window stack",
"mod-Tab Move focus to the next window", "mod-Tab Move focus to the next window",

View File

@ -1,6 +1,5 @@
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-} {-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Config -- Module : XMonad.Config
@ -40,7 +39,7 @@ import XMonad.Operations
import XMonad.ManageHook import XMonad.ManageHook
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Bits ((.|.)) import Data.Bits ((.|.))
import Data.Default.Class import Data.Default
import Data.Monoid import Data.Monoid
import qualified Data.Map as M import qualified Data.Map as M
import System.Exit import System.Exit
@ -219,7 +218,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area , ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- quit, or restart -- quit, or restart
, ((modMask .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit xmonad , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
, ((modMask , xK_q ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad , ((modMask , xK_q ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
, ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners) , ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
@ -240,7 +239,7 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]] , (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
where where
helpCommand :: X () helpCommand :: X ()
helpCommand = xmessage help helpCommand = spawn ("echo " ++ show help ++ " | xmessage -file -")
-- | Mouse bindings: default actions bound to mouse events -- | Mouse bindings: default actions bound to mouse events
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ()) mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
@ -278,7 +277,6 @@ instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) wh
, XMonad.handleExtraArgs = \ xs theConf -> case xs of , XMonad.handleExtraArgs = \ xs theConf -> case xs of
[] -> return theConf [] -> return theConf
_ -> fail ("unrecognized flags:" ++ show xs) _ -> fail ("unrecognized flags:" ++ show xs)
, XMonad.extensibleConf = M.empty
} }
-- | The default set of configuration values itself -- | The default set of configuration values itself
@ -298,7 +296,6 @@ help = unlines ["The default modifier key is 'alt'. Default keybindings:",
"mod-Space Rotate through the available layout algorithms", "mod-Space Rotate through the available layout algorithms",
"mod-Shift-Space Reset the layouts on the current workSpace to default", "mod-Shift-Space Reset the layouts on the current workSpace to default",
"mod-n Resize/refresh viewed windows to the correct size", "mod-n Resize/refresh viewed windows to the correct size",
"mod-Shift-/ Show this help message with the default keybindings",
"", "",
"-- move focus up or down the window stack", "-- move focus up or down the window stack",
"mod-Tab Move focus to the next window", "mod-Tab Move focus to the next window",

View File

@ -1,14 +1,5 @@
{-# LANGUAGE CPP #-} {-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
{-# LANGUAGE DeriveTraversable #-} MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE ViewPatterns #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@ -31,33 +22,26 @@ module XMonad.Core (
XConf(..), XConfig(..), LayoutClass(..), XConf(..), XConfig(..), LayoutClass(..),
Layout(..), readsLayout, Typeable, Message, Layout(..), readsLayout, Typeable, Message,
SomeMessage(..), fromMessage, LayoutMessages(..), SomeMessage(..), fromMessage, LayoutMessages(..),
StateExtension(..), ExtensionClass(..), ConfExtension(..), StateExtension(..), ExtensionClass(..),
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers, runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
withDisplay, withWindowSet, isRoot, runOnWorkspaces, withDisplay, withWindowSet, isRoot, runOnWorkspaces,
getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM, getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX,
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName, getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName,
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes, atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories, ManageHook, Query(..), runQuery
) where ) where
import XMonad.StackSet hiding (modify) import XMonad.StackSet hiding (modify)
import Prelude import Prelude
import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..)) import Control.Exception.Extensible (fromException, try, bracket, throw, finally, SomeException(..))
import qualified Control.Exception as E import qualified Control.Exception.Extensible as E
import Control.Applicative ((<|>), empty) import Control.Applicative(Applicative, pure, (<$>), (<*>))
import Control.Monad.Fail import Control.Monad.Fail
import Control.Monad.Fix (fix)
import Control.Monad.State import Control.Monad.State
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad (filterM, guard, void, when)
import Data.Char (isSpace)
import Data.Semigroup import Data.Semigroup
import Data.Traversable (for) import Data.Default
import Data.Time.Clock (UTCTime)
import Data.Default.Class
import System.Environment (lookupEnv)
import Data.List (isInfixOf, intercalate, (\\))
import System.FilePath import System.FilePath
import System.IO import System.IO
import System.Info import System.Info
@ -72,8 +56,10 @@ import System.Exit
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event) import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
import Data.Typeable import Data.Typeable
import Data.List ((\\))
import Data.Maybe (isJust,fromMaybe) import Data.Maybe (isJust,fromMaybe)
import Data.Monoid (Ap(..)) import Data.Monoid hiding ((<>))
import System.Environment (lookupEnv)
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
@ -107,8 +93,8 @@ data XConf = XConf
, mousePosition :: !(Maybe (Position, Position)) , mousePosition :: !(Maybe (Position, Position))
-- ^ position of the mouse according to -- ^ position of the mouse according to
-- the event currently being processed -- the event currently being processed
, currentEvent :: !(Maybe Event) -- ^ event currently being processed , currentEvent :: !(Maybe Event)
, directories :: !Directories -- ^ directories to use -- ^ event currently being processed
} }
-- todo, better name -- todo, better name
@ -136,11 +122,6 @@ data XConfig l = XConfig
, rootMask :: !EventMask -- ^ The root events that xmonad is interested in , rootMask :: !EventMask -- ^ The root events that xmonad is interested in
, handleExtraArgs :: !([String] -> XConfig Layout -> IO (XConfig Layout)) , handleExtraArgs :: !([String] -> XConfig Layout -> IO (XConfig Layout))
-- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default -- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default
, extensibleConf :: !(M.Map TypeRep ConfExtension)
-- ^ Stores custom config information.
--
-- The module "XMonad.Util.ExtensibleConf" in xmonad-contrib
-- provides additional information and a simple interface for using this.
} }
@ -154,8 +135,7 @@ type WorkspaceId = String
newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real) newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
-- | The 'Rectangle' with screen dimensions -- | The 'Rectangle' with screen dimensions
newtype ScreenDetail = SD { screenRect :: Rectangle } data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
deriving (Eq,Show, Read)
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -168,8 +148,18 @@ newtype ScreenDetail = SD { screenRect :: Rectangle }
-- instantiated on 'XConf' and 'XState' automatically. -- instantiated on 'XConf' and 'XState' automatically.
-- --
newtype X a = X (ReaderT XConf (StateT XState IO) a) newtype X a = X (ReaderT XConf (StateT XState IO) a)
deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf) deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf, Typeable)
deriving (Semigroup, Monoid) via Ap X a
instance Applicative X where
pure = return
(<*>) = ap
instance Semigroup a => Semigroup (X a) where
(<>) = liftM2 (<>)
instance (Monoid a) => Monoid (X a) where
mempty = return mempty
mappend = liftM2 mappend
instance Default a => Default (X a) where instance Default a => Default (X a) where
def = return def def = return def
@ -177,10 +167,16 @@ instance Default a => Default (X a) where
type ManageHook = Query (Endo WindowSet) type ManageHook = Query (Endo WindowSet)
newtype Query a = Query (ReaderT Window X a) newtype Query a = Query (ReaderT Window X a)
deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO) deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
deriving (Semigroup, Monoid) via Ap Query a
runQuery :: Query a -> Window -> X a runQuery :: Query a -> Window -> X a
runQuery (Query m) = runReaderT m runQuery (Query m) w = runReaderT m w
instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>)
instance Monoid a => Monoid (Query a) where
mempty = return mempty
mappend = liftM2 mappend
instance Default a => Default (Query a) where instance Default a => Default (Query a) where
def = return def def = return def
@ -197,7 +193,7 @@ catchX job errcase = do
st <- get st <- get
c <- ask c <- ask
(a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of (a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
Just (_ :: ExitCode) -> throw e Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
_ -> do hPrint stderr e; runX c st errcase _ -> do hPrint stderr e; runX c st errcase
put s' put s'
return a return a
@ -205,12 +201,12 @@ catchX job errcase = do
-- | Execute the argument, catching all exceptions. Either this function or -- | Execute the argument, catching all exceptions. Either this function or
-- 'catchX' should be used at all callsites of user customized code. -- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a) userCode :: X a -> X (Maybe a)
userCode a = catchX (Just <$> a) (return Nothing) userCode a = catchX (Just `liftM` a) (return Nothing)
-- | Same as userCode but with a default argument to return instead of using -- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience. -- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a userCodeDef :: a -> X a -> X a
userCodeDef defValue a = fromMaybe defValue <$> userCode a userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Convenient wrappers to state -- Convenient wrappers to state
@ -231,7 +227,7 @@ withWindowAttributes dpy win f = do
-- | True if the given window is the root window -- | True if the given window is the root window
isRoot :: Window -> X Bool isRoot :: Window -> X Bool
isRoot w = asks $ (w ==) . theRoot isRoot w = (w==) <$> asks theRoot
-- | Wrapper for the common case of atom internment -- | Wrapper for the common case of atom internment
getAtom :: String -> X Atom getAtom :: String -> X Atom
@ -259,18 +255,14 @@ readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-- | Every layout must be an instance of 'LayoutClass', which defines -- | Every layout must be an instance of 'LayoutClass', which defines
-- the basic layout operations along with a sensible default for each. -- the basic layout operations along with a sensible default for each.
-- --
-- All of the methods have default implementations, so there is no -- Minimal complete definition:
-- minimal complete definition. They do, however, have a dependency
-- structure by default; this is something to be aware of should you
-- choose to implement one of these methods. Here is how a minimal
-- complete definition would look like if we did not provide any default
-- implementations:
-- --
-- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout') -- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout'), and
-- --
-- * 'handleMessage' || 'pureMessage' -- * 'handleMessage' || 'pureMessage'
-- --
-- * 'description' -- You should also strongly consider implementing 'description',
-- although it is not required.
-- --
-- Note that any code which /uses/ 'LayoutClass' methods should only -- Note that any code which /uses/ 'LayoutClass' methods should only
-- ever call 'runLayout', 'handleMessage', and 'description'! In -- ever call 'runLayout', 'handleMessage', and 'description'! In
@ -279,7 +271,7 @@ readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
-- 'runLayout', 'handleMessage', and so on. This ensures that the -- 'runLayout', 'handleMessage', and so on. This ensures that the
-- proper methods will be used, regardless of the particular methods -- proper methods will be used, regardless of the particular methods
-- that any 'LayoutClass' instance chooses to define. -- that any 'LayoutClass' instance chooses to define.
class (Show (layout a), Typeable layout) => LayoutClass layout a where class Show (layout a) => LayoutClass layout a where
-- | By default, 'runLayout' calls 'doLayout' if there are any -- | By default, 'runLayout' calls 'doLayout' if there are any
-- windows to be laid out, and 'emptyLayout' otherwise. Most -- windows to be laid out, and 'emptyLayout' otherwise. Most
@ -381,12 +373,12 @@ instance Message Event
-- layouts) should consider handling. -- layouts) should consider handling.
data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible
| ReleaseResources -- ^ sent when xmonad is exiting or restarting | ReleaseResources -- ^ sent when xmonad is exiting or restarting
deriving Eq deriving (Typeable, Eq)
instance Message LayoutMessages instance Message LayoutMessages
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Extensible state/config -- Extensible state
-- --
-- | Every module must make the data it wants to store -- | Every module must make the data it wants to store
@ -394,7 +386,6 @@ instance Message LayoutMessages
-- --
-- Minimal complete definition: initialValue -- Minimal complete definition: initialValue
class Typeable a => ExtensionClass a where class Typeable a => ExtensionClass a where
{-# MINIMAL initialValue #-}
-- | Defines an initial value for the state extension -- | Defines an initial value for the state extension
initialValue :: a initialValue :: a
-- | Specifies whether the state extension should be -- | Specifies whether the state extension should be
@ -413,17 +404,10 @@ data StateExtension =
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a | forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
-- ^ Persistent extension -- ^ Persistent extension
-- | Existential type to store a config extension.
data ConfExtension = forall a. Typeable a => ConfExtension a
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- General utilities -- | General utilities
--
-- | If-then-else lifted to a 'Monad'. -- Lift an 'IO' action into the 'X' monad
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM mb t f = mb >>= \b -> if b then t else f
-- | Lift an 'IO' action into the 'X' monad
io :: MonadIO m => IO a -> m a io :: MonadIO m => IO a -> m a
io = liftIO io = liftIO
@ -437,7 +421,7 @@ catchIO f = io (f `E.catch` \(SomeException e) -> hPrint stderr e >> hFlush stde
-- --
-- Note this function assumes your locale uses utf8. -- Note this function assumes your locale uses utf8.
spawn :: MonadIO m => String -> m () spawn :: MonadIO m => String -> m ()
spawn x = void $ spawnPID x spawn x = spawnPID x >> return ()
-- | Like 'spawn', but returns the 'ProcessID' of the launched application -- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID spawnPID :: MonadIO m => String -> m ProcessID
@ -451,25 +435,10 @@ xfork x = io . forkProcess . finally nullStdin $ do
x x
where where
nullStdin = do nullStdin = do
#if MIN_VERSION_unix(2,8,0)
fd <- openFd "/dev/null" ReadOnly defaultFileFlags
#else
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
#endif
dupTo fd stdInput dupTo fd stdInput
closeFd fd closeFd fd
-- | Use @xmessage@ to show information to the user.
xmessage :: MonadIO m => String -> m ()
xmessage msg = void . xfork $ do
xmessageBin <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
executeFile xmessageBin True
[ "-default", "okay"
, "-xrm", "*international:true"
, "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
, msg
] Nothing
-- | This is basically a map function, running a function in the 'X' monad on -- | This is basically a map function, running a function in the 'X' monad on
-- each workspace with the output of that function being the modified workspace. -- each workspace with the output of that function being the modified workspace.
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X () runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
@ -480,361 +449,137 @@ runOnWorkspaces job = do
$ current ws : visible ws $ current ws : visible ws
modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } } modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
-- | All the directories that xmonad will use. They will be used for -- | Return the path to the xmonad configuration directory. This
-- the following purposes: -- directory is where user configuration files are stored (e.g, the
-- xmonad.hs file). You may also create a @lib@ subdirectory in the
-- configuration directory and the default recompile command will add
-- it to the GHC include path.
-- --
-- * @dataDir@: This directory is used by XMonad to store data files -- Several directories are considered. In order of
-- such as the run-time state file. -- preference:
-- --
-- * @cfgDir@: This directory is where user configuration files are -- 1. The directory specified in the @XMONAD_CONFIG_DIR@ environment variable.
-- stored (e.g, the xmonad.hs file). You may also create a @lib@ -- 2. The @~\/.xmonad@ directory.
-- subdirectory in the configuration directory and the default recompile -- 3. The @XDG_CONFIG_HOME/xmonad@ directory.
-- command will add it to the GHC include path.
-- --
-- * @cacheDir@: This directory is used to store temporary files that -- The first directory that exists will be used. If none of the
-- can easily be recreated such as the configuration binary and any -- directories exist then (1) will be used if it is set, otherwise (2)
-- intermediate object files generated by GHC. -- will be used. Either way, a directory will be created if necessary.
-- Also, the XPrompt history file goes here. getXMonadDir :: MonadIO m => m String
-- getXMonadDir =
-- For how these directories are chosen, see 'getDirectories'. findFirstDirWithEnv "XMONAD_CONFIG_DIR"
-- [ getAppUserDataDirectory "xmonad"
data Directories' a = Directories , getXDGDirectory XDGConfig "xmonad"
{ dataDir :: !a ]
, cfgDir :: !a
, cacheDir :: !a
}
deriving (Show, Functor, Foldable, Traversable)
-- | Convenient type alias for the most common case in which one might -- | Return the path to the xmonad cache directory. This directory is
-- want to use the 'Directories' type. -- used to store temporary files that can easily be recreated. For
type Directories = Directories' FilePath -- example, the XPrompt history file.
--
-- Several directories are considered. In order of preference:
--
-- 1. The directory specified in the @XMONAD_CACHE_DIR@ environment variable.
-- 2. The @~\/.xmonad@ directory.
-- 3. The @XDG_CACHE_HOME/xmonad@ directory.
--
-- The first directory that exists will be used. If none of the
-- directories exist then (1) will be used if it is set, otherwise (2)
-- will be used. Either way, a directory will be created if necessary.
getXMonadCacheDir :: MonadIO m => m String
getXMonadCacheDir =
findFirstDirWithEnv "XMONAD_CACHE_DIR"
[ getAppUserDataDirectory "xmonad"
, getXDGDirectory XDGCache "xmonad"
]
-- | Build up the 'Dirs' that xmonad will use. They are chosen as -- | Return the path to the xmonad data directory. This directory is
-- follows: -- used by XMonad to store data files such as the run-time state file
-- and the configuration binary generated by GHC.
-- --
-- 1. If all three of xmonad's environment variables (@XMONAD_DATA_DIR@, -- Several directories are considered. In order of preference:
-- @XMONAD_CONFIG_DIR@, and @XMONAD_CACHE_DIR@) are set, use them.
-- 2. If there is a build script called @build@ or configuration
-- @xmonad.hs@ in @~\/.xmonad@, set all three directories to
-- @~\/.xmonad@.
-- 3. Otherwise, use the @xmonad@ directory in @XDG_DATA_HOME@,
-- @XDG_CONFIG_HOME@, and @XDG_CACHE_HOME@ (or their respective
-- fallbacks). These directories are created if necessary.
-- --
-- The xmonad configuration file (or the build script, if present) is -- 1. The directory specified in the @XMONAD_DATA_DIR@ environment variable.
-- always assumed to be in @cfgDir@. -- 2. The @~\/.xmonad@ directory.
-- 3. The @XDG_DATA_HOME/xmonad@ directory.
-- --
getDirectories :: IO Directories -- The first directory that exists will be used. If none of the
getDirectories = xmEnvDirs <|> xmDirs <|> xdgDirs -- directories exist then (1) will be used if it is set, otherwise (2)
-- will be used. Either way, a directory will be created if necessary.
getXMonadDataDir :: MonadIO m => m String
getXMonadDataDir =
findFirstDirWithEnv "XMONAD_DATA_DIR"
[ getAppUserDataDirectory "xmonad"
, getXDGDirectory XDGData "xmonad"
]
-- | Helper function that will find the first existing directory and
-- return its path. If none of the directories can be found, create
-- and return the first from the list. If the list is empty this
-- function returns the historical @~\/.xmonad@ directory.
findFirstDirOf :: MonadIO m => [IO FilePath] -> m FilePath
findFirstDirOf [] = findFirstDirOf [getAppUserDataDirectory "xmonad"]
findFirstDirOf possibles = do
found <- go possibles
case found of
Just path -> return path
Nothing -> do
primary <- io (head possibles)
io (createDirectoryIfMissing True primary)
return primary
where where
-- | Check for xmonad's environment variables first go [] = return Nothing
xmEnvDirs :: IO Directories go (x:xs) = do
xmEnvDirs = do dir <- io x
let xmEnvs = Directories{ dataDir = "XMONAD_DATA_DIR" exists <- io (doesDirectoryExist dir)
, cfgDir = "XMONAD_CONFIG_DIR" if exists then return (Just dir) else go xs
, cacheDir = "XMONAD_CACHE_DIR"
}
maybe empty pure . sequenceA =<< traverse getEnv xmEnvs
-- | Check whether the config file or a build script is in the -- | Simple wrapper around @findFirstDirOf@ that allows the primary
-- @~\/.xmonad@ directory -- path to be specified by an environment variable.
xmDirs :: IO Directories findFirstDirWithEnv :: MonadIO m => String -> [IO FilePath] -> m FilePath
xmDirs = do findFirstDirWithEnv envName paths = do
xmDir <- getAppUserDataDirectory "xmonad" envPath' <- io (getEnv envName)
conf <- doesFileExist $ xmDir </> "xmonad.hs"
build <- doesFileExist $ xmDir </> "build"
-- Place *everything* in ~/.xmonad if yes case envPath' of
guard $ conf || build Nothing -> findFirstDirOf paths
pure Directories{ dataDir = xmDir, cfgDir = xmDir, cacheDir = xmDir } Just envPath -> findFirstDirOf (return envPath:paths)
-- | Use XDG directories as a fallback -- | Helper function to retrieve the various XDG directories.
xdgDirs :: IO Directories -- This has been based on the implementation shipped with GHC version 8.0.1 or
xdgDirs = -- higher. Put here to preserve compatibility with older GHC versions.
for Directories{ dataDir = XdgData, cfgDir = XdgConfig, cacheDir = XdgCache } getXDGDirectory :: XDGDirectory -> FilePath -> IO FilePath
$ \dir -> do d <- getXdgDirectory dir "xmonad" getXDGDirectory xdgDir suffix =
d <$ createDirectoryIfMissing True d normalise . (</> suffix) <$>
case xdgDir of
-- | Return the path to the xmonad configuration directory. XDGData -> get "XDG_DATA_HOME" ".local/share"
getXMonadDir :: X String XDGConfig -> get "XDG_CONFIG_HOME" ".config"
getXMonadDir = asks (cfgDir . directories) XDGCache -> get "XDG_CACHE_HOME" ".cache"
{-# DEPRECATED getXMonadDir "Use `asks (cfgDir . directories)' instead." #-}
-- | Return the path to the xmonad cache directory.
getXMonadCacheDir :: X String
getXMonadCacheDir = asks (cacheDir . directories)
{-# DEPRECATED getXMonadCacheDir "Use `asks (cacheDir . directories)' instead." #-}
-- | Return the path to the xmonad data directory.
getXMonadDataDir :: X String
getXMonadDataDir = asks (dataDir . directories)
{-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-}
binFileName, buildDirName :: Directories -> FilePath
binFileName Directories{ cacheDir } = cacheDir </> "xmonad-" <> arch <> "-" <> os
buildDirName Directories{ cacheDir } = cacheDir </> "build-" <> arch <> "-" <> os
errFileName, stateFileName :: Directories -> FilePath
errFileName Directories{ dataDir } = dataDir </> "xmonad.errors"
stateFileName Directories{ dataDir } = dataDir </> "xmonad.state"
srcFileName, libFileName :: Directories -> FilePath
srcFileName Directories{ cfgDir } = cfgDir </> "xmonad.hs"
libFileName Directories{ cfgDir } = cfgDir </> "lib"
buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath
buildScriptFileName Directories{ cfgDir } = cfgDir </> "build"
stackYamlFileName Directories{ cfgDir } = cfgDir </> "stack.yaml"
nixFlakeFileName Directories{ cfgDir } = cfgDir </> "flake.nix"
nixDefaultFileName Directories{ cfgDir } = cfgDir </> "default.nix"
-- | Compilation method for xmonad configuration.
data Compile
= CompileGhc
| CompileCabal
| CompileStackGhc FilePath
| CompileNixFlake
| CompileNixDefault
| CompileScript FilePath
deriving (Show)
-- | Detect compilation method by looking for known file names in xmonad
-- configuration directory.
detectCompile :: Directories -> IO Compile
detectCompile dirs =
tryScript <|> tryStack <|> tryNixFlake <|> tryNixDefault <|> tryCabal <|> useGhc
where where
buildScript = buildScriptFileName dirs get name fallback = do
stackYaml = stackYamlFileName dirs env <- lookupEnv name
flakeNix = nixFlakeFileName dirs case env of
defaultNix = nixDefaultFileName dirs Nothing -> fallback'
Just path
| isRelative path -> fallback'
| otherwise -> return path
where
fallback' = (</> fallback) <$> getHomeDirectory
data XDGDirectory = XDGData | XDGConfig | XDGCache
tryScript = do -- | Get the name of the file used to store the xmonad window state.
guard =<< doesFileExist buildScript stateFileName :: (Functor m, MonadIO m) => m FilePath
isExe <- isExecutable buildScript stateFileName = (</> "xmonad.state") <$> getXMonadDataDir
if isExe
then do
trace $ "XMonad will use build script at " <> show buildScript <> " to recompile."
pure $ CompileScript buildScript
else do
trace $ "XMonad will not use build script, because " <> show buildScript <> " is not executable."
trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript
empty
tryNixFlake = do -- | 'recompile force', recompile the xmonad configuration file when
guard =<< doesFileExist flakeNix -- any of the following apply:
canonNixFlake <- canonicalizePath flakeNix
trace $ "XMonad will use nix flake at " <> show canonNixFlake <> " to recompile"
pure CompileNixFlake
tryNixDefault = do
guard =<< doesFileExist defaultNix
canonNixDefault <- canonicalizePath defaultNix
trace $ "XMonad will use nix file at " <> show canonNixDefault <> " to recompile"
pure CompileNixDefault
tryStack = do
guard =<< doesFileExist stackYaml
canonStackYaml <- canonicalizePath stackYaml
trace $ "XMonad will use stack ghc --stack-yaml " <> show canonStackYaml <> " to recompile."
pure $ CompileStackGhc canonStackYaml
tryCabal = let cwd = cfgDir dirs in listCabalFiles cwd >>= \ case
[] -> do
empty
[name] -> do
trace $ "XMonad will use " <> show name <> " to recompile."
pure CompileCabal
_ : _ : _ -> do
trace $ "XMonad will not use cabal, because there are multiple cabal files in " <> show cwd <> "."
empty
useGhc = do
trace $ "XMonad will use ghc to recompile, because none of "
<> intercalate ", "
[ show buildScript
, show stackYaml
, show flakeNix
, show defaultNix
] <> " nor a suitable .cabal file exist."
pure CompileGhc
listCabalFiles :: FilePath -> IO [FilePath]
listCabalFiles dir = map (dir </>) . Prelude.filter isCabalFile <$> listFiles dir
isCabalFile :: FilePath -> Bool
isCabalFile file = case splitExtension file of
(name, ".cabal") -> not (null name)
_ -> False
listFiles :: FilePath -> IO [FilePath]
listFiles dir = getDirectoryContents dir >>= filterM (doesFileExist . (dir </>))
-- | Determine whether or not the file found at the provided filepath is executable.
isExecutable :: FilePath -> IO Bool
isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
-- | Should we recompile xmonad configuration? Is it newer than the compiled
-- binary?
shouldCompile :: Directories -> Compile -> IO Bool
shouldCompile dirs CompileGhc = do
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles (libFileName dirs)
srcT <- getModTime (srcFileName dirs)
binT <- getModTime (binFileName dirs)
if any (binT <) (srcT : libTs)
then True <$ trace "XMonad recompiling because some files have changed."
else False <$ trace "XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed."
where
isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
allFiles t = do
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
shouldCompile _ CompileCabal = return True
shouldCompile dirs CompileStackGhc{} = do
stackYamlT <- getModTime (stackYamlFileName dirs)
binT <- getModTime (binFileName dirs)
if binT < stackYamlT
then True <$ trace "XMonad recompiling because some files have changed."
else shouldCompile dirs CompileGhc
shouldCompile _dirs CompileNixFlake{} = True <$ trace "XMonad recompiling because flake recompilation is being used."
shouldCompile _dirs CompileNixDefault{} = True <$ trace "XMonad recompiling because nix recompilation is being used."
shouldCompile _dirs CompileScript{} =
True <$ trace "XMonad recompiling because a custom build script is being used."
getModTime :: FilePath -> IO (Maybe UTCTime)
getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
-- | Compile the configuration.
compile :: Directories -> Compile -> IO ExitCode
compile dirs method =
bracket_ uninstallSignalHandlers installSignalHandlers $
withFile (errFileName dirs) WriteMode $ \err -> do
let run = runProc err
case method of
CompileGhc -> do
ghc <- fromMaybe "ghc" <$> lookupEnv "XMONAD_GHC"
run ghc ghcArgs
CompileCabal -> run "cabal" ["build"] .&&. copyBinary
where
copyBinary :: IO ExitCode
copyBinary = readProc err "cabal" ["-v0", "list-bin", "."] >>= \ case
Left status -> return status
Right (trim -> path) -> copyBinaryFrom path
CompileStackGhc stackYaml ->
run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)
CompileNixFlake ->
run "nix" ["build"] >>= andCopyFromResultDir
CompileNixDefault ->
run "nix-build" [] >>= andCopyFromResultDir
CompileScript script ->
run script [binFileName dirs]
where
cwd :: FilePath
cwd = cfgDir dirs
ghcArgs :: [String]
ghcArgs = [ "--make"
, "xmonad.hs"
, "-i" -- only look in @lib@
, "-ilib"
, "-fforce-recomp"
, "-main-is", "main"
, "-v0"
, "-outputdir", buildDirName dirs
, "-o", binFileName dirs
]
andCopyFromResultDir :: ExitCode -> IO ExitCode
andCopyFromResultDir exitCode = do
if exitCode == ExitSuccess then copyFromResultDir else return exitCode
findM :: (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a)
findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
catchAny :: IO a -> (SomeException -> IO a) -> IO a
catchAny = E.catch
copyFromResultDir :: IO ExitCode
copyFromResultDir = do
let binaryDirectory = cfgDir dirs </> "result" </> "bin"
binFiles <- map (binaryDirectory </>) <$> catchAny (listDirectory binaryDirectory) (\_ -> return [])
mfilepath <- findM isExecutable binFiles
case mfilepath of
Just filepath -> copyBinaryFrom filepath
Nothing -> return $ ExitFailure 1
copyBinaryFrom :: FilePath -> IO ExitCode
copyBinaryFrom filepath = copyFile filepath (binFileName dirs) >> return ExitSuccess
-- waitForProcess =<< System.Process.runProcess, but without closing the err handle
runProc :: Handle -> String -> [String] -> IO ExitCode
runProc err exe args = do
(Nothing, Nothing, Nothing, h) <- createProcess_ "runProc" =<< mkProc err exe args
waitForProcess h
readProc :: Handle -> String -> [String] -> IO (Either ExitCode String)
readProc err exe args = do
spec <- mkProc err exe args
(Nothing, Just out, Nothing, h) <- createProcess_ "readProc" spec{ std_out = CreatePipe }
result <- hGetContents out
hPutStr err result >> hFlush err
waitForProcess h >>= \ case
ExitSuccess -> return $ Right result
status -> return $ Left status
mkProc :: Handle -> FilePath -> [FilePath] -> IO CreateProcess
mkProc err exe args = do
hPutStrLn err $ unwords $ "$" : exe : args
hFlush err
return (proc exe args){ cwd = Just cwd, std_err = UseHandle err }
(.&&.) :: Monad m => m ExitCode -> m ExitCode -> m ExitCode
cmd1 .&&. cmd2 = cmd1 >>= \case
ExitSuccess -> cmd2
e -> pure e
-- | Check GHC output for deprecation warnings and notify the user if there
-- were any. Report success otherwise.
checkCompileWarnings :: Directories -> IO ()
checkCompileWarnings dirs = do
ghcErr <- readFile (errFileName dirs)
if "-Wdeprecations" `isInfixOf` ghcErr
then do
let msg = unlines $
["Deprecations detected while compiling xmonad config: " <> srcFileName dirs]
++ lines ghcErr
++ ["","Please correct them or silence using {-# OPTIONS_GHC -Wno-deprecations #-}."]
trace msg
xmessage msg
else
trace "XMonad recompilation process exited with success!"
-- | Notify the user that compilation failed and what was wrong.
compileFailed :: Directories -> ExitCode -> IO ()
compileFailed dirs status = do
ghcErr <- readFile (errFileName dirs)
let msg = unlines $
["Errors detected while compiling xmonad config: " <> srcFileName dirs]
++ lines (if null ghcErr then show status else ghcErr)
++ ["","Please check the file for errors."]
-- nb, the ordering of printing, then forking, is crucial due to
-- lazy evaluation
trace msg
xmessage msg
-- | Recompile the xmonad configuration file when any of the following apply:
-- --
-- * force is 'True' -- * force is 'True'
-- --
-- * the xmonad executable does not exist -- * the xmonad executable does not exist
-- --
-- * the xmonad executable is older than @xmonad.hs@ or any file in -- * the xmonad executable is older than xmonad.hs or any file in
-- the @lib@ directory (under the configuration directory) -- the @lib@ directory (under the configuration directory).
--
-- * custom @build@ script is being used
-- --
-- The -i flag is used to restrict recompilation to the xmonad.hs file only, -- The -i flag is used to restrict recompilation to the xmonad.hs file only,
-- and any files in the aforementioned @lib@ directory. -- and any files in the aforementioned @lib@ directory.
@ -845,21 +590,106 @@ compileFailed dirs status = do
-- --
-- 'False' is returned if there are compilation errors. -- 'False' is returned if there are compilation errors.
-- --
recompile :: MonadIO m => Directories -> Bool -> m Bool recompile :: MonadIO m => Bool -> m Bool
recompile dirs force = io $ do recompile force = io $ do
method <- detectCompile dirs cfgdir <- getXMonadDir
willCompile <- if force datadir <- getXMonadDataDir
then True <$ trace "XMonad recompiling (forced)." let binn = "xmonad-"++arch++"-"++os
else shouldCompile dirs method bin = datadir </> binn
if willCompile err = datadir </> "xmonad.errors"
src = cfgdir </> "xmonad.hs"
lib = cfgdir </> "lib"
buildscript = cfgdir </> "build"
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
srcT <- getModTime src
binT <- getModTime bin
useBuildscript <- do
exists <- doesFileExist buildscript
if exists
then do
isExe <- isExecutable buildscript
if isExe
then do
trace $ "XMonad will use build script at " ++ show buildscript ++ " to recompile."
return True
else do
trace $ unlines
[ "XMonad will not use build script, because " ++ show buildscript ++ " is not executable."
, "Suggested resolution to use it: chmod u+x " ++ show buildscript
]
return False
else do
trace $
"XMonad will use ghc to recompile, because " ++ show buildscript ++ " does not exist."
return False
shouldRecompile <-
if useBuildscript || force
then return True
else if any (binT <) (srcT : libTs)
then do
trace "XMonad doing recompile because some files have changed."
return True
else do
trace "XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed."
return False
if shouldRecompile
then do then do
status <- compile dirs method -- temporarily disable SIGCHLD ignoring:
uninstallSignalHandlers
status <- bracket (openFile err WriteMode) hClose $ \errHandle ->
waitForProcess =<< if useBuildscript
then compileScript bin cfgdir buildscript errHandle
else compileGHC bin cfgdir errHandle
-- re-enable SIGCHLD:
installSignalHandlers
-- now, if it fails, run xmessage to let the user know:
if status == ExitSuccess if status == ExitSuccess
then checkCompileWarnings dirs then trace "XMonad recompilation process exited with success!"
else compileFailed dirs status else do
pure $ status == ExitSuccess ghcErr <- readFile err
else let msg = unlines $
pure True ["Error detected while loading xmonad configuration file: " ++ src]
++ lines (if null ghcErr then show status else ghcErr)
++ ["","Please check the file for errors."]
-- nb, the ordering of printing, then forking, is crucial due to
-- lazy evaluation
hPutStrLn stderr msg
forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing
return ()
return (status == ExitSuccess)
else return True
where getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
allFiles t = do
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
ds <- filterM doesDirectoryExist cs
concat . ((cs \\ ds):) <$> mapM allFiles ds
-- Replace some of the unicode symbols GHC uses in its output
replaceUnicode = map $ \c -> case c of
'\8226' -> '*' --
'\8216' -> '`' --
'\8217' -> '`' --
_ -> c
compileGHC bin dir errHandle =
runProcess "ghc" ["--make"
, "xmonad.hs"
, "-i"
, "-ilib"
, "-fforce-recomp"
, "-main-is", "main"
, "-v0"
, "-o", bin
] (Just dir) Nothing Nothing Nothing (Just errHandle)
compileScript bin dir script errHandle =
runProcess script [bin] (Just dir) Nothing Nothing Nothing (Just errHandle)
-- | Conditionally run an action, using a @Maybe a@ to decide. -- | Conditionally run an action, using a @Maybe a@ to decide.
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m () whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
@ -891,6 +721,3 @@ uninstallSignalHandlers = io $ do
installHandler openEndedPipe Default Nothing installHandler openEndedPipe Default Nothing
installHandler sigCHLD Default Nothing installHandler sigCHLD Default Nothing
return () return ()
trim :: String -> String
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace

View File

@ -1,6 +1,4 @@
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
@ -10,7 +8,7 @@
-- --
-- Maintainer : spencerjanssen@gmail.com -- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable -- Stability : unstable
-- Portability : not portable, mtl, posix -- Portability : not portable, Typeable deriving, mtl, posix
-- --
-- The collection of core layouts. -- The collection of core layouts.
-- --
@ -18,7 +16,7 @@
module XMonad.Layout ( module XMonad.Layout (
Full(..), Tall(..), Mirror(..), Full(..), Tall(..), Mirror(..),
Resize(..), IncMasterN(..), Choose(..), (|||), CLR(..), ChangeLayout(..), JumpToLayout(..), Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),
mirrorRect, splitVertically, mirrorRect, splitVertically,
splitHorizontally, splitHorizontallyBy, splitVerticallyBy, splitHorizontally, splitHorizontallyBy, splitVerticallyBy,
@ -29,7 +27,6 @@ module XMonad.Layout (
import XMonad.Core import XMonad.Core
import Graphics.X11 (Rectangle(..)) import Graphics.X11 (Rectangle(..))
import Graphics.X11.Xlib.Extras ( Event(DestroyWindowEvent) )
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Control.Arrow ((***), second) import Control.Arrow ((***), second)
import Control.Monad import Control.Monad
@ -38,10 +35,10 @@ import Data.Maybe (fromMaybe)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- | Change the size of the master pane. -- | Change the size of the master pane.
data Resize = Shrink | Expand data Resize = Shrink | Expand deriving Typeable
-- | Increase the number of clients in the master pane. -- | Increase the number of clients in the master pane.
newtype IncMasterN = IncMasterN Int data IncMasterN = IncMasterN !Int deriving Typeable
instance Message Resize instance Message Resize
instance Message IncMasterN instance Message IncMasterN
@ -62,13 +59,9 @@ data Tall a = Tall { tallNMaster :: !Int -- ^ The default number o
-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs -- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
instance LayoutClass Tall a where instance LayoutClass Tall a where
pureLayout (Tall nmaster _ frac) r s pureLayout (Tall nmaster _ frac) r s = zip ws rs
| frac == 0 = drop nmaster layout
| frac == 1 = take nmaster layout
| otherwise = layout
where ws = W.integrate s where ws = W.integrate s
rs = tile frac r nmaster (length ws) rs = tile frac r nmaster (length ws)
layout = zip ws rs
pureMessage (Tall nmaster delta frac) m = pureMessage (Tall nmaster delta frac) m =
msum [fmap resize (fromMessage m) msum [fmap resize (fromMessage m)
@ -84,7 +77,7 @@ instance LayoutClass Tall a where
-- algorithm. -- algorithm.
-- --
-- The screen is divided into two panes. All clients are -- The screen is divided into two panes. All clients are
-- then partitioned between these two panes. One pane, the master, by -- then partioned between these two panes. One pane, the master, by
-- convention has the least number of windows in it. -- convention has the least number of windows in it.
tile tile
:: Rational -- ^ @frac@, what proportion of the screen to devote to the master area :: Rational -- ^ @frac@, what proportion of the screen to devote to the master area
@ -138,53 +131,23 @@ mirrorRect (Rectangle rx ry rw rh) = Rectangle ry rx rh rw
-- LayoutClass selection manager -- LayoutClass selection manager
-- Layouts that transition between other layouts -- Layouts that transition between other layouts
-- | Messages to change the current layout. Also see 'JumpToLayout'. -- | Messages to change the current layout.
data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show) data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
instance Message ChangeLayout instance Message ChangeLayout
-- | A message to jump to a particular layout, specified by its
-- description string.
--
-- The argument given to a 'JumpToLayout' message should be the
-- @description@ of the layout to be selected. If you use
-- "XMonad.Hooks.DynamicLog" from @xmonad-contrib@, this is the name of
-- the layout displayed in your status bar. Alternatively, you can use
-- GHCi to determine the proper name to use. For example:
--
-- > $ ghci
-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
-- > Loading package base ... linking ... done.
-- > :set prompt "> " -- don't show loaded module names
-- > > :m +XMonad.Core -- load the xmonad core
-- > > :m +XMonad.Layout.Grid -- load whatever module you want to use
-- > > description Grid -- find out what it's called
-- > "Grid"
--
-- As yet another (possibly easier) alternative, you can use the
-- "XMonad.Layout.Renamed" module (also in @xmonad-contrib@) to give
-- custom names to your layouts, and use those.
--
-- For example, if you want to jump directly to the 'Full' layout you
-- can do
--
-- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")
--
newtype JumpToLayout = JumpToLayout String
instance Message JumpToLayout
-- | The layout choice combinator -- | The layout choice combinator
(|||) :: l a -> r a -> Choose l r a (|||) :: l a -> r a -> Choose l r a
(|||) = Choose CL (|||) = Choose L
infixr 5 ||| infixr 5 |||
-- | A layout that allows users to switch between various layout options. -- | A layout that allows users to switch between various layout options.
data Choose l r a = Choose CLR (l a) (r a) deriving (Read, Show) data Choose l r a = Choose LR (l a) (r a) deriving (Read, Show)
-- | Choose the current sub-layout (left or right) in 'Choose'. -- | Are we on the left or right sub-layout?
data CLR = CL | CR deriving (Read, Show, Eq) data LR = L | R deriving (Read, Show, Eq)
data NextNoWrap = NextNoWrap deriving (Eq, Show) data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
instance Message NextNoWrap instance Message NextNoWrap
-- | A small wrapper around handleMessage, as it is tedious to write -- | A small wrapper around handleMessage, as it is tedious to write
@ -196,26 +159,26 @@ handle l m = handleMessage l (SomeMessage m)
-- new structure if any fields have changed, and performs any necessary cleanup -- new structure if any fields have changed, and performs any necessary cleanup
-- on newly non-visible layouts. -- on newly non-visible layouts.
choose :: (LayoutClass l a, LayoutClass r a) choose :: (LayoutClass l a, LayoutClass r a)
=> Choose l r a -> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a)) => Choose l r a-> LR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing
choose (Choose d l r) d' ml mr = f lr choose (Choose d l r) d' ml mr = f lr
where where
(l', r') = (fromMaybe l ml, fromMaybe r mr) (l', r') = (fromMaybe l ml, fromMaybe r mr)
lr = case (d, d') of lr = case (d, d') of
(CL, CR) -> (hide l' , return r') (L, R) -> (hide l' , return r')
(CR, CL) -> (return l', hide r' ) (R, L) -> (return l', hide r' )
(_ , _ ) -> (return l', return r') (_, _) -> (return l', return r')
f (x,y) = Just <$> liftM2 (Choose d') x y f (x,y) = fmap Just $ liftM2 (Choose d') x y
hide x = fromMaybe x <$> handle x Hide hide x = fmap (fromMaybe x) $ handle x Hide
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout (W.Workspace i (Choose CL l r) ms) = runLayout (W.Workspace i (Choose L l r) ms) =
fmap (second . fmap $ flip (Choose CL) r) . runLayout (W.Workspace i l ms) fmap (second . fmap $ flip (Choose L) r) . runLayout (W.Workspace i l ms)
runLayout (W.Workspace i (Choose CR l r) ms) = runLayout (W.Workspace i (Choose R l r) ms) =
fmap (second . fmap $ Choose CR l) . runLayout (W.Workspace i r ms) fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms)
description (Choose CL l _) = description l description (Choose L l _) = description l
description (Choose CR _ r) = description r description (Choose R _ r) = description r
handleMessage lr m | Just NextLayout <- fromMessage m = do handleMessage lr m | Just NextLayout <- fromMessage m = do
mlr' <- handle lr NextNoWrap mlr' <- handle lr NextNoWrap
@ -223,36 +186,25 @@ instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
handleMessage c@(Choose d l r) m | Just NextNoWrap <- fromMessage m = handleMessage c@(Choose d l r) m | Just NextNoWrap <- fromMessage m =
case d of case d of
CL -> do L -> do
ml <- handle l NextNoWrap ml <- handle l NextNoWrap
case ml of case ml of
Just _ -> choose c CL ml Nothing Just _ -> choose c L ml Nothing
Nothing -> choose c CR Nothing =<< handle r FirstLayout Nothing -> choose c R Nothing =<< handle r FirstLayout
CR -> choose c CR Nothing =<< handle r NextNoWrap R -> choose c R Nothing =<< handle r NextNoWrap
handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m = handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m =
flip (choose c CL) Nothing =<< handle l FirstLayout flip (choose c L) Nothing =<< handle l FirstLayout
handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m = handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources) join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)
handleMessage c@(Choose d l r) m | Just e@DestroyWindowEvent{} <- fromMessage m =
join $ liftM2 (choose c d) (handle l e) (handle r e)
handleMessage c@(Choose d l r) m | Just (JumpToLayout desc) <- fromMessage m = do
ml <- handleMessage l m
mr <- handleMessage r m
let md | desc == description (fromMaybe l ml) = CL
| desc == description (fromMaybe r mr) = CR
| otherwise = d
choose c md ml mr
handleMessage c@(Choose d l r) m = do handleMessage c@(Choose d l r) m = do
ml' <- case d of ml' <- case d of
CL -> handleMessage l m L -> handleMessage l m
CR -> return Nothing R -> return Nothing
mr' <- case d of mr' <- case d of
CL -> return Nothing L -> return Nothing
CR -> handleMessage r m R -> handleMessage r m
choose c d ml' mr' choose c d ml' mr'

View File

@ -1,6 +1,4 @@
{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
---------------------------------------------------------------------------- ----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Main -- Module : XMonad.Main
@ -15,19 +13,18 @@
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Main (xmonad, buildLaunch, launch) where module XMonad.Main (xmonad, launch) where
import System.Locale.SetLocale import System.Locale.SetLocale
import qualified Control.Exception as E import qualified Control.Exception.Extensible as E
import Data.Bits import Data.Bits
import Data.List ((\\)) import Data.List ((\\))
import Data.Foldable (traverse_) import Data.Function
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import Control.Monad (filterM, guard, unless, void, when, forever) import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, isJust)
import Data.Monoid (getAll) import Data.Monoid (getAll)
import Graphics.X11.Xlib hiding (refreshKeyboardMapping) import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
@ -42,7 +39,7 @@ import XMonad.Operations
import System.IO import System.IO
import System.Directory import System.Directory
import System.Info import System.Info
import System.Environment (getArgs, getProgName, withArgs) import System.Environment
import System.Posix.Process (executeFile) import System.Posix.Process (executeFile)
import System.Exit (exitFailure) import System.Exit (exitFailure)
import System.FilePath import System.FilePath
@ -51,7 +48,6 @@ import Paths_xmonad (version)
import Data.Version (showVersion) import Data.Version (showVersion)
import Graphics.X11.Xinerama (compiledWithXinerama) import Graphics.X11.Xinerama (compiledWithXinerama)
import Graphics.X11.Xrandr (xrrQueryExtension, xrrUpdateConfiguration)
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -63,17 +59,17 @@ xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
xmonad conf = do xmonad conf = do
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
dirs <- getDirectories
let launch' args = do let launch' args = do
catchIO (buildLaunch dirs) catchIO buildLaunch
conf'@XConfig { layoutHook = Layout l } conf' @ XConfig { layoutHook = Layout l }
<- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) } <- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }
withArgs [] $ launch (conf' { layoutHook = l }) dirs withArgs [] $ launch (conf' { layoutHook = l })
args <- getArgs args <- getArgs
case args of case args of
("--resume": ws : xs : args') -> migrateState ws xs >> launch' args'
["--help"] -> usage ["--help"] -> usage
["--recompile"] -> recompile dirs True >>= flip unless exitFailure ["--recompile"] -> recompile True >>= flip unless exitFailure
["--restart"] -> sendRestart ["--restart"] -> sendRestart
["--version"] -> putStrLn $ unwords shortVersion ["--version"] -> putStrLn $ unwords shortVersion
["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion ["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
@ -90,14 +86,14 @@ usage :: IO ()
usage = do usage = do
self <- getProgName self <- getProgName
putStr . unlines $ putStr . unlines $
[ "Usage: " <> self <> " [OPTION]" concat ["Usage: ", self, " [OPTION]"] :
, "Options:" "Options:" :
, " --help Print this message" " --help Print this message" :
, " --version Print the version number" " --version Print the version number" :
, " --recompile Recompile your xmonad.hs" " --recompile Recompile your ~/.xmonad/xmonad.hs" :
, " --replace Replace the running window manager with xmonad" " --replace Replace the running window manager with xmonad" :
, " --restart Request a running xmonad process to restart" " --restart Request a running xmonad process to restart" :
] []
-- | Build the xmonad configuration file with ghc, then execute it. -- | Build the xmonad configuration file with ghc, then execute it.
-- If there are no errors, this function does not return. An -- If there are no errors, this function does not return. An
@ -115,21 +111,40 @@ usage = do
-- --
-- * Missing XMonad\/XMonadContrib modules due to ghc upgrade -- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
-- --
buildLaunch :: Directories -> IO () buildLaunch :: IO ()
buildLaunch dirs = do buildLaunch = do
whoami <- getProgName whoami <- getProgName
let bin = binFileName dirs let compiledConfig = "xmonad-"++arch++"-"++os
let compiledConfig = takeFileName bin
unless (whoami == compiledConfig) $ do unless (whoami == compiledConfig) $ do
trace $ concat trace $ concat
[ "XMonad is recompiling and replacing itself with another XMonad process because the current process is called " [ "XMonad is recompiling and replacing itself another XMonad process because the current process is called "
, show whoami , show whoami
, " but the compiled configuration should be called " , " but the compiled configuration should be called "
, show compiledConfig , show compiledConfig
] ]
recompile dirs False recompile False
dir <- getXMonadDataDir
args <- getArgs args <- getArgs
executeFile bin False args Nothing executeFile (dir </> compiledConfig) False args Nothing
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent e rw xmonad_restart 32 0 currentTime
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | a wrapper for 'replace'
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Entry point into xmonad for custom builds. -- | Entry point into xmonad for custom builds.
-- --
@ -151,8 +166,8 @@ buildLaunch dirs = do
-- function instead of 'xmonad'. You probably also want to have a key -- function instead of 'xmonad'. You probably also want to have a key
-- binding to the 'XMonad.Operations.restart` function that restarts -- binding to the 'XMonad.Operations.restart` function that restarts
-- your custom binary with the resume flag set to @True@. -- your custom binary with the resume flag set to @True@.
launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> Directories -> IO () launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
launch initxmc drs = do launch initxmc = do
-- setup locale information from environment -- setup locale information from environment
setLocale LC_ALL (Just "") setLocale LC_ALL (Just "")
-- ignore SIGPIPE and SIGCHLD -- ignore SIGPIPE and SIGCHLD
@ -177,12 +192,12 @@ launch initxmc drs = do
xinesc <- getCleanedScreenInfo dpy xinesc <- getCleanedScreenInfo dpy
nbc <- do v <- initColor dpy $ normalBorderColor xmc nbc <- do v <- initColor dpy $ normalBorderColor xmc
Just nbc_ <- initColor dpy $ normalBorderColor Default.def ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
return (fromMaybe nbc_ v) return (fromMaybe nbc_ v)
fbc <- do v <- initColor dpy $ focusedBorderColor xmc fbc <- do v <- initColor dpy $ focusedBorderColor xmc
Just fbc_ <- initColor dpy $ focusedBorderColor Default.def ~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.def
return (fromMaybe fbc_ v) return (fromMaybe fbc_ v)
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
@ -201,9 +216,7 @@ launch initxmc drs = do
, buttonActions = mouseBindings xmc xmc , buttonActions = mouseBindings xmc xmc
, mouseFocused = False , mouseFocused = False
, mousePosition = Nothing , mousePosition = Nothing
, currentEvent = Nothing , currentEvent = Nothing }
, directories = drs
}
st = XState st = XState
{ windowset = initialWinset { windowset = initialWinset
@ -218,7 +231,7 @@ launch initxmc drs = do
runX cf st $ do runX cf st $ do
-- check for serialized state in a file. -- check for serialized state in a file.
serializedSt <- do serializedSt <- do
path <- asks $ stateFileName . directories path <- stateFileName
exists <- io (doesFileExist path) exists <- io (doesFileExist path)
if exists then readStateFile initxmc else return Nothing if exists then readStateFile initxmc else return Nothing
@ -226,7 +239,7 @@ launch initxmc drs = do
let extst = maybe M.empty extensibleState serializedSt let extst = maybe M.empty extensibleState serializedSt
modify (\s -> s {extensibleState = extst}) modify (\s -> s {extensibleState = extst})
cacheNumlockMask setNumlockMask
grabKeys grabKeys
grabButtons grabButtons
@ -247,11 +260,8 @@ launch initxmc drs = do
userCode $ startupHook initxmc userCode $ startupHook initxmc
rrData <- io $ xrrQueryExtension dpy
let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
-- main loop, for all you HOF/recursion fans out there. -- main loop, for all you HOF/recursion fans out there.
forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e) forever $ prehandle =<< io (nextEvent dpy e >> getEvent e)
return () return ()
where where
@ -300,21 +310,16 @@ handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
-- window destroyed, unmanage it -- window destroyed, unmanage it
-- window gone, unmanage it -- window gone, unmanage it
-- broadcast to layouts handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do
handle e@(DestroyWindowEvent {ev_window = w}) = do
whenX (isClient w) $ do
unmanage w unmanage w
modify (\s -> s { mapped = S.delete w (mapped s) modify (\s -> s { mapped = S.delete w (mapped s)
, waitingUnmap = M.delete w (waitingUnmap s)}) , waitingUnmap = M.delete w (waitingUnmap s)})
-- the window is already unmanged, but we broadcast the event to all layouts
-- to trigger garbage-collection in case they hold window-specific resources
broadcastMessage e
-- We track expected unmap events in waitingUnmap. We ignore this event unless -- We track expected unmap events in waitingUnmap. We ignore this event unless
-- it is synthetic or we are not expecting an unmap notification from a window. -- it is synthetic or we are not expecting an unmap notification from a window.
handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap) e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
if synthetic || e == 0 if (synthetic || e == 0)
then unmanage w then unmanage w
else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) }) else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
where mpred 1 = Nothing where mpred 1 = Nothing
@ -324,7 +329,7 @@ handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient
handle e@(MappingNotifyEvent {}) = do handle e@(MappingNotifyEvent {}) = do
io $ refreshKeyboardMapping e io $ refreshKeyboardMapping e
when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
cacheNumlockMask setNumlockMask
grabKeys grabKeys
-- handle button release, which may finish dragging. -- handle button release, which may finish dragging.
@ -412,7 +417,7 @@ handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
handle e@ClientMessageEvent { ev_message_type = mt } = do handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART" a <- getAtom "XMONAD_RESTART"
if mt == a if (mt == a)
then restart "xmonad" True then restart "xmonad" True
else broadcastMessage e else broadcastMessage e
@ -443,14 +448,35 @@ scan dpy rootw = do
skip :: E.SomeException -> IO Bool skip :: E.SomeException -> IO Bool
skip _ = return False skip _ = return False
setNumlockMask :: X ()
setNumlockMask = do
dpy <- asks display
ms <- io $ getModifierMapping dpy
xs <- sequence [ do
ks <- io $ keycodeToKeysym dpy kc 0
if ks == xK_Num_Lock
then return (setBit 0 (fromIntegral m))
else return (0 :: KeyMask)
| (m, kcs) <- ms, kc <- kcs, kc /= 0]
modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
-- | Grab the keys back -- | Grab the keys back
grabKeys :: X () grabKeys :: X ()
grabKeys = do grabKeys = do
XConf { display = dpy, theRoot = rootw } <- ask XConf { display = dpy, theRoot = rootw } <- ask
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
(minCode, maxCode) = displayKeycodes dpy
allCodes = [fromIntegral minCode .. fromIntegral maxCode]
io $ ungrabKey dpy anyKey anyModifier rootw io $ ungrabKey dpy anyKey anyModifier rootw
let grab :: (KeyMask, KeyCode) -> X () ks <- asks keyActions
grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync -- build a map from keysyms to lists of keysyms (doing what
traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions) -- XGetKeyboardMapping would do if the X11 package bound it)
syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
let keysymMap = M.fromListWith (++) (zip syms [[code] | code <- allCodes])
keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
forM_ (M.keys ks) $ \(mask,sym) ->
forM_ (keysymToKeycodes sym) $ \kc ->
mapM_ (grab kc . (mask .|.)) =<< extraModifiers
-- | Grab the buttons -- | Grab the buttons
grabButtons :: X () grabButtons :: X ()
@ -461,4 +487,37 @@ grabButtons = do
io $ ungrabButton dpy anyButton anyModifier rootw io $ ungrabButton dpy anyButton anyModifier rootw
ems <- extraModifiers ems <- extraModifiers
ba <- asks buttonActions ba <- asks buttonActions
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba) mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
-- | @replace@ to signals compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again

View File

@ -1,3 +1,5 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.ManageHook -- Module : XMonad.ManageHook
@ -6,6 +8,7 @@
-- --
-- Maintainer : spencerjanssen@gmail.com -- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable -- Stability : unstable
-- Portability : not portable, uses cunning newtype deriving
-- --
-- An EDSL for ManageHooks -- An EDSL for ManageHooks
-- --
@ -18,13 +21,13 @@ module XMonad.ManageHook where
import XMonad.Core import XMonad.Core
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME) import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
import Control.Exception (bracket, SomeException(..)) import Control.Exception.Extensible (bracket, SomeException(..))
import qualified Control.Exception as E import qualified Control.Exception.Extensible as E
import Control.Monad.Reader import Control.Monad.Reader
import Data.Maybe import Data.Maybe
import Data.Monoid import Data.Monoid
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient) import XMonad.Operations (floatLocation, reveal)
-- | Lift an 'X' action to a 'Query'. -- | Lift an 'X' action to a 'Query'.
liftX :: X a -> Query a liftX :: X a -> Query a
@ -58,14 +61,13 @@ infixr 3 <&&>, <||>
-- | '&&' lifted to a 'Monad'. -- | '&&' lifted to a 'Monad'.
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool (<&&>) :: Monad m => m Bool -> m Bool -> m Bool
x <&&> y = ifM x y (pure False) (<&&>) = liftM2 (&&)
-- | '||' lifted to a 'Monad'. -- | '||' lifted to a 'Monad'.
(<||>) :: Monad m => m Bool -> m Bool -> m Bool (<||>) :: Monad m => m Bool -> m Bool -> m Bool
x <||> y = ifM x (pure True) y (<||>) = liftM2 (||)
-- | Return the window title; i.e., the string returned by @_NET_WM_NAME@, -- | Return the window title.
-- or failing that, the string returned by @WM_NAME@.
title :: Query String title :: Query String
title = ask >>= \w -> liftX $ do title = ask >>= \w -> liftX $ do
d <- asks display d <- asks display
@ -74,11 +76,10 @@ title = ask >>= \w -> liftX $ do
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w) (internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
`E.catch` \(SomeException _) -> getTextProperty d w wM_NAME `E.catch` \(SomeException _) -> getTextProperty d w wM_NAME
extract prop = do l <- wcTextPropertyToTextList d prop extract prop = do l <- wcTextPropertyToTextList d prop
return $ fromMaybe "" $ listToMaybe l return $ if null l then "" else head l
io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return "" io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return ""
-- | Return the application name; i.e., the /first/ string returned by -- | Return the application name.
-- @WM_CLASS@.
appName :: Query String appName :: Query String
appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w) appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
@ -86,17 +87,14 @@ appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClas
resource :: Query String resource :: Query String
resource = appName resource = appName
-- | Return the resource class; i.e., the /second/ string returned by -- | Return the resource class.
-- @WM_CLASS@.
className :: Query String className :: Query String
className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w) className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
-- | A query that can return an arbitrary X property of type 'String', -- | A query that can return an arbitrary X property of type 'String',
-- identified by name. Works for ASCII strings only. For the properties -- identified by name.
-- @_NET_WM_NAME@/@WM_NAME@ and @WM_CLASS@ the specialised variants 'title'
-- and 'appName'/'className' are preferred.
stringProperty :: String -> Query String stringProperty :: String -> Query String
stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fromMaybe "" <$> getStringProperty d w p) stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
getStringProperty :: Display -> Window -> String -> X (Maybe String) getStringProperty :: Display -> Window -> String -> X (Maybe String)
getStringProperty d w p = do getStringProperty d w p = do
@ -104,10 +102,6 @@ getStringProperty d w p = do
md <- io $ getWindowProperty8 d a w md <- io $ getWindowProperty8 d a w
return $ fmap (map (toEnum . fromIntegral)) md return $ fmap (map (toEnum . fromIntegral)) md
-- | Return whether the window will be a floating window or not
willFloat :: Query Bool
willFloat = ask >>= \w -> liftX $ withDisplay $ \d -> isFixedSizeOrTransient d w
-- | Modify the 'WindowSet' with a pure function. -- | Modify the 'WindowSet' with a pure function.
doF :: (s -> s) -> Query (Endo s) doF :: (s -> s) -> Query (Endo s)
doF = return . Endo doF = return . Endo

View File

@ -1,10 +1,5 @@
{-# LANGUAGE FlexibleContexts #-} {-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ScopedTypeVariables #-}
-- -------------------------------------------------------------------------- -- --------------------------------------------------------------------------
-- | -- |
-- Module : XMonad.Operations -- Module : XMonad.Operations
@ -13,69 +8,31 @@
-- --
-- Maintainer : dons@cse.unsw.edu.au -- Maintainer : dons@cse.unsw.edu.au
-- Stability : unstable -- Stability : unstable
-- Portability : not portable, mtl, posix -- Portability : not portable, Typeable deriving, mtl, posix
-- --
-- Operations. A module for functions that don't cleanly fit anywhere else. -- Operations.
-- --
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module XMonad.Operations ( module XMonad.Operations where
-- * Manage One Window
manage, unmanage, killWindow, kill, isClient,
setInitialProperties, setWMState, setWindowBorderWithFallback,
hide, reveal, tileWindow,
setTopFocus, focus, isFixedSizeOrTransient,
-- * Manage Windows
windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
withFocused, withUnfocused,
-- * Keyboard and Mouse
cleanMask, extraModifiers,
mouseDrag, mouseMoveWindow, mouseResizeWindow,
setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs, unGrab,
-- * Messages
sendMessage, broadcastMessage, sendMessageWithNoRefresh,
sendRestart, sendReplace,
-- * Save and Restore State
StateFile (..), writeStateToFile, readStateFile, restart,
-- * Floating Layer
float, floatLocation,
-- * Window Size Hints
D, mkAdjust, applySizeHints, applySizeHints', applySizeHintsContents,
applyAspectHint, applyResizeIncHint, applyMaxSizeHint,
-- * Rectangles
containedIn, nubScreens, pointWithin, scaleRationalRect,
-- * Other Utilities
initColor, pointScreen, screenWorkspace,
setLayout, updateLayout,
) where
import XMonad.Core import XMonad.Core
import XMonad.Layout (Full(..)) import XMonad.Layout (Full(..))
import qualified XMonad.StackSet as W import qualified XMonad.StackSet as W
import Data.Maybe import Data.Maybe
import Data.Monoid (Endo(..),Any(..)) import Data.Monoid (Endo(..))
import Data.List (nub, (\\), find) import Data.List (nub, (\\), find)
import Data.Bits ((.|.), (.&.), complement, setBit, testBit) import Data.Bits ((.|.), (.&.), complement, testBit)
import Data.Function (on)
import Data.Ratio import Data.Ratio
import qualified Data.Map as M import qualified Data.Map as M
import qualified Data.Set as S import qualified Data.Set as S
import Control.Applicative((<$>), (<*>))
import Control.Arrow (second) import Control.Arrow (second)
import Control.Monad.Fix (fix)
import Control.Monad.Reader import Control.Monad.Reader
import Control.Monad.State import Control.Monad.State
import Control.Monad (forM, forM_, guard, join, unless, void, when) import qualified Control.Exception.Extensible as C
import qualified Control.Exception as C
import System.IO import System.IO
import System.Directory import System.Directory
@ -85,20 +42,9 @@ import Graphics.X11.Xinerama (getScreenInfo)
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Window manager operations
-- | Detect whether a window has fixed size or is transient. This check
-- can be used to determine whether the window should be floating or not
--
isFixedSizeOrTransient :: Display -> Window -> X Bool
isFixedSizeOrTransient d w = do
sh <- io $ getWMNormalHints d w
let isFixedSize = isJust (sh_min_size sh) && sh_min_size sh == sh_max_size sh
isTransient <- isJust <$> io (getTransientForHint d w)
return (isFixedSize || isTransient)
-- | -- |
-- Add a new window to be managed in the current workspace. -- Window manager operations
-- manage. Add a new window to be managed in the current workspace.
-- Bring it into focus. -- Bring it into focus.
-- --
-- Whether the window is already managed, or not, it is mapped, has its -- Whether the window is already managed, or not, it is mapped, has its
@ -106,8 +52,10 @@ isFixedSizeOrTransient d w = do
-- --
manage :: Window -> X () manage :: Window -> X ()
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
sh <- io $ getWMNormalHints d w
shouldFloat <- isFixedSizeOrTransient d w let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
isTransient <- isJust <$> io (getTransientForHint d w)
rr <- snd `fmap` floatLocation w rr <- snd `fmap` floatLocation w
-- ensure that float windows don't go over the edge of the screen -- ensure that float windows don't go over the edge of the screen
@ -115,15 +63,15 @@ manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h = W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
adjust r = r adjust r = r
f ws | shouldFloat = W.float w (adjust rr) . W.insertUp w . W.view i $ ws f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
| otherwise = W.insertUp w ws | otherwise = W.insertUp w ws
where i = W.tag $ W.workspace $ W.current ws where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config) mh <- asks (manageHook . config)
g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w) g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
windows (g . f) windows (g . f)
-- | A window no longer exists; remove it from the window -- | unmanage. A window no longer exists, remove it from the window
-- list, on whatever workspace it is. -- list, on whatever workspace it is.
-- --
unmanage :: Window -> X () unmanage :: Window -> X ()
@ -143,9 +91,9 @@ killWindow w = withDisplay $ \d -> do
io $ if wmdelt `elem` protocols io $ if wmdelt `elem` protocols
then allocaXEvent $ \ev -> do then allocaXEvent $ \ev -> do
setEventType ev clientMessage setEventType ev clientMessage
setClientMessageEvent ev w wmprot 32 wmdelt currentTime setClientMessageEvent ev w wmprot 32 wmdelt 0
sendEvent d w False noEventMask ev sendEvent d w False noEventMask ev
else void (killClient d w) else killClient d w >> return ()
-- | Kill the currently focused client. -- | Kill the currently focused client.
kill :: X () kill :: X ()
@ -154,7 +102,7 @@ kill = withFocused killWindow
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Managing windows -- Managing windows
-- | Modify the current window list with a pure function, and refresh -- | windows. Modify the current window list with a pure function, and refresh
windows :: (WindowSet -> WindowSet) -> X () windows :: (WindowSet -> WindowSet) -> X ()
windows f = do windows f = do
XState { windowset = old } <- get XState { windowset = old } <- get
@ -196,8 +144,7 @@ windows f = do
let m = W.floating ws let m = W.floating ws
flt = [(fw, scaleRationalRect viewrect r) flt = [(fw, scaleRationalRect viewrect r)
| fw <- filter (`M.member` m) (W.index this) | fw <- filter (flip M.member m) (W.index this)
, fw `notElem` vis
, Just r <- [M.lookup fw m]] , Just r <- [M.lookup fw m]]
vs = flt ++ rs vs = flt ++ rs
@ -223,58 +170,38 @@ windows f = do
-- all windows that are no longer in the windowset are marked as -- all windows that are no longer in the windowset are marked as
-- withdrawn, it is important to do this after the above, otherwise 'hide' -- withdrawn, it is important to do this after the above, otherwise 'hide'
-- will overwrite withdrawnState with iconicState -- will overwrite withdrawnState with iconicState
mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws) mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
isMouseFocused <- asks mouseFocused isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask unless isMouseFocused $ clearEvents enterWindowMask
asks (logHook . config) >>= userCodeDef () asks (logHook . config) >>= userCodeDef ()
-- | Modify the @WindowSet@ in state with no special handling.
modifyWindowSet :: (WindowSet -> WindowSet) -> X ()
modifyWindowSet f = modify $ \xst -> xst { windowset = f (windowset xst) }
-- | Perform an @X@ action and check its return value against a predicate p.
-- If p holds, unwind changes to the @WindowSet@ and replay them using @windows@.
windowBracket :: (a -> Bool) -> X a -> X a
windowBracket p action = withWindowSet $ \old -> do
a <- action
when (p a) . withWindowSet $ \new -> do
modifyWindowSet $ const old
windows $ const new
return a
-- | Perform an @X@ action. If it returns @Any True@, unwind the
-- changes to the @WindowSet@ and replay them using @windows@. This is
-- a version of @windowBracket@ that discards the return value and
-- handles an @X@ action that reports its need for refresh via @Any@.
windowBracket_ :: X Any -> X ()
windowBracket_ = void . windowBracket getAny
-- | Produce the actual rectangle from a screen and a ratio on that screen. -- | Produce the actual rectangle from a screen and a ratio on that screen.
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh) scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
= Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh) = Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
where scale s r = floor (toRational s * r) where scale s r = floor (toRational s * r)
-- | Set a window's WM_STATE property. -- | setWMState. set the WM_STATE property
setWMState :: Window -> Int -> X () setWMState :: Window -> Int -> X ()
setWMState w v = withDisplay $ \dpy -> do setWMState w v = withDisplay $ \dpy -> do
a <- atom_WM_STATE a <- atom_WM_STATE
io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none] io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]
-- | Set the border color using the window's color map, if possible; -- | Set the border color using the window's color map, if possible,
-- otherwise fall back to the color in @Pixel@. -- otherwise fallback to the color in @Pixel@.
setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X () setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
setWindowBorderWithFallback dpy w color basic = io $ setWindowBorderWithFallback dpy w color basic = io $
C.handle fallback $ do C.handle fallback $ do
wa <- getWindowAttributes dpy w wa <- getWindowAttributes dpy w
pixel <- setPixelSolid . color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
setWindowBorder dpy w pixel setWindowBorder dpy w pixel
where where
fallback :: C.SomeException -> IO () fallback :: C.SomeException -> IO ()
fallback _ = setWindowBorder dpy w basic fallback e = do hPrint stderr e >> hFlush stderr
setWindowBorder dpy w basic
-- | Hide a window by unmapping it and setting Iconified. -- | hide. Hide a window by unmapping it, and setting Iconified.
hide :: Window -> X () hide :: Window -> X ()
hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
cMask <- asks $ clientMask . config cMask <- asks $ clientMask . config
@ -287,15 +214,15 @@ hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s) modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
, mapped = S.delete w (mapped s) }) , mapped = S.delete w (mapped s) })
-- | Show a window by mapping it and setting Normal. -- | reveal. Show a window by mapping it and setting Normal
-- This is harmless if the window was already visible. -- this is harmless if the window was already visible
reveal :: Window -> X () reveal :: Window -> X ()
reveal w = withDisplay $ \d -> do reveal w = withDisplay $ \d -> do
setWMState w normalState setWMState w normalState
io $ mapWindow d w io $ mapWindow d w
whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) }) whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) })
-- | Set some properties when we initially gain control of a window. -- | Set some properties when we initially gain control of a window
setInitialProperties :: Window -> X () setInitialProperties :: Window -> X ()
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
setWMState w iconicState setWMState w iconicState
@ -306,7 +233,7 @@ setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
-- required by the border setting in 'windows' -- required by the border setting in 'windows'
io $ setWindowBorder d w nb io $ setWindowBorder d w nb
-- | Render the currently visible workspaces, as determined by -- | refresh. Render the currently visible workspaces, as determined by
-- the 'StackSet'. Also, set focus to the focused window. -- the 'StackSet'. Also, set focus to the focused window.
-- --
-- This is our 'view' operation (MVC), in that it pretty prints our model -- This is our 'view' operation (MVC), in that it pretty prints our model
@ -315,7 +242,7 @@ setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
refresh :: X () refresh :: X ()
refresh = windows id refresh = windows id
-- | Remove all events of a given type from the event queue. -- | clearEvents. Remove all events of a given type from the event queue.
clearEvents :: EventMask -> X () clearEvents :: EventMask -> X ()
clearEvents mask = withDisplay $ \d -> io $ do clearEvents mask = withDisplay $ \d -> io $ do
sync d False sync d False
@ -323,8 +250,8 @@ clearEvents mask = withDisplay $ \d -> io $ do
more <- checkMaskEvent d mask p more <- checkMaskEvent d mask p
when more again -- beautiful when more again -- beautiful
-- | Move and resize @w@ such that it fits inside the given rectangle, -- | tileWindow. Moves and resizes w such that it fits inside the given
-- including its border. -- rectangle, including its border.
tileWindow :: Window -> Rectangle -> X () tileWindow :: Window -> Rectangle -> X ()
tileWindow w r = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do tileWindow w r = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
-- give all windows at least 1x1 pixels -- give all windows at least 1x1 pixels
@ -351,28 +278,27 @@ containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)
nubScreens :: [Rectangle] -> [Rectangle] nubScreens :: [Rectangle] -> [Rectangle]
nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs
-- | Clean the list of screens according to the rules documented for -- | Cleans the list of screens according to the rules documented for
-- nubScreens. -- nubScreens.
getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle] getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle]
getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
-- | The screen configuration may have changed (due to -- xrandr), -- | rescreen. The screen configuration may have changed (due to
-- update the state and refresh the screen, and reset the gap. -- xrandr), update the state and refresh the screen, and reset the gap.
rescreen :: X () rescreen :: X ()
rescreen = withDisplay getCleanedScreenInfo >>= \case rescreen = do
[] -> trace "getCleanedScreenInfo returned []" xinesc <- withDisplay getCleanedScreenInfo
xinesc:xinescs ->
windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } -> windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs) let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
a = W.Screen (W.workspace v) 0 (SD xinesc) (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
as = zipWith3 W.Screen xs [1..] $ map SD xinescs in ws { W.current = a
in ws { W.current = a , W.visible = as
, W.visible = as , W.hidden = ys }
, W.hidden = ys }
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- | Tell whether or not to intercept clicks on a given window -- | setButtonGrab. Tell whether or not to intercept clicks on a given window
setButtonGrab :: Bool -> Window -> X () setButtonGrab :: Bool -> Window -> X ()
setButtonGrab grab w = do setButtonGrab grab w = do
pointerMode <- asks $ \c -> if clickJustFocuses (config c) pointerMode <- asks $ \c -> if clickJustFocuses (config c)
@ -427,7 +353,7 @@ setFocusX w = withWindowSet $ \ws -> do
currevt <- asks currentEvent currevt <- asks currentEvent
let inputHintSet = wmh_flags hints `testBit` inputHintBit let inputHintSet = wmh_flags hints `testBit` inputHintBit
when (inputHintSet && wmh_input hints || not inputHintSet) $ when ((inputHintSet && wmh_input hints) || (not inputHintSet)) $
io $ do setInputFocus dpy w revertToPointerRoot 0 io $ do setInputFocus dpy w revertToPointerRoot 0
when (wmtf `elem` protocols) $ when (wmtf `elem` protocols) $
io $ allocaXEvent $ \ev -> do io $ allocaXEvent $ \ev -> do
@ -435,171 +361,56 @@ setFocusX w = withWindowSet $ \ws -> do
setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
sendEvent dpy w False noEventMask ev sendEvent dpy w False noEventMask ev
where event_time ev = where event_time ev =
if ev_event_type ev `elem` timedEvents then if (ev_event_type ev) `elem` timedEvents then
ev_time ev ev_time ev
else else
currentTime currentTime
timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ] timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
cacheNumlockMask :: X ()
cacheNumlockMask = do
dpy <- asks display
ms <- io $ getModifierMapping dpy
xs <- sequence [ do ks <- io $ keycodeToKeysym dpy kc 0
if ks == xK_Num_Lock
then return (setBit 0 (fromIntegral m))
else return (0 :: KeyMask)
| (m, kcs) <- ms, kc <- kcs, kc /= 0
]
modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
-- | Given a list of keybindings, turn the given 'KeySym's into actual
-- 'KeyCode's and prepare them for grabbing.
mkGrabs :: [(KeyMask, KeySym)] -> X [(KeyMask, KeyCode)]
mkGrabs ks = withDisplay $ \dpy -> do
let (minCode, maxCode) = displayKeycodes dpy
allCodes = [fromIntegral minCode .. fromIntegral maxCode]
-- build a map from keysyms to lists of keysyms (doing what
-- XGetKeyboardMapping would do if the X11 package bound it)
syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
let -- keycodeToKeysym returns noSymbol for all unbound keycodes,
-- and we don't want to grab those whenever someone accidentally
-- uses def :: KeySym
keysymMap = M.delete noSymbol $
M.fromListWith (++) (zip syms [[code] | code <- allCodes])
keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
extraMods <- extraModifiers
pure [ (mask .|. extraMod, keycode)
| (mask, sym) <- ks
, keycode <- keysymToKeycodes sym
, extraMod <- extraMods
]
-- | Release XMonad's keyboard grab, so other grabbers can do their thing.
--
-- Start a keyboard action with this if it is going to run something
-- that needs to do a keyboard, pointer, or server grab. For example,
--
-- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot")
--
-- (Other examples are certain screen lockers and "gksu".)
-- This avoids needing to insert a pause/sleep before running the
-- command.
--
-- XMonad retains the keyboard grab during key actions because if they
-- use a submap, they need the keyboard to be grabbed, and if they had
-- to assert their own grab then the asynchronous nature of X11 allows
-- race conditions between XMonad, other clients, and the X server that
-- would cause keys to sometimes be "leaked" to the focused window.
unGrab :: X ()
unGrab = withDisplay $ \d -> io $ do
ungrabKeyboard d currentTime
ungrabPointer d currentTime
sync d False
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Message handling -- Message handling
-- | Throw a message to the current 'LayoutClass' possibly modifying how we -- | Throw a message to the current 'LayoutClass' possibly modifying how we
-- layout the windows, in which case changes are handled through a refresh. -- layout the windows, then refresh.
sendMessage :: Message a => a -> X () sendMessage :: Message a => a -> X ()
sendMessage a = windowBracket_ $ do sendMessage a = do
w <- gets $ W.workspace . W.current . windowset w <- W.workspace . W.current <$> gets windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' -> whenJust ml' $ \l' ->
modifyWindowSet $ \ws -> ws { W.current = (W.current ws) windows $ \ws -> ws { W.current = (W.current ws)
{ W.workspace = (W.workspace $ W.current ws) { W.workspace = (W.workspace $ W.current ws)
{ W.layout = l' }}} { W.layout = l' }}}
return (Any $ isJust ml')
-- | Send a message to all layouts, without refreshing. -- | Send a message to all layouts, without refreshing.
broadcastMessage :: Message a => a -> X () broadcastMessage :: Message a => a -> X ()
broadcastMessage a = withWindowSet $ \ws -> do broadcastMessage a = withWindowSet $ \ws -> do
-- this is O(n²), but we can't really fix this as there's code in let c = W.workspace . W.current $ ws
-- xmonad-contrib that touches the windowset during handleMessage v = map W.workspace . W.visible $ ws
-- (returning Nothing for changes to not get overwritten), so we h = W.hidden ws
-- unfortunately need to do this one by one and persist layout states mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
-- of each workspace separately)
let c = W.workspace . W.current $ ws
v = map W.workspace . W.visible $ ws
h = W.hidden ws
mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
-- | Send a message to a layout, without refreshing. -- | Send a message to a layout, without refreshing.
sendMessageWithNoRefresh :: Message a => a -> WindowSpace -> X () sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
sendMessageWithNoRefresh a w = sendMessageWithNoRefresh a w =
handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>= handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
updateLayout (W.tag w) updateLayout (W.tag w)
-- | Update the layout field of a workspace. -- | Update the layout field of a workspace
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X () updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
updateLayout i ml = whenJust ml $ \l -> updateLayout i ml = whenJust ml $ \l ->
runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww
-- | Set the layout of the currently viewed workspace. -- | Set the layout of the currently viewed workspace
setLayout :: Layout Window -> X () setLayout :: Layout Window -> X ()
setLayout l = do setLayout l = do
ss@W.StackSet{ W.current = c@W.Screen{ W.workspace = ws }} <- gets windowset ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
handleMessage (W.layout ws) (SomeMessage ReleaseResources) handleMessage (W.layout ws) (SomeMessage ReleaseResources)
windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } } windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
-- | Signal xmonad to restart itself.
sendRestart :: IO ()
sendRestart = do
dpy <- openDisplay ""
rw <- rootWindow dpy $ defaultScreen dpy
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
allocaXEvent $ \e -> do
setEventType e clientMessage
setClientMessageEvent' e rw xmonad_restart 32 []
sendEvent dpy rw False structureNotifyMask e
sync dpy False
-- | Signal compliant window managers to exit.
sendReplace :: IO ()
sendReplace = do
dpy <- openDisplay ""
let dflt = defaultScreen dpy
rootw <- rootWindow dpy dflt
replace dpy dflt rootw
-- | Signal compliant window managers to exit.
replace :: Display -> ScreenNumber -> Window -> IO ()
replace dpy dflt rootw = do
-- check for other WM
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
when (currentWmSnOwner /= 0) $ do
-- prepare to receive destroyNotify for old WM
selectInput dpy currentWmSnOwner structureNotifyMask
-- create off-screen window
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
set_override_redirect attributes True
set_event_mask attributes propertyChangeMask
let screen = defaultScreenOfDisplay dpy
visual = defaultVisualOfScreen screen
attrmask = cWOverrideRedirect .|. cWEventMask
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
-- try to acquire wmSnAtom, this should signal the old WM to terminate
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
-- SKIPPED: check if we acquired the selection
-- SKIPPED: send client message indicating that we are now the WM
-- wait for old WM to go away
fix $ \again -> do
evt <- allocaXEvent $ \event -> do
windowEvent dpy currentWmSnOwner structureNotifyMask event
get_EventType event
when (evt /= destroyNotify) again
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Utilities -- Utilities
-- | Return workspace visible on screen @sc@, or 'Nothing'. -- | Return workspace visible on screen 'sc', or 'Nothing'.
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId) screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
@ -607,14 +418,7 @@ screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
withFocused :: (Window -> X ()) -> X () withFocused :: (Window -> X ()) -> X ()
withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
-- | Apply an 'X' operation to all unfocused windows on the current workspace, if there are any. -- | 'True' if window is under management by us
withUnfocused :: (Window -> X ()) -> X ()
withUnfocused f = withWindowSet $ \ws ->
whenJust (W.peek ws) $ \w ->
let unfocusedWindows = filter (/= w) $ W.index ws
in mapM_ f unfocusedWindows
-- | Is the window is under management by xmonad?
isClient :: Window -> X Bool isClient :: Window -> X Bool
isClient w = withWindowSet $ return . W.member w isClient w = withWindowSet $ return . W.member w
@ -625,20 +429,16 @@ extraModifiers = do
nlm <- gets numberlockMask nlm <- gets numberlockMask
return [0, nlm, lockMask, nlm .|. lockMask ] return [0, nlm, lockMask, nlm .|. lockMask ]
-- | Strip numlock\/capslock from a mask. -- | Strip numlock\/capslock from a mask
cleanMask :: KeyMask -> X KeyMask cleanMask :: KeyMask -> X KeyMask
cleanMask km = do cleanMask km = do
nlm <- gets numberlockMask nlm <- gets numberlockMask
return (complement (nlm .|. lockMask) .&. km) return (complement (nlm .|. lockMask) .&. km)
-- | Set the 'Pixel' alpha value to 255. -- | Get the 'Pixel' value for a named color
setPixelSolid :: Pixel -> Pixel
setPixelSolid p = p .|. 0xff000000
-- | Get the 'Pixel' value for a named color.
initColor :: Display -> String -> IO (Maybe Pixel) initColor :: Display -> String -> IO (Maybe Pixel)
initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $ initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
Just . setPixelSolid . color_pixel . fst <$> allocNamedColor dpy colormap c (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy) where colormap = defaultColormap dpy (defaultScreen dpy)
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -658,9 +458,9 @@ writeStateToFile = do
maybeShow _ = Nothing maybeShow _ = Nothing
wsData = W.mapLayout show . windowset wsData = W.mapLayout show . windowset
extState = mapMaybe maybeShow . M.toList . extensibleState extState = catMaybes . map maybeShow . M.toList . extensibleState
path <- asks $ stateFileName . directories path <- stateFileName
stateData <- gets (\s -> StateFile (wsData s) (extState s)) stateData <- gets (\s -> StateFile (wsData s) (extState s))
catchIO (writeFile path $ show stateData) catchIO (writeFile path $ show stateData)
@ -668,7 +468,7 @@ writeStateToFile = do
-- return that state. The state file is removed after reading it. -- return that state. The state file is removed after reading it.
readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState) readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState)
readStateFile xmc = do readStateFile xmc = do
path <- asks $ stateFileName . directories path <- stateFileName
-- I'm trying really hard here to make sure we read the entire -- I'm trying really hard here to make sure we read the entire
-- contents of the file before it is removed from the file system. -- contents of the file before it is removed from the file system.
@ -701,8 +501,23 @@ readStateFile xmc = do
readStrict :: Handle -> IO String readStrict :: Handle -> IO String
readStrict h = hGetContents h >>= \s -> length s `seq` return s readStrict h = hGetContents h >>= \s -> length s `seq` return s
-- | @restart name resume@ attempts to restart xmonad by executing the program -- | Migrate state from a previously running xmonad instance that used
-- @name@. If @resume@ is 'True', restart with the current window state. -- the older @--resume@ technique.
{-# DEPRECATED migrateState "will be removed some point in the future." #-}
migrateState :: (Functor m, MonadIO m) => String -> String -> m ()
migrateState ws xs = do
io (putStrLn "WARNING: --resume is no longer supported.")
whenJust stateData $ \s -> do
path <- stateFileName
catchIO (writeFile path $ show s)
where
stateData = StateFile <$> maybeRead ws <*> maybeRead xs
maybeRead s = case reads s of
[(x, "")] -> Just x
_ -> Nothing
-- | @restart name resume@. Attempt to restart xmonad by executing the program
-- @name@. If @resume@ is 'True', restart with the current window state.
-- When executing another window manager, @resume@ should be 'False'. -- When executing another window manager, @resume@ should be 'False'.
restart :: String -> Bool -> X () restart :: String -> Bool -> X ()
restart prog resume = do restart prog resume = do
@ -712,49 +527,33 @@ restart prog resume = do
catchIO (executeFile prog True [] Nothing) catchIO (executeFile prog True [] Nothing)
------------------------------------------------------------------------ ------------------------------------------------------------------------
-- Floating layer support -- | Floating layer support
-- | Given a window, find the screen it is located on, and compute -- | Given a window, find the screen it is located on, and compute
-- the geometry of that window WRT that screen. -- the geometry of that window wrt. that screen.
floatLocation :: Window -> X (ScreenId, W.RationalRect) floatLocation :: Window -> X (ScreenId, W.RationalRect)
floatLocation w = floatLocation w =
catchX go $ do catchX go $ do
-- Fallback solution if `go' fails. Which it might, since it -- Fallback solution if `go' fails. Which it might, since it
-- calls `getWindowAttributes'. -- calls `getWindowAttributes'.
sc <- gets $ W.current . windowset sc <- W.current <$> gets windowset
return (W.screen sc, W.RationalRect 0 0 1 1) return (W.screen sc, W.RationalRect 0 0 1 1)
where go = withDisplay $ \d -> do where fi x = fromIntegral x
go = withDisplay $ \d -> do
ws <- gets windowset ws <- gets windowset
sh <- io $ getWMNormalHints d w
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
let bw = (fromIntegral . wa_border_width) wa let bw = (fromIntegral . wa_border_width) wa
point_sc <- pointScreen (fi $ wa_x wa) (fi $ wa_y wa) sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
managed <- isClient w
-- ignore pointScreen for new windows unless it's the current let sr = screenRect . W.screenDetail $ sc
-- screen, otherwise the float's relative size is computed against rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
-- a different screen and the float ends up with the wrong size ((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
let sr_eq = (==) `on` fmap (screenRect . W.screenDetail) (fi (wa_width wa + bw*2) % fi (rect_width sr))
sc = fromMaybe (W.current ws) $ (fi (wa_height wa + bw*2) % fi (rect_height sr))
if managed || point_sc `sr_eq` Just (W.current ws) then point_sc else Nothing
sr = screenRect . W.screenDetail $ sc
x = (fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)
y = (fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)
(width, height) = applySizeHintsContents sh (wa_width wa, wa_height wa)
rwidth = fi (width + bw*2) % fi (rect_width sr)
rheight = fi (height + bw*2) % fi (rect_height sr)
-- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen,
-- it might be out of bounds otherwise
rr = if managed || point_sc `sr_eq` Just sc
then W.RationalRect x y rwidth rheight
else W.RationalRect (0.5 - rwidth/2) (0.5 - rheight/2) rwidth rheight
return (W.screen sc, rr) return (W.screen sc, rr)
fi :: (Integral a, Num b) => a -> b
fi = fromIntegral
-- | Given a point, determine the screen (if any) that contains it. -- | Given a point, determine the screen (if any) that contains it.
pointScreen :: Position -> Position pointScreen :: Position -> Position
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail)) -> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@ -785,20 +584,14 @@ float w = do
-- | Accumulate mouse motion events -- | Accumulate mouse motion events
mouseDrag :: (Position -> Position -> X ()) -> X () -> X () mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
mouseDrag = mouseDragCursor Nothing mouseDrag f done = do
-- | Like 'mouseDrag', but with the ability to specify a custom cursor
-- shape.
mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
mouseDragCursor cursorGlyph f done = do
drag <- gets dragging drag <- gets dragging
case drag of case drag of
Just _ -> return () -- error case? we're already dragging Just _ -> return () -- error case? we're already dragging
Nothing -> do Nothing -> do
XConf { theRoot = root, display = d } <- ask XConf { theRoot = root, display = d } <- ask
io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
grabPointer d root False (buttonReleaseMask .|. pointerMotionMask) grabModeAsync grabModeAsync none none currentTime
grabModeAsync grabModeAsync none cursor currentTime
modify $ \s -> s { dragging = Just (motion, cleanup) } modify $ \s -> s { dragging = Just (motion, cleanup) }
where where
cleanup = do cleanup = do
@ -809,41 +602,39 @@ mouseDragCursor cursorGlyph f done = do
clearEvents pointerMotionMask clearEvents pointerMotionMask
return z return z
-- | Drag the window under the cursor with the mouse while it is dragged. -- | drag the window under the cursor with the mouse while it is dragged
mouseMoveWindow :: Window -> X () mouseMoveWindow :: Window -> X ()
mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
(_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w (_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
let ox = fromIntegral ox' let ox = fromIntegral ox'
oy = fromIntegral oy' oy = fromIntegral oy'
mouseDragCursor mouseDrag (\ex ey -> do
(Just xC_fleur)
(\ex ey -> do
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox))) io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy))) (fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
float w float w
) )
(float w) (float w)
-- | Resize the window under the cursor with the mouse while it is dragged. -- | resize the window under the cursor with the mouse while it is dragged
mouseResizeWindow :: Window -> X () mouseResizeWindow :: Window -> X ()
mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
io $ raiseWindow d w
wa <- io $ getWindowAttributes d w wa <- io $ getWindowAttributes d w
sh <- io $ getWMNormalHints d w sh <- io $ getWMNormalHints d w
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa)) io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
mouseDragCursor mouseDrag (\ex ey -> do
(Just xC_bottom_right_corner)
(\ex ey -> do
io $ resizeWindow d w `uncurry` io $ resizeWindow d w `uncurry`
applySizeHintsContents sh (ex - fromIntegral (wa_x wa), applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa)) ey - fromIntegral (wa_y wa))
float w) float w)
(float w) (float w)
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------
-- Support for window size hints -- | Support for window size hints
-- | An alias for a (width, height) pair
type D = (Dimension, Dimension) type D = (Dimension, Dimension)
-- | Given a window, build an adjuster function that will reduce the given -- | Given a window, build an adjuster function that will reduce the given
@ -853,7 +644,7 @@ mkAdjust w = withDisplay $ \d -> liftIO $ do
sh <- getWMNormalHints d w sh <- getWMNormalHints d w
wa <- C.try $ getWindowAttributes d w wa <- C.try $ getWindowAttributes d w
case wa of case wa of
Left (_ :: C.SomeException) -> return id Left err -> const (return id) (err :: C.SomeException)
Right wa' -> Right wa' ->
let bw = fromIntegral $ wa_border_width wa' let bw = fromIntegral $ wa_border_width wa'
in return $ applySizeHints bw sh in return $ applySizeHints bw sh
@ -871,7 +662,7 @@ applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
applySizeHintsContents sh (w, h) = applySizeHintsContents sh (w, h) =
applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h) applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h)
-- | Use X11 size hints to scale a pair of dimensions. -- | XXX comment me
applySizeHints' :: SizeHints -> D -> D applySizeHints' :: SizeHints -> D -> D
applySizeHints' sh = applySizeHints' sh =
maybe id applyMaxSizeHint (sh_max_size sh) maybe id applyMaxSizeHint (sh_max_size sh)

View File

@ -1,5 +1,4 @@
{-# LANGUAGE PatternGuards #-} {-# LANGUAGE PatternGuards #-}
{-# LANGUAGE DeriveFunctor #-}
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- | -- |
@ -53,13 +52,9 @@ module XMonad.StackSet (
) where ) where
import Prelude hiding (filter) import Prelude hiding (filter)
import Control.Applicative.Backwards (Backwards (Backwards, forwards))
import Data.Foldable (foldr, toList)
import Data.Maybe (listToMaybe,isJust,fromMaybe) import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub) import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
import Data.List ( (\\) ) import Data.List ( (\\) )
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty((:|)))
import qualified Data.Map as M (Map,insert,delete,empty) import qualified Data.Map as M (Map,insert,delete,empty)
-- $intro -- $intro
@ -90,27 +85,25 @@ import qualified Data.Map as M (Map,insert,delete,empty)
-- continuation reified as a data structure. -- continuation reified as a data structure.
-- --
-- The Zipper lets us replace an item deep in a complex data -- The Zipper lets us replace an item deep in a complex data
-- structure, e.g., a tree or a term, without a mutation. The -- structure, e.g., a tree or a term, without an mutation. The
-- resulting data structure will share as much of its components with -- resulting data structure will share as much of its components with
-- the old structure as possible. -- the old structure as possible.
-- --
-- <https://mail.haskell.org/pipermail/haskell/2005-April/015769.html Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"> -- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
-- --
-- We use the zipper to keep track of the focused workspace and the -- We use the zipper to keep track of the focused workspace and the
-- focused window on each workspace, allowing us to have correct focus -- focused window on each workspace, allowing us to have correct focus
-- by construction. We closely follow Huet's original implementation: -- by construction. We closely follow Huet's original implementation:
-- --
-- <https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf G. Huet, Functional Pearl: The Zipper; 1997, J. Functional Programming 75(5):549554> -- G. Huet, /Functional Pearl: The Zipper/,
-- 1997, J. Functional Programming 75(5):549-554.
-- and:
-- R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
-- --
-- and -- and Conor McBride's zipper differentiation paper.
-- Another good reference is:
-- --
-- <https://dspace.library.uu.nl/handle/1874/2532 R. Hinze and J. Jeuring, Functional Pearl: Weaving a Web> -- The Zipper, Haskell wikibook
--
-- and
--
-- <http://strictlypositive.org/diff.pdf Conor McBride, The Derivative of a Regular Type is its Type of One-Hole Contexts>.
--
-- Another good reference is: <https://wiki.haskell.org/Zipper The Zipper, Haskell wikibook>
-- $xinerama -- $xinerama
-- Xinerama in X11 lets us view multiple virtual workspaces -- Xinerama in X11 lets us view multiple virtual workspaces
@ -158,7 +151,7 @@ data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stac
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
-- | A structure for window geometries -- | A structure for window geometries
data RationalRect = RationalRect !Rational !Rational !Rational !Rational data RationalRect = RationalRect Rational Rational Rational Rational
deriving (Show, Read, Eq) deriving (Show, Read, Eq)
-- | -- |
@ -182,19 +175,8 @@ data RationalRect = RationalRect !Rational !Rational !Rational !Rational
data Stack a = Stack { focus :: !a -- focused thing in this set data Stack a = Stack { focus :: !a -- focused thing in this set
, up :: [a] -- clowns to the left , up :: [a] -- clowns to the left
, down :: [a] } -- jokers to the right , down :: [a] } -- jokers to the right
deriving (Show, Read, Eq, Functor) deriving (Show, Read, Eq)
instance Foldable Stack where
toList = integrate
foldr f z = foldr f z . toList
instance Traversable Stack where
traverse f s =
flip Stack
-- 'Backwards' applies the Applicative in reverse order.
<$> forwards (traverse (Backwards . f) (up s))
<*> f (focus s)
<*> traverse f (down s)
-- | this function indicates to catch that an error is expected -- | this function indicates to catch that an error is expected
abort :: String -> a abort :: String -> a
@ -212,11 +194,10 @@ abort x = error $ "xmonad: StackSet: " ++ x
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0. -- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
-- --
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
new l (wid:wids) (m:ms) | length ms <= length wids new l wids m | not (null wids) && length m <= length wids && not (null m)
= StackSet cur visi (map ws unseen) M.empty = StackSet cur visi unseen M.empty
where ws i = Workspace i l Nothing where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
(seen, unseen) = L.splitAt (length ms) wids (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
cur:visi = Screen (ws wid) 0 m : [ Screen (ws i) s sd | (i, s, sd) <- zip3 seen [1..] ms ]
-- now zip up visibles with their screen id -- now zip up visibles with their screen id
new _ _ _ = abort "non-positive argument to StackSet.new" new _ _ _ = abort "non-positive argument to StackSet.new"
@ -243,7 +224,7 @@ view i s
| otherwise = s -- not a member of the stackset | otherwise = s -- not a member of the stackset
where equating f x y = f x == f y where equating f = \x y -> f x == f y
-- 'Catch'ing this might be hard. Relies on monotonically increasing -- 'Catch'ing this might be hard. Relies on monotonically increasing
-- workspace tags defined in 'new' -- workspace tags defined in 'new'
@ -316,7 +297,7 @@ integrate :: Stack a -> [a]
integrate (Stack x l r) = reverse l ++ x : r integrate (Stack x l r) = reverse l ++ x : r
-- | -- |
-- /O(n)/. Flatten a possibly empty stack into a list. -- /O(n)/ Flatten a possibly empty stack into a list.
integrate' :: Maybe (Stack a) -> [a] integrate' :: Maybe (Stack a) -> [a]
integrate' = maybe [] integrate integrate' = maybe [] integrate
@ -348,44 +329,32 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
index :: StackSet i l a s sd -> [a] index :: StackSet i l a s sd -> [a]
index = with [] integrate index = with [] integrate
-- | /O(1), O(w) on the wrapping case/. Move the window focus up the -- |
-- stack, wrapping if we reach the end. The wrapping should model a -- /O(1), O(w) on the wrapping case/.
-- @cycle@ on the current stack. The @master@ window and window order --
-- focusUp, focusDown. Move the window focus up or down the stack,
-- wrapping if we reach the end. The wrapping should model a 'cycle'
-- on the current stack. The 'master' window, and window order,
-- are unaffected by movement of focus. -- are unaffected by movement of focus.
focusUp :: StackSet i l a s sd -> StackSet i l a s sd --
-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping
-- if we reach the end. Again the wrapping model should 'cycle' on
-- the current stack.
--
focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
focusUp = modify' focusUp' focusUp = modify' focusUp'
-- | /O(1), O(w) on the wrapping case/. Like 'focusUp', but move the
-- window focus down the stack.
focusDown :: StackSet i l a s sd -> StackSet i l a s sd
focusDown = modify' focusDown' focusDown = modify' focusDown'
-- | /O(1), O(w) on the wrapping case/. Swap the upwards (left)
-- neighbour in the stack ordering, wrapping if we reach the end. Much
-- like for 'focusUp' and 'focusDown', the wrapping model should 'cycle'
-- on the current stack.
swapUp :: StackSet i l a s sd -> StackSet i l a s sd
swapUp = modify' swapUp' swapUp = modify' swapUp'
-- | /O(1), O(w) on the wrapping case/. Like 'swapUp', but for swapping
-- the downwards (right) neighbour.
swapDown :: StackSet i l a s sd -> StackSet i l a s sd
swapDown = modify' (reverseStack . swapUp' . reverseStack) swapDown = modify' (reverseStack . swapUp' . reverseStack)
-- | A variant of 'focusUp' with the same asymptotics that works on a -- | Variants of 'focusUp' and 'focusDown' that work on a
-- 'Stack' rather than an entire 'StackSet'. -- 'Stack' rather than an entire 'StackSet'.
focusUp' :: Stack a -> Stack a focusUp', focusDown' :: Stack a -> Stack a
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs) focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
focusUp' (Stack t [] rs) = Stack x xs [] focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
where (x :| xs) = NE.reverse (t :| rs) focusDown' = reverseStack . focusUp' . reverseStack
-- | A variant of 'focusDown' with the same asymptotics that works on a
-- 'Stack' rather than an entire 'StackSet'.
focusDown' :: Stack a -> Stack a
focusDown' = reverseStack . focusUp' . reverseStack
-- | A variant of 'spawUp' with the same asymptotics that works on a
-- 'Stack' rather than an entire 'StackSet'.
swapUp' :: Stack a -> Stack a swapUp' :: Stack a -> Stack a
swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs) swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
swapUp' (Stack t [] rs) = Stack t (reverse rs) [] swapUp' (Stack t [] rs) = Stack t (reverse rs) []
@ -539,8 +508,8 @@ sink w s = s { floating = M.delete w (floating s) }
-- Focus stays with the item moved. -- Focus stays with the item moved.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = modify' $ \c -> case c of swapMaster = modify' $ \c -> case c of
Stack _ [] _ -> c -- already master. Stack _ [] _ -> c -- already master.
Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls) Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
-- natural! keep focus, move current to the top, move top to current. -- natural! keep focus, move current to the top, move top to current.
@ -556,8 +525,8 @@ shiftMaster = modify' $ \c -> case c of
-- | /O(s)/. Set focus to the master window. -- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of focusMaster = modify' $ \c -> case c of
Stack _ [] _ -> c Stack _ [] _ -> c
Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls) Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
-- --
-- --------------------------------------------------------------------- -- ---------------------------------------------------------------------

View File

@ -1,15 +1,7 @@
resolver: lts-21.12 resolver: lts-7.19
packages: packages:
- ./ - ./
extra-deps: extra-deps:
- X11-1.10 - X11-1.8
nix:
packages:
- zlib
- xorg.libX11
- xorg.libXrandr
- xorg.libXScrnSaver
- xorg.libXext

View File

@ -36,7 +36,7 @@ instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
-- Pick a random window "number" in each workspace, to give focus. -- Pick a random window "number" in each workspace, to give focus.
focus <- sequence [ if null windows focus <- sequence [ if null windows
then return Nothing then return Nothing
else Just <$> choose (0, length windows - 1) else liftM Just $ choose (0, length windows - 1)
| windows <- wsWindows ] | windows <- wsWindows ]
let tags = [1 .. fromIntegral numWs] let tags = [1 .. fromIntegral numWs]
@ -80,7 +80,7 @@ newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T
instance Arbitrary NonEmptyWindowsStackSet where instance Arbitrary NonEmptyWindowsStackSet where
arbitrary = arbitrary =
NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows)) NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
instance Arbitrary Rectangle where instance Arbitrary Rectangle where
arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@ -99,7 +99,7 @@ newtype NonEmptyNubList a = NonEmptyNubList [a]
deriving ( Eq, Ord, Show, Read ) deriving ( Eq, Ord, Show, Read )
instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null)) arbitrary = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
@ -116,7 +116,7 @@ arbitraryTag :: T -> Gen Tag
arbitraryTag x = do arbitraryTag x = do
let ts = tags x let ts = tags x
-- There must be at least 1 workspace, thus at least 1 tag. -- There must be at least 1 workspace, thus at least 1 tag.
idx <- choose (0, length ts - 1) idx <- choose (0, (length ts) - 1)
return $ ts!!idx return $ ts!!idx
-- | Pull out an arbitrary window from a StackSet that is guaranteed to have a -- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
@ -136,5 +136,5 @@ arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window
arbitraryWindow (NonEmptyWindowsStackSet x) = do arbitraryWindow (NonEmptyWindowsStackSet x) = do
let ws = allWindows x let ws = allWindows x
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet. -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
idx <- choose (0, length ws - 1) idx <- choose(0, (length ws) - 1)
return $ ws!!idx return $ ws!!idx

View File

@ -1,6 +1,6 @@
import Test.QuickCheck import Test.QuickCheck
-- Our QC instances and properties: -- Our QC instances and properties.
import Instances import Instances
import Properties.Delete import Properties.Delete
import Properties.Failure import Properties.Failure
@ -166,16 +166,11 @@ tests =
-- tall layout -- tall layout
,("tile 1 window fullsize", property prop_tile_fullscreen) ,("tile 1 window fullsize", property prop_tile_fullscreen)
,("tile max ratio", property prop_tile_max_ratio)
,("tile min ratio", property prop_tile_min_ratio)
,("tiles never overlap", property prop_tile_non_overlap) ,("tiles never overlap", property prop_tile_non_overlap)
,("split horizontal", property prop_split_horizontal) ,("split horizontal", property prop_split_horizontal)
,("split vertical", property prop_split_vertical) ,("split vertical", property prop_split_vertical)
,("pure layout tall", property prop_purelayout_tall) ,("pure layout tall", property prop_purelayout_tall)
{- Following two test cases should be automatically generated by QuickCheck ideally, but it fails. -}
,("pure layout tall: ratio = 0", property (\n d rect -> prop_purelayout_tall n d 0 rect))
,("pure layout tall: ratio = 1", property (\n d rect -> prop_purelayout_tall n d 1 rect))
,("send shrink tall", property prop_shrink_tall) ,("send shrink tall", property prop_shrink_tall)
,("send expand tall", property prop_expand_tall) ,("send expand tall", property prop_expand_tall)
,("send incmaster tall", property prop_incmaster_tall) ,("send incmaster tall", property prop_incmaster_tall)
@ -201,5 +196,6 @@ tests =
,("pointWithin", property prop_point_within) ,("pointWithin", property prop_point_within)
,("pointWithin mirror", property prop_point_within_mirror) ,("pointWithin mirror", property prop_point_within_mirror)
] <> ]
prop_laws_Stack

View File

@ -18,7 +18,7 @@ prop_delete x =
where _ = x :: T where _ = x :: T
-- delete is reversible with 'insert'. -- delete is reversible with 'insert'.
-- It is the identity, except for the 'master', which is reset on insert and delete. -- It is the identiy, except for the 'master', which is reset on insert and delete.
-- --
prop_delete_insert (x :: T) = prop_delete_insert (x :: T) =
case peek x of case peek x of
@ -64,7 +64,7 @@ prop_delete_focus_not_end = do
-- last one in the stack. -- last one in the stack.
`suchThat` \(x' :: T) -> `suchThat` \(x' :: T) ->
let currWins = index x' let currWins = index x'
in length currWins >= 2 && peek x' /= Just (last currWins) in length (currWins) >= 2 && peek x' /= Just (last currWins)
-- This is safe, as we know there are >= 2 windows -- This is safe, as we know there are >= 2 windows
let Just n = peek x let Just n = peek x
return $ peek (delete n x) == peek (focusDown x) return $ peek (delete n x) == peek (focusDown x)

View File

@ -2,7 +2,7 @@ module Properties.Failure where
import XMonad.StackSet hiding (filter) import XMonad.StackSet hiding (filter)
import qualified Control.Exception as C import qualified Control.Exception.Extensible as C
import System.IO.Unsafe import System.IO.Unsafe
import Data.List (isPrefixOf) import Data.List (isPrefixOf)

View File

@ -32,8 +32,8 @@ prop_focusWindow_master (NonNegative n) (x :: T) =
in index (focusWindow (s !! i) x) == index x in index (focusWindow (s !! i) x) == index x
-- shifting focus is trivially reversible -- shifting focus is trivially reversible
prop_focus_left (x :: T) = focusUp (focusDown x) == x prop_focus_left (x :: T) = (focusUp (focusDown x)) == x
prop_focus_right (x :: T) = focusDown (focusUp x) == x prop_focus_right (x :: T) = (focusDown (focusUp x)) == x
-- focus master is idempotent -- focus master is idempotent
prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x) prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
@ -47,9 +47,9 @@ prop_focusWindow_works (NonNegative (n :: Int)) (x :: T) =
in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i) in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
-- rotation through the height of a stack gets us back to the start -- rotation through the height of a stack gets us back to the start
prop_focus_all_l (x :: T) = foldr (const focusUp) x [1..n] == x prop_focus_all_l (x :: T) = (foldr (const focusUp) x [1..n]) == x
where n = length (index x) where n = length (index x)
prop_focus_all_r (x :: T) = foldr (const focusDown) x [1..n] == x prop_focus_all_r (x :: T) = (foldr (const focusDown) x [1..n]) == x
where n = length (index x) where n = length (index x)
-- prop_rotate_all (x :: T) = f (f x) == f x -- prop_rotate_all (x :: T) = f (f x) == f x

View File

@ -35,7 +35,7 @@ prop_greedyView_local (x :: T) = do
-- greedyView is idempotent -- greedyView is idempotent
prop_greedyView_idem (x :: T) = do prop_greedyView_idem (x :: T) = do
n <- arbitraryTag x n <- arbitraryTag x
return $ greedyView n (greedyView n x) == greedyView n x return $ greedyView n (greedyView n x) == (greedyView n x)
-- greedyView is reversible, though shuffles the order of hidden/visible -- greedyView is reversible, though shuffles the order of hidden/visible
prop_greedyView_reversible (x :: T) = do prop_greedyView_reversible (x :: T) = do

View File

@ -46,7 +46,7 @@ prop_insert_delete x = do
-- inserting n elements increases current stack size by n -- inserting n elements increases current stack size by n
prop_size_insert is (EmptyStackSet x) = prop_size_insert is (EmptyStackSet x) =
size (foldr insertUp x ws) == length ws size (foldr insertUp x ws ) == (length ws)
where where
ws = nub is ws = nub is
size = length . index size = length . index

View File

@ -29,6 +29,6 @@ prop_purelayout_full rect = do
-- what happens when we send an IncMaster message to Full --- Nothing -- what happens when we send an IncMaster message to Full --- Nothing
prop_sendmsg_full (NonNegative k) = prop_sendmsg_full (NonNegative k) =
isNothing (Full `pureMessage` SomeMessage (IncMasterN k)) isNothing (Full `pureMessage` (SomeMessage (IncMasterN k)))
prop_desc_full = description Full == show Full prop_desc_full = description Full == show Full

View File

@ -11,9 +11,8 @@ import XMonad.Layout
import Graphics.X11.Xlib.Types (Rectangle(..)) import Graphics.X11.Xlib.Types (Rectangle(..))
import Control.Applicative
import Data.List (sort)
import Data.Maybe import Data.Maybe
import Data.List (sort)
import Data.Ratio import Data.Ratio
------------------------------------------------------------------------ ------------------------------------------------------------------------
@ -28,30 +27,14 @@ prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster w
where _ = rect :: Rectangle where _ = rect :: Rectangle
pct = 3 % 100 pct = 3 % 100
-- with a ratio of 1, no stack windows are drawn of there is at least
-- one master window around.
prop_tile_max_ratio = extremeRatio 1 drop
-- with a ratio of 0, no master windows are drawn at all if there are
-- any stack windows around.
prop_tile_min_ratio = extremeRatio 0 take
extremeRatio amount getRects rect = do
w@(NonNegative windows) <- arbitrary `suchThat` (> NonNegative 0)
NonNegative nmaster <- arbitrary `suchThat` (< w)
let tiled = tile amount rect nmaster windows
pure $ if nmaster == 0
then prop_tile_non_overlap rect windows nmaster
else all ((== 0) . rect_width) $ getRects nmaster tiled
-- splitting horizontally yields sensible results -- splitting horizontally yields sensible results
prop_split_horizontal (NonNegative n) x = prop_split_horizontal (NonNegative n) x =
noOverflows (+) (rect_x x) (rect_width x) ==> (noOverflows (+) (rect_x x) (rect_width x)) ==>
sum (map rect_width xs) == rect_width x sum (map rect_width xs) == rect_width x
&& &&
all (\s -> rect_height s == rect_height x) xs all (== rect_height x) (map rect_height xs)
&& &&
map rect_x xs == sort (map rect_x xs) (map rect_x xs) == (sort $ map rect_x xs)
where where
xs = splitHorizontally n x xs = splitHorizontally n x
@ -66,20 +49,13 @@ prop_split_vertical (r :: Rational) x =
-- pureLayout works. -- pureLayout works.
prop_purelayout_tall n d r rect = do prop_purelayout_tall n r1 r2 rect = do
x <- (arbitrary :: Gen T) `suchThat` (isJust . peek) x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
let layout = Tall n d r let layout = Tall n r1 r2
st = fromJust . stack . workspace . current $ x st = fromJust . stack . workspace . current $ x
ts = pureLayout layout rect st ts = pureLayout layout rect st
ntotal = length (index x)
return $ return $
(if r == 0 then length ts == length (index x)
-- (<=) for Bool is the logical implication
(0 <= n && n <= ntotal) <= (length ts == ntotal - n)
else if r == 1 then
(0 <= n && n <= ntotal) <= (length ts == n)
else
length ts == ntotal)
&& &&
noOverlaps (map snd ts) noOverlaps (map snd ts)
&& &&
@ -96,7 +72,7 @@ prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) =
-- remaining fraction should shrink -- remaining fraction should shrink
where where
l1 = Tall n delta frac l1 = Tall n delta frac
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Shrink Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Shrink)
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
@ -117,7 +93,7 @@ prop_expand_tall (NonNegative n)
where where
frac = min 1 (n1 % d1) frac = min 1 (n1 % d1)
l1 = Tall n delta frac l1 = Tall n delta frac
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Expand Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage Expand)
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
-- what happens when we send an IncMaster message to Tall -- what happens when we send an IncMaster message to Tall
@ -126,7 +102,7 @@ prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac)
delta == delta' && frac == frac' && n' == n + k delta == delta' && frac == frac' && n' == n + k
where where
l1 = Tall n delta frac l1 = Tall n delta frac
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage (IncMasterN k) Just l2@(Tall n' delta' frac') = l1 `pureMessage` (SomeMessage (IncMasterN k))
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a) -- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)

View File

@ -52,14 +52,15 @@ prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
-- applyAspectHint does nothing when the supplied (x,y) fits -- applyAspectHint does nothing when the supplied (x,y) fits
-- the desired range -- the desired range
prop_aspect_fits = prop_aspect_fits =
forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) -> forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
let f = applyAspectHint ((x, y+a), (x+b, y)) let f v = applyAspectHint ((x, y+a), (x+b, y)) v
in noOverflows (*) x (y+a) && noOverflows (*) (x+b) y in and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ]
==> f (x,y) == (x,y) ==> f (x,y) == (x,y)
where pos = choose (0, 65535) where pos = choose (0, 65535)
mul a b = toInteger (a*b) /= toInteger a * toInteger b
prop_point_within r@(Rectangle x y w h) = prop_point_within r @ (Rectangle x y w h) =
forAll ((,) <$> forAll ((,) <$>
choose (0, fromIntegral w - 1) <*> choose (0, fromIntegral w - 1) <*>
choose (0, fromIntegral h - 1)) $ choose (0, fromIntegral h - 1)) $

View File

@ -27,7 +27,7 @@ prop_shift_reversible (x :: T) = do
-- shiftMaster -- shiftMaster
-- focus/local/idempotent same as swapMaster: -- focus/local/idempotent same as swapMaster:
prop_shift_master_focus (x :: T) = peek x == peek (shiftMaster x) prop_shift_master_focus (x :: T) = peek x == (peek $ shiftMaster x)
prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x) prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
-- ordering is constant modulo the focused window: -- ordering is constant modulo the focused window:
@ -57,14 +57,14 @@ prop_shift_win_fix_current = do
x <- arbitrary `suchThat` \(x' :: T) -> x <- arbitrary `suchThat` \(x' :: T) ->
-- Invariant, otherWindows are NOT in the current workspace. -- Invariant, otherWindows are NOT in the current workspace.
let otherWindows = allWindows x' L.\\ index x' let otherWindows = allWindows x' L.\\ index x'
in length (tags x') >= 2 && not (null otherWindows) in length(tags x') >= 2 && length(otherWindows) >= 1
-- Sadly we have to construct `otherWindows` again, for the actual StackSet -- Sadly we have to construct `otherWindows` again, for the actual StackSet
-- that got chosen. -- that got chosen.
let otherWindows = allWindows x L.\\ index x let otherWindows = allWindows x L.\\ index x
-- We know such tag must exists, due to the precondition -- We know such tag must exists, due to the precondition
n <- arbitraryTag x `suchThat` (/= currentTag x) n <- arbitraryTag x `suchThat` (/= currentTag x)
-- we know length is >= 1, from above precondition -- we know length is >= 1, from above precondition
idx <- choose (0, length otherWindows - 1) idx <- choose(0, length(otherWindows) - 1)
let w = otherWindows !! idx let w = otherWindows !! idx
return $ current x == current (shiftWin n w x) return $ (current $ x) == (current $ shiftWin n w x)

View File

@ -1,6 +1,4 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Properties.Stack where module Properties.Stack where
import Test.QuickCheck import Test.QuickCheck
@ -11,18 +9,12 @@ import qualified XMonad.StackSet as S (filter)
import Data.Maybe import Data.Maybe
import Data.Proxy
import Test.QuickCheck.Classes (
Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1),
foldableLaws, traversableLaws,
)
-- The list returned by index should be the same length as the actual -- The list returned by index should be the same length as the actual
-- windows kept in the zipper -- windows kept in the zipper
prop_index_length (x :: T) = prop_index_length (x :: T) =
case stack . workspace . current $ x of case stack . workspace . current $ x of
Nothing -> null (index x) Nothing -> length (index x) == 0
Just it -> length (index x) == length (focus it : up it ++ down it) Just it -> length (index x) == length (focus it : up it ++ down it)
@ -41,7 +33,7 @@ prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
-- which is a key component in this test (together with member). -- which is a key component in this test (together with member).
let ws = allWindows x let ws = allWindows x
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet. -- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
idx <- choose (0, length ws - 1) idx <- choose(0, (length ws) - 1)
return $ member (ws!!idx) x return $ member (ws!!idx) x
@ -54,24 +46,6 @@ prop_filter_order (x :: T) =
-- differentiate should return Nothing if the list is empty or Just stack, with -- differentiate should return Nothing if the list is empty or Just stack, with
-- the first element of the list is current, and the rest of the list is down. -- the first element of the list is current, and the rest of the list is down.
prop_differentiate xs = prop_differentiate xs =
if null xs then isNothing (differentiate xs) if null xs then differentiate xs == Nothing
else differentiate xs == Just (Stack (head xs) [] (tail xs)) else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
where _ = xs :: [Int] where _ = xs :: [Int]
-- Check type class laws of 'Data.Foldable.Foldable' and 'Data.Traversable.Traversable'.
newtype TestStack a = TestStack (Stack a)
deriving (Eq, Read, Show, Foldable, Functor)
instance (Arbitrary a) => Arbitrary (TestStack a) where
arbitrary = TestStack <$> (Stack <$> arbitrary <*> arbitrary <*> arbitrary)
shrink = traverse shrink
instance Traversable TestStack where
traverse f (TestStack sx) = fmap TestStack (traverse f sx)
prop_laws_Stack = format (foldableLaws p) <> format (traversableLaws p)
where
p = Proxy :: Proxy TestStack
format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop)
| (name, prop) <- lawsProperties laws ]

View File

@ -58,7 +58,7 @@ invariant (s :: T) = and
-- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ] -- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
monotonic [] = True monotonic [] = True
monotonic [x] = True monotonic (x:[]) = True
monotonic (x:y:zs) | x == y-1 = monotonic (y:zs) monotonic (x:y:zs) | x == y-1 = monotonic (y:zs)
| otherwise = False | otherwise = False
@ -126,7 +126,7 @@ prop_empty (EmptyStackSet x) =
prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x) prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
-- no windows will be a member of an empty workspace -- no windows will be a member of an empty workspace
prop_member_empty i (EmptyStackSet x) = not (member i x) prop_member_empty i (EmptyStackSet x) = member i x == False
-- peek either yields nothing on the Empty workspace, or Just a valid window -- peek either yields nothing on the Empty workspace, or Just a valid window
prop_member_peek (x :: T) = prop_member_peek (x :: T) =

View File

@ -11,8 +11,8 @@ import XMonad.StackSet hiding (filter)
-- swapUp, swapDown, swapMaster: reordiring windows -- swapUp, swapDown, swapMaster: reordiring windows
-- swap is trivially reversible -- swap is trivially reversible
prop_swap_left (x :: T) = swapUp (swapDown x) == x prop_swap_left (x :: T) = (swapUp (swapDown x)) == x
prop_swap_right (x :: T) = swapDown (swapUp x) == x prop_swap_right (x :: T) = (swapDown (swapUp x)) == x
-- TODO swap is reversible -- TODO swap is reversible
-- swap is reversible, but involves moving focus back the window with -- swap is reversible, but involves moving focus back the window with
-- master on it. easy to do with a mouse... -- master on it. easy to do with a mouse...
@ -26,12 +26,12 @@ prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . curren
-} -}
-- swap doesn't change focus -- swap doesn't change focus
prop_swap_master_focus (x :: T) = peek x == peek (swapMaster x) prop_swap_master_focus (x :: T) = peek x == (peek $ swapMaster x)
-- = case peek x of -- = case peek x of
-- Nothing -> True -- Nothing -> True
-- Just f -> focus (stack (workspace $ current (swap x))) == f -- Just f -> focus (stack (workspace $ current (swap x))) == f
prop_swap_left_focus (x :: T) = peek x == peek (swapUp x) prop_swap_left_focus (x :: T) = peek x == (peek $ swapUp x)
prop_swap_right_focus (x :: T) = peek x == peek (swapDown x) prop_swap_right_focus (x :: T) = peek x == (peek $ swapDown x)
-- swap is local -- swap is local
prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x) prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
@ -39,9 +39,9 @@ prop_swap_left_local (x :: T) = hidden_spaces x == hidden_spaces (swapUp x)
prop_swap_right_local (x :: T) = hidden_spaces x == hidden_spaces (swapDown x) prop_swap_right_local (x :: T) = hidden_spaces x == hidden_spaces (swapDown x)
-- rotation through the height of a stack gets us back to the start -- rotation through the height of a stack gets us back to the start
prop_swap_all_l (x :: T) = foldr (const swapUp) x [1..n] == x prop_swap_all_l (x :: T) = (foldr (const swapUp) x [1..n]) == x
where n = length (index x) where n = length (index x)
prop_swap_all_r (x :: T) = foldr (const swapDown) x [1..n] == x prop_swap_all_r (x :: T) = (foldr (const swapDown) x [1..n]) == x
where n = length (index x) where n = length (index x)
prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x

View File

@ -37,7 +37,7 @@ prop_view_local (x :: T) = do
-- view is idempotent -- view is idempotent
prop_view_idem (x :: T) = do prop_view_idem (x :: T) = do
n <- arbitraryTag x n <- arbitraryTag x
return $ view n (view n x) == view n x return $ view n (view n x) == (view n x)
-- view is reversible, though shuffles the order of hidden/visible -- view is reversible, though shuffles the order of hidden/visible
prop_view_reversible (x :: T) = do prop_view_reversible (x :: T) = do

View File

@ -12,8 +12,8 @@ hidden_spaces x = map workspace (visible x) ++ hidden x
-- normalise workspace list -- normalise workspace list
normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) } normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
where where
f a b = tag (workspace a) `compare` tag (workspace b) f = \a b -> tag (workspace a) `compare` tag (workspace b)
g a b = tag a `compare` tag b g = \a b -> tag a `compare` tag b
noOverlaps [] = True noOverlaps [] = True

83
util/GenerateManpage.hs Executable file → Normal file
View File

@ -1,20 +1,47 @@
#!/usr/bin/env runhaskell {-# LANGUAGE FlexibleContexts #-}
-- Reads markdown (man/xmonad.1.markdown) from stdin, subtitutes -- Generates a in-memory version of "man/xmonad.1.markdown" that has the list
-- ___KEYBINDINGS___ for key-binding definitions generated from -- of known key-bindings is inserted automatically from "Config.hs". That
-- src/XMonad/Config.hs, prints result to stdout. -- document is then rendered with Pandoc as "man/xmonad.1" and
-- "man/xmonad.1.html".
-- --
-- Unlike the rest of xmonad, this file is released under the GNU General -- Unlike the rest of xmonad, this file is released under the GNU General
-- Public License version 2 or later. (Historical reasons, used to link with -- Public License version 2 or later.
-- GPL-licensed pandoc.)
import Control.Monad.IO.Class (liftIO)
import Data.Char import Data.Char
import Data.List import Data.List
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import Text.Pandoc
import Text.Regex.Posix
main :: IO () main :: IO ()
main = do main = do
keybindings <- guessBindings keybindings <- guessBindings
interact $ unlines . replace "___KEYBINDINGS___" keybindings . lines
markdownSource <- readFile "./man/xmonad.1.markdown"
runIOorExplode $ do
parsed <- readMarkdown (def { readerStandalone = True, readerExtensions = pandocExtensions })
. T.pack
. unlines
. replace "___KEYBINDINGS___" keybindings
. lines
$ markdownSource
manTemplate <- getDefaultTemplate "man"
manBody <- writeMan def { writerTemplate = Just manTemplate } parsed
liftIO $ TIO.writeFile "./man/xmonad.1" $ manBody
liftIO $ putStrLn "Documentation created: man/xmonad.1"
htmltemplate <- getDefaultTemplate "html"
htmlBody <- writeHtml5String def
{ writerTemplate = Just htmltemplate
, writerTableOfContents = True }
parsed
liftIO $ TIO.writeFile "./man/xmonad.1.html" htmlBody
liftIO $ putStrLn "Documentation created: man/xmonad.1.html"
-- | The format for the docstrings in "Config.hs" takes the following form: -- | The format for the docstrings in "Config.hs" takes the following form:
-- --
@ -22,7 +49,7 @@ main = do
-- -- mod-x %! Frob the whatsit -- -- mod-x %! Frob the whatsit
-- @ -- @
-- --
-- "Frob the whatsit" will be used as the description for keybinding "mod-x". -- "Frob the whatsit" will be used as the description for keybinding "mod-x".--
-- If the name of the key binding is omitted, the function tries to guess it -- If the name of the key binding is omitted, the function tries to guess it
-- from the rest of the line. For example: -- from the rest of the line. For example:
-- --
@ -34,33 +61,25 @@ main = do
guessBindings :: IO String guessBindings :: IO String
guessBindings = do guessBindings = do
buf <- readFile "./src/XMonad/Config.hs" buf <- readFile "./src/XMonad/Config.hs"
return (intercalate "\n\n" (map markdownDefn (allBindings buf))) return (intercalate "\n\n" (map markdownDefn (allBindings buf)))
allBindings :: String -> [(String, String)] allBindings :: String -> [(String, String)]
allBindings = concatMap parseLine . lines allBindings xs = map (binding . map trim) (xs =~ "(.*)--(.*)%!(.*)")
binding :: [String] -> (String, String)
binding [ _, bindingLine, "", desc ] = (guessKeys bindingLine, desc)
binding [ _, _, keyCombo, desc ] = (keyCombo, desc)
binding x = error ("binding: called with unexpected argument " ++ show x)
guessKeys :: String -> String
guessKeys line =
case keys of
[key] -> concat $ intersperse "-" (modifiers ++ [map toLower key])
_ -> error ("guessKeys: unexpected number of keys " ++ show keys)
where where
parseLine :: String -> [(String, String)] modifiers = map (!!1) (line =~ "(mod|shift|control)Mask")
parseLine l (_, _, _, keys) = line =~ "xK_([_[:alnum:]]+)" :: (String, String, String, [String])
| " -- " `isInfixOf` l
, Just d <- parseDesc l = [(intercalate "-" (parseKeys l), d)]
| otherwise = []
parseDesc :: String -> Maybe String
parseDesc = fmap (trim . drop 4) . find (" %! " `isPrefixOf`) . tails
parseKeys :: String -> [String]
parseKeys l = case lex l of
[("", _)] -> []
[("--", rest)] -> case words rest of
k : "%!" : _ -> [k]
_ -> []
[(k, rest)] -> parseKey k ++ parseKeys rest
parseKey :: String -> [String]
parseKey k | "Mask" `isSuffixOf` k = [reverse (drop 4 (reverse k))]
| "xK_" `isPrefixOf` k = [map toLower (drop 3 k)]
| otherwise = []
-- FIXME: What escaping should we be doing on these strings? -- FIXME: What escaping should we be doing on these strings?
markdownDefn :: (String, String) -> String markdownDefn :: (String, String) -> String

View File

@ -1,5 +1,5 @@
name: xmonad name: xmonad
version: 0.18.0.9 version: 0.14.2
synopsis: A tiling window manager synopsis: A tiling window manager
description: xmonad is a tiling window manager for X. Windows are arranged description: xmonad is a tiling window manager for X. Windows are arranged
automatically to tile the screen without gaps or overlap, maximising automatically to tile the screen without gaps or overlap, maximising
@ -25,34 +25,41 @@ author: Spencer Janssen, Don Stewart, Adam Vogt, David Roundy, Jason
Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey, Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey,
Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout, Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout,
Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver, Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
maintainer: xmonad@haskell.org maintainer: xmonad@haskell.org
tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.2 || == 9.12.2 tested-with: GHC == 8.0.2, GHC == 8.2.2, GHC == 8.4.3, GHC == 8.6.1
category: System category: System
homepage: http://xmonad.org homepage: http://xmonad.org
bug-reports: https://github.com/xmonad/xmonad/issues bug-reports: https://github.com/xmonad/xmonad/issues
build-type: Simple build-type: Simple
extra-source-files: README.md extra-source-files: README.md
CHANGES.md CHANGES.md
CONTRIBUTING.md CONFIG
INSTALL.md STYLE
MAINTAINERS.md tests/*.hs
TUTORIAL.md tests/Properties/*.hs
tests/Properties/Layout/*.hs
man/xmonad.1.markdown man/xmonad.1.markdown
man/xmonad.1 man/xmonad.1
man/xmonad.1.html man/xmonad.1.html
man/xmonad.hs man/xmonad.hs
util/GenerateManpage.hs
util/hpcReport.sh util/hpcReport.sh
cabal-version: 1.12 cabal-version: >= 1.8
source-repository head source-repository head
type: git type: git
location: https://github.com/xmonad/xmonad location: https://github.com/xmonad/xmonad
flag pedantic flag testing
description: Be pedantic (-Werror and the like)
default: False default: False
manual: True manual: True
description: Testing mode, only build minimal components
flag generatemanpage
default: False
manual: True
description: Build the tool for generating the man page
library library
exposed-modules: XMonad exposed-modules: XMonad
@ -65,40 +72,36 @@ library
XMonad.StackSet XMonad.StackSet
other-modules: Paths_xmonad other-modules: Paths_xmonad
hs-source-dirs: src hs-source-dirs: src
build-depends: base >= 4.12 && < 5 build-depends: base >= 4.9 && < 5
, X11 >= 1.10 && < 1.11 , X11 >= 1.8 && < 1.10
, containers , containers
, data-default-class , data-default
, directory , directory
, extensible-exceptions
, filepath , filepath
, mtl , mtl
, process , process
, setlocale , setlocale
, time
, transformers >= 0.3
, unix , unix
ghc-options: -funbox-strict-fields -Wall -Wno-unused-do-bind , utf8-string >= 0.3 && < 1.1
default-language: Haskell2010 ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind
-- Keep this in sync with the oldest version in 'tested-with' if flag(testing)
if impl(ghc > 8.6.5) buildable: False
ghc-options: -Wno-unused-imports
if flag(pedantic)
ghc-options: -Werror
executable xmonad executable xmonad
main-is: Main.hs main-is: Main.hs
build-depends: base, xmonad build-depends: base, X11, mtl, unix, xmonad
ghc-options: -Wall -Wno-unused-do-bind ghc-options: -Wall -fno-warn-unused-do-bind
default-language: Haskell2010
-- Keep this in sync with the oldest version in 'tested-with' executable generatemanpage
if impl(ghc > 8.6.5) main-is: GenerateManpage.hs
ghc-options: -Wno-unused-imports hs-source-dirs: util
if flag(pedantic) if flag(generatemanpage)
ghc-options: -Werror build-depends: base, pandoc >= 2, regex-posix, text
else
buildable: False
test-suite properties test-suite properties
type: exitcode-stdio-1.0 type: exitcode-stdio-1.0
@ -121,16 +124,4 @@ test-suite properties
Properties.Workspace Properties.Workspace
Utils Utils
hs-source-dirs: tests hs-source-dirs: tests
build-depends: base build-depends: base, QuickCheck >= 2, X11, containers, extensible-exceptions, xmonad
, QuickCheck >= 2
, quickcheck-classes >= 0.4.3
, X11
, containers
, xmonad
default-language: Haskell2010
if impl(ghc > 9.8)
ghc-options: -Wno-x-partial
if flag(pedantic)
ghc-options: -Werror