diff --git a/CHANGES.md b/CHANGES.md
--- a/CHANGES.md
+++ b/CHANGES.md
@@ -1,5 +1,25 @@
# Change Log / Release Notes
+## 0.17.1 (September 3, 2021)
+
+### Enhancements
+
+ * Added custom cursor shapes for resizing and moving windows.
+
+ * Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`.
+
+### 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
@@ -44,6 +64,9 @@
* Added `withUnfocused` function to `XMonad.Operations`, allowing for `X`
operations to be applied to unfocused windows.
+
+ * Added `willFloat` function to `XMonad.ManageHooks` to detect whether the
+ (about to be) managed window will be a floating window or not
[these build scripts]: https://github.com/xmonad/xmonad-testing/tree/master/build-scripts
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -70,8 +70,11 @@
and [xmonad][] have test-suites that you could run with
`stack test` for example.
- * Make sure you read the section on rebasing and squashing commits
- below.
+ * When committing, try to follow existing practices. For more
+ 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
@@ -83,7 +86,7 @@
and provide a type signature; use Haddock syntax in the comments.
* Follow the coding style of the module that you are making changes to
- (`n` spaces for indentation, where to break long type signatures, …)
+ (`n` spaces for indentation, where to break long type signatures, …).
* New code should not introduce any new warnings. If you want to
check this yourself before submitting a pull request, there is the
@@ -95,7 +98,7 @@
enforced in our GitHub CI.
* Partial functions are to be avoided: the window manager should not
- crash, so do not call `error` or `undefined`
+ crash, so do not call `error` or `undefined`.
* Any pure function added to the core should have QuickCheck
properties precisely defining its behavior.
@@ -103,84 +106,15 @@
* New modules should identify the author, and be submitted under the
same license as xmonad (BSD3 license).
-## 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`:
- ```shell
- $ 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):
-
- ```shell
- $ 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:
-
- ```shell
- $ 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:
- ```shell
- $ 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.
+## Keep rocking!
- 6. If everything was successful you can push your changed history
- back up to GitHub:
- ```shell
- $ git push --force-with-lease
- ```
+xmonad is a passion project created and maintained by the community.
+We'd love for you to maintain your own contributed modules (approve
+changes from other contributors, review code, etc.). However, before
+we'd be comfortable adding you to the [xmonad GitHub
+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,
+Matrix, etc.][community]).
[hlint]: https://github.com/ndmitchell/hlint
[xmonad]: https://github.com/xmonad/xmonad
@@ -191,3 +125,7 @@
[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
diff --git a/INSTALL.md b/INSTALL.md
--- a/INSTALL.md
+++ b/INSTALL.md
@@ -47,10 +47,21 @@
``` 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
@@ -90,8 +101,8 @@
out a tagged release, e.g.:
``` console
-$ git clone --branch v0.15 https://github.com/xmonad/xmonad
-$ git clone --branch v0.16 https://github.com/xmonad/xmonad-contrib
+$ git clone --branch v0.17.1 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,
@@ -199,7 +210,9 @@
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`!
+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
@@ -343,6 +356,15 @@
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
@@ -374,3 +396,4 @@
[ghcup]: https://www.haskell.org/ghcup/
[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
diff --git a/MAINTAINERS.md b/MAINTAINERS.md
--- a/MAINTAINERS.md
+++ b/MAINTAINERS.md
@@ -2,7 +2,7 @@
## The XMonad Core Team
- * Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`
+ * Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`, [GPG][gpg:geekosaur]
* Brent Yorgey [GitHub][byorgey], IRC: `byorgey`
@@ -10,10 +10,10 @@
* Sibi Prabakaran [GitHub][psibi], [Twitter][twitter:psibi], IRC: `sibi`
- * slotThe [GitHub][slotThe], IRC: `Solid`
-
* Tomáš Janoušek [GitHub][liskin], [Twitter][twitter:liskin], IRC: `liskin`, [GPG][gpg:liskin]
+ * Tony Zorman [GitHub][slotThe], IRC: `Solid`, [GPG][gpg:slotThe]
+
[geekosaur]: https://github.com/geekosaur
[byorgey]: https://github.com/byorgey
[dmwit]: https://github.com/dmwit
@@ -21,7 +21,9 @@
[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
@@ -71,39 +73,41 @@
2. Review documentation files and make sure they are accurate:
- [`README.md`](README.md)
- - [`CHANGES.md`](CHANGES.md)
+ - [`CHANGES.md`](CHANGES.md) (bump version, set date)
- [`INSTALL.md`](INSTALL.md)
- [`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. Make sure that `tested-with:` covers several recent releases of GHC, that
+ 3. Update the website:
+
+ - Draft a [new release announcement][web-announce].
+ - Check install instructions, guided tour, keybindings cheat sheet, …
+
+ 4. Make sure that `tested-with:` covers several recent releases of GHC, that
`.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.
- 4. Create a release on GitHub:
-
- - https://github.com/xmonad/xmonad/releases/new
- - https://github.com/xmonad/xmonad-contrib/releases/new
-
- CI will upload a release candidate to Hackage. Check again that
- everything looks good. To publish a final release, run the CI workflow
- once again with the correct version number:
+ 5. Trigger the Haskell-CI workflow and fill in the candidate version number.
+ This will upload a release candidate to Hackage.
- https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml
- https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml
- See [haskell-ci-hackage.patch][] for details about the release infrastructure.
+ Check that everything looks good. If not, push fixes and do another
+ candidate. When everything's ready, create a release on GitHub:
- 5. Update the website:
+ - https://github.com/xmonad/xmonad/releases/new
+ - https://github.com/xmonad/xmonad-contrib/releases/new
- - Post a [new release announcement][web-announce]
- - Check install instructions, guided tour, keybindings cheat sheet, …
+ CI will automatically upload the final release to Hackage.
- 7. Post announcement to:
+ See [haskell-ci-hackage.patch][] for details about the Hackage automation.
+ 6. Post announcement to:
+
- [xmonad.org website](https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts)
- [XMonad mailing list](https://mail.haskell.org/mailman/listinfo/xmonad)
- [Haskell Cafe](https://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe)
@@ -111,13 +115,17 @@
- [Twitter](https://twitter.com/xmonad)
- [Reddit](https://www.reddit.com/r/xmonad/)
- See [old announcements][old-announce] for inspiration.
+ See [old announcements][old-announce] ([even older][older-announce]) for inspiration.
+ 7. Bump version for development (add `.9`) and prepare fresh sections in
+ [`CHANGES.md`](CHANGES.md).
+
[packdeps]: https://hackage.haskell.org/package/packdeps
[Stackage]: https://www.stackage.org/
[haskell-ci-hackage.patch]: .github/workflows/haskell-ci-hackage.patch
[web-announce]: https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts
-[old-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768
+[old-announce]: https://github.com/xmonad/xmonad-web/blob/gh-pages/news/_posts/2021-10-27-xmonad-0-17-0.md
+[older-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768
## Website and Other Accounts
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,35 +1,20 @@
-
- 
-
+
-
- 
-
-
- 
-
-
- 
-
+
+
+
-
- 
-
-
- 
-
-
- 
-
+
+
+
-
- 
-
-
- 
-
+
+
+
+ 
+ 
# xmonad
diff --git a/TUTORIAL.md b/TUTORIAL.md
--- a/TUTORIAL.md
+++ b/TUTORIAL.md
@@ -54,7 +54,7 @@
to Super instead (I will show you how to do this below).
This guide should work for any GNU/Linux distribution and even for BSD
-folks. Because debian-based distributions are still rather popular, we
+folks. Because Debian-based distributions are still rather popular, we
will give you the `apt` commands when it comes to installing software.
If you use another distribution, just substitute the appropriate
commands for your system.
@@ -187,8 +187,8 @@
here as well.
What if we wanted to add other keybindings? Say you also want to bind
-`M-S-z` to lock your screen with the screensaver, `M-S-=` to take a
-snapshot of one window, and `M-]` to spawn Firefox. This can be
+`M-S-z` to lock your screen with the screensaver, `M-C-s` to take a
+snapshot of one window, and `M-f` to spawn Firefox. This can be
achieved with the `additionalKeysP` function from the
[XMonad.Util.EZConfig] module—luckily we already have it imported! Our
config file, starting with `main`, now looks like:
@@ -200,8 +200,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
```
@@ -247,7 +247,7 @@
to the top of our configuration file. Most modules have a lot of
accompanying text and usage examples in them—so while the type
signatures may seem scary, don't be afraid to look up the
-[xmonad-contrib documentation] on hackage!
+[xmonad-contrib documentation] on Hackage!
Next we just need to tell xmonad that we want to use that particular
layout. To do this, there is the `layoutHook`. Let's use the default
@@ -313,8 +313,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
```
@@ -396,8 +396,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
```
@@ -420,8 +420,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
```
@@ -592,14 +592,14 @@
```
First, we set the font to use for the bar, as well as the colors. The
-position options are documented well on the [xmobar home page] or,
-alternatively, in the [quick-start.org] on GitHub. The particular
-option of `TopW L 90` says to put the bar in the upper left of the
-screen, and make it consume 90% of the width of the screen (we need to
-leave a little bit of space for `trayer-srg`). If you're up for it—and
-this really requires more shell-scripting than Haskell knowledge—you can
-also try to seamlessly embed trayer into xmobar by using
-[trayer-padding-icon.sh] and following the advice given in that thread.
+position options are documented well in xmobar's [quick-start.org]. The
+particular option of `TopW L 90` says to put the bar in the upper left
+of the screen, and make it consume 90% of the width of the screen (we
+need to leave a little bit of space for `trayer-srg`). If you're up for
+it—and this really requires more shell-scripting than Haskell
+knowledge—you can also try to seamlessly embed trayer into xmobar by
+using [trayer-padding-icon.sh] and following the advice given in that
+thread.
In the commands list you, well, define commands. Commands are the
pieces that generate the content to be displayed in your bar. These
@@ -965,9 +965,9 @@
myManageHook = (className =? "Gimp" --> doFloat)
```
-Say we also want to float all dialogs. This is easy with the `isDialog`
-function from [XMonad.Hooks.ManageHelpers] (which you should import) and
-a little modification to the `myManageHook` function:
+Say we also want to float all dialog windows. This is easy with the
+`isDialog` function from [XMonad.Hooks.ManageHelpers] (which you should
+import) and a little modification to the `myManageHook` function:
``` haskell
myManageHook :: ManageHook
@@ -989,8 +989,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
```
@@ -1032,8 +1032,8 @@
}
`additionalKeysP`
[ ("M-S-z", spawn "xscreensaver-command -lock")
- , ("M-S-=", unGrab *> spawn "scrot -s" )
- , ("M-]" , spawn "firefox" )
+ , ("M-C-s", unGrab *> spawn "scrot -s" )
+ , ("M-f" , spawn "firefox" )
]
myManageHook :: ManageHook
@@ -1113,7 +1113,7 @@
}
```
-For an explanation of the battery commands used above, see xmobars
+For an explanation of the battery commands used above, see xmobar's
[battery] documentation.
You can also specify workspaces in the same way and feed them to xmobar
@@ -1121,13 +1121,15 @@
workspace names).
As an example how this would look like in a real configuration, you can
-look at [Liskin's], [slotThe's], or [TheMC47's] xmobar configuration.
-Do note that the last two are Haskell-based and thus may be a little
-hard to understand for newcomers.
+look at [Liskin's old][liskin-xmobarrc-old], [Liskin's current][liskin-xmobarrc],
+[slotThe's][slotThe-xmobarrc], or [TheMC47's][TheMC47-xmobarrc] xmobar
+configuration. Do note that the last three are Haskell-based and thus may
+be a little hard to understand for newcomers.
-[Liskin's]: https://github.com/liskin/dotfiles/blob/home/.xmobarrc
-[TheMC47's]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc
-[slotThe's]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
+[liskin-xmobarrc-old]: https://github.com/liskin/dotfiles/blob/75dfc057c33480ee9d3300d4d02fb79a986ef3a5/.xmobarrc
+[liskin-xmobarrc]: https://github.com/liskin/dotfiles/blob/home/.xmonad/xmobar.hs
+[TheMC47-xmobarrc]: https://github.com/TheMC47/dotfiles/tree/master/xmobar/xmobarrc
+[slotThe-xmobarrc]: https://gitlab.com/slotThe/dotfiles/-/blob/master/xmobar/.config/xmobarrc/src/xmobarrc.hs
### Renaming Layouts
@@ -1222,7 +1224,7 @@
[log]: https://ircbrowse.tomsmeding.com/browse/lcxmonad
[EWMH]: https://specifications.freedesktop.org/wm-spec/wm-spec-1.3.html
[ICCCM]: https://tronche.com/gui/x/icccm/
-[webchat]: https://kiwiirc.com/nextclient/irc.libera.chat/?#xmonad
+[webchat]: https://web.libera.chat/#xmonad
[about xmonad]: https://xmonad.org/about.html
[shell variable]: https://www.shellscript.sh/variables1.html
[xmonad-testing]: https://github.com/xmonad/xmonad-testing
@@ -1230,7 +1232,7 @@
[xmonad guided tour]: https://xmonad.org/tour.html
[xmonad mailing list]: https://mail.haskell.org/mailman/listinfo/xmonad
[xmonad's GitHub page]: https://github.com/xmonad/xmonad
-[trayer-padding-icon.sh]: https://github.com/jaor/xmobar/issues/239#issuecomment-233206552
+[trayer-padding-icon.sh]: https://codeberg.org/xmobar/xmobar/issues/239#issuecomment-537931
[xmonad-contrib documentation]: https://hackage.haskell.org/package/xmonad-contrib
[GNU Image Manipulation Program]: https://www.gimp.org/
[Basic Desktop Environment Integration]: https://wiki.haskell.org/Xmonad/Basic_Desktop_Environment_Integration
@@ -1251,14 +1253,13 @@
[XMonad.Util.ClickableWorkspaces]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Util-ClickableWorkspaces.html
[xmobar]: https://xmobar.org/
-[battery]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#batteryp-dirs-args-refreshrate
-[xmobar.hs]: https://github.com/jaor/xmobar/blob/master/examples/xmobar.hs
+[battery]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#batteryp-dirs-args-refreshrate
+[xmobar.hs]: https://codeberg.org/xmobar/xmobar/src/branch/master/etc/xmobar.hs
[Wikipedia page]: https://en.wikipedia.org/wiki/ICAO_airport_code#Prefixes
-[quick-start.org]: https://github.com/jaor/xmobar/blob/master/doc/quick-start.org#configuration-options
+[quick-start.org]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/quick-start.org#configuration-options
[jao's xmobar.hs]: https://codeberg.org/jao/xmobar-config
-[weather monitor]: https://github.com/jaor/xmobar/blob/master/doc/plugins.org#weather-monitors
-[xmobar home page]: https://xmobar.org/
-[xmobar's `Installation` section]: https://github.com/jaor/xmobar#installation
+[weather monitor]: https://codeberg.org/xmobar/xmobar/src/branch/master/doc/plugins.org#weather-monitors
+[xmobar's `Installation` section]: https://codeberg.org/xmobar/xmobar#installation
[Haskell]: https://www.haskell.org/
[trayer-srg]: https://github.com/sargon/trayer-srg
diff --git a/man/xmonad.hs b/man/xmonad.hs
--- a/man/xmonad.hs
+++ b/man/xmonad.hs
@@ -123,7 +123,7 @@
-- , ((modm , xK_b ), sendMessage ToggleStruts)
-- Quit xmonad
- , ((modm .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
+ , ((modm .|. shiftMask, xK_q ), io exitSuccess)
-- Restart xmonad
, ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart")
@@ -154,18 +154,18 @@
------------------------------------------------------------------------
-- 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
- [ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
- >> windows W.shiftMaster))
+ [ ((modm, button1), \w -> focus w >> mouseMoveWindow w
+ >> windows W.shiftMaster)
-- 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
- , ((modm, button3), (\w -> focus w >> mouseResizeWindow w
- >> windows W.shiftMaster))
+ , ((modm, button3), \w -> focus w >> mouseResizeWindow w
+ >> windows W.shiftMaster)
-- you may also bind events to the mouse scroll wheel (button4 and button5)
]
diff --git a/src/XMonad/Config.hs b/src/XMonad/Config.hs
--- a/src/XMonad/Config.hs
+++ b/src/XMonad/Config.hs
@@ -218,7 +218,7 @@
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
-- quit, or restart
- , ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
+ , ((modMask .|. shiftMask, xK_q ), io 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 .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
diff --git a/src/XMonad/Core.hs b/src/XMonad/Core.hs
--- a/src/XMonad/Core.hs
+++ b/src/XMonad/Core.hs
@@ -1,6 +1,11 @@
-{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
- MultiParamTypeClasses, TypeSynonymInstances, DeriveDataTypeable,
- LambdaCase, NamedFieldPuns, DeriveTraversable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
-----------------------------------------------------------------------------
-- |
@@ -35,17 +40,18 @@
import XMonad.StackSet hiding (modify)
import Prelude
-import Control.Exception (fromException, try, bracket, bracket_, throw, finally, SomeException(..))
+import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
import qualified Control.Exception as E
import Control.Applicative ((<|>), empty)
import Control.Monad.Fail
import Control.Monad.State
import Control.Monad.Reader
+import Control.Monad (void)
import Data.Semigroup
import Data.Traversable (for)
import Data.Time.Clock (UTCTime)
import Data.Default.Class
-import Data.List (isInfixOf)
+import System.Environment (lookupEnv)
import System.FilePath
import System.IO
import System.Info
@@ -60,7 +66,7 @@
import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
import Data.Typeable
-import Data.List ((\\))
+import Data.List (isInfixOf, (\\))
import Data.Maybe (isJust,fromMaybe)
import qualified Data.Map as M
@@ -156,18 +162,13 @@
-- instantiated on 'XConf' and 'XState' automatically.
--
newtype X a = X (ReaderT XConf (StateT XState IO) a)
- deriving (Functor, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
-
-instance Applicative X where
- pure = return
- (<*>) = ap
+ deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
instance Semigroup a => Semigroup (X a) where
(<>) = liftM2 (<>)
instance (Monoid a) => Monoid (X a) where
- mempty = return mempty
- mappend = liftM2 mappend
+ mempty = pure mempty
instance Default a => Default (X a) where
def = return def
@@ -177,14 +178,13 @@
deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
runQuery :: Query a -> Window -> X a
-runQuery (Query m) w = runReaderT m w
+runQuery (Query m) = runReaderT m
instance Semigroup a => Semigroup (Query a) where
(<>) = liftM2 (<>)
instance Monoid a => Monoid (Query a) where
- mempty = return mempty
- mappend = liftM2 mappend
+ mempty = pure mempty
instance Default a => Default (Query a) where
def = return def
@@ -201,7 +201,7 @@
st <- get
c <- ask
(a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
- Just x -> throw e `const` (x `asTypeOf` ExitSuccess)
+ Just (_ :: ExitCode) -> throw e
_ -> do hPrint stderr e; runX c st errcase
put s'
return a
@@ -209,12 +209,12 @@
-- | Execute the argument, catching all exceptions. Either this function or
-- 'catchX' should be used at all callsites of user customized code.
userCode :: X a -> X (Maybe a)
-userCode a = catchX (Just `liftM` a) (return Nothing)
+userCode a = catchX (Just <$> a) (return Nothing)
-- | Same as userCode but with a default argument to return instead of using
-- Maybe, provided for convenience.
userCodeDef :: a -> X a -> X a
-userCodeDef defValue a = fromMaybe defValue `liftM` userCode a
+userCodeDef defValue a = fromMaybe defValue <$> userCode a
-- ---------------------------------------------------------------------
-- Convenient wrappers to state
@@ -235,7 +235,7 @@
-- | True if the given window is the root window
isRoot :: Window -> X Bool
-isRoot w = (w==) <$> asks theRoot
+isRoot w = asks $ (w ==) . theRoot
-- | Wrapper for the common case of atom internment
getAtom :: String -> X Atom
@@ -437,7 +437,7 @@
--
-- Note this function assumes your locale uses utf8.
spawn :: MonadIO m => String -> m ()
-spawn x = spawnPID x >> return ()
+spawn x = void $ spawnPID x
-- | Like 'spawn', but returns the 'ProcessID' of the launched application
spawnPID :: MonadIO m => String -> m ProcessID
@@ -458,7 +458,8 @@
-- | Use @xmessage@ to show information to the user.
xmessage :: MonadIO m => String -> m ()
xmessage msg = void . xfork $ do
- executeFile "xmessage" True
+ 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-*-*-*-*-*-*-*"
@@ -651,11 +652,12 @@
compile :: Directories -> Compile -> IO ExitCode
compile dirs method =
bracket_ uninstallSignalHandlers installSignalHandlers $
- bracket (openFile (errFileName dirs) WriteMode) hClose $ \err -> do
+ withFile (errFileName dirs) WriteMode $ \err -> do
let run = runProc (cfgDir dirs) err
case method of
- CompileGhc ->
- run "ghc" ghcArgs
+ CompileGhc -> do
+ ghc <- fromMaybe "ghc" <$> lookupEnv "XMONAD_GHC"
+ run ghc ghcArgs
CompileStackGhc stackYaml ->
run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)
diff --git a/src/XMonad/Layout.hs b/src/XMonad/Layout.hs
--- a/src/XMonad/Layout.hs
+++ b/src/XMonad/Layout.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances, DeriveDataTypeable, LambdaCase, MultiWayIf #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
-- --------------------------------------------------------------------------
-- |
@@ -39,7 +41,7 @@
data Resize = Shrink | Expand
-- | Increase the number of clients in the master pane.
-data IncMasterN = IncMasterN !Int
+newtype IncMasterN = IncMasterN Int
instance Message Resize
instance Message IncMasterN
@@ -199,8 +201,8 @@
(CL, CR) -> (hide l' , return r')
(CR, CL) -> (return l', hide r' )
(_ , _ ) -> (return l', return r')
- f (x,y) = fmap Just $ liftM2 (Choose d') x y
- hide x = fmap (fromMaybe x) $ handle x Hide
+ f (x,y) = Just <$> liftM2 (Choose d') x y
+ hide x = fromMaybe x <$> handle x Hide
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
runLayout (W.Workspace i (Choose CL l r) ms) =
diff --git a/src/XMonad/Main.hs b/src/XMonad/Main.hs
--- a/src/XMonad/Main.hs
+++ b/src/XMonad/Main.hs
@@ -1,4 +1,6 @@
-{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, NamedFieldPuns #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+
----------------------------------------------------------------------------
-- |
-- Module : XMonad.Main
@@ -19,6 +21,7 @@
import qualified Control.Exception as E
import Data.Bits
import Data.List ((\\))
+import Data.Foldable (traverse_)
import Data.Function
import qualified Data.Map as M
import qualified Data.Set as S
@@ -87,14 +90,14 @@
usage = do
self <- getProgName
putStr . unlines $
- concat ["Usage: ", self, " [OPTION]"] :
- "Options:" :
- " --help Print this message" :
- " --version Print the version number" :
- " --recompile Recompile your xmonad.hs" :
- " --replace Replace the running window manager with xmonad" :
- " --restart Request a running xmonad process to restart" :
- []
+ [ "Usage: " <> self <> " [OPTION]"
+ , "Options:"
+ , " --help Print this message"
+ , " --version Print the version number"
+ , " --recompile Recompile your xmonad.hs"
+ , " --replace Replace the running window manager with xmonad"
+ , " --restart Request a running xmonad process to restart"
+ ]
-- | Build the xmonad configuration file with ghc, then execute it.
-- If there are no errors, this function does not return. An
@@ -193,12 +196,12 @@
xinesc <- getCleanedScreenInfo dpy
- nbc <- do v <- initColor dpy $ normalBorderColor xmc
- ~(Just nbc_) <- initColor dpy $ normalBorderColor Default.def
+ nbc <- do v <- initColor dpy $ normalBorderColor xmc
+ Just nbc_ <- initColor dpy $ normalBorderColor Default.def
return (fromMaybe nbc_ v)
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)
hSetBuffering stdout NoBuffering
@@ -242,7 +245,7 @@
let extst = maybe M.empty extensibleState serializedSt
modify (\s -> s {extensibleState = extst})
- setNumlockMask
+ cacheNumlockMask
grabKeys
grabButtons
@@ -264,10 +267,11 @@
userCode $ startupHook initxmc
rrData <- io $ xrrQueryExtension dpy
- let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
-- 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 >> rrUpdate e >> getEvent e)
+ -- sadly, 9.2.{1,2,3} join points mishandle the above and trash the heap (see #389)
+ mainLoop dpy e rrData
return ()
where
@@ -278,6 +282,8 @@
in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
evs = [ keyPress, keyRelease, enterNotify, leaveNotify
, buttonPress, buttonRelease]
+ rrUpdate e r = when (isJust r) (void (xrrUpdateConfiguration e))
+ mainLoop d e r = io (nextEvent d e >> rrUpdate e r >> getEvent e) >>= prehandle >> mainLoop d e r
-- | Runs handleEventHook from the configuration and runs the default handler
@@ -330,7 +336,7 @@
-- 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
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
- if (synthetic || e == 0)
+ if synthetic || e == 0
then unmanage w
else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
where mpred 1 = Nothing
@@ -340,7 +346,7 @@
handle e@(MappingNotifyEvent {}) = do
io $ refreshKeyboardMapping e
when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
- setNumlockMask
+ cacheNumlockMask
grabKeys
-- handle button release, which may finish dragging.
@@ -428,7 +434,7 @@
handle e@ClientMessageEvent { ev_message_type = mt } = do
a <- getAtom "XMONAD_RESTART"
- if (mt == a)
+ if mt == a
then restart "xmonad" True
else broadcastMessage e
@@ -459,38 +465,14 @@
skip :: E.SomeException -> IO Bool
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
grabKeys :: X ()
grabKeys = do
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
- ks <- asks keyActions
- -- 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 keysymMap' = M.fromListWith (++) (zip syms [[code] | code <- allCodes])
- -- keycodeToKeysym returns noSymbol for all unbound keycodes, and we don't
- -- want to grab those whenever someone accidentally uses def :: KeySym
- let keysymMap = M.delete noSymbol keysymMap'
- let keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
- forM_ (M.keys ks) $ \(mask,sym) ->
- forM_ (keysymToKeycodes sym) $ \kc ->
- mapM_ (grab kc . (mask .|.)) =<< extraModifiers
+ let grab :: (KeyMask, KeyCode) -> X ()
+ grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
+ traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions)
-- | Grab the buttons
grabButtons :: X ()
@@ -501,7 +483,7 @@
io $ ungrabButton dpy anyButton anyModifier rootw
ems <- extraModifiers
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 ()
diff --git a/src/XMonad/ManageHook.hs b/src/XMonad/ManageHook.hs
--- a/src/XMonad/ManageHook.hs
+++ b/src/XMonad/ManageHook.hs
@@ -1,5 +1,3 @@
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
-
-----------------------------------------------------------------------------
-- |
-- Module : XMonad.ManageHook
@@ -8,7 +6,6 @@
--
-- Maintainer : spencerjanssen@gmail.com
-- Stability : unstable
--- Portability : not portable, uses cunning newtype deriving
--
-- An EDSL for ManageHooks
--
@@ -27,7 +24,7 @@
import Data.Maybe
import Data.Monoid
import qualified XMonad.StackSet as W
-import XMonad.Operations (floatLocation, reveal)
+import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient)
-- | Lift an 'X' action to a 'Query'.
liftX :: X a -> Query a
@@ -61,11 +58,11 @@
-- | '&&' lifted to a 'Monad'.
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
-(<&&>) x y = ifM x y (pure False)
+x <&&> y = ifM x y (pure False)
-- | '||' lifted to a 'Monad'.
(<||>) :: Monad m => m Bool -> m Bool -> m Bool
-(<||>) x y = ifM x (pure True) y
+x <||> y = ifM x (pure True) y
-- | If-then-else lifted to a 'Monad'.
ifM :: Monad m => m Bool -> m a -> m a -> m a
@@ -83,7 +80,8 @@
return $ if null l then "" else head l
io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return ""
--- | Return the application name.
+-- | Return the application name; i.e., the /first/ string returned by
+-- @WM_CLASS@.
appName :: Query String
appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
@@ -91,20 +89,25 @@
resource :: Query String
resource = appName
--- | Return the resource class.
+-- | Return the resource class; i.e., the /second/ string returned by
+-- @WM_CLASS@.
className :: Query String
className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
-- | A query that can return an arbitrary X property of type 'String',
-- identified by name.
stringProperty :: String -> Query String
-stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
+stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fromMaybe "" <$> getStringProperty d w p)
getStringProperty :: Display -> Window -> String -> X (Maybe String)
getStringProperty d w p = do
a <- getAtom p
md <- io $ getWindowProperty8 d a w
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.
doF :: (s -> s) -> Query (Endo s)
diff --git a/src/XMonad/Operations.hs b/src/XMonad/Operations.hs
--- a/src/XMonad/Operations.hs
+++ b/src/XMonad/Operations.hs
@@ -1,4 +1,10 @@
-{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, PatternGuards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
-- --------------------------------------------------------------------------
-- |
-- Module : XMonad.Operations
@@ -18,7 +24,7 @@
manage, unmanage, killWindow, kill, isClient,
setInitialProperties, setWMState, setWindowBorderWithFallback,
hide, reveal, tileWindow,
- setTopFocus, focus,
+ setTopFocus, focus, isFixedSizeOrTransient,
-- * Manage Windows
windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
@@ -27,7 +33,7 @@
-- * Keyboard and Mouse
cleanMask, extraModifiers,
mouseDrag, mouseMoveWindow, mouseResizeWindow,
- setButtonGrab, setFocusX,
+ setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs,
-- * Messages
sendMessage, broadcastMessage, sendMessageWithNoRefresh,
@@ -57,7 +63,7 @@
import Data.Maybe
import Data.Monoid (Endo(..),Any(..))
import Data.List (nub, (\\), find)
-import Data.Bits ((.|.), (.&.), complement, testBit)
+import Data.Bits ((.|.), (.&.), complement, setBit, testBit)
import Data.Function (on)
import Data.Ratio
import qualified Data.Map as M
@@ -66,6 +72,7 @@
import Control.Arrow (second)
import Control.Monad.Reader
import Control.Monad.State
+import Control.Monad (void)
import qualified Control.Exception as C
import System.IO
@@ -78,6 +85,16 @@
-- ---------------------------------------------------------------------
-- 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.
-- Bring it into focus.
@@ -87,10 +104,8 @@
--
manage :: Window -> X ()
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
- sh <- io $ getWMNormalHints d w
- let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
- isTransient <- isJust <$> io (getTransientForHint d w)
+ shouldFloat <- isFixedSizeOrTransient d w
rr <- snd `fmap` floatLocation w
-- ensure that float windows don't go over the edge of the screen
@@ -98,8 +113,8 @@
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
adjust r = r
- f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
- | otherwise = W.insertUp w ws
+ f ws | shouldFloat = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
+ | otherwise = W.insertUp w ws
where i = W.tag $ W.workspace $ W.current ws
mh <- asks (manageHook . config)
@@ -128,7 +143,7 @@
setEventType ev clientMessage
setClientMessageEvent ev w wmprot 32 wmdelt currentTime
sendEvent d w False noEventMask ev
- else killClient d w >> return ()
+ else void (killClient d w)
-- | Kill the currently focused client.
kill :: X ()
@@ -179,7 +194,7 @@
let m = W.floating ws
flt = [(fw, scaleRationalRect viewrect r)
- | fw <- filter (flip M.member m) (W.index this)
+ | fw <- filter (`M.member` m) (W.index this)
, Just r <- [M.lookup fw m]]
vs = flt ++ rs
@@ -205,7 +220,7 @@
-- all windows that are no longer in the windowset are marked as
-- withdrawn, it is important to do this after the above, otherwise 'hide'
-- will overwrite withdrawnState with iconicState
- mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
+ mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws)
isMouseFocused <- asks mouseFocused
unless isMouseFocused $ clearEvents enterWindowMask
@@ -221,8 +236,8 @@
windowBracket p action = withWindowSet $ \old -> do
a <- action
when (p a) . withWindowSet $ \new -> do
- modifyWindowSet $ \_ -> old
- windows $ \_ -> new
+ modifyWindowSet $ const old
+ windows $ const new
return a
-- | Perform an @X@ action. If it returns @Any True@, unwind the
@@ -250,12 +265,11 @@
setWindowBorderWithFallback dpy w color basic = io $
C.handle fallback $ do
wa <- getWindowAttributes dpy w
- pixel <- color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
+ pixel <- setPixelSolid . 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
+ fallback _ = setWindowBorder dpy w basic
-- | Hide a window by unmapping it and setting Iconified.
hide :: Window -> X ()
@@ -342,15 +356,16 @@
-- | The screen configuration may have changed (due to -- xrandr),
-- update the state and refresh the screen, and reset the gap.
rescreen :: X ()
-rescreen = do
- xinesc <- withDisplay getCleanedScreenInfo
-
- windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
- let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
- (a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
- in ws { W.current = a
- , W.visible = as
- , W.hidden = ys }
+rescreen = withDisplay getCleanedScreenInfo >>= \case
+ [] -> trace "getCleanedScreenInfo returned []"
+ xinesc:xinescs ->
+ windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
+ let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
+ a = W.Screen (W.workspace v) 0 (SD xinesc)
+ as = zipWith3 W.Screen xs [1..] $ map SD xinescs
+ in ws { W.current = a
+ , W.visible = as
+ , W.hidden = ys }
-- ---------------------------------------------------------------------
@@ -409,7 +424,7 @@
currevt <- asks currentEvent
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
when (wmtf `elem` protocols) $
io $ allocaXEvent $ \ev -> do
@@ -417,12 +432,46 @@
setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
sendEvent dpy w False noEventMask ev
where event_time ev =
- if (ev_event_type ev) `elem` timedEvents then
+ if ev_event_type ev `elem` timedEvents then
ev_time ev
else
currentTime
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
+ ]
+
------------------------------------------------------------------------
-- Message handling
@@ -430,7 +479,7 @@
-- layout the windows, in which case changes are handled through a refresh.
sendMessage :: Message a => a -> X ()
sendMessage a = windowBracket_ $ do
- w <- W.workspace . W.current <$> gets windowset
+ w <- gets $ W.workspace . W.current . windowset
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
whenJust ml' $ \l' ->
modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
@@ -465,9 +514,9 @@
-- | Set the layout of the currently viewed workspace.
setLayout :: Layout Window -> X ()
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)
- windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
+ windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } }
------------------------------------------------------------------------
-- Utilities
@@ -504,10 +553,14 @@
nlm <- gets numberlockMask
return (complement (nlm .|. lockMask) .&. km)
+-- | Set the 'Pixel' alpha value to 255.
+setPixelSolid :: Pixel -> Pixel
+setPixelSolid p = p .|. 0xff000000
+
-- | Get the 'Pixel' value for a named color.
initColor :: Display -> String -> IO (Maybe Pixel)
initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
- (Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
+ Just . setPixelSolid . color_pixel . fst <$> allocNamedColor dpy colormap c
where colormap = defaultColormap dpy (defaultScreen dpy)
------------------------------------------------------------------------
@@ -527,7 +580,7 @@
maybeShow _ = Nothing
wsData = W.mapLayout show . windowset
- extState = catMaybes . map maybeShow . M.toList . extensibleState
+ extState = mapMaybe maybeShow . M.toList . extensibleState
path <- asks $ stateFileName . directories
stateData <- gets (\s -> StateFile (wsData s) (extState s))
@@ -590,11 +643,10 @@
catchX go $ do
-- Fallback solution if `go' fails. Which it might, since it
-- calls `getWindowAttributes'.
- sc <- W.current <$> gets windowset
+ sc <- gets $ W.current . windowset
return (W.screen sc, W.RationalRect 0 0 1 1)
- where fi x = fromIntegral x
- go = withDisplay $ \d -> do
+ where go = withDisplay $ \d -> do
ws <- gets windowset
wa <- io $ getWindowAttributes d w
let bw = (fromIntegral . wa_border_width) wa
@@ -620,6 +672,9 @@
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.
pointScreen :: Position -> Position
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
@@ -650,14 +705,20 @@
-- | Accumulate mouse motion events
mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
-mouseDrag f done = do
+mouseDrag = mouseDragCursor Nothing
+
+-- | 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
case drag of
Just _ -> return () -- error case? we're already dragging
Nothing -> do
XConf { theRoot = root, display = d } <- ask
- io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
- grabModeAsync grabModeAsync none none currentTime
+ io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph
+ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
+ grabModeAsync grabModeAsync none cursor currentTime
modify $ \s -> s { dragging = Just (motion, cleanup) }
where
cleanup = do
@@ -675,7 +736,9 @@
(_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
let ox = fromIntegral ox'
oy = fromIntegral oy'
- mouseDrag (\ex ey -> do
+ mouseDragCursor
+ (Just xC_fleur)
+ (\ex ey -> do
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
float w
@@ -688,12 +751,13 @@
wa <- io $ getWindowAttributes d w
sh <- io $ getWMNormalHints d w
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
- mouseDrag (\ex ey -> do
+ mouseDragCursor
+ (Just xC_bottom_right_corner)
+ (\ex ey -> do
io $ resizeWindow d w `uncurry`
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
ey - fromIntegral (wa_y wa))
float w)
-
(float w)
-- ---------------------------------------------------------------------
@@ -709,7 +773,7 @@
sh <- getWMNormalHints d w
wa <- C.try $ getWindowAttributes d w
case wa of
- Left err -> const (return id) (err :: C.SomeException)
+ Left (_ :: C.SomeException) -> return id
Right wa' ->
let bw = fromIntegral $ wa_border_width wa'
in return $ applySizeHints bw sh
diff --git a/src/XMonad/StackSet.hs b/src/XMonad/StackSet.hs
--- a/src/XMonad/StackSet.hs
+++ b/src/XMonad/StackSet.hs
@@ -58,6 +58,8 @@
import Data.Maybe (listToMaybe,isJust,fromMaybe)
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
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)
-- $intro
@@ -92,21 +94,20 @@
-- resulting data structure will share as much of its components with
-- the old structure as possible.
--
--- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
+--
--
-- We use the zipper to keep track of the focused workspace and the
-- focused window on each workspace, allowing us to have correct focus
-- by construction. We closely follow Huet's original implementation:
--
--- 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 Conor McBride's zipper differentiation paper.
--- Another good reference is:
+-- and
--
--- The Zipper, Haskell wikibook
+--
+--
+-- and Conor McBride's zipper differentiation paper.
+-- Another good reference is:
-- $xinerama
-- Xinerama in X11 lets us view multiple virtual workspaces
@@ -208,10 +209,11 @@
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
--
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
-new l wids m | not (null wids) && length m <= length wids && not (null m)
- = StackSet cur visi unseen M.empty
- where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
- (cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
+new l (wid:wids) (m:ms) | length ms <= length wids
+ = StackSet cur visi (map ws unseen) M.empty
+ where ws i = Workspace i l Nothing
+ (seen, unseen) = L.splitAt (length ms) wids
+ 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
new _ _ _ = abort "non-positive argument to StackSet.new"
@@ -238,7 +240,7 @@
| 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
-- workspace tags defined in 'new'
@@ -311,7 +313,7 @@
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 [] integrate
@@ -343,32 +345,44 @@
index :: StackSet i l a s sd -> [a]
index = with [] integrate
--- |
--- /O(1), O(w) on the wrapping case/.
---
--- 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,
+-- | /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
+-- @cycle@ on the current stack. The @master@ window and window order
-- are unaffected by movement of focus.
---
--- 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 :: StackSet i l a s sd -> StackSet i l a s sd
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'
+-- | /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'
+
+-- | /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)
--- | Variants of 'focusUp' and 'focusDown' that work on a
+-- | A variant of 'focusUp' with the same asymptotics that works on a
-- 'Stack' rather than an entire 'StackSet'.
-focusUp', focusDown' :: Stack a -> Stack a
+focusUp' :: Stack a -> Stack a
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
-focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
-focusDown' = reverseStack . focusUp' . reverseStack
+focusUp' (Stack t [] rs) = Stack x xs []
+ where (x :| xs) = NE.reverse (t :| rs)
+-- | 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 t (l:ls) rs) = Stack t ls (l:rs)
swapUp' (Stack t [] rs) = Stack t (reverse rs) []
@@ -522,8 +536,8 @@
-- Focus stays with the item moved.
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
swapMaster = modify' $ \c -> case c of
- Stack _ [] _ -> c -- already master.
- Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
+ Stack _ [] _ -> c -- already master.
+ Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls)
-- natural! keep focus, move current to the top, move top to current.
@@ -539,8 +553,8 @@
-- | /O(s)/. Set focus to the master window.
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
focusMaster = modify' $ \c -> case c of
- Stack _ [] _ -> c
- Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
+ Stack _ [] _ -> c
+ Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)
--
-- ---------------------------------------------------------------------
diff --git a/tests/Instances.hs b/tests/Instances.hs
--- a/tests/Instances.hs
+++ b/tests/Instances.hs
@@ -36,7 +36,7 @@
-- Pick a random window "number" in each workspace, to give focus.
focus <- sequence [ if null windows
then return Nothing
- else liftM Just $ choose (0, length windows - 1)
+ else Just <$> choose (0, length windows - 1)
| windows <- wsWindows ]
let tags = [1 .. fromIntegral numWs]
@@ -80,7 +80,7 @@
instance Arbitrary NonEmptyWindowsStackSet where
arbitrary =
- NonEmptyWindowsStackSet `fmap` (arbitrary `suchThat` (not . null . allWindows))
+ NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows))
instance Arbitrary Rectangle where
arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
@@ -99,7 +99,7 @@
deriving ( Eq, Ord, Show, Read )
instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
- arbitrary = NonEmptyNubList `fmap` ((liftM nub arbitrary) `suchThat` (not . null))
+ arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null))
@@ -116,7 +116,7 @@
arbitraryTag x = do
let ts = tags x
-- 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
-- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
@@ -136,5 +136,5 @@
arbitraryWindow (NonEmptyWindowsStackSet x) = do
let ws = allWindows x
-- 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
diff --git a/tests/Properties/Delete.hs b/tests/Properties/Delete.hs
--- a/tests/Properties/Delete.hs
+++ b/tests/Properties/Delete.hs
@@ -64,7 +64,7 @@
-- last one in the stack.
`suchThat` \(x' :: T) ->
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
let Just n = peek x
return $ peek (delete n x) == peek (focusDown x)
diff --git a/tests/Properties/Focus.hs b/tests/Properties/Focus.hs
--- a/tests/Properties/Focus.hs
+++ b/tests/Properties/Focus.hs
@@ -32,8 +32,8 @@
in index (focusWindow (s !! i) x) == index x
-- shifting focus is trivially reversible
-prop_focus_left (x :: T) = (focusUp (focusDown x)) == x
-prop_focus_right (x :: T) = (focusDown (focusUp x)) == x
+prop_focus_left (x :: T) = focusUp (focusDown x) == x
+prop_focus_right (x :: T) = focusDown (focusUp x) == x
-- focus master is idempotent
prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
@@ -47,9 +47,9 @@
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
-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)
-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)
-- prop_rotate_all (x :: T) = f (f x) == f x
diff --git a/tests/Properties/GreedyView.hs b/tests/Properties/GreedyView.hs
--- a/tests/Properties/GreedyView.hs
+++ b/tests/Properties/GreedyView.hs
@@ -35,7 +35,7 @@
-- greedyView is idempotent
prop_greedyView_idem (x :: T) = do
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
prop_greedyView_reversible (x :: T) = do
diff --git a/tests/Properties/Insert.hs b/tests/Properties/Insert.hs
--- a/tests/Properties/Insert.hs
+++ b/tests/Properties/Insert.hs
@@ -46,7 +46,7 @@
-- inserting n elements increases current stack size by n
prop_size_insert is (EmptyStackSet x) =
- size (foldr insertUp x ws ) == (length ws)
+ size (foldr insertUp x ws) == length ws
where
ws = nub is
size = length . index
diff --git a/tests/Properties/Layout/Full.hs b/tests/Properties/Layout/Full.hs
--- a/tests/Properties/Layout/Full.hs
+++ b/tests/Properties/Layout/Full.hs
@@ -29,6 +29,6 @@
-- what happens when we send an IncMaster message to Full --- Nothing
prop_sendmsg_full (NonNegative k) =
- isNothing (Full `pureMessage` (SomeMessage (IncMasterN k)))
+ isNothing (Full `pureMessage` SomeMessage (IncMasterN k))
prop_desc_full = description Full == show Full
diff --git a/tests/Properties/Layout/Tall.hs b/tests/Properties/Layout/Tall.hs
--- a/tests/Properties/Layout/Tall.hs
+++ b/tests/Properties/Layout/Tall.hs
@@ -29,12 +29,12 @@
-- splitting horizontally yields sensible results
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
&&
- all (== rect_height x) (map rect_height xs)
+ all (\s -> rect_height s == rect_height x) xs
&&
- (map rect_x xs) == (sort $ map rect_x xs)
+ map rect_x xs == sort (map rect_x xs)
where
xs = splitHorizontally n x
@@ -72,7 +72,7 @@
-- remaining fraction should shrink
where
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)
@@ -93,7 +93,7 @@
where
frac = min 1 (n1 % d1)
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)
-- what happens when we send an IncMaster message to Tall
@@ -102,7 +102,7 @@
delta == delta' && frac == frac' && n' == n + k
where
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)
diff --git a/tests/Properties/Screen.hs b/tests/Properties/Screen.hs
--- a/tests/Properties/Screen.hs
+++ b/tests/Properties/Screen.hs
@@ -53,8 +53,8 @@
-- the desired range
prop_aspect_fits =
forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
- let f v = applyAspectHint ((x, y+a), (x+b, y)) v
- in and [ noOverflows (*) x (y+a), noOverflows (*) (x+b) y ]
+ let f = applyAspectHint ((x, y+a), (x+b, y))
+ in noOverflows (*) x (y+a) && noOverflows (*) (x+b) y
==> f (x,y) == (x,y)
where pos = choose (0, 65535)
diff --git a/tests/Properties/Shift.hs b/tests/Properties/Shift.hs
--- a/tests/Properties/Shift.hs
+++ b/tests/Properties/Shift.hs
@@ -27,7 +27,7 @@
-- shiftMaster
-- 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_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
-- ordering is constant modulo the focused window:
@@ -57,14 +57,14 @@
x <- arbitrary `suchThat` \(x' :: T) ->
-- Invariant, otherWindows are NOT in the current workspace.
let otherWindows = allWindows x' L.\\ index x'
- in length(tags x') >= 2 && length(otherWindows) >= 1
+ in length (tags x') >= 2 && not (null otherWindows)
-- Sadly we have to construct `otherWindows` again, for the actual StackSet
-- that got chosen.
let otherWindows = allWindows x L.\\ index x
-- We know such tag must exists, due to the precondition
n <- arbitraryTag x `suchThat` (/= currentTag x)
-- we know length is >= 1, from above precondition
- idx <- choose(0, length(otherWindows) - 1)
+ idx <- choose (0, length otherWindows - 1)
let w = otherWindows !! idx
- return $ (current $ x) == (current $ shiftWin n w x)
+ return $ current x == current (shiftWin n w x)
diff --git a/tests/Properties/Stack.hs b/tests/Properties/Stack.hs
--- a/tests/Properties/Stack.hs
+++ b/tests/Properties/Stack.hs
@@ -1,6 +1,10 @@
{-# LANGUAGE CPP #-}
-{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
+
+#ifdef VERSION_quickcheck_classes
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+#endif
+
module Properties.Stack where
import Test.QuickCheck
@@ -24,7 +28,7 @@
-- windows kept in the zipper
prop_index_length (x :: T) =
case stack . workspace . current $ x of
- Nothing -> length (index x) == 0
+ Nothing -> null (index x)
Just it -> length (index x) == length (focus it : up it ++ down it)
@@ -43,7 +47,7 @@
-- which is a key component in this test (together with member).
let ws = allWindows x
-- 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
@@ -56,8 +60,8 @@
-- 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.
prop_differentiate xs =
- if null xs then differentiate xs == Nothing
- else (differentiate xs) == Just (Stack (head xs) [] (tail xs))
+ if null xs then isNothing (differentiate xs)
+ else differentiate xs == Just (Stack (head xs) [] (tail xs))
where _ = xs :: [Int]
diff --git a/tests/Properties/StackSet.hs b/tests/Properties/StackSet.hs
--- a/tests/Properties/StackSet.hs
+++ b/tests/Properties/StackSet.hs
@@ -58,7 +58,7 @@
-- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
monotonic [] = True
-monotonic (x:[]) = True
+monotonic [x] = True
monotonic (x:y:zs) | x == y-1 = monotonic (y:zs)
| otherwise = False
@@ -126,7 +126,7 @@
prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
-- no windows will be a member of an empty workspace
-prop_member_empty i (EmptyStackSet x) = member i x == False
+prop_member_empty i (EmptyStackSet x) = not (member i x)
-- peek either yields nothing on the Empty workspace, or Just a valid window
prop_member_peek (x :: T) =
diff --git a/tests/Properties/Swap.hs b/tests/Properties/Swap.hs
--- a/tests/Properties/Swap.hs
+++ b/tests/Properties/Swap.hs
@@ -11,8 +11,8 @@
-- swapUp, swapDown, swapMaster: reordiring windows
-- swap is trivially reversible
-prop_swap_left (x :: T) = (swapUp (swapDown x)) == x
-prop_swap_right (x :: T) = (swapDown (swapUp x)) == x
+prop_swap_left (x :: T) = swapUp (swapDown x) == x
+prop_swap_right (x :: T) = swapDown (swapUp x) == x
-- TODO swap is reversible
-- swap is reversible, but involves moving focus back the window with
-- master on it. easy to do with a mouse...
@@ -26,12 +26,12 @@
-}
-- 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
-- Nothing -> True
-- Just f -> focus (stack (workspace $ current (swap x))) == f
-prop_swap_left_focus (x :: T) = peek x == (peek $ swapUp x)
-prop_swap_right_focus (x :: T) = peek x == (peek $ swapDown x)
+prop_swap_left_focus (x :: T) = peek x == peek (swapUp x)
+prop_swap_right_focus (x :: T) = peek x == peek (swapDown x)
-- swap is local
prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
@@ -39,9 +39,9 @@
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
-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)
-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)
prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
diff --git a/tests/Properties/View.hs b/tests/Properties/View.hs
--- a/tests/Properties/View.hs
+++ b/tests/Properties/View.hs
@@ -37,7 +37,7 @@
-- view is idempotent
prop_view_idem (x :: T) = do
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
prop_view_reversible (x :: T) = do
diff --git a/tests/Utils.hs b/tests/Utils.hs
--- a/tests/Utils.hs
+++ b/tests/Utils.hs
@@ -12,8 +12,8 @@
-- normalise workspace list
normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
where
- f = \a b -> tag (workspace a) `compare` tag (workspace b)
- g = \a b -> tag a `compare` tag b
+ f a b = tag (workspace a) `compare` tag (workspace b)
+ g a b = tag a `compare` tag b
noOverlaps [] = True
diff --git a/xmonad.cabal b/xmonad.cabal
--- a/xmonad.cabal
+++ b/xmonad.cabal
@@ -1,5 +1,5 @@
name: xmonad
-version: 0.17.0
+version: 0.17.1
synopsis: A tiling window manager
description: xmonad is a tiling window manager for X. Windows are arranged
automatically to tile the screen without gaps or overlap, maximising
@@ -25,9 +25,9 @@
Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey,
Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout,
Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
- Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion
+ Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman
maintainer: xmonad@haskell.org
-tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.4 || == 9.0.1
+tested-with: GHC == 8.4.4 || == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.2
category: System
homepage: http://xmonad.org
bug-reports: https://github.com/xmonad/xmonad/issues