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)
This commit is contained in:
Robby Findler
parent
f67d46cd2f
commit
3fa2cc0d67
|
|
@ -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?)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 (setup-size-pref size-preferences-key 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
|
||||
#: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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
||||
Passes the @racket[width] and @racket[height] initialization arguments to
|
||||
the superclass based on the current value of the preference.
|
||||
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[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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user