various cleanups, including finishing up the client mode, string constants, and coloring of (known) identifiers
This commit is contained in:
parent
b9ff546e83
commit
4eb3df7094
|
@ -7,16 +7,20 @@
|
|||
(provide annotate-contracts)
|
||||
|
||||
(define (annotate-contracts stx low-binders binding-inits)
|
||||
(define start-map (make-hash))
|
||||
(define boundary-start-map (make-hash))
|
||||
(define internal-start-map (make-hash))
|
||||
(define arrow-map (make-hash))
|
||||
(define domain-map (make-hash))
|
||||
(define range-map (make-hash))
|
||||
|
||||
;; coloring-plans : hash[stx -o-> (listof color)]
|
||||
(define coloring-plans (make-hash))
|
||||
;; my-coloring-plans : hash[stx -o-> (listof color)]
|
||||
(define my-coloring-plans (make-hash))
|
||||
;; client-coloring-plans : hash[stx -o-> (listof color)]
|
||||
(define client-coloring-plans (make-hash))
|
||||
|
||||
(let loop ([stx stx])
|
||||
(add-to-map stx 'racket/contract:contract-on-boundary start-map)
|
||||
(add-to-map stx 'racket/contract:contract-on-boundary boundary-start-map)
|
||||
(add-to-map stx 'racket/contract:internal-contract internal-start-map)
|
||||
(add-to-map stx 'racket/contract:domain-of domain-map)
|
||||
(add-to-map stx 'racket/contract:rng-of range-map)
|
||||
(add-to-map stx 'racket/contract:function-contract arrow-map)
|
||||
|
@ -24,32 +28,48 @@
|
|||
[(a . b) (loop #'a) (loop #'b)]
|
||||
[else (void)]))
|
||||
|
||||
;; fill in the coloring-plans table
|
||||
(for ([(start-k start-val) (in-hash start-map)])
|
||||
;; fill in the coloring-plans table for boundary contracts
|
||||
(for ([(start-k start-val) (in-hash boundary-start-map)])
|
||||
(for ([start-stx (in-list start-val)])
|
||||
(do-contract-traversal start-stx
|
||||
coloring-plans
|
||||
(do-contract-traversal start-stx #t
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits
|
||||
arrow-map domain-map range-map
|
||||
#t)))
|
||||
|
||||
;; fill in the coloring-plans table for internal contracts
|
||||
(for ([(start-k start-val) (in-hash internal-start-map)])
|
||||
(for ([start-stx (in-list start-val)])
|
||||
(do-contract-traversal start-stx #f
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits
|
||||
arrow-map domain-map range-map
|
||||
#t)))
|
||||
|
||||
;; enact the coloring plans
|
||||
(for ([(stx colors) (in-hash coloring-plans)])
|
||||
(cond
|
||||
[(and (member my-obligation-style-name colors)
|
||||
(member their-obligation-style-name colors))
|
||||
(color stx both-obligation-style-name 'contract-mode)]
|
||||
[(member my-obligation-style-name colors)
|
||||
(color stx my-obligation-style-name 'contract-mode)]
|
||||
[(member their-obligation-style-name colors)
|
||||
(color stx their-obligation-style-name 'contract-mode)]
|
||||
[(member unk-obligation-style-name colors)
|
||||
(color stx unk-obligation-style-name 'contract-mode)])))
|
||||
(for ((coloring-plans (in-list (list my-coloring-plans client-coloring-plans)))
|
||||
(mode (in-list '(my-obligations-mode client-obligations-mode))))
|
||||
(for ([(stx colors) (in-hash coloring-plans)])
|
||||
(cond
|
||||
[(and (member my-obligation-style-name colors)
|
||||
(member their-obligation-style-name colors))
|
||||
(color stx both-obligation-style-name mode)]
|
||||
[(member my-obligation-style-name colors)
|
||||
(color stx my-obligation-style-name mode)]
|
||||
[(member their-obligation-style-name colors)
|
||||
(color stx their-obligation-style-name mode)]
|
||||
[(member unk-obligation-style-name colors)
|
||||
(color stx unk-obligation-style-name mode)]))))
|
||||
|
||||
(define (do-contract-traversal start-stx coloring-plans low-binders binding-inits arrow-map domain-map range-map polarity)
|
||||
(define (do-contract-traversal start-stx boundary-contract?
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits arrow-map domain-map range-map polarity)
|
||||
(let ploop ([stx start-stx]
|
||||
[polarity polarity])
|
||||
|
||||
(define (call-give-up)
|
||||
(give-up start-stx boundary-contract? my-coloring-plans client-coloring-plans))
|
||||
|
||||
(let ([main-prop (syntax-property stx 'racket/contract:contract)])
|
||||
(cond
|
||||
[main-prop
|
||||
|
@ -61,11 +81,15 @@
|
|||
[(vector? prop)
|
||||
(let ([id (vector-ref prop 0)]
|
||||
[to-color (vector-ref prop 1)])
|
||||
(base-color to-color polarity coloring-plans)
|
||||
(base-color #'id polarity boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(for ((stx (in-list (hash-ref domain-map id '()))))
|
||||
(do-contract-traversal stx coloring-plans low-binders binding-inits arrow-map domain-map range-map (not polarity)))
|
||||
(do-contract-traversal stx boundary-contract?
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits arrow-map domain-map range-map (not polarity)))
|
||||
(for ((stx (in-list (hash-ref range-map id '()))))
|
||||
(do-contract-traversal stx coloring-plans low-binders binding-inits arrow-map domain-map range-map polarity)))]))]
|
||||
(do-contract-traversal stx boundary-contract?
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits arrow-map domain-map range-map polarity)))]))]
|
||||
|
||||
[else
|
||||
;; we didn't find a contract, but we might find one in a subexpression
|
||||
|
@ -74,33 +98,44 @@
|
|||
[(#%expression expr)
|
||||
(ploop #'expr polarity)]
|
||||
[(module id name-id (#%plain-module-begin mod-level-form ...))
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(begin tl-form ... last-one)
|
||||
(ploop #'last-one polarity)]
|
||||
[(#%provide pvd ...)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(define-values (id ...) expr)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(define-syntaxes (id ...) expr)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(define-values-for-syntax (id ...) expr)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(#%require rspec ...)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[id
|
||||
(identifier? #'id)
|
||||
(if (known-predicate? #'id)
|
||||
(base-color #'id polarity coloring-plans)
|
||||
(base-color #'id polarity boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(let ([binders (module-identifier-mapping-get low-binders #'id (λ () #f))])
|
||||
(if binders
|
||||
(for ((binder (in-list (module-identifier-mapping-get low-binders #'id))))
|
||||
(for ((rhs (in-list (module-identifier-mapping-get binding-inits binder))))
|
||||
(ploop rhs polarity)))
|
||||
(give-up start-stx coloring-plans))))]
|
||||
(begin
|
||||
(base-color #'id polarity boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(for ((binder (in-list (module-identifier-mapping-get low-binders #'id))))
|
||||
(base-color binder polarity boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(for ((rhs (in-list (module-identifier-mapping-get binding-inits binder))))
|
||||
(ploop rhs polarity))))
|
||||
(call-give-up))))]
|
||||
[(#%plain-lambda (id) expr ...)
|
||||
(identifier? #'id)
|
||||
(base-color stx polarity boundary-contract? my-coloring-plans client-coloring-plans)]
|
||||
[(#%plain-lambda id expr ...)
|
||||
(identifier? #'id)
|
||||
(base-color stx polarity boundary-contract? my-coloring-plans client-coloring-plans)]
|
||||
[(#%plain-lambda formals expr ...)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(case-lambda [formals expr] ...)
|
||||
(give-up start-stx coloring-plans)]
|
||||
;; this should really only happen when the arity of the case-lambda includes 1
|
||||
;; (otherwise we should call give-up)
|
||||
(base-color stx polarity boundary-contract? my-coloring-plans client-coloring-plans)]
|
||||
[(if a b c)
|
||||
;; these calls are questionable.
|
||||
;; if we ultimately end up giving up in both
|
||||
|
@ -110,8 +145,12 @@
|
|||
;; on the other hand, recurring like this will mean that the two
|
||||
;; branches are considered separately and thus calling give-up
|
||||
;; on one side will not pollute the other side.
|
||||
(do-contract-traversal #'b coloring-plans low-binders binding-inits arrow-map domain-map range-map polarity)
|
||||
(do-contract-traversal #'c coloring-plans low-binders binding-inits arrow-map domain-map range-map polarity)]
|
||||
(do-contract-traversal #'b boundary-contract?
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits arrow-map domain-map range-map polarity)
|
||||
(do-contract-traversal #'c boundary-contract?
|
||||
my-coloring-plans client-coloring-plans
|
||||
low-binders binding-inits arrow-map domain-map range-map polarity)]
|
||||
;; [(begin expr ...) (void)]
|
||||
[(begin0 fst rst ...)
|
||||
(ploop #'fst polarity)]
|
||||
|
@ -120,19 +159,19 @@
|
|||
[(letrec-values bindings body ... last-one)
|
||||
(ploop #'last-one polarity)]
|
||||
[(set! a b)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(quote stuff)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(quote-syntax stuff)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(with-continuation-mark a b c)
|
||||
(ploop #'c polarity)]
|
||||
[(#%plain-app f args ...)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(#%top . id)
|
||||
(give-up start-stx coloring-plans)]
|
||||
(call-give-up)]
|
||||
[(#%variable-reference ignored ...)
|
||||
(give-up start-stx coloring-plans)])]))))
|
||||
(call-give-up)])]))))
|
||||
|
||||
;; add-to-map : syntax any hash[any -> (listof stx)]
|
||||
;; looks at stx's property prop and updates map,
|
||||
|
@ -158,31 +197,39 @@
|
|||
(let-values ([(base rel) (module-path-index-split src)])
|
||||
(member base '('#%kernel racket racket/base scheme scheme/base)))))))
|
||||
|
||||
(define (give-up stx coloring-plans)
|
||||
(define (give-up stx boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(let loop ([stx stx])
|
||||
(when (syntax-original? stx)
|
||||
(blank-color stx coloring-plans))
|
||||
(blank-color stx boundary-contract? my-coloring-plans client-coloring-plans))
|
||||
|
||||
(let oloop ([origin (syntax-property stx 'origin)])
|
||||
(cond
|
||||
[(pair? origin) (oloop (car origin)) (oloop (cdr origin))]
|
||||
[(syntax? origin)
|
||||
(when (syntax-original? origin)
|
||||
(blank-color origin coloring-plans))]))
|
||||
(blank-color origin boundary-contract? my-coloring-plans client-coloring-plans))]))
|
||||
|
||||
(syntax-case stx ()
|
||||
[(a . b) (loop #'a) (loop #'b)]
|
||||
[_ (void)])))
|
||||
|
||||
(define (base-color stx polarity boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(let ([style (if polarity my-obligation-style-name their-obligation-style-name)]
|
||||
[neg-style (if polarity their-obligation-style-name my-obligation-style-name)])
|
||||
(cond
|
||||
[boundary-contract?
|
||||
(make-a-coloring-plan stx style my-coloring-plans)
|
||||
(make-a-coloring-plan stx neg-style client-coloring-plans)]
|
||||
[else
|
||||
(make-a-coloring-plan stx style my-coloring-plans)])))
|
||||
|
||||
|
||||
(define (base-color stx polarity coloring-plans)
|
||||
(make-a-coloring-plan stx
|
||||
(if polarity my-obligation-style-name their-obligation-style-name)
|
||||
coloring-plans))
|
||||
|
||||
(define (blank-color stx coloring-plans)
|
||||
(make-a-coloring-plan stx unk-obligation-style-name coloring-plans))
|
||||
(define (blank-color stx boundary-contract? my-coloring-plans client-coloring-plans)
|
||||
(cond
|
||||
[boundary-contract?
|
||||
(make-a-coloring-plan stx unk-obligation-style-name my-coloring-plans)
|
||||
(make-a-coloring-plan stx unk-obligation-style-name client-coloring-plans)]
|
||||
[else
|
||||
(make-a-coloring-plan stx unk-obligation-style-name my-coloring-plans)]))
|
||||
|
||||
(define (make-a-coloring-plan stx plan coloring-plans)
|
||||
(hash-set! coloring-plans
|
||||
|
|
|
@ -57,10 +57,10 @@ If the namespace does not, they are colored the unbound color.
|
|||
(define jump-to-binding (string-constant cs-jump-to-binding))
|
||||
(define jump-to-definition (string-constant cs-jump-to-definition))
|
||||
|
||||
(define cs-mode-menu-show-contract "Show Contract Obligations")
|
||||
(define cs-mode-menu-show-syntax "Show Syntactic Categories")
|
||||
|
||||
|
||||
(define cs-check-syntax-mode (string-constant cs-check-syntax-mode))
|
||||
(define cs-mode-menu-show-my-obligations (string-constant cs-mode-menu-show-my-obligations))
|
||||
(define cs-mode-menu-show-client-obligations (string-constant cs-mode-menu-show-client-obligations))
|
||||
(define cs-mode-menu-show-syntax (string-constant cs-mode-menu-show-syntax))
|
||||
|
||||
(define tool@
|
||||
(unit
|
||||
|
@ -341,6 +341,9 @@ If the namespace does not, they are colored the unbound color.
|
|||
(when f
|
||||
(send f open-status-line 'drracket:check-syntax:mouse-over))))
|
||||
|
||||
(define/public (syncheck:arrows-visible?)
|
||||
(or arrow-vectors cursor-location cursor-text))
|
||||
|
||||
;; syncheck:clear-arrows : -> void
|
||||
(define/public (syncheck:clear-arrows)
|
||||
(when (or arrow-vectors cursor-location cursor-text)
|
||||
|
@ -988,23 +991,25 @@ If the namespace does not, they are colored the unbound color.
|
|||
(syncheck:clear-highlighting))
|
||||
|
||||
(define/public (syncheck:clear-error-message)
|
||||
(set! error-report-visible? #f)
|
||||
(send report-error-text clear-output-ports)
|
||||
(send report-error-text lock #f)
|
||||
(send report-error-text delete/io 0 (send report-error-text last-position))
|
||||
(send report-error-text lock #t)
|
||||
(when (is-current-tab?)
|
||||
(send (get-frame) hide-error-report)
|
||||
(send (get-frame) update-menu-item-label this)))
|
||||
(unless error-report-visible?
|
||||
(set! error-report-visible? #f)
|
||||
(send report-error-text clear-output-ports)
|
||||
(send report-error-text lock #f)
|
||||
(send report-error-text delete/io 0 (send report-error-text last-position))
|
||||
(send report-error-text lock #t)
|
||||
(when (is-current-tab?)
|
||||
(send (get-frame) hide-error-report)
|
||||
(send (get-frame) update-menu-status this))))
|
||||
|
||||
(define/public (syncheck:clear-highlighting)
|
||||
(let* ([definitions (get-defs)]
|
||||
[locked? (send definitions is-locked?)])
|
||||
(send definitions begin-edit-sequence #f)
|
||||
(send definitions lock #f)
|
||||
(send definitions syncheck:clear-arrows)
|
||||
(send definitions lock locked?)
|
||||
(send definitions end-edit-sequence)))
|
||||
(let ([definitions (get-defs)])
|
||||
(when (send definitions syncheck:arrows-visible?)
|
||||
(let ([locked? (send definitions is-locked?)])
|
||||
(send definitions begin-edit-sequence #f)
|
||||
(send definitions lock #f)
|
||||
(send definitions syncheck:clear-arrows)
|
||||
(send definitions lock locked?)
|
||||
(send definitions end-edit-sequence)))))
|
||||
|
||||
(define/augment (can-close?)
|
||||
(and (send report-error-text can-close?)
|
||||
|
@ -1032,7 +1037,7 @@ 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-item-label new-tab)
|
||||
(update-menu-status new-tab)
|
||||
(update-button-visibility/tab new-tab))
|
||||
|
||||
(define/private (update-button-visibility/tab tab)
|
||||
|
@ -1049,11 +1054,13 @@ If the namespace does not, they are colored the unbound color.
|
|||
|
||||
(define/augment (enable-evaluation)
|
||||
(send check-syntax-button enable #t)
|
||||
(send mode-menu-item 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-item enable #f)
|
||||
(send mode-menu-item1 enable #f)
|
||||
(send mode-menu-item2 enable #f)
|
||||
(send check-syntax-button enable #f)
|
||||
(inner (void) disable-evaluation))
|
||||
|
||||
|
@ -1115,36 +1122,47 @@ If the namespace does not, they are colored the unbound color.
|
|||
(set! rest-panel r-root)
|
||||
r-root))
|
||||
|
||||
(define mode-menu-item #f)
|
||||
(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)])
|
||||
(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)
|
||||
(set! mode-menu-item
|
||||
(new menu-item%
|
||||
[parent show-menu]
|
||||
[label ""]
|
||||
[callback
|
||||
(λ (a b)
|
||||
(let ([defs (send (get-current-tab) get-defs)])
|
||||
(case (send defs get-syncheck-mode)
|
||||
[(#f) (syncheck:button-callback #f 'contract-mode)]
|
||||
[(default-mode)
|
||||
(send defs set-syncheck-mode 'contract-mode)
|
||||
(update-menu-item-label (get-current-tab))]
|
||||
[else
|
||||
(send defs set-syncheck-mode 'default-mode)
|
||||
(update-menu-item-label (get-current-tab))])))])))
|
||||
(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-item-label tab)
|
||||
(when mode-menu-item
|
||||
(define/public (update-menu-status tab)
|
||||
(when mode-menu-item1
|
||||
(let ([mode (send (send (get-current-tab) get-defs) get-syncheck-mode)])
|
||||
(case mode
|
||||
[(#f)
|
||||
(send mode-menu-item set-label cs-mode-menu-show-contract)]
|
||||
[(default-mode)
|
||||
(send mode-menu-item set-label cs-mode-menu-show-contract)]
|
||||
[(contract-mode)
|
||||
(send mode-menu-item set-label cs-mode-menu-show-syntax)]))))
|
||||
(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)
|
||||
|
@ -1276,7 +1294,7 @@ If the namespace does not, they are colored the unbound color.
|
|||
(parameterize ([currently-processing-definitions-text definitions-text])
|
||||
(expansion-completed user-namespace user-directory)
|
||||
(send (send (get-current-tab) get-defs) set-syncheck-mode mode)
|
||||
(update-menu-item-label (get-current-tab))
|
||||
(update-menu-status (get-current-tab))
|
||||
(send definitions-text syncheck:sort-bindings-table))))
|
||||
(cleanup)
|
||||
(custodian-shutdown-all user-custodian))))]
|
||||
|
|
|
@ -7,6 +7,7 @@
|
|||
(define-local-member-name
|
||||
syncheck:init-arrows
|
||||
syncheck:clear-arrows
|
||||
syncheck:arrows-visible?
|
||||
syncheck:add-menu
|
||||
syncheck:add-arrow
|
||||
syncheck:add-tail-arrow
|
||||
|
@ -34,12 +35,13 @@
|
|||
|
||||
set-syncheck-mode
|
||||
get-syncheck-mode
|
||||
update-menu-item-label)
|
||||
update-menu-status)
|
||||
|
||||
(define syncheck-text<%>
|
||||
(interface ()
|
||||
syncheck:init-arrows
|
||||
syncheck:clear-arrows
|
||||
syncheck:arrows-visible?
|
||||
syncheck:add-menu
|
||||
syncheck:add-arrow
|
||||
syncheck:add-tail-arrow
|
||||
|
@ -74,6 +76,7 @@
|
|||
;; methods
|
||||
syncheck:init-arrows
|
||||
syncheck:clear-arrows
|
||||
syncheck:arrows-visible?
|
||||
syncheck:add-menu
|
||||
syncheck:add-arrow
|
||||
syncheck:add-tail-arrow
|
||||
|
@ -101,4 +104,4 @@
|
|||
|
||||
set-syncheck-mode
|
||||
get-syncheck-mode
|
||||
update-menu-item-label)
|
||||
update-menu-status)
|
|
@ -197,6 +197,12 @@ please adhere to these guidelines:
|
|||
(cs-set!d-variable "set!’d variable")
|
||||
(cs-imported-variable "imported variable")
|
||||
|
||||
;; mode sub-menu in the "view" menu
|
||||
(cs-check-syntax-mode "Check Syntax Mode")
|
||||
(cs-mode-menu-show-my-obligations "My Contract Obligations")
|
||||
(cs-mode-menu-show-client-obligations "Client Contract Obligations")
|
||||
(cs-mode-menu-show-syntax "Syntactic Categories")
|
||||
|
||||
;;; info bar at botttom of drscheme frame
|
||||
(collect-button-label "GC")
|
||||
(read-only "Read only")
|
||||
|
|
Loading…
Reference in New Issue
Block a user