suzanne.soy/gui
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

original commit: 89ef65a7461a4b91cd3f0c28231f74c593f165ee
This commit is contained in:
Robby Findler 2011-09-12 09:56:43 -05:00
parent 995c2935ba
commit bbe4958a59
4 changed files with 48 additions and 21 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
(read (open-input-text-editor text))
(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)))
(define sexp-snipclass% (make-sexp-snipclass% simple-sexp-snip%))
(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 (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
(require scheme/gui/base
scheme/class)
#lang racket/base
(require racket/gui/base
racket/class)
(provide make-sexp-snipclass%)
(define (make-sexp-snipclass% sexp-snip%)
(class snip-class%
(define/override (read in)
(let* ([left-bracket (integer->char (bytes-ref (send in get-bytes) 0))]
[right-bracket (integer->char (bytes-ref (send in get-bytes) 0))]
[snip-count (send in get-exact)]
[saved-snips
(let loop ([n snip-count])
(cond
[(zero? n) null]
[else
(let* ([classname (bytes->string/utf-8 (send in get-bytes))]
[snipclass (send (get-the-snip-class-list) find classname)])
(cons (send snipclass read in)
(loop (- n 1))))]))])
(instantiate sexp-snip% ()
(left-bracket left-bracket)
(right-bracket right-bracket)
(saved-snips saved-snips))))
(define left-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
(define right-bracket (integer->char (bytes-ref (send in get-bytes) 0)))
(define snip-count (send in get-exact))
(define saved-snips
(for/list ([in-range snip-count])
(define classname (bytes->string/utf-8 (send in get-bytes)))
(define snipclass (send (get-the-snip-class-list) find classname))
(send snipclass read in)))
(new sexp-snip%
[left-bracket left-bracket]
[right-bracket right-bracket]
[saved-snips saved-snips]))
(super-new)))

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

@ -149,7 +149,8 @@
;; old snips (from old versions of drscheme) use this 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 (get-the-snip-class-list) add lib-snip-class)