add display-changed method

collects/mred/private/mrtop.rkt

@@ -35,7 +35,8 @@
     get-focus-window get-edit-target-window
     get-focus-object get-edit-target-object
     center move resize
-    on-message))
+    on-message
+    display-changed))
 
 (define-local-member-name
   do-create-status-line
@@ -76,7 +77,8 @@
      [get-eventspace (entry-point (lambda () (send wx get-eventspace)))])
     (pubment*
      [can-close? (lambda () (inner #t can-close?))]
-     [on-close (lambda () (inner (void) on-close))])
+     [on-close (lambda () (inner (void) on-close))]
+     [display-changed (λ () (inner (void) display-changed))])
     (public*
      [can-exit? (lambda () (can-close?))]
      [on-exit (lambda () (on-close) (show #f))]

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

@@ -41,6 +41,19 @@
 ;;  problems.
 (define all-windows (make-hash))
 
+;; called in atomic mode
+(define (send-screen-change-notifications flags)
+  (when (zero? (bitwise-and flags 1)) ;; discard the "about to change" notifications
+    (for ([b (in-hash-values all-windows)])
+      (define f (weak-box-value b))
+      (when f
+        (parameterize ([current-eventspace (send f get-eventspace)])
+          (queue-callback
+           (λ ()
+             (send f display-changed))))))))
+
+(set-screen-changed-callback! send-screen-change-notifications)
+
 (define-objc-mixin (RacketWindowMethods Superclass)
   [wxb]
   [-a _scheme (getEventspace)
@@ -627,7 +640,9 @@
     (define/public (set-color-callback cb)
       (set! color-callback cb))
     (define/override (on-color-change)
-      (queue-window-event this (lambda () (color-callback))))))
+      (queue-window-event this (lambda () (color-callback))))
+    
+    (define/public (display-changed) (void))))
 
 ;; ----------------------------------------
 

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

@@ -23,7 +23,8 @@
               post-dummy-event
 
               try-to-sync-refresh
-              sync-cocoa-events)
+              sync-cocoa-events
+              set-screen-changed-callback!)
 
  ;; from common/queue:
  current-eventspace
@@ -127,8 +128,12 @@
 ;;  is called, but sometimes the event loop gets stuck after
 ;;  that, so there's an additional hack above.
 (define-appserv CGDisplayRegisterReconfigurationCallback 
-  (_fun (_fun #:atomic? #t -> _void) _pointer -> _int32))
-(define (on-screen-changed) (post-dummy-event))
+  (_fun (_fun #:atomic? #t _uint32 _uint32 -> _void) _pointer -> _int32))
+(define (on-screen-changed display flags) 
+  (screen-changed-callback flags)
+  (post-dummy-event))
+(define screen-changed-callback void)
+(define (set-screen-changed-callback! c) (set! screen-changed-callback c))
 (let ([v (CGDisplayRegisterReconfigurationCallback on-screen-changed #f)])
   (unless (zero? v)
     (log-error (format "error from CGDisplayRegisterReconfigurationCallback: ~a" v))))

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

@@ -511,7 +511,9 @@
       (set! saved-title s)
       (gtk_window_set_title gtk (if is-modified?
                                     (string-append s "*")
-                                    s)))))
+                                    s)))
+    
+    (define/public (display-changed) (void))))
 
 ;; ----------------------------------------
 
@@ -572,3 +574,35 @@
            (maybe GDK_CONTROL_MASK 'control)
            (maybe GDK_MOD1_MASK 'alt)
            (maybe GDK_META_MASK 'meta))))
+
+(define (tell-all-frames-signal-changed n)
+  (define frames (for/list ([f (in-hash-keys all-frames)]) f))
+  (for ([f (in-hash-keys all-frames)])
+    (parameterize ([current-eventspace (send f get-eventspace)])
+      (queue-callback
+       (λ () 
+         (send f display-changed))))))
+
+(define-signal-handler 
+  connect-monitor-changed-signal
+  "monitors-changed"
+  (_fun _GdkScreen -> _void)
+  (λ (screen) (tell-all-frames-signal-changed 1)))
+
+(define-signal-handler 
+  connect-screen-changed-signal
+  "screen-changed"
+  (_fun _GdkScreen -> _void)
+  (λ (screen) (tell-all-frames-signal-changed 2)))
+
+(define-signal-handler 
+  connect-composited-changed-signal
+  "composited-changed"
+  (_fun _GdkScreen -> _void)
+  (λ (screen) (tell-all-frames-signal-changed 3)))
+
+(define (screen-size-signal-connect connect-signal)
+  (void (connect-signal (cast (gdk_screen_get_default) _GdkScreen _GtkWidget))))
+(screen-size-signal-connect connect-monitor-changed-signal)
+(screen-size-signal-connect connect-screen-changed-signal)
+(screen-size-signal-connect connect-composited-changed-signal)

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

@@ -359,7 +359,12 @@
                        (or min-height
                            (POINT-y (MINMAXINFO-ptMinTrackSize mmi)))))))
       0]
