1#lang racket/base 2(require racket/class 3 ffi/unsafe 4 "../../syntax.rkt" 5 "../common/queue.rkt" 6 "../common/dialog.rkt" 7 "../../lock.rkt" 8 "types.rkt" 9 "utils.rkt" 10 "frame.rkt") 11 12(provide 13 (protect-out dialog%)) 14 15(define GTK_WIN_POS_CENTER 1) 16(define GTK_WIN_POS_CENTER_ON_PARENT 4) 17 18(define GDK_WINDOW_TYPE_HINT_DIALOG 1) 19 20(define-gtk gtk_window_set_position (_fun _GtkWidget _int -> _void)) 21(define-gtk gtk_window_set_transient_for (_fun _GtkWidget _GtkWidget -> _void)) 22(define-gtk gtk_window_set_type_hint (_fun _GtkWidget _int -> _void)) 23 24(define dialog% 25 (class (dialog-mixin frame%) 26 (inherit get-gtk 27 get-parent) 28 29 (super-new [is-dialog? #t]) 30 31 (gtk_window_set_type_hint (get-gtk) GDK_WINDOW_TYPE_HINT_DIALOG) 32 33 (let ([p (get-parent)]) 34 (when p 35 (gtk_window_set_transient_for (get-gtk) (send p get-gtk)))) 36 37 (define/override (center dir wrt) 38 (if (eq? dir 'both) 39 (gtk_window_set_position (get-gtk) 40 (if (get-parent) 41 GTK_WIN_POS_CENTER_ON_PARENT 42 GTK_WIN_POS_CENTER)) 43 (super center dir wrt))))) 44