about summary refs log blame commit diff
path: root/exwm-cm.el
blob: 8e019bbc75236dda4a73e52cb18c730810c55401 (plain) (tree)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
1001
1002
1003
1004
1005
1006
1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
1028
1029
1030
1031
1032
1033
1034
1035
1036
1037
1038
1039
1040
1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
1064
1065
1066
1067
1068
1069
1070
1071
1072
1073
1074
1075
1076
1077
1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
1115
1116
1117
1118
1119
1120
1121
1122
1123
1124
1125
1126
1127
1128
1129
1130
1131
1132
1133
1134
1135
1136
1137
1138
1139
1140
1141
1142
1143
1144
1145
1146
1147
1148
1149
1150
1151
1152
1153
1154
1155
1156
1157
1158
1159
1160
1161
1162
1163
1164
1165
1166
1167
1168
1169
1170
1171
1172
1173
1174
1175
1176
1177
1178
1179
1180
1181
1182
1183
1184
1185
1186
1187
1188
1189
1190
1191
1192
1193
1194
1195
1196
1197
1198
1199
1200
1201
1202
1203
1204
1205
1206
1207
1208
1209
1210
1211
1212
1213
1214
1215
1216
1217
1218
1219
1220
1221
1222
1223
1224
1225
1226
1227
1228
1229
1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
1252
1253
1254
1255
1256
1257
1258
1259
1260
1261
1262
1263
1264
1265
1266
1267
1268
1269
1270
1271
1272
1273
1274
1275
1276
1277
1278
1279
1280
1281
1282
1283
1284
1285
1286
1287
1288
1289
1290
1291
1292
1293
1294
1295
1296
1297
1298
1299
1300
1301
1302
1303
1304
1305
1306
1307
1308
1309
1310
1311
1312
1313
1314
1315
1316
1317
1318
1319
1320
1321
1322
1323
1324
1325
1326
1327
1328
1329
1330
1331
1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
1354
1355
1356
1357
1358
1359
1360
1361
1362
1363
1364
1365
1366
1367
1368
1369
1370
1371
1372
1373
1374
1375
1376
1377
1378
1379
1380
1381
1382
1383
1384
1385
1386
1387
1388
1389
1390
1391
1392
1393
1394
1395
1396
1397
1398
1399
1400
1401
1402
1403
1404
1405
1406
1407
1408
1409
1410
1411
1412
1413
1414
1415
1416
1417
1418
1419
1420
1421
1422
1423
1424
1425
1426
1427
1428
1429
1430
1431
1432
1433
1434
1435
1436
1437
1438
1439
1440
1441
1442
1443
1444
1445
1446
1447
1448
1449
1450
1451
1452
1453
1454
1455
1456
1457
1458
1459
1460
1461
1462
1463
1464
1465
1466
1467
1468
1469
1470
1471
1472
1473
1474
1475
1476
1477
1478
1479
1480
1481
1482
1483
1484
1485
1486
1487
1488
1489
1490
1491
1492
1493
1494
1495
1496
1497
1498
1499
1500
1501
1502
1503
1504
1505
1506
1507
1508
1509
1510
1511
1512
1513
1514
1515
1516
1517
1518
1519
1520
1521
1522
1523
1524
1525
1526
1527
1528
1529
1530
1531
1532
1533
1534
1535
1536
1537
1538
1539
1540
1541
1542
1543
1544
1545
1546
1547
1548
1549
1550
1551
1552
1553
1554
1555
1556
1557
1558
1559
1560
1561
1562
1563
1564
1565
1566
1567
1568
1569
1570
1571
1572
1573
1574
1575
1576
1577
1578
1579
1580
1581
1582
1583
1584
1585
1586
1587
1588
1589
1590
1591
1592
1593
1594
1595
1596
1597
1598
1599
1600
1601
1602
1603
1604
1605
1606
1607
1608
1609
1610
1611
1612
1613
1614
1615
1616
1617
1618
1619
1620
1621
1622
1623
1624
1625
1626
1627
1628
1629
1630
1631
1632
1633
1634
1635
1636
1637
1638
1639
1640
1641
1642
1643
1644
1645
1646
1647
1648
1649
1650
1651
1652
1653
1654
1655
1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
1677
1678
1679
1680
1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
1703
1704
1705
1706
1707
1708
1709
1710
1711
1712
1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
1752
1753
1754
1755
1756
1757
1758
1759
1760
1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778

















































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































































                                                                               
;;; exwm-cm.el --- Compositing Manager for EXWM  -*- lexical-binding: t -*-

;; Copyright (C) 2016 Free Software Foundation, Inc.

;; Author: Chris Feng <chris.w.feng@gmail.com>

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This module provides a compositing manager (CM) for EXWM, mainly to
;; enable transparency support.

