From 3b8bdc5ec17625e3be37c5db747b3cf4b4eee3f1 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 19 Jul 2011 08:45:49 -0500 Subject: [PATCH] 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) original commit: 3fa2cc0d6775f1793a5068295e0370cadb70cfaf --- collects/framework/main.rkt | 19 ++- collects/framework/private/frame.rkt | 141 +++++++++++++++++++-- collects/scribblings/framework/frame.scrbl | 31 +++-- 3 files changed, 158 insertions(+), 33 deletions(-) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index fb73b327..4c3dc7ac 100644 --- a/collects/framework/main.rkt +++ b/collects/framework/main.rkt @@ -630,12 +630,25 @@ (proc-doc/names frame:setup-size-pref - (symbol? number? number? . -> . void) - (size-pref-sym width height) + (->* (symbol? number? number?) + (#: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 diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt index e10aabd0..b8cd6768 100644 --- a/collects/framework/private/frame.rkt +++ b/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))) - (let ([lst (preferences:get size-preferences-key)]) - (super-new [width (car lst)] [height (cadr lst)])))) + (cond + [(is-maximized?) + (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) - (λ (x) - (and (pair? x) - (pair? (cdr x)) - (null? (cddr x)) - (number? (car x)) - (number? (cadr x)))))) + (list maximized? w h) + (list/c boolean? + exact-nonnegative-integer? + exact-nonnegative-integer?)) + (when position-preferences-key + (preferences:set-default position-preferences-key + (list 0 0 0) + (list/c exact-nonnegative-integer? + exact-integer? + exact-integer?)))) (define register-group<%> (interface ())) (define register-group-mixin diff --git a/collects/scribblings/framework/frame.scrbl b/collects/scribblings/framework/frame.scrbl index ba49a80f..76d0c987 100644 --- a/collects/scribblings/framework/frame.scrbl +++ b/collects/scribblings/framework/frame.scrbl @@ -164,30 +164,29 @@ } @defmixin[frame:size-pref-mixin (frame:basic<%>) (frame:size-pref<%>)]{ - @defconstructor[((size-preferences-key symbol?) - (label label-string?) - (parent (or/c (is-a?/c frame%) false/c) #f) - (x (or/c (integer-in -10000 10000) false/c) #f) - (y (or/c (integer-in -10000 10000) false/c) #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) - (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))]{ + @defconstructor/auto-super[([size-preferences-key symbol?] + [position-preferences-key (or/c symbol? #f) #f] + [width (or/c (integer-in 0 10000) #f) #f] + [height (or/c (integer-in 0 10000) #f) #f] + [x (or/c (integer-in -10000 10000) #f) #f] + [y (or/c (integer-in -10000 10000) false/c) #f])]{ - 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 - the superclass based on the current value of the preference. + Passes the @racket[x], @racket[y], and @racket[width] and @racket[height] + 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