From d0ce0de3988f02c5b260aa663fac95134b877761 Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Fri, 16 Nov 2012 12:55:24 -0600 Subject: [PATCH] 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. --- collects/drracket/private/unit.rkt | 16 ++--- collects/framework/private/canvas.rkt | 6 +- collects/framework/private/frame.rkt | 75 +++++++++++++--------- collects/scribblings/framework/frame.scrbl | 9 ++- 4 files changed, 58 insertions(+), 48 deletions(-) diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt index 473c09465b..c2e884fa0a 100644 --- a/collects/drracket/private/unit.rkt +++ b/collects/drracket/private/unit.rkt @@ -1371,7 +1371,8 @@ module browser threading seems wrong. file-menu:get-save-item file-menu:get-save-as-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 (set! definitions-canvas (create-definitions-canvas)))) - (define/override (get-delegated-text) definitions-text) - ;; wire the definitions text to the interactions text and initialize it. (define/private (init-definitions-text tab) (let ([defs (send tab get-defs)] @@ -2919,8 +2918,7 @@ module browser threading seems wrong. (inherit begin-container-sequence end-container-sequence) (define/private (change-to-tab tab) (unless (eq? current-tab tab) - (let ([old-delegate (send definitions-text get-delegate)] - [old-tab current-tab]) + (let ([old-tab current-tab]) (save-visible-tab-regions) (set! current-tab tab) (set! definitions-text (send current-tab get-defs)) @@ -2936,9 +2934,9 @@ module browser threading seems wrong. (update-save-message) (update-save-button) (language-changed) + (set-delegated-text definitions-text) (send definitions-text update-frame-filename) - (send definitions-text set-delegate old-delegate) (update-running (send current-tab is-running?)) (on-tab-change old-tab current-tab) (send tab update-log) @@ -2960,12 +2958,6 @@ module browser threading seems wrong. (enable-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)) (define/public (next-tab) (change-to-delta-tab +1)) diff --git a/collects/framework/private/canvas.rkt b/collects/framework/private/canvas.rkt index 6a62b4f3ec..463821e0fd 100644 --- a/collects/framework/private/canvas.rkt +++ b/collects/framework/private/canvas.rkt @@ -32,9 +32,11 @@ (mixin (basic<%>) (delegate<%>) (inherit get-top-level-window) (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-instantiate ()))) + (super-new))) (define info<%> (interface (basic<%>))) ;; (basic<%> -> (class (is-a? (send this get-top-level-window) frame:info<%>))) diff --git a/collects/framework/private/frame.rkt b/collects/framework/private/frame.rkt index f5f11dd648..9ed3971e37 100644 --- a/collects/framework/private/frame.rkt +++ b/collects/framework/private/frame.rkt @@ -1566,11 +1566,12 @@ (define delegate<%> (interface (status-line<%> text<%>) - get-delegated-text delegated-text-shown? hide-delegated-text show-delegated-text - delegate-moved)) + delegate-moved + set-delegated-text + get-delegated-text)) (define delegatee-editor-canvas% (class (canvas:color-mixin canvas:basic%) @@ -1737,7 +1738,20 @@ (define delegate-mixin (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 super-root 'uninitialized-super-root] @@ -1764,23 +1778,26 @@ (inherit close-status-line open-status-line) (define/public (hide-delegated-text) (set! shown? #f) - (send (get-delegated-text) set-delegate #f) + (when delegated-text + (send delegated-text set-delegate #f)) (send super-root change-children (λ (l) (list rest-panel)))) (define/public (show-delegated-text) (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 (λ (l) (list rest-panel delegate-ec)))) (define/public (click-in-overview pos) (when shown? - (let* ([d-text (get-delegated-text)] - [d-canvas (send d-text get-canvas)] + (let* ([d-canvas (send delegated-text get-canvas)] [bx (box 0)] [by (box 0)]) (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 scroll-to (- (unbox bx) (/ cw 2)) @@ -1788,37 +1805,31 @@ cw ch #t) - (send d-text set-position pos))))) + (send delegated-text set-position pos))))) (define/public (delegate-moved) - (let ([startb (box 0)] - [endb (box 0)] - [delegate-text (get-delegated-text)]) - (send delegate-text get-visible-position-range startb endb #f) - (send delegatee set-start/end-para - (send delegate-text position-paragraph (unbox startb)) - (send delegate-text position-paragraph (unbox endb))))) - - (define/public (get-delegatee) delegatee) + (define delegatee (send delegate-ec get-editor)) + (when delegatee + (let ([startb (box 0)] + [endb (box 0)]) + (send delegated-text get-visible-position-range startb endb #f) + (send delegatee set-start/end-para + (send delegated-text position-paragraph (unbox startb)) + (send delegated-text position-paragraph (unbox endb)))))) + (define/public (get-delegatee) (send delegate-ec get-editor)) + (super-new) - (define delegatee (instantiate delegatee-text% ())) - (define delegate-ec (instantiate delegatee-editor-canvas% () - (editor delegatee) - (parent super-root) - (delegate-frame this) - (min-width 150) - (stretchable-width #f))) + (define delegate-ec (new delegatee-editor-canvas% + [parent super-root] + [delegate-frame this] + [min-width 150] + [stretchable-width #f])) (inherit get-editor) (if (preferences:get 'framework:show-delegate?) - (begin - (send (get-delegated-text) set-delegate delegatee) - (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))))))) + (show-delegated-text) + (hide-delegated-text)))) (define searchable<%> (interface (basic<%>) search diff --git a/collects/scribblings/framework/frame.scrbl b/collects/scribblings/framework/frame.scrbl index d3bc222edb..145fe41d4f 100644 --- a/collects/scribblings/framework/frame.scrbl +++ b/collects/scribblings/framework/frame.scrbl @@ -725,8 +725,13 @@ descriptions refers to the original editor and the term @bold{delegatee} refers to the editor showing the 20,000 feet overview. - @defmethod*[(((get-delegated-text) (is-a?/c text:delegate<%>)))]{ - Returns the delegate text. + @defmethod[(get-delegated-text) (or/c #f (is-a?/c text:delegate<%>))]{ + 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?))]{