gtk-screen: Handle button presses.

diff --git a/src/gtk-screen/gtk-screen.pkg b/src/gtk-screen/gtk-screen.pkg
index 8fa01ef7ea97458cda4b34b6c90065c93cd7898e..e14b3bdc3d29e271e2522124f9869c6c8e4e8870 100644 (file)
--- 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 c0aee12c6dfff3a1d489e6a3d46084d3d9a2b1f8..0c5ba8b9a90d8b1c47e6ae5d14bf8cbcc280a45d 100644 (file)
--- 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)))
 \f
 ;;; 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 <text-widget>))