broke up check syntax into multiple files

collects/drracket/private/syncheck/colors.rkt

@@ -0,0 +1,81 @@
+#lang racket/base
+(require string-constants/string-constant
+         framework
+         racket/class
+         racket/gui/base)
+(provide (all-defined-out))
+
+(define cs-my-obligation-color "my obligations")
+(define cs-their-obligation-color "my assumptions")
+(define cs-unk-obligation-color "unknown obligations")
+
+
+    (define lexically-bound-variable-style-pref 'drracket:check-syntax:lexically-bound)
+    (define imported-variable-style-pref 'drracket:check-syntax:imported)
+    (define set!d-variable-style-pref 'drracket:check-syntax:set!d)
+    
+    (define lexically-bound-variable-style-name (symbol->string lexically-bound-variable-style-pref))
+    (define imported-variable-style-name (symbol->string imported-variable-style-pref))
+    (define set!d-variable-style-name (symbol->string set!d-variable-style-pref))
+
+    (define my-obligation-style-pref 'drracket:check-syntax:my-obligation-style-pref)
+    (define their-obligation-style-pref 'drracket:check-syntax:their-obligation-style-pref)
+    (define unk-obligation-style-pref 'drracket:check-syntax:unk-obligation-style-pref)
+    (define my-obligation-style-name (symbol->string my-obligation-style-pref))
+    (define their-obligation-style-name (symbol->string their-obligation-style-pref))
+    (define unk-obligation-style-name (symbol->string unk-obligation-style-pref))
+    
+    (define error-style-name (scheme:short-sym->style-name 'error))
+    ;(define constant-style-name (scheme:short-sym->style-name 'constant))
+    
+    (define (syncheck-add-to-preferences-panel parent)
+      (color-prefs:build-color-selection-panel parent
+                                                  lexically-bound-variable-style-pref
+                                                  lexically-bound-variable-style-name
+                                                  (string-constant cs-lexical-variable))
+      (color-prefs:build-color-selection-panel parent
+                                                  imported-variable-style-pref
+                                                  imported-variable-style-name
+                                                  (string-constant cs-imported-variable))
+      (color-prefs:build-color-selection-panel parent
+                                                  set!d-variable-style-pref
+                                                  set!d-variable-style-name
+                                                  (string-constant cs-set!d-variable))
+      (color-prefs:build-color-selection-panel parent
+                                                  my-obligation-style-pref
+                                                  my-obligation-style-name
+                                                  cs-my-obligation-color)
+      (color-prefs:build-color-selection-panel parent
+                                                  their-obligation-style-pref
+                                                  their-obligation-style-name
+                                                  cs-their-obligation-color)
+      (color-prefs:build-color-selection-panel parent
+                                                  unk-obligation-style-pref
+                                                  unk-obligation-style-name
+                                                  cs-unk-obligation-color))
+    
+    (color-prefs:register-color-preference lexically-bound-variable-style-pref
+                                              lexically-bound-variable-style-name
+                                              (make-object color% 81 112 203)
+                                              (make-object color% 50 163 255))
+    (color-prefs:register-color-preference set!d-variable-style-pref
+                                              set!d-variable-style-name
+                                              (send the-color-database find-color "firebrick")
+                                              (send the-color-database find-color "pink"))
+    (color-prefs:register-color-preference imported-variable-style-pref
+                                              imported-variable-style-name
+                                              (make-object color% 68 0 203)
+                                              (make-object color% 166 0 255))
+    (color-prefs:register-color-preference my-obligation-style-pref
+                                              my-obligation-style-name
+                                              (send the-color-database find-color "firebrick")
+                                              (send the-color-database find-color "pink"))
+    (color-prefs:register-color-preference their-obligation-style-pref
+                                              their-obligation-style-name
+                                              (make-object color% 0 116 0)
+                                              (send the-color-database find-color "limegreen"))
+    (color-prefs:register-color-preference unk-obligation-style-pref
+                                              unk-obligation-style-name
+                                              (make-object color% 139 142 28)
+                                              (send the-color-database find-color "khaki"))
+    

collects/drracket/private/syncheck/intf.rkt

@@ -0,0 +1,104 @@
+#lang racket/base
+(require racket/class
+         racket/promise
+         setup/xref
+         scribble/xref)
+
+(define-local-member-name
+  syncheck:init-arrows
+  syncheck:clear-arrows
+  syncheck:add-menu
+  syncheck:add-arrow
+  syncheck:add-tail-arrow
+  syncheck:add-mouse-over-status
+  syncheck:add-jump-to-definition
+  syncheck:sort-bindings-table
+  syncheck:jump-to-next-bound-occurrence
+  syncheck:jump-to-binding-occurrence
+  syncheck:jump-to-definition
+  
+  syncheck:clear-highlighting
+  syncheck:apply-style/remember
+  ;syncheck:error-report-visible? ;; test suite uses this one.
+  ;syncheck:get-bindings-table    ;; test suite uses this one.
+  syncheck:clear-error-message
+  
+  hide-error-report
+  get-error-report-text
+  get-error-report-visible?
+  
+  turn-off-error-report
+  turn-on-error-report
+  
+  update-button-visibility/settings
+  
+  set-syncheck-mode
+  get-syncheck-mode
+  update-menu-item-label)
+
+(define syncheck-text<%>
+  (interface ()
+    syncheck:init-arrows
+    syncheck:clear-arrows
+    syncheck:add-menu
+    syncheck:add-arrow
+    syncheck:add-tail-arrow
+    syncheck:add-mouse-over-status
+    syncheck:add-jump-to-definition
+    syncheck:sort-bindings-table
+    syncheck:get-bindings-table
+    syncheck:jump-to-next-bound-occurrence
+    syncheck:jump-to-binding-occurrence
+    syncheck:jump-to-definition))
+
+;; use this to communicate the frame being
+;; syntax checked w/out having to add new
+;; parameters to all of the functions
+(define currently-processing-definitions-text (make-parameter #f))
+
+(define xref (if (getenv "PLTDRXREFDELAY")
+                 (begin
+                   (printf "PLTDRXREFDELAY: using plain delay\n")
+                   (delay (begin
+                            (printf "PLTDRXREFDELAY: loading xref\n")
+                            (begin0
+                              (load-collections-xref)
+                              (printf "PLTDRXREFDELAY: loaded xref\n")))))
+                 (delay/idle (load-collections-xref))))
+(define (get-xref) (force xref))
+
+(provide syncheck-text<%>
+         currently-processing-definitions-text
+         get-xref
+         
+         ;; methods
+         syncheck:init-arrows
+         syncheck:clear-arrows
+         syncheck:add-menu
+         syncheck:add-arrow
+         syncheck:add-tail-arrow
+         syncheck:add-mouse-over-status
+         syncheck:add-jump-to-definition
+         syncheck:sort-bindings-table
+         syncheck:jump-to-next-bound-occurrence
+         syncheck:jump-to-binding-occurrence
+         syncheck:jump-to-definition
+         
+         syncheck:clear-highlighting
+         syncheck:apply-style/remember
+         ;syncheck:error-report-visible? ;; test suite uses this one.
+         ;syncheck:get-bindings-table    ;; test suite uses this one.
+         syncheck:clear-error-message
+         
+         hide-error-report
+         get-error-report-text
+         get-error-report-visible?
+         
+         turn-off-error-report
+         turn-on-error-report
+         
+         update-button-visibility/settings
+         
+         set-syncheck-mode
+         get-syncheck-mode
+         update-menu-item-label)