119 lines
4.8 KiB
Racket
119 lines
4.8 KiB
Racket
#lang racket/base
|
|
(require ffi/unsafe
|
|
racket/class
|
|
"../../syntax.rkt"
|
|
"types.rkt"
|
|
"utils.rkt"
|
|
"window.rkt")
|
|
|
|
;; Hacks for working with GtkComboBox[Entry]
|
|
|
|
(provide
|
|
(protect-out extract-combo-button
|
|
connect-combo-key-and-mouse))
|
|
|
|
;; ----------------------------------------
|
|
|
|
(define-gtk gtk_container_foreach (_fun _GtkWidget (_fun _GtkWidget -> _void) _pointer -> _void))
|
|
(define-gtk gtk_container_forall (_fun _GtkWidget (_fun _GtkWidget -> _void) _pointer -> _void))
|
|
|
|
(define-gobj g_signal_parse_name (_fun _string
|
|
_GType
|
|
(id : (_ptr o _uint))
|
|
(_ptr o _GQuark)
|
|
_gboolean
|
|
-> (r : _gboolean)
|
|
-> (and r id)))
|
|
|
|
(define-gobj g_type_from_name (_fun _string -> _GType))
|
|
|
|
(define _GSignalMatchType _int)
|
|
(define _GQuark _uint32)
|
|
(define _GClosure _int)
|
|
(define-gobj g_signal_handler_find (_fun _GtkWidget
|
|
_GSignalMatchType
|
|
_uint ; signal_id
|
|
_GQuark ; detail
|
|
_GClosure ; closure
|
|
_pointer ; func
|
|
_pointer ; data
|
|
-> _ulong))
|
|
(define-gobj g_signal_handler_disconnect (_fun _GtkWidget _uint -> _void))
|
|
(define-gobj g_signal_handler_block (_fun _GtkWidget _uint -> _void))
|
|
(define-gobj g_signal_handler_unblock (_fun _GtkWidget _uint -> _void))
|
|
|
|
(define-gobj g_signal_emit (_fun _GtkWidget
|
|
_uint
|
|
_GQuark
|
|
_pointer
|
|
(r : (_ptr o _gboolean))
|
|
-> _void
|
|
-> r))
|
|
|
|
(define G_SIGNAL_MATCH_ID 1)
|
|
|
|
(define button-press-id #f)
|
|
|
|
(define unblocked? #f)
|
|
(define-signal-handler connect-reorder-button-press "button-press-event"
|
|
(_fun _GtkWidget _GdkEventButton-pointer _long -> _gboolean)
|
|
(lambda (gtk event other-id)
|
|
(if unblocked?
|
|
#f
|
|
(let ([v (do-button-event gtk event #f #f)])
|
|
(or v
|
|
(begin
|
|
(g_signal_handler_unblock gtk other-id)
|
|
(let ([r (g_signal_emit gtk
|
|
button-press-id
|
|
0
|
|
event)])
|
|
(g_signal_handler_block gtk other-id)
|
|
r)))))))
|
|
|
|
;; Dependence on the implemenation of GtkComboBox:
|
|
;; Keyboard focus and other actions are based on a private button widget
|
|
;; inside a GtkComboBox, so we extract it.
|
|
(define (extract-combo-button gtk)
|
|
(let ([all null]
|
|
[ext null])
|
|
(gtk_container_forall gtk (lambda (c) (set! all (cons c all))) #f)
|
|
(gtk_container_foreach gtk (lambda (c) (set! ext (cons c ext))) #f)
|
|
(for-each (lambda (e)
|
|
(set! all (filter (lambda (a) (not (ptr-equal? a e)))
|
|
all)))
|
|
ext)
|
|
(unless (= 1 (length all))
|
|
(error "expected Gtk combobox to have one private child"))
|
|
(car all)))
|
|
|
|
;; More dependence on the implemenation of GtkComboBox:
|
|
;; The memnu-popup action is implemented by seeting a button-press-event
|
|
;; signal handler on `button-gtk'. Since Gtk calls signal handlers in the
|
|
;; order that they're registered, our button-press-event handler doesn't
|
|
;; get called first, so it can't cancel the button press due to modality
|
|
;; or an `on-subwindow-event' result. We effectively reorder the callbacks
|
|
;; by finding the old one, blocking it, and then unblocking during a
|
|
;; redispatch.
|
|
(define (connect-combo-key-and-mouse button-gtk)
|
|
(unless button-press-id
|
|
(set! button-press-id
|
|
(g_signal_parse_name "button-press-event" (g_type_from_name "GtkWidget") #f)))
|
|
(let ([hand-id
|
|
(and button-press-id
|
|
(let ([hand-id (g_signal_handler_find button-gtk
|
|
G_SIGNAL_MATCH_ID
|
|
button-press-id
|
|
0
|
|
0
|
|
#f
|
|
#f)])
|
|
(if (zero? hand-id)
|
|
#f
|
|
(begin
|
|
(g_signal_handler_block button-gtk hand-id)
|
|
hand-id))))])
|
|
(connect-key-and-mouse button-gtk (and hand-id #t))
|
|
(when hand-id
|
|
(connect-reorder-button-press button-gtk (cast hand-id _long _pointer)))))
|