adjusted the default code keywords to include racket/base

This commit is contained in:
Robby Findler 2010-08-20 09:19:14 -05:00
parent 22f2e18a99
commit 7c3b8eadf8
2 changed files with 35 additions and 17 deletions

View File

@ -171,7 +171,8 @@ ascent.}
@defparam[current-keyword-list names (listof string?)]{ @defparam[current-keyword-list names (listof string?)]{
A list of strings to color as syntactic-form names. The default A list of strings to color as syntactic-form names. The default
includes most of the forms provided by @racket[racket/base].} includes all of the forms provided by @racketmodname[racket/base]
and all of the forms provided by @racketmodname[mzscheme].}
@defparam[current-const-list names (listof string?)]{ @defparam[current-const-list names (listof string?)]{
@ -185,6 +186,11 @@ A list of strings to color as constant names. The default is
A list of strings to color as literals, in addition to literals such A list of strings to color as literals, in addition to literals such
as strings. The default is @racket[null].} as strings. The default is @racket[null].}
@defthing[racket/base-const-list (listof string?)]{
A list of strings that could be used to initialize the
@racket[current-const-list] parameter.}
@defthing[mzscheme-const-list (listof string?)]{ @defthing[mzscheme-const-list (listof string?)]{
A list of strings that could be used to initialize the A list of strings that could be used to initialize the

View File

@ -1,10 +1,11 @@
(module code mzscheme (module code mzscheme
(require "mrpict.ss" (require "mrpict.ss"
mzlib/class (prefix r: racket/base)
mzlib/class
mzlib/list mzlib/list
(only scheme/list last) (only scheme/list last)
mred mred
mzlib/unit) mzlib/unit)
(provide define-code code^ code-params^ code@) (provide define-code code^ code-params^ code@)
@ -105,7 +106,8 @@
current-comment-color current-keyword-color current-comment-color current-keyword-color
current-base-color current-id-color current-literal-color current-const-color current-base-color current-id-color current-literal-color current-const-color
current-reader-forms current-reader-forms
mzscheme-const-list)) mzscheme-const-list
racket/base-const-list))
(define-signature code-params^ (define-signature code-params^
(current-font-size (current-font-size
@ -153,25 +155,33 @@
(to-code-pict p bottom-line) (to-code-pict p bottom-line)
p)) p))
(define mzscheme-ns (let ([n (make-namespace)]) (define (get-vars/bindings ns require-spec)
(parameterize ([current-namespace n]) (define ns (let ([n (make-namespace)])
(namespace-require/copy 'mzscheme)) (parameterize ([current-namespace n])
n)) (namespace-require/copy require-spec))
(define mzscheme-bindings (namespace-mapped-symbols mzscheme-ns)) n))
(define mzscheme-vars (filter (lambda (n) (define bindings (namespace-mapped-symbols ns))
(not (eq? 'nope (define vars (filter (lambda (n)
(namespace-variable-value n #f (lambda () 'nope) mzscheme-ns)))) (not (eq? 'nope
mzscheme-bindings)) (namespace-variable-value n #f (lambda () 'nope) ns))))
bindings))
(values vars bindings))
(define-values (mzscheme-vars mzscheme-bindings) (get-vars/bindings (make-namespace) 'mzscheme))
(define-values (racket/base-vars racket/base-bindings) (get-vars/bindings (r:make-base-namespace) 'racket/base))
(define current-keyword-list (define current-keyword-list
(make-parameter (make-parameter
(let ([ht (make-hash-table)]) (let ([ht (make-hash-table)])
(for-each (lambda (n) (hash-table-put! ht n #f)) (for-each (lambda (n) (hash-table-put! ht n #f))
mzscheme-vars) mzscheme-vars)
(for-each (lambda (n) (hash-table-put! ht n #f))
racket/base-vars)
(map symbol->string (map symbol->string
(filter (lambda (n) (filter (lambda (n)
(hash-table-get ht n (lambda () #t))) (hash-table-get ht n (lambda () #t)))
mzscheme-bindings))))) (append mzscheme-bindings
racket/base-bindings))))))
(define current-const-list (define current-const-list
(make-parameter '())) (make-parameter '()))
(define current-literal-list (define current-literal-list
@ -179,6 +189,8 @@
(define mzscheme-const-list (define mzscheme-const-list
(map symbol->string mzscheme-vars)) (map symbol->string mzscheme-vars))
(define racket/base-const-list
(map symbol->string racket/base-vars))
(define code-colorize-enabled (define code-colorize-enabled
(make-parameter #t)) (make-parameter #t))