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