[plt-scheme] a snip copy/paste puzzle
Hi all,
I've been working on a snip implementation (representing an annotated
expression) and am getting a mysterious error. I'd be grateful for
any help the community can offer in solving the problem.
The error: Currently when I attempt to copy and paste my snip, I get
the error
set-editor method of editor-snip%: expects argument of type
<interface:editor% instance>; given #f
...and the editor-snip% in question is apparently not any of the snips
I've defined, which I've verified by overriding their set-editor
method. This error is coming from somewhere deep in MrEd, and (after
embarrassingly many hours of reading internal code and probing/
rewriting) I don't see the cause.
Below is a version I've pared down to just what's necessary to see the
structure and exercise the bug. To reproduce the error: run it,
evaluate (test-w/text%), and attempt to copy and paste the editor-snip
% you see in the frame it created.
Any observations?
Thanks,
jmj
;;;;;;; code-desc-simplified.ss
#lang scheme/gui
(require framework embedded-gui)
(provide anno-snip%)
;;;;;;;;;; Snipclassery (for cut/paste) ;;;;;;;;;;;
;; Design follows framework/private/comment-box.ss lines 23-31
(define anno-snipclass%
(class decorated-editor-snipclass%
(define/override (make-snip stream-in) (new anno-snip%))
(define/override (read in)
(let ([pb (new anno-pb%)])
(let ([code-ed (send pb get-code-editor)]
[anno-ed (send pb get-anno-editor)])
(send code-ed read-from-file in 'start)
(send anno-ed read-from-file in 'start))))
(super-new)))
(define snipclass (make-object anno-snipclass%))
(send snipclass set-version 1)
(send snipclass set-classname "code-desc-snip.ss")
(send (get-the-snip-class-list) add snipclass)
;;;; Snip representing an annotated chunk of code.
(define anno-snip%
(class decorated-editor-snip%
(define/override (make-editor) (new anno-pb%))
(define/override (make-snip) (new anno-snip%))
;; copy/paste:
(inherit get-editor)
(define/override (write stream-out)
(let ([pb (get-editor)])
(let ([code (send pb get-code-editor)]
[anno (send pb get-anno-editor)])
(send code write-to-file stream-out)
(send anno write-to-file stream-out))))
(define/override (copy) ;; -> anno-snip%
;; return a copy of this snip
(let ([s (new anno-snip%)])
(send s set-editor (send (get-editor) copy-self))
s))
(super-new)
))
(define anno-pb%
(let ()
(define (find-owner-snip ed) ;; editor<%> -> (union #f editor-snip
%)
(let ([admin (send ed get-admin)])
(and admin
(admin . is-a? . editor-snip-editor-admin<%>)
(send admin get-snip))))
(define scheme+copy-self% ;; class for the code editor
(class scheme:text% ;; (from framework/private/comment-
box.ss)
(inherit copy-self-to)
(init-field [kind 'default])
(define/override (copy-self)
(let ([ed (new scheme+copy-self%)])
(copy-self-to ed)
ed))
(super-new)
(inherit set-max-undo-history)
(set-max-undo-history 'forever)))
(class aligned-pasteboard%
(super-new)
;;;;;;; Component editors:
;; code-editor and anno-editor are the two text%s that contain
the
;; code and annotation, respectively.
;; -> (union #f text%)
(define/public (get-code-editor) code-editor)
(define/public (make-code-editor) (new scheme+copy-self%
[kind 'code]))
;; -> (union #f text%)
(define/public (get-anno-editor) anno-editor)
(define/public (make-anno-editor) (new text%))
(define code-editor (make-code-editor)) ;; code box's editor
(define anno-editor (make-anno-editor)) ;; annotation box's
;;;;;;; Container snips for the text editors:
(define val (new vertical-alignment% [parent this]))
;; Container for the code box. I'm using this for the ability to
;; show/hide the box:
(define code-view (new vertical-alignment%
[parent val]
[show? #t]))
;; Installs stretchable editor snips, if none are already
installed,
;; to contain the code and anno editors.
;; (Does nothing if they already are installed, and returns #f.)
;; Returns #t if successful.
(define (init-snips)
(and (not (or (find-owner-snip code-editor)
(find-owner-snip anno-editor)))
(let ([code-snip (new stretchable-editor-snip%
[editor code-editor]
[with-border? #t]
[min-width 50])]
[anno-snip (new stretchable-editor-snip%
[editor anno-editor]
[with-border? #f]
[min-width 50])])
(make-object snip-wrapper% code-view code-snip)
(make-object hline% code-view)
(make-object snip-wrapper% val anno-snip)
#t)))
(init-snips)
;;;;;;;;; copy+paste ;;;;;;;;;
(define/override (copy-self)
(let ([ed (new anno-pb%)])
(let ([ed-code (send ed get-code-editor)]
[ed-anno (send ed get-anno-editor)])
(send (get-code-editor) copy-self-to ed-code)
(send (get-anno-editor) copy-self-to ed-anno)
ed)))
)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (test-w/text%)
(define test-snip (new anno-snip%))
(define test-pb (send test-snip get-editor))
(define txt (new scheme:text%))
(define f (mk-test-frame))
(define c (new editor-canvas% [parent f][editor txt]))
(send txt insert "\n(* x 3)\n4))" 0)
(send txt insert test-snip 0)
(send txt insert "(define (f x)\n(+ " 0)
(send txt tabify-all)
(send f show #t)
)
(define (mk-test-frame)
(new frame% [label "ah"] [width 500] [height 300]
[alignment '(center center)]))