gtk: misc fixes

collects/meta/props

@@ -1465,7 +1465,7 @@ path/s is either such a string or a list of them.
 "collects/tests/gracket/gui.rktl" drdr:command-line (gracket "-f" *)
 "collects/tests/gracket/item.rkt" drdr:command-line (mzc *)
 "collects/tests/gracket/loadtest.rktl" drdr:command-line (gracket "-f" *)
-"collects/tests/gracket/mem.rktl" drdr:command-line #f
+"collects/tests/gracket/mem.rkt" drdr:command-line #f
 "collects/tests/gracket/paramz.rktl" drdr:command-line (gracket "-f" *)
 "collects/tests/gracket/png.rktl" drdr:command-line #f
 "collects/tests/gracket/random.rktl" drdr:command-line #f

collects/mred/private/wx/common/queue.rkt

@@ -190,6 +190,7 @@
                                     -> _pointer))
 
 (define (shutdown-eventspace! e ignored)
+  ;; atomic mode
   (unless (eventspace-shutdown? e)
     (set-eventspace-shutdown?! e #t)
     (semaphore-post (eventspace-done-sema e))

collects/mred/private/wx/gtk/frame.rkt

@@ -13,12 +13,14 @@
          "window.rkt"
          "client-window.rkt"
          "widget.rkt"
-         "procs.rkt"
          "cursor.rkt"
          "pixbuf.rkt"
          "../common/queue.rkt")
 
-(provide frame%)
+(provide frame%
+         display-origin
+         display-size
+         location->window)
 
 ;; ----------------------------------------
 
@@ -121,6 +123,9 @@
        (for/fold ([l #f]) ([i (in-list icons)])
 	 (g_list_insert l i -1))))))
 
+;; used for location->window
+(define all-frames (make-hasheq))
+
 (define frame%
   (class (client-size-mixin window%)
     (init parent
@@ -296,10 +301,15 @@
       (void))
 
     (define/override (direct-show on?)
+      ;; atomic mode
+      (if on?
+          (hash-set! all-frames this #t)
+          (hash-remove! all-frames this))
       (super direct-show on?)
       (register-frame-shown this on?))
 
     (define/public (destroy)
+      ;; atomic mode
       (direct-show #f))
 
     (define/override (on-client-size w h)
@@ -366,7 +376,8 @@
 
     (define/public (on-activate on?) (void))
 
-    (def/public-unimplemented designate-root-frame)
+    (define/public (designate-root-frame) (void))
+
     (def/public-unimplemented system-menu)
 
     (define/public (set-modified mod?)
@@ -421,3 +432,23 @@
                                     (string-append s "*")
                                     s)))))
 
+;; ----------------------------------------
+
+(define-gdk gdk_screen_get_width (_fun _GdkScreen -> _int))
+(define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int))
+
+(define (display-origin x y all?) (set-box! x 0) (set-box! y 0))
+(define (display-size w h all?)
+  (let ([s (gdk_screen_get_default)])
+    (set-box! w (gdk_screen_get_width s))
+    (set-box! h (gdk_screen_get_height s))))
+
+(define (location->window x y)
+  (for/or ([f (in-hash-keys all-frames)])
+    (let ([fx (send f get-x)]
+          [fw (send f get-width)])
+      (and (<= fx x (+ fx fw))
+           (let ([fy (send f get-y)]
+                 [fh (send f get-height)])
+             (<= fy y (+ fy fh)))
+           f))))

collects/mred/private/wx/gtk/procs.rkt

@@ -11,6 +11,7 @@
          "style.rkt"
          "widget.rkt"
          "window.rkt"
+         "frame.rkt"
          "dc.rkt"
          "printer-dc.rkt"
          "gl-context.rkt"
@@ -60,7 +61,6 @@
  check-for-break)
 
 (define-unimplemented find-graphical-system-path)
-(define-unimplemented location->window)
 (define-unimplemented send-event)
 (define-unimplemented cancel-quit)
 (define-unimplemented write-resource)
@@ -85,14 +85,6 @@
 (define (get-control-font-size) 10) ;; FIXME
 (define (get-control-font-size-in-pixels?) #f) ;; FIXME
 
-(define-gdk gdk_screen_get_width (_fun _GdkScreen -> _int))
-(define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int))
-
-(define (display-origin x y all?) (set-box! x 0) (set-box! y 0))
-(define (display-size w h all?)
-  (let ([s (gdk_screen_get_default)])
-    (set-box! w (gdk_screen_get_width s))
-    (set-box! h (gdk_screen_get_height s))))
 (define (get-display-depth) 32)
 
 (define-gdk gdk_display_beep (_fun _GdkDisplay -> _void))

collects/mred/private/wx/gtk/types.rkt

@@ -104,6 +104,7 @@
 (define-cstruct _GdkEventCrossing ([type _GdkEventType]
                                    [window _GdkWindow]
                                    [send_event _byte]
+                                   [subwindow _GdkWindow]
                                    [time _uint32]
                                    [x _double]
                                    [y _double]

collects/mred/private/wx/gtk/window.rkt

@@ -478,6 +478,7 @@
 
     (define shown? #f)
     (define/public (direct-show on?)
+      ;; atomic mode
       (if on?
           (gtk_widget_show gtk)
           (gtk_widget_hide gtk))

collects/mred/private/wx/win32/frame.rkt

@@ -237,8 +237,8 @@
   (define/override (get-y)
     (RECT-top (GetWindowRect hwnd)))
 
-  (def/public-unimplemented on-toolbar-click)
-  (def/public-unimplemented on-menu-click)
+  (define/public (on-toolbar-click) (void))
+  (define/public (on-menu-click) (void))
 
   (define/public (on-menu-command i) (void))
 
@@ -348,7 +348,7 @@
 
   (define/override (get-top-frame) this)
 
-  (def/public-unimplemented designate-root-frame)
+  (define/public (designate-root-frame) (void))
   (def/public-unimplemented system-menu)
 
   (define modified? #f)

collects/mred/private/wx/win32/window.rkt

@@ -327,7 +327,7 @@
             hwnd
             (lambda (thunk) (queue-window-event this thunk)))))
 
-  (def/public-unimplemented center)
+  (define/public (center a b) (void))
 
   (define/public (get-parent) parent)
   (define/public (is-frame?) #f)

collects/tests/gracket/mem.rkt

@@ -1,5 +1,4 @@
-
-; run with gracket -u -- -f mem.rktl
+#lang racket/gui
 
 (require mzlib/class100)
 
@@ -28,12 +27,11 @@
 	      allocated))
   v)
 
-(when subwindows?
-  (namespace-set-variable-value!
-   'sub-collect-frame
-   (make-object frame% "sub-collect"))
-  (namespace-set-variable-value!
-   'sub-collect-panel
+(define sub-collect-frame
+  (and subwindows?
+       (make-object frame% "sub-collect")))
+(define sub-collect-panel
+  (and subwindows?
        (make-object panel% sub-collect-frame)))
 
 (define permanent-ready? #f)