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

fix the collapsed snipclass so that it cooperates with the wxme library and

Browse Source 
thus saved files with collapsed snips can be required in non-GUI contexts
This commit is contained in:
Robby Findler 2011-09-12 09:56:43 -05:00
parent cbaa25c2b0
commit 89ef65a746
8 changed files with 749 additions and 55 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
collects/framework/collapsed-snipclass-wxme.rkt Normal file
View File

@ -0,0 +1,24 @@
#lang racket/base
(require racket/class
racket/snip
wxme)
(provide reader)
(define what "collapsed-sexp")
(define reader
(new (class* object% (snip-reader<%>)
(define/public (read-header version stream) (void))
(define/public (read-snip text-only? version stream)
(define left (send stream read-bytes what))
(define right (send stream read-bytes what))
(define count (send stream read-integer what))
(define snips
(for/list ([x (in-range 0 count)])
(define snip-class-name (bytes->string/utf-8 (send stream read-bytes what)))
(read-snip-from-port snip-class-name
'collapsed-snipclass-wxme.rkt
stream)))
(apply bytes-append snips))
(super-new))))

8
collects/framework/collapsed-snipclass.rkt
View File

@ -18,11 +18,17 @@
#f #f
(read (open-input-text-editor text)) (read (open-input-text-editor text))
(list file line col pos 1))) (list file line col pos 1)))
(define/override (copy)
(new simple-sexp-snip%
[left-bracket left-bracket]
[right-bracket right-bracket]
[saved-snips saved-snips]))
(super-new))) (super-new)))
(define sexp-snipclass% (make-sexp-snipclass% simple-sexp-snip%)) (define sexp-snipclass% (make-sexp-snipclass% simple-sexp-snip%))
(define snip-class (make-object sexp-snipclass%)) (define snip-class (make-object sexp-snipclass%))
(send snip-class set-classname (format "~s" '(lib "collapsed-snipclass.ss" "framework"))) (send snip-class set-classname (format "~s" '((lib "collapsed-snipclass.ss" "framework")
(lib "collapsed-snipclass-wxme.ss" "framework"))))
(send snip-class set-version 0) (send snip-class set-version 0)
(send (get-the-snip-class-list) add snip-class) (send (get-the-snip-class-list) add snip-class)

34
collects/framework/private/collapsed-snipclass-helpers.rkt
View File

