suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

color assigned variables in red

Browse Source 
svn: r15873
This commit is contained in:
Robby Findler 2009-09-04 06:35:07 +00:00
parent 5c94d7fe25
commit 40222e5daa
2 changed files with 73 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

120
collects/drscheme/syncheck.ss
View File

@ -1355,9 +1355,11 @@ If the namespace does not, they are colored the unbound color.
(define lexically-bound-variable-style-pref 'drscheme:check-syntax:lexically-bound)
(define imported-variable-style-pref 'drscheme:check-syntax:imported)
(define set!d-variable-style-pref 'drscheme: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 error-style-name (fw:scheme:short-sym->style-name 'error))
;(define constant-style-name (fw:scheme:short-sym->style-name 'constant))
@ -1370,12 +1372,20 @@ If the namespace does not, they are colored the unbound color.
(fw:color-prefs:build-color-selection-panel parent
imported-variable-style-pref
imported-variable-style-name
(string-constant cs-imported-variable)))
(string-constant cs-imported-variable))
(fw:color-prefs:build-color-selection-panel parent
set!d-variable-style-pref
set!d-variable-style-name
(string-constant cs-set!d-variable)))
(fw: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))
(fw: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"))
(fw:color-prefs:register-color-preference imported-variable-style-pref
imported-variable-style-name
(make-object color% 68 0 203)
@ -1415,6 +1425,8 @@ If the namespace does not, they are colored the unbound color.
[tl-high-binders (make-id-set)]
[tl-low-varrefs (make-id-set)]
[tl-high-varrefs (make-id-set)]
[tl-low-varsets (make-id-set)]
[tl-high-varsets (make-id-set)]
[tl-low-tops (make-id-set)]
[tl-high-tops (make-id-set)]
[tl-templrefs (make-id-set)]
@ -1434,6 +1446,8 @@ If the namespace does not, they are colored the unbound color.
[high-binders (make-id-set)]
[varrefs (make-id-set)]
[high-varrefs (make-id-set)]
[varsets (make-id-set)]
[high-varsets (make-id-set)]
[low-tops (make-id-set)]
[high-tops (make-id-set)]
[templrefs (make-id-set)]
@ -1443,7 +1457,10 @@ If the namespace does not, they are colored the unbound color.
[require-for-labels (make-hash)])
(annotate-basic sexp
user-namespace user-directory jump-to-id
low-binders high-binders varrefs high-varrefs low-tops high-tops
low-binders high-binders
varrefs high-varrefs
varsets high-varsets
low-tops high-tops
templrefs
requires require-for-syntaxes require-for-templates require-for-labels)
(annotate-variables user-namespace
@ -1452,6 +1469,8 @@ If the namespace does not, they are colored the unbound color.
high-binders
varrefs
high-varrefs
varsets
high-varsets
low-tops
high-tops
templrefs
@ -1463,7 +1482,8 @@ If the namespace does not, they are colored the unbound color.
(annotate-basic sexp
user-namespace user-directory jump-to-id
tl-low-binders tl-high-binders
tl-low-varrefs tl-high-varrefs
tl-low-varrefs tl-high-varrefs
tl-low-varsets tl-high-varsets
tl-low-tops tl-high-tops
tl-templrefs
tl-requires
@ -1479,6 +1499,8 @@ If the namespace does not, they are colored the unbound color.
tl-high-binders
tl-low-varrefs
tl-high-varrefs
tl-low-varsets
tl-high-varsets
tl-low-tops
tl-high-tops
tl-templrefs
@ -1496,13 +1518,14 @@ If the namespace does not, they are colored the unbound color.
;; namespace
;; string[directory]
;; syntax[id]
;; id-set (six of them)
;; id-set (8 of them)
;; hash-table[require-spec -> syntax] (three of them)
;; -> void
(define (annotate-basic sexp
user-namespace user-directory jump-to-id
low-binders high-binders
low-varrefs high-varrefs
low-varsets high-varsets
low-tops high-tops
templrefs
requires require-for-syntaxes require-for-templates require-for-labels)
@ -1524,6 +1547,7 @@ If the namespace does not, they are colored the unbound color.
(let* ([loop (λ (sexp) (level-loop sexp high-level?))]
[varrefs (if high-level? high-varrefs low-varrefs)]
[varsets (if high-level? high-varsets low-varsets)]
[binders (if high-level? high-binders low-binders)]
[tops (if high-level? high-tops low-tops)]
[collect-general-info
@ -1611,6 +1635,7 @@ If the namespace does not, they are colored the unbound color.
;; tops are used here because a binding free use of a set!'d variable
;; is treated just the same as (#%top . x).
(when (syntax-original? (syntax var))
(add-id varsets (syntax var))
(if (identifier-binding (syntax var) 0)
(add-id varrefs (syntax var))
(add-id tops (syntax var))))
@ -1811,6 +1836,8 @@ If the namespace does not, they are colored the unbound color.
high-binders
low-varrefs
high-varrefs
low-varsets
high-varsets
low-tops
high-tops
templrefs
@ -1852,47 +1879,44 @@ If the namespace does not, they are colored the unbound color.
(hash-for-each require-for-labels
(lambda (k v) (hash-set! unused-require-for-labels k #t)))
(for-each (λ (vars)
(for-each (λ (var)
(when (syntax-original? var)
(color-variable var 0)
(document-variable var 0)
(record-renamable-var rename-ht var)))
vars))
(append (get-idss high-binders)
(get-idss low-binders)))
(let ([handle-var-bind
(λ (var varsets)
(when (syntax-original? var)
(color-variable var 0 varsets)
(document-variable var 0)
(record-renamable-var rename-ht var)))])
(for-each (λ (vars)
(for-each (λ (var) (handle-var-bind var high-varsets))
vars))
(get-idss high-binders))
(for-each (λ (vars)
(for-each (λ (var) (handle-var-bind var low-varsets))
vars))
(get-idss low-binders)))
(for-each (λ (vars) (for-each
(λ (var)
(color-variable var 0)
(document-variable var 0)
(connect-identifier var
rename-ht
low-binders
unused/phases
requires/phases
0
user-namespace
user-directory
#t))
vars))
(get-idss low-varrefs))
(for-each (λ (vars) (for-each
(λ (var)
(color-variable var 1)
(document-variable var 1)
(connect-identifier var
rename-ht
high-binders
unused/phases
requires/phases
1
user-namespace
user-directory
#t))
vars))
(get-idss high-varrefs))
(let ([handle-var-ref
(λ (var index binders varsets)
(color-variable var index varsets)
(document-variable var index)
(connect-identifier var
rename-ht
binders
unused/phases
requires/phases
index
user-namespace
user-directory
#t))])
(for-each (λ (vars) (for-each
(λ (var) (handle-var-ref var 0 low-binders low-varsets))
vars))
(get-idss low-varrefs))
(for-each (λ (vars) (for-each
(λ (var) (handle-var-ref var 1 high-binders high-varsets))
vars))
(get-idss high-varrefs)))
(for-each (lambda (vars) (for-each
(lambda (var)
@ -2115,8 +2139,8 @@ If the namespace does not, they are colored the unbound color.
(color var error-style-name))
(connect-identifier var rename-ht binders #f #f 0 user-namespace user-directory #t)))
;; color-variable : syntax phase-level -> void
(define (color-variable var phase-level)
;; color-variable : syntax phase-level module-identifier-mapping -> void
(define (color-variable var phase-level varsets)
(let* ([b (identifier-binding var phase-level)]
[lexical?
(or (not b)
@ -2128,6 +2152,8 @@ If the namespace does not, they are colored the unbound color.
(and (not a)
(not b)))))))])
(cond
[(module-identifier-mapping-get varsets var (λ () #f))
(color var set!d-variable-style-name)]
[lexical? (color var lexically-bound-variable-style-name)]
[(pair? b) (color var imported-variable-style-name)])))
@ -2258,9 +2284,7 @@ If the namespace does not, they are colored the unbound color.
(parameterize ([current-namespace user-namespace]
[current-directory user-directory]
[current-load-relative-directory user-directory])
(let ([ans (with-handlers ([exn:fail? (λ (x)
(printf "fail ~s\n" (exn-message x))
#f)])
(let ([ans (with-handlers ([exn:fail? (λ (x) #f)])
(cond
[(module-path-index? datum)
(resolved-module-path-name

1
collects/string-constants/english-string-constants.ss
View File

@ -195,6 +195,7 @@ please adhere to these guidelines:
(cs-view-docs-from "~a from ~a") ;; a completed version of the line above (cs-view-docs) is put into the first ~a and a list of modules (separated by commas) is put into the second ~a. Use check syntax and right-click on a documented variable (eg, 'require') to see this in use
(cs-lexical-variable "lexical variable")
(cs-set!d-variable "set!’d variable")
(cs-imported-variable "imported variable")
;;; info bar at botttom of drscheme frame