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