@ -1,26 +1,22 @@
#lang scheme/base #lang racket/base
(require scheme/gui/base (require racket/gui/base
scheme/class) racket/class)
(provide make-sexp-snipclass%) (provide make-sexp-snipclass%)
(define (make-sexp-snipclass% sexp-snip%) (define (make-sexp-snipclass% sexp-snip%)
(class snip-class% (class snip-class%
(define/override (read in) (define/override (read in)
(let* ([left-bracket (integer->char (bytes-ref (send in get-bytes) 0))] (define left-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
[right-bracket (integer->char (bytes-ref (send in get-bytes) 0))] (define right-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
[snip-count (send in get-exact)] (define snip-count (send in get-exact))
[saved-snips (define saved-snips
(let loop ([n snip-count]) (for/list ([in-range snip-count])
(cond (define classname (bytes->string/utf-8 (send in get-bytes)))
[(zero? n) null] (define snipclass (send (get-the-snip-class-list) find classname))
[else (send snipclass read in)))
(let* ([classname (bytes->string/utf-8 (send in get-bytes))] (new sexp-snip%
[snipclass (send (get-the-snip-class-list) find classname)]) [left-bracket left-bracket]
(cons (send snipclass read in) [right-bracket right-bracket]
(loop (- n 1))))]))]) [saved-snips saved-snips]))
(instantiate sexp-snip% ()
(left-bracket left-bracket)
(right-bracket right-bracket)
(saved-snips saved-snips))))
(super-new))) (super-new)))

3
collects/framework/private/scheme.rkt
View File

@ -149,7 +149,8 @@
;; old snips (from old versions of drscheme) use this snipclass ;; old snips (from old versions of drscheme) use this snipclass
(define lib-snip-class (make-object sexp-snipclass%)) (define lib-snip-class (make-object sexp-snipclass%))
(send lib-snip-class set-classname (format "~s" '(lib "collapsed-snipclass.ss" "framework"))) (send lib-snip-class set-classname (format "~s" '((lib "collapsed-snipclass.ss" "framework")
(lib "collapsed-snipclass-wxme.ss" "framework"))))
(send lib-snip-class set-version 0) (send lib-snip-class set-version 0)
(send (get-the-snip-class-list) add lib-snip-class) (send (get-the-snip-class-list) add lib-snip-class)

313
collects/tests/drracket/snip/collapsed-nested.rkt Normal file
View File

@ -0,0 +1,313 @@
#reader(lib"read.ss""wxme")WXME0108 ##
#|
This file uses the GRacket editor format.
Open this file in DrRacket version 5.1.3.8 or later to read it.
Most likely, it was created by saving a program in DrRacket,
and it probably contains a program with non-text elements
(such as images or comment boxes).
http://racket-lang.org/
|#
44 7 #"wxtext\0"
3 1 6 #"wxtab\0"
1 1 8 #"wximage\0"
2 0 8 #"wxmedia\0"
4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0"
1 0 16 #"drscheme:number\0"
3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0"
1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0"
1 0 93
(
#"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni"
#"pclass-wxme.ss\" \"framework\"))\0"
) 0 0 19 #"drscheme:sexp-snip\0"
0 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0"
1 0 68
(
#"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr"
#"lib\"))\0"
) 1 0 33 #"(lib \"bullet-snip.ss\" \"browser\")\0"
0 0 29 #"drscheme:bindings-snipclass%\0"
1 0 25 #"(lib \"matrix.ss\" \"htdp\")\0"
1 0 22 #"drscheme:lambda-snip%\0"
1 0 8 #"gb:core\0"
5 0 10 #"gb:canvas\0"
5 0 17 #"gb:editor-canvas\0"
5 0 10 #"gb:slider\0"
5 0 9 #"gb:gauge\0"
5 0 11 #"gb:listbox\0"
5 0 12 #"gb:radiobox\0"
5 0 10 #"gb:choice\0"
5 0 8 #"gb:text\0"
5 0 11 #"gb:message\0"
5 0 10 #"gb:button\0"
5 0 12 #"gb:checkbox\0"
5 0 18 #"gb:vertical-panel\0"
5 0 9 #"gb:panel\0"
5 0 20 #"gb:horizontal-panel\0"
5 0 33 #"(lib \"readable.ss\" \"guibuilder\")\0"
1 0 57
#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0"
1 0 45 #"(lib \"image-snipr.ss\" \"slideshow\" \"private\")\0"
1 0 26 #"drscheme:pict-value-snip%\0"
0 0 38 #"(lib \"pict-snipclass.ss\" \"slideshow\")\0"
2 0 55 #"(lib \"vertical-separator-snip.ss\" \"stepper\" \"private\")\0"
1 0 18 #"drscheme:xml-snip\0"
1 0 31 #"(lib \"xml-snipclass.ss\" \"xml\")\0"
1 0 21 #"drscheme:scheme-snip\0"
2 0 34 #"(lib \"scheme-snipclass.ss\" \"xml\")\0"
1 0 10 #"text-box%\0"
1 0 32 #"(lib \"text-snipclass.ss\" \"xml\")\0"
1 0 15 #"test-case-box%\0"
2 0 1 6 #"wxloc\0"
0 0 58 0 1 #"\0"
0 75 1 #"\0"
0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9
#"Standard\0"
0 75 25 #"Bitstream Vera Sans Mono\0"
0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24
#"framework:default-color\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15
#"text:ports out\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 192 46 214 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
-1 2 15 #"text:ports err\0"
0 -1 1 #"\0"
1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
-1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17
#"text:ports value\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 57 89 216 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
-1 2 27 #"Matching Parenthesis Style\0"
0 -1 1 #"\0"
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
-1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
37 #"framework:syntax-color:scheme:symbol\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
38 #"framework:syntax-color:scheme:keyword\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 249 148 40 0 0 0 -1 -1 2
38 #"framework:syntax-color:scheme:comment\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 249 148 40 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 51 174 51 0 0 0 -1 -1 2 37
#"framework:syntax-color:scheme:string\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 51 174 51 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 60 194 57 0 0 0 -1 -1 2 39
#"framework:syntax-color:scheme:constant\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 60 194 57 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 151 69 43 0 0 0 -1 -1 2 42
#"framework:syntax-color:scheme:parenthesis\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 151 69 43 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36
#"framework:syntax-color:scheme:error\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
36 #"framework:syntax-color:scheme:other\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 163 255 0 0 0 -1 -1 2
38 #"drracket:check-syntax:lexically-bound\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 163 255 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
28 #"drracket:check-syntax:set!d\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
37 #"drracket:check-syntax:unused-require\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
36 #"drracket:check-syntax:free-variable\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 166 0 255 0 0 0 -1 -1 2 31
#"drracket:check-syntax:imported\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 166 0 255 0 0 0 -1 -1 2 47
#"drracket:check-syntax:my-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 205 50 0 0 0 -1 -1 2 50
#"drracket:check-syntax:their-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 205 50 0 0 0 -1 -1 2 48
#"drracket:check-syntax:unk-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 240 230 140 0 0 0 -1 -1 2
49 #"drracket:check-syntax:both-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 240 230 140 0 0 0 -1 -1 2
26 #"plt:htdp:test-coverage-on\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 2 27
#"plt:htdp:test-coverage-off\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 4 1
#"\0"
0 70 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 4 4 #"XML\0"
0 70 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 37
#"plt:module-language:test-coverage-on\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 2 38
#"plt:module-language:test-coverage-off\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 0 1
#"\0"
0 75 25 #"Bitstream Vera Sans Mono\0"
0.0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0.0 0.0 0.0 0.0 0.0 0.0 0 0 0 255
255 255 1 -1 2 1 #"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 192 46 214 0
0 0 -1 -1 2 1 #"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 57 89 216 0
0 0 -1 -1 4 1 #"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 4 1 #"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 0 0 255 0 0
0 -1 -1 4 1 #"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 0 0 255 0 0
0 -1 -1 4 1 #"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0.0 0.0 0.0 1.0 1.0 1.0 0 100 0 0 0
0 -1 -1 0 43 0 27 3 12 #"#lang racket"
0 0 4 29 1 #"\n"
0 0 23 3 1 #"("
0 0 15 3 6 #"define"
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"f"
0 0 4 3 1 #" "
0 0 14 3 1 #"x"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 3 2 #" "
0 8 84 4 2 #"(\0"
2 #")\0"
7 7 #"wxtext\0"
3 1 #"("
7 #"wxtext\0"
3 1 #"+"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #"1"
7 #"wxtext\0"
3 1 #" "
93
(
#"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni"
#"pclass-wxme.ss\" \"framework\"))\0"
) 2 #"(\0"
2 #")\0"
8 7 #"wxtext\0"
3 1 #"("
7 #"wxtext\0"
3 1 #"+"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #"1"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #"x"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #")"
7 #"wxtext\0"
3 1 #")"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 29 1 #"\n"
0 0 23 3 1 #"("
0 0 14 3 2 #"if"
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"="
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"f"
0 0 4 3 1 #" "
0 0 21 3 1 #"4"
0 0 23 3 1 #")"
0 0 4 3 1 #" "
0 0 21 3 1 #"6"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 3 4 #" "
0 0 21 3 1 #"'"
0 0 14 3 6 #"passed"
0 0 4 29 1 #"\n"
0 0 4 3 4 #" "
0 0 23 3 1 #"("
0 0 14 3 5 #"error"
0 0 4 3 1 #" "
0 0 21 3 1 #"'"
0 0 14 3 6 #"failed"
0 0 23 3 2 #"))"
0 0 4 29 1 #"\n"
0 0

284
collects/tests/drracket/snip/collapsed2.rkt Normal file
View File

@ -0,0 +1,284 @@
#reader(lib"read.ss""wxme")WXME0108 ##
#|
This file uses the GRacket editor format.
Open this file in DrRacket version 5.1.3.7 or later to read it.
Most likely, it was created by saving a program in DrRacket,
and it probably contains a program with non-text elements
(such as images or comment boxes).
http://racket-lang.org/
|#
44 7 #"wxtext\0"
3 1 6 #"wxtab\0"
1 1 8 #"wximage\0"
2 0 8 #"wxmedia\0"
4 1 34 #"(lib \"syntax-browser.ss\" \"mrlib\")\0"
1 0 16 #"drscheme:number\0"
3 0 44 #"(lib \"number-snip.ss\" \"drscheme\" \"private\")\0"
1 0 36 #"(lib \"comment-snip.ss\" \"framework\")\0"
1 0 93
(
#"((lib \"collapsed-snipclass.ss\" \"framework\") (lib \"collapsed-sni"
#"pclass-wxme.ss\" \"framework\"))\0"
) 0 0 19 #"drscheme:sexp-snip\0"
0 0 36 #"(lib \"cache-image-snip.ss\" \"mrlib\")\0"
1 0 68
(
#"((lib \"image-core.ss\" \"mrlib\") (lib \"image-core-wxme.rkt\" \"mr"
#"lib\"))\0"
) 1 0 33 #"(lib \"bullet-snip.ss\" \"browser\")\0"
0 0 29 #"drscheme:bindings-snipclass%\0"
1 0 25 #"(lib \"matrix.ss\" \"htdp\")\0"
1 0 22 #"drscheme:lambda-snip%\0"
1 0 8 #"gb:core\0"
5 0 10 #"gb:canvas\0"
5 0 17 #"gb:editor-canvas\0"
5 0 10 #"gb:slider\0"
5 0 9 #"gb:gauge\0"
5 0 11 #"gb:listbox\0"
5 0 12 #"gb:radiobox\0"
5 0 10 #"gb:choice\0"
5 0 8 #"gb:text\0"
5 0 11 #"gb:message\0"
5 0 10 #"gb:button\0"
5 0 12 #"gb:checkbox\0"
5 0 18 #"gb:vertical-panel\0"
5 0 9 #"gb:panel\0"
5 0 20 #"gb:horizontal-panel\0"
5 0 33 #"(lib \"readable.ss\" \"guibuilder\")\0"
1 0 57
#"(lib \"hrule-snip.rkt\" \"macro-debugger\" \"syntax-browser\")\0"
1 0 45 #"(lib \"image-snipr.ss\" \"slideshow\" \"private\")\0"
1 0 26 #"drscheme:pict-value-snip%\0"
0 0 38 #"(lib \"pict-snipclass.ss\" \"slideshow\")\0"
2 0 55 #"(lib \"vertical-separator-snip.ss\" \"stepper\" \"private\")\0"
1 0 18 #"drscheme:xml-snip\0"
1 0 31 #"(lib \"xml-snipclass.ss\" \"xml\")\0"
1 0 21 #"drscheme:scheme-snip\0"
2 0 34 #"(lib \"scheme-snipclass.ss\" \"xml\")\0"
1 0 10 #"text-box%\0"
1 0 32 #"(lib \"text-snipclass.ss\" \"xml\")\0"
1 0 15 #"test-case-box%\0"
2 0 1 6 #"wxloc\0"
0 0 55 0 1 #"\0"
0 75 1 #"\0"
0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 0 9
#"Standard\0"
0 75 25 #"Bitstream Vera Sans Mono\0"
0 10 90 -1 90 -1 3 -1 0 1 0 1 0 0 0 0 0 0 0 0 0 0 0 255 255 255 1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1 1 1 1 1 1 0 0 0 0 0 0 -1 -1 2 24
#"framework:default-color\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 150 0 150 0 0 0 -1 -1 2 15
#"text:ports out\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 192 46 214 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
-1 2 15 #"text:ports err\0"
0 -1 1 #"\0"
1.0 0 -1 -1 93 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 255 0 0 0 0 0 -1
-1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 0 0 175 0 0 0 -1 -1 2 17
#"text:ports value\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 57 89 216 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
-1 2 27 #"Matching Parenthesis Style\0"
0 -1 1 #"\0"
1.0 0 92 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 34 139 34 0 0 0 -1
-1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
37 #"framework:syntax-color:scheme:symbol\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
38 #"framework:syntax-color:scheme:keyword\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 102 102 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 249 148 40 0 0 0 -1 -1 2
38 #"framework:syntax-color:scheme:comment\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 249 148 40 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 51 174 51 0 0 0 -1 -1 2 37
#"framework:syntax-color:scheme:string\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 51 174 51 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 60 194 57 0 0 0 -1 -1 2 39
#"framework:syntax-color:scheme:constant\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 60 194 57 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 151 69 43 0 0 0 -1 -1 2 42
#"framework:syntax-color:scheme:parenthesis\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 151 69 43 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 36
#"framework:syntax-color:scheme:error\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 0 0 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
36 #"framework:syntax-color:scheme:other\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 163 255 0 0 0 -1 -1 2
38 #"drracket:check-syntax:lexically-bound\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 163 255 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
28 #"drracket:check-syntax:set!d\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
37 #"drracket:check-syntax:unused-require\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
36 #"drracket:check-syntax:free-variable\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 166 0 255 0 0 0 -1 -1 2 31
#"drracket:check-syntax:imported\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 166 0 255 0 0 0 -1 -1 2 47
#"drracket:check-syntax:my-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 192 203 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 205 50 0 0 0 -1 -1 2 50
#"drracket:check-syntax:their-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 50 205 50 0 0 0 -1 -1 2 48
#"drracket:check-syntax:unk-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 240 230 140 0 0 0 -1 -1 2
49 #"drracket:check-syntax:both-obligation-style-pref\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 240 230 140 0 0 0 -1 -1 2
26 #"plt:htdp:test-coverage-on\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 255 255 255 0 0 0 -1 -1 2
1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 2 27
#"plt:htdp:test-coverage-off\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 0 0 0 205 92 92 0 0 0 -1 -1 4 1
#"\0"
0 70 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 4 4 #"XML\0"
0 70 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 2 1 #"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 37
#"plt:module-language:test-coverage-on\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 34 139 34 0 0 0 -1 -1 2 1
#"\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 2 38
#"plt:module-language:test-coverage-off\0"
0 -1 1 #"\0"
1 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1 1 1 176 48 96 0 0 0 -1 -1 4 1
#"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 1.0 1.0 1.0 1.0 1.0 1.0 0 0 0 0 0 0
-1 -1 4 1 #"\0"
0 -1 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1
-1 4 1 #"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 1 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 0 255 0 0 0 -1
-1 4 1 #"\0"
0 71 1 #"\0"
1.0 0 -1 -1 -1 -1 -1 -1 0 0 0 0 0 0 0 0 0 1.0 1.0 1.0 0 100 0 0 0 0 -1
-1 0 43 0 27 3 12 #"#lang racket"
0 0 4 29 1 #"\n"
0 0 23 3 1 #"("
0 0 15 3 6 #"define"
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"f"
0 0 4 3 1 #" "
0 0 14 3 1 #"x"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 3 2 #" "
0 8 42 4 2 #"(\0"
2 #")\0"
7 7 #"wxtext\0"
3 1 #"("
7 #"wxtext\0"
3 1 #"+"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #"x"
7 #"wxtext\0"
3 1 #" "
7 #"wxtext\0"
3 1 #"1"
7 #"wxtext\0"
3 1 #")"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 29 1 #"\n"
0 0 23 3 1 #"("
0 0 14 3 2 #"if"
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"="
0 0 4 3 1 #" "
0 0 23 3 1 #"("
0 0 14 3 1 #"f"
0 0 4 3 1 #" "
0 0 21 3 1 #"4"
0 0 23 3 1 #")"
0 0 4 3 1 #" "
0 0 21 3 1 #"5"
0 0 23 3 1 #")"
0 0 4 29 1 #"\n"
0 0 4 3 4 #" "
0 0 21 3 1 #"'"
0 0 14 3 6 #"passed"
0 0 4 29 1 #"\n"
0 0 4 3 4 #" "
0 0 23 3 1 #"("
0 0 14 3 5 #"error"
0 0 4 3 1 #" "
0 0 21 3 1 #"'"
0 0 14 3 6 #"failed"
0 0 23 3 2 #"))"
0 0 4 29 1 #"\n"
0 0

38
collects/tests/drracket/snip/run-all.rkt Normal file
View File

@ -0,0 +1,38 @@
#lang racket/base
(require racket/gui/base)
(require racket/runtime-path)
(define-runtime-path here ".")
(define known-wxme-failures '("collapsed.rkt"))
(define ((record-failure f gui?) exn)
(eprintf "failed to load ~a in ~a mode\n" f (if gui? "gui" "wxme"))
((error-display-handler) (exn-message exn) exn))
(define tried 0)
(define gui-namespace (make-gui-namespace))
(define base-namespace (make-base-namespace))
(parameterize ([use-compiled-file-paths '()])
;; setting the use-compiled-file-paths here is important
;; so we don't "cheat" by using the wxme version to compile
;; the file and then just avoid using the GUI version at all.
(for ([f (in-list (directory-list here))])
(define f-str (path->string f))
(unless (member f-str '("info.rkt" "run-all.rkt"))
(when (regexp-match #rx"[.]rkt$" f-str)
(parameterize ([current-namespace gui-namespace])
(set! tried (+ tried 1))
(with-handlers ((exn:fail? (record-failure f #t)))
(dynamic-require (build-path here f) #f)))
(unless (member f-str known-wxme-failures)
(parameterize ([current-namespace base-namespace])
(set! tried (+ tried 1))
(with-handlers ((exn:fail? (record-failure f #f)))
(dynamic-require (build-path here f) #f))))))))
(printf "tried ~a files\n" tried)

100
collects/wxme/wxme.rkt
View File

@ -2,7 +2,7 @@
(require mzlib/port (require mzlib/port
mzlib/string mzlib/string
mzlib/kw mzlib/kw
mzlib/class racket/class
racket/contract racket/contract
mzlib/list mzlib/list
scheme/gui/dynamic scheme/gui/dynamic
@ -214,41 +214,45 @@
(snip-class-manager class) (snip-class-manager class)
(not (and len (not (and len
(header-skip-content? header)))) (header-skip-content? header))))
(let ([style (read-integer who port vers "snip style index")] (let ([style (read-integer who port vers "snip style index")])
[m (snip-class-manager class)] (read-snip/given-class class who port vers header #f))
[cvers (snip-class-version class)])
(let ([s (if (procedure? m)
;; Built-in snip class:
(m who port vers cvers header)
;; Extension snip class:
(let* ([text? (header-plain-text? header)]
[s (send m read-snip
text?
cvers
(header-stream header))])
(if (and text?
(not (bytes? s)))
(error 'read-snip
"reader for ~a in text-only mode produced something other than bytes: ~e"
(snip-class-name class)
s)
s)))])
(read-buffer-data who port vers header)
(if (header-skip-content? header)
#""
(if (bytes? s)
;; Return bytes for the stream:
s
;; Filter the non-bytes result, and then wrap it as
;; a special stream result:
(let ([s ((header-snip-filter header) s)])
(lambda (src line col pos)
(if (s . is-a? . readable<%>)
(send s read-special src line col pos)
s)))))))
(begin (begin
(skip-data port vers len) (skip-data port vers len)
#"")))))) #""))))))
(define (read-snip/given-class class who port vers header skip-buffer-data?)
(let ([cvers (snip-class-version class)])
(define manager (snip-class-manager class))
(define name (snip-class-name class))
(let ([s (if (procedure? manager)
;; Built-in snip class:
(manager who port vers cvers header)
;; Extension snip class:
(let* ([text? (header-plain-text? header)]
[s (send manager read-snip
text?
cvers
(header-stream header))])
(if (and text?
(not (bytes? s)))
(error 'read-snip
"reader for ~a in text-only mode produced something other than bytes: ~e"
name
s)
s)))])
(unless skip-buffer-data? (read-buffer-data who port vers header))
(if (header-skip-content? header)
#""
(if (bytes? s)
;; Return bytes for the stream:
s
;; Filter the non-bytes result, and then wrap it as
;; a special stream result:
(let ([s ((header-snip-filter header) s)])
(lambda (src line col pos)
(if (s . is-a? . readable<%>)
(send s read-special src line col pos)
s))))))))
(define (read-buffer-data who port vers header) (define (read-buffer-data who port vers header)
(let loop () (let loop ()
@ -378,6 +382,21 @@
(interface () (interface ()
read-special)) read-special))
(define (find-class/name name header who port vers used?)
(define classes-vec (header-classes header))
(define pos
(let loop ([i 0])
(cond
[(< i (vector-length classes-vec))
(if (equal? (bytes->string/latin-1 (snip-class-name (vector-ref classes-vec i)))
name)
i
(loop (+ i 1)))]
[else #f])))
(unless pos
(read-error who (format "class index for ~s" name) "known class name" port))
(find-class pos header who port vers used?))
(define (find-class pos header who port vers used?) (define (find-class pos header who port vers used?)
(define classes (header-classes header)) (define classes (header-classes header))
(unless (< -1 pos (vector-length classes)) (unless (< -1 pos (vector-length classes))
@ -507,10 +526,15 @@
(error who "cannot load data-class managers, yet"))]))) (error who "cannot load data-class managers, yet"))])))
data-class)) data-class))
(define-local-member-name get-vers get-header get-port)
(define stream% (define stream%
(class object% (class object%
(init-field who port vers header) (init-field who port vers header)
(define/public (get-vers) vers)
(define/public (get-header) header)
(define/public (get-port) port)
(public [rfi read-fixed-integer]) (public [rfi read-fixed-integer])
(define (rfi what) (define (rfi what)
(read-fixed-integer who port vers what)) (read-fixed-integer who port vers what))
@ -705,12 +729,20 @@
(decode 'extract-used-classes port (lambda (x) x) #f #t)) (decode 'extract-used-classes port (lambda (x) x) #f #t))
(values null null))) (values null null)))
(define (read-snip-from-port name who stream)
(define vers (send stream get-vers))
(define header (send stream get-header))
(define port (send stream get-port))
(define class (find-class/name name header who port vers #t))
(read-snip/given-class class who port vers header #t))
(provide/contract [is-wxme-stream? (input-port? . -> . any)] (provide/contract [is-wxme-stream? (input-port? . -> . any)]
[wxme-port->text-port (->* (input-port?) (any/c) input-port?)] [wxme-port->text-port (->* (input-port?) (any/c) input-port?)]
[wxme-port->port (->* (input-port?) (any/c (any/c . -> . any)) input-port?)] [wxme-port->port (->* (input-port?) (any/c (any/c . -> . any)) input-port?)]
[register-lib-mapping! (string? string? . -> . void?)] [register-lib-mapping! (string? string? . -> . void?)]
[string->lib-path (string? any/c . -> . any)] [string->lib-path (string? any/c . -> . any)]
[extract-used-classes (input-port? . -> . any)]) [extract-used-classes (input-port? . -> . any)]
[read-snip-from-port (-> string? any/c (is-a?/c stream<%>) any)])
(provide unknown-extensions-skip-enabled (provide unknown-extensions-skip-enabled
broken-wxme-big-endian? broken-wxme-big-endian?