From 7f345fe067ed4b4c2548a54390ee75b743987ffe Mon Sep 17 00:00:00 2001 From: Ryan Culpepper Date: Sat, 17 Dec 2011 23:55:13 -0700 Subject: [PATCH] removed unstable/gui/language-level --- collects/unstable/gui/language-level.rkt | 202 ------------------ collects/unstable/scribblings/gui.scrbl | 1 - .../scribblings/gui/language-level.scrbl | 136 ------------ 3 files changed, 339 deletions(-) delete mode 100644 collects/unstable/gui/language-level.rkt delete mode 100644 collects/unstable/scribblings/gui/language-level.scrbl diff --git a/collects/unstable/gui/language-level.rkt b/collects/unstable/gui/language-level.rkt deleted file mode 100644 index 8eed798e04..0000000000 --- a/collects/unstable/gui/language-level.rkt +++ /dev/null @@ -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)))) diff --git a/collects/unstable/scribblings/gui.scrbl b/collects/unstable/scribblings/gui.scrbl index 1552c1613f..23607a9d5a 100644 --- a/collects/unstable/scribblings/gui.scrbl +++ b/collects/unstable/scribblings/gui.scrbl @@ -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"] diff --git a/collects/unstable/scribblings/gui/language-level.scrbl b/collects/unstable/scribblings/gui/language-level.scrbl deleted file mode 100644 index 8a67e79181..0000000000 --- a/collects/unstable/scribblings/gui/language-level.scrbl +++ /dev/null @@ -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]. - -} - -}