;; Usage:
;; Add following lines to .emacs and modify accordingly:
;;
;; (require 'exwm-cm)
;; ;; Make all Emacs frames opaque.
;; (setq window-system-default-frame-alist '((x . ((alpha . 100)))))
;; ;; Assign everything else a 80% opacity.
;; (setq exwm-cm-opacity 80)
;; (exwm-cm-enable)
;;
;; With the last line this CM would be started with EXWM.  You can also
;; start and stop this CM with `exwm-cm-start' and `exwm-cm-stop' at any
;; time.

;; Theory:
;; Due to its unique way of managing X windows, EXWM can not work with
;; any existing CMs.  And this CM, designed specifically for EXWM,
;; probably won't work well with other WMs, too.  The theories behind
;; all CMs are basically the same, some peculiarities of this CM are
;; summarized as the following sections.

;; + Data structures:
;;   This CM organizes all X windows concerned with compositing in a
;;   tree hierarchy.  Below is a stripped-down version of such tree with
;;   each node representing an X window (except the root placeholder),
;;
;;   (nil
;;    (root-xwin
;;     (unmanaged-xwin)
;;     (workspace-container
;;      (unmanaged-xwin)
;;      (xwin-container
;;       (xwin)
;;       (floating-frame-container
;;        (floating-frame)))
;;      (xwin-container
;;       (xwin))
;;      (workspace-frame-container
;;       (workspace-frame)))
;;     (minibuffer-frame-container
;;      (minibuffer-frame))))
;;
;;   where
;;   - nodes with non-nil CDRs are containers,
;;   - siblings are arranged in stacking order (top to bottom),
;;   - and "managed" and "unmanaged" are in WM's sense.
;;
;;   During a painting process, the tree is traversed starting from the
;;   root node, with each leaf visited and painted.  The attributes of
;;   each X window (position, size, etc) are recorded as an instance of
;;   class `exwm-cm--attr'.  Such instance is associated with the
;;   corresponding X window ID through a hash table.  The instance also
;;   contains a slot pointing to a subtree of the aforementioned tree,
;;   with the root node being the parent of the X window.  This makes it
;;   convenient to carry out operations such as insertion, deletion,
;;   restacking and reparenting.

;; + Compositing strategies:
;;   - Only leaves are painted, since branches (containers) are always
;;     invisible.
;;   - The root X window is painted separately.
;;   - Siblings below a workspace frame container are not painted; they
;;     are considered hidden.
;;   - Only the top workspace in one (RandR) output is painted.
;;   - Workspace frames and floating frames are always clipped by its
;;     Emacs windows displaying `exwm-mode' buffers, therefore they
;;     don't block X windows.

;; Reference:
;; + xcompmgr (http://cgit.freedesktop.org/xorg/app/xcompmgr/)

;;; Code:

(require 'xcb-composite)
(require 'xcb-damage)
(require 'xcb-ewmh)
(require 'xcb-icccm)
(require 'xcb-renderutil)
(require 'xcb-shape)

(require 'exwm-core)
(require 'exwm-workspace)
(require 'exwm-manage)

(defconst exwm-cm--OPAQUE (float #xFFFFFFFF)
  "The opacity value of the _NET_WM_WINDOW_OPACITY property.")
(defvar exwm-cm--_NET_WM_WINDOW_OPACITY nil "The _NET_WM_WINDOW_OPACITY atom.")
(defvar exwm-cm-opacity nil
  "The default value of opacity when it's not explicitly specified.

The value should be a floating number between 0 (transparent) and 100
(opaque).  A value of nil also means opaque.")

(defvar exwm-cm--hash nil
  "The hash table associating X window IDs to their attributes.")

(defvar exwm-cm--conn nil "The X connection used by the CM.")
(defvar exwm-cm--buffer nil "The rendering buffer.")
(defvar exwm-cm--depth nil "Default depth.")
(defvar exwm-cm--clip-changed t "Whether clip has changed.")
(defvar exwm-cm--damages nil "All damaged regions.")
(defvar exwm-cm--expose-rectangles nil
  "Used by Expose event handler to collect exposed regions.")

(defvar exwm-cm--background nil "The background (render) picture.")
(defvar exwm-cm--background-atom-names '("_XROOTPMAP_ID" "_XSETROOT_ID")
  "Property names for background pixmap.")
(defvar exwm-cm--background-atoms nil "Interned atoms of the property names.")

(defun exwm-cm--get-opacity (xwin)
  "Get the opacity of X window XWIN.

The value is between 0 (fully transparent) to #xFFFFFFFF (opaque)."
  (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn
                   (make-instance 'xcb:icccm:-GetProperty-single
                                  :window xwin
                                  :property exwm-cm--_NET_WM_WINDOW_OPACITY
                                  :type xcb:Atom:CARDINAL))))
    ;; The X window might have already been destroyed.
    (when reply
      (slot-value reply 'value))))

(defun exwm-cm-set-opacity (xwin opacity)
  "Set the opacity of X window XWIN to OPACITY.

The value is between 0 (fully transparent) to 100 (opaque).

If called interactively, XWIN would be the selected X window."
  (interactive
   (list (exwm--buffer->id (window-buffer))
         (read-number "Opacity (0 ~ 100): " 100)))
  (when (and xwin
             (<= 0 opacity 100))
    (setq opacity (round (* exwm-cm--OPAQUE (/ opacity 100.0))))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:icccm:-ChangeProperty-single
                       :window xwin
                       :property exwm-cm--_NET_WM_WINDOW_OPACITY
                       :type xcb:Atom:CARDINAL
                       :data opacity))
    (xcb:flush exwm-cm--conn)))

(defclass exwm-cm--attr ()
  (
   ;; The entity associated with this X window; can be a frame, a buffer
   ;; or nil.
   (entity :initform nil)
   ;; The subtree of which the root node is the parent of this X window.
   (tree :initarg :tree)
   ;; Geometry.
   (x :initarg :x)
   (y :initarg :y)
   (width :initarg :width)
   (height :initarg :height)
   ;; X window attributes.
   (visual :initarg :visual)
   (class :initarg :class)
   ;; The opacity of this X window; can be 0 ~ #xFFFE or nil.
   (opacity :initform nil)
   ;; Determine whether this X window should be treated as opaque or
   ;; transparent; can be nil (opaque), 'argb or 'transparent (both
   ;; should be treated as transparent).
   (mode :initform nil)
   ;; The (render) picture of this X window.
   (picture :initform nil)
   ;; The 1x1 (render) picture with only alpha channel.
   (alpha-picture :initform nil)
   ;; Whether this X window is ever damaged.
   (damaged :initform nil)
   ;; The damage object monitoring this X window.
   (damage :initarg :damage)
   ;; The bounding region of this X window (can be irregular).
   (border-size :initform nil)
   ;; The rectangular bounding region of this X window.
   (extents :initform nil)
   ;; The region require repainting (used for transparent X windows).
   (border-clip :initform nil)
   ;; Shape-related parameters.
   (shaped :initform nil)
   (shape-x :initarg :shape-x)
   (shape-y :initarg :shape-y)
   (shape-width :initarg :shape-width)
   (shape-height :initarg :shape-height))
  :documentation "Attributes of an X window.")

(defsubst exwm-cm--xwin->attr (xwin)
  "Get the attributes of X window XWIN."
  (gethash xwin exwm-cm--hash))

(defsubst exwm-cm--get-tree (xwin)
  "Get the subtree of the parent of X window XWIN."
  (slot-value (exwm-cm--xwin->attr xwin) 'tree))

(defsubst exwm-cm--set-tree (xwin tree)
  "Reparent X window XWIN to another tree TREE."
  (setf (slot-value (exwm-cm--xwin->attr xwin) 'tree) tree))

(defsubst exwm-cm--get-parent (xwin)
  "Get the parent of X window XWIN."
  (car (exwm-cm--get-tree xwin)))

(defsubst exwm-cm--get-siblings (xwin)
  "Get a list of subtrees of the siblings of X window XWIN"
  (cdr (exwm-cm--get-tree xwin)))

(defsubst exwm-cm--get-subtree (xwin)
  "Get the subtree of which the X window XWIN is the root node."
  (assq xwin (exwm-cm--get-siblings xwin)))

(defun exwm-cm--create-attr (xwin tree x y width height)
  "Create attributes for X window XWIN.

TREE is the subtree and the parent of this X window is the tree's root.
X and Y specify the position with regard to the root X window.  WIDTH
and HEIGHT specify the size of the X window."
  (let (visual class map-state damage attr)
    (cond
     ((= xwin exwm--root)
      ;; Redirect all subwindows to off-screen storage.
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:composite:RedirectSubwindows
                         :window exwm--root
                         :update xcb:composite:Redirect:Manual))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:ChangeWindowAttributes
                         :window xwin
                         :value-mask xcb:CW:EventMask
                         :event-mask (logior xcb:EventMask:StructureNotify
                                             xcb:EventMask:PropertyChange
                                             xcb:EventMask:SubstructureNotify
                                             xcb:EventMask:Exposure)))
      (setq visual (slot-value (car (slot-value (xcb:get-setup exwm-cm--conn)
                                                'roots))
                               'root-visual)
            class xcb:WindowClass:InputOutput))
     ((eq xwin exwm-manage--desktop)
      ;; Ignore any desktop; paint the background ourselves.
      (setq visual 0
            class xcb:WindowClass:InputOnly
            map-state xcb:MapState:Unmapped))
     (t
      ;; Redirect this window to off-screen storage, or the content
      ;; would be mirrored to its parent.
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:composite:RedirectWindow
                         :window xwin
                         :update xcb:composite:Redirect:Manual))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:ChangeWindowAttributes
                         :window xwin
                         :value-mask xcb:CW:EventMask
                         :event-mask (logior xcb:EventMask:StructureNotify
                                             xcb:EventMask:PropertyChange)))
      (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn
                       (make-instance 'xcb:GetWindowAttributes
                                      :window xwin))))
        (if reply
            (with-slots ((visual* visual)
                         (class* class)
                         (map-state* map-state))
                reply
              (setq visual visual*
                    class class*
                    map-state map-state*))
          ;; The X window has been destroyed actually.  It'll get
          ;; removed by a DestroyNotify event.
          (setq visual 0
                class xcb:WindowClass:InputOnly
                map-state xcb:MapState:Unmapped)))
      (when (/= class xcb:WindowClass:InputOnly)
        (setq damage (xcb:generate-id exwm-cm--conn))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:damage:Create
                           :damage damage
                           :drawable xwin
                           :level xcb:damage:ReportLevel:NonEmpty))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:shape:SelectInput
                           :destination-window xwin
                           :enable 1)))))
    (setq attr (make-instance 'exwm-cm--attr
                              :tree tree
                              :x x
                              :y y
                              :width width
                              :height height
                              :visual visual
                              :class class
                              :damage damage
                              :shape-x x
                              :shape-y y
                              :shape-width width
                              :shape-height height))
    (puthash xwin attr exwm-cm--hash)
    (unless (or (= xwin exwm--root)
                (= class xcb:WindowClass:InputOnly))
      (exwm-cm--update-opacity xwin)
      (when (= map-state xcb:MapState:Viewable)
        (exwm-cm--map-xwin xwin t)))))

(defun exwm-cm--update-geometry (xwin x y width height &optional above-sibling)
  "Update the geometry of X window XWIN.

X, Y, WIDTH and HEIGHT have the same meaning with the arguments used in
`exwm-cm--create-attr'.  If ABOVE-SIBLING is non-nil, restack XWIN with
`exwm-cm--restack.'"
  (with-slots ((x* x)
               (y* y)
               (width* width)
               (height* height)
               extents shaped shape-x shape-y shape-width shape-height)
      (exwm-cm--xwin->attr xwin)
    (let ((stack-changed (and above-sibling
                              (exwm-cm--restack xwin above-sibling)))
          (position-changed (or (and x (/= x x*))
                                (and y (/= y y*))))
          (size-changed (or (and width (/= width width*))
                            (and height (/= height height*))))
          subtree dx dy damage new-extents)
      (when position-changed
        (setq subtree (exwm-cm--get-subtree xwin)
              dx (- x x*)
              dy (- y y*))
        (dolist (node (cdr subtree))
          (with-slots (x y) (exwm-cm--xwin->attr (car node))
            (exwm--log "(CM) #x%X(*): @%+d%+d => @%+d%+d"
                       (car node) x y (+ x dx) (+ y dy))
            (exwm-cm--update-geometry (car node) (+ x dx) (+ y dy) nil nil)))
        (exwm--log "(CM) #x%X: @%+d%+d => @%+d%+d" xwin x* y* x y)
        (setf x* x
              y* y)
        (cl-incf shape-x dx)
        (cl-incf shape-y dy))
      (when size-changed
        (setf width* width
              height* height)
        (unless shaped
          (setf shape-width width
                shape-height height)))
      (when (or stack-changed position-changed size-changed)
        (setq damage (xcb:generate-id exwm-cm--conn)
              new-extents (xcb:generate-id exwm-cm--conn))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region damage
                           :rectangles nil))
        (when extents
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:CopyRegion
                             :source extents
                             :destination damage)))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region new-extents
                           :rectangles (list (make-instance 'xcb:RECTANGLE
                                                            :x x*
                                                            :y y*
                                                            :width width*
                                                            :height height*))))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:UnionRegion
                           :source1 damage
                           :source2 new-extents
                           :destination damage))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:DestroyRegion
                           :region new-extents))
        (exwm-cm--add-damage damage)))))

