adjust the size-pref frame mixin to track the position of the frame in a multi-monitor sensitive way

(also fix various issues with that code and unify the framework and drracket way of doing this)

collects/drracket/private/main.rkt

@@ -137,12 +137,6 @@
                                                (andmap string? (cdr x))))
                                         x))))
 (drr:set-default 'drracket:defs/ints-horizontal #f boolean?)
-(drr:set-default 'drracket:unit-window-max? #f boolean?)
-(drr:set-default 'drracket:frame:initial-position #f 
-                         (λ (x) (or (not x)
-                                    (and (pair? x)
-                                         (number? (car x))
-                                         (number? (cdr x))))))
 
 (drr:set-default 'drracket:child-only-memory-limit (* 1024 1024 128)
                          (λ (x) (or (boolean? x)
@@ -202,8 +196,11 @@
   (let-values ([(w h) (get-display-size)])
     (set! frame-width (min frame-width (- w window-trimming-upper-bound-width)))
     (set! frame-height (min frame-height (- h window-trimming-upper-bound-height))))
-  (drr:set-default 'drracket:unit-window-width frame-width number?)
+  (frame:setup-size-pref 'drracket:unit-window-size 
-  (drr:set-default 'drracket:unit-window-height frame-height number?))
+                         frame-width
+                         frame-height 
+                         #:position-preferences
+                         'drracket:unit-window-position))
 
 (drr:set-default 'drracket:backtrace-window-width 400 number?)
 (drr:set-default 'drracket:backtrace-window-height 300 number?)

collects/drracket/private/unit.rkt

@@ -1140,19 +1140,20 @@ module browser threading seems wrong.
     (define super-frame%
       (drracket:frame:mixin
        (drracket:frame:basics-mixin 
-        (frame:searchable-text-mixin 
+        (frame:size-pref-mixin
-         (frame:searchable-mixin
+         (frame:searchable-text-mixin 
-          (frame:text-info-mixin 
+          (frame:searchable-mixin
-           (frame:delegate-mixin
+           (frame:text-info-mixin 
-            (frame:status-line-mixin
+            (frame:delegate-mixin
-             (frame:info-mixin
+             (frame:status-line-mixin
-              (frame:text-mixin
+              (frame:info-mixin
-               (frame:open-here-mixin
+               (frame:text-mixin
-                (frame:editor-mixin
+                (frame:open-here-mixin
-                 (frame:standard-menus-mixin
+                 (frame:editor-mixin
-                  (frame:register-group-mixin
+                  (frame:standard-menus-mixin
-                   (frame:basic-mixin
+                   (frame:register-group-mixin
-                    frame%)))))))))))))))
+                    (frame:basic-mixin
+                     frame%))))))))))))))))
     
     (define tab%
       (class* object% (drracket:rep:context<%> tab<%>)
@@ -2760,32 +2761,6 @@ module browser threading seems wrong.
         
         (inherit get-menu-bar get-focus-object get-edit-target-object)
         
-        (inherit is-maximized?)
-        (define/override (on-size w h)
-          (unless (is-maximized?)
-            (preferences:set 'drracket:unit-window-width w)
-            (preferences:set 'drracket:unit-window-height h))
-          (preferences:set 'drracket:unit-window-max? (is-maximized?))
-          (super on-size w h))
-        
-        (define on-move-timer-args #f)
-        (define on-move-timer #f)
-        (define/override (on-move x y)
-          (cond
-            [on-move-timer
-             (set! on-move-timer-args (cons x y))]
-            [else
-             (set! on-move-timer-args (cons x y))
-             (set! on-move-timer 
-                   (new timer% 
-                        [notify-callback
-                         (λ () 
-                           (set! on-move-timer #f)
-                           (set! on-move-timer-args #f)
-                           (preferences:set 'drracket:frame:initial-position on-move-timer-args))]
-                        [interval 1000]
-                        [just-once? #t]))]))
-        
         (define/override (get-editor) definitions-text)
         (define/override (get-canvas)
           (initialize-definitions-canvas)
@@ -4004,13 +3979,10 @@ module browser threading seems wrong.
         (init-definitions-text (car tabs))
         
         (super-new
-         (filename filename)
+         [filename filename]
-         (style '(toolbar-button))
+         [style '(toolbar-button)]
-         (width (preferences:get 'drracket:unit-window-width))
+         [size-preferences-key 'drracket:unit-window-size]
-         (height (preferences:get 'drracket:unit-window-height)))
+         [position-preferences-key 'drracket:unit-window-position])
-        (inherit maximize)
-        (when (preferences:get 'drracket:unit-window-max?)
-          (maximize #t))
         
         (initialize-menus)
         
@@ -4805,17 +4777,11 @@ module browser threading seems wrong.
            [else
             (create-new-drscheme-frame name)])]))
 
-    (define first-frame? #t)
     (define (create-new-drscheme-frame filename)
       (let* ([drs-frame% (drracket:get/extend:get-unit-frame)]
              [frame (new drs-frame% (filename filename))])
-        (when first-frame?
-          (let ([pos (preferences:get 'drracket:frame:initial-position)])
-            (when pos
-              (send frame move (car pos) (cdr pos)))))
         (send frame update-toolbar-visibility)
         (send frame initialize-module-language)
         (send frame show #t)
         (send (send frame get-interactions-text) initialize-console)
-        (set! first-frame? #f)
         frame)))

collects/framework/main.rkt

@@ -630,12 +630,25 @@
 
  (proc-doc/names
   frame:setup-size-pref
-  (symbol? number? number? . -> . void)
+  (->* (symbol? number? number?) 
-  (size-pref-sym width height)
+       (#:maximized? 
+        boolean?
+        #:position-preferences 
+        (or/c #f symbol?))
+       void?)
+  ((size-pref-sym width height)
+   ((maximized? #f)
+    (position-preferences-sym #f)))
   @{Initializes a preference for the @racket[frame:size-pref] mixin.
     
     The first argument should be the preferences symbol, and the second and
-    third should be the default width and height, respectively.})
+    third should be the default width and height, respectively. If the
+    window should be maximized by default, pass @racket[#t] for the
+    @racket[maximized?] argument.
+    
+    If @racket[position-preferences-sym] is passed, then that symbol will be
+    used to track the position of the window.
+    })
 
  (proc-doc/names
   frame:add-snip-menu-items

collects/framework/private/frame.rkt

@@ -1,7 +1,8 @@
-#lang scheme/unit
+#lang racket/unit
 
 (require string-constants
-         scheme/class
+         racket/class
+         racket/contract
          mzlib/include
          "search.rkt"
          "sig.rkt"
@@ -232,21 +233,133 @@
 
 (define size-pref-mixin
   (mixin (basic<%>) (size-pref<%>)
-    (init-field size-preferences-key)
+    (init-field size-preferences-key
+                [position-preferences-key #f])
+    (inherit is-maximized?)
     (define/override (on-size w h)
-      (preferences:set size-preferences-key (list w h)))
+      (cond
-    (let ([lst (preferences:get size-preferences-key)])
+        [(is-maximized?)
-      (super-new [width (car lst)] [height (cadr lst)]))))
+         (define old (preferences:get size-preferences-key)) 
+         (preferences:set size-preferences-key (cons #t (cdr old)))]
+        [else
+         (preferences:set size-preferences-key (list #f w h))])
+      (super on-size w h))
+    
+    (define on-move-timer-arg-x #f)
+    (define on-move-timer-arg-y #f)
+    (define on-move-timer-arg-max? #f)
+    (define on-move-timer #f)
+    (define/override (on-move x y)
+      (when position-preferences-key
+        (unless on-move-timer
+          (set! on-move-timer 
+                (new timer% 
+                     [notify-callback
+                      (λ () 
+                        (unless on-move-timer-arg-max?
+                          (define-values (monitor delta-x delta-y) (find-closest on-move-timer-arg-x on-move-timer-arg-y))
+                          (preferences:set position-preferences-key (list monitor delta-x delta-y))))])))
+        (set! on-move-timer-arg-x x)
+        (set! on-move-timer-arg-y y)
+        (set! on-move-timer-arg-max? (is-maximized?))
+        (send on-move-timer stop)
+        (send on-move-timer start 250 #t))
+      (super on-move x y))
+    
+    ;; if all of the offsets have some negative direction, then
+    ;; just keep the thing relative to the original montior; otherwise
+    ;; make it relative to whatever origin it is closest to.
+    (define/private (find-closest x y)
+      (define closest 0)
+      (define-values (delta-x delta-y dist) (find-distance x y 0))
+      
+      (for ([m (in-range 1 (get-display-count))])
+        (define-values (new-delta-x new-delta-y new-dist) 
+          (find-distance x y m))
+        (when (and (new-delta-x . >= . 0)
+                   (new-delta-y . >= . 0))
+          (when (< new-dist dist)
+            (set! closest m)
+            (set!-values (delta-x delta-y dist) (values new-delta-x new-delta-y new-dist)))))
+      
+      (values closest delta-x delta-y))
+    
+    (define/private (find-distance x y mon)
+      (define-values (delta-x delta-y)
+        (let-values ([(l t) (get-display-left-top-inset #:monitor 0)])
+          (values (- x l) (- y t))))
+      (values delta-x
+              delta-y
+              (sqrt (+ (* delta-x delta-x)
+                       (* delta-y delta-y)))))
+    
+    (inherit maximize)
+    (let ()
+      (define-values (maximized? w h) (apply values (preferences:get size-preferences-key)))
+      (define-values (x y)
+        (cond
+          [position-preferences-key
+           (define-values (monitor delta-x delta-y) (apply values (preferences:get position-preferences-key)))
+           (define-values (l t) (get-display-left-top-inset #:monitor monitor))
+           (define-values (m-w m-h) (get-display-size))
+           (values (- delta-x l) (- delta-y t))]
+          [else
+           (values #f #f)]))
+      (define (window-origin-visible? x y)
+        (for/or ([m (in-range 0 (get-display-count))])
+          (define-values (mw mh) (get-display-size #:monitor m))
+          (define-values (mx my) (get-display-left-top-inset #:monitor m))
+          (and (<= (- mx) x (+ mx mw))
+               (<= (- my) y (+ my mh)))))
+      (define (already-one-there? x y w h)
+        (for/or ([fr (in-list (get-top-level-windows))])
+          (and (equal? x (send fr get-x))
+               (equal? y (send fr get-y))
+               (equal? w (send fr get-width))
+               (equal? h (send fr get-height))
+               (equal? maximized? (send fr is-maximized?)))))
+      (cond
+        [(or (and (already-one-there? x y w h)
+                  (not maximized?))
+             (not (window-origin-visible? x y)))
+         ;; these are the situations where we look for a different position of the window
+         (let loop ([n 50]
+                    [x 0]
+                    [y 0])
+           (cond
+             [(zero? n)
+              (super-new)]
+             [(already-one-there? x y w h)
+              (define-values (dw dh) (get-display-size #:monitor 0))
+              (define sw (- dw w))
+              (define sh (- dh h))
+              (if (or (<= sw 0)
+                      (<= sh 0))
+                (super-new)
+                (loop (- n 1) 
+                      (modulo (+ x 20) (- dw w))
+                      (modulo (+ y 20) (- dh h))))]
+             [else
+              (super-new [width w] [height h] [x x] [y y])]))]
+        [else
+         (super-new [width w] [height h] [x x] [y y])])
+      (when maximized?
+        (maximize #t)))))
 
-(define (setup-size-pref size-preferences-key w h)
+(define (setup-size-pref size-preferences-key w h 
+                         #:maximized? [maximized? #f]
+                         #:position-preferences [position-preferences-key #f])
   (preferences:set-default size-preferences-key 
-                           (list w h)
+                           (list maximized? w h)
-                           (λ (x)
+                           (list/c boolean?
-                             (and (pair? x)
+                                   exact-nonnegative-integer?
-                                  (pair? (cdr x))
+                                   exact-nonnegative-integer?))
-                                  (null? (cddr x))
+  (when position-preferences-key
-                                  (number? (car x))
+    (preferences:set-default position-preferences-key 
-                                  (number? (cadr x))))))
+                             (list 0 0 0)
+                             (list/c exact-nonnegative-integer?
+                                     exact-integer?
+                                     exact-integer?))))
 
 (define register-group<%> (interface ()))
 (define register-group-mixin

collects/scribblings/framework/frame.scrbl

@@ -164,30 +164,29 @@
 
 }
 @defmixin[frame:size-pref-mixin (frame:basic<%>) (frame:size-pref<%>)]{
-  @defconstructor[((size-preferences-key symbol?)
+  @defconstructor/auto-super[([size-preferences-key symbol?]
-                   (label label-string?)
+                              [position-preferences-key (or/c symbol? #f) #f]
-                   (parent (or/c (is-a?/c frame%) false/c) #f)
+                              [width (or/c (integer-in 0 10000) #f) #f]
-                   (x (or/c (integer-in -10000 10000) false/c) #f)
+                              [height (or/c (integer-in 0 10000) #f) #f]
-                   (y (or/c (integer-in -10000 10000) false/c) #f)
+                              [x (or/c (integer-in -10000 10000) #f) #f]
-                   (style (listof (or/c 'no-resize-border 'no-caption 'no-system-menu 'hide-menu-bar 'mdi-parent 'mdi-child 'toolbar-button 'float 'metal)) null)
+                              [y (or/c (integer-in -10000 10000) false/c) #f])]{
-                   (enabled any/c #t)
-                   (border (integer-in 0 1000) 0)
-                   (spacing (integer-in 0 1000) 0)
-                   (alignment (list/c (or/c 'left 'center 'right) (or/c 'top 'center 'bottom)) '(center top))
-                   (min-width (integer-in 0 10000) graphical-minimum-width)
-                   (min-height (integer-in 0 10000) graphical-minimum-height)
-                   (stretchable-width any/c #t) (stretchable-height any/c #t))]{
 
-    The size @racket[size-preferences-key] symbol is used with
+    The  @racket[size-preferences-key] symbol is used with
     @racket[preferences:get] and @racket[preferences:set] to track the current
     size.
+    
+    If present, the @racket[position-preferences-key] symbol is used with
+    @racket[preferences:get] and @racket[preferences:set] to track the current
+    position.
 
-    Passes the @racket[width] and @racket[height] initialization arguments to
+    Passes the @racket[x], @racket[y], and @racket[width] and @racket[height] 
-    the superclass based on the current value of the preference.
+    initialization arguments to the superclass and calls @method[frame% maximize]
+    based on the current values of the preferences.
 
     See also @racket[frame:setup-size-pref].
 
   }
+                                                                               
   @defmethod*[#:mode override (((on-size (width number?) (height number?)) void?))]{
 
     Updates the preferences, according to the width and