removed unstable/gui/language-level
This commit is contained in:
parent
6ac708a3da
commit
7f345fe067
|
@ -1,202 +0,0 @@
|
|||
#lang racket/base
|
||||
(require racket/class
|
||||
racket/file
|
||||
racket/dict
|
||||
racket/unit
|
||||
racket/gui/base
|
||||
drracket/tool
|
||||
string-constants
|
||||
framework/preferences
|
||||
(only-in test-engine/scheme-gui make-formatter)
|
||||
(only-in test-engine/scheme-tests
|
||||
scheme-test-data test-format test-execute)
|
||||
(lib "test-display.scm" "test-engine"))
|
||||
|
||||
(provide language-level^
|
||||
language-level@)
|
||||
|
||||
(define (read-all-syntax [port (current-input-port)]
|
||||
[source (object-name port)]
|
||||
[reader read-syntax])
|
||||
(let loop ()
|
||||
(let* ([next (reader source port)])
|
||||
(if (eof-object? next)
|
||||
null
|
||||
(cons next (loop))))))
|
||||
|
||||
(define (read-module-body [port (current-input-port)]
|
||||
[source (object-name port)]
|
||||
[reader read-syntax]
|
||||
[path 'racket]
|
||||
[name 'program])
|
||||
(let*-values ([(line-1 col-1 pos-1) (port-next-location port)]
|
||||
[(terms) (read-all-syntax port source reader)]
|
||||
[(line-2 col-2 pos-2) (port-next-location port)]
|
||||
[(loc) (list source line-1 col-1 pos-1
|
||||
(and pos-1 pos-2 (- pos-2 pos-1)))])
|
||||
(map (lambda (datum) (datum->syntax #'here datum loc))
|
||||
(list `(module ,name ,path
|
||||
(,(datum->syntax #f '#%module-begin) ,@terms))
|
||||
`(require ',name)
|
||||
`(current-namespace (module->namespace '',name))))))
|
||||
|
||||
(define-signature language-level^
|
||||
(simple-language-level%
|
||||
make-language-level
|
||||
language-level-render-mixin
|
||||
language-level-capability-mixin
|
||||
language-level-eval-as-module-mixin
|
||||
language-level-no-executable-mixin
|
||||
language-level-macro-stepper-mixin
|
||||
language-level-check-expect-mixin
|
||||
language-level-metadata-mixin))
|
||||
|
||||
(define-unit language-level@
|
||||
(import drracket:tool^)
|
||||
(export language-level^)
|
||||
|
||||
(define (make-language-level
|
||||
name path
|
||||
#:number [number (equal-hash-code name)]
|
||||
#:hierarchy [hierarchy experimental-language-hierarchy]
|
||||
#:summary [summary name]
|
||||
#:url [url #f]
|
||||
#:reader [reader read-syntax]
|
||||
. mixins)
|
||||
(let* ([mx-default (drracket:language:get-default-mixin)]
|
||||
[mx-custom (apply compose (reverse mixins))])
|
||||
(new (mx-custom (mx-default simple-language-level%))
|
||||
[module path]
|
||||
[language-position (append (map car hierarchy) (list name))]
|
||||
[language-numbers (append (map cdr hierarchy) (list number))]
|
||||
[one-line-summary summary]
|
||||
[language-url url]
|
||||
[reader (make-namespace-syntax-reader reader)])))
|
||||
|
||||
(define simple-language-level%
|
||||
(drracket:language:module-based-language->language-mixin
|
||||
(drracket:language:simple-module-based-language->module-based-language-mixin
|
||||
drracket:language:simple-module-based-language%)))
|
||||
|
||||
(define (language-level-render-mixin to-sexp show-void?)
|
||||
(mixin (drracket:language:language<%>) ()
|
||||
(super-new)
|
||||
|
||||
(define/override (render-value/format value settings port width)
|
||||
(unless (and (void? value) (not show-void?))
|
||||
(super render-value/format (to-sexp value) settings port width)))))
|
||||
|
||||
(define (language-level-capability-mixin dict)
|
||||
(mixin (drracket:language:language<%>) ()
|
||||
(super-new)
|
||||
|
||||
(define/augment (capability-value key)
|
||||
(dict-ref dict key
|
||||
(lambda ()
|
||||
(inner (drracket:language:get-capability-default key)
|
||||
capability-value key))))))
|
||||
|
||||
(define language-level-no-executable-mixin
|
||||
(mixin (drracket:language:language<%>) ()
|
||||
(super-new)
|
||||
(inherit get-language-name)
|
||||
|
||||
(define/override (create-executable settings parent filename)
|
||||
(message-box
|
||||
"Create Executable: Error"
|
||||
(format "Sorry, ~a does not support creating executables."
|
||||
(get-language-name))
|
||||
#f '(ok stop)))))
|
||||
|
||||
(define language-level-eval-as-module-mixin
|
||||
(mixin (drracket:language:language<%>
|
||||
drracket:language:module-based-language<%>) ()
|
||||
(super-new)
|
||||
|
||||
(inherit get-reader get-module)
|
||||
|
||||
(define/override (front-end/complete-program port settings)
|
||||
(let* ([terms #f])
|
||||
(lambda ()
|
||||
;; On the first run through, initialize the list.
|
||||
(unless terms
|
||||
(set! terms (read-module-body port
|
||||
(object-name port)
|
||||
(get-reader)
|
||||
(get-module))))
|
||||
;; Produce each list element in order.
|
||||
(if (pair? terms)
|
||||
;; Produce and remove a list element.
|
||||
(begin0 (car terms) (set! terms (cdr terms)))
|
||||
;; After null, eof forever.
|
||||
eof))))))
|
||||
|
||||
(define language-level-macro-stepper-mixin
|
||||
(language-level-capability-mixin
|
||||
(make-immutable-hasheq
|
||||
(list (cons 'macro-stepper:enabled #t)))))
|
||||
|
||||
(define language-level-check-expect-mixin
|
||||
(mixin (drracket:language:language<%>) ()
|
||||
(super-new)
|
||||
(inherit render-value/format)
|
||||
|
||||
(define/augment (capability-value key)
|
||||
(case key
|
||||
[(tests:test-menu tests:dock-menu) #t]
|
||||
[else (inner (drracket:language:get-capability-default key)
|
||||
capability-value
|
||||
key)]))
|
||||
|
||||
(define/override (on-execute settings run-in-user-thread)
|
||||
(let* ([drracket-namespace (current-namespace)]
|
||||
[test-engine-path
|
||||
((current-module-name-resolver)
|
||||
'test-engine/scheme-tests #f #f)]
|
||||
[tests-on? (preferences:get 'test-engine:enable?)])
|
||||
(run-in-user-thread
|
||||
(lambda ()
|
||||
(namespace-attach-module drracket-namespace test-engine-path)
|
||||
(namespace-require test-engine-path)
|
||||
(scheme-test-data
|
||||
(list (drracket:rep:current-rep)
|
||||
drracket-eventspace
|
||||
test-display%))
|
||||
(test-execute tests-on?)
|
||||
(test-format
|
||||
(make-formatter
|
||||
(lambda (v o) (render-value/format v settings o 40))))))
|
||||
(super on-execute settings run-in-user-thread)))))
|
||||
|
||||
(define (language-level-metadata-mixin reader-module
|
||||
meta-lines
|
||||
meta->settings
|
||||
settings->meta)
|
||||
(mixin (drracket:language:language<%>) ()
|
||||
(inherit default-settings)
|
||||
(super-new)
|
||||
|
||||
(define/override (get-reader-module) reader-module)
|
||||
|
||||
(define/override (get-metadata modname settings)
|
||||
(settings->meta modname settings))
|
||||
|
||||
(define/override (metadata->settings metadata)
|
||||
(meta->settings metadata (default-settings)))
|
||||
|
||||
(define/override (get-metadata-lines) meta-lines)))
|
||||
|
||||
(define (generic-syntax-reader . args)
|
||||
(parameterize ([read-accept-reader #t])
|
||||
(apply read-syntax args)))
|
||||
|
||||
(define (make-namespace-syntax-reader reader)
|
||||
(lambda args
|
||||
(let ([stx (apply reader args)])
|
||||
(if (syntax? stx) (namespace-syntax-introduce stx) stx))))
|
||||
|
||||
(define drracket-eventspace (current-eventspace))
|
||||
|
||||
(define experimental-language-hierarchy
|
||||
(list (cons (string-constant experimental-languages)
|
||||
1000))))
|
|
@ -7,7 +7,6 @@
|
|||
|
||||
@local-table-of-contents[#:style 'immediate-only]
|
||||
|
||||
@include-section["gui/language-level.scrbl"]
|
||||
@include-section["gui/notify.scrbl"]
|
||||
@include-section["gui/prefs.scrbl"]
|
||||
@include-section["gui/pict.scrbl"]
|
||||
|
|
|
@ -1,136 +0,0 @@
|
|||
#lang scribble/manual
|
||||
@(require "../utils.rkt"
|
||||
(for-label racket/gui
|
||||
drracket/tool-lib
|
||||
unstable/gui/language-level))
|
||||
|
||||
@title{DrRacket Language Levels}
|
||||
|
||||
@defmodule[unstable/gui/language-level]
|
||||
|
||||
@unstable[@author+email["Carl Eastlund" "cce@racket-lang.org"]]
|
||||
|
||||
@defthing[language-level@ unit?]{
|
||||
|
||||
This unit imports @racket[drracket:tool^] and exports @racket[language-level^].
|
||||
|
||||
}
|
||||
|
||||
@defsignature[language-level^ ()]{
|
||||
|
||||
@defproc[(make-language-level
|
||||
[name string?]
|
||||
[path module-path?]
|
||||
[mixin (-> class? class?)] ...
|
||||
[#:number number integer? ...]
|
||||
[#:hierarchy hierarchy (listof (cons/c string? integer?)) ...]
|
||||
[#:summary summary string? name]
|
||||
[#:url url (or/c string? #f) #f]
|
||||
[#:reader reader
|
||||
(->* [] [any/c input-port?] (or/c syntax? eof-object?))
|
||||
read-syntax])
|
||||
(is-a?/c drracket:language:language<%>)]{
|
||||
|
||||
Constructs a language level as an instance of
|
||||
@racket[drracket:language:language<%>] with the given @racket[name] based on the
|
||||
language defined by the module at @racket[path]. Applies
|
||||
@racket[(drracket:language:get-default-mixin)] and the given @racket[mixin]s to
|
||||
@sigelem[language-level^ simple-language-level%] to construct the class, and
|
||||
uses the optional keyword arguments to fill in the language's description and
|
||||
reader.
|
||||
|
||||
}
|
||||
|
||||
@defthing[simple-language-level%
|
||||
(and/c (implementation?/c drracket:language:language<%>)
|
||||
(implementation?/c drracket:language:module-based-language<%>)
|
||||
(implementation?/c drracket:language:simple-module-based-language<%>))]{
|
||||
|
||||
Equal to
|
||||
@racket[
|
||||
(drracket:language:module-based-language->language-mixin
|
||||
(drracket:language:simple-module-based-language->module-based-language-mixin
|
||||
drracket:language:simple-module-based-language%))].
|
||||
|
||||
}
|
||||
|
||||
@defproc[(language-level-render-mixin [to-sexp (-> any/c any/c)]
|
||||
[show-void? boolean?])
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
Produces a mixin that overrides @method[drracket:language:language<%>
|
||||
render-value/format] to apply @racket[to-sexp] to each value before printing it,
|
||||
and to skip @racket[void?] values (pre-transformation) if @racket[show-void?] is
|
||||
@racket[#f].
|
||||
|
||||
}
|
||||
|
||||
@defproc[(language-level-capability-mixin [dict dict?])
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
Produces a mixin that augments @method[drracket:language:language<%>
|
||||
capability-value] to look up each key in @racket[dict], producing the
|
||||
corresponding value if the key is found and deferring to @racket[inner]
|
||||
otherwise.
|
||||
|
||||
}
|
||||
|
||||
@defthing[language-level-no-executable-mixin
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
Overrides @method[drracket:language:language<%> create-executable] to print an
|
||||
error message in a dialog box.
|
||||
|
||||
}
|
||||
|
||||
@defthing[language-level-eval-as-module-mixin
|
||||
(make-mixin-contract drracket:language:language<%>
|
||||
drracket:language:module-based-language<%>)]{
|
||||
|
||||
Overrides @method[drracket:language:language<%> front-end/complete-program] to
|
||||
wrap terms from the definition in a module based on the language level's
|
||||
definition module. This duplicates the behavior of the HtDP teaching languages,
|
||||
for instance.
|
||||
|
||||
}
|
||||
|
||||
@defthing[language-level-macro-stepper-mixin
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
This mixin enables the macro stepper for its language level.
|
||||
|
||||
}
|
||||
|
||||
@defthing[language-level-check-expect-mixin
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
This mixin overrides @method[drracket:language:language<%> on-execute] to set up
|
||||
the @racket[check-expect] test engine to a language level similarly to the HtDP
|
||||
teaching languages.
|
||||
|
||||
}
|
||||
|
||||
@defproc[(language-level-metadata-mixin
|
||||
[reader-module module-path?]
|
||||
[meta-lines exact-nonnegative-integer?]
|
||||
[meta->settings (-> string? any/c any/c)]
|
||||
[settings->meta (-> symbol? any/c string?)])
|
||||
(make-mixin-contract drracket:language:language<%>)]{
|
||||
|
||||
This mixin constructs a language level that stores metadata in saved files
|
||||
allowing Drracket to automatically switch back to this language level upon
|
||||
opening them. It overrides @method[drracket:language:language<%>
|
||||
get-reader-module], @method[drracket:language:language<%> get-metadata],
|
||||
@method[drracket:language:language<%> metadata->settings], and
|
||||
@method[drracket:language:language<%> get-metadata-lines].
|
||||
|
||||
The resulting language level uses the reader from @racket[reader-module], and is
|
||||
recognized in files that start with a reader directive for that module path
|
||||
within the first @racket[meta-lines] lines. Metadata about the language's
|
||||
settings is marshalled between a string and a usable value (based on a default
|
||||
value) by @racket[meta->settings], and between a usable value for a current
|
||||
module (with a symbolic name) by @racket[settings->meta].
|
||||
|
||||
}
|
||||
|
||||
}
|
Loading…
Reference in New Issue
Block a user