(defun exwm-cm--update-opacity (xwin)
  "Update the opacity of X window XWIN."
  (with-slots (visual opacity mode alpha-picture extents)
      (exwm-cm--xwin->attr xwin)
    (let (format forminfo)
      ;; Get the opacity.
      (setf opacity (exwm-cm--get-opacity xwin))
      (if opacity
          (setf opacity (round (* #xFFFF (/ opacity exwm-cm--OPAQUE))))
        (when (numberp exwm-cm-opacity)
          (setf opacity (round (* #xFFFF (/ exwm-cm-opacity 100.0))))))
      (when (and opacity
                 (>= opacity #xFFFF))
        (setf opacity nil))
      ;; Determine the mode of the X window.
      (setq format (xcb:renderutil:find-visual-format
                    (xcb:renderutil:query-formats exwm-cm--conn) visual))
      (when format
        (catch 'break
          (dolist (f (slot-value (xcb:renderutil:query-formats exwm-cm--conn)
                                 'formats))
            (when (eq format (slot-value f 'id))
              (setq forminfo f)
              (throw 'break nil)))))
      (if (and forminfo
               (eq xcb:render:PictType:Direct (slot-value forminfo 'type))
               (/= 0 (slot-value (slot-value forminfo 'direct) 'alpha-mask)))
          (setf mode 'argb)
        (if opacity
            (setf mode 'transparent)
          (setf mode nil)))
      ;; Clear resources.
      (when alpha-picture
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:render:FreePicture
                           :picture alpha-picture))
        (setf alpha-picture nil))
      (when extents
        (let ((damage (xcb:generate-id exwm-cm--conn)))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:CreateRegion
                             :region damage
                             :rectangles nil))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:CopyRegion
                             :source extents
                             :destination damage))
          (exwm-cm--add-damage damage))))))

(defsubst exwm-cm--push (newelt place)
  "Similar to `push' but preserve the reference."
  (let ((oldelt (car place)))
    (setf (car place) newelt
          (cdr place) (cons oldelt (cdr place)))))

(defsubst exwm-cm--delq (elt list)
  "Similar to `delq' but preserve the reference."
  (if (eq elt (car list))
      (setf (car list) (cadr list)
            (cdr list) (cddr list))
    (delq elt list)))

(defsubst exwm-cm--assq-delete-all (key alist)
  "Similar to `assq-delete-all' but preserve the reference."
  (when (eq key (caar alist))
    (setf (car alist) (cadr alist)
          (cdr alist) (cddr alist)))
  (assq-delete-all key alist))

(defun exwm-cm--create-tree (&optional xwin)
  "Create a tree with XWIN being the root node."
  (let (tree0 x0 y0 children containers)
    ;; Get the position of this branch.
    (if xwin
        (with-slots (tree x y) (exwm-cm--xwin->attr xwin)
          (setq tree0 (assq xwin (cdr tree))
                x0 x
                y0 y))
      (setq tree0 (list nil)
            x0 0
            y0 0))
    ;; Get children nodes.
    (if (null xwin)
        (setq children (list exwm--root))
      (setq children
            (reverse (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                                     (make-instance 'xcb:QueryTree
                                                    :window xwin))
                                 'children))))
    ;; Get container nodes.
    ;; Floating frame containers are determined dynamically.
    (cond
     ((null xwin)
      (setq containers `((,exwm--root))))
     ((= xwin exwm--root)
      ;; Workspace containers and the minibuffer frame container.
      (setq containers (mapcar (lambda (f)
                                 (cons (frame-parameter f 'exwm-workspace) f))
                               exwm-workspace--list))
      (when (exwm-workspace--minibuffer-own-frame-p)
        (push (cons
               (frame-parameter exwm-workspace--minibuffer 'exwm-container)
               exwm-workspace--minibuffer)
              containers)))
     ;; No containers in the minibuffer container.
     ((and (exwm-workspace--minibuffer-own-frame-p)
           (= xwin
              (frame-parameter exwm-workspace--minibuffer 'exwm-container))))
     ((= exwm--root
         (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                         (make-instance 'xcb:QueryTree
                                        :window xwin))
                     'parent))
      ;; Managed X window containers and the workspace frame container.
      (let (frame)
        (catch 'break
          (dolist (f exwm-workspace--list)
            (when (= xwin (frame-parameter f 'exwm-workspace))
              (setq frame f)
              (throw 'break nil))))
        (cl-assert frame)
        (dolist (pair exwm--id-buffer-alist)
          (with-current-buffer (cdr pair)
            (when (eq frame exwm--frame)
              (push (cons exwm--container (cdr pair)) containers))))
        (push (cons (frame-parameter frame 'exwm-container) frame)
              containers))))
    ;; Create subnodes.
    (dolist (xwin children)
      ;; Create attributes.
      (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn
                       (make-instance 'xcb:GetGeometry
                                      :drawable xwin))))
        ;; It's possible the X window has been destroyed.
        (if (null reply)
            (setq xwin nil)
          (when reply
            (with-slots (x y width height) reply
              (exwm-cm--create-attr xwin tree0
                                    (+ x x0) (+ y y0) width height))
            ;; Insert the node.
            (setcdr (or (last (cdr tree0)) tree0) `((,xwin))))))
      (cond
       ((null xwin))
       ((assq xwin containers)
        ;; A branch.  Repeat the process.
        (exwm-cm--create-tree xwin)
        (let ((entity (cdr (assq xwin containers)))
              entity-xwin)
          (when entity
            (setq entity-xwin (if (framep entity)
                                  (frame-parameter entity 'exwm-outer-id)
                                (buffer-local-value 'exwm--id entity)))
            (setf (slot-value (exwm-cm--xwin->attr entity-xwin) 'entity) entity
                  (slot-value (exwm-cm--xwin->attr xwin) 'entity) entity)
            (let ((tmp (exwm-cm--get-parent entity-xwin)))
              (when (/= xwin tmp)
                ;; Workspace frame container.
                (setf (slot-value (exwm-cm--xwin->attr tmp) 'entity)
                      entity))))))
       ((and (null containers)
             (exwm--id->buffer xwin))
        ;; A leaf but a floating frame container might follow.
        (with-current-buffer (exwm--id->buffer xwin)
          (when exwm--floating-frame
            (push (cons (frame-parameter exwm--floating-frame 'exwm-container)
                        exwm--floating-frame)
                  containers))))))))

(defun exwm-cm--restack (xwin above-sibling)
  "Restack X window XWIN so as to it's exactly on top of ABOVE-SIBLING."
  (let ((siblings (exwm-cm--get-siblings xwin))
        node tmp)
    (unless (= 1 (length siblings))
      (setq node (assq xwin siblings))
      (if (= above-sibling xcb:Window:None)
          ;; Put at bottom.
          (unless (eq node (cdr (last siblings)))
            (exwm-cm--delq node siblings)
            (setcdr (last siblings) (list node))
            ;; Set the return value.
            t)
        ;; Insert before the sibling.
        (setq tmp siblings)
        (while (and tmp
                    (/= above-sibling (caar tmp)))
          (setq tmp (cdr tmp)))
        (cl-assert tmp)
        ;; Check if it's already at the requested position.
        (unless (eq tmp (cdr siblings))
          (exwm-cm--delq node siblings)
          (exwm-cm--push node tmp)
          ;; Set the return value.
          t)))))

(declare-function exwm-layout--iconic-state-p "exwm-layout.el" (&optional id))

(defun exwm-cm--paint-tree (tree region &optional force-opaque frame-clip)
  "Paint the tree TREE, with REGION specifying the clipping region.

If FORCE-OPAQUE is non-nil, all X windows painted in this tree is
assumed opaque.  FRAME-CLIP specifies the region should be clipped when
painting a frame."
  (unless tree
    (setq tree (exwm-cm--get-tree exwm--root)))
  (let ((root (car tree))
        xwin attr entity current output outputs queue rectangles)
    ;; Paint subtrees.
    (catch 'break
      (dolist (subtree (cdr tree))
        (setq xwin (car subtree)
              attr (exwm-cm--xwin->attr xwin))
        (cond
         ;; Skip destroyed X windows.
         ((null attr))
         ;; Skip InputOnly X windows.
         ((= xcb:WindowClass:InputOnly
             (slot-value attr 'class)))
         ((and (eq root exwm--root)
               (frame-live-p (setq entity (slot-value attr 'entity)))
               (if (eq entity exwm-workspace--minibuffer)
                   ;; Skip the minibuffer if the current workspace is
                   ;; already painted.
                   (unless (exwm-workspace--minibuffer-attached-p)
                     current)
                 ;; Skip lower workspaces on visited RandR output.
                 ;; If RandR is not enabled, it'll just paint the first.
                 (memq (setq output (frame-parameter entity
                                                     'exwm-randr-output))
                       outputs))))
         ((cdr subtree)
          ;; Paint the subtree.
          (setq entity (slot-value attr 'entity))
          (let (fullscreen clip)
            (cond
             ((buffer-live-p entity)
              (with-current-buffer entity
                ;; Collect frame clip but exclude fullscreen and
                ;; floating X windows.
                (setq fullscreen (memq xcb:Atom:_NET_WM_STATE_FULLSCREEN
                                       exwm--ewmh-state))
                (when (and (null fullscreen)
                           ;; In case it's hidden.
                           (null (exwm-layout--iconic-state-p))
                           ;; The buffer of a floating X windows is not
                           ;; displayed on a workspace frame.
                           (null exwm--floating-frame)
                           ;; Opaque regions are always clipped.
                           (slot-value (exwm-cm--xwin->attr xwin) 'mode))
                  ;; Prepare rectangles to clip the workspace frame.
                  (with-slots (x y width height) (exwm-cm--xwin->attr xwin)
                    (push (make-instance 'xcb:RECTANGLE
                                         :x x
                                         :y y
                                         :width width
                                         :height height)
                          rectangles)))))
             ((and rectangles
                   (frame-live-p entity))
              ;; Prepare region to clip the frame.
              (setq clip (xcb:generate-id exwm-cm--conn))
              (xcb:+request exwm-cm--conn
                  (make-instance 'xcb:xfixes:CreateRegion
                                 :region clip
                                 :rectangles rectangles))))
            (setq queue
                  (nconc (exwm-cm--paint-tree subtree region fullscreen clip)
                         queue))
            (when fullscreen
              ;; Fullscreen X windows are always opaque thus occludes
              ;; anything in this workspace.
              (throw 'break 'fullscreen))
            (when clip
              (xcb:+request exwm-cm--conn
                  (make-instance 'xcb:xfixes:DestroyRegion
                                 :region clip))))
          (if (not (eq root exwm--root))
              ;; Avoid painting any siblings below the workspace frame
              ;; container.
              (when (exwm-workspace--workspace-p (slot-value attr 'entity))
                (throw 'break nil))
            ;; Save some status.
            (when (and (frame-live-p entity)
                       (not (eq entity exwm-workspace--minibuffer)))
              (push output outputs)
              (when (eq entity exwm-workspace--current)
                (setq current t)))))
         ((and force-opaque
               (slot-value attr 'damaged))
          (exwm-cm--paint-opaque xwin region t))
         ((slot-value attr 'damaged)
          ;; Paint damaged leaf.
          (setq entity (slot-value attr 'entity))
          (when (slot-value attr 'mode)
            (push xwin queue))
          (cond
           ((buffer-live-p entity)
            (with-current-buffer entity
              (cl-assert (= xwin exwm--id))
              (when (and exwm--floating-frame
                         ;; Opaque regions are always clipped.
                         (slot-value (exwm-cm--xwin->attr xwin) 'mode))
                ;; Prepare rectangles to clip the floating frame.
                (with-slots (x y width height) (exwm-cm--xwin->attr xwin)
                  (push (make-instance 'xcb:RECTANGLE
                                       :x x
                                       :y y
                                       :width width
                                       :height height)
                        rectangles)))))
           ((and frame-clip
                 (frame-live-p entity))
            ;; Apply frame clip.
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:xfixes:IntersectRegion
                               :source1 region
                               :source2 frame-clip
                               :destination frame-clip))
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:xfixes:SubtractRegion
                               :source1 region
                               :source2 frame-clip
                               :destination region))))
          (exwm-cm--paint-opaque xwin region)
          (when (and frame-clip
                     (frame-live-p entity))
            ;; Restore frame clip.
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:xfixes:UnionRegion
                               :source1 region
                               :source2 frame-clip
                               :destination region)))))))
    ;; Return the queue.
    queue))

(defun exwm-cm--paint-opaque (xwin region &optional force-opaque)
  "Paint an X window XWIN clipped by region REGION if XWIN is opaque.

Also update the attributes of XWIN and clip the region."
  (with-slots (x y width height visual mode picture
                 border-size extents border-clip)
      (exwm-cm--xwin->attr xwin)
    ;; Prepare the X window picture.
    (unless picture
      (setf picture (xcb:generate-id exwm-cm--conn))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:CreatePicture
                         :pid picture
                         :drawable xwin
                         :format (xcb:renderutil:find-visual-format
                                  (xcb:renderutil:query-formats exwm-cm--conn)
                                  visual)
                         :value-mask 0)))
    ;; Clear cached resources if clip changed.
    (when exwm-cm--clip-changed
      (when border-size
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:DestroyRegion
                           :region border-size))
        (setf border-size nil))
      (when extents
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:DestroyRegion
                           :region extents))
        (setf extents nil))
      (when border-clip
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:DestroyRegion
                           :region border-clip))
        (setf border-clip nil)))
    ;; Retrieve the border.
    (unless border-size
      (setf border-size (xcb:generate-id exwm-cm--conn))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:CreateRegionFromWindow
                         :region border-size
                         :window xwin
                         :kind xcb:shape:SK:Bounding))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:TranslateRegion
                         :region border-size
                         :dx x
                         :dy y)))
    ;; Retrieve the extents.
    (unless extents
      (setf extents (xcb:generate-id exwm-cm--conn))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:CreateRegion
                         :region extents
                         :rectangles (list (make-instance 'xcb:RECTANGLE
                                                          :x x
                                                          :y y
                                                          :width width
                                                          :height height)))))
    (cond
     ((and mode
           (null force-opaque))
      ;; Calculate clipped border for the transparent X window.
      (unless border-clip
        (setf border-clip (xcb:generate-id exwm-cm--conn))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region border-clip
                           :rectangles nil))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CopyRegion
                           :source region
                           :destination border-clip))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:IntersectRegion
                           :source1 border-clip
                           :source2 border-size
                           :destination border-clip))))
     (t
      ;; Clip & render for the opaque X window.
      ;; Set the clip region for the rendering buffer.
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:SetPictureClipRegion
                         :picture exwm-cm--buffer
                         :region region
                         :x-origin 0
                         :y-origin 0))
      ;; Clip the region with border.
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:SubtractRegion
                         :source1 region
                         :source2 border-size
                         :destination region))
      ;; Render the picture to the buffer.
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:Composite
                         :op xcb:render:PictOp:Src
                         :src picture
                         :mask xcb:render:Picture:None
                         :dst exwm-cm--buffer
                         :src-x 0
                         :src-y 0
                         :mask-x 0
                         :mask-y 0
                         :dst-x x
                         :dst-y y
                         :width width
                         :height height))))))

(defun exwm-cm--paint-transparent (xwin)
  "Paint a transparent X window XWIN."
  (with-slots (x y width height opacity picture alpha-picture border-clip)
      (exwm-cm--xwin->attr xwin)
    ;; Prepare the alpha picture for transparent X windows.
    (when (and opacity (null alpha-picture))
      (setf alpha-picture (xcb:generate-id exwm-cm--conn))
      (let ((pixmap (xcb:generate-id exwm-cm--conn)))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:CreatePixmap
                           :depth 8
                           :pid pixmap
                           :drawable exwm--root
                           :width 1
                           :height 1))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:render:CreatePicture
                           :pid alpha-picture
                           :drawable pixmap
                           :format (xcb:renderutil:find-standard
                                    (xcb:renderutil:query-formats
                                     exwm-cm--conn)
                                    xcb:renderutil:PICT_STANDARD:A_8)
                           :value-mask xcb:render:CP:Repeat
                           :repeat 1))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:render:FillRectangles
                           :op xcb:render:PictOp:Src
                           :dst alpha-picture
                           :color (make-instance 'xcb:render:COLOR
                                                 :red 0
                                                 :green 0
                                                 :blue 0
                                                 :alpha opacity)
                           :rects (list (make-instance 'xcb:RECTANGLE
                                                       :x 0
                                                       :y 0
                                                       :width 1
                                                       :height 1))))))
    ;; Set the clip region for the rendering buffer.
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:xfixes:SetPictureClipRegion
                       :picture exwm-cm--buffer
                       :region border-clip
                       :x-origin 0
                       :y-origin 0))
    ;; Render the picture to the buffer.
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:render:Composite
                       :op xcb:render:PictOp:Over
                       :src picture
                       :mask (or alpha-picture xcb:render:Picture:None)
                       :dst exwm-cm--buffer
                       :src-x 0
                       :src-y 0
                       :mask-x 0
                       :mask-y 0
                       :dst-x x
                       :dst-y y
                       :width width
                       :height height))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:xfixes:DestroyRegion
                       :region border-clip))
    (setf border-clip nil)))

(defun exwm-cm--paint (&optional region)
  "Paint the whole tree within clipping region REGION.

If REGION is omitted, `exwm-cm--damages' is assumed.  If it's t, paint
the whole screen."
  ;; Prepare the clipping region.
  (cond
   ((null region)
    (when exwm-cm--damages
      (setq region exwm-cm--damages)))
   ((eq region t)
    (with-slots (width height) (exwm-cm--xwin->attr exwm--root)
      (let ((rect (make-instance 'xcb:RECTANGLE
                                 :x 0
                                 :y 0
                                 :width width
                                 :height height)))
        (setq region (xcb:generate-id exwm-cm--conn))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region region
                           :rectangles (list rect)))))))
  (when region
    ;; Prepare the rendering buffer.
    (unless exwm-cm--buffer
      (let ((pixmap (xcb:generate-id exwm-cm--conn))
            (picture (xcb:generate-id exwm-cm--conn)))
        (setq exwm-cm--buffer picture)
        (with-slots (width height visual) (exwm-cm--xwin->attr exwm--root)
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:CreatePixmap
                             :depth exwm-cm--depth
                             :pid pixmap
                             :drawable exwm--root
                             :width width
                             :height height))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:render:CreatePicture
                             :pid picture
                             :drawable pixmap
                             :format (xcb:renderutil:find-visual-format
                                      (xcb:renderutil:query-formats
                                       exwm-cm--conn)
                                      visual)
                             :value-mask 0)))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:FreePixmap
                           :pixmap pixmap))))
    (let (queue)
      ;; Paint opaque X windows and update clipping region.
      (setq queue (exwm-cm--paint-tree nil region))
      ;; Paint the background.
      (exwm-cm--paint-background region)
      ;; Paint transparent X windows.
      (while queue
        (exwm-cm--paint-transparent (pop queue))))
    ;; Submit changes.
    (with-slots (width height picture) (exwm-cm--xwin->attr exwm--root)
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:SetPictureClipRegion
                         :picture exwm-cm--buffer
                         :region xcb:xfixes:Region:None
                         :x-origin 0
                         :y-origin 0))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:Composite
                         :op xcb:render:PictOp:Src
                         :src exwm-cm--buffer
                         :mask xcb:render:Picture:None
                         :dst picture
                         :src-x 0
                         :src-y 0
                         :mask-x 0
                         :mask-y 0
                         :dst-x 0
                         :dst-y 0
                         :width width
                         :height height)))
    ;; Cleanup.
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:xfixes:DestroyRegion
                       :region region))
    (when (eq region exwm-cm--damages)
      (setq exwm-cm--damages nil))
    (setq exwm-cm--clip-changed nil)
    (xcb:flush exwm-cm--conn)))

(defun exwm-cm--paint-background (region)
  "Paint the background."
  (unless exwm-cm--background
    (setq exwm-cm--background (xcb:generate-id exwm-cm--conn))
    (let (pixmap exist)
      (catch 'break
        (dolist (atom exwm-cm--background-atoms)
          (with-slots (~lsb format value-len value)
              (xcb:+request-unchecked+reply exwm-cm--conn
                  (make-instance 'xcb:GetProperty
                                 :delete 0
                                 :window exwm--root
                                 :property atom
                                 :type xcb:Atom:PIXMAP
                                 :long-offset 0
                                 :long-length 4))
            (when (and (= format 32)
                       (= 1 value-len))
              (setq pixmap (if ~lsb
                               (xcb:-unpack-u4-lsb value 0)
                             (xcb:-unpack-u4 value 0)))
              (setq exist t)
              (throw 'break nil)))))
      (unless pixmap
        (setq pixmap (xcb:generate-id exwm-cm--conn))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:CreatePixmap
                           :depth exwm-cm--depth
                           :pid pixmap
                           :drawable exwm--root
                           :width 1
                           :height 1)))
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:CreatePicture
                         :pid exwm-cm--background
                         :drawable pixmap
                         :format (xcb:renderutil:find-visual-format
                                  (xcb:renderutil:query-formats exwm-cm--conn)
                                  (slot-value (exwm-cm--xwin->attr exwm--root)
                                              'visual))
                         :value-mask xcb:render:CP:Repeat
                         :repeat 1))
      (unless exist
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:render:FillRectangles
                           :op xcb:render:PictOp:Src
                           :dst exwm-cm--background
                           :color (make-instance 'xcb:render:COLOR
                                                 :red #x8080
                                                 :green #x8080
                                                 :blue #x8080
                                                 :alpha #xFFFF)
                           :rects (list (make-instance 'xcb:RECTANGLE
                                                       :x 0
                                                       :y 0
                                                       :width 1
                                                       :height 1)))))))
  (xcb:+request exwm-cm--conn
      (make-instance 'xcb:xfixes:SetPictureClipRegion
                     :picture exwm-cm--buffer
                     :region region
                     :x-origin 0
                     :y-origin 0))
  (with-slots (width height) (exwm-cm--xwin->attr exwm--root)
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:render:Composite
                       :op xcb:render:PictOp:Src
                       :src exwm-cm--background
                       :mask xcb:render:Picture:None
                       :dst exwm-cm--buffer
                       :src-x 0
                       :src-y 0
                       :mask-x 0
                       :mask-y 0
                       :dst-x 0
                       :dst-y 0
                       :width width
                       :height height))))

(defun exwm-cm--map-xwin (xwin &optional silent)
  "Prepare to map X window XWIN."
  (let ((attr (exwm-cm--xwin->attr xwin)))
    (setf (slot-value attr 'damaged) nil)
    ;; Add to damage.
    (when (slot-value attr 'extents)
      (let ((damage (xcb:generate-id exwm-cm--conn)))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region damage
                           :rectangles nil))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CopyRegion
                           :source (slot-value attr 'extents)
                           :destination damage))
        (exwm-cm--add-damage damage))
      (unless silent
        (exwm-cm--paint)))))

(defun exwm-cm--on-MapNotify (data _synthetic)
  "Handle MapNotify events."
  (let ((obj (make-instance 'xcb:MapNotify))
        attr)
    (xcb:unmarshal obj data)
    (with-slots (event window) obj
      (exwm--log "(CM) MapNotify: Try to map #x%X" window)
      (setq attr (exwm-cm--xwin->attr window))
      (when (and attr
                 (/= (slot-value attr 'class) xcb:WindowClass:InputOnly)
                 (or (= event exwm--root)
                     ;; Filter out duplicated events.
                     (/= exwm--root (exwm-cm--get-parent window))))
        (exwm--log "(CM) MapNotify: Map")
        (exwm-cm--map-xwin window)))))

(defun exwm-cm--on-UnmapNotify (data _synthetic)
  "Handle UnmapNotify events."
  (let ((obj (make-instance 'xcb:UnmapNotify))
        attr)
    (xcb:unmarshal obj data)
    (with-slots (event window) obj
      (exwm--log "(CM) UnmapNotify: Try to unmap #x%X" window)
      (setq attr (exwm-cm--xwin->attr window))
      (when (and attr
                 (or (= event exwm--root)
                     ;; Filter out duplicated events.
                     (/= exwm--root (exwm-cm--get-parent window))))
        (exwm--log "(CM) UnmapNotify: Unmap")
        (with-slots (picture damaged border-size extents border-clip) attr
          (setf damaged nil)
          (when picture
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:render:FreePicture
                               :picture picture))
            (setf picture nil))
          (when border-size
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:xfixes:DestroyRegion
                               :region border-size))
            (setf border-size nil))
          (when extents
            (exwm-cm--add-damage extents)
            (setf extents nil))
          (when border-clip
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:xfixes:DestroyRegion
                               :region border-clip))
            (setf border-clip nil)))
        (setq exwm-cm--clip-changed t)
        (exwm-cm--paint)))))

(defun exwm-cm--on-CreateNotify (data _synthetic)
  "Handle CreateNotify events."
  (let ((obj (make-instance 'xcb:CreateNotify))
        tree0)
    (xcb:unmarshal obj data)
    (with-slots (window parent x y width height) obj
      (exwm--log "(CM) CreateNotify: Create #x%X on #x%X @%sx%s%+d%+d"
                 window parent width height x y)
      (cl-assert (= parent exwm--root))
      (cl-assert (null (exwm-cm--xwin->attr window)))
      (setq tree0 (exwm-cm--get-subtree parent))
      (exwm-cm--create-attr window tree0 x y width height)
      (if (cdr tree0)
          (exwm-cm--push (list window) (cdr tree0))
        (setcdr tree0 `((,window)))))))

(defun exwm-cm--on-ConfigureNotify (data synthetic)
  "Handle ConfigureNotify events."
  ;; Ignore synthetic ConfigureNotify events sent by the WM.
  (unless synthetic
    (let ((obj (make-instance 'xcb:ConfigureNotify)))
      (xcb:unmarshal obj data)
      (with-slots (event window above-sibling x y width height) obj
        (exwm--log
         "(CM) ConfigureNotify: Try to configure #x%X @%sx%s%+d%+d, above #x%X"
         window width height x y above-sibling)
        (cond
         ((= window exwm--root)
          (exwm--log "(CM) ConfigureNotify: Configure the root X window")
          (when exwm-cm--buffer
            (xcb:+request exwm-cm--conn
                (make-instance 'xcb:render:FreePicture
                               :picture exwm-cm--buffer))
            (setq exwm-cm--buffer nil))
          (with-slots ((x* x)
                       (y* y)
                       (width* width)
                       (height* height))
              (exwm-cm--xwin->attr exwm--root)
            (setf x* x
                  y* y
                  width* width
                  height* height))
          (exwm-cm--paint))
         ((null (exwm-cm--xwin->attr window)))
         ((or (= event exwm--root)
              ;; Filter out duplicated events.
              (/= exwm--root (exwm-cm--get-parent window)))
          (exwm--log "(CM) ConfigureNotify: Configure")
          (with-slots ((x0 x)
                       (y0 y))
              (exwm-cm--xwin->attr (exwm-cm--get-parent window))
            (exwm-cm--update-geometry window (+ x x0) (+ y y0) width height
                                      above-sibling))
          (setq exwm-cm--clip-changed t)
          (exwm-cm--paint))
         (t
          (exwm--log "(CM) ConfigureNotify: Skip event from #x%X" event)))))))

(defun exwm-cm--destroy (xwin)
  "Prepare to destroy X window XWIN."
  (with-slots (tree picture alpha-picture damage
                    border-size extents border-clip)
      (exwm-cm--xwin->attr xwin)
    (cl-assert (assq xwin (cdr tree)))
    (if (= 1 (length (cdr tree)))
        (setcdr tree nil)
      (exwm-cm--assq-delete-all xwin (cdr tree)))
    (remhash xwin exwm-cm--hash)
    ;; Release resources.
    (when picture
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:FreePicture
                         :picture picture))
      (setf picture nil))
    (when alpha-picture
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:render:FreePicture
                         :picture alpha-picture))
      (setf alpha-picture nil))
    (when damage
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:damage:Destroy
                         :damage damage))
      (setf damage nil))
    (when border-size
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:DestroyRegion
                         :region border-size))
      (setf border-size nil))
    (when extents
      (exwm-cm--add-damage extents)
      (setf extents nil))
    (when border-clip
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:xfixes:DestroyRegion
                         :region border-clip))
      (setf border-clip nil))))

