mirror of
https://github.com/xmonad/xmonad.git
synced 2025-07-27 02:01:52 -07:00
Compare commits
79 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
71cb355948 | ||
|
19069b3d4b | ||
|
969fca9406 | ||
|
61f00e65f1 | ||
|
db11089e70 | ||
|
e601a7d16d | ||
|
0dd23bddfa | ||
|
55b14d4850 | ||
|
9df514b378 | ||
|
ecf1a0ca0d | ||
|
d216e95f97 | ||
|
af3d3818c8 | ||
|
d065038c8a | ||
|
10bc213349 | ||
|
d22d93b43f | ||
|
871a80fee7 | ||
|
2d59f5157c | ||
|
0738262d9e | ||
|
63d6a66133 | ||
|
fe6215d309 | ||
|
c3cb4ad65f | ||
|
126f891d11 | ||
|
d3383ce0f5 | ||
|
c96a59fa0d | ||
|
12a45b4b99 | ||
|
462957b2f0 | ||
|
2e6312776b | ||
|
3897cab7c9 | ||
|
10b843ad21 | ||
|
bc320b69da | ||
|
89a8cc88c3 | ||
|
76f4a16258 | ||
|
8f2eb540d7 | ||
|
ba2d75b930 | ||
|
acf0652952 | ||
|
e4d231920c | ||
|
980828feea | ||
|
2e5ae02059 | ||
|
50eb1844eb | ||
|
f18bda7dc7 | ||
|
2d8cad02fe | ||
|
2baab28602 | ||
|
ef65f901ce | ||
|
f2da028ff9 | ||
|
bad3ce7a5e | ||
|
e1c555e3e6 | ||
|
ab20f7df8d | ||
|
a70bf6a6a3 | ||
|
f58b2399bd | ||
|
91d23656a3 | ||
|
d6b6189cc1 | ||
|
0248e3c9fa | ||
|
40fc10b6a5 | ||
|
3a140badf5 | ||
|
2b103ede55 | ||
|
4565e2c90e | ||
|
285ee2f836 | ||
|
7e9c9ccb1f | ||
|
dc078490d0 | ||
|
202e239ea4 | ||
|
e159ec36fe | ||
|
0b1ccc75ef | ||
|
b0f9a3d0b9 | ||
|
75d297a633 | ||
|
5f5e737d9c | ||
|
a39ed3ee1b | ||
|
e05a046bca | ||
|
12ddc800ab | ||
|
2fab1bb9f5 | ||
|
1b17d1c378 | ||
|
f490ced673 | ||
|
0919ecfbde | ||
|
41b7b1341e | ||
|
0f0aa5e8cb | ||
|
ad4417c8e0 | ||
|
b0f7643cc5 | ||
|
8b055621e9 | ||
|
dc6a972bc1 | ||
|
e4a3eede18 |
24
.github/ISSUE_TEMPLATE.md
vendored
Normal file
24
.github/ISSUE_TEMPLATE.md
vendored
Normal file
@@ -0,0 +1,24 @@
|
|||||||
|
### Problem Description
|
||||||
|
|
||||||
|
Describe the problem you are having, what you expect to happen
|
||||||
|
instead, and how to reproduce the problem.
|
||||||
|
|
||||||
|
### Configuration File
|
||||||
|
|
||||||
|
Please include the smallest configuration file that reproduces the
|
||||||
|
problem you are experiencing:
|
||||||
|
|
||||||
|
```haskell
|
||||||
|
module Main (main) where
|
||||||
|
|
||||||
|
import XMonad
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = xmonad def
|
||||||
|
```
|
||||||
|
|
||||||
|
### Checklist
|
||||||
|
|
||||||
|
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
|
||||||
|
|
||||||
|
- [ ] I tested my configuration with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
|
14
.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
14
.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
@@ -0,0 +1,14 @@
|
|||||||
|
### Description
|
||||||
|
|
||||||
|
Include a description for your changes, including the motivation
|
||||||
|
behind them.
|
||||||
|
|
||||||
|
### Checklist
|
||||||
|
|
||||||
|
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
|
||||||
|
|
||||||
|
- [ ] I've confirmed these changes don't belong in xmonad-contrib instead
|
||||||
|
|
||||||
|
- [ ] I tested my changes with [xmonad-testing](https://github.com/xmonad/xmonad-testing)
|
||||||
|
|
||||||
|
- [ ] I updated the `CHANGES.md` file
|
1
.gitignore
vendored
1
.gitignore
vendored
@@ -23,3 +23,4 @@ tags
|
|||||||
|
|
||||||
# stack artifacts
|
# stack artifacts
|
||||||
/.stack-work/
|
/.stack-work/
|
||||||
|
/cabal.project.local
|
||||||
|
154
.travis.yml
154
.travis.yml
@@ -1,82 +1,118 @@
|
|||||||
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
|
# 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/hvr/multi-ghc-travis
|
||||||
|
#
|
||||||
language: c
|
language: c
|
||||||
sudo: false
|
sudo: false
|
||||||
|
|
||||||
|
git:
|
||||||
|
submodules: false # whether to recursively clone submodules
|
||||||
|
|
||||||
cache:
|
cache:
|
||||||
directories:
|
directories:
|
||||||
- $HOME/.cabsnap
|
|
||||||
- $HOME/.cabal/packages
|
- $HOME/.cabal/packages
|
||||||
|
- $HOME/.cabal/store
|
||||||
|
|
||||||
before_cache:
|
before_cache:
|
||||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
|
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
|
||||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
|
# 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:
|
matrix:
|
||||||
include:
|
include:
|
||||||
- env: CABALVER=1.16 GHCVER=7.6.3
|
- compiler: "ghc-8.4.3"
|
||||||
compiler: ": #GHC 7.6.3"
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.4.3,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
- env: CABALVER=1.18 GHCVER=7.8.4
|
- compiler: "ghc-8.2.2"
|
||||||
compiler: ": #GHC 7.8.4"
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.2.2,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
- env: CABALVER=1.22 GHCVER=7.10.2
|
- compiler: "ghc-8.0.2"
|
||||||
compiler: ": #GHC 7.10.2"
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-8.0.2,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-7.10.3"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.10.3,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-7.8.4"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.8.4,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
|
- compiler: "ghc-7.6.3"
|
||||||
|
# env: TEST=--disable-tests BENCH=--disable-benchmarks
|
||||||
|
addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.2,ghc-7.6.3,libxrandr-dev], sources: [hvr-ghc]}}
|
||||||
|
|
||||||
before_install:
|
before_install:
|
||||||
- unset CC
|
- HC=${CC}
|
||||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
- 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:
|
install:
|
||||||
- cabal --version
|
- cabal --version
|
||||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
- echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||||
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
|
- BENCH=${BENCH---enable-benchmarks}
|
||||||
then
|
- TEST=${TEST---enable-tests}
|
||||||
zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
|
- HADDOCK=${HADDOCK-true}
|
||||||
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
|
- UNCONSTRAINED=${UNCONSTRAINED-true}
|
||||||
fi
|
- NOINSTALLEDCONSTRAINTS=${NOINSTALLEDCONSTRAINTS-false}
|
||||||
- travis_retry cabal update -v
|
- GHCHEAD=${GHCHEAD-false}
|
||||||
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
|
- travis_retry cabal update -v
|
||||||
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
|
- "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"
|
||||||
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
|
- rm -fv cabal.project cabal.project.local
|
||||||
|
- grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'
|
||||||
# check whether current requested install-plan matches cached package-db snapshot
|
- "printf 'packages: \".\"\\n' > cabal.project"
|
||||||
- if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
|
- touch cabal.project.local
|
||||||
then
|
- "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"
|
||||||
echo "cabal build-cache HIT";
|
- cat cabal.project || true
|
||||||
rm -rfv .ghc;
|
- cat cabal.project.local || true
|
||||||
cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
|
- if [ -f "./configure.ac" ]; then
|
||||||
cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
|
(cd "." && autoreconf -i);
|
||||||
else
|
fi
|
||||||
echo "cabal build-cache MISS";
|
- rm -f cabal.project.freeze
|
||||||
rm -rf $HOME/.cabsnap;
|
- cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all
|
||||||
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
|
- cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all
|
||||||
cabal install --only-dependencies --enable-tests --enable-benchmarks;
|
- rm -rf .ghc.environment.* "."/dist
|
||||||
fi
|
- DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
|
||||||
|
|
||||||
# snapshot package-db on cache miss
|
|
||||||
- if [ ! -d $HOME/.cabsnap ];
|
|
||||||
then
|
|
||||||
echo "snapshotting package-db to build-cache";
|
|
||||||
mkdir $HOME/.cabsnap;
|
|
||||||
cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
|
|
||||||
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
|
|
||||||
fi
|
|
||||||
|
|
||||||
# Here starts the actual work to be performed for the package under test;
|
# 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.
|
# any command which exits with a non-zero exit code causes the build to fail.
|
||||||
script:
|
script:
|
||||||
- if [ -f configure.ac ]; then autoreconf -i; fi
|
# test that source-distributions can be generated
|
||||||
- cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
|
- (cd "." && cabal sdist)
|
||||||
- cabal build # this builds all libraries and executables (including tests/benchmarks)
|
- mv "."/dist/xmonad-*.tar.gz ${DISTDIR}/
|
||||||
- cabal test
|
- cd ${DISTDIR} || false
|
||||||
- cabal check
|
- find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
|
||||||
- cabal sdist # tests that a source-distribution can be generated
|
- "printf 'packages: xmonad-*/*.cabal\\n' > cabal.project"
|
||||||
|
- 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
|
||||||
|
|
||||||
# Check that the resulting source distribution can be built & installed.
|
# build & run tests, build benchmarks
|
||||||
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
|
- cabal new-build -w ${HC} ${TEST} ${BENCH} all
|
||||||
# `cabal install --force-reinstalls dist/*-*.tar.gz`
|
- if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi
|
||||||
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
|
|
||||||
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
|
|
||||||
|
|
||||||
|
# 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
|
# EOF
|
||||||
|
92
CHANGES.md
92
CHANGES.md
@@ -1,5 +1,97 @@
|
|||||||
# Change Log / Release Notes
|
# Change Log / Release Notes
|
||||||
|
|
||||||
|
## 0.14 (July 30, 2018)
|
||||||
|
|
||||||
|
### Bug Fixes
|
||||||
|
|
||||||
|
* The state file that xmonad uses while restarting itself is now
|
||||||
|
removed after it is processed. This fixes a bug that manifested
|
||||||
|
in several different ways:
|
||||||
|
|
||||||
|
- Names of old workspaces would be resurrected after a restart
|
||||||
|
- Screen sizes would be wrong after changing monitor configuration (#90)
|
||||||
|
- `spawnOnce` stopped working (xmonad/xmonad-contrib#155)
|
||||||
|
- Focus did not follow when moving between workspaces (#87)
|
||||||
|
- etc.
|
||||||
|
|
||||||
|
* Recover old behavior (in 0.12) when `focusFollowsMouse == True`:
|
||||||
|
the focus follows when the mouse enters another workspace
|
||||||
|
but not moving into any window.
|
||||||
|
|
||||||
|
* Compiles with GHC 8.4.1
|
||||||
|
|
||||||
|
* Restored compatability with GHC version prior to 8.0.1 by removing the
|
||||||
|
dependency on directory version 1.2.3.
|
||||||
|
|
||||||
|
## 0.13 (February 10, 2017)
|
||||||
|
|
||||||
|
### Breaking Changes
|
||||||
|
|
||||||
|
* When restarting xmonad, resume state is no longer passed to the
|
||||||
|
next process via the command line. Instead, a temporary state
|
||||||
|
file is created and xmonad's state is serialized to that file.
|
||||||
|
|
||||||
|
When upgrading to 0.13 from a previous version, the `--resume`
|
||||||
|
command line option will automatically migrate to a state file.
|
||||||
|
|
||||||
|
This fixes issue #12.
|
||||||
|
|
||||||
|
### Enhancements
|
||||||
|
|
||||||
|
* You can now control which directory xmonad uses for finding your
|
||||||
|
configuration file and which one is used for storing the compiled
|
||||||
|
version of your configuration. In order of preference:
|
||||||
|
|
||||||
|
1. New environment variables. If you want to use these ensure
|
||||||
|
you set the correct environment variable and also create the
|
||||||
|
directory it references:
|
||||||
|
|
||||||
|
- `XMONAD_CONFIG_DIR`
|
||||||
|
- `XMONAD_CACHE_DIR`
|
||||||
|
- `XMONAD_DATA_DIR`
|
||||||
|
|
||||||
|
2. The `~/.xmonad` directory.
|
||||||
|
|
||||||
|
3. XDG Base Directory Specification directories, if they exist:
|
||||||
|
|
||||||
|
- `XDG_CONFIG_HOME/xmonad`
|
||||||
|
- `XDG_CACHE_HOME/xmonad`
|
||||||
|
- `XDG_DATA_HOME/xmonad`
|
||||||
|
|
||||||
|
If none of these directories exist then one will be created using
|
||||||
|
the following logic: If the relevant environment variable
|
||||||
|
mentioned in step (1) above is set, the referent directory will be
|
||||||
|
created and used. Otherwise `~/.xmonad` will be created and used.
|
||||||
|
|
||||||
|
This fixes a few issues, notably #7 and #56.
|
||||||
|
|
||||||
|
* A custom build script can be used when xmonad is given the
|
||||||
|
`--recompile` command line option. If an executable named `build`
|
||||||
|
exists in the xmonad configuration directory it will be called
|
||||||
|
instead of `ghc`. It takes one argument, the name of the
|
||||||
|
executable binary it must produce.
|
||||||
|
|
||||||
|
This fixes #8. (One of two possible custom build solutions. See
|
||||||
|
the next entry for another solution.)
|
||||||
|
|
||||||
|
* For users who build their xmonad configuration using tools such as
|
||||||
|
cabal or stack, there is another option for executing xmonad.
|
||||||
|
|
||||||
|
Instead of running the `xmonad` executable directly, arrange to
|
||||||
|
have your login manager run your configuration binary instead.
|
||||||
|
Then, in your binary, use the new `launch` command instead of
|
||||||
|
`xmonad`.
|
||||||
|
|
||||||
|
This will keep xmonad from using its configuration file
|
||||||
|
checking/compiling code and directly start the window manager
|
||||||
|
without `exec`ing any other binary.
|
||||||
|
|
||||||
|
See the documentation for the `launch` function in `XMonad.Main`
|
||||||
|
for more details.
|
||||||
|
|
||||||
|
Fixes #8. (Second way to have a custom build environment for
|
||||||
|
XMonad. See previous entry for another solution.)
|
||||||
|
|
||||||
## 0.12 (December 14, 2015)
|
## 0.12 (December 14, 2015)
|
||||||
|
|
||||||
* Compiles with GHC 7.10.2, 7.8.4, and 7.6.3
|
* Compiles with GHC 7.10.2, 7.8.4, and 7.6.3
|
||||||
|
141
CONTRIBUTING.md
Normal file
141
CONTRIBUTING.md
Normal file
@@ -0,0 +1,141 @@
|
|||||||
|
# Contributing to xmonad and xmonad-contrib
|
||||||
|
|
||||||
|
## Before Creating a GitHub Issue
|
||||||
|
|
||||||
|
New issue submissions should adhere to the following guidelines:
|
||||||
|
|
||||||
|
* Does your issue have to do with [xmonad][], [xmonad-contrib][], or
|
||||||
|
maybe even with the [X11][] library?
|
||||||
|
|
||||||
|
Please submit your issue to the **correct** GitHub repository.
|
||||||
|
|
||||||
|
* To help you figure out which repository to submit your issue to,
|
||||||
|
and to help us resolve the problem you are having, create the
|
||||||
|
smallest configuration file you can that reproduces the problem.
|
||||||
|
|
||||||
|
You may find that the [xmonad-testing][] repository is helpful in
|
||||||
|
reproducing the problem with a smaller configuration file.
|
||||||
|
|
||||||
|
Once you've done that please include the configuration file with
|
||||||
|
your GitHub issue.
|
||||||
|
|
||||||
|
* If possible, use the [xmonad-testing][] repository to test your
|
||||||
|
configuration with the bleeding-edge development version of xmonad
|
||||||
|
and xmonad-contrib. We might have already fixed your problem.
|
||||||
|
|
||||||
|
## Contributing Changes/Patches
|
||||||
|
|
||||||
|
Have a change to xmonad that you want included in the next release?
|
||||||
|
Awesome! Here are a few things to keep in mind:
|
||||||
|
|
||||||
|
* Review the above section about creating GitHub issues.
|
||||||
|
|
||||||
|
* It's always best to talk with the community before making any
|
||||||
|
nontrivial changes to xmonad. There are a couple of ways you can
|
||||||
|
chat with us:
|
||||||
|
|
||||||
|
- Post a message to the [mailing list][ml].
|
||||||
|
|
||||||
|
- Join the `#xmonad` IRC channel on `chat.freenode.org`.
|
||||||
|
|
||||||
|
* Continue reading this document!
|
||||||
|
|
||||||
|
## Expediting Reviews and Merges
|
||||||
|
|
||||||
|
Here are some tips for getting your changes merged into xmonad:
|
||||||
|
|
||||||
|
* If your changes can go into [xmonad-contrib][] instead
|
||||||
|
of [xmonad][], please do so. We rarely accept new features to
|
||||||
|
xmonad. (Not that we don't accept changes to xmonad, just that we
|
||||||
|
prefer changes to xmonad-contrib instead.)
|
||||||
|
|
||||||
|
* Change the fewest files as possible. If it makes sense, submit a
|
||||||
|
completely new module to xmonad-contrib.
|
||||||
|
|
||||||
|
* Your changes should include relevant entries in the `CHANGES.md`
|
||||||
|
file. Help us communicate changes to the community.
|
||||||
|
|
||||||
|
* Make sure you test your changes using the [xmonad-testing][]
|
||||||
|
repository. Include a new configuration file that shows off your
|
||||||
|
changes if possible by creating a PR on that repository as well.
|
||||||
|
|
||||||
|
* Make sure you read the section on rebasing and squashing commits
|
||||||
|
below.
|
||||||
|
|
||||||
|
## Rebasing and Squashing Commits
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
Instead of merging you should rebase your changes on top of the master
|
||||||
|
branch. If a core team member asks you to "rebase your changes" this
|
||||||
|
is what they are talking about.
|
||||||
|
|
||||||
|
It's also helpful to squash all of your commits so that your pull
|
||||||
|
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.
|
||||||
|
|
||||||
|
### How to Rebase Your Changes
|
||||||
|
|
||||||
|
The goal of rebasing is to bring recent changes from the master branch
|
||||||
|
into your feature branch. This often helps resolve conflicts where
|
||||||
|
you have changed a file that also changed in a recently merged pull
|
||||||
|
request (i.e. the `CHANGES.md` file). Here is how you do that.
|
||||||
|
|
||||||
|
1. Make sure that you have a `git remote` configured for the main
|
||||||
|
repository. I like to call this remote `upstream`:
|
||||||
|
|
||||||
|
$ git remote add upstream https://github.com/xmonad/xmonad-contrib.git
|
||||||
|
|
||||||
|
2. Pull from upstream and rewrite your changes on top of master. For
|
||||||
|
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):
|
||||||
|
|
||||||
|
$ git fetch --all
|
||||||
|
$ git pull --rebase upstream master
|
||||||
|
|
||||||
|
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:
|
||||||
|
|
||||||
|
$ git push --force-with-lease
|
||||||
|
|
||||||
|
4. Your pull request should now be conflict-free and only contain the
|
||||||
|
changes that you actually made.
|
||||||
|
|
||||||
|
### How to Squash Commits
|
||||||
|
|
||||||
|
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
|
||||||
|
|
||||||
|
[xmonad]: https://github.com/xmonad/xmonad
|
||||||
|
[xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
|
||||||
|
[xmonad-testing]: https://github.com/xmonad/xmonad-testing
|
||||||
|
[x11]: https://github.com/xmonad/X11
|
||||||
|
[ml]: https://mail.haskell.org/cgi-bin/mailman/listinfo/xmonad
|
83
MAINTAINERS.md
Normal file
83
MAINTAINERS.md
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
# XMonad Maintainers
|
||||||
|
|
||||||
|
## The XMonad Core Team
|
||||||
|
|
||||||
|
* Adam Vogt [GitHub][aavogt]
|
||||||
|
|
||||||
|
* Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`
|
||||||
|
|
||||||
|
* Brent Yorgey [GitHub][byorgey], IRC: `byorgey`
|
||||||
|
|
||||||
|
* Daniel Wagner [GitHub][dmwit], IRC: `dmwit`
|
||||||
|
|
||||||
|
* David Lazar [GitHub][davidlazar]
|
||||||
|
|
||||||
|
* Devin Mullins [GitHub][twifkak]
|
||||||
|
|
||||||
|
* Peter J. Jones [GitHub][pjones], [Twitter][twitter:pjones], [OpenPGP Key][pgp:pjones], IRC: `pmade`
|
||||||
|
|
||||||
|
## Release Procedures
|
||||||
|
|
||||||
|
When the time comes to release another version of XMonad and Contrib...
|
||||||
|
|
||||||
|
1. Create a release branch (e.g., `release-0.XX`).
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
2. Update the version number in the `*.cabal` files and verify
|
||||||
|
dependencies and documentation. This includes the `tested-with:`
|
||||||
|
field.
|
||||||
|
|
||||||
|
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.
|
||||||
|
|
||||||
|
4. Review documentation files and make sure they are accurate:
|
||||||
|
|
||||||
|
- `README.md`
|
||||||
|
- `CHANGES.md`
|
||||||
|
- and the `example-config.hs` in the `xmonad-testing` repo
|
||||||
|
|
||||||
|
5. Generate the manpage:
|
||||||
|
|
||||||
|
* `cabal configure` with the `-fgeneratemanpage` flag
|
||||||
|
* Build the project
|
||||||
|
* Run the `generatemanpage` tool from the top level of this repo
|
||||||
|
* Review the man page: `man -l man/xmonad.1`
|
||||||
|
|
||||||
|
6. Tag the repository with the release version (e.g., `v0.13`)
|
||||||
|
|
||||||
|
7. Build the project tarballs (`cabal sdist`)
|
||||||
|
|
||||||
|
8. Upload the packages to Hackage (`cabal upload`)
|
||||||
|
|
||||||
|
9. Merge the release branches into `master`
|
||||||
|
|
||||||
|
10. Update the website:
|
||||||
|
|
||||||
|
* Generate and push haddocks with `xmonad-web/gen-docs.sh`
|
||||||
|
|
||||||
|
* Check that `tour.html` and `intro.html` are up to date, and
|
||||||
|
mention all core bindings
|
||||||
|
|
||||||
|
11. Update the topic for the IRC channel (`#xmonad`)
|
||||||
|
|
||||||
|
12. Send the `announce-0.XX.txt` file to:
|
||||||
|
|
||||||
|
- XMonad mailing list
|
||||||
|
- Haskell Cafe
|
||||||
|
|
||||||
|
[packdeps]: http://hackage.haskell.org/package/packdeps
|
||||||
|
|
||||||
|
[aavogt]: https://github.com/orgs/xmonad/people/aavogt
|
||||||
|
[geekosaur]: https://github.com/orgs/xmonad/people/geekosaur
|
||||||
|
[byorgey]: https://github.com/orgs/xmonad/people/byorgey
|
||||||
|
[dmwit]: https://github.com/orgs/xmonad/people/dmwit
|
||||||
|
[davidlazar]: https://github.com/orgs/xmonad/people/davidlazar
|
||||||
|
[twifkak]: https://github.com/orgs/xmonad/people/twifkak
|
||||||
|
|
||||||
|
[pjones]: https://github.com/orgs/xmonad/people/pjones
|
||||||
|
[twitter:pjones]: https://twitter.com/contextualdev
|
||||||
|
[pgp:pjones]: http://pgp.mit.edu/pks/lookup?op=get&search=0x526722D1204284CB
|
@@ -1,5 +1,7 @@
|
|||||||
# xmonad: A Tiling Window Manager
|
# xmonad: A Tiling Window Manager
|
||||||
|
|
||||||
|
[](https://travis-ci.org/xmonad/xmonad)
|
||||||
|
|
||||||
[xmonad][] is a tiling window manager for X. Windows are arranged
|
[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
|
||||||
screen use. Window manager features are accessible from the keyboard:
|
screen use. Window manager features are accessible from the keyboard:
|
||||||
@@ -62,7 +64,7 @@ We'll now walk through the complete list of toolchain dependencies.
|
|||||||
|
|
||||||
## Running xmonad
|
## Running xmonad
|
||||||
|
|
||||||
Add:
|
If you built XMonad using `cabal` then add:
|
||||||
|
|
||||||
exec $HOME/.cabal/bin/xmonad
|
exec $HOME/.cabal/bin/xmonad
|
||||||
|
|
||||||
@@ -70,7 +72,7 @@ to the last line of your `.xsession` or `.xinitrc` file.
|
|||||||
|
|
||||||
## Configuring
|
## Configuring
|
||||||
|
|
||||||
See the `CONFIG` document.
|
See the [CONFIG][] document and the [example configuration file][example-config].
|
||||||
|
|
||||||
## XMonadContrib
|
## XMonadContrib
|
||||||
|
|
||||||
@@ -115,3 +117,5 @@ For a program dispatch menu:
|
|||||||
[xmonadcontrib]: https://hackage.haskell.org/package/xmonad-contrib
|
[xmonadcontrib]: https://hackage.haskell.org/package/xmonad-contrib
|
||||||
[xmc-prompt-shell]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Prompt-Shell.html
|
[xmc-prompt-shell]: https://hackage.haskell.org/package/xmonad-contrib/docs/XMonad-Prompt-Shell.html
|
||||||
[platform]: http://haskell.org/platform/
|
[platform]: http://haskell.org/platform/
|
||||||
|
[example-config]: https://github.com/xmonad/xmonad-testing/blob/master/example-config.hs
|
||||||
|
[config]: https://github.com/xmonad/xmonad/blob/master/CONFIG
|
||||||
|
14
TODO
14
TODO
@@ -1,14 +0,0 @@
|
|||||||
= Release management =
|
|
||||||
|
|
||||||
* generate, and push website haddocks with xmonad-web/gen-docs.sh
|
|
||||||
* generate manpage, generate html manpage
|
|
||||||
* double check README build instructions
|
|
||||||
* bump xmonad.cabal version and X11 version
|
|
||||||
* update cabal "tested-with:" fields
|
|
||||||
* upload X11 and xmonad to Hackage
|
|
||||||
* update #xmonad topic
|
|
||||||
* check examples/text in user-facing Config.hs
|
|
||||||
* check tour.html and intro.html are up to date, and mention all core bindings
|
|
||||||
* confirm template config is type correct
|
|
||||||
* update haskellwiki notable changes since x.x
|
|
||||||
* email announce
|
|
1
cabal.project
Normal file
1
cabal.project
Normal file
@@ -0,0 +1 @@
|
|||||||
|
packages: ./
|
@@ -1,7 +1,7 @@
|
|||||||
.TH xmonad 1 "31 December 2012" xmonad-0.12 "xmonad manual".\" Automatically generated by Pandoc 1.15.1
|
.TH xmonad 1 "31 December 2012" xmonad-0.13 "xmonad manual".\" Automatically generated by Pandoc 1.19.2.1
|
||||||
.\"
|
.\"
|
||||||
.hy
|
|
||||||
.TH "" "" "" "" ""
|
.TH "" "" "" "" ""
|
||||||
|
.hy
|
||||||
.SH Name
|
.SH Name
|
||||||
.PP
|
.PP
|
||||||
xmonad \- a tiling window manager
|
xmonad \- a tiling window manager
|
||||||
|
@@ -8,7 +8,7 @@
|
|||||||
<style type="text/css">code{white-space: pre;}</style>
|
<style type="text/css">code{white-space: pre;}</style>
|
||||||
</head>
|
</head>
|
||||||
<body>
|
<body>
|
||||||
<h1>xmonad-0.12</h1><p>Section: xmonad manual (1)<br/>Updated: 31 December 2012</p><hr/>
|
<h1>xmonad-0.13</h1><p>Section: xmonad manual (1)<br/>Updated: 31 December 2012</p><hr/>
|
||||||
<div id="TOC">
|
<div id="TOC">
|
||||||
<ul>
|
<ul>
|
||||||
<li><a href="#name">Name</a></li>
|
<li><a href="#name">Name</a></li>
|
||||||
|
@@ -221,9 +221,9 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
|||||||
, ((modMask .|. shiftMask, xK_q ), io (exitWith 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 ), spawn ("echo \"" ++ help ++ "\" | xmessage -file -")) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
|
, ((modMask .|. shiftMask, xK_slash ), helpCommand)
|
||||||
-- repeat the binding for non-American layout keyboards
|
-- repeat the binding for non-American layout keyboards
|
||||||
, ((modMask , xK_question), spawn ("echo \"" ++ help ++ "\" | xmessage -file -"))
|
, ((modMask , xK_question), helpCommand)
|
||||||
]
|
]
|
||||||
++
|
++
|
||||||
-- mod-[1..9] %! Switch to workspace N
|
-- mod-[1..9] %! Switch to workspace N
|
||||||
@@ -237,6 +237,9 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
|||||||
[((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
|
[((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
|
||||||
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
||||||
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||||
|
where
|
||||||
|
helpCommand :: X ()
|
||||||
|
helpCommand = spawn ("echo " ++ show help ++ " | xmessage -file -") -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||||
|
|
||||||
-- | 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 ())
|
||||||
@@ -320,9 +323,9 @@ help = unlines ["The default modifier key is 'alt'. Default keybindings:",
|
|||||||
"-- quit, or restart",
|
"-- quit, or restart",
|
||||||
"mod-Shift-q Quit xmonad",
|
"mod-Shift-q Quit xmonad",
|
||||||
"mod-q Restart xmonad",
|
"mod-q Restart xmonad",
|
||||||
"mod-[1..9] Switch to workSpace N",
|
|
||||||
"",
|
"",
|
||||||
"-- Workspaces & screens",
|
"-- Workspaces & screens",
|
||||||
|
"mod-[1..9] Switch to workSpace N",
|
||||||
"mod-Shift-[1..9] Move client 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-{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-Shift-{w,e,r} Move client to screen 1, 2, or 3",
|
||||||
@@ -330,4 +333,4 @@ help = unlines ["The default modifier key is 'alt'. Default keybindings:",
|
|||||||
"-- Mouse bindings: default actions bound to mouse events",
|
"-- Mouse bindings: default actions bound to mouse events",
|
||||||
"mod-button1 Set the window to floating mode and move by dragging",
|
"mod-button1 Set the window to floating mode and move by dragging",
|
||||||
"mod-button2 Raise the window to the top of the stack",
|
"mod-button2 Raise the window to the top of the stack",
|
||||||
"mod-button3 Set the window to floating mode and resize by dragging"]
|
"mod-button3 Set the window to floating mode and resize by dragging"]
|
||||||
|
@@ -25,8 +25,10 @@ module XMonad.Core (
|
|||||||
StateExtension(..), ExtensionClass(..),
|
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, getXMonadDir, recompile, trace, whenJust, whenX,
|
getAtom, spawn, spawnPID, xfork, recompile, trace, whenJust, whenX,
|
||||||
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, ManageHook, Query(..), runQuery
|
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName,
|
||||||
|
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
|
||||||
|
ManageHook, Query(..), runQuery
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import XMonad.StackSet hiding (modify)
|
import XMonad.StackSet hiding (modify)
|
||||||
@@ -37,10 +39,12 @@ import qualified Control.Exception.Extensible as E
|
|||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
|
import Data.Semigroup
|
||||||
import Data.Default
|
import Data.Default
|
||||||
import System.FilePath
|
import System.FilePath
|
||||||
import System.IO
|
import System.IO
|
||||||
import System.Info
|
import System.Info
|
||||||
|
import System.Posix.Env (getEnv)
|
||||||
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
|
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
|
||||||
import System.Posix.Signals
|
import System.Posix.Signals
|
||||||
import System.Posix.IO
|
import System.Posix.IO
|
||||||
@@ -49,11 +53,12 @@ import System.Process
|
|||||||
import System.Directory
|
import System.Directory
|
||||||
import System.Exit
|
import System.Exit
|
||||||
import Graphics.X11.Xlib
|
import Graphics.X11.Xlib
|
||||||
import Graphics.X11.Xlib.Extras (Event)
|
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
|
||||||
import Data.Typeable
|
import Data.Typeable
|
||||||
import Data.List ((\\))
|
import Data.List ((\\))
|
||||||
import Data.Maybe (isJust,fromMaybe)
|
import Data.Maybe (isJust,fromMaybe)
|
||||||
import Data.Monoid
|
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
|
||||||
@@ -68,7 +73,7 @@ data XState = XState
|
|||||||
, extensibleState :: !(M.Map String (Either String StateExtension))
|
, extensibleState :: !(M.Map String (Either String StateExtension))
|
||||||
-- ^ stores custom state information.
|
-- ^ stores custom state information.
|
||||||
--
|
--
|
||||||
-- The module "XMonad.Utils.ExtensibleState" in xmonad-contrib
|
-- The module "XMonad.Util.ExtensibleState" in xmonad-contrib
|
||||||
-- provides additional information and a simple interface for using this.
|
-- provides additional information and a simple interface for using this.
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -148,6 +153,9 @@ instance Applicative X where
|
|||||||
pure = return
|
pure = return
|
||||||
(<*>) = ap
|
(<*>) = ap
|
||||||
|
|
||||||
|
instance Semigroup a => Semigroup (X a) where
|
||||||
|
(<>) = liftM2 (<>)
|
||||||
|
|
||||||
instance (Monoid a) => Monoid (X a) where
|
instance (Monoid a) => Monoid (X a) where
|
||||||
mempty = return mempty
|
mempty = return mempty
|
||||||
mappend = liftM2 mappend
|
mappend = liftM2 mappend
|
||||||
@@ -162,6 +170,9 @@ newtype Query a = Query (ReaderT Window X a)
|
|||||||
runQuery :: Query a -> Window -> X a
|
runQuery :: Query a -> Window -> X a
|
||||||
runQuery (Query m) w = runReaderT m w
|
runQuery (Query m) w = runReaderT m w
|
||||||
|
|
||||||
|
instance Semigroup a => Semigroup (Query a) where
|
||||||
|
(<>) = liftM2 (<>)
|
||||||
|
|
||||||
instance Monoid a => Monoid (Query a) where
|
instance Monoid a => Monoid (Query a) where
|
||||||
mempty = return mempty
|
mempty = return mempty
|
||||||
mappend = liftM2 mappend
|
mappend = liftM2 mappend
|
||||||
@@ -207,6 +218,12 @@ withDisplay f = asks display >>= f
|
|||||||
withWindowSet :: (WindowSet -> X a) -> X a
|
withWindowSet :: (WindowSet -> X a) -> X a
|
||||||
withWindowSet f = gets windowset >>= f
|
withWindowSet f = gets windowset >>= f
|
||||||
|
|
||||||
|
-- | Safely access window attributes.
|
||||||
|
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
|
||||||
|
withWindowAttributes dpy win f = do
|
||||||
|
wa <- userCode (io $ getWindowAttributes dpy win)
|
||||||
|
catchX (whenJust wa f) (return ())
|
||||||
|
|
||||||
-- | 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 = (w==) <$> asks theRoot
|
isRoot w = (w==) <$> asks theRoot
|
||||||
@@ -431,48 +448,174 @@ 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 } }
|
||||||
|
|
||||||
-- | Return the path to @~\/.xmonad@.
|
-- | Return the path to the xmonad configuration directory. This
|
||||||
|
-- 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.
|
||||||
|
--
|
||||||
|
-- Several directories are considered. In order of
|
||||||
|
-- preference:
|
||||||
|
--
|
||||||
|
-- 1. The directory specified in the @XMONAD_CONFIG_DIR@ environment variable.
|
||||||
|
-- 2. The @~\/.xmonad@ directory.
|
||||||
|
-- 3. The @XDG_CONFIG_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.
|
||||||
getXMonadDir :: MonadIO m => m String
|
getXMonadDir :: MonadIO m => m String
|
||||||
getXMonadDir = io $ getAppUserDataDirectory "xmonad"
|
getXMonadDir =
|
||||||
|
findFirstDirWithEnv "XMONAD_CONFIG_DIR"
|
||||||
|
[ getAppUserDataDirectory "xmonad"
|
||||||
|
, getXDGDirectory XDGConfig "xmonad"
|
||||||
|
]
|
||||||
|
|
||||||
-- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the
|
-- | Return the path to the xmonad cache directory. This directory is
|
||||||
-- following apply:
|
-- used to store temporary files that can easily be recreated. For
|
||||||
|
-- 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"
|
||||||
|
]
|
||||||
|
|
||||||
|
-- | Return the path to the xmonad data directory. This directory is
|
||||||
|
-- used by XMonad to store data files such as the run-time state file
|
||||||
|
-- and the configuration binary generated by GHC.
|
||||||
|
--
|
||||||
|
-- Several directories are considered. In order of preference:
|
||||||
|
--
|
||||||
|
-- 1. The directory specified in the @XMONAD_DATA_DIR@ environment variable.
|
||||||
|
-- 2. The @~\/.xmonad@ directory.
|
||||||
|
-- 3. The @XDG_DATA_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.
|
||||||
|
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
|
||||||
|
go [] = return Nothing
|
||||||
|
go (x:xs) = do
|
||||||
|
dir <- io x
|
||||||
|
exists <- io (doesDirectoryExist dir)
|
||||||
|
if exists then return (Just dir) else go xs
|
||||||
|
|
||||||
|
-- | Simple wrapper around @findFirstDirOf@ that allows the primary
|
||||||
|
-- path to be specified by an environment variable.
|
||||||
|
findFirstDirWithEnv :: MonadIO m => String -> [IO FilePath] -> m FilePath
|
||||||
|
findFirstDirWithEnv envName paths = do
|
||||||
|
envPath' <- io (getEnv envName)
|
||||||
|
|
||||||
|
case envPath' of
|
||||||
|
Nothing -> findFirstDirOf paths
|
||||||
|
Just envPath -> findFirstDirOf (return envPath:paths)
|
||||||
|
|
||||||
|
-- | Helper function to retrieve the various XDG directories.
|
||||||
|
-- This has been based on the implementation shipped with GHC version 8.0.1 or
|
||||||
|
-- higher. Put here to preserve compatibility with older GHC versions.
|
||||||
|
getXDGDirectory :: XDGDirectory -> FilePath -> IO FilePath
|
||||||
|
getXDGDirectory xdgDir suffix =
|
||||||
|
normalise . (</> suffix) <$>
|
||||||
|
case xdgDir of
|
||||||
|
XDGData -> get "XDG_DATA_HOME" ".local/share"
|
||||||
|
XDGConfig -> get "XDG_CONFIG_HOME" ".config"
|
||||||
|
XDGCache -> get "XDG_CACHE_HOME" ".cache"
|
||||||
|
where
|
||||||
|
get name fallback = do
|
||||||
|
env <- lookupEnv name
|
||||||
|
case env of
|
||||||
|
Nothing -> fallback'
|
||||||
|
Just path
|
||||||
|
| isRelative path -> fallback'
|
||||||
|
| otherwise -> return path
|
||||||
|
where
|
||||||
|
fallback' = (</> fallback) <$> getHomeDirectory
|
||||||
|
data XDGDirectory = XDGData | XDGConfig | XDGCache
|
||||||
|
|
||||||
|
-- | Get the name of the file used to store the xmonad window state.
|
||||||
|
stateFileName :: (Functor m, MonadIO m) => m FilePath
|
||||||
|
stateFileName = (</> "xmonad.state") <$> getXMonadDataDir
|
||||||
|
|
||||||
|
-- | 'recompile force', 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
|
||||||
-- ~\/.xmonad\/lib
|
-- the @lib@ directory (under the configuration directory).
|
||||||
--
|
--
|
||||||
-- 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 ~\/.xmonad\/lib directory.
|
-- and any files in the aforementioned @lib@ directory.
|
||||||
--
|
--
|
||||||
-- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If
|
-- Compilation errors (if any) are logged to the @xmonad.errors@ file
|
||||||
-- GHC indicates failure with a non-zero exit code, an xmessage displaying
|
-- in the xmonad data directory. If GHC indicates failure with a
|
||||||
-- that file is spawned.
|
-- non-zero exit code, an xmessage displaying that file is spawned.
|
||||||
--
|
--
|
||||||
-- 'False' is returned if there are compilation errors.
|
-- 'False' is returned if there are compilation errors.
|
||||||
--
|
--
|
||||||
recompile :: MonadIO m => Bool -> m Bool
|
recompile :: MonadIO m => Bool -> m Bool
|
||||||
recompile force = io $ do
|
recompile force = io $ do
|
||||||
dir <- getXMonadDir
|
cfgdir <- getXMonadDir
|
||||||
|
datadir <- getXMonadDataDir
|
||||||
let binn = "xmonad-"++arch++"-"++os
|
let binn = "xmonad-"++arch++"-"++os
|
||||||
bin = dir </> binn
|
bin = datadir </> binn
|
||||||
base = dir </> "xmonad"
|
err = datadir </> "xmonad.errors"
|
||||||
err = base ++ ".errors"
|
src = cfgdir </> "xmonad.hs"
|
||||||
src = base ++ ".hs"
|
lib = cfgdir </> "lib"
|
||||||
lib = dir </> "lib"
|
buildscript = cfgdir </> "build"
|
||||||
|
|
||||||
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
|
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
|
||||||
srcT <- getModTime src
|
srcT <- getModTime src
|
||||||
binT <- getModTime bin
|
binT <- getModTime bin
|
||||||
if force || any (binT <) (srcT : libTs)
|
|
||||||
|
useBuildscript <- do
|
||||||
|
exists <- doesFileExist buildscript
|
||||||
|
if exists then isExecutable buildscript else return False
|
||||||
|
|
||||||
|
if force || useBuildscript || any (binT <) (srcT : libTs)
|
||||||
then do
|
then do
|
||||||
-- temporarily disable SIGCHLD ignoring:
|
-- temporarily disable SIGCHLD ignoring:
|
||||||
uninstallSignalHandlers
|
uninstallSignalHandlers
|
||||||
status <- bracket (openFile err WriteMode) hClose $ \h ->
|
status <- bracket (openFile err WriteMode) hClose $ \errHandle ->
|
||||||
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-main-is", "main", "-v0", "-o",binn] (Just dir)
|
waitForProcess =<< if useBuildscript
|
||||||
Nothing Nothing Nothing (Just h)
|
then compileScript bin cfgdir buildscript errHandle
|
||||||
|
else compileGHC bin cfgdir errHandle
|
||||||
|
|
||||||
-- re-enable SIGCHLD:
|
-- re-enable SIGCHLD:
|
||||||
installSignalHandlers
|
installSignalHandlers
|
||||||
@@ -487,17 +630,36 @@ recompile force = io $ do
|
|||||||
-- nb, the ordering of printing, then forking, is crucial due to
|
-- nb, the ordering of printing, then forking, is crucial due to
|
||||||
-- lazy evaluation
|
-- lazy evaluation
|
||||||
hPutStrLn stderr msg
|
hPutStrLn stderr msg
|
||||||
forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
|
forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing
|
||||||
return ()
|
return ()
|
||||||
return (status == ExitSuccess)
|
return (status == ExitSuccess)
|
||||||
else return True
|
else return True
|
||||||
where getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
|
where getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
|
||||||
isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
|
isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
|
||||||
|
isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
|
||||||
allFiles t = do
|
allFiles t = do
|
||||||
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
|
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
|
||||||
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
|
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
|
||||||
ds <- filterM doesDirectoryExist cs
|
ds <- filterM doesDirectoryExist cs
|
||||||
concat . ((cs \\ ds):) <$> mapM allFiles ds
|
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 ()
|
||||||
|
@@ -137,7 +137,7 @@ data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
|
|||||||
instance Message ChangeLayout
|
instance Message ChangeLayout
|
||||||
|
|
||||||
-- | The layout choice combinator
|
-- | The layout choice combinator
|
||||||
(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
|
(|||) :: l a -> r a -> Choose l r a
|
||||||
(|||) = Choose L
|
(|||) = Choose L
|
||||||
infixr 5 |||
|
infixr 5 |||
|
||||||
|
|
||||||
|
@@ -13,10 +13,10 @@
|
|||||||
--
|
--
|
||||||
-----------------------------------------------------------------------------
|
-----------------------------------------------------------------------------
|
||||||
|
|
||||||
module XMonad.Main (xmonad) where
|
module XMonad.Main (xmonad, launch) where
|
||||||
|
|
||||||
import System.Locale.SetLocale
|
import System.Locale.SetLocale
|
||||||
import Control.Arrow (second)
|
import qualified Control.Exception.Extensible as E
|
||||||
import Data.Bits
|
import Data.Bits
|
||||||
import Data.List ((\\))
|
import Data.List ((\\))
|
||||||
import Data.Function
|
import Data.Function
|
||||||
@@ -37,7 +37,7 @@ import qualified XMonad.StackSet as W
|
|||||||
import XMonad.Operations
|
import XMonad.Operations
|
||||||
|
|
||||||
import System.IO
|
import System.IO
|
||||||
|
import System.Directory
|
||||||
import System.Info
|
import System.Info
|
||||||
import System.Environment
|
import System.Environment
|
||||||
import System.Posix.Process (executeFile)
|
import System.Posix.Process (executeFile)
|
||||||
@@ -59,33 +59,29 @@ 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
|
||||||
|
|
||||||
let launch serializedWinset serializedExtState args = do
|
let launch' args = do
|
||||||
catchIO buildLaunch
|
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 [] $
|
withArgs [] $ launch (conf' { layoutHook = l })
|
||||||
xmonadNoargs (conf' { layoutHook = l })
|
|
||||||
serializedWinset
|
|
||||||
serializedExtState
|
|
||||||
|
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
case args of
|
case args of
|
||||||
("--resume": ws : xs : args') -> launch (Just ws) (Just xs) args'
|
("--resume": ws : xs : args') -> migrateState ws xs >> launch' args'
|
||||||
["--help"] -> usage
|
["--help"] -> usage
|
||||||
["--recompile"] -> recompile 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
|
||||||
"--replace" : args' -> do
|
"--replace" : args' -> sendReplace >> launch' args'
|
||||||
sendReplace
|
_ -> launch' args
|
||||||
launch Nothing Nothing args'
|
|
||||||
_ -> launch Nothing Nothing args
|
|
||||||
where
|
where
|
||||||
shortVersion = ["xmonad", showVersion version]
|
shortVersion = ["xmonad", showVersion version]
|
||||||
longVersion = [ "compiled by", compilerName, showVersion compilerVersion
|
longVersion = [ "compiled by", compilerName, showVersion compilerVersion
|
||||||
, "for", arch ++ "-" ++ os
|
, "for", arch ++ "-" ++ os
|
||||||
, "\nXinerama:", show compiledWithXinerama ]
|
, "\nXinerama:", show compiledWithXinerama ]
|
||||||
|
|
||||||
|
|
||||||
usage :: IO ()
|
usage :: IO ()
|
||||||
usage = do
|
usage = do
|
||||||
self <- getProgName
|
self <- getProgName
|
||||||
@@ -99,13 +95,13 @@ usage = do
|
|||||||
" --restart Request a running xmonad process to restart" :
|
" --restart Request a running xmonad process to restart" :
|
||||||
[]
|
[]
|
||||||
|
|
||||||
-- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it. If there are no
|
-- | Build the xmonad configuration file with ghc, then execute it.
|
||||||
-- errors, this function does not return. An exception is raised in any of
|
-- If there are no errors, this function does not return. An
|
||||||
-- these cases:
|
-- exception is raised in any of these cases:
|
||||||
--
|
--
|
||||||
-- * ghc missing
|
-- * ghc missing
|
||||||
--
|
--
|
||||||
-- * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing
|
-- * both the configuration file and executable are missing
|
||||||
--
|
--
|
||||||
-- * xmonad.hs fails to compile
|
-- * xmonad.hs fails to compile
|
||||||
--
|
--
|
||||||
@@ -118,7 +114,7 @@ usage = do
|
|||||||
buildLaunch :: IO ()
|
buildLaunch :: IO ()
|
||||||
buildLaunch = do
|
buildLaunch = do
|
||||||
recompile False
|
recompile False
|
||||||
dir <- getXMonadDir
|
dir <- getXMonadDataDir
|
||||||
args <- getArgs
|
args <- getArgs
|
||||||
whoami <- getProgName
|
whoami <- getProgName
|
||||||
let compiledConfig = "xmonad-"++arch++"-"++os
|
let compiledConfig = "xmonad-"++arch++"-"++os
|
||||||
@@ -144,15 +140,28 @@ sendReplace = do
|
|||||||
rootw <- rootWindow dpy dflt
|
rootw <- rootWindow dpy dflt
|
||||||
replace dpy dflt rootw
|
replace dpy dflt rootw
|
||||||
|
|
||||||
|
-- | Entry point into xmonad for custom builds.
|
||||||
-- |
|
|
||||||
-- The main entry point
|
|
||||||
--
|
--
|
||||||
xmonadNoargs :: (LayoutClass l Window, Read (l Window)) => XConfig l
|
-- This function isn't meant to be called by the typical xmonad user
|
||||||
-> Maybe String -- ^ serialized windowset
|
-- because it:
|
||||||
-> Maybe String -- ^ serialized extensible state
|
--
|
||||||
-> IO ()
|
-- * Does not process any command line arguments.
|
||||||
xmonadNoargs initxmc serializedWinset serializedExtstate = do
|
--
|
||||||
|
-- * Therefore doesn't know how to restart a running xmonad.
|
||||||
|
--
|
||||||
|
-- * Does not compile your configuration file since it assumes it's
|
||||||
|
-- actually running from within your compiled configuration.
|
||||||
|
--
|
||||||
|
-- Unless you know what you are doing, you should probably be using
|
||||||
|
-- the 'xmonad' function instead.
|
||||||
|
--
|
||||||
|
-- However, if you are using a custom build environment (such as
|
||||||
|
-- stack, cabal, make, etc.) you will likely want to call this
|
||||||
|
-- function instead of 'xmonad'. You probably also want to have a key
|
||||||
|
-- binding to the 'XMonad.Operations.restart` function that restarts
|
||||||
|
-- your custom binary with the resume flag set to @True@.
|
||||||
|
launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
|
||||||
|
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
|
||||||
@@ -176,6 +185,7 @@ xmonadNoargs initxmc serializedWinset serializedExtstate = do
|
|||||||
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
|
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
|
||||||
|
|
||||||
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)
|
||||||
@@ -190,19 +200,6 @@ xmonadNoargs initxmc serializedWinset serializedExtstate = do
|
|||||||
lreads = readsLayout layout
|
lreads = readsLayout layout
|
||||||
initialWinset = let padToLen n xs = take (max n (length xs)) $ xs ++ repeat ""
|
initialWinset = let padToLen n xs = take (max n (length xs)) $ xs ++ repeat ""
|
||||||
in new layout (padToLen (length xinesc) (workspaces xmc)) $ map SD xinesc
|
in new layout (padToLen (length xinesc) (workspaces xmc)) $ map SD xinesc
|
||||||
maybeRead reads' s = case reads' s of
|
|
||||||
[(x, "")] -> Just x
|
|
||||||
_ -> Nothing
|
|
||||||
|
|
||||||
winset = fromMaybe initialWinset $ do
|
|
||||||
s <- serializedWinset
|
|
||||||
ws <- maybeRead reads s
|
|
||||||
return . W.ensureTags layout (workspaces xmc)
|
|
||||||
$ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
|
|
||||||
extState = fromMaybe M.empty $ do
|
|
||||||
dyns <- serializedExtstate
|
|
||||||
vals <- maybeRead reads dyns
|
|
||||||
return . M.fromList . map (second Left) $ vals
|
|
||||||
|
|
||||||
cf = XConf
|
cf = XConf
|
||||||
{ display = dpy
|
{ display = dpy
|
||||||
@@ -218,14 +215,24 @@ xmonadNoargs initxmc serializedWinset serializedExtstate = do
|
|||||||
|
|
||||||
st = XState
|
st = XState
|
||||||
{ windowset = initialWinset
|
{ windowset = initialWinset
|
||||||
, numberlockMask = 0
|
, numberlockMask = 0
|
||||||
, mapped = S.empty
|
, mapped = S.empty
|
||||||
, waitingUnmap = M.empty
|
, waitingUnmap = M.empty
|
||||||
, dragging = Nothing
|
, dragging = Nothing
|
||||||
, extensibleState = extState
|
, extensibleState = M.empty
|
||||||
}
|
}
|
||||||
|
|
||||||
allocaXEvent $ \e ->
|
allocaXEvent $ \e ->
|
||||||
runX cf st $ do
|
runX cf st $ do
|
||||||
|
-- check for serialized state in a file.
|
||||||
|
serializedSt <- do
|
||||||
|
path <- stateFileName
|
||||||
|
exists <- io (doesFileExist path)
|
||||||
|
if exists then readStateFile initxmc else return Nothing
|
||||||
|
|
||||||
|
-- restore extensibleState if we read it from a file.
|
||||||
|
let extst = maybe M.empty extensibleState serializedSt
|
||||||
|
modify (\s -> s {extensibleState = extst})
|
||||||
|
|
||||||
setNumlockMask
|
setNumlockMask
|
||||||
grabKeys
|
grabKeys
|
||||||
@@ -240,6 +247,7 @@ xmonadNoargs initxmc serializedWinset serializedExtstate = do
|
|||||||
-- those windows. Remove all windows that are no longer top-level
|
-- those windows. Remove all windows that are no longer top-level
|
||||||
-- children of the root, they may have disappeared since
|
-- children of the root, they may have disappeared since
|
||||||
-- restarting.
|
-- restarting.
|
||||||
|
let winset = maybe initialWinset windowset serializedSt
|
||||||
windows . const . foldr W.delete winset $ W.allWindows winset \\ ws
|
windows . const . foldr W.delete winset $ W.allWindows winset \\ ws
|
||||||
|
|
||||||
-- manage the as-yet-unmanaged windows
|
-- manage the as-yet-unmanaged windows
|
||||||
@@ -290,10 +298,10 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
|
|||||||
|
|
||||||
-- manage a new window
|
-- manage a new window
|
||||||
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||||
wa <- io $ getWindowAttributes dpy w -- ignore override windows
|
withWindowAttributes dpy w $ \wa -> do -- ignore override windows
|
||||||
-- need to ignore mapping requests by managed windows not on the current workspace
|
-- need to ignore mapping requests by managed windows not on the current workspace
|
||||||
managed <- isClient w
|
managed <- isClient w
|
||||||
when (not (wa_override_redirect wa) && not managed) $ do manage w
|
when (not (wa_override_redirect wa) && not managed) $ manage w
|
||||||
|
|
||||||
-- window destroyed, unmanage it
|
-- window destroyed, unmanage it
|
||||||
-- window gone, unmanage it
|
-- window gone, unmanage it
|
||||||
@@ -356,7 +364,13 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
|
|||||||
-- True in the user's config.
|
-- True in the user's config.
|
||||||
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
|
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
|
||||||
| t == enterNotify && ev_mode e == notifyNormal
|
| t == enterNotify && ev_mode e == notifyNormal
|
||||||
= whenX (asks $ focusFollowsMouse . config) (focus w)
|
= whenX (asks $ focusFollowsMouse . config) $ do
|
||||||
|
dpy <- asks display
|
||||||
|
root <- asks theRoot
|
||||||
|
(_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
|
||||||
|
-- when Xlib cannot find a child that contains the pointer,
|
||||||
|
-- it returns None(0)
|
||||||
|
when (w' == 0 || w == w') (focus w)
|
||||||
|
|
||||||
-- left a window, check if we need to focus root
|
-- left a window, check if we need to focus root
|
||||||
handle e@(CrossingEvent {ev_event_type = t})
|
handle e@(CrossingEvent {ev_event_type = t})
|
||||||
@@ -367,8 +381,6 @@ handle e@(CrossingEvent {ev_event_type = t})
|
|||||||
-- configure a window
|
-- configure a window
|
||||||
handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||||
ws <- gets windowset
|
ws <- gets windowset
|
||||||
wa <- io $ getWindowAttributes dpy w
|
|
||||||
|
|
||||||
bw <- asks (borderWidth . config)
|
bw <- asks (borderWidth . config)
|
||||||
|
|
||||||
if M.member w (floating ws)
|
if M.member w (floating ws)
|
||||||
@@ -382,7 +394,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
|||||||
, wc_sibling = ev_above e
|
, wc_sibling = ev_above e
|
||||||
, wc_stack_mode = ev_detail e }
|
, wc_stack_mode = ev_detail e }
|
||||||
when (member w ws) (float w)
|
when (member w ws) (float w)
|
||||||
else io $ allocaXEvent $ \ev -> do
|
else withWindowAttributes dpy w $ \wa -> io $ allocaXEvent $ \ev -> do
|
||||||
setEventType ev configureNotify
|
setEventType ev configureNotify
|
||||||
setConfigureEvent ev w w
|
setConfigureEvent ev w w
|
||||||
(wa_x wa) (wa_y wa) (wa_width wa)
|
(wa_x wa) (wa_y wa) (wa_width wa)
|
||||||
@@ -416,7 +428,7 @@ handle e = broadcastMessage e -- trace (eventName e) -- ignoring
|
|||||||
scan :: Display -> Window -> IO [Window]
|
scan :: Display -> Window -> IO [Window]
|
||||||
scan dpy rootw = do
|
scan dpy rootw = do
|
||||||
(_, _, ws) <- queryTree dpy rootw
|
(_, _, ws) <- queryTree dpy rootw
|
||||||
filterM ok ws
|
filterM (\w -> ok w `E.catch` skip) ws
|
||||||
-- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
|
-- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
|
||||||
-- Iconic
|
-- Iconic
|
||||||
where ok w = do wa <- getWindowAttributes dpy w
|
where ok w = do wa <- getWindowAttributes dpy w
|
||||||
@@ -428,6 +440,9 @@ scan dpy rootw = do
|
|||||||
return $ not (wa_override_redirect wa)
|
return $ not (wa_override_redirect wa)
|
||||||
&& (wa_map_state wa == waIsViewable || ic)
|
&& (wa_map_state wa == waIsViewable || ic)
|
||||||
|
|
||||||
|
skip :: E.SomeException -> IO Bool
|
||||||
|
skip _ = return False
|
||||||
|
|
||||||
setNumlockMask :: X ()
|
setNumlockMask :: X ()
|
||||||
setNumlockMask = do
|
setNumlockMask = do
|
||||||
dpy <- asks display
|
dpy <- asks display
|
||||||
|
@@ -1,6 +1,5 @@
|
|||||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||||
|
|
||||||
-- --------------------------------------------------------------------------
|
-- --------------------------------------------------------------------------
|
||||||
-- |
|
-- |
|
||||||
-- Module : XMonad.Operations
|
-- Module : XMonad.Operations
|
||||||
@@ -30,10 +29,13 @@ import qualified Data.Map as M
|
|||||||
import qualified Data.Set as S
|
import qualified Data.Set as S
|
||||||
|
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
|
import Control.Arrow (second)
|
||||||
import Control.Monad.Reader
|
import Control.Monad.Reader
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
import qualified Control.Exception.Extensible as C
|
import qualified Control.Exception.Extensible as C
|
||||||
|
|
||||||
|
import System.IO
|
||||||
|
import System.Directory
|
||||||
import System.Posix.Process (executeFile)
|
import System.Posix.Process (executeFile)
|
||||||
import Graphics.X11.Xlib
|
import Graphics.X11.Xlib
|
||||||
import Graphics.X11.Xinerama (getScreenInfo)
|
import Graphics.X11.Xinerama (getScreenInfo)
|
||||||
@@ -111,7 +113,10 @@ windows f = do
|
|||||||
|
|
||||||
mapM_ setInitialProperties newwindows
|
mapM_ setInitialProperties newwindows
|
||||||
|
|
||||||
whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc
|
whenJust (W.peek old) $ \otherw -> do
|
||||||
|
nbs <- asks (normalBorderColor . config)
|
||||||
|
setWindowBorderWithFallback d otherw nbs nbc
|
||||||
|
|
||||||
modify (\s -> s { windowset = ws })
|
modify (\s -> s { windowset = ws })
|
||||||
|
|
||||||
-- notify non visibility
|
-- notify non visibility
|
||||||
@@ -151,7 +156,9 @@ windows f = do
|
|||||||
|
|
||||||
mapM_ (uncurry tileWindow) rects
|
mapM_ (uncurry tileWindow) rects
|
||||||
|
|
||||||
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
|
whenJust (W.peek ws) $ \w -> do
|
||||||
|
fbs <- asks (focusedBorderColor . config)
|
||||||
|
setWindowBorderWithFallback d w fbs fbc
|
||||||
|
|
||||||
mapM_ reveal visible
|
mapM_ reveal visible
|
||||||
setTopFocus
|
setTopFocus
|
||||||
@@ -181,6 +188,19 @@ 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,
|
||||||
|
-- otherwise fallback to the color in @Pixel@.
|
||||||
|
setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
|
||||||
|
setWindowBorderWithFallback dpy w color basic = io $
|
||||||
|
C.handle fallback $ do
|
||||||
|
wa <- getWindowAttributes dpy w
|
||||||
|
pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
|
||||||
|
setWindowBorder dpy w pixel
|
||||||
|
where
|
||||||
|
fallback :: C.SomeException -> IO ()
|
||||||
|
fallback e = do hPrint stderr e >> hFlush stderr
|
||||||
|
setWindowBorder dpy w basic
|
||||||
|
|
||||||
-- | hide. 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
|
||||||
@@ -233,10 +253,10 @@ clearEvents mask = withDisplay $ \d -> io $ do
|
|||||||
-- | tileWindow. Moves and resizes w such that it fits inside the given
|
-- | tileWindow. Moves and resizes w such that it fits inside the given
|
||||||
-- rectangle, including its border.
|
-- rectangle, including its border.
|
||||||
tileWindow :: Window -> Rectangle -> X ()
|
tileWindow :: Window -> Rectangle -> X ()
|
||||||
tileWindow w r = withDisplay $ \d -> do
|
tileWindow w r = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
|
||||||
bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w)
|
|
||||||
-- give all windows at least 1x1 pixels
|
-- give all windows at least 1x1 pixels
|
||||||
let least x | x <= bw*2 = 1
|
let bw = fromIntegral $ wa_border_width wa
|
||||||
|
least x | x <= bw*2 = 1
|
||||||
| otherwise = x - bw*2
|
| otherwise = x - bw*2
|
||||||
io $ moveResizeWindow d w (rect_x r) (rect_y r)
|
io $ moveResizeWindow d w (rect_x r) (rect_y r)
|
||||||
(least $ rect_width r) (least $ rect_height r)
|
(least $ rect_width r) (least $ rect_height r)
|
||||||
@@ -423,6 +443,79 @@ initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
|
|||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
|
|
||||||
|
-- | A type to help serialize xmonad's state to a file.
|
||||||
|
data StateFile = StateFile
|
||||||
|
{ sfWins :: W.StackSet WorkspaceId String Window ScreenId ScreenDetail
|
||||||
|
, sfExt :: [(String, String)]
|
||||||
|
} deriving (Show, Read)
|
||||||
|
|
||||||
|
-- | Write the current window state (and extensible state) to a file
|
||||||
|
-- so that xmonad can resume with that state intact.
|
||||||
|
writeStateToFile :: X ()
|
||||||
|
writeStateToFile = do
|
||||||
|
let maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
|
||||||
|
maybeShow (t, Left str) = Just (t, str)
|
||||||
|
maybeShow _ = Nothing
|
||||||
|
|
||||||
|
wsData = W.mapLayout show . windowset
|
||||||
|
extState = catMaybes . map maybeShow . M.toList . extensibleState
|
||||||
|
|
||||||
|
path <- stateFileName
|
||||||
|
stateData <- gets (\s -> StateFile (wsData s) (extState s))
|
||||||
|
catchIO (writeFile path $ show stateData)
|
||||||
|
|
||||||
|
-- | Read the state of a previous xmonad instance from a file and
|
||||||
|
-- return that state. The state file is removed after reading it.
|
||||||
|
readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState)
|
||||||
|
readStateFile xmc = do
|
||||||
|
path <- stateFileName
|
||||||
|
|
||||||
|
-- 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.
|
||||||
|
sf' <- userCode . io $ do
|
||||||
|
raw <- withFile path ReadMode readStrict
|
||||||
|
return $! maybeRead reads raw
|
||||||
|
|
||||||
|
io (removeFile path)
|
||||||
|
|
||||||
|
return $ do
|
||||||
|
sf <- join sf'
|
||||||
|
|
||||||
|
let winset = W.ensureTags layout (workspaces xmc) $ W.mapLayout (fromMaybe layout . maybeRead lreads) (sfWins sf)
|
||||||
|
extState = M.fromList . map (second Left) $ sfExt sf
|
||||||
|
|
||||||
|
return XState { windowset = winset
|
||||||
|
, numberlockMask = 0
|
||||||
|
, mapped = S.empty
|
||||||
|
, waitingUnmap = M.empty
|
||||||
|
, dragging = Nothing
|
||||||
|
, extensibleState = extState
|
||||||
|
}
|
||||||
|
where
|
||||||
|
layout = Layout (layoutHook xmc)
|
||||||
|
lreads = readsLayout layout
|
||||||
|
maybeRead reads' s = case reads' s of
|
||||||
|
[(x, "")] -> Just x
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
readStrict :: Handle -> IO String
|
||||||
|
readStrict h = hGetContents h >>= \s -> length s `seq` return s
|
||||||
|
|
||||||
|
-- | Migrate state from a previously running xmonad instance that used
|
||||||
|
-- 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
|
-- | @restart name resume@. Attempt to restart xmonad by executing the program
|
||||||
-- @name@. If @resume@ is 'True', restart with the current window state.
|
-- @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'.
|
||||||
@@ -430,13 +523,8 @@ restart :: String -> Bool -> X ()
|
|||||||
restart prog resume = do
|
restart prog resume = do
|
||||||
broadcastMessage ReleaseResources
|
broadcastMessage ReleaseResources
|
||||||
io . flush =<< asks display
|
io . flush =<< asks display
|
||||||
let wsData = show . W.mapLayout show . windowset
|
when resume writeStateToFile
|
||||||
maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
|
catchIO (executeFile prog True [] Nothing)
|
||||||
maybeShow (t, Left str) = Just (t, str)
|
|
||||||
maybeShow _ = Nothing
|
|
||||||
extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState
|
|
||||||
args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return []
|
|
||||||
catchIO (executeFile prog True args Nothing)
|
|
||||||
|
|
||||||
------------------------------------------------------------------------
|
------------------------------------------------------------------------
|
||||||
-- | Floating layer support
|
-- | Floating layer support
|
||||||
@@ -444,20 +532,27 @@ restart prog resume = do
|
|||||||
-- | 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 = withDisplay $ \d -> do
|
floatLocation w =
|
||||||
ws <- gets windowset
|
catchX go $ do
|
||||||
wa <- io $ getWindowAttributes d w
|
-- Fallback solution if `go' fails. Which it might, since it
|
||||||
let bw = (fromIntegral . wa_border_width) wa
|
-- calls `getWindowAttributes'.
|
||||||
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
|
sc <- W.current <$> gets windowset
|
||||||
|
return (W.screen sc, W.RationalRect 0 0 1 1)
|
||||||
|
|
||||||
let sr = screenRect . W.screenDetail $ sc
|
|
||||||
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
|
|
||||||
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
|
|
||||||
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
|
||||||
(fi (wa_height wa + bw*2) % fi (rect_height sr))
|
|
||||||
|
|
||||||
return (W.screen sc, rr)
|
|
||||||
where fi x = fromIntegral x
|
where fi x = fromIntegral x
|
||||||
|
go = withDisplay $ \d -> do
|
||||||
|
ws <- gets windowset
|
||||||
|
wa <- io $ getWindowAttributes d w
|
||||||
|
let bw = (fromIntegral . wa_border_width) wa
|
||||||
|
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
|
||||||
|
|
||||||
|
let sr = screenRect . W.screenDetail $ sc
|
||||||
|
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
|
||||||
|
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
|
||||||
|
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
||||||
|
(fi (wa_height wa + bw*2) % fi (rect_height sr))
|
||||||
|
|
||||||
|
return (W.screen sc, rr)
|
||||||
|
|
||||||
-- | 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
|
||||||
@@ -507,7 +602,7 @@ mouseDrag f done = do
|
|||||||
clearEvents pointerMotionMask
|
clearEvents pointerMotionMask
|
||||||
return z
|
return z
|
||||||
|
|
||||||
-- | XXX comment me
|
-- | 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
|
io $ raiseWindow d w
|
||||||
@@ -515,21 +610,26 @@ mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
|||||||
(_, _, _, 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'
|
||||||
mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
|
mouseDrag (\ex ey -> do
|
||||||
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))
|
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
|
||||||
|
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
|
||||||
|
float w
|
||||||
|
)
|
||||||
(float w)
|
(float w)
|
||||||
|
|
||||||
-- | XXX comment me
|
-- | 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
|
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))
|
||||||
mouseDrag (\ex ey ->
|
mouseDrag (\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)
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
@@ -542,8 +642,12 @@ type D = (Dimension, Dimension)
|
|||||||
mkAdjust :: Window -> X (D -> D)
|
mkAdjust :: Window -> X (D -> D)
|
||||||
mkAdjust w = withDisplay $ \d -> liftIO $ do
|
mkAdjust w = withDisplay $ \d -> liftIO $ do
|
||||||
sh <- getWMNormalHints d w
|
sh <- getWMNormalHints d w
|
||||||
bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
|
wa <- C.try $ getWindowAttributes d w
|
||||||
return $ applySizeHints bw sh
|
case wa of
|
||||||
|
Left err -> const (return id) (err :: C.SomeException)
|
||||||
|
Right wa' ->
|
||||||
|
let bw = fromIntegral $ wa_border_width wa'
|
||||||
|
in return $ applySizeHints bw sh
|
||||||
|
|
||||||
-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
|
-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
|
||||||
-- window borders into account.
|
-- window borders into account.
|
||||||
|
@@ -477,12 +477,12 @@ insertUp a s = if member a s then s else insert
|
|||||||
--
|
--
|
||||||
-- * otherwise, delete doesn't affect the master.
|
-- * otherwise, delete doesn't affect the master.
|
||||||
--
|
--
|
||||||
delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
delete :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
delete w = sink w . delete' w
|
delete w = sink w . delete' w
|
||||||
|
|
||||||
-- | Only temporarily remove the window from the stack, thereby not destroying special
|
-- | Only temporarily remove the window from the stack, thereby not destroying special
|
||||||
-- information saved in the 'Stackset'
|
-- information saved in the 'Stackset'
|
||||||
delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
delete' w s = s { current = removeFromScreen (current s)
|
delete' w s = s { current = removeFromScreen (current s)
|
||||||
, visible = map removeFromScreen (visible s)
|
, visible = map removeFromScreen (visible s)
|
||||||
, hidden = map removeFromWorkspace (hidden s) }
|
, hidden = map removeFromWorkspace (hidden s) }
|
||||||
@@ -547,7 +547,7 @@ shift n s = maybe s (\w -> shiftWin n w s) (peek s)
|
|||||||
-- focused element on that workspace.
|
-- focused element on that workspace.
|
||||||
-- The actual focused workspace doesn't change. If the window is not
|
-- The actual focused workspace doesn't change. If the window is not
|
||||||
-- found in the stackSet, the original stackSet is returned.
|
-- found in the stackSet, the original stackSet is returned.
|
||||||
shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||||
shiftWin n w s = case findTag w s of
|
shiftWin n w s = case findTag w s of
|
||||||
Just from | n `tagMember` s && n /= from -> go from s
|
Just from | n `tagMember` s && n /= from -> go from s
|
||||||
_ -> s
|
_ -> s
|
||||||
|
7
stack.yaml
Normal file
7
stack.yaml
Normal file
@@ -0,0 +1,7 @@
|
|||||||
|
resolver: lts-7.19
|
||||||
|
|
||||||
|
packages:
|
||||||
|
- ./
|
||||||
|
|
||||||
|
extra-deps:
|
||||||
|
- X11-1.8
|
@@ -4,23 +4,27 @@ import XMonad.StackSet hiding (filter)
|
|||||||
|
|
||||||
import qualified Control.Exception.Extensible as C
|
import qualified Control.Exception.Extensible as C
|
||||||
import System.IO.Unsafe
|
import System.IO.Unsafe
|
||||||
|
import Data.List (isPrefixOf)
|
||||||
|
|
||||||
-- ---------------------------------------------------------------------
|
-- ---------------------------------------------------------------------
|
||||||
-- testing for failure
|
-- testing for failure and help out hpc
|
||||||
|
--
|
||||||
-- and help out hpc
|
-- Since base 4.9.0.0 `error` appends a stack trace. The tests below
|
||||||
prop_abort x = unsafePerformIO $ C.catch (abort "fail")
|
-- use `isPrefixOf` to only test equality on the error message.
|
||||||
(\(C.SomeException e) -> return $ show e == "xmonad: StackSet: fail" )
|
--
|
||||||
|
prop_abort :: Int -> Bool
|
||||||
|
prop_abort _ = unsafePerformIO $ C.catch (abort "fail") check
|
||||||
where
|
where
|
||||||
_ = x :: Int
|
check (C.SomeException e) =
|
||||||
|
return $ "xmonad: StackSet: fail" `isPrefixOf` show e
|
||||||
|
|
||||||
-- new should fail with an abort
|
-- new should fail with an abort
|
||||||
prop_new_abort x = unsafePerformIO $ C.catch f
|
prop_new_abort :: Int -> Bool
|
||||||
(\(C.SomeException e) -> return $ show e == "xmonad: StackSet: non-positive argument to StackSet.new" )
|
prop_new_abort _ = unsafePerformIO $ C.catch f check
|
||||||
where
|
where
|
||||||
f = new undefined{-layout-} [] [] `seq` return False
|
f = new undefined{-layout-} [] [] `seq` return False
|
||||||
|
check (C.SomeException e) =
|
||||||
_ = x :: Int
|
return $ "xmonad: StackSet: non-positive argument to StackSet.new" `isPrefixOf` show e
|
||||||
|
|
||||||
-- TODO: Fix this?
|
-- TODO: Fix this?
|
||||||
-- prop_view_should_fail = view {- with some bogus data -}
|
-- prop_view_should_fail = view {- with some bogus data -}
|
||||||
|
@@ -1,6 +1,6 @@
|
|||||||
{-# LANGUAGE FlexibleContexts #-}
|
{-# LANGUAGE FlexibleContexts #-}
|
||||||
-- Unlike the rest of xmonad, this file is copyright under the terms of the
|
-- Unlike the rest of xmonad, this file is released under the GNU General
|
||||||
-- GPL.
|
-- Public License version 2 or later.
|
||||||
|
|
||||||
--
|
--
|
||||||
-- Generates man/xmonad.1 from man/xmonad.1.in by filling the list of
|
-- Generates man/xmonad.1 from man/xmonad.1.in by filling the list of
|
||||||
@@ -79,7 +79,7 @@ main = do
|
|||||||
Right template <- getDefaultTemplate Nothing "man"
|
Right template <- getDefaultTemplate Nothing "man"
|
||||||
writeFile "./man/xmonad.1"
|
writeFile "./man/xmonad.1"
|
||||||
. (manHeader ++)
|
. (manHeader ++)
|
||||||
. writeMan def{ writerStandalone = True, writerTemplate = template }
|
. writeMan def{ writerTemplate = Just template }
|
||||||
$ parsed
|
$ parsed
|
||||||
putStrLn "Documentation created: man/xmonad.1"
|
putStrLn "Documentation created: man/xmonad.1"
|
||||||
|
|
||||||
@@ -92,8 +92,7 @@ main = do
|
|||||||
"<p>Section: xmonad manual (1)<br/>"++
|
"<p>Section: xmonad manual (1)<br/>"++
|
||||||
"Updated: "++releaseDate++"</p>"++
|
"Updated: "++releaseDate++"</p>"++
|
||||||
"<hr/>")]
|
"<hr/>")]
|
||||||
, writerStandalone = True
|
, writerTemplate = Just template
|
||||||
, writerTemplate = template
|
|
||||||
, writerTableOfContents = True }
|
, writerTableOfContents = True }
|
||||||
$ parsed
|
$ parsed
|
||||||
putStrLn "Documentation created: man/xmonad.1.html"
|
putStrLn "Documentation created: man/xmonad.1.html"
|
||||||
|
17
xmonad.cabal
17
xmonad.cabal
@@ -1,5 +1,5 @@
|
|||||||
name: xmonad
|
name: xmonad
|
||||||
version: 0.12
|
version: 0.14
|
||||||
homepage: http://xmonad.org
|
homepage: http://xmonad.org
|
||||||
synopsis: A tiling window manager
|
synopsis: A tiling window manager
|
||||||
description:
|
description:
|
||||||
@@ -17,7 +17,7 @@ license: BSD3
|
|||||||
license-file: LICENSE
|
license-file: LICENSE
|
||||||
author: Spencer Janssen
|
author: Spencer Janssen
|
||||||
maintainer: xmonad@haskell.org
|
maintainer: xmonad@haskell.org
|
||||||
extra-source-files: README.md CHANGES.md TODO CONFIG STYLE
|
extra-source-files: README.md CHANGES.md CONFIG STYLE
|
||||||
tests/*.hs
|
tests/*.hs
|
||||||
tests/Properties/*.hs
|
tests/Properties/*.hs
|
||||||
tests/Properties/Layout/*.hs
|
tests/Properties/Layout/*.hs
|
||||||
@@ -31,7 +31,10 @@ build-type: Simple
|
|||||||
tested-with:
|
tested-with:
|
||||||
GHC==7.6.3,
|
GHC==7.6.3,
|
||||||
GHC==7.8.4,
|
GHC==7.8.4,
|
||||||
GHC==7.10.2
|
GHC==7.10.3,
|
||||||
|
GHC==8.0.2,
|
||||||
|
GHC==8.2.2,
|
||||||
|
GHC==8.4.3
|
||||||
|
|
||||||
data-files: man/xmonad.hs, man/xmonad.1, man/xmonad.1.html
|
data-files: man/xmonad.hs, man/xmonad.1, man/xmonad.1.html
|
||||||
|
|
||||||
@@ -42,6 +45,7 @@ source-repository head
|
|||||||
flag testing
|
flag testing
|
||||||
description: Testing mode, only build minimal components
|
description: Testing mode, only build minimal components
|
||||||
default: False
|
default: False
|
||||||
|
manual: True
|
||||||
|
|
||||||
flag generatemanpage
|
flag generatemanpage
|
||||||
description: Build the tool for generating the man page
|
description: Build the tool for generating the man page
|
||||||
@@ -71,7 +75,8 @@ library
|
|||||||
process,
|
process,
|
||||||
unix,
|
unix,
|
||||||
utf8-string >= 0.3 && < 1.1,
|
utf8-string >= 0.3 && < 1.1,
|
||||||
X11>=1.5 && < 1.7
|
X11>=1.8 && < 1.10,
|
||||||
|
semigroups
|
||||||
|
|
||||||
if true
|
if true
|
||||||
ghc-options: -funbox-strict-fields -Wall
|
ghc-options: -funbox-strict-fields -Wall
|
||||||
@@ -81,10 +86,6 @@ library
|
|||||||
if impl(ghc < 7.0.0)
|
if impl(ghc < 7.0.0)
|
||||||
extensions: UndecidableInstances
|
extensions: UndecidableInstances
|
||||||
-- needed for XMonad.Config's instance Default (XConfig a)
|
-- needed for XMonad.Config's instance Default (XConfig a)
|
||||||
|
|
||||||
|
|
||||||
ghc-prof-options: -prof -auto-all
|
|
||||||
|
|
||||||
if flag(testing)
|
if flag(testing)
|
||||||
buildable: False
|
buildable: False
|
||||||
|
|
||||||
|
Reference in New Issue
Block a user