[plt-scheme] a snip copy/paste puzzle

From: Jordan Johnson (jmj at fellowhuman.com)
Date: Sat Aug 8 02:57:22 EDT 2009

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?


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


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


(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- 
         (inherit copy-self-to)
         (init-field [kind 'default])
         (define/override (copy-self)
           (let ([ed (new scheme+copy-self%)])
             (copy-self-to ed)
         (inherit set-max-undo-history)
         (set-max-undo-history 'forever)))
     (class aligned-pasteboard%

       ;;;;;;; Component editors:
       ;; code-editor and anno-editor are the two text%s that contain  
       ;; 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  
       ;; 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)


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

(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)]))

Posted on the users mailing list.