change the way that the delegate text is specified, using
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.
This commit is contained in:
parent
899ce93d07
commit
d0ce0de398
|
@ -1371,7 +1371,8 @@ module browser threading seems wrong.
|
||||||
file-menu:get-save-item
|
file-menu:get-save-item
|
||||||
file-menu:get-save-as-item
|
file-menu:get-save-as-item
|
||||||
file-menu:get-revert-item
|
file-menu:get-revert-item
|
||||||
file-menu:get-print-item)
|
file-menu:get-print-item
|
||||||
|
set-delegated-text)
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;;
|
;;
|
||||||
|
@ -2854,8 +2855,6 @@ module browser threading seems wrong.
|
||||||
(unless definitions-canvas
|
(unless definitions-canvas
|
||||||
(set! definitions-canvas (create-definitions-canvas))))
|
(set! definitions-canvas (create-definitions-canvas))))
|
||||||
|
|
||||||
(define/override (get-delegated-text) definitions-text)
|
|
||||||
|
|
||||||
;; wire the definitions text to the interactions text and initialize it.
|
;; wire the definitions text to the interactions text and initialize it.
|
||||||
(define/private (init-definitions-text tab)
|
(define/private (init-definitions-text tab)
|
||||||
(let ([defs (send tab get-defs)]
|
(let ([defs (send tab get-defs)]
|
||||||
|
@ -2919,8 +2918,7 @@ module browser threading seems wrong.
|
||||||
(inherit begin-container-sequence end-container-sequence)
|
(inherit begin-container-sequence end-container-sequence)
|
||||||
(define/private (change-to-tab tab)
|
(define/private (change-to-tab tab)
|
||||||
(unless (eq? current-tab tab)
|
(unless (eq? current-tab tab)
|
||||||
(let ([old-delegate (send definitions-text get-delegate)]
|
(let ([old-tab current-tab])
|
||||||
[old-tab current-tab])
|
|
||||||
(save-visible-tab-regions)
|
(save-visible-tab-regions)
|
||||||
(set! current-tab tab)
|
(set! current-tab tab)
|
||||||
(set! definitions-text (send current-tab get-defs))
|
(set! definitions-text (send current-tab get-defs))
|
||||||
|
@ -2936,9 +2934,9 @@ module browser threading seems wrong.
|
||||||
(update-save-message)
|
(update-save-message)
|
||||||
(update-save-button)
|
(update-save-button)
|
||||||
(language-changed)
|
(language-changed)
|
||||||
|
(set-delegated-text definitions-text)
|
||||||
|
|
||||||
(send definitions-text update-frame-filename)
|
(send definitions-text update-frame-filename)
|
||||||
(send definitions-text set-delegate old-delegate)
|
|
||||||
(update-running (send current-tab is-running?))
|
(update-running (send current-tab is-running?))
|
||||||
(on-tab-change old-tab current-tab)
|
(on-tab-change old-tab current-tab)
|
||||||
(send tab update-log)
|
(send tab update-log)
|
||||||
|
@ -2960,12 +2958,6 @@ module browser threading seems wrong.
|
||||||
(enable-evaluation)
|
(enable-evaluation)
|
||||||
(disable-evaluation))))
|
(disable-evaluation))))
|
||||||
|
|
||||||
(let ([from-defs (send from-tab get-defs)]
|
|
||||||
[to-defs (send to-tab get-defs)])
|
|
||||||
(let ([delegate (send from-defs get-delegate)])
|
|
||||||
(send from-defs set-delegate #f)
|
|
||||||
(send to-defs set-delegate delegate)))
|
|
||||||
|
|
||||||
(inner (void) on-tab-change from-tab to-tab))
|
(inner (void) on-tab-change from-tab to-tab))
|
||||||
|
|
||||||
(define/public (next-tab) (change-to-delta-tab +1))
|
(define/public (next-tab) (change-to-delta-tab +1))
|
||||||
|
|
|
@ -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<%>)))
|
||||||
|
|
|
@ -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
|
||||||
|
|
|
@ -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?))]{
|
||||||
|
|
Loading…
Reference in New Issue
Block a user