suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

better wxme organization

Browse Source 
svn: r5396
This commit is contained in:
Matthew Flatt 2007-01-18 14:06:30 +00:00
parent ca93f4e358
commit 8fd3137117
14 changed files with 96 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
collects/mred/doc.txt
View File

@ -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.

6
collects/mred/wxme/comment.ss
View File

@ -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?

4
collects/mred/wxmecompat.ss → collects/mred/wxme/compat.ss
View File

@ -1,6 +1,6 @@
(module wxmecompat mzscheme
(require "wxmefile.ss")
(module compat mzscheme
(require "wxme.ss")
(register-lib-mapping!
"(lib \"comment-snip.ss\" \"framework\")"

4
collects/mred/wxme/doc.txt Normal file
View File

@ -0,0 +1,4 @@
_wxme.ss_
Utilities for reading PLT graphical format files without MrEd.

6
collects/mred/wxme/editor.ss Normal file
View File

@ -0,0 +1,6 @@
(module editor mzscheme
(define-struct editor (content-port))
(provide (struct editor (content-port))))

4
collects/mred/wxme/image.ss Normal file
View File

@ -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))))

5
collects/mred/wxme/info.ss Normal file
View File

@ -0,0 +1,5 @@
(module info (lib "infotab.ss" "setup")
(define doc.txt "doc.txt")
(define name "WXME"))

29
collects/mred/wxme/nested.ss
View File

@ -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))))

2
collects/mred/wxme/number.ss
View File

@ -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)))))

30
collects/mred/wxme/private/readable-editor.ss Normal file
View File

@ -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))))

17
collects/mred/wxme/scheme.ss
View File

@ -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)))))

11
collects/mred/wxme/text.ss
View File

@ -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)

25
collects/mred/wxme/wxme.ss
View File

@ -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))

17
collects/mred/wxme/xml.ss
View File

@ -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)))