From 70bd4c91e2cb3f566438c044f088391730dd09c3 Mon Sep 17 00:00:00 2001 From: Matt Birkholz Date: Wed, 18 Jan 2017 13:35:05 -0700 Subject: [PATCH] gtk-screen: Handle button presses. --- src/gtk-screen/gtk-screen.pkg | 2 +- src/gtk-screen/gtk-screen.scm | 38 +++++++++++++++++++++++++++++++++++ 2 files changed, 39 insertions(+), 1 deletion(-) diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg index 8fa01ef7e..e14b3bdc3 100644 --- a/src/gtk-screen/gtk-screen.pkg +++ b/src/gtk-screen/gtk-screen.pkg @@ -57,7 +57,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. register-process-output-events) (import (edwin window) editor-frame-root-window - window-inferiors find-inferior window-next + window-inferiors find-inferior window-next window-superior combination? combination-vertical? combination-child (%window-x-size window-x-size) (%window-y-size window-y-size) diff --git a/src/gtk-screen/gtk-screen.scm b/src/gtk-screen/gtk-screen.scm index c0aee12c6..0c5ba8b9a 100644 --- a/src/gtk-screen/gtk-screen.scm +++ b/src/gtk-screen/gtk-screen.scm @@ -760,6 +760,43 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (if k (queue! (make-special-key k char-bits)) #t)))) + +(define (button-down-handler widget type button modifiers x y) + (declare (ignore type)) + (%trace "; Button down: "button" "modifiers" "x" "y" "widget"\n") + (queue-input-event (edwin-widget-screen widget) + (make-input-event + 'BUTTON + execute-gtk-button-command + widget button modifiers x y)) + #t) + +(define (execute-gtk-button-command widget button modifiers x y) + (let ((screen (edwin-widget-screen widget)) + (frame (text-widget-buffer-frame widget))) + (let ((inferior (find-inferior (window-inferiors (window-superior frame)) + frame))) + (%trace "; button inferior "inferior"\n") + (execute-button-command + screen + (make-down-button (fix:-1+ button) (modifiers->char-bits modifiers)) + (fix:+ (inferior-x-start inferior) + (fix:quotient x + (gtk-screen-char-width screen))) + (fix:+ (inferior-y-start inferior) + (fix:quotient y + (fix:+ (gtk-screen-line-height screen) + (gtk-screen-line-spacing screen)))))))) + +(define (modifiers->char-bits modifiers) + (reduce bitwise-ior 0 (map (lambda (modifier) + (case modifier + ((META) char-bit:meta) + ((CONTROL) char-bit:control) + ((SUPER) char-bit:super) + ((HYPER) char-bit:hyper) + (else 0))) + modifiers))) ;;; Initialization @@ -1136,6 +1173,7 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA. (set-fix-widget-focus-change-handler! widget focus-change-handler) (set-fix-widget-visibility-notify-handler! widget visibility-notify-handler) (set-fix-widget-key-press-handler! widget key-press-handler) + (set-fix-widget-button-handler! widget 'PRESS button-down-handler) widget) (define-method gtk-widget-destroy-callback ((widget )) -- 2.25.1