mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-11 18:22:16 -07:00
Compare commits
438 Commits
v0.10
...
feature/fi
Author | SHA1 | Date | |
---|---|---|---|
|
1833003404 | ||
|
be036f9bb9 | ||
|
217abc39a2 | ||
|
5790913eae | ||
|
d21ed81801 | ||
|
cc44be649d | ||
|
a7059e1a32 | ||
|
7ada94df42 | ||
|
c0a0a44fbc | ||
|
ca5fbc155b | ||
|
856b125186 | ||
|
c51bd739d7 | ||
|
0e1cecd135 | ||
|
ec5f9a9e59 | ||
|
65bbe1a995 | ||
|
7b8798cb30 | ||
|
0a74e3479e | ||
|
8e061c0c6d | ||
|
49fecdf4eb | ||
|
993dedf6d3 | ||
|
fcb57bd657 | ||
|
05d7493888 | ||
|
4983ecfd23 | ||
|
ae7fd21e29 | ||
|
6cb10c9300 | ||
|
e98fedfaa5 | ||
|
dcc2759c4d | ||
|
b871a0c7ee | ||
|
c71f72ff66 | ||
|
e5ca066057 | ||
|
444986d993 | ||
|
1553d81ce7 | ||
|
082c64ec37 | ||
|
01ddbb7b82 | ||
|
feec53c78c | ||
|
e4e120bb8e | ||
|
858a906240 | ||
|
1b81ac7314 | ||
|
262e78770f | ||
|
1c8e17e127 | ||
|
f3de3e2719 | ||
|
464a99b842 | ||
|
f6ded1a4d7 | ||
|
3b4a3d2bd2 | ||
|
753e9ce4b0 | ||
|
bf1f4fcc76 | ||
|
305c8eff0d | ||
|
52b180e6b2 | ||
|
c2331f9657 | ||
|
953f1576f4 | ||
|
7629f774c6 | ||
|
a1adb0b801 | ||
|
c3081bd783 | ||
|
e38fb3bdb8 | ||
|
c48d81e378 | ||
|
94c7cb513c | ||
|
61038f95fb | ||
|
4358f58de8 | ||
|
899ff52316 | ||
|
ea6e1a5d6d | ||
|
4aaf053273 | ||
|
2e53a6cdd6 | ||
|
76565e42c4 | ||
|
a7d5696e5a | ||
|
b9215181bb | ||
|
806a501d51 | ||
|
529683660c | ||
|
15a2a86d46 | ||
|
25df357a4a | ||
|
c2e0fc517c | ||
|
1087844a7f | ||
|
8bfbafeae9 | ||
|
7e777bebfd | ||
|
8d2582f032 | ||
|
81f1eab1ee | ||
|
4e880b37a2 | ||
|
637c5c67b1 | ||
|
8fd8c5d02d | ||
|
d414c76da8 | ||
|
ddcc9e0209 | ||
|
e280f62a57 | ||
|
a8ca8bcd6f | ||
|
f3dc89f821 | ||
|
6a9e9e5a78 | ||
|
1d5cdc108a | ||
|
d6243c9564 | ||
|
c2c6a94834 | ||
|
6aa289c713 | ||
|
cc77b5019d | ||
|
a421da29e6 | ||
|
2831378f8f | ||
|
34f9dda006 | ||
|
e698e5fe53 | ||
|
fce36bda16 | ||
|
73134369ea | ||
|
26b50c043c | ||
|
ed4909aa65 | ||
|
f12167b298 | ||
|
00c6a44bdc | ||
|
b41544b6cc | ||
|
da44e76f75 | ||
|
75b3cae49f | ||
|
72956159b6 | ||
|
9a187f243c | ||
|
e0211ad7d6 | ||
|
c08d48f6aa | ||
|
81dd1cba1d | ||
|
abe911a8d6 | ||
|
1452c9e273 | ||
|
44abb6c8d4 | ||
|
43fccf1a6c | ||
|
f429843b66 | ||
|
dd5a36cc08 | ||
|
01ea659a06 | ||
|
f1d3118417 | ||
|
ceb2df8931 | ||
|
99cc0b6c85 | ||
|
9c95c81a90 | ||
|
15c645d9f2 | ||
|
94a7e97ac8 | ||
|
c736d52268 | ||
|
c27ef4d418 | ||
|
571193a219 | ||
|
bbbdad8faa | ||
|
311d3a0582 | ||
|
b14db06f65 | ||
|
30f657a437 | ||
|
a6f286dbdc | ||
|
3796569268 | ||
|
d5eb7316d1 | ||
|
baf1dd9251 | ||
|
5e96324d80 | ||
|
5df7ba160e | ||
|
431fd66527 | ||
|
f79e3fadea | ||
|
28e9f8bce7 | ||
|
f73eb1c938 | ||
|
83ee18ad94 | ||
|
f4d4bde026 | ||
|
f1b9a0c193 | ||
|
34beb76562 | ||
|
028ad6d6ec | ||
|
a5e87e3894 | ||
|
2855ed3d70 | ||
|
68cfa84b91 | ||
|
b20e7fa1e4 | ||
|
58c3062910 | ||
|
889cd97d08 | ||
|
4a9e28ca8b | ||
|
604a262f38 | ||
|
0510da7659 | ||
|
93b2620ad3 | ||
|
727e214195 | ||
|
9a7a63bfb4 | ||
|
a61ce8dd74 | ||
|
d638dc8b0a | ||
|
bce9c551ef | ||
|
26309d1622 | ||
|
d81b4e5bcb | ||
|
6043914841 | ||
|
ed7be9a791 | ||
|
becb724f95 | ||
|
0447c76d48 | ||
|
e47794148c | ||
|
edd6b8be55 | ||
|
ddcf5abcbf | ||
|
e19460677a | ||
|
b23f56d65d | ||
|
c3b05ceb7f | ||
|
9f68077c6c | ||
|
723494f01e | ||
|
ae6b8db29b | ||
|
1ce26e8cd2 | ||
|
cc7ddcfa60 | ||
|
02ddfebf05 | ||
|
800ae670e2 | ||
|
093352f6c5 | ||
|
fa3e774a65 | ||
|
126ce6f3c9 | ||
|
c98f2b16db | ||
|
0d6c2b1668 | ||
|
5739da65b3 | ||
|
4d3f633c73 | ||
|
6177841488 | ||
|
d81c48d022 | ||
|
b9b4f4af07 | ||
|
8e532562e7 | ||
|
e521d6546f | ||
|
dfeed762d4 | ||
|
0d4439b7a7 | ||
|
09f3c3fbea | ||
|
6ae90737de | ||
|
1c61f3cf05 | ||
|
dfb1c52c66 | ||
|
f35083da9f | ||
|
dc5fbfecc4 | ||
|
8cc31b5c76 | ||
|
ea8e0ea7b6 | ||
|
62dac9ccd2 | ||
|
60922e0cae | ||
|
9eb55c76ea | ||
|
08c88abfb2 | ||
|
b1360f08d0 | ||
|
3b9c6d6ff2 | ||
|
6f0a9785d6 | ||
|
dbfd81b3f9 | ||
|
e6350c91b8 | ||
|
32f3fbdb2f | ||
|
62e40287a6 | ||
|
0a7ae19f90 | ||
|
42a69bfa98 | ||
|
05f3eb17f5 | ||
|
d26da8e63a | ||
|
c1db249147 | ||
|
bbf36809e9 | ||
|
c4b3895af6 | ||
|
e41d7135a9 | ||
|
f7f87c03cb | ||
|
0d061462c7 | ||
|
08beff45b9 | ||
|
d3ffb1661a | ||
|
33c0e81a4a | ||
|
b5b8558acc | ||
|
c2f00b8e61 | ||
|
a0cd3f92e5 | ||
|
e2e63440ee | ||
|
cf5739a484 | ||
|
37f47d0bcb | ||
|
00187576db | ||
|
466f184c65 | ||
|
c8c5d28a9c | ||
|
3405d561b8 | ||
|
b2531a6f48 | ||
|
16db912751 | ||
|
2f5e49919d | ||
|
2e1474f230 | ||
|
e98f0657bb | ||
|
45e4bd4ff6 | ||
|
8ba4e0bed2 | ||
|
88fd1dd4fb | ||
|
9bb1f3b91e | ||
|
dcbff492fe | ||
|
d82bfc6baf | ||
|
e4fde08a0a | ||
|
0857f71938 | ||
|
80348bb4b7 | ||
|
c1abaa0183 | ||
|
20e69af48b | ||
|
6cbddae8c2 | ||
|
19860e2fa0 | ||
|
c115650d0d | ||
|
5816a473dd | ||
|
0903f339b6 | ||
|
201c25e7a4 | ||
|
3b6d0c2458 | ||
|
7dac12829d | ||
|
6d33617e1c | ||
|
8a195a2a48 | ||
|
6c410a8a00 | ||
|
95365822da | ||
|
d0039a2f8b | ||
|
c648a3959b | ||
|
0f21017370 | ||
|
6c96f4d5c6 | ||
|
27f4d5dafe | ||
|
b2a885fe5a | ||
|
12ec2d0be4 | ||
|
74c3f059b0 | ||
|
cbcd42dc83 | ||
|
c5290be3c8 | ||
|
972ee2c19f | ||
|
babbd208a6 | ||
|
4ef0beab55 | ||
|
c073651cc2 | ||
|
4efaa673fe | ||
|
9f453fdb58 | ||
|
6137b1e2ff | ||
|
7d4a083906 | ||
|
56c6b9fef5 | ||
|
ec0fb3ba8a | ||
|
11265ad69b | ||
|
8ff856a761 | ||
|
1173c6c54f | ||
|
eca9d7318e | ||
|
72a537cf46 | ||
|
2f44f16fac | ||
|
2b7add99aa | ||
|
c9b63a8f40 | ||
|
fb7ca05a63 | ||
|
fcf0545475 | ||
|
ec56f2c47c | ||
|
25b9a25925 | ||
|
6a2ad3f1ee | ||
|
e2ff50687e | ||
|
fb3b9f59e4 | ||
|
ca9961c1ca | ||
|
0f6bed2ff7 | ||
|
c1b8674aa0 | ||
|
d88153d3be | ||
|
6b46603147 | ||
|
9403542db0 | ||
|
35ed0601f4 | ||
|
df824edf5f | ||
|
78ed2e1a9e | ||
|
f453a9a375 | ||
|
c6b91b546e | ||
|
7ccac6a9a0 | ||
|
f10a18670a | ||
|
ab3f5b3d5d | ||
|
075b7d69ed | ||
|
95372520bb | ||
|
0906634f3a | ||
|
fd23bd692b | ||
|
2fe30c6730 | ||
|
8f712f0a04 | ||
|
1a916d1c57 | ||
|
7246defb90 | ||
|
d3b2a01e3d | ||
|
129e98773e | ||
|
7958f8905e | ||
|
646090a3d9 | ||
|
0f1b6fb772 | ||
|
daa2731d3d | ||
|
0287b2861c | ||
|
e8259ebd43 | ||
|
12b91b9630 | ||
|
546b582a3d | ||
|
91a5d13005 | ||
|
31ec8cc26a | ||
|
0fcb4ae238 | ||
|
3722f48da9 | ||
|
00be056a1b | ||
|
eae925fc29 | ||
|
faa61bbbab | ||
|
ac8aefbc92 | ||
|
469ff726a4 | ||
|
e11d97137e | ||
|
a56a135313 | ||
|
faf0997881 | ||
|
7dda5f976f | ||
|
493db20cf0 | ||
|
5c04a573db | ||
|
8bfe148416 | ||
|
945714f250 | ||
|
10ee484a59 | ||
|
7e9c986217 | ||
|
0aeef31c5d | ||
|
34800741e5 | ||
|
a45d8d38a6 | ||
|
c0b0d52678 | ||
|
a33f355232 | ||
|
ced8f5e0f0 | ||
|
498a50d109 | ||
|
5d93450b5e | ||
|
9b6ed4c505 | ||
|
d83442b8eb | ||
|
78d44079c2 | ||
|
6072d9c599 | ||
|
277412af44 | ||
|
0030802e46 | ||
|
f211874340 | ||
|
32548e056f | ||
|
2c6f1c22b2 | ||
|
b8a22c4dee | ||
|
42443e3df2 | ||
|
9e0eb7f770 | ||
|
895c47fb4e | ||
|
cc98355700 | ||
|
205e7133ac | ||
|
9caedf2fff | ||
|
265df96ab8 | ||
|
8d1ad8b280 | ||
|
de84dfef0d | ||
|
3fa51ed656 | ||
|
a9911d2168 | ||
|
1716ffd9d0 | ||
|
e776260133 | ||
|
53c2e7833c | ||
|
fbb9eb36f9 | ||
|
4da5da430e | ||
|
0af63a4767 | ||
|
7245766c6d | ||
|
cd6feb81e2 | ||
|
8f9fa05c0f | ||
|
b5f9a61dbe | ||
|
96ab91fcfa | ||
|
3c74148a2f | ||
|
9d34e848d9 | ||
|
a7c2c023fb | ||
|
814fda056b | ||
|
2a6709ff5c | ||
|
3ffc956b93 | ||
|
e705eba1e0 | ||
|
2f2a217b85 | ||
|
6f996bb21f | ||
|
3a740c4d5a | ||
|
f09a61f5f5 | ||
|
1a735f04e3 | ||
|
d2739b1683 | ||
|
9ecc76e087 | ||
|
7b21732ead | ||
|
c691988bbf | ||
|
40d8c01894 | ||
|
328293a0a8 | ||
|
434aec1038 | ||
|
69d2e0a873 | ||
|
9454dd5d7f | ||
|
60713064e7 | ||
|
98b0e8e4c1 | ||
|
d2a076b1e7 | ||
|
e2bb57bd63 | ||
|
d5e7d6217f | ||
|
4feb4fb058 | ||
|
3f39d34994 | ||
|
7789f18ce9 | ||
|
807d356743 | ||
|
c012b3408d | ||
|
f6a050e5a3 | ||
|
92e8f5ebef | ||
|
dd591587f6 | ||
|
219b4dd8fb | ||
|
b944b1129c | ||
|
08d432bde6 | ||
|
04d6cbc5f0 | ||
|
9cafb7c2af | ||
|
272c333f75 | ||
|
aa96dd6e03 | ||
|
59bfe97f63 | ||
|
64efea4d0a | ||
|
a1a578010c | ||
|
9209e96234 | ||
|
c809ae6f5f | ||
|
9b369949ff | ||
|
9e69773d98 | ||
|
2f0ac73313 | ||
|
95290ed278 | ||
|
a551d1367c | ||
|
cb795c8c75 |
25
.gitignore
vendored
Normal file
25
.gitignore
vendored
Normal file
@@ -0,0 +1,25 @@
|
||||
.cabal-sandbox/
|
||||
cabal.sandbox.config
|
||||
.hpc/
|
||||
*.hi
|
||||
*.o
|
||||
*.p_hi
|
||||
*.prof
|
||||
*.tix
|
||||
cabal.config
|
||||
dist
|
||||
dist-*
|
||||
|
||||
# editor temp files
|
||||
|
||||
*#
|
||||
.#*
|
||||
*~
|
||||
.*.swp
|
||||
|
||||
# TAGS files
|
||||
TAGS
|
||||
tags
|
||||
|
||||
# stack artifacts
|
||||
/.stack-work/
|
102
.mailmap
Normal file
102
.mailmap
Normal file
@@ -0,0 +1,102 @@
|
||||
Alejandro Serrano Mena <trupill@gmail.com>
|
||||
Alexandre Buisse <buisse@cs.chalmers.se>
|
||||
Anders Engstrom <ankaan@gmail.com>
|
||||
Antoine R. Dumont <eniotna.t@gmail.com>
|
||||
Anton Pirogov <anton.pirogov@gmail.com>
|
||||
Anton Pirogov <anton.pirogov@gmail.com> anton.pirogov at gmail . com <unknown>
|
||||
Arjun Comar <nrujac@gmail.com>
|
||||
Audun Skaugen <audun@skaugen.name> <audunskaugen@gmail.com>
|
||||
Bas van Dijk <v.dijk.bas@gmail.com>
|
||||
Ben Boeckel <mathstuf@gmail.com>
|
||||
Ben Weitzman <benweitzman@gmail.com>
|
||||
Bogdan Sinitsyn <bogdan.sinitsyn@gmail.com>
|
||||
Brandon S Allbery KF8NH <allbery.b@gmail.com>
|
||||
Brandon S Allbery KF8NH <allbery.b@gmail.com> <allbery@ece.cmu.edu>
|
||||
Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
|
||||
Carlos Lopez-Camey <c.lopez@kmels.net>
|
||||
Carsten Otto <xmonad@c-otto.de>
|
||||
Christian Dietrich <stettberger@dokucode.de>
|
||||
Christian Wills <cwills.dev@gmail.com>
|
||||
Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
|
||||
Daniel Schoepe <daniel.schoepe@googlemail.com> <asgaroth_@gmx.de>
|
||||
Daniel Schoepe <daniel.schoepe@googlemail.com> <daniel.schoepe@gmail.com>
|
||||
Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
|
||||
Dave Harrison <dave@nullcube.com>
|
||||
David Glasser <glasser@mit.edu>
|
||||
David McLean <gopsychonauts@gmail.com>
|
||||
Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
|
||||
Dominik Bruhn <dominik@dbruhn.de>
|
||||
Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
|
||||
Don Stewart <dons00@gmail.com> <dons@galois.com>
|
||||
Edward Z. Yang <ezyang@cs.stanford.edu>
|
||||
Gwern Branwen <gwern@gwern.net>
|
||||
Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
|
||||
Henrique Abreu <hgabreu@gmail.com>
|
||||
Ilya Portnov <portnov84@rambler.ru>
|
||||
intrigeri <intrigeri@boum.org>
|
||||
Ivan Miljenovic <Ivan.Miljenovic@gmail.com>
|
||||
Jan-David Quesel <quesel@informatik.uni-oldenburg.de>
|
||||
Jens Petersen <juhp@community.haskell.org> <petersen@haskell.org>
|
||||
Jeremy Apthorp <nornagon@gmail.com>
|
||||
Joachim Breitner <mail@joachim-breitner.de>
|
||||
Joachim Fasting <joachim.fasting@gmail.com>
|
||||
Joel Suovaniemi <joel.suovaniemi@iki.fi>
|
||||
Joe Thornber <joe.thornber@gmail.com>
|
||||
Johann Giwer <johanngiwer@web.de>
|
||||
Jussi Maki <joamaki@gmail.com>
|
||||
Konstantin Sobolev <konstantin.sobolev@gmail.com>
|
||||
Lanny Ripple <lan3ny@gmail.com>
|
||||
Lei Chen <linxray@gmail.com>
|
||||
Leonardo Serra <leoserra@minaslivre.org>
|
||||
Luis Cabellos <zhen.sydow@gmail.com>
|
||||
Lukas Mai <l.mai@web.de>
|
||||
Mario Pastorelli <pastorelli.mario@gmail.com>
|
||||
Mathias Stearn <redbeard0531@gmail.com>
|
||||
Matt Brown <deadguysfrom@gmail.com>
|
||||
Matthew Hague <matthewhague@zoho.com>
|
||||
Nathaniel Filardo <nwfilardo@gmail.com>
|
||||
Nelson Elhage <nelhage@mit.edu>
|
||||
Nicolas Dudebout <nicolas.dudebout@gatech.edu>
|
||||
Nicolas Pouillard <nicolas.pouillard@gmail.com>
|
||||
Nils Schweinsberg <mail@n-sch.de>
|
||||
Norbert Zeh <nzeh@cs.dal.ca>
|
||||
Peter Olson <polson2@hawk.iit.edu>
|
||||
Quentin Moser <moserq@gmail.com>
|
||||
Quentin Moser <quentin.moser@unifr.ch>
|
||||
Rickard Gustafsson <acura@allyourbase.se>
|
||||
Robert Marlow <bobstopper@bobturf.org>
|
||||
Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
|
||||
Rohan Jain <crodjer@gmail.com>
|
||||
Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
|
||||
Sean Escriva <sean.escriva@gmail.com>
|
||||
Sean McEligot <seanmce33@gmail.com>
|
||||
Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
|
||||
Tomohiro Matsuyama <matsuyama3@ariel-networks.com>
|
||||
Tom Rauchenwald <its.sec@gmx.net>
|
||||
Tony Morris <haskell@tmorris.net>
|
||||
Valery V. Vorotyntsev <valery.vv@gmail.com>
|
||||
Will Farrington <wcfarrington@gmail.com>
|
||||
Wirt Wolff <wirtwolff@gmail.com>
|
||||
Yaakov Nemoy <loupgaroublond@gmail.com>
|
||||
|
||||
brian <brian@lorf.org>
|
||||
cardboard42 <cardboard42@gmail.com>
|
||||
daedalusinfinity <daedalusinfinity@gmail.com>
|
||||
hexago.nl <xmonad-contrib@hexago.nl>
|
||||
intrigeri <intrigeri@boum.org>
|
||||
jakob <jakob@pipefour.org>
|
||||
kedals0 <kedals0@gmail.com>
|
||||
lithis <xmonad@selg.hethrael.org>
|
||||
lithis <xmonad@selg.hethrael.org> <xmonad@s001.hethrael.com>
|
||||
longpoke <longpoke@gmail.com>
|
||||
md143rbh7f <md143rbh7f@gmail.com>
|
||||
perlkat <perlkat@katspace.org>
|
||||
rupa <rupa@lrrr.us> <rupa@lrrr.us>
|
||||
timthelion <tim.thelion@gmail.com>
|
||||
|
||||
# for core only
|
||||
Neil Mitchell <http://www.cs.york.ac.uk/~ndm/>, Neil Mitchell
|
||||
Nick Burlett <nickburlett@mac.com>
|
||||
Sam Hughes <hughes@rpi.edu>
|
||||
Shae Erisson <shae@ScannedInAvian.com>
|
||||
Conrad Irwin <conrad.irwin@gmail.com>
|
91
.travis.yml
Normal file
91
.travis.yml
Normal file
@@ -0,0 +1,91 @@
|
||||
# This file has been generated -- see https://github.com/hvr/multi-ghc-travis
|
||||
language: c
|
||||
sudo: false
|
||||
|
||||
cache:
|
||||
directories:
|
||||
- $HOME/.cabsnap
|
||||
- $HOME/.cabal/packages
|
||||
|
||||
before_cache:
|
||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log
|
||||
- rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar
|
||||
|
||||
matrix:
|
||||
include:
|
||||
- env: CABALVER=1.16 GHCVER=7.4.2
|
||||
compiler: ": #GHC 7.4.2"
|
||||
addons: {apt: {packages: [cabal-install-1.16,ghc-7.4.2], sources: [hvr-ghc]}}
|
||||
- env: CABALVER=1.16 GHCVER=7.6.3
|
||||
compiler: ": #GHC 7.6.3"
|
||||
addons: {apt: {packages: [cabal-install-1.16,ghc-7.6.3], sources: [hvr-ghc]}}
|
||||
- env: CABALVER=1.18 GHCVER=7.8.4
|
||||
compiler: ": #GHC 7.8.4"
|
||||
addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4], sources: [hvr-ghc]}}
|
||||
- env: CABALVER=1.22 GHCVER=7.10.2
|
||||
compiler: ": #GHC 7.10.2"
|
||||
addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.2], sources: [hvr-ghc]}}
|
||||
|
||||
before_install:
|
||||
- unset CC
|
||||
- export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH
|
||||
|
||||
install:
|
||||
# build xmonad from HEAD
|
||||
- git clone https://github.com/xmonad/xmonad.git
|
||||
|
||||
- cabal --version
|
||||
- echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]"
|
||||
- if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ];
|
||||
then
|
||||
zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz >
|
||||
$HOME/.cabal/packages/hackage.haskell.org/00-index.tar;
|
||||
fi
|
||||
- travis_retry cabal update -v
|
||||
- sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config
|
||||
- cabal install --only-dependencies --enable-tests --enable-benchmarks --dry -v > installplan.txt
|
||||
- sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt
|
||||
|
||||
# check whether current requested install-plan matches cached package-db snapshot
|
||||
- if diff -u installplan.txt $HOME/.cabsnap/installplan.txt;
|
||||
then
|
||||
echo "cabal build-cache HIT";
|
||||
rm -rfv .ghc;
|
||||
cp -a $HOME/.cabsnap/ghc $HOME/.ghc;
|
||||
cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/;
|
||||
else
|
||||
echo "cabal build-cache MISS";
|
||||
rm -rf $HOME/.cabsnap;
|
||||
mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin;
|
||||
cabal install --only-dependencies --enable-tests --enable-benchmarks;
|
||||
fi
|
||||
|
||||
# snapshot package-db on cache miss
|
||||
- if [ ! -d $HOME/.cabsnap ];
|
||||
then
|
||||
echo "snapshotting package-db to build-cache";
|
||||
mkdir $HOME/.cabsnap;
|
||||
cp -a $HOME/.ghc $HOME/.cabsnap/ghc;
|
||||
cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/;
|
||||
fi
|
||||
|
||||
- cabal install xmonad/
|
||||
|
||||
# Here starts the actual work to be performed for the package under test;
|
||||
# any command which exits with a non-zero exit code causes the build to fail.
|
||||
script:
|
||||
- if [ -f configure.ac ]; then autoreconf -i; fi
|
||||
- cabal configure --enable-tests --enable-benchmarks -v2 # -v2 provides useful information for debugging
|
||||
- cabal build # this builds all libraries and executables (including tests/benchmarks)
|
||||
- cabal test
|
||||
# - cabal check # complains about -Werror even though it is
|
||||
# hidden behind a manual flag with default false
|
||||
- cabal sdist # tests that a source-distribution can be generated
|
||||
|
||||
# Check that the resulting source distribution can be built & installed.
|
||||
# If there are no other `.tar.gz` files in `dist`, this can be even simpler:
|
||||
# `cabal install --force-reinstalls dist/*-*.tar.gz`
|
||||
- SRC_TGZ=$(cabal info . | awk '{print $2;exit}').tar.gz &&
|
||||
(cd dist && cabal install --force-reinstalls "$SRC_TGZ")
|
||||
|
||||
# EOF
|
269
CHANGES.md
Normal file
269
CHANGES.md
Normal file
@@ -0,0 +1,269 @@
|
||||
# Change Log / Release Notes
|
||||
|
||||
## 0.13
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* The type of `completionKey` (of `XPConfig` record) has been
|
||||
changed from `KeySym` to `(KeyMask, KeySym)`. The default value
|
||||
for this is still binded to `Tab` key.
|
||||
|
||||
* New constructor `CenteredAt Rational Rational` added for
|
||||
`XMonad.Prompt.XPPosition`.
|
||||
|
||||
### New Modules
|
||||
|
||||
* `XMonad.Layout.SortedLayout`
|
||||
|
||||
A new LayoutModifier that sorts a given layout by a list of
|
||||
properties. The order of properties in the list determines
|
||||
the order of windows in the final layout. Any unmatched windows
|
||||
go to the end of the order.
|
||||
|
||||
* `XMonad.Prompt.Unicode`
|
||||
|
||||
A prompt to search a unicode character by its name, and put it into the
|
||||
clipboard.
|
||||
|
||||
* `XMonad.Util.Ungrab`
|
||||
|
||||
Release xmonad's keyboard and pointer grabs immediately, so
|
||||
screen grabbers and lock utilities, etc. will work. Replaces
|
||||
the short sleep hackaround.
|
||||
|
||||
* `XMonad.Util.Loggers.NamedScratchpad`
|
||||
|
||||
A collection of Loggers (see `XMonad.Util.Loggers`) for NamedScratchpads
|
||||
(see `XMonad.Util.NamedScratchpad`).
|
||||
|
||||
* `XMonad.Util.NoTaskbar`
|
||||
|
||||
Utility function and `ManageHook` to mark a window to be ignored by
|
||||
EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
|
||||
you will usually be taken to the `NSP` workspace by them.
|
||||
|
||||
### Minor Changes
|
||||
|
||||
* `XMonad.Layout.LayoutBuilder`
|
||||
|
||||
Merge all functionality from `XMonad.Layout.LayoutBuilderP` into
|
||||
`XMonad.Layout.LayoutBuilder`.
|
||||
|
||||
* `XMonad.Actions.DynamicProjects`
|
||||
|
||||
- Switching away from a dynamic project that contains no windows
|
||||
automatically deletes that project's workspace.
|
||||
|
||||
The project itself was already being deleted, this just deletes
|
||||
the workspace created for it as well.
|
||||
|
||||
## 0.12 (December 14, 2015)
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* `XMonad.Actions.UpdatePointer.updatePointer` arguments were
|
||||
changed. This allows including aspects of both of the
|
||||
`TowardsCentre` and `Relative` methods. To keep the same behavior,
|
||||
replace the entry in the left column with the entry on the right:
|
||||
|
||||
| < 0.12 | >= 0.12 |
|
||||
|-------------------------------------|----------------------------------|
|
||||
| `updatePointer Nearest` | `updatePointer (0.5, 0.5) (1,1)` |
|
||||
| `updatePointer (Relative x y)` | `updatePointer (x,y) (0,0)` |
|
||||
| `updatePointer (TowardsCentre x y)` | `updatePointer (0.5,0.5) (x,y)` |
|
||||
|
||||
### New Modules
|
||||
|
||||
* `XMonad.Actions.AfterDrag`
|
||||
|
||||
Perform an action after the current mouse drag is completed.
|
||||
|
||||
* `XMonad.Actions.DynamicProjects`
|
||||
|
||||
Imbues workspaces with additional features so they can be treated
|
||||
as individual project areas.
|
||||
|
||||
* `XMonad.Actions.LinkWorkspaces`
|
||||
|
||||
Provides bindings to add and delete links between workspaces. It
|
||||
is aimed at providing useful links between workspaces in a
|
||||
multihead setup. Linked workspaces are viewed at the same time.
|
||||
|
||||
* `XMonad.Config.Bepo`
|
||||
|
||||
This module fixes some of the keybindings for the francophone
|
||||
among you who use a BEPO keyboard layout. Based on
|
||||
`XMonad.Config.Azerty`
|
||||
|
||||
* `XMonad.Config.Dmwit`
|
||||
|
||||
Daniel Wagner's configuration.
|
||||
|
||||
* `XMonad.Config.Mate`
|
||||
|
||||
This module provides a config suitable for use with the MATE
|
||||
desktop environment.
|
||||
|
||||
* `XMonad.Config.Prime`
|
||||
|
||||
A draft of a brand new config syntax for xmonad.
|
||||
|
||||
* `XMonad.Hooks.DynamicProperty`
|
||||
|
||||
Module to apply a `ManageHook` to an already-mapped window when a
|
||||
property changes. This would commonly be used to match browser
|
||||
windows by title, since the final title will only be set after (a)
|
||||
the window is mapped, (b) its document has been loaded, (c) all
|
||||
load-time scripts have run.
|
||||
|
||||
* `XMonad.Hooks.ManageDebug`
|
||||
|
||||
A `manageHook` and associated `logHook` for debugging `ManageHook`s.
|
||||
Simplest usage: wrap your xmonad config in the `debugManageHook`
|
||||
combinator. Or use `debugManageHookOn` for a triggerable version,
|
||||
specifying the triggering key sequence in `XMonad.Util.EZConfig`
|
||||
syntax. Or use the individual hooks in whatever way you see fit.
|
||||
|
||||
* `XMonad.Hooks.WallpaperSetter`
|
||||
|
||||
Log hook which changes the wallpapers depending on visible
|
||||
workspaces.
|
||||
|
||||
* `XMonad.Hooks.WorkspaceHistory`
|
||||
|
||||
Keeps track of workspace viewing order.
|
||||
|
||||
* `XMonad.Layout.AvoidFloats`
|
||||
|
||||
Find a maximum empty rectangle around floating windows and use
|
||||
that area to display non-floating windows.
|
||||
|
||||
* `XMonad.Layout.BinarySpacePartition`
|
||||
|
||||
Layout where new windows will split the focused window in half,
|
||||
based off of BSPWM.
|
||||
|
||||
* `XMonad.Layout.Dwindle`
|
||||
|
||||
Three layouts: The first, `Spiral`, is a reimplementation of
|
||||
`XMonad.Layout.Spiral.spiral` with, at least to me, more intuitive
|
||||
semantics. The second, `Dwindle`, is inspired by a similar layout
|
||||
in awesome and produces the same sequence of decreasing window
|
||||
sizes as Spiral but pushes the smallest windows into a screen
|
||||
corner rather than the centre. The third, `Squeeze` arranges all
|
||||
windows in one row or in one column, with geometrically decreasing
|
||||
sizes.
|
||||
|
||||
* `XMonad.Layout.Hidden`
|
||||
|
||||
Similar to `XMonad.Layout.Minimize` but completely removes windows
|
||||
from the window set so `XMonad.Layout.BoringWindows` isn't
|
||||
necessary. Perfect companion to `XMonad.Layout.BinarySpacePartition`
|
||||
since it can be used to move windows to another part of the BSP tree.
|
||||
|
||||
* `XMonad.Layout.IfMax`
|
||||
|
||||
Provides `IfMax` layout, which will run one layout if there are
|
||||
maximum `N` windows on workspace, and another layout, when number
|
||||
of windows is greater than `N`.
|
||||
|
||||
* `XMonad.Layout.PerScreen`
|
||||
|
||||
Configure layouts based on the width of your screen; use your
|
||||
favorite multi-column layout for wide screens and a full-screen
|
||||
layout for small ones.
|
||||
|
||||
* `XMonad.Layout.Stoppable`
|
||||
|
||||
This module implements a special kind of layout modifier, which when
|
||||
applied to a layout, causes xmonad to stop all non-visible processes.
|
||||
In a way, this is a sledge-hammer for applications that drain power.
|
||||
For example, given a web browser on a stoppable workspace, once the
|
||||
workspace is hidden the web browser will be stopped.
|
||||
|
||||
* `XMonad.Prompt.ConfirmPrompt`
|
||||
|
||||
A module for setting up simple confirmation prompts for
|
||||
keybindings.
|
||||
|
||||
* `XMonad.Prompt.Pass`
|
||||
|
||||
This module provides 3 `XMonad.Prompt`s to ease passwords
|
||||
manipulation (generate, read, remove) via [pass][].
|
||||
|
||||
* `XMonad.Util.RemoteWindows`
|
||||
|
||||
This module implements a proper way of finding out whether the
|
||||
window is remote or local.
|
||||
|
||||
* `XMonad.Util.SpawnNamedPipe`
|
||||
|
||||
A module for spawning a pipe whose `Handle` lives in the xmonad state.
|
||||
|
||||
* `XMonad.Util.WindowState`
|
||||
|
||||
Functions for saving per-window data.
|
||||
|
||||
### Miscellaneous Changes
|
||||
|
||||
* Fix issue #9: `XMonad.Prompt.Shell` `searchPredicate` is ignored,
|
||||
defaults to `isPrefixOf`
|
||||
|
||||
* Fix moveHistory when alwaysHighlight is enabled
|
||||
|
||||
* `XMonad.Actions.DynamicWorkspaceGroups` now exports `addRawWSGroup`
|
||||
|
||||
* Side tabs were added to the tabbed layout
|
||||
|
||||
* `XMonad/Layout/IndependentScreens` now exports `marshallSort`
|
||||
|
||||
* `XMonad/Hooks/UrgencyHook` now exports `clearUrgency`
|
||||
|
||||
* Exceptions are now caught when finding commands on `PATH` in `Prompt.Shell`
|
||||
|
||||
* Switched to `Data.Default` wherever possible
|
||||
|
||||
* `XMonad.Layout.IndependentScreens` now exports `whenCurrentOn`
|
||||
|
||||
* `XMonad.Util.NamedActions` now exports `addDescrKeys'`
|
||||
|
||||
* EWMH `DEMANDS_ATTENTION` support added to `UrgencyHook`
|
||||
|
||||
* New `useTransientFor` modifier in `XMonad.Layout.TrackFloating`
|
||||
|
||||
* Added the ability to remove arbitrary workspaces
|
||||
|
||||
## 0.9 (October 26, 2009)
|
||||
|
||||
### Updates that Require Changes in `xmonad.hs`
|
||||
|
||||
* `XMonad.Hooks.EwmhDesktops` no longer uses `layoutHook`, the
|
||||
`ewmhDesktopsLayout` modifier has been removed from
|
||||
xmonad-contrib. It uses `logHook`, `handleEventHook`, and
|
||||
`startupHook` instead and provides a convenient function `ewmh` to
|
||||
add EWMH support to a `defaultConfig`.
|
||||
|
||||
* Most `DynamicLog` users can continue with configs unchanged, but
|
||||
users of the quickbar functions `xmobar` or `dzen` will need to
|
||||
change `xmonad.hs`: their types have changed to allow easier
|
||||
composition with other `XConfig` modifiers. The `dynamicLogDzen`
|
||||
and `dynamicLogXmobar` functions have been removed.
|
||||
|
||||
* `WindowGo` or `safeSpawn` users may need to change command lines
|
||||
due to `safeSpawn` changes.
|
||||
|
||||
* People explicitly referencing the "SP" scratchpad workspace should
|
||||
change it to "NSP" which is also used by the new
|
||||
`Util.NamedScratchpad` module.
|
||||
|
||||
* (Optional) People who explicitly use `swapMaster` in key or mouse
|
||||
bindings should change it to `shiftMaster`. It's the current
|
||||
default used where `swapMaster` had been used previously. It works
|
||||
better than `swapMaster` when using floating and tiled windows
|
||||
together on the same workspace.
|
||||
|
||||
## See Also
|
||||
|
||||
<https://wiki.haskell.org/Xmonad/Notable_changes_since_0.8>
|
||||
|
||||
[pass]: http://www.passwordstore.org/
|
82
README
82
README
@@ -1,82 +0,0 @@
|
||||
xmonad-contrib : third party extensions to the xmonad window manager
|
||||
|
||||
http://xmonad.org
|
||||
|
||||
You need the ghc compiler and xmonad window manager installed in
|
||||
order to use these extensions.
|
||||
|
||||
For installation and configuration instructions, please see the
|
||||
xmonad website, the documents included with the xmonad source
|
||||
distribution, and online haddock documentation:
|
||||
|
||||
http://www.xmonad.org/xmonad-docs
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Changelogs
|
||||
|
||||
For a list of changes since the 0.8.x releases, see:
|
||||
|
||||
http://www.haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Updates to XMonadContrib-0.9 that may Require Changes to ~/.xmonad/xmonad.hs
|
||||
|
||||
Please see the Changelogs and xmonad-contrib haddock documentation
|
||||
links for further details regarding the following changes.
|
||||
|
||||
* XMonad.Hooks.EwmhDesktops no longer uses layoutHook, the
|
||||
ewmhDesktopsLayout modifier has been removed from xmonad-contrib. It
|
||||
uses logHook, handleEventHook, and startupHook instead and provides
|
||||
a convenient function 'ewmh' to add EWMH support to a defaultConfig.
|
||||
|
||||
* Most DynamicLog users can continue with configs unchanged, but users
|
||||
of the quickbar functions 'xmobar' or 'dzen' will need to change
|
||||
xmonad.hs: their types have changed to allow easier composition with
|
||||
other XConfig modifiers. The 'dynamicLogDzen' and 'dynamicLogXmobar'
|
||||
functions have been removed.
|
||||
|
||||
* WindowGo or safeSpawn users may need to change command lines due to
|
||||
safeSpawn changes.
|
||||
|
||||
* People explicitly referencing the "SP" scratchpad workspace should
|
||||
change it to "NSP" which is also used by the new Util.NamedScratchpad.
|
||||
|
||||
* (Optional) People who explicitly use swapMaster in key or mouse
|
||||
bindings should change it to shiftMaster. It's the current default
|
||||
used where swapMaster had been used previously. It works better than
|
||||
swapMaster when using floating and tiled windows together on the
|
||||
same workspace.
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Getting or updating XMonadContrib
|
||||
|
||||
latest release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib
|
||||
|
||||
darcs version: darcs get http://code.haskell.org/XMonadContrib
|
||||
|
||||
(To use darcs xmonad-contrib you must also use the darcs version
|
||||
of xmonad.)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Contributing
|
||||
|
||||
Haskell code contributed to this repo should live under the
|
||||
appropriate subdivision of the 'XMonad.' namespace (currently
|
||||
includes Actions, Config, Hooks, Layout, Prompt, and Util). For
|
||||
example, to use the Grid layout, one would import:
|
||||
|
||||
XMonad.Layout.Grid
|
||||
|
||||
For further details, see the documentation for the
|
||||
XMonad.Doc.Developing module and http://xmonad.org website.
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Code submitted to the contrib repo is licensed under the same license as
|
||||
xmonad itself, with copyright held by the authors.
|
||||
|
||||
------------------------------------------------------------------------
|
40
README.md
Normal file
40
README.md
Normal file
@@ -0,0 +1,40 @@
|
||||
# xmonad-contrib: Third Party Extensions to the xmonad Window Manager
|
||||
|
||||
You need the ghc compiler and xmonad window manager installed in
|
||||
order to use these extensions.
|
||||
|
||||
For installation and configuration instructions, please see the
|
||||
[xmonad website] [xmonad], the documents included with the
|
||||
[xmonad source distribution] [xmonad-git], and the
|
||||
[online haddock documentation] [xmonad-docs].
|
||||
|
||||
## Getting or Updating XMonadContrib
|
||||
|
||||
* Latest release: <https://hackage.haskell.org/package/xmonad-contrib>
|
||||
|
||||
* Git version: <https://github.com/xmonad/xmonad-contrib>
|
||||
|
||||
(To use git xmonad-contrib you must also use the
|
||||
[git version of xmonad] [xmonad-git].)
|
||||
|
||||
## Contributing
|
||||
|
||||
Haskell code contributed to this repo should live under the
|
||||
appropriate subdivision of the `XMonad` namespace (currently includes
|
||||
`Actions`, `Config`, `Hooks`, `Layout`, `Prompt`, and `Util`). For
|
||||
example, to use the Grid layout, one would import:
|
||||
|
||||
XMonad.Layout.Grid
|
||||
|
||||
For further details, see the [documentation] [developing] for the
|
||||
`XMonad.Doc.Developing` module and the [xmonad website] [xmonad].
|
||||
|
||||
## License
|
||||
|
||||
Code submitted to the contrib repo is licensed under the same license as
|
||||
xmonad itself, with copyright held by the authors.
|
||||
|
||||
[xmonad]: http://xmonad.org
|
||||
[xmonad-git]: https://github.com/xmonad/xmonad
|
||||
[xmonad-docs]: http://www.xmonad.org/xmonad-docs
|
||||
[developing]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
|
71
XMonad/Actions/AfterDrag.hs
Normal file
71
XMonad/Actions/AfterDrag.hs
Normal file
@@ -0,0 +1,71 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.AfterDrag
|
||||
-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Anders Engstrom <ankaan@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Perform an action after the current mouse drag is completed.
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.AfterDrag (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
afterDrag,
|
||||
ifClick,
|
||||
ifClick') where
|
||||
|
||||
import XMonad
|
||||
import System.Time
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.AfterDrag
|
||||
--
|
||||
-- Then add appropriate mouse bindings, for example:
|
||||
--
|
||||
-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (windows $ W.float w $ W.RationalRect 0 0 1 1)))
|
||||
--
|
||||
-- This will allow you to resize windows as usual, but if you instead of
|
||||
-- draging click the mouse button the window will be automatically resized to
|
||||
-- fill the whole screen.
|
||||
--
|
||||
-- For detailed instructions on editing your mouse bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
|
||||
--
|
||||
-- More practical examples are available in "XMonad.Actions.FloatSnap".
|
||||
|
||||
-- | Schedule a task to take place after the current dragging is completed.
|
||||
afterDrag
|
||||
:: X () -- ^ The task to schedule.
|
||||
-> X ()
|
||||
afterDrag task = do drag <- gets dragging
|
||||
case drag of
|
||||
Nothing -> return () -- Not dragging
|
||||
Just (motion, cleanup) -> modify $ \s -> s { dragging = Just(motion, cleanup >> task) }
|
||||
|
||||
-- | Take an action if the current dragging can be considered a click,
|
||||
-- supposing the drag just started before this function is called.
|
||||
-- A drag is considered a click if it is completed within 300 ms.
|
||||
ifClick
|
||||
:: X () -- ^ The action to take if the dragging turned out to be a click.
|
||||
-> X ()
|
||||
ifClick action = ifClick' 300 action (return ())
|
||||
|
||||
-- | Take an action if the current dragging is completed within a certain time (in milliseconds.)
|
||||
ifClick'
|
||||
:: Int -- ^ Maximum time of dragging for it to be considered a click (in milliseconds.)
|
||||
-> X () -- ^ The action to take if the dragging turned out to be a click.
|
||||
-> X () -- ^ The action to take if the dragging turned out to not be a click.
|
||||
-> X ()
|
||||
ifClick' ms click drag = do
|
||||
start <- io $ getClockTime
|
||||
afterDrag $ do
|
||||
stop <- io $ getClockTime
|
||||
if diffClockTimes stop start <= noTimeDiff { tdPicosec = fromIntegral ms * 10^(9 :: Integer) }
|
||||
then click
|
||||
else drag
|
@@ -36,7 +36,7 @@ import System.Exit
|
||||
--
|
||||
-- Then edit your @handleEventHook@:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook' bluetileCommands }
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHook' bluetileCommands }
|
||||
--
|
||||
-- See the documentation of "XMonad.Hooks.ServerMode" for details on
|
||||
-- how to actually invoke the commands from external programs.
|
||||
|
@@ -87,7 +87,7 @@ import qualified XMonad.StackSet as W
|
||||
-- >
|
||||
-- > main = do
|
||||
-- > h <- spawnPipe "xmobar"
|
||||
-- > xmonad defaultConfig { logHook = sampleLogHook h }
|
||||
-- > xmonad def { logHook = sampleLogHook h }
|
||||
|
||||
-- | Copy the focused window to a workspace.
|
||||
copy :: (Eq s, Eq i, Eq a) => i -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||
|
@@ -78,11 +78,11 @@ module XMonad.Actions.CycleWS (
|
||||
|
||||
) where
|
||||
|
||||
import Control.Monad ( unless )
|
||||
import Data.List ( findIndex )
|
||||
import Data.List ( find, findIndex )
|
||||
import Data.Maybe ( isNothing, isJust )
|
||||
|
||||
import XMonad hiding (workspaces)
|
||||
import qualified XMonad.Hooks.WorkspaceHistory as WH
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import XMonad.Util.Types
|
||||
import XMonad.Util.WorkspaceCompare
|
||||
@@ -119,6 +119,10 @@ import XMonad.Util.WorkspaceCompare
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
--
|
||||
-- When using the toggle functions, in order to ensure that the workspace
|
||||
-- to which you switch is the previously viewed workspace, use the
|
||||
-- 'logHook' in "XMonad.Hooks.WorkspaceHistory".
|
||||
|
||||
{- $moving
|
||||
|
||||
@@ -158,9 +162,7 @@ toggleWS = toggleWS' []
|
||||
-- > -- Ignore the scratchpad workspace while toggling:
|
||||
-- > ("M-b", toggleWS' ["NSP"])
|
||||
toggleWS' :: [WorkspaceId] -> X ()
|
||||
toggleWS' skips = do
|
||||
hs' <- cleanHiddens skips
|
||||
unless (null hs') (windows . view . tag $ head hs')
|
||||
toggleWS' skips = lastViewedHiddenExcept skips >>= flip whenJust (windows . view)
|
||||
|
||||
-- | 'XMonad.StackSet.greedyView' a workspace, or if already there, view
|
||||
-- the previously displayed workspace ala weechat. Change @greedyView@ to
|
||||
@@ -184,10 +186,9 @@ toggleOrView = toggleOrDoSkip [] greedyView
|
||||
toggleOrDoSkip :: [WorkspaceId] -> (WorkspaceId -> WindowSet -> WindowSet)
|
||||
-> WorkspaceId -> X ()
|
||||
toggleOrDoSkip skips f toWS = do
|
||||
hs' <- cleanHiddens skips
|
||||
cur <- gets (currentTag . windowset)
|
||||
if toWS == cur
|
||||
then unless (null hs') (windows . f . tag $ head hs')
|
||||
then lastViewedHiddenExcept skips >>= flip whenJust (windows . f)
|
||||
else windows (f toWS)
|
||||
|
||||
-- | List difference ('\\') for workspaces and tags. Removes workspaces
|
||||
@@ -195,8 +196,16 @@ toggleOrDoSkip skips f toWS = do
|
||||
skipTags :: (Eq i) => [Workspace i l a] -> [i] -> [Workspace i l a]
|
||||
skipTags wss ids = filter ((`notElem` ids) . tag) wss
|
||||
|
||||
cleanHiddens :: [WorkspaceId] -> X [WindowSpace]
|
||||
cleanHiddens skips = gets $ (flip skipTags) skips . hidden . windowset
|
||||
-- | Ignoring the skips, find the best candidate for the last viewed hidden
|
||||
-- workspace.
|
||||
lastViewedHiddenExcept :: [WorkspaceId] -> X (Maybe WorkspaceId)
|
||||
lastViewedHiddenExcept skips = do
|
||||
hs <- gets $ map tag . flip skipTags skips . hidden . windowset
|
||||
vs <- WH.workspaceHistory
|
||||
return $ choose hs (find (`elem` hs) vs)
|
||||
where choose [] _ = Nothing
|
||||
choose (h:_) Nothing = Just h
|
||||
choose _ vh@(Just _) = vh
|
||||
|
||||
switchWorkspace :: Int -> X ()
|
||||
switchWorkspace d = wsBy d >>= windows . greedyView
|
||||
|
312
XMonad/Actions/DynamicProjects.hs
Normal file
312
XMonad/Actions/DynamicProjects.hs
Normal file
@@ -0,0 +1,312 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.DynamicProjects
|
||||
-- Copyright : (c) Peter J. Jones
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Peter Jones <pjones@devalot.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Imbues workspaces with additional features so they can be treated
|
||||
-- as individual project areas.
|
||||
--------------------------------------------------------------------------------
|
||||
module XMonad.Actions.DynamicProjects
|
||||
( -- * Overview
|
||||
-- $overview
|
||||
|
||||
-- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Types
|
||||
Project (..)
|
||||
, ProjectName
|
||||
|
||||
-- * Hooks
|
||||
, dynamicProjects
|
||||
|
||||
-- * Bindings
|
||||
, switchProjectPrompt
|
||||
, shiftToProjectPrompt
|
||||
, renameProjectPrompt
|
||||
|
||||
-- * Helper Functions
|
||||
, switchProject
|
||||
, shiftToProject
|
||||
, lookupProject
|
||||
, currentProject
|
||||
, activateProject
|
||||
) where
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
import Control.Applicative ((<|>))
|
||||
import Control.Monad (when, unless)
|
||||
import Data.List (sort, union, stripPrefix)
|
||||
import Data.Map.Strict (Map)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import Data.Maybe (fromMaybe, isNothing)
|
||||
import Data.Monoid ((<>))
|
||||
import System.Directory (setCurrentDirectory, getHomeDirectory)
|
||||
import XMonad
|
||||
import XMonad.Actions.DynamicWorkspaces
|
||||
import XMonad.Prompt
|
||||
import XMonad.Prompt.Directory (directoryPrompt)
|
||||
import XMonad.Prompt.Workspace (Wor(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- $overview
|
||||
-- Inspired by @TopicSpace@, @DynamicWorkspaces@, and @WorkspaceDir@,
|
||||
-- @DynamicProjects@ treats workspaces as projects while maintaining
|
||||
-- compatibility with all existing workspace-related functionality in
|
||||
-- XMonad.
|
||||
--
|
||||
-- Instead of using generic workspace names such as @3@ or @work@,
|
||||
-- @DynamicProjects@ allows you to dedicate workspaces to specific
|
||||
-- projects and then switch between projects easily.
|
||||
--
|
||||
-- A project is made up of a name, working directory, and a start-up
|
||||
-- hook. When you switch to a workspace, @DynamicProjects@ changes
|
||||
-- the working directory to the one configured for the matching
|
||||
-- project. If the workspace doesn't have any windows, the project's
|
||||
-- start-up hook is executed. This allows you to launch applications
|
||||
-- or further configure the workspace/project.
|
||||
--
|
||||
-- When using the @switchProjectPrompt@ function, workspaces are
|
||||
-- created as needed. This means you can create new project spaces
|
||||
-- (and therefore workspaces) on the fly. (These dynamic projects are
|
||||
-- not preserved across restarts.)
|
||||
--
|
||||
-- Additionally, frequently used projects can be configured statically
|
||||
-- in your XMonad configuration. Doing so allows you to configure the
|
||||
-- per-project start-up hook.
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- $usage
|
||||
-- To use @DynamicProjects@ you need to add it to your XMonad
|
||||
-- configuration and then configure some optional key bindings.
|
||||
--
|
||||
-- > import XMonad.Actions.DynamicProjects
|
||||
--
|
||||
-- Start by defining some projects:
|
||||
--
|
||||
-- > projects :: [Project]
|
||||
-- > projects =
|
||||
-- > [ Project { projectName = "scratch"
|
||||
-- > , projectDirectory = "~/"
|
||||
-- > , projectStartHook = Nothing
|
||||
-- > }
|
||||
-- >
|
||||
-- > , Project { projectName = "browser"
|
||||
-- > , projectDirectory = "~/download"
|
||||
-- > , projectStartHook = Just $ do spawn "conkeror"
|
||||
-- > spawn "chromium"
|
||||
-- > }
|
||||
-- > ]
|
||||
--
|
||||
-- Then inject @DynamicProjects@ into your XMonad configuration:
|
||||
--
|
||||
-- > main = xmonad $ dynamicProjects projects def
|
||||
--
|
||||
-- And finally, configure some optional key bindings:
|
||||
--
|
||||
-- > , ((modm, xK_space), switchProjectPrompt)
|
||||
-- > , ((modm, xK_slash), shiftToProjectPrompt)
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
type ProjectName = String
|
||||
type ProjectTable = Map ProjectName Project
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Details about a workspace that represents a project.
|
||||
data Project = Project
|
||||
{ projectName :: !ProjectName -- ^ Workspace name.
|
||||
, projectDirectory :: !FilePath -- ^ Working directory.
|
||||
, projectStartHook :: !(Maybe (X ())) -- ^ Optional start-up hook.
|
||||
} deriving Typeable
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Internal project state.
|
||||
data ProjectState = ProjectState
|
||||
{ projects :: !ProjectTable
|
||||
, previousProject :: !(Maybe WorkspaceId)
|
||||
} deriving Typeable
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
instance ExtensionClass ProjectState where
|
||||
initialValue = ProjectState Map.empty Nothing
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Add dynamic projects support to the given config.
|
||||
dynamicProjects :: [Project] -> XConfig a -> XConfig a
|
||||
dynamicProjects ps c =
|
||||
c { startupHook = dynamicProjectsStartupHook ps <> startupHook c
|
||||
, logHook = dynamicProjectsLogHook <> logHook c
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Log hook for tracking workspace changes.
|
||||
dynamicProjectsLogHook :: X ()
|
||||
dynamicProjectsLogHook = do
|
||||
name <- gets (W.tag . W.workspace . W.current . windowset)
|
||||
xstate <- XS.get
|
||||
|
||||
unless (Just name == previousProject xstate) $ do
|
||||
XS.put (xstate {previousProject = Just name})
|
||||
activateProject . fromMaybe (defProject name) $
|
||||
Map.lookup name (projects xstate)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Start-up hook for recording configured projects.
|
||||
dynamicProjectsStartupHook :: [Project] -> X ()
|
||||
dynamicProjectsStartupHook ps = XS.modify go
|
||||
where
|
||||
go :: ProjectState -> ProjectState
|
||||
go s = s {projects = update $ projects s}
|
||||
|
||||
update :: ProjectTable -> ProjectTable
|
||||
update = Map.union (Map.fromList $ map entry ps)
|
||||
|
||||
entry :: Project -> (ProjectName, Project)
|
||||
entry p = (projectName p, addDefaultHook p)
|
||||
|
||||
-- Force the hook to be a @Just@ so that it doesn't automatically
|
||||
-- get deleted when switching away from a workspace with no
|
||||
-- windows.
|
||||
addDefaultHook :: Project -> Project
|
||||
addDefaultHook p = p { projectStartHook = projectStartHook p <|>
|
||||
Just (return ())
|
||||
}
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Find a project based on its name.
|
||||
lookupProject :: ProjectName -> X (Maybe Project)
|
||||
lookupProject name = Map.lookup name `fmap` XS.gets projects
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Fetch the current project (the one being used for the currently
|
||||
-- active workspace).
|
||||
currentProject :: X Project
|
||||
currentProject = do
|
||||
name <- gets (W.tag . W.workspace . W.current . windowset)
|
||||
proj <- lookupProject name
|
||||
return $ fromMaybe (defProject name) proj
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Switch to the given project.
|
||||
switchProject :: Project -> X ()
|
||||
switchProject p = do
|
||||
oldws <- gets (W.workspace . W.current . windowset)
|
||||
oldp <- currentProject
|
||||
|
||||
let name = W.tag oldws
|
||||
ws = W.integrate' (W.stack oldws)
|
||||
|
||||
-- If the project we are switching away from has no windows, and
|
||||
-- it's a dynamic project, remove it from the configuration.
|
||||
when (null ws && isNothing (projectStartHook oldp)) $ do
|
||||
removeWorkspaceByTag name -- also remove the old workspace
|
||||
XS.modify (\s -> s {projects = Map.delete name $ projects s})
|
||||
|
||||
appendWorkspace (projectName p)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for a project name and then switch to it. Automatically
|
||||
-- creates a project if a new name is returned from the prompt.
|
||||
switchProjectPrompt :: XPConfig -> X ()
|
||||
switchProjectPrompt c = projectPrompt c switch
|
||||
where
|
||||
switch :: ProjectTable -> ProjectName -> X ()
|
||||
switch ps name = case Map.lookup name ps of
|
||||
Just p -> switchProject p
|
||||
Nothing | null name -> return ()
|
||||
| otherwise -> directoryPrompt dirC "Project Dir: " (mkProject name)
|
||||
|
||||
dirC :: XPConfig
|
||||
dirC = c { alwaysHighlight = False } -- Fix broken tab completion.
|
||||
|
||||
mkProject :: ProjectName -> FilePath -> X ()
|
||||
mkProject name dir = do
|
||||
let p = Project name dir Nothing
|
||||
XS.modify $ \s -> s {projects = Map.insert name p $ projects s}
|
||||
switchProject p
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Shift the currently focused window to the given project.
|
||||
shiftToProject :: Project -> X ()
|
||||
shiftToProject p = do
|
||||
addHiddenWorkspace (projectName p)
|
||||
windows (W.shift $ projectName p)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompts for a project name and then shifts the currently focused
|
||||
-- window to that project.
|
||||
shiftToProjectPrompt :: XPConfig -> X ()
|
||||
shiftToProjectPrompt c = projectPrompt c go
|
||||
where
|
||||
go :: ProjectTable -> ProjectName -> X ()
|
||||
go ps name = shiftToProject . fromMaybe (defProject name) $
|
||||
Map.lookup name ps
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Prompt for a project name.
|
||||
projectPrompt :: XPConfig -> (ProjectTable -> ProjectName -> X ()) -> X ()
|
||||
projectPrompt c f = do
|
||||
ws <- map W.tag `fmap` gets (W.workspaces . windowset)
|
||||
ps <- XS.gets projects
|
||||
|
||||
let names = sort (Map.keys ps `union` ws)
|
||||
label = "Switch or Create Project: "
|
||||
|
||||
mkXPrompt (Wor label) c (mkComplFunFromList' names) (f ps)
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Rename the current project.
|
||||
renameProjectPrompt :: XPConfig -> X ()
|
||||
renameProjectPrompt c = mkXPrompt (Wor "New Project Name: ") c (return . (:[])) go
|
||||
where
|
||||
go :: String -> X ()
|
||||
go name = do
|
||||
p <- currentProject
|
||||
ps <- XS.gets projects
|
||||
renameWorkspaceByName name
|
||||
|
||||
let p' = fromMaybe (p { projectName = name }) $ Map.lookup name ps
|
||||
ps' = Map.insert name p' $ Map.delete (projectName p) ps
|
||||
|
||||
XS.modify $ \s -> s {projects = ps'}
|
||||
activateProject p'
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Activate a project by updating the working directory and
|
||||
-- possibly running its start-up hook. This function is automatically
|
||||
-- invoked when the workspace changes.
|
||||
activateProject :: Project -> X ()
|
||||
activateProject p = do
|
||||
ws <- gets (W.integrate' . W.stack . W.workspace . W.current . windowset)
|
||||
home <- io getHomeDirectory
|
||||
|
||||
-- Change to the project's directory.
|
||||
catchIO (setCurrentDirectory $ expandHome home $ projectDirectory p)
|
||||
|
||||
-- Possibly run the project's startup hook.
|
||||
when (null ws) $ fromMaybe (return ()) (projectStartHook p)
|
||||
|
||||
where
|
||||
|
||||
-- Replace an initial @~@ character with the home directory.
|
||||
expandHome :: FilePath -> FilePath -> FilePath
|
||||
expandHome home dir = case stripPrefix "~" dir of
|
||||
Nothing -> dir
|
||||
Just xs -> home ++ xs
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- | Default project.
|
||||
defProject :: ProjectName -> Project
|
||||
defProject name = Project name "~/" Nothing
|
@@ -23,6 +23,7 @@ module XMonad.Actions.DynamicWorkspaceGroups
|
||||
|
||||
WSGroupId
|
||||
|
||||
, addRawWSGroup
|
||||
, addWSGroup
|
||||
, addCurrentWSGroup
|
||||
, forgetWSGroup
|
||||
@@ -72,20 +73,27 @@ instance ExtensionClass WSGroupStorage where
|
||||
initialValue = WSG $ M.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | Add a new workspace group of the given name, mapping to an
|
||||
-- explicitly specified association between screen IDs and workspace
|
||||
-- names. This function could be useful for, say, creating some
|
||||
-- standard workspace groups in your startup hook.
|
||||
addRawWSGroup :: WSGroupId -> [(ScreenId, WorkspaceId)] -> X ()
|
||||
addRawWSGroup name = XS.modify . withWSG . M.insert name
|
||||
|
||||
-- | Add a new workspace group with the given name.
|
||||
addWSGroup :: WSGroupId -> [WorkspaceId] -> X ()
|
||||
addWSGroup name wids = withWindowSet $ \w -> do
|
||||
let wss = map ((W.tag . W.workspace) &&& W.screen) $ W.screens w
|
||||
wmap = mapM (strength . (flip lookup wss &&& id)) wids
|
||||
case wmap of
|
||||
Just ps -> XS.modify . withWSG . M.insert name $ ps
|
||||
Just ps -> addRawWSGroup name ps
|
||||
Nothing -> return ()
|
||||
where strength (ma, b) = ma >>= \a -> return (a,b)
|
||||
|
||||
-- | Give a name to the current workspace group.
|
||||
addCurrentWSGroup :: WSGroupId -> X ()
|
||||
addCurrentWSGroup name = withWindowSet $ \w ->
|
||||
addWSGroup name $ map (W.tag . W.workspace) (W.current w : W.visible w)
|
||||
addWSGroup name $ map (W.tag . W.workspace) (reverse $ W.current w : W.visible w)
|
||||
|
||||
-- | Delete the named workspace group from the list of workspace
|
||||
-- groups. Note that this has no effect on the workspaces involved;
|
||||
|
@@ -28,6 +28,8 @@ module XMonad.Actions.DynamicWorkspaceOrder
|
||||
, moveToGreedy
|
||||
, shiftTo
|
||||
|
||||
, withNthWorkspace
|
||||
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -163,3 +165,14 @@ moveToGreedy dir t = doTo dir t getSortByOrder (windows . W.greedyView)
|
||||
-- given type in the given direction, using the dynamic workspace order.
|
||||
shiftTo :: Direction1D -> WSType -> X ()
|
||||
shiftTo dir t = doTo dir t getSortByOrder (windows . W.shift)
|
||||
|
||||
-- | Do something with the nth workspace in the dynamic order. The
|
||||
-- callback is given the workspace's tag as well as the 'WindowSet'
|
||||
-- of the workspace itself.
|
||||
withNthWorkspace :: (String -> WindowSet -> WindowSet) -> Int -> X ()
|
||||
withNthWorkspace job wnum = do
|
||||
sort <- getSortByOrder
|
||||
ws <- gets (map W.tag . sort . W.workspaces . windowset)
|
||||
case drop wnum ws of
|
||||
(w:_) -> windows $ job w
|
||||
[] -> return ()
|
@@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.DynamicWorkspaces
|
||||
@@ -16,14 +18,21 @@ module XMonad.Actions.DynamicWorkspaces (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
addWorkspace, addWorkspacePrompt,
|
||||
appendWorkspace, appendWorkspacePrompt,
|
||||
addWorkspaceAt,
|
||||
removeWorkspace,
|
||||
removeWorkspaceByTag,
|
||||
removeEmptyWorkspace,
|
||||
removeEmptyWorkspaceByTag,
|
||||
removeEmptyWorkspaceAfter,
|
||||
removeEmptyWorkspaceAfterExcept,
|
||||
addHiddenWorkspace,
|
||||
addHiddenWorkspace, addHiddenWorkspaceAt,
|
||||
withWorkspace,
|
||||
selectWorkspace, renameWorkspace,
|
||||
toNthWorkspace, withNthWorkspace
|
||||
renameWorkspaceByName,
|
||||
toNthWorkspace, withNthWorkspace,
|
||||
setWorkspaceIndex, withWorkspaceIndex,
|
||||
WorkspaceIndex
|
||||
) where
|
||||
|
||||
import XMonad hiding (workspaces)
|
||||
@@ -34,6 +43,8 @@ import XMonad.Util.WorkspaceCompare ( getSortByIndex )
|
||||
import Data.List (find)
|
||||
import Data.Maybe (isNothing)
|
||||
import Control.Monad (when)
|
||||
import qualified Data.Map.Strict as Map
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
@@ -44,21 +55,60 @@ import Control.Monad (when)
|
||||
-- Then add keybindings like the following:
|
||||
--
|
||||
-- > , ((modm .|. shiftMask, xK_BackSpace), removeWorkspace)
|
||||
-- > , ((modm .|. shiftMask, xK_v ), selectWorkspace defaultXPConfig)
|
||||
-- > , ((modm, xK_m ), withWorkspace defaultXPConfig (windows . W.shift))
|
||||
-- > , ((modm .|. shiftMask, xK_m ), withWorkspace defaultXPConfig (windows . copy))
|
||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig)
|
||||
-- > , ((modm .|. shiftMask, xK_v ), selectWorkspace def)
|
||||
-- > , ((modm, xK_m ), withWorkspace def (windows . W.shift))
|
||||
-- > , ((modm .|. shiftMask, xK_m ), withWorkspace def (windows . copy))
|
||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def)
|
||||
--
|
||||
-- > -- mod-[1..9] %! Switch to workspace N
|
||||
-- > -- mod-shift-[1..9] %! Move client to workspace N
|
||||
-- > -- mod-[1..9] %! Switch to workspace N in the list of workspaces
|
||||
-- > -- mod-shift-[1..9] %! Move client to workspace N in the list of workspaces
|
||||
-- > ++
|
||||
-- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withNthWorkspace W.greedyView) [0..])
|
||||
-- > ++
|
||||
-- > zip (zip (repeat (modm .|. shiftMask)) [xK_1..xK_9]) (map (withNthWorkspace W.shift) [0..])
|
||||
--
|
||||
-- Alternatively, you can associate indexes (which don't depend of the
|
||||
-- workspace list order) to workspaces by using following keybindings:
|
||||
--
|
||||
-- > -- mod-[1..9] %! Switch to workspace of index N
|
||||
-- > -- mod-control-[1..9] %! Set index N to the current workspace
|
||||
-- > ++
|
||||
-- > zip (zip (repeat (modm)) [xK_1..xK_9]) (map (withWorkspaceIndex W.greedyView) [1..])
|
||||
-- > ++
|
||||
-- > zip (zip (repeat (modm .|. controlMask)) [xK_1..xK_9]) (map (setWorkspaceIndex) [1..])
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings". See also the documentation for
|
||||
-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'defaultXPConfig'.
|
||||
-- "XMonad.Actions.CopyWindow", 'windows', 'shift', and 'XPConfig'.
|
||||
|
||||
type WorkspaceTag = String
|
||||
-- | The workspace index is mapped to a workspace tag by the user and
|
||||
-- can be updated.
|
||||
type WorkspaceIndex = Int
|
||||
|
||||
-- | Internal dynamic project state that stores a mapping between
|
||||
-- workspace indexes and workspace tags.
|
||||
data DynamicWorkspaceState = DynamicWorkspaceState {workspaceIndexMap :: Map.Map WorkspaceIndex WorkspaceTag}
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass DynamicWorkspaceState where
|
||||
initialValue = DynamicWorkspaceState Map.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | Set the index of the current workspace.
|
||||
setWorkspaceIndex :: WorkspaceIndex -> X ()
|
||||
setWorkspaceIndex widx = do
|
||||
wtag <- gets (currentTag . windowset)
|
||||
wmap <- XS.gets workspaceIndexMap
|
||||
XS.modify $ \s -> s {workspaceIndexMap = Map.insert widx wtag wmap}
|
||||
|
||||
withWorkspaceIndex :: (String -> WindowSet -> WindowSet) -> WorkspaceIndex -> X ()
|
||||
withWorkspaceIndex job widx = do
|
||||
wtag <- ilookup widx
|
||||
maybe (return ()) (windows . job) wtag
|
||||
where
|
||||
ilookup :: WorkspaceIndex -> X (Maybe WorkspaceTag)
|
||||
ilookup idx = Map.lookup idx `fmap` XS.gets workspaceIndexMap
|
||||
|
||||
|
||||
mkCompl :: [String] -> String -> IO [String]
|
||||
@@ -73,11 +123,18 @@ withWorkspace c job = do ws <- gets (workspaces . windowset)
|
||||
mkXPrompt (Wor "") c (mkCompl ts) job'
|
||||
|
||||
renameWorkspace :: XPConfig -> X ()
|
||||
renameWorkspace conf = workspacePrompt conf $ \w ->
|
||||
renameWorkspace conf = workspacePrompt conf renameWorkspaceByName
|
||||
|
||||
renameWorkspaceByName :: String -> X ()
|
||||
renameWorkspaceByName w = do old <- gets (currentTag . windowset)
|
||||
windows $ \s -> let sett wk = wk { tag = w }
|
||||
setscr scr = scr { workspace = sett $ workspace scr }
|
||||
sets q = q { current = setscr $ current q }
|
||||
in sets $ removeWorkspace' w s
|
||||
updateIndexMap old w
|
||||
where updateIndexMap old new = do
|
||||
wmap <- XS.gets workspaceIndexMap
|
||||
XS.modify $ \s -> s {workspaceIndexMap = Map.map (\t -> if t == old then new else t) wmap}
|
||||
|
||||
toNthWorkspace :: (String -> X ()) -> Int -> X ()
|
||||
toNthWorkspace job wnum = do sort <- getSortByIndex
|
||||
@@ -104,20 +161,41 @@ selectWorkspace conf = workspacePrompt conf $ \w ->
|
||||
-- workspace with the given name already exists; then switch to the
|
||||
-- newly created workspace.
|
||||
addWorkspace :: String -> X ()
|
||||
addWorkspace newtag = addHiddenWorkspace newtag >> windows (greedyView newtag)
|
||||
addWorkspace = addWorkspaceAt (:)
|
||||
|
||||
-- | Same as addWorkspace, but adds the workspace to the end of the list of workspaces
|
||||
appendWorkspace :: String -> X()
|
||||
appendWorkspace = addWorkspaceAt (flip (++) . return)
|
||||
|
||||
-- | Adds a new workspace with the given name to the current list of workspaces.
|
||||
-- This function allows the user to pass a function that inserts an element
|
||||
-- into a list at an arbitrary spot.
|
||||
addWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
|
||||
addWorkspaceAt add newtag = addHiddenWorkspaceAt add newtag >> windows (greedyView newtag)
|
||||
|
||||
-- | Prompt for the name of a new workspace, add it if it does not
|
||||
-- already exist, and switch to it.
|
||||
addWorkspacePrompt :: XPConfig -> X ()
|
||||
addWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) addWorkspace
|
||||
|
||||
-- | Prompt for the name of a new workspace, appending it to the end of the list of workspaces
|
||||
-- if it does not already exist, and switch to it.
|
||||
appendWorkspacePrompt :: XPConfig -> X ()
|
||||
appendWorkspacePrompt conf = mkXPrompt (Wor "New workspace name: ") conf (const (return [])) appendWorkspace
|
||||
|
||||
-- | Add a new hidden workspace with the given name, or do nothing if
|
||||
-- a workspace with the given name already exists. Takes a function to insert
|
||||
-- the workspace at an arbitrary spot in the list.
|
||||
addHiddenWorkspaceAt :: (WindowSpace -> [WindowSpace] -> [WindowSpace]) -> String -> X ()
|
||||
addHiddenWorkspaceAt add newtag =
|
||||
whenX (gets (not . tagMember newtag . windowset)) $ do
|
||||
l <- asks (layoutHook . config)
|
||||
windows (addHiddenWorkspace' add newtag l)
|
||||
|
||||
-- | Add a new hidden workspace with the given name, or do nothing if
|
||||
-- a workspace with the given name already exists.
|
||||
addHiddenWorkspace :: String -> X ()
|
||||
addHiddenWorkspace newtag =
|
||||
whenX (gets (not . tagMember newtag . windowset)) $ do
|
||||
l <- asks (layoutHook . config)
|
||||
windows (addHiddenWorkspace' newtag l)
|
||||
addHiddenWorkspace = addHiddenWorkspaceAt (:)
|
||||
|
||||
-- | Remove the current workspace if it contains no windows.
|
||||
removeEmptyWorkspace :: X ()
|
||||
@@ -127,12 +205,11 @@ removeEmptyWorkspace = gets (currentTag . windowset) >>= removeEmptyWorkspaceByT
|
||||
removeWorkspace :: X ()
|
||||
removeWorkspace = gets (currentTag . windowset) >>= removeWorkspaceByTag
|
||||
|
||||
-- | Remove workspace with specific tag if it contains no windows. Only works
|
||||
-- on the current or the last workspace.
|
||||
-- | Remove workspace with specific tag if it contains no windows.
|
||||
removeEmptyWorkspaceByTag :: String -> X ()
|
||||
removeEmptyWorkspaceByTag t = whenX (isEmpty t) $ removeWorkspaceByTag t
|
||||
|
||||
-- | Remove workspace with specific tag. Only works on the current or the last workspace.
|
||||
-- | Remove workspace with specific tag.
|
||||
removeWorkspaceByTag :: String -> X ()
|
||||
removeWorkspaceByTag torem = do
|
||||
s <- gets windowset
|
||||
@@ -163,16 +240,21 @@ isEmpty t = do wsl <- gets $ workspaces . windowset
|
||||
let mws = find (\ws -> tag ws == t) wsl
|
||||
return $ maybe True (isNothing . stack) mws
|
||||
|
||||
addHiddenWorkspace' :: i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||
addHiddenWorkspace' newtag l s@(StackSet { hidden = ws }) = s { hidden = Workspace newtag l Nothing:ws }
|
||||
addHiddenWorkspace' :: (Workspace i l a -> [Workspace i l a] -> [Workspace i l a]) -> i -> l -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||
addHiddenWorkspace' add newtag l s@(StackSet { hidden = ws }) = s { hidden = add (Workspace newtag l Nothing) ws }
|
||||
|
||||
-- | Remove the hidden workspace with the given tag from the StackSet, if
|
||||
-- it exists. All the windows in that workspace are moved to the current
|
||||
-- workspace.
|
||||
removeWorkspace' :: (Eq i) => i -> StackSet i l a sid sd -> StackSet i l a sid sd
|
||||
removeWorkspace' torem s@(StackSet { current = scr@(Screen { workspace = wc })
|
||||
, hidden = (w:ws) })
|
||||
| tag w == torem = s { current = scr { workspace = wc { stack = meld (stack w) (stack wc) } }
|
||||
, hidden = ws }
|
||||
, hidden = hs })
|
||||
= let (xs, ys) = break ((== torem) . tag) hs
|
||||
in removeWorkspace'' xs ys
|
||||
where meld Nothing Nothing = Nothing
|
||||
meld x Nothing = x
|
||||
meld Nothing x = x
|
||||
meld (Just x) (Just y) = differentiate (integrate x ++ integrate y)
|
||||
removeWorkspace' _ s = s
|
||||
removeWorkspace'' xs (y:ys) = s { current = scr { workspace = wc { stack = meld (stack y) (stack wc) } }
|
||||
, hidden = xs ++ ys }
|
||||
removeWorkspace'' _ _ = s
|
||||
|
@@ -15,7 +15,7 @@
|
||||
module XMonad.Actions.FindEmptyWorkspace (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
viewEmptyWorkspace, tagToEmptyWorkspace
|
||||
viewEmptyWorkspace, tagToEmptyWorkspace, sendToEmptyWorkspace
|
||||
) where
|
||||
|
||||
import Data.List
|
||||
@@ -65,3 +65,8 @@ viewEmptyWorkspace = withEmptyWorkspace (windows . view)
|
||||
-- all workspaces are in use.
|
||||
tagToEmptyWorkspace :: X ()
|
||||
tagToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ view w . shift w
|
||||
|
||||
-- | Send current window to an empty workspace. Do nothing if
|
||||
-- all workspaces are in use.
|
||||
sendToEmptyWorkspace :: X ()
|
||||
sendToEmptyWorkspace = withEmptyWorkspace $ \w -> windows $ shift w
|
||||
|
@@ -21,18 +21,21 @@ module XMonad.Actions.FloatSnap (
|
||||
snapShrink,
|
||||
snapMagicMove,
|
||||
snapMagicResize,
|
||||
snapMagicMouseResize) where
|
||||
snapMagicMouseResize,
|
||||
afterDrag,
|
||||
ifClick,
|
||||
ifClick') where
|
||||
|
||||
import XMonad
|
||||
import Control.Applicative((<$>))
|
||||
import Data.List (sort)
|
||||
import Data.Maybe (listToMaybe,fromJust,isNothing)
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified Data.Set as S
|
||||
|
||||
import XMonad.Hooks.ManageDocks (calcGap)
|
||||
import XMonad.Util.Types (Direction2D(..))
|
||||
|
||||
import qualified Data.Set as S
|
||||
import XMonad.Actions.AfterDrag
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
@@ -53,17 +56,24 @@ import qualified Data.Set as S
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
--
|
||||
-- And possibly add an appropriate mouse binding, for example:
|
||||
-- And possibly add appropriate mouse bindings, for example:
|
||||
--
|
||||
-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicMove (Just 50) (Just 50) w))
|
||||
-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> snapMagicResize [L,R,U,D] (Just 50) (Just 50) w))
|
||||
-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> snapMagicResize [R,D] (Just 50) (Just 50) w))
|
||||
-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicMove (Just 50) (Just 50) w)))
|
||||
-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> ifClick (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
|
||||
-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> ifClick (snapMagicResize [R,D] (Just 50) (Just 50) w)))
|
||||
--
|
||||
-- For detailed instructions on editing your mouse bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_mouse_bindings".
|
||||
--
|
||||
-- Using these mouse bindings, it will not snap while moving, but allow you to click the window once after it has been moved or resized to snap it into place.
|
||||
-- Note that the order in which the commands are applied in the mouse bindings are important.
|
||||
-- Note that the order in which the commands are applied in the mouse bindings are important. Snapping can also be used together with other window resizing
|
||||
-- functions, such as those from "XMonad.Actions.FlexibleResize"
|
||||
--
|
||||
-- An alternative set of mouse bindings that will always snap after the drag is:
|
||||
--
|
||||
-- > , ((modm, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicMove (Just 50) (Just 50) w)))
|
||||
-- > , ((modm .|. shiftMask, button1), (\w -> focus w >> mouseMoveWindow w >> afterDrag (snapMagicResize [L,R,U,D] (Just 50) (Just 50) w)))
|
||||
-- > , ((modm, button3), (\w -> focus w >> mouseResizeWindow w >> afterDrag (snapMagicResize [R,D] (Just 50) (Just 50) w)))
|
||||
--
|
||||
-- Interesting values for the distance to look for window in the orthogonal axis are Nothing (to snap against every window), Just 0 (to only snap
|
||||
-- against windows that we should collide with geometrically while moving) and Just 1 (to also snap against windows we brush against).
|
||||
|
@@ -14,7 +14,8 @@
|
||||
module XMonad.Actions.FocusNth (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
focusNth,focusNth') where
|
||||
focusNth,focusNth',
|
||||
swapNth,swapNth') where
|
||||
|
||||
import XMonad.StackSet
|
||||
import XMonad
|
||||
@@ -41,6 +42,17 @@ focusNth' :: Int -> Stack a -> Stack a
|
||||
focusNth' n s@(Stack _ ls rs) | (n < 0) || (n > length(ls) + length(rs)) = s
|
||||
| otherwise = listToStack n (integrate s)
|
||||
|
||||
-- | Swap current window with nth. Focus stays in the same position
|
||||
swapNth :: Int -> X ()
|
||||
swapNth = windows . modify' . swapNth'
|
||||
|
||||
swapNth' :: Int -> Stack a -> Stack a
|
||||
swapNth' n s@(Stack c l r)
|
||||
| (n < 0) || (n > length l + length r) || (n == length l) = s
|
||||
| n < length l = let (nl, nc:nr) = splitAt (length l - n - 1) l in Stack nc (nl ++ c : nr) r
|
||||
| otherwise = let (nl, nc:nr) = splitAt (n - length l - 1) r in Stack nc l (nl ++ c : nr)
|
||||
|
||||
|
||||
listToStack :: Int -> [a] -> Stack a
|
||||
listToStack n l = Stack t ls rs
|
||||
where
|
||||
|
@@ -27,6 +27,7 @@ module XMonad.Actions.GridSelect (
|
||||
|
||||
-- * Configuration
|
||||
GSConfig(..),
|
||||
def,
|
||||
defaultGSConfig,
|
||||
TwoDPosition,
|
||||
buildDefaultGSConfig,
|
||||
@@ -38,6 +39,7 @@ module XMonad.Actions.GridSelect (
|
||||
bringSelected,
|
||||
goToSelected,
|
||||
gridselectWorkspace,
|
||||
gridselectWorkspace',
|
||||
spawnSelected,
|
||||
runSelectedAction,
|
||||
|
||||
@@ -65,6 +67,12 @@ module XMonad.Actions.GridSelect (
|
||||
cancel,
|
||||
transformSearchString,
|
||||
|
||||
-- * Rearrangers
|
||||
-- $rearrangers
|
||||
Rearranger,
|
||||
noRearranger,
|
||||
searchStringRearrangerGenerator,
|
||||
|
||||
-- * Screenshots
|
||||
-- $screenshots
|
||||
|
||||
@@ -74,6 +82,7 @@ module XMonad.Actions.GridSelect (
|
||||
import Data.Maybe
|
||||
import Data.Bits
|
||||
import Data.Char
|
||||
import Data.Ord (comparing)
|
||||
import Control.Applicative
|
||||
import Control.Monad.State
|
||||
import Control.Arrow
|
||||
@@ -166,7 +175,7 @@ import Data.Word (Word8)
|
||||
--
|
||||
-- You can then define @gsconfig3@ which may be used in exactly the same manner as @gsconfig1@:
|
||||
--
|
||||
-- > gsconfig3 = defaultGSConfig
|
||||
-- > gsconfig3 = def
|
||||
-- > { gs_cellheight = 30
|
||||
-- > , gs_cellwidth = 100
|
||||
-- > , gs_navigate = myNavigation
|
||||
@@ -182,6 +191,11 @@ import Data.Word (Word8)
|
||||
--
|
||||
-- <<http://haskell.org/wikiupload/3/35/Xmonad-gridselect-window-aavogt.png>>
|
||||
|
||||
-- | The 'Default' instance gives a basic configuration for 'gridselect', with
|
||||
-- the colorizer chosen based on the type.
|
||||
--
|
||||
-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
|
||||
-- instead of 'def' to avoid ambiguous type variables.
|
||||
data GSConfig a = GSConfig {
|
||||
gs_cellheight :: Integer,
|
||||
gs_cellwidth :: Integer,
|
||||
@@ -189,6 +203,7 @@ data GSConfig a = GSConfig {
|
||||
gs_colorizer :: a -> Bool -> X (String, String),
|
||||
gs_font :: String,
|
||||
gs_navigate :: TwoD a (Maybe a),
|
||||
gs_rearranger :: Rearranger a,
|
||||
gs_originFractX :: Double,
|
||||
gs_originFractY :: Double
|
||||
}
|
||||
@@ -211,12 +226,12 @@ instance HasColorizer a where
|
||||
let getColor = if isFg then focusedBorderColor else normalBorderColor
|
||||
in asks $ flip (,) "black" . getColor . config
|
||||
|
||||
-- | A basic configuration for 'gridselect', with the colorizer chosen based on the type.
|
||||
--
|
||||
-- If you want to replace the 'gs_colorizer' field, use 'buildDefaultGSConfig'
|
||||
-- instead, to avoid ambiguous type variables.
|
||||
instance HasColorizer a => Default (GSConfig a) where
|
||||
def = buildDefaultGSConfig defaultColorizer
|
||||
|
||||
{-# DEPRECATED defaultGSConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.GridSelect) instead." #-}
|
||||
defaultGSConfig :: HasColorizer a => GSConfig a
|
||||
defaultGSConfig = buildDefaultGSConfig defaultColorizer
|
||||
defaultGSConfig = def
|
||||
|
||||
type TwoDPosition = (Integer, Integer)
|
||||
|
||||
@@ -231,16 +246,48 @@ data TwoDState a = TwoDState { td_curpos :: TwoDPosition
|
||||
, td_paneY :: Integer
|
||||
, td_drawingWin :: Window
|
||||
, td_searchString :: String
|
||||
, td_elementmap :: TwoDElementMap a
|
||||
}
|
||||
|
||||
td_elementmap :: TwoDState a -> [(TwoDPosition,(String,a))]
|
||||
td_elementmap s =
|
||||
let positions = td_availSlots s
|
||||
elements = L.filter (((td_searchString s) `isSubstringOf`) . fst) (td_elements s)
|
||||
in zipWith (,) positions elements
|
||||
where sub `isSubstringOf` string = or [ (upper sub) `isPrefixOf` t | t <- tails (upper string) ]
|
||||
generateElementmap :: TwoDState a -> X (TwoDElementMap a)
|
||||
generateElementmap s = do
|
||||
rearrangedElements <- rearranger searchString sortedElements
|
||||
return $ zip positions rearrangedElements
|
||||
where
|
||||
TwoDState {td_availSlots = positions,
|
||||
td_gsconfig = gsconfig,
|
||||
td_searchString = searchString} = s
|
||||
GSConfig {gs_rearranger = rearranger} = gsconfig
|
||||
-- Filter out any elements that don't contain the searchString (case insensitive)
|
||||
filteredElements = L.filter ((searchString `isInfixOfI`) . fst) (td_elements s)
|
||||
-- Sorts the elementmap
|
||||
sortedElements = orderElementmap searchString filteredElements
|
||||
-- Case Insensitive version of isInfixOf
|
||||
needle `isInfixOfI` haystack = (upper needle) `isInfixOf` (upper haystack)
|
||||
upper = map toUpper
|
||||
|
||||
|
||||
-- | We enforce an ordering such that we will always get the same result. If the
|
||||
-- elements position changes from call to call of gridselect, then the shown
|
||||
-- positions will also change when you search for the same string. This is
|
||||
-- especially the case when using gridselect for showing and switching between
|
||||
-- workspaces, as workspaces are usually shown in order of last visited. The
|
||||
-- chosen ordering is "how deep in the haystack the needle is" (number of
|
||||
-- characters from the beginning of the string and the needle).
|
||||
orderElementmap :: String -> [(String,a)] -> [(String,a)]
|
||||
orderElementmap searchString elements = if not $ null searchString then sortedElements else elements
|
||||
where
|
||||
upper = map toUpper
|
||||
-- Calculates a (score, element) tuple where the score is the depth of the (case insensitive) needle.
|
||||
calcScore element = ( length $ takeWhile (not . isPrefixOf (upper searchString)) (tails . upper . fst $ element)
|
||||
, element)
|
||||
-- Use the score and then the string as the parameters for comparing, making
|
||||
-- it consistent even when two strings that score the same, as it will then be
|
||||
-- sorted by the strings, making it consistent.
|
||||
compareScore = comparing (\(score, (str,_)) -> (score, str))
|
||||
sortedElements = map snd . sortBy compareScore $ map calcScore elements
|
||||
|
||||
|
||||
newtype TwoD a b = TwoD { unTwoD :: StateT (TwoDState a) X b }
|
||||
deriving (Monad,Functor,MonadState (TwoDState a))
|
||||
|
||||
@@ -303,11 +350,11 @@ updateAllElements =
|
||||
s <- get
|
||||
updateElements (td_elementmap s)
|
||||
|
||||
grayoutAllElements :: TwoD a ()
|
||||
grayoutAllElements =
|
||||
grayoutElements :: Int -> TwoD a ()
|
||||
grayoutElements skip =
|
||||
do
|
||||
s <- get
|
||||
updateElementsWithColorizer grayOnly (td_elementmap s)
|
||||
updateElementsWithColorizer grayOnly $ drop skip (td_elementmap s)
|
||||
where grayOnly _ _ = return ("#808080", "#808080")
|
||||
|
||||
updateElements :: TwoDElementMap a -> TwoD a ()
|
||||
@@ -343,7 +390,7 @@ stdHandle :: Event -> TwoD a (Maybe a) -> TwoD a (Maybe a)
|
||||
stdHandle (ButtonEvent { ev_event_type = t, ev_x = x, ev_y = y }) contEventloop
|
||||
| t == buttonRelease = do
|
||||
s @ TwoDState { td_paneX = px, td_paneY = py,
|
||||
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _) } <- get
|
||||
td_gsconfig = (GSConfig ch cw _ _ _ _ _ _ _) } <- get
|
||||
let gridX = (fi x - (px - cw) `div` 2) `div` cw
|
||||
gridY = (fi y - (py - ch) `div` 2) `div` ch
|
||||
case lookup (gridX,gridY) (td_elementmap s) of
|
||||
@@ -439,11 +486,17 @@ transformSearchString f = do
|
||||
let oldSearchString = td_searchString s
|
||||
newSearchString = f oldSearchString
|
||||
when (newSearchString /= oldSearchString) $ do
|
||||
-- FIXME: grayoutAllElements + updateAllElements paint some fields twice causing flickering
|
||||
-- we would need a much smarter update strategy to fix that
|
||||
when (length newSearchString > length oldSearchString) grayoutAllElements
|
||||
-- FIXME curpos might end up outside new bounds
|
||||
put s { td_searchString = newSearchString }
|
||||
let s' = s { td_searchString = newSearchString }
|
||||
m <- liftX $ generateElementmap s'
|
||||
let s'' = s' { td_elementmap = m }
|
||||
oldLen = length $ td_elementmap s
|
||||
newLen = length $ td_elementmap s''
|
||||
-- All the elements in the previous element map should be
|
||||
-- grayed out, except for those which will be covered by
|
||||
-- elements in the new element map.
|
||||
when (newLen < oldLen) $ grayoutElements newLen
|
||||
put s''
|
||||
updateAllElements
|
||||
|
||||
-- | By default gridselect used the defaultNavigation action, which
|
||||
@@ -594,16 +647,16 @@ gridselect _ [] = return Nothing
|
||||
gridselect gsconfig elements =
|
||||
withDisplay $ \dpy -> do
|
||||
rootw <- asks theRoot
|
||||
s <- gets $ screenRect . W.screenDetail . W.current . windowset
|
||||
scr <- gets $ screenRect . W.screenDetail . W.current . windowset
|
||||
win <- liftIO $ mkUnmanagedWindow dpy (defaultScreenOfDisplay dpy) rootw
|
||||
(rect_x s) (rect_y s) (rect_width s) (rect_height s)
|
||||
(rect_x scr) (rect_y scr) (rect_width scr) (rect_height scr)
|
||||
liftIO $ mapWindow dpy win
|
||||
liftIO $ selectInput dpy win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
|
||||
status <- io $ grabKeyboard dpy win True grabModeAsync grabModeAsync currentTime
|
||||
io $ grabButton dpy button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
|
||||
io $ grabPointer dpy win True buttonReleaseMask grabModeAsync grabModeAsync none none currentTime
|
||||
font <- initXMF (gs_font gsconfig)
|
||||
let screenWidth = toInteger $ rect_width s;
|
||||
screenHeight = toInteger $ rect_height s;
|
||||
let screenWidth = toInteger $ rect_width scr
|
||||
screenHeight = toInteger $ rect_height scr
|
||||
selectedElement <- if (status == grabSuccess) then do
|
||||
let restriction ss cs = (fromInteger ss/fromInteger (cs gsconfig)-1)/2 :: Double
|
||||
restrictX = floor $ restriction screenWidth gs_cellwidth
|
||||
@@ -611,8 +664,7 @@ gridselect gsconfig elements =
|
||||
originPosX = floor $ ((gs_originFractX gsconfig) - (1/2)) * 2 * fromIntegral restrictX
|
||||
originPosY = floor $ ((gs_originFractY gsconfig) - (1/2)) * 2 * fromIntegral restrictY
|
||||
coords = diamondRestrict restrictX restrictY originPosX originPosY
|
||||
|
||||
evalTwoD (updateAllElements >> (gs_navigate gsconfig)) TwoDState { td_curpos = (head coords),
|
||||
s = TwoDState { td_curpos = (head coords),
|
||||
td_availSlots = coords,
|
||||
td_elements = elements,
|
||||
td_gsconfig = gsconfig,
|
||||
@@ -620,12 +672,17 @@ gridselect gsconfig elements =
|
||||
td_paneX = screenWidth,
|
||||
td_paneY = screenHeight,
|
||||
td_drawingWin = win,
|
||||
td_searchString = "" }
|
||||
td_searchString = "",
|
||||
td_elementmap = [] }
|
||||
m <- generateElementmap s
|
||||
evalTwoD (updateAllElements >> (gs_navigate gsconfig))
|
||||
(s { td_elementmap = m })
|
||||
else
|
||||
return Nothing
|
||||
liftIO $ do
|
||||
unmapWindow dpy win
|
||||
destroyWindow dpy win
|
||||
ungrabPointer dpy currentTime
|
||||
sync dpy False
|
||||
releaseXMF font
|
||||
return selectedElement
|
||||
@@ -657,7 +714,7 @@ decorateName' w = do
|
||||
|
||||
-- | Builds a default gs config from a colorizer function.
|
||||
buildDefaultGSConfig :: (a -> Bool -> X (String,String)) -> GSConfig a
|
||||
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation (1/2) (1/2)
|
||||
buildDefaultGSConfig col = GSConfig 50 130 10 col "xft:Sans-8" defaultNavigation noRearranger (1/2) (1/2)
|
||||
|
||||
borderColor :: String
|
||||
borderColor = "white"
|
||||
@@ -693,6 +750,44 @@ runSelectedAction conf actions = do
|
||||
-- > gridselectWorkspace (\ws -> W.greedyView ws . W.shift ws)
|
||||
gridselectWorkspace :: GSConfig WorkspaceId ->
|
||||
(WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
||||
gridselectWorkspace conf viewFunc = withWindowSet $ \ws -> do
|
||||
gridselectWorkspace conf viewFunc = gridselectWorkspace' conf (windows . viewFunc)
|
||||
|
||||
-- | Select a workspace and run an arbitrary action on it.
|
||||
gridselectWorkspace' :: GSConfig WorkspaceId -> (WorkspaceId -> X ()) -> X ()
|
||||
gridselectWorkspace' conf func = withWindowSet $ \ws -> do
|
||||
let wss = map W.tag $ W.hidden ws ++ map W.workspace (W.current ws : W.visible ws)
|
||||
gridselect conf (zip wss wss) >>= flip whenJust (windows . viewFunc)
|
||||
gridselect conf (zip wss wss) >>= flip whenJust func
|
||||
|
||||
-- $rearrangers
|
||||
--
|
||||
-- Rearrangers allow for arbitrary post-filter rearranging of the grid
|
||||
-- elements.
|
||||
--
|
||||
-- For example, to be able to switch to a new dynamic workspace by typing
|
||||
-- in its name, you can use the following keybinding action:
|
||||
--
|
||||
-- > import XMonad.Actions.DynamicWorkspaces (addWorkspace)
|
||||
-- >
|
||||
-- > gridselectWorkspace' defaultGSConfig
|
||||
-- > { gs_navigate = navNSearch
|
||||
-- > , gs_rearranger = searchStringRearrangerGenerator id
|
||||
-- > }
|
||||
-- > addWorkspace
|
||||
|
||||
-- | A function taking the search string and a list of elements, and
|
||||
-- returning a potentially rearranged list of elements.
|
||||
type Rearranger a = String -> [(String, a)] -> X [(String, a)]
|
||||
|
||||
-- | A rearranger that leaves the elements unmodified.
|
||||
noRearranger :: Rearranger a
|
||||
noRearranger _ = return
|
||||
|
||||
-- | A generator for rearrangers that append a single element based on the
|
||||
-- search string, if doing so would not be redundant (empty string or value
|
||||
-- already present).
|
||||
searchStringRearrangerGenerator :: (String -> a) -> Rearranger a
|
||||
searchStringRearrangerGenerator f =
|
||||
let r "" xs = return $ xs
|
||||
r s xs | s `elem` map fst xs = return $ xs
|
||||
| otherwise = return $ xs ++ [(s, f s)]
|
||||
in r
|
||||
|
@@ -46,7 +46,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
Import the module into your @~\/.xmonad\/xmonad.hs@:
|
||||
|
||||
> import XMonad.Actions,GroupNavigation
|
||||
> import XMonad.Actions.GroupNavigation
|
||||
|
||||
To support cycling forward and backward through all xterm windows, add
|
||||
something like this to your keybindings:
|
||||
@@ -73,7 +73,7 @@ Finally, you can define keybindings to jump to the most recent window
|
||||
matching a certain Boolean query. To do this, you need to add
|
||||
'historyHook' to your logHook:
|
||||
|
||||
> main = xmonad $ defaultConfig { logHook = historyHook }
|
||||
> main = xmonad $ def { logHook = historyHook }
|
||||
|
||||
Then the following keybindings, for example, allow you to return to
|
||||
the most recent xterm or emacs window or to simply to the most recent
|
||||
|
123
XMonad/Actions/Launcher.hs
Normal file
123
XMonad/Actions/Launcher.hs
Normal file
@@ -0,0 +1,123 @@
|
||||
{- |
|
||||
Module : XMonad.Actions.Launcher
|
||||
Copyright : (C) 2012 Carlos López-Camey
|
||||
License : None; public domain
|
||||
|
||||
Maintainer : <c.lopez@kmels.net>
|
||||
Stability : unstable
|
||||
|
||||
A set of prompts for XMonad
|
||||
-}
|
||||
|
||||
module XMonad.Actions.Launcher(
|
||||
-- * Description and use
|
||||
-- $description
|
||||
defaultLauncherModes
|
||||
, ExtensionActions
|
||||
, LauncherConfig(..)
|
||||
, launcherPrompt
|
||||
) where
|
||||
|
||||
import Data.List (find, findIndex, isPrefixOf, tails)
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (isJust)
|
||||
import XMonad hiding (config)
|
||||
import XMonad.Prompt
|
||||
import XMonad.Util.Run
|
||||
|
||||
{- $description
|
||||
This module exemplifies usage of `XMonad.Prompt.mkXPromptWithModes`. It includes two modes:
|
||||
|
||||
* Hoogle mode: Search for functions using hoogle, choosing a function leads you to documentation in Haddock.
|
||||
|
||||
* Calc: Uses the program calc to do calculations.
|
||||
|
||||
To test it, modify your local .xmonad:
|
||||
|
||||
> import XMonad.Prompt(def)
|
||||
> import XMonad.Actions.Launcher
|
||||
|
||||
> ((modm .|. controlMask, xK_l), launcherPrompt def $ defaultLauncherModes launcherConfig)
|
||||
|
||||
A LauncherConfig contains settings for the default modes, modify them accordingly.
|
||||
|
||||
> launcherConfig = LauncherConfig { pathToHoogle = "/home/YOU/.cabal/bin/hoogle" , browser = "firefox"}
|
||||
|
||||
Restart xmonad. Press Ctrl + Your_Modkey + L and the first prompt should pop up.
|
||||
|
||||
If you used the default 'XPConfig', you can change mode with 'xK_grave'. If you are using your own 'XPConfig', define the value for 'changeModeKey'.
|
||||
-}
|
||||
|
||||
data HoogleMode = HMode FilePath String --path to hoogle and browser
|
||||
data CalculatorMode = CalcMode
|
||||
|
||||
data LauncherConfig = LauncherConfig {
|
||||
browser :: String
|
||||
, pathToHoogle :: String
|
||||
}
|
||||
|
||||
type ExtensionActions = M.Map String (String -> X())
|
||||
|
||||
-- | Uses the command `calc` to compute arithmetic expressions
|
||||
instance XPrompt CalculatorMode where
|
||||
showXPrompt CalcMode = "calc %s> "
|
||||
commandToComplete CalcMode = id --send the whole string to `calc`
|
||||
completionFunction CalcMode = \s -> if (length s == 0) then return [] else do
|
||||
fmap lines $ runProcessWithInput "calc" [s] ""
|
||||
modeAction CalcMode _ _ = return () -- do nothing; this might copy the result to the clipboard
|
||||
|
||||
-- | Uses the program `hoogle` to search for functions
|
||||
instance XPrompt HoogleMode where
|
||||
showXPrompt _ = "hoogle %s> "
|
||||
commandToComplete _ = id
|
||||
completionFunction (HMode pathToHoogleBin' _) = \s -> completionFunctionWith pathToHoogleBin' ["--count","8",s]
|
||||
-- This action calls hoogle again to find the URL corresponding to the autocompleted item
|
||||
modeAction (HMode pathToHoogleBin'' browser') query result = do
|
||||
completionsWithLink <- liftIO $ completionFunctionWith pathToHoogleBin'' ["--count","5","--link",query]
|
||||
let link = do
|
||||
s <- find (isJust . \complStr -> findSeqIndex complStr result) completionsWithLink
|
||||
i <- findSeqIndex s "http://"
|
||||
return $ drop i s
|
||||
case link of
|
||||
Just l -> spawn $ browser' ++ " " ++ l
|
||||
_ -> return ()
|
||||
where
|
||||
-- | Receives a sublist and a list. It returns the index where the sublist appears in the list.
|
||||
findSeqIndex :: (Eq a) => [a] -> [a] -> Maybe Int
|
||||
findSeqIndex xs xss = findIndex (isPrefixOf xss) $ tails xs
|
||||
|
||||
-- | Creates an autocompletion function for a programm given the program's name and a list of args to send to the command.
|
||||
completionFunctionWith :: String -> [String] -> IO [String]
|
||||
completionFunctionWith cmd args = do fmap lines $ runProcessWithInput cmd args ""
|
||||
|
||||
-- | Creates a prompt with the given modes
|
||||
launcherPrompt :: XPConfig -> [XPMode] -> X()
|
||||
launcherPrompt config modes = mkXPromptWithModes modes config
|
||||
|
||||
-- | Create a list of modes based on :
|
||||
-- a list of extensions mapped to actions
|
||||
-- the path to hoogle
|
||||
defaultLauncherModes :: LauncherConfig -> [XPMode]
|
||||
defaultLauncherModes cnf = let
|
||||
ph = pathToHoogle cnf
|
||||
in [ hoogleMode ph $ browser cnf
|
||||
, calcMode]
|
||||
|
||||
hoogleMode :: FilePath -> String -> XPMode
|
||||
hoogleMode pathToHoogleBin browser' = XPT $ HMode pathToHoogleBin browser'
|
||||
calcMode :: XPMode
|
||||
calcMode = XPT CalcMode
|
||||
|
||||
{-
|
||||
|
||||
-- ideas for XMonad.Prompt running on mode XPMultipleModes
|
||||
* Switch to mode by name of the prompt, 1. ':' at an empty(?) buffer, 2. autocomplete name in buffer should happen, 3. switch to mode with enter (cancel switch with C-g)
|
||||
|
||||
* Support for actions of type String -> X a
|
||||
|
||||
-- ideas for this module
|
||||
|
||||
* Hoogle mode: add a setting in the action to either go to documentation or to the source code (needs hoogle change?)
|
||||
|
||||
* Hoogle mode: add setting to query hoogle at haskell.org instead (with &mode=json)
|
||||
-}
|
169
XMonad/Actions/LinkWorkspaces.hs
Normal file
169
XMonad/Actions/LinkWorkspaces.hs
Normal file
@@ -0,0 +1,169 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.LinkWorkspaces
|
||||
-- Copyright : (c) Jan-David Quesel <quesel@gmail.org>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : none
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Provides bindings to add and delete links between workspaces. It is aimed
|
||||
-- at providing useful links between workspaces in a multihead setup. Linked
|
||||
-- workspaces are view at the same time.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
module XMonad.Actions.LinkWorkspaces (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
switchWS,
|
||||
removeAllMatchings,
|
||||
unMatch,
|
||||
toggleLinkWorkspaces,
|
||||
defaultMessageConf,
|
||||
MessageConfig(..)
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Layout.IndependentScreens(countScreens)
|
||||
import qualified XMonad.Util.ExtensibleState as XS (get, put)
|
||||
import XMonad.Actions.OnScreen(Focus(FocusCurrent), onScreen')
|
||||
import qualified Data.Map as M
|
||||
( insert, delete, Map, lookup, empty, filter )
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Actions.LinkWorkspaces
|
||||
--
|
||||
-- and add a function to print messages like
|
||||
--
|
||||
-- > message_command (S screen) = " dzen2 -p 1 -w 300 -xs " ++ show (screen + 1)
|
||||
-- > message_color_func c1 c2 msg = dzenColor c1 c2 msg
|
||||
-- > message screen c1 c2 msg = spawn $ "echo '" ++ (message_color_func c1 c2 msg) ++ "' | " ++ message_command screen
|
||||
--
|
||||
-- alternatively you can use the noMessages function as the argument
|
||||
--
|
||||
-- Then add keybindings like the following:
|
||||
--
|
||||
-- > ,((modm, xK_p), toggleLinkWorkspaces message)
|
||||
-- > ,((modm .|. shiftMask, xK_p), removeAllMatchings message)
|
||||
--
|
||||
-- > [ ((modm .|. m, k), a i)
|
||||
-- > | (a, m) <- [(switchWS (\y -> windows $ view y) message, 0),(switchWS (\x -> windows $ shift x . view x) message, shiftMask)]
|
||||
-- > , (i, k) <- zip (XMonad.workspaces conf) [xK_1 .. xK_9]]
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
data MessageConfig = MessageConfig { messageFunction :: (ScreenId -> [Char] -> [Char] -> [Char] -> X())
|
||||
, foreground :: [Char]
|
||||
, alertedForeground :: [Char]
|
||||
, background :: [Char]
|
||||
}
|
||||
|
||||
defaultMessageConf :: MessageConfig
|
||||
defaultMessageConf = MessageConfig { messageFunction = noMessageFn
|
||||
, background = "#000000"
|
||||
, alertedForeground = "#ff7701"
|
||||
, foreground = "#00ff00" }
|
||||
|
||||
noMessageFn :: ScreenId -> [Char] -> [Char] -> [Char] -> X()
|
||||
noMessageFn _ _ _ _ = return () :: X ()
|
||||
|
||||
-- | Stuff for linking workspaces
|
||||
data WorkspaceMap = WorkspaceMap (M.Map WorkspaceId WorkspaceId) deriving (Read, Show, Typeable)
|
||||
instance ExtensionClass WorkspaceMap
|
||||
where initialValue = WorkspaceMap M.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
switchWS :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> X ()
|
||||
switchWS f m ws = switchWS' f m ws Nothing
|
||||
|
||||
-- | Switch to the given workspace in a non greedy way, stop if we reached the first screen
|
||||
-- | we already did switching on
|
||||
switchWS' :: (WorkspaceId -> X ()) -> MessageConfig -> WorkspaceId -> (Maybe ScreenId) -> X ()
|
||||
switchWS' switchFn message workspace stopAtScreen = do
|
||||
ws <- gets windowset
|
||||
nScreens <- countScreens
|
||||
let now = W.screen (W.current ws)
|
||||
let next = ((now + 1) `mod` nScreens)
|
||||
switchFn workspace
|
||||
case stopAtScreen of
|
||||
Nothing -> sTM now next (Just now)
|
||||
Just sId -> if sId == next then return () else sTM now next (Just sId)
|
||||
where sTM = switchToMatching (switchWS' switchFn message) message workspace
|
||||
|
||||
-- | Switch to the workspace that matches the current one, executing switches for that workspace as well.
|
||||
-- | The function switchWorkspaceNonGreedy' will take of stopping if we reached the first workspace again.
|
||||
switchToMatching :: (WorkspaceId -> (Maybe ScreenId) -> X ()) -> MessageConfig -> WorkspaceId -> ScreenId
|
||||
-> ScreenId -> (Maybe ScreenId) -> X ()
|
||||
switchToMatching f message t now next stopAtScreen = do
|
||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||
case (M.lookup t matchings) of
|
||||
Nothing -> return () :: X()
|
||||
Just newWorkspace -> do
|
||||
onScreen' (f newWorkspace stopAtScreen) FocusCurrent next
|
||||
messageFunction message now (foreground message) (background message) ("Switching to: " ++ (t ++ " and " ++ newWorkspace))
|
||||
|
||||
-- | Insert a mapping between t1 and t2 or remove it was already present
|
||||
toggleMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> X ()
|
||||
toggleMatching message t1 t2 = do
|
||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||
case (M.lookup t1 matchings) of
|
||||
Nothing -> setMatching message t1 t2 matchings
|
||||
Just t -> if t == t2 then removeMatching' message t1 t2 matchings else setMatching message t1 t2 matchings
|
||||
return ()
|
||||
|
||||
-- | Insert a mapping between t1 and t2 and display a message
|
||||
setMatching :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
|
||||
setMatching message t1 t2 matchings = do
|
||||
ws <- gets windowset
|
||||
let now = W.screen (W.current ws)
|
||||
XS.put $ WorkspaceMap $ M.insert t1 t2 matchings
|
||||
messageFunction message now (foreground message) (background message) ("Linked: " ++ (t1 ++ " " ++ t2))
|
||||
|
||||
-- currently this function is called manually this means that if workspaces
|
||||
-- were deleted, some links stay in the RAM even though they are not used
|
||||
-- anymore... because of the small amount of memory used for those there is no
|
||||
-- special cleanup so far
|
||||
removeMatching' :: MessageConfig -> WorkspaceId -> WorkspaceId -> M.Map WorkspaceId WorkspaceId -> X ()
|
||||
removeMatching' message t1 t2 matchings = do
|
||||
ws <- gets windowset
|
||||
let now = W.screen (W.current ws)
|
||||
XS.put $ WorkspaceMap $ M.delete t1 matchings
|
||||
messageFunction message now (alertedForeground message) (background message) ("Unlinked: " ++ t1 ++ " " ++ t2)
|
||||
|
||||
-- | Remove all maps between workspaces
|
||||
removeAllMatchings :: MessageConfig -> X ()
|
||||
removeAllMatchings message = do
|
||||
ws <- gets windowset
|
||||
let now = W.screen (W.current ws)
|
||||
XS.put $ WorkspaceMap $ M.empty
|
||||
messageFunction message now (alertedForeground message) (background message) "All links removed!"
|
||||
|
||||
-- | remove all matching regarding a given workspace
|
||||
unMatch :: WorkspaceId -> X ()
|
||||
unMatch workspace = do
|
||||
WorkspaceMap matchings <- XS.get :: X WorkspaceMap
|
||||
XS.put $ WorkspaceMap $ M.delete workspace (M.filter (/= workspace) matchings)
|
||||
|
||||
-- | Toggle the currently displayed workspaces as matching. Starting from the one with focus
|
||||
-- | a linked list of workspaces is created that will later be iterated by switchToMatching.
|
||||
toggleLinkWorkspaces :: MessageConfig -> X ()
|
||||
toggleLinkWorkspaces message = withWindowSet $ \ws -> toggleLinkWorkspaces' (W.screen (W.current ws)) message
|
||||
|
||||
toggleLinkWorkspaces' :: ScreenId -> MessageConfig -> X ()
|
||||
toggleLinkWorkspaces' first message = do
|
||||
ws <- gets windowset
|
||||
nScreens <- countScreens
|
||||
let now = W.screen (W.current ws)
|
||||
let next = (now + 1) `mod` nScreens
|
||||
if next == first then return () else do -- this is also the case if there is only one screen
|
||||
case (W.lookupWorkspace next ws) of
|
||||
Nothing -> return ()
|
||||
Just name -> toggleMatching message (W.currentTag ws) (name)
|
||||
onScreen' (toggleLinkWorkspaces' first message) FocusCurrent next
|
@@ -43,11 +43,11 @@ import XMonad.Util.XUtils
|
||||
--
|
||||
-- Then edit your @layoutHook@ by modifying a given layout:
|
||||
--
|
||||
-- > myLayout = mouseResize $ windowArrange $ layoutHook defaultConfig
|
||||
-- > myLayout = mouseResize $ windowArrange $ layoutHook def
|
||||
--
|
||||
-- and then:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
884
XMonad/Actions/Navigation2D.hs
Normal file
884
XMonad/Actions/Navigation2D.hs
Normal file
@@ -0,0 +1,884 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, MultiParamTypeClasses, PatternGuards, RankNTypes, TypeSynonymInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.Navigation2D
|
||||
-- Copyright : (c) 2011 Norbert Zeh <nzeh@cs.dal.ca>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Norbert Zeh <nzeh@cs.dal.ca>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Navigation2D is an xmonad extension that allows easy directional
|
||||
-- navigation of windows and screens (in a multi-monitor setup).
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.Navigation2D ( -- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Finer points
|
||||
-- $finer_points
|
||||
|
||||
-- * Alternative directional navigation modules
|
||||
-- $alternatives
|
||||
|
||||
-- * Incompatibilities
|
||||
-- $incompatibilities
|
||||
|
||||
-- * Detailed technical discussion
|
||||
-- $technical
|
||||
|
||||
-- * Exported functions and types
|
||||
-- #Exports#
|
||||
|
||||
navigation2D
|
||||
, navigation2DP
|
||||
, additionalNav2DKeys
|
||||
, additionalNav2DKeysP
|
||||
, withNavigation2DConfig
|
||||
, Navigation2DConfig(..)
|
||||
, def
|
||||
, defaultNavigation2DConfig
|
||||
, Navigation2D
|
||||
, lineNavigation
|
||||
, centerNavigation
|
||||
, hybridNavigation
|
||||
, fullScreenRect
|
||||
, singleWindowRect
|
||||
, switchLayer
|
||||
, windowGo
|
||||
, windowSwap
|
||||
, windowToScreen
|
||||
, screenGo
|
||||
, screenSwap
|
||||
, Direction2D(..)
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import qualified Data.List as L
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import XMonad hiding (Screen)
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.EZConfig (additionalKeys, additionalKeysP)
|
||||
import XMonad.Util.Types
|
||||
|
||||
-- $usage
|
||||
-- #Usage#
|
||||
-- Navigation2D provides directional navigation (go left, right, up, down) for
|
||||
-- windows and screens. It treats floating and tiled windows as two separate
|
||||
-- layers and provides mechanisms to navigate within each layer and to switch
|
||||
-- between layers. Navigation2D provides two different navigation strategies
|
||||
-- (see <#Technical_Discussion> for details): /Line navigation/ feels rather
|
||||
-- natural but may make it impossible to navigate to a given window from the
|
||||
-- current window, particularly in the floating layer. /Center navigation/
|
||||
-- feels less natural in certain situations but ensures that all windows can be
|
||||
-- reached without the need to involve the mouse. A third option is to use
|
||||
-- /Hybrid navigation/, which automatically chooses between the two whenever
|
||||
-- navigation is attempted. Navigation2D allows different navigation strategies
|
||||
-- to be used in the two layers and allows customization of the navigation strategy
|
||||
-- for the tiled layer based on the layout currently in effect.
|
||||
--
|
||||
-- You can use this module with (a subset of) the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.Navigation2D
|
||||
--
|
||||
-- Then add the configuration of the module to your main function:
|
||||
--
|
||||
-- > main = xmonad $ navigation2D def
|
||||
-- > (xK_Up, xK_Left, xK_Down, xK_Right)
|
||||
-- > [(mod4Mask, windowGo ),
|
||||
-- > (mod4Mask .|. shiftMask, windowSwap)]
|
||||
-- > False
|
||||
-- > $ def
|
||||
--
|
||||
-- Alternatively, you can use navigation2DP:
|
||||
--
|
||||
-- > main = xmonad $ navigation2D def
|
||||
-- > ("<Up>", "<Left>", "<Down>", "<Right>")
|
||||
-- > [("M-", windowGo ),
|
||||
-- > ("M-S-", windowSwap)]
|
||||
-- > False
|
||||
-- > $ def
|
||||
--
|
||||
-- That's it. If instead you'd like more control, you can combine
|
||||
-- withNavigation2DConfig and additionalNav2DKeys or additionalNav2DKeysP:
|
||||
--
|
||||
-- > main = xmonad $ withNavigation2DConfig def
|
||||
-- > $ additionalNav2DKeys (xK_Up, xK_Left, xK_Down, xK_Right)
|
||||
-- > [(mod4Mask, windowGo ),
|
||||
-- > (mod4Mask .|. shiftMask, windowSwap)]
|
||||
-- > False
|
||||
-- > $ additionalNav2DKeys (xK_u, xK_l, xK_d, xK_r)
|
||||
-- > [(mod4Mask, screenGo ),
|
||||
-- > (mod4Mask .|. shiftMask, screenSwap)]
|
||||
-- > False
|
||||
-- > $ def
|
||||
--
|
||||
-- Or you can add the configuration of the module to your main function:
|
||||
--
|
||||
-- > main = xmonad $ withNavigation2DConfig def $ def
|
||||
--
|
||||
-- And specify your keybindings normally:
|
||||
--
|
||||
-- > -- Switch between layers
|
||||
-- > , ((modm, xK_space), switchLayer)
|
||||
-- >
|
||||
-- > -- Directional navigation of windows
|
||||
-- > , ((modm, xK_Right), windowGo R False)
|
||||
-- > , ((modm, xK_Left ), windowGo L False)
|
||||
-- > , ((modm, xK_Up ), windowGo U False)
|
||||
-- > , ((modm, xK_Down ), windowGo D False)
|
||||
-- >
|
||||
-- > -- Swap adjacent windows
|
||||
-- > , ((modm .|. controlMask, xK_Right), windowSwap R False)
|
||||
-- > , ((modm .|. controlMask, xK_Left ), windowSwap L False)
|
||||
-- > , ((modm .|. controlMask, xK_Up ), windowSwap U False)
|
||||
-- > , ((modm .|. controlMask, xK_Down ), windowSwap D False)
|
||||
-- >
|
||||
-- > -- Directional navigation of screens
|
||||
-- > , ((modm, xK_r ), screenGo R False)
|
||||
-- > , ((modm, xK_l ), screenGo L False)
|
||||
-- > , ((modm, xK_u ), screenGo U False)
|
||||
-- > , ((modm, xK_d ), screenGo D False)
|
||||
-- >
|
||||
-- > -- Swap workspaces on adjacent screens
|
||||
-- > , ((modm .|. controlMask, xK_r ), screenSwap R False)
|
||||
-- > , ((modm .|. controlMask, xK_l ), screenSwap L False)
|
||||
-- > , ((modm .|. controlMask, xK_u ), screenSwap U False)
|
||||
-- > , ((modm .|. controlMask, xK_d ), screenSwap D False)
|
||||
-- >
|
||||
-- > -- Send window to adjacent screen
|
||||
-- > , ((modm .|. mod1Mask, xK_r ), windowToScreen R False)
|
||||
-- > , ((modm .|. mod1Mask, xK_l ), windowToScreen L False)
|
||||
-- > , ((modm .|. mod1Mask, xK_u ), windowToScreen U False)
|
||||
-- > , ((modm .|. mod1Mask, xK_d ), windowToScreen D False)
|
||||
--
|
||||
-- For detailed instruction on editing the key binding see:
|
||||
--
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
-- $finer_points
|
||||
-- #Finer_Points#
|
||||
-- The above should get you started. Here are some finer points:
|
||||
--
|
||||
-- Navigation2D has the ability to wrap around at screen edges. For example, if
|
||||
-- you navigated to the rightmost window on the rightmost screen and you
|
||||
-- continued to go right, this would get you to the leftmost window on the
|
||||
-- leftmost screen. This feature may be useful for switching between screens
|
||||
-- that are far apart but may be confusing at least to novice users. Therefore,
|
||||
-- it is disabled in the above example (e.g., navigation beyond the rightmost
|
||||
-- window on the rightmost screen is not possible and trying to do so will
|
||||
-- simply not do anything.) If you want this feature, change all the 'False'
|
||||
-- values in the above example to 'True'. You could also decide you want
|
||||
-- wrapping only for a subset of the operations and no wrapping for others.
|
||||
--
|
||||
-- By default, all layouts use the 'defaultTiledNavigation' strategy specified
|
||||
-- in the 'Navigation2DConfig' (by default, line navigation is used). To
|
||||
-- override this behaviour for some layouts, add a pair (\"layout name\",
|
||||
-- navigation strategy) to the 'layoutNavigation' list in the
|
||||
-- 'Navigation2DConfig', where \"layout name\" is the string reported by the
|
||||
-- layout's description method (normally what is shown as the layout name in
|
||||
-- your status bar). For example, all navigation strategies normally allow only
|
||||
-- navigation between mapped windows. The first step to overcome this, for
|
||||
-- example, for the Full layout, is to switch to center navigation for the Full
|
||||
-- layout:
|
||||
--
|
||||
-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)] }
|
||||
-- >
|
||||
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- The navigation between windows is based on their screen rectangles, which are
|
||||
-- available /and meaningful/ only for mapped windows. Thus, as already said,
|
||||
-- the default is to allow navigation only between mapped windows. However,
|
||||
-- there are layouts that do not keep all windows mapped. One example is the
|
||||
-- Full layout, which unmaps all windows except the one that has the focus,
|
||||
-- thereby preventing navigation to any other window in the layout. To make
|
||||
-- navigation to unmapped windows possible, unmapped windows need to be assigned
|
||||
-- rectangles to pretend they are mapped, and a natural way to do this for the
|
||||
-- Full layout is to pretend all windows occupy the full screen and are stacked
|
||||
-- on top of each other so that only the frontmost one is visible. This can be
|
||||
-- done as follows:
|
||||
--
|
||||
-- > myNavigation2DConfig = def { layoutNavigation = [("Full", centerNavigation)]
|
||||
-- > , unmappedWindowRect = [("Full", singleWindowRect)]
|
||||
-- > }
|
||||
-- >
|
||||
-- > main = xmonad $ withNavigation2DConfig myNavigation2DConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- With this setup, Left/Up navigation behaves like standard
|
||||
-- 'XMonad.StackSet.focusUp' and Right/Down navigation behaves like
|
||||
-- 'XMonad.StackSet.focusDown', thus allowing navigation between windows in the
|
||||
-- layout.
|
||||
--
|
||||
-- In general, each entry in the 'unmappedWindowRect' association list is a pair
|
||||
-- (\"layout description\", function), where the function computes a rectangle
|
||||
-- for each unmapped window from the screen it is on and the window ID.
|
||||
-- Currently, Navigation2D provides only two functions of this type:
|
||||
-- 'singleWindowRect' and 'fullScreenRect'.
|
||||
--
|
||||
-- With per-layout navigation strategies, if different layouts are in effect on
|
||||
-- different screens in a multi-monitor setup, and different navigation
|
||||
-- strategies are defined for these active layouts, the most general of these
|
||||
-- navigation strategies is used across all screens (because Navigation2D does
|
||||
-- not distinguish between windows on different workspaces), where center
|
||||
-- navigation is more general than line navigation, as discussed formally under
|
||||
-- <#Technical_Discussion>.
|
||||
|
||||
-- $alternatives
|
||||
-- #Alternatives#
|
||||
--
|
||||
-- There exist two alternatives to Navigation2D:
|
||||
-- "XMonad.Actions.WindowNavigation" and "XMonad.Layout.WindowNavigation".
|
||||
-- X.L.WindowNavigation has the advantage of colouring windows to indicate the
|
||||
-- window that would receive the focus in each navigation direction, but it does
|
||||
-- not support navigation across multiple monitors, does not support directional
|
||||
-- navigation of floating windows, and has a very unintuitive definition of
|
||||
-- which window receives the focus next in each direction. X.A.WindowNavigation
|
||||
-- does support navigation across multiple monitors but does not provide window
|
||||
-- colouring while retaining the unintuitive navigational semantics of
|
||||
-- X.L.WindowNavigation. This makes it very difficult to predict which window
|
||||
-- receives the focus next. Neither X.A.WindowNavigation nor
|
||||
-- X.L.WindowNavigation supports directional navigation of screens.
|
||||
|
||||
-- $technical
|
||||
-- #Technical_Discussion#
|
||||
-- An in-depth discussion of the navigational strategies implemented in
|
||||
-- Navigation2D, including formal proofs of their properties, can be found
|
||||
-- at <http://www.cs.dal.ca/~nzeh/xmonad/Navigation2D.pdf>.
|
||||
|
||||
-- $incompatibilities
|
||||
-- #Incompatibilities#
|
||||
-- Currently Navigation2D is known not to play nicely with tabbed layouts, but
|
||||
-- it should work well with any other tiled layout. My hope is to address the
|
||||
-- incompatibility with tabbed layouts in a future version. The navigation to
|
||||
-- unmapped windows, for example in a Full layout, by assigning rectangles to
|
||||
-- unmapped windows is more a workaround than a clean solution. Figuring out
|
||||
-- how to deal with tabbed layouts may also lead to a more general and cleaner
|
||||
-- solution to query the layout for a window's rectangle that may make this
|
||||
-- workaround unnecessary. At that point, the 'unmappedWindowRect' field of the
|
||||
-- 'Navigation2DConfig' will disappear.
|
||||
|
||||
-- | A rectangle paired with an object
|
||||
type Rect a = (a, Rectangle)
|
||||
|
||||
-- | A shorthand for window-rectangle pairs. Reduces typing.
|
||||
type WinRect = Rect Window
|
||||
|
||||
-- | A shorthand for workspace-rectangle pairs. Reduces typing.
|
||||
type WSRect = Rect WorkspaceId
|
||||
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- PUBLIC INTERFACE --
|
||||
-- --
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
|
||||
-- | Encapsulates the navigation strategy
|
||||
data Navigation2D = N Generality (forall a . Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a)
|
||||
|
||||
runNav :: forall a . Eq a => Navigation2D -> (Direction2D -> Rect a -> [Rect a] -> Maybe a)
|
||||
runNav (N _ nav) = nav
|
||||
|
||||
-- | Score that indicates how general a navigation strategy is
|
||||
type Generality = Int
|
||||
|
||||
instance Eq Navigation2D where
|
||||
(N x _) == (N y _) = x == y
|
||||
|
||||
instance Ord Navigation2D where
|
||||
(N x _) <= (N y _) = x <= y
|
||||
|
||||
-- | Line navigation. To illustrate this navigation strategy, consider
|
||||
-- navigating to the left from the current window. In this case, we draw a
|
||||
-- horizontal line through the center of the current window and consider all
|
||||
-- windows that intersect this horizontal line and whose right boundaries are to
|
||||
-- the left of the left boundary of the current window. From among these
|
||||
-- windows, we choose the one with the rightmost right boundary.
|
||||
lineNavigation :: Navigation2D
|
||||
lineNavigation = N 1 doLineNavigation
|
||||
|
||||
-- | Center navigation. Again, consider navigating to the left. Then we
|
||||
-- consider the cone bounded by the two rays shot at 45-degree angles in
|
||||
-- north-west and south-west direction from the center of the current window. A
|
||||
-- window is a candidate to receive the focus if its center lies in this cone.
|
||||
-- We choose the window whose center has minimum L1-distance from the current
|
||||
-- window center. The tie breaking strategy for windows with the same distance
|
||||
-- is a bit complicated (see <#Technical_Discussion>) but ensures that all
|
||||
-- windows can be reached and that windows with the same center are traversed in
|
||||
-- their order in the window stack, that is, in the order
|
||||
-- 'XMonad.StackSet.focusUp' and 'XMonad.StackSet.focusDown' would traverse
|
||||
-- them.
|
||||
centerNavigation :: Navigation2D
|
||||
centerNavigation = N 2 doCenterNavigation
|
||||
|
||||
-- | Hybrid navigation. This attempts Line navigation, then falls back on Center
|
||||
-- navigation if it does not find any suitable target windows. This is useful since
|
||||
-- Line navigation tends to fail on gaps, but provides more intuitive motions
|
||||
-- when it succeeds—provided there are no floating windows.
|
||||
hybridNavigation :: Navigation2D
|
||||
hybridNavigation = N 2 doHybridNavigation
|
||||
|
||||
-- | Stores the configuration of directional navigation. The 'Default' instance
|
||||
-- uses line navigation for the tiled layer and for navigation between screens,
|
||||
-- and center navigation for the float layer. No custom navigation strategies
|
||||
-- or rectangles for unmapped windows are defined for individual layouts.
|
||||
data Navigation2DConfig = Navigation2DConfig
|
||||
{ defaultTiledNavigation :: Navigation2D -- ^ default navigation strategy for the tiled layer
|
||||
, floatNavigation :: Navigation2D -- ^ navigation strategy for the float layer
|
||||
, screenNavigation :: Navigation2D -- ^ strategy for navigation between screens
|
||||
, layoutNavigation :: [(String, Navigation2D)] -- ^ association list of customized navigation strategies
|
||||
-- for different layouts in the tiled layer. Each pair
|
||||
-- is of the form (\"layout description\", navigation
|
||||
-- strategy). If there is no pair in this list whose first
|
||||
-- component is the name of the current layout, the
|
||||
-- 'defaultTiledNavigation' strategy is used.
|
||||
, unmappedWindowRect :: [(String, Screen -> Window -> X (Maybe Rectangle))]
|
||||
-- ^ list associating functions to calculate rectangles
|
||||
-- for unmapped windows with layouts to which they are
|
||||
-- to be applied. Each pair in this list is of
|
||||
-- the form (\"layout description\", function), where the
|
||||
-- function calculates a rectangle for a given unmapped
|
||||
-- window from the screen it is on and its window ID.
|
||||
-- See <#Finer_Points> for how to use this.
|
||||
} deriving Typeable
|
||||
|
||||
-- | Shorthand for the tedious screen type
|
||||
type Screen = W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail
|
||||
|
||||
-- | Convenience function for enabling Navigation2D with typical keybindings.
|
||||
-- Takes a Navigation2DConfig, an (up, left, down, right) tuple, a mapping from
|
||||
-- modifier key to action, and a bool to indicate if wrapping should occur, and
|
||||
-- returns a function from XConfig to XConfig.
|
||||
-- Example:
|
||||
--
|
||||
-- > navigation2D def (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
|
||||
navigation2D :: Navigation2DConfig -> (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
|
||||
Bool -> XConfig l -> XConfig l
|
||||
navigation2D navConfig (u, l, d, r) modifiers wrap xconfig =
|
||||
additionalNav2DKeys (u, l, d, r) modifiers wrap $
|
||||
withNavigation2DConfig navConfig xconfig
|
||||
|
||||
-- | Convenience function for enabling Navigation2D with typical keybindings,
|
||||
-- using the syntax defined in 'XMonad.Util.EZConfig.mkKeymap'. Takes a
|
||||
-- Navigation2DConfig, an (up, left, down, right) tuple, a mapping from key
|
||||
-- prefix to action, and a bool to indicate if wrapping should occur, and
|
||||
-- returns a function from XConfig to XConfig. Example:
|
||||
--
|
||||
-- > navigation2DP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
|
||||
navigation2DP :: Navigation2DConfig -> (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
|
||||
Bool -> XConfig l -> XConfig l
|
||||
navigation2DP navConfig (u, l, d, r) modifiers wrap xconfig =
|
||||
additionalNav2DKeysP (u, l, d, r) modifiers wrap $
|
||||
withNavigation2DConfig navConfig xconfig
|
||||
|
||||
-- | Convenience function for adding keybindings. Takes an (up, left, down,
|
||||
-- right) tuple, a mapping from key prefix to action, and a bool to indicate if
|
||||
-- wrapping should occur, and returns a function from XConfig to XConfig.
|
||||
-- Example:
|
||||
--
|
||||
-- > additionalNav2DKeys (xK_w, xK_a, xK_s, xK_d) [(mod4Mask, windowGo), (mod4Mask .|. shiftMask, windowSwap)] False myConfig
|
||||
additionalNav2DKeys :: (KeySym, KeySym, KeySym, KeySym) -> [(ButtonMask, Direction2D -> Bool -> X ())] ->
|
||||
Bool -> XConfig l -> XConfig l
|
||||
additionalNav2DKeys (u, l, d, r) modifiers wrap =
|
||||
flip additionalKeys [((modif, k), func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
|
||||
where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
|
||||
|
||||
-- | Convenience function for adding keybindings, using the syntax defined in
|
||||
-- 'XMonad.Util.EZConfig.mkKeymap'. Takes an (up, left, down, right) tuple, a
|
||||
-- mapping from key prefix to action, and a bool to indicate if wrapping should
|
||||
-- occur, and returns a function from XConfig to XConfig. Example:
|
||||
--
|
||||
-- > additionalNav2DKeysP def ("w", "a", "s", "d") [("M-", windowGo), ("M-S-", windowSwap)] False myConfig
|
||||
additionalNav2DKeysP :: (String, String, String, String) -> [(String, Direction2D -> Bool -> X ())] ->
|
||||
Bool -> XConfig l -> XConfig l
|
||||
additionalNav2DKeysP (u, l, d, r) modifiers wrap =
|
||||
flip additionalKeysP [(modif ++ k, func dir wrap) | (modif, func) <- modifiers, (k, dir) <- dirKeys]
|
||||
where dirKeys = [(u, U), (l, L), (d, D), (r, R)]
|
||||
|
||||
-- So we can store the configuration in extensible state
|
||||
instance ExtensionClass Navigation2DConfig where
|
||||
initialValue = def
|
||||
|
||||
-- | Modifies the xmonad configuration to store the Navigation2D configuration
|
||||
withNavigation2DConfig :: Navigation2DConfig -> XConfig a -> XConfig a
|
||||
withNavigation2DConfig conf2d xconf = xconf { startupHook = startupHook xconf
|
||||
>> XS.put conf2d
|
||||
}
|
||||
|
||||
{-# DEPRECATED defaultNavigation2DConfig "Use def (from Data.Default, and re-exported from XMonad.Actions.Navigation2D) instead." #-}
|
||||
defaultNavigation2DConfig :: Navigation2DConfig
|
||||
defaultNavigation2DConfig = def
|
||||
|
||||
instance Default Navigation2DConfig where
|
||||
def = Navigation2DConfig { defaultTiledNavigation = lineNavigation
|
||||
, floatNavigation = centerNavigation
|
||||
, screenNavigation = lineNavigation
|
||||
, layoutNavigation = []
|
||||
, unmappedWindowRect = []
|
||||
}
|
||||
|
||||
-- | Switches focus to the closest window in the other layer (floating if the
|
||||
-- current window is tiled, tiled if the current window is floating). Closest
|
||||
-- means that the L1-distance between the centers of the windows is minimized.
|
||||
switchLayer :: X ()
|
||||
switchLayer = actOnLayer otherLayer
|
||||
( \ _ cur wins -> windows
|
||||
$ doFocusClosestWindow cur wins
|
||||
)
|
||||
( \ _ cur wins -> windows
|
||||
$ doFocusClosestWindow cur wins
|
||||
)
|
||||
( \ _ _ _ -> return () )
|
||||
False
|
||||
|
||||
-- | Moves the focus to the next window in the given direction and in the same
|
||||
-- layer as the current window. The second argument indicates whether
|
||||
-- navigation should wrap around (e.g., from the left edge of the leftmost
|
||||
-- screen to the right edge of the rightmost screen).
|
||||
windowGo :: Direction2D -> Bool -> X ()
|
||||
windowGo dir wrap = actOnLayer thisLayer
|
||||
( \ conf cur wins -> windows
|
||||
$ doTiledNavigation conf dir W.focusWindow cur wins
|
||||
)
|
||||
( \ conf cur wins -> windows
|
||||
$ doFloatNavigation conf dir W.focusWindow cur wins
|
||||
)
|
||||
( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.view cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Swaps the current window with the next window in the given direction and in
|
||||
-- the same layer as the current window. (In the floating layer, all that
|
||||
-- changes for the two windows is their stacking order if they're on the same
|
||||
-- screen. If they're on different screens, each window is moved to the other
|
||||
-- window's screen but retains its position and size relative to the screen.)
|
||||
-- The second argument indicates wrapping (see 'windowGo').
|
||||
windowSwap :: Direction2D -> Bool -> X ()
|
||||
windowSwap dir wrap = actOnLayer thisLayer
|
||||
( \ conf cur wins -> windows
|
||||
$ doTiledNavigation conf dir swap cur wins
|
||||
)
|
||||
( \ conf cur wins -> windows
|
||||
$ doFloatNavigation conf dir swap cur wins
|
||||
)
|
||||
( \ _ _ _ -> return () )
|
||||
wrap
|
||||
|
||||
-- | Moves the current window to the next screen in the given direction. The
|
||||
-- second argument indicates wrapping (see 'windowGo').
|
||||
windowToScreen :: Direction2D -> Bool -> X ()
|
||||
windowToScreen dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.shift cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Moves the focus to the next screen in the given direction. The second
|
||||
-- argument indicates wrapping (see 'windowGo').
|
||||
screenGo :: Direction2D -> Bool -> X ()
|
||||
screenGo dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.view cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Swaps the workspace on the current screen with the workspace on the screen
|
||||
-- in the given direction. The second argument indicates wrapping (see
|
||||
-- 'windowGo').
|
||||
screenSwap :: Direction2D -> Bool -> X ()
|
||||
screenSwap dir wrap = actOnScreens ( \ conf cur wspcs -> windows
|
||||
$ doScreenNavigation conf dir W.greedyView cur wspcs
|
||||
)
|
||||
wrap
|
||||
|
||||
-- | Maps each window to a fullscreen rect. This may not be the same rectangle the
|
||||
-- window maps to under the Full layout or a similar layout if the layout
|
||||
-- respects statusbar struts. In such cases, it may be better to use
|
||||
-- 'singleWindowRect'.
|
||||
fullScreenRect :: Screen -> Window -> X (Maybe Rectangle)
|
||||
fullScreenRect scr _ = return (Just . screenRect . W.screenDetail $ scr)
|
||||
|
||||
-- | Maps each window to the rectangle it would receive if it was the only
|
||||
-- window in the layout. Useful, for example, for determining the default
|
||||
-- rectangle for unmapped windows in a Full layout that respects statusbar
|
||||
-- struts.
|
||||
singleWindowRect :: Screen -> Window -> X (Maybe Rectangle)
|
||||
singleWindowRect scr win = listToMaybe
|
||||
. map snd
|
||||
. fst
|
||||
<$> runLayout ((W.workspace scr) { W.stack = W.differentiate [win] })
|
||||
(screenRect . W.screenDetail $ scr)
|
||||
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- PRIVATE X ACTIONS --
|
||||
-- --
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
|
||||
-- | Acts on the appropriate layer using the given action functions
|
||||
actOnLayer :: ([WinRect] -> [WinRect] -> [WinRect]) -- ^ Chooses which layer to operate on, relative
|
||||
-- to the current window (same or other layer)
|
||||
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the tiled layer
|
||||
-> (Navigation2DConfig -> WinRect -> [WinRect] -> X ()) -- ^ The action for the float layer
|
||||
-> (Navigation2DConfig -> WSRect -> [WSRect] -> X ()) -- ^ The action if the current workspace is empty
|
||||
-> Bool -- ^ Should navigation wrap around screen edges?
|
||||
-> X ()
|
||||
actOnLayer choice tiledact floatact wsact wrap = withWindowSet $ \winset -> do
|
||||
conf <- XS.get
|
||||
(floating, tiled) <- navigableWindows conf wrap winset
|
||||
let cur = W.peek winset
|
||||
case cur of
|
||||
Nothing -> actOnScreens wsact wrap
|
||||
Just w | Just rect <- L.lookup w tiled -> tiledact conf (w, rect) (choice tiled floating)
|
||||
| Just rect <- L.lookup w floating -> floatact conf (w, rect) (choice floating tiled)
|
||||
| otherwise -> return ()
|
||||
|
||||
-- | Returns the list of windows on the currently visible workspaces
|
||||
navigableWindows :: Navigation2DConfig -> Bool -> WindowSet -> X ([WinRect], [WinRect])
|
||||
navigableWindows conf wrap winset = L.partition (\(win, _) -> M.member win (W.floating winset))
|
||||
. addWrapping winset wrap
|
||||
. catMaybes
|
||||
. concat
|
||||
<$>
|
||||
( mapM ( \scr -> mapM (maybeWinRect scr)
|
||||
$ W.integrate'
|
||||
$ W.stack
|
||||
$ W.workspace scr
|
||||
)
|
||||
. sortedScreens
|
||||
) winset
|
||||
where
|
||||
maybeWinRect scr win = do
|
||||
winrect <- windowRect win
|
||||
rect <- case winrect of
|
||||
Just _ -> return winrect
|
||||
Nothing -> maybe (return Nothing)
|
||||
(\f -> f scr win)
|
||||
(L.lookup (description . W.layout . W.workspace $ scr) (unmappedWindowRect conf))
|
||||
return ((,) win <$> rect)
|
||||
|
||||
-- | Returns the current rectangle of the given window, Nothing if the window isn't mapped
|
||||
windowRect :: Window -> X (Maybe Rectangle)
|
||||
windowRect win = withDisplay $ \dpy -> do
|
||||
mp <- isMapped win
|
||||
if mp then do (_, x, y, w, h, bw, _) <- io $ getGeometry dpy win
|
||||
return $ Just $ Rectangle x y (w + 2 * bw) (h + 2 * bw)
|
||||
`catchX` return Nothing
|
||||
else return Nothing
|
||||
|
||||
-- | Acts on the screens using the given action function
|
||||
actOnScreens :: (Navigation2DConfig -> WSRect -> [WSRect] -> X ())
|
||||
-> Bool -- ^ Should wrapping be used?
|
||||
-> X ()
|
||||
actOnScreens act wrap = withWindowSet $ \winset -> do
|
||||
conf <- XS.get
|
||||
let wsrects = visibleWorkspaces winset wrap
|
||||
cur = W.tag . W.workspace . W.current $ winset
|
||||
rect = fromJust $ L.lookup cur wsrects
|
||||
act conf (cur, rect) wsrects
|
||||
|
||||
-- | Determines whether a given window is mapped
|
||||
isMapped :: Window -> X Bool
|
||||
isMapped win = withDisplay
|
||||
$ \dpy -> io
|
||||
$ (waIsUnmapped /=)
|
||||
. wa_map_state
|
||||
<$> getWindowAttributes dpy win
|
||||
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
-- --
|
||||
-- PRIVATE PURE FUNCTIONS --
|
||||
-- --
|
||||
----------------------------------------------------------------------------------------------------
|
||||
----------------------------------------------------------------------------------------------------
|
||||
|
||||
-- | Finds the window closest to the given window and focuses it. Ties are
|
||||
-- broken by choosing the first window in the window stack among the tied
|
||||
-- windows. (The stack order is the one produced by integrate'ing each visible
|
||||
-- workspace's window stack and concatenating these lists for all visible
|
||||
-- workspaces.)
|
||||
doFocusClosestWindow :: WinRect
|
||||
-> [WinRect]
|
||||
-> (WindowSet -> WindowSet)
|
||||
doFocusClosestWindow (cur, rect) winrects
|
||||
| null winctrs = id
|
||||
| otherwise = W.focusWindow . fst $ L.foldl1' closer winctrs
|
||||
where
|
||||
ctr = centerOf rect
|
||||
winctrs = filter ((cur /=) . fst)
|
||||
$ map (\(w, r) -> (w, centerOf r)) winrects
|
||||
closer wc1@(_, c1) wc2@(_, c2) | lDist ctr c1 > lDist ctr c2 = wc2
|
||||
| otherwise = wc1
|
||||
|
||||
-- | Implements navigation for the tiled layer
|
||||
doTiledNavigation :: Navigation2DConfig
|
||||
-> Direction2D
|
||||
-> (Window -> WindowSet -> WindowSet)
|
||||
-> WinRect
|
||||
-> [WinRect]
|
||||
-> (WindowSet -> WindowSet)
|
||||
doTiledNavigation conf dir act cur winrects winset
|
||||
| Just win <- runNav nav dir cur winrects = act win winset
|
||||
| otherwise = winset
|
||||
where
|
||||
layouts = map (description . W.layout . W.workspace)
|
||||
$ W.screens winset
|
||||
nav = maximum
|
||||
$ map ( fromMaybe (defaultTiledNavigation conf)
|
||||
. flip L.lookup (layoutNavigation conf)
|
||||
)
|
||||
$ layouts
|
||||
|
||||
-- | Implements navigation for the float layer
|
||||
doFloatNavigation :: Navigation2DConfig
|
||||
-> Direction2D
|
||||
-> (Window -> WindowSet -> WindowSet)
|
||||
-> WinRect
|
||||
-> [WinRect]
|
||||
-> (WindowSet -> WindowSet)
|
||||
doFloatNavigation conf dir act cur winrects
|
||||
| Just win <- runNav nav dir cur winrects = act win
|
||||
| otherwise = id
|
||||
where
|
||||
nav = floatNavigation conf
|
||||
|
||||
-- | Implements navigation between screens
|
||||
doScreenNavigation :: Navigation2DConfig
|
||||
-> Direction2D
|
||||
-> (WorkspaceId -> WindowSet -> WindowSet)
|
||||
-> WSRect
|
||||
-> [WSRect]
|
||||
-> (WindowSet -> WindowSet)
|
||||
doScreenNavigation conf dir act cur wsrects
|
||||
| Just ws <- runNav nav dir cur wsrects = act ws
|
||||
| otherwise = id
|
||||
where
|
||||
nav = screenNavigation conf
|
||||
|
||||
-- | Implements line navigation. For layouts without overlapping windows, there
|
||||
-- is no need to break ties between equidistant windows. When windows do
|
||||
-- overlap, even the best tie breaking rule cannot make line navigation feel
|
||||
-- natural. Thus, we fairly arbtitrarily break ties by preferring the window
|
||||
-- that comes first in the window stack. (The stack order is the one produced
|
||||
-- by integrate'ing each visible workspace's window stack and concatenating
|
||||
-- these lists for all visible workspaces.)
|
||||
doLineNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
|
||||
doLineNavigation dir (cur, rect) winrects
|
||||
| null winrects' = Nothing
|
||||
| otherwise = Just . fst $ L.foldl1' closer winrects'
|
||||
where
|
||||
-- The current window's center
|
||||
ctr@(xc, yc) = centerOf rect
|
||||
|
||||
-- The list of windows that are candidates to receive focus.
|
||||
winrects' = filter dirFilter
|
||||
$ filter ((cur /=) . fst)
|
||||
$ winrects
|
||||
|
||||
-- Decides whether a given window matches the criteria to be a candidate to
|
||||
-- receive the focus.
|
||||
dirFilter (_, r) = (dir == L && leftOf r rect && intersectsY yc r)
|
||||
|| (dir == R && leftOf rect r && intersectsY yc r)
|
||||
|| (dir == U && above r rect && intersectsX xc r)
|
||||
|| (dir == D && above rect r && intersectsX xc r)
|
||||
|
||||
-- Decide whether r1 is left of/above r2.
|
||||
leftOf r1 r2 = rect_x r1 + fi (rect_width r1) <= rect_x r2
|
||||
above r1 r2 = rect_y r1 + fi (rect_height r1) <= rect_y r2
|
||||
|
||||
-- Check whether r's x-/y-range contains the given x-/y-coordinate.
|
||||
intersectsX x r = rect_x r <= x && rect_x r + fi (rect_width r) >= x
|
||||
intersectsY y r = rect_y r <= y && rect_y r + fi (rect_height r) >= y
|
||||
|
||||
-- Decides whether r1 is closer to the current window's center than r2
|
||||
closer wr1@(_, r1) wr2@(_, r2) | dist ctr r1 > dist ctr r2 = wr2
|
||||
| otherwise = wr1
|
||||
|
||||
-- Returns the distance of r from the point (x, y)
|
||||
dist (x, y) r | dir == L = x - rect_x r - fi (rect_width r)
|
||||
| dir == R = rect_x r - x
|
||||
| dir == U = y - rect_y r - fi (rect_height r)
|
||||
| otherwise = rect_y r - y
|
||||
|
||||
-- | Implements center navigation
|
||||
doCenterNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
|
||||
doCenterNavigation dir (cur, rect) winrects
|
||||
| ((w, _):_) <- onCtr' = Just w
|
||||
| otherwise = closestOffCtr
|
||||
where
|
||||
-- The center of the current window
|
||||
(xc, yc) = centerOf rect
|
||||
|
||||
-- All the windows with their center points relative to the current
|
||||
-- center rotated so the right cone becomes the relevant cone.
|
||||
-- The windows are ordered in the order they should be preferred
|
||||
-- when they are otherwise tied.
|
||||
winctrs = map (\(w, r) -> (w, dirTransform . centerOf $ r))
|
||||
$ stackTransform
|
||||
$ winrects
|
||||
|
||||
-- Give preference to windows later in the stack for going left or up and to
|
||||
-- windows earlier in the stack for going right or down. (The stack order
|
||||
-- is the one produced by integrate'ing each visible workspace's window
|
||||
-- stack and concatenating these lists for all visible workspaces.)
|
||||
stackTransform | dir == L || dir == U = reverse
|
||||
| otherwise = id
|
||||
|
||||
-- Transform a point into a difference to the current window center and
|
||||
-- rotate it so that the relevant cone becomes the right cone.
|
||||
dirTransform (x, y) | dir == R = ( x - xc , y - yc )
|
||||
| dir == L = (-(x - xc), -(y - yc))
|
||||
| dir == D = ( y - yc , x - xc )
|
||||
| otherwise = (-(y - yc), -(x - xc))
|
||||
|
||||
-- Partition the points into points that coincide with the center
|
||||
-- and points that do not.
|
||||
(onCtr, offCtr) = L.partition (\(_, (x, y)) -> x == 0 && y == 0) winctrs
|
||||
|
||||
-- All the points that coincide with the current center and succeed it
|
||||
-- in the (appropriately ordered) window stack.
|
||||
onCtr' = L.tail $ L.dropWhile ((cur /=) . fst) onCtr
|
||||
-- tail should be safe here because cur should be in onCtr
|
||||
|
||||
-- All the points that do not coincide with the current center and which
|
||||
-- lie in the (rotated) right cone.
|
||||
offCtr' = L.filter (\(_, (x, y)) -> x > 0 && y < x && y >= -x) offCtr
|
||||
|
||||
-- The off-center point closest to the center and
|
||||
-- closest to the bottom ray of the cone. Nothing if no off-center
|
||||
-- point is in the cone
|
||||
closestOffCtr = if null offCtr' then Nothing
|
||||
else Just $ fst $ L.foldl1' closest offCtr'
|
||||
|
||||
closest wp@(_, p@(_, yp)) wq@(_, q@(_, yq))
|
||||
| lDist (0, 0) q < lDist (0, 0) p = wq -- q is closer than p
|
||||
| lDist (0, 0) p < lDist (0, 0) q = wp -- q is farther away than p
|
||||
| yq < yp = wq -- q is closer to the bottom ray than p
|
||||
| otherwise = wp -- q is farther away from the bottom ray than p
|
||||
-- or it has the same distance but comes later
|
||||
-- in the window stack
|
||||
|
||||
-- | Implements Hybrid navigation. This attempts Line navigation first,
|
||||
-- then falls back on Center navigation if it finds no suitable target window.
|
||||
doHybridNavigation :: Eq a => Direction2D -> Rect a -> [Rect a] -> Maybe a
|
||||
doHybridNavigation = applyToBoth (<|>) doLineNavigation doCenterNavigation
|
||||
where
|
||||
applyToBoth f g h a b c = f (g a b c) (h a b c)
|
||||
|
||||
-- | Swaps the current window with the window given as argument
|
||||
swap :: Window -> WindowSet -> WindowSet
|
||||
swap win winset = W.focusWindow cur
|
||||
$ L.foldl' (flip W.focusWindow) newwinset newfocused
|
||||
where
|
||||
-- The current window
|
||||
cur = fromJust $ W.peek winset
|
||||
|
||||
-- All screens
|
||||
scrs = W.screens winset
|
||||
|
||||
-- All visible workspaces
|
||||
visws = map W.workspace scrs
|
||||
|
||||
-- The focused windows of the visible workspaces
|
||||
focused = mapMaybe (\ws -> W.focus <$> W.stack ws) visws
|
||||
|
||||
-- The window lists of the visible workspaces
|
||||
wins = map (W.integrate' . W.stack) visws
|
||||
|
||||
-- Update focused windows and window lists to reflect swap of windows.
|
||||
newfocused = map swapWins focused
|
||||
newwins = map (map swapWins) wins
|
||||
|
||||
-- Replaces the current window with the argument window and vice versa.
|
||||
swapWins x | x == cur = win
|
||||
| x == win = cur
|
||||
| otherwise = x
|
||||
|
||||
-- Reconstruct the workspaces' window stacks to reflect the swap.
|
||||
newvisws = zipWith (\ws wns -> ws { W.stack = W.differentiate wns }) visws newwins
|
||||
newscrs = zipWith (\scr ws -> scr { W.workspace = ws }) scrs newvisws
|
||||
newwinset = winset { W.current = head newscrs
|
||||
, W.visible = tail newscrs
|
||||
}
|
||||
|
||||
-- | Calculates the center of a rectangle
|
||||
centerOf :: Rectangle -> (Position, Position)
|
||||
centerOf r = (rect_x r + fi (rect_width r) `div` 2, rect_y r + fi (rect_height r) `div` 2)
|
||||
|
||||
-- | Shorthand for integer conversions
|
||||
fi :: (Integral a, Num b) => a -> b
|
||||
fi = fromIntegral
|
||||
|
||||
-- | Functions to choose the subset of windows to operate on
|
||||
thisLayer, otherLayer :: a -> a -> a
|
||||
thisLayer = curry fst
|
||||
otherLayer = curry snd
|
||||
|
||||
-- | Returns the list of visible workspaces and their screen rects
|
||||
visibleWorkspaces :: WindowSet -> Bool -> [WSRect]
|
||||
visibleWorkspaces winset wrap = addWrapping winset wrap
|
||||
$ map ( \scr -> ( W.tag . W.workspace $ scr
|
||||
, screenRect . W.screenDetail $ scr
|
||||
)
|
||||
)
|
||||
$ sortedScreens winset
|
||||
|
||||
-- | Creates five copies of each (window/workspace, rect) pair in the input: the
|
||||
-- original and four offset one desktop size (desktop = collection of all
|
||||
-- screens) to the left, to the right, up, and down. Wrap-around at desktop
|
||||
-- edges is implemented by navigating into these displaced copies.
|
||||
addWrapping :: WindowSet -- ^ The window set, used to get the desktop size
|
||||
-> Bool -- ^ Should wrapping be used? Do nothing if not.
|
||||
-> [Rect a] -- ^ Input set of (window/workspace, rect) pairs
|
||||
-> [Rect a]
|
||||
addWrapping _ False wrects = wrects
|
||||
addWrapping winset True wrects = [ (w, r { rect_x = rect_x r + fi x
|
||||
, rect_y = rect_y r + fi y
|
||||
}
|
||||
)
|
||||
| (w, r) <- wrects
|
||||
, (x, y) <- [(0, 0), (-xoff, 0), (xoff, 0), (0, -yoff), (0, yoff)]
|
||||
]
|
||||
where
|
||||
(xoff, yoff) = wrapOffsets winset
|
||||
|
||||
-- | Calculates the offsets for window/screen coordinates for the duplication
|
||||
-- of windows/workspaces that implements wrap-around.
|
||||
wrapOffsets :: WindowSet -> (Integer, Integer)
|
||||
wrapOffsets winset = (max_x - min_x, max_y - min_y)
|
||||
where
|
||||
min_x = fi $ minimum $ map rect_x rects
|
||||
min_y = fi $ minimum $ map rect_y rects
|
||||
max_x = fi $ maximum $ map (\r -> rect_x r + (fi $ rect_width r)) rects
|
||||
max_y = fi $ maximum $ map (\r -> rect_y r + (fi $ rect_height r)) rects
|
||||
rects = map snd $ visibleWorkspaces winset False
|
||||
|
||||
|
||||
-- | Returns the list of screens sorted primarily by their centers'
|
||||
-- x-coordinates and secondarily by their y-coordinates.
|
||||
sortedScreens :: WindowSet -> [Screen]
|
||||
sortedScreens winset = L.sortBy cmp
|
||||
$ W.screens winset
|
||||
where
|
||||
cmp s1 s2 | x1 < x2 = LT
|
||||
| x1 > x2 = GT
|
||||
| y1 < x2 = LT
|
||||
| y1 > y2 = GT
|
||||
| otherwise = EQ
|
||||
where
|
||||
(x1, y1) = centerOf (screenRect . W.screenDetail $ s1)
|
||||
(x2, y2) = centerOf (screenRect . W.screenDetail $ s2)
|
||||
|
||||
|
||||
-- | Calculates the L1-distance between two points.
|
||||
lDist :: (Position, Position) -> (Position, Position) -> Int
|
||||
lDist (x1, y1) (x2, y2) = abs (fi $ x1 - x2) + abs (fi $ y1 - y2)
|
@@ -41,7 +41,7 @@ and then left-to-right.
|
||||
|
||||
Example usage in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
|
||||
> import XMonad.Actions.PhysicalSCreens
|
||||
> import XMonad.Actions.PhysicalScreens
|
||||
|
||||
> , ((modMask, xK_a), onPrevNeighbour W.view)
|
||||
> , ((modMask, xK_o), onNextNeighbour W.view)
|
||||
@@ -112,4 +112,3 @@ onNextNeighbour = neighbourWindows 1
|
||||
-- | Apply operation on a WindowSet with the WorkspaceId of the previous screen in the physical order as parameter.
|
||||
onPrevNeighbour :: (WorkspaceId -> WindowSet -> WindowSet) -> X ()
|
||||
onPrevNeighbour = neighbourWindows (-1)
|
||||
|
||||
|
@@ -51,12 +51,13 @@ import XMonad.Util.Run
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
--
|
||||
-- > import XMonad.Actions.Plane
|
||||
-- > import Data.Map (union)
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig {keys = myKeys}
|
||||
-- > main = xmonad def {keys = myKeys}
|
||||
-- >
|
||||
-- > myKeys conf = union (keys defaultConfig conf) $ myNewKeys conf
|
||||
-- > myKeys conf = union (keys def conf) $ myNewKeys conf
|
||||
-- >
|
||||
-- > myNewkeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
|
||||
-- > myNewKeys (XConfig {modMask = modm}) = planeKeys modm (Lines 3) Finite
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
@@ -110,7 +111,7 @@ plane ::
|
||||
(WorkspaceId -> WindowSet -> WindowSet) -> Lines -> Limits -> Direction ->
|
||||
X ()
|
||||
plane function numberLines_ limits direction = do
|
||||
state <- get
|
||||
st <- get
|
||||
xconf <- ask
|
||||
|
||||
numberLines <-
|
||||
@@ -205,7 +206,7 @@ plane function numberLines_ limits direction = do
|
||||
preColumns = div areas numberLines
|
||||
|
||||
mCurrentWS :: Maybe Int
|
||||
mCurrentWS = elemIndex (currentTag $ windowset state) areaNames
|
||||
mCurrentWS = elemIndex (currentTag $ windowset st) areaNames
|
||||
|
||||
areas :: Int
|
||||
areas = length areaNames
|
||||
|
@@ -46,11 +46,14 @@ module XMonad.Actions.Search ( -- * Usage
|
||||
mathworld,
|
||||
openstreetmap,
|
||||
scholar,
|
||||
stackage,
|
||||
thesaurus,
|
||||
wayback,
|
||||
wikipedia,
|
||||
wiktionary,
|
||||
youtube,
|
||||
vocabulary,
|
||||
duckduckgo,
|
||||
multi,
|
||||
-- * Use case: searching with a submap
|
||||
-- $tip
|
||||
@@ -63,8 +66,10 @@ import Codec.Binary.UTF8.String (encode)
|
||||
import Data.Char (isAlphaNum, isAscii)
|
||||
import Data.List (isPrefixOf)
|
||||
import Text.Printf
|
||||
import XMonad (X(), MonadIO, liftIO)
|
||||
import XMonad.Prompt (XPrompt(showXPrompt, nextCompletion, commandToComplete), mkXPrompt, XPConfig(), historyCompletionP, getNextCompletion)
|
||||
import XMonad (X (), liftIO)
|
||||
import XMonad.Prompt (XPConfig (), XPrompt (showXPrompt, nextCompletion, commandToComplete),
|
||||
getNextCompletion,
|
||||
historyCompletionP, mkXPrompt)
|
||||
import XMonad.Prompt.Shell (getBrowser)
|
||||
import XMonad.Util.Run (safeSpawn)
|
||||
import XMonad.Util.XSelection (getSelection)
|
||||
@@ -114,6 +119,8 @@ import XMonad.Util.XSelection (getSelection)
|
||||
|
||||
* 'hoogle' -- Hoogle, the Haskell libraries API search engine.
|
||||
|
||||
* 'stackage' -- Stackage, An alternative Haskell libraries API search engine.
|
||||
|
||||
* 'images' -- Google images.
|
||||
|
||||
* 'imdb' -- the Internet Movie Database.
|
||||
@@ -138,6 +145,10 @@ import XMonad.Util.XSelection (getSelection)
|
||||
|
||||
* 'youtube' -- Youtube video search.
|
||||
|
||||
* 'vocabulary' -- Dictionary search
|
||||
|
||||
* 'duckduckgo' -- DuckDuckGo search engine.
|
||||
|
||||
* 'multi' -- Search based on the prefix. \"amazon:Potter\" will use amazon, etc. With no prefix searches google.
|
||||
|
||||
Feel free to add more! -}
|
||||
@@ -157,7 +168,7 @@ Then add the following to your key bindings:
|
||||
|
||||
> ...
|
||||
> -- Search commands
|
||||
> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.defaultXPConfig)
|
||||
> , ((modm, xK_s), SM.submap $ searchEngineMap $ S.promptSearch P.def)
|
||||
> , ((modm .|. shiftMask, xK_s), SM.submap $ searchEngineMap $ S.selectSearch)
|
||||
>
|
||||
> ...
|
||||
@@ -173,7 +184,7 @@ Or in combination with XMonad.Util.EZConfig:
|
||||
> ...
|
||||
> ] -- end of regular keybindings
|
||||
> -- Search commands
|
||||
> ++ [("M-s " ++ k, S.promptSearch P.defaultXPConfig f) | (k,f) <- searchList ]
|
||||
> ++ [("M-s " ++ k, S.promptSearch P.def f) | (k,f) <- searchList ]
|
||||
> ++ [("M-S-s " ++ k, S.selectSearch f) | (k,f) <- searchList ]
|
||||
>
|
||||
> ...
|
||||
@@ -271,9 +282,9 @@ searchEngineF = SearchEngine
|
||||
|
||||
-- The engines.
|
||||
amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle,
|
||||
images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary,
|
||||
youtube :: SearchEngine
|
||||
amazon = searchEngine "amazon" "http://www.amazon.com/exec/obidos/external-search?index=all&keyword="
|
||||
images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, stackage, thesaurus, vocabulary, wayback, wikipedia, wiktionary,
|
||||
youtube, duckduckgo :: SearchEngine
|
||||
amazon = searchEngine "amazon" "http://www.amazon.com/s/ref=nb_sb_noss_2?url=search-alias%3Daps&field-keywords="
|
||||
alpha = searchEngine "alpha" "http://www.wolframalpha.com/input/?i="
|
||||
codesearch = searchEngine "codesearch" "http://www.google.com/codesearch?q="
|
||||
deb = searchEngine "deb" "http://packages.debian.org/"
|
||||
@@ -291,14 +302,17 @@ maps = searchEngine "maps" "http://maps.google.com/maps?q="
|
||||
mathworld = searchEngine "mathworld" "http://mathworld.wolfram.com/search/?query="
|
||||
openstreetmap = searchEngine "openstreetmap" "http://gazetteer.openstreetmap.org/namefinder/?find="
|
||||
scholar = searchEngine "scholar" "http://scholar.google.com/scholar?q="
|
||||
stackage = searchEngine "stackage" "www.stackage.org/lts/hoogle?q="
|
||||
thesaurus = searchEngine "thesaurus" "http://thesaurus.reference.com/search?q="
|
||||
wikipedia = searchEngine "wiki" "http://en.wikipedia.org/wiki/Special:Search?go=Go&search="
|
||||
wiktionary = searchEngine "wikt" "http://en.wiktionary.org/wiki/Special:Search?go=Go&search="
|
||||
youtube = searchEngine "youtube" "http://www.youtube.com/results?search_type=search_videos&search_query="
|
||||
wayback = searchEngineF "wayback" ("http://web.archive.org/web/*/"++)
|
||||
vocabulary = searchEngine "vocabulary" "http://www.vocabulary.com/search?q="
|
||||
duckduckgo = searchEngine "duckduckgo" "https://duckduckgo.com/?t=lm&q="
|
||||
|
||||
multi :: SearchEngine
|
||||
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, (prefixAware google)]
|
||||
multi = namedEngine "multi" $ foldr1 (!>) [amazon, alpha, codesearch, deb, debbts, debpts, dictionary, google, hackage, hoogle, images, imdb, isohunt, lucky, maps, mathworld, openstreetmap, scholar, thesaurus, wayback, wikipedia, wiktionary, duckduckgo, (prefixAware google)]
|
||||
|
||||
{- | This function wraps up a search engine and creates a new one, which works
|
||||
like the argument, but goes directly to a URL if one is given rather than
|
||||
|
121
XMonad/Actions/ShowText.hs
Normal file
121
XMonad/Actions/ShowText.hs
Normal file
@@ -0,0 +1,121 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.ShowText
|
||||
-- Copyright : (c) Mario Pastorelli (2012)
|
||||
-- License : BSD-style (see xmonad/LICENSE)
|
||||
--
|
||||
-- Maintainer : pastorelli.mario@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- ShowText displays text for sometime on the screen similar to "XMonad.Util.Dzen"
|
||||
-- which offers more features (currently)
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Actions.ShowText
|
||||
( -- * Usage
|
||||
-- $usage
|
||||
def
|
||||
, defaultSTConfig
|
||||
, handleTimerEvent
|
||||
, flashText
|
||||
, ShowTextConfig(..)
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.Map (Map,empty,insert,lookup)
|
||||
import Data.Monoid (mempty, All)
|
||||
import Prelude hiding (lookup)
|
||||
import XMonad
|
||||
import XMonad.StackSet (current,screen)
|
||||
import XMonad.Util.Font (Align(AlignCenter)
|
||||
, initXMF
|
||||
, releaseXMF
|
||||
, textExtentsXMF
|
||||
, textWidthXMF)
|
||||
import XMonad.Util.Timer (startTimer)
|
||||
import XMonad.Util.XUtils (createNewWindow
|
||||
, deleteWindow
|
||||
, fi
|
||||
, showWindow
|
||||
, paintAndWrite)
|
||||
import qualified XMonad.Util.ExtensibleState as ES
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.ShowText
|
||||
--
|
||||
-- Then add the event hook handler:
|
||||
--
|
||||
-- > xmonad { handleEventHook = myHandleEventHooks <+> handleTimerEvent }
|
||||
--
|
||||
-- You can then use flashText in your keybindings:
|
||||
--
|
||||
-- > ((modMask, xK_Right), flashText def 1 "->" >> nextWS)
|
||||
--
|
||||
|
||||
-- | ShowText contains the map with timers as keys and created windows as values
|
||||
newtype ShowText = ShowText (Map Atom Window)
|
||||
deriving (Read,Show,Typeable)
|
||||
|
||||
instance ExtensionClass ShowText where
|
||||
initialValue = ShowText empty
|
||||
|
||||
-- | Utility to modify a ShowText
|
||||
modShowText :: (Map Atom Window -> Map Atom Window) -> ShowText -> ShowText
|
||||
modShowText f (ShowText m) = ShowText $ f m
|
||||
|
||||
data ShowTextConfig =
|
||||
STC { st_font :: String -- ^ Font name
|
||||
, st_bg :: String -- ^ Background color
|
||||
, st_fg :: String -- ^ Foreground color
|
||||
}
|
||||
|
||||
instance Default ShowTextConfig where
|
||||
def =
|
||||
STC { st_font = "-misc-fixed-*-*-*-*-20-*-*-*-*-*-*-*"
|
||||
, st_bg = "black"
|
||||
, st_fg = "white"
|
||||
}
|
||||
|
||||
{-# DEPRECATED defaultSTConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.ShowText) instead." #-}
|
||||
defaultSTConfig :: ShowTextConfig
|
||||
defaultSTConfig = def
|
||||
|
||||
-- | Handles timer events that notify when a window should be removed
|
||||
handleTimerEvent :: Event -> X All
|
||||
handleTimerEvent (ClientMessageEvent _ _ _ dis _ mtyp d) = do
|
||||
(ShowText m) <- ES.get :: X ShowText
|
||||
a <- io $ internAtom dis "XMONAD_TIMER" False
|
||||
when (mtyp == a && length d >= 1)
|
||||
(whenJust (lookup (fromIntegral $ d !! 0) m) deleteWindow)
|
||||
mempty
|
||||
handleTimerEvent _ = mempty
|
||||
|
||||
-- | Shows a window in the center of the screen with the given text
|
||||
flashText :: ShowTextConfig
|
||||
-> Rational -- ^ number of seconds
|
||||
-> String -- ^ text to display
|
||||
-> X ()
|
||||
flashText c i s = do
|
||||
f <- initXMF (st_font c)
|
||||
d <- asks display
|
||||
sc <- gets $ fi . screen . current . windowset
|
||||
width <- textWidthXMF d f s
|
||||
(as,ds) <- textExtentsXMF f s
|
||||
let hight = as + ds
|
||||
ht = displayHeight d sc
|
||||
wh = displayWidth d sc
|
||||
y = (fi ht - hight + 2) `div` 2
|
||||
x = (fi wh - width + 2) `div` 2
|
||||
w <- createNewWindow (Rectangle (fi x) (fi y) (fi width) (fi hight))
|
||||
Nothing "" True
|
||||
showWindow w
|
||||
paintAndWrite w f (fi width) (fi hight) 0 (st_bg c) ""
|
||||
(st_fg c) (st_bg c) [AlignCenter] [s]
|
||||
releaseXMF f
|
||||
io $ sync d False
|
||||
t <- startTimer i
|
||||
ES.modify $ modShowText (insert (fromIntegral t) w)
|
@@ -20,6 +20,7 @@ module XMonad.Actions.SpawnOn (
|
||||
-- $usage
|
||||
Spawner,
|
||||
manageSpawn,
|
||||
manageSpawnWithGC,
|
||||
spawnHere,
|
||||
spawnOn,
|
||||
spawnAndDo,
|
||||
@@ -44,16 +45,16 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- > import XMonad.Actions.SpawnOn
|
||||
--
|
||||
-- > main = do
|
||||
-- > xmonad defaultConfig {
|
||||
-- > xmonad def {
|
||||
-- > ...
|
||||
-- > manageHook = manageSpawn <+> manageHook defaultConfig
|
||||
-- > manageHook = manageSpawn <+> manageHook def
|
||||
-- > ...
|
||||
-- > }
|
||||
--
|
||||
-- To ensure that application appears on a workspace it was launched at, add keybindings like:
|
||||
--
|
||||
-- > , ((mod1Mask,xK_o), spawnHere "urxvt")
|
||||
-- > , ((mod1Mask,xK_s), shellPromptHere defaultXPConfig)
|
||||
-- > , ((mod1Mask,xK_s), shellPromptHere def)
|
||||
--
|
||||
-- The module can also be used to apply other manage hooks to the window of
|
||||
-- the spawned application(e.g. float or resize it).
|
||||
@@ -66,8 +67,6 @@ newtype Spawner = Spawner {pidsRef :: [(ProcessID, ManageHook)]} deriving Typeab
|
||||
instance ExtensionClass Spawner where
|
||||
initialValue = Spawner []
|
||||
|
||||
maxPids :: Int
|
||||
maxPids = 5
|
||||
|
||||
-- | Get the current Spawner or create one if it doesn't exist.
|
||||
modifySpawner :: ([(ProcessID, ManageHook)] -> [(ProcessID, ManageHook)]) -> X ()
|
||||
@@ -76,20 +75,26 @@ modifySpawner f = XS.modify (Spawner . f . pidsRef)
|
||||
-- | Provides a manage hook to react on process spawned with
|
||||
-- 'spawnOn', 'spawnHere' etc.
|
||||
manageSpawn :: ManageHook
|
||||
manageSpawn = do
|
||||
manageSpawn = manageSpawnWithGC (return . take 20)
|
||||
|
||||
manageSpawnWithGC :: ([(ProcessID, ManageHook)] -> X [(ProcessID, ManageHook)])
|
||||
-- ^ function to stop accumulation of entries for windows that never set @_NET_WM_PID@
|
||||
-> ManageHook
|
||||
manageSpawnWithGC garbageCollect = do
|
||||
Spawner pids <- liftX XS.get
|
||||
mp <- pid
|
||||
case flip lookup pids =<< mp of
|
||||
Nothing -> idHook
|
||||
Just mh -> do
|
||||
whenJust mp $ \p ->
|
||||
liftX . modifySpawner $ filter ((/= p) . fst)
|
||||
whenJust mp $ \p -> liftX $ do
|
||||
ps <- XS.gets pidsRef
|
||||
XS.put . Spawner =<< garbageCollect (filter ((/= p) . fst) ps)
|
||||
mh
|
||||
|
||||
mkPrompt :: (String -> X ()) -> XPConfig -> X ()
|
||||
mkPrompt cb c = do
|
||||
cmds <- io $ getCommands
|
||||
mkXPrompt Shell c (getShellCompl cmds) cb
|
||||
mkXPrompt Shell c (getShellCompl cmds $ searchPredicate c) cb
|
||||
|
||||
-- | Replacement for Shell prompt ("XMonad.Prompt.Shell") which launches
|
||||
-- application on current workspace.
|
||||
@@ -115,7 +120,7 @@ spawnOn ws cmd = spawnAndDo (doShift ws) cmd
|
||||
spawnAndDo :: ManageHook -> String -> X ()
|
||||
spawnAndDo mh cmd = do
|
||||
p <- spawnPID $ mangle cmd
|
||||
modifySpawner $ (take maxPids . ((p,mh) :))
|
||||
modifySpawner $ ((p,mh) :)
|
||||
where
|
||||
-- TODO this is silly, search for a better solution
|
||||
mangle xs | any (`elem` metaChars) xs || "exec" `isInfixOf` xs = xs
|
||||
|
@@ -16,9 +16,11 @@ module XMonad.Actions.Submap (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
submap,
|
||||
submapDefault
|
||||
submapDefault,
|
||||
submapDefaultWithKey
|
||||
) where
|
||||
import Data.Bits
|
||||
import Data.Maybe (fromMaybe)
|
||||
import XMonad hiding (keys)
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad.Fix (fix)
|
||||
@@ -58,11 +60,18 @@ For detailed instructions on editing your key bindings, see
|
||||
-- corresponding action, or does nothing if the key is not found in
|
||||
-- the map.
|
||||
submap :: M.Map (KeyMask, KeySym) (X ()) -> X ()
|
||||
submap keys = submapDefault (return ()) keys
|
||||
submap = submapDefault (return ())
|
||||
|
||||
-- | Like 'submap', but executes a default action if the key did not match.
|
||||
submapDefault :: X () -> M.Map (KeyMask, KeySym) (X ()) -> X ()
|
||||
submapDefault def keys = do
|
||||
submapDefault = submapDefaultWithKey . const
|
||||
|
||||
-- | Like 'submapDefault', but sends the unmatched key to the default
|
||||
-- action as argument.
|
||||
submapDefaultWithKey :: ((KeyMask, KeySym) -> X ())
|
||||
-> M.Map (KeyMask, KeySym) (X ())
|
||||
-> X ()
|
||||
submapDefaultWithKey defAction keys = do
|
||||
XConf { theRoot = root, display = d } <- ask
|
||||
|
||||
io $ grabKeyboard d root False grabModeAsync grabModeAsync currentTime
|
||||
@@ -79,4 +88,4 @@ submapDefault def keys = do
|
||||
|
||||
io $ ungrabKeyboard d currentTime
|
||||
|
||||
maybe def id (M.lookup (m', s) keys)
|
||||
fromMaybe (defAction (m', s)) (M.lookup (m', s) keys)
|
||||
|
@@ -26,10 +26,9 @@ module XMonad.Actions.TagWindows (
|
||||
TagPrompt,
|
||||
) where
|
||||
|
||||
import Prelude hiding (catch)
|
||||
import Data.List (nub,sortBy)
|
||||
import Control.Monad
|
||||
import Control.Exception
|
||||
import Control.Exception as E
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
@@ -54,12 +53,12 @@ econst = const . return
|
||||
-- > , ((modm, xK_d ), withTaggedP "abc" (W.shiftWin "2"))
|
||||
-- > , ((modm .|. shiftMask, xK_d ), withTaggedGlobalP "abc" shiftHere)
|
||||
-- > , ((modm .|. controlMask, xK_d ), focusUpTaggedGlobal "abc")
|
||||
-- > , ((modm, xK_g ), tagPrompt defaultXPConfig (\s -> withFocused (addTag s)))
|
||||
-- > , ((modm .|. controlMask, xK_g ), tagDelPrompt defaultXPConfig)
|
||||
-- > , ((modm .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobal s float))
|
||||
-- > , ((modWinMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedP s (W.shiftWin "2")))
|
||||
-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt defaultXPConfig (\s -> withTaggedGlobalP s shiftHere))
|
||||
-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt defaultXPConfig (\s -> focusUpTaggedGlobal s))
|
||||
-- > , ((modm, xK_g ), tagPrompt def (\s -> withFocused (addTag s)))
|
||||
-- > , ((modm .|. controlMask, xK_g ), tagDelPrompt def)
|
||||
-- > , ((modm .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobal s float))
|
||||
-- > , ((modWinMask, xK_g ), tagPrompt def (\s -> withTaggedP s (W.shiftWin "2")))
|
||||
-- > , ((modWinMask .|. shiftMask, xK_g ), tagPrompt def (\s -> withTaggedGlobalP s shiftHere))
|
||||
-- > , ((modWinMask .|. controlMask, xK_g ), tagPrompt def (\s -> focusUpTaggedGlobal s))
|
||||
--
|
||||
-- NOTE: Tags are saved as space separated strings and split with
|
||||
-- 'unwords'. Thus if you add a tag \"a b\" the window will have
|
||||
@@ -82,7 +81,7 @@ setTag s w = withDisplay $ \d ->
|
||||
-- reads from the \"_XMONAD_TAGS\" window property
|
||||
getTags :: Window -> X [String]
|
||||
getTags w = withDisplay $ \d ->
|
||||
io $ catch (internAtom d "_XMONAD_TAGS" False >>=
|
||||
io $ E.catch (internAtom d "_XMONAD_TAGS" False >>=
|
||||
getTextProperty d w >>=
|
||||
wcTextPropertyToTextList d)
|
||||
(econst [[]])
|
||||
|
@@ -22,6 +22,7 @@ module XMonad.Actions.TopicSpace
|
||||
Topic
|
||||
, Dir
|
||||
, TopicConfig(..)
|
||||
, def
|
||||
, defaultTopicConfig
|
||||
, getLastFocusedTopics
|
||||
, setLastFocusedTopic
|
||||
@@ -89,7 +90,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- > ]
|
||||
-- >
|
||||
-- > myTopicConfig :: TopicConfig
|
||||
-- > myTopicConfig = defaultTopicConfig
|
||||
-- > myTopicConfig = def
|
||||
-- > { topicDirs = M.fromList $
|
||||
-- > [ ("conf", "w/conf")
|
||||
-- > , ("dashboard", "Desktop")
|
||||
@@ -161,7 +162,7 @@ import qualified XMonad.Util.ExtensibleState as XS
|
||||
-- > myConfig = do
|
||||
-- > checkTopicConfig myTopics myTopicConfig
|
||||
-- > myLogHook <- makeMyLogHook
|
||||
-- > return $ defaultConfig
|
||||
-- > return $ def
|
||||
-- > { borderWidth = 1 -- Width of the window border in pixels.
|
||||
-- > , workspaces = myTopics
|
||||
-- > , layoutHook = myModifiers myLayout
|
||||
@@ -206,14 +207,18 @@ data TopicConfig = TopicConfig { topicDirs :: M.Map Topic Dir
|
||||
-- numeric keypad.
|
||||
}
|
||||
|
||||
defaultTopicConfig :: TopicConfig
|
||||
defaultTopicConfig = TopicConfig { topicDirs = M.empty
|
||||
instance Default TopicConfig where
|
||||
def = TopicConfig { topicDirs = M.empty
|
||||
, topicActions = M.empty
|
||||
, defaultTopicAction = const (ask >>= spawn . terminal . config)
|
||||
, defaultTopic = "1"
|
||||
, maxTopicHistory = 10
|
||||
}
|
||||
|
||||
{-# DEPRECATED defaultTopicConfig "Use def (from Data.Default, and re-exported by XMonad.Actions.TopicSpace) instead." #-}
|
||||
defaultTopicConfig :: TopicConfig
|
||||
defaultTopicConfig = def
|
||||
|
||||
newtype PrevTopics = PrevTopics { getPrevTopics :: [String] } deriving (Read,Show,Typeable)
|
||||
instance ExtensionClass PrevTopics where
|
||||
initialValue = PrevTopics []
|
||||
|
657
XMonad/Actions/TreeSelect.hs
Normal file
657
XMonad/Actions/TreeSelect.hs
Normal file
@@ -0,0 +1,657 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE RecordWildCards #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.TreeSelect
|
||||
-- Copyright : (c) Tom Smeets <tom.tsmeets@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Tom Smeets <tom.tsmeets@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
--
|
||||
-- TreeSelect displays your workspaces or actions in a Tree-like format.
|
||||
-- You can select the desired workspace/action with the cursor or hjkl keys.
|
||||
--
|
||||
-- This module is fully configurable and very useful if you like to have a
|
||||
-- lot of workspaces.
|
||||
--
|
||||
-- Only the nodes up to the currently selected are displayed.
|
||||
-- This will be configurable in the near future by changing 'ts_hidechildren' to @False@, this is not yet implemented.
|
||||
--
|
||||
-- <<https://wiki.haskell.org/wikiupload/thumb/0/0b/Treeselect-Workspace.png/800px-Treeselect-Workspace.png>>
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
module XMonad.Actions.TreeSelect
|
||||
(
|
||||
-- * Usage
|
||||
-- $usage
|
||||
treeselectWorkspace
|
||||
, toWorkspaces
|
||||
, treeselectAction
|
||||
|
||||
-- * Configuring
|
||||
-- $config
|
||||
, Pixel
|
||||
-- $pixel
|
||||
|
||||
, TSConfig(..)
|
||||
, tsDefaultConfig
|
||||
|
||||
-- * Navigation
|
||||
-- $navigation
|
||||
, defaultNavigation
|
||||
, select
|
||||
, cancel
|
||||
, moveParent
|
||||
, moveChild
|
||||
, moveNext
|
||||
, movePrev
|
||||
, moveHistBack
|
||||
, moveHistForward
|
||||
, moveTo
|
||||
|
||||
-- * Advanced usage
|
||||
-- $advusage
|
||||
, TSNode(..)
|
||||
, treeselect
|
||||
, treeselectAt
|
||||
) where
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Data.List (find)
|
||||
import Data.Maybe
|
||||
import Data.Tree
|
||||
import Foreign
|
||||
import System.IO
|
||||
import System.Posix.Process (forkProcess, executeFile)
|
||||
import XMonad hiding (liftX)
|
||||
import XMonad.StackSet as W
|
||||
import XMonad.Util.Font
|
||||
import XMonad.Util.NamedWindows
|
||||
import XMonad.Util.TreeZipper
|
||||
import XMonad.Hooks.WorkspaceHistory
|
||||
import qualified Data.Map as M
|
||||
|
||||
#ifdef XFT
|
||||
import Graphics.X11.Xft
|
||||
import Graphics.X11.Xrender
|
||||
#endif
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- These imports are used in the following example
|
||||
--
|
||||
-- > import Data.Tree
|
||||
-- > import XMonad.Actions.TreeSelect
|
||||
-- > import XMonad.Hooks.WorkspaceHistory
|
||||
-- > import qualified XMonad.StackSet as W
|
||||
--
|
||||
-- For selecting Workspaces, you need to define them in a tree structure using 'Data.Tree.Node' instead of just a standard list
|
||||
--
|
||||
-- Here is an example workspace-tree
|
||||
--
|
||||
-- > myWorkspaces :: Forest String
|
||||
-- > myWorkspaces = [ Node "Browser" [] -- a workspace for your browser
|
||||
-- > , Node "Home" -- for everyday activity's
|
||||
-- > [ Node "1" [] -- with 4 extra sub-workspaces, for even more activity's
|
||||
-- > , Node "2" []
|
||||
-- > , Node "3" []
|
||||
-- > , Node "4" []
|
||||
-- > ]
|
||||
-- > , Node "Programming" -- for all your programming needs
|
||||
-- > [ Node "Haskell" []
|
||||
-- > , Node "Docs" [] -- documentation
|
||||
-- > ]
|
||||
-- > ]
|
||||
--
|
||||
-- Then add it to your 'XMonad.Core.workspaces' using the 'toWorkspaces' function.
|
||||
--
|
||||
-- Optionally, if you add 'workspaceHistoryHook' to your 'logHook' you can use the \'o\' and \'i\' keys to select from previously-visited workspaces
|
||||
--
|
||||
-- > xmonad $ defaultConfig { ...
|
||||
-- > , workspaces = toWorkspaces myWorkspaces
|
||||
-- > , logHook = workspaceHistoryHook
|
||||
-- > }
|
||||
--
|
||||
-- After that you still need to bind buttons to 'treeselectWorkspace' to start selecting a workspaces and moving windows
|
||||
--
|
||||
-- you could bind @Mod-f@ to switch workspace
|
||||
--
|
||||
-- > , ((modMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.greedyView)
|
||||
--
|
||||
-- and bind @Mod-Shift-f@ to moving the focused windows to a workspace
|
||||
--
|
||||
-- > , ((modMask .|. shiftMask, xK_f), treeselectWorkspace myTreeConf myWorkspaces W.shift)
|
||||
|
||||
-- $config
|
||||
-- The selection menu is very configurable, you can change the font, all colors and the sizes of the boxes.
|
||||
--
|
||||
-- The default config defined as 'tsDefaultConfig'
|
||||
--
|
||||
-- > tsDefaultConfig = TSConfig { ts_hidechildren = True
|
||||
-- > , ts_background = 0xc0c0c0c0
|
||||
-- > , ts_font = "xft:Sans-16"
|
||||
-- > , ts_node = (0xff000000, 0xff50d0db)
|
||||
-- > , ts_nodealt = (0xff000000, 0xff10b8d6)
|
||||
-- > , ts_highlight = (0xffffffff, 0xffff0000)
|
||||
-- > , ts_extra = 0xff000000
|
||||
-- > , ts_node_width = 200
|
||||
-- > , ts_node_height = 30
|
||||
-- > , ts_originX = 0
|
||||
-- > , ts_originY = 0
|
||||
-- > , ts_indent = 80
|
||||
-- > , ts_navigate = defaultNavigation
|
||||
-- > }
|
||||
|
||||
-- $pixel
|
||||
--
|
||||
-- The 'Pixel' Color format is in the form of @0xaarrggbb@
|
||||
--
|
||||
-- Note that transparency is only supported if you have a window compositor running like <https://github.com/chjj/compton compton>
|
||||
--
|
||||
-- Some Examples:
|
||||
--
|
||||
-- @
|
||||
-- white = 0xffffffff
|
||||
-- black = 0xff000000
|
||||
-- red = 0xffff0000
|
||||
-- blue = 0xff00ff00
|
||||
-- green = 0xff0000ff
|
||||
-- transparent = 0x00000000
|
||||
-- @
|
||||
|
||||
-- $navigation
|
||||
--
|
||||
-- Keybindings for navigations can also be modified
|
||||
--
|
||||
-- This is the definition of 'defaultNavigation'
|
||||
--
|
||||
-- > defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
|
||||
-- > defaultNavigation = M.fromList
|
||||
-- > [ ((0, xK_Escape), cancel)
|
||||
-- > , ((0, xK_Return), select)
|
||||
-- > , ((0, xK_space), select)
|
||||
-- > , ((0, xK_Up), movePrev)
|
||||
-- > , ((0, xK_Down), moveNext)
|
||||
-- > , ((0, xK_Left), moveParent)
|
||||
-- > , ((0, xK_Right), moveChild)
|
||||
-- > , ((0, xK_k), movePrev)
|
||||
-- > , ((0, xK_j), moveNext)
|
||||
-- > , ((0, xK_h), moveParent)
|
||||
-- > , ((0, xK_l), moveChild)
|
||||
-- > , ((0, xK_o), moveHistBack)
|
||||
-- > , ((0, xK_i), moveHistForward)
|
||||
-- > ]
|
||||
|
||||
-- $advusage
|
||||
-- This module can also be used to select any other action
|
||||
|
||||
-- | Extensive configuration for displaying the tree.
|
||||
--
|
||||
-- This class also has a 'Default' instance
|
||||
data TSConfig a = TSConfig { ts_hidechildren :: Bool -- ^ when enabled, only the parents (and their first children) of the current node will be shown (This feature is not yet implemented!)
|
||||
, ts_background :: Pixel -- ^ background color filling the entire screen.
|
||||
|
||||
, ts_font :: String -- ^ XMF font for drawing the node name extra text
|
||||
|
||||
, ts_node :: (Pixel, Pixel) -- ^ node foreground (text) and background color when not selected
|
||||
, ts_nodealt :: (Pixel, Pixel) -- ^ every other node will use this color instead of 'ts_node'
|
||||
, ts_highlight :: (Pixel, Pixel) -- ^ node foreground (text) and background color when selected
|
||||
|
||||
, ts_extra :: Pixel -- ^ extra text color
|
||||
|
||||
, ts_node_width :: Int -- ^ node width in pixels
|
||||
, ts_node_height :: Int -- ^ node height in pixels
|
||||
, ts_originX :: Int -- ^ tree X position on the screen in pixels
|
||||
, ts_originY :: Int -- ^ tree Y position on the screen in pixels
|
||||
|
||||
, ts_indent :: Int -- ^ indentation amount for each level in pixels
|
||||
|
||||
, ts_navigate :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a)) -- ^ key bindings for navigating the tree
|
||||
}
|
||||
|
||||
instance Default (TSConfig a) where
|
||||
def = TSConfig { ts_hidechildren = True
|
||||
, ts_background = 0xc0c0c0c0
|
||||
, ts_font = "xft:Sans-16"
|
||||
, ts_node = (0xff000000, 0xff50d0db)
|
||||
, ts_nodealt = (0xff000000, 0xff10b8d6)
|
||||
, ts_highlight = (0xffffffff, 0xffff0000)
|
||||
, ts_extra = 0xff000000
|
||||
, ts_node_width = 200
|
||||
, ts_node_height = 30
|
||||
, ts_originX = 0
|
||||
, ts_originY = 0
|
||||
, ts_indent = 80
|
||||
, ts_navigate = defaultNavigation
|
||||
}
|
||||
|
||||
-- | Default navigation
|
||||
--
|
||||
-- * navigation using either arrow key or vi style hjkl
|
||||
-- * Return or Space to confirm
|
||||
-- * Escape or Backspace to cancel to
|
||||
defaultNavigation :: M.Map (KeyMask, KeySym) (TreeSelect a (Maybe a))
|
||||
defaultNavigation = M.fromList
|
||||
[ ((0, xK_Escape), cancel)
|
||||
, ((0, xK_Return), select)
|
||||
, ((0, xK_space), select)
|
||||
, ((0, xK_Up), movePrev)
|
||||
, ((0, xK_Down), moveNext)
|
||||
, ((0, xK_Left), moveParent)
|
||||
, ((0, xK_Right), moveChild)
|
||||
, ((0, xK_k), movePrev)
|
||||
, ((0, xK_j), moveNext)
|
||||
, ((0, xK_h), moveParent)
|
||||
, ((0, xK_l), moveChild)
|
||||
, ((0, xK_o), moveHistBack)
|
||||
, ((0, xK_i), moveHistForward)
|
||||
]
|
||||
|
||||
-- | Default configuration.
|
||||
--
|
||||
-- Using nice alternating blue nodes
|
||||
tsDefaultConfig :: TSConfig a
|
||||
tsDefaultConfig = def
|
||||
|
||||
-- | Tree Node With a name and extra text
|
||||
data TSNode a = TSNode { tsn_name :: String
|
||||
, tsn_extra :: String -- ^ extra text, displayed next to the node name
|
||||
, tsn_value :: a -- ^ value to return when this node is selected
|
||||
}
|
||||
|
||||
-- | State used by TreeSelect.
|
||||
--
|
||||
-- Contains all needed information such as the window, font and a zipper over the tree.
|
||||
data TSState a = TSState { tss_tree :: TreeZipper (TSNode a)
|
||||
, tss_window :: Window
|
||||
, tss_display :: Display
|
||||
, tss_size :: (Int, Int) -- ^ size of 'tz_window'
|
||||
, tss_xfont :: XMonadFont
|
||||
, tss_gc :: GC
|
||||
, tss_visual :: Visual
|
||||
, tss_colormap :: Colormap
|
||||
, tss_history :: ([[String]], [[String]]) -- ^ history zipper, navigated with 'moveHistBack' and 'moveHistForward'
|
||||
}
|
||||
|
||||
-- | State monad transformer using 'TSState'
|
||||
newtype TreeSelect a b = TreeSelect { runTreeSelect :: ReaderT (TSConfig a) (StateT (TSState a) X) b }
|
||||
deriving (Monad, Applicative, Functor, MonadState (TSState a), MonadReader (TSConfig a), MonadIO)
|
||||
|
||||
-- | Lift the 'X' action into the 'XMonad.Actions.TreeSelect.TreeSelect' monad
|
||||
liftX :: X a -> TreeSelect b a
|
||||
liftX = TreeSelect . lift . lift
|
||||
|
||||
-- | Run Treeselect with a given config and tree.
|
||||
-- This can be used for selectiong anything
|
||||
--
|
||||
-- * for switching workspaces and moving windows use 'treeselectWorkspace'
|
||||
-- * for selecting actions use 'treeselectAction'
|
||||
treeselect :: TSConfig a -- ^ config file
|
||||
-> Forest (TSNode a) -- ^ a list of 'Data.Tree.Tree's to select from.
|
||||
-> X (Maybe a)
|
||||
treeselect c t = treeselectAt c (fromForest t) []
|
||||
|
||||
-- | Same as 'treeselect' but ad a specific starting position
|
||||
treeselectAt :: TSConfig a -- ^ config file
|
||||
-> TreeZipper (TSNode a) -- ^ tree structure with a cursor position (starting node)
|
||||
-> [[String]] -- ^ list of paths that can be navigated with 'moveHistBack' and 'moveHistForward' (bound to the 'o' and 'i' keys)
|
||||
-> X (Maybe a)
|
||||
treeselectAt conf@TSConfig{..} zipper hist = withDisplay $ \display -> do
|
||||
-- create a window on the currently focused screen
|
||||
rootw <- asks theRoot
|
||||
Rectangle{..} <- gets $ screenRect . W.screenDetail . W.current . windowset
|
||||
|
||||
Just vinfo <- liftIO $ matchVisualInfo display (defaultScreen display) 32 4
|
||||
|
||||
colormap <- liftIO $ createColormap display rootw (visualInfo_visual vinfo) allocNone
|
||||
|
||||
win <- liftIO $ allocaSetWindowAttributes $ \attributes -> do
|
||||
set_override_redirect attributes True
|
||||
set_colormap attributes colormap
|
||||
set_background_pixel attributes ts_background
|
||||
set_border_pixel attributes 0
|
||||
createWindow display rootw rect_x rect_y rect_width rect_height 0 (visualInfo_depth vinfo) inputOutput (visualInfo_visual vinfo) (cWColormap .|. cWBorderPixel .|. cWBackPixel) attributes
|
||||
|
||||
liftIO $ do
|
||||
-- TODO: move below?
|
||||
-- make the window visible
|
||||
mapWindow display win
|
||||
|
||||
-- listen to key and mouse button events
|
||||
selectInput display win (exposureMask .|. keyPressMask .|. buttonReleaseMask)
|
||||
|
||||
-- TODO: enable mouse select?
|
||||
-- and mouse button 1
|
||||
grabButton display button1 anyModifier win True buttonReleaseMask grabModeAsync grabModeAsync none none
|
||||
|
||||
-- grab the keyboard
|
||||
status <- liftIO $ grabKeyboard display win True grabModeAsync grabModeAsync currentTime
|
||||
|
||||
r <- if status == grabSuccess
|
||||
then do
|
||||
-- load the XMF font
|
||||
gc <- liftIO $ createGC display win
|
||||
xfont <- initXMF ts_font
|
||||
|
||||
-- run the treeselect Monad
|
||||
ret <- evalStateT (runReaderT (runTreeSelect (redraw >> navigate)) conf)
|
||||
TSState{ tss_tree = zipper
|
||||
, tss_window = win
|
||||
, tss_display = display
|
||||
, tss_xfont = xfont
|
||||
, tss_size = (fromIntegral rect_width, fromIntegral rect_height)
|
||||
, tss_gc = gc
|
||||
, tss_visual = visualInfo_visual vinfo
|
||||
, tss_colormap = colormap
|
||||
, tss_history = ([], hist)
|
||||
}
|
||||
|
||||
-- release the XMF font
|
||||
releaseXMF xfont
|
||||
liftIO $ freeGC display gc
|
||||
return ret
|
||||
|
||||
else return Nothing
|
||||
|
||||
-- destroy the window
|
||||
liftIO $ do
|
||||
unmapWindow display win
|
||||
destroyWindow display win
|
||||
freeColormap display colormap
|
||||
-- Flush the output buffer and wait for all the events to be processed
|
||||
-- TODO: is this needed?
|
||||
sync display False
|
||||
return r
|
||||
|
||||
-- | Select a workspace and execute a \"view\" function from "XMonad.StackSet" on it.
|
||||
treeselectWorkspace :: TSConfig WorkspaceId
|
||||
-> Forest String -- ^ your tree of workspace-names
|
||||
-> (WorkspaceId -> WindowSet -> WindowSet) -- ^ the \"view\" function.
|
||||
-- Instances can be 'W.greedyView' for switching to a workspace
|
||||
-- and/or 'W.shift' for moving the focused window to a selected workspace.
|
||||
--
|
||||
-- These actions can also be combined by doing
|
||||
--
|
||||
-- > \i -> W.greedyView i . W.shift i
|
||||
-> X ()
|
||||
treeselectWorkspace c xs f = do
|
||||
-- get all defined workspaces
|
||||
-- They have to be set with 'toWorkspaces'!
|
||||
ws <- gets (W.workspaces . windowset)
|
||||
|
||||
-- check the 'XConfig.workspaces'
|
||||
if all (`elem` map tag ws) (toWorkspaces xs)
|
||||
then do
|
||||
-- convert the 'Forest WorkspaceId' to 'Forest (TSNode WorkspaceId)'
|
||||
wsf <- forMForest (mkPaths xs) $ \(n, i) -> maybe (return (TSNode n "Does not exist!" "")) (mkNode n) (find (\w -> i == tag w) ws)
|
||||
|
||||
-- get the current workspace path
|
||||
me <- gets (W.tag . W.workspace . W.current . windowset)
|
||||
hist <- workspaceHistory
|
||||
treeselectAt c (fromJust $ followPath tsn_name (splitPath me) $ fromForest wsf) (map splitPath hist) >>= maybe (return ()) (windows . f)
|
||||
|
||||
else liftIO $ do
|
||||
-- error!
|
||||
let msg = unlines $ [ "Please add:"
|
||||
, " workspaces = toWorkspaces myWorkspaces"
|
||||
, "to your XMonad config!"
|
||||
, ""
|
||||
, "XConfig.workspaces: "
|
||||
] ++ map tag ws
|
||||
hPutStrLn stderr msg
|
||||
_ <- forkProcess $ executeFile "xmessage" True [msg] Nothing
|
||||
return ()
|
||||
where
|
||||
mkNode n w = do
|
||||
-- find the focused window's name on this workspace
|
||||
name <- maybe (return "") (fmap show . getName . W.focus) $ stack w
|
||||
return $ TSNode n name (tag w)
|
||||
|
||||
-- | Convert the workspace-tree to a flat list of paths such that XMonad can use them
|
||||
--
|
||||
-- The Nodes will be separated by a dot (\'.\') character
|
||||
toWorkspaces :: Forest String -> [WorkspaceId]
|
||||
toWorkspaces = map snd . concatMap flatten . mkPaths
|
||||
|
||||
mkPaths :: Forest String -> Forest (String, WorkspaceId)
|
||||
mkPaths = map (\(Node n ns) -> Node (n, n) (map (f n) ns))
|
||||
where
|
||||
f pth (Node x xs) = let pth' = pth ++ '.' : x
|
||||
in Node (x, pth') (map (f pth') xs)
|
||||
|
||||
splitPath :: WorkspaceId -> [String]
|
||||
splitPath i = case break (== '.') i of
|
||||
(x, []) -> [x]
|
||||
(x, _:xs) -> x : splitPath xs
|
||||
|
||||
-- | Select from a Tree of 'X' actions
|
||||
--
|
||||
-- <<https://wiki.haskell.org/wikiupload/thumb/9/9b/Treeselect-Action.png/800px-Treeselect-Action.png>>
|
||||
--
|
||||
-- Each of these actions have to be specified inside a 'TSNode'
|
||||
--
|
||||
-- Example
|
||||
--
|
||||
-- > treeselectAction myTreeConf
|
||||
-- > [ Node (TSNode "Hello" "displays hello" (spawn "xmessage hello!")) []
|
||||
-- > , Node (TSNode "Shutdown" "Poweroff the system" (spawn "shutdown")) []
|
||||
-- > , Node (TSNode "Brightness" "Sets screen brightness using xbacklight" (return ()))
|
||||
-- > [ Node (TSNode "Bright" "FULL POWER!!" (spawn "xbacklight -set 100")) []
|
||||
-- > , Node (TSNode "Normal" "Normal Brightness (50%)" (spawn "xbacklight -set 50")) []
|
||||
-- > , Node (TSNode "Dim" "Quite dark" (spawn "xbacklight -set 10")) []
|
||||
-- > ]
|
||||
-- > ]
|
||||
treeselectAction :: TSConfig (X a) -> Forest (TSNode (X a)) -> X ()
|
||||
treeselectAction c xs = treeselect c xs >>= \x -> case x of
|
||||
Just a -> a >> return ()
|
||||
Nothing -> return ()
|
||||
|
||||
forMForest :: (Functor m, Applicative m, Monad m) => [Tree a] -> (a -> m b) -> m [Tree b]
|
||||
forMForest x g = mapM (mapMTree g) x
|
||||
|
||||
mapMTree :: (Functor m, Applicative m, Monad m) => (a -> m b) -> Tree a -> m (Tree b)
|
||||
mapMTree f (Node x xs) = Node <$> f x <*> mapM (mapMTree f) xs
|
||||
|
||||
|
||||
-- | Quit returning the currently selected node
|
||||
select :: TreeSelect a (Maybe a)
|
||||
select = Just <$> gets (tsn_value . cursor . tss_tree)
|
||||
|
||||
-- | Quit without returning anything
|
||||
cancel :: TreeSelect a (Maybe a)
|
||||
cancel = return Nothing
|
||||
|
||||
-- TODO: redraw only what is necessary.
|
||||
-- Examples: redrawAboveCursor, redrawBelowCursor and redrawCursor
|
||||
|
||||
-- | Move the cursor to its parent node
|
||||
moveParent :: TreeSelect a (Maybe a)
|
||||
moveParent = moveWith parent >> redraw >> navigate
|
||||
|
||||
-- | Move the cursor one level down, highlighting its first child-node
|
||||
moveChild :: TreeSelect a (Maybe a)
|
||||
moveChild = moveWith children >> redraw >> navigate
|
||||
|
||||
-- | Move the cursor to the next child-node
|
||||
moveNext :: TreeSelect a (Maybe a)
|
||||
moveNext = moveWith nextChild >> redraw >> navigate
|
||||
|
||||
-- | Move the cursor to the previous child-node
|
||||
movePrev :: TreeSelect a (Maybe a)
|
||||
movePrev = moveWith previousChild >> redraw >> navigate
|
||||
|
||||
-- | Move backwards in history
|
||||
moveHistBack :: TreeSelect a (Maybe a)
|
||||
moveHistBack = do
|
||||
s <- get
|
||||
case tss_history s of
|
||||
(xs, a:y:ys) -> do
|
||||
put s{tss_history = (a:xs, y:ys)}
|
||||
moveTo y
|
||||
_ -> navigate
|
||||
|
||||
-- | Move forward in history
|
||||
moveHistForward :: TreeSelect a (Maybe a)
|
||||
moveHistForward = do
|
||||
s <- get
|
||||
case tss_history s of
|
||||
(x:xs, ys) -> do
|
||||
put s{tss_history = (xs, x:ys)}
|
||||
moveTo x
|
||||
_ -> navigate
|
||||
|
||||
-- | Move to a specific node
|
||||
moveTo :: [String] -- ^ path, always starting from the top
|
||||
-> TreeSelect a (Maybe a)
|
||||
moveTo i = moveWith (followPath tsn_name i . rootNode) >> redraw >> navigate
|
||||
|
||||
-- | Apply a transformation on the internal 'XMonad.Util.TreeZipper.TreeZipper'.
|
||||
moveWith :: (TreeZipper (TSNode a) -> Maybe (TreeZipper (TSNode a))) -> TreeSelect a ()
|
||||
moveWith f = do
|
||||
s <- get
|
||||
case f (tss_tree s) of
|
||||
-- TODO: redraw cursor only?
|
||||
Just t -> put s{ tss_tree = t }
|
||||
Nothing -> return ()
|
||||
|
||||
-- | wait for keys and run navigation
|
||||
navigate :: TreeSelect a (Maybe a)
|
||||
navigate = gets tss_display >>= \d -> join . liftIO . allocaXEvent $ \e -> do
|
||||
maskEvent d (exposureMask .|. keyPressMask .|. buttonReleaseMask) e
|
||||
|
||||
ev <- getEvent e
|
||||
|
||||
if ev_event_type ev == keyPress
|
||||
then do
|
||||
(ks, _) <- lookupString $ asKeyEvent e
|
||||
return $ do
|
||||
mask <- liftX $ cleanMask (ev_state ev)
|
||||
f <- asks ts_navigate
|
||||
fromMaybe navigate $ M.lookup (mask, fromMaybe xK_VoidSymbol ks) f
|
||||
else return navigate
|
||||
|
||||
-- | Request a full redraw
|
||||
redraw :: TreeSelect a ()
|
||||
redraw = do
|
||||
win <- gets tss_window
|
||||
dpy <- gets tss_display
|
||||
|
||||
-- clear window
|
||||
-- TODO: not always needed!
|
||||
liftIO $ clearWindow dpy win
|
||||
|
||||
t <- gets tss_tree
|
||||
_ <- drawLayers 0 0 (reverse $ (tz_before t, cursor t, tz_after t) : tz_parents t)
|
||||
return ()
|
||||
|
||||
drawLayers :: Int -- ^ indentation level
|
||||
-> Int -- ^ height
|
||||
-> [(Forest (TSNode a), TSNode a, Forest (TSNode a))] -- ^ node layers (from top to bottom!)
|
||||
-> TreeSelect a Int
|
||||
drawLayers _ yl [] = return yl
|
||||
drawLayers xl yl ((bs, c, as):xs) = do
|
||||
TSConfig{..} <- ask
|
||||
|
||||
let nodeColor y = if odd y then ts_node else ts_nodealt
|
||||
|
||||
-- draw nodes above
|
||||
forM_ (zip [yl ..] (reverse bs)) $ \(y, Node n _) ->
|
||||
drawNode xl y n (nodeColor y)
|
||||
-- drawLayers (xl + 1) (y + 1) ns
|
||||
-- TODO: draw rest? if not ts_hidechildren
|
||||
-- drawLayers (xl + 1) (y + 1) ns
|
||||
|
||||
-- draw the current / parent node
|
||||
-- if this is the last (currently focused) we use the 'ts_highlight' color
|
||||
let current_level = yl + length bs
|
||||
drawNode xl current_level c $
|
||||
if null xs then ts_highlight
|
||||
else nodeColor current_level
|
||||
|
||||
l2 <- drawLayers (xl + 1) (current_level + 1) xs
|
||||
|
||||
-- draw nodes below
|
||||
forM_ (zip [l2 ..] as) $ \(y, Node n _) ->
|
||||
drawNode xl y n (nodeColor y)
|
||||
-- TODO: draw rest? if not ts_hidechildren
|
||||
-- drawLayers (xl + 1) (y + 1) ns
|
||||
return (l2 + length as)
|
||||
|
||||
|
||||
-- | Draw a node at a given indentation and height level
|
||||
drawNode :: Int -- ^ indentation level (not in pixels)
|
||||
-> Int -- ^ height level (not in pixels)
|
||||
-> TSNode a -- ^ node to draw
|
||||
-> (Pixel, Pixel) -- ^ node foreground (font) and background color
|
||||
-> TreeSelect a ()
|
||||
drawNode ix iy TSNode{..} col = do
|
||||
TSConfig{..} <- ask
|
||||
window <- gets tss_window
|
||||
display <- gets tss_display
|
||||
font <- gets tss_xfont
|
||||
gc <- gets tss_gc
|
||||
colormap <- gets tss_colormap
|
||||
visual <- gets tss_visual
|
||||
liftIO $ drawWinBox window display visual colormap gc font col tsn_name ts_extra tsn_extra
|
||||
(ix * ts_indent) (iy * ts_node_height)
|
||||
ts_node_width ts_node_height
|
||||
|
||||
-- TODO: draw extra text (transparent background? or ts_background)
|
||||
-- drawWinBox window fnt col2 nodeH (scW-x) (mes) (x+nodeW) y 8
|
||||
|
||||
-- | Draw a simple box with text
|
||||
drawWinBox :: Window -> Display -> Visual -> Colormap -> GC -> XMonadFont -> (Pixel, Pixel) -> String -> Pixel -> String -> Int -> Int -> Int -> Int -> IO ()
|
||||
drawWinBox win display visual colormap gc font (fg, bg) text fg2 text2 x y w h = do
|
||||
-- draw box
|
||||
setForeground display gc bg
|
||||
fillRectangle display win gc (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
|
||||
|
||||
-- dreaw text
|
||||
drawStringXMF display win visual colormap gc font fg
|
||||
(fromIntegral $ x + 8)
|
||||
(fromIntegral $ y + h - 8)
|
||||
text
|
||||
|
||||
-- dreaw extra text
|
||||
drawStringXMF display win visual colormap gc font fg2
|
||||
(fromIntegral $ x + w + 8)
|
||||
(fromIntegral $ y + h - 8)
|
||||
text2
|
||||
|
||||
-- | Modified version of 'XMonad.Util.Font.printStringXMF' that uses 'Pixel' as color format
|
||||
drawStringXMF :: Display -> Drawable -> Visual -> Colormap -> GC
|
||||
-> XMonadFont -- ^ XMF Font
|
||||
-> Pixel -- ^ font color
|
||||
-> Position -- ^ x-position
|
||||
-> Position -- ^ y-position
|
||||
-> String -- ^ string text
|
||||
-> IO ()
|
||||
drawStringXMF display window visual colormap gc font col x y text = case font of
|
||||
Core fnt -> do
|
||||
setForeground display gc col
|
||||
setFont display gc $ fontFromFontStruct fnt
|
||||
drawImageString display window gc x y text
|
||||
Utf8 fnt -> do
|
||||
setForeground display gc col
|
||||
wcDrawImageString display window fnt gc x y text
|
||||
#ifdef XFT
|
||||
Xft fnt -> do
|
||||
withXftDraw display window visual colormap $
|
||||
\ft_draw -> withXftColorValue display visual colormap (fromARGB col) $
|
||||
\ft_color -> xftDrawString ft_draw ft_color fnt x y text
|
||||
|
||||
-- | Convert 'Pixel' to 'XRenderColor'
|
||||
--
|
||||
-- Note that it uses short to represent its components
|
||||
fromARGB :: Pixel -> XRenderColor
|
||||
fromARGB x = XRenderColor (fromIntegral $ 0xff00 .&. shiftR x 8) -- red
|
||||
(fromIntegral $ 0xff00 .&. x) -- green
|
||||
(fromIntegral $ 0xff00 .&. shiftL x 8) -- blue
|
||||
(fromIntegral $ 0xff00 .&. shiftR x 16) -- alpha
|
||||
#endif
|
@@ -29,7 +29,7 @@ import Data.Monoid
|
||||
-- following to your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.UpdateFocus
|
||||
-- > xmonad $ defaultConfig {
|
||||
-- > xmonad $ def {
|
||||
-- > ..
|
||||
-- > startupHook = adjustEventInput
|
||||
-- > handleEventHook = focusOnMouseMove
|
||||
|
@@ -19,12 +19,12 @@ module XMonad.Actions.UpdatePointer
|
||||
-- * Usage
|
||||
-- $usage
|
||||
updatePointer
|
||||
, PointerPosition (..)
|
||||
)
|
||||
where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Util.XUtils (fi)
|
||||
import Control.Arrow
|
||||
import Control.Monad
|
||||
import XMonad.StackSet (member, peek, screenDetail, current)
|
||||
import Data.Maybe
|
||||
@@ -35,31 +35,32 @@ import Data.Maybe
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Actions.UpdatePointer
|
||||
--
|
||||
-- Enable it by including it in your logHook definition. Eg:
|
||||
-- Enable it by including it in your logHook definition, e.g.:
|
||||
--
|
||||
-- > logHook = updatePointer Nearest
|
||||
-- > logHook = updatePointer (0.5, 0.5) (1, 1)
|
||||
--
|
||||
-- which will move the pointer to the nearest point of a newly focused window, or
|
||||
-- which will move the pointer to the nearest point of a newly focused
|
||||
-- window. The first argument establishes a reference point within the
|
||||
-- newly-focused window, while the second argument linearly interpolates
|
||||
-- between said reference point and the edges of the newly-focused window to
|
||||
-- obtain a bounding box for the pointer.
|
||||
--
|
||||
-- > logHook = updatePointer (Relative 0.5 0.5)
|
||||
--
|
||||
-- which will move the pointer to the center of a newly focused window.
|
||||
-- > logHook = updatePointer (0.5, 0.5) (0, 0) -- exact centre of window
|
||||
-- > logHook = updatePointer (0.25, 0.25) (0.25, 0.25) -- near the top-left
|
||||
-- > logHook = updatePointer (0.5, 0.5) (1.1, 1.1) -- within 110% of the edge
|
||||
--
|
||||
-- To use this with an existing logHook, use >> :
|
||||
--
|
||||
-- > logHook = dynamicLog
|
||||
-- > >> updatePointer (Relative 1 1)
|
||||
-- > >> updatePointer (1, 1) (0, 0)
|
||||
--
|
||||
-- which moves the pointer to the bottom-right corner of the focused window.
|
||||
|
||||
data PointerPosition = Nearest | Relative Rational Rational | TowardsCentre Rational Rational
|
||||
deriving (Read,Show)
|
||||
|
||||
-- | Update the pointer's location to the currently focused
|
||||
-- window or empty screen unless it's already there, or unless the user was changing
|
||||
-- focus with the mouse
|
||||
updatePointer :: PointerPosition -> X ()
|
||||
updatePointer p = do
|
||||
updatePointer :: (Rational, Rational) -> (Rational, Rational) -> X ()
|
||||
updatePointer refPos ratio = do
|
||||
ws <- gets windowset
|
||||
dpy <- asks display
|
||||
rect <- case peek ws of
|
||||
@@ -67,39 +68,37 @@ updatePointer p = do
|
||||
Just w -> windowAttributesToRectangle `fmap` io (getWindowAttributes dpy w)
|
||||
root <- asks theRoot
|
||||
mouseIsMoving <- asks mouseFocused
|
||||
(_sameRoot,_,currentWindow,rootx,rooty,_,_,_) <- io $ queryPointer dpy root
|
||||
(_sameRoot,_,currentWindow,rootX,rootY,_,_,_) <- io $ queryPointer dpy root
|
||||
drag <- gets dragging
|
||||
unless (pointWithin (fi rootx) (fi rooty) rect
|
||||
unless (pointWithin (fi rootX) (fi rootY) rect
|
||||
|| mouseIsMoving
|
||||
|| isJust drag
|
||||
|| not (currentWindow `member` ws || currentWindow == none)) $
|
||||
case p of
|
||||
Nearest -> do
|
||||
let x = moveWithin (fi rootx) (rect_x rect) (fi (rect_x rect) + fi (rect_width rect))
|
||||
y = moveWithin (fi rooty) (rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
|
||||
io $ warpPointer dpy none root 0 0 0 0 x y
|
||||
TowardsCentre xfrc yfrc -> do
|
||||
let cx = fi (rect_width rect) / 2 + fi (rect_x rect)
|
||||
cy = fi (rect_height rect) / 2 + fi (rect_y rect)
|
||||
x,y,cx,cy :: Rational
|
||||
x = moveWithin (fi rootx) (fi $ rect_x rect) (fi (rect_x rect) + fi (rect_width rect))
|
||||
y = moveWithin (fi rooty) (fi $ rect_y rect) (fi (rect_y rect) + fi (rect_height rect))
|
||||
io $ warpPointer dpy none root 0 0 0 0 (round $ x + xfrc*(cx-x)) (round $ y + yfrc*(cy-y))
|
||||
Relative h v ->
|
||||
io $ warpPointer dpy none root 0 0 0 0
|
||||
(rect_x rect + fraction h (rect_width rect))
|
||||
(rect_y rect + fraction v (rect_height rect))
|
||||
where fraction x y = floor (x * fromIntegral y)
|
||||
|| not (currentWindow `member` ws || currentWindow == none)) $ let
|
||||
-- focused rectangle
|
||||
(rectX, rectY) = (rect_x &&& rect_y) rect
|
||||
(rectW, rectH) = (fi . rect_width &&& fi . rect_height) rect
|
||||
-- reference position, with (0,0) and (1,1) being top-left and bottom-right
|
||||
refX = lerp (fst refPos) rectX (rectX + rectW)
|
||||
refY = lerp (snd refPos) rectY (rectY + rectH)
|
||||
-- final pointer bounds, lerped *outwards* from reference position
|
||||
boundsX = join (***) (lerp (fst ratio) refX) (rectX, rectX + rectW)
|
||||
boundsY = join (***) (lerp (snd ratio) refY) (rectY, rectY + rectH)
|
||||
-- ideally we ought to move the pointer in a straight line towards the
|
||||
-- reference point until it is within the above bounds, but…
|
||||
in io $ warpPointer dpy none root 0 0 0 0
|
||||
(round . clip boundsX $ fi rootX)
|
||||
(round . clip boundsY $ fi rootY)
|
||||
|
||||
windowAttributesToRectangle :: WindowAttributes -> Rectangle
|
||||
windowAttributesToRectangle wa = Rectangle (fi (wa_x wa))
|
||||
(fi (wa_y wa))
|
||||
(fi (wa_width wa + 2 * wa_border_width wa))
|
||||
(fi (wa_height wa + 2 * wa_border_width wa))
|
||||
moveWithin :: Ord a => a -> a -> a -> a
|
||||
moveWithin now lower upper =
|
||||
if now < lower
|
||||
then lower
|
||||
else if now > upper
|
||||
then upper
|
||||
else now
|
||||
|
||||
lerp :: (RealFrac r, Real a, Real b) => r -> a -> b -> r
|
||||
lerp r a b = (1 - r) * realToFrac a + r * realToFrac b
|
||||
|
||||
clip :: Ord a => (a, a) -> a -> a
|
||||
clip (lower, upper) x = if x < lower then lower
|
||||
else if x > upper then upper else x
|
||||
|
||||
|
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.WindowBringer
|
||||
@@ -17,13 +18,13 @@
|
||||
module XMonad.Actions.WindowBringer (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
gotoMenu, gotoMenu', gotoMenuArgs, gotoMenuArgs',
|
||||
bringMenu, bringMenu', bringMenuArgs, bringMenuArgs',
|
||||
windowMap,
|
||||
bringWindow
|
||||
WindowBringerConfig(..),
|
||||
gotoMenu, gotoMenuConfig, gotoMenu', gotoMenuArgs, gotoMenuArgs',
|
||||
bringMenu, bringMenuConfig, bringMenu', bringMenuArgs, bringMenuArgs',
|
||||
windowMap, windowMap', bringWindow, actionMenu
|
||||
) where
|
||||
|
||||
import Data.Char (toLower)
|
||||
import Control.Applicative((<$>))
|
||||
import qualified Data.Map as M
|
||||
|
||||
import qualified XMonad.StackSet as W
|
||||
@@ -46,54 +47,74 @@ import XMonad.Util.NamedWindows (getName)
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
-- | Default menu command
|
||||
defaultCmd :: String
|
||||
defaultCmd = "dmenu"
|
||||
data WindowBringerConfig = WindowBringerConfig
|
||||
{ menuCommand :: String -- ^ The shell command that will handle window selection
|
||||
, menuArgs :: [String] -- ^ Arguments to be passed to menuCommand
|
||||
, windowTitler :: X.WindowSpace -> Window -> X String -- ^ A function that produces window titles given a workspace and a window
|
||||
}
|
||||
|
||||
instance Default WindowBringerConfig where
|
||||
def = WindowBringerConfig{ menuCommand = "dmenu"
|
||||
, menuArgs = ["-i"]
|
||||
, windowTitler = decorateName
|
||||
}
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
||||
-- taken to the corresponding workspace.
|
||||
gotoMenu :: X ()
|
||||
gotoMenu = gotoMenuArgs []
|
||||
gotoMenu = gotoMenuConfig def
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
||||
-- taken to the corresponding workspace. This version accepts a configuration
|
||||
-- object.
|
||||
gotoMenuConfig :: WindowBringerConfig -> X ()
|
||||
gotoMenuConfig wbConfig = actionMenu wbConfig W.focusWindow
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and you will be
|
||||
-- taken to the corresponding workspace. This version takes a list of
|
||||
-- arguments to pass to dmenu.
|
||||
gotoMenuArgs :: [String] -> X ()
|
||||
gotoMenuArgs menuArgs = gotoMenuArgs' defaultCmd menuArgs
|
||||
gotoMenuArgs args = gotoMenuConfig def { menuArgs = args }
|
||||
|
||||
-- | Pops open an application with window titles given over stdin. Choose one,
|
||||
-- and you will be taken to the corresponding workspace.
|
||||
gotoMenu' :: String -> X ()
|
||||
gotoMenu' menuCmd = gotoMenuArgs' menuCmd []
|
||||
gotoMenu' cmd = gotoMenuConfig def { menuArgs = [], menuCommand = cmd }
|
||||
|
||||
-- | Pops open an application with window titles given over stdin. Choose one,
|
||||
-- and you will be taken to the corresponding workspace. This version takes a
|
||||
-- list of arguments to pass to dmenu.
|
||||
gotoMenuArgs' :: String -> [String] -> X ()
|
||||
gotoMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs W.focusWindow
|
||||
gotoMenuArgs' cmd args = gotoMenuConfig def { menuCommand = cmd, menuArgs = args }
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and it will be
|
||||
-- dragged, kicking and screaming, into your current workspace.
|
||||
bringMenu :: X ()
|
||||
bringMenu = bringMenuArgs []
|
||||
bringMenu = bringMenuArgs def
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and it will be
|
||||
-- dragged, kicking and screaming, into your current workspace. This version
|
||||
-- accepts a configuration object.
|
||||
bringMenuConfig :: WindowBringerConfig -> X ()
|
||||
bringMenuConfig wbConfig = actionMenu wbConfig bringWindow
|
||||
|
||||
-- | Pops open a dmenu with window titles. Choose one, and it will be
|
||||
-- dragged, kicking and screaming, into your current workspace. This version
|
||||
-- takes a list of arguments to pass to dmenu.
|
||||
bringMenuArgs :: [String] -> X ()
|
||||
bringMenuArgs menuArgs = bringMenuArgs' defaultCmd menuArgs
|
||||
bringMenuArgs args = bringMenuConfig def { menuArgs = args }
|
||||
|
||||
-- | Pops open an application with window titles given over stdin. Choose one,
|
||||
-- and it will be dragged, kicking and screaming, into your current
|
||||
-- workspace.
|
||||
bringMenu' :: String -> X ()
|
||||
bringMenu' menuCmd = bringMenuArgs' menuCmd []
|
||||
bringMenu' cmd = bringMenuConfig def { menuArgs = [], menuCommand = cmd }
|
||||
|
||||
-- | Pops open an application with window titles given over stdin. Choose one,
|
||||
-- and it will be dragged, kicking and screaming, into your current
|
||||
-- workspace. This version allows arguments to the chooser to be specified.
|
||||
bringMenuArgs' :: String -> [String] -> X ()
|
||||
bringMenuArgs' menuCmd menuArgs = actionMenu menuCmd menuArgs bringWindow
|
||||
bringMenuArgs' cmd args = bringMenuConfig def { menuArgs = args, menuCommand = cmd }
|
||||
|
||||
-- | Brings the specified window into the current workspace.
|
||||
bringWindow :: Window -> X.WindowSet -> X.WindowSet
|
||||
@@ -101,25 +122,33 @@ bringWindow w ws = W.shiftWin (W.currentTag ws) w ws
|
||||
|
||||
-- | Calls dmenuMap to grab the appropriate Window, and hands it off to action
|
||||
-- if found.
|
||||
actionMenu :: String -> [String] -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
|
||||
actionMenu menuCmd menuArgs action = windowMap >>= menuMapFunction >>= flip X.whenJust (windows . action)
|
||||
actionMenu :: WindowBringerConfig -> (Window -> X.WindowSet -> X.WindowSet) -> X ()
|
||||
actionMenu WindowBringerConfig{ menuCommand = cmd
|
||||
, menuArgs = args
|
||||
, windowTitler = titler
|
||||
} action
|
||||
= windowMap' titler >>= menuMapFunction >>= flip X.whenJust (windows . action)
|
||||
where
|
||||
menuMapFunction :: M.Map String a -> X (Maybe a)
|
||||
menuMapFunction selectionMap = menuMapArgs menuCmd menuArgs selectionMap
|
||||
menuMapFunction = menuMapArgs cmd args
|
||||
|
||||
|
||||
-- | A map from window names to Windows.
|
||||
windowMap :: X (M.Map String Window)
|
||||
windowMap = do
|
||||
windowMap = windowMap' decorateName
|
||||
|
||||
-- | A map from window names to Windows, given a windowTitler function.
|
||||
windowMap' :: (X.WindowSpace -> Window -> X String) -> X (M.Map String Window)
|
||||
windowMap' titler = do
|
||||
ws <- gets X.windowset
|
||||
M.fromList `fmap` concat `fmap` mapM keyValuePairs (W.workspaces ws)
|
||||
M.fromList . concat <$> mapM keyValuePairs (W.workspaces ws)
|
||||
where keyValuePairs ws = mapM (keyValuePair ws) $ W.integrate' (W.stack ws)
|
||||
keyValuePair ws w = flip (,) w `fmap` decorateName ws w
|
||||
keyValuePair ws w = flip (,) w <$> titler ws w
|
||||
|
||||
-- | Returns the window name as will be listed in dmenu.
|
||||
-- Lowercased, for your convenience (since dmenu is case-sensitive).
|
||||
-- Tagged with the workspace ID, to guarantee uniqueness, and to let the user
|
||||
-- know where he's going.
|
||||
decorateName :: X.WindowSpace -> Window -> X String
|
||||
decorateName ws w = do
|
||||
name <- fmap (map toLower . show) $ getName w
|
||||
name <- show <$> getName w
|
||||
return $ name ++ " [" ++ W.tag ws ++ "]"
|
||||
|
@@ -21,6 +21,7 @@ module XMonad.Actions.WindowGo (
|
||||
runOrRaiseNext,
|
||||
raiseMaybe,
|
||||
raiseNextMaybe,
|
||||
raiseNextMaybeCustomFocus,
|
||||
|
||||
raiseBrowser,
|
||||
raiseEditor,
|
||||
@@ -38,7 +39,7 @@ module XMonad.Actions.WindowGo (
|
||||
import Control.Monad
|
||||
import Data.Char (toLower)
|
||||
import Data.Monoid
|
||||
import XMonad (Query(), X(), ManageHook, withWindowSet, runQuery, liftIO, ask)
|
||||
import XMonad (Query(), X(), ManageHook, WindowSet, withWindowSet, runQuery, liftIO, ask)
|
||||
import Graphics.X11 (Window)
|
||||
import XMonad.ManageHook
|
||||
import XMonad.Operations (windows)
|
||||
@@ -114,7 +115,7 @@ raise = raiseMaybe $ return ()
|
||||
Mutt which you just did for Firefox - but Mutt runs inside a terminal window?
|
||||
No problem: you search for a terminal window calling itself \"mutt\", and if
|
||||
there isn't you run a terminal with a command to run Mutt! Here's an example
|
||||
(borrowing 'runInTerm' from "XMonad.Utils.Run"):
|
||||
(borrowing 'runInTerm' from "XMonad.Util.Run"):
|
||||
|
||||
> , ((modm, xK_m), raiseMaybe (runInTerm "-title mutt" "mutt") (title =? "mutt"))
|
||||
-}
|
||||
@@ -137,16 +138,21 @@ raiseNext = raiseNextMaybe $ return ()
|
||||
'raiseNextMaybe' is an alternative version that allows cycling
|
||||
through the matching windows. If the focused window matches the
|
||||
query the next matching window is raised. If no matches are found
|
||||
the function f is executed.
|
||||
-}
|
||||
|
||||
the function f is executed. -}
|
||||
raiseNextMaybe :: X () -> Query Bool -> X ()
|
||||
raiseNextMaybe f qry = flip (ifWindows qry) f $ \ws -> do
|
||||
raiseNextMaybe = raiseNextMaybeCustomFocus W.focusWindow
|
||||
|
||||
{- | See 'raiseMaybe' and 'raiseNextMaybe'.
|
||||
In addition to all of the options offered by 'raiseNextMaybe'
|
||||
'raiseNextMaybeCustomFocus' allows the user to supply the function that
|
||||
should be used to shift the focus to any window that is found. -}
|
||||
raiseNextMaybeCustomFocus :: (Window -> WindowSet -> WindowSet) -> X() -> Query Bool -> X()
|
||||
raiseNextMaybeCustomFocus focusFn f qry = flip (ifWindows qry) f $ \ws -> do
|
||||
foc <- withWindowSet $ return . W.peek
|
||||
case foc of
|
||||
Just w | w `elem` ws -> let (_:y:_) = dropWhile (/=w) $ cycle ws -- cannot fail to match
|
||||
in windows $ W.focusWindow y
|
||||
_ -> windows . W.focusWindow . head $ ws
|
||||
in windows $ focusFn y
|
||||
_ -> windows . focusFn . head $ ws
|
||||
|
||||
-- | Given a function which gets us a String, we try to raise a window with that classname,
|
||||
-- or we then interpret that String as a executable name.
|
||||
@@ -167,7 +173,8 @@ raiseAndDo :: X () -> Query Bool -> (Window -> X ()) -> X ()
|
||||
raiseAndDo f qry after = ifWindow qry (afterRaise `mappend` raiseHook) f
|
||||
where afterRaise = ask >>= (>> idHook) . liftX . after
|
||||
|
||||
{- | If a window matching the second argument is found, the window is focused and the third argument is called;
|
||||
{- | If a window matching the second argument is found, the window is focused and
|
||||
the third argument is called;
|
||||
otherwise, the first argument is called. -}
|
||||
runOrRaiseAndDo :: String -> Query Bool -> (Window -> X ()) -> X ()
|
||||
runOrRaiseAndDo = raiseAndDo . safeSpawnProg
|
||||
@@ -182,7 +189,6 @@ raiseMaster raisef thatUserQuery = raiseAndDo raisef thatUserQuery (\_ -> window
|
||||
{- | If the window is found the window is focused and set to master
|
||||
otherwise, action is run.
|
||||
|
||||
> runOrRaiseMaster "firefox" (className =? "Firefox"))
|
||||
-}
|
||||
> runOrRaiseMaster "firefox" (className =? "Firefox")) -}
|
||||
runOrRaiseMaster :: String -> Query Bool -> X ()
|
||||
runOrRaiseMaster run query = runOrRaiseAndDo run query (\_ -> windows W.swapMaster)
|
||||
|
@@ -62,7 +62,7 @@ import qualified Data.Set as S
|
||||
--
|
||||
-- > main = do
|
||||
-- > config <- withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
|
||||
-- > $ defaultConfig { ... }
|
||||
-- > $ def { ... }
|
||||
-- > xmonad config
|
||||
--
|
||||
-- Here, we pass in the keys for navigation in counter-clockwise order from up.
|
||||
|
110
XMonad/Actions/Workscreen.hs
Normal file
110
XMonad/Actions/Workscreen.hs
Normal file
@@ -0,0 +1,110 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Actions.Workscreen
|
||||
-- Copyright : (c) 2012 kedals0
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Dal <kedasl0@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability: unportable
|
||||
--
|
||||
-- A workscreen permits to display a set of workspaces on several
|
||||
-- screens. In xinerama mode, when a workscreen is viewed, workspaces
|
||||
-- associated to all screens are visible.
|
||||
--
|
||||
-- The first workspace of a workscreen is displayed on first screen,
|
||||
-- second on second screen, etc. Workspace position can be easily
|
||||
-- changed. If the current workscreen is called again, workspaces are
|
||||
-- shifted.
|
||||
--
|
||||
-- This also permits to see all workspaces of a workscreen even if just
|
||||
-- one screen is present, and to move windows from workspace to workscreen.
|
||||
-----------------------------------------------------------------------------
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
module XMonad.Actions.Workscreen (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
configWorkscreen
|
||||
,viewWorkscreen
|
||||
,Workscreen(..)
|
||||
,shiftToWorkscreen
|
||||
,fromWorkspace
|
||||
,expandWorkspace
|
||||
,WorkscreenId
|
||||
) where
|
||||
|
||||
import XMonad hiding (workspaces)
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Actions.OnScreen
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Actions.Workscreen
|
||||
-- > myWorkspaces = let myOldWorkspaces = ["adm","work","mail"]
|
||||
-- > in Workscreen.expandWorkspace 2 myOldWorkspaces
|
||||
-- > myStartupHook = do Workscreen.configWorkscreen (Workscreen.fromWorkspace 2 myWorkspaces)
|
||||
-- > return ()
|
||||
--
|
||||
-- Then, replace normal workspace view and shift keybinding:
|
||||
--
|
||||
-- > [((m .|. modm, k), f i)
|
||||
-- > | (i, k) <- zip [0..] [1..12]
|
||||
-- > , (f, m) <- [(Workscreen.viewWorkscreen, 0), (Workscreen.shiftToWorkscreen, shiftMask)]]
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
|
||||
|
||||
data Workscreen = Workscreen{workscreenId::Int,workspaces::[WorkspaceId]} deriving (Show,Typeable)
|
||||
type WorkscreenId=Int
|
||||
|
||||
data WorkscreenStorage = WorkscreenStorage WorkscreenId [Workscreen] deriving (Show,Typeable)
|
||||
instance ExtensionClass WorkscreenStorage where
|
||||
initialValue = WorkscreenStorage 0 []
|
||||
|
||||
-- | Helper to group workspaces. Multiply workspace by screens number.
|
||||
expandWorkspace :: Int -> [WorkspaceId] -> [WorkspaceId]
|
||||
expandWorkspace nscr ws = concat $ map expandId ws
|
||||
where expandId wsId = let t = wsId ++ "_"
|
||||
in map ((++) t . show ) [1..nscr]
|
||||
|
||||
-- | Create workscreen list from workspace list. Group workspaces to
|
||||
-- packets of screens number size.
|
||||
fromWorkspace :: Int -> [WorkspaceId] -> [Workscreen]
|
||||
fromWorkspace n ws = map (\(a,b) -> Workscreen a b) $ zip [0..] (fromWorkspace' n ws)
|
||||
fromWorkspace' :: Int -> [WorkspaceId] -> [[WorkspaceId]]
|
||||
fromWorkspace' _ [] = []
|
||||
fromWorkspace' n ws = take n ws : fromWorkspace' n (drop n ws)
|
||||
|
||||
-- | Initial configuration of workscreens
|
||||
configWorkscreen :: [Workscreen] -> X ()
|
||||
configWorkscreen wscrn = XS.put (WorkscreenStorage 0 wscrn)
|
||||
|
||||
-- | View workscreen of index @WorkscreenId@. If current workscreen is asked
|
||||
-- workscreen, workscreen's workspaces are shifted.
|
||||
viewWorkscreen :: WorkscreenId -> X ()
|
||||
viewWorkscreen wscrId = do (WorkscreenStorage c a) <- XS.get
|
||||
let wscr = if wscrId == c
|
||||
then Workscreen wscrId $ shiftWs (workspaces $ a !! wscrId)
|
||||
else a !! wscrId
|
||||
(x,_:ys) = splitAt wscrId a
|
||||
newWorkscreenStorage = WorkscreenStorage wscrId (x ++ [wscr] ++ ys)
|
||||
windows (viewWorkscreen' wscr)
|
||||
XS.put newWorkscreenStorage
|
||||
|
||||
viewWorkscreen' :: Workscreen -> WindowSet -> WindowSet
|
||||
viewWorkscreen' (Workscreen _ ws) = \s -> foldl wsToSc' s (zip [0..] ws)
|
||||
where wsToSc' s (scr,wsId) = greedyViewOnScreen scr wsId s
|
||||
|
||||
shiftWs :: [WorkspaceId] -> [WorkspaceId]
|
||||
shiftWs a = drop 1 a ++ take 1 a
|
||||
|
||||
-- | Shift a window on the first workspace of workscreen
|
||||
-- @WorkscreenId@.
|
||||
shiftToWorkscreen :: WorkscreenId -> X ()
|
||||
shiftToWorkscreen wscrId = do (WorkscreenStorage _ a) <- XS.get
|
||||
let ws = head . workspaces $ a !! wscrId
|
||||
windows $ W.shift ws
|
@@ -69,8 +69,8 @@ import Data.Traversable(sequenceA)
|
||||
-- > x <- xmobar conf
|
||||
-- > xmonad x
|
||||
-- >
|
||||
-- > conf = additionalKeysP defaultConfig
|
||||
-- > { layoutHook = workspaceCursors myCursors $ layoutHook defaultConfig
|
||||
-- > conf = additionalKeysP def
|
||||
-- > { layoutHook = workspaceCursors myCursors $ layoutHook def
|
||||
-- > , workspaces = toList myCursors } $
|
||||
-- > [("M-"++shift++control++[k], f direction depth)
|
||||
-- > | (f,shift) <- zip [modifyLayer,shiftModifyLayer] ["","S-"]
|
||||
|
@@ -24,7 +24,10 @@ module XMonad.Actions.WorkspaceNames (
|
||||
-- * Workspace naming
|
||||
renameWorkspace,
|
||||
workspaceNamesPP,
|
||||
getWorkspaceNames',
|
||||
getWorkspaceNames,
|
||||
getWorkspaceName,
|
||||
getCurrentWorkspaceName,
|
||||
setWorkspaceName,
|
||||
setCurrentWorkspaceName,
|
||||
|
||||
@@ -32,6 +35,9 @@ module XMonad.Actions.WorkspaceNames (
|
||||
swapTo,
|
||||
swapTo',
|
||||
swapWithCurrent,
|
||||
|
||||
-- * Workspace prompt
|
||||
workspaceNamePrompt
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -47,6 +53,7 @@ import XMonad.Util.WorkspaceCompare (getSortByIndex)
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Data.List (isInfixOf)
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@ file:
|
||||
@@ -55,7 +62,7 @@ import Data.Maybe (fromMaybe)
|
||||
--
|
||||
-- Then add keybindings like the following:
|
||||
--
|
||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace defaultXPConfig)
|
||||
-- > , ((modm .|. shiftMask, xK_r ), renameWorkspace def)
|
||||
--
|
||||
-- and apply workspaceNamesPP to your DynamicLog pretty-printer:
|
||||
--
|
||||
@@ -84,14 +91,27 @@ instance ExtensionClass WorkspaceNames where
|
||||
initialValue = WorkspaceNames M.empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | Returns a lookup function that maps workspace tags to workspace names.
|
||||
getWorkspaceNames' :: X (WorkspaceId -> Maybe String)
|
||||
getWorkspaceNames' = do
|
||||
WorkspaceNames m <- XS.get
|
||||
return (`M.lookup` m)
|
||||
|
||||
-- | Returns a function that maps workspace tag @\"t\"@ to @\"t:name\"@ for
|
||||
-- workspaces with a name, and to @\"t\"@ otherwise.
|
||||
getWorkspaceNames :: X (WorkspaceId -> String)
|
||||
getWorkspaceNames = do
|
||||
WorkspaceNames m <- XS.get
|
||||
return $ \wks -> case M.lookup wks m of
|
||||
Nothing -> wks
|
||||
Just s -> wks ++ ":" ++ s
|
||||
lookup <- getWorkspaceNames'
|
||||
return $ \wks -> wks ++ maybe "" (':' :) (lookup wks)
|
||||
|
||||
-- | Gets the name of a workspace, if set, otherwise returns nothing.
|
||||
getWorkspaceName :: WorkspaceId -> X (Maybe String)
|
||||
getWorkspaceName w = ($ w) `fmap` getWorkspaceNames'
|
||||
|
||||
-- | Gets the name of the current workspace. See 'getWorkspaceName'
|
||||
getCurrentWorkspaceName :: X (Maybe String)
|
||||
getCurrentWorkspaceName = do
|
||||
getWorkspaceName =<< gets (W.currentTag . windowset)
|
||||
|
||||
-- | Sets the name of a workspace. Empty string makes the workspace unnamed
|
||||
-- again.
|
||||
@@ -150,3 +170,18 @@ swapNames w1 w2 = do
|
||||
let getname w = fromMaybe "" $ M.lookup w m
|
||||
set w name m' = if null name then M.delete w m' else M.insert w name m'
|
||||
XS.put $ WorkspaceNames $ set w1 (getname w2) $ set w2 (getname w1) $ m
|
||||
|
||||
-- | Same behavior than 'XMonad.Prompt.Workspace.workspacePrompt' excepted it acts on the workspace name provided by this module.
|
||||
workspaceNamePrompt :: XPConfig -> (String -> X ()) -> X ()
|
||||
workspaceNamePrompt conf job = do
|
||||
myWorkspaces <- gets $ map W.tag . W.workspaces . windowset
|
||||
myWorkspacesName <- getWorkspaceNames >>= \f -> return $ map f myWorkspaces
|
||||
let pairs = zip myWorkspacesName myWorkspaces
|
||||
mkXPrompt (Wor "Select workspace: ") conf
|
||||
(contains myWorkspacesName)
|
||||
(job . toWsId pairs)
|
||||
where toWsId pairs name = case lookup name pairs of
|
||||
Nothing -> ""
|
||||
Just i -> i
|
||||
contains completions input =
|
||||
return $ filter (Data.List.isInfixOf input) completions
|
||||
|
@@ -36,7 +36,6 @@ import XMonad.Layout.NoBorders
|
||||
import XMonad.Layout.SimpleFloat
|
||||
import XMonad.Layout.Tabbed
|
||||
import XMonad.Layout.WindowArranger
|
||||
import XMonad.Prompt
|
||||
import XMonad.Prompt.Shell
|
||||
import XMonad.Prompt.Ssh
|
||||
import XMonad.Prompt.Theme
|
||||
@@ -86,7 +85,7 @@ import XMonad.Util.Themes
|
||||
|
||||
arossatoConfig = do
|
||||
xmobar <- spawnPipe "xmobar" -- REMOVE this line if you do not have xmobar installed!
|
||||
return $ defaultConfig
|
||||
return $ def
|
||||
{ workspaces = ["home","var","dev","mail","web","doc"] ++
|
||||
map show [7 .. 9 :: Int]
|
||||
, logHook = myDynLog xmobar -- REMOVE this line if you do not have xmobar installed!
|
||||
@@ -120,7 +119,7 @@ arossatoConfig = do
|
||||
newManageHook = myManageHook
|
||||
|
||||
-- xmobar
|
||||
myDynLog h = dynamicLogWithPP defaultPP
|
||||
myDynLog h = dynamicLogWithPP def
|
||||
{ ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
|
||||
, ppTitle = xmobarColor "green" "" . shorten 40
|
||||
, ppVisible = wrap "(" ")"
|
||||
@@ -128,7 +127,7 @@ arossatoConfig = do
|
||||
}
|
||||
|
||||
-- key bindings stuff
|
||||
defKeys = keys defaultConfig
|
||||
defKeys = keys def
|
||||
delKeys x = foldr M.delete (defKeys x) (toRemove x)
|
||||
newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x)
|
||||
-- remove some of the default key bindings
|
||||
@@ -144,12 +143,12 @@ arossatoConfig = do
|
||||
[(shiftMask .|. modMask x, k) | k <- [xK_1 .. xK_9]]
|
||||
-- These are my personal key bindings
|
||||
toAdd x =
|
||||
[ ((modMask x , xK_F12 ), xmonadPrompt defaultXPConfig )
|
||||
, ((modMask x , xK_F3 ), shellPrompt defaultXPConfig )
|
||||
, ((modMask x , xK_F4 ), sshPrompt defaultXPConfig )
|
||||
, ((modMask x , xK_F5 ), themePrompt defaultXPConfig )
|
||||
, ((modMask x , xK_F6 ), windowPromptGoto defaultXPConfig )
|
||||
, ((modMask x , xK_F7 ), windowPromptBring defaultXPConfig )
|
||||
[ ((modMask x , xK_F12 ), xmonadPrompt def )
|
||||
, ((modMask x , xK_F3 ), shellPrompt def )
|
||||
, ((modMask x , xK_F4 ), sshPrompt def )
|
||||
, ((modMask x , xK_F5 ), themePrompt def )
|
||||
, ((modMask x , xK_F6 ), windowPromptGoto def )
|
||||
, ((modMask x , xK_F7 ), windowPromptBring def )
|
||||
, ((modMask x , xK_comma ), prevWS )
|
||||
, ((modMask x , xK_period), nextWS )
|
||||
, ((modMask x , xK_Right ), windows W.focusDown )
|
||||
|
@@ -36,9 +36,9 @@ import qualified Data.Map as M
|
||||
-- If you prefer, an azertyKeys function is provided which you can use as so:
|
||||
--
|
||||
-- > import qualified Data.Map as M
|
||||
-- > main = xmonad someConfig { keys = \c -> azertyKeys c `M.union` keys someConfig c }
|
||||
-- > main = xmonad someConfig { keys = \c -> azertyKeys c <+> keys someConfig c }
|
||||
|
||||
azertyConfig = defaultConfig { keys = azertyKeys <+> keys defaultConfig }
|
||||
azertyConfig = def { keys = azertyKeys <+> keys def }
|
||||
|
||||
azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
|
||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||
@@ -46,3 +46,9 @@ azertyKeys conf@(XConfig {modMask = modm}) = M.fromList $
|
||||
[((m .|. modm, k), windows $ f i)
|
||||
| (i, k) <- zip (workspaces conf) [0x26,0xe9,0x22,0x27,0x28,0x2d,0xe8,0x5f,0xe7,0xe0],
|
||||
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
||||
++
|
||||
-- mod-{z,e,r} %! Switch to physical/Xinerama screens 1, 2, or 3
|
||||
-- mod-shift-{z,e,r} %! Move client to screen 1, 2, or 3
|
||||
[((m .|. modm, key), screenWorkspace sc >>= flip whenJust (windows . f))
|
||||
| (key, sc) <- zip [xK_z, xK_e, xK_r] [0..],
|
||||
(f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||
|
47
XMonad/Config/Bepo.hs
Normal file
47
XMonad/Config/Bepo.hs
Normal file
@@ -0,0 +1,47 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Bepo
|
||||
-- Copyright : (c) Yorick Laupa <yo.eight@gmail.com>
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : Yorick Laupa <yo.eight@gmail.com>
|
||||
-- Stability : stable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This module fixes some of the keybindings for the francophone among you who
|
||||
-- use a BEPO keyboard layout. Based on XMonad.Config.Azerty
|
||||
|
||||
module XMonad.Config.Bepo (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
bepoConfig, bepoKeys
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
-- $usage
|
||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.Bepo
|
||||
-- >
|
||||
-- > main = xmonad bepoConfig
|
||||
--
|
||||
-- If you prefer, an bepoKeys function is provided which you can use as so:
|
||||
--
|
||||
-- > import qualified Data.Map as M
|
||||
-- > main = xmonad someConfig { keys = \c -> bepoKeys c `M.union` keys someConfig c }
|
||||
|
||||
bepoConfig = def { keys = bepoKeys <+> keys def }
|
||||
|
||||
bepoKeys conf@(XConfig { modMask = modm }) = M.fromList $
|
||||
[((modm, xK_semicolon), sendMessage (IncMasterN (-1)))]
|
||||
++
|
||||
[((m .|. modm, k), windows $ f i)
|
||||
| (i, k) <- zip (workspaces conf) [0x22,0xab,0xbb,0x28,0x29,0x40,0x2b,0x2d,0x2f,0x2a],
|
||||
(f, m) <- [(W.greedyView, 0), (W.shift, shiftMask)]]
|
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# OPTIONS -fno-warn-missing-signatures #-}
|
||||
----------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -179,8 +180,7 @@ bluetileManageHook :: ManageHook
|
||||
bluetileManageHook = composeAll
|
||||
[ workspaceByPos, positionStoreManageHook (Just defaultThemeWithButtons)
|
||||
, className =? "MPlayer" --> doFloat
|
||||
, isFullscreen --> doFullFloat
|
||||
, manageDocks]
|
||||
, isFullscreen --> doFullFloat]
|
||||
|
||||
bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
|
||||
named "Floating" floating |||
|
||||
@@ -198,7 +198,8 @@ bluetileLayoutHook = avoidStruts $ minimize $ boringWindows $ (
|
||||
floatingDeco l = buttonDeco shrinkText defaultThemeWithButtons l
|
||||
|
||||
bluetileConfig =
|
||||
defaultConfig
|
||||
docks $
|
||||
def
|
||||
{ modMask = mod4Mask, -- logo key
|
||||
manageHook = bluetileManageHook,
|
||||
layoutHook = bluetileLayoutHook,
|
||||
|
@@ -22,7 +22,8 @@ module XMonad.Config.Desktop (
|
||||
-- the DE via a subset of the Extended Window Manager Hints (EWMH)
|
||||
-- specification. Extra xmonad settings unique to specific DE's are
|
||||
-- added by overriding or modifying @desktopConfig@ fields in the
|
||||
-- same way that @defaultConfig@ is customized in @~\/.xmonad/xmonad.hs@.
|
||||
-- same way that the default configuration is customized in
|
||||
-- @~\/.xmonad/xmonad.hs@.
|
||||
--
|
||||
-- For more information about EWMH see:
|
||||
--
|
||||
@@ -69,7 +70,7 @@ import qualified Data.Map as M
|
||||
-- <http://haskell.org/haskellwiki/Xmonad>
|
||||
--
|
||||
-- To configure xmonad for use with a DE or with DE tools like panels
|
||||
-- and pagers, in place of @defaultConfig@ in your @~\/.xmonad/xmonad.hs@,
|
||||
-- and pagers, in place of @def@ in your @~\/.xmonad/xmonad.hs@,
|
||||
-- use @desktopConfig@ or one of the other desktop configs from the
|
||||
-- @XMonad.Config@ namespace. The following setup and customization examples
|
||||
-- work the same way for the other desktop configs as for @desktopConfig@.
|
||||
@@ -88,7 +89,7 @@ import qualified Data.Map as M
|
||||
|
||||
-- $customizing
|
||||
-- To customize a desktop config, modify its fields as is illustrated with
|
||||
-- @defaultConfig@ in "XMonad.Doc.Extending#Extending xmonad".
|
||||
-- the default configuration @def@ in "XMonad.Doc.Extending#Extending xmonad".
|
||||
|
||||
-- $layouts
|
||||
-- See also "XMonad.Util.EZConfig" for more options for modifying key bindings.
|
||||
@@ -163,11 +164,10 @@ import qualified Data.Map as M
|
||||
-- > adjustEventInput
|
||||
--
|
||||
|
||||
desktopConfig = ewmh defaultConfig
|
||||
{ startupHook = setDefaultCursor xC_left_ptr
|
||||
, layoutHook = desktopLayoutModifiers $ layoutHook defaultConfig
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks
|
||||
, keys = desktopKeys <+> keys defaultConfig }
|
||||
desktopConfig = docks $ ewmh def
|
||||
{ startupHook = setDefaultCursor xC_left_ptr <+> startupHook def
|
||||
, layoutHook = desktopLayoutModifiers $ layoutHook def
|
||||
, keys = desktopKeys <+> keys def }
|
||||
|
||||
desktopKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_b), sendMessage ToggleStruts) ]
|
||||
|
322
XMonad/Config/Dmwit.hs
Normal file
322
XMonad/Config/Dmwit.hs
Normal file
@@ -0,0 +1,322 @@
|
||||
-- boilerplate {{{
|
||||
{-# LANGUAGE ExistentialQuantification, NoMonomorphismRestriction, TypeSynonymInstances #-}
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-type-defaults #-}
|
||||
module XMonad.Config.Dmwit where
|
||||
|
||||
-- system imports
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans
|
||||
import Data.Char
|
||||
import Data.List
|
||||
import Data.Map (Map, fromList)
|
||||
import Data.Ratio
|
||||
import Data.Word
|
||||
import GHC.Real
|
||||
import System.Environment
|
||||
import System.Exit
|
||||
import System.IO
|
||||
import System.Process
|
||||
|
||||
-- xmonad core
|
||||
import XMonad
|
||||
import XMonad.StackSet hiding (workspaces)
|
||||
|
||||
-- xmonad contrib
|
||||
import XMonad.Actions.SpawnOn
|
||||
import XMonad.Actions.Warp
|
||||
import XMonad.Hooks.DynamicLog
|
||||
import XMonad.Hooks.ManageDocks
|
||||
import XMonad.Hooks.ManageHelpers
|
||||
import XMonad.Layout.Grid
|
||||
import XMonad.Layout.IndependentScreens
|
||||
import XMonad.Layout.Magnifier
|
||||
import XMonad.Layout.NoBorders
|
||||
import XMonad.Util.Dzen hiding (x, y)
|
||||
import XMonad.Util.SpawnOnce
|
||||
-- }}}
|
||||
-- volume {{{
|
||||
outputOf :: String -> IO String
|
||||
outputOf s = do
|
||||
uninstallSignalHandlers
|
||||
(hIn, hOut, hErr, p) <- runInteractiveCommand s
|
||||
mapM_ hClose [hIn, hErr]
|
||||
hGetContents hOut <* waitForProcess p <* installSignalHandlers
|
||||
|
||||
geomMean :: Floating a => [a] -> a
|
||||
geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
|
||||
|
||||
arithMean :: Floating a => [a] -> a
|
||||
arithMean xs = sum xs / fromIntegral (length xs)
|
||||
|
||||
namedNumbers n s = do
|
||||
l <- lines s
|
||||
guard (sentinel `isPrefixOf` l)
|
||||
return (drop (length sentinel) l)
|
||||
where sentinel = n ++ " #"
|
||||
|
||||
-- Data.List.Split.splitOn ":", but without involving an extra dependency
|
||||
splitColon xs = case break (==':') xs of
|
||||
(a, ':':b) -> a : splitColon b
|
||||
(a, _) -> [a]
|
||||
|
||||
parse s = arithMean $ do
|
||||
l <- lines s
|
||||
guard ("\tVolume: " `isPrefixOf` l)
|
||||
part <- splitColon l
|
||||
(n,'%':_) <- reads part
|
||||
return n
|
||||
|
||||
modVolume :: String -> Integer -> IO Double
|
||||
modVolume kind n = do
|
||||
is <- namedNumbers parseKind <$> outputOf listCommand
|
||||
forM_ is (outputOf . setCommand)
|
||||
parse <$> outputOf listCommand
|
||||
where
|
||||
sign | n > 0 = "+" | otherwise = "-"
|
||||
ctlKind = map (\c -> if c == ' ' then '-' else c) kind
|
||||
parseKind = unwords . map (\(c:cs) -> toUpper c : cs) . words $ kind
|
||||
setCommand i = "pactl set-" ++ ctlKind ++ "-volume " ++ i ++ " -- " ++ sign ++ show (abs n) ++ "%"
|
||||
listCommand = "pactl list " ++ ctlKind ++ "s"
|
||||
-- }}}
|
||||
-- convenient actions {{{
|
||||
centerMouse = warpToWindow (1/2) (1/2)
|
||||
statusBarMouse = warpToScreen 0 (5/1600) (5/1200)
|
||||
withScreen s f = screenWorkspace s >>= flip whenJust (windows . f)
|
||||
|
||||
makeLauncher yargs run exec close = concat
|
||||
["exe=`yeganesh ", yargs, "` && ", run, " ", exec, "$exe", close]
|
||||
launcher = makeLauncher "" "eval" "\"exec " "\""
|
||||
termLauncher = makeLauncher "-p withterm" "exec urxvt -e" "" ""
|
||||
viewShift i = view i . shift i
|
||||
floatAll = composeAll . map (\s -> className =? s --> doFloat)
|
||||
sinkFocus = peek >>= maybe id sink
|
||||
showMod k n = liftIO (modVolume k n) >>= volumeDzen . show . round
|
||||
volumeDzen = dzenConfig $ onCurr (center 170 66) >=> font "-*-helvetica-*-r-*-*-64-*-*-*-*-*-*-*,-*-terminus-*-*-*-*-64-*-*-*-*-*-*-*"
|
||||
-- }}}
|
||||
altMask = mod1Mask
|
||||
bright = "#80c0ff"
|
||||
dark = "#13294e"
|
||||
-- manage hooks for mplayer {{{
|
||||
fullscreen43on169 = expand $ RationalRect 0 (-1/6) 1 (4/3) where
|
||||
expand (RationalRect x y w h) = RationalRect (x - bwx) (y - bwy) (w + 2 * bwx) (h + 2 * bwy)
|
||||
bwx = 2 / 1920 -- borderwidth
|
||||
bwy = 2 / 1080
|
||||
|
||||
fullscreenMPlayer = className =? "MPlayer" --> do
|
||||
dpy <- liftX $ asks display
|
||||
win <- ask
|
||||
hints <- liftIO $ getWMNormalHints dpy win
|
||||
case fmap (approx . fst) (sh_aspect hints) of
|
||||
Just ( 4 :% 3) -> viewFullOn 0 "5" win
|
||||
Just (16 :% 9) -> viewFullOn 1 "5" win
|
||||
_ -> doFloat
|
||||
where
|
||||
fi = fromIntegral :: Dimension -> Double
|
||||
approx (n, d) = approxRational (fi n / fi d) (1/100)
|
||||
|
||||
operationOn f s n w = do
|
||||
let ws = marshall s n
|
||||
currws <- liftX $ screenWorkspace s
|
||||
doF $ view ws . maybe id view currws . shiftWin ws w . f w
|
||||
|
||||
viewFullOn = operationOn sink
|
||||
centerWineOn = operationOn (`XMonad.StackSet.float` RationalRect (79/960) (-1/540) (401/480) (271/270))
|
||||
-- }}}
|
||||
-- debugging {{{
|
||||
class Show a => PPrint a where
|
||||
pprint :: Int -> a -> String
|
||||
pprint _ = show
|
||||
|
||||
data PPrintable = forall a. PPrint a => P a
|
||||
instance Show PPrintable where show (P x) = show x
|
||||
instance PPrint PPrintable where pprint n (P x) = pprint n x
|
||||
|
||||
record :: String -> Int -> [(String, PPrintable)] -> String
|
||||
record s n xs = preamble ++ intercalate newline fields ++ postlude where
|
||||
indentation = '\n' : replicate n '\t'
|
||||
preamble = s ++ " {" ++ indentation
|
||||
postlude = indentation ++ "}"
|
||||
newline = ',' : indentation
|
||||
fields = map (\(name, value) -> name ++ " = " ++ pprint (n+1) value) xs
|
||||
|
||||
instance PPrint a => PPrint (Maybe a) where
|
||||
pprint n (Just x) = "Just (" ++ pprint n x ++ ")"
|
||||
pprint _ x = show x
|
||||
|
||||
instance PPrint a => PPrint [a] where
|
||||
pprint _ [] = "[]"
|
||||
pprint n xs = preamble ++ intercalate newline allLines ++ postlude where
|
||||
indentation = '\n' : replicate n '\t'
|
||||
preamble = "[" ++ indentation
|
||||
allLines = map (pprint (n+1)) xs
|
||||
newline = ',' : indentation
|
||||
postlude = indentation ++ "]"
|
||||
|
||||
instance PPrint Rectangle where
|
||||
pprint n x = record "Rectangle" n [
|
||||
("rect_x", P (rect_x x)),
|
||||
("rect_y", P (rect_y x)),
|
||||
("rect_width", P (rect_width x)),
|
||||
("rect_height", P (rect_height x))
|
||||
]
|
||||
|
||||
instance PPrint a => PPrint (Stack a) where
|
||||
pprint n x = record "Stack" n [
|
||||
("focus", P (XMonad.StackSet.focus x)),
|
||||
("up", P (up x)),
|
||||
("down", P (down x))
|
||||
]
|
||||
|
||||
instance (PPrint i, PPrint l, PPrint a) => PPrint (Workspace i l a) where
|
||||
pprint n x = record "Workspace" n [
|
||||
("tag", P (tag x)),
|
||||
("layout", P (layout x)),
|
||||
("stack", P (stack x))
|
||||
]
|
||||
|
||||
instance PPrint ScreenDetail where
|
||||
pprint n x = record "SD" n [("screenRect", P (screenRect x))]
|
||||
|
||||
instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (XMonad.StackSet.Screen i l a sid sd) where
|
||||
pprint n x = record "Screen" n [
|
||||
("workspace", P (workspace x)),
|
||||
("screen", P (screen x)),
|
||||
("screenDetail", P (screenDetail x))
|
||||
]
|
||||
|
||||
instance (PPrint i, PPrint l, PPrint a, PPrint sid, PPrint sd) => PPrint (StackSet i l a sid sd) where
|
||||
pprint n x = record "StackSet" n [
|
||||
("current", P (current x)),
|
||||
("visible", P (visible x)),
|
||||
("hidden", P (hidden x)),
|
||||
("floating", P (floating x))
|
||||
]
|
||||
|
||||
instance PPrint (Layout a)
|
||||
instance PPrint Int
|
||||
instance PPrint XMonad.Screen
|
||||
instance PPrint Integer
|
||||
instance PPrint Position
|
||||
instance PPrint Dimension
|
||||
instance PPrint Char
|
||||
instance PPrint Word64
|
||||
instance PPrint ScreenId
|
||||
instance (Show a, Show b) => PPrint (Map a b)
|
||||
-- }}}
|
||||
-- main {{{
|
||||
dmwitConfig nScreens = docks $ def {
|
||||
borderWidth = 2,
|
||||
workspaces = withScreens nScreens (map show [1..5]),
|
||||
terminal = "urxvt",
|
||||
normalBorderColor = dark,
|
||||
focusedBorderColor = bright,
|
||||
modMask = mod4Mask,
|
||||
keys = keyBindings,
|
||||
layoutHook = magnifierOff $ avoidStruts (GridRatio 0.9) ||| noBorders Full,
|
||||
manageHook = (title =? "CGoban: Main Window" --> doF sinkFocus)
|
||||
<+> (className =? "Wine" <&&> (appName =? "hl2.exe" <||> appName =? "portal2.exe") --> ask >>= viewFullOn {-centerWineOn-} 1 "5")
|
||||
<+> (className =? "VirtualBox" --> ask >>= viewFullOn 1 "5")
|
||||
<+> (isFullscreen --> doFullFloat) -- TF2 matches the "isFullscreen" criteria, so its manage hook should appear after (e.g., to the left of a <+> compared to) this one
|
||||
<+> (appName =? "huludesktop" --> doRectFloat fullscreen43on169)
|
||||
<+> fullscreenMPlayer
|
||||
<+> floatAll ["Gimp", "Wine"]
|
||||
<+> manageSpawn,
|
||||
logHook = allPPs nScreens,
|
||||
startupHook = refresh
|
||||
>> mapM_ (spawnOnce . xmobarCommand) [0 .. nScreens-1]
|
||||
}
|
||||
|
||||
main = countScreens >>= xmonad . dmwitConfig
|
||||
-- }}}
|
||||
-- keybindings {{{
|
||||
keyBindings conf = let m = modMask conf in fromList . anyMask $ [
|
||||
((m , xK_BackSpace ), spawnHere "urxvt"),
|
||||
((m , xK_p ), spawnHere launcher),
|
||||
((m .|. shiftMask , xK_p ), spawnHere termLauncher),
|
||||
((m .|. shiftMask , xK_c ), kill),
|
||||
((m , xK_q ), restart "xmonad" True),
|
||||
((m .|. shiftMask , xK_q ), io (exitWith ExitSuccess)),
|
||||
((m , xK_grave ), sendMessage NextLayout),
|
||||
((m .|. shiftMask , xK_grave ), setLayout $ layoutHook conf),
|
||||
((m , xK_o ), sendMessage Toggle),
|
||||
((m , xK_x ), withFocused (windows . sink)),
|
||||
((m , xK_Home ), windows focusUp),
|
||||
((m .|. shiftMask , xK_Home ), windows swapUp),
|
||||
((m , xK_End ), windows focusDown),
|
||||
((m .|. shiftMask , xK_End ), windows swapDown),
|
||||
((m , xK_a ), windows focusMaster),
|
||||
((m .|. shiftMask , xK_a ), windows swapMaster),
|
||||
((m , xK_Control_L ), withScreen 0 view),
|
||||
((m .|. shiftMask , xK_Control_L ), withScreen 0 viewShift),
|
||||
((m , xK_Alt_L ), withScreen 1 view),
|
||||
((m .|. shiftMask , xK_Alt_L ), withScreen 1 viewShift),
|
||||
((m , xK_u ), centerMouse),
|
||||
((m .|. shiftMask , xK_u ), statusBarMouse),
|
||||
((m , xK_s ), spawnHere "chromium --password-store=gnome"),
|
||||
((m , xK_n ), spawnHere "gvim todo"),
|
||||
((m , xK_t ), spawnHere "mpc toggle"),
|
||||
((m , xK_h ), spawnHere "urxvt -e alsamixer"),
|
||||
((m , xK_d ), spawnHere "wyvern"),
|
||||
((m , xK_l ), spawnHere "urxvt -e sup"),
|
||||
((m , xK_r ), spawnHere "urxvt -e ncmpcpp"),
|
||||
((m , xK_c ), spawnHere "urxvt -e ghci"),
|
||||
((m , xK_g ), spawnHere "slock" >> spawnHere "xscreensaver-command -lock"),
|
||||
((m , xK_f ), spawnHere "gvim ~/.xmonad/xmonad.hs"),
|
||||
(( noModMask , xK_F8 ), showMod "sink input" (-4)),
|
||||
(( noModMask , xK_F9 ), showMod "sink input" 4 ),
|
||||
(( shiftMask , xK_F8 ), showMod "sink" (-4)),
|
||||
(( shiftMask , xK_F9 ), showMod "sink" 4 ),
|
||||
(( noModMask , xK_Super_L ), return ()) -- make VirtualBox ignore stray hits of the Windows key
|
||||
] ++ [
|
||||
((m .|. e , key ), windows (onCurrentScreen f ws))
|
||||
| (key, ws) <- zip [xK_1..xK_9] (workspaces' conf)
|
||||
, (e, f) <- [(0, view), (shiftMask, viewShift)]
|
||||
]
|
||||
|
||||
atSchool school home = do
|
||||
host <- liftIO (getEnv "HOST")
|
||||
return $ case host of
|
||||
"sorghum" -> home
|
||||
"buckwheat" -> home
|
||||
_ -> school
|
||||
|
||||
anyMask xs = do
|
||||
((mask, key), action) <- xs
|
||||
extraMask <- [0, controlMask, altMask, controlMask .|. altMask]
|
||||
return ((mask .|. extraMask, key), action)
|
||||
-- }}}
|
||||
-- logHook {{{
|
||||
pipeName n s = "/home/dmwit/.xmonad/pipe-" ++ n ++ "-" ++ show s
|
||||
|
||||
xmobarCommand (S s) = unwords ["xmobar",
|
||||
"-x", show s,
|
||||
"-t", template s,
|
||||
"-C", pipeReader
|
||||
]
|
||||
where
|
||||
template 0 = "}%focus%{%workspaces%"
|
||||
template _ = "%date%}%focus%{%workspaces%"
|
||||
pipeReader = "'[\
|
||||
\Run PipeReader \"" ++ pipeName "focus" s ++ "\" \"focus\",\
|
||||
\Run PipeReader \"" ++ pipeName "workspaces" s ++ "\" \"workspaces\"\
|
||||
\]'"
|
||||
|
||||
allPPs nScreens = sequence_ [dynamicLogWithPP (pp s) | s <- [0..nScreens-1], pp <- [ppFocus, ppWorkspaces]]
|
||||
color c = xmobarColor c ""
|
||||
|
||||
ppFocus s@(S s_) = whenCurrentOn s def {
|
||||
ppOrder = \(_:_:windowTitle:_) -> [windowTitle],
|
||||
ppOutput = appendFile (pipeName "focus" s_) . (++ "\n")
|
||||
}
|
||||
|
||||
ppWorkspaces s@(S s_) = marshallPP s def {
|
||||
ppCurrent = color "white",
|
||||
ppVisible = color "white",
|
||||
ppHiddenNoWindows = color dark,
|
||||
ppUrgent = color "red",
|
||||
ppSep = "",
|
||||
ppOrder = \(wss:_layout:_title:_) -> [wss],
|
||||
ppOutput = appendFile (pipeName "workspaces" s_) . (++"\n")
|
||||
}
|
||||
-- }}}
|
@@ -16,7 +16,7 @@ import qualified XMonad.StackSet as W
|
||||
import qualified Data.Map as M
|
||||
import System.Exit ( exitWith, ExitCode(ExitSuccess) )
|
||||
|
||||
import XMonad.Layout.Tabbed ( tabbed, defaultTheme,
|
||||
import XMonad.Layout.Tabbed ( tabbed,
|
||||
shrinkText, Shrinker, shrinkIt, CustomShrink(CustomShrink) )
|
||||
import XMonad.Layout.Combo ( combineTwo )
|
||||
import XMonad.Layout.Named ( named )
|
||||
@@ -32,7 +32,7 @@ import XMonad.Layout.ToggleLayouts ( toggleLayouts, ToggleLayout(ToggleLayout) )
|
||||
import XMonad.Layout.ShowWName ( showWName )
|
||||
import XMonad.Layout.Magnifier ( maximizeVertical, MagnifyMsg(Toggle) )
|
||||
|
||||
import XMonad.Prompt ( defaultXPConfig, font, height, XPConfig )
|
||||
import XMonad.Prompt ( font, height, XPConfig )
|
||||
import XMonad.Prompt.Layout ( layoutPrompt )
|
||||
import XMonad.Prompt.Shell ( shellPrompt )
|
||||
|
||||
@@ -42,11 +42,11 @@ import XMonad.Actions.DynamicWorkspaces ( withNthWorkspace, withWorkspace,
|
||||
import XMonad.Actions.CycleWS ( moveTo, WSType( HiddenNonEmptyWS ),
|
||||
Direction1D( Prev, Next) )
|
||||
|
||||
import XMonad.Hooks.ManageDocks ( avoidStruts, manageDocks )
|
||||
import XMonad.Hooks.ManageDocks ( avoidStruts, docks )
|
||||
import XMonad.Hooks.EwmhDesktops ( ewmh )
|
||||
|
||||
myXPConfig :: XPConfig
|
||||
myXPConfig = defaultXPConfig {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
|
||||
myXPConfig = def {font="-*-lucida-medium-r-*-*-14-*-*-*-*-*-*-*"
|
||||
,height=22}
|
||||
|
||||
|
||||
@@ -117,7 +117,7 @@ keys x = M.fromList $
|
||||
++
|
||||
zip (zip (repeat (modMask x .|. shiftMask)) [xK_F1..xK_F12]) (map (withNthWorkspace copy) [0..])
|
||||
|
||||
config = ewmh defaultConfig
|
||||
config = docks $ ewmh def
|
||||
{ borderWidth = 1 -- Width of the window border in pixels.
|
||||
, XMonad.workspaces = ["mutt","iceweasel"]
|
||||
, layoutHook = showWName $ workspaceDir "~" $
|
||||
@@ -129,7 +129,6 @@ config = ewmh defaultConfig
|
||||
named "widescreen" ((mytab *||* mytab)
|
||||
****//* combineTwo Square mytab mytab) -- |||
|
||||
--mosaic 0.25 0.5
|
||||
, manageHook = manageHook defaultConfig <+> manageDocks -- add panel-handling
|
||||
, terminal = "xterm" -- The preferred terminal program.
|
||||
, normalBorderColor = "#222222" -- Border color for unfocused windows.
|
||||
, focusedBorderColor = "#00ff00" -- Border color for focused windows.
|
||||
@@ -137,7 +136,7 @@ config = ewmh defaultConfig
|
||||
, XMonad.keys = keys
|
||||
}
|
||||
|
||||
mytab = tabbed CustomShrink defaultTheme
|
||||
mytab = tabbed CustomShrink def
|
||||
|
||||
instance Shrinker CustomShrink where
|
||||
shrinkIt shr s | Just s' <- dropFromHead " " s = shrinkIt shr s'
|
||||
|
@@ -18,7 +18,8 @@ module XMonad.Config.Gnome (
|
||||
-- $usage
|
||||
gnomeConfig,
|
||||
gnomeRun,
|
||||
gnomeRegister
|
||||
gnomeRegister,
|
||||
desktopLayoutModifiers
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -74,7 +75,7 @@ gnomeRegister = io $ do
|
||||
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
|
||||
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
||||
["--session"
|
||||
,"--print-reply=string"
|
||||
,"--print-reply=literal"
|
||||
,"--dest=org.gnome.SessionManager"
|
||||
,"/org/gnome/SessionManager"
|
||||
,"org.gnome.SessionManager.RegisterClient"
|
||||
|
@@ -17,7 +17,8 @@ module XMonad.Config.Kde (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
kdeConfig,
|
||||
kde4Config
|
||||
kde4Config,
|
||||
desktopLayoutModifiers
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
|
88
XMonad/Config/Mate.hs
Normal file
88
XMonad/Config/Mate.hs
Normal file
@@ -0,0 +1,88 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Mate
|
||||
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
|
||||
-- License : BSD
|
||||
--
|
||||
-- Maintainer : allbery.b@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This module provides a config suitable for use with the MATE desktop
|
||||
-- environment.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Config.Mate (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
mateConfig,
|
||||
mateRun,
|
||||
mateRegister,
|
||||
desktopLayoutModifiers
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Config.Desktop
|
||||
import XMonad.Util.Run (safeSpawn)
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
import System.Environment (getEnvironment)
|
||||
|
||||
-- $usage
|
||||
-- To use this module, start with the following @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Config.Mate
|
||||
-- >
|
||||
-- > main = xmonad mateConfig
|
||||
--
|
||||
-- For examples of how to further customize @mateConfig@ see "XMonad.Config.Desktop".
|
||||
|
||||
mateConfig = desktopConfig
|
||||
{ terminal = "mate-terminal"
|
||||
, keys = mateKeys <+> keys desktopConfig
|
||||
, startupHook = mateRegister >> startupHook desktopConfig }
|
||||
|
||||
mateKeys (XConfig {modMask = modm}) = M.fromList $
|
||||
[ ((modm, xK_p), mateRun)
|
||||
, ((modm .|. shiftMask, xK_q), spawn "mate-session-save --logout-dialog") ]
|
||||
|
||||
-- | Launch the "Run Application" dialog. mate-panel must be running for this
|
||||
-- to work.
|
||||
mateRun :: X ()
|
||||
mateRun = withDisplay $ \dpy -> do
|
||||
rw <- asks theRoot
|
||||
mate_panel <- getAtom "_MATE_PANEL_ACTION"
|
||||
panel_run <- getAtom "_MATE_PANEL_ACTION_RUN_DIALOG"
|
||||
|
||||
io $ allocaXEvent $ \e -> do
|
||||
setEventType e clientMessage
|
||||
setClientMessageEvent e rw mate_panel 32 panel_run 0
|
||||
sendEvent dpy rw False structureNotifyMask e
|
||||
sync dpy False
|
||||
|
||||
-- | Register xmonad with mate. 'dbus-send' must be in the $PATH with which
|
||||
-- xmonad is started.
|
||||
--
|
||||
-- This action reduces a delay on startup only if you have configured
|
||||
-- mate-session to start xmonad with a command such as (check local
|
||||
-- documentation):
|
||||
--
|
||||
-- > dconf write /org/mate/desktop/session/required_components/windowmanager "'xmonad'"
|
||||
--
|
||||
-- (the extra quotes are required by dconf)
|
||||
mateRegister :: MonadIO m => m ()
|
||||
mateRegister = io $ do
|
||||
x <- lookup "DESKTOP_AUTOSTART_ID" `fmap` getEnvironment
|
||||
whenJust x $ \sessionId -> safeSpawn "dbus-send"
|
||||
["--session"
|
||||
,"--print-reply=literal"
|
||||
,"--dest=org.mate.SessionManager"
|
||||
,"/org/mate/SessionManager"
|
||||
,"org.mate.SessionManager.RegisterClient"
|
||||
,"string:xmonad"
|
||||
,"string:"++sessionId]
|
689
XMonad/Config/Prime.hs
Normal file
689
XMonad/Config/Prime.hs
Normal file
@@ -0,0 +1,689 @@
|
||||
{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies, KindSignatures, MultiParamTypeClasses, UndecidableInstances #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config.Prime
|
||||
-- Copyright : Devin Mullins <devin.mullins@gmail.com>
|
||||
-- License : BSD-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Devin Mullins <devin.mullins@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This is a draft of a brand new config syntax for xmonad. It aims to be:
|
||||
--
|
||||
-- * easier to copy/paste snippets from the docs
|
||||
--
|
||||
-- * easier to get the gist for what's going on, for you imperative programmers
|
||||
--
|
||||
-- It's brand new, so it's pretty much guaranteed to break or change syntax.
|
||||
-- But what's the worst that could happen? Xmonad crashes and logs you out?
|
||||
-- It probably won't do that. Give it a try.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Config.Prime (
|
||||
-- Note: The identifiers here are listed in the order that makes the most sense
|
||||
-- for a user, while the definitions below are listed in the order that makes
|
||||
-- the most sense for a developer.
|
||||
|
||||
-- * Start here
|
||||
-- $start_here
|
||||
xmonad,
|
||||
nothing,
|
||||
-- * Attributes you can set
|
||||
-- $settables
|
||||
normalBorderColor,
|
||||
focusedBorderColor,
|
||||
terminal,
|
||||
modMask,
|
||||
borderWidth,
|
||||
focusFollowsMouse,
|
||||
clickJustFocuses,
|
||||
SettableClass(..),
|
||||
UpdateableClass(..),
|
||||
|
||||
-- * Attributes you can add to
|
||||
-- $summables
|
||||
manageHook,
|
||||
handleEventHook,
|
||||
workspaces,
|
||||
logHook,
|
||||
startupHook,
|
||||
clientMask,
|
||||
rootMask,
|
||||
SummableClass(..),
|
||||
|
||||
-- * Attributes you can add to or remove from
|
||||
-- $removables
|
||||
keys,
|
||||
mouseBindings,
|
||||
RemovableClass(..),
|
||||
|
||||
-- * Modifying the list of workspaces
|
||||
-- $workspaces
|
||||
withWorkspaces,
|
||||
wsNames,
|
||||
wsKeys,
|
||||
wsActions,
|
||||
wsSetName,
|
||||
|
||||
-- * Modifying the screen keybindings
|
||||
-- $screens
|
||||
withScreens,
|
||||
sKeys,
|
||||
sActions,
|
||||
onScreens,
|
||||
|
||||
-- * Modifying the layoutHook
|
||||
-- $layout
|
||||
addLayout,
|
||||
resetLayout,
|
||||
modifyLayout,
|
||||
|
||||
-- * Updating the XConfig en masse
|
||||
-- $update
|
||||
startWith,
|
||||
apply,
|
||||
applyIO,
|
||||
|
||||
-- * The rest of the world
|
||||
-- | Everything you know and love from the core "XMonad" module is available
|
||||
-- for use in your config file, too.
|
||||
module XMonad,
|
||||
-- | (Almost) everything you know and love from the Haskell "Prelude" is
|
||||
-- available for use in your config file. Note that '>>' has been overriden, so
|
||||
-- if you want to create do-blocks for normal monads, you'll need some let
|
||||
-- statements or a separate module. (See the Troubleshooting section.)
|
||||
module Prelude,
|
||||
|
||||
-- * Core
|
||||
-- | These are the building blocks on which the config language is built.
|
||||
-- Regular people shouldn't need to know about these.
|
||||
Prime,
|
||||
Arr,
|
||||
(>>),
|
||||
ifThenElse,
|
||||
|
||||
-- * Example config
|
||||
-- $example
|
||||
|
||||
-- * Troubleshooting
|
||||
-- $troubleshooting
|
||||
) where
|
||||
|
||||
import Prelude hiding ((>>), mod)
|
||||
import qualified Prelude as P ((>>=), (>>))
|
||||
|
||||
import Data.Monoid (All)
|
||||
|
||||
import XMonad hiding (xmonad, XConfig(..))
|
||||
import XMonad (XConfig(XConfig))
|
||||
import qualified XMonad.StackSet as W
|
||||
import qualified XMonad as X (xmonad, XConfig(..))
|
||||
|
||||
import XMonad.Util.EZConfig (additionalKeysP, additionalMouseBindings, checkKeymap, removeKeysP, removeMouseBindings)
|
||||
|
||||
-- $start_here
|
||||
-- To start with, create a @~\/.xmonad\/xmonad.hs@ that looks like this:
|
||||
--
|
||||
-- > {-# LANGUAGE RebindableSyntax #-}
|
||||
-- > import XMonad.Config.Prime
|
||||
-- >
|
||||
-- > -- Imports go here.
|
||||
-- >
|
||||
-- > main = xmonad $ do
|
||||
-- > nothing
|
||||
-- > -- Configs go here.
|
||||
--
|
||||
-- This will give you a default xmonad install, with room to grow. The lines
|
||||
-- starting with double dashes are comments. You may delete them. Note that
|
||||
-- Haskell is a bit precise about indentation. Make sure all the statements in
|
||||
-- your do-block start at the same column, and make sure that any multi-line
|
||||
-- statements are formatted with a hanging indent. (For an example, see the
|
||||
-- 'keys =+' statement in the /Example config/ section, below.)
|
||||
--
|
||||
-- After changing your config file, restart xmonad with mod-q (where, by
|
||||
-- default, "mod" == "alt").
|
||||
|
||||
--
|
||||
-- The Prime "Monad"
|
||||
--
|
||||
|
||||
-- | A Prime is a function that transforms an XConfig. It's not a monad, but we
|
||||
-- turn on RebindableSyntax so we can abuse the pretty do notation.
|
||||
type Prime l l' = Arr (XConfig l) (XConfig l')
|
||||
|
||||
-- | An Arr is a generalization of Prime. Don't reference the type, if you can
|
||||
-- avoid it. It might go away in the future.
|
||||
type Arr x y = x -> IO y
|
||||
|
||||
-- | Composes two Arrs using 'Prelude.>>=' from "Prelude".
|
||||
(>>) :: Arr x y -> Arr y z -> Arr x z
|
||||
(>>) x y c = (P.>>=) (x c) y
|
||||
|
||||
-- | Because of RebindableSyntax, this is necessary to enable you to use
|
||||
-- if-then-else expressions. No need to call it directly.
|
||||
ifThenElse :: Bool -> a -> a -> a
|
||||
ifThenElse True a _ = a
|
||||
ifThenElse False _ b = b
|
||||
|
||||
-- | This is the xmonad main function. It passes 'XMonad.Config.def' (the
|
||||
-- default 'XConfig') into your do-block, takes the modified config out of your
|
||||
-- do-block, and then runs xmonad.
|
||||
--
|
||||
-- The do-block is a 'Prime'. Advanced readers can skip right to that
|
||||
-- definition.
|
||||
|
||||
xmonad :: (Default a, Read (l Window), LayoutClass l Window) =>
|
||||
(a -> IO (XConfig l)) -> IO ()
|
||||
xmonad prime = (P.>>=) (prime def) X.xmonad
|
||||
|
||||
-- | This doesn't modify the config in any way. It's just here for your initial
|
||||
-- config because Haskell doesn't allow empty do-blocks. Feel free to delete it
|
||||
-- once you've added other stuff.
|
||||
nothing :: Prime l l
|
||||
nothing = return
|
||||
|
||||
-- $settables
|
||||
-- These are a bunch of attributes that you can set. Syntax looks like this:
|
||||
--
|
||||
-- > terminal =: "urxvt"
|
||||
--
|
||||
-- Strings are double quoted, Dimensions are unquoted integers, booleans are
|
||||
-- 'True' or 'False' (case-sensitive), and 'modMask' is usually 'mod1Mask' or
|
||||
-- 'mod4Mask'.
|
||||
|
||||
class UpdateableClass s x y | s -> x y where
|
||||
-- | This lets you apply a function to an attribute (i.e. read, modify, write).
|
||||
(=.) :: s c -> (x -> y) -> Arr c c
|
||||
|
||||
class SettableClass s x y | s -> x y where
|
||||
-- | This lets you modify an attribute.
|
||||
(=:) :: s c -> y -> Arr c c
|
||||
|
||||
-- Undecideable instance. But it's nice to leave open the possibility to write
|
||||
-- fields you can't read (e.g. `wmName =: ...`).
|
||||
instance UpdateableClass s x y => SettableClass s x y where
|
||||
s =: y = s =. const y
|
||||
|
||||
data Settable x c = Settable (c -> x) -- getter
|
||||
(x -> c -> c) -- setter
|
||||
|
||||
instance UpdateableClass (Settable x) x x where
|
||||
(Settable g s =. f) c = return $ s (f $ g c) c
|
||||
|
||||
-- | Non-focused windows border color. Default: @\"#dddddd\"@
|
||||
normalBorderColor :: Settable String (XConfig l)
|
||||
normalBorderColor = Settable X.normalBorderColor (\x c -> c { X.normalBorderColor = x })
|
||||
|
||||
-- | Focused windows border color. Default: @\"#ff0000\"@
|
||||
focusedBorderColor :: Settable String (XConfig l)
|
||||
focusedBorderColor = Settable X.focusedBorderColor (\x c -> c { X.focusedBorderColor = x })
|
||||
|
||||
-- | The preferred terminal application. Default: @\"xterm\"@
|
||||
terminal :: Settable String (XConfig l)
|
||||
terminal = Settable X.terminal (\x c -> c { X.terminal = x })
|
||||
|
||||
-- | The mod modifier, as used by key bindings. Default: @mod1Mask@ (which is
|
||||
-- probably alt on your computer).
|
||||
modMask :: Settable KeyMask (XConfig l)
|
||||
modMask = Settable X.modMask (\x c -> c { X.modMask = x })
|
||||
|
||||
-- | The border width (in pixels). Default: @1@
|
||||
borderWidth :: Settable Dimension (XConfig l)
|
||||
borderWidth = Settable X.borderWidth (\x c -> c { X.borderWidth = x })
|
||||
|
||||
-- | Whether window focus follows the mouse cursor on move, or requires a mouse
|
||||
-- click. (Mouse? What's that?) Default: @True@
|
||||
focusFollowsMouse :: Settable Bool (XConfig l)
|
||||
focusFollowsMouse = Settable X.focusFollowsMouse (\x c -> c { X.focusFollowsMouse = x })
|
||||
|
||||
-- | If True, a mouse click on an inactive window focuses it, but the click is
|
||||
-- not passed to the window. If False, the click is also passed to the window.
|
||||
-- Default @True@
|
||||
clickJustFocuses :: Settable Bool (XConfig l)
|
||||
clickJustFocuses = Settable X.clickJustFocuses (\x c -> c { X.clickJustFocuses = x })
|
||||
|
||||
-- $summables
|
||||
-- In addition to being able to set these attributes, they have a special
|
||||
-- syntax for being able to add to them. The operator is @=+@ (the plus comes
|
||||
-- /after/ the equals), but each attribute has a different syntax for what
|
||||
-- comes after the operator.
|
||||
|
||||
class SummableClass s y | s -> y where
|
||||
-- | This lets you add to an attribute.
|
||||
(=+) :: s c -> y -> Arr c c
|
||||
infix 0 =+
|
||||
|
||||
data Summable x y c = Summable (c -> x) -- getter
|
||||
(x -> c -> c) -- setter
|
||||
(x -> y -> x) -- accumulator
|
||||
|
||||
instance UpdateableClass (Summable x y) x x where
|
||||
(Summable g s _ =. f) c = return $ s (f $ g c) c
|
||||
|
||||
instance SummableClass (Summable x y) y where
|
||||
(Summable g s a =+ y) c = return $ s (g c `a` y) c
|
||||
|
||||
-- | The action to run when a new window is opened. Default:
|
||||
--
|
||||
-- > manageHook =: composeAll [className =? "MPlayer" --> doFloat, className =? "Gimp" --> doFloat]
|
||||
--
|
||||
-- To add more rules to this list, you can say, for instance:
|
||||
--
|
||||
-- > import XMonad.StackSet
|
||||
-- > ...
|
||||
-- > manageHook =+ (className =? "Emacs" --> doF kill)
|
||||
-- > manageHook =+ (className =? "Vim" --> doF shiftMaster)
|
||||
--
|
||||
-- Note that operator precedence mandates the parentheses here.
|
||||
manageHook :: Summable ManageHook ManageHook (XConfig l)
|
||||
manageHook = Summable X.manageHook (\x c -> c { X.manageHook = x }) (<+>)
|
||||
|
||||
-- | Custom X event handler. Return @All True@ if the default handler should
|
||||
-- also be run afterwards. Default does nothing. To add an event handler:
|
||||
--
|
||||
-- > import XMonad.Hooks.ServerMode
|
||||
-- > ...
|
||||
-- > handleEventHook =+ serverModeEventHook
|
||||
handleEventHook :: Summable (Event -> X All) (Event -> X All) (XConfig l)
|
||||
handleEventHook = Summable X.handleEventHook (\x c -> c { X.handleEventHook = x }) (<+>)
|
||||
|
||||
-- | List of workspaces' names. Default: @map show [1 .. 9 :: Int]@. Adding
|
||||
-- appends to the end:
|
||||
--
|
||||
-- > workspaces =+ ["0"]
|
||||
--
|
||||
-- This is useless unless you also create keybindings for this.
|
||||
workspaces :: Summable [String] [String] (XConfig l)
|
||||
workspaces = Summable X.workspaces (\x c -> c { X.workspaces = x }) (++)
|
||||
|
||||
-- | The action to perform when the windows set is changed. This happens
|
||||
-- whenever focus change, a window is moved, etc. @logHook =+@ takes an @X ()@
|
||||
-- and appends it via '(>>)'. For instance:
|
||||
--
|
||||
-- > import XMonad.Hooks.ICCCMFocus
|
||||
-- > ...
|
||||
-- > logHook =+ takeTopFocus
|
||||
--
|
||||
-- Note that if your expression is parametrically typed (e.g. of type
|
||||
-- @MonadIO m => m ()@), you'll need to explicitly annotate it, like so:
|
||||
--
|
||||
-- > logHook =+ (io $ putStrLn "Hello, world!" :: X ())
|
||||
logHook :: Summable (X ()) (X ()) (XConfig l)
|
||||
logHook = Summable X.logHook (\x c -> c { X.logHook = x }) (P.>>)
|
||||
|
||||
-- | The action to perform on startup. @startupHook =+@ takes an @X ()@ and
|
||||
-- appends it via '(>>)'. For instance:
|
||||
--
|
||||
-- > import XMonad.Hooks.SetWMName
|
||||
-- > ...
|
||||
-- > startupHook =+ setWMName "LG3D"
|
||||
--
|
||||
-- Note that if your expression is parametrically typed (e.g. of type
|
||||
-- @MonadIO m => m ()@), you'll need to explicitly annotate it, as documented
|
||||
-- in 'logHook'.
|
||||
startupHook :: Summable (X ()) (X ()) (XConfig l)
|
||||
startupHook = Summable X.startupHook (\x c -> c { X.startupHook = x }) (P.>>)
|
||||
|
||||
-- | The client events that xmonad is interested in. This is useful in
|
||||
-- combination with handleEventHook. Default: @structureNotifyMask .|.
|
||||
-- enterWindowMask .|. propertyChangeMask@
|
||||
--
|
||||
-- > clientMask =+ keyPressMask .|. keyReleaseMask
|
||||
clientMask :: Summable EventMask EventMask (XConfig l)
|
||||
clientMask = Summable X.clientMask (\x c -> c { X.clientMask = x }) (.|.)
|
||||
|
||||
-- | The root events that xmonad is interested in. This is useful in
|
||||
-- combination with handleEventHook. Default: @substructureRedirectMask .|.
|
||||
-- substructureNotifyMask .|. enterWindowMask .|. leaveWindowMask .|.
|
||||
-- structureNotifyMask .|. buttonPressMask@
|
||||
rootMask :: Summable EventMask EventMask (XConfig l)
|
||||
rootMask = Summable X.rootMask (\x c -> c { X.rootMask = x }) (.|.)
|
||||
|
||||
-- $removables
|
||||
-- The following support the the @=+@ for adding items and the @=-@ operator
|
||||
-- for removing items.
|
||||
|
||||
class RemovableClass r y | r -> y where
|
||||
-- | This lets you remove from an attribute.
|
||||
(=-) :: r c -> y -> Arr c c
|
||||
infix 0 =-
|
||||
|
||||
data Keys c = Keys { kAdd :: [(String, X ())] -> c -> c,
|
||||
kRemove :: [String] -> c -> c }
|
||||
|
||||
instance SummableClass Keys [(String, X ())] where
|
||||
Keys { kAdd = a } =+ newKeys = return . a newKeys
|
||||
|
||||
instance RemovableClass Keys [String] where
|
||||
Keys { kRemove = r } =- sadKeys = return . r sadKeys
|
||||
|
||||
-- | Key bindings to 'X' actions. Default: see @`man xmonad`@. 'keys'
|
||||
-- takes a list of keybindings specified emacs-style, as documented in
|
||||
-- 'XMonad.Util.EZConfig.mkKeyMap'. For example, to change the "kill window"
|
||||
-- key:
|
||||
--
|
||||
-- > keys =- ["M-S-c"]
|
||||
-- > keys =+ [("M-M1-x", kill)]
|
||||
keys :: Keys (XConfig l)
|
||||
keys = Keys {
|
||||
-- Note that since checkKeymap happens on newKeys, it doesn't check for
|
||||
-- duplicates between repeated applications. Probably OK. (Especially since
|
||||
-- overriding defaults is a common behavior.) Also note that there's no
|
||||
-- reference cycle here. Yay!
|
||||
kAdd = \newKeys c -> (c `additionalKeysP` newKeys) { X.startupHook = (P.>>) (X.startupHook c) (checkKeymap c newKeys) },
|
||||
kRemove = flip removeKeysP
|
||||
}
|
||||
|
||||
data MouseBindings c = MouseBindings { mAdd :: [((ButtonMask, Button), Window -> X ())] -> c -> c,
|
||||
mRemove :: [(ButtonMask, Button)] -> c -> c }
|
||||
|
||||
instance SummableClass MouseBindings [((ButtonMask, Button), Window -> X ())] where
|
||||
MouseBindings { mAdd = a } =+ newBindings = return . a newBindings
|
||||
|
||||
instance RemovableClass MouseBindings [(ButtonMask, Button)] where
|
||||
MouseBindings { mRemove = r } =- sadBindings = return . r sadBindings
|
||||
|
||||
-- | Mouse button bindings to an 'X' actions on a window. Default: see @`man
|
||||
-- xmonad`@. To make mod-<scrollwheel> switch workspaces:
|
||||
--
|
||||
-- > import XMonad.Actions.CycleWS (nextWS, prevWS)
|
||||
-- > ...
|
||||
-- > mouseBindings =+ [((mod4Mask, button4), const prevWS),
|
||||
-- > ((mod4Mask, button5), const nextWS)]
|
||||
--
|
||||
-- Note that you need to specify the numbered mod-mask e.g. 'mod4Mask' instead
|
||||
-- of just 'modMask'.
|
||||
mouseBindings :: MouseBindings (XConfig l)
|
||||
mouseBindings = MouseBindings {
|
||||
mAdd = flip additionalMouseBindings,
|
||||
mRemove = flip removeMouseBindings
|
||||
}
|
||||
|
||||
-- $workspaces
|
||||
-- Workspaces can be configured through 'workspaces', but then the 'keys' need
|
||||
-- to be set, and this can be a bit laborious. 'withWorkspaces' provides a
|
||||
-- convenient mechanism for common workspace updates.
|
||||
|
||||
-- | Configure workspaces through a Prime-like interface. Example:
|
||||
--
|
||||
-- > withWorkspaces $ do
|
||||
-- > wsKeys =+ ["0"]
|
||||
-- > wsActions =+ [("M-M1-", windows . swapWithCurrent)]
|
||||
-- > wsSetName 1 "mail"
|
||||
--
|
||||
-- This will set 'workspaces' and add the necessary keybindings to 'keys'. Note
|
||||
-- that it won't remove old keybindings; it's just not that clever.
|
||||
withWorkspaces :: Arr WorkspaceConfig WorkspaceConfig -> Prime l l
|
||||
withWorkspaces wsarr xconf = (P.>>=) (wsarr def) $ \wsconf -> wsprime wsconf xconf
|
||||
where wsprime :: WorkspaceConfig -> Prime l l
|
||||
wsprime wsconf =
|
||||
(workspaces =: allNames) >>
|
||||
(keys =+ [(mod ++ key, action name) | (name, key) <- zip allNames (wsKeys_ wsconf),
|
||||
(mod, action) <- wsActions_ wsconf])
|
||||
where allNames = zipWith chooseName (wsNames_ wsconf) (wsKeys_ wsconf)
|
||||
chooseName name keyspec = if not (null name) then name else keyspec
|
||||
|
||||
data WorkspaceConfig = WorkspaceConfig {
|
||||
wsNames_ :: [String],
|
||||
wsKeys_ :: [String],
|
||||
wsActions_ :: [(String, String -> X ())]
|
||||
}
|
||||
|
||||
instance Default WorkspaceConfig where
|
||||
def = WorkspaceConfig {
|
||||
wsNames_ = repeat "",
|
||||
wsKeys_ = map (:[]) ['1'..'9'], -- The hungry monkey eats dots and turns them into numbers.
|
||||
wsActions_ = [("M-", windows . W.greedyView),
|
||||
("M-S-", windows . W.shift)]
|
||||
}
|
||||
|
||||
-- | The list of workspace names, like 'workspaces' but with two differences:
|
||||
--
|
||||
-- 1. If any entry is the empty string, it'll be replaced with the
|
||||
-- corresponding entry in 'wsKeys'.
|
||||
-- 2. The list is truncated to the size of 'wsKeys'.
|
||||
--
|
||||
-- The default value is @'repeat' ""@.
|
||||
--
|
||||
-- If you'd like to create workspaces without associated keyspecs, you can do
|
||||
-- that afterwards, outside the 'withWorkspaces' block, with @'workspaces' =+@.
|
||||
wsNames :: Settable [String] WorkspaceConfig
|
||||
wsNames = Settable wsNames_ (\x c -> c { wsNames_ = x })
|
||||
|
||||
-- | The list of workspace keys. These are combined with the modifiers in
|
||||
-- 'wsActions' to form the keybindings for navigating to workspaces. Default:
|
||||
-- @["1","2",...,"9"]@.
|
||||
wsKeys :: Summable [String] [String] WorkspaceConfig
|
||||
wsKeys = Summable wsKeys_ (\x c -> c { wsKeys_ = x }) (++)
|
||||
|
||||
-- | Mapping from key prefix to command. Its type is @[(String, String ->
|
||||
-- X())]@. The key prefix may be a modifier such as @\"M-\"@, or a submap
|
||||
-- prefix such as @\"M-a \"@, or both, as in @\"M-a M-\"@. The command is a
|
||||
-- function that takes a workspace name and returns an @X ()@. 'withWorkspaces'
|
||||
-- creates keybindings for the cartesian product of 'wsKeys' and 'wsActions'.
|
||||
--
|
||||
-- Default:
|
||||
--
|
||||
-- > [("M-", windows . W.greedyView),
|
||||
-- > ("M-S-", windows . W.shift)]
|
||||
wsActions :: Summable [(String, String -> X ())] [(String, String -> X ())] WorkspaceConfig
|
||||
wsActions = Summable wsActions_ (\x c -> c { wsActions_ = x }) (++)
|
||||
|
||||
-- | A convenience for just modifying one entry in 'wsNames', in case you only
|
||||
-- want a few named workspaces. Example:
|
||||
--
|
||||
-- > wsSetName 1 "mail"
|
||||
-- > wsSetName 2 "web"
|
||||
wsSetName :: Int -> String -> Arr WorkspaceConfig WorkspaceConfig
|
||||
wsSetName index newName = wsNames =. (map maybeSet . zip [0..])
|
||||
where maybeSet (i, oldName) | i == (index - 1) = newName
|
||||
| otherwise = oldName
|
||||
|
||||
-- $screens
|
||||
-- 'withScreens' provides a convenient mechanism to set keybindings for moving
|
||||
-- between screens, much like 'withWorkspaces'.
|
||||
|
||||
-- | Configure screen keys through a Prime-like interface:
|
||||
--
|
||||
-- > withScreens $ do
|
||||
-- > sKeys =: ["e", "r"]
|
||||
--
|
||||
-- This will add the necessary keybindings to 'keys'. Note that it won't remove
|
||||
-- old keybindings; it's just not that clever.
|
||||
withScreens :: Arr ScreenConfig ScreenConfig -> Prime l l
|
||||
withScreens sarr xconf = (P.>>=) (sarr def) $ \sconf -> sprime sconf xconf
|
||||
where sprime :: ScreenConfig -> Prime l l
|
||||
sprime sconf =
|
||||
(keys =+ [(mod ++ key, action sid) | (sid, key) <- zip [0..] (sKeys_ sconf),
|
||||
(mod, action) <- sActions_ sconf])
|
||||
|
||||
data ScreenConfig = ScreenConfig {
|
||||
sKeys_ :: [String],
|
||||
sActions_ :: [(String, ScreenId -> X ())]
|
||||
}
|
||||
|
||||
instance Default ScreenConfig where
|
||||
def = ScreenConfig {
|
||||
sKeys_ = ["w", "e", "r"],
|
||||
sActions_ = [("M-", windows . onScreens W.view),
|
||||
("M-S-", windows . onScreens W.shift)]
|
||||
}
|
||||
|
||||
|
||||
-- | The list of screen keys. These are combined with the modifiers in
|
||||
-- 'sActions' to form the keybindings for navigating to workspaces. Default:
|
||||
-- @["w","e","r"]@.
|
||||
sKeys :: Summable [String] [String] ScreenConfig
|
||||
sKeys = Summable sKeys_ (\x c -> c { sKeys_ = x }) (++)
|
||||
|
||||
-- | Mapping from key prefix to command. Its type is @[(String, ScreenId ->
|
||||
-- X())]@. Works the same as 'wsActions' except for a different function type.
|
||||
--
|
||||
-- Default:
|
||||
--
|
||||
-- > [("M-", windows . onScreens W.view),
|
||||
-- > ("M-S-", windows . onScreens W.shift)]
|
||||
sActions :: Summable [(String, ScreenId -> X ())] [(String, ScreenId -> X ())] ScreenConfig
|
||||
sActions = Summable sActions_ (\x c -> c { sActions_ = x }) (++)
|
||||
|
||||
-- | Converts a stackset transformer parameterized on the workspace type into one
|
||||
-- parameterized on the screen type. For example, you can use @onScreens W.view
|
||||
-- 0@ to navigate to the workspace on the 0th screen. If the screen id is not
|
||||
-- recognized, the returned transformer acts as an identity function.
|
||||
onScreens :: Eq s => (i -> W.StackSet i l a s sd -> W.StackSet i l a s sd) ->
|
||||
s -> W.StackSet i l a s sd -> W.StackSet i l a s sd
|
||||
onScreens f sc ws = maybe id f (W.lookupWorkspace sc ws) ws
|
||||
|
||||
-- $layout
|
||||
-- Layouts are special. You can't modify them using the @=:@ or @=.@ operator.
|
||||
-- You need to use the following functions.
|
||||
|
||||
-- | Add a layout to the list of layouts choosable with mod-space. For instance:
|
||||
--
|
||||
-- > import XMonad.Layout.Tabbed
|
||||
-- > ...
|
||||
-- > addLayout simpleTabbed
|
||||
addLayout :: (LayoutClass l Window, LayoutClass r Window) => r Window -> Prime l (Choose l r)
|
||||
addLayout r c = return c { X.layoutHook = X.layoutHook c ||| r }
|
||||
|
||||
-- | Reset the layoutHook from scratch. For instance, to get rid of the wide
|
||||
-- layout:
|
||||
--
|
||||
-- > resetLayout $ Tall 1 (3/100) (1/2) ||| Full
|
||||
--
|
||||
-- (The dollar is like an auto-closing parenthesis, so all the stuff to the
|
||||
-- right of it is treated like an argument to resetLayout.)
|
||||
resetLayout :: (LayoutClass r Window) => r Window -> Prime l r
|
||||
resetLayout r c = return c { X.layoutHook = r }
|
||||
|
||||
-- | Modify your 'layoutHook' with some wrapper function. You probably want to call
|
||||
-- this after you're done calling 'addLayout'. Example:
|
||||
--
|
||||
-- > import XMonad.Layout.NoBorders
|
||||
-- > ...
|
||||
-- > modifyLayout smartBorders
|
||||
modifyLayout :: (LayoutClass r Window) => (l Window -> r Window) -> Prime l r
|
||||
modifyLayout f c = return c { X.layoutHook = f $ X.layoutHook c }
|
||||
|
||||
-- $update
|
||||
-- Finally, there are a few contrib modules that bundle multiple attribute
|
||||
-- updates together. There are three types: 1) wholesale replacements for the
|
||||
-- default config, 2) pure functions on the config, and 3) IO actions on the
|
||||
-- config. The syntax for each is different. Examples:
|
||||
--
|
||||
-- 1) To start with a 'XMonad.Config.Gnome.gnomeConfig' instead of the default,
|
||||
-- we use 'startWith':
|
||||
--
|
||||
-- > import XMonad.Config.Gnome
|
||||
-- > ...
|
||||
-- > startWith gnomeConfig
|
||||
--
|
||||
-- 2) 'XMonad.Hooks.UrgencyHook.withUrgencyHook' is a pure function, so we need
|
||||
-- to use 'apply':
|
||||
--
|
||||
-- > import XMonad.Hooks.UrgencyHook
|
||||
-- > ...
|
||||
-- > apply $ withUrgencyHook dzenUrgencyHook
|
||||
--
|
||||
-- 3) 'XMonad.Hooks.DynamicLog.xmobar' returns an @IO (XConfig l)@, so we need
|
||||
-- to use 'applyIO':
|
||||
--
|
||||
-- > import XMonad.Hooks.DynamicLog
|
||||
-- > ...
|
||||
-- > applyIO xmobar
|
||||
|
||||
-- | Replace the current 'XConfig' with the given one. If you use this, you
|
||||
-- probably want it to be the first line of your config.
|
||||
startWith :: XConfig l' -> Prime l l'
|
||||
startWith = const . return
|
||||
|
||||
-- | Turns a pure function on 'XConfig' into a 'Prime'.
|
||||
apply :: (XConfig l -> XConfig l') -> Prime l l'
|
||||
apply f = return . f
|
||||
|
||||
-- | Turns an IO function on 'XConfig' into a 'Prime'.
|
||||
applyIO :: (XConfig l -> IO (XConfig l')) -> Prime l l'
|
||||
applyIO = id -- This is here in case we want to change the Prime type later.
|
||||
|
||||
-- $example
|
||||
-- As an example, I've included below a subset of my current config. Note that
|
||||
-- my import statements specify individual identifiers in parentheticals.
|
||||
-- That's optional. The default is to import the entire module. I just find it
|
||||
-- helpful to remind me where things came from.
|
||||
--
|
||||
-- > {-# LANGUAGE RebindableSyntax #-}
|
||||
-- > import XMonad.Config.Prime
|
||||
-- >
|
||||
-- > import XMonad.Actions.CycleWS (prevWS, nextWS)
|
||||
-- > import XMonad.Actions.SwapWorkspaces (swapWithCurrent)
|
||||
-- > import XMonad.Actions.WindowNavigation (withWindowNavigation)
|
||||
-- > import XMonad.Layout.Fullscreen (fullscreenSupport)
|
||||
-- > import XMonad.Layout.NoBorders (smartBorders)
|
||||
-- > import XMonad.Layout.Tabbed (simpleTabbed)
|
||||
-- >
|
||||
-- > main = xmonad $ do
|
||||
-- > modMask =: mod4Mask
|
||||
-- > normalBorderColor =: "#222222"
|
||||
-- > terminal =: "urxvt"
|
||||
-- > focusFollowsMouse =: False
|
||||
-- > resetLayout $ Tall 1 (3/100) (1/2) ||| simpleTabbed
|
||||
-- > modifyLayout smartBorders
|
||||
-- > apply fullscreenSupport
|
||||
-- > applyIO $ withWindowNavigation (xK_w, xK_a, xK_s, xK_d)
|
||||
-- > withWorkspaces $ do
|
||||
-- > wsKeys =+ ["0"]
|
||||
-- > wsActions =+ [("M-M1-", windows . swapWithCurrent)]
|
||||
-- > keys =+ [
|
||||
-- > ("M-,", sendMessage $ IncMasterN (-1)),
|
||||
-- > ("M-.", sendMessage $ IncMasterN 1),
|
||||
-- > ("M-M1-d", spawn "date | dzen2 -fg '#eeeeee' -p 2"),
|
||||
-- > ("C-S-q", return ()),
|
||||
-- > ("<XF86AudioLowerVolume>", spawn "amixer set Master 5%-"),
|
||||
-- > ("<XF86AudioRaiseVolume>", spawn "amixer set Master 5%+"),
|
||||
-- > ("M-M1-x", kill),
|
||||
-- > ("M-i", prevWS),
|
||||
-- > ("M-o", nextWS)
|
||||
-- > ]
|
||||
|
||||
-- $troubleshooting
|
||||
-- === Only the last line of my config seems to take effect. What gives?
|
||||
-- You're missing the @{-\# LANGUAGE RebindableSyntax \#-}@ line at the top.
|
||||
--
|
||||
-- === How do I do use normal monads like 'X' or 'IO'?
|
||||
-- Here are a couple of ways:
|
||||
--
|
||||
-- > import qualified Prelude as P
|
||||
-- > ...
|
||||
-- > test1, test2 :: X ()
|
||||
-- > test1 = spawn "echo Hi" P.>> spawn "echo Bye"
|
||||
-- > test2 = do spawn "echo Hi"
|
||||
-- > spawn "echo Bye"
|
||||
-- > where (>>) = (P.>>)
|
||||
--
|
||||
-- === How do I use the old keyboard syntax?
|
||||
-- You can use 'apply' and supply your own Haskell function. For instance:
|
||||
--
|
||||
-- > apply $ flip additionalKeys $ [((mod1Mask, xK_z), spawn "date | dzen2 -fg '#eeeeee' -p 2")]
|
||||
--
|
||||
-- === How do I run a command before xmonad starts (like 'spawnPipe')?
|
||||
-- If you're using it for a status bar, see if 'XMonad.Hooks.DynamicLog.dzen'
|
||||
-- or 'XMonad.Hooks.DynamicLog.xmobar' does what you want. If so, you can apply
|
||||
-- it with 'applyIO'.
|
||||
--
|
||||
-- If not, you can write your own @XConfig l -> IO (XConfig l)@ and apply it
|
||||
-- with 'applyIO'. When writing this function, see the above tip about using
|
||||
-- normal monads.
|
||||
--
|
||||
-- Alternatively, you could do something like this this:
|
||||
--
|
||||
-- > import qualified Prelude as P (>>)
|
||||
-- >
|
||||
-- > main =
|
||||
-- > openFile ".xmonad.log" AppendMode >>= \log ->
|
||||
-- > hSetBuffering log LineBuffering P.>>
|
||||
-- > (xmonad $ do
|
||||
-- > nothing -- Prime config here.
|
||||
-- > )
|
@@ -21,21 +21,21 @@ import XMonad.Layout.TwoPane
|
||||
import qualified Data.Map as M
|
||||
|
||||
sjanssenConfig =
|
||||
ewmh $ defaultConfig
|
||||
docks $ ewmh $ def
|
||||
{ terminal = "exec urxvt"
|
||||
, workspaces = ["irc", "web"] ++ map show [3 .. 9 :: Int]
|
||||
, mouseBindings = \(XConfig {modMask = modm}) -> M.fromList $
|
||||
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w))
|
||||
, ((modm, button2), (\w -> focus w >> windows W.swapMaster))
|
||||
, ((modm.|. shiftMask, button1), (\w -> focus w >> mouseResizeWindow w)) ]
|
||||
, keys = \c -> mykeys c `M.union` keys defaultConfig c
|
||||
, keys = \c -> mykeys c `M.union` keys def c
|
||||
, logHook = dynamicLogString sjanssenPP >>= xmonadPropLog
|
||||
, layoutHook = modifiers layouts
|
||||
, manageHook = composeAll [className =? x --> doShift w
|
||||
| (x, w) <- [ ("Firefox", "web")
|
||||
, ("Ktorrent", "7")
|
||||
, ("Amarokapp", "7")]]
|
||||
<+> manageHook defaultConfig <+> manageDocks <+> manageSpawn
|
||||
<+> manageHook def <+> manageSpawn
|
||||
<+> (isFullscreen --> doFullFloat)
|
||||
, startupHook = mapM_ spawnOnce spawns
|
||||
}
|
||||
@@ -62,8 +62,8 @@ sjanssenConfig =
|
||||
]
|
||||
|
||||
myFont = "xft:Bitstream Vera Sans Mono:pixelsize=10"
|
||||
myTheme = defaultTheme { fontName = myFont }
|
||||
myPromptConfig = defaultXPConfig
|
||||
myTheme = def { fontName = myFont }
|
||||
myPromptConfig = def
|
||||
{ position = Top
|
||||
, font = myFont
|
||||
, showCompletionOnTab = True
|
||||
|
@@ -16,7 +16,8 @@
|
||||
module XMonad.Config.Xfce (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
xfceConfig
|
||||
xfceConfig,
|
||||
desktopLayoutModifiers
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
|
10
XMonad/Config/dmwit.xmobarrc
Normal file
10
XMonad/Config/dmwit.xmobarrc
Normal file
@@ -0,0 +1,10 @@
|
||||
Config {
|
||||
font = "xft:Monospace:pixelsize=14,-*-*-*-r-*-*-16-*-*-*-*-*-*-*",
|
||||
bgColor = "#000040",
|
||||
fgColor = "#80c0ff",
|
||||
position = TopSize C 100 26,
|
||||
lowerOnStart = True,
|
||||
commands = [ Run Com "date" ["+%H:%M"] "" 30 ],
|
||||
sepChar = "%",
|
||||
alignSep = "}{"
|
||||
}
|
@@ -49,9 +49,9 @@ import XMonad.Doc.Developing ()
|
||||
xmonad is a tiling window manager for X. The xmonad-contrib library
|
||||
collects third party tiling algorithms, hooks, configurations,
|
||||
scripts, and other extensions to xmonad. The source for this library
|
||||
is available from <http://code.haskell.org/XMonadContrib> via darcs:
|
||||
is available from <https://github.com/xmonad/xmonad-contrib> via git:
|
||||
|
||||
> darcs get http://code.haskell.org/XMonadContrib
|
||||
> git clone https://github.com/xmonad/xmonad-contrib.git
|
||||
|
||||
Each stable release of xmonad is accompanied by a stable release of
|
||||
the contrib library, which you should use if (and only if) you're
|
||||
|
@@ -84,7 +84,7 @@ some colours:
|
||||
>
|
||||
> import XMonad
|
||||
>
|
||||
> main = xmonad $ defaultConfig
|
||||
> main = xmonad $ def
|
||||
> { borderWidth = 2
|
||||
> , terminal = "urxvt"
|
||||
> , normalBorderColor = "#cccccc"
|
||||
|
@@ -102,7 +102,7 @@ For more information about any particular module, just click on its
|
||||
name to view its Haddock documentation; each module should come with
|
||||
extensive documentation. If you find a module that could be better
|
||||
documented, or has incorrect documentation, please report it as a bug
|
||||
(<http://code.google.com/p/xmonad/issues/list>)!
|
||||
(<https://github.com/xmonad/xmonad/issues>)!
|
||||
|
||||
-}
|
||||
|
||||
@@ -116,6 +116,13 @@ beyond the standard keybindings provided by xmonad.
|
||||
See "XMonad.Doc.Extending#Editing_key_bindings" for instructions on how to
|
||||
edit your key bindings.
|
||||
|
||||
* "XMonad.Actions.AfterDrag":
|
||||
Allows you to add actions dependent on the current mouse drag.
|
||||
|
||||
* "XMonad.Actions.BluetileCommands":
|
||||
External commands for interfacing the [Bluetile](https://hackage.haskell.org/package/bluetile)
|
||||
tiling window manager with Xmonad.
|
||||
|
||||
* "XMonad.Actions.Commands":
|
||||
Allows you to run internal xmonad commands (X () actions) using
|
||||
a dmenu menu in addition to key bindings. Requires dmenu and
|
||||
@@ -159,6 +166,20 @@ edit your key bindings.
|
||||
master, swap it with the next window in the stack. Focus stays in the
|
||||
master.
|
||||
|
||||
* "XMonad.Actions.DynamicProjects":
|
||||
Imbues workspaces with additional features so they can be treated as
|
||||
individual project areas.
|
||||
|
||||
* "XMonad.Actions.DynamicWorkspaceGroups":
|
||||
Dynamically manage "workspace groups", sets of workspaces being used
|
||||
together for some common task or purpose, to allow switching between
|
||||
workspace groups in a single action. Note that this only makes sense for
|
||||
multi-head setups.
|
||||
|
||||
* "XMonad.Actions.DynamicWorkspaceOrder":
|
||||
Remember a dynamically updateable ordering on workspaces, together with
|
||||
tools for using this ordering with "XMonad.Actions.CycleWS" and "XMonad.Hooks.DynamicLog".
|
||||
|
||||
* "XMonad.Actions.DynamicWorkspaces":
|
||||
Provides bindings to add and delete workspaces. Note that you may only
|
||||
delete a workspace that is already empty.
|
||||
@@ -175,7 +196,7 @@ edit your key bindings.
|
||||
* "XMonad.Actions.FloatKeys":
|
||||
Move and resize floating windows.
|
||||
|
||||
* "XMonad.Layout.FloatSnap":
|
||||
* "XMonad.Actions.FloatSnap":
|
||||
Move and resize floating windows using other windows and the edge of the
|
||||
screen as guidelines.
|
||||
|
||||
@@ -186,6 +207,24 @@ edit your key bindings.
|
||||
GridSelect displays items(e.g. the opened windows) in a 2D grid and lets
|
||||
the user select from it with the cursor/hjkl keys or the mouse.
|
||||
|
||||
* "XMonad.Actions.GroupNavigation":
|
||||
Provides methods for cycling through groups of windows across workspaces,
|
||||
ignoring windows that do not belong to this group. A group consists of all
|
||||
windows matching a user-provided boolean query. Also provides a method for
|
||||
jumping back to the most recently used window in any given group.
|
||||
|
||||
* "XMonad.Actions.KeyRemap":
|
||||
Remap Keybinding on the fly, e.g having Dvorak char,
|
||||
but everything with Control/Shift is left US Layout.
|
||||
|
||||
* "XMonad.Actions.Launcher":
|
||||
A set of prompts for XMonad.
|
||||
|
||||
* "XMonad.Actions.LinkWorkspaces":
|
||||
Provides bindings to add and delete links between workspaces. It is aimed at
|
||||
providing useful links between workspaces in a multihead setup.
|
||||
Linked workspaces are view at the same time.
|
||||
|
||||
* "XMonad.Actions.MessageFeedback":
|
||||
Alternative to 'XMonad.Operations.sendMessage' that provides knowledge
|
||||
of whether the message was handled, and utility functions based on
|
||||
@@ -198,6 +237,10 @@ edit your key bindings.
|
||||
A layout modifier to resize windows with the mouse by grabbing the
|
||||
window's lower right corner.
|
||||
|
||||
* "XMonad.Actions.Navigation2D":
|
||||
Navigation2D is an xmonad extension that allows easy directional navigation
|
||||
of windows and screens (in a multi-monitor setup).
|
||||
|
||||
* "XMonad.Actions.NoBorders":
|
||||
This module provides helper functions for dealing with window borders.
|
||||
|
||||
@@ -228,6 +271,10 @@ edit your key bindings.
|
||||
A module for easily running Internet searches on web sites through xmonad.
|
||||
Modeled after the handy Surfraw CLI search tools at <https://secure.wikimedia.org/wikipedia/en/wiki/Surfraw>.
|
||||
|
||||
* "XMonad.Actions.ShowText":
|
||||
ShowText displays text for sometime on the screen similar to
|
||||
"XMonad.Util.Dzen" which offers more features (currently).
|
||||
|
||||
* "XMonad.Actions.SimpleDate":
|
||||
An example external contrib module for XMonad.
|
||||
Provides a simple binding to dzen2 to print the date as a popup menu.
|
||||
@@ -254,10 +301,16 @@ edit your key bindings.
|
||||
* "XMonad.Actions.TopicSpace":
|
||||
Turns your workspaces into a more topic oriented system.
|
||||
|
||||
* "XMonad.Actions.TreeSelect":
|
||||
TreeSelect displays your workspaces or actions in a Tree-like format.
|
||||
You can select the desired workspace/action with the cursor or hjkl keys.
|
||||
This module is fully configurable and very useful if you like to have a
|
||||
lot of workspaces.
|
||||
|
||||
* "XMonad.Actions.UpdateFocus":
|
||||
Updates the focus on mouse move in unfocused windows.
|
||||
|
||||
* "XMonadContrib.UpdatePointer":
|
||||
* "XMonad.Actions.UpdatePointer":
|
||||
Causes the pointer to follow whichever window focus changes to.
|
||||
|
||||
* "XMonad.Actions.Warp":
|
||||
@@ -283,9 +336,23 @@ edit your key bindings.
|
||||
Provides functions for performing a given action on all windows of
|
||||
the current workspace.
|
||||
|
||||
* "XMonad.Actions.Workscreen":
|
||||
A workscreen permits to display a set of workspaces on several screens. In
|
||||
xinerama mode, when a workscreen is viewed, workspaces associated to all
|
||||
screens are visible. The first workspace of a workscreen is displayed on
|
||||
first screen, second on second screen, etc. Workspace position can be easily
|
||||
changed. If the current workscreen is called again, workspaces are shifted.
|
||||
This also permits to see all workspaces of a workscreen even if just one screen
|
||||
is present, and to move windows from workspace to workscreen.
|
||||
|
||||
* "XMonad.Actions.WorkspaceCursors":
|
||||
Like "XMonad.Actions.Plane" for an arbitrary number of dimensions.
|
||||
|
||||
* "XMonad.Actions.WorkspaceNames":
|
||||
Provides bindings to rename workspaces, show these names in DynamicLog and
|
||||
swap workspaces along with their names. These names survive restart. Together
|
||||
with "XMonad.Layout.WorkspaceDir" this provides for a fully dynamic topic
|
||||
space workflow.
|
||||
-}
|
||||
|
||||
{- $configs
|
||||
@@ -297,25 +364,56 @@ configuration; you can also simply import them and use them as your
|
||||
own configuration, possibly with some modifications.
|
||||
|
||||
|
||||
* "XMonad.Config.Arossato"
|
||||
* "XMonad.Config.Arossato":
|
||||
This module specifies my xmonad defaults.
|
||||
|
||||
* "XMonad.Config.Azerty"
|
||||
* "XMonad.Config.Azerty":
|
||||
Fixes some keybindings for users of French keyboard layouts.
|
||||
|
||||
* "XMonad.Config.Desktop"
|
||||
* "XMonad.Config.Bepo":
|
||||
This module fixes some of the keybindings for the francophone among you who
|
||||
use a BEPO keyboard layout. Based on "XMonad.Config.Azerty".
|
||||
|
||||
* "XMonad.Config.Bluetile":
|
||||
This is the default configuration of [Bluetile](http://projects.haskell.org/bluetile/).
|
||||
If you are migrating from Bluetile to xmonad or want to create a similar setup,
|
||||
then this will give you pretty much the same thing, except for Bluetile's
|
||||
helper applications such as the dock.
|
||||
|
||||
* "XMonad.Config.Desktop":
|
||||
This module provides core desktop environment settings used
|
||||
in the Gnome, Kde, and Xfce config configs. It is also useful
|
||||
for people using other environments such as lxde, or using
|
||||
tray or panel applications without full desktop environments.
|
||||
|
||||
* "XMonad.Config.Gnome"
|
||||
* "XMonad.Config.Dmwit":
|
||||
[dmwit](https://github.com/dmwit)'s xmonad configs and helpers.
|
||||
|
||||
* "XMonad.Config.Kde"
|
||||
* "XMonad.Config.Droundy":
|
||||
Droundy's xmonad config.
|
||||
|
||||
* "XMonad.Config.Sjanssen"
|
||||
* "XMonad.Config.Gnome":
|
||||
This module provides a config suitable for use with the GNOME desktop environment.
|
||||
|
||||
* "XMonad.Config.Xfce"
|
||||
* "XMonad.Config.Kde":
|
||||
This module provides a config suitable for use with the KDE desktop environment.
|
||||
|
||||
* "XMonad.Config.Mate":
|
||||
This module provides a config suitable for use with the MATE desktop environment.
|
||||
|
||||
* "XMonad.Config.Prime":
|
||||
This is a draft of a brand new config syntax for xmonad. It aims to be
|
||||
1) easier to copy/paste snippets from the docs 2) easier to get the gist
|
||||
for what's going on, for you imperative programmers. It's brand new, so it's
|
||||
pretty much guaranteed to break or change syntax. But what's the worst that
|
||||
could happen? Xmonad crashes and logs you out? It probably won't do that.
|
||||
Give it a try.
|
||||
|
||||
* "XMonad.Config.Sjanssen":
|
||||
[spencerjanssen](https://github.com/spencerjanssen)'s xmonad configs.
|
||||
|
||||
* "XMonad.Config.Xfce":
|
||||
This module provides a config suitable for use with the Xfce desktop environment.
|
||||
|
||||
-}
|
||||
|
||||
@@ -349,6 +447,29 @@ occur. The two most important hooks are:
|
||||
|
||||
Here is a list of the modules found in @XMonad.Hooks@:
|
||||
|
||||
* "XMonad.Hooks.CurrentWorkspaceOnTop":
|
||||
Ensures that the windows of the current workspace are always in front of
|
||||
windows that are located on other visible screens. This becomes important if
|
||||
you use decoration and drag windows from one screen to another.
|
||||
Using this module, the dragged window will always be in front of other windows.
|
||||
|
||||
* "XMonad.Hooks.DebugEvents":
|
||||
Module to dump diagnostic information about X11 events received by xmonad.
|
||||
This is incomplete due to "Event" being incomplete and not providing
|
||||
information about a number of events, and enforcing artificial constraints
|
||||
on others (for example ClientMessage); the X11 package will require a number
|
||||
of changes to fix these problems.
|
||||
|
||||
* "XMonad.Hooks.DebugKeyEvents":
|
||||
A debugging module to track key events, useful when you can't tell whether
|
||||
xmonad is processing some or all key events.
|
||||
|
||||
* "XMonad.Hooks.DebugStack":
|
||||
Dump the state of the StackSet. A logHook and handleEventHook are also provided.
|
||||
|
||||
* "Xmonad.Hooks.DynamicBars":
|
||||
Manage per-screen status bars.
|
||||
|
||||
* "XMonad.Hooks.DynamicHooks":
|
||||
One-shot and permanent ManageHooks that can be updated at runtime.
|
||||
|
||||
@@ -367,14 +488,28 @@ Here is a list of the modules found in @XMonad.Hooks@:
|
||||
which causes those windows to become slightly translucent if something
|
||||
like xcompmgr is running
|
||||
|
||||
* "XMonad.Hooks.FadeWindows":
|
||||
A more flexible and general compositing interface than FadeInactive. Windows
|
||||
can be selected and opacity specified by means of FadeHooks, which are very
|
||||
similar to ManageHooks and use the same machinery.
|
||||
|
||||
* "XMonad.Hooks.FloatNext":
|
||||
Hook and keybindings for automatically sending the next
|
||||
spawned window(s) to the floating layer.
|
||||
|
||||
* "XMonad.Hooks.ICCCMFocus":
|
||||
Deprecated.
|
||||
|
||||
* "XMonad.Hooks.InsertPosition":
|
||||
Configure where new windows should be added and which window should be
|
||||
focused.
|
||||
|
||||
* "XMonad.Hooks.ManageDebug":
|
||||
A manageHook and associated logHook for debugging "ManageHooks". Simplest
|
||||
usage: wrap your xmonad config in the debugManageHook combinator. Or use
|
||||
debugManageHookOn for a triggerable version, specifying the triggering key
|
||||
sequence in "EZConfig" syntax. Or use the individual hooks in whatever way you see fit.
|
||||
|
||||
* "XMonad.Hooks.ManageDocks":
|
||||
This module provides tools to automatically manage 'dock' type programs,
|
||||
such as gnome-panel, kicker, dzen, and xmobar.
|
||||
@@ -389,35 +524,54 @@ Here is a list of the modules found in @XMonad.Hooks@:
|
||||
* "XMonad.Hooks.Place":
|
||||
Automatic placement of floating windows.
|
||||
|
||||
* "XMonad.Hooks.PositionStoreHooks":
|
||||
This module contains two hooks for the PositionStore (see XMonad.Util.PositionStore) -
|
||||
a ManageHook and an EventHook. The ManageHook can be used to fill the
|
||||
PositionStore with position and size information about new windows. The advantage
|
||||
of using this hook is, that the information is recorded independent of the
|
||||
currently active layout. So the floating shape of the window can later be restored
|
||||
even if it was opened in a tiled layout initially. The EventHook makes sure
|
||||
that windows are deleted from the PositionStore when they are closed.
|
||||
|
||||
* "XMonad.Hooks.RestoreMinimized":
|
||||
(Deprecated: Use XMonad.Hooks.Minimize) Lets you restore minimized
|
||||
windows (see "XMonad.Layout.Minimize") by selecting them on a
|
||||
taskbar (listens for _NET_ACTIVE_WINDOW and WM_CHANGE_STATE).
|
||||
|
||||
* "XMonad.Hooks.ScreenCorners":
|
||||
Run X () actions by touching the edge of your screen with your mouse.
|
||||
|
||||
* "XMonad.Hooks.Script":
|
||||
Provides a simple interface for running a ~\/.xmonad\/hooks script with the
|
||||
name of a hook.
|
||||
|
||||
* "XMonad.Hooks.ServerMode": Allows sending commands to a running xmonad process.
|
||||
|
||||
* "XMonad.Hooks.SetCursor":
|
||||
Set a default mouse cursor on startup.
|
||||
* "XMonad.Hooks.ServerMode":
|
||||
Allows sending commands to a running xmonad process.
|
||||
|
||||
* "XMonad.Hooks.SetWMName":
|
||||
Sets the WM name to a given string, so that it could be detected using
|
||||
_NET_SUPPORTING_WM_CHECK protocol. May be useful for making Java GUI
|
||||
programs work.
|
||||
|
||||
* "XMonad.Hooks.ToggleHook":
|
||||
Hook and keybindings for toggling hook behavior.
|
||||
|
||||
* "XMonad.Hooks.UrgencyHook":
|
||||
UrgencyHook lets you configure an action to occur when a window demands
|
||||
your attention. (In traditional WMs, this takes the form of \"flashing\"
|
||||
on your \"taskbar.\" Blech.)
|
||||
|
||||
* "XMonad.Hooks.WallpaperSetter":
|
||||
Log hook which changes the wallpapers depending on visible workspaces.
|
||||
|
||||
* "XMonad.Hooks.WorkspaceByPos":
|
||||
Useful in a dual-head setup: Looks at the requested geometry of
|
||||
new windows and moves them to the workspace of the non-focused
|
||||
screen if necessary.
|
||||
|
||||
* "XMonad.Hooks.WorkspaceHistory":
|
||||
Keeps track of workspace viewing order.
|
||||
|
||||
* "XMonad.Hooks.XPropManage":
|
||||
A ManageHook matching on XProperties.
|
||||
|
||||
@@ -450,6 +604,13 @@ For more information on using those modules for customizing your
|
||||
master and slave. Size of slave area automatically changes depending on
|
||||
number of slave windows.
|
||||
|
||||
* "XMonad.Layout.AvoidFloats":
|
||||
Find a maximum empty rectangle around floating windows and use that area to
|
||||
display non-floating windows.
|
||||
|
||||
* "XMonad.Layout.BinarySpacePartition":
|
||||
Layout where new windows will split the focused window in half, based off of BSPWM.
|
||||
|
||||
* "XMonad.Layout.BorderResize":
|
||||
This layout modifier will allow to resize windows by dragging their
|
||||
borders with the mouse. However, it only works in layouts or modified
|
||||
@@ -460,6 +621,11 @@ For more information on using those modules for customizing your
|
||||
* "XMonad.Layout.BoringWindows":
|
||||
BoringWindows is an extension to allow windows to be marked boring
|
||||
|
||||
* "XMonad.Layout.ButtonDecoration":
|
||||
A decoration that includes small buttons on both ends which invoke various
|
||||
actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),
|
||||
minimize, maximize or close the window.
|
||||
|
||||
* "XMonad.Layout.CenteredMaster":
|
||||
Two layout modifiers. centerMaster places master window at center,
|
||||
on top of all other windows, which are managed by base layout.
|
||||
@@ -488,6 +654,11 @@ For more information on using those modules for customizing your
|
||||
A layout modifier and a class for easily creating decorated
|
||||
layouts.
|
||||
|
||||
* "XMonad.Layout.DecorationAddons":
|
||||
Various stuff that can be added to the decoration. Most of it is intended to
|
||||
be used by other modules. See "XMonad.Layout.ButtonDecoration" for a module
|
||||
that makes use of this.
|
||||
|
||||
* "XMonad.Layout.DecorationMadness":
|
||||
A collection of decorated layouts: some of them may be nice, some
|
||||
usable, others just funny.
|
||||
@@ -502,6 +673,24 @@ For more information on using those modules for customizing your
|
||||
the other is either the currently focused window or the second window in
|
||||
layout order. See also "XMonad.Layout.MouseResizableTall"
|
||||
|
||||
* "XMonad.Layout.DraggingVisualizer":
|
||||
A helper module to visualize the process of dragging a window by making it
|
||||
follow the mouse cursor. See "XMonad.Layout.WindowSwitcherDecoration" for a
|
||||
module that makes use of this.
|
||||
|
||||
* "XMonad.Layout.Drawer":
|
||||
A layout modifier that puts some windows in a "drawer" which retracts and
|
||||
expands depending on whether any window in it has focus. Useful for music
|
||||
players, tool palettes, etc.
|
||||
|
||||
* "XMonad.Layout.Dwindle":
|
||||
Three layouts: The first, Spiral, is a reimplementation of spiral with, at
|
||||
least to me, more intuitive semantics. The second, Dwindle, is inspired by
|
||||
a similar layout in awesome and produces the same sequence of decreasing
|
||||
window sizes as Spiral but pushes the smallest windows into a screen corner
|
||||
rather than the centre. The third, Squeeze arranges all windows in one row
|
||||
or in one column, with geometrically decreasing sizes.
|
||||
|
||||
* "XMonad.Layout.DwmStyle":
|
||||
A layout modifier for decorating windows in a dwm like style.
|
||||
|
||||
@@ -511,6 +700,10 @@ For more information on using those modules for customizing your
|
||||
split. This is useful when you usually leave a text editor or
|
||||
terminal in the master pane and like it to be 80 columns wide.
|
||||
|
||||
* "XMonad.Layout.Fullscreen":
|
||||
Hooks for sending messages about fullscreen windows to layouts, and a few
|
||||
example layout modifier that implement fullscreen windows.
|
||||
|
||||
* "XMonad.Layout.Gaps":
|
||||
Create manually-sized gaps along edges of the screen which will not
|
||||
be used for tiling, along with support for toggling gaps on and
|
||||
@@ -526,6 +719,25 @@ For more information on using those modules for customizing your
|
||||
master area and uses an aspect-ratio-specified layout for the
|
||||
slaves.
|
||||
|
||||
* "XMonad.Layout.Groups":
|
||||
Two-level layout with windows split in individual layout groups, themselves
|
||||
managed by a user-provided layout.
|
||||
|
||||
* * "XMonad.Layout.Groups.Examples":
|
||||
Example layouts for "XMonad.Layout.Groups".
|
||||
|
||||
* * "XMonad.Layout.Groups.Helpers":
|
||||
Utility functions for "XMonad.Layout.Groups".
|
||||
|
||||
* * "XMonad.Layout.Groups.Wmii":
|
||||
A wmii-like layout algorithm.
|
||||
|
||||
* "XMonad.Layout.Hidden":
|
||||
Similar to XMonad.Layout.Minimize but completely removes windows from the
|
||||
window set so XMonad.Layout.BoringWindows isn't necessary. Perfect companion
|
||||
to XMonad.Layout.BinarySpacePartition since it can be used to move windows
|
||||
to another part of the BSP tree.
|
||||
|
||||
* "XMonad.Layout.HintedGrid":
|
||||
A not so simple layout that attempts to put all windows in a square grid
|
||||
while obeying their size hints.
|
||||
@@ -538,6 +750,16 @@ For more information on using those modules for customizing your
|
||||
Layout modfier suitable for workspace with multi-windowed instant messenger
|
||||
(like Psi or Tkabber).
|
||||
|
||||
* "XMonad.Layout.IfMax":
|
||||
Provides IfMax layout, which will run one layout if there are maximum N
|
||||
windows on workspace, and another layout, when number of windows is greater
|
||||
than N.
|
||||
|
||||
* "XMonad.Layout.ImageButtonDecoration":
|
||||
A decoration that includes small image buttons on both ends which invoke
|
||||
various actions when clicked on: Show a window menu (see "XMonad.Actions.WindowMenu"),
|
||||
minimize, maximize or close the window.
|
||||
|
||||
* "XMonad.Layout.IndependentScreens":
|
||||
Utility functions for simulating independent sets of workspaces on
|
||||
each screen (like dwm's workspace model), using internal tags to
|
||||
@@ -613,12 +835,19 @@ For more information on using those modules for customizing your
|
||||
A layout in the spirit of "XMonad.Layout.ResizableTile", but with the option
|
||||
to use the mouse to adjust the layout.
|
||||
|
||||
* "XMonad.Layout.MultiColumns":
|
||||
This layout tiles windows in a growing number of columns. The number of
|
||||
windows in each column can be controlled by messages.
|
||||
|
||||
* "XMonad.Layout.MultiToggle":
|
||||
Dynamically apply and unapply transformers to your window layout. This can
|
||||
be used to rotate your window layout by 90 degrees, or to make the
|
||||
currently focused window occupy the whole screen (\"zoom in\") then undo
|
||||
the transformation (\"zoom out\").
|
||||
|
||||
* * "XMonad.Layout.MultiToggle.Instances":
|
||||
Some convenient common instances of the Transformer class, for use with "XMonad.Layout.MultiToggle".
|
||||
|
||||
* "XMonad.Layout.Named":
|
||||
A module for assigning a name to a given layout.
|
||||
|
||||
@@ -634,17 +863,38 @@ For more information on using those modules for customizing your
|
||||
result in title bars that span the entire window instead of being only the
|
||||
length of the window title.
|
||||
|
||||
* "XMonad.Layout.OnHost":
|
||||
Configure layouts on a per-host basis: use layouts and apply layout modifiers
|
||||
selectively, depending on the host. Heavily based on "XMonad.Layout.PerWorkspace"
|
||||
by Brent Yorgey.
|
||||
|
||||
* "XMonad.Layout.OneBig":
|
||||
Places one (master) window at top left corner of screen, and other (slave)
|
||||
windows at the top.
|
||||
|
||||
* "XMonad.Layout.PerScreen":
|
||||
Configure layouts based on the width of your screen; use your favorite
|
||||
multi-column layout for wide screens and a full-screen layout for small ones.
|
||||
|
||||
* "XMonad.Layout.PerWorkspace":
|
||||
Configure layouts on a per-workspace basis: use layouts and apply
|
||||
layout modifiers selectively, depending on the workspace.
|
||||
|
||||
* "XMonad.Layout.PositionStoreFloat":
|
||||
A floating layout which has been designed with a dual-head setup in mind.
|
||||
It makes use of "XMonad.Util.PositionStore" as well as "XMonad.Hooks.PositionStoreHooks".
|
||||
Since there is currently no way to move or resize windows with the keyboard
|
||||
alone in this layout, it is adviced to use it in combination with a decoration
|
||||
such as "XMonad.Layout.NoFrillsDecoration" (to move windows) and the layout
|
||||
modifier "XMonad.Layout.BorderResize" (to resize windows).
|
||||
|
||||
* "XMonad.Layout.Reflect":
|
||||
Reflect a layout horizontally or vertically.
|
||||
|
||||
* "XMonad.Layout.Renamed":
|
||||
Layout modifier that can modify the description of its underlying layout on
|
||||
a (hopefully) flexible way.
|
||||
|
||||
* "XMonad.Layout.ResizableTile":
|
||||
More useful tiled layout that allows you to change a width\/height of window.
|
||||
See also "XMonad.Layout.MouseResizableTile".
|
||||
@@ -676,6 +926,12 @@ For more information on using those modules for customizing your
|
||||
* "XMonad.Layout.SimplestFloat":
|
||||
A basic floating layout like SimpleFloat but without the decoration.
|
||||
|
||||
* "XMonad.Layout.SortedLayout":
|
||||
A new LayoutModifier that sorts a given layout by a list of
|
||||
properties. The order of properties in the list determines
|
||||
the order of windows in the final layout. Any unmatched windows
|
||||
go to the end of the order.
|
||||
|
||||
* "XMonad.Layout.Spacing":
|
||||
Add a configurable amount of space around windows.
|
||||
|
||||
@@ -694,6 +950,13 @@ For more information on using those modules for customizing your
|
||||
A stacking layout, like dishes but with the ability to resize master pane.
|
||||
Mostly useful on small screens.
|
||||
|
||||
* "XMonad.Layout.Stoppable":
|
||||
This module implements a special kind of layout modifier, which when applied
|
||||
to a layout, causes xmonad to stop all non-visible processes. In a way,
|
||||
this is a sledge-hammer for applications that drain power. For example, given
|
||||
a web browser on a stoppable workspace, once the workspace is hidden the web
|
||||
browser will be stopped.
|
||||
|
||||
* "XMonad.Layout.SubLayouts":
|
||||
A layout combinator that allows layouts to be nested.
|
||||
|
||||
@@ -724,6 +987,10 @@ For more information on using those modules for customizing your
|
||||
WindowNavigation is an extension to allow easy navigation of a workspace.
|
||||
See also "XMonad.Actions.WindowNavigation".
|
||||
|
||||
* "XMonad.Layout.WindowSwitcherDecoration":
|
||||
A decoration that allows to switch the position of windows by dragging them
|
||||
onto each other.
|
||||
|
||||
* "XMonad.Layout.WorkspaceDir":
|
||||
WorkspaceDir is an extension to set the current directory in a workspace.
|
||||
Actually, it sets the current directory in a layout, since there's no way I
|
||||
@@ -757,6 +1024,9 @@ These are the available prompts:
|
||||
you're doing.
|
||||
Who knows, it might be useful for other purposes as well!
|
||||
|
||||
* "XMonad.Prompt.ConfirmPrompt":
|
||||
A module for setting up simple confirmation prompts for keybindings.
|
||||
|
||||
* "XMonad.Prompt.DirExec":
|
||||
A directory file executables prompt for XMonad. This might be useful if you
|
||||
don't want to have scripts in your PATH environment variable (same
|
||||
@@ -786,6 +1056,13 @@ These are the available prompts:
|
||||
* narrow completions by section number, if the one is specified
|
||||
(like @\/etc\/bash_completion@ does)
|
||||
|
||||
* "XMonad.Prompt.Pass":
|
||||
This module provides 3 combinators for ease passwords manipulation (generate, read, remove):
|
||||
1) one to lookup passwords in the password-storage.
|
||||
2) one to generate a password for a given password label that the user inputs.
|
||||
3) one to delete a stored password for a given password label that the user inputs.
|
||||
|
||||
|
||||
* "XMonad.Prompt.RunOrRaise":
|
||||
A prompt for XMonad which will run a program, open a file,
|
||||
or raise an already running program, depending on context.
|
||||
@@ -830,6 +1107,10 @@ A non complete list with a brief description:
|
||||
* "XMonad.Util.CustomKeys": configure key bindings (see
|
||||
"XMonad.Doc.Extending#Editing_key_bindings").
|
||||
|
||||
* "XMonad.Util.DebugWindow":
|
||||
Module to dump window information for diagnostic/debugging purposes. See
|
||||
"XMonad.Hooks.DebugEvents" and "XMonad.Hooks.DebugStack" for practical uses.
|
||||
|
||||
* "XMonad.Util.Dmenu":
|
||||
A convenient binding to dmenu.
|
||||
Requires the process-1.0 package
|
||||
@@ -837,11 +1118,19 @@ A non complete list with a brief description:
|
||||
* "XMonad.Util.Dzen":
|
||||
Handy wrapper for dzen. Requires dzen >= 0.2.4.
|
||||
|
||||
* "XMonad.Util.EZConfig": configure key bindings easily, including a
|
||||
* "XMonad.Util.EZConfig":
|
||||
Configure key bindings easily, including a
|
||||
parser for writing key bindings in "M-C-x" style.
|
||||
|
||||
* "XMonad.Util.Font": A module for abstracting a font facility over
|
||||
Core fonts and Xft
|
||||
* "XMonad.Util.ExtensibleState":
|
||||
Module for storing custom mutable state in xmonad.
|
||||
|
||||
* "XMonad.Util.Font":
|
||||
A module for abstracting a font facility over
|
||||
Core fonts and Xft.
|
||||
|
||||
* "XMonad.Util.Image":
|
||||
Utilities for manipulating [[Bool]] as images.
|
||||
|
||||
* "XMonad.Util.Invisible":
|
||||
A data type to store the layout state
|
||||
@@ -852,6 +1141,10 @@ A non complete list with a brief description:
|
||||
a pretty-printing status logger format. See "XMonad.Hooks.DynamicLog"
|
||||
for more information.
|
||||
|
||||
* * "XMonad.Util.Loggers.NamedScratchpad":
|
||||
A collection of Loggers (see "XMonad.Util.Loggers") for NamedScratchpads
|
||||
(see "XMonad.Util.NamedScratchpad").
|
||||
|
||||
* "XMonad.Util.NamedActions":
|
||||
A wrapper for keybinding configuration that can list the available
|
||||
keybindings.
|
||||
@@ -864,10 +1157,22 @@ A non complete list with a brief description:
|
||||
This module allows you to associate the X titles of windows with
|
||||
them.
|
||||
|
||||
* "XMonad.Util.NoTaskbar":
|
||||
Utility function and 'ManageHook` to mark a window to be ignored by
|
||||
EWMH taskbars and pagers. Useful for `NamedScratchpad` windows, since
|
||||
you will usually be taken to the `NSP` workspace by them.
|
||||
|
||||
* "XMonad.Util.Paste":
|
||||
A module for sending key presses to windows. This modules provides generalized
|
||||
and specialized functions for this task.
|
||||
|
||||
* "XMonad.Util.PositionStore":
|
||||
A utility module to store information about position and size of a window.
|
||||
See "XMonad.Layout.PositionStoreFloat" for a layout that makes use of this.
|
||||
|
||||
* "XMonad.Util.RemoteWindows":
|
||||
This module implements a proper way of finding out whether the window is remote or local.
|
||||
|
||||
* "XMonad.Util.Replace":
|
||||
Implements a @--replace@ flag outside of core.
|
||||
|
||||
@@ -880,6 +1185,16 @@ A non complete list with a brief description:
|
||||
* "XMonad.Util.Scratchpad":
|
||||
Very handy hotkey-launched toggleable floating terminal window.
|
||||
|
||||
* "XMonad.Util.SpawnNamedPipe":
|
||||
A module for spawning a pipe whose Handle lives in the Xmonad state.
|
||||
|
||||
* "XMonad.Util.SpawnOnce":
|
||||
A module for spawning a command once, and only once. Useful to start status
|
||||
bars and make session settings inside startupHook.
|
||||
|
||||
* "XMonad.Util.Stack":
|
||||
Utility functions for manipulating Maybe Stacks.
|
||||
|
||||
* "XMonad.Util.StringProp":
|
||||
Internal utility functions for storing Strings with the root window.
|
||||
Used for global state like IORefs with string keys, but more latency,
|
||||
@@ -894,10 +1209,21 @@ A non complete list with a brief description:
|
||||
* "XMonad.Util.Types":
|
||||
Miscellaneous commonly used types.
|
||||
|
||||
* "XMonad.Util.Ungrab":
|
||||
Release xmonad's keyboard and pointer grabs immediately, so
|
||||
screen grabbers and lock utilities, etc. will work. Replaces
|
||||
the short sleep hackaround.
|
||||
|
||||
* "XMonad.Util.WindowProperties":
|
||||
EDSL for specifying window properties; various utilities related to window
|
||||
properties.
|
||||
|
||||
* "XMonad.Util.WindowState":
|
||||
Functions for saving per-window data.
|
||||
|
||||
* "XMonad.Util.WorkspaceCompare":
|
||||
Functions for examining, comparing, and sorting workspaces.
|
||||
|
||||
* "XMonad.Util.XSelection":
|
||||
A module for accessing and manipulating X Window's mouse selection (the buffer used in copy and pasting).
|
||||
'getSelection' and 'putSelection' are adaptations of Hxsel.hs and Hxput.hs from the XMonad-utils
|
||||
@@ -932,13 +1258,13 @@ example, you could write:
|
||||
|
||||
> import XMonad
|
||||
>
|
||||
> main = xmonad $ defaultConfig { keys = myKeys }
|
||||
> main = xmonad $ def { keys = myKeys }
|
||||
|
||||
and provide an appropriate definition of @myKeys@, such as:
|
||||
|
||||
> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
|
||||
> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
|
||||
> , ((modm, xK_F3 ), shellPrompt defaultXPConfig)
|
||||
> [ ((modm, xK_F12), xmonadPrompt def)
|
||||
> , ((modm, xK_F3 ), shellPrompt def)
|
||||
> ]
|
||||
|
||||
This particular definition also requires importing "XMonad.Prompt",
|
||||
@@ -984,25 +1310,25 @@ For instance, if you have defined some additional key bindings like
|
||||
these:
|
||||
|
||||
> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
|
||||
> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
|
||||
> , ((modm, xK_F3 ), shellPrompt defaultXPConfig)
|
||||
> [ ((modm, xK_F12), xmonadPrompt def)
|
||||
> , ((modm, xK_F3 ), shellPrompt def)
|
||||
> ]
|
||||
|
||||
then you can create a new key bindings map by joining the default one
|
||||
with yours:
|
||||
|
||||
> newKeys x = myKeys x `M.union` keys defaultConfig x
|
||||
> newKeys x = myKeys x `M.union` keys def x
|
||||
|
||||
Finally, you can use @newKeys@ in the 'XMonad.Core.XConfig.keys' field
|
||||
of the configuration:
|
||||
|
||||
> main = xmonad $ defaultConfig { keys = newKeys }
|
||||
> main = xmonad $ def { keys = newKeys }
|
||||
|
||||
Alternatively, the '<+>' operator can be used which in this usage does exactly
|
||||
the same as the explicit usage of 'M.union' and propagation of the config
|
||||
argument, thanks to appropriate instances in "Data.Monoid".
|
||||
|
||||
> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
|
||||
> main = xmonad $ def { keys = myKeys <+> keys def }
|
||||
|
||||
All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
|
||||
|
||||
@@ -1018,11 +1344,11 @@ All together, your @~\/.xmonad\/xmonad.hs@ would now look like this:
|
||||
> import XMonad.Prompt.XMonad
|
||||
>
|
||||
> main :: IO ()
|
||||
> main = xmonad $ defaultConfig { keys = myKeys <+> keys defaultConfig }
|
||||
> main = xmonad $ def { keys = myKeys <+> keys def }
|
||||
>
|
||||
> myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList
|
||||
> [ ((modm, xK_F12), xmonadPrompt defaultXPConfig)
|
||||
> , ((modm, xK_F3 ), shellPrompt defaultXPConfig)
|
||||
> [ ((modm, xK_F12), xmonadPrompt def)
|
||||
> , ((modm, xK_F3 ), shellPrompt def)
|
||||
> ]
|
||||
|
||||
There are much simpler ways to accomplish this, however, if you are
|
||||
@@ -1044,7 +1370,7 @@ For example, suppose you want to get rid of @mod-q@ and @mod-shift-q@
|
||||
to define @newKeys@ as a 'Data.Map.difference' between the default
|
||||
map and the map of the key bindings you want to remove. Like so:
|
||||
|
||||
> newKeys x = keys defaultConfig x `M.difference` keysToRemove x
|
||||
> newKeys x = keys def x `M.difference` keysToRemove x
|
||||
>
|
||||
> keysToRemove :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
> keysToRemove x = M.fromList
|
||||
@@ -1060,7 +1386,7 @@ It is also possible to simply define a list of keys we want to unbind
|
||||
and then use 'Data.Map.delete' to remove them. In that case we would
|
||||
write something like:
|
||||
|
||||
> newKeys x = foldr M.delete (keys defaultConfig x) (keysToRemove x)
|
||||
> newKeys x = foldr M.delete (keys def x) (keysToRemove x)
|
||||
>
|
||||
> keysToRemove :: XConfig Layout -> [(KeyMask, KeySym)]
|
||||
> keysToRemove x =
|
||||
@@ -1081,7 +1407,7 @@ Adding and removing key bindings requires simply combining the steps
|
||||
for removing and adding. Here is an example from
|
||||
"XMonad.Config.Arossato":
|
||||
|
||||
> defKeys = keys defaultConfig
|
||||
> defKeys = keys def
|
||||
> delKeys x = foldr M.delete (defKeys x) (toRemove x)
|
||||
> newKeys x = foldr (uncurry M.insert) (delKeys x) (toAdd x)
|
||||
> -- remove some of the default key bindings
|
||||
@@ -1097,8 +1423,8 @@ for removing and adding. Here is an example from
|
||||
> [(shiftMask .|. modm, k) | k <- [xK_1 .. xK_9]]
|
||||
> -- These are my personal key bindings
|
||||
> toAdd XConfig{modMask = modm} =
|
||||
> [ ((modm , xK_F12 ), xmonadPrompt defaultXPConfig )
|
||||
> , ((modm , xK_F3 ), shellPrompt defaultXPConfig )
|
||||
> [ ((modm , xK_F12 ), xmonadPrompt def )
|
||||
> , ((modm , xK_F3 ), shellPrompt def )
|
||||
> ] ++
|
||||
> -- Use modm .|. shiftMask .|. controlMask 1-9 instead
|
||||
> [( (m .|. modm, k), windows $ f i)
|
||||
@@ -1125,9 +1451,9 @@ the window you click on like so:
|
||||
>
|
||||
> myMouse x = [ (0, button4), (\w -> focus w >> kill) ]
|
||||
>
|
||||
> newMouse x = M.union (mouseBindings defaultConfig x) (M.fromList (myMouse x))
|
||||
> newMouse x = M.union (mouseBindings def x) (M.fromList (myMouse x))
|
||||
>
|
||||
> main = xmonad $ defaultConfig { ..., mouseBindings = newMouse, ... }
|
||||
> main = xmonad $ def { ..., mouseBindings = newMouse, ... }
|
||||
|
||||
Overriding or deleting mouse bindings works similarly. You can also
|
||||
configure mouse bindings much more easily using the
|
||||
@@ -1174,13 +1500,13 @@ Suppose we want a list with the 'XMonad.Layout.Full',
|
||||
|
||||
Then we create the combination of layouts we need:
|
||||
|
||||
> mylayoutHook = Full ||| tabbed shrinkText defaultTheme ||| Accordion
|
||||
> mylayoutHook = Full ||| tabbed shrinkText def ||| Accordion
|
||||
|
||||
|
||||
Now, all we need to do is change the 'XMonad.Core.layoutHook'
|
||||
field of the 'XMonad.Core.XConfig' record, like so:
|
||||
|
||||
> main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
|
||||
> main = xmonad $ def { layoutHook = mylayoutHook }
|
||||
|
||||
Thanks to the new combinator, we can apply a layout modifier to a
|
||||
whole combination of layouts, instead of applying it to each one. For
|
||||
@@ -1188,11 +1514,11 @@ example, suppose we want to use the
|
||||
'XMonad.Layout.NoBorders.noBorders' layout modifier, from the
|
||||
"XMonad.Layout.NoBorders" module (which must be imported):
|
||||
|
||||
> mylayoutHook = noBorders (Full ||| tabbed shrinkText defaultTheme ||| Accordion)
|
||||
> mylayoutHook = noBorders (Full ||| tabbed shrinkText def ||| Accordion)
|
||||
|
||||
If we want only the tabbed layout without borders, then we may write:
|
||||
|
||||
> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion
|
||||
> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion
|
||||
|
||||
Our @~\/.xmonad\/xmonad.hs@ will now look like this:
|
||||
|
||||
@@ -1202,9 +1528,9 @@ Our @~\/.xmonad\/xmonad.hs@ will now look like this:
|
||||
> import XMonad.Layout.Accordion
|
||||
> import XMonad.Layout.NoBorders
|
||||
>
|
||||
> mylayoutHook = Full ||| noBorders (tabbed shrinkText defaultTheme) ||| Accordion
|
||||
> mylayoutHook = Full ||| noBorders (tabbed shrinkText def) ||| Accordion
|
||||
>
|
||||
> main = xmonad $ defaultConfig { layoutHook = mylayoutHook }
|
||||
> main = xmonad $ def { layoutHook = mylayoutHook }
|
||||
|
||||
That's it!
|
||||
|
||||
@@ -1256,7 +1582,7 @@ This is another example of 'XMonad.Config.manageHook', taken from
|
||||
> , resource =? "win" --> doF (W.shift "doc") -- xpdf
|
||||
> , resource =? "firefox-bin" --> doF (W.shift "web")
|
||||
> ]
|
||||
> newManageHook = myManageHook <+> manageHook defaultConfig
|
||||
> newManageHook = myManageHook <+> manageHook def
|
||||
|
||||
|
||||
Again we use 'XMonad.ManageHook.composeAll' to compose a list of
|
||||
@@ -1318,14 +1644,14 @@ Then we create our own 'XMonad.Config.manageHook':
|
||||
We can now use the 'XMonad.ManageHook.<+>' combinator to add our
|
||||
'XMonad.Config.manageHook' to the default one:
|
||||
|
||||
> newManageHook = myManageHook <+> manageHook defaultConfig
|
||||
> newManageHook = myManageHook <+> manageHook def
|
||||
|
||||
(Of course, if we wanted to completely replace the default
|
||||
'XMonad.Config.manageHook', this step would not be necessary.) Now,
|
||||
all we need to do is change the 'XMonad.Core.manageHook' field of the
|
||||
'XMonad.Core.XConfig' record, like so:
|
||||
|
||||
> main = xmonad defaultConfig { ..., manageHook = newManageHook, ... }
|
||||
> main = xmonad def { ..., manageHook = newManageHook, ... }
|
||||
|
||||
And we are done.
|
||||
|
||||
@@ -1387,7 +1713,7 @@ Then you just need to update the 'XMonad.Core.logHook' field of the
|
||||
'XMonad.Core.XConfig' record with one of the provided functions. For
|
||||
example:
|
||||
|
||||
> main = xmonad defaultConfig { logHook = dynamicLog }
|
||||
> main = xmonad def { logHook = dynamicLog }
|
||||
|
||||
More interesting configurations are also possible; see the
|
||||
"XMonad.Hooks.DynamicLog" module for more possibilities.
|
||||
|
@@ -33,7 +33,7 @@ import qualified Data.Map as M
|
||||
--
|
||||
-- > import XMonad.Hooks.CurrentWorkspaceOnTop
|
||||
-- >
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = currentWorkspaceOnTop
|
||||
-- > ...
|
||||
|
1247
XMonad/Hooks/DebugEvents.hs
Normal file
1247
XMonad/Hooks/DebugEvents.hs
Normal file
File diff suppressed because it is too large
Load Diff
@@ -1,3 +1,4 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DebugKeyEvents
|
||||
@@ -91,7 +92,11 @@ vmask numLockMask msk = intercalate " " $
|
||||
fst $
|
||||
foldr vmask' ([],msk) masks
|
||||
where
|
||||
masks = map (\m -> (m,show m)) [0..toEnum (bitSize msk - 1)] ++
|
||||
|
||||
#if __GLASGOW_HASKELL__ < 707
|
||||
finiteBitSize x = bitSize x
|
||||
#endif
|
||||
masks = map (\m -> (m,show m)) [0..toEnum (finiteBitSize msk - 1)] ++
|
||||
[(numLockMask,"num" )
|
||||
,( lockMask,"lock" )
|
||||
,(controlMask,"ctrl" )
|
||||
|
110
XMonad/Hooks/DebugStack.hs
Normal file
110
XMonad/Hooks/DebugStack.hs
Normal file
@@ -0,0 +1,110 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DebugStack
|
||||
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : allbery.b@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Dump the state of the 'StackSet'. A @logHook@ and @handleEventHook@ are
|
||||
-- also provided.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.DebugStack (debugStack
|
||||
,debugStackFull
|
||||
,debugStackString
|
||||
,debugStackFullString
|
||||
,debugStackLogHook
|
||||
,debugStackFullLogHook
|
||||
,debugStackEventHook
|
||||
,debugStackFullEventHook
|
||||
) where
|
||||
|
||||
import XMonad.Core
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import XMonad.Util.DebugWindow
|
||||
|
||||
import Graphics.X11.Types (Window)
|
||||
import Graphics.X11.Xlib.Extras (Event)
|
||||
|
||||
import Control.Monad (foldM)
|
||||
import Data.Map (member)
|
||||
import Data.Monoid (All(..))
|
||||
import Data.List (intercalate)
|
||||
|
||||
-- | Print the state of the current window stack for the current workspace to
|
||||
-- @stderr@, which for most installations goes to @~/.xsession-errors@.
|
||||
-- "XMonad.Util.DebugWindow" is used to display the individual windows.
|
||||
debugStack :: X ()
|
||||
debugStack = debugStackString >>= trace
|
||||
|
||||
-- | Print the state of the current window stack for all workspaces to
|
||||
-- @stderr@, which for most installations goes to @~/.xsession-errors@.
|
||||
-- "XMonad.Util.DebugWindow" is used to display the individual windows.
|
||||
debugStackFull :: X ()
|
||||
debugStackFull = debugStackFullString >>= trace
|
||||
|
||||
-- | 'debugStack' packaged as a 'logHook'. (Currently this is identical.)
|
||||
debugStackLogHook :: X ()
|
||||
debugStackLogHook = debugStack
|
||||
|
||||
-- | 'debugStackFull packaged as a 'logHook'. (Currently this is identical.)
|
||||
debugStackFullLogHook :: X ()
|
||||
debugStackFullLogHook = debugStackFull
|
||||
|
||||
-- | 'debugStack' packaged as a 'handleEventHook'. You almost certainly do not
|
||||
-- want to use this unconditionally, as it will cause massive amounts of
|
||||
-- output and possibly slow @xmonad@ down severely.
|
||||
|
||||
debugStackEventHook :: Event -> X All
|
||||
debugStackEventHook _ = debugStack >> return (All True)
|
||||
|
||||
-- | 'debugStackFull' packaged as a 'handleEventHook'. You almost certainly do
|
||||
-- not want to use this unconditionally, as it will cause massive amounts of
|
||||
-- output and possibly slow @xmonad@ down severely.
|
||||
|
||||
debugStackFullEventHook :: Event -> X All
|
||||
debugStackFullEventHook _ = debugStackFull >> return (All True)
|
||||
|
||||
-- | Dump the state of the current workspace in the 'StackSet' as a multiline 'String'.
|
||||
debugStackString :: X String
|
||||
debugStackString = withWindowSet $ debugStackWs . W.workspace . W.current
|
||||
|
||||
-- | Dump the state of all workspaces in the 'StackSet' as a multiline 'String'.
|
||||
-- @@@ this is in stackset order, which is roughly lru-ish
|
||||
debugStackFullString :: X String
|
||||
debugStackFullString = withWindowSet $ fmap (intercalate "\n") . mapM debugStackWs . W.workspaces
|
||||
|
||||
-- | Dump the state of a workspace in the current 'StackSet' as a multiline 'String'.
|
||||
-- @
|
||||
-- Workspace "foo::
|
||||
-- mm
|
||||
-- * ww
|
||||
-- ^ww
|
||||
-- @
|
||||
-- * indicates the focused window, ^ indicates a floating window
|
||||
debugStackWs :: W.Workspace String (Layout Window) Window -> X String
|
||||
debugStackWs w = withWindowSet $ \ws -> do
|
||||
let cur = if wt == W.currentTag ws then " (current)" else ""
|
||||
wt = W.tag w
|
||||
s <- emit ws $ W.integrate' . W.stack $ w
|
||||
return $ intercalate "\n" $ ("Workspace " ++ show wt ++ cur):s
|
||||
where
|
||||
emit :: WindowSet -> [Window] -> X [String]
|
||||
emit _ [] = return [" -empty workspace-"]
|
||||
emit ww ws = do
|
||||
(_,ss) <- foldM emit' (ww,[]) ws
|
||||
return ss
|
||||
|
||||
emit' :: (WindowSet,[String])
|
||||
-> Window
|
||||
-> X (WindowSet,[String])
|
||||
emit' (ws,a) w' = do
|
||||
let focus = if Just w' == W.peek ws then '*' else ' '
|
||||
float = if w' `member` W.floating ws then '^' else ' '
|
||||
s <- debugWindow w'
|
||||
return (ws,(focus:float:s):a)
|
186
XMonad/Hooks/DynamicBars.hs
Normal file
186
XMonad/Hooks/DynamicBars.hs
Normal file
@@ -0,0 +1,186 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DynamicBars
|
||||
-- Copyright : (c) Ben Boeckel 2012
|
||||
-- License : BSD-style (as xmonad)
|
||||
--
|
||||
-- Maintainer : mathstuf@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Manage per-screen status bars.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.DynamicBars (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
DynamicStatusBar
|
||||
, DynamicStatusBarCleanup
|
||||
, DynamicStatusBarPartialCleanup
|
||||
, dynStatusBarStartup
|
||||
, dynStatusBarStartup'
|
||||
, dynStatusBarEventHook
|
||||
, dynStatusBarEventHook'
|
||||
, multiPP
|
||||
, multiPPFormat
|
||||
) where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.Trans (lift)
|
||||
import Control.Monad.Writer (WriterT, execWriterT, tell)
|
||||
|
||||
import Data.List
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import Data.Foldable (traverse_)
|
||||
|
||||
import Graphics.X11.Xinerama
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras
|
||||
import Graphics.X11.Xrandr
|
||||
|
||||
import System.IO
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Hooks.DynamicLog
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
-- $usage
|
||||
-- Provides a few helper functions to manage per-screen status bars while
|
||||
-- dynamically responding to screen changes. A startup action, event hook, and
|
||||
-- a way to separate PP styles based on the screen's focus are provided:
|
||||
--
|
||||
-- * The 'dynStatusBarStartup' hook which initializes the status bars. The
|
||||
-- first argument is an `ScreenId -> IO Handle` which spawns a status bar on the
|
||||
-- given screen and returns the pipe which the string should be written to.
|
||||
-- The second argument is a `IO ()` to shut down all status bars. This should
|
||||
-- be placed in your `startupHook`.
|
||||
--
|
||||
-- * The 'dynStatusBarEventHook' hook which respawns status bars when the
|
||||
-- number of screens changes. The arguments are the same as for the
|
||||
-- `dynStatusBarStartup` function. This should be placed in your
|
||||
-- `handleEventHook`.
|
||||
--
|
||||
-- * Each of the above functions have an alternate form
|
||||
-- (`dynStatusBarStartup'` and `dynStatusBarEventHook'`) which use a cleanup
|
||||
-- function which takes an additional `ScreenId` argument which allows for
|
||||
-- more fine-grained control for shutting down a specific screen's status bar.
|
||||
--
|
||||
-- * The 'multiPP' function which allows for different output based on whether
|
||||
-- the screen for the status bar has focus (the first argument) or not (the
|
||||
-- second argument). This is for use in your `logHook`.
|
||||
--
|
||||
-- * The 'multiPPFormat' function is the same as the 'multiPP' function, but it
|
||||
-- also takes in a function that can customize the output to status bars.
|
||||
--
|
||||
-- The hooks take a 'DynamicStatusBar' function which is given the id of the
|
||||
-- screen to start up and returns the 'Handle' to the pipe to write to. The
|
||||
-- 'DynamicStatusBarCleanup' argument should tear down previous instances. It
|
||||
-- is called when the number of screens changes and on startup.
|
||||
--
|
||||
|
||||
data DynStatusBarInfo = DynStatusBarInfo
|
||||
{ dsbInfo :: [(ScreenId, Handle)]
|
||||
} deriving (Typeable)
|
||||
|
||||
instance ExtensionClass DynStatusBarInfo where
|
||||
initialValue = DynStatusBarInfo []
|
||||
|
||||
type DynamicStatusBar = ScreenId -> IO Handle
|
||||
type DynamicStatusBarCleanup = IO ()
|
||||
type DynamicStatusBarPartialCleanup = ScreenId -> IO ()
|
||||
|
||||
dynStatusBarSetup :: X ()
|
||||
dynStatusBarSetup = do
|
||||
dpy <- asks display
|
||||
root <- asks theRoot
|
||||
io $ xrrSelectInput dpy root rrScreenChangeNotifyMask
|
||||
|
||||
dynStatusBarStartup :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
|
||||
dynStatusBarStartup sb cleanup = do
|
||||
dynStatusBarSetup
|
||||
updateStatusBars sb cleanup
|
||||
|
||||
dynStatusBarStartup' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
|
||||
dynStatusBarStartup' sb cleanup = do
|
||||
dynStatusBarSetup
|
||||
updateStatusBars' sb cleanup
|
||||
|
||||
dynStatusBarEventHook :: DynamicStatusBar -> DynamicStatusBarCleanup -> Event -> X All
|
||||
dynStatusBarEventHook sb cleanup = dynStatusBarRun (updateStatusBars sb cleanup)
|
||||
|
||||
dynStatusBarEventHook' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> Event -> X All
|
||||
dynStatusBarEventHook' sb cleanup = dynStatusBarRun (updateStatusBars' sb cleanup)
|
||||
|
||||
dynStatusBarRun :: X () -> Event -> X All
|
||||
dynStatusBarRun action (RRScreenChangeNotifyEvent {}) = action >> return (All True)
|
||||
dynStatusBarRun _ _ = return (All True)
|
||||
|
||||
updateStatusBars :: DynamicStatusBar -> DynamicStatusBarCleanup -> X ()
|
||||
updateStatusBars sb cleanup = do
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
screens <- getScreens
|
||||
when (screens /= dsbInfoScreens) $ do
|
||||
newHandles <- liftIO $ do
|
||||
hClose `mapM_` dsbInfoHandles
|
||||
cleanup
|
||||
mapM sb screens
|
||||
XS.put $ DynStatusBarInfo (zip screens newHandles)
|
||||
|
||||
updateStatusBars' :: DynamicStatusBar -> DynamicStatusBarPartialCleanup -> X ()
|
||||
updateStatusBars' sb cleanup = do
|
||||
(dsbInfoScreens, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
screens <- getScreens
|
||||
when (screens /= dsbInfoScreens) $ do
|
||||
let oldInfo = zip dsbInfoScreens dsbInfoHandles
|
||||
let (infoToKeep, infoToClose) = partition (flip elem screens . fst) oldInfo
|
||||
newInfo <- liftIO $ do
|
||||
mapM_ hClose $ map snd infoToClose
|
||||
mapM_ cleanup $ map fst infoToClose
|
||||
let newScreens = screens \\ dsbInfoScreens
|
||||
newHandles <- mapM sb newScreens
|
||||
return $ zip newScreens newHandles
|
||||
XS.put . DynStatusBarInfo $ infoToKeep ++ newInfo
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- The following code is from adamvo's xmonad.hs file.
|
||||
-- http://www.haskell.org/haskellwiki/Xmonad/Config_archive/adamvo%27s_xmonad.hs
|
||||
|
||||
multiPP :: PP -- ^ The PP to use if the screen is focused
|
||||
-> PP -- ^ The PP to use otherwise
|
||||
-> X ()
|
||||
multiPP = multiPPFormat dynamicLogString
|
||||
|
||||
multiPPFormat :: (PP -> X String) -> PP -> PP -> X ()
|
||||
multiPPFormat dynlStr focusPP unfocusPP = do
|
||||
(_, dsbInfoHandles) <- XS.get >>= return . unzip . dsbInfo
|
||||
multiPP' dynlStr focusPP unfocusPP dsbInfoHandles
|
||||
|
||||
multiPP' :: (PP -> X String) -> PP -> PP -> [Handle] -> X ()
|
||||
multiPP' dynlStr focusPP unfocusPP handles = do
|
||||
st <- get
|
||||
let pickPP :: WorkspaceId -> WriterT (Last XState) X String
|
||||
pickPP ws = do
|
||||
let isFoc = (ws ==) . W.tag . W.workspace . W.current $ windowset st
|
||||
put st{ windowset = W.view ws $ windowset st }
|
||||
out <- lift $ dynlStr $ if isFoc then focusPP else unfocusPP
|
||||
when isFoc $ get >>= tell . Last . Just
|
||||
return out
|
||||
traverse_ put . getLast
|
||||
=<< execWriterT . (io . zipWithM_ hPutStrLn handles <=< mapM pickPP) . catMaybes
|
||||
=<< mapM screenWorkspace (zipWith const [0 .. ] handles)
|
||||
|
||||
getScreens :: MonadIO m => m [ScreenId]
|
||||
getScreens = liftIO $ do
|
||||
screens <- do
|
||||
dpy <- openDisplay ""
|
||||
rects <- getScreenInfo dpy
|
||||
closeDisplay dpy
|
||||
return rects
|
||||
let ids = zip [0 .. ] screens
|
||||
return $ map fst ids
|
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleContexts, PatternGuards #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -35,7 +35,7 @@ module XMonad.Hooks.DynamicLog (
|
||||
-- * Build your own formatter
|
||||
dynamicLogWithPP,
|
||||
dynamicLogString,
|
||||
PP(..), defaultPP,
|
||||
PP(..), defaultPP, def,
|
||||
|
||||
-- * Example formatters
|
||||
dzenPP, xmobarPP, sjanssenPP, byorgeyPP,
|
||||
@@ -43,6 +43,7 @@ module XMonad.Hooks.DynamicLog (
|
||||
-- * Formatting utilities
|
||||
wrap, pad, trim, shorten,
|
||||
xmobarColor, xmobarStrip,
|
||||
xmobarStripTags,
|
||||
dzenColor, dzenEscape, dzenStrip,
|
||||
|
||||
-- * Internal formatting functions
|
||||
@@ -57,10 +58,10 @@ module XMonad.Hooks.DynamicLog (
|
||||
-- Useful imports
|
||||
|
||||
import Codec.Binary.UTF8.String (encodeString)
|
||||
import Control.Monad (liftM2)
|
||||
import Control.Monad (liftM2, msum)
|
||||
import Data.Char ( isSpace, ord )
|
||||
import Data.List (intersperse, isPrefixOf, sortBy)
|
||||
import Data.Maybe ( isJust, catMaybes )
|
||||
import Data.List (intersperse, stripPrefix, isPrefixOf, sortBy)
|
||||
import Data.Maybe ( isJust, catMaybes, mapMaybe )
|
||||
import Data.Ord ( comparing )
|
||||
import qualified Data.Map as M
|
||||
import qualified XMonad.StackSet as S
|
||||
@@ -88,7 +89,7 @@ import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- > main = xmonad =<< xmobar myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- There is also 'statusBar' if you'd like to use another status bar, or would
|
||||
-- like to use different formatting options. The 'xmobar', 'dzen', and
|
||||
@@ -99,7 +100,7 @@ import XMonad.Hooks.ManageDocks
|
||||
-- ('dynamicLog' or 'dynamicLogXinerama') by simply setting your logHook to the
|
||||
-- appropriate function, for instance:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = dynamicLog
|
||||
-- > ...
|
||||
@@ -124,9 +125,9 @@ import XMonad.Hooks.ManageDocks
|
||||
-- >
|
||||
-- > main = do
|
||||
-- > h <- spawnPipe "xmobar -options -foo -bar"
|
||||
-- > xmonad $ defaultConfig {
|
||||
-- > xmonad $ def {
|
||||
-- > ...
|
||||
-- > logHook = dynamicLogWithPP $ defaultPP { ppOutput = hPutStrLn h }
|
||||
-- > logHook = dynamicLogWithPP $ def { ppOutput = hPutStrLn h }
|
||||
--
|
||||
-- If you use @spawnPipe@, be sure to redefine the 'ppOutput' field of
|
||||
-- your pretty-printer as in the example above; by default the status
|
||||
@@ -153,7 +154,7 @@ import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- > main = xmonad =<< dzen myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- The intent is that the above config file should provide a nice
|
||||
-- status bar with minimal effort.
|
||||
@@ -178,7 +179,7 @@ dzen conf = statusBar ("dzen2 " ++ flags) dzenPP toggleStrutsKey conf
|
||||
--
|
||||
-- > main = xmonad =<< xmobar myConfig
|
||||
-- >
|
||||
-- > myConfig = defaultConfig { ... }
|
||||
-- > myConfig = def { ... }
|
||||
--
|
||||
-- This works pretty much the same as 'dzen' function above.
|
||||
--
|
||||
@@ -198,12 +199,11 @@ statusBar :: LayoutClass l Window
|
||||
-> IO (XConfig (ModifiedLayout AvoidStruts l))
|
||||
statusBar cmd pp k conf = do
|
||||
h <- spawnPipe cmd
|
||||
return $ conf
|
||||
return $ docks $ conf
|
||||
{ layoutHook = avoidStruts (layoutHook conf)
|
||||
, logHook = do
|
||||
logHook conf
|
||||
dynamicLogWithPP pp { ppOutput = hPutStrLn h }
|
||||
, manageHook = manageHook conf <+> manageDocks
|
||||
, keys = liftM2 M.union keys' (keys conf)
|
||||
}
|
||||
where
|
||||
@@ -246,7 +246,7 @@ toggleStrutsKey XConfig{modMask = modm} = (modm, xK_b )
|
||||
-- To customize the output format, see 'dynamicLogWithPP'.
|
||||
--
|
||||
dynamicLog :: X ()
|
||||
dynamicLog = dynamicLogWithPP defaultPP
|
||||
dynamicLog = dynamicLogWithPP def
|
||||
|
||||
-- | Format the current status using the supplied pretty-printing format,
|
||||
-- and write it to stdout.
|
||||
@@ -279,7 +279,7 @@ dynamicLogString pp = do
|
||||
return $ encodeString . sepBy (ppSep pp) . ppOrder pp $
|
||||
[ ws
|
||||
, ppLayout pp ld
|
||||
, ppTitle pp wt
|
||||
, ppTitle pp $ ppTitleSanitize pp wt
|
||||
]
|
||||
++ catMaybes extras
|
||||
|
||||
@@ -312,7 +312,7 @@ pprWindowSet sort' urgents pp s = sepBy (ppWsSep pp) . map fmt . sort' $
|
||||
-- using 'dynamicLogWithPP' by setting 'ppSort' to /getSortByXineramaRule/ from
|
||||
-- "XMonad.Util.WorkspaceCompare". For example,
|
||||
--
|
||||
-- > defaultPP { ppCurrent = dzenColor "red" "#efebe7"
|
||||
-- > def { ppCurrent = dzenColor "red" "#efebe7"
|
||||
-- > , ppVisible = wrap "[" "]"
|
||||
-- > , ppSort = getSortByXineramaRule
|
||||
-- > }
|
||||
@@ -394,16 +394,33 @@ xmobarColor fg bg = wrap t "</fc>"
|
||||
|
||||
-- ??? add an xmobarEscape function?
|
||||
|
||||
-- | Strip xmobar markup.
|
||||
-- | Strip xmobar markup, specifically the <fc>, <icon> and <action> tags and
|
||||
-- the matching tags like </fc>.
|
||||
xmobarStrip :: String -> String
|
||||
xmobarStrip = strip [] where
|
||||
xmobarStrip = converge (xmobarStripTags ["fc","icon","action"]) where
|
||||
|
||||
converge :: (Eq a) => (a -> a) -> a -> a
|
||||
converge f a = let xs = iterate f a
|
||||
in fst $ head $ dropWhile (uncurry (/=)) $ zip xs $ tail xs
|
||||
|
||||
xmobarStripTags :: [String] -- ^ tags
|
||||
-> String -> String -- ^ with all <tag>...</tag> removed
|
||||
xmobarStripTags tags = strip [] where
|
||||
strip keep [] = keep
|
||||
strip keep x
|
||||
| null x = keep
|
||||
| "<fc=" `isPrefixOf` x = strip keep (drop 1 . dropWhile (/= '>') $ x)
|
||||
| "</fc>" `isPrefixOf` x = strip keep (drop 5 x)
|
||||
| '<' == head x = strip (keep ++ "<") (tail x)
|
||||
| otherwise = let (good,x') = span (/= '<') x
|
||||
in strip (keep ++ good) x'
|
||||
| rest: _ <- mapMaybe dropTag tags = strip keep rest
|
||||
|
||||
|
||||
| '<':xs <- x = strip (keep ++ "<") xs
|
||||
| (good,x') <- span (/= '<') x = strip (keep ++ good) x' -- this is n^2 bad... but titles have few tags
|
||||
where dropTag :: String -> Maybe String
|
||||
dropTag tag = msum [fmap dropTilClose (openTag tag `stripPrefix` x),
|
||||
closeTag tag `stripPrefix` x]
|
||||
|
||||
dropTilClose, openTag, closeTag :: String -> String
|
||||
dropTilClose = drop 1 . dropWhile (/= '>')
|
||||
openTag str = "<" ++ str ++ "="
|
||||
closeTag str = "</" ++ str ++ ">"
|
||||
|
||||
-- | The 'PP' type allows the user to customize the formatting of
|
||||
-- status information.
|
||||
@@ -427,6 +444,8 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
|
||||
-- ^ separator to use between workspace tags
|
||||
, ppTitle :: String -> String
|
||||
-- ^ window title format
|
||||
, ppTitleSanitize :: String -> String
|
||||
-- ^ escape / sanitizes input to 'ppTitle'
|
||||
, ppLayout :: String -> String
|
||||
-- ^ layout name format
|
||||
, ppOrder :: [String] -> [String]
|
||||
@@ -459,8 +478,12 @@ data PP = PP { ppCurrent :: WorkspaceId -> String
|
||||
}
|
||||
|
||||
-- | The default pretty printing options, as seen in 'dynamicLog'.
|
||||
{-# DEPRECATED defaultPP "Use def (from Data.Default, and re-exported by XMonad.Hooks.DynamicLog) instead." #-}
|
||||
defaultPP :: PP
|
||||
defaultPP = PP { ppCurrent = wrap "[" "]"
|
||||
defaultPP = def
|
||||
|
||||
instance Default PP where
|
||||
def = PP { ppCurrent = wrap "[" "]"
|
||||
, ppVisible = wrap "<" ">"
|
||||
, ppHidden = id
|
||||
, ppHiddenNoWindows = const ""
|
||||
@@ -468,6 +491,7 @@ defaultPP = PP { ppCurrent = wrap "[" "]"
|
||||
, ppSep = " : "
|
||||
, ppWsSep = " "
|
||||
, ppTitle = shorten 80
|
||||
, ppTitleSanitize = xmobarStrip . dzenEscape
|
||||
, ppLayout = id
|
||||
, ppOrder = id
|
||||
, ppOutput = putStrLn
|
||||
@@ -477,7 +501,7 @@ defaultPP = PP { ppCurrent = wrap "[" "]"
|
||||
|
||||
-- | Settings to emulate dwm's statusbar, dzen only.
|
||||
dzenPP :: PP
|
||||
dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad
|
||||
dzenPP = def { ppCurrent = dzenColor "white" "#2b4f98" . pad
|
||||
, ppVisible = dzenColor "black" "#999999" . pad
|
||||
, ppHidden = dzenColor "black" "#cccccc" . pad
|
||||
, ppHiddenNoWindows = const ""
|
||||
@@ -496,7 +520,7 @@ dzenPP = defaultPP { ppCurrent = dzenColor "white" "#2b4f98" . pad
|
||||
|
||||
-- | Some nice xmobar defaults.
|
||||
xmobarPP :: PP
|
||||
xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
|
||||
xmobarPP = def { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
|
||||
, ppTitle = xmobarColor "green" "" . shorten 40
|
||||
, ppVisible = wrap "(" ")"
|
||||
, ppUrgent = xmobarColor "red" "yellow"
|
||||
@@ -504,15 +528,15 @@ xmobarPP = defaultPP { ppCurrent = xmobarColor "yellow" "" . wrap "[" "]"
|
||||
|
||||
-- | The options that sjanssen likes to use with xmobar, as an
|
||||
-- example. Note the use of 'xmobarColor' and the record update on
|
||||
-- 'defaultPP'.
|
||||
-- 'def'.
|
||||
sjanssenPP :: PP
|
||||
sjanssenPP = defaultPP { ppCurrent = xmobarColor "white" "black"
|
||||
sjanssenPP = def { ppCurrent = xmobarColor "white" "black"
|
||||
, ppTitle = xmobarColor "#00ee00" "" . shorten 120
|
||||
}
|
||||
|
||||
-- | The options that byorgey likes to use with dzen, as another example.
|
||||
byorgeyPP :: PP
|
||||
byorgeyPP = defaultPP { ppHiddenNoWindows = showNamedWorkspaces
|
||||
byorgeyPP = def { ppHiddenNoWindows = showNamedWorkspaces
|
||||
, ppHidden = dzenColor "black" "#a8a3f7" . pad
|
||||
, ppCurrent = dzenColor "yellow" "#a8a3f7" . pad
|
||||
, ppUrgent = dzenColor "red" "yellow" . pad
|
||||
|
71
XMonad/Hooks/DynamicProperty.hs
Normal file
71
XMonad/Hooks/DynamicProperty.hs
Normal file
@@ -0,0 +1,71 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.DynamicProperty
|
||||
-- Copyright : (c) Brandon S Allbery, 2015
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : allbery.b@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Module to apply a ManageHook to an already-mapped window when a property
|
||||
-- changes. This would commonly be used to match browser windows by title,
|
||||
-- since the final title will only be set after (a) the window is mapped,
|
||||
-- (b) its document has been loaded, (c) all load-time scripts have run.
|
||||
-- (Don't blame browsers for this; it's inherent in HTML and the DOM. And
|
||||
-- changing title dynamically is explicitly permitted by ICCCM and EWMH;
|
||||
-- you don't really want to have your editor window umapped/remapped to
|
||||
-- show the current document and modified state in the titlebar, do you?)
|
||||
--
|
||||
-- This is a handleEventHook that triggers on a PropertyChange event. It
|
||||
-- currently ignores properties being removed, in part because you can't
|
||||
-- do anything useful in a ManageHook involving nonexistence of a property.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.DynamicProperty where
|
||||
|
||||
import XMonad
|
||||
import Data.Monoid
|
||||
import Control.Applicative
|
||||
import Control.Monad (when)
|
||||
|
||||
-- |
|
||||
-- Run a 'ManageHook' when a specific property is changed on a window. Note
|
||||
-- that this will run on any window which changes the property, so you should
|
||||
-- be very specific in your 'MansgeHook' matching (lots of windows change
|
||||
-- their titles on the fly!):
|
||||
--
|
||||
-- dynamicPropertyChange "WM_NAME" (className =? "Iceweasel" <&&> title =? "whatever" --> doShift "2")
|
||||
--
|
||||
-- Note that the fixity of (-->) won't allow it to be mixed with ($), so you
|
||||
-- can't use the obvious $ shorthand.
|
||||
--
|
||||
-- > dynamicPropertyChange "WM_NAME" $ title =? "Foo" --> doFloat -- won't work!
|
||||
--
|
||||
-- Consider instead phrasing it like any
|
||||
-- other 'ManageHook':
|
||||
--
|
||||
-- > , handleEventHook = dynamicPropertyChange "WM_NAME" myDynHook <+> handleEventHook baseConfig
|
||||
-- >
|
||||
-- > {- ... -}
|
||||
-- >
|
||||
-- > myDynHook = composeAll [...]
|
||||
--
|
||||
dynamicPropertyChange :: String -> ManageHook -> Event -> X All
|
||||
dynamicPropertyChange prop hook PropertyEvent { ev_window = w, ev_atom = a, ev_propstate = ps } = do
|
||||
pa <- getAtom prop
|
||||
when (ps == propertyNewValue && a == pa) $ do
|
||||
g <- appEndo <$> userCodeDef (Endo id) (runQuery hook w)
|
||||
windows g
|
||||
return (All False) -- so anything else also processes it
|
||||
dynamicPropertyChange _ _ _ = return (All False)
|
||||
|
||||
-- | A shorthand for the most common case, dynamic titles
|
||||
dynamicTitle :: ManageHook -> Event -> X All
|
||||
-- strictly, this should also check _NET_WM_NAME. practically, both will
|
||||
-- change and each gets its own PropertyEvent, so we'd need to record that
|
||||
-- we saw the event for that window and ignore the second one. Instead, just
|
||||
-- trust that nobody sets only _NET_WM_NAME. (I'm sure this will prove false,
|
||||
-- since there's always someone who can't bother being compliant.)
|
||||
dynamicTitle = dynamicPropertyChange "WM_NAME"
|
@@ -20,6 +20,7 @@ module XMonad.Hooks.EwmhDesktops (
|
||||
ewmhDesktopsLogHook,
|
||||
ewmhDesktopsLogHookCustom,
|
||||
ewmhDesktopsEventHook,
|
||||
ewmhDesktopsEventHookCustom,
|
||||
fullscreenEventHook
|
||||
) where
|
||||
|
||||
@@ -43,9 +44,10 @@ import XMonad.Util.WindowProperties (getProp32)
|
||||
-- > import XMonad
|
||||
-- > import XMonad.Hooks.EwmhDesktops
|
||||
-- >
|
||||
-- > main = xmonad $ ewmh defaultConfig
|
||||
-- > main = xmonad $ ewmh def{ handleEventHook =
|
||||
-- > handleEventHook def <+> fullscreenEventHook }
|
||||
--
|
||||
-- You may also be interested in 'avoidStruts' from XMonad.Hooks.ManageDocks.
|
||||
-- You may also be interested in 'docks' from "XMonad.Hooks.ManageDocks".
|
||||
|
||||
|
||||
-- | Add EWMH functionality to the given config. See above for an example.
|
||||
@@ -53,7 +55,8 @@ ewmh :: XConfig a -> XConfig a
|
||||
ewmh c = c { startupHook = startupHook c +++ ewmhDesktopsStartup
|
||||
, handleEventHook = handleEventHook c +++ ewmhDesktopsEventHook
|
||||
, logHook = logHook c +++ ewmhDesktopsLogHook }
|
||||
where x +++ y = mappend x y
|
||||
-- @@@ will fix this correctly later with the rewrite
|
||||
where x +++ y = mappend y x
|
||||
|
||||
-- |
|
||||
-- Initializes EwmhDesktops and advertises EWMH support to the X
|
||||
@@ -116,18 +119,23 @@ ewmhDesktopsLogHookCustom f = withWindowSet $ \s -> do
|
||||
-- * _NET_WM_DESKTOP (move windows to other desktops)
|
||||
--
|
||||
-- * _NET_ACTIVE_WINDOW (activate another window, changing workspace if needed)
|
||||
--
|
||||
ewmhDesktopsEventHook :: Event -> X All
|
||||
ewmhDesktopsEventHook e = handle e >> return (All True)
|
||||
ewmhDesktopsEventHook = ewmhDesktopsEventHookCustom id
|
||||
|
||||
handle :: Event -> X ()
|
||||
handle ClientMessageEvent {
|
||||
-- |
|
||||
-- Generalized version of ewmhDesktopsEventHook that allows an arbitrary
|
||||
-- user-specified function to transform the workspace list (post-sorting)
|
||||
ewmhDesktopsEventHookCustom :: ([WindowSpace] -> [WindowSpace]) -> Event -> X All
|
||||
ewmhDesktopsEventHookCustom f e = handle f e >> return (All True)
|
||||
|
||||
handle :: ([WindowSpace] -> [WindowSpace]) -> Event -> X ()
|
||||
handle f (ClientMessageEvent {
|
||||
ev_window = w,
|
||||
ev_message_type = mt,
|
||||
ev_data = d
|
||||
} = withWindowSet $ \s -> do
|
||||
}) = withWindowSet $ \s -> do
|
||||
sort' <- getSortByIndex
|
||||
let ws = sort' $ W.workspaces s
|
||||
let ws = f $ sort' $ W.workspaces s
|
||||
|
||||
a_cd <- getAtom "_NET_CURRENT_DESKTOP"
|
||||
a_d <- getAtom "_NET_WM_DESKTOP"
|
||||
@@ -154,17 +162,19 @@ handle ClientMessageEvent {
|
||||
-- The Message is unknown to us, but that is ok, not all are meant
|
||||
-- to be handled by the window manager
|
||||
return ()
|
||||
handle _ = return ()
|
||||
handle _ _ = return ()
|
||||
|
||||
-- |
|
||||
-- An event hook to handle applications that wish to fullscreen using the
|
||||
-- _NET_WM_STATE protocol. This includes users of the gtk_window_fullscreen()
|
||||
-- function, such as Totem, Evince and OpenOffice.org.
|
||||
--
|
||||
-- Note this is not included in 'ewmh'.
|
||||
fullscreenEventHook :: Event -> X All
|
||||
fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
|
||||
state <- getAtom "_NET_WM_STATE"
|
||||
wmstate <- getAtom "_NET_WM_STATE"
|
||||
fullsc <- getAtom "_NET_WM_STATE_FULLSCREEN"
|
||||
wstate <- fromMaybe [] `fmap` getProp32 state win
|
||||
wstate <- fromMaybe [] `fmap` getProp32 wmstate win
|
||||
|
||||
let isFull = fromIntegral fullsc `elem` wstate
|
||||
|
||||
@@ -173,9 +183,9 @@ fullscreenEventHook (ClientMessageEvent _ _ _ dpy win typ (action:dats)) = do
|
||||
add = 1
|
||||
toggle = 2
|
||||
ptype = 4 -- The atom property type for changeProperty
|
||||
chWstate f = io $ changeProperty32 dpy win state ptype propModeReplace (f wstate)
|
||||
chWstate f = io $ changeProperty32 dpy win wmstate ptype propModeReplace (f wstate)
|
||||
|
||||
when (typ == state && fi fullsc `elem` dats) $ do
|
||||
when (typ == wmstate && fi fullsc `elem` dats) $ do
|
||||
when (action == add || (action == toggle && not isFull)) $ do
|
||||
chWstate (fi fullsc:)
|
||||
windows $ W.float win $ W.RationalRect 0 0 1 1
|
||||
|
@@ -17,10 +17,12 @@ module XMonad.Hooks.FadeInactive (
|
||||
-- $usage
|
||||
setOpacity,
|
||||
isUnfocused,
|
||||
isUnfocusedOnCurrentWS,
|
||||
fadeIn,
|
||||
fadeOut,
|
||||
fadeIf,
|
||||
fadeInactiveLogHook,
|
||||
fadeInactiveCurrentWSLogHook,
|
||||
fadeOutLogHook
|
||||
) where
|
||||
|
||||
@@ -38,7 +40,7 @@ import Control.Monad
|
||||
-- > myLogHook = fadeInactiveLogHook fadeAmount
|
||||
-- > where fadeAmount = 0.8
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { logHook = myLogHook }
|
||||
-- > main = xmonad def { logHook = myLogHook }
|
||||
--
|
||||
-- fadeAmount can be any rational between 0 and 1.
|
||||
-- you will need to have xcompmgr <http://freedesktop.org/wiki/Software/xapps>
|
||||
@@ -58,18 +60,18 @@ rationalToOpacity perc
|
||||
| perc < 0 || perc > 1 = round perc -- to maintain backwards-compatability
|
||||
| otherwise = round $ perc * 0xffffffff
|
||||
|
||||
-- | sets the opacity of a window
|
||||
-- | Sets the opacity of a window
|
||||
setOpacity :: Window -> Rational -> X ()
|
||||
setOpacity w t = withDisplay $ \dpy -> do
|
||||
a <- getAtom "_NET_WM_WINDOW_OPACITY"
|
||||
c <- getAtom "CARDINAL"
|
||||
io $ changeProperty32 dpy w a c propModeReplace [rationalToOpacity t]
|
||||
|
||||
-- | fades a window out by setting the opacity
|
||||
-- | Fades a window out by setting the opacity
|
||||
fadeOut :: Rational -> Window -> X ()
|
||||
fadeOut = flip setOpacity
|
||||
|
||||
-- | makes a window completely opaque
|
||||
-- | Makes a window completely opaque
|
||||
fadeIn :: Window -> X ()
|
||||
fadeIn = fadeOut 1
|
||||
|
||||
@@ -78,15 +80,34 @@ fadeIn = fadeOut 1
|
||||
fadeIf :: Query Bool -> Rational -> Query Rational
|
||||
fadeIf qry amt = qry >>= \b -> return $ if b then amt else 1
|
||||
|
||||
-- | sets the opacity of inactive windows to the specified amount
|
||||
-- | Sets the opacity of inactive windows to the specified amount
|
||||
fadeInactiveLogHook :: Rational -> X ()
|
||||
fadeInactiveLogHook = fadeOutLogHook . fadeIf isUnfocused
|
||||
|
||||
-- | returns True if the window doesn't have the focus.
|
||||
-- | Set the opacity of inactive windows, on the current workspace, to the
|
||||
-- specified amount. This is specifically usefull in a multi monitor setup. See
|
||||
-- 'isUnfocusedOnCurrentWS'.
|
||||
fadeInactiveCurrentWSLogHook :: Rational -> X ()
|
||||
fadeInactiveCurrentWSLogHook = fadeOutLogHook . fadeIf isUnfocusedOnCurrentWS
|
||||
|
||||
-- | Returns True if the window doesn't have the focus.
|
||||
isUnfocused :: Query Bool
|
||||
isUnfocused = ask >>= \w -> liftX . gets $ maybe True (w /=) . W.peek . windowset
|
||||
|
||||
-- | fades out every window by the amount returned by the query.
|
||||
-- | Returns True if the window doesn't have the focus, and the window is on the
|
||||
-- current workspace. This is specifically handy in a multi monitor setup
|
||||
-- (xinerama) where multiple workspaces are visible. Using this, non-focused
|
||||
-- workspaces are are not faded out making it easier to look and read the
|
||||
-- content on them.
|
||||
isUnfocusedOnCurrentWS :: Query Bool
|
||||
isUnfocusedOnCurrentWS = do
|
||||
w <- ask
|
||||
ws <- liftX $ gets windowset
|
||||
let thisWS = w `elem` W.index ws
|
||||
unfocused = maybe True (w /=) $ W.peek ws
|
||||
return $ thisWS && unfocused
|
||||
|
||||
-- | Fades out every window by the amount returned by the query.
|
||||
fadeOutLogHook :: Query Rational -> X ()
|
||||
fadeOutLogHook qry = withWindowSet $ \s -> do
|
||||
let visibleWins = (W.integrate' . W.stack . W.workspace . W.current $ s) ++
|
||||
|
@@ -115,7 +115,7 @@ import Graphics.X11.Xlib.Extras (Event(..))
|
||||
-- a tight loop trying to fade the popup in). I find it useful to
|
||||
-- have a key binding to restart the compositing manager; for example,
|
||||
--
|
||||
-- main = xmonad $ defaultConfig {
|
||||
-- main = xmonad $ def {
|
||||
-- {- ... -}
|
||||
-- }
|
||||
-- `additionalKeysP`
|
||||
|
@@ -53,7 +53,7 @@ hookName = "__float"
|
||||
--
|
||||
-- and adding 'floatNextHook' to your 'ManageHook':
|
||||
--
|
||||
-- > myManageHook = floatNextHook <+> manageHook defaultConfig
|
||||
-- > myManageHook = floatNextHook <+> manageHook def
|
||||
--
|
||||
-- The 'floatNext' and 'toggleFloatNext' functions can be used in key
|
||||
-- bindings to float the next spawned window:
|
||||
|
@@ -18,6 +18,7 @@
|
||||
-- @
|
||||
-----------------------------------------------------------------------------
|
||||
module XMonad.Hooks.ICCCMFocus
|
||||
{-# DEPRECATED "XMonad.Hooks.ICCCMFocus: xmonad>0.10 core merged issue 177" #-}
|
||||
(
|
||||
atom_WM_TAKE_FOCUS
|
||||
, takeFocusX
|
||||
@@ -27,27 +28,11 @@ module XMonad.Hooks.ICCCMFocus
|
||||
import XMonad
|
||||
import XMonad.Hooks.SetWMName
|
||||
import qualified XMonad.StackSet as W
|
||||
import Control.Monad
|
||||
|
||||
atom_WM_TAKE_FOCUS ::
|
||||
X Atom
|
||||
atom_WM_TAKE_FOCUS =
|
||||
getAtom "WM_TAKE_FOCUS"
|
||||
|
||||
takeFocusX ::
|
||||
Window
|
||||
-> X ()
|
||||
takeFocusX w =
|
||||
withWindowSet . const $ do
|
||||
dpy <- asks display
|
||||
wmtakef <- atom_WM_TAKE_FOCUS
|
||||
wmprot <- atom_WM_PROTOCOLS
|
||||
protocols <- io $ getWMProtocols dpy w
|
||||
when (wmtakef `elem` protocols) $
|
||||
io . allocaXEvent $ \ev -> do
|
||||
setEventType ev clientMessage
|
||||
setClientMessageEvent ev w wmprot 32 wmtakef currentTime
|
||||
sendEvent dpy w False noEventMask ev
|
||||
takeFocusX _w = return ()
|
||||
|
||||
-- | The value to add to your log hook configuration.
|
||||
takeTopFocus ::
|
||||
|
@@ -31,7 +31,7 @@ import Data.Monoid(Endo(Endo))
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.InsertPosition
|
||||
-- > xmonad defaultConfig { manageHook = insertPosition Master Newer <+> myManageHook }
|
||||
-- > xmonad def { manageHook = insertPosition Master Newer <+> myManageHook }
|
||||
--
|
||||
-- You should you put the manageHooks that use 'doShift' to take effect
|
||||
-- /before/ 'insertPosition', so that the window order will be consistent.
|
||||
|
100
XMonad/Hooks/ManageDebug.hs
Normal file
100
XMonad/Hooks/ManageDebug.hs
Normal file
@@ -0,0 +1,100 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ManageDebug
|
||||
-- Copyright : (c) Brandon S Allbery KF8NH, 2014
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : allbery.b@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- A @manageHook@ and associated @logHook@ for debugging 'ManageHook's.
|
||||
-- Simplest usage: wrap your xmonad config in the @debugManageHook@ combinator.
|
||||
-- Or use @debugManageHookOn@ for a triggerable version, specifying the
|
||||
-- triggering key sequence in 'XMonad.Util.EZConfig' syntax. Or use the
|
||||
-- individual hooks in whatever way you see fit.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
--
|
||||
--
|
||||
|
||||
module XMonad.Hooks.ManageDebug (debugManageHook
|
||||
,debugManageHookOn
|
||||
,manageDebug
|
||||
,maybeManageDebug
|
||||
,manageDebugLogHook
|
||||
,debugNextManagedWindow
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Hooks.DebugStack
|
||||
import XMonad.Util.DebugWindow
|
||||
import XMonad.Util.EZConfig
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import Control.Monad (when)
|
||||
|
||||
-- persistent state for manageHook debugging to trigger logHook debugging
|
||||
data ManageStackDebug = MSD (Bool,Bool) deriving Typeable
|
||||
instance ExtensionClass ManageStackDebug where
|
||||
initialValue = MSD (False,False)
|
||||
|
||||
-- | A combinator to add full 'ManageHook' debugging in a single operation.
|
||||
debugManageHook :: XConfig l -> XConfig l
|
||||
debugManageHook cf = cf {logHook = manageDebugLogHook <+> logHook cf
|
||||
,manageHook = manageDebug <+> manageHook cf
|
||||
}
|
||||
|
||||
-- | A combinator to add triggerable 'ManageHook' debugging in a single operation.
|
||||
-- Specify a key sequence as a string in 'XMonad.Util.EZConfig' syntax; press
|
||||
-- this key before opening the window to get just that logged.
|
||||
debugManageHookOn :: String -> XConfig l -> XConfig l
|
||||
debugManageHookOn key cf = cf {logHook = manageDebugLogHook <+> logHook cf
|
||||
,manageHook = maybeManageDebug <+> manageHook cf
|
||||
}
|
||||
`additionalKeysP`
|
||||
[(key,debugNextManagedWindow)]
|
||||
|
||||
-- | Place this at the start of a 'ManageHook', or possibly other places for a
|
||||
-- more limited view. It will show the current 'StackSet' state and the new
|
||||
-- window, and set a flag so that @manageDebugLogHook@ will display the
|
||||
-- final 'StackSet' state.
|
||||
--
|
||||
-- Note that the initial state shows only the current workspace; the final
|
||||
-- one shows all workspaces, since your 'ManageHook' might use e.g. 'doShift',
|
||||
manageDebug :: ManageHook
|
||||
manageDebug = do
|
||||
w <- ask
|
||||
liftX $ do
|
||||
trace "== manageHook; current stack =="
|
||||
debugStackString >>= trace
|
||||
ws <- debugWindow w
|
||||
trace $ "new:\n " ++ ws
|
||||
XS.modify $ \(MSD (_,key)) -> MSD (True,key)
|
||||
idHook
|
||||
|
||||
-- | @manageDebug@ only if the user requested it with @debugNextManagedWindow@.
|
||||
maybeManageDebug :: ManageHook
|
||||
maybeManageDebug = do
|
||||
go <- liftX $ do
|
||||
MSD (log_,go') <- XS.get
|
||||
XS.put $ MSD (log_,False)
|
||||
return go'
|
||||
if go then manageDebug else idHook
|
||||
|
||||
-- | If @manageDebug@ has set the debug-stack flag, show the stack.
|
||||
manageDebugLogHook :: X ()
|
||||
manageDebugLogHook = do
|
||||
MSD (go,key) <- XS.get
|
||||
when go $ do
|
||||
trace "== manageHook; final stack =="
|
||||
debugStackFullString >>= trace
|
||||
XS.put $ MSD (False,key)
|
||||
idHook
|
||||
|
||||
-- | Request that the next window to be managed be @manageDebug@-ed. This can
|
||||
-- be used anywhere an X action can, such as key bindings, mouse bindings
|
||||
-- (presumably with 'const'), 'startupHook', etc.
|
||||
debugNextManagedWindow :: X ()
|
||||
debugNextManagedWindow = XS.modify $ \(MSD (log_,_)) -> MSD (log_,True)
|
@@ -1,5 +1,4 @@
|
||||
{-# LANGUAGE DeriveDataTypeable, PatternGuards, FlexibleInstances, MultiParamTypeClasses, CPP #-}
|
||||
-- deriving Typeable for ghc-6.6 compatibility, which is retained in the core
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ManageDocks
|
||||
@@ -16,8 +15,8 @@
|
||||
module XMonad.Hooks.ManageDocks (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
|
||||
docksEventHook,
|
||||
docks, manageDocks, checkDock, AvoidStruts, avoidStruts, avoidStrutsOn,
|
||||
docksEventHook, docksStartupHook,
|
||||
ToggleStruts(..),
|
||||
SetStruts(..),
|
||||
module XMonad.Util.Types,
|
||||
@@ -40,34 +39,29 @@ import XMonad.Layout.LayoutModifier
|
||||
import XMonad.Util.Types
|
||||
import XMonad.Util.WindowProperties (getProp32s)
|
||||
import XMonad.Util.XUtils (fi)
|
||||
import Data.Monoid (All(..))
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import Data.Monoid (All(..), mempty)
|
||||
import Data.Functor((<$>))
|
||||
|
||||
import qualified Data.Set as S
|
||||
import qualified Data.Map as M
|
||||
import Control.Monad (when, forM_, filterM)
|
||||
|
||||
-- $usage
|
||||
-- To use this module, add the following import to @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.ManageDocks
|
||||
--
|
||||
-- The first component is a 'ManageHook' which recognizes these
|
||||
-- windows and de-manages them, so that xmonad does not try to tile
|
||||
-- them. To enable it:
|
||||
-- Wrap your xmonad config with a call to 'docks', like so:
|
||||
--
|
||||
-- > manageHook = ... <+> manageDocks
|
||||
-- > main = xmonad $ docks def
|
||||
--
|
||||
-- The second component is a layout modifier that prevents windows
|
||||
-- from overlapping these dock windows. It is intended to replace
|
||||
-- xmonad's so-called \"gap\" support. First, you must add it to your
|
||||
-- list of layouts:
|
||||
-- Then add 'avoidStruts' or 'avoidStrutsOn' layout modifier to your layout
|
||||
-- to prevent windows from overlapping these windows.
|
||||
--
|
||||
-- > layoutHook = avoidStruts (tall ||| mirror tall ||| ...)
|
||||
-- > where tall = Tall 1 (3/100) (1/2)
|
||||
--
|
||||
-- The third component is an event hook that causes new docks to appear
|
||||
-- immediately, instead of waiting for the next focus change.
|
||||
--
|
||||
-- > handleEventHook = ... <+> docksEventHook
|
||||
--
|
||||
-- 'AvoidStruts' also supports toggling the dock gaps; add a keybinding
|
||||
-- similar to:
|
||||
--
|
||||
@@ -87,22 +81,44 @@ import qualified Data.Set as S
|
||||
--
|
||||
-- > layoutHook = avoidStrutsOn [U,L] (tall ||| mirror tall ||| ...)
|
||||
--
|
||||
-- /Important note/: if you are switching from manual gaps
|
||||
-- (defaultGaps in your config) to avoidStruts (recommended, since
|
||||
-- manual gaps will probably be phased out soon), be sure to switch
|
||||
-- off all your gaps (with mod-b) /before/ reloading your config with
|
||||
-- avoidStruts! Toggling struts with a 'ToggleStruts' message will
|
||||
-- not work unless your gaps are set to zero.
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
--
|
||||
|
||||
-- | Add docks functionality to the given config. See above for an example.
|
||||
docks :: XConfig a -> XConfig a
|
||||
docks c = c { startupHook = docksStartupHook <+> startupHook c
|
||||
, handleEventHook = docksEventHook <+> handleEventHook c
|
||||
, manageHook = manageDocks <+> manageHook c }
|
||||
|
||||
newtype StrutCache = StrutCache { fromStrutCache :: M.Map Window [Strut] }
|
||||
deriving (Eq, Typeable)
|
||||
|
||||
data UpdateDocks = UpdateDocks deriving Typeable
|
||||
instance Message UpdateDocks
|
||||
|
||||
refreshDocks :: X ()
|
||||
refreshDocks = sendMessage UpdateDocks
|
||||
|
||||
instance ExtensionClass StrutCache where
|
||||
initialValue = StrutCache M.empty
|
||||
|
||||
updateStrutCache :: Window -> [Strut] -> X Bool
|
||||
updateStrutCache w strut = do
|
||||
XS.modified $ StrutCache . M.insert w strut . fromStrutCache
|
||||
|
||||
deleteFromStructCache :: Window -> X Bool
|
||||
deleteFromStructCache w = do
|
||||
XS.modified $ StrutCache . M.delete w . fromStrutCache
|
||||
|
||||
-- | Detects if the given window is of type DOCK and if so, reveals
|
||||
-- it, but does not manage it. If the window has the STRUT property
|
||||
-- set, adjust the gap accordingly.
|
||||
-- it, but does not manage it.
|
||||
manageDocks :: ManageHook
|
||||
manageDocks = checkDock --> doIgnore
|
||||
manageDocks = checkDock --> (doIgnore <+> setDocksMask)
|
||||
where setDocksMask = do
|
||||
ask >>= \win -> liftX $ withDisplay $ \dpy -> do
|
||||
io $ selectInput dpy win (propertyChangeMask .|. structureNotifyMask)
|
||||
mempty
|
||||
|
||||
-- | Checks if a window is a DOCK or DESKTOP window
|
||||
checkDock :: Query Bool
|
||||
@@ -111,17 +127,41 @@ checkDock = ask >>= \w -> liftX $ do
|
||||
desk <- getAtom "_NET_WM_WINDOW_TYPE_DESKTOP"
|
||||
mbr <- getProp32s "_NET_WM_WINDOW_TYPE" w
|
||||
case mbr of
|
||||
Just [r] -> return $ elem (fromIntegral r) [dock, desk]
|
||||
Just rs -> return $ any (`elem` [dock,desk]) (map fromIntegral rs)
|
||||
_ -> return False
|
||||
|
||||
-- | Whenever a new dock appears, refresh the layout immediately to avoid the
|
||||
-- new dock.
|
||||
docksEventHook :: Event -> X All
|
||||
docksEventHook (MapNotifyEvent { ev_window = w }) = do
|
||||
whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh
|
||||
whenX (runQuery checkDock w <&&> (not <$> isClient w)) $ do
|
||||
strut <- getStrut w
|
||||
whenX (updateStrutCache w strut) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook (PropertyEvent { ev_window = w
|
||||
, ev_atom = a }) = do
|
||||
whenX (runQuery checkDock w) $ do
|
||||
nws <- getAtom "_NET_WM_STRUT"
|
||||
nwsp <- getAtom "_NET_WM_STRUT_PARTIAL"
|
||||
when (a == nws || a == nwsp) $ do
|
||||
strut <- getStrut w
|
||||
whenX (updateStrutCache w strut) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook (DestroyWindowEvent {ev_window = w}) = do
|
||||
whenX (deleteFromStructCache w) refreshDocks
|
||||
return (All True)
|
||||
docksEventHook _ = return (All True)
|
||||
|
||||
docksStartupHook :: X ()
|
||||
docksStartupHook = withDisplay $ \dpy -> do
|
||||
rootw <- asks theRoot
|
||||
(_,_,wins) <- io $ queryTree dpy rootw
|
||||
docks <- filterM (runQuery checkDock) wins
|
||||
forM_ docks $ \win -> do
|
||||
strut <- getStrut win
|
||||
updateStrutCache win strut
|
||||
refreshDocks
|
||||
|
||||
-- | Gets the STRUT config, if present, in xmonad gap order
|
||||
getStrut :: Window -> X [Strut]
|
||||
getStrut w = do
|
||||
@@ -143,9 +183,7 @@ getStrut w = do
|
||||
calcGap :: S.Set Direction2D -> X (Rectangle -> Rectangle)
|
||||
calcGap ss = withDisplay $ \dpy -> do
|
||||
rootw <- asks theRoot
|
||||
-- We don't keep track of dock like windows, so we find all of them here
|
||||
(_,_,wins) <- io $ queryTree dpy rootw
|
||||
struts <- (filter careAbout . concat) `fmap` mapM getStrut wins
|
||||
struts <- (filter careAbout . concat) `fmap` XS.gets (M.elems . fromStrutCache)
|
||||
|
||||
-- we grab the window attributes of the root window rather than checking
|
||||
-- the width of the screen because xlib caches this info and it tends to
|
||||
@@ -167,7 +205,7 @@ avoidStrutsOn :: LayoutClass l a =>
|
||||
[Direction2D]
|
||||
-> l a
|
||||
-> ModifiedLayout AvoidStruts l a
|
||||
avoidStrutsOn ss = ModifiedLayout $ AvoidStruts $ S.fromList ss
|
||||
avoidStrutsOn ss = ModifiedLayout $ AvoidStruts (S.fromList ss)
|
||||
|
||||
data AvoidStruts a = AvoidStruts (S.Set Direction2D) deriving ( Read, Show )
|
||||
|
||||
@@ -207,21 +245,30 @@ instance Message SetStruts
|
||||
|
||||
instance LayoutModifier AvoidStruts a where
|
||||
modifyLayout (AvoidStruts ss) w r = do
|
||||
nr <- fmap ($ r) (calcGap ss)
|
||||
runLayout w nr
|
||||
srect <- fmap ($ r) (calcGap ss)
|
||||
setWorkarea srect
|
||||
runLayout w srect
|
||||
|
||||
pureMess (AvoidStruts ss) m
|
||||
pureMess as@(AvoidStruts ss) m
|
||||
| Just ToggleStruts <- fromMessage m = Just $ AvoidStruts (toggleAll ss)
|
||||
| Just (ToggleStrut s) <- fromMessage m = Just $ AvoidStruts (toggleOne s ss)
|
||||
| Just (SetStruts n k) <- fromMessage m
|
||||
, let newSS = S.fromList n `S.union` (ss S.\\ S.fromList k)
|
||||
, newSS /= ss = Just $ AvoidStruts newSS
|
||||
| Just UpdateDocks <- fromMessage m = Just as
|
||||
| otherwise = Nothing
|
||||
where toggleAll x | S.null x = S.fromList [minBound .. maxBound]
|
||||
| otherwise = S.empty
|
||||
toggleOne x xs | x `S.member` xs = S.delete x xs
|
||||
| otherwise = x `S.insert` xs
|
||||
|
||||
setWorkarea :: Rectangle -> X ()
|
||||
setWorkarea (Rectangle x y w h) = withDisplay $ \dpy -> do
|
||||
a <- getAtom "_NET_WORKAREA"
|
||||
c <- getAtom "CARDINAL"
|
||||
r <- asks theRoot
|
||||
io $ changeProperty32 dpy r a c propModeReplace [fi x, fi y, fi w, fi h]
|
||||
|
||||
|
||||
-- | (Direction, height\/width, initial pixel, final pixel).
|
||||
|
||||
|
@@ -13,7 +13,7 @@
|
||||
--
|
||||
-- > import XMonad.Hooks.ManageHelpers
|
||||
-- > main =
|
||||
-- > xmonad defaultConfig{
|
||||
-- > xmonad def{
|
||||
-- > ...
|
||||
-- > manageHook = composeOne [
|
||||
-- > isKDETrayWindow -?> doIgnore,
|
||||
|
@@ -9,7 +9,7 @@
|
||||
-- Portability : not portable
|
||||
--
|
||||
-- Handles window manager hints to minimize and restore windows. Use
|
||||
-- this with XMonad.Layout.Minimize.
|
||||
-- this with "XMonad.Layout.Minimize".
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
@@ -33,7 +33,7 @@ import XMonad.Layout.Minimize
|
||||
-- >
|
||||
-- > myHandleEventHook = minimizeEventHook
|
||||
-- > myLayout = minimize (Tall 1 (3/100) (1/2)) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout
|
||||
-- > main = xmonad def { layoutHook = myLayout
|
||||
-- > , handleEventHook = myHandleEventHook }
|
||||
|
||||
minimizeEventHook :: Event -> X All
|
||||
|
@@ -59,8 +59,8 @@ import Control.Monad.Trans (lift)
|
||||
--
|
||||
-- and adding 'placeHook' to your 'manageHook', for example:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig { manageHook = placeHook simpleSmart
|
||||
-- > <+> manageHook defaultConfig }
|
||||
-- > main = xmonad $ def { manageHook = placeHook simpleSmart
|
||||
-- > <+> manageHook def }
|
||||
--
|
||||
-- Note that 'placeHook' should be applied after most other hooks, especially hooks
|
||||
-- such as 'doFloat' and 'doShift'. Since hooks combined with '<+>' are applied from
|
||||
|
@@ -55,13 +55,13 @@ import qualified Data.Set as S
|
||||
-- as 'positionStoreEventHook' to your event hooks. To be accurate
|
||||
-- about window sizes, the module needs to know if any decoration is in effect.
|
||||
-- This is specified with the first argument: Supply 'Nothing' for no decoration,
|
||||
-- otherwise use 'Just defaultTheme' or similar to inform the module about the
|
||||
-- otherwise use 'Just def' or similar to inform the module about the
|
||||
-- decoration theme used.
|
||||
--
|
||||
-- > myManageHook = positionStoreManageHook Nothing <+> manageHook defaultConfig
|
||||
-- > myManageHook = positionStoreManageHook Nothing <+> manageHook def
|
||||
-- > myHandleEventHook = positionStoreEventHook
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { manageHook = myManageHook
|
||||
-- > main = xmonad def { manageHook = myManageHook
|
||||
-- > , handleEventHook = myHandleEventHook
|
||||
-- > }
|
||||
--
|
||||
|
@@ -34,7 +34,7 @@ import XMonad.Layout.Minimize
|
||||
-- >
|
||||
-- > myHandleEventHook = restoreMinimizedEventHook
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { handleEventHook = myHandleEventHook }
|
||||
-- > main = xmonad def { handleEventHook = myHandleEventHook }
|
||||
|
||||
data RestoreMinimized = RestoreMinimized deriving ( Show, Read )
|
||||
|
||||
|
@@ -1,8 +1,8 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ScreenCorners
|
||||
-- Copyright : (c) 2009 Nils Schweinsberg
|
||||
-- Copyright : (c) 2009 Nils Schweinsberg, 2015 Evgeny Kurnevsky
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Nils Schweinsberg <mail@n-sch.de>
|
||||
@@ -25,12 +25,16 @@ module XMonad.Hooks.ScreenCorners
|
||||
|
||||
-- * Event hook
|
||||
, screenCornerEventHook
|
||||
|
||||
-- * Layout hook
|
||||
, screenCornerLayoutHook
|
||||
) where
|
||||
|
||||
import Data.Monoid
|
||||
import Data.List (find)
|
||||
import XMonad
|
||||
import XMonad.Util.XUtils (fi)
|
||||
import XMonad.Layout.LayoutModifier
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
@@ -142,6 +146,23 @@ screenCornerEventHook CrossingEvent { ev_window = win } = do
|
||||
screenCornerEventHook _ = return (All True)
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- Layout hook
|
||||
--------------------------------------------------------------------------------
|
||||
|
||||
data ScreenCornerLayout a = ScreenCornerLayout
|
||||
deriving ( Read, Show )
|
||||
|
||||
instance LayoutModifier ScreenCornerLayout a where
|
||||
hook ScreenCornerLayout = withDisplay $ \dpy -> do
|
||||
ScreenCornerState m <- XS.get
|
||||
io $ mapM_ (raiseWindow dpy) $ M.keys m
|
||||
unhook = hook
|
||||
|
||||
screenCornerLayoutHook :: l a -> ModifiedLayout ScreenCornerLayout l a
|
||||
screenCornerLayoutHook = ModifiedLayout ScreenCornerLayout
|
||||
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
-- $usage
|
||||
--
|
||||
@@ -163,6 +184,14 @@ screenCornerEventHook _ = return (All True)
|
||||
-- > , (SCLowerLeft, prevWS)
|
||||
-- > ]
|
||||
--
|
||||
-- Then add layout hook:
|
||||
--
|
||||
-- > myLayout = screenCornerLayoutHook $ tiled ||| Mirror tiled ||| Full where
|
||||
-- > tiled = Tall nmaster delta ratio
|
||||
-- > nmaster = 1
|
||||
-- > ratio = 1 / 2
|
||||
-- > delta = 3 / 100
|
||||
--
|
||||
-- And finally wait for screen corner events in your event hook:
|
||||
--
|
||||
-- > myEventHook e = do
|
||||
|
@@ -26,8 +26,6 @@ module XMonad.Hooks.Script (
|
||||
--
|
||||
import XMonad
|
||||
|
||||
import System.Directory
|
||||
|
||||
-- $usage
|
||||
--
|
||||
-- This module allows you to run a centrally located script with the text
|
||||
@@ -36,7 +34,7 @@ import System.Directory
|
||||
-- For example, if you wanted to run the hook "startup" in your script every
|
||||
-- time your startup hook ran, you could modify your xmonad config as such:
|
||||
--
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > main = xmonad $ def {
|
||||
-- > ...
|
||||
-- > startupHook = execScriptHook "startup"
|
||||
-- > ...
|
||||
@@ -47,7 +45,7 @@ import System.Directory
|
||||
|
||||
-- | Execute a named script hook
|
||||
execScriptHook :: MonadIO m => String -> m ()
|
||||
execScriptHook hook = io $ do
|
||||
home <- getHomeDirectory
|
||||
let script = home ++ "/.xmonad/hooks "
|
||||
execScriptHook hook = do
|
||||
xmonadDir <- getXMonadDir
|
||||
let script = xmonadDir ++ "/hooks "
|
||||
spawn (script ++ hook)
|
||||
|
@@ -1,69 +1,104 @@
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.ServerMode
|
||||
-- Copyright : (c) Andrea Rossato and David Roundy 2007
|
||||
-- Copyright : (c) Peter Olson 2013 and Andrea Rossato and David Roundy 2007
|
||||
-- License : BSD-style (see xmonad/LICENSE)
|
||||
--
|
||||
-- Maintainer : andrea.rossato@unibz.it
|
||||
-- Maintainer : polson2@hawk.iit.edu
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- This is an 'EventHook' that will receive commands from an external
|
||||
-- client.
|
||||
-- client. Also consider "XMonad.Hooks.EwmhDesktops" together with
|
||||
-- @wmctrl@.
|
||||
--
|
||||
-- This is the example of a client:
|
||||
--
|
||||
-- > import Graphics.X11.Xlib
|
||||
-- > import Graphics.X11.Xlib.Extras
|
||||
-- > import System.Environment
|
||||
-- > import System.IO
|
||||
-- > import Data.Char
|
||||
-- >
|
||||
-- > usage :: String -> String
|
||||
-- > usage n = "Usage: " ++ n ++ " command number\nSend a command number to a running instance of XMonad"
|
||||
-- >
|
||||
-- > main :: IO ()
|
||||
-- > main = do
|
||||
-- > args <- getArgs
|
||||
-- > pn <- getProgName
|
||||
-- > let com = case args of
|
||||
-- > [] -> error $ usage pn
|
||||
-- > w -> (w !! 0)
|
||||
-- > sendCommand com
|
||||
-- > main = parse True "XMONAD_COMMAND" =<< getArgs
|
||||
-- >
|
||||
-- > sendCommand :: String -> IO ()
|
||||
-- > sendCommand s = do
|
||||
-- > parse :: Bool -> String -> [String] -> IO ()
|
||||
-- > parse input addr args = case args of
|
||||
-- > ["--"] | input -> repl addr
|
||||
-- > | otherwise -> return ()
|
||||
-- > ("--":xs) -> sendAll addr xs
|
||||
-- > ("-a":a:xs) -> parse input a xs
|
||||
-- > ("-h":_) -> showHelp
|
||||
-- > ("--help":_) -> showHelp
|
||||
-- > ("-?":_) -> showHelp
|
||||
-- > (a@('-':_):_) -> hPutStrLn stderr ("Unknown option " ++ a)
|
||||
-- >
|
||||
-- > (x:xs) -> sendCommand addr x >> parse False addr xs
|
||||
-- > [] | input -> repl addr
|
||||
-- > | otherwise -> return ()
|
||||
-- >
|
||||
-- >
|
||||
-- > repl :: String -> IO ()
|
||||
-- > repl addr = do e <- isEOF
|
||||
-- > case e of
|
||||
-- > True -> return ()
|
||||
-- > False -> do l <- getLine
|
||||
-- > sendCommand addr l
|
||||
-- > repl addr
|
||||
-- >
|
||||
-- > sendAll :: String -> [String] -> IO ()
|
||||
-- > sendAll addr ss = foldr (\a b -> sendCommand addr a >> b) (return ()) ss
|
||||
-- >
|
||||
-- > sendCommand :: String -> String -> IO ()
|
||||
-- > sendCommand addr s = do
|
||||
-- > d <- openDisplay ""
|
||||
-- > rw <- rootWindow d $ defaultScreen d
|
||||
-- > a <- internAtom d "XMONAD_COMMAND" False
|
||||
-- > a <- internAtom d addr False
|
||||
-- > m <- internAtom d s False
|
||||
-- > allocaXEvent $ \e -> do
|
||||
-- > setEventType e clientMessage
|
||||
-- > setClientMessageEvent e rw a 32 (fromIntegral (read s)) currentTime
|
||||
-- > setClientMessageEvent e rw a 32 m currentTime
|
||||
-- > sendEvent d rw False structureNotifyMask e
|
||||
-- > sync d False
|
||||
-- >
|
||||
-- > showHelp :: IO ()
|
||||
-- > showHelp = do pn <- getProgName
|
||||
-- > putStrLn ("Send commands to a running instance of xmonad. xmonad.hs must be configured with XMonad.Hooks.ServerMode to work.\n-a atomname can be used at any point in the command line arguments to change which atom it is sending on.\nIf sent with no arguments or only -a atom arguments, it will read commands from stdin.\nEx:\n" ++ pn ++ " cmd1 cmd2\n" ++ pn ++ " -a XMONAD_COMMAND cmd1 cmd2 cmd3 -a XMONAD_PRINT hello world\n" ++ pn ++ " -a XMONAD_PRINT # will read data from stdin.\nThe atom defaults to XMONAD_COMMAND.")
|
||||
--
|
||||
-- compile with: @ghc --make sendCommand.hs@
|
||||
--
|
||||
-- compile with: @ghc --make xmonadctl.hs@
|
||||
--
|
||||
-- run with
|
||||
--
|
||||
-- > sendCommand command number
|
||||
-- > xmonadctl command
|
||||
--
|
||||
-- For instance:
|
||||
-- or with
|
||||
--
|
||||
-- > sendCommand 0
|
||||
-- > $ xmonadctl
|
||||
-- > command1
|
||||
-- > command2
|
||||
-- > .
|
||||
-- > .
|
||||
-- > .
|
||||
-- > ^D
|
||||
--
|
||||
-- Usage will change depending on which event hook(s) you use. More examples are shown below.
|
||||
--
|
||||
-- will ask to xmonad to print the list of command numbers in
|
||||
-- stderr (so you can read it in @~\/.xsession-errors@).
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.ServerMode
|
||||
( -- * Usage
|
||||
-- $usage
|
||||
ServerMode (..)
|
||||
, serverModeEventHook
|
||||
serverModeEventHook
|
||||
, serverModeEventHook'
|
||||
, serverModeEventHookCmd
|
||||
, serverModeEventHookCmd'
|
||||
, serverModeEventHookF
|
||||
) where
|
||||
|
||||
import Control.Monad (when)
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import System.IO
|
||||
|
||||
@@ -75,31 +110,64 @@ import XMonad.Actions.Commands
|
||||
-- @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.ServerMode
|
||||
-- > import XMonad.Actions.Commands
|
||||
--
|
||||
-- Then edit your @handleEventHook@ by adding the 'serverModeEventHook':
|
||||
--
|
||||
-- > main = xmonad defaultConfig { handleEventHook = serverModeEventHook }
|
||||
--
|
||||
|
||||
data ServerMode = ServerMode deriving ( Show, Read )
|
||||
-- Then edit your @handleEventHook@ by adding the appropriate event hook from below
|
||||
|
||||
-- | Executes a command of the list when receiving its index via a special ClientMessageEvent
|
||||
-- (indexing starts at 1)
|
||||
-- (indexing starts at 1). Sending index 0 will ask xmonad to print the list of command numbers
|
||||
-- in stderr (so that you can read it in @~\/.xsession-errors@). Uses "XMonad.Actions.Commands#defaultCommands" as the default.
|
||||
--
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHook }
|
||||
--
|
||||
-- > xmonadctl 0 # tells xmonad to output command list
|
||||
-- > xmonadctl 1 # tells xmonad to switch to workspace 1
|
||||
--
|
||||
serverModeEventHook :: Event -> X All
|
||||
serverModeEventHook = serverModeEventHook' defaultCommands
|
||||
|
||||
-- | serverModeEventHook' additionally takes an action to generate the list of
|
||||
-- commands.
|
||||
serverModeEventHook' :: X [(String,X ())] -> Event -> X All
|
||||
serverModeEventHook' cmdAction (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
|
||||
d <- asks display
|
||||
a <- io $ internAtom d "XMONAD_COMMAND" False
|
||||
when (mt == a && dt /= []) $ do
|
||||
cl <- cmdAction
|
||||
let listOfCommands = map (uncurry (++)) . zip (map show ([1..] :: [Int])) . map ((++) " - " . fst)
|
||||
case lookup (fromIntegral (head dt) :: Int) (zip [1..] cl) of
|
||||
serverModeEventHook' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
|
||||
where helper cmd = do cl <- cmdAction
|
||||
case lookup cmd (zip (map show [1 :: Integer ..]) cl) of
|
||||
Just (_,action) -> action
|
||||
Nothing -> mapM_ (io . hPutStrLn stderr) . listOfCommands $ cl
|
||||
listOfCommands cl = map (uncurry (++)) $ zip (map show ([1..] :: [Int])) $ map ((++) " - " . fst) cl
|
||||
|
||||
|
||||
-- | Executes a command of the list when receiving its name via a special ClientMessageEvent.
|
||||
-- Uses "XMonad.Actions.Commands#defaultCommands" as the default.
|
||||
--
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHookCmd }
|
||||
--
|
||||
-- > xmonadctl run # Tells xmonad to generate a run prompt
|
||||
--
|
||||
serverModeEventHookCmd :: Event -> X All
|
||||
serverModeEventHookCmd = serverModeEventHookCmd' defaultCommands
|
||||
|
||||
-- | Additionally takes an action to generate the list of commands
|
||||
serverModeEventHookCmd' :: X [(String,X ())] -> Event -> X All
|
||||
serverModeEventHookCmd' cmdAction ev = serverModeEventHookF "XMONAD_COMMAND" (sequence_ . map helper . words) ev
|
||||
where helper cmd = do cl <- cmdAction
|
||||
fromMaybe (io $ hPutStrLn stderr ("Couldn't find command " ++ cmd)) (lookup cmd cl)
|
||||
|
||||
-- | Listens for an atom, then executes a callback function whenever it hears it.
|
||||
-- A trivial example that prints everything supplied to it on xmonad's standard out:
|
||||
--
|
||||
-- > main = xmonad def { handleEventHook = serverModeEventHookF "XMONAD_PRINT" (io . putStrLn) }
|
||||
--
|
||||
-- > xmonadctl -a XMONAD_PRINT "hello world"
|
||||
--
|
||||
serverModeEventHookF :: String -> (String -> X ()) -> Event -> X All
|
||||
serverModeEventHookF key func (ClientMessageEvent {ev_message_type = mt, ev_data = dt}) = do
|
||||
d <- asks display
|
||||
atm <- io $ internAtom d key False
|
||||
when (mt == atm && dt /= []) $ do
|
||||
let atom = fromIntegral $ toInteger $ foldr1 (\a b -> a + (b*2^(32::Int))) dt
|
||||
cmd <- io $ getAtomName d atom
|
||||
case cmd of
|
||||
Just command -> func command
|
||||
Nothing -> io $ hPutStrLn stderr ("Couldn't retrieve atom " ++ (show atom))
|
||||
return (All True)
|
||||
serverModeEventHook' _ _ = return (All True)
|
||||
serverModeEventHookF _ _ _ = return (All True)
|
||||
|
@@ -63,10 +63,11 @@ _pp n f s st = (\b -> guard b >> Just (st s)) <$> _get n f
|
||||
|
||||
{- The current state is kept here -}
|
||||
|
||||
data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable)
|
||||
data HookState = HookState { hooks :: Map String (Bool, Bool) } deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass HookState where
|
||||
initialValue = HookState empty
|
||||
extensionType = PersistentExtension
|
||||
|
||||
modify' :: String -> ((Bool, Bool) -> (Bool, Bool)) -> X ()
|
||||
modify' n f = XS.modify (HookState . setter . hooks)
|
||||
@@ -84,12 +85,12 @@ modify' n f = XS.modify (HookState . setter . hooks)
|
||||
-- and adding 'toggleHook name hook' to your 'ManageHook' where @name@ is the
|
||||
-- name of the hook and @hook@ is the hook to execute based on the state.
|
||||
--
|
||||
-- > myManageHook = toggleHook "float" doFloat <+> manageHook defaultConfig
|
||||
-- > myManageHook = toggleHook "float" doFloat <+> manageHook def
|
||||
--
|
||||
-- Additionally, toggleHook' is provided to toggle between two hooks (rather
|
||||
-- than on/off).
|
||||
--
|
||||
-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook defaultConfig
|
||||
-- > myManageHook = toggleHook' "oldfocus" (const id) W.focusWindow <+> manageHook def
|
||||
--
|
||||
-- The 'hookNext' and 'toggleHookNext' functions can be used in key
|
||||
-- bindings to set whether the hook is applied or not.
|
||||
|
@@ -59,7 +59,9 @@ module XMonad.Hooks.UrgencyHook (
|
||||
dzenUrgencyHook,
|
||||
DzenUrgencyHook(..),
|
||||
NoUrgencyHook(..),
|
||||
BorderUrgencyHook(..),
|
||||
FocusHook(..),
|
||||
filterUrgencyHook,
|
||||
minutes, seconds,
|
||||
-- * Stuff for developers:
|
||||
readUrgents, withUrgents,
|
||||
@@ -67,6 +69,7 @@ module XMonad.Hooks.UrgencyHook (
|
||||
SpawnUrgencyHook(..),
|
||||
UrgencyHook(urgencyHook),
|
||||
Interval,
|
||||
borderUrgencyHook, focusHook, spawnUrgencyHook, stdoutUrgencyHook
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -76,13 +79,16 @@ import XMonad.Util.Dzen (dzenWithArgs, seconds)
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
import XMonad.Util.NamedWindows (getName)
|
||||
import XMonad.Util.Timer (TimerId, startTimer, handleTimer)
|
||||
import XMonad.Util.WindowProperties (getProp32)
|
||||
|
||||
import Control.Applicative ((<$>))
|
||||
import Control.Monad (when)
|
||||
import Data.Bits (testBit)
|
||||
import Data.List (delete, (\\))
|
||||
import Data.Maybe (listToMaybe, maybeToList)
|
||||
import Data.Maybe (listToMaybe, maybeToList, fromMaybe)
|
||||
import qualified Data.Set as S
|
||||
import System.IO (hPutStrLn, stderr)
|
||||
import Foreign.C.Types (CLong)
|
||||
|
||||
-- $usage
|
||||
--
|
||||
@@ -101,7 +107,7 @@ import qualified Data.Set as S
|
||||
-- 'withUrgencyHook'. For example:
|
||||
--
|
||||
-- > main = xmonad $ withUrgencyHook dzenUrgencyHook { args = ["-bg", "darkgreen", "-xs", "1"] }
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- This will pop up a dzen bar for five seconds telling you you've got an
|
||||
-- urgent window.
|
||||
@@ -113,7 +119,7 @@ import qualified Data.Set as S
|
||||
-- extra popup, install NoUrgencyHook, as so:
|
||||
--
|
||||
-- > main = xmonad $ withUrgencyHook NoUrgencyHook
|
||||
-- > $ defaultConfig
|
||||
-- > $ def
|
||||
--
|
||||
-- Now, your "XMonad.Hooks.DynamicLog" must be set up to display the urgent
|
||||
-- windows. If you're using the 'dzen' or 'dzenPP' functions from that module,
|
||||
@@ -254,7 +260,7 @@ minutes secs = secs * 60
|
||||
|
||||
-- | The default 'UrgencyConfig'. suppressWhen = Visible, remindWhen = Dont.
|
||||
-- Use a variation of this in your config just as you use a variation of
|
||||
-- defaultConfig for your xmonad definition.
|
||||
-- 'def' for your xmonad definition.
|
||||
urgencyConfig :: UrgencyConfig
|
||||
urgencyConfig = UrgencyConfig { suppressWhen = Visible, remindWhen = Dont }
|
||||
|
||||
@@ -307,12 +313,34 @@ readReminders = XS.get
|
||||
adjustReminders :: ([Reminder] -> [Reminder]) -> X ()
|
||||
adjustReminders = XS.modify
|
||||
|
||||
clearUrgency :: Window -> X ()
|
||||
clearUrgency w = adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
|
||||
|
||||
data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
|
||||
deriving (Read, Show)
|
||||
|
||||
-- | Change the _NET_WM_STATE property by applying a function to the list of atoms.
|
||||
changeNetWMState :: Display -> Window -> ([CLong] -> [CLong]) -> X ()
|
||||
changeNetWMState dpy w f = do
|
||||
wmstate <- getAtom "_NET_WM_STATE"
|
||||
wstate <- fromMaybe [] `fmap` getProp32 wmstate w
|
||||
let ptype = 4 -- atom property type for changeProperty
|
||||
io $ changeProperty32 dpy w wmstate ptype propModeReplace (f wstate)
|
||||
return ()
|
||||
|
||||
-- | Add an atom to the _NET_WM_STATE property.
|
||||
addNetWMState :: Display -> Window -> Atom -> X ()
|
||||
addNetWMState dpy w atom = changeNetWMState dpy w $ ((fromIntegral atom):)
|
||||
|
||||
-- | Remove an atom from the _NET_WM_STATE property.
|
||||
removeNetWMState :: Display -> Window -> Atom -> X ()
|
||||
removeNetWMState dpy w atom = changeNetWMState dpy w $ delete (fromIntegral atom)
|
||||
|
||||
-- | Get the _NET_WM_STATE propertly as a [CLong]
|
||||
getNetWMState :: Window -> X [CLong]
|
||||
getNetWMState w = do
|
||||
a_wmstate <- getAtom "_NET_WM_STATE"
|
||||
fromMaybe [] `fmap` getProp32 a_wmstate w
|
||||
|
||||
|
||||
-- The Non-ICCCM Manifesto:
|
||||
-- Note: Some non-standard choices have been made in this implementation to
|
||||
-- account for the fact that things are different in a tiling window manager:
|
||||
@@ -328,20 +356,40 @@ data WithUrgencyHook h = WithUrgencyHook h UrgencyConfig
|
||||
handleEvent :: UrgencyHook h => WithUrgencyHook h -> Event -> X ()
|
||||
handleEvent wuh event =
|
||||
case event of
|
||||
-- WM_HINTS urgency flag
|
||||
PropertyEvent { ev_event_type = t, ev_atom = a, ev_window = w } -> do
|
||||
when (t == propertyNotify && a == wM_HINTS) $ withDisplay $ \dpy -> do
|
||||
WMHints { wmh_flags = flags } <- io $ getWMHints dpy w
|
||||
if (testBit flags urgencyHintBit) then do
|
||||
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
|
||||
callUrgencyHook wuh w
|
||||
else
|
||||
clearUrgency w
|
||||
userCodeDef () =<< asks (logHook . config)
|
||||
if (testBit flags urgencyHintBit) then markUrgent w else markNotUrgent w
|
||||
-- Window destroyed
|
||||
DestroyWindowEvent {ev_window = w} ->
|
||||
clearUrgency w
|
||||
markNotUrgent w
|
||||
-- _NET_WM_STATE_DEMANDS_ATTENTION requested by client
|
||||
ClientMessageEvent {ev_event_display = dpy, ev_window = w, ev_message_type = t, ev_data = action:atoms} -> do
|
||||
a_wmstate <- getAtom "_NET_WM_STATE"
|
||||
a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
|
||||
wstate <- getNetWMState w
|
||||
let demandsAttention = fromIntegral a_da `elem` wstate
|
||||
remove = 0
|
||||
add = 1
|
||||
toggle = 2
|
||||
when (t == a_wmstate && fromIntegral a_da `elem` atoms) $ do
|
||||
when (action == add || (action == toggle && not demandsAttention)) $ do
|
||||
markUrgent w
|
||||
addNetWMState dpy w a_da
|
||||
when (action == remove || (action == toggle && demandsAttention)) $ do
|
||||
markNotUrgent w
|
||||
removeNetWMState dpy w a_da
|
||||
_ ->
|
||||
mapM_ handleReminder =<< readReminders
|
||||
where handleReminder reminder = handleTimer (timer reminder) event $ reminderHook wuh reminder
|
||||
markUrgent w = do
|
||||
adjustUrgents (\ws -> if elem w ws then ws else w : ws)
|
||||
callUrgencyHook wuh w
|
||||
userCodeDef () =<< asks (logHook . config)
|
||||
markNotUrgent w = do
|
||||
adjustUrgents (delete w) >> adjustReminders (filter $ (w /=) . window)
|
||||
userCodeDef () =<< asks (logHook . config)
|
||||
|
||||
callUrgencyHook :: UrgencyHook h => WithUrgencyHook h -> Window -> X ()
|
||||
callUrgencyHook (WithUrgencyHook hook UrgencyConfig { suppressWhen = sw, remindWhen = rw }) w =
|
||||
@@ -375,6 +423,9 @@ shouldSuppress sw w = elem w <$> suppressibleWindows sw
|
||||
cleanupUrgents :: SuppressWhen -> X ()
|
||||
cleanupUrgents sw = do
|
||||
sw' <- suppressibleWindows sw
|
||||
a_da <- getAtom "_NET_WM_STATE_DEMANDS_ATTENTION"
|
||||
dpy <- withDisplay (\dpy -> return dpy)
|
||||
mapM_ (\w -> removeNetWMState dpy w a_da) sw'
|
||||
adjustUrgents (\\ sw') >> adjustReminders (filter $ ((`notElem` sw') . window))
|
||||
|
||||
suppressibleWindows :: SuppressWhen -> X [Window]
|
||||
@@ -388,9 +439,12 @@ suppressibleWindows Never = return []
|
||||
|
||||
-- | The class definition, and some pre-defined instances.
|
||||
|
||||
class (Read h, Show h) => UrgencyHook h where
|
||||
class UrgencyHook h where
|
||||
urgencyHook :: h -> Window -> X ()
|
||||
|
||||
instance UrgencyHook (Window -> X ()) where
|
||||
urgencyHook = id
|
||||
|
||||
data NoUrgencyHook = NoUrgencyHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook NoUrgencyHook where
|
||||
@@ -418,11 +472,40 @@ instance UrgencyHook DzenUrgencyHook where
|
||||
|
||||
> withUrgencyHook FocusHook $ myconfig { ...
|
||||
-}
|
||||
focusHook :: Window -> X ()
|
||||
focusHook = urgencyHook FocusHook
|
||||
data FocusHook = FocusHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook FocusHook where
|
||||
urgencyHook _ _ = focusUrgent
|
||||
|
||||
-- | A hook that sets the border color of an urgent window. The color
|
||||
-- will remain until the next time the window gains or loses focus, at
|
||||
-- which point the standard border color from the XConfig will be applied.
|
||||
-- You may want to use suppressWhen = Never with this:
|
||||
--
|
||||
-- > withUrgencyHookC BorderUrgencyHook { urgencyBorderColor = "#ff0000" } urgencyConfig { suppressWhen = Never } ...
|
||||
--
|
||||
-- (This should be @urgentBorderColor@ but that breaks "XMonad.Layout.Decoration".
|
||||
-- @borderColor@ breaks anyone using 'XPConfig' from "XMonad.Prompt". We need to
|
||||
-- think a bit more about namespacing issues, maybe.)
|
||||
|
||||
borderUrgencyHook :: String -> Window -> X ()
|
||||
borderUrgencyHook = urgencyHook . BorderUrgencyHook
|
||||
data BorderUrgencyHook = BorderUrgencyHook { urgencyBorderColor :: !String }
|
||||
deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook BorderUrgencyHook where
|
||||
urgencyHook BorderUrgencyHook { urgencyBorderColor = cs } w =
|
||||
withDisplay $ \dpy -> io $ do
|
||||
c' <- initColor dpy cs
|
||||
case c' of
|
||||
Just c -> setWindowBorder dpy w c
|
||||
_ -> hPutStrLn stderr $ concat ["Warning: bad urgentBorderColor "
|
||||
,show cs
|
||||
," in BorderUrgencyHook"
|
||||
]
|
||||
|
||||
-- | Flashes when a window requests your attention and you can't see it.
|
||||
-- Defaults to a duration of five seconds, and no extra args to dzen.
|
||||
-- See 'DzenUrgencyHook'.
|
||||
@@ -432,13 +515,32 @@ dzenUrgencyHook = DzenUrgencyHook { duration = seconds 5, args = [] }
|
||||
-- | Spawn a commandline thing, appending the window id to the prefix string
|
||||
-- you provide. (Make sure to add a space if you need it.) Do your crazy
|
||||
-- xcompmgr thing.
|
||||
spawnUrgencyHook :: String -> Window -> X ()
|
||||
spawnUrgencyHook = urgencyHook . SpawnUrgencyHook
|
||||
newtype SpawnUrgencyHook = SpawnUrgencyHook String deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook SpawnUrgencyHook where
|
||||
urgencyHook (SpawnUrgencyHook prefix) w = spawn $ prefix ++ show w
|
||||
|
||||
-- | For debugging purposes, really.
|
||||
stdoutUrgencyHook :: Window -> X ()
|
||||
stdoutUrgencyHook = urgencyHook StdoutUrgencyHook
|
||||
data StdoutUrgencyHook = StdoutUrgencyHook deriving (Read, Show)
|
||||
|
||||
instance UrgencyHook StdoutUrgencyHook where
|
||||
urgencyHook _ w = io $ putStrLn $ "Urgent: " ++ show w
|
||||
|
||||
-- | urgencyhook such that windows on certain workspaces
|
||||
-- never get urgency set.
|
||||
--
|
||||
-- Useful for scratchpad workspaces perhaps:
|
||||
--
|
||||
-- > main = xmonad (withUrgencyHook (filterUrgencyHook ["NSP", "SP"]) defaultConfig)
|
||||
filterUrgencyHook :: [WorkspaceId] -> Window -> X ()
|
||||
filterUrgencyHook skips w = do
|
||||
ws <- gets windowset
|
||||
case W.findTag w ws of
|
||||
Just tag -> when (tag `elem` skips)
|
||||
$ adjustUrgents (delete w)
|
||||
_ -> return ()
|
||||
|
||||
|
223
XMonad/Hooks/WallpaperSetter.hs
Normal file
223
XMonad/Hooks/WallpaperSetter.hs
Normal file
@@ -0,0 +1,223 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
-----------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.WallpaperSetter
|
||||
-- Copyright : (c) Anton Pirogov, 2014
|
||||
-- License : BSD3
|
||||
--
|
||||
-- Maintainer : Anton Pirogov <anton.pirogov@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Log hook which changes the wallpapers depending on visible workspaces.
|
||||
-----------------------------------
|
||||
module XMonad.Hooks.WallpaperSetter (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
wallpaperSetter
|
||||
, WallpaperConf(..)
|
||||
, Wallpaper(..)
|
||||
, WallpaperList(..)
|
||||
, defWallpaperConf
|
||||
, defWPNames
|
||||
-- *TODO
|
||||
-- $todo
|
||||
) where
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as S
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
import System.IO
|
||||
import System.Process
|
||||
import System.Directory (getHomeDirectory, doesFileExist, doesDirectoryExist, getDirectoryContents)
|
||||
import System.FilePath ((</>))
|
||||
import System.Random (randomRIO)
|
||||
|
||||
import qualified Data.Map as M
|
||||
import Data.List (intersperse, sortBy)
|
||||
import Data.Char (isAlphaNum)
|
||||
import Data.Ord (comparing)
|
||||
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
|
||||
-- $usage
|
||||
-- This module requires imagemagick and feh to be installed, as these are utilized
|
||||
-- for the required image transformations and the actual setting of the wallpaper.
|
||||
--
|
||||
-- This was especially tested with multi-head setups - if you have two monitors and swap
|
||||
-- the workspaces, the wallpapers will be swapped too, scaled accordingly and rotated if necessary
|
||||
-- (e.g. if you are using your monitor rotated but only have wide wallpapers).
|
||||
--
|
||||
-- Add a log hook like this:
|
||||
--
|
||||
-- > myWorkspaces = ["1:main","2:misc","3","4"]
|
||||
-- > ...
|
||||
-- > main = xmonad $ defaultConfig {
|
||||
-- > logHook = wallpaperSetter defWallpaperConf {
|
||||
-- > wallpapers = defWPNames myWorkspaces
|
||||
-- > <> WallpaperList [("1:main",WallpaperDir "1")]
|
||||
-- > }
|
||||
-- > }
|
||||
-- > ...
|
||||
|
||||
-- $todo
|
||||
-- * implement a kind of image cache like in wallpaperd to remove or at least reduce the lag
|
||||
--
|
||||
-- * find out how to merge multiple images from stdin to one (-> for caching all pictures in memory)
|
||||
|
||||
-- | internal. to use XMonad state for memory in-between log-hook calls and remember PID of old external call
|
||||
data WCState = WCState (Maybe [WorkspaceId]) (Maybe ProcessHandle) deriving Typeable
|
||||
instance ExtensionClass WCState where
|
||||
initialValue = WCState Nothing Nothing
|
||||
|
||||
-- | Represents a wallpaper
|
||||
data Wallpaper = WallpaperFix FilePath -- ^ Single, fixed wallpaper
|
||||
| WallpaperDir FilePath -- ^ Random wallpaper from this subdirectory
|
||||
deriving (Eq, Show, Read)
|
||||
|
||||
newtype WallpaperList = WallpaperList [(WorkspaceId, Wallpaper)]
|
||||
deriving (Show,Read)
|
||||
|
||||
instance Monoid WallpaperList where
|
||||
mempty = WallpaperList []
|
||||
mappend (WallpaperList w1) (WallpaperList w2) =
|
||||
WallpaperList $ M.toList $ (M.fromList w2) `M.union` (M.fromList w1)
|
||||
|
||||
-- | Complete wallpaper configuration passed to the hook
|
||||
data WallpaperConf = WallpaperConf {
|
||||
wallpaperBaseDir :: FilePath -- ^ Where the wallpapers reside (if empty, will look in \~\/.wallpapers/)
|
||||
, wallpapers :: WallpaperList -- ^ List of the wallpaper associations for workspaces
|
||||
} deriving (Show, Read)
|
||||
|
||||
-- | default configuration. looks in \~\/.wallpapers/ for WORKSPACEID.jpg
|
||||
defWallpaperConf :: WallpaperConf
|
||||
defWallpaperConf = WallpaperConf "" $ WallpaperList []
|
||||
|
||||
instance Default WallpaperConf where
|
||||
def = defWallpaperConf
|
||||
|
||||
-- |returns the default association list (maps name to name.jpg, non-alphanumeric characters are omitted)
|
||||
defWPNames :: [WorkspaceId] -> WallpaperList
|
||||
defWPNames xs = WallpaperList $ map (\x -> (x,WallpaperFix (filter isAlphaNum x++".jpg"))) xs
|
||||
|
||||
-- | Add this to your log hook with the workspace configuration as argument.
|
||||
wallpaperSetter :: WallpaperConf -> X ()
|
||||
wallpaperSetter wpconf = do
|
||||
WCState oldws h <- XS.get
|
||||
visws <- getVisibleWorkspaces
|
||||
when (Just visws /= oldws) $ do
|
||||
|
||||
wpconf' <- completeWPConf wpconf
|
||||
wspicpaths <- getPicPathsAndWSRects wpconf'
|
||||
|
||||
-- terminate old call if any to prevent unnecessary CPU overload when switching WS too fast
|
||||
case h of
|
||||
Nothing -> return ()
|
||||
Just pid -> liftIO $ terminateProcess pid
|
||||
|
||||
handle <- applyWallpaper wspicpaths
|
||||
XS.put $ WCState (Just visws) $ Just handle
|
||||
|
||||
-- Helper functions
|
||||
-------------------
|
||||
|
||||
-- | Picks a random element from a list
|
||||
pickFrom :: [a] -> IO a
|
||||
pickFrom list = do
|
||||
i <- randomRIO (0,length list - 1)
|
||||
return $ list !! i
|
||||
|
||||
-- | get absolute picture path of the given wallpaper picture
|
||||
-- or select a random one if it is a directory
|
||||
getPicPath :: WallpaperConf -> Wallpaper -> IO (Maybe FilePath)
|
||||
getPicPath conf (WallpaperDir dir) = do
|
||||
direxists <- doesDirectoryExist $ wallpaperBaseDir conf </> dir
|
||||
if direxists
|
||||
then do files <- getDirectoryContents $ wallpaperBaseDir conf </> dir
|
||||
let files' = filter ((/='.').head) files
|
||||
file <- pickFrom files'
|
||||
return $ Just $ wallpaperBaseDir conf </> dir </> file
|
||||
else return Nothing
|
||||
getPicPath conf (WallpaperFix file) = do
|
||||
exist <- doesFileExist path
|
||||
return $ if exist then Just path else Nothing
|
||||
where path = wallpaperBaseDir conf </> file
|
||||
|
||||
-- | Take a path to a picture, return (width, height) if the path is a valid picture
|
||||
-- (requires imagemagick tool identify to be installed)
|
||||
getPicRes :: FilePath -> IO (Maybe (Int,Int))
|
||||
getPicRes picpath = do
|
||||
(_, Just outh,_,_pid) <- createProcess $ (proc "identify" ["-format", "%w %h", picpath]) { std_out = CreatePipe }
|
||||
output <- hGetContents outh
|
||||
return $ case map reads (words output) of
|
||||
-- mapM Text.Read.readMaybe is better but only in ghc>=7.6
|
||||
[[(w,"")],[(h,"")]] -> Just (w,h)
|
||||
_ -> Nothing
|
||||
|
||||
|
||||
-- |complete unset fields to default values (wallpaper directory = ~/.wallpapers,
|
||||
-- expects a file "NAME.jpg" for each workspace named NAME)
|
||||
completeWPConf :: WallpaperConf -> X WallpaperConf
|
||||
completeWPConf (WallpaperConf dir (WallpaperList ws)) = do
|
||||
home <- liftIO getHomeDirectory
|
||||
winset <- gets windowset
|
||||
let tags = map S.tag $ S.workspaces winset
|
||||
dir' = if null dir then home </> ".wallpapers" else dir
|
||||
ws' = if null ws then defWPNames tags else WallpaperList ws
|
||||
return (WallpaperConf dir' ws')
|
||||
|
||||
getVisibleWorkspaces :: X [WorkspaceId]
|
||||
getVisibleWorkspaces = do
|
||||
winset <- gets windowset
|
||||
return $ map (S.tag . S.workspace) . sortBy (comparing S.screen) $ S.current winset : S.visible winset
|
||||
|
||||
getPicPathsAndWSRects :: WallpaperConf -> X [(Rectangle, FilePath)]
|
||||
getPicPathsAndWSRects wpconf = do
|
||||
winset <- gets windowset
|
||||
paths <- liftIO getPicPaths
|
||||
visws <- getVisibleWorkspaces
|
||||
let visscr = S.current winset : S.visible winset
|
||||
visrects = M.fromList $ map (\x -> ((S.tag . S.workspace) x, S.screenDetail x)) visscr
|
||||
hasPicAndIsVisible (n, mp) = n `elem` visws && (isJust mp)
|
||||
getRect tag = screenRect $ fromJust $ M.lookup tag visrects
|
||||
foundpaths = map (\(n,Just p)->(getRect n,p)) $ filter hasPicAndIsVisible paths
|
||||
return foundpaths
|
||||
where getPicPaths = mapM (\(x,y) -> getPicPath wpconf y
|
||||
>>= \p -> return (x,p)) wl
|
||||
WallpaperList wl = wallpapers wpconf
|
||||
|
||||
-- | Gets a list of geometry rectangles and filenames, builds and sets wallpaper
|
||||
applyWallpaper :: [(Rectangle, FilePath)] -> X ProcessHandle
|
||||
applyWallpaper parts = do
|
||||
winset <- gets windowset
|
||||
let (vx,vy) = getVScreenDim winset
|
||||
layers <- liftIO $ mapM layerCommand parts
|
||||
let basepart ="convert -size "++show vx++"x"++show vy++" xc:black "
|
||||
endpart =" jpg:- | feh --no-xinerama --bg-tile --no-fehbg -"
|
||||
cmd = basepart ++ (concat $ intersperse " " layers) ++ endpart
|
||||
liftIO $ runCommand cmd
|
||||
|
||||
|
||||
getVScreenDim :: S.StackSet i l a sid ScreenDetail -> (Integer, Integer)
|
||||
getVScreenDim = foldr maxXY (0,0) . map (screenRect . S.screenDetail) . S.screens
|
||||
where maxXY (Rectangle x y w h) (mx,my) = ( fromIntegral ((fromIntegral x)+w) `max` mx
|
||||
, fromIntegral ((fromIntegral y)+h) `max` my )
|
||||
|
||||
needsRotation :: Rectangle -> (Int,Int) -> Bool
|
||||
needsRotation rect (px,py) = let wratio, pratio :: Double
|
||||
wratio = (fromIntegral $ rect_width rect) / (fromIntegral $ rect_height rect)
|
||||
pratio = fromIntegral px / fromIntegral py
|
||||
in wratio > 1 && pratio < 1 || wratio < 1 && pratio > 1
|
||||
|
||||
layerCommand :: (Rectangle, FilePath) -> IO String
|
||||
layerCommand (rect, path) = do
|
||||
res <- getPicRes path
|
||||
return $ case needsRotation rect <$> res of
|
||||
Nothing -> ""
|
||||
Just rotate ->
|
||||
" \\( '"++path++"' "++(if rotate then "-rotate 90 " else "")
|
||||
++ " -scale "++(show$rect_width rect)++"x"++(show$rect_height rect)++"! \\)"
|
||||
++ " -geometry +"++(show$rect_x rect)++"+"++(show$rect_y rect)++" -composite "
|
@@ -33,9 +33,9 @@ import Control.Monad.Error ((<=<),guard,lift,runErrorT,throwError)
|
||||
--
|
||||
-- > import XMonad.Hooks.WorkspaceByPos
|
||||
-- >
|
||||
-- > myManageHook = workspaceByPos <+> manageHook defaultConfig
|
||||
-- > myManageHook = workspaceByPos <+> manageHook def
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { manageHook = myManageHook }
|
||||
-- > main = xmonad def { manageHook = myManageHook }
|
||||
|
||||
workspaceByPos :: ManageHook
|
||||
workspaceByPos = (maybe idHook doShift <=< liftX . needsMoving) =<< ask
|
||||
|
74
XMonad/Hooks/WorkspaceHistory.hs
Normal file
74
XMonad/Hooks/WorkspaceHistory.hs
Normal file
@@ -0,0 +1,74 @@
|
||||
{-# LANGUAGE DeriveDataTypeable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Hooks.WorkspaceHistory
|
||||
-- Copyright : (c) 2013 Dmitri Iouchtchenko
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Dmitri Iouchtchenko <johnnyspoon@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Keeps track of workspace viewing order.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Hooks.WorkspaceHistory
|
||||
( -- * Usage
|
||||
-- $usage
|
||||
|
||||
-- * Hooking
|
||||
workspaceHistoryHook
|
||||
|
||||
-- * Querying
|
||||
, workspaceHistory
|
||||
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.StackSet (currentTag)
|
||||
import qualified XMonad.Util.ExtensibleState as XS
|
||||
|
||||
-- $usage
|
||||
-- To record the order in which you view workspaces, you can use this
|
||||
-- module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Hooks.WorkspaceHistory (workspaceHistoryHook)
|
||||
--
|
||||
-- Then add the hook to your 'logHook':
|
||||
--
|
||||
-- > main = xmonad $ def
|
||||
-- > { ...
|
||||
-- > , logHook = ... >> workspaceHistoryHook >> ...
|
||||
-- > , ...
|
||||
-- > }
|
||||
--
|
||||
-- To make use of the collected data, a query function is provided.
|
||||
|
||||
data WorkspaceHistory =
|
||||
WorkspaceHistory { history :: [WorkspaceId] -- ^ Workspaces in reverse-chronological order.
|
||||
}
|
||||
deriving (Typeable, Read, Show)
|
||||
|
||||
instance ExtensionClass WorkspaceHistory where
|
||||
initialValue = WorkspaceHistory []
|
||||
extensionType = PersistentExtension
|
||||
|
||||
-- | A 'logHook' that keeps track of the order in which workspaces have
|
||||
-- been viewed.
|
||||
workspaceHistoryHook :: X ()
|
||||
workspaceHistoryHook = gets (currentTag . windowset) >>= (XS.modify . makeFirst)
|
||||
|
||||
-- | A list of workspace tags in the order they have been viewed, with the
|
||||
-- most recent first. No duplicates are present, but not all workspaces are
|
||||
-- guaranteed to appear, and there may be workspaces that no longer exist.
|
||||
workspaceHistory :: X [WorkspaceId]
|
||||
workspaceHistory = XS.gets history
|
||||
|
||||
|
||||
-- | Cons the 'WorkspaceId' onto the 'WorkspaceHistory' if it is not
|
||||
-- already there, or move it to the front if it is.
|
||||
makeFirst :: WorkspaceId -> WorkspaceHistory -> WorkspaceHistory
|
||||
makeFirst w v = let (xs, ys) = break (w ==) $ history v
|
||||
in v { history = w : (xs ++ drop 1 ys) }
|
@@ -18,8 +18,7 @@ module XMonad.Hooks.XPropManage (
|
||||
xPropManageHook, XPropMatch, pmX, pmP
|
||||
) where
|
||||
|
||||
import Prelude hiding (catch)
|
||||
import Control.Exception
|
||||
import Control.Exception as E
|
||||
import Data.Char (chr)
|
||||
import Data.Monoid (mconcat, Endo(..))
|
||||
|
||||
@@ -76,7 +75,7 @@ xPropManageHook tms = mconcat $ map propToHook tms
|
||||
|
||||
getProp :: Display -> Window -> Atom -> X ([String])
|
||||
getProp d w p = do
|
||||
prop <- io $ catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
|
||||
prop <- io $ E.catch (getTextProperty d w p >>= wcTextPropertyToTextList d) (\(_ :: IOException) -> return [[]])
|
||||
let filt q | q == wM_COMMAND = concat . map splitAtNull
|
||||
| otherwise = id
|
||||
return (filt p prop)
|
||||
|
@@ -31,7 +31,7 @@ import Data.Ratio
|
||||
-- Then edit your @layoutHook@ by adding the Accordion layout:
|
||||
--
|
||||
-- > myLayout = Accordion ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
239
XMonad/Layout/AvoidFloats.hs
Normal file
239
XMonad/Layout/AvoidFloats.hs
Normal file
@@ -0,0 +1,239 @@
|
||||
{-# LANGUAGE PatternGuards, FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, TypeSynonymInstances, ParallelListComp, DeriveDataTypeable #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.AvoidFloats
|
||||
-- Copyright : (c) 2014 Anders Engstrom <ankaan@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : (c) Anders Engstrom <ankaan@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Find a maximum empty rectangle around floating windows and use that area
|
||||
-- to display non-floating windows.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.AvoidFloats (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
avoidFloats,
|
||||
avoidFloats',
|
||||
AvoidFloatMsg(..),
|
||||
AvoidFloatItemMsg(..),
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import XMonad.Layout.LayoutModifier
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Data.List
|
||||
import Data.Ord
|
||||
import Data.Maybe
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your ~\/.xmonad\/xmonad.hs file:
|
||||
--
|
||||
-- > import XMonad.Layout.AvoidFloats
|
||||
--
|
||||
-- and modify the layouts to call avoidFloats on the layouts where you want the
|
||||
-- non-floating windows to not be behind floating windows.
|
||||
--
|
||||
-- > layoutHook = ... ||| avoidFloats Full ||| ...
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
-- "XMonad.Doc.Extending#Editing_the_layout_hook"
|
||||
--
|
||||
-- Then add appropriate key bindings, for example:
|
||||
--
|
||||
-- > ,((modm .|. shiftMask, xK_b), sendMessage AvoidFloatToggle)
|
||||
-- > ,((modm .|. controlMask, xK_b), withFocused $ sendMessage . AvoidFloatToggleItem)
|
||||
-- > ,((modm .|. shiftMask .|. controlMask, xK_b), sendMessage (AvoidFloatSet False) >> sendMessage AvoidFloatClearItems)
|
||||
--
|
||||
-- For detailed instructions on editing your key bindings, see
|
||||
-- "XMonad.Doc.Extending#Editing_key_bindings".
|
||||
--
|
||||
-- Note that this module is incompatible with an old way of configuring
|
||||
-- "XMonad.Actions.FloatSnap". If you are having problems, please update your
|
||||
-- configuration.
|
||||
|
||||
-- | Avoid floating windows unless the resulting area for windows would be too small.
|
||||
-- In that case, use the whole screen as if this layout modifier wasn't there.
|
||||
-- No windows are avoided by default, they need to be added using signals.
|
||||
avoidFloats
|
||||
:: l a -- ^ Layout to modify.
|
||||
-> ModifiedLayout AvoidFloats l a
|
||||
avoidFloats = avoidFloats' 100 100 False
|
||||
|
||||
-- | Avoid floating windows unless the resulting area for windows would be too small.
|
||||
-- In that case, use the whole screen as if this layout modifier wasn't there.
|
||||
avoidFloats'
|
||||
:: Int -- ^ Minimum width of the area used for non-floating windows.
|
||||
-> Int -- ^ Minimum height of the area used for non-floating windows.
|
||||
-> Bool -- ^ If floating windows should be avoided by default.
|
||||
-> l a -- ^ Layout to modify.
|
||||
-> ModifiedLayout AvoidFloats l a
|
||||
avoidFloats' w h act = ModifiedLayout (AvoidFloats Nothing S.empty w h act)
|
||||
|
||||
data AvoidFloats a = AvoidFloats
|
||||
{ cache :: Maybe ((M.Map a W.RationalRect, Rectangle), Rectangle)
|
||||
, chosen :: S.Set a
|
||||
, minw :: Int
|
||||
, minh :: Int
|
||||
, avoidAll :: Bool
|
||||
} deriving (Read, Show)
|
||||
|
||||
-- | Change the state of the whole avoid float layout modifier.
|
||||
data AvoidFloatMsg
|
||||
= AvoidFloatToggle -- ^ Toggle between avoiding all or only selected.
|
||||
| AvoidFloatSet Bool -- ^ Set if all all floating windows should be avoided.
|
||||
| AvoidFloatClearItems -- ^ Clear the set of windows to specifically avoid.
|
||||
deriving (Typeable)
|
||||
|
||||
|
||||
-- | Change the state of the avoid float layout modifier conserning a specific window.
|
||||
data AvoidFloatItemMsg a
|
||||
= AvoidFloatAddItem a -- ^ Add a window to always avoid.
|
||||
| AvoidFloatRemoveItem a -- ^ Stop always avoiding selected window.
|
||||
| AvoidFloatToggleItem a -- ^ Toggle between always avoiding selected window.
|
||||
deriving (Typeable)
|
||||
|
||||
instance Message AvoidFloatMsg
|
||||
instance Typeable a => Message (AvoidFloatItemMsg a)
|
||||
|
||||
instance LayoutModifier AvoidFloats Window where
|
||||
modifyLayoutWithUpdate lm w r = withDisplay $ \d -> do
|
||||
floating <- gets $ W.floating . windowset
|
||||
case cache lm of
|
||||
Just (key, mer) | key == (floating,r) -> flip (,) Nothing `fmap` runLayout w mer
|
||||
_ -> do rs <- io $ map toRect `fmap` mapM (getWindowAttributes d) (filter shouldAvoid $ M.keys floating)
|
||||
let mer = maximumBy (comparing area) $ filter bigEnough $ maxEmptyRectangles r rs
|
||||
flip (,) (Just $ pruneWindows $ lm { cache = Just ((floating,r),mer) }) `fmap` runLayout w mer
|
||||
where
|
||||
toRect :: WindowAttributes -> Rectangle
|
||||
toRect wa = let b = fi $ wa_border_width wa
|
||||
in Rectangle (fi $ wa_x wa) (fi $ wa_y wa) (fi $ wa_width wa + 2*b) (fi $ wa_height wa + 2*b)
|
||||
|
||||
bigEnough :: Rectangle -> Bool
|
||||
bigEnough rect = rect_width rect >= fi (minw lm) && rect_height rect >= fi (minh lm)
|
||||
|
||||
shouldAvoid a = avoidAll lm || a `S.member` chosen lm
|
||||
|
||||
pureMess lm m
|
||||
| Just (AvoidFloatToggle) <- fromMessage m = Just $ lm { avoidAll = not (avoidAll lm), cache = Nothing }
|
||||
| Just (AvoidFloatSet s) <- fromMessage m, s /= avoidAll lm = Just $ lm { avoidAll = s, cache = Nothing }
|
||||
| Just (AvoidFloatClearItems) <- fromMessage m = Just $ lm { chosen = S.empty, cache = Nothing }
|
||||
| Just (AvoidFloatAddItem a) <- fromMessage m, a `S.notMember` chosen lm = Just $ lm { chosen = S.insert a (chosen lm), cache = Nothing }
|
||||
| Just (AvoidFloatRemoveItem a) <- fromMessage m, a `S.member` chosen lm = Just $ lm { chosen = S.delete a (chosen lm), cache = Nothing }
|
||||
| Just (AvoidFloatToggleItem a) <- fromMessage m = let op = if a `S.member` chosen lm then S.delete else S.insert
|
||||
in Just $ lm { chosen = op a (chosen lm), cache = Nothing }
|
||||
| otherwise = Nothing
|
||||
|
||||
pruneWindows :: AvoidFloats Window -> AvoidFloats Window
|
||||
pruneWindows lm = case cache lm of
|
||||
Nothing -> lm
|
||||
Just ((floating,_),_) -> lm { chosen = S.filter (flip M.member floating) (chosen lm) }
|
||||
|
||||
-- | Find all maximum empty rectangles (MERs) that are axis aligned. This is
|
||||
-- done in O(n^2) time using a modified version of the algoprithm MERAlg 1
|
||||
-- described in \"On the maximum empty rectangle problem\" by A. Naamad, D.T.
|
||||
-- Lee and W.-L HSU. Published in Discrete Applied Mathematics 8 (1984.)
|
||||
maxEmptyRectangles :: Rectangle -> [Rectangle] -> [Rectangle]
|
||||
maxEmptyRectangles br rectangles = filter (\a -> area a > 0) $ upAndDownEdge ++ noneOrUpEdge ++ downEdge
|
||||
where
|
||||
upAndDownEdge = findGaps br rectangles
|
||||
noneOrUpEdge = concat $ map (everyLower br bottoms) bottoms
|
||||
downEdge = concat $ map maybeToList $ map (bottomEdge br bottoms) bottoms
|
||||
bottoms = sortBy (comparing bottom) $ splitContainers rectangles
|
||||
|
||||
everyLower :: Rectangle -> [Rectangle] -> Rectangle -> [Rectangle]
|
||||
everyLower br bottoms r = let (rs, boundLeft, boundRight, boundRects) = foldr (everyUpper r) ([], left br, right br, reverse bottoms) bottoms
|
||||
(boundLeft', boundRight', _) = shrinkBounds boundLeft boundRight boundRects r (top br)
|
||||
in mkRect boundLeft' boundRight' (top br) (top r) ?: rs
|
||||
|
||||
everyUpper
|
||||
:: Rectangle -- ^ The current rectangle where the top edge is used.
|
||||
-> Rectangle -- ^ The current rectangle where the bottom edge is used.
|
||||
-> ([Rectangle],Int,Int,[Rectangle]) -- ^ List of MERs found so far, left bound, right bound and list of rectangles used for bounds.
|
||||
-> ([Rectangle],Int,Int,[Rectangle])
|
||||
everyUpper lower upper (rs, boundLeft, boundRight, boundRects) = (r?:rs, boundLeft', boundRight', boundRects')
|
||||
where
|
||||
r = mkRect boundLeft' boundRight' (bottom upper) (top lower)
|
||||
(boundLeft', boundRight', boundRects') = shrinkBounds boundLeft boundRight boundRects lower (bottom upper)
|
||||
|
||||
shrinkBounds :: Int -> Int -> [Rectangle] -> Rectangle -> Int -> (Int, Int, [Rectangle])
|
||||
shrinkBounds boundLeft boundRight boundRects lower upperLimit = (boundLeft', boundRight', boundRects')
|
||||
where
|
||||
(shrinkers, boundRects') = span (\a -> bottom a > upperLimit) boundRects
|
||||
(boundLeft', boundRight') = foldr (shrinkBounds' lower) (boundLeft, boundRight) $ filter (\a -> top a < top lower) shrinkers
|
||||
|
||||
shrinkBounds' :: Rectangle -> Rectangle -> (Int, Int) -> (Int, Int)
|
||||
shrinkBounds' mr r (boundLeft, boundRight)
|
||||
| right r < right mr = (max boundLeft $ right r, boundRight)
|
||||
| left r > left mr = (boundLeft, min boundRight $ left r)
|
||||
| otherwise = (right r, left r) -- r is horizontally covering all of mr; make sure the area of this rectangle will always be 0.
|
||||
|
||||
bottomEdge :: Rectangle -> [Rectangle] -> Rectangle -> Maybe Rectangle
|
||||
bottomEdge br bottoms r = let rs = filter (\a -> bottom r < bottom a && top a < bottom br) bottoms
|
||||
boundLeft = maximum $ left br : (filter (< right r) $ map right rs)
|
||||
boundRight = minimum $ right br : (filter (> left r) $ map left rs)
|
||||
in if any (\a -> left a <= left r && right r <= right a) rs
|
||||
then Nothing
|
||||
else mkRect boundLeft boundRight (bottom r) (bottom br)
|
||||
|
||||
-- | Split rectangles that horizontally fully contains another rectangle
|
||||
-- without sharing either the left or right side.
|
||||
splitContainers :: [Rectangle] -> [Rectangle]
|
||||
splitContainers rects = splitContainers' [] $ sortBy (comparing rect_width) rects
|
||||
where
|
||||
splitContainers' :: [Rectangle] -> [Rectangle] -> [Rectangle]
|
||||
splitContainers' res [] = res
|
||||
splitContainers' res (r:rs) = splitContainers' (r:res) $ concat $ map (doSplit r) rs
|
||||
|
||||
doSplit :: Rectangle -> Rectangle -> [Rectangle]
|
||||
doSplit guide r
|
||||
| left guide <= left r || right r <= right guide = [r]
|
||||
| otherwise = let w0 = fi (rect_x guide - rect_x r) + (rect_width guide `div` 2)
|
||||
w1 = rect_width r - w0
|
||||
in [ Rectangle (rect_x r) (rect_y r) w0 (rect_height r)
|
||||
, Rectangle (rect_x r + fi w0) (rect_y r) w1 (rect_height r)
|
||||
]
|
||||
|
||||
-- | Find all horizontal gaps that are left empty from top to bottom of screen.
|
||||
findGaps
|
||||
:: Rectangle -- ^ Bounding rectangle.
|
||||
-> [Rectangle] -- ^ List of all rectangles that can cover areas in the bounding rectangle.
|
||||
-> [Rectangle]
|
||||
findGaps br rs = let (gaps,end) = foldr findGaps' ([], left br) $ sortBy (flip $ comparing left) $ filter inBounds rs
|
||||
lastgap = mkRect end (right br) (top br) (bottom br)
|
||||
in lastgap?:gaps
|
||||
where
|
||||
findGaps' :: Rectangle -> ([Rectangle], Int) -> ([Rectangle], Int)
|
||||
findGaps' r (gaps, end) = let gap = mkRect end (left r) (top br) (bottom br)
|
||||
in (gap?:gaps, max end (right r))
|
||||
|
||||
inBounds :: Rectangle -> Bool
|
||||
inBounds r = left r < right br && left br < right r
|
||||
|
||||
fi :: (Integral a, Num b) => a -> b
|
||||
fi x = fromIntegral x
|
||||
|
||||
(?:) :: Maybe a -> [a] -> [a]
|
||||
Just x ?: xs = x:xs
|
||||
_ ?: xs = xs
|
||||
|
||||
left, right, top, bottom, area :: Rectangle -> Int
|
||||
left r = fi (rect_x r)
|
||||
right r = fi (rect_x r) + fi (rect_width r)
|
||||
top r = fi (rect_y r)
|
||||
bottom r = fi (rect_y r) + fi (rect_height r)
|
||||
area r = fi (rect_width r * rect_height r)
|
||||
|
||||
mkRect :: Int -> Int -> Int -> Int -> Maybe Rectangle
|
||||
mkRect l r t b = let rect = Rectangle (fi l) (fi t) (fi $ max 0 $ r-l) (fi $ max 0 $ b-t)
|
||||
in if area rect > 0
|
||||
then Just rect
|
||||
else Nothing
|
794
XMonad/Layout/BinarySpacePartition.hs
Normal file
794
XMonad/Layout/BinarySpacePartition.hs
Normal file
@@ -0,0 +1,794 @@
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE DoAndIfThenElse #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.BinarySpacePartition
|
||||
-- Copyright : (c) 2013 Ben Weitzman <benweitzman@gmail.com>
|
||||
-- 2015 Anton Pirogov <anton.pirogov@gmail.com>
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : Ben Weitzman <benweitzman@gmail.com>
|
||||
-- Stability : unstable
|
||||
-- Portability : unportable
|
||||
--
|
||||
-- Layout where new windows will split the focused window in half, based off of BSPWM
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Layout.BinarySpacePartition (
|
||||
-- * Usage
|
||||
-- $usage
|
||||
emptyBSP
|
||||
, Rotate(..)
|
||||
, Swap(..)
|
||||
, ResizeDirectional(..)
|
||||
, TreeRotate(..)
|
||||
, TreeBalance(..)
|
||||
, FocusParent(..)
|
||||
, SelectMoveNode(..)
|
||||
, Direction2D(..)
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Util.Stack hiding (Zipper)
|
||||
import XMonad.Util.Types
|
||||
|
||||
-- for mouse resizing
|
||||
import XMonad.Layout.WindowArranger (WindowArrangerMsg(SetGeometry))
|
||||
-- for "focus parent" node border
|
||||
import XMonad.Util.XUtils
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Data.List ((\\), elemIndex, foldl')
|
||||
import Data.Maybe (fromMaybe, isNothing, isJust, mapMaybe, catMaybes)
|
||||
import Control.Applicative
|
||||
import Control.Monad
|
||||
import Data.Ratio ((%))
|
||||
|
||||
-- $usage
|
||||
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
|
||||
--
|
||||
-- > import XMonad.Layout.BinarySpacePartition
|
||||
--
|
||||
-- Then add the layout, using the default BSP (BinarySpacePartition)
|
||||
--
|
||||
-- > myLayout = emptyBSP ||| etc ..
|
||||
--
|
||||
-- It may be a good idea to use "XMonad.Actions.Navigation2D" to move between the windows.
|
||||
--
|
||||
-- This layout responds to SetGeometry and is compatible with e.g. "XMonad.Actions.MouseResize"
|
||||
-- or "XMonad.Layout.BorderResize". You should probably try both to decide which is better for you,
|
||||
-- if you want to be able to resize the splits with the mouse.
|
||||
--
|
||||
-- If you don't want to use the mouse, add the following key bindings to resize the splits with the keyboard:
|
||||
--
|
||||
-- > , ((modm .|. altMask, xK_l ), sendMessage $ ExpandTowards R)
|
||||
-- > , ((modm .|. altMask, xK_h ), sendMessage $ ExpandTowards L)
|
||||
-- > , ((modm .|. altMask, xK_j ), sendMessage $ ExpandTowards D)
|
||||
-- > , ((modm .|. altMask, xK_k ), sendMessage $ ExpandTowards U)
|
||||
-- > , ((modm .|. altMask .|. ctrlMask , xK_l ), sendMessage $ ShrinkFrom R)
|
||||
-- > , ((modm .|. altMask .|. ctrlMask , xK_h ), sendMessage $ ShrinkFrom L)
|
||||
-- > , ((modm .|. altMask .|. ctrlMask , xK_j ), sendMessage $ ShrinkFrom D)
|
||||
-- > , ((modm .|. altMask .|. ctrlMask , xK_k ), sendMessage $ ShrinkFrom U)
|
||||
-- > , ((modm, xK_r ), sendMessage Rotate)
|
||||
-- > , ((modm, xK_s ), sendMessage Swap)
|
||||
-- > , ((modm, xK_n ), sendMessage FocusParent)
|
||||
-- > , ((modm .|. ctrlMask, xK_n ), sendMessage SelectNode)
|
||||
-- > , ((modm .|. shiftMask, xK_n ), sendMessage MoveNode)
|
||||
--
|
||||
-- Here's an alternative key mapping, this time using additionalKeysP,
|
||||
-- arrow keys, and slightly different behavior when resizing windows
|
||||
--
|
||||
-- > , ("M-M1-<Left>", sendMessage $ ExpandTowards L)
|
||||
-- > , ("M-M1-<Right>", sendMessage $ ShrinkFrom L)
|
||||
-- > , ("M-M1-<Up>", sendMessage $ ExpandTowards U)
|
||||
-- > , ("M-M1-<Down>", sendMessage $ ShrinkFrom U)
|
||||
-- > , ("M-M1-C-<Left>", sendMessage $ ShrinkFrom R)
|
||||
-- > , ("M-M1-C-<Right>", sendMessage $ ExpandTowards R)
|
||||
-- > , ("M-M1-C-<Up>", sendMessage $ ShrinkFrom D)
|
||||
-- > , ("M-M1-C-<Down>", sendMessage $ ExpandTowards D)
|
||||
-- > , ("M-s", sendMessage $ BSP.Swap)
|
||||
-- > , ("M-M1-s", sendMessage $ Rotate) ]
|
||||
--
|
||||
-- If you have many windows open and the layout begins to look too hard to manage, you can 'Balance'
|
||||
-- the layout, so that the current splittings are discarded and windows are tiled freshly in a way that
|
||||
-- the split depth is minimized. You can combine this with 'Equalize', which does not change your tree,
|
||||
-- but tunes the split ratios in a way that each window gets the same amount of space:
|
||||
--
|
||||
-- > , ((myModMask, xK_a), sendMessage Balance)
|
||||
-- > , ((myModMask .|. shiftMask, xK_a), sendMessage Equalize)
|
||||
--
|
||||
|
||||
-- |Message for rotating the binary tree around the parent node of the window to the left or right
|
||||
data TreeRotate = RotateL | RotateR deriving Typeable
|
||||
instance Message TreeRotate
|
||||
|
||||
-- |Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)
|
||||
data TreeBalance = Balance | Equalize deriving Typeable
|
||||
instance Message TreeBalance
|
||||
|
||||
-- |Message for resizing one of the cells in the BSP
|
||||
data ResizeDirectional = ExpandTowards Direction2D | ShrinkFrom Direction2D | MoveSplit Direction2D deriving Typeable
|
||||
instance Message ResizeDirectional
|
||||
|
||||
-- |Message for rotating a split (horizontal/vertical) in the BSP
|
||||
data Rotate = Rotate deriving Typeable
|
||||
instance Message Rotate
|
||||
|
||||
-- |Message for swapping the left child of a split with the right child of split
|
||||
data Swap = Swap deriving Typeable
|
||||
instance Message Swap
|
||||
|
||||
-- |Message to cyclically select the parent node instead of the leaf
|
||||
data FocusParent = FocusParent deriving Typeable
|
||||
instance Message FocusParent
|
||||
|
||||
-- |Message to move nodes inside the tree
|
||||
data SelectMoveNode = SelectNode | MoveNode deriving Typeable
|
||||
instance Message SelectMoveNode
|
||||
|
||||
data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
|
||||
|
||||
oppositeDirection :: Direction2D -> Direction2D
|
||||
oppositeDirection U = D
|
||||
oppositeDirection D = U
|
||||
oppositeDirection L = R
|
||||
oppositeDirection R = L
|
||||
|
||||
oppositeAxis :: Axis -> Axis
|
||||
oppositeAxis Vertical = Horizontal
|
||||
oppositeAxis Horizontal = Vertical
|
||||
|
||||
toAxis :: Direction2D -> Axis
|
||||
toAxis U = Horizontal
|
||||
toAxis D = Horizontal
|
||||
toAxis L = Vertical
|
||||
toAxis R = Vertical
|
||||
|
||||
split :: Axis -> Rational -> Rectangle -> (Rectangle, Rectangle)
|
||||
split Horizontal r (Rectangle sx sy sw sh) = (r1, r2) where
|
||||
r1 = Rectangle sx sy sw sh'
|
||||
r2 = Rectangle sx (sy + fromIntegral sh') sw (sh - sh')
|
||||
sh' = floor $ fromIntegral sh * r
|
||||
split Vertical r (Rectangle sx sy sw sh) = (r1, r2) where
|
||||
r1 = Rectangle sx sy sw' sh
|
||||
r2 = Rectangle (sx + fromIntegral sw') sy (sw - sw') sh
|
||||
sw' = floor $ fromIntegral sw * r
|
||||
|
||||
data Split = Split { axis :: Axis
|
||||
, ratio :: Rational
|
||||
} deriving (Show, Read, Eq)
|
||||
|
||||
oppositeSplit :: Split -> Split
|
||||
oppositeSplit (Split d r) = Split (oppositeAxis d) r
|
||||
|
||||
increaseRatio :: Split -> Rational -> Split
|
||||
increaseRatio (Split d r) delta = Split d (min 0.9 (max 0.1 (r + delta)))
|
||||
|
||||
resizeDiff :: Rational
|
||||
resizeDiff = 0.05
|
||||
|
||||
|
||||
data Tree a = Leaf Int | Node { value :: a
|
||||
, left :: Tree a
|
||||
, right :: Tree a
|
||||
} deriving (Show, Read, Eq)
|
||||
|
||||
numLeaves :: Tree a -> Int
|
||||
numLeaves (Leaf _) = 1
|
||||
numLeaves (Node _ l r) = numLeaves l + numLeaves r
|
||||
|
||||
-- right or left rotation of a (sub)tree, no effect if rotation not possible
|
||||
rotTree :: Direction2D -> Tree a -> Tree a
|
||||
rotTree _ (Leaf n) = Leaf n
|
||||
rotTree R n@(Node _ (Leaf _) _) = n
|
||||
rotTree L n@(Node _ _ (Leaf _)) = n
|
||||
rotTree R (Node sp (Node sp2 l2 r2) r) = Node sp2 l2 (Node sp r2 r)
|
||||
rotTree L (Node sp l (Node sp2 l2 r2)) = Node sp2 (Node sp l l2) r2
|
||||
rotTree _ t = t
|
||||
|
||||
|
||||
data Crumb a = LeftCrumb a (Tree a) | RightCrumb a (Tree a) deriving (Show, Read, Eq)
|
||||
|
||||
swapCrumb :: Crumb a -> Crumb a
|
||||
swapCrumb (LeftCrumb s t) = RightCrumb s t
|
||||
swapCrumb (RightCrumb s t) = LeftCrumb s t
|
||||
|
||||
parentVal :: Crumb a -> a
|
||||
parentVal (LeftCrumb s _) = s
|
||||
parentVal (RightCrumb s _) = s
|
||||
|
||||
modifyParentVal :: (a -> a) -> Crumb a -> Crumb a
|
||||
modifyParentVal f (LeftCrumb s t) = LeftCrumb (f s) t
|
||||
modifyParentVal f (RightCrumb s t) = RightCrumb (f s) t
|
||||
|
||||
type Zipper a = (Tree a, [Crumb a])
|
||||
|
||||
toZipper :: Tree a -> Zipper a
|
||||
toZipper t = (t, [])
|
||||
|
||||
goLeft :: Zipper a -> Maybe (Zipper a)
|
||||
goLeft (Leaf _, _) = Nothing
|
||||
goLeft (Node x l r, bs) = Just (l, LeftCrumb x r:bs)
|
||||
|
||||
goRight :: Zipper a -> Maybe (Zipper a)
|
||||
goRight (Leaf _, _) = Nothing
|
||||
goRight (Node x l r, bs) = Just (r, RightCrumb x l:bs)
|
||||
|
||||
goUp :: Zipper a -> Maybe (Zipper a)
|
||||
goUp (_, []) = Nothing
|
||||
goUp (t, LeftCrumb x r:cs) = Just (Node x t r, cs)
|
||||
goUp (t, RightCrumb x l:cs) = Just (Node x l t, cs)
|
||||
|
||||
goSibling :: Zipper a -> Maybe (Zipper a)
|
||||
goSibling (_, []) = Nothing
|
||||
goSibling z@(_, LeftCrumb _ _:_) = Just z >>= goUp >>= goRight
|
||||
goSibling z@(_, RightCrumb _ _:_) = Just z >>= goUp >>= goLeft
|
||||
|
||||
top :: Zipper a -> Zipper a
|
||||
top z = case goUp z of
|
||||
Nothing -> z
|
||||
Just z' -> top z'
|
||||
|
||||
toTree :: Zipper a -> Tree a
|
||||
toTree = fst . top
|
||||
|
||||
goToNthLeaf :: Int -> Zipper a -> Maybe (Zipper a)
|
||||
goToNthLeaf _ z@(Leaf _, _) = Just z
|
||||
goToNthLeaf n z@(t, _) =
|
||||
if numLeaves (left t) > n
|
||||
then do z' <- goLeft z
|
||||
goToNthLeaf n z'
|
||||
else do z' <- goRight z
|
||||
goToNthLeaf (n - (numLeaves . left $ t)) z'
|
||||
|
||||
toggleSplits :: Tree Split -> Tree Split
|
||||
toggleSplits (Leaf l) = Leaf l
|
||||
toggleSplits (Node s l r) = Node (oppositeSplit s) (toggleSplits l) (toggleSplits r)
|
||||
|
||||
splitCurrent :: Zipper Split -> Maybe (Zipper Split)
|
||||
splitCurrent (Leaf _, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (Leaf 0), [])
|
||||
splitCurrent (Leaf _, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (Leaf 0), crumb:cs)
|
||||
splitCurrent (n, []) = Just (Node (Split Vertical 0.5) (Leaf 0) (toggleSplits n), [])
|
||||
splitCurrent (n, crumb:cs) = Just (Node (Split (oppositeAxis . axis . parentVal $ crumb) 0.5) (Leaf 0) (toggleSplits n), crumb:cs)
|
||||
|
||||
removeCurrent :: Zipper a -> Maybe (Zipper a)
|
||||
removeCurrent (Leaf _, LeftCrumb _ r:cs) = Just (r, cs)
|
||||
removeCurrent (Leaf _, RightCrumb _ l:cs) = Just (l, cs)
|
||||
removeCurrent (Leaf _, []) = Nothing
|
||||
removeCurrent (Node _ (Leaf _) r@(Node _ _ _), cs) = Just (r, cs)
|
||||
removeCurrent (Node _ l@(Node _ _ _) (Leaf _), cs) = Just (l, cs)
|
||||
removeCurrent (Node _ (Leaf _) (Leaf _), cs) = Just (Leaf 0, cs)
|
||||
removeCurrent z@(Node _ _ _, _) = goLeft z >>= removeCurrent
|
||||
|
||||
rotateCurrent :: Zipper Split -> Maybe (Zipper Split)
|
||||
rotateCurrent l@(_, []) = Just l
|
||||
rotateCurrent (n, c:cs) = Just (n, modifyParentVal oppositeSplit c:cs)
|
||||
|
||||
swapCurrent :: Zipper a -> Maybe (Zipper a)
|
||||
swapCurrent l@(_, []) = Just l
|
||||
swapCurrent (n, c:cs) = Just (n, swapCrumb c:cs)
|
||||
|
||||
isAllTheWay :: Direction2D -> Zipper Split -> Bool
|
||||
isAllTheWay _ (_, []) = True
|
||||
isAllTheWay R (_, LeftCrumb s _:_)
|
||||
| axis s == Vertical = False
|
||||
isAllTheWay L (_, RightCrumb s _:_)
|
||||
| axis s == Vertical = False
|
||||
isAllTheWay D (_, LeftCrumb s _:_)
|
||||
| axis s == Horizontal = False
|
||||
isAllTheWay U (_, RightCrumb s _:_)
|
||||
| axis s == Horizontal = False
|
||||
isAllTheWay dir z = fromMaybe False $ goUp z >>= Just . isAllTheWay dir
|
||||
|
||||
expandTreeTowards :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
|
||||
expandTreeTowards _ z@(_, []) = Just z
|
||||
expandTreeTowards dir z
|
||||
| isAllTheWay dir z = shrinkTreeFrom (oppositeDirection dir) z
|
||||
expandTreeTowards R (t, LeftCrumb s r:cs)
|
||||
| axis s == Vertical = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)
|
||||
expandTreeTowards L (t, RightCrumb s l:cs)
|
||||
| axis s == Vertical = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)
|
||||
expandTreeTowards D (t, LeftCrumb s r:cs)
|
||||
| axis s == Horizontal = Just (t, LeftCrumb (increaseRatio s resizeDiff) r:cs)
|
||||
expandTreeTowards U (t, RightCrumb s l:cs)
|
||||
| axis s == Horizontal = Just (t, RightCrumb (increaseRatio s (-resizeDiff)) l:cs)
|
||||
expandTreeTowards dir z = goUp z >>= expandTreeTowards dir
|
||||
|
||||
shrinkTreeFrom :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
|
||||
shrinkTreeFrom _ z@(_, []) = Just z
|
||||
shrinkTreeFrom R z@(_, LeftCrumb s _:_)
|
||||
| axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards L
|
||||
shrinkTreeFrom L z@(_, RightCrumb s _:_)
|
||||
| axis s == Vertical = Just z >>= goSibling >>= expandTreeTowards R
|
||||
shrinkTreeFrom D z@(_, LeftCrumb s _:_)
|
||||
| axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards U
|
||||
shrinkTreeFrom U z@(_, RightCrumb s _:_)
|
||||
| axis s == Horizontal = Just z >>= goSibling >>= expandTreeTowards D
|
||||
shrinkTreeFrom dir z = goUp z >>= shrinkTreeFrom dir
|
||||
|
||||
-- Direction2D refers to which direction the divider should move.
|
||||
autoSizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
|
||||
autoSizeTree _ z@(_, []) = Just z
|
||||
autoSizeTree d z =
|
||||
Just z >>= getSplit (toAxis d) >>= resizeTree d
|
||||
|
||||
-- resizing once found the correct split. YOU MUST FIND THE RIGHT SPLIT FIRST.
|
||||
resizeTree :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
|
||||
resizeTree _ z@(_, []) = Just z
|
||||
resizeTree R z@(_, LeftCrumb _ _:_) =
|
||||
Just z >>= expandTreeTowards R
|
||||
resizeTree L z@(_, LeftCrumb _ _:_) =
|
||||
Just z >>= shrinkTreeFrom R
|
||||
resizeTree U z@(_, LeftCrumb _ _:_) =
|
||||
Just z >>= shrinkTreeFrom D
|
||||
resizeTree D z@(_, LeftCrumb _ _:_) =
|
||||
Just z >>= expandTreeTowards D
|
||||
resizeTree R z@(_, RightCrumb _ _:_) =
|
||||
Just z >>= shrinkTreeFrom L
|
||||
resizeTree L z@(_, RightCrumb _ _:_) =
|
||||
Just z >>= expandTreeTowards L
|
||||
resizeTree U z@(_, RightCrumb _ _:_) =
|
||||
Just z >>= expandTreeTowards U
|
||||
resizeTree D z@(_, RightCrumb _ _:_) =
|
||||
Just z >>= shrinkTreeFrom U
|
||||
|
||||
getSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
|
||||
getSplit _ (_, []) = Nothing
|
||||
getSplit d z =
|
||||
do let fs = findSplit d z
|
||||
if isNothing fs
|
||||
then findClosest d z
|
||||
else fs
|
||||
|
||||
findClosest :: Axis -> Zipper Split -> Maybe (Zipper Split)
|
||||
findClosest _ z@(_, []) = Just z
|
||||
findClosest d z@(_, LeftCrumb s _:_)
|
||||
| axis s == d = Just z
|
||||
findClosest d z@(_, RightCrumb s _:_)
|
||||
| axis s == d = Just z
|
||||
findClosest d z = goUp z >>= findClosest d
|
||||
|
||||
findSplit :: Axis -> Zipper Split -> Maybe (Zipper Split)
|
||||
findSplit _ (_, []) = Nothing
|
||||
findSplit d z@(_, LeftCrumb s _:_)
|
||||
| axis s == d = Just z
|
||||
findSplit d z = goUp z >>= findSplit d
|
||||
|
||||
resizeSplit :: Direction2D -> (Rational,Rational) -> Zipper Split -> Maybe (Zipper Split)
|
||||
resizeSplit _ _ z@(_, []) = Just z
|
||||
resizeSplit dir (xsc,ysc) z = case goToBorder dir z of
|
||||
Nothing -> Just z
|
||||
Just (t, crumb) -> Just $ case dir of
|
||||
R -> (t{value=sp{ratio=scaleRatio (ratio sp) xsc}}, crumb)
|
||||
D -> (t{value=sp{ratio=scaleRatio (ratio sp) ysc}}, crumb)
|
||||
L -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) xsc}}, crumb)
|
||||
U -> (t{value=sp{ratio=1-scaleRatio (1-ratio sp) ysc}}, crumb)
|
||||
where sp = value t
|
||||
scaleRatio r fac = min 0.9 $ max 0.1 $ r*fac
|
||||
|
||||
-- starting from a leaf, go to node representing a border of the according window
|
||||
goToBorder :: Direction2D -> Zipper Split -> Maybe (Zipper Split)
|
||||
goToBorder L z@(_, RightCrumb (Split Vertical _) _:_) = goUp z
|
||||
goToBorder L z = goUp z >>= goToBorder L
|
||||
goToBorder R z@(_, LeftCrumb (Split Vertical _) _:_) = goUp z
|
||||
goToBorder R z = goUp z >>= goToBorder R
|
||||
goToBorder U z@(_, RightCrumb (Split Horizontal _) _:_) = goUp z
|
||||
goToBorder U z = goUp z >>= goToBorder U
|
||||
goToBorder D z@(_, LeftCrumb (Split Horizontal _) _:_) = goUp z
|
||||
goToBorder D z = goUp z >>= goToBorder D
|
||||
|
||||
-- takes a list of indices and numerates the leaves of a given tree
|
||||
numerate :: [Int] -> Tree a -> Tree a
|
||||
numerate ns t = snd $ num ns t
|
||||
where num (n:nns) (Leaf _) = (nns, Leaf n)
|
||||
num [] (Leaf _) = ([], Leaf 0)
|
||||
num n (Node s l r) = (n'', Node s nl nr)
|
||||
where (n', nl) = num n l
|
||||
(n'', nr) = num n' r
|
||||
|
||||
-- return values of leaves from left to right as list
|
||||
flatten :: Tree a -> [Int]
|
||||
flatten (Leaf n) = [n]
|
||||
flatten (Node _ l r) = flatten l++flatten r
|
||||
|
||||
-- adjust ratios to make window areas equal
|
||||
equalize :: Zipper Split -> Maybe (Zipper Split)
|
||||
equalize (t, cs) = Just (eql t, cs)
|
||||
where eql (Leaf n) = Leaf n
|
||||
eql n@(Node s l r) = Node s{ratio=fromIntegral (numLeaves l) % fromIntegral (numLeaves n)}
|
||||
(eql l) (eql r)
|
||||
|
||||
-- generate a symmetrical balanced tree for n leaves from given tree, preserving leaf labels
|
||||
balancedTree :: Zipper Split -> Maybe (Zipper Split)
|
||||
balancedTree (t, cs) = Just (numerate (flatten t) $ balanced (numLeaves t), cs)
|
||||
where balanced 1 = Leaf 0
|
||||
balanced 2 = Node (Split Horizontal 0.5) (Leaf 0) (Leaf 0)
|
||||
balanced m = Node (Split Horizontal 0.5) (balanced (m`div`2)) (balanced (m-m`div`2))
|
||||
|
||||
-- attempt to rotate splits optimally in order choose more quad-like rects
|
||||
optimizeOrientation :: Rectangle -> Zipper Split -> Maybe (Zipper Split)
|
||||
optimizeOrientation rct (t, cs) = Just (opt t rct, cs)
|
||||
where opt (Leaf v) _ = Leaf v
|
||||
opt (Node sp l r) rect = Node sp' (opt l lrect) (opt r rrect)
|
||||
where (Rectangle _ _ w1 h1,Rectangle _ _ w2 h2) = split (axis sp) (ratio sp) rect
|
||||
(Rectangle _ _ w3 h3,Rectangle _ _ w4 h4) = split (axis $ oppositeSplit sp) (ratio sp) rect
|
||||
f w h = if w > h then w'/h' else h'/w' where (w',h') = (fromIntegral w :: Double, fromIntegral h :: Double)
|
||||
wratio = min (f w1 h1) (f w2 h2)
|
||||
wratio' = min (f w3 h3) (f w4 h4)
|
||||
sp' = if wratio<wratio' then sp else oppositeSplit sp
|
||||
(lrect, rrect) = split (axis sp') (ratio sp') rect
|
||||
|
||||
|
||||
-- initially focused leaf, path from root to selected node, window ids of borders highlighting the selection
|
||||
data NodeRef = NodeRef { refLeaf :: Int, refPath :: [Direction2D], refWins :: [Window] } deriving (Show,Read,Eq)
|
||||
noRef :: NodeRef
|
||||
noRef = NodeRef (-1) [] []
|
||||
|
||||
goToNode :: NodeRef -> Zipper a -> Maybe (Zipper a)
|
||||
goToNode (NodeRef _ dirs _) z = foldM gofun z dirs
|
||||
where gofun z' L = goLeft z'
|
||||
gofun z' R = goRight z'
|
||||
gofun _ _ = Nothing
|
||||
|
||||
toNodeRef :: Int -> Maybe (Zipper Split) -> NodeRef
|
||||
toNodeRef _ Nothing = noRef
|
||||
toNodeRef l (Just (_, cs)) = NodeRef l (reverse $ map crumbToDir cs) []
|
||||
where crumbToDir (LeftCrumb _ _) = L
|
||||
crumbToDir (RightCrumb _ _) = R
|
||||
|
||||
-- returns the leaf a noderef is leading to, if any
|
||||
nodeRefToLeaf :: NodeRef -> Maybe (Zipper a) -> Maybe Int
|
||||
nodeRefToLeaf n (Just z) = case goToNode n z of
|
||||
Just (Leaf l, _) -> Just l
|
||||
Just (Node _ _ _, _) -> Nothing
|
||||
Nothing -> Nothing
|
||||
nodeRefToLeaf _ Nothing = Nothing
|
||||
|
||||
leafToNodeRef :: Int -> BinarySpacePartition a -> NodeRef
|
||||
leafToNodeRef l b = toNodeRef l (makeZipper b >>= goToNthLeaf l)
|
||||
|
||||
data BinarySpacePartition a = BinarySpacePartition { getOldRects :: [(Window,Rectangle)]
|
||||
, getFocusedNode :: NodeRef
|
||||
, getSelectedNode :: NodeRef
|
||||
, getTree :: Maybe (Tree Split) } deriving (Show, Read,Eq)
|
||||
|
||||
-- | an empty BinarySpacePartition to use as a default for adding windows to.
|
||||
emptyBSP :: BinarySpacePartition a
|
||||
emptyBSP = BinarySpacePartition [] noRef noRef Nothing
|
||||
|
||||
makeBSP :: Tree Split -> BinarySpacePartition a
|
||||
makeBSP = BinarySpacePartition [] noRef noRef . Just
|
||||
|
||||
makeZipper :: BinarySpacePartition a -> Maybe (Zipper Split)
|
||||
makeZipper (BinarySpacePartition _ _ _ Nothing) = Nothing
|
||||
makeZipper (BinarySpacePartition _ _ _ (Just t)) = Just . toZipper $ t
|
||||
|
||||
size :: BinarySpacePartition a -> Int
|
||||
size = maybe 0 numLeaves . getTree
|
||||
|
||||
zipperToBinarySpacePartition :: Maybe (Zipper Split) -> BinarySpacePartition b
|
||||
zipperToBinarySpacePartition Nothing = emptyBSP
|
||||
zipperToBinarySpacePartition (Just z) = BinarySpacePartition [] noRef noRef . Just . toTree . top $ z
|
||||
|
||||
rectangles :: BinarySpacePartition a -> Rectangle -> [Rectangle]
|
||||
rectangles (BinarySpacePartition _ _ _ Nothing) _ = []
|
||||
rectangles (BinarySpacePartition _ _ _ (Just (Leaf _))) rootRect = [rootRect]
|
||||
rectangles (BinarySpacePartition _ _ _ (Just node)) rootRect =
|
||||
rectangles (makeBSP . left $ node) leftBox ++
|
||||
rectangles (makeBSP . right $ node) rightBox
|
||||
where (leftBox, rightBox) = split (axis info) (ratio info) rootRect
|
||||
info = value node
|
||||
|
||||
getNodeRect :: BinarySpacePartition a -> Rectangle -> NodeRef -> Rectangle
|
||||
getNodeRect b r n = fromMaybe (Rectangle 0 0 1 1) (makeZipper b >>= goToNode n >>= getRect [])
|
||||
where getRect ls (_, []) = Just $ foldl (\r' (s,f) -> f $ split' s r') r ls
|
||||
getRect ls z@(_, LeftCrumb s _:_) = goUp z >>= getRect ((s,fst):ls)
|
||||
getRect ls z@(_, RightCrumb s _:_) = goUp z >>= getRect ((s,snd):ls)
|
||||
split' s = split (axis s) (ratio s)
|
||||
|
||||
doToNth :: (Zipper Split -> Maybe (Zipper Split)) -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
doToNth f b = b{getTree=getTree $ zipperToBinarySpacePartition $ makeZipper b >>= goToNode (getFocusedNode b) >>= f}
|
||||
|
||||
splitNth :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
splitNth (BinarySpacePartition _ _ _ Nothing) = makeBSP (Leaf 0)
|
||||
splitNth b = doToNth splitCurrent b
|
||||
|
||||
removeNth :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
removeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
removeNth (BinarySpacePartition _ _ _ (Just (Leaf _))) = emptyBSP
|
||||
removeNth b = doToNth removeCurrent b
|
||||
|
||||
rotateNth :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
rotateNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
rotateNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
rotateNth b = doToNth rotateCurrent b
|
||||
|
||||
swapNth :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
swapNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
swapNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
swapNth b = doToNth swapCurrent b
|
||||
|
||||
growNthTowards :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
growNthTowards _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
growNthTowards _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
growNthTowards dir b = doToNth (expandTreeTowards dir) b
|
||||
|
||||
shrinkNthFrom :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
shrinkNthFrom _ (BinarySpacePartition _ _ _ Nothing)= emptyBSP
|
||||
shrinkNthFrom _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
shrinkNthFrom dir b = doToNth (shrinkTreeFrom dir) b
|
||||
|
||||
autoSizeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
autoSizeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
autoSizeNth _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
autoSizeNth dir b = doToNth (autoSizeTree dir) b
|
||||
|
||||
resizeSplitNth :: Direction2D -> (Rational,Rational) -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
resizeSplitNth _ _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
resizeSplitNth _ _ b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
resizeSplitNth dir sc b = doToNth (resizeSplit dir sc) b
|
||||
|
||||
-- rotate tree left or right around parent of nth leaf
|
||||
rotateTreeNth :: Direction2D -> BinarySpacePartition a -> BinarySpacePartition a
|
||||
rotateTreeNth _ (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
rotateTreeNth U b = b
|
||||
rotateTreeNth D b = b
|
||||
rotateTreeNth dir b@(BinarySpacePartition _ _ _ (Just _)) =
|
||||
doToNth (\t -> case goUp t of
|
||||
Nothing -> Just t
|
||||
Just (t', c) -> Just (rotTree dir t', c)) b
|
||||
|
||||
equalizeNth :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
equalizeNth (BinarySpacePartition _ _ _ Nothing) = emptyBSP
|
||||
equalizeNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) = b
|
||||
equalizeNth b = doToNth equalize b
|
||||
|
||||
rebalanceNth :: BinarySpacePartition a -> Rectangle -> BinarySpacePartition a
|
||||
rebalanceNth (BinarySpacePartition _ _ _ Nothing) _ = emptyBSP
|
||||
rebalanceNth b@(BinarySpacePartition _ _ _ (Just (Leaf _))) _ = b
|
||||
rebalanceNth b r = doToNth (balancedTree >=> optimizeOrientation r) b
|
||||
|
||||
flattenLeaves :: BinarySpacePartition a -> [Int]
|
||||
flattenLeaves (BinarySpacePartition _ _ _ Nothing) = []
|
||||
flattenLeaves (BinarySpacePartition _ _ _ (Just t)) = flatten t
|
||||
|
||||
-- we do this before an action to look afterwards which leaves moved where
|
||||
numerateLeaves :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
numerateLeaves b@(BinarySpacePartition _ _ _ Nothing) = b
|
||||
numerateLeaves b@(BinarySpacePartition _ _ _ (Just t)) = b{getTree=Just $ numerate ns t}
|
||||
where ns = [0..(numLeaves t-1)]
|
||||
|
||||
-- if there is a selected and focused node and the focused is not a part of selected,
|
||||
-- move selected node to be a child of focused node
|
||||
moveNode :: BinarySpacePartition a -> BinarySpacePartition a
|
||||
moveNode b@(BinarySpacePartition _ (NodeRef (-1) _ _) _ _) = b
|
||||
moveNode b@(BinarySpacePartition _ _ (NodeRef (-1) _ _) _) = b
|
||||
moveNode b@(BinarySpacePartition _ _ _ Nothing) = b
|
||||
moveNode b@(BinarySpacePartition _ f s (Just ot)) =
|
||||
case makeZipper b >>= goToNode s of
|
||||
Just (n, LeftCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)}
|
||||
Just (n, RightCrumb _ t:cs) -> b{getTree=Just $ insert n $ top (t, cs)}
|
||||
_ -> b
|
||||
where insert t z = case goToNode f z of
|
||||
Nothing -> ot --return original tree (abort)
|
||||
Just (n, c:cs) -> toTree (Node (Split (oppositeAxis . axis . parentVal $ c) 0.5) t n, c:cs)
|
||||
Just (n, []) -> toTree (Node (Split Vertical 0.5) t n, [])
|
||||
|
||||
------------------------------------------
|
||||
|
||||
-- returns index of focused window or 0 for empty stack
|
||||
index :: W.Stack a -> Int
|
||||
index s = case toIndex (Just s) of
|
||||
(_, Nothing) -> 0
|
||||
(_, Just int) -> int
|
||||
|
||||
--move windows to new positions according to tree transformations, keeping focus on originally focused window
|
||||
--CAREFUL here! introduce a bug here and have fun debugging as your windows start to disappear or explode
|
||||
adjustStack :: Maybe (W.Stack Window) --original stack
|
||||
-> Maybe (W.Stack Window) --stack without floating windows
|
||||
-> [Window] --just floating windows of this WS
|
||||
-> Maybe (BinarySpacePartition Window) -- Tree with numbered leaves telling what to move where
|
||||
-> Maybe (W.Stack Window) --resulting stack
|
||||
adjustStack orig Nothing _ _ = orig --no new stack -> no changes
|
||||
adjustStack orig _ _ Nothing = orig --empty tree -> no changes
|
||||
adjustStack orig s fw (Just b) =
|
||||
if length ls<length ws then orig --less leaves than non-floating windows -> tree incomplete, no changes
|
||||
else fromIndex ws' fid'
|
||||
where ws' = mapMaybe (`M.lookup` wsmap) ls ++ fw
|
||||
fid' = fromMaybe 0 $ elemIndex focused ws'
|
||||
wsmap = M.fromList $ zip [0..] ws -- map: old index in list -> window
|
||||
ls = flattenLeaves b -- get new index ordering from tree
|
||||
(ws,fid) = toIndex s
|
||||
focused = ws !! fromMaybe 0 fid
|
||||
|
||||
--replace the window stack of the managed workspace with our modified stack
|
||||
replaceStack :: Maybe (W.Stack Window) -> X ()
|
||||
replaceStack s = do
|
||||
st <- get
|
||||
let wset = windowset st
|
||||
cur = W.current wset
|
||||
wsp = W.workspace cur
|
||||
put st{windowset=wset{W.current=cur{W.workspace=wsp{W.stack=s}}}}
|
||||
|
||||
replaceFloating :: M.Map Window W.RationalRect -> X ()
|
||||
replaceFloating wsm = do
|
||||
st <- get
|
||||
let wset = windowset st
|
||||
put st{windowset=wset{W.floating=wsm}}
|
||||
|
||||
-- some helpers to filter windows
|
||||
--
|
||||
getFloating :: X [Window]
|
||||
getFloating = (M.keys . W.floating) <$> gets windowset -- all floating windows
|
||||
|
||||
getStackSet :: X (Maybe (W.Stack Window))
|
||||
getStackSet = (W.stack . W.workspace . W.current) <$> gets windowset -- windows on this WS (with floating)
|
||||
|
||||
getScreenRect :: X Rectangle
|
||||
getScreenRect = (screenRect . W.screenDetail . W.current) <$> gets windowset
|
||||
|
||||
withoutFloating :: [Window] -> Maybe (W.Stack Window) -> Maybe (W.Stack Window)
|
||||
withoutFloating fs = maybe Nothing (unfloat fs)
|
||||
|
||||
-- ignore messages if current focus is on floating window, otherwise return stack without floating
|
||||
unfloat :: [Window] -> W.Stack Window -> Maybe (W.Stack Window)
|
||||
unfloat fs s = if W.focus s `elem` fs
|
||||
then Nothing
|
||||
else Just $ s{W.up = W.up s \\ fs, W.down = W.down s \\ fs}
|
||||
|
||||
instance LayoutClass BinarySpacePartition Window where
|
||||
doLayout b r s = do
|
||||
let b' = layout b
|
||||
b'' <- updateNodeRef b' (size b/=size b') r
|
||||
let rs = rectangles b'' r
|
||||
wrs = zip ws rs
|
||||
return (wrs, Just b''{getOldRects=wrs})
|
||||
where
|
||||
ws = W.integrate s
|
||||
l = length ws
|
||||
layout bsp
|
||||
| l == sz = bsp
|
||||
| l > sz = layout $ splitNth bsp
|
||||
| otherwise = layout $ removeNth bsp
|
||||
where sz = size bsp
|
||||
|
||||
handleMessage b_orig m
|
||||
| Just msg@(SetGeometry _) <- fromMessage m = handleResize b msg
|
||||
| Just FocusParent <- fromMessage m = do
|
||||
let n = getFocusedNode b
|
||||
let n' = toNodeRef (refLeaf n) (makeZipper b >>= goToNode n >>= goUp)
|
||||
return $ Just b{getFocusedNode=n'{refWins=refWins n}}
|
||||
| Just SelectNode <- fromMessage m = do
|
||||
let n = getFocusedNode b
|
||||
let s = getSelectedNode b
|
||||
removeBorder $ refWins s
|
||||
let s' = if refLeaf n == refLeaf s && refPath n == refPath s
|
||||
then noRef else n{refWins=[]}
|
||||
return $ Just b{getSelectedNode=s'}
|
||||
| otherwise = do
|
||||
ws <- getStackSet
|
||||
fs <- getFloating
|
||||
r <- getScreenRect
|
||||
-- removeBorder $ refWins $ getSelectedNode b
|
||||
let lws = withoutFloating fs ws -- tiled windows on WS
|
||||
lfs = maybe [] W.integrate ws \\ maybe [] W.integrate lws -- untiled windows on WS
|
||||
b' = handleMesg r -- transform tree (concerns only tiled windows)
|
||||
ws' = adjustStack ws lws lfs b' -- apply transformation to window stack, reintegrate floating wins
|
||||
replaceStack ws'
|
||||
return b'
|
||||
where handleMesg r = msum [ fmap resize (fromMessage m)
|
||||
, fmap rotate (fromMessage m)
|
||||
, fmap swap (fromMessage m)
|
||||
, fmap rotateTr (fromMessage m)
|
||||
, fmap (balanceTr r) (fromMessage m)
|
||||
, fmap move (fromMessage m)
|
||||
]
|
||||
resize (ExpandTowards dir) = growNthTowards dir b
|
||||
resize (ShrinkFrom dir) = shrinkNthFrom dir b
|
||||
resize (MoveSplit dir) = autoSizeNth dir b
|
||||
rotate Rotate = resetFoc $ rotateNth b
|
||||
swap Swap = resetFoc $ swapNth b
|
||||
rotateTr RotateL = resetFoc $ rotateTreeNth L b
|
||||
rotateTr RotateR = resetFoc $ rotateTreeNth R b
|
||||
balanceTr _ Equalize = resetFoc $ equalizeNth b
|
||||
balanceTr r Balance = resetFoc $ rebalanceNth b r
|
||||
move MoveNode = resetFoc $ moveNode b
|
||||
move SelectNode = b --should not happen here, is done above, as we need X monad
|
||||
|
||||
b = numerateLeaves b_orig
|
||||
resetFoc bsp = bsp{getFocusedNode=(getFocusedNode bsp){refLeaf=(-1)}
|
||||
,getSelectedNode=(getSelectedNode bsp){refLeaf=(-1)}}
|
||||
|
||||
description _ = "BSP"
|
||||
|
||||
-- React to SetGeometry message to work with BorderResize/MouseResize
|
||||
handleResize :: BinarySpacePartition Window -> WindowArrangerMsg -> X (Maybe (BinarySpacePartition Window))
|
||||
handleResize b (SetGeometry newrect@(Rectangle _ _ w h)) = do
|
||||
ws <- getStackSet
|
||||
fs <- getFloating
|
||||
case W.focus <$> ws of
|
||||
Nothing -> return Nothing
|
||||
Just win -> do
|
||||
(_,_,_,_,_,mx,my,_) <- withDisplay (\d -> io $ queryPointer d win)
|
||||
let oldrect@(Rectangle _ _ ow oh) = fromMaybe (Rectangle 0 0 0 0) $ lookup win $ getOldRects b
|
||||
let (xsc,ysc) = (fi w % fi ow, fi h % fi oh)
|
||||
(xsc',ysc') = (rough xsc, rough ysc)
|
||||
dirs = changedDirs oldrect newrect (fi mx,fi my)
|
||||
n = elemIndex win $ maybe [] W.integrate $ withoutFloating fs ws
|
||||
-- unless (isNothing dir) $ debug $
|
||||
-- show (fi x-fi ox,fi y-fi oy) ++ show (fi w-fi ow,fi h-fi oh)
|
||||
-- ++ show dir ++ " " ++ show win ++ " " ++ show (mx,my)
|
||||
return $ case n of
|
||||
Just _ -> Just $ foldl' (\b' d -> resizeSplitNth d (xsc',ysc') b') b dirs
|
||||
Nothing -> Nothing --focused window is floating -> ignore
|
||||
where rough v = min 1.5 $ max 0.75 v -- extreme scale factors are forbidden
|
||||
handleResize _ _ = return Nothing
|
||||
|
||||
-- find out which borders have been pulled. We need the old and new rects and the mouse coordinates
|
||||
changedDirs :: Rectangle -> Rectangle -> (Int,Int) -> [Direction2D]
|
||||
changedDirs (Rectangle _ _ ow oh) (Rectangle _ _ w h) (mx,my) = catMaybes [lr, ud]
|
||||
where lr = if ow==w then Nothing
|
||||
else Just (if (fi mx :: Double) > (fi ow :: Double)/2 then R else L)
|
||||
ud = if oh==h then Nothing
|
||||
else Just (if (fi my :: Double) > (fi oh :: Double)/2 then D else U)
|
||||
|
||||
-- node focus border helpers
|
||||
----------------------------
|
||||
updateNodeRef :: BinarySpacePartition Window -> Bool -> Rectangle -> X (BinarySpacePartition Window)
|
||||
updateNodeRef b force r = do
|
||||
let n = getFocusedNode b
|
||||
let s = getSelectedNode b
|
||||
removeBorder (refWins n++refWins s)
|
||||
l <- getCurrFocused
|
||||
b' <- if refLeaf n /= l || refLeaf n == (-1) || force
|
||||
then return b{getFocusedNode=leafToNodeRef l b}
|
||||
else return b
|
||||
b'' <- if force then return b'{getSelectedNode=noRef} else return b'
|
||||
renderBorders r b''
|
||||
where getCurrFocused = maybe 0 index <$> (withoutFloating <$> getFloating <*> getStackSet)
|
||||
|
||||
-- create border around focused node if necessary
|
||||
renderBorders :: Rectangle -> BinarySpacePartition a -> X (BinarySpacePartition a)
|
||||
renderBorders r b = do
|
||||
let l = nodeRefToLeaf (getFocusedNode b) $ makeZipper b
|
||||
wssel <- if refLeaf (getSelectedNode b)/=(-1)
|
||||
then createBorder (getNodeRect b r (getSelectedNode b)) $ Just "#00ff00"
|
||||
else return []
|
||||
let b' = b{getSelectedNode=(getSelectedNode b){refWins=wssel}}
|
||||
if refLeaf (getFocusedNode b')==(-1) || isJust l || size b'<2 then return b'
|
||||
else do
|
||||
ws' <- createBorder (getNodeRect b' r (getFocusedNode b')) Nothing
|
||||
return b'{getFocusedNode=(getFocusedNode b'){refWins=ws'}}
|
||||
|
||||
-- create a window for each border line, show, add into stack and set floating
|
||||
createBorder :: Rectangle -> Maybe String -> X [Window]
|
||||
createBorder (Rectangle wx wy ww wh) c = do
|
||||
bw <- asks (borderWidth.config)
|
||||
bc <- case c of
|
||||
Nothing -> asks (focusedBorderColor.config)
|
||||
Just s -> return s
|
||||
let rects = [ Rectangle wx wy ww (fi bw)
|
||||
, Rectangle wx wy (fi bw) wh
|
||||
, Rectangle wx (wy+fi wh-fi bw) ww (fi bw)
|
||||
, Rectangle (wx+fi ww-fi bw) wy (fi bw) wh
|
||||
]
|
||||
ws <- mapM (\r -> createNewWindow r Nothing bc False) rects
|
||||
showWindows ws
|
||||
maybe Nothing (\s -> Just s{W.down=W.down s ++ ws}) <$> getStackSet >>= replaceStack
|
||||
M.union (M.fromList $ zip ws $ map toRR rects) . W.floating . windowset <$> get >>= replaceFloating
|
||||
modify (\s -> s{mapped=mapped s `S.union` S.fromList ws})
|
||||
-- show <$> mapM isClient ws >>= debug
|
||||
return ws
|
||||
where toRR (Rectangle x y w h) = W.RationalRect (fi x) (fi y) (fi w) (fi h)
|
||||
|
||||
-- remove border line windows from stack + floating, kill
|
||||
removeBorder :: [Window] -> X ()
|
||||
removeBorder ws = do
|
||||
modify (\s -> s{mapped = mapped s `S.difference` S.fromList ws})
|
||||
flip (foldl (flip M.delete)) ws . W.floating . windowset <$> get >>= replaceFloating
|
||||
maybe Nothing (\s -> Just s{W.down=W.down s \\ ws}) <$> getStackSet >>= replaceStack
|
||||
deleteWindows ws
|
@@ -40,7 +40,7 @@ import qualified Data.Map as M
|
||||
--
|
||||
-- > import XMonad.Layout.BorderResize
|
||||
-- > myLayout = borderResize (... layout setup that reacts to SetGeometry ...)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
|
||||
type BorderBlueprint = (Rectangle, Glyph, BorderType)
|
||||
@@ -59,10 +59,8 @@ type RectWithBorders = (Rectangle, [BorderInfo])
|
||||
|
||||
data BorderResize a = BR (M.Map Window RectWithBorders) deriving (Show, Read)
|
||||
|
||||
brBorderOffset :: Position
|
||||
brBorderOffset = 5
|
||||
brBorderSize :: Dimension
|
||||
brBorderSize = 10
|
||||
brBorderSize = 2
|
||||
|
||||
borderResize :: l a -> ModifiedLayout BorderResize l a
|
||||
borderResize = ModifiedLayout (BR M.empty)
|
||||
@@ -147,10 +145,10 @@ createBorderLookupTable wrsLastTime = concat $ map processSingleEntry $ M.toList
|
||||
|
||||
prepareBorders :: Rectangle -> [BorderBlueprint]
|
||||
prepareBorders (Rectangle x y wh ht) =
|
||||
[((Rectangle (x + fi wh - brBorderOffset) y brBorderSize ht), xC_right_side , RightSideBorder),
|
||||
((Rectangle (x - brBorderOffset) y brBorderSize ht) , xC_left_side , LeftSideBorder),
|
||||
((Rectangle x (y - brBorderOffset) wh brBorderSize) , xC_top_side , TopSideBorder),
|
||||
((Rectangle x (y + fi ht - brBorderOffset) wh brBorderSize), xC_bottom_side, BottomSideBorder)
|
||||
[((Rectangle (x + fi wh - fi brBorderSize) y brBorderSize ht), xC_right_side , RightSideBorder),
|
||||
((Rectangle x y brBorderSize ht) , xC_left_side , LeftSideBorder),
|
||||
((Rectangle x y wh brBorderSize) , xC_top_side , TopSideBorder),
|
||||
((Rectangle x (y + fi ht - fi brBorderSize) wh brBorderSize), xC_bottom_side, BottomSideBorder)
|
||||
]
|
||||
|
||||
handleResize :: [(Window, (BorderType, Window, Rectangle))] -> Event -> X ()
|
||||
|
@@ -49,7 +49,7 @@ import qualified XMonad.StackSet as W
|
||||
-- Then edit your @layoutHook@ by adding the layout modifier:
|
||||
--
|
||||
-- > myLayout = boringWindows (Full ||| etc..)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- Then to your keybindings, add:
|
||||
--
|
||||
|
@@ -40,8 +40,8 @@ import XMonad.Layout.DecorationAddons
|
||||
-- Then edit your @layoutHook@ by adding the ButtonDecoration to
|
||||
-- your layout:
|
||||
--
|
||||
-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook defaultConfig)
|
||||
-- > main = xmonad defaultConfig { layoutHook = myL }
|
||||
-- > myL = buttonDeco shrinkText defaultThemeWithButtons (layoutHook def)
|
||||
-- > main = xmonad def { layoutHook = myL }
|
||||
--
|
||||
|
||||
buttonDeco :: (Eq a, Shrinker s) => s -> Theme
|
||||
|
@@ -32,7 +32,7 @@ import XMonad.StackSet (integrate, peek)
|
||||
-- Then edit your @layoutHook@ by adding the Circle layout:
|
||||
--
|
||||
-- > myLayout = Circle ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@@ -29,7 +29,7 @@ import Control.Monad( msum )
|
||||
-- Then edit your @layoutHook@ by adding one of the Cross layouts:
|
||||
--
|
||||
-- > myLayout = simpleCross ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
|
||||
-- apply a factor to a Rectangle Dimension
|
||||
|
@@ -17,7 +17,7 @@ module XMonad.Layout.Decoration
|
||||
( -- * Usage:
|
||||
-- $usage
|
||||
decoration
|
||||
, Theme (..), defaultTheme
|
||||
, Theme (..), defaultTheme, def
|
||||
, Decoration
|
||||
, DecorationMsg (..)
|
||||
, DecorationStyle (..)
|
||||
@@ -86,9 +86,8 @@ data Theme =
|
||||
-- Inner @[Bool]@ is a row in a icon bitmap.
|
||||
} deriving (Show, Read)
|
||||
|
||||
-- | The default xmonad 'Theme'.
|
||||
defaultTheme :: Theme
|
||||
defaultTheme =
|
||||
instance Default Theme where
|
||||
def =
|
||||
Theme { activeColor = "#999999"
|
||||
, inactiveColor = "#666666"
|
||||
, urgentColor = "#FFFF00"
|
||||
@@ -105,6 +104,11 @@ defaultTheme =
|
||||
, windowTitleIcons = []
|
||||
}
|
||||
|
||||
{-# DEPRECATED defaultTheme "Use def (from Data.Default, and re-exported by XMonad.Layout.Decoration) instead." #-}
|
||||
-- | The default xmonad 'Theme'.
|
||||
defaultTheme :: Theme
|
||||
defaultTheme = def
|
||||
|
||||
-- | A 'Decoration' layout modifier will handle 'SetTheme', a message
|
||||
-- to dynamically change the decoration 'Theme'.
|
||||
data DecorationMsg = SetTheme Theme deriving ( Typeable )
|
||||
|
@@ -68,7 +68,7 @@ titleBarButtonHandler mainw distFromLeft distFromRight = do
|
||||
|
||||
-- | Intended to be used together with 'titleBarButtonHandler'. See above.
|
||||
defaultThemeWithButtons :: Theme
|
||||
defaultThemeWithButtons = defaultTheme {
|
||||
defaultThemeWithButtons = def {
|
||||
windowTitleAddons = [ (" (M)", AlignLeft)
|
||||
, ("_" , AlignRightOffset minimizeButtonOffset)
|
||||
, ("[]" , AlignRightOffset maximizeButtonOffset)
|
||||
|
@@ -82,7 +82,7 @@ module XMonad.Layout.DecorationMadness
|
||||
, floatDwmStyle
|
||||
, floatSimpleTabbed
|
||||
, floatTabbed
|
||||
, defaultTheme, shrinkText
|
||||
, def, defaultTheme, shrinkText
|
||||
) where
|
||||
|
||||
import XMonad
|
||||
@@ -105,7 +105,7 @@ import XMonad.Layout.SimpleFloat
|
||||
--
|
||||
-- Then edit your @layoutHook@ by adding the layout you want:
|
||||
--
|
||||
-- > main = xmonad defaultConfig { layoutHook = someMadLayout }
|
||||
-- > main = xmonad def { layoutHook = someMadLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
@@ -113,7 +113,7 @@ import XMonad.Layout.SimpleFloat
|
||||
--
|
||||
-- You can also edit the default theme:
|
||||
--
|
||||
-- > myTheme = defaultTheme { inactiveBorderColor = "#FF0000"
|
||||
-- > myTheme = def { inactiveBorderColor = "#FF0000"
|
||||
-- > , activeTextColor = "#00FF00" }
|
||||
--
|
||||
-- and
|
||||
@@ -140,7 +140,7 @@ import XMonad.Layout.SimpleFloat
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefault.png>
|
||||
circleSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Circle Window
|
||||
circleSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Circle
|
||||
circleSimpleDefault = decoration shrinkText def DefaultDecoration Circle
|
||||
|
||||
-- | Similar to 'circleSimpleDefault' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -155,7 +155,7 @@ circleDefault s t = decoration s t DefaultDecoration Circle
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDeco.png>
|
||||
circleSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Circle Window
|
||||
circleSimpleDeco = decoration shrinkText defaultTheme (Simple True) Circle
|
||||
circleSimpleDeco = decoration shrinkText def (Simple True) Circle
|
||||
|
||||
-- | Similar to 'circleSimpleDece' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -172,7 +172,7 @@ circleDeco s t = decoration s t (Simple True) Circle
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDefaultResizable.png>
|
||||
circleSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
|
||||
circleSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Circle)
|
||||
circleSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Circle)
|
||||
|
||||
-- | Similar to 'circleSimpleDefaultResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -190,7 +190,7 @@ circleDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ win
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDecoResizable.png>
|
||||
circleSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Circle)) Window
|
||||
circleSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Circle)
|
||||
circleSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Circle)
|
||||
|
||||
-- | Similar to 'circleSimpleDecoResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -206,7 +206,7 @@ circleDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArra
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/circleSimpleDwmStyle.png>
|
||||
circleSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Circle Window
|
||||
circleSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Circle
|
||||
circleSimpleDwmStyle = decoration shrinkText def Dwm Circle
|
||||
|
||||
-- | Similar to 'circleSimpleDwmStyle' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -241,7 +241,7 @@ circleTabbed s t = tabBar s t Top (resizeVertical (fi $ decoHeight t) Circle)
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDefault.png>
|
||||
accordionSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Accordion Window
|
||||
accordionSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration Accordion
|
||||
accordionSimpleDefault = decoration shrinkText def DefaultDecoration Accordion
|
||||
|
||||
-- | Similar to 'accordionSimpleDefault' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -256,7 +256,7 @@ accordionDefault s t = decoration s t DefaultDecoration Accordion
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDeco.png>
|
||||
accordionSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Accordion Window
|
||||
accordionSimpleDeco = decoration shrinkText defaultTheme (Simple True) Accordion
|
||||
accordionSimpleDeco = decoration shrinkText def (Simple True) Accordion
|
||||
|
||||
-- | Similar to 'accordionSimpleDece' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -269,7 +269,7 @@ accordionDeco s t = decoration s t (Simple True) Accordion
|
||||
-- windows with the mouse, and resize\/move them with the keyboard.
|
||||
accordionSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
|
||||
accordionSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange Accordion)
|
||||
accordionSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange Accordion)
|
||||
|
||||
-- | Similar to 'accordionSimpleDefaultResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -283,7 +283,7 @@ accordionDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $
|
||||
-- windows with the mouse, and resize\/move them with the keyboard.
|
||||
accordionSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Accordion)) Window
|
||||
accordionSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange Accordion)
|
||||
accordionSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange Accordion)
|
||||
|
||||
-- | Similar to 'accordionSimpleDecoResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -299,7 +299,7 @@ accordionDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowA
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/accordionSimpleDwmStyle.png>
|
||||
accordionSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Accordion Window
|
||||
accordionSimpleDwmStyle = decoration shrinkText defaultTheme Dwm Accordion
|
||||
accordionSimpleDwmStyle = decoration shrinkText def Dwm Accordion
|
||||
|
||||
-- | Similar to 'accordionSimpleDwmStyle' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -337,7 +337,7 @@ tall = Tall 1 (3/100) (1/2)
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefault.png>
|
||||
tallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) Tall Window
|
||||
tallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration tall
|
||||
tallSimpleDefault = decoration shrinkText def DefaultDecoration tall
|
||||
|
||||
-- | Similar to 'tallSimpleDefault' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -352,7 +352,7 @@ tallDefault s t = decoration s t DefaultDecoration tall
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDeco.png>
|
||||
tallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) Tall Window
|
||||
tallSimpleDeco = decoration shrinkText defaultTheme (Simple True) tall
|
||||
tallSimpleDeco = decoration shrinkText def (Simple True) tall
|
||||
|
||||
-- | Similar to 'tallSimpleDece' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -369,7 +369,7 @@ tallDeco s t = decoration s t (Simple True) tall
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDefaultResizable.png>
|
||||
tallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
|
||||
tallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange tall)
|
||||
tallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange tall)
|
||||
|
||||
-- | Similar to 'tallSimpleDefaultResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -387,7 +387,7 @@ tallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $ windo
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDecoResizable.png>
|
||||
tallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger Tall)) Window
|
||||
tallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange tall)
|
||||
tallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange tall)
|
||||
|
||||
-- | Similar to 'tallSimpleDecoResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -403,7 +403,7 @@ tallDecoResizable s t = decoration s t (Simple True) (mouseResize $ windowArrang
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/tallSimpleDwmStyle.png>
|
||||
tallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) Tall Window
|
||||
tallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm tall
|
||||
tallSimpleDwmStyle = decoration shrinkText def Dwm tall
|
||||
|
||||
-- | Similar to 'tallSimpleDwmStyle' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -440,7 +440,7 @@ mirrorTall = Mirror tall
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefault.png>
|
||||
mirrorTallSimpleDefault :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker) (Mirror Tall) Window
|
||||
mirrorTallSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration mirrorTall
|
||||
mirrorTallSimpleDefault = decoration shrinkText def DefaultDecoration mirrorTall
|
||||
|
||||
-- | Similar to 'mirrorTallSimpleDefault' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -455,7 +455,7 @@ mirrorTallDefault s t = decoration s t DefaultDecoration mirrorTall
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDeco.png>
|
||||
mirrorTallSimpleDeco :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker) (Mirror Tall) Window
|
||||
mirrorTallSimpleDeco = decoration shrinkText defaultTheme (Simple True) mirrorTall
|
||||
mirrorTallSimpleDeco = decoration shrinkText def (Simple True) mirrorTall
|
||||
|
||||
-- | Similar to 'mirrorTallSimpleDece' but with the possibility of
|
||||
-- setting a custom shrinker and a custom theme.
|
||||
@@ -472,7 +472,7 @@ mirrorTallDeco s t = decoration s t (Simple True) mirrorTall
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDefaultResizable.png>
|
||||
mirrorTallSimpleDefaultResizable :: ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
|
||||
mirrorTallSimpleDefaultResizable = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrange mirrorTall)
|
||||
mirrorTallSimpleDefaultResizable = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrange mirrorTall)
|
||||
|
||||
-- | Similar to 'mirrorTallSimpleDefaultResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -490,7 +490,7 @@ mirrorTallDefaultResizable s t = decoration s t DefaultDecoration (mouseResize $
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDecoResizable.png>
|
||||
mirrorTallSimpleDecoResizable :: ModifiedLayout (Decoration SimpleDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger (Mirror Tall))) Window
|
||||
mirrorTallSimpleDecoResizable = decoration shrinkText defaultTheme (Simple True) (mouseResize $ windowArrange mirrorTall)
|
||||
mirrorTallSimpleDecoResizable = decoration shrinkText def (Simple True) (mouseResize $ windowArrange mirrorTall)
|
||||
|
||||
-- | Similar to 'mirrorTallSimpleDecoResizable' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -506,7 +506,7 @@ mirrorTallDecoResizable s t = decoration s t (Simple True) (mouseResize $ window
|
||||
--
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/mirrorTallSimpleDwmStyle.png>
|
||||
mirrorTallSimpleDwmStyle :: ModifiedLayout (Decoration DwmStyle DefaultShrinker) (Mirror Tall) Window
|
||||
mirrorTallSimpleDwmStyle = decoration shrinkText defaultTheme Dwm mirrorTall
|
||||
mirrorTallSimpleDwmStyle = decoration shrinkText def Dwm mirrorTall
|
||||
|
||||
-- | Similar to 'mirrorTallSimpleDwmStyle' but with the
|
||||
-- possibility of setting a custom shrinker and a custom theme.
|
||||
@@ -555,7 +555,7 @@ floatSimple = simpleFloat'
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDefault.png>
|
||||
floatSimpleDefault :: (Show a, Eq a) => ModifiedLayout (Decoration DefaultDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
|
||||
floatSimpleDefault = decoration shrinkText defaultTheme DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20)
|
||||
floatSimpleDefault = decoration shrinkText def DefaultDecoration (mouseResize $ windowArrangeAll $ SF 20)
|
||||
|
||||
-- | Same as 'floatSimpleDefault', but with the possibility of setting a
|
||||
-- custom shrinker and a custom theme.
|
||||
@@ -572,7 +572,7 @@ floatDefault s t = decoration s t DefaultDecoration (mouseResize $ windowArrange
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleDwmStyle.png>
|
||||
floatSimpleDwmStyle :: (Show a, Eq a) => ModifiedLayout (Decoration DwmStyle DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
|
||||
floatSimpleDwmStyle = decoration shrinkText defaultTheme Dwm (mouseResize $ windowArrangeAll $ SF 20)
|
||||
floatSimpleDwmStyle = decoration shrinkText def Dwm (mouseResize $ windowArrangeAll $ SF 20)
|
||||
|
||||
-- | Same as 'floatSimpleDwmStyle', but with the possibility of setting a
|
||||
-- custom shrinker and a custom theme.
|
||||
@@ -589,7 +589,7 @@ floatDwmStyle s t = decoration s t Dwm (mouseResize $ windowArrangeAll $ SF (dec
|
||||
-- <http://code.haskell.org/~arossato/xmonadShots/floatSimpleTabbed.png>
|
||||
floatSimpleTabbed :: (Show a, Eq a) => ModifiedLayout (Decoration TabBarDecoration DefaultShrinker)
|
||||
(ModifiedLayout MouseResize (ModifiedLayout WindowArranger SimpleFloat)) a
|
||||
floatSimpleTabbed = tabBar shrinkText defaultTheme Top (mouseResize $ windowArrangeAll $ SF 20)
|
||||
floatSimpleTabbed = tabBar shrinkText def Top (mouseResize $ windowArrangeAll $ SF 20)
|
||||
|
||||
-- | Same as 'floatSimpleTabbed', but with the possibility of setting a
|
||||
-- custom shrinker and a custom theme.
|
||||
|
@@ -33,7 +33,7 @@ import Control.Monad (ap)
|
||||
-- Then edit your @layoutHook@ by adding the Dishes layout:
|
||||
--
|
||||
-- > myLayout = Dishes 2 (1/6) ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@@ -41,7 +41,7 @@ import XMonad.Util.XUtils
|
||||
-- Then edit your @layoutHook@ by adding the DragPane layout:
|
||||
--
|
||||
-- > myLayout = dragPane Horizontal 0.1 0.5 ||| Full ||| etc..
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- For more detailed instructions on editing the layoutHook see:
|
||||
--
|
||||
|
@@ -48,7 +48,7 @@ import XMonad.Layout.Reflect
|
||||
-- > where
|
||||
-- > drawer = simpleDrawer 0.01 0.3 (ClassName "Rhythmbox" `Or` ClassName "Xchat")
|
||||
-- >
|
||||
-- > main = xmonad defaultConfig { layoutHook = myLayout }
|
||||
-- > main = xmonad def { layoutHook = myLayout }
|
||||
--
|
||||
-- This will place the Rhythmbox and Xchat windows in at the top of the screen
|
||||
-- only when using the 'Tall' layout. See "XMonad.Util.WindowProperties" for
|
||||
|
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user