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

change the way that the delegate text is specified, using

Browse Source 
getter/setters instead of overriding a method

this has the benefit that the delegate does not have to be
rebuilt when switching tabs in drracket; we just leave the
old delegate on the old definitions text, and the swap it
back into the editor-canvas when we swap the text% object
itself back in.

original commit: d0ce0de3988f02c5b260aa663fac95134b877761
This commit is contained in:
Robby Findler 2012-11-16 12:55:24 -06:00
parent 1a5c4047dc
commit 80950cd990
3 changed files with 54 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/framework/private/canvas.rkt
View File

@ -32,9 +32,11 @@
(mixin (basic<%>) (delegate<%>) (mixin (basic<%>) (delegate<%>)
(inherit get-top-level-window) (inherit get-top-level-window)
(define/override (on-superwindow-show shown?) (define/override (on-superwindow-show shown?)
(send (send (get-top-level-window) get-delegatee) set-start/end-para #f #f) (define delegatee (send (get-top-level-window) get-delegatee))
(when delegatee
(send delegatee set-start/end-para #f #f))
(super on-superwindow-show shown?)) (super on-superwindow-show shown?))
(super-instantiate ()))) (super-new)))
(define info<%> (interface (basic<%>))) (define info<%> (interface (basic<%>)))
;; (basic<%> -> (class (is-a? (send this get-top-level-window) frame:info<%>))) ;; (basic<%> -> (class (is-a? (send this get-top-level-window) frame:info<%>)))

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

@ -1566,11 +1566,12 @@
(define delegate<%> (define delegate<%>
(interface (status-line<%> text<%>) (interface (status-line<%> text<%>)
get-delegated-text
delegated-text-shown? delegated-text-shown?
hide-delegated-text hide-delegated-text
show-delegated-text show-delegated-text
delegate-moved)) delegate-moved
set-delegated-text
get-delegated-text))
(define delegatee-editor-canvas% (define delegatee-editor-canvas%
(class (canvas:color-mixin canvas:basic%) (class (canvas:color-mixin canvas:basic%)
@ -1737,7 +1738,20 @@
(define delegate-mixin (define delegate-mixin
(mixin (status-line<%> text<%>) (delegate<%>) (mixin (status-line<%> text<%>) (delegate<%>)
(define/public (get-delegated-text) (get-editor)) (define delegated-text #f)
(define/public-final (get-delegated-text) delegated-text)
(define/public-final (set-delegated-text t)
(unless (or (not t) (is-a? t text:delegate<%>))
(error 'set-delegated-text
"expected either #f or a text:delegate<%> object, got ~e"
t))
(unless (eq? delegated-text t)
(set! delegated-text t)
(when shown?
(unless (send (get-delegated-text) get-delegate)
(send (get-delegated-text) set-delegate
(new delegatee-text%)))
(send delegate-ec set-editor (send (get-delegated-text) get-delegate)))))
[define rest-panel 'uninitialized-root] [define rest-panel 'uninitialized-root]
[define super-root 'uninitialized-super-root] [define super-root 'uninitialized-super-root]
@ -1764,23 +1778,26 @@
(inherit close-status-line open-status-line) (inherit close-status-line open-status-line)
(define/public (hide-delegated-text) (define/public (hide-delegated-text)
(set! shown? #f) (set! shown? #f)
(send (get-delegated-text) set-delegate #f) (when delegated-text
(send delegated-text set-delegate #f))
(send super-root change-children (send super-root change-children
(λ (l) (list rest-panel)))) (λ (l) (list rest-panel))))
(define/public (show-delegated-text) (define/public (show-delegated-text)
(set! shown? #t) (set! shown? #t)
(send (get-delegated-text) set-delegate delegatee) (when delegated-text
(unless (send delegated-text get-delegate)
(send delegated-text set-delegate
(new delegatee-text%))))
(send super-root change-children (send super-root change-children
(λ (l) (list rest-panel delegate-ec)))) (λ (l) (list rest-panel delegate-ec))))
(define/public (click-in-overview pos) (define/public (click-in-overview pos)
(when shown? (when shown?
(let* ([d-text (get-delegated-text)] (let* ([d-canvas (send delegated-text get-canvas)]
[d-canvas (send d-text get-canvas)]
[bx (box 0)] [bx (box 0)]
[by (box 0)]) [by (box 0)])
(let-values ([(cw ch) (send d-canvas get-client-size)]) (let-values ([(cw ch) (send d-canvas get-client-size)])
(send d-text position-location pos bx by) (send delegated-text position-location pos bx by)
(send d-canvas focus) (send d-canvas focus)
(send d-canvas scroll-to (send d-canvas scroll-to
(- (unbox bx) (/ cw 2)) (- (unbox bx) (/ cw 2))
@ -1788,37 +1805,31 @@
cw cw
ch ch
#t) #t)
(send d-text set-position pos))))) (send delegated-text set-position pos)))))
(define/public (delegate-moved) (define/public (delegate-moved)
(let ([startb (box 0)] (define delegatee (send delegate-ec get-editor))
[endb (box 0)] (when delegatee
[delegate-text (get-delegated-text)]) (let ([startb (box 0)]
(send delegate-text get-visible-position-range startb endb #f) [endb (box 0)])
(send delegatee set-start/end-para (send delegated-text get-visible-position-range startb endb #f)
(send delegate-text position-paragraph (unbox startb)) (send delegatee set-start/end-para
(send delegate-text position-paragraph (unbox endb))))) (send delegated-text position-paragraph (unbox startb))
(send delegated-text position-paragraph (unbox endb))))))
(define/public (get-delegatee) delegatee)
(define/public (get-delegatee) (send delegate-ec get-editor))
(super-new) (super-new)
(define delegatee (instantiate delegatee-text% ())) (define delegate-ec (new delegatee-editor-canvas%
(define delegate-ec (instantiate delegatee-editor-canvas% () [parent super-root]
(editor delegatee) [delegate-frame this]
(parent super-root) [min-width 150]
(delegate-frame this) [stretchable-width #f]))
(min-width 150)
(stretchable-width #f)))
(inherit get-editor) (inherit get-editor)
(if (preferences:get 'framework:show-delegate?) (if (preferences:get 'framework:show-delegate?)
(begin (show-delegated-text)
(send (get-delegated-text) set-delegate delegatee) (hide-delegated-text))))
(send super-root change-children
(λ (l) (list rest-panel delegate-ec))))
(begin
(send (get-delegated-text) set-delegate #f)
(send super-root change-children (λ (l) (list rest-panel)))))))
(define searchable<%> (interface (basic<%>) (define searchable<%> (interface (basic<%>)
search search

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

@ -725,8 +725,13 @@
descriptions refers to the original editor and the term @bold{delegatee} descriptions refers to the original editor and the term @bold{delegatee}
refers to the editor showing the 20,000 feet overview. refers to the editor showing the 20,000 feet overview.
@defmethod*[(((get-delegated-text) (is-a?/c text:delegate<%>)))]{ @defmethod[(get-delegated-text) (or/c #f (is-a?/c text:delegate<%>))]{
Returns the delegate text. Returns the current delegate text, if any.
}
@defmethod[(set-delegated-text [d (or/c #f (is-a?/c text:delegate<%>))])
void?]{
Sets the delegate text to @racket[d].
} }
@defmethod*[(((delegated-text-shown?) boolean?))]{ @defmethod*[(((delegated-text-shown?) boolean?))]{