xmonad 0.17.0 → 0.17.1
raw patch · 29 files changed
+436/−387 lines, 29 files
Files
- CHANGES.md +23/−0
- CONTRIBUTING.md +19/−81
- INSTALL.md +26/−3
- MAINTAINERS.md +28/−20
- README.md +12/−27
- TUTORIAL.md +43/−42
- man/xmonad.hs +7/−7
- src/XMonad/Config.hs +1/−1
- src/XMonad/Core.hs +27/−25
- src/XMonad/Layout.hs +6/−4
- src/XMonad/Main.hs +28/−46
- src/XMonad/ManageHook.hs +12/−9
- src/XMonad/Operations.hs +107/−43
- src/XMonad/StackSet.hs +48/−34
- tests/Instances.hs +5/−5
- tests/Properties/Delete.hs +1/−1
- tests/Properties/Focus.hs +4/−4
- tests/Properties/GreedyView.hs +1/−1
- tests/Properties/Insert.hs +1/−1
- tests/Properties/Layout/Full.hs +1/−1
- tests/Properties/Layout/Tall.hs +6/−6
- tests/Properties/Screen.hs +2/−2
- tests/Properties/Shift.hs +4/−4
- tests/Properties/Stack.hs +9/−5
- tests/Properties/StackSet.hs +2/−2
- tests/Properties/Swap.hs +7/−7
- tests/Properties/View.hs +1/−1
- tests/Utils.hs +2/−2
- xmonad.cabal +3/−3
CHANGES.md view
@@ -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
CONTRIBUTING.md view
@@ -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
INSTALL.md view
@@ -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
MAINTAINERS.md view
@@ -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
README.md view
@@ -1,35 +1,20 @@ <p align="center">- <a href="https://xmonad.org/">- <img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150>- </a>+ <a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a> </p> <p align="center">- <a href="https://hackage.haskell.org/package/xmonad">- <img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell">- </a>- <a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE">- <img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad">- </a>- <a href="https://haskell.org/">- <img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell">- </a>+ <a href="https://hackage.haskell.org/package/xmonad"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell"></a>+ <a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad"></a>+ <a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a> <br>- <a href="https://github.com/xmonad/xmonad/actions/workflows/stack.yml">- <img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Stack?label=Stack&logo=githubactions&logoColor=white">- </a>- <a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml">- <img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white">- </a>- <a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml">- <img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Nix?label=Nix&logo=githubactions&logoColor=white">- </a>+ <a href="https://github.com/xmonad/xmonad/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Stack?label=Stack&logo=githubactions&logoColor=white"></a>+ <a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Haskell-CI?label=Cabal&logo=githubactions&logoColor=white"></a>+ <a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/workflow/status/xmonad/xmonad/Nix?label=Nix&logo=githubactions&logoColor=white"></a> <br>- <a href="https://github.com/sponsors/xmonad">- <img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors">- </a>- <a href="https://opencollective.com/xmonad">- <img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective">- </a>+ <a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>+ <a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>+ <br>+ <a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>+ <a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a> </p> # xmonad
TUTORIAL.md view
@@ -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
man/xmonad.hs view
@@ -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) ]
src/XMonad/Config.hs view
@@ -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)
src/XMonad/Core.hs view
@@ -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)
src/XMonad/Layout.hs view
@@ -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) =
src/XMonad/Main.hs view
@@ -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 ()
src/XMonad/ManageHook.hs view
@@ -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)
src/XMonad/Operations.hs view
@@ -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
src/XMonad/StackSet.hs view
@@ -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"+-- <https://mail.haskell.org/pipermail/haskell/2005-April/015769.html 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/.+-- <https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf G. Huet, Functional Pearl: The Zipper; 1997, J. Functional Programming 75(5):549–554> ----- and Conor McBride's zipper differentiation paper.--- Another good reference is:+-- and ----- The Zipper, Haskell wikibook+-- <https://dspace.library.uu.nl/handle/1874/2532 R. Hinze and J. Jeuring, Functional Pearl: Weaving a Web>+--+-- and Conor McBride's zipper differentiation paper.+-- Another good reference is: <https://wiki.haskell.org/Zipper The Zipper, Haskell wikibook> -- $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) -- -- ---------------------------------------------------------------------
tests/Instances.hs view
@@ -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
tests/Properties/Delete.hs view
@@ -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)
tests/Properties/Focus.hs view
@@ -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
tests/Properties/GreedyView.hs view
@@ -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
tests/Properties/Insert.hs view
@@ -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
tests/Properties/Layout/Full.hs view
@@ -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
tests/Properties/Layout/Tall.hs view
@@ -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)
tests/Properties/Screen.hs view
@@ -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)
tests/Properties/Shift.hs view
@@ -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)
tests/Properties/Stack.hs view
@@ -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]
tests/Properties/StackSet.hs view
@@ -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) =
tests/Properties/Swap.hs view
@@ -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
tests/Properties/View.hs view
@@ -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
tests/Utils.hs view
@@ -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
xmonad.cabal view
@@ -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