From 1ed2c7c417f6b7d8adcc07b1136fd0a729251b9f Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sat, 2 Oct 2010 09:31:33 -0500
Subject: [PATCH] closes PR 11277

---
 collects/drracket/private/syncheck/gui.rkt | 101 +++++++++++++++------
 collects/drracket/private/unit.rkt         |   6 +-
 2 files changed, 75 insertions(+), 32 deletions(-)

diff --git a/collects/drracket/private/syncheck/gui.rkt b/collects/drracket/private/syncheck/gui.rkt
index 922b6e27a7..721f0de265 100644
--- a/collects/drracket/private/syncheck/gui.rkt
+++ b/collects/drracket/private/syncheck/gui.rkt
@@ -137,35 +137,78 @@ If the namespace does not, they are colored the unbound color.
     ;; adds a begin/end-edit-sequence to the insertion and deletion
     ;;  to ensure that the on-change method isn't called until after
     ;;  the arrows are cleared.
-    (define clearing-text-mixin
-      (mixin ((class->interface text%)) ()
-        
-        (inherit begin-edit-sequence end-edit-sequence)
-        (define/augment (on-delete start len)
-          (begin-edit-sequence)
-          (inner (void) on-delete start len))
-        (define/augment (after-delete start len)
-          (inner (void) after-delete start len)
-          (clean-up)
-          (end-edit-sequence))
-        
-        (define/augment (on-insert start len)
-          (begin-edit-sequence)
-          (inner (void) on-insert start len))
-        (define/augment (after-insert start len)
-          (inner (void) after-insert start len)
-          (clean-up)
-          (end-edit-sequence))
-        
-        (define/private (clean-up)
-          (let ([st (find-syncheck-text this)])
-            (when (and st
-                       (is-a? st drracket:unit:definitions-text<%>))
-              (let ([tab (send st get-tab)])
-                (send tab syncheck:clear-error-message)
-                (send tab syncheck:clear-highlighting)))))
-        
-        (super-new)))
+    (define (clearing-text-mixin super%)
+      (define-local-member-name set-do-cleanup)
+      
+      (define cs-clearing<%>
+        (interface ()
+          set-do-cleanup))
+      
+      ;; the commented out definition of extra
+      ;; is because of PR 11279. When it is fixed, use it
+      ;; instead of this one.
+      (define (extra super%)
+        (class super%
+          (inherit set-do-cleanup)
+          (define/augment (begin-metadata-changes)
+            (set-do-cleanup #f)
+            (inner (void) begin-metadata-changes))
+          (define/augment (end-metadata-changes)
+            (set-do-cleanup #t)
+            (inner (void) end-metadata-changes))
+          (super-new)))
+      
+      #;
+      (define extra
+        (mixin (cs-clearing<%> drracket:unit:definitions-text<%>) ()
+          (inherit set-do-cleanup)
+          (define/augment (begin-metadata-changes)
+            (set-do-cleanup #f)
+            (inner (void) begin-metadata-changes))
+          (define/augment (end-metadata-changes)
+            (set-do-cleanup #t)
+            (inner (void) end-metadata-changes))
+          (super-new)))
+
+      (define basic
+        (mixin ((class->interface text%)) (cs-clearing<%>)
+          (inherit begin-edit-sequence end-edit-sequence)
+          (define/augment (on-delete start len)
+            (begin-edit-sequence)
+            (inner (void) on-delete start len))
+          (define/augment (after-delete start len)
+            (inner (void) after-delete start len)
+            (clean-up)
+            (end-edit-sequence))
+          
+          (define/augment (on-insert start len)
+            (begin-edit-sequence)
+            (inner (void) on-insert start len))
+          (define/augment (after-insert start len)
+            (inner (void) after-insert start len)
+            (clean-up)
+            (end-edit-sequence))
+          
+          (define do-cleanup #t)
+          (define/public (set-do-cleanup s)
+            (set! do-cleanup s))
+          
+          (define/private (clean-up)
+            (when do-cleanup
+              (let ([st (find-syncheck-text this)])
+                (when (and st
+                           (is-a? st drracket:unit:definitions-text<%>))
+                  (let ([tab (send st get-tab)])
+                    (send tab syncheck:clear-error-message)
+                    (send tab syncheck:clear-highlighting))))))
+          
+          (super-new)))
+      
+      (cond
+        [(implementation? super% drracket:unit:definitions-text<%>)
+         (extra (basic super%))]
+        [else
+         (basic super%)]))
     
     (define make-syncheck-text%
       (λ (super%)
diff --git a/collects/drracket/private/unit.rkt b/collects/drracket/private/unit.rkt
index 915ceaf537..0889f2f6b2 100644
--- a/collects/drracket/private/unit.rkt
+++ b/collects/drracket/private/unit.rkt
@@ -540,7 +540,6 @@ module browser threading seems wrong.
     (define (make-definitions-text%)
       (let ([definitions-super%
               (linked-scroller
-              ((get-program-editor-mixin)
                (text:first-line-mixin
                 (drracket:module-language:module-language-put-file-mixin
                  (scheme:text-mixin
@@ -552,7 +551,8 @@ module browser threading seems wrong.
                        (drracket:rep:drs-autocomplete-mixin
                         (λ (x) x)
                         (text:normalize-paste-mixin
-                         text:info%))))))))))))])
+                         text:info%)))))))))))])
+        ((get-program-editor-mixin)
         (class* definitions-super% (definitions-text<%>)
           (inherit get-top-level-window is-locked? lock while-unlocked highlight-first-line)
           
@@ -910,7 +910,7 @@ module browser threading seems wrong.
            (is-a? (drracket:language-configuration:language-settings-language next-settings)
                   drracket:module-language:module-language<%>))
           (inherit set-max-undo-history)
-          (set-max-undo-history 'forever))))
+          (set-max-undo-history 'forever)))))
     
     ;; is-lang-line? : string -> boolean
     ;; given the first line in the editor, this returns #t if it is a #lang line.