From a66c735b825083458f77f27cb7eee829ca08ee5d Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Tue, 17 Jul 2012 12:24:19 -0500 Subject: [PATCH] removed the check syntax mode support --- .../drracket/private/syncheck/annotate.rkt | 8 +- collects/drracket/private/syncheck/gui.rkt | 122 ++---------------- collects/drracket/private/syncheck/intf.rkt | 2 +- .../drracket/private/syncheck/traversals.rkt | 12 +- 4 files changed, 20 insertions(+), 124 deletions(-) diff --git a/collects/drracket/private/syncheck/annotate.rkt b/collects/drracket/private/syncheck/annotate.rkt index c713fa83d7..2f4c2b0884 100644 --- a/collects/drracket/private/syncheck/annotate.rkt +++ b/collects/drracket/private/syncheck/annotate.rkt @@ -9,20 +9,20 @@ ;; color : syntax[original] str -> void ;; colors the syntax with style-name's style -(define (color stx style-name mode) +(define (color stx style-name) (let ([source (find-source-editor stx)]) (when (and (syntax-position stx) (syntax-span stx)) (let ([pos (- (syntax-position stx) 1)] [span (syntax-span stx)]) - (color-range source pos (+ pos span) style-name mode))))) + (color-range source pos (+ pos span) style-name))))) ;; color-range : text start finish style-name ;; colors a range in the text based on `style-name' -(define (color-range source start finish style-name mode) +(define (color-range source start finish style-name) (define defs (current-annotations)) (when defs - (send defs syncheck:color-range source start finish style-name mode))) + (send defs syncheck:color-range source start finish style-name))) ;; add-mouse-over : syntax[original] string -> void ;; registers the range in the editor so that a mouse over diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt index 5f691bd855..9b84c0e641 100644 --- a/collects/drracket/private/syncheck/gui.rkt +++ b/collects/drracket/private/syncheck/gui.rkt @@ -79,10 +79,6 @@ If the namespace does not, they are colored the unbound color. ;; be < 50ms) (define syncheck-arrow-delay 100) -(preferences:set-default 'drracket:syncheck-mode 'default-mode - (λ (x) (memq x '(default-mode - my-obligations-mode - client-obligations-mode)))) (let ([number-between-zero-and-one? (λ (x) (and (number? x) (<= 0 x 1)))]) (preferences:set-default @@ -354,7 +350,6 @@ If the namespace does not, they are colored the unbound color. ;; cleanup-texts : (or/c #f (listof text)) (define cleanup-texts #f) - (define style-mapping #f) ;; bindings-table : hash-table[(list text number number) -o> (listof (list text number number))] ;; this is a private field @@ -490,8 +485,7 @@ If the namespace does not, they are colored the unbound color. (set! tacked-hash-table (make-hasheq)) (set! arrow-records (make-hasheq)) (set! bindings-table (make-hash)) - (set! cleanup-texts '()) - (set! style-mapping (make-hash))) + (set! cleanup-texts '())) (define/public (syncheck:arrows-visible?) (or arrow-records cursor-pos cursor-text cursor-eles cursor-tooltip)) @@ -504,7 +498,6 @@ If the namespace does not, they are colored the unbound color. (when (update-latent-arrows #f #f) (update-drawn-arrows)) (syncheck:clear-coloring) - (set! style-mapping #f) (invalidate-bitmap-cache))) (define/public (syncheck:clear-coloring) @@ -514,19 +507,15 @@ If the namespace does not, they are colored the unbound color. (set! cleanup-texts #f)) ;; syncheck:apply-style/remember : (is-a?/c text%) number number style% symbol -> void - (define/public (syncheck:apply-style/remember txt start finish style mode) - (when (eq? mode syncheck-mode) - (add-to-cleanup/apply-style txt start finish style)) - (when cleanup-texts - (hash-set! style-mapping mode (cons (list txt start finish style) - (hash-ref style-mapping mode '()))))) + (define/public (syncheck:apply-style/remember txt start finish style) + (add-to-cleanup/apply-style txt start finish style)) - (define/public (syncheck:color-range source start finish style-name mode) + (define/public (syncheck:color-range source start finish style-name) (when (is-a? source text%) - (define (apply-style/remember ed start finish style mode) + (define (apply-style/remember ed start finish style) (let ([outermost (find-outermost-editor ed)]) (and (is-a? outermost syncheck-text<%>) - (send outermost syncheck:apply-style/remember ed start finish style mode)))) + (send outermost syncheck:apply-style/remember ed start finish style)))) (define (find-outermost-editor ed) (let loop ([ed ed]) @@ -540,7 +529,7 @@ If the namespace does not, they are colored the unbound color. (let ([style (send (send source get-style-list) find-named-style style-name)]) - (apply-style/remember source start finish style mode)))) + (apply-style/remember source start finish style)))) ;; add-to-cleanup/apply-style : (is-a?/c text%) number number style% symbol -> boolean (define/private (add-to-cleanup/apply-style txt start finish style) @@ -1390,47 +1379,6 @@ If the namespace does not, they are colored the unbound color. (when frame (send frame update-button-visibility/settings settings))) (inner (void) after-set-next-settings settings)) - - (define syncheck-mode 'default-mode) - (define/public (set-syncheck-mode m) - (let ([old-mode syncheck-mode]) - (set! syncheck-mode m) - (when style-mapping - (unless (eq? old-mode syncheck-mode) - (apply-syncheck-mode))))) - (define/public (get-syncheck-mode) (if style-mapping - syncheck-mode - #f)) - - (define/private (apply-syncheck-mode) - (let ([edit-sequences '()]) - - ;; we need to reset the colors in every editor we can find, not just those that have new colors - (for ([(k v) (in-hash style-mapping)]) - (for ((l (in-list v))) - (let-values ([(txt start finish style) (apply values l)]) - (unless (memq txt edit-sequences) - (send txt begin-edit-sequence #f) - - ;; this little dance resets the - ;; colors to their natural values - (begin - (cond - [(send txt is-frozen?) - (send txt thaw-colorer)] - [else - (send txt freeze-colorer) - (send txt thaw-colorer)]) - (send txt freeze-colorer)) - - (set! edit-sequences (cons txt edit-sequences)))))) - - (for ((l (in-list (reverse (hash-ref style-mapping syncheck-mode '()))))) - (let-values ([(txt start finish style) (apply values l)]) - (add-to-cleanup/apply-style txt start finish style))) - - (for ((txt (in-list edit-sequences))) - (send txt end-edit-sequence)))) (define/public (syncheck:find-source-object stx) (cond @@ -1497,8 +1445,7 @@ If the namespace does not, they are colored the unbound color. (when error-report-visible? (cond [(is-current-tab?) - (send (get-frame) hide-error-report) - (send (get-frame) update-menu-status this)] + (send (get-frame) hide-error-report)] [else (set! error-report-visible? #f)]))) @@ -1540,7 +1487,6 @@ If the namespace does not, they are colored the unbound color. (show-error-report) (hide-error-report)) (send report-error-canvas set-editor (send new-tab get-error-report-text)) - (update-menu-status new-tab) (update-button-visibility/tab new-tab)) (define/private (update-button-visibility/tab tab) @@ -1669,13 +1615,9 @@ If the namespace does not, they are colored the unbound color. (define/augment (enable-evaluation) (send check-syntax-button enable #t) - (send mode-menu-item1 enable #t) - (send mode-menu-item2 enable #t) (inner (void) enable-evaluation)) (define/augment (disable-evaluation) - (send mode-menu-item1 enable #f) - (send mode-menu-item2 enable #f) (send check-syntax-button enable #f) (inner (void) disable-evaluation)) @@ -1756,55 +1698,11 @@ If the namespace does not, they are colored the unbound color. (set! super-root s-root) (set! rest-panel r-root) r-root)) - - (define mode-menu-item1 #f) - (define mode-menu-item2 #f) - (define mode-menu-item3 #f) - - (define/override (add-show-menu-items show-menu) - (define (start-checking mode) - (let* ([tab (get-current-tab)] - [defs (send tab get-defs)]) - (preferences:set 'drracket:syncheck-mode mode) - (cond - [(send defs get-syncheck-mode) - (send defs set-syncheck-mode mode) - (update-menu-status tab)] - [else - (syncheck:button-callback #f mode)]))) - - (super add-show-menu-items show-menu) - (let ([p (new menu% - [parent show-menu] - [label cs-check-syntax-mode])]) - (set! mode-menu-item1 - (new checkable-menu-item% - [parent p] - [label cs-mode-menu-show-syntax] - [callback (λ (a b) (start-checking 'default-mode))])) - (set! mode-menu-item2 - (new checkable-menu-item% - [parent p] - [label cs-mode-menu-show-my-obligations] - [callback (λ (a b) (start-checking 'my-obligations-mode))])) - (set! mode-menu-item3 - (new checkable-menu-item% - [parent p] - [label cs-mode-menu-show-client-obligations] - [callback (λ (a b) (start-checking 'client-obligations-mode))])))) - - (define/public (update-menu-status tab) - (when mode-menu-item1 - (let ([mode (send (send (get-current-tab) get-defs) get-syncheck-mode)]) - (send mode-menu-item1 check (eq? mode 'default-mode)) - (send mode-menu-item2 check (eq? mode 'my-obligations-mode)) - (send mode-menu-item3 check (eq? mode 'client-obligations-mode))))) (inherit open-status-line close-status-line update-status-line ensure-rep-hidden) ;; syncheck:button-callback : (case-> (-> void) ((union #f syntax) -> void) ;; this is the only function that has any code running on the user's thread - (define/public (syncheck:button-callback [jump-to-id #f] - [mode (preferences:get 'drracket:syncheck-mode)]) + (define/public (syncheck:button-callback [jump-to-id #f]) (when (send check-syntax-button is-enabled?) (open-status-line 'drracket:check-syntax:status) (update-status-line 'drracket:check-syntax:status status-init) @@ -1952,8 +1850,6 @@ If the namespace does not, they are colored the unbound color. (λ () (parameterize ([current-annotations definitions-text]) (expansion-completed)) - (send (send (get-current-tab) get-defs) set-syncheck-mode mode) - (update-menu-status (get-current-tab)) (send definitions-text syncheck:sort-bindings-table))) (cleanup) (custodian-shutdown-all user-custodian))))] diff --git a/collects/drracket/private/syncheck/intf.rkt b/collects/drracket/private/syncheck/intf.rkt index f544cc87ca..b36efa68cf 100644 --- a/collects/drracket/private/syncheck/intf.rkt +++ b/collects/drracket/private/syncheck/intf.rkt @@ -45,7 +45,7 @@ (define/public (syncheck:add-tail-arrow from-text from-pos to-text to-pos) (void)) (define/public (syncheck:add-mouse-over-status text pos-left pos-right str) (void)) (define/public (syncheck:add-jump-to-definition text start end id filename) (void)) - (define/public (syncheck:color-range source start finish style-name mode) (void)) + (define/public (syncheck:color-range source start finish style-name) (void)) (super-new))) (provide syncheck-text<%> diff --git a/collects/drracket/private/syncheck/traversals.rkt b/collects/drracket/private/syncheck/traversals.rkt index aca0f2eba2..5dc0d1b50b 100644 --- a/collects/drracket/private/syncheck/traversals.rkt +++ b/collects/drracket/private/syncheck/traversals.rkt @@ -544,7 +544,7 @@ (define fin (+ start span)) (send defs-text syncheck:add-background-color source-editor start fin "firebrick"))) - (color stx unused-require-style-name 'default-mode))) + (color stx unused-require-style-name))) (hash-ref requires k (λ () (error 'syncheck/traversals.rkt "requires doesn't have a mapping for ~s" k))))))) @@ -667,10 +667,10 @@ #t)))]) (cond [top-bound? - (color var lexically-bound-variable-style-name 'default-mode)] + (color var lexically-bound-variable-style-name)] [else (add-mouse-over var (format "~s is a free variable" (syntax-e var))) - (color var free-variable-style-name 'default-mode)]) + (color var free-variable-style-name)]) (connect-identifier var binders #f #f 0 user-namespace user-directory #t))) ;; color-variable : syntax phase-level identifier-mapping -> void @@ -686,9 +686,9 @@ (cond [(get-ids varsets var) (add-mouse-over var (string-constant cs-set!d-variable)) - (color var set!d-variable-style-name 'default-mode)] - [lexical? (color var lexically-bound-variable-style-name 'default-mode)] - [(pair? b) (color var imported-variable-style-name 'default-mode)]))) + (color var set!d-variable-style-name)] + [lexical? (color var lexically-bound-variable-style-name)] + [(pair? b) (color var imported-variable-style-name)]))) ;; add-var : hash-table -> syntax -> void ;; adds the variable to the hash table.