try to connect gtk dialog with parent
This commit is contained in:
parent
6ae09fca1c
commit
03f5e140ea
|
@ -13,6 +13,7 @@
|
||||||
(define GTK_WIN_POS_CENTER_ON_PARENT 4)
|
(define GTK_WIN_POS_CENTER_ON_PARENT 4)
|
||||||
|
|
||||||
(define-gtk gtk_window_set_position (_fun _GtkWidget _int -> _void))
|
(define-gtk gtk_window_set_position (_fun _GtkWidget _int -> _void))
|
||||||
|
(define-gtk gtk_window_set_transient_for (_fun _GtkWidget _GtkWidget -> _void))
|
||||||
|
|
||||||
(defclass dialog% frame%
|
(defclass dialog% frame%
|
||||||
(inherit get-gtk
|
(inherit get-gtk
|
||||||
|
@ -22,6 +23,10 @@
|
||||||
|
|
||||||
(define close-sema #f)
|
(define close-sema #f)
|
||||||
|
|
||||||
|
(let ([p (get-parent)])
|
||||||
|
(when p
|
||||||
|
(gtk_window_set_transient_for (get-gtk) (send p get-gtk))))
|
||||||
|
|
||||||
(define/override (direct-show on?)
|
(define/override (direct-show on?)
|
||||||
(unless on?
|
(unless on?
|
||||||
(when close-sema
|
(when close-sema
|
||||||
|
@ -30,7 +35,7 @@
|
||||||
(super direct-show on?))
|
(super direct-show on?))
|
||||||
|
|
||||||
(define/override (center dir wrt)
|
(define/override (center dir wrt)
|
||||||
(if #f ; (eq? dir 'both)
|
(if (eq? dir 'both)
|
||||||
(gtk_window_set_position (get-gtk)
|
(gtk_window_set_position (get-gtk)
|
||||||
(if (get-parent)
|
(if (get-parent)
|
||||||
GTK_WIN_POS_CENTER_ON_PARENT
|
GTK_WIN_POS_CENTER_ON_PARENT
|
||||||
|
|
|
@ -91,7 +91,12 @@
|
||||||
(define (get-control-font-size) 10) ;; FIXME
|
(define (get-control-font-size) 10) ;; FIXME
|
||||||
(define-unimplemented cancel-quit)
|
(define-unimplemented cancel-quit)
|
||||||
(define-unimplemented fill-private-color)
|
(define-unimplemented fill-private-color)
|
||||||
(define (flush-display) (void))
|
|
||||||
|
(define _GdkDisplay (_cpointer 'GdkDisplay))
|
||||||
|
(define-gdk gdk_display_flush (_fun _GdkDisplay -> _void))
|
||||||
|
(define-gdk gdk_display_get_default (_fun -> _GdkDisplay))
|
||||||
|
(define (flush-display) (gdk_display_flush (gdk_display_get_default)))
|
||||||
|
|
||||||
(define-unimplemented write-resource)
|
(define-unimplemented write-resource)
|
||||||
(define-unimplemented get-resource)
|
(define-unimplemented get-resource)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user