mirror of
https://github.com/xmonad/xmonad.git
synced 2025-07-26 01:31:53 -07:00
Compare commits
737 Commits
Author | SHA1 | Date | |
---|---|---|---|
|
8113e0fe55 | ||
|
fa8f34596d | ||
|
799b0dc199 | ||
|
8ff0fb7b52 | ||
|
7a93f11bfd | ||
|
c605d09681 | ||
|
ebf265a84c | ||
|
da4ef9ea37 | ||
|
0d90d183a7 | ||
|
756643c30e | ||
|
ca1ba91360 | ||
|
f2d1efbb6f | ||
|
4173227e04 | ||
|
3a37d4c1f8 | ||
|
bd99fd5f34 | ||
|
e9e1ad3190 | ||
|
07d95ad8fc | ||
|
39ae48970c | ||
|
eae89e25f9 | ||
|
ab6648ca8f | ||
|
5d73d294d4 | ||
|
1c57ed4c9a | ||
|
30d3f7159b | ||
|
81cf71d7c6 | ||
|
eba9e97794 | ||
|
aadb8df59b | ||
|
053c798085 | ||
|
a4140b9349 | ||
|
dad56b04f5 | ||
|
a58ccac7ba | ||
|
b1d9884d2d | ||
|
2ba1258cc1 | ||
|
bcf3bf6c77 | ||
|
8b54c11558 | ||
|
7de2d3e969 | ||
|
cfbf1ad51d | ||
|
21028ad648 | ||
|
4be171810c | ||
|
edadb427e7 | ||
|
38a303ea3e | ||
|
4620a705b4 | ||
|
7d588210e2 | ||
|
f09d7aa641 | ||
|
cde1a25bca | ||
|
383e3d6f47 | ||
|
81a80b8a5d | ||
|
ce22dbf7db | ||
|
88102c0afb | ||
|
804bef7bcf | ||
|
746880e9b9 | ||
|
82a7762f81 | ||
|
459f6afeca | ||
|
88b4ad3c13 | ||
|
7cb14762cb | ||
|
0ed6a2377e | ||
|
e5548547e3 | ||
|
4b9ef59706 | ||
|
5cf87c75cd | ||
|
c3acee78d0 | ||
|
1396343a58 | ||
|
c9334fbae7 | ||
|
c496c31158 | ||
|
31f63bb162 | ||
|
ddb4292d5a | ||
|
765e059470 | ||
|
c4cf4715f7 | ||
|
fa124f5658 | ||
|
855ff2f73c | ||
|
5a04fa185d | ||
|
706f54862c | ||
|
1d43cd203f | ||
|
8421b100dd | ||
|
0156e2963b | ||
|
32afd5e7e8 | ||
|
404e50d560 | ||
|
05d6037f53 | ||
|
2f58567912 | ||
|
f2aa84e102 | ||
|
2b7e278f7f | ||
|
bd69d20d01 | ||
|
35fa7bf4a2 | ||
|
a239a00977 | ||
|
afb66dd55c | ||
|
1b7dea7acc | ||
|
8e820945f4 | ||
|
21cc6ebd93 | ||
|
050ba6420d | ||
|
67b5510dde | ||
|
327c2cf0c1 | ||
|
96b3628b54 | ||
|
dc4d304802 | ||
|
c264e4cdb3 | ||
|
bb895d8415 | ||
|
897597463a | ||
|
937493256d | ||
|
8ec512b437 | ||
|
e563e01a5f | ||
|
0e4c1e6837 | ||
|
5c2ba06902 | ||
|
efffa8946a | ||
|
431bb4b57c | ||
|
3c80296733 | ||
|
f289b3b134 | ||
|
0932779f15 | ||
|
9138046ec5 | ||
|
a24e9b4c7f | ||
|
1aac6611d8 | ||
|
51e507e953 | ||
|
10abd059b7 | ||
|
d4c607c4f9 | ||
|
28bc7dacde | ||
|
b7a76a5e8c | ||
|
58f3e8c6f1 | ||
|
00045cfc2a | ||
|
69134f9e8a | ||
|
025a78508c | ||
|
b03fa7a67b | ||
|
64fbf6a09d | ||
|
eeac754ac7 | ||
|
5ee76ca48f | ||
|
aa9dd2696a | ||
|
19cba6b25f | ||
|
a09ca446fb | ||
|
5641038500 | ||
|
990555c8ab | ||
|
a207e30751 | ||
|
970893f556 | ||
|
460096dfc5 | ||
|
0817c6a7ff | ||
|
b59473b016 | ||
|
c2aeaffc03 | ||
|
7f95f5ef07 | ||
|
57b715972b | ||
|
a9866836d9 | ||
|
099233812e | ||
|
9cb13bdd3d | ||
|
86bb4d2a21 | ||
|
30103efbc8 | ||
|
a16541b834 | ||
|
202fecf7ba | ||
|
dd1e02555e | ||
|
4931bc4e41 | ||
|
67267b7346 | ||
|
4806b51a23 | ||
|
98e5d1583d | ||
|
dc48e9e9c9 | ||
|
572d02d8e8 | ||
|
f53db04285 | ||
|
2324d21202 | ||
|
f2c9c75f67 | ||
|
1364ee4b1f | ||
|
a17fa0d28b | ||
|
b394435443 | ||
|
faf5cf7b27 | ||
|
9d0fd62cb2 | ||
|
386d4e6295 | ||
|
ea295dabcc | ||
|
4b3e5e0d07 | ||
|
4b2107a07a | ||
|
3ae5f46052 | ||
|
f734f19c1a | ||
|
391c0fc0c9 | ||
|
5ecdf7591d | ||
|
301428e5df | ||
|
63f73e18f9 | ||
|
57c3a13125 | ||
|
e6329968ff | ||
|
c1670303c0 | ||
|
1d1c012cb9 | ||
|
a19ffb0404 | ||
|
5aa70bd88a | ||
|
2502fd8d55 | ||
|
d0942e37ad | ||
|
40f8246080 | ||
|
be8fd7fdc9 | ||
|
6e35910b62 | ||
|
2f2d105098 | ||
|
cd86480ff7 | ||
|
5c7c28060c | ||
|
78719507a9 | ||
|
f4d25fcef4 | ||
|
314390937c | ||
|
cf4d6f31b1 | ||
|
044d9244e5 | ||
|
ab99c17a68 | ||
|
d170e99bc5 | ||
|
96452213f4 | ||
|
c19eb06807 | ||
|
6d7da8dc25 | ||
|
f96b3f0398 | ||
|
34f257ad6f | ||
|
f94ad61a27 | ||
|
3977a7a4e2 | ||
|
3cd839f0ac | ||
|
a9abc4e09c | ||
|
25a4ed69da | ||
|
262dc4779f | ||
|
a2259bb309 | ||
|
3d8238b35d | ||
|
fd9de8903f | ||
|
fb1f33258e | ||
|
d0f12af1ae | ||
|
df6b40c980 | ||
|
b771abeadc | ||
|
2db596fbe8 | ||
|
0f31b24bd2 | ||
|
5cdddab1f1 | ||
|
488b52ffaa | ||
|
83a8bb8d51 | ||
|
b06d885e76 | ||
|
a13a1dcee8 | ||
|
8965e41d06 | ||
|
28afc9bdc6 | ||
|
23f36d7e23 | ||
|
117583e473 | ||
|
bf6e66b100 | ||
|
366c09b3d7 | ||
|
ed5c8667b1 | ||
|
1695aeb28a | ||
|
521e8356fc | ||
|
45a89130d9 | ||
|
79602bfec5 | ||
|
711b28f494 | ||
|
0edb65107b | ||
|
845d770f35 | ||
|
3f1a37f216 | ||
|
165e25f9e0 | ||
|
9189d002dd | ||
|
29475fa7f8 | ||
|
e5a258f19c | ||
|
0c8ed88d8a | ||
|
9442871016 | ||
|
adb363a480 | ||
|
3d65a37c7e | ||
|
54d921c5a6 | ||
|
f61fdbaf0c | ||
|
d88643c639 | ||
|
eaaf0aafcd | ||
|
23df88d778 | ||
|
90d0ca4a2e | ||
|
f3f0c712d8 | ||
|
a5b708ba00 | ||
|
6fc90cd9d3 | ||
|
3009304352 | ||
|
5dd964e109 | ||
|
90c719148b | ||
|
831ca49331 | ||
|
2c9e24e0f6 | ||
|
a854cdaf9b | ||
|
c2904425e9 | ||
|
89ea1356c1 | ||
|
f4a5b88e64 | ||
|
906b9d34b3 | ||
|
c537a0658a | ||
|
8546ea095b | ||
|
c2e632a2b9 | ||
|
b6af6bb86a | ||
|
eee0a0dc39 | ||
|
0f5b5c2297 | ||
|
e25d090112 | ||
|
eb2ee340e4 | ||
|
79278d9475 | ||
|
dbe9c4f799 | ||
|
f6e4e278b5 | ||
|
673de33436 | ||
|
a5b6e09985 | ||
|
bb448cc293 | ||
|
ae4c5e26be | ||
|
54df2e9acd | ||
|
7f6d758ce5 | ||
|
9f64c2ca90 | ||
|
9849800dc5 | ||
|
a902fefaf1 | ||
|
0f708e76b1 | ||
|
6e6f562b0d | ||
|
12d1b31d6c | ||
|
b92bd28d97 | ||
|
e1daf46c75 | ||
|
a8e1249ba7 | ||
|
e3824687c7 | ||
|
c979ee67c0 | ||
|
6c92dd22ad | ||
|
66ac855959 | ||
|
7fab71f5f0 | ||
|
055dce10af | ||
|
292f19eab8 | ||
|
a204c9ed04 | ||
|
78f1a8e716 | ||
|
72794d92b1 | ||
|
546d0b5ddb | ||
|
a03b6e86de | ||
|
856c8b2c8d | ||
|
dbd441cc1b | ||
|
2e89e5ed23 | ||
|
0ebedbb533 | ||
|
c2a1a3c0a6 | ||
|
7d10e470d7 | ||
|
6608f0012b | ||
|
bc8f7ff133 | ||
|
7845145706 | ||
|
79afdfbbb9 | ||
|
8774081c15 | ||
|
60f36e78ba | ||
|
b198b80559 | ||
|
6bbd8b869e | ||
|
97aeb8577c | ||
|
0be6d2bec5 | ||
|
b1fef9b18c | ||
|
b5b95e27ce | ||
|
4e30ef13a7 | ||
|
d92125485a | ||
|
33a86c0cdb | ||
|
3bb653bf9c | ||
|
ebce32d891 | ||
|
b3bd9c90d1 | ||
|
5da25c5413 | ||
|
11d76e284c | ||
|
6d661203d3 | ||
|
30c2eeeeb3 | ||
|
d66e71d464 | ||
|
5c7e61def2 | ||
|
eb48bb4aef | ||
|
5eff329fc6 | ||
|
183e14725f | ||
|
0ab42d4228 | ||
|
52a5e7ca8c | ||
|
f89df98f40 | ||
|
30719202b9 | ||
|
aa18707c3e | ||
|
b77ba03ed9 | ||
|
be1d2269ce | ||
|
7bdc7ab9dc | ||
|
ae97c1f107 | ||
|
782ac25b8e | ||
|
8aa0d4a3e0 | ||
|
1f8e5b43e1 | ||
|
9813e218b0 | ||
|
403e4df624 | ||
|
aa35ea1856 | ||
|
3b6d00ba91 | ||
|
befc4bc8d8 | ||
|
6c31aad683 | ||
|
3e76270245 | ||
|
3a414660fc | ||
|
453010bb6d | ||
|
2ac8f0ea27 | ||
|
ad7288030f | ||
|
206fc918bb | ||
|
f5a60f82ee | ||
|
a1ee3b4530 | ||
|
89218fc57d | ||
|
71af4239bd | ||
|
f1d6316526 | ||
|
92d01e37a0 | ||
|
101c7052f4 | ||
|
7b7feeca42 | ||
|
cbe7ee7c03 | ||
|
8adb8463ab | ||
|
256eb29ef1 | ||
|
4ba9c8b8c1 | ||
|
98173777fe | ||
|
05aeef0dc2 | ||
|
85787ce059 | ||
|
d64aeba80f | ||
|
72cbe0667d | ||
|
af354f7528 | ||
|
1a4c95fac8 | ||
|
42d319545b | ||
|
2e6eb9068d | ||
|
13849c6230 | ||
|
6a7eb85e84 | ||
|
2a3c358533 | ||
|
28637d0db7 | ||
|
b14b3ffcec | ||
|
bbb4a0ef25 | ||
|
9db74715f2 | ||
|
5b064f474d | ||
|
bffa6dc2ce | ||
|
341dea5907 | ||
|
676530307b | ||
|
09425bbe43 | ||
|
1805666e9d | ||
|
40cd2081da | ||
|
66514127f3 | ||
|
fdc3bf0484 | ||
|
f97d2527ff | ||
|
7199d953a7 | ||
|
15653d4669 | ||
|
d64a22d8db | ||
|
2e9f8dc831 | ||
|
e8bfc5bb69 | ||
|
9e5b16ed8a | ||
|
d72da951c9 | ||
|
90101613e7 | ||
|
6caac22df1 | ||
|
e9987b1adf | ||
|
383ffb772e | ||
|
6379307baa | ||
|
d620639f7d | ||
|
a5cee9bac2 | ||
|
131fd3669f | ||
|
56f810d182 | ||
|
46f637e0be | ||
|
095d0e37d6 | ||
|
7e798afd11 | ||
|
669a9aed9e | ||
|
c869129c71 | ||
|
b8523a3c9b | ||
|
400730fe3b | ||
|
6c5204b91c | ||
|
910d99cb74 | ||
|
031bbd6230 | ||
|
05e8c204e9 | ||
|
2c91ea1621 | ||
|
5cdf428f55 | ||
|
22b579bd14 | ||
|
14d9fa247a | ||
|
cfe99998fc | ||
|
9fce3805fc | ||
|
fd243ca1c1 | ||
|
c90df53081 | ||
|
e4659c2475 | ||
|
caae51c399 | ||
|
fb390fa9cc | ||
|
4a0b166998 | ||
|
b9ce5b034b | ||
|
a90558c07e | ||
|
56b0f850bc | ||
|
51a179dc68 | ||
|
8a8d5f71b1 | ||
|
4b69a456cc | ||
|
e12d0be1b2 | ||
|
002326ceb1 | ||
|
758e3d85e6 | ||
|
f5bd77a7f8 | ||
|
519c79a57e | ||
|
0aa40480f9 | ||
|
36dd6afb49 | ||
|
3015968ee4 | ||
|
5bb6c88b41 | ||
|
f875a56620 | ||
|
70a75e5e3f | ||
|
735fb58f6c | ||
|
e8f48b77f9 | ||
|
e363c44bb0 | ||
|
ec1c3e0159 | ||
|
2a1a18023a | ||
|
ff738988d3 | ||
|
fc4657d529 | ||
|
bd961b7866 | ||
|
3df77d6f20 | ||
|
b59c768cdd | ||
|
a37a3cb6e8 | ||
|
823581816a | ||
|
3ea0d74954 | ||
|
b3c860b892 | ||
|
958e701bf4 | ||
|
28e75da77f | ||
|
a812869c0c | ||
|
96fb01b9be | ||
|
6fa0bb7d4f | ||
|
0a040cbc96 | ||
|
96d4f1fe85 | ||
|
30f2d9f325 | ||
|
5be975b4f2 | ||
|
22c370a068 | ||
|
c3e032e08e | ||
|
2c3bf17dfb | ||
|
a926b68838 | ||
|
6dc1e319d1 | ||
|
0db71d552a | ||
|
f52ed1d19e | ||
|
ffcb01ad80 | ||
|
66d2241703 | ||
|
11814bfec3 | ||
|
bbc1c010ed | ||
|
eeeae810ae | ||
|
3c6f52a349 | ||
|
40466b2be2 | ||
|
6a4a742feb | ||
|
f8b243b66e | ||
|
fa9a3abe49 | ||
|
78b967198b | ||
|
68574be2cf | ||
|
2ab37aa4a4 | ||
|
5ab9fede6c | ||
|
a81ba4ba53 | ||
|
b65728032d | ||
|
e747377775 | ||
|
d6f88918de | ||
|
21cd920b61 | ||
|
bb13853929 | ||
|
3d1720c3f3 | ||
|
0614ffb65c | ||
|
85b47fc3ac | ||
|
1a99280227 | ||
|
e8133eb9a6 | ||
|
4ccaff8f25 | ||
|
56dc186e68 | ||
|
10b2efe81c | ||
|
49c69fa73b | ||
|
120ebce490 | ||
|
c0cf91303f | ||
|
80f1c6f027 | ||
|
c54e7088f0 | ||
|
1f3a27f9b9 | ||
|
ec97d83f3f | ||
|
f0975b734c | ||
|
2324266fae | ||
|
3b0559c6cc | ||
|
886a0d4041 | ||
|
98f39eabc1 | ||
|
425c3c0872 | ||
|
29c9819daa | ||
|
3c2b09c213 | ||
|
64a660894d | ||
|
27b1ce9dd7 | ||
|
5caf235f6b | ||
|
4ef9c12d13 | ||
|
d6705fd595 | ||
|
7c1065c43f | ||
|
af104509c3 | ||
|
586ee75a9a | ||
|
013da018a1 | ||
|
71cb355948 | ||
|
19069b3d4b | ||
|
969fca9406 | ||
|
61f00e65f1 | ||
|
db11089e70 | ||
|
e601a7d16d | ||
|
0dd23bddfa | ||
|
55b14d4850 | ||
|
9df514b378 | ||
|
b6d92b4e38 | ||
|
ecf1a0ca0d | ||
|
d216e95f97 | ||
|
af3d3818c8 | ||
|
d065038c8a | ||
|
10bc213349 | ||
|
d22d93b43f | ||
|
871a80fee7 | ||
|
2d59f5157c | ||
|
0738262d9e | ||
|
63d6a66133 | ||
|
fe6215d309 | ||
|
c3cb4ad65f | ||
|
126f891d11 | ||
|
d3383ce0f5 | ||
|
c96a59fa0d | ||
|
12a45b4b99 | ||
|
462957b2f0 | ||
|
3ec3536761 | ||
|
179b6a30f4 | ||
|
3dc65c3d2e | ||
|
2e6312776b | ||
|
3897cab7c9 | ||
|
0c97a89754 | ||
|
5afdc16387 | ||
|
10b843ad21 | ||
|
bc320b69da | ||
|
89a8cc88c3 | ||
|
76f4a16258 | ||
|
8f2eb540d7 | ||
|
ba2d75b930 | ||
|
acf0652952 | ||
|
e4d231920c | ||
|
980828feea | ||
|
2e5ae02059 | ||
|
50eb1844eb | ||
|
f18bda7dc7 | ||
|
2d8cad02fe | ||
|
2baab28602 | ||
|
ef65f901ce | ||
|
f2da028ff9 | ||
|
bad3ce7a5e | ||
|
e1c555e3e6 | ||
|
ab20f7df8d | ||
|
a70bf6a6a3 | ||
|
f58b2399bd | ||
|
91d23656a3 | ||
|
d6b6189cc1 | ||
|
0248e3c9fa | ||
|
40fc10b6a5 | ||
|
3a140badf5 | ||
|
2b103ede55 | ||
|
4565e2c90e | ||
|
285ee2f836 | ||
|
7e9c9ccb1f | ||
|
dc078490d0 | ||
|
202e239ea4 | ||
|
e159ec36fe | ||
|
0b1ccc75ef | ||
|
b0f9a3d0b9 | ||
|
75d297a633 | ||
|
5f5e737d9c | ||
|
a39ed3ee1b | ||
|
e05a046bca | ||
|
12ddc800ab | ||
|
2fab1bb9f5 | ||
|
1b17d1c378 | ||
|
f490ced673 | ||
|
0919ecfbde | ||
|
41b7b1341e | ||
|
0f0aa5e8cb | ||
|
ad4417c8e0 | ||
|
b0f7643cc5 | ||
|
8b055621e9 | ||
|
dc6a972bc1 | ||
|
e4a3eede18 | ||
|
a0ffe7e47d | ||
|
b00b94fda7 | ||
|
45a78ba802 | ||
|
4c0717e9cc | ||
|
30b4ff5e40 | ||
|
b68ebc797a | ||
|
eb4ef5b23f | ||
|
73224be21b | ||
|
7e287ec815 | ||
|
60f472faa2 | ||
|
bd72c6e1e2 | ||
|
b5402e76d3 | ||
|
39dc00b16f | ||
|
038f77de5a | ||
|
59e731ea11 | ||
|
3ce9dcbbb5 | ||
|
f25afdab9f | ||
|
577d5ae968 | ||
|
29bcd465c2 | ||
|
307b82a53d | ||
|
197b0091f8 | ||
|
69c5dae00d | ||
|
28c3482411 | ||
|
73ee008cf6 | ||
|
82a1cae123 | ||
|
d01b913594 | ||
|
d9e3ebf531 | ||
|
252c9d5eee | ||
|
5f0b1601d5 | ||
|
d60791e3f5 | ||
|
f0054fdde7 | ||
|
a9de363b14 | ||
|
7eb6ba0126 | ||
|
f03d2cdf74 | ||
|
16c0cb9a33 | ||
|
fdf3fb2c58 | ||
|
22d5e7eaa3 | ||
|
f837b830fc | ||
|
939c0558e6 | ||
|
fbd406eb03 | ||
|
ecde376224 | ||
|
edf3394821 | ||
|
20be322b08 | ||
|
f8f53fdff8 | ||
|
1da1e2e21e | ||
|
4026075bc6 | ||
|
8863761d66 | ||
|
d67dcd8c4b | ||
|
aa84841289 | ||
|
d10abdcdd0 | ||
|
3073826dfc | ||
|
daed0062c6 | ||
|
abd737cfb4 | ||
|
e719be4e69 | ||
|
ec1a20c727 | ||
|
8f039ec434 | ||
|
057fcc5162 | ||
|
8e7634f543 | ||
|
40cb12ce17 | ||
|
b803fd74a5 | ||
|
d386a230f6 | ||
|
e87456ab77 | ||
|
cdc22f0849 | ||
|
70413b2e22 | ||
|
67ffde0dfb | ||
|
d904fb1cc4 | ||
|
4120be8ba0 | ||
|
e015155131 | ||
|
4c1536cd18 | ||
|
a34a5e979a | ||
|
38faddf9de | ||
|
3ab2b28711 | ||
|
934ff6a562 | ||
|
f8b07d8956 | ||
|
67d436a4e6 | ||
|
c6fef373dc | ||
|
2d4f304c0a | ||
|
1df8ea3d0e | ||
|
490719c035 | ||
|
3cd001e8df | ||
|
b0dda7b351 | ||
|
d8495adf0d | ||
|
06f35a650e | ||
|
56f5ecb320 | ||
|
ff674a27e2 | ||
|
6c51745122 | ||
|
108c2280ef | ||
|
e70b489936 | ||
|
450c3a34fe | ||
|
32f416a3c2 | ||
|
4be3b39cd2 | ||
|
75889ab62e | ||
|
792add376e | ||
|
87c50a911f | ||
|
d16aa9975e | ||
|
f34642cbac | ||
|
008c3638a5 | ||
|
f5c40e9e12 | ||
|
bd82cc9150 | ||
|
a025912ab7 | ||
|
19c1759b35 | ||
|
92acd1eb74 | ||
|
db9f39d6af | ||
|
ebcd67efac | ||
|
387a253f62 | ||
|
4c83e8e097 | ||
|
ae59a5184f | ||
|
fa8fe9aca4 | ||
|
673c3e9ed9 | ||
|
6ba45cdb38 | ||
|
b995b430bc | ||
|
ba482a4611 | ||
|
684907bc77 | ||
|
ad4136df26 | ||
|
defe0c282e | ||
|
c7bdac1a7e | ||
|
17799f131a | ||
|
8cd66aa380 | ||
|
32ba0d4a0d | ||
|
77b3f62610 | ||
|
f3b07eb5dc | ||
|
4372c256ed | ||
|
34239a79de | ||
|
5866db4f0f | ||
|
46d039cde5 | ||
|
dd22717961 | ||
|
0beeb4164b | ||
|
0b435028ff |
30
.github/ISSUE_TEMPLATE.md
vendored
Normal file
30
.github/ISSUE_TEMPLATE.md
vendored
Normal file
@@ -0,0 +1,30 @@
|
||||
### Problem Description
|
||||
|
||||
Describe the problem you are having and what you expect to happen
|
||||
instead.
|
||||
|
||||
### Steps to Reproduce
|
||||
|
||||
Give detailed step-by-step instructions on how to reproduce the problem.
|
||||
|
||||
### Configuration File
|
||||
|
||||
Please include the smallest _full_ configuration file that reproduces
|
||||
the problem you are experiencing:
|
||||
|
||||
```haskell
|
||||
module Main (main) where
|
||||
|
||||
import XMonad
|
||||
|
||||
main :: IO ()
|
||||
main = xmonad def
|
||||
```
|
||||
|
||||
### Checklist
|
||||
|
||||
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
|
||||
|
||||
- I tested my configuration
|
||||
- [ ] With `xmonad` version XXX (commit XXX if using git)
|
||||
- [ ] With `xmonad-contrib` version XXX (commit XXX if using git)
|
15
.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
15
.github/PULL_REQUEST_TEMPLATE.md
vendored
Normal file
@@ -0,0 +1,15 @@
|
||||
### Description
|
||||
|
||||
Include a description for your changes, including the motivation
|
||||
behind them.
|
||||
|
||||
### Checklist
|
||||
|
||||
- [ ] I've read [CONTRIBUTING.md](https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md)
|
||||
|
||||
- [ ] I've confirmed these changes don't belong in xmonad-contrib instead
|
||||
|
||||
- [ ] I've considered how to best test these changes (property, unit,
|
||||
manually, ...) and concluded: XXX
|
||||
|
||||
- [ ] I updated the `CHANGES.md` file
|
6
.github/dependabot.yml
vendored
Normal file
6
.github/dependabot.yml
vendored
Normal file
@@ -0,0 +1,6 @@
|
||||
version: 2
|
||||
updates:
|
||||
- package-ecosystem: "github-actions"
|
||||
directory: "/"
|
||||
schedule:
|
||||
interval: "weekly"
|
33
.github/workflows/generatemanpage.yml
vendored
Normal file
33
.github/workflows/generatemanpage.yml
vendored
Normal file
@@ -0,0 +1,33 @@
|
||||
name: Generate manpage
|
||||
|
||||
on:
|
||||
push:
|
||||
branches:
|
||||
- master
|
||||
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Install dependencies
|
||||
run: |
|
||||
set -ex
|
||||
sudo apt install -y pandoc
|
||||
|
||||
- name: Generate manpage
|
||||
run: |
|
||||
set -ex
|
||||
for d in /opt/ghc/*/bin; do PATH="$d:$PATH"; break; done
|
||||
make -B -C man
|
||||
|
||||
- name: Commit/push if changed
|
||||
run: |
|
||||
set -ex
|
||||
git config user.name 'github-actions[bot]'
|
||||
git config user.email '41898282+github-actions[bot]@users.noreply.github.com'
|
||||
git diff --quiet --exit-code && exit
|
||||
git commit -a -m 'man: Update'
|
||||
git push
|
139
.github/workflows/haskell-ci-hackage.patch
vendored
Normal file
139
.github/workflows/haskell-ci-hackage.patch
vendored
Normal file
@@ -0,0 +1,139 @@
|
||||
Piggy-back on the haskell-ci workflow for automatic releases to Hackage.
|
||||
|
||||
This extends the workflow with two additional triggers:
|
||||
|
||||
* When the Haskell-CI workflow is triggered manually with a non-empty version
|
||||
input (matching the version in the cabal file), a candidate release is
|
||||
uploaded to Hackage and docs are submitted for it as Hackage can't build
|
||||
them itself (https://github.com/haskell/hackage-server/issues/925).
|
||||
|
||||
Note that promoting the candidate on Hackage discards the uploaded docs
|
||||
(https://github.com/haskell/hackage-server/issues/70). Don't do that.
|
||||
|
||||
* When a release is created on GitHub, a final release is uploaded to Hackage
|
||||
and docs are submitted for it.
|
||||
|
||||
The automation uses a special Hackage user: https://hackage.haskell.org/user/xmonad
|
||||
and each repo (X11, xmonad, xmonad-contrib) has its own HACKAGE_API_KEY token
|
||||
set in GitHub repository secrets.
|
||||
|
||||
--- .github/workflows/haskell-ci.yml.orig
|
||||
+++ .github/workflows/haskell-ci.yml
|
||||
@@ -14,8 +14,15 @@
|
||||
#
|
||||
name: Haskell-CI
|
||||
on:
|
||||
- - push
|
||||
- - pull_request
|
||||
+ push:
|
||||
+ pull_request:
|
||||
+ release:
|
||||
+ types:
|
||||
+ - published
|
||||
+ workflow_dispatch:
|
||||
+ inputs:
|
||||
+ version:
|
||||
+ description: candidate version (must match version in cabal file)
|
||||
jobs:
|
||||
linux:
|
||||
name: Haskell-CI - Linux - ${{ matrix.compiler }}
|
||||
@@ -33,6 +40,7 @@
|
||||
compilerVersion: 9.8.4
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
+ upload: true
|
||||
- compiler: ghc-9.6.7
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.6.7
|
||||
@@ -257,6 +265,10 @@
|
||||
- name: haddock
|
||||
run: |
|
||||
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
|
||||
+ - name: haddock for hackage
|
||||
+ if: matrix.upload
|
||||
+ run: |
|
||||
+ $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
|
||||
- name: unconstrained build
|
||||
run: |
|
||||
rm -f cabal.project.local
|
||||
@@ -267,3 +279,80 @@
|
||||
with:
|
||||
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
|
||||
path: ~/.cabal/store
|
||||
+ # must be separate artifacts because GitHub Actions are still broken:
|
||||
+ # https://github.com/actions/upload-artifact/issues/441
|
||||
+ # https://github.com/actions/upload-artifact/issues/457
|
||||
+ - name: upload artifact (sdist)
|
||||
+ if: matrix.upload
|
||||
+ uses: actions/upload-artifact@v4
|
||||
+ with:
|
||||
+ name: sdist
|
||||
+ path: ${{ github.workspace }}/sdist/*.tar.gz
|
||||
+ - name: upload artifact (haddock)
|
||||
+ if: matrix.upload
|
||||
+ uses: actions/upload-artifact@v4
|
||||
+ with:
|
||||
+ name: haddock
|
||||
+ path: ${{ github.workspace }}/haddock/*-docs.tar.gz
|
||||
+ - name: hackage upload (candidate)
|
||||
+ if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
|
||||
+ shell: bash
|
||||
+ run: |
|
||||
+ set -ex
|
||||
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
||||
+ res=$(
|
||||
+ curl \
|
||||
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
+ --header "Accept: text/plain" \
|
||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
||||
+ https://hackage.haskell.org/packages/candidates/
|
||||
+ )
|
||||
+ [[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
|
||||
+ res=$(
|
||||
+ curl \
|
||||
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
+ -X PUT \
|
||||
+ --header "Accept: text/plain" \
|
||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
+ --header "Content-Type: application/x-tar" \
|
||||
+ --header "Content-Encoding: gzip" \
|
||||
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
||||
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
|
||||
+ )
|
||||
+ [[ $res == 2?? ]]
|
||||
+ env:
|
||||
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
||||
+ PACKAGE_NAME: ${{ github.event.repository.name }}
|
||||
+ PACKAGE_VERSION: ${{ github.event.inputs.version }}
|
||||
+ - name: hackage upload (release)
|
||||
+ if: matrix.upload && github.event_name == 'release'
|
||||
+ shell: bash
|
||||
+ run: |
|
||||
+ set -ex
|
||||
+ PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
||||
+ res=$(
|
||||
+ curl \
|
||||
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
+ --header "Accept: text/plain" \
|
||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
+ --form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
||||
+ https://hackage.haskell.org/packages/
|
||||
+ )
|
||||
+ [[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
|
||||
+ res=$(
|
||||
+ curl \
|
||||
+ --silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
+ -X PUT \
|
||||
+ --header "Accept: text/plain" \
|
||||
+ --header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
+ --header "Content-Type: application/x-tar" \
|
||||
+ --header "Content-Encoding: gzip" \
|
||||
+ --data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
||||
+ https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
|
||||
+ )
|
||||
+ [[ $res == 2?? ]]
|
||||
+ env:
|
||||
+ HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
||||
+ PACKAGE_NAME: ${{ github.event.repository.name }}
|
||||
+ PACKAGE_VERSION: ${{ github.event.release.tag_name }}
|
335
.github/workflows/haskell-ci.yml
vendored
Normal file
335
.github/workflows/haskell-ci.yml
vendored
Normal file
@@ -0,0 +1,335 @@
|
||||
# This GitHub workflow config has been generated by a script via
|
||||
#
|
||||
# haskell-ci 'github' 'cabal.project'
|
||||
#
|
||||
# To regenerate the script (for example after adjusting tested-with) run
|
||||
#
|
||||
# haskell-ci regenerate
|
||||
#
|
||||
# For more information, see https://github.com/haskell-CI/haskell-ci
|
||||
#
|
||||
# version: 0.19.20250506
|
||||
#
|
||||
# REGENDATA ("0.19.20250506",["github","cabal.project"])
|
||||
#
|
||||
name: Haskell-CI
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
release:
|
||||
types:
|
||||
- published
|
||||
workflow_dispatch:
|
||||
inputs:
|
||||
version:
|
||||
description: candidate version (must match version in cabal file)
|
||||
jobs:
|
||||
linux:
|
||||
name: Haskell-CI - Linux - ${{ matrix.compiler }}
|
||||
runs-on: ubuntu-24.04
|
||||
timeout-minutes:
|
||||
60
|
||||
container:
|
||||
image: buildpack-deps:jammy
|
||||
continue-on-error: ${{ matrix.allow-failure }}
|
||||
strategy:
|
||||
matrix:
|
||||
include:
|
||||
- compiler: ghc-9.12.2
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.12.2
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-9.10.2
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.10.2
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-9.8.4
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.8.4
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
upload: true
|
||||
- compiler: ghc-9.6.7
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.6.7
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-9.4.8
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.4.8
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-9.2.8
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.2.8
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-9.0.2
|
||||
compilerKind: ghc
|
||||
compilerVersion: 9.0.2
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-8.10.7
|
||||
compilerKind: ghc
|
||||
compilerVersion: 8.10.7
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-8.8.4
|
||||
compilerKind: ghc
|
||||
compilerVersion: 8.8.4
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
- compiler: ghc-8.6.5
|
||||
compilerKind: ghc
|
||||
compilerVersion: 8.6.5
|
||||
setup-method: ghcup
|
||||
allow-failure: false
|
||||
fail-fast: false
|
||||
steps:
|
||||
- name: apt-get install
|
||||
run: |
|
||||
apt-get update
|
||||
apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
|
||||
apt-get install -y libx11-dev libxext-dev libxinerama-dev libxrandr-dev libxss-dev
|
||||
- name: Install GHCup
|
||||
run: |
|
||||
mkdir -p "$HOME/.ghcup/bin"
|
||||
curl -sL https://downloads.haskell.org/ghcup/0.1.50.1/x86_64-linux-ghcup-0.1.50.1 > "$HOME/.ghcup/bin/ghcup"
|
||||
chmod a+x "$HOME/.ghcup/bin/ghcup"
|
||||
- name: Install cabal-install
|
||||
run: |
|
||||
"$HOME/.ghcup/bin/ghcup" install cabal 3.14.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false)
|
||||
echo "CABAL=$HOME/.ghcup/bin/cabal-3.14.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
|
||||
- name: Install GHC (GHCup)
|
||||
if: matrix.setup-method == 'ghcup'
|
||||
run: |
|
||||
"$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false)
|
||||
HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER")
|
||||
HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#')
|
||||
HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#')
|
||||
echo "HC=$HC" >> "$GITHUB_ENV"
|
||||
echo "HCPKG=$HCPKG" >> "$GITHUB_ENV"
|
||||
echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV"
|
||||
env:
|
||||
HCKIND: ${{ matrix.compilerKind }}
|
||||
HCNAME: ${{ matrix.compiler }}
|
||||
HCVER: ${{ matrix.compilerVersion }}
|
||||
- name: Set PATH and environment variables
|
||||
run: |
|
||||
echo "$HOME/.cabal/bin" >> $GITHUB_PATH
|
||||
echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
|
||||
echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
|
||||
echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
|
||||
HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
|
||||
echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
|
||||
echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
|
||||
echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
|
||||
echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
|
||||
echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
|
||||
env:
|
||||
HCKIND: ${{ matrix.compilerKind }}
|
||||
HCNAME: ${{ matrix.compiler }}
|
||||
HCVER: ${{ matrix.compilerVersion }}
|
||||
- name: env
|
||||
run: |
|
||||
env
|
||||
- name: write cabal config
|
||||
run: |
|
||||
mkdir -p $CABAL_DIR
|
||||
cat >> $CABAL_CONFIG <<EOF
|
||||
remote-build-reporting: anonymous
|
||||
write-ghc-environment-files: never
|
||||
remote-repo-cache: $CABAL_DIR/packages
|
||||
logs-dir: $CABAL_DIR/logs
|
||||
world-file: $CABAL_DIR/world
|
||||
extra-prog-path: $CABAL_DIR/bin
|
||||
symlink-bindir: $CABAL_DIR/bin
|
||||
installdir: $CABAL_DIR/bin
|
||||
build-summary: $CABAL_DIR/logs/build.log
|
||||
store-dir: $CABAL_DIR/store
|
||||
install-dirs user
|
||||
prefix: $CABAL_DIR
|
||||
repository hackage.haskell.org
|
||||
url: http://hackage.haskell.org/
|
||||
EOF
|
||||
cat >> $CABAL_CONFIG <<EOF
|
||||
program-default-options
|
||||
ghc-options: $GHCJOBS +RTS -M3G -RTS
|
||||
EOF
|
||||
cat $CABAL_CONFIG
|
||||
- name: versions
|
||||
run: |
|
||||
$HC --version || true
|
||||
$HC --print-project-git-commit-id || true
|
||||
$CABAL --version || true
|
||||
- name: update cabal index
|
||||
run: |
|
||||
$CABAL v2-update -v
|
||||
- name: install cabal-plan
|
||||
run: |
|
||||
mkdir -p $HOME/.cabal/bin
|
||||
curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.7.3.0/cabal-plan-0.7.3.0-x86_64-linux.xz > cabal-plan.xz
|
||||
echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c -
|
||||
xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
|
||||
rm -f cabal-plan.xz
|
||||
chmod a+x $HOME/.cabal/bin/cabal-plan
|
||||
cabal-plan --version
|
||||
- name: checkout
|
||||
uses: actions/checkout@v4
|
||||
with:
|
||||
path: source
|
||||
- name: initial cabal.project for sdist
|
||||
run: |
|
||||
touch cabal.project
|
||||
echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
|
||||
cat cabal.project
|
||||
- name: sdist
|
||||
run: |
|
||||
mkdir -p sdist
|
||||
$CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
|
||||
- name: unpack
|
||||
run: |
|
||||
mkdir -p unpacked
|
||||
find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
|
||||
- name: generate cabal.project
|
||||
run: |
|
||||
PKGDIR_xmonad="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/xmonad-[0-9.]*')"
|
||||
echo "PKGDIR_xmonad=${PKGDIR_xmonad}" >> "$GITHUB_ENV"
|
||||
rm -f cabal.project cabal.project.local
|
||||
touch cabal.project
|
||||
touch cabal.project.local
|
||||
echo "packages: ${PKGDIR_xmonad}" >> cabal.project
|
||||
echo "package xmonad" >> cabal.project
|
||||
echo " ghc-options: -Werror=missing-methods" >> cabal.project
|
||||
cat >> cabal.project <<EOF
|
||||
optimization: False
|
||||
|
||||
package xmonad
|
||||
flags: +pedantic
|
||||
EOF
|
||||
$HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: any.$_ installed\n" unless /^(xmonad)$/; }' >> cabal.project.local
|
||||
cat cabal.project
|
||||
cat cabal.project.local
|
||||
- name: dump install plan
|
||||
run: |
|
||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
|
||||
cabal-plan
|
||||
- name: restore cache
|
||||
uses: actions/cache/restore@v4
|
||||
with:
|
||||
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
|
||||
path: ~/.cabal/store
|
||||
restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
|
||||
- name: install dependencies
|
||||
run: |
|
||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
|
||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
|
||||
- name: build w/o tests
|
||||
run: |
|
||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
|
||||
- name: build
|
||||
run: |
|
||||
$CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
|
||||
- name: tests
|
||||
run: |
|
||||
$CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
|
||||
- name: cabal check
|
||||
run: |
|
||||
cd ${PKGDIR_xmonad} || false
|
||||
${CABAL} -vnormal check
|
||||
- name: haddock
|
||||
run: |
|
||||
$CABAL v2-haddock --disable-documentation $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
|
||||
- name: haddock for hackage
|
||||
if: matrix.upload
|
||||
run: |
|
||||
$CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH --haddock-for-hackage --builddir $GITHUB_WORKSPACE/haddock all
|
||||
- name: unconstrained build
|
||||
run: |
|
||||
rm -f cabal.project.local
|
||||
$CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
|
||||
- name: save cache
|
||||
if: always()
|
||||
uses: actions/cache/save@v4
|
||||
with:
|
||||
key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
|
||||
path: ~/.cabal/store
|
||||
# must be separate artifacts because GitHub Actions are still broken:
|
||||
# https://github.com/actions/upload-artifact/issues/441
|
||||
# https://github.com/actions/upload-artifact/issues/457
|
||||
- name: upload artifact (sdist)
|
||||
if: matrix.upload
|
||||
uses: actions/upload-artifact@v4
|
||||
with:
|
||||
name: sdist
|
||||
path: ${{ github.workspace }}/sdist/*.tar.gz
|
||||
- name: upload artifact (haddock)
|
||||
if: matrix.upload
|
||||
uses: actions/upload-artifact@v4
|
||||
with:
|
||||
name: haddock
|
||||
path: ${{ github.workspace }}/haddock/*-docs.tar.gz
|
||||
- name: hackage upload (candidate)
|
||||
if: matrix.upload && github.event_name == 'workflow_dispatch' && github.event.inputs.version != ''
|
||||
shell: bash
|
||||
run: |
|
||||
set -ex
|
||||
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
||||
res=$(
|
||||
curl \
|
||||
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
--header "Accept: text/plain" \
|
||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
||||
https://hackage.haskell.org/packages/candidates/
|
||||
)
|
||||
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
|
||||
res=$(
|
||||
curl \
|
||||
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
-X PUT \
|
||||
--header "Accept: text/plain" \
|
||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
--header "Content-Type: application/x-tar" \
|
||||
--header "Content-Encoding: gzip" \
|
||||
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
||||
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/candidate/docs
|
||||
)
|
||||
[[ $res == 2?? ]]
|
||||
env:
|
||||
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
||||
PACKAGE_NAME: ${{ github.event.repository.name }}
|
||||
PACKAGE_VERSION: ${{ github.event.inputs.version }}
|
||||
- name: hackage upload (release)
|
||||
if: matrix.upload && github.event_name == 'release'
|
||||
shell: bash
|
||||
run: |
|
||||
set -ex
|
||||
PACKAGE_VERSION="${PACKAGE_VERSION#v}"
|
||||
res=$(
|
||||
curl \
|
||||
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
--header "Accept: text/plain" \
|
||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
--form package=@"${GITHUB_WORKSPACE}/sdist/${PACKAGE_NAME}-${PACKAGE_VERSION}.tar.gz" \
|
||||
https://hackage.haskell.org/packages/
|
||||
)
|
||||
[[ $res == 2?? ]] # TODO: --fail-with-body once curl 7.76.0 is available
|
||||
res=$(
|
||||
curl \
|
||||
--silent --show-error --output /dev/stderr --write-out '%{http_code}' \
|
||||
-X PUT \
|
||||
--header "Accept: text/plain" \
|
||||
--header "Authorization: X-ApiKey $HACKAGE_API_KEY" \
|
||||
--header "Content-Type: application/x-tar" \
|
||||
--header "Content-Encoding: gzip" \
|
||||
--data-binary @"${GITHUB_WORKSPACE}/haddock/${PACKAGE_NAME}-${PACKAGE_VERSION}-docs.tar.gz" \
|
||||
https://hackage.haskell.org/package/${PACKAGE_NAME}-${PACKAGE_VERSION}/docs
|
||||
)
|
||||
[[ $res == 2?? ]]
|
||||
env:
|
||||
HACKAGE_API_KEY: ${{ secrets.HACKAGE_API_KEY }}
|
||||
PACKAGE_NAME: ${{ github.event.repository.name }}
|
||||
PACKAGE_VERSION: ${{ github.event.release.tag_name }}
|
22
.github/workflows/hlint.yaml
vendored
Normal file
22
.github/workflows/hlint.yaml
vendored
Normal file
@@ -0,0 +1,22 @@
|
||||
name: hlint
|
||||
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
|
||||
jobs:
|
||||
hlint:
|
||||
runs-on: ubuntu-latest
|
||||
steps:
|
||||
- uses: actions/checkout@v4
|
||||
|
||||
- name: 'Set up HLint'
|
||||
uses: haskell-actions/hlint-setup@v2
|
||||
with:
|
||||
version: '3.5'
|
||||
|
||||
- name: 'Run HLint'
|
||||
uses: haskell-actions/hlint-run@v2
|
||||
with:
|
||||
path: '.'
|
||||
fail-on: status
|
21
.github/workflows/nix.yml
vendored
Normal file
21
.github/workflows/nix.yml
vendored
Normal file
@@ -0,0 +1,21 @@
|
||||
name: Nix
|
||||
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
|
||||
jobs:
|
||||
build:
|
||||
runs-on: ubuntu-latest
|
||||
name: Nix Flake - Linux
|
||||
permissions:
|
||||
contents: read
|
||||
steps:
|
||||
- name: Install Nix
|
||||
uses: cachix/install-nix-action@v31
|
||||
with:
|
||||
github_access_token: ${{ secrets.GITHUB_TOKEN }}
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v4
|
||||
- name: Build
|
||||
run: nix build --print-build-logs
|
48
.github/workflows/packdeps.yml
vendored
Normal file
48
.github/workflows/packdeps.yml
vendored
Normal file
@@ -0,0 +1,48 @@
|
||||
name: Packdeps
|
||||
|
||||
on:
|
||||
workflow_dispatch:
|
||||
schedule:
|
||||
# Run every Saturday
|
||||
- cron: '0 3 * * 6'
|
||||
|
||||
jobs:
|
||||
packdeps:
|
||||
name: Packdeps
|
||||
runs-on: ubuntu-latest
|
||||
|
||||
steps:
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v4
|
||||
- name: Setup Haskell
|
||||
uses: haskell-actions/setup@v2
|
||||
with:
|
||||
# packdeps doesn't build with newer as of 2021-10
|
||||
ghc-version: '8.8'
|
||||
- name: Install packdeps
|
||||
run: |
|
||||
set -ex
|
||||
cd # go somewhere without a cabal.project
|
||||
cabal install packdeps
|
||||
- name: Check package bounds (all)
|
||||
continue-on-error: true
|
||||
run: |
|
||||
set -ex
|
||||
packdeps \
|
||||
--exclude X11 \
|
||||
*.cabal
|
||||
- name: Check package bounds (preferred)
|
||||
run: |
|
||||
set -ex
|
||||
packdeps \
|
||||
--preferred \
|
||||
--exclude X11 \
|
||||
*.cabal
|
||||
|
||||
workflow-keepalive:
|
||||
if: github.event_name == 'schedule'
|
||||
runs-on: ubuntu-latest
|
||||
permissions:
|
||||
actions: write
|
||||
steps:
|
||||
- uses: liskin/gh-workflow-keepalive@v1
|
79
.github/workflows/stack.yml
vendored
Normal file
79
.github/workflows/stack.yml
vendored
Normal file
@@ -0,0 +1,79 @@
|
||||
name: Stack
|
||||
|
||||
on:
|
||||
push:
|
||||
pull_request:
|
||||
|
||||
jobs:
|
||||
build:
|
||||
name: Stack CI - Linux - ${{ matrix.resolver }}
|
||||
runs-on: ubuntu-latest
|
||||
strategy:
|
||||
fail-fast: false
|
||||
matrix:
|
||||
include:
|
||||
- resolver: lts-14 # GHC 8.6
|
||||
- resolver: lts-16 # GHC 8.8
|
||||
- resolver: lts-18 # GHC 8.10
|
||||
- resolver: lts-19 # GHC 9.0
|
||||
- resolver: lts-20 # GHC 9.2
|
||||
- resolver: lts-21 # GHC 9.4
|
||||
- resolver: lts-22 # GHC 9.6
|
||||
- resolver: lts-23 # GHC 9.8
|
||||
|
||||
steps:
|
||||
- name: Clone project
|
||||
uses: actions/checkout@v4
|
||||
|
||||
- name: Install C dependencies
|
||||
run: |
|
||||
set -ex
|
||||
sudo apt update -y
|
||||
sudo apt install -y \
|
||||
libx11-dev \
|
||||
libxext-dev \
|
||||
libxinerama-dev \
|
||||
libxrandr-dev \
|
||||
libxss-dev \
|
||||
#
|
||||
|
||||
- name: Refresh caches once a month
|
||||
id: cache-date
|
||||
# GHA writes caches on the first miss and then never updates them again;
|
||||
# force updating the cache at least once a month. Additionally, the
|
||||
# date is prefixed with an epoch number to let us manually refresh the
|
||||
# cache when needed. This is a workaround for https://github.com/actions/cache/issues/2
|
||||
run: |
|
||||
date +date=1-%Y-%m >> $GITHUB_OUTPUT
|
||||
|
||||
- name: Cache Haskell package metadata
|
||||
uses: actions/cache@v4
|
||||
with:
|
||||
path: ~/.stack/pantry
|
||||
key: stack-pantry-${{ runner.os }}-${{ steps.cache-date.outputs.date }}
|
||||
|
||||
- name: Cache Haskell dependencies
|
||||
uses: actions/cache@v4
|
||||
with:
|
||||
path: |
|
||||
~/.stack/*
|
||||
!~/.stack/pantry
|
||||
!~/.stack/programs
|
||||
key: stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles('stack.yaml') }}-${{ hashFiles('*.cabal') }}
|
||||
restore-keys: |
|
||||
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-${{ hashFiles('stack.yaml') }}-
|
||||
stack-${{ runner.os }}-${{ matrix.resolver }}-${{ steps.cache-date.outputs.date }}-
|
||||
|
||||
- name: Update hackage index
|
||||
# always update index to prevent the shared ~/.stack/pantry cache from being empty
|
||||
run: |
|
||||
set -ex
|
||||
stack update
|
||||
|
||||
- name: Build and test
|
||||
run: |
|
||||
set -ex
|
||||
stack test \
|
||||
--fast --no-terminal \
|
||||
--resolver=${{ matrix.resolver }} --system-ghc \
|
||||
--flag=xmonad:pedantic
|
32
.gitignore
vendored
Normal file
32
.gitignore
vendored
Normal file
@@ -0,0 +1,32 @@
|
||||
.hpc/
|
||||
*.hi
|
||||
*.o
|
||||
*.p_hi
|
||||
*.prof
|
||||
*.tix
|
||||
|
||||
# editor temp files
|
||||
|
||||
*#
|
||||
.#*
|
||||
*~
|
||||
.*.swp
|
||||
|
||||
# TAGS files
|
||||
TAGS
|
||||
tags
|
||||
|
||||
# stack artifacts
|
||||
/.stack-work/
|
||||
|
||||
# cabal-install artifacts
|
||||
/.*.environment.*-*
|
||||
/.cabal-sandbox/
|
||||
/cabal.config
|
||||
/cabal.project.local
|
||||
/cabal.sandbox.config
|
||||
/dist-newstyle/
|
||||
/dist/
|
||||
|
||||
# nix artifacts
|
||||
result
|
2
.hlint.yaml
Normal file
2
.hlint.yaml
Normal file
@@ -0,0 +1,2 @@
|
||||
# Ignore these warnings.
|
||||
- ignore: {name: "Use camelCase"}
|
39
.mailmap
Normal file
39
.mailmap
Normal file
@@ -0,0 +1,39 @@
|
||||
Adam Plaice <plaice.adam+github@gmail.com>
|
||||
Brandon S Allbery KF8NH <allbery.b@gmail.com>
|
||||
Brent Yorgey <byorgey@gmail.com> <byorgey@cis.upenn.edu>
|
||||
Conrad Irwin <conrad.irwin@gmail.com>
|
||||
Daniel Neri <daniel.neri@sigicom.com> <daniel.neri@sigicom.se>
|
||||
Daniel Schoepe <daniel.schoepe@gmail.com> <asgaroth_@gmx.de>
|
||||
Daniel Wagner <me@dmwit.com> <daniel@wagner-home.com>
|
||||
David Glasser <glasser@mit.edu>
|
||||
Deven Lahoti <deven.lahoti@gmail.com>
|
||||
Devin Mullins <devin.mullins@gmail.com> <me@twifkak.com>
|
||||
Don Stewart <dons00@gmail.com> <dons@cse.unsw.edu.au>
|
||||
Don Stewart <dons00@gmail.com> <dons@galois.com>
|
||||
Felix Springer <felixspringer149@gmail.com> <39434424+jumper149@users.noreply.github.com>
|
||||
Gwern Branwen <gwern@gwern.net> <gwern0@gmail.com>
|
||||
Lukas Mai <l.mai@web.de>
|
||||
Marshall Lochbaum <mwlochbaum@gmail.com>
|
||||
Michael G. Sloan <mgsloan@gmail.com>
|
||||
Neil Mitchell <ndmitchell@gmail.com> <http://www.cs.york.ac.uk/~ndm/>
|
||||
Neil Mitchell <ndmitchell@gmail.com> Neil Mitchell <unknown>
|
||||
Nick Burlett <nickburlett@mac.com>
|
||||
Nicolas Pouillard <nicolas.pouillard@gmail.com>
|
||||
Nik Nyby <nnyby@columbia.edu>
|
||||
Peter J. Jones <pjones@devalot.com>
|
||||
Peter J. Jones <pjones@devalot.com> <pjones@pmade.com>
|
||||
Robert Marlow <bobstopper@bobturf.org>
|
||||
Robert Marlow <bobstopper@bobturf.org> <robreim@bobturf.org>
|
||||
Sam Hughes <hughes@rpi.edu>
|
||||
Shae Erisson <shae@ScannedInAvian.com>
|
||||
Sibi Prabakaran <sibi@psibi.in>
|
||||
Sibi Prabakaran <sibi@psibi.in> <psibi2000@gmail.com>
|
||||
Spencer Janssen <spencerjanssen@gmail.com> <sjanssen@cse.unl.edu>
|
||||
Timothy Hobbs <tim.thelion@gmail.com>
|
||||
Tomas Janousek <tomi@nomi.cz>
|
||||
Valery V. Vorotyntsev <valery.vv@gmail.com>
|
||||
Vanessa McHale <vamchale@gmail.com> <vanessa.mchale@reconfigure.io>
|
||||
Wirt Wolff <wirtwolff@gmail.com>
|
||||
|
||||
Tony Zorman <soliditsallgood@mailbox.org> <50166980+slotThe@users.noreply.github.com>
|
||||
Tony Zorman <soliditsallgood@mailbox.org>
|
323
CHANGES.md
Normal file
323
CHANGES.md
Normal file
@@ -0,0 +1,323 @@
|
||||
# Change Log / Release Notes
|
||||
|
||||
## _unreleased_
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* Use `cabal` for `--recompile` if there is a `.cabal` file in the config
|
||||
directory and none of `build`, `stack.yaml`, `flake.nix`, nor `default.nix`
|
||||
exist.
|
||||
|
||||
### Enhancements
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
### Other
|
||||
|
||||
PR #404 (see last change in 0.17.1) has been reverted, because the affected
|
||||
compilers are (hopefully) no longer being used.
|
||||
|
||||
All 9.0 releases of GHC, plus 9.2.1 and 9.2.2 have the join point bug.
|
||||
Note that 9.0.x is known to also have GC issues and is officially deprecated,
|
||||
and the only 9.2 release that should be used is 9.2.8. Additionally, GHC HQ
|
||||
doesn't support releases before 9.6.6.
|
||||
|
||||
## 0.18.0 (February 3, 2024)
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* Dropped support for GHC 8.4.
|
||||
|
||||
### Enhancements
|
||||
|
||||
* Exported `sendRestart` and `sendReplace` from `XMonad.Operations`.
|
||||
|
||||
* Exported `buildLaunch` from `XMonad.Main`.
|
||||
|
||||
* `Tall` does not draw windows with zero area.
|
||||
|
||||
* `XMonad.Operations.floatLocation` now applies size hints. This means windows
|
||||
will snap to these hints as soon as they're floated (mouse move, keybinding).
|
||||
Previously that only happened on mouse resize.
|
||||
|
||||
* Recompilation now detects `flake.nix` and `default.nix` (can be a
|
||||
symlink) and switches to using `nix build` as appropriate.
|
||||
|
||||
* Added `unGrab` to `XMonad.Operations`; this releases XMonad's passive
|
||||
keyboard grab, so other applications (like `scrot`) can do their
|
||||
thing.
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Duplicated floats (e.g. from X.A.CopyToAll) no longer escape to inactive
|
||||
screens.
|
||||
|
||||
## 0.17.2 (April 2, 2023)
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Fixed the build with GHC 9.6.
|
||||
|
||||
## 0.17.1 (September 3, 2022)
|
||||
|
||||
### Enhancements
|
||||
|
||||
* Added custom cursor shapes for resizing and moving windows.
|
||||
|
||||
* Exported `cacheNumlockMask` and `mkGrabs` from `XMonad.Operations`.
|
||||
|
||||
* Added `willFloat` function to `XMonad.ManageHooks` to detect whether the
|
||||
(about to be) managed window will be a floating window or not.
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Fixed border color of windows with alpha channel. Now all windows have the
|
||||
same opaque border color.
|
||||
|
||||
* Change the main loop to try to avoid [GHC bug 21708] on systems
|
||||
running GHC 9.2 up to version 9.2.3. The issue has been fixed in
|
||||
[GHC 9.2.4] and all later releases.
|
||||
|
||||
[GHC bug 21708]: https://gitlab.haskell.org/ghc/ghc/-/issues/21708
|
||||
[GHC 9.2.4]: https://discourse.haskell.org/t/ghc-9-2-4-released/4851
|
||||
|
||||
## 0.17.0 (October 27, 2021)
|
||||
|
||||
### Enhancements
|
||||
|
||||
* Migrated `X.L.LayoutCombinators.(|||)` into `XMonad.Layout`, providing the
|
||||
ability to directly jump to a layout with the `JumpToLayout` message.
|
||||
|
||||
* Recompilation now detects `stack.yaml` (can be a symlink) alongside
|
||||
`xmonad.hs` and switches to using `stack ghc`. We also updated INSTALL.md
|
||||
with instructions for cabal-install that lead to correct recompilation.
|
||||
|
||||
Deprecation warnings during recompilation are no longer suppressed to make
|
||||
it easier for us to clean up the codebase. These can still be suppressed
|
||||
manually using an `OPTIONS_GHC` pragma with `-Wno-deprecations`.
|
||||
|
||||
* Improve handling of XDG directories.
|
||||
|
||||
1. If all three of xmonad's environment variables (`XMONAD_DATA_DIR,`
|
||||
`XMONAD_CONFIG_DIR`, and `XMONAD_CACHE_DIR`) are set, use them.
|
||||
2. If there is a build script called `build` (see [these build scripts]
|
||||
for usage examples) or configuration `xmonad.hs` in `~/.xmonad`, set
|
||||
all three directories to `~/.xmonad`.
|
||||
3. Otherwise, use the `xmonad` directory in `XDG_DATA_HOME`,
|
||||
`XDG_CONFIG_HOME`, and `XDG_CACHE_HOME` (or their respective
|
||||
fallbacks). These directories are created if necessary.
|
||||
|
||||
In the cases of 1. and 3., the build script or executable is expected to be
|
||||
in the config dir.
|
||||
|
||||
Additionally, the xmonad config binary and intermediate object files were
|
||||
moved to the cache directory (only relevant if using XDG or
|
||||
`XMONAD_CACHE_DIR`).
|
||||
|
||||
* Added `Foldable`, `Functor`, and `Traversable` instances for `Stack`.
|
||||
|
||||
* Added `Typeable layout` constraint to `LayoutClass`, making it possible to
|
||||
cast `Layout` back into a concrete type and extract current layout state
|
||||
from it.
|
||||
|
||||
* Export constructor for `Choose` and `CLR` from `Module.Layout` to allow
|
||||
pattern-matching on the left and right sub-layouts of `Choose l r a`.
|
||||
|
||||
* Added `withUnfocused` function to `XMonad.Operations`, allowing for `X`
|
||||
operations to be applied to unfocused windows.
|
||||
|
||||
[these build scripts]: https://github.com/xmonad/xmonad-testing/tree/master/build-scripts
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Fixed a bug when using multiple screens with different dimensions, causing
|
||||
some floating windows to be smaller/larger than the size they requested.
|
||||
|
||||
* Compatibility with GHC 9.0
|
||||
|
||||
* Fixed dunst notifications being obscured when moving floats.
|
||||
https://github.com/xmonad/xmonad/issues/208
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* Made `(<&&>)` and `(<||>)` non-strict in their right operand; i.e., these
|
||||
operators now implement short-circuit evaluation so the right operand is
|
||||
evaluated only if the left operand does not suffice to determine the
|
||||
result.
|
||||
|
||||
* Change `ScreenDetail` to a newtype and make `RationalRect` strict in its
|
||||
contents.
|
||||
|
||||
* Added the `extensibleConf` field to `XConfig` which makes it easier for
|
||||
contrib modules to have composable configuration (custom hooks, …).
|
||||
|
||||
* `util/GenerateManpage.hs` is no longer distributed in the tarball.
|
||||
Instead, the manpage source is regenerated and manpage rebuilt
|
||||
automatically in CI.
|
||||
|
||||
* `DestroyWindowEvent` is now broadcasted to layouts to let them know
|
||||
window-specific resources can be discarded.
|
||||
|
||||
## 0.15 (September 30, 2018)
|
||||
|
||||
* Reimplement `sendMessage` to deal properly with windowset changes made
|
||||
during handling.
|
||||
|
||||
* Add new library functions `windowBracket` and `modifyWindowSet` to
|
||||
`XMonad.Operations`.
|
||||
|
||||
## 0.14.2 (August 21, 2018)
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Add the sample configuration file xmonad.hs again to the release tarball.
|
||||
[https://github.com/xmonad/xmonad/issues/181]
|
||||
|
||||
## 0.14.1 (August 20, 2018)
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* The cabal build no longer installs xmonad.hs, xmonad.1, and xmonad.1.html
|
||||
as data files. The location cabal picks for chose files isn't useful as
|
||||
standard tools like man(1) won't find them there. Instead, we rely on
|
||||
distributors to pick up the files from the source tarball during the build
|
||||
and to install them into proper locations where their users expect them.
|
||||
[https://github.com/xmonad/xmonad/pull/127]
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* Add support for GHC 8.6.x by providing an instance for 'MonadFail X'. A
|
||||
side effect of that change is that our code no longer compiles with GHC
|
||||
versions prior to 8.0.x. We could work around that, no doubt, but the
|
||||
resulting code would require CPP and Cabal flags and whatnot. It feels more
|
||||
reasonable to just require a moderately recent compiler instead of going
|
||||
through all that trouble.
|
||||
|
||||
* xmonad no longer always recompile on startup. Now it only does so if the
|
||||
executable does not have the name that would be used for the compilation
|
||||
output. The purpose of recompiling and executing the results in this case is
|
||||
so that the `xmonad` executable in the package can be used with custom
|
||||
configurations.
|
||||
|
||||
### Enhancements
|
||||
|
||||
* Whenever xmonad recompiles, it now explains how it is attempting to
|
||||
recompile, by outputting logs to stderr. If you are using xmonad as a custom
|
||||
X session, then this will end up in a `.xsession-errors` file.
|
||||
|
||||
## 0.14 (July 30, 2018)
|
||||
|
||||
### Bug Fixes
|
||||
|
||||
* The state file that xmonad uses while restarting itself is now
|
||||
removed after it is processed. This fixes a bug that manifested
|
||||
in several different ways:
|
||||
|
||||
- Names of old workspaces would be resurrected after a restart
|
||||
- Screen sizes would be wrong after changing monitor configuration (#90)
|
||||
- `spawnOnce` stopped working (xmonad/xmonad-contrib#155)
|
||||
- Focus did not follow when moving between workspaces (#87)
|
||||
- etc.
|
||||
|
||||
* Recover old behavior (in 0.12) when `focusFollowsMouse == True`:
|
||||
the focus follows when the mouse enters another workspace
|
||||
but not moving into any window.
|
||||
|
||||
* Compiles with GHC 8.4.1
|
||||
|
||||
* Restored compatibility with GHC version prior to 8.0.1 by removing the
|
||||
dependency on directory version 1.2.3.
|
||||
|
||||
|
||||
## 0.13 (February 10, 2017)
|
||||
|
||||
### Breaking Changes
|
||||
|
||||
* When restarting xmonad, resume state is no longer passed to the
|
||||
next process via the command line. Instead, a temporary state
|
||||
file is created and xmonad's state is serialized to that file.
|
||||
|
||||
When upgrading to 0.13 from a previous version, the `--resume`
|
||||
command line option will automatically migrate to a state file.
|
||||
|
||||
This fixes issue #12.
|
||||
|
||||
### Enhancements
|
||||
|
||||
* You can now control which directory xmonad uses for finding your
|
||||
configuration file and which one is used for storing the compiled
|
||||
version of your configuration. In order of preference:
|
||||
|
||||
1. New environment variables. If you want to use these ensure
|
||||
you set the correct environment variable and also create the
|
||||
directory it references:
|
||||
|
||||
- `XMONAD_CONFIG_DIR`
|
||||
- `XMONAD_CACHE_DIR`
|
||||
- `XMONAD_DATA_DIR`
|
||||
|
||||
2. The `~/.xmonad` directory.
|
||||
|
||||
3. XDG Base Directory Specification directories, if they exist:
|
||||
|
||||
- `XDG_CONFIG_HOME/xmonad`
|
||||
- `XDG_CACHE_HOME/xmonad`
|
||||
- `XDG_DATA_HOME/xmonad`
|
||||
|
||||
If none of these directories exist then one will be created using
|
||||
the following logic: If the relevant environment variable
|
||||
mentioned in step (1) above is set, the referent directory will be
|
||||
created and used. Otherwise `~/.xmonad` will be created and used.
|
||||
|
||||
This fixes a few issues, notably #7 and #56.
|
||||
|
||||
* A custom build script can be used when xmonad is given the
|
||||
`--recompile` command line option. If an executable named `build`
|
||||
exists in the xmonad configuration directory it will be called
|
||||
instead of `ghc`. It takes one argument, the name of the
|
||||
executable binary it must produce.
|
||||
|
||||
This fixes #8. (One of two possible custom build solutions. See
|
||||
the next entry for another solution.)
|
||||
|
||||
* For users who build their xmonad configuration using tools such as
|
||||
cabal or stack, there is another option for executing xmonad.
|
||||
|
||||
Instead of running the `xmonad` executable directly, arrange to
|
||||
have your login manager run your configuration binary instead.
|
||||
Then, in your binary, use the new `launch` command instead of
|
||||
`xmonad`.
|
||||
|
||||
This will keep xmonad from using its configuration file
|
||||
checking/compiling code and directly start the window manager
|
||||
without `exec`ing any other binary.
|
||||
|
||||
See the documentation for the `launch` function in `XMonad.Main`
|
||||
for more details.
|
||||
|
||||
Fixes #8. (Second way to have a custom build environment for
|
||||
XMonad. See previous entry for another solution.)
|
||||
|
||||
## 0.12 (December 14, 2015)
|
||||
|
||||
* Compiles with GHC 7.10.2, 7.8.4, and 7.6.3
|
||||
|
||||
* Use of [data-default][] allows using `def` where previously you
|
||||
had to write `defaultConfig`, `defaultXPConfig`, etc.
|
||||
|
||||
* The [setlocale][] package is now used instead of a binding shipped
|
||||
with xmonad proper allowing the use of `Main.hs` instead of
|
||||
`Main.hsc`
|
||||
|
||||
* No longer encodes paths for `spawnPID`
|
||||
|
||||
* The default `manageHook` no longer floats Gimp windows
|
||||
|
||||
* Doesn't crash when there are fewer workspaces than screens
|
||||
|
||||
* `Query` is now an instance of `Applicative`
|
||||
|
||||
* Various improvements to the example configuration file
|
||||
|
||||
[data-default]: http://hackage.haskell.org/package/data-default
|
||||
[setlocale]: https://hackage.haskell.org/package/setlocale
|
82
CONFIG
82
CONFIG
@@ -1,82 +0,0 @@
|
||||
== Configuring xmonad ==
|
||||
|
||||
xmonad is configured by creating and editing the file:
|
||||
|
||||
~/.xmonad/xmonad.hs
|
||||
|
||||
xmonad then uses settings from this file as arguments to the window manager,
|
||||
on startup. For a complete example of possible settings, see the file:
|
||||
|
||||
man/xmonad.hs
|
||||
|
||||
Further examples are on the website, wiki and extension documentation.
|
||||
|
||||
http://haskell.org/haskellwiki/Xmonad
|
||||
|
||||
== A simple example ==
|
||||
|
||||
Here is a basic example, which overrides the default border width,
|
||||
default terminal, and some colours. This text goes in the file
|
||||
$HOME/.xmonad/xmonad.hs :
|
||||
|
||||
import XMonad
|
||||
|
||||
main = xmonad $ defaultConfig
|
||||
{ borderWidth = 2
|
||||
, terminal = "urxvt"
|
||||
, normalBorderColor = "#cccccc"
|
||||
, focusedBorderColor = "#cd8b00" }
|
||||
|
||||
You can find the defaults in the file:
|
||||
|
||||
XMonad/Config.hs
|
||||
|
||||
== Checking your xmonad.hs is correct ==
|
||||
|
||||
Place this text in ~/.xmonad/xmonad.hs, and then check that it is
|
||||
syntactically and type correct by loading it in the Haskell
|
||||
interpreter:
|
||||
|
||||
$ ghci ~/.xmonad/xmonad.hs
|
||||
GHCi, version 6.8.1: http://www.haskell.org/ghc/ :? for help
|
||||
Loading package base ... linking ... done.
|
||||
Ok, modules loaded: Main.
|
||||
|
||||
Prelude Main> :t main
|
||||
main :: IO ()
|
||||
|
||||
Ok, looks good.
|
||||
|
||||
== Loading your configuration ==
|
||||
|
||||
To have xmonad start using your settings, type 'mod-q'. xmonad will
|
||||
then load this new file, and run it. If it is unable to, the defaults
|
||||
are used.
|
||||
|
||||
To load successfully, both 'xmonad' and 'ghc' must be in your $PATH
|
||||
environment variable. If GHC isn't in your path, for some reason, you
|
||||
can compile the xmonad.hs file yourself:
|
||||
|
||||
$ cd ~/.xmonad
|
||||
$ ghc --make xmonad.hs
|
||||
$ ls
|
||||
xmonad xmonad.hi xmonad.hs xmonad.o
|
||||
|
||||
When you hit mod-q, this newly compiled xmonad will be used.
|
||||
|
||||
== Where are the defaults? ==
|
||||
|
||||
The default configuration values are defined in the source file:
|
||||
|
||||
XMonad/Config.hs
|
||||
|
||||
the XConfig data structure itself is defined in:
|
||||
|
||||
XMonad/Core.hs
|
||||
|
||||
== Extensions ==
|
||||
|
||||
Since the xmonad.hs file is just another Haskell module, you may import
|
||||
and use any Haskell code or libraries you wish. For example, you can use
|
||||
things from the xmonad-contrib library, or other code you write
|
||||
yourself.
|
131
CONTRIBUTING.md
Normal file
131
CONTRIBUTING.md
Normal file
@@ -0,0 +1,131 @@
|
||||
# Contributing to xmonad and xmonad-contrib
|
||||
|
||||
## Before Creating a GitHub Issue
|
||||
|
||||
New issue submissions should adhere to the following guidelines:
|
||||
|
||||
* Does your issue have to do with [xmonad][], [xmonad-contrib][], or
|
||||
maybe even with the [X11][] library?
|
||||
|
||||
Please submit your issue to the **correct** GitHub repository.
|
||||
|
||||
* To help you figure out which repository to submit your issue to,
|
||||
and to help us resolve the problem you are having, create the
|
||||
smallest configuration file you can that reproduces the problem.
|
||||
|
||||
You may find that the [xmonad-testing][] repository is helpful in
|
||||
reproducing the problem with a smaller configuration file.
|
||||
|
||||
Once you've done that please include the configuration file with
|
||||
your GitHub issue.
|
||||
|
||||
* If possible, use the [xmonad-testing][] repository to test your
|
||||
configuration with the bleeding-edge development version of xmonad
|
||||
and xmonad-contrib. We might have already fixed your problem.
|
||||
|
||||
## Contributing Changes/Patches
|
||||
|
||||
Have a change to xmonad that you want included in the next release?
|
||||
Awesome! Here are a few things to keep in mind:
|
||||
|
||||
* Review the above section about creating GitHub issues.
|
||||
|
||||
* It's always best to talk with the community before making any
|
||||
nontrivial changes to xmonad. There are a couple of ways you can
|
||||
chat with us:
|
||||
|
||||
- Join the [`#xmonad` IRC channel] on `irc.libera.chat` or the
|
||||
official [matrix channel], which is linked to IRC. This is the
|
||||
preferred (and fastest!) way to get into contact with us.
|
||||
|
||||
- Post a message to the [mailing list][ml].
|
||||
|
||||
* [XMonad.Doc.Developing][xmonad-doc-developing] is a great
|
||||
resource to get an overview of xmonad. Make sure to also check
|
||||
it if you want more details on the coding style.
|
||||
|
||||
* Continue reading this document!
|
||||
|
||||
## Expediting Reviews and Merges
|
||||
|
||||
Here are some tips for getting your changes merged into xmonad:
|
||||
|
||||
* If your changes can go into [xmonad-contrib][] instead
|
||||
of [xmonad][], please do so. We rarely accept new features to
|
||||
xmonad. (Not that we don't accept changes to xmonad, just that we
|
||||
prefer changes to xmonad-contrib instead.)
|
||||
|
||||
* Change the fewest files as possible. If it makes sense, submit a
|
||||
completely new module to xmonad-contrib.
|
||||
|
||||
* Your changes should include relevant entries in the `CHANGES.md`
|
||||
file. Help us communicate changes to the community.
|
||||
|
||||
* Make sure you test your changes against the most recent commit of
|
||||
[xmonad][] (and [xmonad-contrib][], if you're contributing there).
|
||||
If you're adding a new module or functionality, make sure to add an
|
||||
example in the documentation and in the PR description.
|
||||
|
||||
* Make sure you run the automated tests. Both [xmonad-contrib][]
|
||||
and [xmonad][] have test-suites that you could run with
|
||||
`stack test` for example.
|
||||
|
||||
* When committing, try to follow existing practices. For more
|
||||
information on what good commit messages look like, see [How to
|
||||
Write a Git Commit Message][commit-cbeams] and the [Kernel
|
||||
documentation][commit-kernel] about committing logical changes
|
||||
separately.
|
||||
|
||||
## Style Guidelines
|
||||
|
||||
Below are some common style guidelines that all of the core modules
|
||||
follow. Before submitting a pull request, make sure that your code does
|
||||
as well!
|
||||
|
||||
* Comment every top level function (particularly exported functions),
|
||||
and provide a type signature; use Haddock syntax in the comments.
|
||||
|
||||
* Follow the coding style of the module that you are making changes to
|
||||
(`n` spaces for indentation, where to break long type signatures, …).
|
||||
|
||||
* New code should not introduce any new warnings. If you want to
|
||||
check this yourself before submitting a pull request, there is the
|
||||
`pedantic` flag, which is enforced in our CI. You can enable it by
|
||||
building your changes with `stack build --flag xmonad:pedantic` or
|
||||
`cabal build --flag pedantic`.
|
||||
|
||||
* Likewise, your code should be free of [hlint] warnings; this is also
|
||||
enforced in our GitHub CI.
|
||||
|
||||
* Partial functions are to be avoided: the window manager should not
|
||||
crash, so do not call `error` or `undefined`.
|
||||
|
||||
* Any pure function added to the core should have QuickCheck
|
||||
properties precisely defining its behavior.
|
||||
|
||||
* New modules should identify the author, and be submitted under the
|
||||
same license as xmonad (BSD3 license).
|
||||
|
||||
## Keep rocking!
|
||||
|
||||
xmonad is a passion project created and maintained by the community.
|
||||
We'd love for you to maintain your own contributed modules (approve
|
||||
changes from other contributors, review code, etc.). However, before
|
||||
we'd be comfortable adding you to the [xmonad GitHub
|
||||
organization][xmonad-gh-org] we need to trust that you have sufficient
|
||||
knowledge of Haskell and git; and have a way of chatting with you ([IRC,
|
||||
Matrix, etc.][community]).
|
||||
|
||||
[hlint]: https://github.com/ndmitchell/hlint
|
||||
[xmonad]: https://github.com/xmonad/xmonad
|
||||
[xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
|
||||
[xmonad-testing]: https://github.com/xmonad/xmonad-testing
|
||||
[x11]: https://github.com/xmonad/X11
|
||||
[ml]: https://mail.haskell.org/cgi-bin/mailman/listinfo/xmonad
|
||||
[xmonad-doc-developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
|
||||
[`#xmonad` IRC channel]: https://web.libera.chat/#xmonad
|
||||
[matrix channel]: https://matrix.to/#/#xmonad:matrix.org
|
||||
[commit-cbeams]: https://cbea.ms/git-commit/
|
||||
[commit-kernel]: https://www.kernel.org/doc/html/v4.10/process/submitting-patches.html#separate-your-changes
|
||||
[community]: https://xmonad.org/community.html
|
||||
[xmonad-gh-org]: https://github.com/xmonad
|
402
INSTALL.md
Normal file
402
INSTALL.md
Normal file
@@ -0,0 +1,402 @@
|
||||
# Install XMonad
|
||||
|
||||
On many systems xmonad is available as a binary package in your
|
||||
distribution (Debian, Ubuntu, Fedora, Arch, Gentoo, …).
|
||||
It's by far the easiest way to get xmonad, although you'll miss out on the
|
||||
latest features and fixes that may not have been released yet.
|
||||
|
||||
If you do want the latest and greatest, continue reading.
|
||||
Those who install from distro can skip this and go straight to
|
||||
[the XMonad Configuration Tutorial](TUTORIAL.md).
|
||||
|
||||
<!-- https://github.com/frnmst/md-toc -->
|
||||
<!-- regenerate via: md_toc -s1 -p github INSTALL.md -->
|
||||
<!--TOC-->
|
||||
|
||||
- [Dependencies](#dependencies)
|
||||
- [Preparation](#preparation)
|
||||
- [Download XMonad sources](#download-xmonad-sources)
|
||||
- [Build XMonad](#build-xmonad)
|
||||
- [Build using Stack](#build-using-stack)
|
||||
- [Build using cabal-install](#build-using-cabal-install)
|
||||
- [Make XMonad your window manager](#make-xmonad-your-window-manager)
|
||||
- [Custom Build Script](#custom-build-script)
|
||||
|
||||
<!--TOC-->
|
||||
|
||||
## Dependencies
|
||||
|
||||
#### Debian, Ubuntu
|
||||
|
||||
``` console
|
||||
$ sudo apt install \
|
||||
> git \
|
||||
> libx11-dev libxft-dev libxinerama-dev libxrandr-dev libxss-dev
|
||||
```
|
||||
|
||||
#### Fedora
|
||||
|
||||
``` console
|
||||
$ sudo dnf install \
|
||||
> git \
|
||||
> libX11-devel libXft-devel libXinerama-devel libXrandr-devel libXScrnSaver-devel
|
||||
```
|
||||
|
||||
#### Arch
|
||||
|
||||
``` console
|
||||
$ sudo pacman -S \
|
||||
> git \
|
||||
> xorg-server xorg-apps xorg-xinit xorg-xmessage \
|
||||
> libx11 libxft libxinerama libxrandr libxss \
|
||||
> pkgconf
|
||||
```
|
||||
|
||||
#### Void
|
||||
|
||||
``` console
|
||||
$ sudo xbps-install \
|
||||
> git \
|
||||
> ncurses-libtinfo-libs ncurses-libtinfo-devel \
|
||||
> libX11-devel libXft-devel libXinerama-devel libXrandr-devel libXScrnSaver-devel \
|
||||
> pkg-config
|
||||
```
|
||||
|
||||
## Preparation
|
||||
|
||||
We'll use the [XDG] directory specifications here, meaning our
|
||||
configuration will reside within `$XDG_CONFIG_HOME`, which is
|
||||
`~/.config` on most systems. Let's create this directory and move to
|
||||
it:
|
||||
|
||||
``` console
|
||||
$ mkdir -p ~/.config/xmonad && cd ~/.config/xmonad
|
||||
```
|
||||
|
||||
If you already have an `xmonad.hs` configuration, you can copy it over
|
||||
now. If not, you can use the defaults: create a file called `xmonad.hs`
|
||||
with the following content:
|
||||
|
||||
``` haskell
|
||||
import XMonad
|
||||
|
||||
main :: IO ()
|
||||
main = xmonad def
|
||||
```
|
||||
|
||||
Older versions of xmonad used `~/.xmonad` instead.
|
||||
This is still supported, but XDG is preferred.
|
||||
|
||||
## Download XMonad sources
|
||||
|
||||
Still in `~/.config/xmonad`, clone `xmonad` and `xmonad-contrib` repositories
|
||||
using [git][]:
|
||||
|
||||
``` console
|
||||
$ git clone https://github.com/xmonad/xmonad
|
||||
$ git clone https://github.com/xmonad/xmonad-contrib
|
||||
```
|
||||
|
||||
This will give you the latest `HEAD`; if you want you can also check
|
||||
out a tagged release, e.g.:
|
||||
|
||||
``` console
|
||||
$ git clone --branch v0.17.2 https://github.com/xmonad/xmonad
|
||||
$ git clone --branch v0.17.1 https://github.com/xmonad/xmonad-contrib
|
||||
```
|
||||
|
||||
(Sources and binaries don't usually go into `~/.config`. In our case,
|
||||
however, it avoids complexities related to Haskell build tools and lets us
|
||||
focus on the important bits of XMonad installation.)
|
||||
|
||||
## Build XMonad
|
||||
|
||||
There are two widely used Haskell build tools:
|
||||
|
||||
* [Stack][stack]
|
||||
* [cabal-install][cabal-install]
|
||||
|
||||
We include instructions for both.
|
||||
Unless you already know which one you prefer, use Stack, which is easier.
|
||||
|
||||
### Build using Stack
|
||||
|
||||
#### Install Stack
|
||||
|
||||
Probably one of the best ways to get [stack] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options.
|
||||
|
||||
You can also use your system's package
|
||||
manager:
|
||||
|
||||
``` console
|
||||
$ sudo apt install haskell-stack # Debian, Ubuntu
|
||||
$ sudo dnf install stack # Fedora
|
||||
$ sudo pacman -S stack # Arch
|
||||
```
|
||||
|
||||
If you install stack via this method, it is advisable that you run
|
||||
`stack upgrade` after installation. This will make sure that you are on
|
||||
the most recent version of the program, regardless of which version your
|
||||
distribution actually packages.
|
||||
|
||||
If your distribution does not package stack, you can also easily install
|
||||
it via the following command (this is the recommended way to install
|
||||
stack via its [documentation][stack]):
|
||||
|
||||
``` console
|
||||
$ curl -sSL https://get.haskellstack.org/ | sh
|
||||
```
|
||||
|
||||
#### Create a New Project
|
||||
|
||||
Let's create a stack project. Since we're already in the correct
|
||||
directory (`~/.config/xmonad`) with `xmonad` and `xmonad-contrib`
|
||||
subdirectories, starting a new stack project is as simple as running `stack
|
||||
init`.
|
||||
|
||||
Stack should now inform you that it will use the relevant `stack` and
|
||||
`cabal` files from `xmonad` and `xmonad-contrib` to generate its
|
||||
`stack.yaml` file. At the time of writing, this looks a little bit like
|
||||
this:
|
||||
|
||||
``` console
|
||||
$ stack init
|
||||
Looking for .cabal or package.yaml files to use to init the project.
|
||||
Using cabal packages:
|
||||
- xmonad-contrib/
|
||||
- xmonad/
|
||||
|
||||
Selecting the best among 19 snapshots...
|
||||
|
||||
* Matches https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
|
||||
|
||||
Selected resolver: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
|
||||
Initialising configuration using resolver: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
|
||||
Total number of user packages considered: 2
|
||||
Writing configuration to file: stack.yaml
|
||||
All done.
|
||||
```
|
||||
|
||||
If you look into your current directory now, you should see a freshly
|
||||
generated `stack.yaml` file:
|
||||
|
||||
``` console
|
||||
$ ls
|
||||
xmonad xmonad-contrib stack.yaml xmonad.hs
|
||||
```
|
||||
|
||||
The meat of that file (comments start with `#`, we've omitted them here)
|
||||
will look a little bit like
|
||||
|
||||
``` yaml
|
||||
resolver:
|
||||
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/9.yaml
|
||||
|
||||
packages:
|
||||
- xmonad
|
||||
- xmonad-contrib
|
||||
```
|
||||
|
||||
With `stack.yaml` alongside `xmonad.hs`, xmonad now knows that it needs to use
|
||||
`stack ghc` instead of just `ghc` when (re)compiling its configuration.
|
||||
If you want to keep xmonad sources and the stack project elsewhere, but still
|
||||
use `xmonad --recompile`, symlink your real `stack.yaml` into the xmonad
|
||||
configuration directory, or [use a custom build script](#custom-build-script).
|
||||
|
||||
#### Install Everything
|
||||
|
||||
Installing things is as easy as typing `stack install`. This will
|
||||
install the correct version of GHC, as well as build all of the required
|
||||
packages (`stack build`) and then copy the relevant executables
|
||||
(`xmonad`, in our case) to `~/.local/bin`. Make sure to add that
|
||||
directory to your `$PATH`! The command `which xmonad` should now return
|
||||
that executable. In case it does not, check if you still have xmonad
|
||||
installed via your package manager and uninstall it.
|
||||
|
||||
If you're getting build failures while building the `X11` package it may
|
||||
be that you don't have the required C libraries installed. See
|
||||
[above](#dependencies).
|
||||
|
||||
### Build using cabal-install
|
||||
|
||||
#### Install cabal-install
|
||||
|
||||
Probably one of the best ways to get [cabal-install] is to use [GHCup], which is the main Haskell installer according to language's official [website][GHCup] and community [survey]. GHCup is [widely available] and is considered less error prone than other installation options.
|
||||
|
||||
You can also use your system's package
|
||||
manager:
|
||||
|
||||
``` console
|
||||
$ sudo apt install cabal-install # Debian, Ubuntu
|
||||
$ sudo dnf install cabal-install # Fedora
|
||||
$ sudo pacman -S cabal-install # Arch
|
||||
```
|
||||
|
||||
See also <https://www.haskell.org/cabal/#install-upgrade>.
|
||||
|
||||
#### Create a New Project
|
||||
|
||||
If you want to use `xmonad` or `xmonad-contrib` from git, you will need a
|
||||
`cabal.project` file. If you want to use both from [Hackage][], you should
|
||||
skip this step.
|
||||
|
||||
Create a file named `cabal.project` containing:
|
||||
|
||||
```
|
||||
packages: */*.cabal
|
||||
```
|
||||
|
||||
(If you do this step without using [git] checkouts, you will get an error from
|
||||
cabal in the next step. Simply remove `cabal.project` and try again.)
|
||||
|
||||
#### Install Everything
|
||||
|
||||
You'll need to update the cabal package index, build xmonad and xmonad-contrib
|
||||
libraries and then build the xmonad binary:
|
||||
|
||||
``` console
|
||||
$ cabal update
|
||||
$ cabal install --package-env=$HOME/.config/xmonad --lib base xmonad xmonad-contrib
|
||||
$ cabal install --package-env=$HOME/.config/xmonad xmonad
|
||||
```
|
||||
|
||||
This will create a GHC environment in `~/.config/xmonad` so that the libraries
|
||||
are available for recompilation of the config file, and also install the
|
||||
xmonad binary to `~/.cabal/bin/xmonad`. Make sure you have that directory in
|
||||
your `$PATH`!
|
||||
|
||||
If you're getting build failures while building the `X11` package it may
|
||||
be that you don't have the required C libraries installed. See
|
||||
[above](#dependencies).
|
||||
|
||||
## Make XMonad your window manager
|
||||
|
||||
This step varies depending on your distribution and X display manager (if
|
||||
any).
|
||||
|
||||
#### Debian, Ubuntu
|
||||
|
||||
`/etc/X11/xinit/xinitrc` runs `/etc/X11/Xsession` which runs `~/.xsession`, so
|
||||
you probably want to put `exec xmonad` there (don't forget the shebang and chmod).
|
||||
|
||||
(Tested with `startx`, `xdm`, `lightdm`.)
|
||||
|
||||
By using `~/.xsession`, the distro takes care of stuff like dbus, ssh-agent, X
|
||||
resources, etc. If you want a completely manual X session, use `~/.xinitrc`
|
||||
instead. Or invoke `startx`/`xinit` with an explicit path.
|
||||
|
||||
Some newer display managers require an entry in `/usr/share/xsessions`.
|
||||
To use your custom `~/.xsession`, put these lines to
|
||||
`/usr/share/xsessions/default.desktop`:
|
||||
|
||||
```
|
||||
[Desktop Entry]
|
||||
Name=Default X session
|
||||
Type=Application
|
||||
Exec=default
|
||||
```
|
||||
|
||||
(Tested with `sddm`.)
|
||||
|
||||
#### Fedora
|
||||
|
||||
`/etc/X11/xinit/xinitrc` runs `~/.Xclients`, so you probably want to put `exec
|
||||
xmonad` there (don't forget the shebang and chmod). Like in Debian, this can
|
||||
be overridden by having a completely custom `~/.xinitrc` or passing arguments
|
||||
to `startx`/`xinit`.
|
||||
|
||||
X display managers (e.g. `lightdm`) usually invoke `/etc/X11/xinit/Xsession`
|
||||
instead, which additionally redirects output to `~/.xsession-errors` and also
|
||||
tries `~/.xsession` before `~/.Xclients`.
|
||||
|
||||
Newer display managers require an entry in `/usr/share/xsessions`, which is
|
||||
available in the `xorg-x11-xinit-session` package.
|
||||
|
||||
#### Arch
|
||||
|
||||
`/etc/X11/xinit/xinitrc` runs `twm`, `xclock` and 3 `xterm`s; users are
|
||||
meant to just copy that to `~/.xinitrc` and
|
||||
[customize](https://wiki.archlinux.org/title/Xinit#xinitrc) it: replace the
|
||||
last few lines with `exec xmonad`.
|
||||
|
||||
Display managers like `lightdm` have their own `Xsession` script which invokes
|
||||
`~/.xsession`. Other display managers need an entry in
|
||||
`/usr/share/xsessions`, <https://aur.archlinux.org/packages/xinit-xsession/>
|
||||
provides one.
|
||||
|
||||
#### See also
|
||||
|
||||
* <https://xmonad.org/documentation.html#in-your-environment>
|
||||
* [FAQ: How can I use xmonad with a display manager? (xdm, kdm, gdm)](https://wiki.haskell.org/Xmonad/Frequently_asked_questions#How_can_I_use_xmonad_with_a_display_manager.3F_.28xdm.2C_kdm.2C_gdm.29)
|
||||
|
||||
## Custom Build Script
|
||||
|
||||
If you need to customize what happens during `xmonad --recompile` (bound to
|
||||
`M-q` by default), perhaps because your xmonad configuration is a whole
|
||||
separate Haskell package, you need to create a so-called `build` file. This
|
||||
is quite literally just a shell script called `build` in your xmonad directory
|
||||
(which is `~/.config/xmonad` for us) that tells xmonad how it should build its
|
||||
executable.
|
||||
|
||||
A good starting point (this is essentially [what xmonad would do][]
|
||||
without a build file, with the exception that we are invoking `stack
|
||||
ghc` instead of plain `ghc`) would be
|
||||
|
||||
``` shell
|
||||
#!/bin/sh
|
||||
|
||||
exec stack ghc -- \
|
||||
--make xmonad.hs \
|
||||
-i \
|
||||
-ilib \
|
||||
-fforce-recomp \
|
||||
-main-is main \
|
||||
-v0 \
|
||||
-o "$1"
|
||||
```
|
||||
|
||||
Don't forget to mark the file as `+x`: `chmod +x build`!
|
||||
|
||||
Some example build scripts for `stack` and `cabal` are provided in the
|
||||
`xmonad-contrib` distribution. You can see those online in the
|
||||
[scripts/build][] directory. You might wish to use these if you have
|
||||
special dependencies for your `xmonad.hs`, especially with cabal as
|
||||
you must use a cabal file and often a `cabal.project` to specify them;
|
||||
`cabal install --lib` above generally isn't enough, and when it is
|
||||
it can be difficult to keep track of when you want to replicate your
|
||||
configuration on another system.
|
||||
|
||||
#### Don't Recompile on Every Startup
|
||||
|
||||
By default, xmonad always recompiles itself when a build script is used
|
||||
(because the build script could contain arbitrary code, so a simple
|
||||
check whether the `xmonad.hs` file changed is not enough). If you find
|
||||
that too annoying, then you can use the `xmonad-ARCH` executable that
|
||||
`xmonad --recompile` generates instead of `xmonad` in your startup. For
|
||||
example, instead of writing
|
||||
|
||||
``` shell
|
||||
exec xmonad
|
||||
```
|
||||
|
||||
in your `~/.xinitrc`, you would write
|
||||
|
||||
``` shell
|
||||
exec $HOME/.cache/xmonad/xmonad-x86_64-linux
|
||||
```
|
||||
|
||||
The `~/.cache` prefix is the `$XDG_CACHE_HOME` directory. Note that
|
||||
if your xmonad configuration resides within `~/.xmonad`, then the
|
||||
executable will also be within that directory and not in
|
||||
`$XDG_CACHE_HOME`.
|
||||
|
||||
[XDG]: https://specifications.freedesktop.org/basedir-spec/basedir-spec-latest.html
|
||||
[git]: https://git-scm.com/
|
||||
[stack]: https://docs.haskellstack.org/en/stable/README/
|
||||
[cabal-install]: https://www.haskell.org/cabal/
|
||||
[GHCup]: https://www.haskell.org/ghcup/
|
||||
[survey]: https://taylor.fausak.me/2022/11/18/haskell-survey-results/
|
||||
[widely available]: https://www.haskell.org/ghcup/install/#supported-platforms
|
||||
[what xmonad would do]: https://github.com/xmonad/xmonad/blob/master/src/XMonad/Core.hs#L659-L667
|
||||
[Hackage]: https://hackage.haskell.org/
|
||||
[scripts/build]: https://github.com/xmonad/xmonad-contrib/blob/master/scripts/build
|
45
LICENSE
45
LICENSE
@@ -1,31 +1,28 @@
|
||||
Copyright (c) 2007,2008 Spencer Janssen
|
||||
Copyright (c) 2007,2008 Don Stewart
|
||||
Copyright (c) The Xmonad Community. All rights reserved.
|
||||
|
||||
All rights reserved.
|
||||
Redistribution and use in source and binary forms, with or without modification,
|
||||
are permitted provided that the following conditions are met:
|
||||
|
||||
Redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions
|
||||
are met:
|
||||
1. Redistributions of source code must retain the above copyright notice,
|
||||
this list of conditions and the following disclaimer.
|
||||
|
||||
1. Redistributions of source code must retain the above copyright
|
||||
notice, this list of conditions and the following disclaimer.
|
||||
2. Redistributions in binary form must reproduce the above copyright notice,
|
||||
this list of conditions and the following disclaimer in the documentation
|
||||
and/or other materials provided with the distribution.
|
||||
|
||||
2. Redistributions in binary form must reproduce the above copyright
|
||||
notice, this list of conditions and the following disclaimer in the
|
||||
documentation and/or other materials provided with the distribution.
|
||||
3. Neither the name of the copyright holder nor the names of its contributors
|
||||
may be used to endorse or promote products derived from this software without
|
||||
specific prior written permission.
|
||||
|
||||
3. Neither the name of the author nor the names of his contributors
|
||||
may be used to endorse or promote products derived from this software
|
||||
without specific prior written permission.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``AS IS'' AND ANY EXPRESS OR
|
||||
IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR
|
||||
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
|
||||
OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
|
||||
HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
|
||||
STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
|
||||
ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
||||
POSSIBILITY OF SUCH DAMAGE.
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
||||
AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
||||
IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
||||
ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
|
||||
LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE
|
||||
USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
|
146
MAINTAINERS.md
Normal file
146
MAINTAINERS.md
Normal file
@@ -0,0 +1,146 @@
|
||||
# XMonad Maintainers
|
||||
|
||||
## The XMonad Core Team
|
||||
|
||||
* Brandon S Allbery [GitHub][geekosaur], IRC: `geekosaur`, [GPG][gpg:geekosaur]
|
||||
|
||||
* Brent Yorgey [GitHub][byorgey], IRC: `byorgey`
|
||||
|
||||
* Daniel Wagner [GitHub][dmwit], [Twitter][twitter:dmwit], IRC: `dmwit`
|
||||
|
||||
* Sibi Prabakaran [GitHub][psibi], [Twitter][twitter:psibi], IRC: `sibi`
|
||||
|
||||
* Tomáš Janoušek [GitHub][liskin], [Twitter][twitter:liskin], IRC: `liskin`, [GPG][gpg:liskin]
|
||||
|
||||
* Tony Zorman [GitHub][slotThe], IRC: `Solid`, [GPG][gpg:slotThe]
|
||||
|
||||
[geekosaur]: https://github.com/geekosaur
|
||||
[byorgey]: https://github.com/byorgey
|
||||
[dmwit]: https://github.com/dmwit
|
||||
[psibi]: https://github.com/psibi
|
||||
[liskin]: https://github.com/liskin
|
||||
[slotThe]: https://github.com/slotThe
|
||||
|
||||
[gpg:geekosaur]: https://github.com/geekosaur.gpg
|
||||
[gpg:liskin]: https://github.com/liskin.gpg
|
||||
[gpg:slotThe]: https://github.com/slotThe.gpg
|
||||
|
||||
[twitter:dmwit]: https://twitter.com/dmwit13
|
||||
[twitter:psibi]: https://twitter.com/psibi
|
||||
[twitter:liskin]: https://twitter.com/Liskni_si
|
||||
|
||||
## Hall of Fame (past maintainers/developers)
|
||||
|
||||
* Adam Vogt [GitHub](https://github.com/aavogt)
|
||||
|
||||
* Peter Simons [GitHub](https://github.com/peti), [Twitter](https://twitter.com/OriginalPeti)
|
||||
|
||||
* Spencer Janssen [GitHub](https://github.com/spencerjanssen)
|
||||
|
||||
* Don Stewart [GitHub](https://github.com/donsbot), [Twitter](https://twitter.com/donsbot)
|
||||
|
||||
* Jason Creighton [GitHub](https://github.com/JasonCreighton)
|
||||
|
||||
* David Roundy [GitHub](https://github.com/droundy)
|
||||
|
||||
* Daniel Schoepe [GitHub](https://github.com/dschoepe)
|
||||
|
||||
* Eric Mertens [GitHub](https://github.com/glguy)
|
||||
|
||||
* Nicolas Pouillard [GitHub](https://github.com/np)
|
||||
|
||||
* Roman Cheplyaka [GitHub](https://github.com/UnkindPartition)
|
||||
|
||||
* Gwern Branwen [GitHub](https://github.com/gwern)
|
||||
|
||||
* Lukas Mai [GitHub](https://github.com/mauke)
|
||||
|
||||
* Braden Shepherdson [GitHub](https://github.com/shepheb)
|
||||
|
||||
* Devin Mullins [GitHub](https://github.com/twifkak)
|
||||
|
||||
* David Lazar [GitHub](https://github.com/davidlazar)
|
||||
|
||||
* Peter J. Jones [GitHub](https://github.com/pjones)
|
||||
|
||||
## Release Procedures
|
||||
|
||||
When the time comes to release another version of xmonad and xmonad-contrib:
|
||||
|
||||
1. Update the version number in all the `*.cabal` files and let the CI
|
||||
verify that it all builds together.
|
||||
|
||||
2. Review documentation files and make sure they are accurate:
|
||||
|
||||
- [`README.md`](README.md)
|
||||
- [`CHANGES.md`](CHANGES.md) (bump version, set date)
|
||||
- [`INSTALL.md`](INSTALL.md)
|
||||
- [`man/xmonad.1.markdown.in`](man/xmonad.1.markdown.in)
|
||||
- [haddocks](https://xmonad.github.io/xmonad-docs/)
|
||||
|
||||
If the manpage changes, wait for the CI to rebuild the rendered outputs.
|
||||
|
||||
3. Update the website:
|
||||
|
||||
- Draft a [new release announcement][web-announce].
|
||||
- Check install instructions, guided tour, keybindings cheat sheet, …
|
||||
|
||||
4. Make sure that `tested-with:` covers several recent releases of GHC, that
|
||||
`.github/workflows/haskell-ci.yml` had been updated to test all these GHC
|
||||
versions and that `.github/workflows/stack.yml` tests with several recent
|
||||
revisions of [Stackage][] LTS.
|
||||
|
||||
5. Trigger the Haskell-CI workflow and fill in the candidate version number.
|
||||
This will upload a release candidate to Hackage.
|
||||
|
||||
- https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml
|
||||
- https://github.com/xmonad/xmonad-contrib/actions/workflows/haskell-ci.yml
|
||||
|
||||
Check that everything looks good. If not, push fixes and do another
|
||||
candidate. When everything's ready, create a release on GitHub:
|
||||
|
||||
- https://github.com/xmonad/xmonad/releases/new
|
||||
- https://github.com/xmonad/xmonad-contrib/releases/new
|
||||
|
||||
CI will automatically upload the final release to Hackage.
|
||||
|
||||
See [haskell-ci-hackage.patch][] for details about the Hackage automation.
|
||||
|
||||
6. Post announcement to:
|
||||
|
||||
- [xmonad.org website](https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts)
|
||||
- [XMonad mailing list](https://mail.haskell.org/mailman/listinfo/xmonad)
|
||||
- [Haskell Cafe](https://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe)
|
||||
- [Haskell Discourse](https://discourse.haskell.org/)
|
||||
- [Twitter](https://twitter.com/xmonad)
|
||||
- [Reddit](https://www.reddit.com/r/xmonad/)
|
||||
|
||||
See [old announcements][old-announce] ([even older][older-announce]) for inspiration.
|
||||
|
||||
7. Trigger xmonad-docs build to generate and persist docs for the just
|
||||
released version:
|
||||
|
||||
- https://github.com/xmonad/xmonad-docs/actions/workflows/stack.yml
|
||||
|
||||
8. Bump version for development (add `.9`) and prepare fresh sections in
|
||||
[`CHANGES.md`](CHANGES.md).
|
||||
|
||||
[packdeps]: https://hackage.haskell.org/package/packdeps
|
||||
[Stackage]: https://www.stackage.org/
|
||||
[haskell-ci-hackage.patch]: .github/workflows/haskell-ci-hackage.patch
|
||||
[web-announce]: https://github.com/xmonad/xmonad-web/tree/gh-pages/news/_posts
|
||||
[old-announce]: https://github.com/xmonad/xmonad-web/blob/gh-pages/news/_posts/2021-10-27-xmonad-0-17-0.md
|
||||
[older-announce]: https://github.com/xmonad/xmonad-web/tree/55614349421ebafaef4a47424fcb16efa80ff768
|
||||
|
||||
## Website and Other Accounts
|
||||
|
||||
* The [xmonad twitter] is tended to by [liskin].
|
||||
|
||||
* The [xmonad.org] domain is owned by [eyenx] and the website itself is
|
||||
deployed via GitHub Pages. It can be updated by making a pull request
|
||||
against the [xmonad-web] repository.
|
||||
|
||||
[eyenx]: https://github.com/eyenx
|
||||
[xmonad-web]: https://github.com/xmonad/xmonad-web/
|
||||
[xmonad.org]: https://xmonad.org/
|
||||
[xmonad twitter]: https://twitter.com/xmonad
|
90
Main.hs
90
Main.hs
@@ -16,93 +16,5 @@ module Main (main) where
|
||||
|
||||
import XMonad
|
||||
|
||||
import Control.Monad (unless)
|
||||
import System.IO
|
||||
import System.Info
|
||||
import System.Environment
|
||||
import System.Posix.Process (executeFile)
|
||||
import System.Exit (exitFailure)
|
||||
|
||||
import Paths_xmonad (version)
|
||||
import Data.Version (showVersion)
|
||||
|
||||
import Graphics.X11.Xinerama (compiledWithXinerama)
|
||||
|
||||
#ifdef TESTING
|
||||
import qualified Properties
|
||||
#endif
|
||||
|
||||
-- | The entry point into xmonad. Attempts to compile any custom main
|
||||
-- for xmonad, and if it doesn't find one, just launches the default.
|
||||
main :: IO ()
|
||||
main = do
|
||||
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
|
||||
args <- getArgs
|
||||
let launch = catchIO buildLaunch >> xmonad defaultConfig
|
||||
case args of
|
||||
[] -> launch
|
||||
("--resume":_) -> launch
|
||||
["--help"] -> usage
|
||||
["--recompile"] -> recompile True >>= flip unless exitFailure
|
||||
["--restart"] -> sendRestart >> return ()
|
||||
["--version"] -> putStrLn $ unwords shortVersion
|
||||
["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
|
||||
#ifdef TESTING
|
||||
("--run-tests":_) -> Properties.main
|
||||
#endif
|
||||
_ -> fail "unrecognized flags"
|
||||
where
|
||||
shortVersion = ["xmonad", showVersion version]
|
||||
longVersion = [ "compiled by", compilerName, showVersion compilerVersion
|
||||
, "for", arch ++ "-" ++ os
|
||||
, "\nXinerama:", show compiledWithXinerama ]
|
||||
|
||||
usage :: IO ()
|
||||
usage = do
|
||||
self <- getProgName
|
||||
putStr . unlines $
|
||||
concat ["Usage: ", self, " [OPTION]"] :
|
||||
"Options:" :
|
||||
" --help Print this message" :
|
||||
" --version Print the version number" :
|
||||
" --recompile Recompile your ~/.xmonad/xmonad.hs" :
|
||||
" --restart Request a running xmonad process to restart" :
|
||||
#ifdef TESTING
|
||||
" --run-tests Run the test suite" :
|
||||
#endif
|
||||
[]
|
||||
|
||||
-- | Build "~\/.xmonad\/xmonad.hs" with ghc, then execute it. If there are no
|
||||
-- errors, this function does not return. An exception is raised in any of
|
||||
-- these cases:
|
||||
--
|
||||
-- * ghc missing
|
||||
--
|
||||
-- * both "~\/.xmonad\/xmonad.hs" and "~\/.xmonad\/xmonad-$arch-$os" missing
|
||||
--
|
||||
-- * xmonad.hs fails to compile
|
||||
--
|
||||
-- ** wrong ghc in path (fails to compile)
|
||||
--
|
||||
-- ** type error, syntax error, ..
|
||||
--
|
||||
-- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
|
||||
--
|
||||
buildLaunch :: IO ()
|
||||
buildLaunch = do
|
||||
recompile False
|
||||
dir <- getXMonadDir
|
||||
args <- getArgs
|
||||
executeFile (dir ++ "/xmonad-"++arch++"-"++os) False args Nothing
|
||||
return ()
|
||||
|
||||
sendRestart :: IO ()
|
||||
sendRestart = do
|
||||
dpy <- openDisplay ""
|
||||
rw <- rootWindow dpy $ defaultScreen dpy
|
||||
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
|
||||
allocaXEvent $ \e -> do
|
||||
setEventType e clientMessage
|
||||
setClientMessageEvent e rw xmonad_restart 32 0 currentTime
|
||||
sendEvent dpy rw False structureNotifyMask e
|
||||
sync dpy False
|
||||
main = xmonad def
|
||||
|
149
README
149
README
@@ -1,149 +0,0 @@
|
||||
xmonad : a tiling window manager
|
||||
|
||||
http://xmonad.org
|
||||
|
||||
xmonad is a tiling window manager for X. Windows are arranged
|
||||
automatically to tile the screen without gaps or overlap, maximising
|
||||
screen use. Window manager features are accessible from the
|
||||
keyboard: a mouse is optional. xmonad is written, configured and
|
||||
extensible in Haskell. Custom layout algorithms, key bindings and
|
||||
other extensions may be written by the user in config files. Layouts
|
||||
are applied dynamically, and different layouts may be used on each
|
||||
workspace. Xinerama is fully supported, allowing windows to be tiled
|
||||
on several physical screens.
|
||||
|
||||
Quick start:
|
||||
|
||||
Obtain the dependent libraries, then build with:
|
||||
|
||||
runhaskell Setup.lhs configure --user --prefix=$HOME
|
||||
runhaskell Setup.lhs build
|
||||
runhaskell Setup.lhs install --user
|
||||
|
||||
For the full story, read on.
|
||||
|
||||
Building:
|
||||
|
||||
Building is quite straightforward, and requires a basic Haskell toolchain.
|
||||
On many systems xmonad is available as a binary package in your
|
||||
package system (e.g. on Debian or Gentoo). If at all possible, use this
|
||||
in preference to a source build, as the dependency resolution will be
|
||||
simpler.
|
||||
|
||||
We'll now walk through the complete list of toolchain dependencies.
|
||||
|
||||
* GHC: the Glasgow Haskell Compiler
|
||||
|
||||
You first need a Haskell compiler. Your distribution's package
|
||||
system will have binaries of GHC (the Glasgow Haskell Compiler), the
|
||||
compiler we use, so install that first. If your operating system's
|
||||
package system doesn't provide a binary version of GHC, you can find
|
||||
them here:
|
||||
|
||||
http://haskell.org/ghc
|
||||
|
||||
For example, in Debian you would install GHC with:
|
||||
|
||||
apt-get install ghc6
|
||||
|
||||
It shouldn't be necessary to compile GHC from source -- every common
|
||||
system has a pre-build binary version.
|
||||
|
||||
* X11 libraries:
|
||||
|
||||
Since you're building an X application, you'll need the C X11
|
||||
library headers. On many platforms, these come pre-installed. For
|
||||
others, such as Debian, you can get them from your package manager:
|
||||
|
||||
apt-get install libx11-dev
|
||||
|
||||
Typically you need: libXinerama libXext libX11
|
||||
|
||||
* Cabal
|
||||
|
||||
xmonad requires a recent version of Cabal, >= 1.2.0. If you're using
|
||||
GHC 6.8, then it comes bundled with the right version. If you're
|
||||
using GHC 6.6.x, you'll need to build and install Cabal from hackage
|
||||
first:
|
||||
|
||||
http://hackage.haskell.org/cgi-bin/hackage-scripts/package/Cabal
|
||||
|
||||
You can check which version you have with the command:
|
||||
|
||||
$ ghc-pkg list Cabal
|
||||
Cabal-1.2.2.0
|
||||
|
||||
* Haskell libraries: mtl, unix, X11
|
||||
|
||||
Finally, you need the Haskell libraries xmonad depends on. Since
|
||||
you've a working GHC installation now, most of these will be
|
||||
provided. To check whether you've got a package run 'ghc-pkg list
|
||||
some_package_name'. You will need the following packages:
|
||||
|
||||
mtl http://hackage.haskell.org/cgi-bin/hackage-scripts/package/mtl
|
||||
unix http://hackage.haskell.org/cgi-bin/hackage-scripts/package/unix
|
||||
X11 http://hackage.haskell.org/cgi-bin/hackage-scripts/package/X11
|
||||
|
||||
* Build xmonad:
|
||||
|
||||
Once you've got all the dependencies in place (which should be
|
||||
straightforward), build xmonad:
|
||||
|
||||
runhaskell Setup.lhs configure --user --prefix=$HOME
|
||||
runhaskell Setup.lhs build
|
||||
runhaskell Setup.lhs install --user
|
||||
|
||||
And you're done!
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Running xmonad:
|
||||
|
||||
Add:
|
||||
|
||||
$HOME/bin/xmonad
|
||||
|
||||
to the last line of your .xsession or .xinitrc file.
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Configuring:
|
||||
|
||||
See the CONFIG document
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
XMonadContrib
|
||||
|
||||
There are many extensions to xmonad available in the XMonadContrib
|
||||
(xmc) library. Examples include an ion3-like tabbed layout, a
|
||||
prompt/program launcher, and various other useful modules.
|
||||
XMonadContrib is available at:
|
||||
|
||||
latest release: http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmonad-contrib
|
||||
|
||||
darcs version: darcs get http://code.haskell.org/XMonadContrib
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
Other useful programs:
|
||||
|
||||
A nicer xterm replacement, that supports resizing better:
|
||||
|
||||
urxvt http://software.schmorp.de/pkg/rxvt-unicode.html
|
||||
|
||||
For custom status bars:
|
||||
|
||||
dzen http://gotmor.googlepages.com/dzen
|
||||
xmobar http://hackage.haskell.org/cgi-bin/hackage-scripts/package/xmobar
|
||||
|
||||
For a program dispatch menu:
|
||||
|
||||
dmenu http://www.suckless.org/download/
|
||||
gmrun (in your package system)
|
||||
|
||||
Authors:
|
||||
|
||||
Spencer Janssen
|
||||
Don Stewart
|
||||
Jason Creighton
|
104
README.md
Normal file
104
README.md
Normal file
@@ -0,0 +1,104 @@
|
||||
<p align="center">
|
||||
<a href="https://xmonad.org/"><img alt="XMonad logo" src="https://xmonad.org/images/logo-wrapped.svg" height=150></a>
|
||||
</p>
|
||||
<p align="center">
|
||||
<a href="https://hackage.haskell.org/package/xmonad"><img alt="Hackage" src="https://img.shields.io/hackage/v/xmonad?logo=haskell"></a>
|
||||
<a href="https://github.com/xmonad/xmonad/blob/readme/LICENSE"><img alt="License" src="https://img.shields.io/github/license/xmonad/xmonad"></a>
|
||||
<a href="https://haskell.org/"><img alt="Made in Haskell" src="https://img.shields.io/badge/Made%20in-Haskell-%235e5086?logo=haskell"></a>
|
||||
<br>
|
||||
<a href="https://github.com/xmonad/xmonad/actions/workflows/stack.yml"><img alt="Stack" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/stack.yml?label=Stack&logo=githubactions&logoColor=white"></a>
|
||||
<a href="https://github.com/xmonad/xmonad/actions/workflows/haskell-ci.yml"><img alt="Cabal" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/haskell-ci.yml?label=Cabal&logo=githubactions&logoColor=white"></a>
|
||||
<a href="https://github.com/xmonad/xmonad/actions/workflows/nix.yml"><img alt="Nix" src="https://img.shields.io/github/actions/workflow/status/xmonad/xmonad/nix.yml?label=Nix&logo=githubactions&logoColor=white"></a>
|
||||
<br>
|
||||
<a href="https://github.com/sponsors/xmonad"><img alt="GitHub Sponsors" src="https://img.shields.io/github/sponsors/xmonad?label=GitHub%20Sponsors&logo=githubsponsors"></a>
|
||||
<a href="https://opencollective.com/xmonad"><img alt="Open Collective" src="https://img.shields.io/opencollective/all/xmonad?label=Open%20Collective&logo=opencollective"></a>
|
||||
<br>
|
||||
<a href="https://web.libera.chat/#xmonad"><img alt="Chat on #xmonad@irc.libera.chat" src="https://img.shields.io/badge/%23%20chat-on%20libera-brightgreen"></a>
|
||||
<a href="https://matrix.to/#/#xmonad:matrix.org"><img alt="Chat on #xmonad:matrix.org" src="https://img.shields.io/matrix/xmonad:matrix.org?logo=matrix"></a>
|
||||
</p>
|
||||
|
||||
# xmonad
|
||||
|
||||
**A tiling window manager for X11.**
|
||||
|
||||
[XMonad][web:xmonad] is a tiling window manager for X11. Windows are arranged
|
||||
automatically to tile the screen without gaps or overlap, maximising
|
||||
screen use. Window manager features are accessible from the keyboard:
|
||||
a mouse is optional. xmonad is written, configured and extensible in
|
||||
Haskell. Custom layout algorithms, key bindings and other extensions
|
||||
may be written by the user in config files. Layouts are applied
|
||||
dynamically, and different layouts may be used on each
|
||||
workspace. Xinerama is fully supported, allowing windows to be tiled
|
||||
on several physical screens.
|
||||
|
||||
This repository contains the [xmonad][hackage:xmonad] package, a minimal,
|
||||
stable, yet extensible core. It is accompanied by
|
||||
[xmonad-contrib][gh:xmonad-contrib], a library of hundreds of additional
|
||||
community-maintained tiling algorithms and extension modules. The two combined
|
||||
make for a powerful X11 window-manager with endless customization
|
||||
possibilities. They are, quite literally, libraries for creating your own
|
||||
window manager.
|
||||
|
||||
## Installation
|
||||
|
||||
For installation and configuration instructions, please see:
|
||||
|
||||
* [downloading and installing xmonad][web:download]
|
||||
* [installing latest xmonad snapshot from git][web:install]
|
||||
* [configuring xmonad][web:tutorial]
|
||||
|
||||
If you run into any trouble, consult our [documentation][web:documentation] or
|
||||
ask the [community][web:community] for help.
|
||||
|
||||
## Contributing
|
||||
|
||||
We welcome all forms of contributions:
|
||||
|
||||
* [bug reports and feature ideas][gh:xmonad:issues]
|
||||
(also to [xmonad-contrib][gh:xmonad-contrib:issues])
|
||||
* [bug fixes, new features, new extensions][gh:xmonad:pulls]
|
||||
(usually to [xmonad-contrib][gh:xmonad-contrib:pulls])
|
||||
* documentation fixes and improvements: [xmonad][gh:xmonad],
|
||||
[xmonad-contrib][gh:xmonad-contrib], [xmonad-web][gh:xmonad-web]
|
||||
* helping others in the [community][web:community]
|
||||
* financial support: [GitHub Sponsors][gh:xmonad:sponsors],
|
||||
[Open Collective][opencollective:xmonad]
|
||||
|
||||
Please do read the [CONTRIBUTING][gh:xmonad:contributing] document for more
|
||||
information about bug reporting and code contributions. For a brief overview
|
||||
of the architecture and code conventions, see the [documentation for the
|
||||
`XMonad.Doc.Developing` module][doc:developing]. If in doubt, [talk to
|
||||
us][web:community].
|
||||
|
||||
## Authors
|
||||
|
||||
Started in 2007 by [Spencer Janssen][gh:spencerjanssen], [Don
|
||||
Stewart][gh:donsbot] and [Jason Creighton][gh:JasonCreighton], the
|
||||
[XMonad][web:xmonad] project lives on thanks to [new generations of
|
||||
maintainers][gh:xmonad:maintainers] and [dozens of
|
||||
contributors][gh:xmonad:contributors].
|
||||
|
||||
[gh:spencerjanssen]: https://github.com/spencerjanssen
|
||||
[gh:donsbot]: https://github.com/donsbot
|
||||
[gh:JasonCreighton]: https://github.com/JasonCreighton
|
||||
|
||||
[doc:developing]: https://xmonad.github.io/xmonad-docs/xmonad-contrib/XMonad-Doc-Developing.html
|
||||
[gh:xmonad-contrib:issues]: https://github.com/xmonad/xmonad-contrib/issues
|
||||
[gh:xmonad-contrib:pulls]: https://github.com/xmonad/xmonad-contrib/pulls
|
||||
[gh:xmonad-contrib]: https://github.com/xmonad/xmonad-contrib
|
||||
[gh:xmonad-web]: https://github.com/xmonad/xmonad-web
|
||||
[gh:xmonad:contributing]: https://github.com/xmonad/xmonad/blob/master/CONTRIBUTING.md
|
||||
[gh:xmonad:contributors]: https://github.com/xmonad/xmonad/graphs/contributors
|
||||
[gh:xmonad:issues]: https://github.com/xmonad/xmonad/issues
|
||||
[gh:xmonad:maintainers]: https://github.com/xmonad/xmonad/blob/master/MAINTAINERS.md
|
||||
[gh:xmonad:pulls]: https://github.com/xmonad/xmonad/pulls
|
||||
[gh:xmonad:sponsors]: https://github.com/sponsors/xmonad
|
||||
[gh:xmonad]: https://github.com/xmonad/xmonad
|
||||
[hackage:xmonad]: https://hackage.haskell.org/package/xmonad
|
||||
[opencollective:xmonad]: https://opencollective.com/xmonad
|
||||
[web:community]: https://xmonad.org/community.html
|
||||
[web:documentation]: https://xmonad.org/documentation.html
|
||||
[web:download]: https://xmonad.org/download.html
|
||||
[web:install]: https://xmonad.org/INSTALL.html
|
||||
[web:tutorial]: https://xmonad.org/TUTORIAL.html
|
||||
[web:xmonad]: https://xmonad.org/
|
21
STYLE
21
STYLE
@@ -1,21 +0,0 @@
|
||||
|
||||
== Coding guidelines for contributing to
|
||||
== xmonad and the xmonad contributed extensions
|
||||
|
||||
* Comment every top level function (particularly exported functions), and
|
||||
provide a type signature; use Haddock syntax in the comments.
|
||||
|
||||
* Follow the coding style of the other modules.
|
||||
|
||||
* Code should be compilable with -Wall -Werror. There should be no warnings.
|
||||
|
||||
* Partial functions should be avoided: the window manager should not
|
||||
crash, so do not call `error` or `undefined`
|
||||
|
||||
* Tabs are illegal. Use 4 spaces for indenting.
|
||||
|
||||
* Any pure function added to the core should have QuickCheck properties
|
||||
precisely defining its behavior.
|
||||
|
||||
* New modules should identify the author, and be submitted under
|
||||
the same license as xmonad (BSD3 license or freer).
|
21
TODO
21
TODO
@@ -1,21 +0,0 @@
|
||||
- Write down invariants for the window life cycle, especially:
|
||||
- When are borders set? Prove that the current handling is sufficient.
|
||||
|
||||
- current floating layer handling is nonoptimal. FocusUp should raise,
|
||||
for example
|
||||
|
||||
- Issues still with stacking order.
|
||||
|
||||
= Release management =
|
||||
|
||||
* configuration documentation
|
||||
|
||||
* generate haddocks for core and XMC, upload to xmonad.org
|
||||
* generate manpage, generate html manpage
|
||||
* double check README build instructions
|
||||
* test core with 6.6 and 6.8
|
||||
* bump xmonad.cabal version and X11 version
|
||||
* upload X11 and xmonad to Hackage
|
||||
* check examples/text in user-facing Config.hs
|
||||
* check tour.html and intro.html are up to date, and mention all core bindings
|
||||
* confirm template config is type correct
|
1330
TUTORIAL.md
Normal file
1330
TUTORIAL.md
Normal file
File diff suppressed because it is too large
Load Diff
511
XMonad/Core.hs
511
XMonad/Core.hs
@@ -1,511 +0,0 @@
|
||||
{-# LANGUAGE ExistentialQuantification, FlexibleInstances, GeneralizedNewtypeDeriving,
|
||||
MultiParamTypeClasses, TypeSynonymInstances, CPP #-}
|
||||
-- required for deriving Typeable
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Core
|
||||
-- Copyright : (c) Spencer Janssen 2007
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : spencerjanssen@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, uses cunning newtype deriving
|
||||
--
|
||||
-- The 'X' monad, a state monad transformer over 'IO', for the window
|
||||
-- manager state, and support routines.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Core (
|
||||
X, WindowSet, WindowSpace, WorkspaceId,
|
||||
ScreenId(..), ScreenDetail(..), XState(..),
|
||||
XConf(..), XConfig(..), LayoutClass(..),
|
||||
Layout(..), readsLayout, Typeable, Message,
|
||||
SomeMessage(..), fromMessage, LayoutMessages(..),
|
||||
StateExtension(..), ExtensionClass(..),
|
||||
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
|
||||
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
|
||||
getAtom, spawn, spawnPID, getXMonadDir, recompile, trace, whenJust, whenX,
|
||||
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, ManageHook, Query(..), runQuery
|
||||
) where
|
||||
|
||||
import XMonad.StackSet hiding (modify)
|
||||
|
||||
import Prelude hiding ( catch )
|
||||
import Control.Exception (catch, try, bracket, throw, finally, Exception(ExitException))
|
||||
import Control.Applicative
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Reader
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import System.Info
|
||||
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
|
||||
import System.Posix.Signals
|
||||
import System.Posix.IO
|
||||
import System.Posix.Types (ProcessID)
|
||||
import System.Process
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (Event)
|
||||
import Data.Typeable
|
||||
import Data.List ((\\))
|
||||
import Data.Maybe (isJust,fromMaybe)
|
||||
import Data.Monoid
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- | XState, the (mutable) window manager state.
|
||||
data XState = XState
|
||||
{ windowset :: !WindowSet -- ^ workspace list
|
||||
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows
|
||||
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
|
||||
, dragging :: !(Maybe (Position -> Position -> X (), X ()))
|
||||
, numlockMask :: !KeyMask -- ^ The numlock modifier
|
||||
, extensibleState :: !(M.Map String (Either String StateExtension))
|
||||
-- ^ stores custom state information.
|
||||
--
|
||||
-- The module XMonad.Utils.ExtensibleState in xmonad-contrib
|
||||
-- provides additional information and a simple interface for using this.
|
||||
}
|
||||
|
||||
-- | XConf, the (read-only) window manager configuration.
|
||||
data XConf = XConf
|
||||
{ display :: Display -- ^ the X11 display
|
||||
, config :: !(XConfig Layout) -- ^ initial user configuration
|
||||
, theRoot :: !Window -- ^ the root window
|
||||
, normalBorder :: !Pixel -- ^ border color of unfocused windows
|
||||
, focusedBorder :: !Pixel -- ^ border color of the focused window
|
||||
, keyActions :: !(M.Map (KeyMask, KeySym) (X ()))
|
||||
-- ^ a mapping of key presses to actions
|
||||
, buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
|
||||
-- ^ a mapping of button presses to actions
|
||||
, mouseFocused :: !Bool -- ^ was refocus caused by mouse action?
|
||||
, mousePosition :: !(Maybe (Position, Position))
|
||||
-- ^ position of the mouse according to
|
||||
-- the event currently being processed
|
||||
}
|
||||
|
||||
-- todo, better name
|
||||
data XConfig l = XConfig
|
||||
{ normalBorderColor :: !String -- ^ Non focused windows border color. Default: \"#dddddd\"
|
||||
, focusedBorderColor :: !String -- ^ Focused windows border color. Default: \"#ff0000\"
|
||||
, terminal :: !String -- ^ The preferred terminal application. Default: \"xterm\"
|
||||
, layoutHook :: !(l Window) -- ^ The available layouts
|
||||
, manageHook :: !ManageHook -- ^ The action to run when a new window is opened
|
||||
, handleEventHook :: !(Event -> X All) -- ^ Handle an X event, returns (All True) if the default handler
|
||||
-- should also be run afterwards. mappend should be used for combining
|
||||
-- event hooks in most cases.
|
||||
, workspaces :: ![String] -- ^ The list of workspaces' names
|
||||
, modMask :: !KeyMask -- ^ the mod modifier
|
||||
, keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
|
||||
-- ^ The key binding: a map from key presses and actions
|
||||
, mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
|
||||
-- ^ The mouse bindings
|
||||
, borderWidth :: !Dimension -- ^ The border width
|
||||
, logHook :: !(X ()) -- ^ The action to perform when the windows set is changed
|
||||
, startupHook :: !(X ()) -- ^ The action to perform on startup
|
||||
, focusFollowsMouse :: !Bool -- ^ Whether window entry events can change focus
|
||||
}
|
||||
|
||||
|
||||
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
|
||||
type WindowSpace = Workspace WorkspaceId (Layout Window) Window
|
||||
|
||||
-- | Virtual workspace indices
|
||||
type WorkspaceId = String
|
||||
|
||||
-- | Physical screen indices
|
||||
newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
|
||||
|
||||
-- | The 'Rectangle' with screen dimensions
|
||||
data ScreenDetail = SD { screenRect :: !Rectangle } deriving (Eq,Show, Read)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO'
|
||||
-- encapsulating the window manager configuration and state,
|
||||
-- respectively.
|
||||
--
|
||||
-- Dynamic components may be retrieved with 'get', static components
|
||||
-- with 'ask'. With newtype deriving we get readers and state monads
|
||||
-- instantiated on 'XConf' and 'XState' automatically.
|
||||
--
|
||||
newtype X a = X (ReaderT XConf (StateT XState IO) a)
|
||||
#ifndef __HADDOCK__
|
||||
deriving (Functor, Monad, MonadIO, MonadState XState, MonadReader XConf, Typeable)
|
||||
#endif
|
||||
|
||||
instance Applicative X where
|
||||
pure = return
|
||||
(<*>) = ap
|
||||
|
||||
instance (Monoid a) => Monoid (X a) where
|
||||
mempty = return mempty
|
||||
mappend = liftM2 mappend
|
||||
|
||||
type ManageHook = Query (Endo WindowSet)
|
||||
newtype Query a = Query (ReaderT Window X a)
|
||||
#ifndef __HADDOCK__
|
||||
deriving (Functor, Monad, MonadReader Window, MonadIO)
|
||||
#endif
|
||||
|
||||
runQuery :: Query a -> Window -> X a
|
||||
runQuery (Query m) w = runReaderT m w
|
||||
|
||||
instance Monoid a => Monoid (Query a) where
|
||||
mempty = return mempty
|
||||
mappend = liftM2 mappend
|
||||
|
||||
-- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state
|
||||
-- Return the result, and final state
|
||||
runX :: XConf -> XState -> X a -> IO (a, XState)
|
||||
runX c st (X a) = runStateT (runReaderT a c) st
|
||||
|
||||
-- | Run in the 'X' monad, and in case of exception, and catch it and log it
|
||||
-- to stderr, and run the error case.
|
||||
catchX :: X a -> X a -> X a
|
||||
catchX job errcase = do
|
||||
st <- get
|
||||
c <- ask
|
||||
(a, s') <- io $ runX c st job `catch` \e -> case e of
|
||||
ExitException {} -> throw e
|
||||
_ -> do hPrint stderr e; runX c st errcase
|
||||
put s'
|
||||
return a
|
||||
|
||||
-- | Execute the argument, catching all exceptions. Either this function or
|
||||
-- 'catchX' should be used at all callsites of user customized code.
|
||||
userCode :: X a -> X (Maybe a)
|
||||
userCode a = catchX (Just `liftM` a) (return Nothing)
|
||||
|
||||
-- | Same as userCode but with a default argument to return instead of using
|
||||
-- Maybe, provided for convenience.
|
||||
userCodeDef :: a -> X a -> X a
|
||||
userCodeDef def a = fromMaybe def `liftM` userCode a
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Convenient wrappers to state
|
||||
|
||||
-- | Run a monad action with the current display settings
|
||||
withDisplay :: (Display -> X a) -> X a
|
||||
withDisplay f = asks display >>= f
|
||||
|
||||
-- | Run a monadic action with the current stack set
|
||||
withWindowSet :: (WindowSet -> X a) -> X a
|
||||
withWindowSet f = gets windowset >>= f
|
||||
|
||||
-- | True if the given window is the root window
|
||||
isRoot :: Window -> X Bool
|
||||
isRoot w = (w==) <$> asks theRoot
|
||||
|
||||
-- | Wrapper for the common case of atom internment
|
||||
getAtom :: String -> X Atom
|
||||
getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
|
||||
|
||||
-- | Common non-predefined atoms
|
||||
atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE :: X Atom
|
||||
atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS"
|
||||
atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW"
|
||||
atom_WM_STATE = getAtom "WM_STATE"
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- LayoutClass handling. See particular instances in Operations.hs
|
||||
|
||||
-- | An existential type that can hold any object that is in 'Read'
|
||||
-- and 'LayoutClass'.
|
||||
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
|
||||
|
||||
-- | Using the 'Layout' as a witness, parse existentially wrapped windows
|
||||
-- from a 'String'.
|
||||
readsLayout :: Layout a -> String -> [(Layout a, String)]
|
||||
readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
|
||||
|
||||
-- | Every layout must be an instance of 'LayoutClass', which defines
|
||||
-- the basic layout operations along with a sensible default for each.
|
||||
--
|
||||
-- Minimal complete definition:
|
||||
--
|
||||
-- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout'), and
|
||||
--
|
||||
-- * 'handleMessage' || 'pureMessage'
|
||||
--
|
||||
-- You should also strongly consider implementing 'description',
|
||||
-- although it is not required.
|
||||
--
|
||||
-- Note that any code which /uses/ 'LayoutClass' methods should only
|
||||
-- ever call 'runLayout', 'handleMessage', and 'description'! In
|
||||
-- other words, the only calls to 'doLayout', 'pureMessage', and other
|
||||
-- such methods should be from the default implementations of
|
||||
-- 'runLayout', 'handleMessage', and so on. This ensures that the
|
||||
-- proper methods will be used, regardless of the particular methods
|
||||
-- that any 'LayoutClass' instance chooses to define.
|
||||
class Show (layout a) => LayoutClass layout a where
|
||||
|
||||
-- | By default, 'runLayout' calls 'doLayout' if there are any
|
||||
-- windows to be laid out, and 'emptyLayout' otherwise. Most
|
||||
-- instances of 'LayoutClass' probably do not need to implement
|
||||
-- 'runLayout'; it is only useful for layouts which wish to make
|
||||
-- use of more of the 'Workspace' information (for example,
|
||||
-- "XMonad.Layout.PerWorkspace").
|
||||
runLayout :: Workspace WorkspaceId (layout a) a
|
||||
-> Rectangle
|
||||
-> X ([(a, Rectangle)], Maybe (layout a))
|
||||
runLayout (Workspace _ l ms) r = maybe (emptyLayout l r) (doLayout l r) ms
|
||||
|
||||
-- | Given a 'Rectangle' in which to place the windows, and a 'Stack'
|
||||
-- of windows, return a list of windows and their corresponding
|
||||
-- Rectangles. If an element is not given a Rectangle by
|
||||
-- 'doLayout', then it is not shown on screen. The order of
|
||||
-- windows in this list should be the desired stacking order.
|
||||
--
|
||||
-- Also possibly return a modified layout (by returning @Just
|
||||
-- newLayout@), if this layout needs to be modified (e.g. if it
|
||||
-- keeps track of some sort of state). Return @Nothing@ if the
|
||||
-- layout does not need to be modified.
|
||||
--
|
||||
-- Layouts which do not need access to the 'X' monad ('IO', window
|
||||
-- manager state, or configuration) and do not keep track of their
|
||||
-- own state should implement 'pureLayout' instead of 'doLayout'.
|
||||
doLayout :: layout a -> Rectangle -> Stack a
|
||||
-> X ([(a, Rectangle)], Maybe (layout a))
|
||||
doLayout l r s = return (pureLayout l r s, Nothing)
|
||||
|
||||
-- | This is a pure version of 'doLayout', for cases where we
|
||||
-- don't need access to the 'X' monad to determine how to lay out
|
||||
-- the windows, and we don't need to modify the layout itself.
|
||||
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
|
||||
pureLayout _ r s = [(focus s, r)]
|
||||
|
||||
-- | 'emptyLayout' is called when there are no windows.
|
||||
emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
|
||||
emptyLayout _ _ = return ([], Nothing)
|
||||
|
||||
-- | 'handleMessage' performs message handling. If
|
||||
-- 'handleMessage' returns @Nothing@, then the layout did not
|
||||
-- respond to the message and the screen is not refreshed.
|
||||
-- Otherwise, 'handleMessage' returns an updated layout and the
|
||||
-- screen is refreshed.
|
||||
--
|
||||
-- Layouts which do not need access to the 'X' monad to decide how
|
||||
-- to handle messages should implement 'pureMessage' instead of
|
||||
-- 'handleMessage' (this restricts the risk of error, and makes
|
||||
-- testing much easier).
|
||||
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
|
||||
handleMessage l = return . pureMessage l
|
||||
|
||||
-- | Respond to a message by (possibly) changing our layout, but
|
||||
-- taking no other action. If the layout changes, the screen will
|
||||
-- be refreshed.
|
||||
pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
|
||||
pureMessage _ _ = Nothing
|
||||
|
||||
-- | This should be a human-readable string that is used when
|
||||
-- selecting layouts by name. The default implementation is
|
||||
-- 'show', which is in some cases a poor default.
|
||||
description :: layout a -> String
|
||||
description = show
|
||||
|
||||
instance LayoutClass Layout Window where
|
||||
runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
|
||||
doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s
|
||||
emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
|
||||
handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
|
||||
description (Layout l) = description l
|
||||
|
||||
instance Show (Layout a) where show (Layout l) = show l
|
||||
|
||||
-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of
|
||||
-- Exceptions/, Simon Marlow, 2006. Use extensible messages to the
|
||||
-- 'handleMessage' handler.
|
||||
--
|
||||
-- User-extensible messages must be a member of this class.
|
||||
--
|
||||
class Typeable a => Message a
|
||||
|
||||
-- |
|
||||
-- A wrapped value of some type in the 'Message' class.
|
||||
--
|
||||
data SomeMessage = forall a. Message a => SomeMessage a
|
||||
|
||||
-- |
|
||||
-- And now, unwrap a given, unknown 'Message' type, performing a (dynamic)
|
||||
-- type check on the result.
|
||||
--
|
||||
fromMessage :: Message m => SomeMessage -> Maybe m
|
||||
fromMessage (SomeMessage m) = cast m
|
||||
|
||||
-- X Events are valid Messages.
|
||||
instance Message Event
|
||||
|
||||
-- | 'LayoutMessages' are core messages that all layouts (especially stateful
|
||||
-- layouts) should consider handling.
|
||||
data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible
|
||||
| ReleaseResources -- ^ sent when xmonad is exiting or restarting
|
||||
deriving (Typeable, Eq)
|
||||
|
||||
instance Message LayoutMessages
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Extensible state
|
||||
--
|
||||
|
||||
-- | Every module must make the data it wants to store
|
||||
-- an instance of this class.
|
||||
--
|
||||
-- Minimal complete definition: initialValue
|
||||
class Typeable a => ExtensionClass a where
|
||||
-- | Defines an initial value for the state extension
|
||||
initialValue :: a
|
||||
-- | Specifies whether the state extension should be
|
||||
-- persistent. Setting this method to 'PersistentExtension'
|
||||
-- will make the stored data survive restarts, but
|
||||
-- requires a to be an instance of Read and Show.
|
||||
--
|
||||
-- It defaults to 'StateExtension', i.e. no persistence.
|
||||
extensionType :: a -> StateExtension
|
||||
extensionType = StateExtension
|
||||
|
||||
-- | Existential type to store a state extension.
|
||||
data StateExtension =
|
||||
forall a. ExtensionClass a => StateExtension a
|
||||
-- ^ Non-persistent state extension
|
||||
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
|
||||
-- ^ Persistent extension
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- | General utilities
|
||||
--
|
||||
-- Lift an 'IO' action into the 'X' monad
|
||||
io :: MonadIO m => IO a -> m a
|
||||
io = liftIO
|
||||
|
||||
-- | Lift an 'IO' action into the 'X' monad. If the action results in an 'IO'
|
||||
-- exception, log the exception to stderr and continue normal execution.
|
||||
catchIO :: MonadIO m => IO () -> m ()
|
||||
catchIO f = io (f `catch` \e -> hPrint stderr e >> hFlush stderr)
|
||||
|
||||
-- | spawn. Launch an external application. Specifically, it double-forks and
|
||||
-- runs the 'String' you pass as a command to /bin/sh.
|
||||
spawn :: MonadIO m => String -> m ()
|
||||
spawn x = spawnPID x >> return ()
|
||||
|
||||
-- | Like 'spawn', but returns the 'ProcessID' of the launched application
|
||||
spawnPID :: MonadIO m => String -> m ProcessID
|
||||
spawnPID x = io . forkProcess . finally nullStdin $ do
|
||||
uninstallSignalHandlers
|
||||
createSession
|
||||
executeFile "/bin/sh" False ["-c", x] Nothing
|
||||
where
|
||||
nullStdin = do
|
||||
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
|
||||
dupTo fd stdInput
|
||||
closeFd fd
|
||||
|
||||
-- | This is basically a map function, running a function in the 'X' monad on
|
||||
-- each workspace with the output of that function being the modified workspace.
|
||||
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
|
||||
runOnWorkspaces job = do
|
||||
ws <- gets windowset
|
||||
h <- mapM job $ hidden ws
|
||||
c:v <- mapM (\s -> (\w -> s { workspace = w}) <$> job (workspace s))
|
||||
$ current ws : visible ws
|
||||
modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
|
||||
|
||||
-- | Return the path to @~\/.xmonad@.
|
||||
getXMonadDir :: MonadIO m => m String
|
||||
getXMonadDir = io $ getAppUserDataDirectory "xmonad"
|
||||
|
||||
-- | 'recompile force', recompile @~\/.xmonad\/xmonad.hs@ when any of the
|
||||
-- following apply:
|
||||
--
|
||||
-- * force is 'True'
|
||||
--
|
||||
-- * the xmonad executable does not exist
|
||||
--
|
||||
-- * the xmonad executable is older than xmonad.hs
|
||||
--
|
||||
-- The -i flag is used to restrict recompilation to the xmonad.hs file only.
|
||||
--
|
||||
-- Compilation errors (if any) are logged to ~\/.xmonad\/xmonad.errors. If
|
||||
-- GHC indicates failure with a non-zero exit code, an xmessage displaying
|
||||
-- that file is spawned.
|
||||
--
|
||||
-- 'False' is returned if there are compilation errors.
|
||||
--
|
||||
recompile :: MonadIO m => Bool -> m Bool
|
||||
recompile force = io $ do
|
||||
dir <- getXMonadDir
|
||||
let binn = "xmonad-"++arch++"-"++os
|
||||
bin = dir </> binn
|
||||
base = dir </> "xmonad"
|
||||
err = base ++ ".errors"
|
||||
src = base ++ ".hs"
|
||||
lib = dir </> "lib"
|
||||
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles lib
|
||||
srcT <- getModTime src
|
||||
binT <- getModTime bin
|
||||
if force || any (binT <) (srcT : libTs)
|
||||
then do
|
||||
-- temporarily disable SIGCHLD ignoring:
|
||||
uninstallSignalHandlers
|
||||
status <- bracket (openFile err WriteMode) hClose $ \h -> do
|
||||
waitForProcess =<< runProcess "ghc" ["--make", "xmonad.hs", "-i", "-ilib", "-fforce-recomp", "-v0", "-o",binn] (Just dir)
|
||||
Nothing Nothing Nothing (Just h)
|
||||
|
||||
-- re-enable SIGCHLD:
|
||||
installSignalHandlers
|
||||
|
||||
-- now, if it fails, run xmessage to let the user know:
|
||||
when (status /= ExitSuccess) $ do
|
||||
ghcErr <- readFile err
|
||||
let msg = unlines $
|
||||
["Error detected while loading xmonad configuration file: " ++ src]
|
||||
++ lines ghcErr ++ ["","Please check the file for errors."]
|
||||
-- nb, the ordering of printing, then forking, is crucial due to
|
||||
-- lazy evaluation
|
||||
hPutStrLn stderr msg
|
||||
forkProcess $ executeFile "xmessage" True ["-default", "okay", msg] Nothing
|
||||
return ()
|
||||
return (status == ExitSuccess)
|
||||
else return True
|
||||
where getModTime f = catch (Just <$> getModificationTime f) (const $ return Nothing)
|
||||
isSource = flip elem [".hs",".lhs",".hsc"]
|
||||
allFiles t = do
|
||||
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
|
||||
cs <- prep <$> catch (getDirectoryContents t) (\_ -> return [])
|
||||
ds <- filterM doesDirectoryExist cs
|
||||
concat . ((cs \\ ds):) <$> mapM allFiles ds
|
||||
|
||||
-- | Conditionally run an action, using a @Maybe a@ to decide.
|
||||
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
|
||||
whenJust mg f = maybe (return ()) f mg
|
||||
|
||||
-- | Conditionally run an action, using a 'X' event to decide
|
||||
whenX :: X Bool -> X () -> X ()
|
||||
whenX a f = a >>= \b -> when b f
|
||||
|
||||
-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may
|
||||
-- be found in your .xsession-errors file
|
||||
trace :: MonadIO m => String -> m ()
|
||||
trace = io . hPutStrLn stderr
|
||||
|
||||
-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
|
||||
-- avoid zombie processes, and clean up any extant zombie processes.
|
||||
installSignalHandlers :: MonadIO m => m ()
|
||||
installSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Ignore Nothing
|
||||
installHandler sigCHLD Ignore Nothing
|
||||
try $ fix $ \more -> do
|
||||
x <- getAnyProcessStatus False False
|
||||
when (isJust x) more
|
||||
return ()
|
||||
|
||||
uninstallSignalHandlers :: MonadIO m => m ()
|
||||
uninstallSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Default Nothing
|
||||
installHandler sigCHLD Default Nothing
|
||||
return ()
|
@@ -1,569 +0,0 @@
|
||||
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Operations
|
||||
-- Copyright : (c) Spencer Janssen 2007
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : dons@cse.unsw.edu.au
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, Typeable deriving, mtl, posix
|
||||
--
|
||||
-- Operations.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Operations where
|
||||
|
||||
import XMonad.Core
|
||||
import XMonad.Layout (Full(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Monoid (Endo(..))
|
||||
import Data.List (nub, (\\), find)
|
||||
import Data.Bits ((.|.), (.&.), complement)
|
||||
import Data.Ratio
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Control.Applicative
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import qualified Control.Exception as C
|
||||
|
||||
import System.IO
|
||||
import System.Posix.Process (executeFile)
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xinerama (getScreenInfo)
|
||||
import Graphics.X11.Xlib.Extras
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- |
|
||||
-- Window manager operations
|
||||
-- manage. Add a new window to be managed in the current workspace.
|
||||
-- Bring it into focus.
|
||||
--
|
||||
-- Whether the window is already managed, or not, it is mapped, has its
|
||||
-- border set, and its event mask set.
|
||||
--
|
||||
manage :: Window -> X ()
|
||||
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
|
||||
sh <- io $ getWMNormalHints d w
|
||||
|
||||
let isFixedSize = sh_min_size sh /= Nothing && sh_min_size sh == sh_max_size sh
|
||||
isTransient <- isJust <$> io (getTransientForHint d w)
|
||||
|
||||
rr <- snd `fmap` floatLocation w
|
||||
-- ensure that float windows don't go over the edge of the screen
|
||||
let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0
|
||||
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
|
||||
adjust r = r
|
||||
|
||||
f ws | isFixedSize || isTransient = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
|
||||
| otherwise = W.insertUp w ws
|
||||
where i = W.tag $ W.workspace $ W.current ws
|
||||
|
||||
mh <- asks (manageHook . config)
|
||||
g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
|
||||
windows (g . f)
|
||||
|
||||
-- | unmanage. A window no longer exists, remove it from the window
|
||||
-- list, on whatever workspace it is.
|
||||
--
|
||||
unmanage :: Window -> X ()
|
||||
unmanage = windows . W.delete
|
||||
|
||||
-- | Kill the specified window. If we do kill it, we'll get a
|
||||
-- delete notify back from X.
|
||||
--
|
||||
-- There are two ways to delete a window. Either just kill it, or if it
|
||||
-- supports the delete protocol, send a delete event (e.g. firefox)
|
||||
--
|
||||
killWindow :: Window -> X ()
|
||||
killWindow w = withDisplay $ \d -> do
|
||||
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
|
||||
|
||||
protocols <- io $ getWMProtocols d w
|
||||
io $ if wmdelt `elem` protocols
|
||||
then allocaXEvent $ \ev -> do
|
||||
setEventType ev clientMessage
|
||||
setClientMessageEvent ev w wmprot 32 wmdelt 0
|
||||
sendEvent d w False noEventMask ev
|
||||
else killClient d w >> return ()
|
||||
|
||||
-- | Kill the currently focused client.
|
||||
kill :: X ()
|
||||
kill = withFocused killWindow
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Managing windows
|
||||
|
||||
-- | windows. Modify the current window list with a pure function, and refresh
|
||||
windows :: (WindowSet -> WindowSet) -> X ()
|
||||
windows f = do
|
||||
XState { windowset = old } <- get
|
||||
let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
|
||||
newwindows = W.allWindows ws \\ W.allWindows old
|
||||
ws = f old
|
||||
XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
|
||||
|
||||
mapM_ setInitialProperties newwindows
|
||||
|
||||
whenJust (W.peek old) $ \otherw -> io $ setWindowBorder d otherw nbc
|
||||
modify (\s -> s { windowset = ws })
|
||||
|
||||
-- notify non visibility
|
||||
let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old
|
||||
gottenhidden = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws
|
||||
mapM_ (sendMessageWithNoRefresh Hide) gottenhidden
|
||||
|
||||
-- for each workspace, layout the currently visible workspaces
|
||||
let allscreens = W.screens ws
|
||||
summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
|
||||
rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
|
||||
let wsp = W.workspace w
|
||||
this = W.view n ws
|
||||
n = W.tag wsp
|
||||
tiled = (W.stack . W.workspace . W.current $ this)
|
||||
>>= W.filter (`M.notMember` W.floating ws)
|
||||
>>= W.filter (`notElem` vis)
|
||||
viewrect = screenRect $ W.screenDetail w
|
||||
|
||||
-- just the tiled windows:
|
||||
-- now tile the windows on this workspace, modified by the gap
|
||||
(rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
|
||||
runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
|
||||
updateLayout n ml'
|
||||
|
||||
let m = W.floating ws
|
||||
flt = [(fw, scaleRationalRect viewrect r)
|
||||
| fw <- filter (flip M.member m) (W.index this)
|
||||
, Just r <- [M.lookup fw m]]
|
||||
vs = flt ++ rs
|
||||
|
||||
io $ restackWindows d (map fst vs)
|
||||
-- return the visible windows for this workspace:
|
||||
return vs
|
||||
|
||||
let visible = map fst rects
|
||||
|
||||
mapM_ (uncurry tileWindow) rects
|
||||
|
||||
whenJust (W.peek ws) $ \w -> io $ setWindowBorder d w fbc
|
||||
|
||||
mapM_ reveal visible
|
||||
setTopFocus
|
||||
|
||||
-- hide every window that was potentially visible before, but is not
|
||||
-- given a position by a layout now.
|
||||
mapM_ hide (nub (oldvisible ++ newwindows) \\ visible)
|
||||
|
||||
-- all windows that are no longer in the windowset are marked as
|
||||
-- withdrawn, it is important to do this after the above, otherwise 'hide'
|
||||
-- will overwrite withdrawnState with iconicState
|
||||
mapM_ (flip setWMState withdrawnState) (W.allWindows old \\ W.allWindows ws)
|
||||
|
||||
isMouseFocused <- asks mouseFocused
|
||||
unless isMouseFocused $ clearEvents enterWindowMask
|
||||
asks (logHook . config) >>= userCodeDef ()
|
||||
|
||||
-- | Produce the actual rectangle from a screen and a ratio on that screen.
|
||||
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
|
||||
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
|
||||
= Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
|
||||
where scale s r = floor (toRational s * r)
|
||||
|
||||
-- | setWMState. set the WM_STATE property
|
||||
setWMState :: Window -> Int -> X ()
|
||||
setWMState w v = withDisplay $ \dpy -> do
|
||||
a <- atom_WM_STATE
|
||||
io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]
|
||||
|
||||
-- | hide. Hide a window by unmapping it, and setting Iconified.
|
||||
hide :: Window -> X ()
|
||||
hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
|
||||
io $ do selectInput d w (clientMask .&. complement structureNotifyMask)
|
||||
unmapWindow d w
|
||||
selectInput d w clientMask
|
||||
setWMState w iconicState
|
||||
-- this part is key: we increment the waitingUnmap counter to distinguish
|
||||
-- between client and xmonad initiated unmaps.
|
||||
modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
|
||||
, mapped = S.delete w (mapped s) })
|
||||
|
||||
-- | reveal. Show a window by mapping it and setting Normal
|
||||
-- this is harmless if the window was already visible
|
||||
reveal :: Window -> X ()
|
||||
reveal w = withDisplay $ \d -> do
|
||||
setWMState w normalState
|
||||
io $ mapWindow d w
|
||||
modify (\s -> s { mapped = S.insert w (mapped s) })
|
||||
|
||||
-- | The client events that xmonad is interested in
|
||||
clientMask :: EventMask
|
||||
clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
|
||||
|
||||
-- | Set some properties when we initially gain control of a window
|
||||
setInitialProperties :: Window -> X ()
|
||||
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
|
||||
setWMState w iconicState
|
||||
io $ selectInput d w $ clientMask
|
||||
bw <- asks (borderWidth . config)
|
||||
io $ setWindowBorderWidth d w bw
|
||||
-- we must initially set the color of new windows, to maintain invariants
|
||||
-- required by the border setting in 'windows'
|
||||
io $ setWindowBorder d w nb
|
||||
|
||||
-- | refresh. Render the currently visible workspaces, as determined by
|
||||
-- the 'StackSet'. Also, set focus to the focused window.
|
||||
--
|
||||
-- This is our 'view' operation (MVC), in that it pretty prints our model
|
||||
-- with X calls.
|
||||
--
|
||||
refresh :: X ()
|
||||
refresh = windows id
|
||||
|
||||
-- | clearEvents. Remove all events of a given type from the event queue.
|
||||
clearEvents :: EventMask -> X ()
|
||||
clearEvents mask = withDisplay $ \d -> io $ do
|
||||
sync d False
|
||||
allocaXEvent $ \p -> fix $ \again -> do
|
||||
more <- checkMaskEvent d mask p
|
||||
when more again -- beautiful
|
||||
|
||||
-- | tileWindow. Moves and resizes w such that it fits inside the given
|
||||
-- rectangle, including its border.
|
||||
tileWindow :: Window -> Rectangle -> X ()
|
||||
tileWindow w r = withDisplay $ \d -> do
|
||||
bw <- (fromIntegral . wa_border_width) <$> io (getWindowAttributes d w)
|
||||
-- give all windows at least 1x1 pixels
|
||||
let least x | x <= bw*2 = 1
|
||||
| otherwise = x - bw*2
|
||||
io $ moveResizeWindow d w (rect_x r) (rect_y r)
|
||||
(least $ rect_width r) (least $ rect_height r)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Returns 'True' if the first rectangle is contained within, but not equal
|
||||
-- to the second.
|
||||
containedIn :: Rectangle -> Rectangle -> Bool
|
||||
containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)
|
||||
= and [ r1 /= r2
|
||||
, x1 >= x2
|
||||
, y1 >= y2
|
||||
, fromIntegral x1 + w1 <= fromIntegral x2 + w2
|
||||
, fromIntegral y1 + h1 <= fromIntegral y2 + h2 ]
|
||||
|
||||
-- | Given a list of screens, remove all duplicated screens and screens that
|
||||
-- are entirely contained within another.
|
||||
nubScreens :: [Rectangle] -> [Rectangle]
|
||||
nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs
|
||||
|
||||
-- | Cleans the list of screens according to the rules documented for
|
||||
-- nubScreens.
|
||||
getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle]
|
||||
getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
|
||||
|
||||
-- | rescreen. The screen configuration may have changed (due to
|
||||
-- xrandr), update the state and refresh the screen, and reset the gap.
|
||||
rescreen :: X ()
|
||||
rescreen = do
|
||||
xinesc <- withDisplay getCleanedScreenInfo
|
||||
|
||||
windows $ \ws@(W.StackSet { W.current = v, W.visible = vs, W.hidden = hs }) ->
|
||||
let (xs, ys) = splitAt (length xinesc) $ map W.workspace (v:vs) ++ hs
|
||||
(a:as) = zipWith3 W.Screen xs [0..] $ map SD xinesc
|
||||
in ws { W.current = a
|
||||
, W.visible = as
|
||||
, W.hidden = ys }
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | setButtonGrab. Tell whether or not to intercept clicks on a given window
|
||||
setButtonGrab :: Bool -> Window -> X ()
|
||||
setButtonGrab grab w = withDisplay $ \d -> io $
|
||||
if grab
|
||||
then forM_ [button1, button2, button3] $ \b ->
|
||||
grabButton d b anyModifier w False buttonPressMask
|
||||
grabModeAsync grabModeSync none none
|
||||
else ungrabButton d anyButton anyModifier w
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Setting keyboard focus
|
||||
|
||||
-- | Set the focus to the window on top of the stack, or root
|
||||
setTopFocus :: X ()
|
||||
setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek
|
||||
|
||||
-- | Set focus explicitly to window 'w' if it is managed by us, or root.
|
||||
-- This happens if X notices we've moved the mouse (and perhaps moved
|
||||
-- the mouse to a new screen).
|
||||
focus :: Window -> X ()
|
||||
focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
|
||||
let stag = W.tag . W.workspace
|
||||
curr = stag $ W.current s
|
||||
mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
|
||||
=<< asks mousePosition
|
||||
root <- asks theRoot
|
||||
case () of
|
||||
_ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w)
|
||||
| Just new <- mnew, w == root && curr /= new
|
||||
-> windows (W.view new)
|
||||
| otherwise -> return ()
|
||||
|
||||
-- | Call X to set the keyboard focus details.
|
||||
setFocusX :: Window -> X ()
|
||||
setFocusX w = withWindowSet $ \ws -> do
|
||||
dpy <- asks display
|
||||
|
||||
-- clear mouse button grab and border on other windows
|
||||
forM_ (W.current ws : W.visible ws) $ \wk -> do
|
||||
forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw -> do
|
||||
setButtonGrab True otherw
|
||||
|
||||
-- If we ungrab buttons on the root window, we lose our mouse bindings.
|
||||
whenX (not <$> isRoot w) $ setButtonGrab False w
|
||||
io $ do setInputFocus dpy w revertToPointerRoot 0
|
||||
-- raiseWindow dpy w
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Message handling
|
||||
|
||||
-- | Throw a message to the current 'LayoutClass' possibly modifying how we
|
||||
-- layout the windows, then refresh.
|
||||
sendMessage :: Message a => a -> X ()
|
||||
sendMessage a = do
|
||||
w <- W.workspace . W.current <$> gets windowset
|
||||
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
|
||||
whenJust ml' $ \l' -> do
|
||||
windows $ \ws -> ws { W.current = (W.current ws)
|
||||
{ W.workspace = (W.workspace $ W.current ws)
|
||||
{ W.layout = l' }}}
|
||||
|
||||
-- | Send a message to all layouts, without refreshing.
|
||||
broadcastMessage :: Message a => a -> X ()
|
||||
broadcastMessage a = withWindowSet $ \ws -> do
|
||||
let c = W.workspace . W.current $ ws
|
||||
v = map W.workspace . W.visible $ ws
|
||||
h = W.hidden ws
|
||||
mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
|
||||
|
||||
-- | Send a message to a layout, without refreshing.
|
||||
sendMessageWithNoRefresh :: Message a => a -> W.Workspace WorkspaceId (Layout Window) Window -> X ()
|
||||
sendMessageWithNoRefresh a w =
|
||||
handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
|
||||
updateLayout (W.tag w)
|
||||
|
||||
-- | Update the layout field of a workspace
|
||||
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
|
||||
updateLayout i ml = whenJust ml $ \l ->
|
||||
runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww
|
||||
|
||||
-- | Set the layout of the currently viewed workspace
|
||||
setLayout :: Layout Window -> X ()
|
||||
setLayout l = do
|
||||
ss@(W.StackSet { W.current = c@(W.Screen { W.workspace = ws })}) <- gets windowset
|
||||
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
|
||||
windows $ const $ ss {W.current = c { W.workspace = ws { W.layout = l } } }
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Utilities
|
||||
|
||||
-- | Return workspace visible on screen 'sc', or 'Nothing'.
|
||||
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
|
||||
screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
|
||||
|
||||
-- | Apply an 'X' operation to the currently focused window, if there is one.
|
||||
withFocused :: (Window -> X ()) -> X ()
|
||||
withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
|
||||
|
||||
-- | 'True' if window is under management by us
|
||||
isClient :: Window -> X Bool
|
||||
isClient w = withWindowSet $ return . W.member w
|
||||
|
||||
-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
|
||||
-- (numlock and capslock)
|
||||
extraModifiers :: X [KeyMask]
|
||||
extraModifiers = do
|
||||
nlm <- gets numlockMask
|
||||
return [0, nlm, lockMask, nlm .|. lockMask ]
|
||||
|
||||
-- | Strip numlock\/capslock from a mask
|
||||
cleanMask :: KeyMask -> X KeyMask
|
||||
cleanMask km = do
|
||||
nlm <- gets numlockMask
|
||||
return (complement (nlm .|. lockMask) .&. km)
|
||||
|
||||
-- | Get the 'Pixel' value for a named color
|
||||
initColor :: Display -> String -> IO (Maybe Pixel)
|
||||
initColor dpy c = C.handle (\_ -> return Nothing) $
|
||||
(Just . color_pixel . fst) <$> allocNamedColor dpy colormap c
|
||||
where colormap = defaultColormap dpy (defaultScreen dpy)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | @restart name resume@. Attempt to restart xmonad by executing the program
|
||||
-- @name@. If @resume@ is 'True', restart with the current window state.
|
||||
-- When executing another window manager, @resume@ should be 'False'.
|
||||
restart :: String -> Bool -> X ()
|
||||
restart prog resume = do
|
||||
broadcastMessage ReleaseResources
|
||||
io . flush =<< asks display
|
||||
let wsData = show . W.mapLayout show . windowset
|
||||
maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
|
||||
maybeShow (t, Left str) = Just (t, str)
|
||||
maybeShow _ = Nothing
|
||||
extState = return . show . catMaybes . map maybeShow . M.toList . extensibleState
|
||||
args <- if resume then gets (\s -> "--resume":wsData s:extState s) else return []
|
||||
catchIO (executeFile prog True args Nothing)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- | Floating layer support
|
||||
|
||||
-- | Given a window, find the screen it is located on, and compute
|
||||
-- the geometry of that window wrt. that screen.
|
||||
floatLocation :: Window -> X (ScreenId, W.RationalRect)
|
||||
floatLocation w = withDisplay $ \d -> do
|
||||
ws <- gets windowset
|
||||
wa <- io $ getWindowAttributes d w
|
||||
bw <- fi <$> asks (borderWidth . config)
|
||||
sc <- fromMaybe (W.current ws) <$> pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
|
||||
|
||||
let sr = screenRect . W.screenDetail $ sc
|
||||
rr = W.RationalRect ((fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr))
|
||||
((fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr))
|
||||
(fi (wa_width wa + bw*2) % fi (rect_width sr))
|
||||
(fi (wa_height wa + bw*2) % fi (rect_height sr))
|
||||
|
||||
return (W.screen $ sc, rr)
|
||||
where fi x = fromIntegral x
|
||||
|
||||
-- | Given a point, determine the screen (if any) that contains it.
|
||||
pointScreen :: Position -> Position
|
||||
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
|
||||
pointScreen x y = withWindowSet $ return . find p . W.screens
|
||||
where p = pointWithin x y . screenRect . W.screenDetail
|
||||
|
||||
-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
|
||||
-- @r@.
|
||||
pointWithin :: Position -> Position -> Rectangle -> Bool
|
||||
pointWithin x y r = x >= rect_x r &&
|
||||
x < rect_x r + fromIntegral (rect_width r) &&
|
||||
y >= rect_y r &&
|
||||
y < rect_y r + fromIntegral (rect_height r)
|
||||
|
||||
-- | Make a tiled window floating, using its suggested rectangle
|
||||
float :: Window -> X ()
|
||||
float w = do
|
||||
(sc, rr) <- floatLocation w
|
||||
windows $ \ws -> W.float w rr . fromMaybe ws $ do
|
||||
i <- W.findTag w ws
|
||||
guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)
|
||||
f <- W.peek ws
|
||||
sw <- W.lookupWorkspace sc ws
|
||||
return (W.focusWindow f . W.shiftWin sw w $ ws)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Mouse handling
|
||||
|
||||
-- | Accumulate mouse motion events
|
||||
mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
|
||||
mouseDrag f done = do
|
||||
drag <- gets dragging
|
||||
case drag of
|
||||
Just _ -> return () -- error case? we're already dragging
|
||||
Nothing -> do
|
||||
XConf { theRoot = root, display = d } <- ask
|
||||
io $ grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
|
||||
grabModeAsync grabModeAsync none none currentTime
|
||||
modify $ \s -> s { dragging = Just (motion, cleanup) }
|
||||
where
|
||||
cleanup = do
|
||||
withDisplay $ io . flip ungrabPointer currentTime
|
||||
modify $ \s -> s { dragging = Nothing }
|
||||
done
|
||||
motion x y = do z <- f x y
|
||||
clearEvents pointerMotionMask
|
||||
return z
|
||||
|
||||
-- | XXX comment me
|
||||
mouseMoveWindow :: Window -> X ()
|
||||
mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
io $ raiseWindow d w
|
||||
wa <- io $ getWindowAttributes d w
|
||||
(_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
|
||||
let ox = fromIntegral ox'
|
||||
oy = fromIntegral oy'
|
||||
mouseDrag (\ex ey -> io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
|
||||
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy))))
|
||||
(float w)
|
||||
|
||||
-- | XXX comment me
|
||||
mouseResizeWindow :: Window -> X ()
|
||||
mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
io $ raiseWindow d w
|
||||
wa <- io $ getWindowAttributes d w
|
||||
sh <- io $ getWMNormalHints d w
|
||||
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
||||
mouseDrag (\ex ey -> do
|
||||
io $ resizeWindow d w `uncurry`
|
||||
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
|
||||
ey - fromIntegral (wa_y wa)))
|
||||
(float w)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- | Support for window size hints
|
||||
|
||||
type D = (Dimension, Dimension)
|
||||
|
||||
-- | Given a window, build an adjuster function that will reduce the given
|
||||
-- dimensions according to the window's border width and size hints.
|
||||
mkAdjust :: Window -> X (D -> D)
|
||||
mkAdjust w = withDisplay $ \d -> liftIO $ do
|
||||
sh <- getWMNormalHints d w
|
||||
bw <- fmap (fromIntegral . wa_border_width) $ getWindowAttributes d w
|
||||
return $ applySizeHints bw sh
|
||||
|
||||
-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
|
||||
-- window borders into account.
|
||||
applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D
|
||||
applySizeHints bw sh =
|
||||
tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw)
|
||||
where
|
||||
tmap f (x, y) = (f x, f y)
|
||||
|
||||
-- | Reduce the dimensions if needed to comply to the given SizeHints.
|
||||
applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
|
||||
applySizeHintsContents sh (w, h) =
|
||||
applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h)
|
||||
|
||||
-- | XXX comment me
|
||||
applySizeHints' :: SizeHints -> D -> D
|
||||
applySizeHints' sh =
|
||||
maybe id applyMaxSizeHint (sh_max_size sh)
|
||||
. maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size sh)
|
||||
. maybe id applyResizeIncHint (sh_resize_inc sh)
|
||||
. maybe id applyAspectHint (sh_aspect sh)
|
||||
. maybe id (\(bw,bh) (w,h) -> (w-bw, h-bh)) (sh_base_size sh)
|
||||
|
||||
-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.
|
||||
applyAspectHint :: (D, D) -> D -> D
|
||||
applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)
|
||||
| or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x
|
||||
| w * maxy > h * maxx = (h * maxx `div` maxy, h)
|
||||
| w * miny < h * minx = (w, w * miny `div` minx)
|
||||
| otherwise = x
|
||||
|
||||
-- | Reduce the dimensions so they are a multiple of the size increments.
|
||||
applyResizeIncHint :: D -> D -> D
|
||||
applyResizeIncHint (iw,ih) x@(w,h) =
|
||||
if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x
|
||||
|
||||
-- | Reduce the dimensions if they exceed the given maximum dimensions.
|
||||
applyMaxSizeHint :: D -> D -> D
|
||||
applyMaxSizeHint (mw,mh) x@(w,h) =
|
||||
if mw > 0 && mh > 0 then (min w mw,min h mh) else x
|
17
cabal.haskell-ci
Normal file
17
cabal.haskell-ci
Normal file
@@ -0,0 +1,17 @@
|
||||
apt:
|
||||
libx11-dev
|
||||
libxext-dev
|
||||
libxinerama-dev
|
||||
libxrandr-dev
|
||||
libxss-dev
|
||||
|
||||
github-patches:
|
||||
.github/workflows/haskell-ci-hackage.patch
|
||||
|
||||
raw-project
|
||||
optimization: False
|
||||
package xmonad
|
||||
flags: +pedantic
|
||||
|
||||
-- avoid --haddock-all which overwrites *-docs.tar.gz with tests docs
|
||||
haddock-components: libs
|
4
cabal.project
Normal file
4
cabal.project
Normal file
@@ -0,0 +1,4 @@
|
||||
-- cabal.project
|
||||
|
||||
packages:
|
||||
xmonad.cabal
|
106
flake.nix
Normal file
106
flake.nix
Normal file
@@ -0,0 +1,106 @@
|
||||
# This file is maintained by @IvanMalison and @LSLeary (github)
|
||||
# See xmonad-contrib/NIX.md for an overview of module usage.
|
||||
{
|
||||
inputs = {
|
||||
flake-utils.url = "github:numtide/flake-utils";
|
||||
git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master";
|
||||
unstable.url = "github:NixOS/nixpkgs/nixos-unstable";
|
||||
};
|
||||
outputs = { self, flake-utils, nixpkgs, unstable, git-ignore-nix }:
|
||||
let
|
||||
hpath = { prefix ? null, compiler ? null }:
|
||||
(if prefix == null then [] else [ prefix ]) ++
|
||||
(if compiler == null
|
||||
then [ "haskellPackages" ]
|
||||
else [ "haskell" "packages" compiler ]
|
||||
);
|
||||
fromHOL = hol: comp: final: prev: with prev.lib; with attrsets;
|
||||
let
|
||||
path = hpath comp;
|
||||
root = head path;
|
||||
branch = tail path;
|
||||
hpkgs' = (getAttrFromPath path prev).override (old: {
|
||||
overrides = composeExtensions (old.overrides or (_: _: {}))
|
||||
(hol final prev);
|
||||
});
|
||||
in {
|
||||
${root} = recursiveUpdate prev.${root} (setAttrByPath branch hpkgs');
|
||||
};
|
||||
hoverlay = final: prev: hself: hsuper:
|
||||
with prev.haskell.lib.compose; {
|
||||
xmonad = hself.callCabal2nix "xmonad"
|
||||
(git-ignore-nix.lib.gitignoreSource ./.) { };
|
||||
};
|
||||
defComp = if builtins.pathExists ./comp.nix
|
||||
then import ./comp.nix
|
||||
else { };
|
||||
overlay = fromHOL hoverlay defComp;
|
||||
overlays = [ overlay ];
|
||||
nixosModule = { config, pkgs, lib, ... }: with lib; with attrsets;
|
||||
let
|
||||
cfg = config.services.xserver.windowManager.xmonad.flake;
|
||||
comp = { inherit (cfg) prefix compiler; };
|
||||
in {
|
||||
options = {
|
||||
services.xserver.windowManager.xmonad.flake = with types; {
|
||||
enable = mkEnableOption "flake";
|
||||
prefix = mkOption {
|
||||
default = null;
|
||||
type = nullOr str;
|
||||
example = literalExpression "\"unstable\"";
|
||||
description = ''
|
||||
Specify a nested alternative <literal>pkgs</literal> by attrName.
|
||||
'';
|
||||
};
|
||||
compiler = mkOption {
|
||||
default = null;
|
||||
type = nullOr str;
|
||||
example = literalExpression "\"ghc922\"";
|
||||
description = ''
|
||||
Which compiler to build xmonad with.
|
||||
Must be an attribute of <literal>pkgs.haskell.packages</literal>.
|
||||
Sets <option>xmonad.haskellPackages</option> to match.
|
||||
'';
|
||||
};
|
||||
};
|
||||
};
|
||||
config = mkIf cfg.enable {
|
||||
nixpkgs.overlays = [ (fromHOL hoverlay comp) ];
|
||||
services.xserver.windowManager.xmonad.haskellPackages =
|
||||
getAttrFromPath (hpath comp) pkgs;
|
||||
};
|
||||
};
|
||||
nixosModules = [ nixosModule ];
|
||||
in flake-utils.lib.eachDefaultSystem (system:
|
||||
let pkgs = import nixpkgs { inherit system overlays; };
|
||||
hpkg = pkgs.lib.attrsets.getAttrFromPath (hpath defComp) pkgs;
|
||||
modifyDevShell =
|
||||
if builtins.pathExists ./develop.nix
|
||||
then import ./develop.nix
|
||||
else _: x: x;
|
||||
in
|
||||
rec {
|
||||
devShell = hpkg.shellFor (modifyDevShell pkgs {
|
||||
packages = p: [ p.xmonad ];
|
||||
});
|
||||
defaultPackage = hpkg.xmonad;
|
||||
# An auxiliary NixOS module that modernises the standard xmonad NixOS module
|
||||
# and wrapper script used, replacing them with versions from unstable.
|
||||
# Currently, due to the NIX_GHC --> XMONAD_GHC env var change, this is
|
||||
# necessary in order for Mod-q recompilation to work out-of-the-box.
|
||||
modernise =
|
||||
let
|
||||
xmonadModFile = "services/x11/window-managers/xmonad.nix";
|
||||
unpkgs = import unstable { inherit system; };
|
||||
replaceWrapper = _: _:
|
||||
{ xmonad-with-packages = unpkgs.xmonad-with-packages; };
|
||||
in {
|
||||
disabledModules = [ xmonadModFile ];
|
||||
imports = [ (unstable + "/nixos/modules/" + xmonadModFile) ];
|
||||
nixpkgs.overlays = [ replaceWrapper ];
|
||||
};
|
||||
}) // {
|
||||
inherit hoverlay overlay overlays nixosModule nixosModules;
|
||||
lib = { inherit hpath fromHOL; };
|
||||
};
|
||||
}
|
71
man/HCAR.tex
Normal file
71
man/HCAR.tex
Normal file
@@ -0,0 +1,71 @@
|
||||
% xmonad-Gx.tex
|
||||
\begin{hcarentry}{xmonad}
|
||||
\label{xmonad}
|
||||
\report{Gwern Branwen}%11/11
|
||||
\status{active development}
|
||||
\makeheader
|
||||
|
||||
XMonad is a tiling window manager for X. Windows are arranged
|
||||
automatically to tile the screen without gaps or overlap, maximizing
|
||||
screen use. Window manager features are accessible from the keyboard; a
|
||||
mouse is optional. XMonad is written, configured, and extensible in
|
||||
Haskell. Custom layout algorithms, key bindings, and other extensions may
|
||||
be written by the user in config files. Layouts are applied
|
||||
dynamically, and different layouts may be used on each workspace.
|
||||
Xinerama is fully supported, allowing windows to be tiled on several
|
||||
physical screens.
|
||||
|
||||
Development since the last report has continued; XMonad founder Don Stewart
|
||||
has stepped down and Adam Vogt is the new maintainer.
|
||||
After gestating for 2 years, version 0.10 has been released, with simultaneous
|
||||
releases of the XMonadContrib library of customizations (which has now grown to
|
||||
no less than 216 modules encompassing a dizzying array of features) and the
|
||||
xmonad-extras package of extensions,
|
||||
|
||||
Details of changes between releases can be found in the release notes:
|
||||
\begin{compactitem}
|
||||
\item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.8}
|
||||
\item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.9}
|
||||
% \item \url{http://haskell.org/haskellwiki/Xmonad/Notable_changes_since_0.10}
|
||||
\item the Darcs repositories have been upgraded to the hashed format
|
||||
\item XMonad.Config.PlainConfig allows writing configs in a more 'normal' style, and not raw Haskell
|
||||
\item Supports using local modules in xmonad.hs; for example: to use definitions from \~/.xmonad/lib/XMonad/Stack/MyAdditions.hs
|
||||
\item xmonad --restart CLI option
|
||||
\item xmonad --replace CLI option
|
||||
\item XMonad.Prompt now has customizable keymaps
|
||||
\item Actions.GridSelect - a GUI menu for selecting windows or workspaces \& substring search on window names
|
||||
\item Actions.OnScreen
|
||||
\item Extensions now can have state
|
||||
\item Actions.SpawnOn - uses state to spawn applications on the workspace the user was originally on,
|
||||
and not where the user happens to be
|
||||
\item Markdown manpages and not man/troff
|
||||
\item XMonad.Layout.ImageButtonDecoration \&\\ XMonad.Util.Image
|
||||
\item XMonad.Layout.Groups
|
||||
\item XMonad.Layout.ZoomRow
|
||||
\item XMonad.Layout.Renamed
|
||||
\item XMonad.Layout.Drawer
|
||||
\item XMonad.Layout.FullScreen
|
||||
\item XMonad.Hooks.ScreenCorners
|
||||
\item XMonad.Actions.DynamicWorkspaceOrder
|
||||
\item XMonad.Actions.WorkspaceNames
|
||||
\item XMonad.Actions.DynamicWorkspaceGroups
|
||||
\end{compactitem}
|
||||
|
||||
Binary packages of XMonad and XMonadContrib are available for all major Linux distributions.
|
||||
|
||||
\FurtherReading
|
||||
\begin{compactitem}
|
||||
\item Homepage:
|
||||
\url{http://xmonad.org/}
|
||||
|
||||
\item Git source:
|
||||
|
||||
\texttt{git clone} \url{https://github.com/xmonad/xmonad.git}
|
||||
|
||||
\item IRC channel:
|
||||
\verb+#xmonad @@ irc.freenode.org+
|
||||
|
||||
\item Mailing list:
|
||||
\email{xmonad@@haskell.org}
|
||||
\end{compactitem}
|
||||
\end{hcarentry}
|
11
man/Makefile
Normal file
11
man/Makefile
Normal file
@@ -0,0 +1,11 @@
|
||||
.PHONY: all
|
||||
all: xmonad.1 xmonad.1.html
|
||||
|
||||
xmonad.1.markdown: xmonad.1.markdown.in
|
||||
(cd .. && util/GenerateManpage.hs) <$< >$@
|
||||
|
||||
xmonad.1: xmonad.1.markdown
|
||||
pandoc --from=markdown --to=man --standalone --output=$@ $<
|
||||
|
||||
xmonad.1.html: xmonad.1.markdown
|
||||
pandoc --from=markdown --to=html --standalone --table-of-contents --output=$@ $<
|
241
man/xmonad.1
Normal file
241
man/xmonad.1
Normal file
@@ -0,0 +1,241 @@
|
||||
.\" Automatically generated by Pandoc 3.1.3
|
||||
.\"
|
||||
.\" Define V font for inline verbatim, using C font in formats
|
||||
.\" that render this, and otherwise B font.
|
||||
.ie "\f[CB]x\f[]"x" \{\
|
||||
. ftr V B
|
||||
. ftr VI BI
|
||||
. ftr VB B
|
||||
. ftr VBI BI
|
||||
.\}
|
||||
.el \{\
|
||||
. ftr V CR
|
||||
. ftr VI CI
|
||||
. ftr VB CB
|
||||
. ftr VBI CBI
|
||||
.\}
|
||||
.TH "XMONAD" "1" "27 October 2021" "Tiling Window Manager" ""
|
||||
.hy
|
||||
.SH Name
|
||||
.PP
|
||||
xmonad - Tiling Window Manager
|
||||
.SH Description
|
||||
.PP
|
||||
\f[I]xmonad\f[R] is a minimalist tiling window manager for X, written in
|
||||
Haskell.
|
||||
Windows are managed using automatic layout algorithms, which can be
|
||||
dynamically reconfigured.
|
||||
At any time windows are arranged so as to maximize the use of screen
|
||||
real estate.
|
||||
All features of the window manager are accessible purely from the
|
||||
keyboard: a mouse is entirely optional.
|
||||
\f[I]xmonad\f[R] is configured in Haskell, and custom layout algorithms
|
||||
may be implemented by the user in config files.
|
||||
A principle of \f[I]xmonad\f[R] is predictability: the user should know
|
||||
in advance precisely the window arrangement that will result from any
|
||||
action.
|
||||
.PP
|
||||
By default, \f[I]xmonad\f[R] provides three layout algorithms: tall,
|
||||
wide and fullscreen.
|
||||
In tall or wide mode, windows are tiled and arranged to prevent overlap
|
||||
and maximize screen use.
|
||||
Sets of windows are grouped together on virtual screens, and each screen
|
||||
retains its own layout, which may be reconfigured dynamically.
|
||||
Multiple physical monitors are supported via Xinerama, allowing
|
||||
simultaneous display of a number of screens.
|
||||
.PP
|
||||
By utilizing the expressivity of a modern functional language with a
|
||||
rich static type system, \f[I]xmonad\f[R] provides a complete,
|
||||
featureful window manager in less than 1200 lines of code, with an
|
||||
emphasis on correctness and robustness.
|
||||
Internal properties of the window manager are checked using a
|
||||
combination of static guarantees provided by the type system, and
|
||||
type-based automated testing.
|
||||
A benefit of this is that the code is simple to understand, and easy to
|
||||
modify.
|
||||
.SH Usage
|
||||
.PP
|
||||
\f[I]xmonad\f[R] places each window into a \[lq]workspace\[rq].
|
||||
Each workspace can have any number of windows, which you can cycle
|
||||
though with mod-j and mod-k.
|
||||
Windows are either displayed full screen, tiled horizontally, or tiled
|
||||
vertically.
|
||||
You can toggle the layout mode with mod-space, which will cycle through
|
||||
the available modes.
|
||||
.PP
|
||||
You can switch to workspace N with mod-N.
|
||||
For example, to switch to workspace 5, you would press mod-5.
|
||||
Similarly, you can move the current window to another workspace with
|
||||
mod-shift-N.
|
||||
.PP
|
||||
When running with multiple monitors (Xinerama), each screen has exactly
|
||||
1 workspace visible.
|
||||
mod-{w,e,r} switch the focus between screens, while shift-mod-{w,e,r}
|
||||
move the current window to that screen.
|
||||
When \f[I]xmonad\f[R] starts, workspace 1 is on screen 1, workspace 2 is
|
||||
on screen 2, etc.
|
||||
When switching workspaces to one that is already visible, the current
|
||||
and visible workspaces are swapped.
|
||||
.SS Flags
|
||||
.PP
|
||||
xmonad has several flags which you may pass to the executable.
|
||||
These flags are:
|
||||
.TP
|
||||
\[en]recompile
|
||||
Recompiles your \f[I]xmonad.hs\f[R] configuration
|
||||
.TP
|
||||
\[en]restart
|
||||
Causes the currently running \f[I]xmonad\f[R] process to restart
|
||||
.TP
|
||||
\[en]replace
|
||||
Replace the current window manager with xmonad
|
||||
.TP
|
||||
\[en]version
|
||||
Display version of \f[I]xmonad\f[R]
|
||||
.TP
|
||||
\[en]verbose-version
|
||||
Display detailed version of \f[I]xmonad\f[R]
|
||||
.SS Default keyboard bindings
|
||||
.TP
|
||||
mod-shift-return
|
||||
Launch terminal
|
||||
.TP
|
||||
mod-p
|
||||
Launch dmenu
|
||||
.TP
|
||||
mod-shift-p
|
||||
Launch gmrun
|
||||
.TP
|
||||
mod-shift-c
|
||||
Close the focused window
|
||||
.TP
|
||||
mod-space
|
||||
Rotate through the available layout algorithms
|
||||
.TP
|
||||
mod-shift-space
|
||||
Reset the layouts on the current workspace to default
|
||||
.TP
|
||||
mod-n
|
||||
Resize viewed windows to the correct size
|
||||
.TP
|
||||
mod-tab
|
||||
Move focus to the next window
|
||||
.TP
|
||||
mod-shift-tab
|
||||
Move focus to the previous window
|
||||
.TP
|
||||
mod-j
|
||||
Move focus to the next window
|
||||
.TP
|
||||
mod-k
|
||||
Move focus to the previous window
|
||||
.TP
|
||||
mod-m
|
||||
Move focus to the master window
|
||||
.TP
|
||||
mod-return
|
||||
Swap the focused window and the master window
|
||||
.TP
|
||||
mod-shift-j
|
||||
Swap the focused window with the next window
|
||||
.TP
|
||||
mod-shift-k
|
||||
Swap the focused window with the previous window
|
||||
.TP
|
||||
mod-h
|
||||
Shrink the master area
|
||||
.TP
|
||||
mod-l
|
||||
Expand the master area
|
||||
.TP
|
||||
mod-t
|
||||
Push window back into tiling
|
||||
.TP
|
||||
mod-comma
|
||||
Increment the number of windows in the master area
|
||||
.TP
|
||||
mod-period
|
||||
Deincrement the number of windows in the master area
|
||||
.TP
|
||||
mod-shift-q
|
||||
Quit xmonad
|
||||
.TP
|
||||
mod-q
|
||||
Restart xmonad
|
||||
.TP
|
||||
mod-shift-slash
|
||||
Run xmessage with a summary of the default keybindings (useful for
|
||||
beginners)
|
||||
.TP
|
||||
mod-question
|
||||
Run xmessage with a summary of the default keybindings (useful for
|
||||
beginners)
|
||||
.TP
|
||||
mod-[1..9]
|
||||
Switch to workspace N
|
||||
.TP
|
||||
mod-shift-[1..9]
|
||||
Move client to workspace N
|
||||
.TP
|
||||
mod-{w,e,r}
|
||||
Switch to physical/Xinerama screens 1, 2, or 3
|
||||
.TP
|
||||
mod-shift-{w,e,r}
|
||||
Move client to screen 1, 2, or 3
|
||||
.TP
|
||||
mod-button1
|
||||
Set the window to floating mode and move by dragging
|
||||
.TP
|
||||
mod-button2
|
||||
Raise the window to the top of the stack
|
||||
.TP
|
||||
mod-button3
|
||||
Set the window to floating mode and resize by dragging
|
||||
.SH Examples
|
||||
.PP
|
||||
To use xmonad as your window manager add to your
|
||||
\f[I]\[ti]/.xinitrc\f[R] file:
|
||||
.RS
|
||||
.PP
|
||||
exec xmonad
|
||||
.RE
|
||||
.SH Customization
|
||||
.PP
|
||||
xmonad is customized in your \f[I]xmonad.hs\f[R], and then restarted
|
||||
with mod-q.
|
||||
You can choose where your configuration file lives by
|
||||
.IP "1." 3
|
||||
Setting \f[V]XMONAD_DATA_DIR,\f[R] \f[V]XMONAD_CONFIG_DIR\f[R], and
|
||||
\f[V]XMONAD_CACHE_DIR\f[R]; \f[I]xmonad.hs\f[R] is then expected to be
|
||||
in \f[V]XMONAD_CONFIG_DIR\f[R].
|
||||
.IP "2." 3
|
||||
Creating \f[I]xmonad.hs\f[R] in \f[I]\[ti]/.xmonad\f[R].
|
||||
.IP "3." 3
|
||||
Creating \f[I]xmonad.hs\f[R] in \f[V]XDG_CONFIG_HOME\f[R].
|
||||
Note that, in this case, xmonad will use \f[V]XDG_DATA_HOME\f[R] and
|
||||
\f[V]XDG_CACHE_HOME\f[R] for its data and cache directory respectively.
|
||||
.PP
|
||||
You can find many extensions to the core feature set in the xmonad-
|
||||
contrib package, available through your package manager or from
|
||||
xmonad.org (https://xmonad.org).
|
||||
.SS Modular Configuration
|
||||
.PP
|
||||
As of \f[I]xmonad-0.9\f[R], any additional Haskell modules may be placed
|
||||
in \f[I]\[ti]/.xmonad/lib/\f[R] are available in GHC\[cq]s searchpath.
|
||||
Hierarchical modules are supported: for example, the file
|
||||
\f[I]\[ti]/.xmonad/lib/XMonad/Stack/MyAdditions.hs\f[R] could contain:
|
||||
.IP
|
||||
.nf
|
||||
\f[C]
|
||||
module XMonad.Stack.MyAdditions (function1) where
|
||||
function1 = error \[dq]function1: Not implemented yet!\[dq]
|
||||
\f[R]
|
||||
.fi
|
||||
.PP
|
||||
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
|
||||
module was contained within xmonad or xmonad-contrib.
|
||||
.SH Bugs
|
||||
.PP
|
||||
Probably.
|
||||
If you find any, please report them to the
|
||||
bugtracker (https://github.com/xmonad/xmonad/issues)
|
490
man/xmonad.1.html
Normal file
490
man/xmonad.1.html
Normal file
@@ -0,0 +1,490 @@
|
||||
<!DOCTYPE html>
|
||||
<html xmlns="http://www.w3.org/1999/xhtml" lang="" xml:lang="">
|
||||
<head>
|
||||
<meta charset="utf-8" />
|
||||
<meta name="generator" content="pandoc" />
|
||||
<meta name="viewport" content="width=device-width, initial-scale=1.0, user-scalable=yes" />
|
||||
<meta name="author" content="" />
|
||||
<meta name="dcterms.date" content="2021-10-27" />
|
||||
<title>XMONAD(1) Tiling Window Manager</title>
|
||||
<style>
|
||||
html {
|
||||
color: #1a1a1a;
|
||||
background-color: #fdfdfd;
|
||||
}
|
||||
body {
|
||||
margin: 0 auto;
|
||||
max-width: 36em;
|
||||
padding-left: 50px;
|
||||
padding-right: 50px;
|
||||
padding-top: 50px;
|
||||
padding-bottom: 50px;
|
||||
hyphens: auto;
|
||||
overflow-wrap: break-word;
|
||||
text-rendering: optimizeLegibility;
|
||||
font-kerning: normal;
|
||||
}
|
||||
@media (max-width: 600px) {
|
||||
body {
|
||||
font-size: 0.9em;
|
||||
padding: 12px;
|
||||
}
|
||||
h1 {
|
||||
font-size: 1.8em;
|
||||
}
|
||||
}
|
||||
@media print {
|
||||
html {
|
||||
background-color: white;
|
||||
}
|
||||
body {
|
||||
background-color: transparent;
|
||||
color: black;
|
||||
font-size: 12pt;
|
||||
}
|
||||
p, h2, h3 {
|
||||
orphans: 3;
|
||||
widows: 3;
|
||||
}
|
||||
h2, h3, h4 {
|
||||
page-break-after: avoid;
|
||||
}
|
||||
}
|
||||
p {
|
||||
margin: 1em 0;
|
||||
}
|
||||
a {
|
||||
color: #1a1a1a;
|
||||
}
|
||||
a:visited {
|
||||
color: #1a1a1a;
|
||||
}
|
||||
img {
|
||||
max-width: 100%;
|
||||
}
|
||||
h1, h2, h3, h4, h5, h6 {
|
||||
margin-top: 1.4em;
|
||||
}
|
||||
h5, h6 {
|
||||
font-size: 1em;
|
||||
font-style: italic;
|
||||
}
|
||||
h6 {
|
||||
font-weight: normal;
|
||||
}
|
||||
ol, ul {
|
||||
padding-left: 1.7em;
|
||||
margin-top: 1em;
|
||||
}
|
||||
li > ol, li > ul {
|
||||
margin-top: 0;
|
||||
}
|
||||
blockquote {
|
||||
margin: 1em 0 1em 1.7em;
|
||||
padding-left: 1em;
|
||||
border-left: 2px solid #e6e6e6;
|
||||
color: #606060;
|
||||
}
|
||||
code {
|
||||
font-family: Menlo, Monaco, Consolas, 'Lucida Console', monospace;
|
||||
font-size: 85%;
|
||||
margin: 0;
|
||||
hyphens: manual;
|
||||
}
|
||||
pre {
|
||||
margin: 1em 0;
|
||||
overflow: auto;
|
||||
}
|
||||
pre code {
|
||||
padding: 0;
|
||||
overflow: visible;
|
||||
overflow-wrap: normal;
|
||||
}
|
||||
.sourceCode {
|
||||
background-color: transparent;
|
||||
overflow: visible;
|
||||
}
|
||||
hr {
|
||||
background-color: #1a1a1a;
|
||||
border: none;
|
||||
height: 1px;
|
||||
margin: 1em 0;
|
||||
}
|
||||
table {
|
||||
margin: 1em 0;
|
||||
border-collapse: collapse;
|
||||
width: 100%;
|
||||
overflow-x: auto;
|
||||
display: block;
|
||||
font-variant-numeric: lining-nums tabular-nums;
|
||||
}
|
||||
table caption {
|
||||
margin-bottom: 0.75em;
|
||||
}
|
||||
tbody {
|
||||
margin-top: 0.5em;
|
||||
border-top: 1px solid #1a1a1a;
|
||||
border-bottom: 1px solid #1a1a1a;
|
||||
}
|
||||
th {
|
||||
border-top: 1px solid #1a1a1a;
|
||||
padding: 0.25em 0.5em 0.25em 0.5em;
|
||||
}
|
||||
td {
|
||||
padding: 0.125em 0.5em 0.25em 0.5em;
|
||||
}
|
||||
header {
|
||||
margin-bottom: 4em;
|
||||
text-align: center;
|
||||
}
|
||||
#TOC li {
|
||||
list-style: none;
|
||||
}
|
||||
#TOC ul {
|
||||
padding-left: 1.3em;
|
||||
}
|
||||
#TOC > ul {
|
||||
padding-left: 0;
|
||||
}
|
||||
#TOC a:not(:hover) {
|
||||
text-decoration: none;
|
||||
}
|
||||
code{white-space: pre-wrap;}
|
||||
span.smallcaps{font-variant: small-caps;}
|
||||
div.columns{display: flex; gap: min(4vw, 1.5em);}
|
||||
div.column{flex: auto; overflow-x: auto;}
|
||||
div.hanging-indent{margin-left: 1.5em; text-indent: -1.5em;}
|
||||
/* The extra [class] is a hack that increases specificity enough to
|
||||
override a similar rule in reveal.js */
|
||||
ul.task-list[class]{list-style: none;}
|
||||
ul.task-list li input[type="checkbox"] {
|
||||
font-size: inherit;
|
||||
width: 0.8em;
|
||||
margin: 0 0.8em 0.2em -1.6em;
|
||||
vertical-align: middle;
|
||||
}
|
||||
.display.math{display: block; text-align: center; margin: 0.5rem auto;}
|
||||
/* CSS for syntax highlighting */
|
||||
pre > code.sourceCode { white-space: pre; position: relative; }
|
||||
pre > code.sourceCode > span { line-height: 1.25; }
|
||||
pre > code.sourceCode > span:empty { height: 1.2em; }
|
||||
.sourceCode { overflow: visible; }
|
||||
code.sourceCode > span { color: inherit; text-decoration: inherit; }
|
||||
div.sourceCode { margin: 1em 0; }
|
||||
pre.sourceCode { margin: 0; }
|
||||
@media screen {
|
||||
div.sourceCode { overflow: auto; }
|
||||
}
|
||||
@media print {
|
||||
pre > code.sourceCode { white-space: pre-wrap; }
|
||||
pre > code.sourceCode > span { text-indent: -5em; padding-left: 5em; }
|
||||
}
|
||||
pre.numberSource code
|
||||
{ counter-reset: source-line 0; }
|
||||
pre.numberSource code > span
|
||||
{ position: relative; left: -4em; counter-increment: source-line; }
|
||||
pre.numberSource code > span > a:first-child::before
|
||||
{ content: counter(source-line);
|
||||
position: relative; left: -1em; text-align: right; vertical-align: baseline;
|
||||
border: none; display: inline-block;
|
||||
-webkit-touch-callout: none; -webkit-user-select: none;
|
||||
-khtml-user-select: none; -moz-user-select: none;
|
||||
-ms-user-select: none; user-select: none;
|
||||
padding: 0 4px; width: 4em;
|
||||
color: #aaaaaa;
|
||||
}
|
||||
pre.numberSource { margin-left: 3em; border-left: 1px solid #aaaaaa; padding-left: 4px; }
|
||||
div.sourceCode
|
||||
{ }
|
||||
@media screen {
|
||||
pre > code.sourceCode > span > a:first-child::before { text-decoration: underline; }
|
||||
}
|
||||
code span.al { color: #ff0000; font-weight: bold; } /* Alert */
|
||||
code span.an { color: #60a0b0; font-weight: bold; font-style: italic; } /* Annotation */
|
||||
code span.at { color: #7d9029; } /* Attribute */
|
||||
code span.bn { color: #40a070; } /* BaseN */
|
||||
code span.bu { color: #008000; } /* BuiltIn */
|
||||
code span.cf { color: #007020; font-weight: bold; } /* ControlFlow */
|
||||
code span.ch { color: #4070a0; } /* Char */
|
||||
code span.cn { color: #880000; } /* Constant */
|
||||
code span.co { color: #60a0b0; font-style: italic; } /* Comment */
|
||||
code span.cv { color: #60a0b0; font-weight: bold; font-style: italic; } /* CommentVar */
|
||||
code span.do { color: #ba2121; font-style: italic; } /* Documentation */
|
||||
code span.dt { color: #902000; } /* DataType */
|
||||
code span.dv { color: #40a070; } /* DecVal */
|
||||
code span.er { color: #ff0000; font-weight: bold; } /* Error */
|
||||
code span.ex { } /* Extension */
|
||||
code span.fl { color: #40a070; } /* Float */
|
||||
code span.fu { color: #06287e; } /* Function */
|
||||
code span.im { color: #008000; font-weight: bold; } /* Import */
|
||||
code span.in { color: #60a0b0; font-weight: bold; font-style: italic; } /* Information */
|
||||
code span.kw { color: #007020; font-weight: bold; } /* Keyword */
|
||||
code span.op { color: #666666; } /* Operator */
|
||||
code span.ot { color: #007020; } /* Other */
|
||||
code span.pp { color: #bc7a00; } /* Preprocessor */
|
||||
code span.sc { color: #4070a0; } /* SpecialChar */
|
||||
code span.ss { color: #bb6688; } /* SpecialString */
|
||||
code span.st { color: #4070a0; } /* String */
|
||||
code span.va { color: #19177c; } /* Variable */
|
||||
code span.vs { color: #4070a0; } /* VerbatimString */
|
||||
code span.wa { color: #60a0b0; font-weight: bold; font-style: italic; } /* Warning */
|
||||
</style>
|
||||
</head>
|
||||
<body>
|
||||
<header id="title-block-header">
|
||||
<h1 class="title">XMONAD(1) Tiling Window Manager</h1>
|
||||
<p class="author"></p>
|
||||
<p class="date">27 October 2021</p>
|
||||
</header>
|
||||
<nav id="TOC" role="doc-toc">
|
||||
<ul>
|
||||
<li><a href="#name" id="toc-name">Name</a></li>
|
||||
<li><a href="#description" id="toc-description">Description</a></li>
|
||||
<li><a href="#usage" id="toc-usage">Usage</a>
|
||||
<ul>
|
||||
<li><a href="#flags" id="toc-flags">Flags</a></li>
|
||||
<li><a href="#default-keyboard-bindings"
|
||||
id="toc-default-keyboard-bindings">Default keyboard bindings</a></li>
|
||||
</ul></li>
|
||||
<li><a href="#examples" id="toc-examples">Examples</a></li>
|
||||
<li><a href="#customization" id="toc-customization">Customization</a>
|
||||
<ul>
|
||||
<li><a href="#modular-configuration"
|
||||
id="toc-modular-configuration">Modular Configuration</a></li>
|
||||
</ul></li>
|
||||
<li><a href="#bugs" id="toc-bugs">Bugs</a></li>
|
||||
</ul>
|
||||
</nav>
|
||||
<h1 id="name">Name</h1>
|
||||
<p>xmonad - Tiling Window Manager</p>
|
||||
<h1 id="description">Description</h1>
|
||||
<p><em>xmonad</em> is a minimalist tiling window manager for X, written
|
||||
in Haskell. Windows are managed using automatic layout algorithms, which
|
||||
can be dynamically reconfigured. At any time windows are arranged so as
|
||||
to maximize the use of screen real estate. All features of the window
|
||||
manager are accessible purely from the keyboard: a mouse is entirely
|
||||
optional. <em>xmonad</em> is configured in Haskell, and custom layout
|
||||
algorithms may be implemented by the user in config files. A principle
|
||||
of <em>xmonad</em> is predictability: the user should know in advance
|
||||
precisely the window arrangement that will result from any action.</p>
|
||||
<p>By default, <em>xmonad</em> provides three layout algorithms: tall,
|
||||
wide and fullscreen. In tall or wide mode, windows are tiled and
|
||||
arranged to prevent overlap and maximize screen use. Sets of windows are
|
||||
grouped together on virtual screens, and each screen retains its own
|
||||
layout, which may be reconfigured dynamically. Multiple physical
|
||||
monitors are supported via Xinerama, allowing simultaneous display of a
|
||||
number of screens.</p>
|
||||
<p>By utilizing the expressivity of a modern functional language with a
|
||||
rich static type system, <em>xmonad</em> provides a complete, featureful
|
||||
window manager in less than 1200 lines of code, with an emphasis on
|
||||
correctness and robustness. Internal properties of the window manager
|
||||
are checked using a combination of static guarantees provided by the
|
||||
type system, and type-based automated testing. A benefit of this is that
|
||||
the code is simple to understand, and easy to modify.</p>
|
||||
<h1 id="usage">Usage</h1>
|
||||
<p><em>xmonad</em> places each window into a “workspace”. Each workspace
|
||||
can have any number of windows, which you can cycle though with mod-j
|
||||
and mod-k. Windows are either displayed full screen, tiled horizontally,
|
||||
or tiled vertically. You can toggle the layout mode with mod-space,
|
||||
which will cycle through the available modes.</p>
|
||||
<p>You can switch to workspace N with mod-N. For example, to switch to
|
||||
workspace 5, you would press mod-5. Similarly, you can move the current
|
||||
window to another workspace with mod-shift-N.</p>
|
||||
<p>When running with multiple monitors (Xinerama), each screen has
|
||||
exactly 1 workspace visible. mod-{w,e,r} switch the focus between
|
||||
screens, while shift-mod-{w,e,r} move the current window to that screen.
|
||||
When <em>xmonad</em> starts, workspace 1 is on screen 1, workspace 2 is
|
||||
on screen 2, etc. When switching workspaces to one that is already
|
||||
visible, the current and visible workspaces are swapped.</p>
|
||||
<h2 id="flags">Flags</h2>
|
||||
<p>xmonad has several flags which you may pass to the executable. These
|
||||
flags are:</p>
|
||||
<dl>
|
||||
<dt>–recompile</dt>
|
||||
<dd>
|
||||
Recompiles your <em>xmonad.hs</em> configuration
|
||||
</dd>
|
||||
<dt>–restart</dt>
|
||||
<dd>
|
||||
Causes the currently running <em>xmonad</em> process to restart
|
||||
</dd>
|
||||
<dt>–replace</dt>
|
||||
<dd>
|
||||
Replace the current window manager with xmonad
|
||||
</dd>
|
||||
<dt>–version</dt>
|
||||
<dd>
|
||||
Display version of <em>xmonad</em>
|
||||
</dd>
|
||||
<dt>–verbose-version</dt>
|
||||
<dd>
|
||||
Display detailed version of <em>xmonad</em>
|
||||
</dd>
|
||||
</dl>
|
||||
<h2 id="default-keyboard-bindings">Default keyboard bindings</h2>
|
||||
<dl>
|
||||
<dt>mod-shift-return</dt>
|
||||
<dd>
|
||||
Launch terminal
|
||||
</dd>
|
||||
<dt>mod-p</dt>
|
||||
<dd>
|
||||
Launch dmenu
|
||||
</dd>
|
||||
<dt>mod-shift-p</dt>
|
||||
<dd>
|
||||
Launch gmrun
|
||||
</dd>
|
||||
<dt>mod-shift-c</dt>
|
||||
<dd>
|
||||
Close the focused window
|
||||
</dd>
|
||||
<dt>mod-space</dt>
|
||||
<dd>
|
||||
Rotate through the available layout algorithms
|
||||
</dd>
|
||||
<dt>mod-shift-space</dt>
|
||||
<dd>
|
||||
Reset the layouts on the current workspace to default
|
||||
</dd>
|
||||
<dt>mod-n</dt>
|
||||
<dd>
|
||||
Resize viewed windows to the correct size
|
||||
</dd>
|
||||
<dt>mod-tab</dt>
|
||||
<dd>
|
||||
Move focus to the next window
|
||||
</dd>
|
||||
<dt>mod-shift-tab</dt>
|
||||
<dd>
|
||||
Move focus to the previous window
|
||||
</dd>
|
||||
<dt>mod-j</dt>
|
||||
<dd>
|
||||
Move focus to the next window
|
||||
</dd>
|
||||
<dt>mod-k</dt>
|
||||
<dd>
|
||||
Move focus to the previous window
|
||||
</dd>
|
||||
<dt>mod-m</dt>
|
||||
<dd>
|
||||
Move focus to the master window
|
||||
</dd>
|
||||
<dt>mod-return</dt>
|
||||
<dd>
|
||||
Swap the focused window and the master window
|
||||
</dd>
|
||||
<dt>mod-shift-j</dt>
|
||||
<dd>
|
||||
Swap the focused window with the next window
|
||||
</dd>
|
||||
<dt>mod-shift-k</dt>
|
||||
<dd>
|
||||
Swap the focused window with the previous window
|
||||
</dd>
|
||||
<dt>mod-h</dt>
|
||||
<dd>
|
||||
Shrink the master area
|
||||
</dd>
|
||||
<dt>mod-l</dt>
|
||||
<dd>
|
||||
Expand the master area
|
||||
</dd>
|
||||
<dt>mod-t</dt>
|
||||
<dd>
|
||||
Push window back into tiling
|
||||
</dd>
|
||||
<dt>mod-comma</dt>
|
||||
<dd>
|
||||
Increment the number of windows in the master area
|
||||
</dd>
|
||||
<dt>mod-period</dt>
|
||||
<dd>
|
||||
Deincrement the number of windows in the master area
|
||||
</dd>
|
||||
<dt>mod-shift-q</dt>
|
||||
<dd>
|
||||
Quit xmonad
|
||||
</dd>
|
||||
<dt>mod-q</dt>
|
||||
<dd>
|
||||
Restart xmonad
|
||||
</dd>
|
||||
<dt>mod-shift-slash</dt>
|
||||
<dd>
|
||||
Run xmessage with a summary of the default keybindings (useful for
|
||||
beginners)
|
||||
</dd>
|
||||
<dt>mod-question</dt>
|
||||
<dd>
|
||||
Run xmessage with a summary of the default keybindings (useful for
|
||||
beginners)
|
||||
</dd>
|
||||
<dt>mod-[1..9]</dt>
|
||||
<dd>
|
||||
Switch to workspace N
|
||||
</dd>
|
||||
<dt>mod-shift-[1..9]</dt>
|
||||
<dd>
|
||||
Move client to workspace N
|
||||
</dd>
|
||||
<dt>mod-{w,e,r}</dt>
|
||||
<dd>
|
||||
Switch to physical/Xinerama screens 1, 2, or 3
|
||||
</dd>
|
||||
<dt>mod-shift-{w,e,r}</dt>
|
||||
<dd>
|
||||
Move client to screen 1, 2, or 3
|
||||
</dd>
|
||||
<dt>mod-button1</dt>
|
||||
<dd>
|
||||
Set the window to floating mode and move by dragging
|
||||
</dd>
|
||||
<dt>mod-button2</dt>
|
||||
<dd>
|
||||
Raise the window to the top of the stack
|
||||
</dd>
|
||||
<dt>mod-button3</dt>
|
||||
<dd>
|
||||
Set the window to floating mode and resize by dragging
|
||||
</dd>
|
||||
</dl>
|
||||
<h1 id="examples">Examples</h1>
|
||||
<p>To use xmonad as your window manager add to your <em>~/.xinitrc</em>
|
||||
file:</p>
|
||||
<blockquote>
|
||||
<p>exec xmonad</p>
|
||||
</blockquote>
|
||||
<h1 id="customization">Customization</h1>
|
||||
<p>xmonad is customized in your <em>xmonad.hs</em>, and then restarted
|
||||
with mod-q. You can choose where your configuration file lives by</p>
|
||||
<ol type="1">
|
||||
<li>Setting <code>XMONAD_DATA_DIR,</code>
|
||||
<code>XMONAD_CONFIG_DIR</code>, and <code>XMONAD_CACHE_DIR</code>;
|
||||
<em>xmonad.hs</em> is then expected to be in
|
||||
<code>XMONAD_CONFIG_DIR</code>.</li>
|
||||
<li>Creating <em>xmonad.hs</em> in <em>~/.xmonad</em>.</li>
|
||||
<li>Creating <em>xmonad.hs</em> in <code>XDG_CONFIG_HOME</code>. Note
|
||||
that, in this case, xmonad will use <code>XDG_DATA_HOME</code> and
|
||||
<code>XDG_CACHE_HOME</code> for its data and cache directory
|
||||
respectively.</li>
|
||||
</ol>
|
||||
<p>You can find many extensions to the core feature set in the xmonad-
|
||||
contrib package, available through your package manager or from <a
|
||||
href="https://xmonad.org">xmonad.org</a>.</p>
|
||||
<h2 id="modular-configuration">Modular Configuration</h2>
|
||||
<p>As of <em>xmonad-0.9</em>, any additional Haskell modules may be
|
||||
placed in <em>~/.xmonad/lib/</em> are available in GHC’s searchpath.
|
||||
Hierarchical modules are supported: for example, the file
|
||||
<em>~/.xmonad/lib/XMonad/Stack/MyAdditions.hs</em> could contain:</p>
|
||||
<div class="sourceCode" id="cb1"><pre
|
||||
class="sourceCode haskell"><code class="sourceCode haskell"><span id="cb1-1"><a href="#cb1-1" aria-hidden="true" tabindex="-1"></a><span class="kw">module</span> <span class="dt">XMonad.Stack.MyAdditions</span> (function1) <span class="kw">where</span></span>
|
||||
<span id="cb1-2"><a href="#cb1-2" aria-hidden="true" tabindex="-1"></a> function1 <span class="ot">=</span> <span class="fu">error</span> <span class="st">"function1: Not implemented yet!"</span></span></code></pre></div>
|
||||
<p>Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
|
||||
module was contained within xmonad or xmonad-contrib.</p>
|
||||
<h1 id="bugs">Bugs</h1>
|
||||
<p>Probably. If you find any, please report them to the <a
|
||||
href="https://github.com/xmonad/xmonad/issues">bugtracker</a></p>
|
||||
</body>
|
||||
</html>
|
@@ -1,7 +1,12 @@
|
||||
#Name
|
||||
xmonad - a tiling window manager
|
||||
% XMONAD(1) Tiling Window Manager
|
||||
%
|
||||
% 27 October 2021
|
||||
|
||||
#Description
|
||||
# Name
|
||||
|
||||
xmonad - Tiling Window Manager
|
||||
|
||||
# Description
|
||||
|
||||
_xmonad_ is a minimalist tiling window manager for X, written in Haskell.
|
||||
Windows are managed using automatic layout algorithms, which can be
|
||||
@@ -28,7 +33,7 @@ combination of static guarantees provided by the type system, and
|
||||
type-based automated testing. A benefit of this is that the code is simple
|
||||
to understand, and easy to modify.
|
||||
|
||||
#Usage
|
||||
# Usage
|
||||
|
||||
_xmonad_ places each window into a "workspace". Each workspace can have
|
||||
any number of windows, which you can cycle though with mod-j and mod-k.
|
||||
@@ -47,53 +52,159 @@ starts, workspace 1 is on screen 1, workspace 2 is on screen 2, etc. When
|
||||
switching workspaces to one that is already visible, the current and
|
||||
visible workspaces are swapped.
|
||||
|
||||
##Flags
|
||||
## Flags
|
||||
|
||||
xmonad has several flags which you may pass to the executable.
|
||||
These flags are:
|
||||
|
||||
--recompile
|
||||
: Recompiles your configuration in _~/.xmonad/xmonad.hs_
|
||||
: Recompiles your _xmonad.hs_ configuration
|
||||
|
||||
--restart
|
||||
: Causes the currently running _xmonad_ process to restart
|
||||
|
||||
--replace
|
||||
: Replace the current window manager with xmonad
|
||||
|
||||
--version
|
||||
: Display version of _xmonad_
|
||||
|
||||
--verbose-version
|
||||
: Display detailed version of _xmonad_
|
||||
|
||||
##Default keyboard bindings
|
||||
## Default keyboard bindings
|
||||
|
||||
___KEYBINDINGS___
|
||||
mod-shift-return
|
||||
: Launch terminal
|
||||
|
||||
mod-p
|
||||
: Launch dmenu
|
||||
|
||||
mod-shift-p
|
||||
: Launch gmrun
|
||||
|
||||
mod-shift-c
|
||||
: Close the focused window
|
||||
|
||||
mod-space
|
||||
: Rotate through the available layout algorithms
|
||||
|
||||
mod-shift-space
|
||||
: Reset the layouts on the current workspace to default
|
||||
|
||||
mod-n
|
||||
: Resize viewed windows to the correct size
|
||||
|
||||
mod-tab
|
||||
: Move focus to the next window
|
||||
|
||||
mod-shift-tab
|
||||
: Move focus to the previous window
|
||||
|
||||
mod-j
|
||||
: Move focus to the next window
|
||||
|
||||
mod-k
|
||||
: Move focus to the previous window
|
||||
|
||||
mod-m
|
||||
: Move focus to the master window
|
||||
|
||||
mod-return
|
||||
: Swap the focused window and the master window
|
||||
|
||||
mod-shift-j
|
||||
: Swap the focused window with the next window
|
||||
|
||||
mod-shift-k
|
||||
: Swap the focused window with the previous window
|
||||
|
||||
mod-h
|
||||
: Shrink the master area
|
||||
|
||||
mod-l
|
||||
: Expand the master area
|
||||
|
||||
mod-t
|
||||
: Push window back into tiling
|
||||
|
||||
mod-comma
|
||||
: Increment the number of windows in the master area
|
||||
|
||||
mod-period
|
||||
: Deincrement the number of windows in the master area
|
||||
|
||||
mod-shift-q
|
||||
: Quit xmonad
|
||||
|
||||
mod-q
|
||||
: Restart xmonad
|
||||
|
||||
mod-shift-slash
|
||||
: Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||
|
||||
mod-question
|
||||
: Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||
|
||||
mod-[1..9]
|
||||
: Switch to workspace N
|
||||
|
||||
mod-shift-[1..9]
|
||||
: Move client to workspace N
|
||||
|
||||
mod-{w,e,r}
|
||||
: Switch to physical/Xinerama screens 1, 2, or 3
|
||||
|
||||
mod-shift-{w,e,r}
|
||||
: Move client to screen 1, 2, or 3
|
||||
|
||||
mod-button1
|
||||
: Set the window to floating mode and move by dragging
|
||||
|
||||
mod-button2
|
||||
: Raise the window to the top of the stack
|
||||
|
||||
mod-button3
|
||||
: Set the window to floating mode and resize by dragging
|
||||
|
||||
# Examples
|
||||
|
||||
#Examples
|
||||
To use xmonad as your window manager add to your _~/.xinitrc_ file:
|
||||
|
||||
> exec xmonad
|
||||
|
||||
#Customization
|
||||
xmonad is customized in ~/.xmonad/xmonad.hs, and then restarting
|
||||
with mod-q.
|
||||
# Customization
|
||||
xmonad is customized in your _xmonad.hs_, and then restarted with mod-q.
|
||||
You can choose where your configuration file lives by
|
||||
|
||||
1. Setting `XMONAD_DATA_DIR,` `XMONAD_CONFIG_DIR`, and
|
||||
`XMONAD_CACHE_DIR`; _xmonad.hs_ is then expected to be in
|
||||
`XMONAD_CONFIG_DIR`.
|
||||
2. Creating _xmonad.hs_ in _~/.xmonad_.
|
||||
3. Creating _xmonad.hs_ in `XDG_CONFIG_HOME`. Note that, in this
|
||||
case, xmonad will use `XDG_DATA_HOME` and `XDG_CACHE_HOME` for its
|
||||
data and cache directory respectively.
|
||||
|
||||
You can find many extensions to the core feature set in the xmonad-
|
||||
contrib package, available through your package manager or from
|
||||
[xmonad.org].
|
||||
|
||||
##Modular Configuration
|
||||
## Modular Configuration
|
||||
As of _xmonad-0.9_, any additional Haskell modules may be placed in
|
||||
_~/.xmonad/lib/_ are available in GHC's searchpath. Hierarchical modules
|
||||
are supported: for example, the file
|
||||
_~/.xmonad/lib/XMonad/Stack/MyAdditions.hs_ could contain:
|
||||
|
||||
> module XMonad.Stack.MyAdditions (function1) where
|
||||
> function1 = error "function1: Not implemented yet!"
|
||||
```haskell
|
||||
module XMonad.Stack.MyAdditions (function1) where
|
||||
function1 = error "function1: Not implemented yet!"
|
||||
```
|
||||
|
||||
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
|
||||
module was contained within xmonad or xmonad-contrib.
|
||||
|
||||
#Bugs
|
||||
# Bugs
|
||||
Probably. If you find any, please report them to the [bugtracker]
|
||||
|
||||
[xmonad.org]: http://xmonad.org
|
||||
[bugtracker]: http://code.google.com/p/xmonad/issues/list
|
||||
[xmonad.org]: https://xmonad.org
|
||||
[bugtracker]: https://github.com/xmonad/xmonad/issues
|
||||
|
119
man/xmonad.1.markdown.in
Normal file
119
man/xmonad.1.markdown.in
Normal file
@@ -0,0 +1,119 @@
|
||||
% XMONAD(1) Tiling Window Manager
|
||||
%
|
||||
% 27 October 2021
|
||||
|
||||
# Name
|
||||
|
||||
xmonad - Tiling Window Manager
|
||||
|
||||
# Description
|
||||
|
||||
_xmonad_ is a minimalist tiling window manager for X, written in Haskell.
|
||||
Windows are managed using automatic layout algorithms, which can be
|
||||
dynamically reconfigured. At any time windows are arranged so as to
|
||||
maximize the use of screen real estate. All features of the window manager
|
||||
are accessible purely from the keyboard: a mouse is entirely optional.
|
||||
_xmonad_ is configured in Haskell, and custom layout algorithms may be
|
||||
implemented by the user in config files. A principle of _xmonad_ is
|
||||
predictability: the user should know in advance precisely the window
|
||||
arrangement that will result from any action.
|
||||
|
||||
By default, _xmonad_ provides three layout algorithms: tall, wide and
|
||||
fullscreen. In tall or wide mode, windows are tiled and arranged to prevent
|
||||
overlap and maximize screen use. Sets of windows are grouped together on
|
||||
virtual screens, and each screen retains its own layout, which may be
|
||||
reconfigured dynamically. Multiple physical monitors are supported via
|
||||
Xinerama, allowing simultaneous display of a number of screens.
|
||||
|
||||
By utilizing the expressivity of a modern functional language with a rich
|
||||
static type system, _xmonad_ provides a complete, featureful window manager
|
||||
in less than 1200 lines of code, with an emphasis on correctness and
|
||||
robustness. Internal properties of the window manager are checked using a
|
||||
combination of static guarantees provided by the type system, and
|
||||
type-based automated testing. A benefit of this is that the code is simple
|
||||
to understand, and easy to modify.
|
||||
|
||||
# Usage
|
||||
|
||||
_xmonad_ places each window into a "workspace". Each workspace can have
|
||||
any number of windows, which you can cycle though with mod-j and mod-k.
|
||||
Windows are either displayed full screen, tiled horizontally, or tiled
|
||||
vertically. You can toggle the layout mode with mod-space, which will cycle
|
||||
through the available modes.
|
||||
|
||||
You can switch to workspace N with mod-N. For example, to switch to
|
||||
workspace 5, you would press mod-5. Similarly, you can move the current
|
||||
window to another workspace with mod-shift-N.
|
||||
|
||||
When running with multiple monitors (Xinerama), each screen has exactly 1
|
||||
workspace visible. mod-{w,e,r} switch the focus between screens, while
|
||||
shift-mod-{w,e,r} move the current window to that screen. When _xmonad_
|
||||
starts, workspace 1 is on screen 1, workspace 2 is on screen 2, etc. When
|
||||
switching workspaces to one that is already visible, the current and
|
||||
visible workspaces are swapped.
|
||||
|
||||
## Flags
|
||||
|
||||
xmonad has several flags which you may pass to the executable.
|
||||
These flags are:
|
||||
|
||||
--recompile
|
||||
: Recompiles your _xmonad.hs_ configuration
|
||||
|
||||
--restart
|
||||
: Causes the currently running _xmonad_ process to restart
|
||||
|
||||
--replace
|
||||
: Replace the current window manager with xmonad
|
||||
|
||||
--version
|
||||
: Display version of _xmonad_
|
||||
|
||||
--verbose-version
|
||||
: Display detailed version of _xmonad_
|
||||
|
||||
## Default keyboard bindings
|
||||
|
||||
___KEYBINDINGS___
|
||||
|
||||
# Examples
|
||||
|
||||
To use xmonad as your window manager add to your _~/.xinitrc_ file:
|
||||
|
||||
> exec xmonad
|
||||
|
||||
# Customization
|
||||
xmonad is customized in your _xmonad.hs_, and then restarted with mod-q.
|
||||
You can choose where your configuration file lives by
|
||||
|
||||
1. Setting `XMONAD_DATA_DIR,` `XMONAD_CONFIG_DIR`, and
|
||||
`XMONAD_CACHE_DIR`; _xmonad.hs_ is then expected to be in
|
||||
`XMONAD_CONFIG_DIR`.
|
||||
2. Creating _xmonad.hs_ in _~/.xmonad_.
|
||||
3. Creating _xmonad.hs_ in `XDG_CONFIG_HOME`. Note that, in this
|
||||
case, xmonad will use `XDG_DATA_HOME` and `XDG_CACHE_HOME` for its
|
||||
data and cache directory respectively.
|
||||
|
||||
You can find many extensions to the core feature set in the xmonad-
|
||||
contrib package, available through your package manager or from
|
||||
[xmonad.org].
|
||||
|
||||
## Modular Configuration
|
||||
As of _xmonad-0.9_, any additional Haskell modules may be placed in
|
||||
_~/.xmonad/lib/_ are available in GHC's searchpath. Hierarchical modules
|
||||
are supported: for example, the file
|
||||
_~/.xmonad/lib/XMonad/Stack/MyAdditions.hs_ could contain:
|
||||
|
||||
```haskell
|
||||
module XMonad.Stack.MyAdditions (function1) where
|
||||
function1 = error "function1: Not implemented yet!"
|
||||
```
|
||||
|
||||
Your xmonad.hs may then import XMonad.Stack.MyAdditions as if that
|
||||
module was contained within xmonad or xmonad-contrib.
|
||||
|
||||
# Bugs
|
||||
Probably. If you find any, please report them to the [bugtracker]
|
||||
|
||||
[xmonad.org]: https://xmonad.org
|
||||
[bugtracker]: https://github.com/xmonad/xmonad/issues
|
@@ -23,6 +23,10 @@ myTerminal = "xterm"
|
||||
myFocusFollowsMouse :: Bool
|
||||
myFocusFollowsMouse = True
|
||||
|
||||
-- Whether clicking on a window to focus also passes the click to the window
|
||||
myClickJustFocuses :: Bool
|
||||
myClickJustFocuses = False
|
||||
|
||||
-- Width of the window border in pixels.
|
||||
--
|
||||
myBorderWidth = 1
|
||||
@@ -59,7 +63,7 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
|
||||
[ ((modm .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf)
|
||||
|
||||
-- launch dmenu
|
||||
, ((modm, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"")
|
||||
, ((modm, xK_p ), spawn "dmenu_run")
|
||||
|
||||
-- launch gmrun
|
||||
, ((modm .|. shiftMask, xK_p ), spawn "gmrun")
|
||||
@@ -119,10 +123,13 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
|
||||
-- , ((modm , xK_b ), sendMessage ToggleStruts)
|
||||
|
||||
-- Quit xmonad
|
||||
, ((modm .|. shiftMask, xK_q ), io (exitWith ExitSuccess))
|
||||
, ((modm .|. shiftMask, xK_q ), io exitSuccess)
|
||||
|
||||
-- Restart xmonad
|
||||
, ((modm , xK_q ), spawn "xmonad --recompile; xmonad --restart")
|
||||
|
||||
-- Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||
, ((modm .|. shiftMask, xK_slash ), xmessage help)
|
||||
]
|
||||
++
|
||||
|
||||
@@ -147,18 +154,18 @@ myKeys conf@(XConfig {XMonad.modMask = modm}) = M.fromList $
|
||||
------------------------------------------------------------------------
|
||||
-- Mouse bindings: default actions bound to mouse events
|
||||
--
|
||||
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList $
|
||||
myMouseBindings (XConfig {XMonad.modMask = modm}) = M.fromList
|
||||
|
||||
-- mod-button1, Set the window to floating mode and move by dragging
|
||||
[ ((modm, button1), (\w -> focus w >> mouseMoveWindow w
|
||||
>> windows W.shiftMaster))
|
||||
[ ((modm, button1), \w -> focus w >> mouseMoveWindow w
|
||||
>> windows W.shiftMaster)
|
||||
|
||||
-- mod-button2, Raise the window to the top of the stack
|
||||
, ((modm, button2), (\w -> focus w >> windows W.shiftMaster))
|
||||
, ((modm, button2), \w -> focus w >> windows W.shiftMaster)
|
||||
|
||||
-- mod-button3, Set the window to floating mode and resize by dragging
|
||||
, ((modm, button3), (\w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster))
|
||||
, ((modm, button3), \w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster)
|
||||
|
||||
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
||||
]
|
||||
@@ -251,10 +258,11 @@ main = xmonad defaults
|
||||
--
|
||||
-- No need to modify this.
|
||||
--
|
||||
defaults = defaultConfig {
|
||||
defaults = def {
|
||||
-- simple stuff
|
||||
terminal = myTerminal,
|
||||
focusFollowsMouse = myFocusFollowsMouse,
|
||||
clickJustFocuses = myClickJustFocuses,
|
||||
borderWidth = myBorderWidth,
|
||||
modMask = myModMask,
|
||||
workspaces = myWorkspaces,
|
||||
@@ -272,3 +280,55 @@ defaults = defaultConfig {
|
||||
logHook = myLogHook,
|
||||
startupHook = myStartupHook
|
||||
}
|
||||
|
||||
-- | Finally, a copy of the default bindings in simple textual tabular format.
|
||||
help :: String
|
||||
help = unlines ["The default modifier key is 'alt'. Default keybindings:",
|
||||
"",
|
||||
"-- launching and killing programs",
|
||||
"mod-Shift-Enter Launch xterminal",
|
||||
"mod-p Launch dmenu",
|
||||
"mod-Shift-p Launch gmrun",
|
||||
"mod-Shift-c Close/kill the focused window",
|
||||
"mod-Space Rotate through the available layout algorithms",
|
||||
"mod-Shift-Space Reset the layouts on the current workSpace to default",
|
||||
"mod-n Resize/refresh viewed windows to the correct size",
|
||||
"mod-Shift-/ Show this help message with the default keybindings",
|
||||
"",
|
||||
"-- move focus up or down the window stack",
|
||||
"mod-Tab Move focus to the next window",
|
||||
"mod-Shift-Tab Move focus to the previous window",
|
||||
"mod-j Move focus to the next window",
|
||||
"mod-k Move focus to the previous window",
|
||||
"mod-m Move focus to the master window",
|
||||
"",
|
||||
"-- modifying the window order",
|
||||
"mod-Return Swap the focused window and the master window",
|
||||
"mod-Shift-j Swap the focused window with the next window",
|
||||
"mod-Shift-k Swap the focused window with the previous window",
|
||||
"",
|
||||
"-- resizing the master/slave ratio",
|
||||
"mod-h Shrink the master area",
|
||||
"mod-l Expand the master area",
|
||||
"",
|
||||
"-- floating layer support",
|
||||
"mod-t Push window back into tiling; unfloat and re-tile it",
|
||||
"",
|
||||
"-- increase or decrease number of windows in the master area",
|
||||
"mod-comma (mod-,) Increment the number of windows in the master area",
|
||||
"mod-period (mod-.) Deincrement the number of windows in the master area",
|
||||
"",
|
||||
"-- quit, or restart",
|
||||
"mod-Shift-q Quit xmonad",
|
||||
"mod-q Restart xmonad",
|
||||
"mod-[1..9] Switch to workSpace N",
|
||||
"",
|
||||
"-- Workspaces & screens",
|
||||
"mod-Shift-[1..9] Move client to workspace N",
|
||||
"mod-{w,e,r} Switch to physical/Xinerama screens 1, 2, or 3",
|
||||
"mod-Shift-{w,e,r} Move client to screen 1, 2, or 3",
|
||||
"",
|
||||
"-- Mouse bindings: default actions bound to mouse events",
|
||||
"mod-button1 Set the window to floating mode and move by dragging",
|
||||
"mod-button2 Raise the window to the top of the stack",
|
||||
"mod-button3 Set the window to floating mode and resize by dragging"]
|
||||
|
@@ -1,4 +1,6 @@
|
||||
{-# OPTIONS -fno-warn-missing-signatures #-}
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-orphans #-}
|
||||
{-# LANGUAGE TypeFamilies #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Config
|
||||
@@ -13,13 +15,13 @@
|
||||
--
|
||||
-- DO NOT MODIFY THIS FILE! It won't work. You may configure xmonad
|
||||
-- by providing your own @~\/.xmonad\/xmonad.hs@ that overrides
|
||||
-- specific fields in 'defaultConfig'. For a starting point, you can
|
||||
-- specific fields in the default config, 'def'. For a starting point, you can
|
||||
-- copy the @xmonad.hs@ found in the @man@ directory, or look at
|
||||
-- examples on the xmonad wiki.
|
||||
--
|
||||
------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Config (defaultConfig) where
|
||||
module XMonad.Config (defaultConfig, Default(..)) where
|
||||
|
||||
--
|
||||
-- Useful imports
|
||||
@@ -27,17 +29,18 @@ module XMonad.Config (defaultConfig) where
|
||||
import XMonad.Core as XMonad hiding
|
||||
(workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
|
||||
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
|
||||
,handleEventHook)
|
||||
,handleEventHook,clickJustFocuses,rootMask,clientMask)
|
||||
import qualified XMonad.Core as XMonad
|
||||
(workspaces,manageHook,keys,logHook,startupHook,borderWidth,mouseBindings
|
||||
,layoutHook,modMask,terminal,normalBorderColor,focusedBorderColor,focusFollowsMouse
|
||||
,handleEventHook)
|
||||
,handleEventHook,clickJustFocuses,rootMask,clientMask)
|
||||
|
||||
import XMonad.Layout
|
||||
import XMonad.Operations
|
||||
import XMonad.ManageHook
|
||||
import qualified XMonad.StackSet as W
|
||||
import Data.Bits ((.|.))
|
||||
import Data.Default.Class
|
||||
import Data.Monoid
|
||||
import qualified Data.Map as M
|
||||
import System.Exit
|
||||
@@ -90,7 +93,7 @@ focusedBorderColor = "red" -- "#ff0000" don't use hex, not <24 bit safe
|
||||
manageHook :: ManageHook
|
||||
manageHook = composeAll
|
||||
[ className =? "MPlayer" --> doFloat
|
||||
, className =? "Gimp" --> doFloat ]
|
||||
, className =? "mplayer2" --> doFloat ]
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Logging
|
||||
@@ -145,6 +148,19 @@ layout = tiled ||| Mirror tiled ||| Full
|
||||
-- Percent of screen to increment by when resizing panes
|
||||
delta = 3/100
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Event Masks:
|
||||
|
||||
-- | The client events that xmonad is interested in
|
||||
clientMask :: EventMask
|
||||
clientMask = structureNotifyMask .|. enterWindowMask .|. propertyChangeMask
|
||||
|
||||
-- | The root events that xmonad is interested in
|
||||
rootMask :: EventMask
|
||||
rootMask = substructureRedirectMask .|. substructureNotifyMask
|
||||
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
||||
.|. buttonPressMask
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Key bindings:
|
||||
|
||||
@@ -157,6 +173,11 @@ terminal = "xterm"
|
||||
focusFollowsMouse :: Bool
|
||||
focusFollowsMouse = True
|
||||
|
||||
-- | Whether a mouse click select the focus or is just passed to the window
|
||||
clickJustFocuses :: Bool
|
||||
clickJustFocuses = True
|
||||
|
||||
|
||||
-- | The xmonad key bindings. Add, modify or remove key bindings here.
|
||||
--
|
||||
-- (The comment formatting character is used when generating the manpage)
|
||||
@@ -165,7 +186,7 @@ keys :: XConfig Layout -> M.Map (KeyMask, KeySym) (X ())
|
||||
keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
-- launching and killing programs
|
||||
[ ((modMask .|. shiftMask, xK_Return), spawn $ XMonad.terminal conf) -- %! Launch terminal
|
||||
, ((modMask, xK_p ), spawn "exe=`dmenu_path | dmenu` && eval \"exec $exe\"") -- %! Launch dmenu
|
||||
, ((modMask, xK_p ), spawn "dmenu_run") -- %! Launch dmenu
|
||||
, ((modMask .|. shiftMask, xK_p ), spawn "gmrun") -- %! Launch gmrun
|
||||
, ((modMask .|. shiftMask, xK_c ), kill) -- %! Close the focused window
|
||||
|
||||
@@ -197,12 +218,13 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
, ((modMask , xK_comma ), sendMessage (IncMasterN 1)) -- %! Increment the number of windows in the master area
|
||||
, ((modMask , xK_period), sendMessage (IncMasterN (-1))) -- %! Deincrement the number of windows in the master area
|
||||
|
||||
-- toggle the status bar gap
|
||||
--, ((modMask , xK_b ), modifyGap (\i n -> let x = (XMonad.defaultGaps conf ++ repeat (0,0,0,0)) !! i in if n == x then (0,0,0,0) else x)) -- %! Toggle the status bar gap
|
||||
|
||||
-- quit, or restart
|
||||
, ((modMask .|. shiftMask, xK_q ), io (exitWith ExitSuccess)) -- %! Quit xmonad
|
||||
, ((modMask , xK_q ), spawn "xmonad --recompile && xmonad --restart") -- %! Restart xmonad
|
||||
, ((modMask .|. shiftMask, xK_q ), io exitSuccess) -- %! Quit xmonad
|
||||
, ((modMask , xK_q ), spawn "if type xmonad; then xmonad --recompile && xmonad --restart; else xmessage xmonad not in \\$PATH: \"$PATH\"; fi") -- %! Restart xmonad
|
||||
|
||||
, ((modMask .|. shiftMask, xK_slash ), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||
-- repeat the binding for non-American layout keyboards
|
||||
, ((modMask , xK_question), helpCommand) -- %! Run xmessage with a summary of the default keybindings (useful for beginners)
|
||||
]
|
||||
++
|
||||
-- mod-[1..9] %! Switch to workspace N
|
||||
@@ -216,24 +238,26 @@ keys conf@(XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
[((m .|. modMask, key), screenWorkspace sc >>= flip whenJust (windows . f))
|
||||
| (key, sc) <- zip [xK_w, xK_e, xK_r] [0..]
|
||||
, (f, m) <- [(W.view, 0), (W.shift, shiftMask)]]
|
||||
where
|
||||
helpCommand :: X ()
|
||||
helpCommand = xmessage help
|
||||
|
||||
-- | Mouse bindings: default actions bound to mouse events
|
||||
--
|
||||
mouseBindings :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
|
||||
mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList $
|
||||
mouseBindings (XConfig {XMonad.modMask = modMask}) = M.fromList
|
||||
-- mod-button1 %! Set the window to floating mode and move by dragging
|
||||
[ ((modMask, button1), (\w -> focus w >> mouseMoveWindow w
|
||||
>> windows W.shiftMaster))
|
||||
[ ((modMask, button1), \w -> focus w >> mouseMoveWindow w
|
||||
>> windows W.shiftMaster)
|
||||
-- mod-button2 %! Raise the window to the top of the stack
|
||||
, ((modMask, button2), (\w -> focus w >> windows W.shiftMaster))
|
||||
, ((modMask, button2), windows . (W.shiftMaster .) . W.focusWindow)
|
||||
-- mod-button3 %! Set the window to floating mode and resize by dragging
|
||||
, ((modMask, button3), (\w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster))
|
||||
, ((modMask, button3), \w -> focus w >> mouseResizeWindow w
|
||||
>> windows W.shiftMaster)
|
||||
-- you may also bind events to the mouse scroll wheel (button4 and button5)
|
||||
]
|
||||
|
||||
-- | And, finally, the default set of configuration values itself
|
||||
defaultConfig = XConfig
|
||||
instance (a ~ Choose Tall (Choose (Mirror Tall) Full)) => Default (XConfig a) where
|
||||
def = XConfig
|
||||
{ XMonad.borderWidth = borderWidth
|
||||
, XMonad.workspaces = workspaces
|
||||
, XMonad.layoutHook = layout
|
||||
@@ -248,4 +272,68 @@ defaultConfig = XConfig
|
||||
, XMonad.manageHook = manageHook
|
||||
, XMonad.handleEventHook = handleEventHook
|
||||
, XMonad.focusFollowsMouse = focusFollowsMouse
|
||||
}
|
||||
, XMonad.clickJustFocuses = clickJustFocuses
|
||||
, XMonad.clientMask = clientMask
|
||||
, XMonad.rootMask = rootMask
|
||||
, XMonad.handleExtraArgs = \ xs theConf -> case xs of
|
||||
[] -> return theConf
|
||||
_ -> fail ("unrecognized flags:" ++ show xs)
|
||||
, XMonad.extensibleConf = M.empty
|
||||
}
|
||||
|
||||
-- | The default set of configuration values itself
|
||||
{-# DEPRECATED defaultConfig "Use def (from Data.Default, and re-exported by XMonad and XMonad.Config) instead." #-}
|
||||
defaultConfig :: XConfig (Choose Tall (Choose (Mirror Tall) Full))
|
||||
defaultConfig = def
|
||||
|
||||
-- | Finally, a copy of the default bindings in simple textual tabular format.
|
||||
help :: String
|
||||
help = unlines ["The default modifier key is 'alt'. Default keybindings:",
|
||||
"",
|
||||
"-- launching and killing programs",
|
||||
"mod-Shift-Enter Launch xterminal",
|
||||
"mod-p Launch dmenu",
|
||||
"mod-Shift-p Launch gmrun",
|
||||
"mod-Shift-c Close/kill the focused window",
|
||||
"mod-Space Rotate through the available layout algorithms",
|
||||
"mod-Shift-Space Reset the layouts on the current workSpace to default",
|
||||
"mod-n Resize/refresh viewed windows to the correct size",
|
||||
"mod-Shift-/ Show this help message with the default keybindings",
|
||||
"",
|
||||
"-- move focus up or down the window stack",
|
||||
"mod-Tab Move focus to the next window",
|
||||
"mod-Shift-Tab Move focus to the previous window",
|
||||
"mod-j Move focus to the next window",
|
||||
"mod-k Move focus to the previous window",
|
||||
"mod-m Move focus to the master window",
|
||||
"",
|
||||
"-- modifying the window order",
|
||||
"mod-Return Swap the focused window and the master window",
|
||||
"mod-Shift-j Swap the focused window with the next window",
|
||||
"mod-Shift-k Swap the focused window with the previous window",
|
||||
"",
|
||||
"-- resizing the master/slave ratio",
|
||||
"mod-h Shrink the master area",
|
||||
"mod-l Expand the master area",
|
||||
"",
|
||||
"-- floating layer support",
|
||||
"mod-t Push window back into tiling; unfloat and re-tile it",
|
||||
"",
|
||||
"-- increase or decrease number of windows in the master area",
|
||||
"mod-comma (mod-,) Increment the number of windows in the master area",
|
||||
"mod-period (mod-.) Deincrement the number of windows in the master area",
|
||||
"",
|
||||
"-- quit, or restart",
|
||||
"mod-Shift-q Quit xmonad",
|
||||
"mod-q Restart xmonad",
|
||||
"",
|
||||
"-- Workspaces & screens",
|
||||
"mod-[1..9] Switch to workSpace N",
|
||||
"mod-Shift-[1..9] Move client to workspace N",
|
||||
"mod-{w,e,r} Switch to physical/Xinerama screens 1, 2, or 3",
|
||||
"mod-Shift-{w,e,r} Move client to screen 1, 2, or 3",
|
||||
"",
|
||||
"-- Mouse bindings: default actions bound to mouse events",
|
||||
"mod-button1 Set the window to floating mode and move by dragging",
|
||||
"mod-button2 Raise the window to the top of the stack",
|
||||
"mod-button3 Set the window to floating mode and resize by dragging"]
|
896
src/XMonad/Core.hs
Normal file
896
src/XMonad/Core.hs
Normal file
@@ -0,0 +1,896 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE DeriveTraversable #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE NamedFieldPuns #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE DerivingVia #-}
|
||||
{-# LANGUAGE ViewPatterns #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Core
|
||||
-- Copyright : (c) Spencer Janssen 2007
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : spencerjanssen@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, uses cunning newtype deriving
|
||||
--
|
||||
-- The 'X' monad, a state monad transformer over 'IO', for the window
|
||||
-- manager state, and support routines.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Core (
|
||||
X, WindowSet, WindowSpace, WorkspaceId,
|
||||
ScreenId(..), ScreenDetail(..), XState(..),
|
||||
XConf(..), XConfig(..), LayoutClass(..),
|
||||
Layout(..), readsLayout, Typeable, Message,
|
||||
SomeMessage(..), fromMessage, LayoutMessages(..),
|
||||
StateExtension(..), ExtensionClass(..), ConfExtension(..),
|
||||
runX, catchX, userCode, userCodeDef, io, catchIO, installSignalHandlers, uninstallSignalHandlers,
|
||||
withDisplay, withWindowSet, isRoot, runOnWorkspaces,
|
||||
getAtom, spawn, spawnPID, xfork, xmessage, recompile, trace, whenJust, whenX, ifM,
|
||||
getXMonadDir, getXMonadCacheDir, getXMonadDataDir, stateFileName, binFileName,
|
||||
atom_WM_STATE, atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_TAKE_FOCUS, withWindowAttributes,
|
||||
ManageHook, Query(..), runQuery, Directories'(..), Directories, getDirectories,
|
||||
) where
|
||||
|
||||
import XMonad.StackSet hiding (modify)
|
||||
|
||||
import Prelude
|
||||
import Control.Exception (fromException, try, bracket_, throw, finally, SomeException(..))
|
||||
import qualified Control.Exception as E
|
||||
import Control.Applicative ((<|>), empty)
|
||||
import Control.Monad.Fail
|
||||
import Control.Monad.Fix (fix)
|
||||
import Control.Monad.State
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad (filterM, guard, void, when)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Semigroup
|
||||
import Data.Traversable (for)
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Default.Class
|
||||
import System.Environment (lookupEnv)
|
||||
import Data.List (isInfixOf, intercalate, (\\))
|
||||
import System.FilePath
|
||||
import System.IO
|
||||
import System.Info
|
||||
import System.Posix.Env (getEnv)
|
||||
import System.Posix.Process (executeFile, forkProcess, getAnyProcessStatus, createSession)
|
||||
import System.Posix.Signals
|
||||
import System.Posix.IO
|
||||
import System.Posix.Types (ProcessID)
|
||||
import System.Process
|
||||
import System.Directory
|
||||
import System.Exit
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xlib.Extras (getWindowAttributes, WindowAttributes, Event)
|
||||
import Data.Typeable
|
||||
import Data.Maybe (isJust,fromMaybe)
|
||||
import Data.Monoid (Ap(..))
|
||||
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
-- | XState, the (mutable) window manager state.
|
||||
data XState = XState
|
||||
{ windowset :: !WindowSet -- ^ workspace list
|
||||
, mapped :: !(S.Set Window) -- ^ the Set of mapped windows
|
||||
, waitingUnmap :: !(M.Map Window Int) -- ^ the number of expected UnmapEvents
|
||||
, dragging :: !(Maybe (Position -> Position -> X (), X ()))
|
||||
, numberlockMask :: !KeyMask -- ^ The numlock modifier
|
||||
, extensibleState :: !(M.Map String (Either String StateExtension))
|
||||
-- ^ stores custom state information.
|
||||
--
|
||||
-- The module "XMonad.Util.ExtensibleState" in xmonad-contrib
|
||||
-- provides additional information and a simple interface for using this.
|
||||
}
|
||||
|
||||
-- | XConf, the (read-only) window manager configuration.
|
||||
data XConf = XConf
|
||||
{ display :: Display -- ^ the X11 display
|
||||
, config :: !(XConfig Layout) -- ^ initial user configuration
|
||||
, theRoot :: !Window -- ^ the root window
|
||||
, normalBorder :: !Pixel -- ^ border color of unfocused windows
|
||||
, focusedBorder :: !Pixel -- ^ border color of the focused window
|
||||
, keyActions :: !(M.Map (KeyMask, KeySym) (X ()))
|
||||
-- ^ a mapping of key presses to actions
|
||||
, buttonActions :: !(M.Map (KeyMask, Button) (Window -> X ()))
|
||||
-- ^ a mapping of button presses to actions
|
||||
, mouseFocused :: !Bool -- ^ was refocus caused by mouse action?
|
||||
, mousePosition :: !(Maybe (Position, Position))
|
||||
-- ^ position of the mouse according to
|
||||
-- the event currently being processed
|
||||
, currentEvent :: !(Maybe Event) -- ^ event currently being processed
|
||||
, directories :: !Directories -- ^ directories to use
|
||||
}
|
||||
|
||||
-- todo, better name
|
||||
data XConfig l = XConfig
|
||||
{ normalBorderColor :: !String -- ^ Non focused windows border color. Default: \"#dddddd\"
|
||||
, focusedBorderColor :: !String -- ^ Focused windows border color. Default: \"#ff0000\"
|
||||
, terminal :: !String -- ^ The preferred terminal application. Default: \"xterm\"
|
||||
, layoutHook :: !(l Window) -- ^ The available layouts
|
||||
, manageHook :: !ManageHook -- ^ The action to run when a new window is opened
|
||||
, handleEventHook :: !(Event -> X All) -- ^ Handle an X event, returns (All True) if the default handler
|
||||
-- should also be run afterwards. mappend should be used for combining
|
||||
-- event hooks in most cases.
|
||||
, workspaces :: ![String] -- ^ The list of workspaces' names
|
||||
, modMask :: !KeyMask -- ^ the mod modifier
|
||||
, keys :: !(XConfig Layout -> M.Map (ButtonMask,KeySym) (X ()))
|
||||
-- ^ The key binding: a map from key presses and actions
|
||||
, mouseBindings :: !(XConfig Layout -> M.Map (ButtonMask, Button) (Window -> X ()))
|
||||
-- ^ The mouse bindings
|
||||
, borderWidth :: !Dimension -- ^ The border width
|
||||
, logHook :: !(X ()) -- ^ The action to perform when the windows set is changed
|
||||
, startupHook :: !(X ()) -- ^ The action to perform on startup
|
||||
, focusFollowsMouse :: !Bool -- ^ Whether window entry events can change focus
|
||||
, clickJustFocuses :: !Bool -- ^ False to make a click which changes focus to be additionally passed to the window
|
||||
, clientMask :: !EventMask -- ^ The client events that xmonad is interested in
|
||||
, rootMask :: !EventMask -- ^ The root events that xmonad is interested in
|
||||
, handleExtraArgs :: !([String] -> XConfig Layout -> IO (XConfig Layout))
|
||||
-- ^ Modify the configuration, complain about extra arguments etc. with arguments that are not handled by default
|
||||
, extensibleConf :: !(M.Map TypeRep ConfExtension)
|
||||
-- ^ Stores custom config information.
|
||||
--
|
||||
-- The module "XMonad.Util.ExtensibleConf" in xmonad-contrib
|
||||
-- provides additional information and a simple interface for using this.
|
||||
}
|
||||
|
||||
|
||||
type WindowSet = StackSet WorkspaceId (Layout Window) Window ScreenId ScreenDetail
|
||||
type WindowSpace = Workspace WorkspaceId (Layout Window) Window
|
||||
|
||||
-- | Virtual workspace indices
|
||||
type WorkspaceId = String
|
||||
|
||||
-- | Physical screen indices
|
||||
newtype ScreenId = S Int deriving (Eq,Ord,Show,Read,Enum,Num,Integral,Real)
|
||||
|
||||
-- | The 'Rectangle' with screen dimensions
|
||||
newtype ScreenDetail = SD { screenRect :: Rectangle }
|
||||
deriving (Eq,Show, Read)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | The X monad, 'ReaderT' and 'StateT' transformers over 'IO'
|
||||
-- encapsulating the window manager configuration and state,
|
||||
-- respectively.
|
||||
--
|
||||
-- Dynamic components may be retrieved with 'get', static components
|
||||
-- with 'ask'. With newtype deriving we get readers and state monads
|
||||
-- instantiated on 'XConf' and 'XState' automatically.
|
||||
--
|
||||
newtype X a = X (ReaderT XConf (StateT XState IO) a)
|
||||
deriving (Functor, Applicative, Monad, MonadFail, MonadIO, MonadState XState, MonadReader XConf)
|
||||
deriving (Semigroup, Monoid) via Ap X a
|
||||
|
||||
instance Default a => Default (X a) where
|
||||
def = return def
|
||||
|
||||
type ManageHook = Query (Endo WindowSet)
|
||||
newtype Query a = Query (ReaderT Window X a)
|
||||
deriving (Functor, Applicative, Monad, MonadReader Window, MonadIO)
|
||||
deriving (Semigroup, Monoid) via Ap Query a
|
||||
|
||||
runQuery :: Query a -> Window -> X a
|
||||
runQuery (Query m) = runReaderT m
|
||||
|
||||
instance Default a => Default (Query a) where
|
||||
def = return def
|
||||
|
||||
-- | Run the 'X' monad, given a chunk of 'X' monad code, and an initial state
|
||||
-- Return the result, and final state
|
||||
runX :: XConf -> XState -> X a -> IO (a, XState)
|
||||
runX c st (X a) = runStateT (runReaderT a c) st
|
||||
|
||||
-- | Run in the 'X' monad, and in case of exception, and catch it and log it
|
||||
-- to stderr, and run the error case.
|
||||
catchX :: X a -> X a -> X a
|
||||
catchX job errcase = do
|
||||
st <- get
|
||||
c <- ask
|
||||
(a, s') <- io $ runX c st job `E.catch` \e -> case fromException e of
|
||||
Just (_ :: ExitCode) -> throw e
|
||||
_ -> do hPrint stderr e; runX c st errcase
|
||||
put s'
|
||||
return a
|
||||
|
||||
-- | Execute the argument, catching all exceptions. Either this function or
|
||||
-- 'catchX' should be used at all callsites of user customized code.
|
||||
userCode :: X a -> X (Maybe a)
|
||||
userCode a = catchX (Just <$> a) (return Nothing)
|
||||
|
||||
-- | Same as userCode but with a default argument to return instead of using
|
||||
-- Maybe, provided for convenience.
|
||||
userCodeDef :: a -> X a -> X a
|
||||
userCodeDef defValue a = fromMaybe defValue <$> userCode a
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Convenient wrappers to state
|
||||
|
||||
-- | Run a monad action with the current display settings
|
||||
withDisplay :: (Display -> X a) -> X a
|
||||
withDisplay f = asks display >>= f
|
||||
|
||||
-- | Run a monadic action with the current stack set
|
||||
withWindowSet :: (WindowSet -> X a) -> X a
|
||||
withWindowSet f = gets windowset >>= f
|
||||
|
||||
-- | Safely access window attributes.
|
||||
withWindowAttributes :: Display -> Window -> (WindowAttributes -> X ()) -> X ()
|
||||
withWindowAttributes dpy win f = do
|
||||
wa <- userCode (io $ getWindowAttributes dpy win)
|
||||
catchX (whenJust wa f) (return ())
|
||||
|
||||
-- | True if the given window is the root window
|
||||
isRoot :: Window -> X Bool
|
||||
isRoot w = asks $ (w ==) . theRoot
|
||||
|
||||
-- | Wrapper for the common case of atom internment
|
||||
getAtom :: String -> X Atom
|
||||
getAtom str = withDisplay $ \dpy -> io $ internAtom dpy str False
|
||||
|
||||
-- | Common non-predefined atoms
|
||||
atom_WM_PROTOCOLS, atom_WM_DELETE_WINDOW, atom_WM_STATE, atom_WM_TAKE_FOCUS :: X Atom
|
||||
atom_WM_PROTOCOLS = getAtom "WM_PROTOCOLS"
|
||||
atom_WM_DELETE_WINDOW = getAtom "WM_DELETE_WINDOW"
|
||||
atom_WM_STATE = getAtom "WM_STATE"
|
||||
atom_WM_TAKE_FOCUS = getAtom "WM_TAKE_FOCUS"
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- LayoutClass handling. See particular instances in Operations.hs
|
||||
|
||||
-- | An existential type that can hold any object that is in 'Read'
|
||||
-- and 'LayoutClass'.
|
||||
data Layout a = forall l. (LayoutClass l a, Read (l a)) => Layout (l a)
|
||||
|
||||
-- | Using the 'Layout' as a witness, parse existentially wrapped windows
|
||||
-- from a 'String'.
|
||||
readsLayout :: Layout a -> String -> [(Layout a, String)]
|
||||
readsLayout (Layout l) s = [(Layout (asTypeOf x l), rs) | (x, rs) <- reads s]
|
||||
|
||||
-- | Every layout must be an instance of 'LayoutClass', which defines
|
||||
-- the basic layout operations along with a sensible default for each.
|
||||
--
|
||||
-- All of the methods have default implementations, so there is no
|
||||
-- minimal complete definition. They do, however, have a dependency
|
||||
-- structure by default; this is something to be aware of should you
|
||||
-- choose to implement one of these methods. Here is how a minimal
|
||||
-- complete definition would look like if we did not provide any default
|
||||
-- implementations:
|
||||
--
|
||||
-- * 'runLayout' || (('doLayout' || 'pureLayout') && 'emptyLayout')
|
||||
--
|
||||
-- * 'handleMessage' || 'pureMessage'
|
||||
--
|
||||
-- * 'description'
|
||||
--
|
||||
-- Note that any code which /uses/ 'LayoutClass' methods should only
|
||||
-- ever call 'runLayout', 'handleMessage', and 'description'! In
|
||||
-- other words, the only calls to 'doLayout', 'pureMessage', and other
|
||||
-- such methods should be from the default implementations of
|
||||
-- 'runLayout', 'handleMessage', and so on. This ensures that the
|
||||
-- proper methods will be used, regardless of the particular methods
|
||||
-- that any 'LayoutClass' instance chooses to define.
|
||||
class (Show (layout a), Typeable layout) => LayoutClass layout a where
|
||||
|
||||
-- | By default, 'runLayout' calls 'doLayout' if there are any
|
||||
-- windows to be laid out, and 'emptyLayout' otherwise. Most
|
||||
-- instances of 'LayoutClass' probably do not need to implement
|
||||
-- 'runLayout'; it is only useful for layouts which wish to make
|
||||
-- use of more of the 'Workspace' information (for example,
|
||||
-- "XMonad.Layout.PerWorkspace").
|
||||
runLayout :: Workspace WorkspaceId (layout a) a
|
||||
-> Rectangle
|
||||
-> X ([(a, Rectangle)], Maybe (layout a))
|
||||
runLayout (Workspace _ l ms) r = maybe (emptyLayout l r) (doLayout l r) ms
|
||||
|
||||
-- | Given a 'Rectangle' in which to place the windows, and a 'Stack'
|
||||
-- of windows, return a list of windows and their corresponding
|
||||
-- Rectangles. If an element is not given a Rectangle by
|
||||
-- 'doLayout', then it is not shown on screen. The order of
|
||||
-- windows in this list should be the desired stacking order.
|
||||
--
|
||||
-- Also possibly return a modified layout (by returning @Just
|
||||
-- newLayout@), if this layout needs to be modified (e.g. if it
|
||||
-- keeps track of some sort of state). Return @Nothing@ if the
|
||||
-- layout does not need to be modified.
|
||||
--
|
||||
-- Layouts which do not need access to the 'X' monad ('IO', window
|
||||
-- manager state, or configuration) and do not keep track of their
|
||||
-- own state should implement 'pureLayout' instead of 'doLayout'.
|
||||
doLayout :: layout a -> Rectangle -> Stack a
|
||||
-> X ([(a, Rectangle)], Maybe (layout a))
|
||||
doLayout l r s = return (pureLayout l r s, Nothing)
|
||||
|
||||
-- | This is a pure version of 'doLayout', for cases where we
|
||||
-- don't need access to the 'X' monad to determine how to lay out
|
||||
-- the windows, and we don't need to modify the layout itself.
|
||||
pureLayout :: layout a -> Rectangle -> Stack a -> [(a, Rectangle)]
|
||||
pureLayout _ r s = [(focus s, r)]
|
||||
|
||||
-- | 'emptyLayout' is called when there are no windows.
|
||||
emptyLayout :: layout a -> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
|
||||
emptyLayout _ _ = return ([], Nothing)
|
||||
|
||||
-- | 'handleMessage' performs message handling. If
|
||||
-- 'handleMessage' returns @Nothing@, then the layout did not
|
||||
-- respond to the message and the screen is not refreshed.
|
||||
-- Otherwise, 'handleMessage' returns an updated layout and the
|
||||
-- screen is refreshed.
|
||||
--
|
||||
-- Layouts which do not need access to the 'X' monad to decide how
|
||||
-- to handle messages should implement 'pureMessage' instead of
|
||||
-- 'handleMessage' (this restricts the risk of error, and makes
|
||||
-- testing much easier).
|
||||
handleMessage :: layout a -> SomeMessage -> X (Maybe (layout a))
|
||||
handleMessage l = return . pureMessage l
|
||||
|
||||
-- | Respond to a message by (possibly) changing our layout, but
|
||||
-- taking no other action. If the layout changes, the screen will
|
||||
-- be refreshed.
|
||||
pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
|
||||
pureMessage _ _ = Nothing
|
||||
|
||||
-- | This should be a human-readable string that is used when
|
||||
-- selecting layouts by name. The default implementation is
|
||||
-- 'show', which is in some cases a poor default.
|
||||
description :: layout a -> String
|
||||
description = show
|
||||
|
||||
instance LayoutClass Layout Window where
|
||||
runLayout (Workspace i (Layout l) ms) r = fmap (fmap Layout) `fmap` runLayout (Workspace i l ms) r
|
||||
doLayout (Layout l) r s = fmap (fmap Layout) `fmap` doLayout l r s
|
||||
emptyLayout (Layout l) r = fmap (fmap Layout) `fmap` emptyLayout l r
|
||||
handleMessage (Layout l) = fmap (fmap Layout) . handleMessage l
|
||||
description (Layout l) = description l
|
||||
|
||||
instance Show (Layout a) where show (Layout l) = show l
|
||||
|
||||
-- | Based on ideas in /An Extensible Dynamically-Typed Hierarchy of
|
||||
-- Exceptions/, Simon Marlow, 2006. Use extensible messages to the
|
||||
-- 'handleMessage' handler.
|
||||
--
|
||||
-- User-extensible messages must be a member of this class.
|
||||
--
|
||||
class Typeable a => Message a
|
||||
|
||||
-- |
|
||||
-- A wrapped value of some type in the 'Message' class.
|
||||
--
|
||||
data SomeMessage = forall a. Message a => SomeMessage a
|
||||
|
||||
-- |
|
||||
-- And now, unwrap a given, unknown 'Message' type, performing a (dynamic)
|
||||
-- type check on the result.
|
||||
--
|
||||
fromMessage :: Message m => SomeMessage -> Maybe m
|
||||
fromMessage (SomeMessage m) = cast m
|
||||
|
||||
-- X Events are valid Messages.
|
||||
instance Message Event
|
||||
|
||||
-- | 'LayoutMessages' are core messages that all layouts (especially stateful
|
||||
-- layouts) should consider handling.
|
||||
data LayoutMessages = Hide -- ^ sent when a layout becomes non-visible
|
||||
| ReleaseResources -- ^ sent when xmonad is exiting or restarting
|
||||
deriving Eq
|
||||
|
||||
instance Message LayoutMessages
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Extensible state/config
|
||||
--
|
||||
|
||||
-- | Every module must make the data it wants to store
|
||||
-- an instance of this class.
|
||||
--
|
||||
-- Minimal complete definition: initialValue
|
||||
class Typeable a => ExtensionClass a where
|
||||
{-# MINIMAL initialValue #-}
|
||||
-- | Defines an initial value for the state extension
|
||||
initialValue :: a
|
||||
-- | Specifies whether the state extension should be
|
||||
-- persistent. Setting this method to 'PersistentExtension'
|
||||
-- will make the stored data survive restarts, but
|
||||
-- requires a to be an instance of Read and Show.
|
||||
--
|
||||
-- It defaults to 'StateExtension', i.e. no persistence.
|
||||
extensionType :: a -> StateExtension
|
||||
extensionType = StateExtension
|
||||
|
||||
-- | Existential type to store a state extension.
|
||||
data StateExtension =
|
||||
forall a. ExtensionClass a => StateExtension a
|
||||
-- ^ Non-persistent state extension
|
||||
| forall a. (Read a, Show a, ExtensionClass a) => PersistentExtension a
|
||||
-- ^ Persistent extension
|
||||
|
||||
-- | Existential type to store a config extension.
|
||||
data ConfExtension = forall a. Typeable a => ConfExtension a
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- General utilities
|
||||
|
||||
-- | If-then-else lifted to a 'Monad'.
|
||||
ifM :: Monad m => m Bool -> m a -> m a -> m a
|
||||
ifM mb t f = mb >>= \b -> if b then t else f
|
||||
|
||||
-- | Lift an 'IO' action into the 'X' monad
|
||||
io :: MonadIO m => IO a -> m a
|
||||
io = liftIO
|
||||
|
||||
-- | Lift an 'IO' action into the 'X' monad. If the action results in an 'IO'
|
||||
-- exception, log the exception to stderr and continue normal execution.
|
||||
catchIO :: MonadIO m => IO () -> m ()
|
||||
catchIO f = io (f `E.catch` \(SomeException e) -> hPrint stderr e >> hFlush stderr)
|
||||
|
||||
-- | spawn. Launch an external application. Specifically, it double-forks and
|
||||
-- runs the 'String' you pass as a command to \/bin\/sh.
|
||||
--
|
||||
-- Note this function assumes your locale uses utf8.
|
||||
spawn :: MonadIO m => String -> m ()
|
||||
spawn x = void $ spawnPID x
|
||||
|
||||
-- | Like 'spawn', but returns the 'ProcessID' of the launched application
|
||||
spawnPID :: MonadIO m => String -> m ProcessID
|
||||
spawnPID x = xfork $ executeFile "/bin/sh" False ["-c", x] Nothing
|
||||
|
||||
-- | A replacement for 'forkProcess' which resets default signal handlers.
|
||||
xfork :: MonadIO m => IO () -> m ProcessID
|
||||
xfork x = io . forkProcess . finally nullStdin $ do
|
||||
uninstallSignalHandlers
|
||||
createSession
|
||||
x
|
||||
where
|
||||
nullStdin = do
|
||||
#if MIN_VERSION_unix(2,8,0)
|
||||
fd <- openFd "/dev/null" ReadOnly defaultFileFlags
|
||||
#else
|
||||
fd <- openFd "/dev/null" ReadOnly Nothing defaultFileFlags
|
||||
#endif
|
||||
dupTo fd stdInput
|
||||
closeFd fd
|
||||
|
||||
-- | Use @xmessage@ to show information to the user.
|
||||
xmessage :: MonadIO m => String -> m ()
|
||||
xmessage msg = void . xfork $ do
|
||||
xmessageBin <- fromMaybe "xmessage" <$> liftIO (lookupEnv "XMONAD_XMESSAGE")
|
||||
executeFile xmessageBin True
|
||||
[ "-default", "okay"
|
||||
, "-xrm", "*international:true"
|
||||
, "-xrm", "*fontSet:-*-fixed-medium-r-normal-*-18-*-*-*-*-*-*-*,-*-fixed-*-*-*-*-18-*-*-*-*-*-*-*,-*-*-*-*-*-*-18-*-*-*-*-*-*-*"
|
||||
, msg
|
||||
] Nothing
|
||||
|
||||
-- | This is basically a map function, running a function in the 'X' monad on
|
||||
-- each workspace with the output of that function being the modified workspace.
|
||||
runOnWorkspaces :: (WindowSpace -> X WindowSpace) -> X ()
|
||||
runOnWorkspaces job = do
|
||||
ws <- gets windowset
|
||||
h <- mapM job $ hidden ws
|
||||
c:v <- mapM (\s -> (\w -> s { workspace = w}) <$> job (workspace s))
|
||||
$ current ws : visible ws
|
||||
modify $ \s -> s { windowset = ws { current = c, visible = v, hidden = h } }
|
||||
|
||||
-- | All the directories that xmonad will use. They will be used for
|
||||
-- the following purposes:
|
||||
--
|
||||
-- * @dataDir@: This directory is used by XMonad to store data files
|
||||
-- such as the run-time state file.
|
||||
--
|
||||
-- * @cfgDir@: This directory is where user configuration files are
|
||||
-- stored (e.g, the xmonad.hs file). You may also create a @lib@
|
||||
-- subdirectory in the configuration directory and the default recompile
|
||||
-- command will add it to the GHC include path.
|
||||
--
|
||||
-- * @cacheDir@: This directory is used to store temporary files that
|
||||
-- can easily be recreated such as the configuration binary and any
|
||||
-- intermediate object files generated by GHC.
|
||||
-- Also, the XPrompt history file goes here.
|
||||
--
|
||||
-- For how these directories are chosen, see 'getDirectories'.
|
||||
--
|
||||
data Directories' a = Directories
|
||||
{ dataDir :: !a
|
||||
, cfgDir :: !a
|
||||
, cacheDir :: !a
|
||||
}
|
||||
deriving (Show, Functor, Foldable, Traversable)
|
||||
|
||||
-- | Convenient type alias for the most common case in which one might
|
||||
-- want to use the 'Directories' type.
|
||||
type Directories = Directories' FilePath
|
||||
|
||||
-- | Build up the 'Dirs' that xmonad will use. They are chosen as
|
||||
-- follows:
|
||||
--
|
||||
-- 1. If all three of xmonad's environment variables (@XMONAD_DATA_DIR@,
|
||||
-- @XMONAD_CONFIG_DIR@, and @XMONAD_CACHE_DIR@) are set, use them.
|
||||
-- 2. If there is a build script called @build@ or configuration
|
||||
-- @xmonad.hs@ in @~\/.xmonad@, set all three directories to
|
||||
-- @~\/.xmonad@.
|
||||
-- 3. Otherwise, use the @xmonad@ directory in @XDG_DATA_HOME@,
|
||||
-- @XDG_CONFIG_HOME@, and @XDG_CACHE_HOME@ (or their respective
|
||||
-- fallbacks). These directories are created if necessary.
|
||||
--
|
||||
-- The xmonad configuration file (or the build script, if present) is
|
||||
-- always assumed to be in @cfgDir@.
|
||||
--
|
||||
getDirectories :: IO Directories
|
||||
getDirectories = xmEnvDirs <|> xmDirs <|> xdgDirs
|
||||
where
|
||||
-- | Check for xmonad's environment variables first
|
||||
xmEnvDirs :: IO Directories
|
||||
xmEnvDirs = do
|
||||
let xmEnvs = Directories{ dataDir = "XMONAD_DATA_DIR"
|
||||
, cfgDir = "XMONAD_CONFIG_DIR"
|
||||
, cacheDir = "XMONAD_CACHE_DIR"
|
||||
}
|
||||
maybe empty pure . sequenceA =<< traverse getEnv xmEnvs
|
||||
|
||||
-- | Check whether the config file or a build script is in the
|
||||
-- @~\/.xmonad@ directory
|
||||
xmDirs :: IO Directories
|
||||
xmDirs = do
|
||||
xmDir <- getAppUserDataDirectory "xmonad"
|
||||
conf <- doesFileExist $ xmDir </> "xmonad.hs"
|
||||
build <- doesFileExist $ xmDir </> "build"
|
||||
|
||||
-- Place *everything* in ~/.xmonad if yes
|
||||
guard $ conf || build
|
||||
pure Directories{ dataDir = xmDir, cfgDir = xmDir, cacheDir = xmDir }
|
||||
|
||||
-- | Use XDG directories as a fallback
|
||||
xdgDirs :: IO Directories
|
||||
xdgDirs =
|
||||
for Directories{ dataDir = XdgData, cfgDir = XdgConfig, cacheDir = XdgCache }
|
||||
$ \dir -> do d <- getXdgDirectory dir "xmonad"
|
||||
d <$ createDirectoryIfMissing True d
|
||||
|
||||
-- | Return the path to the xmonad configuration directory.
|
||||
getXMonadDir :: X String
|
||||
getXMonadDir = asks (cfgDir . directories)
|
||||
{-# DEPRECATED getXMonadDir "Use `asks (cfgDir . directories)' instead." #-}
|
||||
|
||||
-- | Return the path to the xmonad cache directory.
|
||||
getXMonadCacheDir :: X String
|
||||
getXMonadCacheDir = asks (cacheDir . directories)
|
||||
{-# DEPRECATED getXMonadCacheDir "Use `asks (cacheDir . directories)' instead." #-}
|
||||
|
||||
-- | Return the path to the xmonad data directory.
|
||||
getXMonadDataDir :: X String
|
||||
getXMonadDataDir = asks (dataDir . directories)
|
||||
{-# DEPRECATED getXMonadDataDir "Use `asks (dataDir . directories)' instead." #-}
|
||||
|
||||
binFileName, buildDirName :: Directories -> FilePath
|
||||
binFileName Directories{ cacheDir } = cacheDir </> "xmonad-" <> arch <> "-" <> os
|
||||
buildDirName Directories{ cacheDir } = cacheDir </> "build-" <> arch <> "-" <> os
|
||||
|
||||
errFileName, stateFileName :: Directories -> FilePath
|
||||
errFileName Directories{ dataDir } = dataDir </> "xmonad.errors"
|
||||
stateFileName Directories{ dataDir } = dataDir </> "xmonad.state"
|
||||
|
||||
srcFileName, libFileName :: Directories -> FilePath
|
||||
srcFileName Directories{ cfgDir } = cfgDir </> "xmonad.hs"
|
||||
libFileName Directories{ cfgDir } = cfgDir </> "lib"
|
||||
|
||||
buildScriptFileName, stackYamlFileName, nixFlakeFileName, nixDefaultFileName :: Directories -> FilePath
|
||||
buildScriptFileName Directories{ cfgDir } = cfgDir </> "build"
|
||||
stackYamlFileName Directories{ cfgDir } = cfgDir </> "stack.yaml"
|
||||
nixFlakeFileName Directories{ cfgDir } = cfgDir </> "flake.nix"
|
||||
nixDefaultFileName Directories{ cfgDir } = cfgDir </> "default.nix"
|
||||
|
||||
-- | Compilation method for xmonad configuration.
|
||||
data Compile
|
||||
= CompileGhc
|
||||
| CompileCabal
|
||||
| CompileStackGhc FilePath
|
||||
| CompileNixFlake
|
||||
| CompileNixDefault
|
||||
| CompileScript FilePath
|
||||
deriving (Show)
|
||||
|
||||
-- | Detect compilation method by looking for known file names in xmonad
|
||||
-- configuration directory.
|
||||
detectCompile :: Directories -> IO Compile
|
||||
detectCompile dirs =
|
||||
tryScript <|> tryStack <|> tryNixFlake <|> tryNixDefault <|> tryCabal <|> useGhc
|
||||
where
|
||||
buildScript = buildScriptFileName dirs
|
||||
stackYaml = stackYamlFileName dirs
|
||||
flakeNix = nixFlakeFileName dirs
|
||||
defaultNix = nixDefaultFileName dirs
|
||||
|
||||
tryScript = do
|
||||
guard =<< doesFileExist buildScript
|
||||
isExe <- isExecutable buildScript
|
||||
if isExe
|
||||
then do
|
||||
trace $ "XMonad will use build script at " <> show buildScript <> " to recompile."
|
||||
pure $ CompileScript buildScript
|
||||
else do
|
||||
trace $ "XMonad will not use build script, because " <> show buildScript <> " is not executable."
|
||||
trace $ "Suggested resolution to use it: chmod u+x " <> show buildScript
|
||||
empty
|
||||
|
||||
tryNixFlake = do
|
||||
guard =<< doesFileExist flakeNix
|
||||
canonNixFlake <- canonicalizePath flakeNix
|
||||
trace $ "XMonad will use nix flake at " <> show canonNixFlake <> " to recompile"
|
||||
pure CompileNixFlake
|
||||
|
||||
tryNixDefault = do
|
||||
guard =<< doesFileExist defaultNix
|
||||
canonNixDefault <- canonicalizePath defaultNix
|
||||
trace $ "XMonad will use nix file at " <> show canonNixDefault <> " to recompile"
|
||||
pure CompileNixDefault
|
||||
|
||||
tryStack = do
|
||||
guard =<< doesFileExist stackYaml
|
||||
canonStackYaml <- canonicalizePath stackYaml
|
||||
trace $ "XMonad will use stack ghc --stack-yaml " <> show canonStackYaml <> " to recompile."
|
||||
pure $ CompileStackGhc canonStackYaml
|
||||
|
||||
tryCabal = let cwd = cfgDir dirs in listCabalFiles cwd >>= \ case
|
||||
[] -> do
|
||||
empty
|
||||
[name] -> do
|
||||
trace $ "XMonad will use " <> show name <> " to recompile."
|
||||
pure CompileCabal
|
||||
_ : _ : _ -> do
|
||||
trace $ "XMonad will not use cabal, because there are multiple cabal files in " <> show cwd <> "."
|
||||
empty
|
||||
|
||||
useGhc = do
|
||||
trace $ "XMonad will use ghc to recompile, because none of "
|
||||
<> intercalate ", "
|
||||
[ show buildScript
|
||||
, show stackYaml
|
||||
, show flakeNix
|
||||
, show defaultNix
|
||||
] <> " nor a suitable .cabal file exist."
|
||||
pure CompileGhc
|
||||
|
||||
listCabalFiles :: FilePath -> IO [FilePath]
|
||||
listCabalFiles dir = map (dir </>) . Prelude.filter isCabalFile <$> listFiles dir
|
||||
|
||||
isCabalFile :: FilePath -> Bool
|
||||
isCabalFile file = case splitExtension file of
|
||||
(name, ".cabal") -> not (null name)
|
||||
_ -> False
|
||||
|
||||
listFiles :: FilePath -> IO [FilePath]
|
||||
listFiles dir = getDirectoryContents dir >>= filterM (doesFileExist . (dir </>))
|
||||
|
||||
-- | Determine whether or not the file found at the provided filepath is executable.
|
||||
isExecutable :: FilePath -> IO Bool
|
||||
isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False)
|
||||
|
||||
-- | Should we recompile xmonad configuration? Is it newer than the compiled
|
||||
-- binary?
|
||||
shouldCompile :: Directories -> Compile -> IO Bool
|
||||
shouldCompile dirs CompileGhc = do
|
||||
libTs <- mapM getModTime . Prelude.filter isSource =<< allFiles (libFileName dirs)
|
||||
srcT <- getModTime (srcFileName dirs)
|
||||
binT <- getModTime (binFileName dirs)
|
||||
if any (binT <) (srcT : libTs)
|
||||
then True <$ trace "XMonad recompiling because some files have changed."
|
||||
else False <$ trace "XMonad skipping recompile because it is not forced (e.g. via --recompile), and neither xmonad.hs nor any *.hs / *.lhs / *.hsc files in lib/ have been changed."
|
||||
where
|
||||
isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension
|
||||
allFiles t = do
|
||||
let prep = map (t</>) . Prelude.filter (`notElem` [".",".."])
|
||||
cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return [])
|
||||
ds <- filterM doesDirectoryExist cs
|
||||
concat . ((cs \\ ds):) <$> mapM allFiles ds
|
||||
shouldCompile _ CompileCabal = return True
|
||||
shouldCompile dirs CompileStackGhc{} = do
|
||||
stackYamlT <- getModTime (stackYamlFileName dirs)
|
||||
binT <- getModTime (binFileName dirs)
|
||||
if binT < stackYamlT
|
||||
then True <$ trace "XMonad recompiling because some files have changed."
|
||||
else shouldCompile dirs CompileGhc
|
||||
shouldCompile _dirs CompileNixFlake{} = True <$ trace "XMonad recompiling because flake recompilation is being used."
|
||||
shouldCompile _dirs CompileNixDefault{} = True <$ trace "XMonad recompiling because nix recompilation is being used."
|
||||
shouldCompile _dirs CompileScript{} =
|
||||
True <$ trace "XMonad recompiling because a custom build script is being used."
|
||||
|
||||
getModTime :: FilePath -> IO (Maybe UTCTime)
|
||||
getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing)
|
||||
|
||||
-- | Compile the configuration.
|
||||
compile :: Directories -> Compile -> IO ExitCode
|
||||
compile dirs method =
|
||||
bracket_ uninstallSignalHandlers installSignalHandlers $
|
||||
withFile (errFileName dirs) WriteMode $ \err -> do
|
||||
let run = runProc err
|
||||
case method of
|
||||
CompileGhc -> do
|
||||
ghc <- fromMaybe "ghc" <$> lookupEnv "XMONAD_GHC"
|
||||
run ghc ghcArgs
|
||||
CompileCabal -> run "cabal" ["build"] .&&. copyBinary
|
||||
where
|
||||
copyBinary :: IO ExitCode
|
||||
copyBinary = readProc err "cabal" ["-v0", "list-bin", "."] >>= \ case
|
||||
Left status -> return status
|
||||
Right (trim -> path) -> copyBinaryFrom path
|
||||
CompileStackGhc stackYaml ->
|
||||
run "stack" ["build", "--silent", "--stack-yaml", stackYaml] .&&.
|
||||
run "stack" ("ghc" : "--stack-yaml" : stackYaml : "--" : ghcArgs)
|
||||
CompileNixFlake ->
|
||||
run "nix" ["build"] >>= andCopyFromResultDir
|
||||
CompileNixDefault ->
|
||||
run "nix-build" [] >>= andCopyFromResultDir
|
||||
CompileScript script ->
|
||||
run script [binFileName dirs]
|
||||
where
|
||||
cwd :: FilePath
|
||||
cwd = cfgDir dirs
|
||||
|
||||
ghcArgs :: [String]
|
||||
ghcArgs = [ "--make"
|
||||
, "xmonad.hs"
|
||||
, "-i" -- only look in @lib@
|
||||
, "-ilib"
|
||||
, "-fforce-recomp"
|
||||
, "-main-is", "main"
|
||||
, "-v0"
|
||||
, "-outputdir", buildDirName dirs
|
||||
, "-o", binFileName dirs
|
||||
]
|
||||
|
||||
andCopyFromResultDir :: ExitCode -> IO ExitCode
|
||||
andCopyFromResultDir exitCode = do
|
||||
if exitCode == ExitSuccess then copyFromResultDir else return exitCode
|
||||
|
||||
findM :: (Monad m, Foldable t) => (a -> m Bool) -> t a -> m (Maybe a)
|
||||
findM p = foldr (\x -> ifM (p x) (pure $ Just x)) (pure Nothing)
|
||||
|
||||
catchAny :: IO a -> (SomeException -> IO a) -> IO a
|
||||
catchAny = E.catch
|
||||
|
||||
copyFromResultDir :: IO ExitCode
|
||||
copyFromResultDir = do
|
||||
let binaryDirectory = cfgDir dirs </> "result" </> "bin"
|
||||
binFiles <- map (binaryDirectory </>) <$> catchAny (listDirectory binaryDirectory) (\_ -> return [])
|
||||
mfilepath <- findM isExecutable binFiles
|
||||
case mfilepath of
|
||||
Just filepath -> copyBinaryFrom filepath
|
||||
Nothing -> return $ ExitFailure 1
|
||||
|
||||
copyBinaryFrom :: FilePath -> IO ExitCode
|
||||
copyBinaryFrom filepath = copyFile filepath (binFileName dirs) >> return ExitSuccess
|
||||
|
||||
-- waitForProcess =<< System.Process.runProcess, but without closing the err handle
|
||||
runProc :: Handle -> String -> [String] -> IO ExitCode
|
||||
runProc err exe args = do
|
||||
(Nothing, Nothing, Nothing, h) <- createProcess_ "runProc" =<< mkProc err exe args
|
||||
waitForProcess h
|
||||
|
||||
readProc :: Handle -> String -> [String] -> IO (Either ExitCode String)
|
||||
readProc err exe args = do
|
||||
spec <- mkProc err exe args
|
||||
(Nothing, Just out, Nothing, h) <- createProcess_ "readProc" spec{ std_out = CreatePipe }
|
||||
result <- hGetContents out
|
||||
hPutStr err result >> hFlush err
|
||||
waitForProcess h >>= \ case
|
||||
ExitSuccess -> return $ Right result
|
||||
status -> return $ Left status
|
||||
|
||||
mkProc :: Handle -> FilePath -> [FilePath] -> IO CreateProcess
|
||||
mkProc err exe args = do
|
||||
hPutStrLn err $ unwords $ "$" : exe : args
|
||||
hFlush err
|
||||
return (proc exe args){ cwd = Just cwd, std_err = UseHandle err }
|
||||
|
||||
(.&&.) :: Monad m => m ExitCode -> m ExitCode -> m ExitCode
|
||||
cmd1 .&&. cmd2 = cmd1 >>= \case
|
||||
ExitSuccess -> cmd2
|
||||
e -> pure e
|
||||
|
||||
-- | Check GHC output for deprecation warnings and notify the user if there
|
||||
-- were any. Report success otherwise.
|
||||
checkCompileWarnings :: Directories -> IO ()
|
||||
checkCompileWarnings dirs = do
|
||||
ghcErr <- readFile (errFileName dirs)
|
||||
if "-Wdeprecations" `isInfixOf` ghcErr
|
||||
then do
|
||||
let msg = unlines $
|
||||
["Deprecations detected while compiling xmonad config: " <> srcFileName dirs]
|
||||
++ lines ghcErr
|
||||
++ ["","Please correct them or silence using {-# OPTIONS_GHC -Wno-deprecations #-}."]
|
||||
trace msg
|
||||
xmessage msg
|
||||
else
|
||||
trace "XMonad recompilation process exited with success!"
|
||||
|
||||
-- | Notify the user that compilation failed and what was wrong.
|
||||
compileFailed :: Directories -> ExitCode -> IO ()
|
||||
compileFailed dirs status = do
|
||||
ghcErr <- readFile (errFileName dirs)
|
||||
let msg = unlines $
|
||||
["Errors detected while compiling xmonad config: " <> srcFileName dirs]
|
||||
++ lines (if null ghcErr then show status else ghcErr)
|
||||
++ ["","Please check the file for errors."]
|
||||
-- nb, the ordering of printing, then forking, is crucial due to
|
||||
-- lazy evaluation
|
||||
trace msg
|
||||
xmessage msg
|
||||
|
||||
-- | Recompile the xmonad configuration file when any of the following apply:
|
||||
--
|
||||
-- * force is 'True'
|
||||
--
|
||||
-- * the xmonad executable does not exist
|
||||
--
|
||||
-- * the xmonad executable is older than @xmonad.hs@ or any file in
|
||||
-- the @lib@ directory (under the configuration directory)
|
||||
--
|
||||
-- * custom @build@ script is being used
|
||||
--
|
||||
-- The -i flag is used to restrict recompilation to the xmonad.hs file only,
|
||||
-- and any files in the aforementioned @lib@ directory.
|
||||
--
|
||||
-- Compilation errors (if any) are logged to the @xmonad.errors@ file
|
||||
-- in the xmonad data directory. If GHC indicates failure with a
|
||||
-- non-zero exit code, an xmessage displaying that file is spawned.
|
||||
--
|
||||
-- 'False' is returned if there are compilation errors.
|
||||
--
|
||||
recompile :: MonadIO m => Directories -> Bool -> m Bool
|
||||
recompile dirs force = io $ do
|
||||
method <- detectCompile dirs
|
||||
willCompile <- if force
|
||||
then True <$ trace "XMonad recompiling (forced)."
|
||||
else shouldCompile dirs method
|
||||
if willCompile
|
||||
then do
|
||||
status <- compile dirs method
|
||||
if status == ExitSuccess
|
||||
then checkCompileWarnings dirs
|
||||
else compileFailed dirs status
|
||||
pure $ status == ExitSuccess
|
||||
else
|
||||
pure True
|
||||
|
||||
-- | Conditionally run an action, using a @Maybe a@ to decide.
|
||||
whenJust :: Monad m => Maybe a -> (a -> m ()) -> m ()
|
||||
whenJust mg f = maybe (return ()) f mg
|
||||
|
||||
-- | Conditionally run an action, using a 'X' event to decide
|
||||
whenX :: X Bool -> X () -> X ()
|
||||
whenX a f = a >>= \b -> when b f
|
||||
|
||||
-- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may
|
||||
-- be found in your .xsession-errors file
|
||||
trace :: MonadIO m => String -> m ()
|
||||
trace = io . hPutStrLn stderr
|
||||
|
||||
-- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to
|
||||
-- avoid zombie processes, and clean up any extant zombie processes.
|
||||
installSignalHandlers :: MonadIO m => m ()
|
||||
installSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Ignore Nothing
|
||||
installHandler sigCHLD Ignore Nothing
|
||||
(try :: IO a -> IO (Either SomeException a))
|
||||
$ fix $ \more -> do
|
||||
x <- getAnyProcessStatus False False
|
||||
when (isJust x) more
|
||||
return ()
|
||||
|
||||
uninstallSignalHandlers :: MonadIO m => m ()
|
||||
uninstallSignalHandlers = io $ do
|
||||
installHandler openEndedPipe Default Nothing
|
||||
installHandler sigCHLD Default Nothing
|
||||
return ()
|
||||
|
||||
trim :: String -> String
|
||||
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
|
@@ -1,5 +1,6 @@
|
||||
{-# OPTIONS_GHC -fglasgow-exts #-} -- For deriving Data/Typeable
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, PatternGuards, TypeSynonymInstances #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -9,7 +10,7 @@
|
||||
--
|
||||
-- Maintainer : spencerjanssen@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, Typeable deriving, mtl, posix
|
||||
-- Portability : not portable, mtl, posix
|
||||
--
|
||||
-- The collection of core layouts.
|
||||
--
|
||||
@@ -17,7 +18,7 @@
|
||||
|
||||
module XMonad.Layout (
|
||||
Full(..), Tall(..), Mirror(..),
|
||||
Resize(..), IncMasterN(..), Choose, (|||), ChangeLayout(..),
|
||||
Resize(..), IncMasterN(..), Choose(..), (|||), CLR(..), ChangeLayout(..), JumpToLayout(..),
|
||||
mirrorRect, splitVertically,
|
||||
splitHorizontally, splitHorizontallyBy, splitVerticallyBy,
|
||||
|
||||
@@ -28,6 +29,7 @@ module XMonad.Layout (
|
||||
import XMonad.Core
|
||||
|
||||
import Graphics.X11 (Rectangle(..))
|
||||
import Graphics.X11.Xlib.Extras ( Event(DestroyWindowEvent) )
|
||||
import qualified XMonad.StackSet as W
|
||||
import Control.Arrow ((***), second)
|
||||
import Control.Monad
|
||||
@@ -36,10 +38,10 @@ import Data.Maybe (fromMaybe)
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | Change the size of the master pane.
|
||||
data Resize = Shrink | Expand deriving Typeable
|
||||
data Resize = Shrink | Expand
|
||||
|
||||
-- | Increase the number of clients in the master pane.
|
||||
data IncMasterN = IncMasterN !Int deriving Typeable
|
||||
newtype IncMasterN = IncMasterN Int
|
||||
|
||||
instance Message Resize
|
||||
instance Message IncMasterN
|
||||
@@ -53,15 +55,20 @@ instance LayoutClass Full a
|
||||
-- 'IncMasterN'.
|
||||
data Tall a = Tall { tallNMaster :: !Int -- ^ The default number of windows in the master pane (default: 1)
|
||||
, tallRatioIncrement :: !Rational -- ^ Percent of screen to increment by when resizing panes (default: 3/100)
|
||||
, tallRatio :: !Rational } -- ^ Default proportion of screen occupied by master pane (default: 1/2)
|
||||
, tallRatio :: !Rational -- ^ Default proportion of screen occupied by master pane (default: 1/2)
|
||||
}
|
||||
deriving (Show, Read)
|
||||
-- TODO should be capped [0..1] ..
|
||||
|
||||
-- a nice pure layout, lots of properties for the layout, and its messages, in Properties.hs
|
||||
instance LayoutClass Tall a where
|
||||
pureLayout (Tall nmaster _ frac) r s = zip ws rs
|
||||
pureLayout (Tall nmaster _ frac) r s
|
||||
| frac == 0 = drop nmaster layout
|
||||
| frac == 1 = take nmaster layout
|
||||
| otherwise = layout
|
||||
where ws = W.integrate s
|
||||
rs = tile frac r nmaster (length ws)
|
||||
layout = zip ws rs
|
||||
|
||||
pureMessage (Tall nmaster delta frac) m =
|
||||
msum [fmap resize (fromMessage m)
|
||||
@@ -77,7 +84,7 @@ instance LayoutClass Tall a where
|
||||
-- algorithm.
|
||||
--
|
||||
-- The screen is divided into two panes. All clients are
|
||||
-- then partioned between these two panes. One pane, the master, by
|
||||
-- then partitioned between these two panes. One pane, the master, by
|
||||
-- convention has the least number of windows in it.
|
||||
tile
|
||||
:: Rational -- ^ @frac@, what proportion of the screen to devote to the master area
|
||||
@@ -125,29 +132,59 @@ instance LayoutClass l a => LayoutClass (Mirror l) a where
|
||||
|
||||
-- | Mirror a rectangle.
|
||||
mirrorRect :: Rectangle -> Rectangle
|
||||
mirrorRect (Rectangle rx ry rw rh) = (Rectangle ry rx rh rw)
|
||||
mirrorRect (Rectangle rx ry rw rh) = Rectangle ry rx rh rw
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- LayoutClass selection manager
|
||||
-- Layouts that transition between other layouts
|
||||
|
||||
-- | Messages to change the current layout.
|
||||
data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show, Typeable)
|
||||
-- | Messages to change the current layout. Also see 'JumpToLayout'.
|
||||
data ChangeLayout = FirstLayout | NextLayout deriving (Eq, Show)
|
||||
|
||||
instance Message ChangeLayout
|
||||
|
||||
-- | A message to jump to a particular layout, specified by its
|
||||
-- description string.
|
||||
--
|
||||
-- The argument given to a 'JumpToLayout' message should be the
|
||||
-- @description@ of the layout to be selected. If you use
|
||||
-- "XMonad.Hooks.DynamicLog" from @xmonad-contrib@, this is the name of
|
||||
-- the layout displayed in your status bar. Alternatively, you can use
|
||||
-- GHCi to determine the proper name to use. For example:
|
||||
--
|
||||
-- > $ ghci
|
||||
-- > GHCi, version 6.8.2: http://www.haskell.org/ghc/ :? for help
|
||||
-- > Loading package base ... linking ... done.
|
||||
-- > :set prompt "> " -- don't show loaded module names
|
||||
-- > > :m +XMonad.Core -- load the xmonad core
|
||||
-- > > :m +XMonad.Layout.Grid -- load whatever module you want to use
|
||||
-- > > description Grid -- find out what it's called
|
||||
-- > "Grid"
|
||||
--
|
||||
-- As yet another (possibly easier) alternative, you can use the
|
||||
-- "XMonad.Layout.Renamed" module (also in @xmonad-contrib@) to give
|
||||
-- custom names to your layouts, and use those.
|
||||
--
|
||||
-- For example, if you want to jump directly to the 'Full' layout you
|
||||
-- can do
|
||||
--
|
||||
-- > , ((modm .|. controlMask, xK_f), sendMessage $ JumpToLayout "Full")
|
||||
--
|
||||
newtype JumpToLayout = JumpToLayout String
|
||||
instance Message JumpToLayout
|
||||
|
||||
-- | The layout choice combinator
|
||||
(|||) :: (LayoutClass l a, LayoutClass r a) => l a -> r a -> Choose l r a
|
||||
(|||) = Choose L
|
||||
(|||) :: l a -> r a -> Choose l r a
|
||||
(|||) = Choose CL
|
||||
infixr 5 |||
|
||||
|
||||
-- | A layout that allows users to switch between various layout options.
|
||||
data Choose l r a = Choose LR (l a) (r a) deriving (Read, Show)
|
||||
data Choose l r a = Choose CLR (l a) (r a) deriving (Read, Show)
|
||||
|
||||
-- | Are we on the left or right sub-layout?
|
||||
data LR = L | R deriving (Read, Show, Eq)
|
||||
-- | Choose the current sub-layout (left or right) in 'Choose'.
|
||||
data CLR = CL | CR deriving (Read, Show, Eq)
|
||||
|
||||
data NextNoWrap = NextNoWrap deriving (Eq, Show, Typeable)
|
||||
data NextNoWrap = NextNoWrap deriving (Eq, Show)
|
||||
instance Message NextNoWrap
|
||||
|
||||
-- | A small wrapper around handleMessage, as it is tedious to write
|
||||
@@ -159,26 +196,26 @@ handle l m = handleMessage l (SomeMessage m)
|
||||
-- new structure if any fields have changed, and performs any necessary cleanup
|
||||
-- on newly non-visible layouts.
|
||||
choose :: (LayoutClass l a, LayoutClass r a)
|
||||
=> Choose l r a-> LR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
|
||||
=> Choose l r a -> CLR -> Maybe (l a) -> Maybe (r a) -> X (Maybe (Choose l r a))
|
||||
choose (Choose d _ _) d' Nothing Nothing | d == d' = return Nothing
|
||||
choose (Choose d l r) d' ml mr = f lr
|
||||
where
|
||||
(l', r') = (fromMaybe l ml, fromMaybe r mr)
|
||||
lr = case (d, d') of
|
||||
(L, R) -> (hide l' , return r')
|
||||
(R, L) -> (return l', hide r' )
|
||||
(_, _) -> (return l', return r')
|
||||
f (x,y) = fmap Just $ liftM2 (Choose d') x y
|
||||
hide x = fmap (fromMaybe x) $ handle x Hide
|
||||
(CL, CR) -> (hide l' , return r')
|
||||
(CR, CL) -> (return l', hide r' )
|
||||
(_ , _ ) -> (return l', return r')
|
||||
f (x,y) = Just <$> liftM2 (Choose d') x y
|
||||
hide x = fromMaybe x <$> handle x Hide
|
||||
|
||||
instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
|
||||
runLayout (W.Workspace i (Choose L l r) ms) =
|
||||
fmap (second . fmap $ flip (Choose L) $ r) . runLayout (W.Workspace i l ms)
|
||||
runLayout (W.Workspace i (Choose R l r) ms) =
|
||||
fmap (second . fmap $ Choose R l) . runLayout (W.Workspace i r ms)
|
||||
runLayout (W.Workspace i (Choose CL l r) ms) =
|
||||
fmap (second . fmap $ flip (Choose CL) r) . runLayout (W.Workspace i l ms)
|
||||
runLayout (W.Workspace i (Choose CR l r) ms) =
|
||||
fmap (second . fmap $ Choose CR l) . runLayout (W.Workspace i r ms)
|
||||
|
||||
description (Choose L l _) = description l
|
||||
description (Choose R _ r) = description r
|
||||
description (Choose CL l _) = description l
|
||||
description (Choose CR _ r) = description r
|
||||
|
||||
handleMessage lr m | Just NextLayout <- fromMessage m = do
|
||||
mlr' <- handle lr NextNoWrap
|
||||
@@ -186,25 +223,36 @@ instance (LayoutClass l a, LayoutClass r a) => LayoutClass (Choose l r) a where
|
||||
|
||||
handleMessage c@(Choose d l r) m | Just NextNoWrap <- fromMessage m =
|
||||
case d of
|
||||
L -> do
|
||||
CL -> do
|
||||
ml <- handle l NextNoWrap
|
||||
case ml of
|
||||
Just _ -> choose c L ml Nothing
|
||||
Nothing -> choose c R Nothing =<< handle r FirstLayout
|
||||
Just _ -> choose c CL ml Nothing
|
||||
Nothing -> choose c CR Nothing =<< handle r FirstLayout
|
||||
|
||||
R -> choose c R Nothing =<< handle r NextNoWrap
|
||||
CR -> choose c CR Nothing =<< handle r NextNoWrap
|
||||
|
||||
handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m = do
|
||||
flip (choose c L) Nothing =<< handle l FirstLayout
|
||||
handleMessage c@(Choose _ l _) m | Just FirstLayout <- fromMessage m =
|
||||
flip (choose c CL) Nothing =<< handle l FirstLayout
|
||||
|
||||
handleMessage c@(Choose d l r) m | Just ReleaseResources <- fromMessage m =
|
||||
join $ liftM2 (choose c d) (handle l ReleaseResources) (handle r ReleaseResources)
|
||||
|
||||
handleMessage c@(Choose d l r) m | Just e@DestroyWindowEvent{} <- fromMessage m =
|
||||
join $ liftM2 (choose c d) (handle l e) (handle r e)
|
||||
|
||||
handleMessage c@(Choose d l r) m | Just (JumpToLayout desc) <- fromMessage m = do
|
||||
ml <- handleMessage l m
|
||||
mr <- handleMessage r m
|
||||
let md | desc == description (fromMaybe l ml) = CL
|
||||
| desc == description (fromMaybe r mr) = CR
|
||||
| otherwise = d
|
||||
choose c md ml mr
|
||||
|
||||
handleMessage c@(Choose d l r) m = do
|
||||
ml' <- case d of
|
||||
L -> handleMessage l m
|
||||
R -> return Nothing
|
||||
CL -> handleMessage l m
|
||||
CR -> return Nothing
|
||||
mr' <- case d of
|
||||
L -> return Nothing
|
||||
R -> handleMessage r m
|
||||
CL -> return Nothing
|
||||
CR -> handleMessage r m
|
||||
choose c d ml' mr'
|
@@ -1,4 +1,6 @@
|
||||
{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, ForeignFunctionInterface #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
|
||||
----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Main
|
||||
@@ -13,23 +15,21 @@
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Main (xmonad) where
|
||||
module XMonad.Main (xmonad, buildLaunch, launch) where
|
||||
|
||||
import Control.Arrow (second)
|
||||
import System.Locale.SetLocale
|
||||
import qualified Control.Exception as E
|
||||
import Data.Bits
|
||||
import Data.List ((\\))
|
||||
import Data.Foldable (traverse_)
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Data.Maybe (fromMaybe)
|
||||
import Control.Monad (filterM, guard, unless, void, when, forever)
|
||||
import Data.Maybe (fromMaybe, isJust)
|
||||
import Data.Monoid (getAll)
|
||||
|
||||
import Foreign.C
|
||||
import Foreign.Ptr
|
||||
|
||||
import System.Environment (getArgs)
|
||||
|
||||
import Graphics.X11.Xlib hiding (refreshKeyboardMapping)
|
||||
import Graphics.X11.Xlib.Extras
|
||||
|
||||
@@ -40,24 +40,121 @@ import qualified XMonad.StackSet as W
|
||||
import XMonad.Operations
|
||||
|
||||
import System.IO
|
||||
import System.Directory
|
||||
import System.Info
|
||||
import System.Environment (getArgs, getProgName, withArgs)
|
||||
import System.Posix.Process (executeFile)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath
|
||||
|
||||
import Paths_xmonad (version)
|
||||
import Data.Version (showVersion)
|
||||
|
||||
import Graphics.X11.Xinerama (compiledWithXinerama)
|
||||
import Graphics.X11.Xrandr (xrrQueryExtension, xrrUpdateConfiguration)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Locale support
|
||||
|
||||
#include <locale.h>
|
||||
|
||||
foreign import ccall unsafe "locale.h setlocale"
|
||||
c_setlocale :: CInt -> Ptr CChar -> IO (Ptr CChar)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- |
|
||||
-- The main entry point
|
||||
--
|
||||
-- | The entry point into xmonad. Attempts to compile any custom main
|
||||
-- for xmonad, and if it doesn't find one, just launches the default.
|
||||
xmonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
|
||||
xmonad initxmc = do
|
||||
xmonad conf = do
|
||||
installSignalHandlers -- important to ignore SIGCHLD to avoid zombies
|
||||
|
||||
dirs <- getDirectories
|
||||
let launch' args = do
|
||||
catchIO (buildLaunch dirs)
|
||||
conf'@XConfig { layoutHook = Layout l }
|
||||
<- handleExtraArgs conf args conf{ layoutHook = Layout (layoutHook conf) }
|
||||
withArgs [] $ launch (conf' { layoutHook = l }) dirs
|
||||
|
||||
args <- getArgs
|
||||
case args of
|
||||
["--help"] -> usage
|
||||
["--recompile"] -> recompile dirs True >>= flip unless exitFailure
|
||||
["--restart"] -> sendRestart
|
||||
["--version"] -> putStrLn $ unwords shortVersion
|
||||
["--verbose-version"] -> putStrLn . unwords $ shortVersion ++ longVersion
|
||||
"--replace" : args' -> sendReplace >> launch' args'
|
||||
_ -> launch' args
|
||||
where
|
||||
shortVersion = ["xmonad", showVersion version]
|
||||
longVersion = [ "compiled by", compilerName, showVersion compilerVersion
|
||||
, "for", arch ++ "-" ++ os
|
||||
, "\nXinerama:", show compiledWithXinerama ]
|
||||
|
||||
|
||||
usage :: IO ()
|
||||
usage = do
|
||||
self <- getProgName
|
||||
putStr . unlines $
|
||||
[ "Usage: " <> self <> " [OPTION]"
|
||||
, "Options:"
|
||||
, " --help Print this message"
|
||||
, " --version Print the version number"
|
||||
, " --recompile Recompile your xmonad.hs"
|
||||
, " --replace Replace the running window manager with xmonad"
|
||||
, " --restart Request a running xmonad process to restart"
|
||||
]
|
||||
|
||||
-- | Build the xmonad configuration file with ghc, then execute it.
|
||||
-- If there are no errors, this function does not return. An
|
||||
-- exception is raised in any of these cases:
|
||||
--
|
||||
-- * ghc missing
|
||||
--
|
||||
-- * both the configuration file and executable are missing
|
||||
--
|
||||
-- * xmonad.hs fails to compile
|
||||
--
|
||||
-- ** wrong ghc in path (fails to compile)
|
||||
--
|
||||
-- ** type error, syntax error, ..
|
||||
--
|
||||
-- * Missing XMonad\/XMonadContrib modules due to ghc upgrade
|
||||
--
|
||||
buildLaunch :: Directories -> IO ()
|
||||
buildLaunch dirs = do
|
||||
whoami <- getProgName
|
||||
let bin = binFileName dirs
|
||||
let compiledConfig = takeFileName bin
|
||||
unless (whoami == compiledConfig) $ do
|
||||
trace $ concat
|
||||
[ "XMonad is recompiling and replacing itself with another XMonad process because the current process is called "
|
||||
, show whoami
|
||||
, " but the compiled configuration should be called "
|
||||
, show compiledConfig
|
||||
]
|
||||
recompile dirs False
|
||||
args <- getArgs
|
||||
executeFile bin False args Nothing
|
||||
|
||||
-- | Entry point into xmonad for custom builds.
|
||||
--
|
||||
-- This function isn't meant to be called by the typical xmonad user
|
||||
-- because it:
|
||||
--
|
||||
-- * Does not process any command line arguments.
|
||||
--
|
||||
-- * Therefore doesn't know how to restart a running xmonad.
|
||||
--
|
||||
-- * Does not compile your configuration file since it assumes it's
|
||||
-- actually running from within your compiled configuration.
|
||||
--
|
||||
-- Unless you know what you are doing, you should probably be using
|
||||
-- the 'xmonad' function instead.
|
||||
--
|
||||
-- However, if you are using a custom build environment (such as
|
||||
-- stack, cabal, make, etc.) you will likely want to call this
|
||||
-- function instead of 'xmonad'. You probably also want to have a key
|
||||
-- binding to the 'XMonad.Operations.restart` function that restarts
|
||||
-- your custom binary with the resume flag set to @True@.
|
||||
launch :: (LayoutClass l Window, Read (l Window)) => XConfig l -> Directories -> IO ()
|
||||
launch initxmc drs = do
|
||||
-- setup locale information from environment
|
||||
withCString "" $ c_setlocale (#const LC_ALL)
|
||||
setLocale LC_ALL (Just "")
|
||||
-- ignore SIGPIPE and SIGCHLD
|
||||
installSignalHandlers
|
||||
-- First, wrap the layout in an existential, to keep things pretty:
|
||||
@@ -70,9 +167,8 @@ xmonad initxmc = do
|
||||
-- If another WM is running, a BadAccess error will be returned. The
|
||||
-- default error handler will write the exception to stderr and exit with
|
||||
-- an error.
|
||||
selectInput dpy rootw $ substructureRedirectMask .|. substructureNotifyMask
|
||||
.|. enterWindowMask .|. leaveWindowMask .|. structureNotifyMask
|
||||
.|. buttonPressMask
|
||||
selectInput dpy rootw $ rootMask initxmc
|
||||
|
||||
sync dpy False -- sync to ensure all outstanding errors are delivered
|
||||
|
||||
-- turn off the default handler in favor of one that ignores all errors
|
||||
@@ -80,33 +176,20 @@ xmonad initxmc = do
|
||||
xSetErrorHandler -- in C, I'm too lazy to write the binding: dons
|
||||
|
||||
xinesc <- getCleanedScreenInfo dpy
|
||||
nbc <- do v <- initColor dpy $ normalBorderColor xmc
|
||||
~(Just nbc_) <- initColor dpy $ normalBorderColor Default.defaultConfig
|
||||
|
||||
nbc <- do v <- initColor dpy $ normalBorderColor xmc
|
||||
Just nbc_ <- initColor dpy $ normalBorderColor Default.def
|
||||
return (fromMaybe nbc_ v)
|
||||
|
||||
fbc <- do v <- initColor dpy $ focusedBorderColor xmc
|
||||
~(Just fbc_) <- initColor dpy $ focusedBorderColor Default.defaultConfig
|
||||
Just fbc_ <- initColor dpy $ focusedBorderColor Default.def
|
||||
return (fromMaybe fbc_ v)
|
||||
|
||||
hSetBuffering stdout NoBuffering
|
||||
args <- getArgs
|
||||
|
||||
let layout = layoutHook xmc
|
||||
lreads = readsLayout layout
|
||||
initialWinset = new layout (workspaces xmc) $ map SD xinesc
|
||||
maybeRead reads' s = case reads' s of
|
||||
[(x, "")] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
winset = fromMaybe initialWinset $ do
|
||||
("--resume" : s : _) <- return args
|
||||
ws <- maybeRead reads s
|
||||
return . W.ensureTags layout (workspaces xmc)
|
||||
$ W.mapLayout (fromMaybe layout . maybeRead lreads) ws
|
||||
extState = fromMaybe M.empty $ do
|
||||
("--resume" : _ : dyns : _) <- return args
|
||||
vals <- maybeRead reads dyns
|
||||
return . M.fromList . map (second Left) $ vals
|
||||
initialWinset = let padToLen n xs = take (max n (length xs)) $ xs ++ repeat ""
|
||||
in new layout (padToLen (length xinesc) (workspaces xmc)) $ map SD xinesc
|
||||
|
||||
cf = XConf
|
||||
{ display = dpy
|
||||
@@ -117,20 +200,33 @@ xmonad initxmc = do
|
||||
, keyActions = keys xmc xmc
|
||||
, buttonActions = mouseBindings xmc xmc
|
||||
, mouseFocused = False
|
||||
, mousePosition = Nothing }
|
||||
, mousePosition = Nothing
|
||||
, currentEvent = Nothing
|
||||
, directories = drs
|
||||
}
|
||||
|
||||
st = XState
|
||||
{ windowset = initialWinset
|
||||
, numlockMask = 0
|
||||
, numberlockMask = 0
|
||||
, mapped = S.empty
|
||||
, waitingUnmap = M.empty
|
||||
, dragging = Nothing
|
||||
, extensibleState = extState
|
||||
, extensibleState = M.empty
|
||||
}
|
||||
|
||||
allocaXEvent $ \e ->
|
||||
runX cf st $ do
|
||||
-- check for serialized state in a file.
|
||||
serializedSt <- do
|
||||
path <- asks $ stateFileName . directories
|
||||
exists <- io (doesFileExist path)
|
||||
if exists then readStateFile initxmc else return Nothing
|
||||
|
||||
setNumlockMask
|
||||
-- restore extensibleState if we read it from a file.
|
||||
let extst = maybe M.empty extensibleState serializedSt
|
||||
modify (\s -> s {extensibleState = extst})
|
||||
|
||||
cacheNumlockMask
|
||||
grabKeys
|
||||
grabButtons
|
||||
|
||||
@@ -143,6 +239,7 @@ xmonad initxmc = do
|
||||
-- those windows. Remove all windows that are no longer top-level
|
||||
-- children of the root, they may have disappeared since
|
||||
-- restarting.
|
||||
let winset = maybe initialWinset windowset serializedSt
|
||||
windows . const . foldr W.delete winset $ W.allWindows winset \\ ws
|
||||
|
||||
-- manage the as-yet-unmanaged windows
|
||||
@@ -150,18 +247,19 @@ xmonad initxmc = do
|
||||
|
||||
userCode $ startupHook initxmc
|
||||
|
||||
rrData <- io $ xrrQueryExtension dpy
|
||||
let rrUpdate = when (isJust rrData) . void . xrrUpdateConfiguration
|
||||
|
||||
-- main loop, for all you HOF/recursion fans out there.
|
||||
forever_ $ prehandle =<< io (nextEvent dpy e >> getEvent e)
|
||||
forever $ prehandle =<< io (nextEvent dpy e >> rrUpdate e >> getEvent e)
|
||||
|
||||
return ()
|
||||
where
|
||||
forever_ a = a >> forever_ a
|
||||
|
||||
-- if the event gives us the position of the pointer, set mousePosition
|
||||
prehandle e = let mouse = do guard (ev_event_type e `elem` evs)
|
||||
return (fromIntegral (ev_x_root e)
|
||||
,fromIntegral (ev_y_root e))
|
||||
in local (\c -> c { mousePosition = mouse }) (handleWithHook e)
|
||||
in local (\c -> c { mousePosition = mouse, currentEvent = Just e }) (handleWithHook e)
|
||||
evs = [ keyPress, keyRelease, enterNotify, leaveNotify
|
||||
, buttonPress, buttonRelease]
|
||||
|
||||
@@ -195,23 +293,28 @@ handle (KeyEvent {ev_event_type = t, ev_state = m, ev_keycode = code})
|
||||
|
||||
-- manage a new window
|
||||
handle (MapRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
wa <- io $ getWindowAttributes dpy w -- ignore override windows
|
||||
-- need to ignore mapping requests by managed windows not on the current workspace
|
||||
managed <- isClient w
|
||||
when (not (wa_override_redirect wa) && not managed) $ do manage w
|
||||
withWindowAttributes dpy w $ \wa -> do -- ignore override windows
|
||||
-- need to ignore mapping requests by managed windows not on the current workspace
|
||||
managed <- isClient w
|
||||
when (not (wa_override_redirect wa) && not managed) $ manage w
|
||||
|
||||
-- window destroyed, unmanage it
|
||||
-- window gone, unmanage it
|
||||
handle (DestroyWindowEvent {ev_window = w}) = whenX (isClient w) $ do
|
||||
-- broadcast to layouts
|
||||
handle e@(DestroyWindowEvent {ev_window = w}) = do
|
||||
whenX (isClient w) $ do
|
||||
unmanage w
|
||||
modify (\s -> s { mapped = S.delete w (mapped s)
|
||||
, waitingUnmap = M.delete w (waitingUnmap s)})
|
||||
-- the window is already unmanged, but we broadcast the event to all layouts
|
||||
-- to trigger garbage-collection in case they hold window-specific resources
|
||||
broadcastMessage e
|
||||
|
||||
-- We track expected unmap events in waitingUnmap. We ignore this event unless
|
||||
-- it is synthetic or we are not expecting an unmap notification from a window.
|
||||
handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient w) $ do
|
||||
e <- gets (fromMaybe 0 . M.lookup w . waitingUnmap)
|
||||
if (synthetic || e == 0)
|
||||
if synthetic || e == 0
|
||||
then unmanage w
|
||||
else modify (\s -> s { waitingUnmap = M.update mpred w (waitingUnmap s) })
|
||||
where mpred 1 = Nothing
|
||||
@@ -221,7 +324,7 @@ handle (UnmapEvent {ev_window = w, ev_send_event = synthetic}) = whenX (isClient
|
||||
handle e@(MappingNotifyEvent {}) = do
|
||||
io $ refreshKeyboardMapping e
|
||||
when (ev_request e `elem` [mappingKeyboard, mappingModifier]) $ do
|
||||
setNumlockMask
|
||||
cacheNumlockMask
|
||||
grabKeys
|
||||
|
||||
-- handle button release, which may finish dragging.
|
||||
@@ -245,19 +348,29 @@ handle e@(ButtonEvent {ev_window = w,ev_event_type = t,ev_button = b })
|
||||
| t == buttonPress = do
|
||||
-- If it's the root window, then it's something we
|
||||
-- grabbed in grabButtons. Otherwise, it's click-to-focus.
|
||||
dpy <- asks display
|
||||
isr <- isRoot w
|
||||
m <- cleanMask $ ev_state e
|
||||
mact <- asks (M.lookup (m, b) . buttonActions)
|
||||
case mact of
|
||||
(Just act) | isr -> act $ ev_subwindow e
|
||||
_ -> focus w
|
||||
Just act | isr -> act $ ev_subwindow e
|
||||
_ -> do
|
||||
focus w
|
||||
ctf <- asks (clickJustFocuses . config)
|
||||
unless ctf $ io (allowEvents dpy replayPointer currentTime)
|
||||
broadcastMessage e -- Always send button events.
|
||||
|
||||
-- entered a normal window: focus it if focusFollowsMouse is set to
|
||||
-- True in the user's config.
|
||||
handle e@(CrossingEvent {ev_window = w, ev_event_type = t})
|
||||
| t == enterNotify && ev_mode e == notifyNormal
|
||||
= whenX (asks $ focusFollowsMouse . config) (focus w)
|
||||
= whenX (asks $ focusFollowsMouse . config) $ do
|
||||
dpy <- asks display
|
||||
root <- asks theRoot
|
||||
(_, _, w', _, _, _, _, _) <- io $ queryPointer dpy root
|
||||
-- when Xlib cannot find a child that contains the pointer,
|
||||
-- it returns None(0)
|
||||
when (w' == 0 || w == w') (focus w)
|
||||
|
||||
-- left a window, check if we need to focus root
|
||||
handle e@(CrossingEvent {ev_event_type = t})
|
||||
@@ -268,8 +381,6 @@ handle e@(CrossingEvent {ev_event_type = t})
|
||||
-- configure a window
|
||||
handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
ws <- gets windowset
|
||||
wa <- io $ getWindowAttributes dpy w
|
||||
|
||||
bw <- asks (borderWidth . config)
|
||||
|
||||
if M.member w (floating ws)
|
||||
@@ -283,7 +394,7 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
, wc_sibling = ev_above e
|
||||
, wc_stack_mode = ev_detail e }
|
||||
when (member w ws) (float w)
|
||||
else io $ allocaXEvent $ \ev -> do
|
||||
else withWindowAttributes dpy w $ \wa -> io $ allocaXEvent $ \ev -> do
|
||||
setEventType ev configureNotify
|
||||
setConfigureEvent ev w w
|
||||
(wa_x wa) (wa_y wa) (wa_width wa)
|
||||
@@ -295,12 +406,13 @@ handle e@(ConfigureRequestEvent {ev_window = w}) = withDisplay $ \dpy -> do
|
||||
handle (ConfigureEvent {ev_window = w}) = whenX (isRoot w) rescreen
|
||||
|
||||
-- property notify
|
||||
handle PropertyEvent { ev_event_type = t, ev_atom = a }
|
||||
| t == propertyNotify && a == wM_NAME = userCodeDef () =<< asks (logHook . config)
|
||||
handle event@(PropertyEvent { ev_event_type = t, ev_atom = a })
|
||||
| t == propertyNotify && a == wM_NAME = asks (logHook . config) >>= userCodeDef () >>
|
||||
broadcastMessage event
|
||||
|
||||
handle e@ClientMessageEvent { ev_message_type = mt } = do
|
||||
a <- getAtom "XMONAD_RESTART"
|
||||
if (mt == a)
|
||||
if mt == a
|
||||
then restart "xmonad" True
|
||||
else broadcastMessage e
|
||||
|
||||
@@ -316,7 +428,7 @@ handle e = broadcastMessage e -- trace (eventName e) -- ignoring
|
||||
scan :: Display -> Window -> IO [Window]
|
||||
scan dpy rootw = do
|
||||
(_, _, ws) <- queryTree dpy rootw
|
||||
filterM ok ws
|
||||
filterM (\w -> ok w `E.catch` skip) ws
|
||||
-- TODO: scan for windows that are either 'IsViewable' or where WM_STATE ==
|
||||
-- Iconic
|
||||
where ok w = do wa <- getWindowAttributes dpy w
|
||||
@@ -328,32 +440,19 @@ scan dpy rootw = do
|
||||
return $ not (wa_override_redirect wa)
|
||||
&& (wa_map_state wa == waIsViewable || ic)
|
||||
|
||||
setNumlockMask :: X ()
|
||||
setNumlockMask = do
|
||||
dpy <- asks display
|
||||
ms <- io $ getModifierMapping dpy
|
||||
xs <- sequence [ do
|
||||
ks <- io $ keycodeToKeysym dpy kc 0
|
||||
if ks == xK_Num_Lock
|
||||
then return (setBit 0 (fromIntegral m))
|
||||
else return (0 :: KeyMask)
|
||||
| (m, kcs) <- ms, kc <- kcs, kc /= 0]
|
||||
modify (\s -> s { numlockMask = foldr (.|.) 0 xs })
|
||||
skip :: E.SomeException -> IO Bool
|
||||
skip _ = return False
|
||||
|
||||
-- | Grab the keys back
|
||||
grabKeys :: X ()
|
||||
grabKeys = do
|
||||
XConf { display = dpy, theRoot = rootw } <- ask
|
||||
let grab kc m = io $ grabKey dpy kc m rootw True grabModeAsync grabModeAsync
|
||||
io $ ungrabKey dpy anyKey anyModifier rootw
|
||||
ks <- asks keyActions
|
||||
forM_ (M.keys ks) $ \(mask,sym) -> do
|
||||
kc <- io $ keysymToKeycode dpy sym
|
||||
-- "If the specified KeySym is not defined for any KeyCode,
|
||||
-- XKeysymToKeycode() returns zero."
|
||||
when (kc /= 0) $ mapM_ (grab kc . (mask .|.)) =<< extraModifiers
|
||||
let grab :: (KeyMask, KeyCode) -> X ()
|
||||
grab (km, kc) = io $ grabKey dpy kc km rootw True grabModeAsync grabModeAsync
|
||||
traverse_ grab =<< mkGrabs =<< asks (M.keys . keyActions)
|
||||
|
||||
-- | XXX comment me
|
||||
-- | Grab the buttons
|
||||
grabButtons :: X ()
|
||||
grabButtons = do
|
||||
XConf { display = dpy, theRoot = rootw } <- ask
|
||||
@@ -362,4 +461,4 @@ grabButtons = do
|
||||
io $ ungrabButton dpy anyButton anyModifier rootw
|
||||
ems <- extraModifiers
|
||||
ba <- asks buttonActions
|
||||
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys $ ba)
|
||||
mapM_ (\(m,b) -> mapM_ (grab b . (m .|.)) ems) (M.keys ba)
|
@@ -1,5 +1,3 @@
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.ManageHook
|
||||
@@ -8,7 +6,6 @@
|
||||
--
|
||||
-- Maintainer : spencerjanssen@gmail.com
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, uses cunning newtype deriving
|
||||
--
|
||||
-- An EDSL for ManageHooks
|
||||
--
|
||||
@@ -18,38 +15,40 @@
|
||||
|
||||
module XMonad.ManageHook where
|
||||
|
||||
import Prelude hiding (catch)
|
||||
import XMonad.Core
|
||||
import Graphics.X11.Xlib.Extras
|
||||
import Graphics.X11.Xlib (Display, Window, internAtom, wM_NAME)
|
||||
import Control.Exception (bracket, catch)
|
||||
import Control.Exception (bracket, SomeException(..))
|
||||
import qualified Control.Exception as E
|
||||
import Control.Monad.Reader
|
||||
import Data.Maybe
|
||||
import Data.Monoid
|
||||
import qualified XMonad.StackSet as W
|
||||
import XMonad.Operations (floatLocation, reveal)
|
||||
import XMonad.Operations (floatLocation, reveal, isFixedSizeOrTransient)
|
||||
|
||||
-- | Lift an 'X' action to a 'Query'.
|
||||
liftX :: X a -> Query a
|
||||
liftX = Query . lift
|
||||
|
||||
-- | The identity hook that returns the WindowSet unchanged.
|
||||
idHook :: ManageHook
|
||||
idHook = doF id
|
||||
idHook :: Monoid m => m
|
||||
idHook = mempty
|
||||
|
||||
-- | Infix 'mappend'. Compose two 'ManageHook' from right to left.
|
||||
(<+>) :: Monoid m => m -> m -> m
|
||||
(<+>) = mappend
|
||||
|
||||
-- | Compose the list of 'ManageHook's.
|
||||
composeAll :: [ManageHook] -> ManageHook
|
||||
composeAll :: Monoid m => [m] -> m
|
||||
composeAll = mconcat
|
||||
|
||||
infix 0 -->
|
||||
|
||||
-- | @p --> x@. If @p@ returns 'True', execute the 'ManageHook'.
|
||||
(-->) :: Query Bool -> ManageHook -> ManageHook
|
||||
p --> f = p >>= \b -> if b then f else mempty
|
||||
--
|
||||
-- > (-->) :: Monoid m => Query Bool -> Query m -> Query m -- a simpler type
|
||||
(-->) :: (Monad m, Monoid a) => m Bool -> m a -> m a
|
||||
p --> f = p >>= \b -> if b then f else return mempty
|
||||
|
||||
-- | @q =? x@. if the result of @q@ equals @x@, return 'True'.
|
||||
(=?) :: Eq a => Query a -> a -> Query Bool
|
||||
@@ -59,25 +58,27 @@ infixr 3 <&&>, <||>
|
||||
|
||||
-- | '&&' lifted to a 'Monad'.
|
||||
(<&&>) :: Monad m => m Bool -> m Bool -> m Bool
|
||||
(<&&>) = liftM2 (&&)
|
||||
x <&&> y = ifM x y (pure False)
|
||||
|
||||
-- | '||' lifted to a 'Monad'.
|
||||
(<||>) :: Monad m => m Bool -> m Bool -> m Bool
|
||||
(<||>) = liftM2 (||)
|
||||
x <||> y = ifM x (pure True) y
|
||||
|
||||
-- | Return the window title.
|
||||
-- | Return the window title; i.e., the string returned by @_NET_WM_NAME@,
|
||||
-- or failing that, the string returned by @WM_NAME@.
|
||||
title :: Query String
|
||||
title = ask >>= \w -> liftX $ do
|
||||
d <- asks display
|
||||
let
|
||||
getProp =
|
||||
(internAtom d "_NET_WM_NAME" False >>= getTextProperty d w)
|
||||
`catch` \_ -> getTextProperty d w wM_NAME
|
||||
`E.catch` \(SomeException _) -> getTextProperty d w wM_NAME
|
||||
extract prop = do l <- wcTextPropertyToTextList d prop
|
||||
return $ if null l then "" else head l
|
||||
io $ bracket getProp (xFree . tp_value) extract `catch` \_ -> return ""
|
||||
return $ fromMaybe "" $ listToMaybe l
|
||||
io $ bracket getProp (xFree . tp_value) extract `E.catch` \(SomeException _) -> return ""
|
||||
|
||||
-- | Return the application name.
|
||||
-- | Return the application name; i.e., the /first/ string returned by
|
||||
-- @WM_CLASS@.
|
||||
appName :: Query String
|
||||
appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClassHint d w)
|
||||
|
||||
@@ -85,14 +86,17 @@ appName = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resName $ io $ getClas
|
||||
resource :: Query String
|
||||
resource = appName
|
||||
|
||||
-- | Return the resource class.
|
||||
-- | Return the resource class; i.e., the /second/ string returned by
|
||||
-- @WM_CLASS@.
|
||||
className :: Query String
|
||||
className = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap resClass $ io $ getClassHint d w)
|
||||
|
||||
-- | A query that can return an arbitrary X property of type 'String',
|
||||
-- identified by name.
|
||||
-- identified by name. Works for ASCII strings only. For the properties
|
||||
-- @_NET_WM_NAME@/@WM_NAME@ and @WM_CLASS@ the specialised variants 'title'
|
||||
-- and 'appName'/'className' are preferred.
|
||||
stringProperty :: String -> Query String
|
||||
stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fmap (fromMaybe "") $ getStringProperty d w p)
|
||||
stringProperty p = ask >>= (\w -> liftX $ withDisplay $ \d -> fromMaybe "" <$> getStringProperty d w p)
|
||||
|
||||
getStringProperty :: Display -> Window -> String -> X (Maybe String)
|
||||
getStringProperty d w p = do
|
||||
@@ -100,8 +104,12 @@ getStringProperty d w p = do
|
||||
md <- io $ getWindowProperty8 d a w
|
||||
return $ fmap (map (toEnum . fromIntegral)) md
|
||||
|
||||
-- | Return whether the window will be a floating window or not
|
||||
willFloat :: Query Bool
|
||||
willFloat = ask >>= \w -> liftX $ withDisplay $ \d -> isFixedSizeOrTransient d w
|
||||
|
||||
-- | Modify the 'WindowSet' with a pure function.
|
||||
doF :: (WindowSet -> WindowSet) -> ManageHook
|
||||
doF :: (s -> s) -> Query (Endo s)
|
||||
doF = return . Endo
|
||||
|
||||
-- | Move the window to the floating layer.
|
899
src/XMonad/Operations.hs
Normal file
899
src/XMonad/Operations.hs
Normal file
@@ -0,0 +1,899 @@
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE FlexibleInstances #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
-- --------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Operations
|
||||
-- Copyright : (c) Spencer Janssen 2007
|
||||
-- License : BSD3-style (see LICENSE)
|
||||
--
|
||||
-- Maintainer : dons@cse.unsw.edu.au
|
||||
-- Stability : unstable
|
||||
-- Portability : not portable, mtl, posix
|
||||
--
|
||||
-- Operations. A module for functions that don't cleanly fit anywhere else.
|
||||
--
|
||||
-----------------------------------------------------------------------------
|
||||
|
||||
module XMonad.Operations (
|
||||
-- * Manage One Window
|
||||
manage, unmanage, killWindow, kill, isClient,
|
||||
setInitialProperties, setWMState, setWindowBorderWithFallback,
|
||||
hide, reveal, tileWindow,
|
||||
setTopFocus, focus, isFixedSizeOrTransient,
|
||||
|
||||
-- * Manage Windows
|
||||
windows, refresh, rescreen, modifyWindowSet, windowBracket, windowBracket_, clearEvents, getCleanedScreenInfo,
|
||||
withFocused, withUnfocused,
|
||||
|
||||
-- * Keyboard and Mouse
|
||||
cleanMask, extraModifiers,
|
||||
mouseDrag, mouseMoveWindow, mouseResizeWindow,
|
||||
setButtonGrab, setFocusX, cacheNumlockMask, mkGrabs, unGrab,
|
||||
|
||||
-- * Messages
|
||||
sendMessage, broadcastMessage, sendMessageWithNoRefresh,
|
||||
sendRestart, sendReplace,
|
||||
|
||||
-- * Save and Restore State
|
||||
StateFile (..), writeStateToFile, readStateFile, restart,
|
||||
|
||||
-- * Floating Layer
|
||||
float, floatLocation,
|
||||
|
||||
-- * Window Size Hints
|
||||
D, mkAdjust, applySizeHints, applySizeHints', applySizeHintsContents,
|
||||
applyAspectHint, applyResizeIncHint, applyMaxSizeHint,
|
||||
|
||||
-- * Rectangles
|
||||
containedIn, nubScreens, pointWithin, scaleRationalRect,
|
||||
|
||||
-- * Other Utilities
|
||||
initColor, pointScreen, screenWorkspace,
|
||||
setLayout, updateLayout,
|
||||
) where
|
||||
|
||||
import XMonad.Core
|
||||
import XMonad.Layout (Full(..))
|
||||
import qualified XMonad.StackSet as W
|
||||
|
||||
import Data.Maybe
|
||||
import Data.Monoid (Endo(..),Any(..))
|
||||
import Data.List (nub, (\\), find)
|
||||
import Data.Bits ((.|.), (.&.), complement, setBit, testBit)
|
||||
import Data.Function (on)
|
||||
import Data.Ratio
|
||||
import qualified Data.Map as M
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Control.Arrow (second)
|
||||
import Control.Monad.Fix (fix)
|
||||
import Control.Monad.Reader
|
||||
import Control.Monad.State
|
||||
import Control.Monad (forM, forM_, guard, join, unless, void, when)
|
||||
import qualified Control.Exception as C
|
||||
|
||||
import System.IO
|
||||
import System.Directory
|
||||
import System.Posix.Process (executeFile)
|
||||
import Graphics.X11.Xlib
|
||||
import Graphics.X11.Xinerama (getScreenInfo)
|
||||
import Graphics.X11.Xlib.Extras
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Window manager operations
|
||||
|
||||
-- | Detect whether a window has fixed size or is transient. This check
|
||||
-- can be used to determine whether the window should be floating or not
|
||||
--
|
||||
isFixedSizeOrTransient :: Display -> Window -> X Bool
|
||||
isFixedSizeOrTransient d w = do
|
||||
sh <- io $ getWMNormalHints d w
|
||||
let isFixedSize = isJust (sh_min_size sh) && sh_min_size sh == sh_max_size sh
|
||||
isTransient <- isJust <$> io (getTransientForHint d w)
|
||||
return (isFixedSize || isTransient)
|
||||
|
||||
-- |
|
||||
-- Add a new window to be managed in the current workspace.
|
||||
-- Bring it into focus.
|
||||
--
|
||||
-- Whether the window is already managed, or not, it is mapped, has its
|
||||
-- border set, and its event mask set.
|
||||
--
|
||||
manage :: Window -> X ()
|
||||
manage w = whenX (not <$> isClient w) $ withDisplay $ \d -> do
|
||||
|
||||
shouldFloat <- isFixedSizeOrTransient d w
|
||||
|
||||
rr <- snd `fmap` floatLocation w
|
||||
-- ensure that float windows don't go over the edge of the screen
|
||||
let adjust (W.RationalRect x y wid h) | x + wid > 1 || y + h > 1 || x < 0 || y < 0
|
||||
= W.RationalRect (0.5 - wid/2) (0.5 - h/2) wid h
|
||||
adjust r = r
|
||||
|
||||
f ws | shouldFloat = W.float w (adjust rr) . W.insertUp w . W.view i $ ws
|
||||
| otherwise = W.insertUp w ws
|
||||
where i = W.tag $ W.workspace $ W.current ws
|
||||
|
||||
mh <- asks (manageHook . config)
|
||||
g <- appEndo <$> userCodeDef (Endo id) (runQuery mh w)
|
||||
windows (g . f)
|
||||
|
||||
-- | A window no longer exists; remove it from the window
|
||||
-- list, on whatever workspace it is.
|
||||
--
|
||||
unmanage :: Window -> X ()
|
||||
unmanage = windows . W.delete
|
||||
|
||||
-- | Kill the specified window. If we do kill it, we'll get a
|
||||
-- delete notify back from X.
|
||||
--
|
||||
-- There are two ways to delete a window. Either just kill it, or if it
|
||||
-- supports the delete protocol, send a delete event (e.g. firefox)
|
||||
--
|
||||
killWindow :: Window -> X ()
|
||||
killWindow w = withDisplay $ \d -> do
|
||||
wmdelt <- atom_WM_DELETE_WINDOW ; wmprot <- atom_WM_PROTOCOLS
|
||||
|
||||
protocols <- io $ getWMProtocols d w
|
||||
io $ if wmdelt `elem` protocols
|
||||
then allocaXEvent $ \ev -> do
|
||||
setEventType ev clientMessage
|
||||
setClientMessageEvent ev w wmprot 32 wmdelt currentTime
|
||||
sendEvent d w False noEventMask ev
|
||||
else void (killClient d w)
|
||||
|
||||
-- | Kill the currently focused client.
|
||||
kill :: X ()
|
||||
kill = withFocused killWindow
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Managing windows
|
||||
|
||||
-- | Modify the current window list with a pure function, and refresh
|
||||
windows :: (WindowSet -> WindowSet) -> X ()
|
||||
windows f = do
|
||||
XState { windowset = old } <- get
|
||||
let oldvisible = concatMap (W.integrate' . W.stack . W.workspace) $ W.current old : W.visible old
|
||||
newwindows = W.allWindows ws \\ W.allWindows old
|
||||
ws = f old
|
||||
XConf { display = d , normalBorder = nbc, focusedBorder = fbc } <- ask
|
||||
|
||||
mapM_ setInitialProperties newwindows
|
||||
|
||||
whenJust (W.peek old) $ \otherw -> do
|
||||
nbs <- asks (normalBorderColor . config)
|
||||
setWindowBorderWithFallback d otherw nbs nbc
|
||||
|
||||
modify (\s -> s { windowset = ws })
|
||||
|
||||
-- notify non visibility
|
||||
let tags_oldvisible = map (W.tag . W.workspace) $ W.current old : W.visible old
|
||||
gottenhidden = filter (flip elem tags_oldvisible . W.tag) $ W.hidden ws
|
||||
mapM_ (sendMessageWithNoRefresh Hide) gottenhidden
|
||||
|
||||
-- for each workspace, layout the currently visible workspaces
|
||||
let allscreens = W.screens ws
|
||||
summed_visible = scanl (++) [] $ map (W.integrate' . W.stack . W.workspace) allscreens
|
||||
rects <- fmap concat $ forM (zip allscreens summed_visible) $ \ (w, vis) -> do
|
||||
let wsp = W.workspace w
|
||||
this = W.view n ws
|
||||
n = W.tag wsp
|
||||
tiled = (W.stack . W.workspace . W.current $ this)
|
||||
>>= W.filter (`M.notMember` W.floating ws)
|
||||
>>= W.filter (`notElem` vis)
|
||||
viewrect = screenRect $ W.screenDetail w
|
||||
|
||||
-- just the tiled windows:
|
||||
-- now tile the windows on this workspace, modified by the gap
|
||||
(rs, ml') <- runLayout wsp { W.stack = tiled } viewrect `catchX`
|
||||
runLayout wsp { W.stack = tiled, W.layout = Layout Full } viewrect
|
||||
updateLayout n ml'
|
||||
|
||||
let m = W.floating ws
|
||||
flt = [(fw, scaleRationalRect viewrect r)
|
||||
| fw <- filter (`M.member` m) (W.index this)
|
||||
, fw `notElem` vis
|
||||
, Just r <- [M.lookup fw m]]
|
||||
vs = flt ++ rs
|
||||
|
||||
io $ restackWindows d (map fst vs)
|
||||
-- return the visible windows for this workspace:
|
||||
return vs
|
||||
|
||||
let visible = map fst rects
|
||||
|
||||
mapM_ (uncurry tileWindow) rects
|
||||
|
||||
whenJust (W.peek ws) $ \w -> do
|
||||
fbs <- asks (focusedBorderColor . config)
|
||||
setWindowBorderWithFallback d w fbs fbc
|
||||
|
||||
mapM_ reveal visible
|
||||
setTopFocus
|
||||
|
||||
-- hide every window that was potentially visible before, but is not
|
||||
-- given a position by a layout now.
|
||||
mapM_ hide (nub (oldvisible ++ newwindows) \\ visible)
|
||||
|
||||
-- all windows that are no longer in the windowset are marked as
|
||||
-- withdrawn, it is important to do this after the above, otherwise 'hide'
|
||||
-- will overwrite withdrawnState with iconicState
|
||||
mapM_ (`setWMState` withdrawnState) (W.allWindows old \\ W.allWindows ws)
|
||||
|
||||
isMouseFocused <- asks mouseFocused
|
||||
unless isMouseFocused $ clearEvents enterWindowMask
|
||||
asks (logHook . config) >>= userCodeDef ()
|
||||
|
||||
-- | Modify the @WindowSet@ in state with no special handling.
|
||||
modifyWindowSet :: (WindowSet -> WindowSet) -> X ()
|
||||
modifyWindowSet f = modify $ \xst -> xst { windowset = f (windowset xst) }
|
||||
|
||||
-- | Perform an @X@ action and check its return value against a predicate p.
|
||||
-- If p holds, unwind changes to the @WindowSet@ and replay them using @windows@.
|
||||
windowBracket :: (a -> Bool) -> X a -> X a
|
||||
windowBracket p action = withWindowSet $ \old -> do
|
||||
a <- action
|
||||
when (p a) . withWindowSet $ \new -> do
|
||||
modifyWindowSet $ const old
|
||||
windows $ const new
|
||||
return a
|
||||
|
||||
-- | Perform an @X@ action. If it returns @Any True@, unwind the
|
||||
-- changes to the @WindowSet@ and replay them using @windows@. This is
|
||||
-- a version of @windowBracket@ that discards the return value and
|
||||
-- handles an @X@ action that reports its need for refresh via @Any@.
|
||||
windowBracket_ :: X Any -> X ()
|
||||
windowBracket_ = void . windowBracket getAny
|
||||
|
||||
-- | Produce the actual rectangle from a screen and a ratio on that screen.
|
||||
scaleRationalRect :: Rectangle -> W.RationalRect -> Rectangle
|
||||
scaleRationalRect (Rectangle sx sy sw sh) (W.RationalRect rx ry rw rh)
|
||||
= Rectangle (sx + scale sw rx) (sy + scale sh ry) (scale sw rw) (scale sh rh)
|
||||
where scale s r = floor (toRational s * r)
|
||||
|
||||
-- | Set a window's WM_STATE property.
|
||||
setWMState :: Window -> Int -> X ()
|
||||
setWMState w v = withDisplay $ \dpy -> do
|
||||
a <- atom_WM_STATE
|
||||
io $ changeProperty32 dpy w a a propModeReplace [fromIntegral v, fromIntegral none]
|
||||
|
||||
-- | Set the border color using the window's color map, if possible;
|
||||
-- otherwise fall back to the color in @Pixel@.
|
||||
setWindowBorderWithFallback :: Display -> Window -> String -> Pixel -> X ()
|
||||
setWindowBorderWithFallback dpy w color basic = io $
|
||||
C.handle fallback $ do
|
||||
wa <- getWindowAttributes dpy w
|
||||
pixel <- setPixelSolid . color_pixel . fst <$> allocNamedColor dpy (wa_colormap wa) color
|
||||
setWindowBorder dpy w pixel
|
||||
where
|
||||
fallback :: C.SomeException -> IO ()
|
||||
fallback _ = setWindowBorder dpy w basic
|
||||
|
||||
-- | Hide a window by unmapping it and setting Iconified.
|
||||
hide :: Window -> X ()
|
||||
hide w = whenX (gets (S.member w . mapped)) $ withDisplay $ \d -> do
|
||||
cMask <- asks $ clientMask . config
|
||||
io $ do selectInput d w (cMask .&. complement structureNotifyMask)
|
||||
unmapWindow d w
|
||||
selectInput d w cMask
|
||||
setWMState w iconicState
|
||||
-- this part is key: we increment the waitingUnmap counter to distinguish
|
||||
-- between client and xmonad initiated unmaps.
|
||||
modify (\s -> s { waitingUnmap = M.insertWith (+) w 1 (waitingUnmap s)
|
||||
, mapped = S.delete w (mapped s) })
|
||||
|
||||
-- | Show a window by mapping it and setting Normal.
|
||||
-- This is harmless if the window was already visible.
|
||||
reveal :: Window -> X ()
|
||||
reveal w = withDisplay $ \d -> do
|
||||
setWMState w normalState
|
||||
io $ mapWindow d w
|
||||
whenX (isClient w) $ modify (\s -> s { mapped = S.insert w (mapped s) })
|
||||
|
||||
-- | Set some properties when we initially gain control of a window.
|
||||
setInitialProperties :: Window -> X ()
|
||||
setInitialProperties w = asks normalBorder >>= \nb -> withDisplay $ \d -> do
|
||||
setWMState w iconicState
|
||||
asks (clientMask . config) >>= io . selectInput d w
|
||||
bw <- asks (borderWidth . config)
|
||||
io $ setWindowBorderWidth d w bw
|
||||
-- we must initially set the color of new windows, to maintain invariants
|
||||
-- required by the border setting in 'windows'
|
||||
io $ setWindowBorder d w nb
|
||||
|
||||
-- | Render the currently visible workspaces, as determined by
|
||||
-- the 'StackSet'. Also, set focus to the focused window.
|
||||
--
|
||||
-- This is our 'view' operation (MVC), in that it pretty prints our model
|
||||
-- with X calls.
|
||||
--
|
||||
refresh :: X ()
|
||||
refresh = windows id
|
||||
|
||||
-- | Remove all events of a given type from the event queue.
|
||||
clearEvents :: EventMask -> X ()
|
||||
clearEvents mask = withDisplay $ \d -> io $ do
|
||||
sync d False
|
||||
allocaXEvent $ \p -> fix $ \again -> do
|
||||
more <- checkMaskEvent d mask p
|
||||
when more again -- beautiful
|
||||
|
||||
-- | Move and resize @w@ such that it fits inside the given rectangle,
|
||||
-- including its border.
|
||||
tileWindow :: Window -> Rectangle -> X ()
|
||||
tileWindow w r = withDisplay $ \d -> withWindowAttributes d w $ \wa -> do
|
||||
-- give all windows at least 1x1 pixels
|
||||
let bw = fromIntegral $ wa_border_width wa
|
||||
least x | x <= bw*2 = 1
|
||||
| otherwise = x - bw*2
|
||||
io $ moveResizeWindow d w (rect_x r) (rect_y r)
|
||||
(least $ rect_width r) (least $ rect_height r)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Returns 'True' if the first rectangle is contained within, but not equal
|
||||
-- to the second.
|
||||
containedIn :: Rectangle -> Rectangle -> Bool
|
||||
containedIn r1@(Rectangle x1 y1 w1 h1) r2@(Rectangle x2 y2 w2 h2)
|
||||
= and [ r1 /= r2
|
||||
, x1 >= x2
|
||||
, y1 >= y2
|
||||
, fromIntegral x1 + w1 <= fromIntegral x2 + w2
|
||||
, fromIntegral y1 + h1 <= fromIntegral y2 + h2 ]
|
||||
|
||||
-- | Given a list of screens, remove all duplicated screens and screens that
|
||||
-- are entirely contained within another.
|
||||
nubScreens :: [Rectangle] -> [Rectangle]
|
||||
nubScreens xs = nub . filter (\x -> not $ any (x `containedIn`) xs) $ xs
|
||||
|
||||
-- | Clean the list of screens according to the rules documented for
|
||||
-- nubScreens.
|
||||
getCleanedScreenInfo :: MonadIO m => Display -> m [Rectangle]
|
||||
getCleanedScreenInfo = io . fmap nubScreens . getScreenInfo
|
||||
|
||||
-- | The screen configuration may have changed (due to -- xrandr),
|
||||
-- update the state and refresh the screen, and reset the gap.
|
||||
rescreen :: X ()
|
||||
rescreen = withDisplay getCleanedScreenInfo >>= \case
|
||||
[] -> trace "getCleanedScreenInfo returned []"
|
||||
xinesc:xinescs ->
|
||||
windows $ \ws@W.StackSet{ W.current = v, W.visible = vs, W.hidden = hs } ->
|
||||
let (xs, ys) = splitAt (length xinescs) (map W.workspace vs ++ hs)
|
||||
a = W.Screen (W.workspace v) 0 (SD xinesc)
|
||||
as = zipWith3 W.Screen xs [1..] $ map SD xinescs
|
||||
in ws { W.current = a
|
||||
, W.visible = as
|
||||
, W.hidden = ys }
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
-- | Tell whether or not to intercept clicks on a given window
|
||||
setButtonGrab :: Bool -> Window -> X ()
|
||||
setButtonGrab grab w = do
|
||||
pointerMode <- asks $ \c -> if clickJustFocuses (config c)
|
||||
then grabModeAsync
|
||||
else grabModeSync
|
||||
withDisplay $ \d -> io $ if grab
|
||||
then forM_ [button1, button2, button3] $ \b ->
|
||||
grabButton d b anyModifier w False buttonPressMask
|
||||
pointerMode grabModeSync none none
|
||||
else ungrabButton d anyButton anyModifier w
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Setting keyboard focus
|
||||
|
||||
-- | Set the focus to the window on top of the stack, or root
|
||||
setTopFocus :: X ()
|
||||
setTopFocus = withWindowSet $ maybe (setFocusX =<< asks theRoot) setFocusX . W.peek
|
||||
|
||||
-- | Set focus explicitly to window 'w' if it is managed by us, or root.
|
||||
-- This happens if X notices we've moved the mouse (and perhaps moved
|
||||
-- the mouse to a new screen).
|
||||
focus :: Window -> X ()
|
||||
focus w = local (\c -> c { mouseFocused = True }) $ withWindowSet $ \s -> do
|
||||
let stag = W.tag . W.workspace
|
||||
curr = stag $ W.current s
|
||||
mnew <- maybe (return Nothing) (fmap (fmap stag) . uncurry pointScreen)
|
||||
=<< asks mousePosition
|
||||
root <- asks theRoot
|
||||
case () of
|
||||
_ | W.member w s && W.peek s /= Just w -> windows (W.focusWindow w)
|
||||
| Just new <- mnew, w == root && curr /= new
|
||||
-> windows (W.view new)
|
||||
| otherwise -> return ()
|
||||
|
||||
-- | Call X to set the keyboard focus details.
|
||||
setFocusX :: Window -> X ()
|
||||
setFocusX w = withWindowSet $ \ws -> do
|
||||
dpy <- asks display
|
||||
|
||||
-- clear mouse button grab and border on other windows
|
||||
forM_ (W.current ws : W.visible ws) $ \wk ->
|
||||
forM_ (W.index (W.view (W.tag (W.workspace wk)) ws)) $ \otherw ->
|
||||
setButtonGrab True otherw
|
||||
|
||||
-- If we ungrab buttons on the root window, we lose our mouse bindings.
|
||||
whenX (not <$> isRoot w) $ setButtonGrab False w
|
||||
|
||||
hints <- io $ getWMHints dpy w
|
||||
protocols <- io $ getWMProtocols dpy w
|
||||
wmprot <- atom_WM_PROTOCOLS
|
||||
wmtf <- atom_WM_TAKE_FOCUS
|
||||
currevt <- asks currentEvent
|
||||
let inputHintSet = wmh_flags hints `testBit` inputHintBit
|
||||
|
||||
when (inputHintSet && wmh_input hints || not inputHintSet) $
|
||||
io $ do setInputFocus dpy w revertToPointerRoot 0
|
||||
when (wmtf `elem` protocols) $
|
||||
io $ allocaXEvent $ \ev -> do
|
||||
setEventType ev clientMessage
|
||||
setClientMessageEvent ev w wmprot 32 wmtf $ maybe currentTime event_time currevt
|
||||
sendEvent dpy w False noEventMask ev
|
||||
where event_time ev =
|
||||
if ev_event_type ev `elem` timedEvents then
|
||||
ev_time ev
|
||||
else
|
||||
currentTime
|
||||
timedEvents = [ keyPress, keyRelease, buttonPress, buttonRelease, enterNotify, leaveNotify, selectionRequest ]
|
||||
|
||||
cacheNumlockMask :: X ()
|
||||
cacheNumlockMask = do
|
||||
dpy <- asks display
|
||||
ms <- io $ getModifierMapping dpy
|
||||
xs <- sequence [ do ks <- io $ keycodeToKeysym dpy kc 0
|
||||
if ks == xK_Num_Lock
|
||||
then return (setBit 0 (fromIntegral m))
|
||||
else return (0 :: KeyMask)
|
||||
| (m, kcs) <- ms, kc <- kcs, kc /= 0
|
||||
]
|
||||
modify (\s -> s { numberlockMask = foldr (.|.) 0 xs })
|
||||
|
||||
-- | Given a list of keybindings, turn the given 'KeySym's into actual
|
||||
-- 'KeyCode's and prepare them for grabbing.
|
||||
mkGrabs :: [(KeyMask, KeySym)] -> X [(KeyMask, KeyCode)]
|
||||
mkGrabs ks = withDisplay $ \dpy -> do
|
||||
let (minCode, maxCode) = displayKeycodes dpy
|
||||
allCodes = [fromIntegral minCode .. fromIntegral maxCode]
|
||||
-- build a map from keysyms to lists of keysyms (doing what
|
||||
-- XGetKeyboardMapping would do if the X11 package bound it)
|
||||
syms <- forM allCodes $ \code -> io (keycodeToKeysym dpy code 0)
|
||||
let -- keycodeToKeysym returns noSymbol for all unbound keycodes,
|
||||
-- and we don't want to grab those whenever someone accidentally
|
||||
-- uses def :: KeySym
|
||||
keysymMap = M.delete noSymbol $
|
||||
M.fromListWith (++) (zip syms [[code] | code <- allCodes])
|
||||
keysymToKeycodes sym = M.findWithDefault [] sym keysymMap
|
||||
extraMods <- extraModifiers
|
||||
pure [ (mask .|. extraMod, keycode)
|
||||
| (mask, sym) <- ks
|
||||
, keycode <- keysymToKeycodes sym
|
||||
, extraMod <- extraMods
|
||||
]
|
||||
|
||||
-- | Release XMonad's keyboard grab, so other grabbers can do their thing.
|
||||
--
|
||||
-- Start a keyboard action with this if it is going to run something
|
||||
-- that needs to do a keyboard, pointer, or server grab. For example,
|
||||
--
|
||||
-- > , ((modm .|. controlMask, xK_p), unGrab >> spawn "scrot")
|
||||
--
|
||||
-- (Other examples are certain screen lockers and "gksu".)
|
||||
-- This avoids needing to insert a pause/sleep before running the
|
||||
-- command.
|
||||
--
|
||||
-- XMonad retains the keyboard grab during key actions because if they
|
||||
-- use a submap, they need the keyboard to be grabbed, and if they had
|
||||
-- to assert their own grab then the asynchronous nature of X11 allows
|
||||
-- race conditions between XMonad, other clients, and the X server that
|
||||
-- would cause keys to sometimes be "leaked" to the focused window.
|
||||
unGrab :: X ()
|
||||
unGrab = withDisplay $ \d -> io $ do
|
||||
ungrabKeyboard d currentTime
|
||||
ungrabPointer d currentTime
|
||||
sync d False
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Message handling
|
||||
|
||||
-- | Throw a message to the current 'LayoutClass' possibly modifying how we
|
||||
-- layout the windows, in which case changes are handled through a refresh.
|
||||
sendMessage :: Message a => a -> X ()
|
||||
sendMessage a = windowBracket_ $ do
|
||||
w <- gets $ W.workspace . W.current . windowset
|
||||
ml' <- handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing
|
||||
whenJust ml' $ \l' ->
|
||||
modifyWindowSet $ \ws -> ws { W.current = (W.current ws)
|
||||
{ W.workspace = (W.workspace $ W.current ws)
|
||||
{ W.layout = l' }}}
|
||||
return (Any $ isJust ml')
|
||||
|
||||
-- | Send a message to all layouts, without refreshing.
|
||||
broadcastMessage :: Message a => a -> X ()
|
||||
broadcastMessage a = withWindowSet $ \ws -> do
|
||||
-- this is O(n²), but we can't really fix this as there's code in
|
||||
-- xmonad-contrib that touches the windowset during handleMessage
|
||||
-- (returning Nothing for changes to not get overwritten), so we
|
||||
-- unfortunately need to do this one by one and persist layout states
|
||||
-- of each workspace separately)
|
||||
let c = W.workspace . W.current $ ws
|
||||
v = map W.workspace . W.visible $ ws
|
||||
h = W.hidden ws
|
||||
mapM_ (sendMessageWithNoRefresh a) (c : v ++ h)
|
||||
|
||||
-- | Send a message to a layout, without refreshing.
|
||||
sendMessageWithNoRefresh :: Message a => a -> WindowSpace -> X ()
|
||||
sendMessageWithNoRefresh a w =
|
||||
handleMessage (W.layout w) (SomeMessage a) `catchX` return Nothing >>=
|
||||
updateLayout (W.tag w)
|
||||
|
||||
-- | Update the layout field of a workspace.
|
||||
updateLayout :: WorkspaceId -> Maybe (Layout Window) -> X ()
|
||||
updateLayout i ml = whenJust ml $ \l ->
|
||||
runOnWorkspaces $ \ww -> return $ if W.tag ww == i then ww { W.layout = l} else ww
|
||||
|
||||
-- | Set the layout of the currently viewed workspace.
|
||||
setLayout :: Layout Window -> X ()
|
||||
setLayout l = do
|
||||
ss@W.StackSet{ W.current = c@W.Screen{ W.workspace = ws }} <- gets windowset
|
||||
handleMessage (W.layout ws) (SomeMessage ReleaseResources)
|
||||
windows $ const $ ss{ W.current = c{ W.workspace = ws{ W.layout = l } } }
|
||||
|
||||
-- | Signal xmonad to restart itself.
|
||||
sendRestart :: IO ()
|
||||
sendRestart = do
|
||||
dpy <- openDisplay ""
|
||||
rw <- rootWindow dpy $ defaultScreen dpy
|
||||
xmonad_restart <- internAtom dpy "XMONAD_RESTART" False
|
||||
allocaXEvent $ \e -> do
|
||||
setEventType e clientMessage
|
||||
setClientMessageEvent' e rw xmonad_restart 32 []
|
||||
sendEvent dpy rw False structureNotifyMask e
|
||||
sync dpy False
|
||||
|
||||
-- | Signal compliant window managers to exit.
|
||||
sendReplace :: IO ()
|
||||
sendReplace = do
|
||||
dpy <- openDisplay ""
|
||||
let dflt = defaultScreen dpy
|
||||
rootw <- rootWindow dpy dflt
|
||||
replace dpy dflt rootw
|
||||
|
||||
-- | Signal compliant window managers to exit.
|
||||
replace :: Display -> ScreenNumber -> Window -> IO ()
|
||||
replace dpy dflt rootw = do
|
||||
-- check for other WM
|
||||
wmSnAtom <- internAtom dpy ("WM_S" ++ show dflt) False
|
||||
currentWmSnOwner <- xGetSelectionOwner dpy wmSnAtom
|
||||
when (currentWmSnOwner /= 0) $ do
|
||||
-- prepare to receive destroyNotify for old WM
|
||||
selectInput dpy currentWmSnOwner structureNotifyMask
|
||||
|
||||
-- create off-screen window
|
||||
netWmSnOwner <- allocaSetWindowAttributes $ \attributes -> do
|
||||
set_override_redirect attributes True
|
||||
set_event_mask attributes propertyChangeMask
|
||||
let screen = defaultScreenOfDisplay dpy
|
||||
visual = defaultVisualOfScreen screen
|
||||
attrmask = cWOverrideRedirect .|. cWEventMask
|
||||
createWindow dpy rootw (-100) (-100) 1 1 0 copyFromParent copyFromParent visual attrmask attributes
|
||||
|
||||
-- try to acquire wmSnAtom, this should signal the old WM to terminate
|
||||
xSetSelectionOwner dpy wmSnAtom netWmSnOwner currentTime
|
||||
|
||||
-- SKIPPED: check if we acquired the selection
|
||||
-- SKIPPED: send client message indicating that we are now the WM
|
||||
|
||||
-- wait for old WM to go away
|
||||
fix $ \again -> do
|
||||
evt <- allocaXEvent $ \event -> do
|
||||
windowEvent dpy currentWmSnOwner structureNotifyMask event
|
||||
get_EventType event
|
||||
|
||||
when (evt /= destroyNotify) again
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Utilities
|
||||
|
||||
-- | Return workspace visible on screen @sc@, or 'Nothing'.
|
||||
screenWorkspace :: ScreenId -> X (Maybe WorkspaceId)
|
||||
screenWorkspace sc = withWindowSet $ return . W.lookupWorkspace sc
|
||||
|
||||
-- | Apply an 'X' operation to the currently focused window, if there is one.
|
||||
withFocused :: (Window -> X ()) -> X ()
|
||||
withFocused f = withWindowSet $ \w -> whenJust (W.peek w) f
|
||||
|
||||
-- | Apply an 'X' operation to all unfocused windows on the current workspace, if there are any.
|
||||
withUnfocused :: (Window -> X ()) -> X ()
|
||||
withUnfocused f = withWindowSet $ \ws ->
|
||||
whenJust (W.peek ws) $ \w ->
|
||||
let unfocusedWindows = filter (/= w) $ W.index ws
|
||||
in mapM_ f unfocusedWindows
|
||||
|
||||
-- | Is the window is under management by xmonad?
|
||||
isClient :: Window -> X Bool
|
||||
isClient w = withWindowSet $ return . W.member w
|
||||
|
||||
-- | Combinations of extra modifier masks we need to grab keys\/buttons for.
|
||||
-- (numlock and capslock)
|
||||
extraModifiers :: X [KeyMask]
|
||||
extraModifiers = do
|
||||
nlm <- gets numberlockMask
|
||||
return [0, nlm, lockMask, nlm .|. lockMask ]
|
||||
|
||||
-- | Strip numlock\/capslock from a mask.
|
||||
cleanMask :: KeyMask -> X KeyMask
|
||||
cleanMask km = do
|
||||
nlm <- gets numberlockMask
|
||||
return (complement (nlm .|. lockMask) .&. km)
|
||||
|
||||
-- | Set the 'Pixel' alpha value to 255.
|
||||
setPixelSolid :: Pixel -> Pixel
|
||||
setPixelSolid p = p .|. 0xff000000
|
||||
|
||||
-- | Get the 'Pixel' value for a named color.
|
||||
initColor :: Display -> String -> IO (Maybe Pixel)
|
||||
initColor dpy c = C.handle (\(C.SomeException _) -> return Nothing) $
|
||||
Just . setPixelSolid . color_pixel . fst <$> allocNamedColor dpy colormap c
|
||||
where colormap = defaultColormap dpy (defaultScreen dpy)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- | A type to help serialize xmonad's state to a file.
|
||||
data StateFile = StateFile
|
||||
{ sfWins :: W.StackSet WorkspaceId String Window ScreenId ScreenDetail
|
||||
, sfExt :: [(String, String)]
|
||||
} deriving (Show, Read)
|
||||
|
||||
-- | Write the current window state (and extensible state) to a file
|
||||
-- so that xmonad can resume with that state intact.
|
||||
writeStateToFile :: X ()
|
||||
writeStateToFile = do
|
||||
let maybeShow (t, Right (PersistentExtension ext)) = Just (t, show ext)
|
||||
maybeShow (t, Left str) = Just (t, str)
|
||||
maybeShow _ = Nothing
|
||||
|
||||
wsData = W.mapLayout show . windowset
|
||||
extState = mapMaybe maybeShow . M.toList . extensibleState
|
||||
|
||||
path <- asks $ stateFileName . directories
|
||||
stateData <- gets (\s -> StateFile (wsData s) (extState s))
|
||||
catchIO (writeFile path $ show stateData)
|
||||
|
||||
-- | Read the state of a previous xmonad instance from a file and
|
||||
-- return that state. The state file is removed after reading it.
|
||||
readStateFile :: (LayoutClass l Window, Read (l Window)) => XConfig l -> X (Maybe XState)
|
||||
readStateFile xmc = do
|
||||
path <- asks $ stateFileName . directories
|
||||
|
||||
-- I'm trying really hard here to make sure we read the entire
|
||||
-- contents of the file before it is removed from the file system.
|
||||
sf' <- userCode . io $ do
|
||||
raw <- withFile path ReadMode readStrict
|
||||
return $! maybeRead reads raw
|
||||
|
||||
io (removeFile path)
|
||||
|
||||
return $ do
|
||||
sf <- join sf'
|
||||
|
||||
let winset = W.ensureTags layout (workspaces xmc) $ W.mapLayout (fromMaybe layout . maybeRead lreads) (sfWins sf)
|
||||
extState = M.fromList . map (second Left) $ sfExt sf
|
||||
|
||||
return XState { windowset = winset
|
||||
, numberlockMask = 0
|
||||
, mapped = S.empty
|
||||
, waitingUnmap = M.empty
|
||||
, dragging = Nothing
|
||||
, extensibleState = extState
|
||||
}
|
||||
where
|
||||
layout = Layout (layoutHook xmc)
|
||||
lreads = readsLayout layout
|
||||
maybeRead reads' s = case reads' s of
|
||||
[(x, "")] -> Just x
|
||||
_ -> Nothing
|
||||
|
||||
readStrict :: Handle -> IO String
|
||||
readStrict h = hGetContents h >>= \s -> length s `seq` return s
|
||||
|
||||
-- | @restart name resume@ attempts to restart xmonad by executing the program
|
||||
-- @name@. If @resume@ is 'True', restart with the current window state.
|
||||
-- When executing another window manager, @resume@ should be 'False'.
|
||||
restart :: String -> Bool -> X ()
|
||||
restart prog resume = do
|
||||
broadcastMessage ReleaseResources
|
||||
io . flush =<< asks display
|
||||
when resume writeStateToFile
|
||||
catchIO (executeFile prog True [] Nothing)
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Floating layer support
|
||||
|
||||
-- | Given a window, find the screen it is located on, and compute
|
||||
-- the geometry of that window WRT that screen.
|
||||
floatLocation :: Window -> X (ScreenId, W.RationalRect)
|
||||
floatLocation w =
|
||||
catchX go $ do
|
||||
-- Fallback solution if `go' fails. Which it might, since it
|
||||
-- calls `getWindowAttributes'.
|
||||
sc <- gets $ W.current . windowset
|
||||
return (W.screen sc, W.RationalRect 0 0 1 1)
|
||||
|
||||
where go = withDisplay $ \d -> do
|
||||
ws <- gets windowset
|
||||
sh <- io $ getWMNormalHints d w
|
||||
wa <- io $ getWindowAttributes d w
|
||||
let bw = (fromIntegral . wa_border_width) wa
|
||||
point_sc <- pointScreen (fi $ wa_x wa) (fi $ wa_y wa)
|
||||
managed <- isClient w
|
||||
|
||||
-- ignore pointScreen for new windows unless it's the current
|
||||
-- screen, otherwise the float's relative size is computed against
|
||||
-- a different screen and the float ends up with the wrong size
|
||||
let sr_eq = (==) `on` fmap (screenRect . W.screenDetail)
|
||||
sc = fromMaybe (W.current ws) $
|
||||
if managed || point_sc `sr_eq` Just (W.current ws) then point_sc else Nothing
|
||||
sr = screenRect . W.screenDetail $ sc
|
||||
x = (fi (wa_x wa) - fi (rect_x sr)) % fi (rect_width sr)
|
||||
y = (fi (wa_y wa) - fi (rect_y sr)) % fi (rect_height sr)
|
||||
(width, height) = applySizeHintsContents sh (wa_width wa, wa_height wa)
|
||||
rwidth = fi (width + bw*2) % fi (rect_width sr)
|
||||
rheight = fi (height + bw*2) % fi (rect_height sr)
|
||||
-- adjust x/y of unmanaged windows if we ignored or didn't get pointScreen,
|
||||
-- it might be out of bounds otherwise
|
||||
rr = if managed || point_sc `sr_eq` Just sc
|
||||
then W.RationalRect x y rwidth rheight
|
||||
else W.RationalRect (0.5 - rwidth/2) (0.5 - rheight/2) rwidth rheight
|
||||
|
||||
return (W.screen sc, rr)
|
||||
|
||||
fi :: (Integral a, Num b) => a -> b
|
||||
fi = fromIntegral
|
||||
|
||||
-- | Given a point, determine the screen (if any) that contains it.
|
||||
pointScreen :: Position -> Position
|
||||
-> X (Maybe (W.Screen WorkspaceId (Layout Window) Window ScreenId ScreenDetail))
|
||||
pointScreen x y = withWindowSet $ return . find p . W.screens
|
||||
where p = pointWithin x y . screenRect . W.screenDetail
|
||||
|
||||
-- | @pointWithin x y r@ returns 'True' if the @(x, y)@ co-ordinate is within
|
||||
-- @r@.
|
||||
pointWithin :: Position -> Position -> Rectangle -> Bool
|
||||
pointWithin x y r = x >= rect_x r &&
|
||||
x < rect_x r + fromIntegral (rect_width r) &&
|
||||
y >= rect_y r &&
|
||||
y < rect_y r + fromIntegral (rect_height r)
|
||||
|
||||
-- | Make a tiled window floating, using its suggested rectangle
|
||||
float :: Window -> X ()
|
||||
float w = do
|
||||
(sc, rr) <- floatLocation w
|
||||
windows $ \ws -> W.float w rr . fromMaybe ws $ do
|
||||
i <- W.findTag w ws
|
||||
guard $ i `elem` map (W.tag . W.workspace) (W.screens ws)
|
||||
f <- W.peek ws
|
||||
sw <- W.lookupWorkspace sc ws
|
||||
return (W.focusWindow f . W.shiftWin sw w $ ws)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Mouse handling
|
||||
|
||||
-- | Accumulate mouse motion events
|
||||
mouseDrag :: (Position -> Position -> X ()) -> X () -> X ()
|
||||
mouseDrag = mouseDragCursor Nothing
|
||||
|
||||
-- | Like 'mouseDrag', but with the ability to specify a custom cursor
|
||||
-- shape.
|
||||
mouseDragCursor :: Maybe Glyph -> (Position -> Position -> X ()) -> X () -> X ()
|
||||
mouseDragCursor cursorGlyph f done = do
|
||||
drag <- gets dragging
|
||||
case drag of
|
||||
Just _ -> return () -- error case? we're already dragging
|
||||
Nothing -> do
|
||||
XConf { theRoot = root, display = d } <- ask
|
||||
io $ do cursor <- maybe (pure none) (createFontCursor d) cursorGlyph
|
||||
grabPointer d root False (buttonReleaseMask .|. pointerMotionMask)
|
||||
grabModeAsync grabModeAsync none cursor currentTime
|
||||
modify $ \s -> s { dragging = Just (motion, cleanup) }
|
||||
where
|
||||
cleanup = do
|
||||
withDisplay $ io . flip ungrabPointer currentTime
|
||||
modify $ \s -> s { dragging = Nothing }
|
||||
done
|
||||
motion x y = do z <- f x y
|
||||
clearEvents pointerMotionMask
|
||||
return z
|
||||
|
||||
-- | Drag the window under the cursor with the mouse while it is dragged.
|
||||
mouseMoveWindow :: Window -> X ()
|
||||
mouseMoveWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
wa <- io $ getWindowAttributes d w
|
||||
(_, _, _, ox', oy', _, _, _) <- io $ queryPointer d w
|
||||
let ox = fromIntegral ox'
|
||||
oy = fromIntegral oy'
|
||||
mouseDragCursor
|
||||
(Just xC_fleur)
|
||||
(\ex ey -> do
|
||||
io $ moveWindow d w (fromIntegral (fromIntegral (wa_x wa) + (ex - ox)))
|
||||
(fromIntegral (fromIntegral (wa_y wa) + (ey - oy)))
|
||||
float w
|
||||
)
|
||||
(float w)
|
||||
|
||||
-- | Resize the window under the cursor with the mouse while it is dragged.
|
||||
mouseResizeWindow :: Window -> X ()
|
||||
mouseResizeWindow w = whenX (isClient w) $ withDisplay $ \d -> do
|
||||
wa <- io $ getWindowAttributes d w
|
||||
sh <- io $ getWMNormalHints d w
|
||||
io $ warpPointer d none w 0 0 0 0 (fromIntegral (wa_width wa)) (fromIntegral (wa_height wa))
|
||||
mouseDragCursor
|
||||
(Just xC_bottom_right_corner)
|
||||
(\ex ey -> do
|
||||
io $ resizeWindow d w `uncurry`
|
||||
applySizeHintsContents sh (ex - fromIntegral (wa_x wa),
|
||||
ey - fromIntegral (wa_y wa))
|
||||
float w)
|
||||
(float w)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- Support for window size hints
|
||||
|
||||
-- | An alias for a (width, height) pair
|
||||
type D = (Dimension, Dimension)
|
||||
|
||||
-- | Given a window, build an adjuster function that will reduce the given
|
||||
-- dimensions according to the window's border width and size hints.
|
||||
mkAdjust :: Window -> X (D -> D)
|
||||
mkAdjust w = withDisplay $ \d -> liftIO $ do
|
||||
sh <- getWMNormalHints d w
|
||||
wa <- C.try $ getWindowAttributes d w
|
||||
case wa of
|
||||
Left (_ :: C.SomeException) -> return id
|
||||
Right wa' ->
|
||||
let bw = fromIntegral $ wa_border_width wa'
|
||||
in return $ applySizeHints bw sh
|
||||
|
||||
-- | Reduce the dimensions if needed to comply to the given SizeHints, taking
|
||||
-- window borders into account.
|
||||
applySizeHints :: Integral a => Dimension -> SizeHints -> (a, a) -> D
|
||||
applySizeHints bw sh =
|
||||
tmap (+ 2 * bw) . applySizeHintsContents sh . tmap (subtract $ 2 * fromIntegral bw)
|
||||
where
|
||||
tmap f (x, y) = (f x, f y)
|
||||
|
||||
-- | Reduce the dimensions if needed to comply to the given SizeHints.
|
||||
applySizeHintsContents :: Integral a => SizeHints -> (a, a) -> D
|
||||
applySizeHintsContents sh (w, h) =
|
||||
applySizeHints' sh (fromIntegral $ max 1 w, fromIntegral $ max 1 h)
|
||||
|
||||
-- | Use X11 size hints to scale a pair of dimensions.
|
||||
applySizeHints' :: SizeHints -> D -> D
|
||||
applySizeHints' sh =
|
||||
maybe id applyMaxSizeHint (sh_max_size sh)
|
||||
. maybe id (\(bw, bh) (w, h) -> (w+bw, h+bh)) (sh_base_size sh)
|
||||
. maybe id applyResizeIncHint (sh_resize_inc sh)
|
||||
. maybe id applyAspectHint (sh_aspect sh)
|
||||
. maybe id (\(bw,bh) (w,h) -> (w-bw, h-bh)) (sh_base_size sh)
|
||||
|
||||
-- | Reduce the dimensions so their aspect ratio falls between the two given aspect ratios.
|
||||
applyAspectHint :: (D, D) -> D -> D
|
||||
applyAspectHint ((minx, miny), (maxx, maxy)) x@(w,h)
|
||||
| or [minx < 1, miny < 1, maxx < 1, maxy < 1] = x
|
||||
| w * maxy > h * maxx = (h * maxx `div` maxy, h)
|
||||
| w * miny < h * minx = (w, w * miny `div` minx)
|
||||
| otherwise = x
|
||||
|
||||
-- | Reduce the dimensions so they are a multiple of the size increments.
|
||||
applyResizeIncHint :: D -> D -> D
|
||||
applyResizeIncHint (iw,ih) x@(w,h) =
|
||||
if iw > 0 && ih > 0 then (w - w `mod` iw, h - h `mod` ih) else x
|
||||
|
||||
-- | Reduce the dimensions if they exceed the given maximum dimensions.
|
||||
applyMaxSizeHint :: D -> D -> D
|
||||
applyMaxSizeHint (mw,mh) x@(w,h) =
|
||||
if mw > 0 && mh > 0 then (min w mw,min h mh) else x
|
@@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE DeriveFunctor #-}
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
@@ -52,9 +53,13 @@ module XMonad.StackSet (
|
||||
) where
|
||||
|
||||
import Prelude hiding (filter)
|
||||
import Data.Maybe (listToMaybe,isJust)
|
||||
import Control.Applicative.Backwards (Backwards (Backwards, forwards))
|
||||
import Data.Foldable (foldr, toList)
|
||||
import Data.Maybe (listToMaybe,isJust,fromMaybe)
|
||||
import qualified Data.List as L (deleteBy,find,splitAt,filter,nub)
|
||||
import Data.List ( (\\) )
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import Data.List.NonEmpty (NonEmpty((:|)))
|
||||
import qualified Data.Map as M (Map,insert,delete,empty)
|
||||
|
||||
-- $intro
|
||||
@@ -85,25 +90,27 @@ import qualified Data.Map as M (Map,insert,delete,empty)
|
||||
-- continuation reified as a data structure.
|
||||
--
|
||||
-- The Zipper lets us replace an item deep in a complex data
|
||||
-- structure, e.g., a tree or a term, without an mutation. The
|
||||
-- structure, e.g., a tree or a term, without a mutation. The
|
||||
-- resulting data structure will share as much of its components with
|
||||
-- the old structure as possible.
|
||||
--
|
||||
-- Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation"
|
||||
-- <https://mail.haskell.org/pipermail/haskell/2005-April/015769.html Oleg Kiselyov, 27 Apr 2005, haskell\@, "Zipper as a delimited continuation">
|
||||
--
|
||||
-- We use the zipper to keep track of the focused workspace and the
|
||||
-- focused window on each workspace, allowing us to have correct focus
|
||||
-- by construction. We closely follow Huet's original implementation:
|
||||
--
|
||||
-- G. Huet, /Functional Pearl: The Zipper/,
|
||||
-- 1997, J. Functional Programming 75(5):549-554.
|
||||
-- and:
|
||||
-- R. Hinze and J. Jeuring, /Functional Pearl: The Web/.
|
||||
-- <https://www.st.cs.uni-saarland.de/edu/seminare/2005/advanced-fp/docs/huet-zipper.pdf G. Huet, Functional Pearl: The Zipper; 1997, J. Functional Programming 75(5):549–554>
|
||||
--
|
||||
-- and Conor McBride's zipper differentiation paper.
|
||||
-- Another good reference is:
|
||||
-- and
|
||||
--
|
||||
-- The Zipper, Haskell wikibook
|
||||
-- <https://dspace.library.uu.nl/handle/1874/2532 R. Hinze and J. Jeuring, Functional Pearl: Weaving a Web>
|
||||
--
|
||||
-- and
|
||||
--
|
||||
-- <http://strictlypositive.org/diff.pdf Conor McBride, The Derivative of a Regular Type is its Type of One-Hole Contexts>.
|
||||
--
|
||||
-- Another good reference is: <https://wiki.haskell.org/Zipper The Zipper, Haskell wikibook>
|
||||
|
||||
-- $xinerama
|
||||
-- Xinerama in X11 lets us view multiple virtual workspaces
|
||||
@@ -151,11 +158,11 @@ data Workspace i l a = Workspace { tag :: !i, layout :: l, stack :: Maybe (Stac
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
-- | A structure for window geometries
|
||||
data RationalRect = RationalRect Rational Rational Rational Rational
|
||||
data RationalRect = RationalRect !Rational !Rational !Rational !Rational
|
||||
deriving (Show, Read, Eq)
|
||||
|
||||
-- |
|
||||
-- A stack is a cursor onto a (possibly empty) window list.
|
||||
-- A stack is a cursor onto a window list.
|
||||
-- The data structure tracks focus by construction, and
|
||||
-- the master window is by convention the top-most item.
|
||||
-- Focus operations will not reorder the list that results from
|
||||
@@ -175,8 +182,19 @@ data RationalRect = RationalRect Rational Rational Rational Rational
|
||||
data Stack a = Stack { focus :: !a -- focused thing in this set
|
||||
, up :: [a] -- clowns to the left
|
||||
, down :: [a] } -- jokers to the right
|
||||
deriving (Show, Read, Eq)
|
||||
deriving (Show, Read, Eq, Functor)
|
||||
|
||||
instance Foldable Stack where
|
||||
toList = integrate
|
||||
foldr f z = foldr f z . toList
|
||||
|
||||
instance Traversable Stack where
|
||||
traverse f s =
|
||||
flip Stack
|
||||
-- 'Backwards' applies the Applicative in reverse order.
|
||||
<$> forwards (traverse (Backwards . f) (up s))
|
||||
<*> f (focus s)
|
||||
<*> traverse f (down s)
|
||||
|
||||
-- | this function indicates to catch that an error is expected
|
||||
abort :: String -> a
|
||||
@@ -194,10 +212,11 @@ abort x = error $ "xmonad: StackSet: " ++ x
|
||||
-- Xinerama: Virtual workspaces are assigned to physical screens, starting at 0.
|
||||
--
|
||||
new :: (Integral s) => l -> [i] -> [sd] -> StackSet i l a s sd
|
||||
new l wids m | not (null wids) && length m <= length wids && not (null m)
|
||||
= StackSet cur visi unseen M.empty
|
||||
where (seen,unseen) = L.splitAt (length m) $ map (\i -> Workspace i l Nothing) wids
|
||||
(cur:visi) = [ Screen i s sd | (i, s, sd) <- zip3 seen [0..] m ]
|
||||
new l (wid:wids) (m:ms) | length ms <= length wids
|
||||
= StackSet cur visi (map ws unseen) M.empty
|
||||
where ws i = Workspace i l Nothing
|
||||
(seen, unseen) = L.splitAt (length ms) wids
|
||||
cur:visi = Screen (ws wid) 0 m : [ Screen (ws i) s sd | (i, s, sd) <- zip3 seen [1..] ms ]
|
||||
-- now zip up visibles with their screen id
|
||||
new _ _ _ = abort "non-positive argument to StackSet.new"
|
||||
|
||||
@@ -224,7 +243,7 @@ view i s
|
||||
|
||||
| otherwise = s -- not a member of the stackset
|
||||
|
||||
where equating f = \x y -> f x == f y
|
||||
where equating f x y = f x == f y
|
||||
|
||||
-- 'Catch'ing this might be hard. Relies on monotonically increasing
|
||||
-- workspace tags defined in 'new'
|
||||
@@ -297,7 +316,7 @@ integrate :: Stack a -> [a]
|
||||
integrate (Stack x l r) = reverse l ++ x : r
|
||||
|
||||
-- |
|
||||
-- /O(n)/ Flatten a possibly empty stack into a list.
|
||||
-- /O(n)/. Flatten a possibly empty stack into a list.
|
||||
integrate' :: Maybe (Stack a) -> [a]
|
||||
integrate' = maybe [] integrate
|
||||
|
||||
@@ -329,32 +348,44 @@ filter p (Stack f ls rs) = case L.filter p (f:rs) of
|
||||
index :: StackSet i l a s sd -> [a]
|
||||
index = with [] integrate
|
||||
|
||||
-- |
|
||||
-- /O(1), O(w) on the wrapping case/.
|
||||
--
|
||||
-- focusUp, focusDown. Move the window focus up or down the stack,
|
||||
-- wrapping if we reach the end. The wrapping should model a 'cycle'
|
||||
-- on the current stack. The 'master' window, and window order,
|
||||
-- | /O(1), O(w) on the wrapping case/. Move the window focus up the
|
||||
-- stack, wrapping if we reach the end. The wrapping should model a
|
||||
-- @cycle@ on the current stack. The @master@ window and window order
|
||||
-- are unaffected by movement of focus.
|
||||
--
|
||||
-- swapUp, swapDown, swap the neighbour in the stack ordering, wrapping
|
||||
-- if we reach the end. Again the wrapping model should 'cycle' on
|
||||
-- the current stack.
|
||||
--
|
||||
focusUp, focusDown, swapUp, swapDown :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusUp :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusUp = modify' focusUp'
|
||||
|
||||
-- | /O(1), O(w) on the wrapping case/. Like 'focusUp', but move the
|
||||
-- window focus down the stack.
|
||||
focusDown :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusDown = modify' focusDown'
|
||||
|
||||
-- | /O(1), O(w) on the wrapping case/. Swap the upwards (left)
|
||||
-- neighbour in the stack ordering, wrapping if we reach the end. Much
|
||||
-- like for 'focusUp' and 'focusDown', the wrapping model should 'cycle'
|
||||
-- on the current stack.
|
||||
swapUp :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
swapUp = modify' swapUp'
|
||||
|
||||
-- | /O(1), O(w) on the wrapping case/. Like 'swapUp', but for swapping
|
||||
-- the downwards (right) neighbour.
|
||||
swapDown :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
swapDown = modify' (reverseStack . swapUp' . reverseStack)
|
||||
|
||||
-- | Variants of 'focusUp' and 'focusDown' that work on a
|
||||
-- | A variant of 'focusUp' with the same asymptotics that works on a
|
||||
-- 'Stack' rather than an entire 'StackSet'.
|
||||
focusUp', focusDown' :: Stack a -> Stack a
|
||||
focusUp' :: Stack a -> Stack a
|
||||
focusUp' (Stack t (l:ls) rs) = Stack l ls (t:rs)
|
||||
focusUp' (Stack t [] rs) = Stack x xs [] where (x:xs) = reverse (t:rs)
|
||||
focusDown' = reverseStack . focusUp' . reverseStack
|
||||
focusUp' (Stack t [] rs) = Stack x xs []
|
||||
where (x :| xs) = NE.reverse (t :| rs)
|
||||
|
||||
-- | A variant of 'focusDown' with the same asymptotics that works on a
|
||||
-- 'Stack' rather than an entire 'StackSet'.
|
||||
focusDown' :: Stack a -> Stack a
|
||||
focusDown' = reverseStack . focusUp' . reverseStack
|
||||
|
||||
-- | A variant of 'spawUp' with the same asymptotics that works on a
|
||||
-- 'Stack' rather than an entire 'StackSet'.
|
||||
swapUp' :: Stack a -> Stack a
|
||||
swapUp' (Stack t (l:ls) rs) = Stack t ls (l:rs)
|
||||
swapUp' (Stack t [] rs) = Stack t (reverse rs) []
|
||||
@@ -369,7 +400,7 @@ reverseStack (Stack t ls rs) = Stack t rs ls
|
||||
--
|
||||
focusWindow :: (Eq s, Eq a, Eq i) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusWindow w s | Just w == peek s = s
|
||||
| otherwise = maybe s id $ do
|
||||
| otherwise = fromMaybe s $ do
|
||||
n <- findTag w s
|
||||
return $ until ((Just w ==) . peek) focusUp (view n s)
|
||||
|
||||
@@ -477,12 +508,12 @@ insertUp a s = if member a s then s else insert
|
||||
--
|
||||
-- * otherwise, delete doesn't affect the master.
|
||||
--
|
||||
delete :: (Ord a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
delete :: (Ord a) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
delete w = sink w . delete' w
|
||||
|
||||
-- | Only temporarily remove the window from the stack, thereby not destroying special
|
||||
-- information saved in the 'Stackset'
|
||||
delete' :: (Eq a, Eq s) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
delete' :: (Eq a) => a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
delete' w s = s { current = removeFromScreen (current s)
|
||||
, visible = map removeFromScreen (visible s)
|
||||
, hidden = map removeFromWorkspace (hidden s) }
|
||||
@@ -508,8 +539,8 @@ sink w s = s { floating = M.delete w (floating s) }
|
||||
-- Focus stays with the item moved.
|
||||
swapMaster :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
swapMaster = modify' $ \c -> case c of
|
||||
Stack _ [] _ -> c -- already master.
|
||||
Stack t ls rs -> Stack t [] (xs ++ x : rs) where (x:xs) = reverse ls
|
||||
Stack _ [] _ -> c -- already master.
|
||||
Stack t (l:ls) rs -> Stack t [] (xs ++ x : rs) where (x :| xs) = NE.reverse (l :| ls)
|
||||
|
||||
-- natural! keep focus, move current to the top, move top to current.
|
||||
|
||||
@@ -525,8 +556,8 @@ shiftMaster = modify' $ \c -> case c of
|
||||
-- | /O(s)/. Set focus to the master window.
|
||||
focusMaster :: StackSet i l a s sd -> StackSet i l a s sd
|
||||
focusMaster = modify' $ \c -> case c of
|
||||
Stack _ [] _ -> c
|
||||
Stack t ls rs -> Stack x [] (xs ++ t : rs) where (x:xs) = reverse ls
|
||||
Stack _ [] _ -> c
|
||||
Stack t (l:ls) rs -> Stack x [] (xs ++ t : rs) where (x :| xs) = NE.reverse (l :| ls)
|
||||
|
||||
--
|
||||
-- ---------------------------------------------------------------------
|
||||
@@ -547,7 +578,7 @@ shift n s = maybe s (\w -> shiftWin n w s) (peek s)
|
||||
-- focused element on that workspace.
|
||||
-- The actual focused workspace doesn't change. If the window is not
|
||||
-- found in the stackSet, the original stackSet is returned.
|
||||
shiftWin :: (Ord a, Eq a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
shiftWin :: (Ord a, Eq s, Eq i) => i -> a -> StackSet i l a s sd -> StackSet i l a s sd
|
||||
shiftWin n w s = case findTag w s of
|
||||
Just from | n `tagMember` s && n /= from -> go from s
|
||||
_ -> s
|
15
stack.yaml
Normal file
15
stack.yaml
Normal file
@@ -0,0 +1,15 @@
|
||||
resolver: lts-21.12
|
||||
|
||||
packages:
|
||||
- ./
|
||||
|
||||
extra-deps:
|
||||
- X11-1.10
|
||||
|
||||
nix:
|
||||
packages:
|
||||
- zlib
|
||||
- xorg.libX11
|
||||
- xorg.libXrandr
|
||||
- xorg.libXScrnSaver
|
||||
- xorg.libXext
|
140
tests/Instances.hs
Normal file
140
tests/Instances.hs
Normal file
@@ -0,0 +1,140 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Instances where
|
||||
|
||||
import Test.QuickCheck
|
||||
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet
|
||||
import Control.Monad
|
||||
import Data.List (nub, genericLength)
|
||||
|
||||
import Debug.Trace
|
||||
|
||||
import Graphics.X11 (Rectangle(Rectangle))
|
||||
import Control.Applicative
|
||||
|
||||
--
|
||||
-- The all important Arbitrary instance for StackSet.
|
||||
--
|
||||
instance (Integral i, Integral s, Eq a, Arbitrary a, Arbitrary l, Arbitrary sd)
|
||||
=> Arbitrary (StackSet i l a s sd) where
|
||||
arbitrary = do
|
||||
-- TODO: Fix this to be a reasonable higher number, Possibly use PositiveSized
|
||||
numWs <- choose (1, 20) -- number of workspaces, there must be at least 1.
|
||||
numScreens <- choose (1, numWs) -- number of physical screens, there must be at least 1
|
||||
lay <- arbitrary -- pick any layout
|
||||
|
||||
wsIdxInFocus <- choose (1, numWs) -- pick index of WS to be in focus
|
||||
|
||||
-- The same screen id's will be present in the list, with high possibility.
|
||||
screens <- replicateM numScreens arbitrary
|
||||
|
||||
-- Generate a list of "windows" for each workspace.
|
||||
wsWindows <- vector numWs :: Gen [[a]]
|
||||
|
||||
-- Pick a random window "number" in each workspace, to give focus.
|
||||
focus <- sequence [ if null windows
|
||||
then return Nothing
|
||||
else Just <$> choose (0, length windows - 1)
|
||||
| windows <- wsWindows ]
|
||||
|
||||
let tags = [1 .. fromIntegral numWs]
|
||||
focusWsWindows = zip focus wsWindows
|
||||
wss = zip tags focusWsWindows -- tmp representation of a workspace (tag, windows)
|
||||
initSs = new lay tags screens
|
||||
return $
|
||||
view (fromIntegral wsIdxInFocus) $
|
||||
foldr (\(tag, (focus, windows)) ss -> -- Fold through all generated (tags,windows).
|
||||
-- set workspace active by tag and fold through all
|
||||
-- windows while inserting them. Apply the given number
|
||||
-- of `focusUp` on the resulting StackSet.
|
||||
applyN focus focusUp $ foldr insertUp (view tag ss) windows
|
||||
) initSs wss
|
||||
|
||||
|
||||
--
|
||||
-- Just generate StackSets with Char elements.
|
||||
--
|
||||
type Tag = Int
|
||||
type Window = Char
|
||||
type T = StackSet Tag Int Window Int Int
|
||||
|
||||
|
||||
|
||||
newtype EmptyStackSet = EmptyStackSet T
|
||||
deriving Show
|
||||
|
||||
instance Arbitrary EmptyStackSet where
|
||||
arbitrary = do
|
||||
(NonEmptyNubList ns) <- arbitrary
|
||||
(NonEmptyNubList sds) <- arbitrary
|
||||
l <- arbitrary
|
||||
-- there cannot be more screens than workspaces:
|
||||
return . EmptyStackSet . new l ns $ take (min (length ns) (length sds)) sds
|
||||
|
||||
|
||||
|
||||
newtype NonEmptyWindowsStackSet = NonEmptyWindowsStackSet T
|
||||
deriving Show
|
||||
|
||||
instance Arbitrary NonEmptyWindowsStackSet where
|
||||
arbitrary =
|
||||
NonEmptyWindowsStackSet <$> (arbitrary `suchThat` (not . null . allWindows))
|
||||
|
||||
instance Arbitrary Rectangle where
|
||||
arbitrary = Rectangle <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
|
||||
|
||||
|
||||
newtype SizedPositive = SizedPositive Int
|
||||
deriving (Eq, Ord, Show, Read)
|
||||
|
||||
instance Arbitrary SizedPositive where
|
||||
arbitrary = sized $ \s -> do x <- choose (1, max 1 s)
|
||||
return $ SizedPositive x
|
||||
|
||||
|
||||
|
||||
newtype NonEmptyNubList a = NonEmptyNubList [a]
|
||||
deriving ( Eq, Ord, Show, Read )
|
||||
|
||||
instance (Eq a, Arbitrary a) => Arbitrary (NonEmptyNubList a) where
|
||||
arbitrary = NonEmptyNubList <$> ((nub <$> arbitrary) `suchThat` (not . null))
|
||||
|
||||
|
||||
|
||||
-- | Pull out an arbitrary tag from the StackSet. This removes the need for the
|
||||
-- precondition "n `tagMember x` in many properties and thus reduces the number
|
||||
-- of discarded tests.
|
||||
--
|
||||
-- n <- arbitraryTag x
|
||||
--
|
||||
-- We can do the reverse with a simple `suchThat`:
|
||||
--
|
||||
-- n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
|
||||
arbitraryTag :: T -> Gen Tag
|
||||
arbitraryTag x = do
|
||||
let ts = tags x
|
||||
-- There must be at least 1 workspace, thus at least 1 tag.
|
||||
idx <- choose (0, length ts - 1)
|
||||
return $ ts!!idx
|
||||
|
||||
-- | Pull out an arbitrary window from a StackSet that is guaranteed to have a
|
||||
-- non empty set of windows. This eliminates the precondition "i `member` x" in
|
||||
-- a few properties.
|
||||
--
|
||||
--
|
||||
-- foo (nex :: NonEmptyWindowsStackSet) = do
|
||||
-- let NonEmptyWindowsStackSet x = nex
|
||||
-- w <- arbitraryWindow nex
|
||||
-- return $ .......
|
||||
--
|
||||
-- We can do the reverse with a simple `suchThat`:
|
||||
--
|
||||
-- n <- arbitrary `suchThat` \n' -> not $ n `member` x
|
||||
arbitraryWindow :: NonEmptyWindowsStackSet -> Gen Window
|
||||
arbitraryWindow (NonEmptyWindowsStackSet x) = do
|
||||
let ws = allWindows x
|
||||
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
|
||||
idx <- choose (0, length ws - 1)
|
||||
return $ ws!!idx
|
1308
tests/Properties.hs
1308
tests/Properties.hs
File diff suppressed because it is too large
Load Diff
70
tests/Properties/Delete.hs
Normal file
70
tests/Properties/Delete.hs
Normal file
@@ -0,0 +1,70 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Delete where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- 'delete'
|
||||
|
||||
-- deleting the current item removes it.
|
||||
prop_delete x =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just i -> not (member i (delete i x))
|
||||
where _ = x :: T
|
||||
|
||||
-- delete is reversible with 'insert'.
|
||||
-- It is the identity, except for the 'master', which is reset on insert and delete.
|
||||
--
|
||||
prop_delete_insert (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just n -> insertUp n (delete n y) == y
|
||||
where
|
||||
y = swapMaster x
|
||||
|
||||
-- delete should be local
|
||||
prop_delete_local (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just i -> hidden_spaces x == hidden_spaces (delete i x)
|
||||
|
||||
-- delete should not affect focus unless the focused element is what is being deleted
|
||||
prop_delete_focus = do
|
||||
-- There should be at least two windows. One in focus, and some to try and
|
||||
-- delete (doesn't have to be windows on the current workspace). We generate
|
||||
-- our own, since we can't rely on NonEmptyWindowsStackSet returning one in
|
||||
-- the argument with at least two windows.
|
||||
x <- arbitrary `suchThat` \x' -> length (allWindows x') >= 2
|
||||
w <- arbitraryWindow (NonEmptyWindowsStackSet x)
|
||||
-- Make sure we pick a window that is NOT the currently focused
|
||||
`suchThat` \w' -> Just w' /= peek x
|
||||
return $ peek (delete w x) == peek x
|
||||
|
||||
-- focus movement in the presence of delete:
|
||||
-- when the last window in the stack set is focused, focus moves `up'.
|
||||
-- usual case is that it moves 'down'.
|
||||
prop_delete_focus_end = do
|
||||
-- Generate a StackSet with at least two windows on the current workspace.
|
||||
x <- arbitrary `suchThat` \(x' :: T) -> length (index x') >= 2
|
||||
let w = last (index x)
|
||||
y = focusWindow w x -- focus last window in stack
|
||||
return $ peek (delete w y) == peek (focusUp y)
|
||||
|
||||
|
||||
-- focus movement in the presence of delete:
|
||||
-- when not in the last item in the stack, focus moves down
|
||||
prop_delete_focus_not_end = do
|
||||
x <- arbitrary
|
||||
-- There must be at least two windows and the current focused is not the
|
||||
-- last one in the stack.
|
||||
`suchThat` \(x' :: T) ->
|
||||
let currWins = index x'
|
||||
in length currWins >= 2 && peek x' /= Just (last currWins)
|
||||
-- This is safe, as we know there are >= 2 windows
|
||||
let Just n = peek x
|
||||
return $ peek (delete n x) == peek (focusDown x)
|
30
tests/Properties/Failure.hs
Normal file
30
tests/Properties/Failure.hs
Normal file
@@ -0,0 +1,30 @@
|
||||
module Properties.Failure where
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import qualified Control.Exception as C
|
||||
import System.IO.Unsafe
|
||||
import Data.List (isPrefixOf)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- testing for failure and help out hpc
|
||||
--
|
||||
-- Since base 4.9.0.0 `error` appends a stack trace. The tests below
|
||||
-- use `isPrefixOf` to only test equality on the error message.
|
||||
--
|
||||
prop_abort :: Int -> Bool
|
||||
prop_abort _ = unsafePerformIO $ C.catch (abort "fail") check
|
||||
where
|
||||
check (C.SomeException e) =
|
||||
return $ "xmonad: StackSet: fail" `isPrefixOf` show e
|
||||
|
||||
-- new should fail with an abort
|
||||
prop_new_abort :: Int -> Bool
|
||||
prop_new_abort _ = unsafePerformIO $ C.catch f check
|
||||
where
|
||||
f = new undefined{-layout-} [] [] `seq` return False
|
||||
check (C.SomeException e) =
|
||||
return $ "xmonad: StackSet: non-positive argument to StackSet.new" `isPrefixOf` show e
|
||||
|
||||
-- TODO: Fix this?
|
||||
-- prop_view_should_fail = view {- with some bogus data -}
|
36
tests/Properties/Floating.hs
Normal file
36
tests/Properties/Floating.hs
Normal file
@@ -0,0 +1,36 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Floating where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import qualified Data.Map as M
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- properties for the floating layer:
|
||||
|
||||
prop_float_reversible (nex :: NonEmptyWindowsStackSet) = do
|
||||
let NonEmptyWindowsStackSet x = nex
|
||||
w <- arbitraryWindow nex
|
||||
return $ sink w (float w geom x) == x
|
||||
where
|
||||
geom = RationalRect 100 100 100 100
|
||||
|
||||
prop_float_geometry (nex :: NonEmptyWindowsStackSet) = do
|
||||
let NonEmptyWindowsStackSet x = nex
|
||||
w <- arbitraryWindow nex
|
||||
let s = float w geom x
|
||||
return $ M.lookup w (floating s) == Just geom
|
||||
where
|
||||
geom = RationalRect 100 100 100 100
|
||||
|
||||
prop_float_delete (nex :: NonEmptyWindowsStackSet) = do
|
||||
let NonEmptyWindowsStackSet x = nex
|
||||
w <- arbitraryWindow nex
|
||||
let s = float w geom x
|
||||
t = delete w s
|
||||
return $ not (w `member` t)
|
||||
where
|
||||
geom = RationalRect 100 100 100 100
|
74
tests/Properties/Focus.hs
Normal file
74
tests/Properties/Focus.hs
Normal file
@@ -0,0 +1,74 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Focus where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.Maybe (fromJust)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- rotating focus
|
||||
--
|
||||
|
||||
-- master/focus
|
||||
--
|
||||
-- The tiling order, and master window, of a stack is unaffected by focus changes.
|
||||
--
|
||||
prop_focus_left_master (SizedPositive n) (x::T) =
|
||||
index (applyN (Just n) focusUp x) == index x
|
||||
prop_focus_right_master (SizedPositive n) (x::T) =
|
||||
index (applyN (Just n) focusDown x) == index x
|
||||
prop_focus_master_master (SizedPositive n) (x::T) =
|
||||
index (applyN (Just n) focusMaster x) == index x
|
||||
|
||||
prop_focusWindow_master (NonNegative n) (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just _ -> let s = index x
|
||||
i = n `mod` length s
|
||||
in index (focusWindow (s !! i) x) == index x
|
||||
|
||||
-- shifting focus is trivially reversible
|
||||
prop_focus_left (x :: T) = focusUp (focusDown x) == x
|
||||
prop_focus_right (x :: T) = focusDown (focusUp x) == x
|
||||
|
||||
-- focus master is idempotent
|
||||
prop_focusMaster_idem (x :: T) = focusMaster x == focusMaster (focusMaster x)
|
||||
|
||||
-- focusWindow actually leaves the window focused...
|
||||
prop_focusWindow_works (NonNegative (n :: Int)) (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just _ -> let s = index x
|
||||
i = fromIntegral n `mod` length s
|
||||
in (focus . fromJust . stack . workspace . current) (focusWindow (s !! i) x) == (s !! i)
|
||||
|
||||
-- rotation through the height of a stack gets us back to the start
|
||||
prop_focus_all_l (x :: T) = foldr (const focusUp) x [1..n] == x
|
||||
where n = length (index x)
|
||||
prop_focus_all_r (x :: T) = foldr (const focusDown) x [1..n] == x
|
||||
where n = length (index x)
|
||||
|
||||
-- prop_rotate_all (x :: T) = f (f x) == f x
|
||||
-- f x' = foldr (\_ y -> rotate GT y) x' [1..n]
|
||||
|
||||
-- focus is local to the current workspace
|
||||
prop_focus_down_local (x :: T) = hidden_spaces (focusDown x) == hidden_spaces x
|
||||
prop_focus_up_local (x :: T) = hidden_spaces (focusUp x) == hidden_spaces x
|
||||
|
||||
prop_focus_master_local (x :: T) = hidden_spaces (focusMaster x) == hidden_spaces x
|
||||
|
||||
prop_focusWindow_local (NonNegative (n :: Int)) (x::T ) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just _ -> let s = index x
|
||||
i = fromIntegral n `mod` length s
|
||||
in hidden_spaces (focusWindow (s !! i) x) == hidden_spaces x
|
||||
|
||||
-- On an invalid window, the stackset is unmodified
|
||||
prop_focusWindow_identity (x::T ) = do
|
||||
n <- arbitrary `suchThat` \n' -> not $ n' `member` x
|
||||
return $ focusWindow n x == x
|
44
tests/Properties/GreedyView.hs
Normal file
44
tests/Properties/GreedyView.hs
Normal file
@@ -0,0 +1,44 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.GreedyView where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- greedyViewing workspaces
|
||||
|
||||
-- greedyView sets the current workspace to 'n'
|
||||
prop_greedyView_current (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ currentTag (greedyView n x) == n
|
||||
|
||||
-- greedyView leaves things unchanged for invalid workspaces
|
||||
prop_greedyView_current_id (x :: T) = do
|
||||
n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
|
||||
return $ currentTag (greedyView n x) == currentTag x
|
||||
|
||||
-- greedyView *only* sets the current workspace, and touches Xinerama.
|
||||
-- no workspace contents will be changed.
|
||||
prop_greedyView_local (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ workspaces x == workspaces (greedyView n x)
|
||||
where
|
||||
workspaces a = sortBy (\s t -> tag s `compare` tag t) $
|
||||
workspace (current a)
|
||||
: map workspace (visible a) ++ hidden a
|
||||
|
||||
-- greedyView is idempotent
|
||||
prop_greedyView_idem (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ greedyView n (greedyView n x) == greedyView n x
|
||||
|
||||
-- greedyView is reversible, though shuffles the order of hidden/visible
|
||||
prop_greedyView_reversible (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ normal (greedyView n' (greedyView n x)) == normal x
|
||||
where n' = currentTag x
|
52
tests/Properties/Insert.hs
Normal file
52
tests/Properties/Insert.hs
Normal file
@@ -0,0 +1,52 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Insert where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.List (nub)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- 'insert'
|
||||
|
||||
-- inserting a item into an empty stackset means that item is now a member
|
||||
prop_insert_empty i (EmptyStackSet x)= member i (insertUp i x)
|
||||
|
||||
-- insert should be idempotent
|
||||
prop_insert_idem i (x :: T) = insertUp i x == insertUp i (insertUp i x)
|
||||
|
||||
-- insert when an item is a member should leave the stackset unchanged
|
||||
prop_insert_duplicate (nex :: NonEmptyWindowsStackSet) = do
|
||||
let NonEmptyWindowsStackSet x = nex
|
||||
w <- arbitraryWindow nex
|
||||
return $ insertUp w x == x
|
||||
|
||||
-- push shouldn't change anything but the current workspace
|
||||
prop_insert_local (x :: T) = do
|
||||
i <- arbitrary `suchThat` \i' -> not $ i' `member` x
|
||||
return $ hidden_spaces x == hidden_spaces (insertUp i x)
|
||||
|
||||
-- Inserting a (unique) list of items into an empty stackset should
|
||||
-- result in the last inserted element having focus.
|
||||
prop_insert_peek (EmptyStackSet x) (NonEmptyNubList is) =
|
||||
peek (foldr insertUp x is) == Just (head is)
|
||||
|
||||
-- insert >> delete is the identity, when i `notElem` .
|
||||
-- Except for the 'master', which is reset on insert and delete.
|
||||
--
|
||||
prop_insert_delete x = do
|
||||
n <- arbitrary `suchThat` \n -> not $ n `member` x
|
||||
return $ delete n (insertUp n y) == (y :: T)
|
||||
where
|
||||
y = swapMaster x -- sets the master window to the current focus.
|
||||
-- otherwise, we don't have a rule for where master goes.
|
||||
|
||||
-- inserting n elements increases current stack size by n
|
||||
prop_size_insert is (EmptyStackSet x) =
|
||||
size (foldr insertUp x ws) == length ws
|
||||
where
|
||||
ws = nub is
|
||||
size = length . index
|
34
tests/Properties/Layout/Full.hs
Normal file
34
tests/Properties/Layout/Full.hs
Normal file
@@ -0,0 +1,34 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Layout.Full where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import XMonad.Core
|
||||
import XMonad.Layout
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Full layout
|
||||
|
||||
-- pureLayout works for Full
|
||||
prop_purelayout_full rect = do
|
||||
x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
|
||||
let layout = Full
|
||||
st = fromJust . stack . workspace . current $ x
|
||||
ts = pureLayout layout rect st
|
||||
return $
|
||||
length ts == 1 -- only one window to view
|
||||
&&
|
||||
snd (head ts) == rect -- and sets fullscreen
|
||||
&&
|
||||
fst (head ts) == fromJust (peek x) -- and the focused window is shown
|
||||
|
||||
|
||||
-- what happens when we send an IncMaster message to Full --- Nothing
|
||||
prop_sendmsg_full (NonNegative k) =
|
||||
isNothing (Full `pureMessage` SomeMessage (IncMasterN k))
|
||||
|
||||
prop_desc_full = description Full == show Full
|
140
tests/Properties/Layout/Tall.hs
Normal file
140
tests/Properties/Layout/Tall.hs
Normal file
@@ -0,0 +1,140 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Layout.Tall where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import XMonad.Core
|
||||
import XMonad.Layout
|
||||
|
||||
import Graphics.X11.Xlib.Types (Rectangle(..))
|
||||
|
||||
import Control.Applicative
|
||||
import Data.List (sort)
|
||||
import Data.Maybe
|
||||
import Data.Ratio
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- The Tall layout
|
||||
|
||||
-- 1 window should always be tiled fullscreen
|
||||
prop_tile_fullscreen rect = tile pct rect 1 1 == [rect]
|
||||
where pct = 1/2
|
||||
|
||||
-- multiple windows
|
||||
prop_tile_non_overlap rect windows nmaster = noOverlaps (tile pct rect nmaster windows)
|
||||
where _ = rect :: Rectangle
|
||||
pct = 3 % 100
|
||||
|
||||
-- with a ratio of 1, no stack windows are drawn of there is at least
|
||||
-- one master window around.
|
||||
prop_tile_max_ratio = extremeRatio 1 drop
|
||||
|
||||
-- with a ratio of 0, no master windows are drawn at all if there are
|
||||
-- any stack windows around.
|
||||
prop_tile_min_ratio = extremeRatio 0 take
|
||||
|
||||
extremeRatio amount getRects rect = do
|
||||
w@(NonNegative windows) <- arbitrary `suchThat` (> NonNegative 0)
|
||||
NonNegative nmaster <- arbitrary `suchThat` (< w)
|
||||
let tiled = tile amount rect nmaster windows
|
||||
pure $ if nmaster == 0
|
||||
then prop_tile_non_overlap rect windows nmaster
|
||||
else all ((== 0) . rect_width) $ getRects nmaster tiled
|
||||
|
||||
-- splitting horizontally yields sensible results
|
||||
prop_split_horizontal (NonNegative n) x =
|
||||
noOverflows (+) (rect_x x) (rect_width x) ==>
|
||||
sum (map rect_width xs) == rect_width x
|
||||
&&
|
||||
all (\s -> rect_height s == rect_height x) xs
|
||||
&&
|
||||
map rect_x xs == sort (map rect_x xs)
|
||||
|
||||
where
|
||||
xs = splitHorizontally n x
|
||||
|
||||
-- splitting vertically yields sensible results
|
||||
prop_split_vertical (r :: Rational) x =
|
||||
rect_x x == rect_x a && rect_x x == rect_x b
|
||||
&&
|
||||
rect_width x == rect_width a && rect_width x == rect_width b
|
||||
where
|
||||
(a,b) = splitVerticallyBy r x
|
||||
|
||||
|
||||
-- pureLayout works.
|
||||
prop_purelayout_tall n d r rect = do
|
||||
x <- (arbitrary :: Gen T) `suchThat` (isJust . peek)
|
||||
let layout = Tall n d r
|
||||
st = fromJust . stack . workspace . current $ x
|
||||
ts = pureLayout layout rect st
|
||||
ntotal = length (index x)
|
||||
return $
|
||||
(if r == 0 then
|
||||
-- (<=) for Bool is the logical implication
|
||||
(0 <= n && n <= ntotal) <= (length ts == ntotal - n)
|
||||
else if r == 1 then
|
||||
(0 <= n && n <= ntotal) <= (length ts == n)
|
||||
else
|
||||
length ts == ntotal)
|
||||
&&
|
||||
noOverlaps (map snd ts)
|
||||
&&
|
||||
description layout == "Tall"
|
||||
|
||||
|
||||
-- Test message handling of Tall
|
||||
|
||||
-- what happens when we send a Shrink message to Tall
|
||||
prop_shrink_tall (NonNegative n) (Positive delta) (NonNegative frac) =
|
||||
n == n' && delta == delta' -- these state components are unchanged
|
||||
&& frac' <= frac && (if frac' < frac then frac' == 0 || frac' == frac - delta
|
||||
else frac == 0 )
|
||||
-- remaining fraction should shrink
|
||||
where
|
||||
l1 = Tall n delta frac
|
||||
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Shrink
|
||||
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
|
||||
|
||||
|
||||
-- what happens when we send a Shrink message to Tall
|
||||
prop_expand_tall (NonNegative n)
|
||||
(Positive delta)
|
||||
(NonNegative n1)
|
||||
(Positive d1) =
|
||||
|
||||
n == n'
|
||||
&& delta == delta' -- these state components are unchanged
|
||||
&& frac' >= frac
|
||||
&& (if frac' > frac
|
||||
then frac' == 1 || frac' == frac + delta
|
||||
else frac == 1 )
|
||||
|
||||
-- remaining fraction should shrink
|
||||
where
|
||||
frac = min 1 (n1 % d1)
|
||||
l1 = Tall n delta frac
|
||||
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage Expand
|
||||
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
|
||||
|
||||
-- what happens when we send an IncMaster message to Tall
|
||||
prop_incmaster_tall (NonNegative n) (Positive delta) (NonNegative frac)
|
||||
(NonNegative k) =
|
||||
delta == delta' && frac == frac' && n' == n + k
|
||||
where
|
||||
l1 = Tall n delta frac
|
||||
Just l2@(Tall n' delta' frac') = l1 `pureMessage` SomeMessage (IncMasterN k)
|
||||
-- pureMessage :: layout a -> SomeMessage -> Maybe (layout a)
|
||||
|
||||
|
||||
|
||||
-- toMessage LT = SomeMessage Shrink
|
||||
-- toMessage EQ = SomeMessage Expand
|
||||
-- toMessage GT = SomeMessage (IncMasterN 1)
|
||||
|
||||
|
||||
prop_desc_mirror n r1 r2 = description (Mirror $! t) == "Mirror Tall"
|
||||
where t = Tall n r1 r2
|
72
tests/Properties/Screen.hs
Normal file
72
tests/Properties/Screen.hs
Normal file
@@ -0,0 +1,72 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Screen where
|
||||
|
||||
import Utils
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
|
||||
import Control.Applicative
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import XMonad.Operations
|
||||
import Graphics.X11.Xlib.Types (Dimension)
|
||||
|
||||
import Graphics.X11 (Rectangle(Rectangle))
|
||||
import XMonad.Layout
|
||||
|
||||
prop_screens (x :: T) = n `elem` screens x
|
||||
where
|
||||
n = current x
|
||||
|
||||
-- screens makes sense
|
||||
prop_screens_works (x :: T) = screens x == current x : visible x
|
||||
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- Hints
|
||||
|
||||
prop_resize_inc (Positive inc_w,Positive inc_h) b@(w,h) =
|
||||
w' `mod` inc_w == 0 && h' `mod` inc_h == 0
|
||||
where (w',h') = applyResizeIncHint a b
|
||||
a = (inc_w,inc_h)
|
||||
|
||||
prop_resize_inc_extra ((NonNegative inc_w)) b@(w,h) =
|
||||
(w,h) == (w',h')
|
||||
where (w',h') = applyResizeIncHint a b
|
||||
a = (-inc_w,0::Dimension)-- inc_h)
|
||||
|
||||
prop_resize_max (Positive inc_w,Positive inc_h) b@(w,h) =
|
||||
w' <= inc_w && h' <= inc_h
|
||||
where (w',h') = applyMaxSizeHint a b
|
||||
a = (inc_w,inc_h)
|
||||
|
||||
prop_resize_max_extra ((NonNegative inc_w)) b@(w,h) =
|
||||
(w,h) == (w',h')
|
||||
where (w',h') = applyMaxSizeHint a b
|
||||
a = (-inc_w,0::Dimension)-- inc_h)
|
||||
|
||||
|
||||
prop_aspect_hint_shrink hint (w,h) = case applyAspectHint hint (w,h) of
|
||||
(w',h') -> w' <= w && h' <= h
|
||||
|
||||
|
||||
-- applyAspectHint does nothing when the supplied (x,y) fits
|
||||
-- the desired range
|
||||
prop_aspect_fits =
|
||||
forAll ((,,,) <$> pos <*> pos <*> pos <*> pos) $ \ (x,y,a,b) ->
|
||||
let f = applyAspectHint ((x, y+a), (x+b, y))
|
||||
in noOverflows (*) x (y+a) && noOverflows (*) (x+b) y
|
||||
==> f (x,y) == (x,y)
|
||||
|
||||
where pos = choose (0, 65535)
|
||||
|
||||
prop_point_within r@(Rectangle x y w h) =
|
||||
forAll ((,) <$>
|
||||
choose (0, fromIntegral w - 1) <*>
|
||||
choose (0, fromIntegral h - 1)) $
|
||||
\(dx,dy) ->
|
||||
and [ dx > 0, dy > 0,
|
||||
noOverflows (\ a b -> a + abs b) x w,
|
||||
noOverflows (\ a b -> a + abs b) y h ]
|
||||
==> pointWithin (x+dx) (y+dy) r
|
||||
|
||||
prop_point_within_mirror r (x,y) = pointWithin x y r == pointWithin y x (mirrorRect r)
|
70
tests/Properties/Shift.hs
Normal file
70
tests/Properties/Shift.hs
Normal file
@@ -0,0 +1,70 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Shift where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import qualified Data.List as L
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- shift
|
||||
|
||||
-- shift is fully reversible on current window, when focus and master
|
||||
-- are the same. otherwise, master may move.
|
||||
prop_shift_reversible (x :: T) = do
|
||||
i <- arbitraryTag x
|
||||
case peek y of
|
||||
Nothing -> return True
|
||||
Just _ -> return $ normal ((view n . shift n . view i . shift i) y) == normal y
|
||||
where
|
||||
y = swapMaster x
|
||||
n = currentTag y
|
||||
|
||||
------------------------------------------------------------------------
|
||||
-- shiftMaster
|
||||
|
||||
-- focus/local/idempotent same as swapMaster:
|
||||
prop_shift_master_focus (x :: T) = peek x == peek (shiftMaster x)
|
||||
prop_shift_master_local (x :: T) = hidden_spaces x == hidden_spaces (shiftMaster x)
|
||||
prop_shift_master_idempotent (x :: T) = shiftMaster (shiftMaster x) == shiftMaster x
|
||||
-- ordering is constant modulo the focused window:
|
||||
prop_shift_master_ordering (x :: T) = case peek x of
|
||||
Nothing -> True
|
||||
Just m -> L.delete m (index x) == L.delete m (index $ shiftMaster x)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- shiftWin
|
||||
|
||||
-- shiftWin on current window is the same as shift
|
||||
prop_shift_win_focus (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
case peek x of
|
||||
Nothing -> return True
|
||||
Just w -> return $ shiftWin n w x == shift n x
|
||||
|
||||
-- shiftWin on a non-existent window is identity
|
||||
prop_shift_win_indentity (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
w <- arbitrary `suchThat` \w' -> not (w' `member` x)
|
||||
return $ shiftWin n w x == x
|
||||
|
||||
-- shiftWin leaves the current screen as it is, if neither n is the tag
|
||||
-- of the current workspace nor w on the current workspace
|
||||
prop_shift_win_fix_current = do
|
||||
x <- arbitrary `suchThat` \(x' :: T) ->
|
||||
-- Invariant, otherWindows are NOT in the current workspace.
|
||||
let otherWindows = allWindows x' L.\\ index x'
|
||||
in length (tags x') >= 2 && not (null otherWindows)
|
||||
-- Sadly we have to construct `otherWindows` again, for the actual StackSet
|
||||
-- that got chosen.
|
||||
let otherWindows = allWindows x L.\\ index x
|
||||
-- We know such tag must exists, due to the precondition
|
||||
n <- arbitraryTag x `suchThat` (/= currentTag x)
|
||||
-- we know length is >= 1, from above precondition
|
||||
idx <- choose (0, length otherWindows - 1)
|
||||
let w = otherWindows !! idx
|
||||
return $ current x == current (shiftWin n w x)
|
||||
|
77
tests/Properties/Stack.hs
Normal file
77
tests/Properties/Stack.hs
Normal file
@@ -0,0 +1,77 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||
|
||||
module Properties.Stack where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import qualified XMonad.StackSet as S (filter)
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
import Data.Proxy
|
||||
import Test.QuickCheck.Classes (
|
||||
Laws (lawsTypeclass, lawsProperties), Proxy1 (Proxy1),
|
||||
foldableLaws, traversableLaws,
|
||||
)
|
||||
|
||||
|
||||
-- The list returned by index should be the same length as the actual
|
||||
-- windows kept in the zipper
|
||||
prop_index_length (x :: T) =
|
||||
case stack . workspace . current $ x of
|
||||
Nothing -> null (index x)
|
||||
Just it -> length (index x) == length (focus it : up it ++ down it)
|
||||
|
||||
|
||||
-- For all windows in the stackSet, findTag should identify the
|
||||
-- correct workspace
|
||||
prop_findIndex (x :: T) =
|
||||
and [ tag w == fromJust (findTag i x)
|
||||
| w <- workspace (current x) : map workspace (visible x) ++ hidden x
|
||||
, t <- maybeToList (stack w)
|
||||
, i <- focus t : up t ++ down t
|
||||
]
|
||||
|
||||
prop_allWindowsMember (NonEmptyWindowsStackSet x) = do
|
||||
-- Reimplementation of arbitraryWindow, but to make sure that
|
||||
-- implementation doesn't change in the future, and stop using allWindows,
|
||||
-- which is a key component in this test (together with member).
|
||||
let ws = allWindows x
|
||||
-- We know that there are at least 1 window in a NonEmptyWindowsStackSet.
|
||||
idx <- choose (0, length ws - 1)
|
||||
return $ member (ws!!idx) x
|
||||
|
||||
|
||||
-- preserve order
|
||||
prop_filter_order (x :: T) =
|
||||
case stack $ workspace $ current x of
|
||||
Nothing -> True
|
||||
Just s@(Stack i _ _) -> integrate' (S.filter (/= i) s) == filter (/= i) (integrate' (Just s))
|
||||
|
||||
-- differentiate should return Nothing if the list is empty or Just stack, with
|
||||
-- the first element of the list is current, and the rest of the list is down.
|
||||
prop_differentiate xs =
|
||||
if null xs then isNothing (differentiate xs)
|
||||
else differentiate xs == Just (Stack (head xs) [] (tail xs))
|
||||
where _ = xs :: [Int]
|
||||
|
||||
|
||||
-- Check type class laws of 'Data.Foldable.Foldable' and 'Data.Traversable.Traversable'.
|
||||
newtype TestStack a = TestStack (Stack a)
|
||||
deriving (Eq, Read, Show, Foldable, Functor)
|
||||
|
||||
instance (Arbitrary a) => Arbitrary (TestStack a) where
|
||||
arbitrary = TestStack <$> (Stack <$> arbitrary <*> arbitrary <*> arbitrary)
|
||||
shrink = traverse shrink
|
||||
|
||||
instance Traversable TestStack where
|
||||
traverse f (TestStack sx) = fmap TestStack (traverse f sx)
|
||||
|
||||
prop_laws_Stack = format (foldableLaws p) <> format (traversableLaws p)
|
||||
where
|
||||
p = Proxy :: Proxy TestStack
|
||||
format laws = [ ("Stack: " <> lawsTypeclass laws <> ": " <> name, prop)
|
||||
| (name, prop) <- lawsProperties laws ]
|
135
tests/Properties/StackSet.hs
Normal file
135
tests/Properties/StackSet.hs
Normal file
@@ -0,0 +1,135 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.StackSet where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
import Data.List (nub)
|
||||
-- ---------------------------------------------------------------------
|
||||
-- QuickCheck properties for the StackSet
|
||||
|
||||
-- Some general hints for creating StackSet properties:
|
||||
--
|
||||
-- * ops that mutate the StackSet are usually local
|
||||
-- * most ops on StackSet should either be trivially reversible, or
|
||||
-- idempotent, or both.
|
||||
------------------------------------------------------------------------
|
||||
|
||||
-- Basic data invariants of the StackSet
|
||||
--
|
||||
-- With the new zipper-based StackSet, tracking focus is no longer an
|
||||
-- issue: the data structure enforces focus by construction.
|
||||
--
|
||||
-- But we still need to ensure there are no duplicates, and master/and
|
||||
-- the xinerama mapping aren't checked by the data structure at all.
|
||||
--
|
||||
-- * no element should ever appear more than once in a StackSet
|
||||
-- * the xinerama screen map should be:
|
||||
-- -- keys should always index valid workspaces
|
||||
-- -- monotonically ascending in the elements
|
||||
-- * the current workspace should be a member of the xinerama screens
|
||||
--
|
||||
invariant (s :: T) = and
|
||||
-- no duplicates
|
||||
[ noDuplicates
|
||||
|
||||
-- TODO: Fix this.
|
||||
-- all this xinerama stuff says we don't have the right structure
|
||||
-- , validScreens
|
||||
-- , validWorkspaces
|
||||
-- , inBounds
|
||||
]
|
||||
where
|
||||
ws = concat [ focus t : up t ++ down t
|
||||
| w <- workspace (current s) : map workspace (visible s) ++ hidden s
|
||||
, t <- maybeToList (stack w)] :: [Char]
|
||||
noDuplicates = nub ws == ws
|
||||
|
||||
-- validScreens = monotonic . sort . M. . (W.current s : W.visible : W$ s
|
||||
|
||||
-- validWorkspaces = and [ w `elem` allworkspaces | w <- (M.keys . screens) s ]
|
||||
-- where allworkspaces = map tag $ current s : prev s ++ next s
|
||||
|
||||
-- inBounds = and [ w >=0 && w < size s | (w,sc) <- M.assocs (screens s) ]
|
||||
|
||||
monotonic [] = True
|
||||
monotonic [x] = True
|
||||
monotonic (x:y:zs) | x == y-1 = monotonic (y:zs)
|
||||
| otherwise = False
|
||||
|
||||
prop_invariant = invariant
|
||||
|
||||
-- and check other ops preserve invariants
|
||||
prop_empty_I (SizedPositive n) l = forAll (choose (1, fromIntegral n)) $ \m ->
|
||||
forAll (vector m) $ \ms ->
|
||||
invariant $ new l [0..fromIntegral n-1] ms
|
||||
|
||||
prop_view_I n (x :: T) =
|
||||
invariant $ view n x
|
||||
|
||||
prop_greedyView_I n (x :: T) =
|
||||
invariant $ greedyView n x
|
||||
|
||||
prop_focusUp_I (SizedPositive n) (x :: T) =
|
||||
invariant $ applyN (Just n) focusUp x
|
||||
prop_focusMaster_I (SizedPositive n) (x :: T) =
|
||||
invariant $ applyN (Just n) focusMaster x
|
||||
prop_focusDown_I (SizedPositive n) (x :: T) =
|
||||
invariant $ applyN (Just n) focusDown x
|
||||
|
||||
prop_focus_I (SizedPositive n) (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True
|
||||
Just _ -> let w = focus . fromJust . stack . workspace . current $
|
||||
applyN (Just n) focusUp x
|
||||
in invariant $ focusWindow w x
|
||||
|
||||
prop_insertUp_I n (x :: T) = invariant $ insertUp n x
|
||||
|
||||
prop_delete_I (x :: T) = invariant $
|
||||
case peek x of
|
||||
Nothing -> x
|
||||
Just i -> delete i x
|
||||
|
||||
prop_swap_master_I (x :: T) = invariant $ swapMaster x
|
||||
|
||||
prop_swap_left_I (SizedPositive n) (x :: T) =
|
||||
invariant $ applyN (Just n) swapUp x
|
||||
prop_swap_right_I (SizedPositive n) (x :: T) =
|
||||
invariant $ applyN (Just n) swapDown x
|
||||
|
||||
prop_shift_I (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ invariant $ shift (fromIntegral n) x
|
||||
|
||||
prop_shift_win_I (nex :: NonEmptyWindowsStackSet) = do
|
||||
let NonEmptyWindowsStackSet x = nex
|
||||
w <- arbitraryWindow nex
|
||||
n <- arbitraryTag x
|
||||
return $ invariant $ shiftWin n w x
|
||||
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
|
||||
|
||||
-- empty StackSets have no windows in them
|
||||
prop_empty (EmptyStackSet x) =
|
||||
all (== Nothing) [ stack w | w <- workspace (current x)
|
||||
: map workspace (visible x) ++ hidden x ]
|
||||
|
||||
-- empty StackSets always have focus on first workspace
|
||||
prop_empty_current (EmptyStackSet x) = currentTag x == head (tags x)
|
||||
|
||||
-- no windows will be a member of an empty workspace
|
||||
prop_member_empty i (EmptyStackSet x) = not (member i x)
|
||||
|
||||
-- peek either yields nothing on the Empty workspace, or Just a valid window
|
||||
prop_member_peek (x :: T) =
|
||||
case peek x of
|
||||
Nothing -> True {- then we don't know anything -}
|
||||
Just i -> member i x
|
47
tests/Properties/Swap.hs
Normal file
47
tests/Properties/Swap.hs
Normal file
@@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Swap where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- swapUp, swapDown, swapMaster: reordiring windows
|
||||
|
||||
-- swap is trivially reversible
|
||||
prop_swap_left (x :: T) = swapUp (swapDown x) == x
|
||||
prop_swap_right (x :: T) = swapDown (swapUp x) == x
|
||||
-- TODO swap is reversible
|
||||
-- swap is reversible, but involves moving focus back the window with
|
||||
-- master on it. easy to do with a mouse...
|
||||
{-
|
||||
prop_promote_reversible x b = (not . null . fromMaybe [] . flip index x . current $ x) ==>
|
||||
(raiseFocus y . promote . raiseFocus z . promote) x == x
|
||||
where _ = x :: T
|
||||
dir = if b then LT else GT
|
||||
(Just y) = peek x
|
||||
(Just (z:_)) = flip index x . current $ x
|
||||
-}
|
||||
|
||||
-- swap doesn't change focus
|
||||
prop_swap_master_focus (x :: T) = peek x == peek (swapMaster x)
|
||||
-- = case peek x of
|
||||
-- Nothing -> True
|
||||
-- Just f -> focus (stack (workspace $ current (swap x))) == f
|
||||
prop_swap_left_focus (x :: T) = peek x == peek (swapUp x)
|
||||
prop_swap_right_focus (x :: T) = peek x == peek (swapDown x)
|
||||
|
||||
-- swap is local
|
||||
prop_swap_master_local (x :: T) = hidden_spaces x == hidden_spaces (swapMaster x)
|
||||
prop_swap_left_local (x :: T) = hidden_spaces x == hidden_spaces (swapUp x)
|
||||
prop_swap_right_local (x :: T) = hidden_spaces x == hidden_spaces (swapDown x)
|
||||
|
||||
-- rotation through the height of a stack gets us back to the start
|
||||
prop_swap_all_l (x :: T) = foldr (const swapUp) x [1..n] == x
|
||||
where n = length (index x)
|
||||
prop_swap_all_r (x :: T) = foldr (const swapDown) x [1..n] == x
|
||||
where n = length (index x)
|
||||
|
||||
prop_swap_master_idempotent (x :: T) = swapMaster (swapMaster x) == swapMaster x
|
47
tests/Properties/View.hs
Normal file
47
tests/Properties/View.hs
Normal file
@@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.View where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- ---------------------------------------------------------------------
|
||||
-- viewing workspaces
|
||||
|
||||
-- view sets the current workspace to 'n'
|
||||
prop_view_current (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ (tag . workspace . current . view n) x == n
|
||||
|
||||
-- view *only* sets the current workspace, and touches Xinerama.
|
||||
-- no workspace contents will be changed.
|
||||
prop_view_local (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ workspaces x == workspaces (view n x)
|
||||
where
|
||||
workspaces a = sortBy (\s t -> tag s `compare` tag t) $
|
||||
workspace (current a)
|
||||
: map workspace (visible a) ++ hidden a
|
||||
|
||||
-- TODO: Fix this
|
||||
-- view should result in a visible xinerama screen
|
||||
-- prop_view_xinerama (x :: T) (n :: NonNegative Int) = i `tagMember` x ==>
|
||||
-- M.member i (screens (view i x))
|
||||
-- where
|
||||
-- i = fromIntegral n
|
||||
|
||||
-- view is idempotent
|
||||
prop_view_idem (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ view n (view n x) == view n x
|
||||
|
||||
-- view is reversible, though shuffles the order of hidden/visible
|
||||
prop_view_reversible (x :: T) = do
|
||||
n <- arbitraryTag x
|
||||
return $ normal (view n' (view n x)) == normal x
|
||||
where
|
||||
n' = currentTag x
|
65
tests/Properties/Workspace.hs
Normal file
65
tests/Properties/Workspace.hs
Normal file
@@ -0,0 +1,65 @@
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
module Properties.Workspace where
|
||||
|
||||
import Test.QuickCheck
|
||||
import Instances
|
||||
import Utils
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
|
||||
import Data.Maybe
|
||||
|
||||
-- looking up the tag of the current workspace should always produce a tag.
|
||||
prop_lookup_current (x :: T) = lookupWorkspace scr x == Just tg
|
||||
where
|
||||
(Screen (Workspace tg _ _) scr _) = current x
|
||||
|
||||
-- looking at a visible tag
|
||||
prop_lookup_visible = do
|
||||
-- make sure we have some xinerama screens.
|
||||
x <- arbitrary `suchThat` \(x' :: T) -> visible x' /= []
|
||||
let tags = [ tag (workspace y) | y <- visible x ]
|
||||
scr = last [ screen y | y <- visible x ]
|
||||
return $ fromJust (lookupWorkspace scr x) `elem` tags
|
||||
|
||||
|
||||
prop_currentTag (x :: T) =
|
||||
currentTag x == tag (workspace (current x))
|
||||
|
||||
-- Rename a given tag if present in the StackSet.
|
||||
prop_rename1 (x::T) = do
|
||||
o <- arbitraryTag x
|
||||
n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
|
||||
-- Rename o to n
|
||||
let y = renameTag o n x
|
||||
return $ n `tagMember` y
|
||||
|
||||
-- Ensure that a given set of workspace tags is present by renaming
|
||||
-- existing workspaces and\/or creating new hidden workspaces as
|
||||
-- necessary.
|
||||
--
|
||||
prop_ensure (x :: T) l xs = let y = ensureTags l xs x
|
||||
in and [ n `tagMember` y | n <- xs ]
|
||||
|
||||
-- adding a tag should create a new hidden workspace
|
||||
prop_ensure_append (x :: T) l = do
|
||||
n <- arbitrary `suchThat` \n' -> not $ n' `tagMember` x
|
||||
let ts = tags x
|
||||
y = ensureTags l (n:ts) x
|
||||
return $ hidden y /= hidden x -- doesn't append, renames
|
||||
&& and [ isNothing (stack z) && layout z == l | z <- hidden y, tag z == n ]
|
||||
|
||||
|
||||
|
||||
|
||||
prop_mapWorkspaceId (x::T) = x == mapWorkspace id x
|
||||
|
||||
prop_mapWorkspaceInverse (x::T) = x == mapWorkspace predTag (mapWorkspace succTag x)
|
||||
where predTag w = w { tag = pred $ tag w }
|
||||
succTag w = w { tag = succ $ tag w }
|
||||
|
||||
prop_mapLayoutId (x::T) = x == mapLayout id x
|
||||
|
||||
prop_mapLayoutInverse (x::T) = x == mapLayout pred (mapLayout succ x)
|
||||
|
||||
|
47
tests/Utils.hs
Normal file
47
tests/Utils.hs
Normal file
@@ -0,0 +1,47 @@
|
||||
{-# LANGUAGE RankNTypes #-}
|
||||
module Utils where
|
||||
|
||||
import XMonad.StackSet hiding (filter)
|
||||
import Graphics.X11.Xlib.Types (Rectangle(..))
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- Useful operation, the non-local workspaces
|
||||
hidden_spaces x = map workspace (visible x) ++ hidden x
|
||||
|
||||
|
||||
-- normalise workspace list
|
||||
normal s = s { hidden = sortBy g (hidden s), visible = sortBy f (visible s) }
|
||||
where
|
||||
f a b = tag (workspace a) `compare` tag (workspace b)
|
||||
g a b = tag a `compare` tag b
|
||||
|
||||
|
||||
noOverlaps [] = True
|
||||
noOverlaps [_] = True
|
||||
noOverlaps xs = and [ verts a `notOverlap` verts b
|
||||
| a <- xs
|
||||
, b <- filter (a /=) xs
|
||||
]
|
||||
where
|
||||
verts (Rectangle a b w h) = (a,b,a + fromIntegral w - 1, b + fromIntegral h - 1)
|
||||
|
||||
notOverlap (left1,bottom1,right1,top1)
|
||||
(left2,bottom2,right2,top2)
|
||||
= (top1 < bottom2 || top2 < bottom1)
|
||||
|| (right1 < left2 || right2 < left1)
|
||||
|
||||
|
||||
applyN :: (Integral n) => Maybe n -> (a -> a) -> a -> a
|
||||
applyN Nothing f v = v
|
||||
applyN (Just 0) f v = v
|
||||
applyN (Just n) f v = applyN (Just $ n-1) f (f v)
|
||||
|
||||
tags x = map tag $ workspaces x
|
||||
|
||||
|
||||
-- | noOverflows op a b is True if @a `op` fromIntegral b@ overflows (or
|
||||
-- otherwise gives the same answer when done using Integer
|
||||
noOverflows :: (Integral b, Integral c) =>
|
||||
(forall a. Integral a => a -> a -> a) -> b -> c -> Bool
|
||||
noOverflows op a b = toInteger (a `op` fromIntegral b) == toInteger a `op` toInteger b
|
||||
|
@@ -1,10 +0,0 @@
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
import System.Cmd
|
||||
|
||||
-- generate appropriate .hpc files
|
||||
main = do
|
||||
system $ "rm -rf *.tix"
|
||||
system $ "dist/build/xmonad/xmonad --run-tests"
|
||||
system $ "hpc markup xmonad --exclude=Main --exclude=Properties --exclude=XMonad --exclude=Paths_xmonad"
|
||||
system $ "hpc report xmonad --exclude=Main --exclude=Properties --exclude=XMonad --exclude=Paths_xmonad"
|
@@ -5,9 +5,9 @@ main = do foo <- getContents
|
||||
let actual_loc = filter (not.null) $ filter isntcomment $
|
||||
map (dropWhile (==' ')) $ lines foo
|
||||
loc = length actual_loc
|
||||
putStrLn $ show loc
|
||||
print loc
|
||||
-- uncomment the following to check for mistakes in isntcomment
|
||||
-- putStr $ unlines $ actual_loc
|
||||
-- print actual_loc
|
||||
|
||||
isntcomment ('-':'-':_) = False
|
||||
isntcomment ('{':'-':_) = False -- pragmas
|
||||
|
133
util/GenerateManpage.hs
Normal file → Executable file
133
util/GenerateManpage.hs
Normal file → Executable file
@@ -1,56 +1,66 @@
|
||||
-- Unlike the rest of xmonad, this file is copyright under the terms of the
|
||||
-- GPL.
|
||||
#!/usr/bin/env runhaskell
|
||||
|
||||
-- Reads markdown (man/xmonad.1.markdown) from stdin, substitutes
|
||||
-- ___KEYBINDINGS___ for key-binding definitions generated from
|
||||
-- src/XMonad/Config.hs, prints result to stdout.
|
||||
--
|
||||
-- Generates man/xmonad.1 from man/xmonad.1.in by filling the list of
|
||||
-- keybindings with values scraped from Config.hs
|
||||
--
|
||||
-- Uses cabal to grab the xmonad version from xmonad.cabal
|
||||
--
|
||||
-- Uses pandoc to convert the "xmonad.1.markdown" to "xmonad.1"
|
||||
--
|
||||
-- Format for the docstrings in Config.hs takes the following form:
|
||||
--
|
||||
-- -- mod-x %! Frob the whatsit
|
||||
--
|
||||
-- "Frob the whatsit" will be used as the description for keybinding "mod-x"
|
||||
--
|
||||
-- If the keybinding name is omitted, it will try to guess from the rest of the
|
||||
-- line. For example:
|
||||
--
|
||||
-- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm
|
||||
--
|
||||
-- Here, mod-shift-return will be used as the keybinding name.
|
||||
import Control.Monad
|
||||
import Control.Applicative
|
||||
import Text.Regex.Posix
|
||||
-- Unlike the rest of xmonad, this file is released under the GNU General
|
||||
-- Public License version 2 or later. (Historical reasons, used to link with
|
||||
-- GPL-licensed pandoc.)
|
||||
|
||||
import Data.Char
|
||||
import Data.List
|
||||
|
||||
import Distribution.PackageDescription.Parse
|
||||
import Distribution.Verbosity
|
||||
import Distribution.Package
|
||||
import Distribution.PackageDescription
|
||||
import Text.PrettyPrint.HughesPJ
|
||||
import Distribution.Text
|
||||
main :: IO ()
|
||||
main = do
|
||||
keybindings <- guessBindings
|
||||
interact $ unlines . replace "___KEYBINDINGS___" keybindings . lines
|
||||
|
||||
import Text.Pandoc
|
||||
-- | The format for the docstrings in "Config.hs" takes the following form:
|
||||
--
|
||||
-- @
|
||||
-- -- mod-x %! Frob the whatsit
|
||||
-- @
|
||||
--
|
||||
-- "Frob the whatsit" will be used as the description for keybinding "mod-x".
|
||||
-- If the name of the key binding is omitted, the function tries to guess it
|
||||
-- from the rest of the line. For example:
|
||||
--
|
||||
-- @
|
||||
-- [ ((modMask .|. shiftMask, xK_Return), spawn "xterm") -- %! Launch an xterm
|
||||
-- @
|
||||
--
|
||||
-- Here, "mod-shift-return" will be used as the key binding name.
|
||||
|
||||
releaseDate = "25 October 09"
|
||||
|
||||
trim :: String -> String
|
||||
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
|
||||
|
||||
guessKeys line = concat $ intersperse "-" (modifiers ++ [map toLower key])
|
||||
where modifiers = map (!!1) (line =~ "(mod|shift|control)Mask")
|
||||
(_, _, _, [key]) = line =~ "xK_(\\w+)" :: (String, String, String, [String])
|
||||
|
||||
binding :: [String] -> (String, String)
|
||||
binding [ _, bindingLine, "", desc ] = (guessKeys bindingLine, desc)
|
||||
binding [ _, _, keyCombo, desc ] = (keyCombo, desc)
|
||||
guessBindings :: IO String
|
||||
guessBindings = do
|
||||
buf <- readFile "./src/XMonad/Config.hs"
|
||||
return (intercalate "\n\n" (map markdownDefn (allBindings buf)))
|
||||
|
||||
allBindings :: String -> [(String, String)]
|
||||
allBindings xs = map (binding . map trim) (xs =~ "(.*)--(.*)%!(.*)")
|
||||
allBindings = concatMap parseLine . lines
|
||||
where
|
||||
parseLine :: String -> [(String, String)]
|
||||
parseLine l
|
||||
| " -- " `isInfixOf` l
|
||||
, Just d <- parseDesc l = [(intercalate "-" (parseKeys l), d)]
|
||||
| otherwise = []
|
||||
|
||||
parseDesc :: String -> Maybe String
|
||||
parseDesc = fmap (trim . drop 4) . find (" %! " `isPrefixOf`) . tails
|
||||
|
||||
parseKeys :: String -> [String]
|
||||
parseKeys l = case lex l of
|
||||
[("", _)] -> []
|
||||
[("--", rest)] -> case words rest of
|
||||
k : "%!" : _ -> [k]
|
||||
_ -> []
|
||||
[(k, rest)] -> parseKey k ++ parseKeys rest
|
||||
|
||||
parseKey :: String -> [String]
|
||||
parseKey k | "Mask" `isSuffixOf` k = [reverse (drop 4 (reverse k))]
|
||||
| "xK_" `isPrefixOf` k = [map toLower (drop 3 k)]
|
||||
| otherwise = []
|
||||
|
||||
-- FIXME: What escaping should we be doing on these strings?
|
||||
markdownDefn :: (String, String) -> String
|
||||
@@ -59,36 +69,5 @@ markdownDefn (key, desc) = key ++ "\n: " ++ desc
|
||||
replace :: Eq a => a -> a -> [a] -> [a]
|
||||
replace x y = map (\a -> if a == x then y else a)
|
||||
|
||||
-- rawSystem "pandoc" ["--read=markdown","--write=man","man/xmonad.1.markdown"]
|
||||
|
||||
main = do
|
||||
releaseName <- (show . disp . package . packageDescription)
|
||||
`liftM`readPackageDescription normal "xmonad.cabal"
|
||||
keybindings <- (intercalate "\n\n" . map markdownDefn . allBindings)
|
||||
`liftM` readFile "./XMonad/Config.hs"
|
||||
|
||||
let manHeader = unwords [".TH xmonad 1","\""++releaseDate++"\"",releaseName,"\"xmonad manual\""]
|
||||
writeOpts = defaultWriterOptions -- { writerLiterateHaskell = True }
|
||||
|
||||
parsed <- readMarkdown defaultParserState { stateLiterateHaskell = True }
|
||||
. unlines
|
||||
. replace "___KEYBINDINGS___" keybindings
|
||||
. lines
|
||||
<$> readFile "./man/xmonad.1.markdown"
|
||||
|
||||
writeFile "./man/xmonad.1"
|
||||
. (manHeader ++)
|
||||
. writeMan writeOpts
|
||||
$ parsed
|
||||
putStrLn "Documentation created: man/xmonad.1"
|
||||
|
||||
writeFile "./man/xmonad.1.html"
|
||||
. writeHtmlString writeOpts
|
||||
{ writerHeader = "<h1>"++releaseName++"</h1>"++
|
||||
"<p>Section: xmonad manual (1)<br>"++
|
||||
"Updated: "++releaseDate++"</p>"++
|
||||
"<hr>"
|
||||
, writerStandalone = True
|
||||
, writerTableOfContents = True }
|
||||
$ parsed
|
||||
putStrLn "Documentation created: man/xmonad.1.html"
|
||||
trim :: String -> String
|
||||
trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
|
||||
|
33
util/hpcReport.sh
Normal file
33
util/hpcReport.sh
Normal file
@@ -0,0 +1,33 @@
|
||||
#!/bin/bash
|
||||
|
||||
set -e
|
||||
|
||||
if [[ ! ( -e xmonad.cabal && -e dist/hpc/tix/properties/properties.tix ) ]]; then
|
||||
echo "run in the same dir as xmonad.cabal after having run
|
||||
|
||||
cabal configure --enable-tests --enable-library-coverage; cabal test
|
||||
|
||||
"
|
||||
exit 1
|
||||
fi
|
||||
|
||||
|
||||
propsExclude=$(find tests/Properties -name '*.hs' \
|
||||
| sed -e 's_/_._g' -e 's_.hs$__' -e 's_^tests._--exclude=_' )
|
||||
|
||||
hpcFlags="
|
||||
--hpcdir=dist/hpc/mix/
|
||||
dist/hpc/tix/properties/properties.tix
|
||||
"
|
||||
|
||||
|
||||
if [[ ! (-e dist/hpc/mix/Main.mix) ]]; then
|
||||
mv dist/hpc/mix/properties/* dist/hpc/mix/
|
||||
mv dist/hpc/mix/xmonad-*/xmonad-*/* dist/hpc/mix/xmonad-*/
|
||||
fi
|
||||
|
||||
|
||||
hpc markup --destdir=dist/hpc $hpcFlags > /dev/null
|
||||
echo "see dist/hpc/hpc_index.html
|
||||
"
|
||||
hpc report $hpcFlags
|
183
xmonad.cabal
183
xmonad.cabal
@@ -1,79 +1,136 @@
|
||||
name: xmonad
|
||||
version: 0.9.1
|
||||
homepage: http://xmonad.org
|
||||
version: 0.18.0.9
|
||||
synopsis: A tiling window manager
|
||||
description:
|
||||
xmonad is a tiling window manager for X. Windows are arranged
|
||||
automatically to tile the screen without gaps or overlap, maximising
|
||||
screen use. All features of the window manager are accessible from
|
||||
the keyboard: a mouse is strictly optional. xmonad is written and
|
||||
extensible in Haskell. Custom layout algorithms, and other
|
||||
extensions, may be written by the user in config files. Layouts are
|
||||
applied dynamically, and different layouts may be used on each
|
||||
workspace. Xinerama is fully supported, allowing windows to be tiled
|
||||
on several screens.
|
||||
category: System
|
||||
description: xmonad is a tiling window manager for X. Windows are arranged
|
||||
automatically to tile the screen without gaps or overlap, maximising
|
||||
screen use. All features of the window manager are accessible from the
|
||||
keyboard: a mouse is strictly optional. xmonad is written and
|
||||
extensible in Haskell. Custom layout algorithms, and other extensions,
|
||||
may be written by the user in config files. Layouts are applied
|
||||
dynamically, and different layouts may be used on each workspace.
|
||||
Xinerama is fully supported, allowing windows to be tiled on several
|
||||
screens.
|
||||
license: BSD3
|
||||
license-file: LICENSE
|
||||
author: Spencer Janssen
|
||||
author: Spencer Janssen, Don Stewart, Adam Vogt, David Roundy, Jason Creighton,
|
||||
Brent Yorgey, Peter Jones, Peter Simons, Andrea Rossato, Devin Mullins,
|
||||
Lukas Mai, Alec Berryman, Stefan O'Rear, Daniel Wagner, Peter J. Jones,
|
||||
Daniel Schoepe, Karsten Schoelzel, Neil Mitchell, Joachim Breitner,
|
||||
Peter De Wachter, Eric Mertens, Geoff Reedy, Michiel Derhaeg,
|
||||
Philipp Balzarek, Valery V. Vorotyntsev, Alex Tarkovsky, Fabian Beuke,
|
||||
Felix Hirn, Michael Sloan, Tomas Janousek, Vanessa McHale, Nicolas Pouillard,
|
||||
Aaron Denney, Austin Seipp, Benno Fünfstück, Brandon S Allbery, Chris Mears,
|
||||
Christian Thiemann, Clint Adams, Daniel Neri, David Lazar, Ferenc Wagner,
|
||||
Francesco Ariis, Gábor Lipták, Ivan N. Veselov, Ivan Tarasov, Javran Cheng,
|
||||
Jens Petersen, Joey Hess, Jonne Ransijn, Josh Holland, Khudyakov Alexey,
|
||||
Klaus Weidner, Michael G. Sloan, Mikkel Christiansen, Nicolas Dudebout,
|
||||
Ondřej Súkup, Paul Hebble, Shachaf Ben-Kiki, Siim Põder, Tim McIver,
|
||||
Trevor Elliott, Wouter Swierstra, Conrad Irwin, Tim Thelion, Tony Zorman
|
||||
maintainer: xmonad@haskell.org
|
||||
extra-source-files: README TODO CONFIG STYLE tests/loc.hs tests/Properties.hs
|
||||
man/xmonad.1.markdown man/xmonad.1 man/xmonad.1.html
|
||||
util/GenerateManpage.hs
|
||||
cabal-version: >= 1.2
|
||||
tested-with: GHC == 8.6.5 || == 8.8.4 || == 8.10.7 || == 9.0.2 || == 9.2.8 || == 9.4.8 || == 9.6.7 || == 9.8.4 || == 9.10.2 || == 9.12.2
|
||||
category: System
|
||||
homepage: http://xmonad.org
|
||||
bug-reports: https://github.com/xmonad/xmonad/issues
|
||||
build-type: Simple
|
||||
extra-source-files: README.md
|
||||
CHANGES.md
|
||||
CONTRIBUTING.md
|
||||
INSTALL.md
|
||||
MAINTAINERS.md
|
||||
TUTORIAL.md
|
||||
man/xmonad.1.markdown
|
||||
man/xmonad.1
|
||||
man/xmonad.1.html
|
||||
man/xmonad.hs
|
||||
util/hpcReport.sh
|
||||
cabal-version: 1.12
|
||||
|
||||
data-files: man/xmonad.hs
|
||||
source-repository head
|
||||
type: git
|
||||
location: https://github.com/xmonad/xmonad
|
||||
|
||||
flag small_base
|
||||
description: Choose the new smaller, split-up base package.
|
||||
|
||||
flag testing
|
||||
description: Testing mode, only build minimal components
|
||||
default: False
|
||||
flag pedantic
|
||||
description: Be pedantic (-Werror and the like)
|
||||
default: False
|
||||
manual: True
|
||||
|
||||
library
|
||||
exposed-modules: XMonad
|
||||
XMonad.Main
|
||||
XMonad.Core
|
||||
XMonad.Config
|
||||
XMonad.Layout
|
||||
XMonad.ManageHook
|
||||
XMonad.Operations
|
||||
XMonad.StackSet
|
||||
exposed-modules: XMonad
|
||||
XMonad.Config
|
||||
XMonad.Core
|
||||
XMonad.Layout
|
||||
XMonad.Main
|
||||
XMonad.ManageHook
|
||||
XMonad.Operations
|
||||
XMonad.StackSet
|
||||
other-modules: Paths_xmonad
|
||||
hs-source-dirs: src
|
||||
build-depends: base >= 4.12 && < 5
|
||||
, X11 >= 1.10 && < 1.11
|
||||
, containers
|
||||
, data-default-class
|
||||
, directory
|
||||
, filepath
|
||||
, mtl
|
||||
, process
|
||||
, setlocale
|
||||
, time
|
||||
, transformers >= 0.3
|
||||
, unix
|
||||
ghc-options: -funbox-strict-fields -Wall -Wno-unused-do-bind
|
||||
default-language: Haskell2010
|
||||
|
||||
if flag(small_base)
|
||||
build-depends: base < 4 && >=3, containers, directory, process, filepath
|
||||
else
|
||||
build-depends: base < 3
|
||||
build-depends: X11>=1.5.0.0 && < 1.6, mtl, unix
|
||||
-- Keep this in sync with the oldest version in 'tested-with'
|
||||
if impl(ghc > 8.6.5)
|
||||
ghc-options: -Wno-unused-imports
|
||||
|
||||
ghc-options: -funbox-strict-fields -Wall
|
||||
ghc-prof-options: -prof -auto-all
|
||||
extensions: CPP
|
||||
|
||||
if flag(testing)
|
||||
buildable: False
|
||||
if flag(pedantic)
|
||||
ghc-options: -Werror
|
||||
|
||||
executable xmonad
|
||||
main-is: Main.hs
|
||||
other-modules: XMonad
|
||||
XMonad.Main
|
||||
XMonad.Core
|
||||
XMonad.Config
|
||||
XMonad.Layout
|
||||
XMonad.ManageHook
|
||||
XMonad.Operations
|
||||
XMonad.StackSet
|
||||
main-is: Main.hs
|
||||
build-depends: base, xmonad
|
||||
ghc-options: -Wall -Wno-unused-do-bind
|
||||
default-language: Haskell2010
|
||||
|
||||
ghc-options: -funbox-strict-fields -Wall
|
||||
ghc-prof-options: -prof -auto-all
|
||||
extensions: CPP
|
||||
-- Keep this in sync with the oldest version in 'tested-with'
|
||||
if impl(ghc > 8.6.5)
|
||||
ghc-options: -Wno-unused-imports
|
||||
|
||||
if flag(testing)
|
||||
cpp-options: -DTESTING
|
||||
hs-source-dirs: . tests/
|
||||
build-depends: QuickCheck < 2
|
||||
ghc-options: -Werror
|
||||
if flag(testing) && flag(small_base)
|
||||
build-depends: random
|
||||
if flag(pedantic)
|
||||
ghc-options: -Werror
|
||||
|
||||
test-suite properties
|
||||
type: exitcode-stdio-1.0
|
||||
main-is: Properties.hs
|
||||
other-modules: Instances
|
||||
Properties.Delete
|
||||
Properties.Failure
|
||||
Properties.Floating
|
||||
Properties.Focus
|
||||
Properties.GreedyView
|
||||
Properties.Insert
|
||||
Properties.Layout.Full
|
||||
Properties.Layout.Tall
|
||||
Properties.Screen
|
||||
Properties.Shift
|
||||
Properties.Stack
|
||||
Properties.StackSet
|
||||
Properties.Swap
|
||||
Properties.View
|
||||
Properties.Workspace
|
||||
Utils
|
||||
hs-source-dirs: tests
|
||||
build-depends: base
|
||||
, QuickCheck >= 2
|
||||
, quickcheck-classes >= 0.4.3
|
||||
, X11
|
||||
, containers
|
||||
, xmonad
|
||||
default-language: Haskell2010
|
||||
|
||||
if impl(ghc > 9.8)
|
||||
ghc-options: -Wno-x-partial
|
||||
|
||||
if flag(pedantic)
|
||||
ghc-options: -Werror
|
||||
|
Reference in New Issue
Block a user