add get-display-count' and #:screen argument to get-display-size'

and to `get-display-left-top-inset'

 add -M <monitor> option to Slideshow

original commit: 23a2a075eaa636b27ec0700a054d49989ae53a0e

collects/mred/mred-sig.rkt

@@ -79,6 +79,7 @@ get-choices-from-user
 get-color-from-user
 get-default-shortcut-prefix
 get-directory
+get-display-count
 get-display-depth
 get-display-left-top-inset
 get-display-size

collects/mred/private/mred.rkt

@@ -242,6 +242,7 @@
 	   play-sound
 	   get-display-size
 	   get-display-left-top-inset
+	   get-display-count
 	   get-color-from-user
 	   get-font-from-user
            append-editor-operation-menu-items

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

@@ -61,6 +61,7 @@
    bell
    display-size
    display-origin
+   display-count
    flush-display
    fill-private-color
    cancel-quit

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

@@ -42,6 +42,7 @@
   cancel-quit
   display-origin
   display-size
+  display-count
   bell
   hide-cursor
   get-display-depth
@@ -88,31 +89,59 @@
 
 (define (check-for-break) #f)
 
-(define (display-origin xb yb all?)
+(define (display-origin xb yb all? num)
-  (if all?
+  (if (or all? (positive? num))
-      (atomically
+      (unless (atomically
-       (with-autorelease
+               (with-autorelease
-        (let* ([screen (tell (tell NSScreen screens) objectAtIndex: #:type _NSUInteger 0)]
+                (let ([screens (tell NSScreen screens)])
-               [f (tell #:type _NSRect screen visibleFrame)])
+                  (if (num . < . (tell #:type _NSUInteger screens count))
-          (set-box! xb (->long (NSPoint-x (NSRect-origin f)))))))
+                      (let* ([screen (tell screens objectAtIndex: #:type _NSUInteger num)]
+                             [f (if (zero? num)
+                                    (tell #:type _NSRect screen visibleFrame)
+                                    (tell #:type _NSRect screen frame))])
+                        (set-box! xb (->long (NSPoint-x (NSRect-origin f))))
+                        (unless (zero? num)
+                          (let* ([screen0 (tell screens objectAtIndex: #:type _NSUInteger 0)]
+                                 [f0 (tell #:type _NSRect screen0 frame)])
+                            (set-box! yb (->long (- (+ (NSPoint-y (NSRect-origin f))
+                                                       (NSSize-height (NSRect-size f)))
+                                                    (NSSize-height (NSRect-size f0)))))))
+                        #t)
+                      #f))))
+        (error 'get-display-left-top-inset "no such monitor: ~v" num))
       (set-box! xb 0))
-  (set-box! yb (get-menu-bar-height)))
+  (when (zero? num)
+    (set-box! yb 0))
+  (set-box! yb (+ (unbox yb) (get-menu-bar-height))))
 
-(define (display-size xb yb all?)
+(define (display-size xb yb all? num)
+  (unless (atomically
+           (with-autorelease
+            (let ([screens (tell NSScreen screens)])
+              (if (num . < . (tell #:type _NSUInteger screens count))
+                  (let* ([screen (tell screens objectAtIndex: #:type _NSUInteger num)]
+                         [f (if all?
+                                (tell #:type _NSRect screen frame)
+                                (tell #:type _NSRect screen visibleFrame))])
+                    (set-box! xb (->long (NSSize-width (NSRect-size f))))
+                    (set-box! yb (->long (- (NSSize-height (NSRect-size f))
+                                            (cond
+                                             [all? 0]
+                                             [(positive? num) 0]
+                                             [(tell #:type _BOOL NSMenu menuBarVisible) 0]
+                                             ;; Make result consistent when menu bar is hidden:
+                                             [else 
+                                              (get-menu-bar-height)]))))
+                    #t)
+                  #f))))
+    (error 'get-display-size "no such monitor: ~v" num)))
+
+
+(define (display-count)
   (atomically
    (with-autorelease
-    (let* ([screen (tell (tell NSScreen screens) objectAtIndex: #:type _NSUInteger 0)]
+    (let ([screens (tell NSScreen screens)])
-           [f (if all?
+      (tell #:type _NSUInteger screens count)))))
-                  (tell #:type _NSRect screen frame)
-                  (tell #:type _NSRect screen visibleFrame))])
-      (set-box! xb (->long (NSSize-width (NSRect-size f))))
-      (set-box! yb (->long (- (NSSize-height (NSRect-size f))
-                              (cond
-                               [all? 0]
-                               [(tell #:type _BOOL NSMenu menuBarVisible) 0]
-                               ;; Make result consistent when menu bar is hidden:
-                               [else 
-                                (get-menu-bar-height)]))))))))
 
 (define-appkit NSBeep (_fun -> _void))  
 (define (bell) (NSBeep))

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

@@ -21,6 +21,7 @@
  (protect-out frame%
               display-origin
               display-size
+	      display-count
               location->window))
 
 ;; ----------------------------------------
@@ -488,23 +489,29 @@
 (define-gdk gdk_screen_get_height (_fun _GdkScreen -> _int))
 
 (define-gdk gdk_screen_get_monitor_geometry (_fun _GdkScreen _int _GdkRectangle-pointer -> _void))
+(define-gdk gdk_screen_get_n_monitors (_fun _GdkScreen -> _int))
 
-(define (monitor-rect num)
+(define (monitor-rect who num)
   (let ([s (gdk_screen_get_default)]
 	[r (make-GdkRectangle 0 0 0 0)])
+    (unless (num . < . (gdk_screen_get_n_monitors s))
+      (error who "no such monitor: ~v" num))
     (gdk_screen_get_monitor_geometry s num r)
     r))
 
-(define (display-origin x y all?)
+(define (display-origin x y all? num)
-  (let ([r (monitor-rect 0)])
+  (let ([r (monitor-rect 'get-display-left-top-inset num)])
-    (set-box! x (GdkRectangle-x r))
+    (set-box! x (- (GdkRectangle-x r)))
-    (set-box! y (GdkRectangle-y r))))
+    (set-box! y (- (GdkRectangle-y r)))))
 
-(define (display-size w h all?)
+(define (display-size w h all? num)
-  (let ([r (monitor-rect 0)])
+  (let ([r (monitor-rect 'get-display-size num)])
     (set-box! w (GdkRectangle-width r))
     (set-box! h (GdkRectangle-height r))))
 
+(define (display-count)
+  (gdk_screen_get_n_monitors (gdk_screen_get_default)))
+
 (define (location->window x y)
   (for/or ([f (in-hash-keys all-frames)])
     (let ([fx (send f get-x)]

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

@@ -62,6 +62,7 @@
    bell
    display-size
    display-origin
+   display-count
    flush-display
    fill-private-color
    cancel-quit

collects/mred/private/wx/platform.rkt

@@ -48,6 +48,7 @@
                 bell
                 display-size
                 display-origin
+		display-count
                 flush-display
                 fill-private-color
                 cancel-quit

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

@@ -21,7 +21,8 @@
 (provide 
  (protect-out frame%
               display-size
-              display-origin))
+              display-origin
+	      display-count))
 
 (define-user32 SetLayeredWindowAttributes (_wfun _HWND _COLORREF _BYTE _DWORD -> _BOOL))
 (define-user32 GetActiveWindow (_wfun -> _HWND))
@@ -35,6 +36,12 @@
 
 (define-user32 IsZoomed (_wfun _HWND -> _BOOL))
 
+(define-user32 EnumDisplayMonitors (_wfun _HDC 
+					  _pointer 
+					  (_wfun #:atomic? #t _pointer _HDC _RECT-pointer _pointer 
+						 -> _BOOL)
+					  _pointer -> _BOOL))
+
 (define-user32 SystemParametersInfoW (_wfun _UINT _UINT _pointer _UINT -> (r : _BOOL)
                                             -> (unless r (failed 'SystemParametersInfo))))
 (define-cstruct _MINMAXINFO ([ptReserved _POINT]
@@ -58,27 +65,60 @@
 
 (define SPI_GETWORKAREA            #x0030)
 
-(define (display-size xb yb all?)
+(define (get-all-screen-rects)
-  (if all?
+  (let ([rects null])
-      (atomically
+    (EnumDisplayMonitors #f #f (lambda (mon dc r ptr)
-       (let ([hdc (GetDC #f)])
+				 (set! rects (cons
-	 (set-box! xb (GetDeviceCaps hdc HORZRES))
+					      (list (RECT-left r)
-	 (set-box! yb (GetDeviceCaps hdc VERTRES))
+						    (RECT-top r)
-	 (ReleaseDC #f hdc)))
+						    (RECT-right r)
-      (let ([r (make-RECT 0 0 0 0)])
+						    (RECT-bottom r))
-	(SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
+					      rects))
-	(set-box! xb (- (RECT-right r) (RECT-left r)))
+				 #t)
-	(set-box! yb (- (RECT-bottom r) (RECT-top r))))))
+			 #f)
+    (reverse rects)))
 
-(define (display-origin xb yb avoid-bars?)
+(define (display-size xb yb all? num)
-  (if avoid-bars?
+  (cond
-      (let ([r (make-RECT 0 0 0 0)])
+   [(positive? num)
-        (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
+    (let ([rs (get-all-screen-rects)])
-        (set-box! xb (RECT-left r))
+      (unless (num . < . (length rs))
-        (set-box! yb (RECT-top r)))
+	(error 'get-display-size "no such monitor: ~v" num))
-      (begin
+      (let ([r (list-ref rs num)])
-        (set-box! xb 0)
+	(set-box! xb (- (caddr r) (car r)))
-        (set-box! yb 0))))
+	(set-box! yb (- (cadddr r) (cadr r)))))]
+   [all?
+    (atomically
+     (let ([hdc (GetDC #f)])
+       (set-box! xb (GetDeviceCaps hdc HORZRES))
+       (set-box! yb (GetDeviceCaps hdc VERTRES))
+       (ReleaseDC #f hdc)))]
+   [else
+    (let ([r (make-RECT 0 0 0 0)])
+      (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
+      (set-box! xb (- (RECT-right r) (RECT-left r)))
+      (set-box! yb (- (RECT-bottom r) (RECT-top r))))]))
+
+(define (display-origin xb yb avoid-bars? num)
+  (cond
+   [(positive? num)
+    (let ([rs (get-all-screen-rects)])
+      (unless (num . < . (length rs))
+	(error 'get-display-left-top-inset "no such monitor: ~v" num))
+      (let ([r (list-ref rs num)])
+	(set-box! xb (- (car r)))
+	(set-box! yb (- (cadr r)))))]
+   [avoid-bars?
+    (let ([r (make-RECT 0 0 0 0)])
+      (SystemParametersInfoW SPI_GETWORKAREA 0 r 0)
+      (set-box! xb (RECT-left r))
+      (set-box! yb (RECT-top r)))]
+   [else
+    (set-box! xb 0)
+    (set-box! yb 0)]))
+
+(define (display-count)
+  (length (get-all-screen-rects)))
 
 (define mouse-frame #f)
 
@@ -391,7 +431,7 @@
 	  [wh (box 0)]
 	  [wx (box 0)]
 	  [wy (box 0)])
-      (display-size sw sh #f)
+      (display-size sw sh #f 0)
       (if wrt
 	  (begin
 	    (send wrt get-size ww wh)

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

@@ -62,6 +62,7 @@
    bell
    display-size
    display-origin
+   display-count
    flush-display
    fill-private-color
    cancel-quit

collects/mred/private/wxtop.rkt

@@ -1,11 +1,10 @@
-(module wxtop mzscheme
+(module wxtop racket/base
   (require mzlib/class
            mzlib/class100
-           mzlib/etc
            mzlib/list
-           (prefix wx: "kernel.rkt")
+           (prefix-in wx: "kernel.rkt")
-           (prefix wx: "wxme/editor-canvas.rkt")
+           (prefix-in wx: "wxme/editor-canvas.rkt")
-           (prefix wx: "wxme/editor-snip.rkt")
+           (prefix-in wx: "wxme/editor-snip.rkt")
            "lock.rkt"
            "helper.rkt"
            "const.rkt"
@@ -15,14 +14,15 @@
            "wxwindow.rkt"
            "wxcontainer.rkt")
 
-  (provide (protect active-main-frame
+  (provide (protect-out active-main-frame
-                    set-root-menu-wx-frame!)
+			set-root-menu-wx-frame!)
 	   get-display-size
 	   get-display-left-top-inset
-	   (protect make-top-container%
+	   get-display-count
-		    make-top-level-window-glue%
+	   (protect-out make-top-container%
-		    wx-frame%
+			make-top-level-window-glue%
-		    wx-dialog%))
+			wx-frame%
+			wx-dialog%))
 
   ;; Weak boxed:
   (define active-main-frame (make-weak-box #f))
@@ -32,19 +32,27 @@
     (set! root-menu-wx-frame f))
 
   (define get-display-size
-    (opt-lambda ([full-screen? #f])
+    (lambda ([full-screen? #f] #:monitor [monitor 0])
+      (unless (exact-nonnegative-integer? monitor)
+	(raise-type-error 'get-display-size "exact non-negative integer" monitor))
       (let ([xb (box 0)]
 	    [yb (box 0)])
-	(wx:display-size xb yb full-screen?)
+	(wx:display-size xb yb full-screen? monitor)
 	(values (unbox xb) (unbox yb)))))
 
   (define get-display-left-top-inset
-    (opt-lambda ([advisory? #f])
+    (lambda ([advisory? #f] #:monitor [monitor 0])
+      (unless (exact-nonnegative-integer? monitor)
+	(raise-type-error 'get-display-left-top-inset "exact non-negative integer" monitor))
       (let ([xb (box 0)]
 	    [yb (box 0)])
-	(wx:display-origin xb yb advisory?)
+	(wx:display-origin xb yb advisory? monitor)
 	(values (unbox xb) (unbox yb)))))
 
+  (define get-display-count
+    (lambda ()
+      (wx:display-count)))
+
   (define-values (left-margin top-margin init-top-x init-top-y)
     (let-values ([(x y) (get-display-left-top-inset #f)]
 		 [(x2 y2) (get-display-left-top-inset #t)])
@@ -55,7 +63,7 @@
 
   (define top-x init-top-x)
   (define top-y init-top-y)
-  (define top-level-windows (make-hash-table 'weak))
+  (define top-level-windows (make-weak-hasheq))
   
   ;; make-top-container%: adds the necessary functionality to wx:frame% and 
   ;; wx:dialog%.
@@ -99,8 +107,8 @@
 
        [parent-for-center parent]
 
-       [show-ht (make-hash-table)]
+       [show-ht (make-hasheq)]
-       [fake-show-ht (make-hash-table)])
+       [fake-show-ht (make-hasheq)])
       
       (override
 	[enable
@@ -192,17 +200,17 @@
 	   (when perform-updates?
 	     (when pending-redraws?
 	       (force-redraw))
-	     (when (positive? (hash-table-count fake-show-ht))
+	     (when (positive? (hash-count fake-show-ht))
 	       (let ([t fake-show-ht])
-		 (set! fake-show-ht (make-hash-table))
+		 (set! fake-show-ht (make-hasheq))
-		 (hash-table-for-each
+		 (hash-for-each
 		  t
 		  (lambda (win v?)
 		    (send win really-show #t)))))
-	     (when (positive? (hash-table-count show-ht))
+	     (when (positive? (hash-count show-ht))
 	       (let ([t show-ht])
-		 (set! show-ht (make-hash-table))
+		 (set! show-ht (make-hasheq))
-		 (hash-table-for-each
+		 (hash-for-each
 		  t
 		  (lambda (win v?)
 		    (send win show v?))))))])]
@@ -221,7 +229,7 @@
 	 (lambda (child show?)
 	   (if perform-updates?
 	       (send child show show?)
-	       (hash-table-put! show-ht child show?)))]
+	       (hash-set! show-ht child show?)))]
 
         [show-control
          (lambda (child on?)
@@ -230,10 +238,10 @@
                    (child . is-a? . wx-frame%)
                    (child . is-a? . wx-dialog%))
 	       (begin
-		 (hash-table-remove! fake-show-ht child)
+		 (hash-remove! fake-show-ht child)
 		 (send child really-show on?))
                (begin
-		 (hash-table-put! fake-show-ht child #t)
+		 (hash-set! fake-show-ht child #t)
                  (send child fake-show on?))))]
 
 	;; force-redraw: receives a message from to redraw the
@@ -353,8 +361,8 @@
            (when on?
              (position-for-initial-show))
 	   (if on?
-	       (hash-table-put! top-level-windows this #t)
+	       (hash-set! top-level-windows this #t)
-	       (hash-table-remove! top-level-windows this))
+	       (hash-remove! top-level-windows this))
 	   (as-exit ; as-exit because there's an implicit wx:yield for dialogs
             do-show))])
       
@@ -713,7 +721,7 @@
 		 (or (send event get-control-down)
 		     (send event get-meta-down)
 		     (send event get-alt-down)
-		     (hash-table-get function-keys (send event get-key-code) #f))
+		     (hash-ref function-keys (send event get-key-code) #f))
 		 (begin
 		   (send menu-bar on-demand)
 		   (send menu-bar handle-key event))))])

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

@@ -14,6 +14,12 @@ Normally, drawing is automatically flushed to the screen. Use
 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.
+}
+
+
 @defproc[(get-display-depth)
          exact-nonnegative-integer?]{
 
@@ -21,36 +27,44 @@ Returns the depth of the main display (a value of 1 denotes a monochrome display
 
 }
 
-@defproc[(get-display-left-top-inset [avoid-bars? any/c #f])
+@defproc[(get-display-left-top-inset [avoid-bars? any/c #f]
+                                     [#:monitor monitor exact-nonnegative-integer? 0])
          (values exact-nonnegative-integer? exact-nonnegative-integer?)]{
 
 When the optional argument is @racket[#f] (the default), this function
- returns the offset of the main screen's origin from the
+ returns the offset of @racket[monitor]'s origin from the
- top-left of the physical screen. On Unix and Windows, the result is
+ top-left of the physical monitor. For @racket[monitor] @racket[0], on Unix and Windows, the result is
  always @racket[0] and @racket[0]; on Mac OS X, the result is
- @racket[0] and the height of the menu bar.
+ @racket[0] and the height of the menu bar. To position a frame
+ at a given @racket[monitor]'s top-left corner, use the negated results from
+ @racket[get-display-left-top-inset] as the frame's position.
 
-When the optional argument is true, this function returns the amount
+When the optional @racket[avoid-bars?] argument is true, for @racket[monitor]
- space at the left and top of the main screen that is occupied by the
+ @racket[0], @racket[get-display-left-top-inset] function returns the
- task bar (Windows) or menu bar and dock (Mac OS X). On Unix, the
+ amount space at the left and top of the monitor that is occupied by
- result is always @racket[0] and @racket[0].
+ the task bar (Windows) or menu bar and dock (Mac OS X). On Unix, for
+ monitor @racket[0], the result is always @racket[0] and @racket[0].
+ For monitors other than @racket[0], @racket[avoid-bars?] has no effect.
 
-}
+If @racket[monitor] is not less than the current number of available monitors, the
+ @racket[exn:fail] exception is raised.}
 
-@defproc[(get-display-size [full-screen? any/c #f])
+
+@defproc[(get-display-size [full-screen? any/c #f]
+                           [#:monitor monitor exact-nonnegative-integer? 0])
          (values exact-nonnegative-integer? exact-nonnegative-integer?)]{
 
-@index["screen resolution"]{Gets} the physical size of the display in
+@index["screen resolution"]{Gets} the physical size of the specified @racket[monitor] in
  pixels.  On Windows, this size does not include the task bar by
  default.  On Mac OS X, this size does not include the menu bar or
  dock area by default.
 
-On Windows and Mac OS X, if the optional argument is true, then
+On Windows and Mac OS X, if the optional argument is true and @racket[monitor] is @racket[0], then
  the task bar, menu bar, and dock area are included in the result.
 
-Returns the screen's width and height.
+If @racket[monitor] is not less than the current number of available monitors, the
+ @racket[exn:fail] exception is raised.}
 
-}
 
 @defproc[(is-color-display?)
          boolean?]{