-     [else (super wndproc w msg wParam lParam default)]))
+     [(= msg WM_DISPLAYCHANGE)
+      (parameterize ([current-eventspace (get-eventspace)])
+        (queue-callback (lambda () (display-changed))))
+      0]
+     [else
+      (super wndproc w msg wParam lParam default)]))
 
   (define/override (try-nc-mouse w msg wParam lParam)
     #f)
@@ -665,4 +670,7 @@
     (DefWindowProcW hwnd WM_SYSCHAR (char->integer c) (arithmetic-shift 1 29)))
 
   (define/public (system-menu)
-    (popup-menu-with-char #\space)))
+    (popup-menu-with-char #\space))
+
+  (define/public (display-changed) (void)))
+

collects/mred/private/wxtop.rkt

@@ -64,7 +64,6 @@
 
   (define top-x init-top-x)
   (define top-y init-top-y)
-  (define top-level-windows (make-weak-hasheq))
   
   ;; make-top-container%: adds the necessary functionality to wx:frame% and 
   ;; wx:dialog%.
@@ -362,9 +361,6 @@
         (lambda (on? do-show)
           (when on?
             (position-for-initial-show))
-          (if on?
-              (hash-set! top-level-windows this #t)
-              (hash-remove! top-level-windows this))
           (as-exit ; as-exit because there's an implicit wx:yield for dialogs
            do-show))])
       
@@ -645,7 +641,10 @@
                         (lambda () (send (get-mred) on-activate on?)))
                        (as-exit
                         (lambda ()
-                          (super on-activate on?)))))])
+                          (super on-activate on?)))))]
+       [display-changed
+        (λ () 
+          (send (get-mred) display-changed))])
       (public*
        [is-act-on? (lambda () act-on?)]
        [add-activate-update (lambda (win) (set! activate-refresh-wins  

collects/scribblings/gui/global-draw-funcs.scrbl

@@ -15,8 +15,11 @@ other actions depend on updating the display.}
 
 
 @defproc[(get-display-count) exact-positive-integer?]{
-Returns the number of monitors currently active. On Windows and Mac OS X,
- the result can change at any time.
+Returns the number of monitors currently active. 
+
+On Windows and Mac OS X, the result can change at any time.
+See also @xmethod[top-level-window<%> display-changed].
+
 }
 
 
@@ -49,7 +52,8 @@ When the optional @racket[avoid-bars?] argument is true, for @racket[monitor]
 
 If @racket[monitor] is not less than the current number of available
  monitors (which can change at any time), the results are @racket[#f]
- and @racket[#f].}
+ and @racket[#f]. See also @xmethod[top-level-window<%> display-changed].
+}
 
 
 @defproc[(get-display-size [full-screen? any/c #f]
@@ -67,7 +71,8 @@ On Windows and Mac OS X, if the optional argument is true and @racket[monitor] i
 
 If @racket[monitor] is not less than the current number of available
  monitors (which can change at any time), the results are @racket[#f]
- and @racket[#f].}
+ and @racket[#f]. See also @xmethod[top-level-window<%> display-changed].
+}
 
 
 @defproc[(is-color-display?)

collects/scribblings/gui/top-level-window-intf.scrbl

@@ -192,6 +192,24 @@ Returns @|void-const|.
 }}
 
 
+@defmethod[(display-changed) any/c]{
+  @methspec{
+    Called when the displays configuration changes.
+
+    To determine the new monitor configuration, use
+    @racket[get-display-count], @racket[get-display-size], and
+    @racket[get-display-left-top-inset]. 
+
+    Note that this method may be invoked multiple times for a single
+    logical change to the monitors.
+    
+  }
+  @methimpl{
+    Returns @|void-const|.
+  }
+}
+
+
 @defmethod[(on-traverse-char [event (is-a?/c key-event%)])
            boolean?]{