(defun exwm-cm--on-DestroyNotify (data _synthetic)
  "Handle DestroyNotify events."
  (let ((obj (make-instance 'xcb:DestroyNotify))
        xwin)
    (xcb:unmarshal obj data)
    (setq xwin (slot-value obj 'window))
    (exwm--log "(CM) DestroyNotify: Try to destroy #x%X" xwin)
    (when (exwm-cm--xwin->attr xwin)
      (exwm--log "(CM) DestroyNotify: Destroy")
      (exwm-cm--destroy xwin))))

(defun exwm-cm--on-CirculateNotify (data _synthetic)
  "Handle CirculateNotify events."
  (let ((obj (make-instance 'xcb:CirculateNotify))
        attr)
    (xcb:unmarshal obj data)
    (with-slots (event window place) obj
      (setq attr (exwm-cm--xwin->attr window))
      (exwm--log "(CM) CirculateNotify: Try to circulate #x%X to %s"
                 window place)
      (when (and attr
                 (or (= event exwm--root)
                     ;; Filter out duplicated events.
                     (/= exwm--root (exwm-cm--get-parent window))))
        (exwm--log "(CM) CirculateNotify: Circulate")
        (exwm-cm--update-geometry window nil nil nil nil
                                  (if (= place xcb:Circulate:LowerHighest)
                                      xcb:Window:None
                                    (caar (exwm-cm--get-siblings window))))
        (setq exwm-cm--clip-changed t)
        (exwm-cm--paint)))))

(defun exwm-cm--on-Expose (data _synthetic)
  "Handle Expose events."
  (let ((obj (make-instance 'xcb:Expose)))
    (xcb:unmarshal obj data)
    (with-slots (window x y width height count) obj
      (when (eq window exwm--root)
        (push (make-instance 'xcb:RECTANGLE
                             :x x
                             :y y
                             :width width
                             :height height)
              exwm-cm--expose-rectangles))
      (when (= count 0)
        (let ((region (xcb:generate-id exwm-cm--conn)))
          (xcb:+request exwm-cm--conn
              (xcb:xfixes:CreateRegion
               :region region
               :rectangles exwm-cm--expose-rectangles))
          (exwm-cm--add-damage region))
        (setq exwm-cm--expose-rectangles nil)
        (exwm-cm--paint)))))

(defun exwm-cm--on-PropertyNotify (data _synthetic)
  "Handle PropertyNotify events."
  (let ((obj (make-instance 'xcb:PropertyNotify)))
    (xcb:unmarshal obj data)
    (with-slots (window atom) obj
      (cond
       ((and (= window exwm--root)
             (memq atom exwm-cm--background-atoms))
        (exwm--log "(CM) PropertyNotify: Update background")
        (when exwm-cm--background
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:render:FreePicture
                             :picture exwm-cm--background))
          (setq exwm-cm--background nil)
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:ClearArea
                             :exposures 1
                             :window exwm--root
                             :x 0
                             :y 0
                             :width 0
                             :height 0))
          (xcb:flush exwm-cm--conn)))
       ((and (= atom exwm-cm--_NET_WM_WINDOW_OPACITY)
             ;; Some applications also set this property on their parents.
             (null (cdr (exwm-cm--get-subtree window))))
        (when (exwm-cm--xwin->attr window)
          (exwm--log "(CM) PropertyNotify: Update opacity for #x%X" window)
          (exwm-cm--update-opacity window)
          (exwm-cm--paint)))))))

(defun exwm-cm--prepare-container (xwin)
  "Make X window XWIN a container by deselecting unnecessary events."
  (with-slots (damage) (exwm-cm--xwin->attr xwin)
    (when damage
      (xcb:+request exwm-cm--conn
          (make-instance 'xcb:damage:Destroy
                         :damage damage)))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:shape:SelectInput
                       :destination-window xwin
                       :enable 0))))

(defun exwm-cm--on-ReparentNotify (data _synthetic)
  "Handle ReparentNotify events."
  (let ((obj (make-instance 'xcb:ReparentNotify))
        tree tree0 grandparent great-grandparent entity)
    (xcb:unmarshal obj data)
    (with-slots (window parent x y) obj
      (exwm--log "(CM) ReparentNotify: Try to reparent #x%X to #x%X @%+d%+d"
                 window parent x y)
      (cond
       ((null (exwm-cm--xwin->attr window))
        (when (eq parent exwm--root)
          (exwm--log "(CM) ReparentNotify: Create on the root X window")
          (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn
                           (make-instance 'xcb:GetGeometry
                                          :drawable window))))
            (when reply
              (with-slots (width height) reply
                (setq tree0 (exwm-cm--get-subtree exwm--root))
                (exwm-cm--create-attr window tree0 x y width height)
                (if (cdr tree0)
                    (exwm-cm--push (list window) (cdr tree0))
                  (setcdr tree0 `((,window)))))
              (exwm-cm--paint)))))
       ((= parent (exwm-cm--get-parent window)))
       (t
        (unless (exwm-cm--xwin->attr parent)
          ;; Only allow workspace frame here.
          (setq grandparent
                (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                                (make-instance 'xcb:QueryTree
                                               :window parent))
                            'parent))
          (cond
           ((null (exwm-cm--xwin->attr grandparent))
            (exwm--log "(CM) ReparentNotify: Destroy (too deep)"))
           ((and (= exwm--root
                    (setq great-grandparent (exwm-cm--get-parent grandparent)))
                 (setq tree0 (exwm-cm--get-subtree grandparent))
                 (or (setq entity (exwm--id->buffer window))
                     (null (cdr tree0))))
            ;; Reparent a workspace frame or an X window into its
            ;; container.
            (exwm--debug
             (if entity
                 (exwm--log "(CM) ReparentNotify: \
Create implicit X window container")
               (exwm--log "(CM) ReparentNotify: \
Create implicit workspace frame container")))
            (unless entity
              (setq entity 'workspace-frame))
            (with-slots ((x0 x)
                         (y0 y))
                (exwm-cm--xwin->attr grandparent)
              (with-slots (x y width height)
                  (xcb:+request-unchecked+reply exwm-cm--conn
                      (make-instance 'xcb:GetGeometry
                                     :drawable parent))
                (exwm-cm--create-attr parent tree0
                                      (+ x x0) (+ y y0) width height)))
            (if (null (cdr tree0))
                (setcdr tree0 `((,parent)))
              ;; The stacking order of the parent is unknown.
              (let* ((siblings
                      (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                                      (make-instance 'xcb:QueryTree
                                                     :window grandparent))
                                  'children)))
                (cl-assert (memq parent siblings))
                (if (= parent (car siblings))
                    ;; At the bottom.
                    (setcdr (last (cdr tree0)) `((,parent)))
                  ;; Insert it.
                  (exwm-cm--push (list parent)
                                 ;; The stacking order is reversed.
                                 (nthcdr (- (length siblings) 1
                                            (cl-position parent siblings))
                                         (cdr tree0)))))))
           ((and (= exwm--root
                    (exwm-cm--get-parent great-grandparent))
                 (setq tree0 (exwm-cm--get-subtree grandparent))
                 (= 1 (length (cdr tree0)))
                 (exwm--id->buffer (caar (cdr tree0))))
            ;; Reparent a floating frame into its container.
            (exwm--log "(CM) ReparentNotify: Create floating frame container")
            (setq entity 'floating-frame)
            (with-slots ((x0 x)
                         (y0 y))
                (exwm-cm--xwin->attr grandparent)
              (with-slots (x y width height)
                  (xcb:+request-unchecked+reply exwm-cm--conn
                      (make-instance 'xcb:GetGeometry
                                     :drawable parent))
                (exwm-cm--create-attr parent tree0
                                      (+ x x0) (+ y y0) width height)))
            (nconc (cdr tree0) `((,parent))))
           (t
            (exwm--log "(CM) ReparentNotify: Destroy")
            (exwm-cm--destroy window))))
        ;; Ensure there's a valid parent.
        (when (exwm-cm--xwin->attr parent)
          (exwm--log "(CM) ReparentNotify: Reparent")
          (when (null (cdr (exwm-cm--get-subtree parent)))
            ;; The parent is a new container.
            (exwm-cm--prepare-container parent))
          (setq tree (exwm-cm--get-subtree window))
          (let ((tree (exwm-cm--get-tree window)))
            (if (= 1 (length (cdr tree)))
                (setcdr tree nil)
              (exwm-cm--assq-delete-all window (cdr tree))))
          (setq tree0 (exwm-cm--get-subtree parent))
          (exwm-cm--set-tree window tree0)
          ;; The size might have already changed (e.g. when reparenting
          ;; a workspace frame).
          (let ((reply (xcb:+request-unchecked+reply exwm-cm--conn
                           (make-instance 'xcb:GetGeometry
                                          :drawable window))))
            ;; The X window might have already been destroyed.
            (when reply
              (with-slots (width height) reply
                (with-slots ((x0 x)
                             (y0 y))
                    (exwm-cm--xwin->attr parent)
                  (exwm-cm--update-geometry window (+ x x0) (+ y y0)
                                            width height)))))
          (when entity
            ;; Decide frame entity.
            (when (symbolp entity)
              (catch 'break
                (dolist (f (if (eq entity 'workspace-frame)
                               exwm-workspace--list
                             (frame-list)))
                  (when (eq window (frame-parameter f 'exwm-outer-id))
                    (setq entity f)
                    (throw 'break nil))))
              (when (exwm-workspace--workspace-p entity)
                ;; The grandparent is a new workspace container.
                (exwm-cm--prepare-container grandparent)
                (setf (slot-value (exwm-cm--xwin->attr grandparent) 'entity)
                      entity)))
            (setf (slot-value (exwm-cm--xwin->attr parent) 'entity) entity)
            (setf (slot-value (exwm-cm--xwin->attr window) 'entity) entity))
          (if (cdr tree0)
              (exwm-cm--push tree (cdr tree0))
            (setcdr tree0 `(,tree)))
          (exwm-cm--paint)))))))

(defun exwm-cm--add-damage (damage)
  "Add region DAMAGE to `exwm-cm--damages'."
  (if (not exwm-cm--damages)
      (setq exwm-cm--damages damage)
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:xfixes:UnionRegion
                       :source1 exwm-cm--damages
                       :source2 damage
                       :destination exwm-cm--damages))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:xfixes:DestroyRegion
                       :region damage))))

(defun exwm-cm--on-DamageNotify (data _synthetic)
  "Handle DamageNotify events."
  (let ((obj (make-instance 'xcb:damage:Notify))
        parts)
    (xcb:unmarshal obj data)
    (cl-assert (exwm-cm--xwin->attr (slot-value obj 'drawable)))
    (with-slots (x y width height damaged damage)
        (exwm-cm--xwin->attr (slot-value obj 'drawable))
      (setq parts (xcb:generate-id exwm-cm--conn))
      (cond
       (damaged
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region parts
                           :rectangles nil))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:damage:Subtract
                           :damage damage
                           :repair xcb:xfixes:Region:None
                           :parts parts))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:TranslateRegion
                           :region parts
                           :dx x
                           :dy y)))
       (t
        (setf damaged t)
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:xfixes:CreateRegion
                           :region parts
                           :rectangles (list (make-instance 'xcb:RECTANGLE
                                                            :width width
                                                            :height height
                                                            :x x
                                                            :y y))))
        (xcb:+request exwm-cm--conn
            (make-instance 'xcb:damage:Subtract
                           :damage damage
                           :repair xcb:xfixes:Region:None
                           :parts xcb:xfixes:Region:None))))
      (exwm-cm--add-damage parts))
    ;; Check if there are more damages immediately followed.
    (unless (/= 0 (logand #x80 (slot-value obj 'level)))
      (exwm-cm--paint))))

(defun exwm-cm--on-ShapeNotify (data _synthetic)
  "Handle ShapeNotify events."
  (let ((obj (make-instance 'xcb:shape:Notify))
        attr region1 region2)
    (xcb:unmarshal obj data)
    (with-slots (shape-kind affected-window shaped
                            extents-x extents-y extents-width extents-height)
        obj
      (exwm--log "(CM) ShapeNotify: #x%X" affected-window)
      (when (and (or (eq shape-kind xcb:shape:SK:Clip)
                     (eq shape-kind xcb:shape:SK:Bounding))
                 (setq attr (exwm-cm--xwin->attr affected-window)))
        (with-slots ((shaped* shaped)
                     x y width height
                     shape-x shape-y shape-width shape-height)
            attr
          (setq region1 (xcb:generate-id exwm-cm--conn)
                region2 (xcb:generate-id exwm-cm--conn))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:CreateRegion
                             :region region1
                             :rectangles `(,(make-instance 'xcb:RECTANGLE
                                                           :width shape-width
                                                           :height shape-height
                                                           :x shape-x
                                                           :y shape-y))))
          (if shaped
              (setf shaped* t
                    shape-x (+ x extents-x)
                    shape-y (+ y extents-y)
                    shape-width (+ width extents-width)
                    shape-height (+ height extents-height))
            (setf shaped* nil
                  shape-x x
                  shape-y y
                  shape-width width
                  shape-height height))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:CreateRegion
                             :region region2
                             :rectangles `(,(make-instance 'xcb:RECTANGLE
                                                           :width shape-width
                                                           :height shape-height
                                                           :x shape-x
                                                           :y shape-y))))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:UnionRegion
                             :source1 region1
                             :source2 region2
                             :destination region1))
          (xcb:+request exwm-cm--conn
              (make-instance 'xcb:xfixes:DestroyRegion
                             :region region2))
          (setq exwm-cm--clip-changed t)
          (exwm-cm--paint region1))))))

(defun exwm-cm--init ()
  "Initialize EXWM compositing manager."
  ;; Create a new connection.
  (setq exwm-cm--conn (xcb:connect))
  (set-process-query-on-exit-flag (slot-value exwm-cm--conn 'process) nil)
  ;; Initialize ICCCM/EWMH support.
  (xcb:icccm:init exwm-cm--conn)
  (xcb:ewmh:init exwm-cm--conn)
  ;; Check for Render extension.
  (let ((version (xcb:renderutil:query-version exwm-cm--conn)))
    (unless (and version
                 (= 0 (slot-value version 'major-version))
                 (<= 2 (slot-value version 'minor-version)))
      (error "[EXWM] The server does not support Render extension")))
  ;; Check for Composite extension.
  (when (or (= 0
               (slot-value (xcb:get-extension-data exwm-cm--conn
                                                   'xcb:composite)
                           'present))
            (with-slots (major-version minor-version)
                (xcb:+request-unchecked+reply exwm-cm--conn
                    (make-instance 'xcb:composite:QueryVersion
                                   :client-major-version 0
                                   :client-minor-version 1))
              (or (/= major-version 0) (< minor-version 1))))
    (error "[EXWM] The server does not support Composite extension"))
  ;; Check for Damage extension.
  (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:damage)
                             'present))
            (with-slots (major-version minor-version)
                (xcb:+request-unchecked+reply exwm-cm--conn
                    (make-instance 'xcb:damage:QueryVersion
                                   :client-major-version 1
                                   :client-minor-version 1))
              (or (/= major-version 1) (< minor-version 1))))
    (error "[EXWM] The server does not support Damage extension"))
  ;; Check for XFixes extension.
  (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:xfixes)
                             'present))
            (with-slots (major-version minor-version)
                (xcb:+request-unchecked+reply exwm-cm--conn
                    (make-instance 'xcb:xfixes:QueryVersion
                                   :client-major-version 2
                                   :client-minor-version 0))
              (or (/= major-version 2) (/= minor-version 0))))
    (error "[EXWM] The server does not support XFixes extension"))
  ;; Check for Shape extension.
  (when (or (= 0 (slot-value (xcb:get-extension-data exwm-cm--conn 'xcb:shape)
                             'present))
            (with-slots (major-version minor-version)
                (xcb:+request-unchecked+reply exwm-cm--conn
                    (make-instance 'xcb:shape:QueryVersion))
              (or (/= major-version 1) (< minor-version 1))))
    (error "[EXWM] The server does not support Shape extension"))
  ;; Intern atoms.
  (let ((atom-name "_NET_WM_WINDOW_OPACITY"))
    (setq exwm-cm--_NET_WM_WINDOW_OPACITY
          (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                          (make-instance 'xcb:InternAtom
                                         :only-if-exists 0
                                         :name-len (length atom-name)
                                         :name atom-name))
                      'atom)))
  (setq exwm-cm--background-atoms
        (mapcar (lambda (atom-name)
                  (slot-value (xcb:+request-unchecked+reply exwm-cm--conn
                                  (make-instance 'xcb:InternAtom
                                                 :only-if-exists 0
                                                 :name-len (length atom-name)
                                                 :name atom-name))
                              'atom))
                exwm-cm--background-atom-names))
  ;; Register CM.
  (with-slots (owner)
      (xcb:+request-unchecked+reply exwm-cm--conn
          (make-instance 'xcb:GetSelectionOwner
                         :selection xcb:Atom:_NET_WM_CM_S0))
    (when (/= owner xcb:Window:None)
      (error "[EXWM] Other compositing manager detected")))
  (let ((id (xcb:generate-id exwm-cm--conn)))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:CreateWindow
                       :depth 0
                       :wid id
                       :parent exwm--root
                       :x 0
                       :y 0
                       :width 1
                       :height 1
                       :border-width 0
                       :class xcb:WindowClass:InputOnly
                       :visual 0
                       :value-mask xcb:CW:OverrideRedirect
                       :override-redirect 1))
    ;; Set _NET_WM_NAME.
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:ewmh:set-_NET_WM_NAME
                       :window id
                       :data "EXWM-CM"))
    ;; Get the selection ownership.
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:SetSelectionOwner
                       :owner id
                       :selection xcb:Atom:_NET_WM_CM_S0
                       :time xcb:Time:CurrentTime)))
  ;; Attach event listeners.
  (xcb:+event exwm-cm--conn 'xcb:MapNotify #'exwm-cm--on-MapNotify)
  (xcb:+event exwm-cm--conn 'xcb:UnmapNotify #'exwm-cm--on-UnmapNotify)
  (xcb:+event exwm-cm--conn 'xcb:CreateNotify #'exwm-cm--on-CreateNotify)
  (xcb:+event exwm-cm--conn 'xcb:ConfigureNotify #'exwm-cm--on-ConfigureNotify)
  (xcb:+event exwm-cm--conn 'xcb:DestroyNotify #'exwm-cm--on-DestroyNotify)
  (xcb:+event exwm-cm--conn 'xcb:ReparentNotify #'exwm-cm--on-ReparentNotify)
  (xcb:+event exwm-cm--conn 'xcb:CirculateNotify #'exwm-cm--on-CirculateNotify)
  (xcb:+event exwm-cm--conn 'xcb:Expose #'exwm-cm--on-Expose)
  (xcb:+event exwm-cm--conn 'xcb:PropertyNotify #'exwm-cm--on-PropertyNotify)
  (xcb:+event exwm-cm--conn 'xcb:damage:Notify #'exwm-cm--on-DamageNotify)
  (xcb:+event exwm-cm--conn 'xcb:shape:Notify #'exwm-cm--on-ShapeNotify)
  ;; Scan the window tree.
  (setq exwm-cm--hash (make-hash-table))
  (exwm-cm--create-tree)
  ;; Set up the root X window.
  (setq exwm-cm--depth
        (slot-value (car (slot-value (xcb:get-setup exwm-cm--conn) 'roots))
                    'root-depth))
  (with-slots (visual picture) (exwm-cm--xwin->attr exwm--root)
    (setf picture (xcb:generate-id exwm-cm--conn))
    (xcb:+request exwm-cm--conn
        (make-instance 'xcb:render:CreatePicture
                       :pid picture
                       :drawable exwm--root
                       :format (xcb:renderutil:find-visual-format
                                (xcb:renderutil:query-formats exwm-cm--conn)
                                visual)
                       :value-mask xcb:render:CP:SubwindowMode
                       :subwindowmode xcb:SubwindowMode:IncludeInferiors)))
  (xcb:flush exwm-cm--conn)
  ;; Paint once.
  (exwm-cm--paint t))

(defun exwm-cm--exit ()
  "Exit EXWM compositing manager."
  (when exwm-cm--conn
    (xcb:disconnect exwm-cm--conn)
    (clrhash exwm-cm--hash)
    (setq exwm-cm--hash nil
          exwm-cm--conn nil
          exwm-cm--buffer nil
          exwm-cm--clip-changed t
          exwm-cm--damages nil
          exwm-cm--expose-rectangles nil
          exwm-cm--background nil)))

(defun exwm-cm-enable ()
  "Enable compositing support for EXWM."
  (add-hook 'exwm-init-hook #'exwm-cm--init t)
  (add-hook 'exwm-exit-hook #'exwm-cm--exit t))

(defun exwm-cm-start ()
  "Start EXWM composting manager."
  (interactive)
  (unless exwm-cm--conn
    (exwm-cm--init)))

(defun exwm-cm-stop ()
  "Stop EXWM compositing manager."
  (interactive)
  (exwm-cm--exit))

(defun exwm-cm-toggle ()
  "Toggle the running state of EXWM compositing manager."
  (interactive)
  (if exwm-cm--conn
      (exwm-cm-stop)
    (exwm-cm-start)))



(provide 'exwm-cm)

;;; exwm-cm.el ends here