suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

drracket tracks the frame position and size on a

Browse Source 
per-monitor-configuration basis and (possibly) moves/resizes
the frame when it changes
This commit is contained in:
Robby Findler 2012-12-21 19:21:06 -06:00
parent 3f9e60a908
commit 2fced5d7d6
3 changed files with 174 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
collects/drracket/private/unit.rkt
View File

@ -1358,7 +1358,7 @@ module browser threading seems wrong.
show-planet-status)
(define frame-mixin
(mixin (drracket:frame:<%> frame:searchable-text<%> frame:delegate<%>)
(mixin (drracket:frame:<%> frame:searchable-text<%> frame:delegate<%> frame:size-pref<%>)
(drracket:unit:frame<%>)
(init filename)
(inherit set-label-prefix get-show-menu
@ -4283,6 +4283,12 @@ module browser threading seems wrong.
(init-definitions-text (car tabs))
(define/override (adjust-size-when-monitor-setup-changes?)
(= 1 (for/sum ([f (in-list (get-top-level-windows))])
(if (is-a? f drracket:unit:frame<%>)
1
0))))
(super-new
[filename filename]
[style '(toolbar-button)]

180
collects/framework/private/frame.rkt
View File

@ -253,7 +253,10 @@
(define current-icon (make-parameter #f))
(define size-pref<%>
(interface (basic<%>)))
(interface (basic<%>)
adjust-size-when-monitor-setup-changes?))
(define-local-member-name monitor-setup-changed)
(define size-pref-mixin
(mixin (basic<%>) (size-pref<%>)
@ -261,35 +264,66 @@
[position-preferences-key #f])
(inherit is-maximized?)
(define/override (on-size w h)
(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))])
;; if the monitor state is currently fluxuating, then
;; don't save preferences values, since the OS is doing
;; some adjustments for us.
(when (or (equal? (compute-current-monitor-information)
latest-monitor-information)
(not (adjust-size-when-monitor-setup-changes?)))
(define old-table (preferences:get size-preferences-key))
(define new-val
(cond
[(is-maximized?)
(define old (or (hash-ref old-table latest-monitor-information #f)
(hash-ref old-table #f)))
(cons #t (cdr old))]
[else
(list #f w h)]))
(preferences:set size-preferences-key
(hash-set*
old-table
latest-monitor-information new-val
#f new-val)))
(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 on-move-callback-running? #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))))])))
(unless on-move-callback-running?
(set! on-move-callback-running? #t)
(queue-callback
(λ ()
(set! on-move-callback-running? #f)
(unless on-move-timer-arg-max?
;; if the monitor state is currently fluxuating, then
;; don't save preferences values, since the OS is doing
;; some adjustments for us.
(when (or (equal? (compute-current-monitor-information)
latest-monitor-information)
(not (adjust-size-when-monitor-setup-changes?)))
(define-values (monitor delta-x delta-y) (find-closest on-move-timer-arg-x on-move-timer-arg-y))
(define old-table (preferences:get position-preferences-key))
(define val (list monitor delta-x delta-y))
(preferences:set position-preferences-key
(hash-set*
old-table
latest-monitor-information val
#f val)))))
#f))
(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))
(set! on-move-timer-arg-max? (is-maximized?)))
(super on-move x y))
(define/augment (display-changed)
(restart-montior-information-timer)
(inner (void) display-changed))
;; 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.
@ -320,12 +354,16 @@
(* delta-y delta-y)))))
(inherit maximize)
(let ()
(define-values (maximized? w h) (apply values (preferences:get size-preferences-key)))
(define/private (get-sizes/maximzed)
(define size-table (preferences:get size-preferences-key))
(define-values (maximized? w h) (apply values (or (hash-ref size-table latest-monitor-information #f)
(hash-ref size-table #f))))
(define-values (x y origin-still-visible?)
(cond
[position-preferences-key
(define-values (monitor delta-x delta-y) (apply values (preferences:get position-preferences-key)))
(define pos-table (preferences:get position-preferences-key))
(define-values (monitor delta-x delta-y) (apply values (or (hash-ref pos-table latest-monitor-information #f)
(hash-ref pos-table #f))))
(define-values (l t) (get-display-left-top-inset #:monitor monitor))
(define-values (mw mh) (get-display-size #:monitor monitor))
(if (and l t mw mh)
@ -353,21 +391,45 @@
[y 0])
(cond
[(zero? n)
(super-new)]
(values #f #f #f #f maximized?)]
[(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)
(values #f #f #f #f maximized?)
(loop (- n 1)
(modulo (+ x 20) (- dw w))
(modulo (+ y 20) (- dh h))))]
[else
(super-new [width w] [height h] [x x] [y y])]))]
(values w h x y maximized?)]))]
[else
(super-new [width w] [height h] [x x] [y y])])
(values w h x y maximized?)]))
(define/public (adjust-size-when-monitor-setup-changes?) #f)
(inherit begin-container-sequence
end-container-sequence
move
resize)
(define/public (monitor-setup-changed)
(when (adjust-size-when-monitor-setup-changes?)
(define-values (w h x y maximized?) (get-sizes/maximzed))
(when (and w h x y)
(begin-container-sequence)
(move x y)
(resize w h)
(when maximized?
(maximize #t))
(end-container-sequence))))
(let-values ([(w h x y maximized?) (get-sizes/maximzed)])
(cond
[(and w h x y)
(super-new [width w] [height h] [x x] [y y])]
[else
(super-new)])
(when maximized?
(maximize #t)))))
@ -375,16 +437,64 @@
#:maximized? [maximized? #f]
#:position-preferences [position-preferences-key #f])
(preferences:set-default size-preferences-key
(list maximized? w h)
(list/c boolean?
exact-nonnegative-integer?
exact-nonnegative-integer?))
(hash #f (list maximized? w h))
(hash/c (or/c (listof (list/c any/c any/c any/c any/c))
#f)
(list/c boolean?
exact-nonnegative-integer?
exact-nonnegative-integer?)
#:immutable #t
#:flat? #t))
(when position-preferences-key
(preferences:set-default position-preferences-key
(list 0 0 0)
(list/c exact-nonnegative-integer?
exact-integer?
exact-integer?))))
(hash #f (list 0 0 0))
(hash/c (or/c (listof (list/c any/c any/c any/c any/c))
#f)
(list/c exact-nonnegative-integer?
exact-integer?
exact-integer?)
#:immutable #t
#:flat? #t))))
(define (compute-current-monitor-information)
(filter
values
(for/list ([m (in-range (get-display-count))])
(define-values (left top) (get-display-left-top-inset #:monitor m))
(define-values (width height) (get-display-size #:monitor m))
(and left top width height
(list left top width height)))))
(define latest-monitor-information (compute-current-monitor-information))
(define pending-monitor-information #f)
(define montior-information-timer
(new timer%
[notify-callback
(λ ()
(define new-monitor-information (compute-current-monitor-information))
(cond
[pending-monitor-information
(cond
[(equal? pending-monitor-information new-monitor-information)
(set! pending-monitor-information #f)
(set! latest-monitor-information new-monitor-information)
(queue-callback
(λ ()
(for ([frame (in-list (get-top-level-windows))])
(when (is-a? frame size-pref<%>)
(send frame monitor-setup-changed)))
#f))]
[else
(set! pending-monitor-information new-monitor-information)
(restart-montior-information-timer)])]
[else
(unless (equal? latest-monitor-information new-monitor-information)
(set! pending-monitor-information new-monitor-information)
(restart-montior-information-timer))]))]))
(define (restart-montior-information-timer)
(send montior-information-timer stop)
(send montior-information-timer start 250 #t))
(define register-group<%> (interface ()))
(define register-group-mixin

25
collects/scribblings/framework/frame.scrbl
View File

@ -191,7 +191,12 @@
}
@definterface[frame:size-pref<%> (frame:basic<%>)]{
@defmethod[(adjust-size-when-monitor-setup-changes?) boolean?]{
Determines if the frame's size should be automatically adjusted
when the monitors configuration changes.
Defaults to returning @racket[#f].
}
}
@defmixin[frame:size-pref-mixin (frame:basic<%>) (frame:size-pref<%>)]{
@defconstructor/auto-super[([size-preferences-key symbol?]
@ -209,6 +214,11 @@
@racket[preferences:get] and @racket[preferences:set] to track the current
position.
Both preferences are tracked on a per-monitor-configuration basis. That is,
the preference value saved is a mapping from the current monitor configuration
(derived from the results of @racket[get-display-count], @racket[get-display-left-top-inset],
and @racket[get-display-size]).
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.
@ -217,13 +227,22 @@
}
@defmethod*[#:mode override (((on-size (width number?) (height number?)) void?))]{
@defmethod[#:mode override (on-size (width (integer-in 0 10000))
(height (integer-in 0 10000)))
void?]{
Updates the preferences, according to the width and
height. The preferences key is the one passed
to the initialization argument of the class.
}
@defmethod[#:mode override (on-move (width (integer-in -10000 10000))
(height (integer-in -10000 10000)))
void?]{
Updates the preferences according to the width and
height, if @racket[position-preferences-key] is not @racket[#f], using
it as the preferences key.
}
}
@definterface[frame:register-group<%> ()]{
Frames that implement this interface are registered with the group. See
@racket[group:get-the-frame-group] and @racket[frame:register-group-mixin].