From 43aee45f5751bb2c38889105f29c4fd9d0fbfbf7 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jacek=20TeMPOraL=20Z=C5=82ydach?= <temporal.pl@gmail.com>
Date: Sat, 27 May 2017 20:12:13 +0200
Subject: [PATCH] Implemented #'clim-internals::port-query-pointer for CLX.

Based on implementation from tk-silica.
---
 clx/clx-port.lisp | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/clx/clx-port.lisp b/clx/clx-port.lisp
index d242c1c4..4854d0ec 100644
--- a/clx/clx-port.lisp
+++ b/clx/clx-port.lisp
@@ -759,3 +759,18 @@
       (do-shift :hyper))
     mask))
 
+
+
+(defmethod clim-internals::port-query-pointer ((port clx-port) sheet)
+  (multiple-value-bind (native-x native-y samep child? mask? root-x root-y root?)
+      (xlib:query-pointer (sheet-mirror sheet))
+    (declare (ignore samep child? mask? root?))
+    (multiple-value-bind (x y)
+        (untransform-position  (sheet-device-transformation sheet) native-x native-y)
+      (values x y native-x native-y root-x root-y))))
+
+(defmethod clim-internals::port-query-pointer ((port clx-port) (sheet graft))
+  (multiple-value-bind (native-x native-y samep child? mask? root-x root-y root?)
+      (xlib:query-pointer (sheet-mirror sheet))
+    (declare (ignore samep child? mask? root?))
+    (values native-x native-y native-x native-y root-x root-y)))
-- 
GitLab