diff --git a/collects/drracket/private/main.rkt b/collects/drracket/private/main.rkt index 072ce606bc..b3f888ffdf 100644 --- a/collects/drracket/private/main.rkt +++ b/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?) - (drr:set-default 'drracket:unit-window-height frame-height number?)) + (frame:setup-size-pref 'drracket:unit-window-size + 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?) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 97af6d4195..87b6d0f6fc 100644 --- a/collects/drracket/private/unit.rkt +++ b/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:searchable-mixin - (frame:text-info-mixin - (frame:delegate-mixin - (frame:status-line-mixin - (frame:info-mixin - (frame:text-mixin - (frame:open-here-mixin - (frame:editor-mixin - (frame:standard-menus-mixin - (frame:register-group-mixin - (frame:basic-mixin - frame%))))))))))))))) + (frame:size-pref-mixin + (frame:searchable-text-mixin + (frame:searchable-mixin + (frame:text-info-mixin + (frame:delegate-mixin + (frame:status-line-mixin + (frame:info-mixin + (frame:text-mixin + (frame:open-here-mixin + (frame:editor-mixin + (frame:standard-menus-mixin + (frame:register-group-mixin + (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) - (style '(toolbar-button)) - (width (preferences:get 'drracket:unit-window-width)) - (height (preferences:get 'drracket:unit-window-height))) - (inherit maximize) - (when (preferences:get 'drracket:unit-window-max?) - (maximize #t)) + [filename filename] + [style '(toolbar-button)] + [size-preferences-key 'drracket:unit-window-size] + [position-preferences-key 'drracket:unit-window-position]) (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))) diff --git a/collects/framework/main.rkt b/collects/framework/main.rkt index fb73b3270d..4c3dc7ac75 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 e10aabd00a..b8cd67689a 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 ba49a80f27..76d0c98763 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