diff --git a/collects/mred/doc.txt b/collects/mred/doc.txt index 3ecb6b1932..18cbf1d3d6 100644 --- a/collects/mred/doc.txt +++ b/collects/mred/doc.txt @@ -27,3 +27,9 @@ The edit.ss module exports the following function. > (new-frame editor% file) Takes the editor class. + +----------------------------------------------------------------- + +_wxme.ss_ + +Reader syntax for PLT graphical format. diff --git a/collects/mred/wxme/comment.ss b/collects/mred/wxme/comment.ss index 514cb95ad2..4696f4f613 100644 --- a/collects/mred/wxme/comment.ss +++ b/collects/mred/wxme/comment.ss @@ -2,13 +2,13 @@ (module comment mzscheme (require (lib "class.ss") (lib "string.ss") - "../wxmefile.ss" - "nested.ss") + "wxme.ss" + "private/readable-editor.ss") (provide reader) (define reader - (new (class nested-reader% + (new (class editor-reader% (define/override (read-snip text? vers stream) (let ([s (super read-snip text? vers stream)]) (if text? diff --git a/collects/mred/wxmecompat.ss b/collects/mred/wxme/compat.ss similarity index 95% rename from collects/mred/wxmecompat.ss rename to collects/mred/wxme/compat.ss index 496c3bbd28..5a65493984 100644 --- a/collects/mred/wxmecompat.ss +++ b/collects/mred/wxme/compat.ss @@ -1,6 +1,6 @@ -(module wxmecompat mzscheme - (require "wxmefile.ss") +(module compat mzscheme + (require "wxme.ss") (register-lib-mapping! "(lib \"comment-snip.ss\" \"framework\")" diff --git a/collects/mred/wxme/doc.txt b/collects/mred/wxme/doc.txt new file mode 100644 index 0000000000..f4c5b30561 --- /dev/null +++ b/collects/mred/wxme/doc.txt @@ -0,0 +1,4 @@ + +_wxme.ss_ + +Utilities for reading PLT graphical format files without MrEd. diff --git a/collects/mred/wxme/editor.ss b/collects/mred/wxme/editor.ss new file mode 100644 index 0000000000..d276ed3983 --- /dev/null +++ b/collects/mred/wxme/editor.ss @@ -0,0 +1,6 @@ + +(module editor mzscheme + (define-struct editor (content-port)) + (provide (struct editor (content-port)))) + + diff --git a/collects/mred/wxme/image.ss b/collects/mred/wxme/image.ss new file mode 100644 index 0000000000..01680e9555 --- /dev/null +++ b/collects/mred/wxme/image.ss @@ -0,0 +1,4 @@ + +(module image mzscheme + (define-struct image (filename data w h dx dy)) + (provide (struct image (filename data w h dx dy)))) diff --git a/collects/mred/wxme/info.ss b/collects/mred/wxme/info.ss new file mode 100644 index 0000000000..9f0547adef --- /dev/null +++ b/collects/mred/wxme/info.ss @@ -0,0 +1,5 @@ + +(module info (lib "infotab.ss" "setup") + (define doc.txt "doc.txt") + (define name "WXME")) + diff --git a/collects/mred/wxme/nested.ss b/collects/mred/wxme/nested.ss deleted file mode 100644 index b0fd00a1f5..0000000000 --- a/collects/mred/wxme/nested.ss +++ /dev/null @@ -1,29 +0,0 @@ - -(module nested mzscheme - (require (lib "class.ss") - (lib "struct.ss") - "../wxmefile.ss") - - (provide nested-reader% - (struct readable-nested (reader data))) - - (define-struct/properties (readable-nested nested) (reader data) - ([prop:readable (lambda (this src line col pos) - (send (readable-nested-reader this) generate-special this src line col pos))])) - - (define nested-reader% - (class object% - (define/public (read-header vers stream) - (void)) - (define/public (read-nested-snip text? vers stream data) - (let ([s (send stream read-nested-editor)]) - (if text? - s - (make-readable-nested s this data)))) - (define/public (read-snip text? vers stream) - (read-nested-snip text? vers stream #f)) - - (define/public (generate-special nested src line col pos) - (make-special-comment nested)) - - (super-new)))) diff --git a/collects/mred/wxme/number.ss b/collects/mred/wxme/number.ss index 1ad38dfd13..94647f1588 100644 --- a/collects/mred/wxme/number.ss +++ b/collects/mred/wxme/number.ss @@ -16,7 +16,7 @@ [expansions (send stream read-bytes "expansions")]) (if text? number - (lambda (src line col pos) (string->number (bytes->string/latin-1 number)))))) + (string->number (bytes->string/latin-1 number))))) (super-new))))) diff --git a/collects/mred/wxme/private/readable-editor.ss b/collects/mred/wxme/private/readable-editor.ss new file mode 100644 index 0000000000..ba737d2082 --- /dev/null +++ b/collects/mred/wxme/private/readable-editor.ss @@ -0,0 +1,30 @@ + +(module readable-editor mzscheme + (require (lib "class.ss") + (lib "struct.ss") + "../wxme.ss" + "../editor.ss") + + (provide editor-reader% + (struct readable-editor (reader data))) + + (define-struct/properties (readable-editor editor) (reader data) + ([prop:readable (lambda (this src line col pos) + (send (readable-editor-reader this) generate-special this src line col pos))])) + + (define editor-reader% + (class object% + (define/public (read-header vers stream) + (void)) + (define/public (read-editor-snip text? vers stream data) + (let ([s (send stream read-editor-snip)]) + (if text? + s + (make-readable-editor s this data)))) + (define/public (read-snip text? vers stream) + (read-editor-snip text? vers stream #f)) + + (define/public (generate-special editor src line col pos) + (make-special-comment editor)) + + (super-new)))) diff --git a/collects/mred/wxme/scheme.ss b/collects/mred/wxme/scheme.ss index 697f4c4f47..198b22f1cd 100644 --- a/collects/mred/wxme/scheme.ss +++ b/collects/mred/wxme/scheme.ss @@ -1,23 +1,24 @@ (module scheme mzscheme (require (lib "class.ss") - "../wxmefile.ss" - "nested.ss") + "wxme.ss" + "editor.ss" + "private/readable-editor.ss") (provide reader) (define reader (new - (class nested-reader% - (inherit read-nested-snip) + (class editor-reader% + (inherit read-editor-snip) (define/override (read-snip text? vers stream) (let ([splice? (zero? (send stream read-integer "splice?"))]) - (read-nested-snip text? vers stream splice?))) + (read-editor-snip text? vers stream splice?))) - (define/override (generate-special nested src line col pos) - (list (if (readable-nested-data nested) + (define/override (generate-special editor src line col pos) + (list (if (readable-editor-data editor) 'unquote-splicing 'unquote) - (read (nested-content-port nested)))) + (read (editor-content-port editor)))) (super-new))))) diff --git a/collects/mred/wxme/text.ss b/collects/mred/wxme/text.ss index 4e3839a5b5..a741b936b3 100644 --- a/collects/mred/wxme/text.ss +++ b/collects/mred/wxme/text.ss @@ -1,15 +1,16 @@ (module text mzscheme (require (lib "class.ss") - "../wxmefile.ss" - "nested.ss") + "wxme.ss" + "editor.ss" + "private/readable-editor.ss") (provide reader) (define reader - (new (class nested-reader% - (define/override (generate-special nested src line col pos) - (let ([port (nested-content-port nested)]) + (new (class editor-reader% + (define/override (generate-special editor src line col pos) + (let ([port (editor-content-port editor)]) (let loop ([accum null]) (let ([s (read-bytes 4096 port)]) (if (eof-object? s) diff --git a/collects/mred/wxme/wxme.ss b/collects/mred/wxme/wxme.ss index b44af9ea13..442b0a0470 100644 --- a/collects/mred/wxme/wxme.ss +++ b/collects/mred/wxme/wxme.ss @@ -3,7 +3,9 @@ (require (lib "port.ss") (lib "string.ss") (lib "kw.ss") - (lib "class.ss")) + (lib "class.ss") + "image.ss" + "editor.ss") (define (expect rx port who msg) (let ([m (regexp-match rx port)]) @@ -50,7 +52,7 @@ (define (read-editor-footers who port vers header) (discard-headers/footers who port vers)) - (define (read-nested-editor who port vers header) + (define (read-editor-snip who port vers header) (let ([cnt (read-editor who port vers header)]) (let loop ([cnt cnt][accum null]) (if (zero? cnt) @@ -320,9 +322,6 @@ (define-values (prop:readable readable? readable-ref) (make-struct-type-property 'readable)) - (define-struct nested (content-port)) - (define-struct image (filename data w h dx dy)) - (define (find-class pos header who port vers) (define classes (header-classes header)) (unless (< -1 pos (vector-length classes)) @@ -370,10 +369,10 @@ (read-integer who port vers "nested-editor tight-fit?")) (when (cvers . > . 2) (read-integer who port vers "nested-editor alignment")) - (let ([n (read-nested-editor who port vers header)]) + (let ([n (read-editor-snip who port vers header)]) (if (header-plain-text? header) n - (make-nested n))))] + (make-editor n))))] [(equal? name #"wximage") (lambda (who port vers cvers header) (let ([filename (read-a-string who port vers "image-snip filename")] @@ -450,9 +449,9 @@ (define/public (read-bytes what) (read-a-string who port vers what)) - (public [rne read-nested-editor]) + (public [rne read-editor-snip]) (define (rne) - (read-nested-editor who port vers header)) + (read-editor-snip who port vers header)) (super-new))) @@ -552,7 +551,7 @@ (define unknown-extensions-skip-enabled (make-parameter #f)) - (define/kw (decode-wxme-stream port #:optional [snip-filter (lambda (x) x)]) + (define/kw (wxme-port->port port #:optional [snip-filter (lambda (x) x)]) ;; read optional #reader header: (regexp-match/fail-without-reading #rx#"^#reader[(]lib\"wxme.ss\"\"mred\"[)]" port) ;; decode: @@ -584,11 +583,9 @@ (lambda (port) (read-syntax source-name-v port)))) - (provide register-lib-mapping! + (provide wxme-port->port + register-lib-mapping! unknown-extensions-skip-enabled - decode-wxme-stream - (struct nested (content-port)) - (struct image (filename data w h dx dy)) prop:readable wxme:read wxme:read-syntax)) diff --git a/collects/mred/wxme/xml.ss b/collects/mred/wxme/xml.ss index c261fd530a..619acc89a8 100644 --- a/collects/mred/wxme/xml.ss +++ b/collects/mred/wxme/xml.ss @@ -3,23 +3,24 @@ (require (lib "class.ss") (lib "xml.ss" "xml") (lib "list.ss") - "../wxmefile.ss" - "nested.ss") + "wxme.ss" + "editor.ss" + "private/readable-editor.ss") (provide reader) (define reader - (new (class nested-reader% - (inherit read-nested-snip) + (new (class editor-reader% + (inherit read-editor-snip) (define/override (read-snip text? vers stream) (let ([elim-whitespace? (zero? (send stream read-integer "elim-whitespace?"))]) - (read-nested-snip text? vers stream elim-whitespace?))) + (read-editor-snip text? vers stream elim-whitespace?))) - (define/override (generate-special nested src line col pos) - (let* ([port (nested-content-port nested)] + (define/override (generate-special editor src line col pos) + (let* ([port (editor-content-port editor)] [xml (read-xml port)] [xexpr (xml->xexpr (document-element xml))] - [clean-xexpr (if (readable-nested-data nested) + [clean-xexpr (if (readable-editor-data editor) (eliminate-whitespace-in-empty-tags xexpr) xexpr)]) (list 'quasiquote clean-xexpr)))