#lang scheme/gui

(require drscheme/tool
         framework
         embedded-gui ;; for aligned-pasteboard, stretchable snips, etc.
         srfi/2 ;; for and-let*
         scheme/runtime-path
         mzlib/unit
         )

(define-runtime-path ICON-PATH "expr.png")
(define-runtime-path ICON2-PATH "unbalanced-expr.png")

(provide tool@)

(define tool@
  (unit
    (import drscheme:tool^)
    (export drscheme:tool-exports^)

    (define (phase1)
      ;; Mixin below gets added to the mixin that must be mixed into any text%
      ;; object that might contain program text.  Q: must it be mixed in
      ;; to my code-editor's scheme:text% subclass?  Docs seem to indicate so.
      ;(drscheme:unit:add-to-program-editor-mixin
      ;  ...) ;; nothing necessary here, as far as I can tell.
      (void))
    (define (phase2)
      (void))

    (define annotate-item-label-string "Annotate this Code")
    (define insert-annotated-expression-label-string
      "Insert Annotated Code Box")

    ;;;;;;;;;;;;;;; Former contents of code-desc-snip.ss ;;;;;;;;;;;;;;
    
    ;; Icon for top-left of snip's visual rep:
    (define ICON (make-object bitmap% ICON-PATH))
    (define UNBALANCED-ICON (make-object bitmap% ICON2-PATH))
    
    (define MIN-TEXT-WIDTH 50) ;; minimum width of a code or anno editor
    
    ;;;;;;;;;; Snipclassery (for cut/paste) ;;;;;;;;;;;
    
    ;
    ;
    ;
    ;                     ;                     ;;;
    ;                                             ;
    ;                                             ;
    ;    ;;;;   ; ;;;   ;;;     ; ;;;     ;;;;    ;       ;;;;   ;;;;    ;;;;
    ;   ;    ;  ;;   ;    ;     ;;   ;   ;        ;      ;   ;  ;    ;  ;    ;
    ;   ;       ;    ;    ;     ;    ;  ;         ;     ;    ;  ;       ;
    ;    ;;     ;    ;    ;     ;    ;  ;         ;     ;    ;   ;;      ;;
    ;      ;;   ;    ;    ;     ;    ;  ;         ;     ;    ;     ;;      ;;
    ;        ;  ;    ;    ;     ;    ;  ;         ;     ;    ;       ;       ;
    ;   ;    ;  ;    ;    ;     ;   ;    ;        ;     ;   ;;  ;    ;  ;    ;
    ;    ;;;;   ;    ;    ;;;   ;;;;      ;;;;    ;;;    ;;; ;   ;;;;    ;;;;
    ;                           ;
    ;                           ;
    ;                           ;
    
    ;; framework/private/comment-box.ss lines 23-31
    (define anno-snipclass%
      (class decorated-editor-snipclass%
        (define/override (make-snip stream-in) (new anno-snip%))
        
        ;; editor-stream-in% -> anno-snip%
        ;; Reads an anno-snip% (contents and show/hide-code state) from the stream.
        (define/override (read in)
          (let* ([s (new anno-snip%)]
                 [pb (send s get-editor)])
            (let ([code-ed (send pb get-code-editor)]
                  [anno-ed (send pb get-anno-editor)]
                  [show-code? (box -1)])
              (send in get show-code?) ;; 0,1 <==> false,true
              (send code-ed read-from-file in 'start)
              (send anno-ed read-from-file in 'start)
              (send pb show-code (= (unbox show-code?) 1))
              s)))
        
        (super-new)))
    
    (define snipclass (make-object anno-snipclass%))
    (send snipclass set-version 1)
    (send snipclass set-classname
          (format "~s" '(lib annotated-snip/annotated-code-tool)))
    (send (get-the-snip-class-list) add snipclass)
    
    
    
;                                 
;                                 
;                                 
;                     ;           
;                                 
;                                 
;    ;;;;   ; ;;;   ;;;     ; ;;; 
;   ;    ;  ;;   ;    ;     ;;   ;
;   ;       ;    ;    ;     ;    ;
;    ;;     ;    ;    ;     ;    ;
;      ;;   ;    ;    ;     ;    ;
;        ;  ;    ;    ;     ;    ;
;   ;    ;  ;    ;    ;     ;   ; 
;    ;;;;   ;    ;    ;;;   ;;;;  
;                           ;     
;                           ;     
;                           ;     

    ;; Snip representing an annotated chunk of code.
    (define anno-snip%
      (class* decorated-editor-snip% (readable-snip<%>)
        (inherit get-editor)
        (define/override (make-editor) (new anno-pb%))
        (define/override (make-snip) (new anno-snip%))
        ;;;;;;; icon
        
        ;; Generates the icon for the top-left of the snip; indicates whether
        ;; the contents of the code editor form a balanced s-exp.
        (define/override (get-corner-bitmap)
          (or (and-let* ([pb (get-editor)]
                         [code (and (pb . is-a? . anno-pb%)
                                    (send pb get-code-editor))])
                (and (send code contains-balanced-sexp?)
                     ICON))
              UNBALANCED-ICON))
        
        (define/override (get-position) 'left-top)
        
        
        ;; get-text...see framework/private/comment-box.ss line 59
        (define/override (get-text offset num [flattened? #t])
          ;      (printf "[get-text ~s ~s ~s]~n" offset num flattened?)
          (if flattened?
              (let ([pb (get-editor)])
                (let ([code (send (send pb get-code-editor)
                                  get-text 0)]
                      [anno (send (send pb get-anno-editor)
                                  get-text 0)])
                  (if (string=? anno "")
                      code
                      (let ([commented-anno (regexp-replace* "\n" anno "\n; ")])
                        (if (char=? #\newline
                                    (string-ref commented-anno
                                                (- (string-length commented-anno) 1)))
                            (string-append code "\n; " commented-anno)
                            (string-append code "\n; " commented-anno "\n"))))))
              "."))
        
        ;; -> (is-a? popup-menu%)
        ;; Generate a context menu with three options: show/hide code,
        ;; convert to commented text, or convert to unannotated code.
        (define/override (get-menu)
          (let ([menu (make-object popup-menu%)])
            (define (copy-callback perform-copy)
              (λ (_ __)
                (let ([to-ed (find-containing-editor)])
                  (when to-ed
                    (let ([this-pos (find-this-position)])
                      (when this-pos
                        (let* ([from-ed (get-editor)]
                               [from-code (send from-ed get-code-editor)]
                               [from-anno (send from-ed get-anno-editor)])
                          (send to-ed begin-edit-sequence)
                          (send from-ed begin-edit-sequence)
                          (perform-copy to-ed from-code from-anno (+ this-pos 1))
                          (send to-ed delete this-pos (+ this-pos 1))
                          (send to-ed end-edit-sequence)
                          (send from-ed end-edit-sequence))))))))
            (make-show/hide-code-item (get-editor) menu)
            (make-object menu-item%
              "convert to commented text"
              menu
              (copy-callback (λ (to-ed from-code from-anno dest-pos)
                               (if (newline-after-this?)
                                   (copy-contents-with-semicolons-to-position
                                    to-ed from-anno dest-pos)
                                   (begin ;; use inline comment
                                     (send to-ed insert "|#" dest-pos)
                                     (copy-contents-to-position
                                      to-ed from-anno dest-pos)
                                     (send to-ed insert "#|" dest-pos)))
                               (send to-ed insert #\space dest-pos)
                               (copy-contents-to-position
                                to-ed from-code dest-pos))))
            (make-object menu-item%
              "convert to un-annotated text"
              menu
              (copy-callback
               (λ (to-ed from-code from-anno dest-pos)
                 (copy-contents-to-position to-ed from-code dest-pos))))
            menu))
        
        ;; -> bool
        ;; true iff a newline follows this snip
        (inherit get-flags)
        (define (newline-after-this?)
          (let ([flags (get-flags)])
            (or (memq 'hard-newline flags) (memq 'newline flags))))
        
        ;;;;;; Helpers from framework/private/comment-box.ss (lines 85&ff.)
        ;; (used by the above menu items)
        (inherit get-admin)
        ;; find-containing-editor : -> (union #f editor)
        ;; the editor containing this snip, or #f if none contains it
        (define/private (find-containing-editor)
          (let ([admin (get-admin)])
            (and admin
                 (send admin get-editor))))
        ;; find-this-position : -> (union #f number)
        ;; index of this snip in the containing editor (or #f if none contains it)
        (define/private (find-this-position)
          (let ([ed (find-containing-editor)])
            (and ed
                 (send ed get-snip-position this))))
        
        ;;;;;; readable-snip<%> implementation
        ;; returns the parsed contents of the code editor
        (define/public (read-special file line col pos)
          (let* ([ip (open-input-text-editor (send (get-editor) get-code-editor))]
                 [expr (read ip)])
            (close-input-port ip)
            (datum->syntax #f expr (list file line col pos 1))))
        
        ;;;;;; copy+paste
        
        ;; editor-stream-out% -> void
        ;; Write this editor's state (i.e., showing-code? and contents) to the
        ;; given stream.
        (define/override (write stream-out)
          (let ([pb (get-editor)])
            (let ([code (send pb get-code-editor)]
                  [anno (send pb get-anno-editor)])
              (send stream-out put (if (send pb showing-code?) 1 0))
              (send code write-to-file stream-out)
              (send anno write-to-file stream-out))))
        
        ;; -> anno-snip%
        ;; return a copy of this snip
        (define/override (copy)
          (let* ([s (new anno-snip%)]
                 [pb (send (get-editor) copy-self)])
            (send s set-editor pb)
            s))
        
        (super-new)
        (inherit set-snipclass)
        (set-snipclass snipclass)
        ))
    



    ;
    ;
    ;
    ;                                                   ;       ;;    ;
    ;                                                   ;      ;  ;  ;
    ;                                                   ;      ;  ;  ;
    ;     ;;;;  ; ;;;   ; ;;;     ;;            ; ;;;   ; ;;;  ;  ; ;
    ;    ;   ;  ;;   ;  ;;   ;   ;  ;           ;;   ;  ;;   ;  ;; ;
    ;   ;    ;  ;    ;  ;    ;  ;    ;  ;;;;;;; ;    ;  ;    ;     ;
    ;   ;    ;  ;    ;  ;    ;  ;    ;          ;    ;  ;    ;    ; ;;
    ;   ;    ;  ;    ;  ;    ;  ;    ;          ;    ;  ;    ;   ; ;  ;
    ;   ;    ;  ;    ;  ;    ;  ;    ;          ;    ;  ;    ;   ; ;  ;
    ;   ;   ;;  ;    ;  ;    ;   ;  ;           ;   ;   ;   ;   ;  ;  ;
    ;    ;;; ;  ;    ;  ;    ;    ;;            ;;;;    ;;;;   ;    ;;
    ;                                           ;
    ;                                           ;
    ;                                           ;
    
    ;; interface for scheme:text% subclasses that cache the result of
    ;; scheme:text-balanced?
    (define caches-balanced<%>
      (interface ((class->interface scheme:text%))
        contains-balanced-sexp?))
    
    (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))))
        
        ;; (The following is based on framework/private/comment-box.ss.)
        (define scheme+copy-self% (vector #f #f))
        (define (get-scheme+copy-self% code-editor?)
          (define ce-bit (if code-editor? 1 0))
          (unless (vector-ref scheme+copy-self% ce-bit)
            (vector-set! scheme+copy-self% ce-bit
                         (class* (let ([% (tabbable-text-mixin scheme:text%)])
                                   (if code-editor?
                                       ;Creating a class for the code editor here...
                                       ((drscheme:unit:get-program-editor-mixin) %)
                                       ; ...or for the annotation editor here:
                                       %))
                           (caches-balanced<%>)
                           (define currently-balanced-expr #f)
                           (inherit copy-self-to)
                           (define/override (copy-self)
                             (let ([ed (new scheme+copy-self%)]) (copy-self-to ed) ed))
                           (define/augment (after-edit-sequence)
                             (set! currently-balanced-expr
                               (scheme:text-balanced? this))
                             (inner (void) after-edit-sequence))
                           (define/public (contains-balanced-sexp?) currently-balanced-expr)
                           (super-new)
                           (inherit set-max-undo-history)
                           (set-max-undo-history 'forever))))
          (vector-ref scheme+copy-self% ce-bit))
        (class aligned-pasteboard%
          (super-new)
          
          ;;;;;;; Component editors:
          ;; -> (union #f text%)
          (define/public (get-code-editor) code-editor)
          (define/public (make-code-editor)
            (new (get-scheme+copy-self% #t)))
          ;; -> (union #f text%)
          (define/public (get-anno-editor) anno-editor)
          (define/public (make-anno-editor)
            (new (get-scheme+copy-self% #f)))
          
          (define code-editor (make-code-editor))  ;; code box's editor
          (define anno-editor (make-anno-editor))  ;; annotation box's
          (set-tabbing code-editor anno-editor)
          ;;;;;;; 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? #f]))
          
          ;; 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)
            (if (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 MIN-TEXT-WIDTH])]
                      [anno-snip (new stretchable-editor-snip%
                                      [editor anno-editor]
                                      [with-border? #f]
                                      [min-width MIN-TEXT-WIDTH])])
                  (make-object snip-wrapper% code-view code-snip)
                  (make-object hline% code-view)
                  (make-object snip-wrapper% val anno-snip)
                  #t)
                #f))
          
          (init-snips)
          
          ;;;;;;;;; show/hide code ;;;;;;;;;
          (define showing-code #f)
          
          (define/public (showing-code?)  ;; Accessor.
            showing-code)
          (define/public (show-code on/off) ;; Toggle.
            (send code-view show on/off)
            (and-let* ([ed (get-code-editor)]
                       [snip (find-owner-snip ed)]
                       [adm (send snip get-admin)])
              (send adm set-caret-owner snip 'global))
            (set! showing-code on/off))
          
          ;;;;;;;;; copy+paste ;;;;;;;;;
          
          (define/override (copy-self) ;; -> anno-pb%
            (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)
                (send ed show-code (showing-code?))
                ed)))
          )))
    
    ;; (is-a? anno-pb%) (is-a? popup-menu%) -> void
    ;; add an item to the given menu for showing/hiding the code portion of
    ;; the given object.
    (define (make-show/hide-code-item pb menu)
      (let ([showing-code-now? (send pb showing-code?)])
        (new menu-item%
             [label (if showing-code-now?
                        "Hide program text"
                        "Show program text")]
             [parent menu]
             [callback (lambda (item evt)
                         (send pb show-code (not showing-code-now?)))])))
    
    
    
    ;; copy-contents-with-semicolons-to-position :
    ;;    (is-a? text%) (is-a? text%) number -> void
    ;; Copies from-ed to position pos in to-ed.
    ;; From  framework/private/comment-box.ss (line 99).
    (define (copy-contents-with-semicolons-to-position to-ed from-ed pos)
      (let loop ([snip (find-last-snip from-ed)])
        (cond
          [snip
           (when (or (memq 'hard-newline (send snip get-flags))
                     (memq 'newline (send snip get-flags)))
             (send to-ed insert "; " pos))
           (send to-ed insert (send snip copy) pos)
           (loop (send snip previous))]
          [else
           (send to-ed insert "; " pos)])))
    
    ;; copy-contents-to-position : (is-a? text%) (is-a? text%) number -> void
    ;; As above, but no semicolons.
    (define (copy-contents-to-position to-ed from-ed pos)
      (let loop ([snip (find-last-snip from-ed)])
        (when snip
          (send to-ed insert (send snip copy) pos)
          (loop (send snip previous)))))
    
    ;; find-last-snip : editor -> snip
    ;; returns the last snip in the given editor.
    ;;  From  framework/private/comment-box.ss (line 112)
    (define (find-last-snip ed)
      (let loop ([snip (send ed find-first-snip)]
                 [acc (send ed find-first-snip)])
        (cond
          [snip (loop (send snip next) snip)]
          [else acc])))

    ;;;;;;;;;;;;;;;;;;;;;;;;;;;; End snip impl ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;                                         
;                                         
;                                         
;                                         
;                                         
;                                         
;  ; ;; ;;    ;;;   ; ;;;   ;    ;   ;;;; 
;  ;; ;; ;   ;   ;  ;;   ;  ;    ;  ;    ;
;  ;  ;  ;  ;    ;  ;    ;  ;    ;  ;     
;  ;  ;  ;  ;;;;;;  ;    ;  ;    ;   ;;   
;  ;  ;  ;  ;       ;    ;  ;    ;     ;; 
;  ;  ;  ;  ;       ;    ;  ;    ;       ;
;  ;  ;  ;   ;      ;    ;  ;   ;;  ;    ;
;  ;  ;  ;    ;;;;  ;    ;   ;;; ;   ;;;; 
;                                         
;                                         
;                                         


    ;; add-annotate-to-menu : (instanceof menu%) (instanceof text%)
    ;;     (instanceof mouse-event%) -> void
    ;; Attaches an "annotate this s-exp" menu item to the given menu, for
    ;; annotating the s-exp under the mouse cursor.
    ;; (From framework/private/scheme.ss line 160ff.)
    (define add-annotate-to-menu
      (let ()
        ;; make-annotate-item :
        ;;   (instanceof text%) num num (instanceof menu%) -> void
        ;; adds an "annotate this s-exp" item for the range between L and R
        ;; to the given menu
        (define (make-annotate-item text L R menu)
          (new separator-menu-item% [parent menu])
          (new menu-item%
               [parent menu]
               [label annotate-item-label-string]
               [callback (λ (item evt)
                           (convert-to-annotated-sexp text L R))]))
        (lambda (menu text event)
          (when (and (not (send text is-frozen?))
                     (not (send text is-stopped?)))
            (let* ([on-it-box (box #f)]
                   [click-pos
                    (call-with-values
                     (λ ()
                       (send text dc-location-to-editor-location
                             (send event get-x)
                             (send event get-y)))
                     (λ (x y)
                       (send text find-position x y #f on-it-box)))]
                   [snip (send text find-snip click-pos 'after)]
                   [char (send text get-character click-pos)]
                   [left? (memq char '(#\( #\{ #\[))]
                   [right? (memq char '(#\) #\} #\]))])
              (cond
                [(not (unbox on-it-box))
                 ;; clicking in nowhere land, just ignore
                 (void)]
                [(or left? right?)
                 ;; clicking on a left or right paren
                 (let* ([pos (if left?
                                 click-pos
                                 (+ click-pos 1))]
                        [other-pos (if left?
                                       (send text get-forward-sexp pos)
                                       (send text get-backward-sexp pos))])
                   (when other-pos
                     (let ([left-pos (min pos other-pos)]
                           [right-pos (max pos other-pos)])
                       (make-annotate-item text left-pos right-pos menu))))]
                [else
                 ;; clicking on some other text: annotate the containing sexp
                 (let ([up-sexp (send text find-up-sexp click-pos)])
                   (when up-sexp
                     (let ([fwd (send text get-forward-sexp up-sexp)])
                       (make-annotate-item text up-sexp fwd menu))))]))))))



    ;; (instanceof text%) num num -> void
    ;; Replaces the contents of text between left-pos and right-pos with an
    ;; anno-snip% whose code-editor contains those contents.
    (define (convert-to-annotated-sexp text L R)
      (send text begin-edit-sequence)
      (send text split-snip L)
      (send text split-snip R)
      (let ([snips (let loop ([snip (send text find-snip L 'after)])
                     (cond
                       [(not snip) null]
                       [((send text get-snip-position snip) . >= . R)
                        null]
                       [else (cons (send snip copy) (loop (send snip next)))]))])
        (send text delete L R)
        (let* ([ann-snip (new anno-snip%)]
               [pb (send ann-snip get-editor)]
               [code-ed (send pb get-code-editor)])
          (for-each (lambda (snip) (send code-ed insert snip)) snips)
          (send pb show-code #t)
          (send text insert ann-snip L L)
          (send text end-edit-sequence)
          ;(send text set-caret-owner ann-snip)
          )))

    ;; Install the context menu to the global keymap:
    (keymap:add-to-right-button-menu
     (let ([old (keymap:add-to-right-button-menu)])
       (λ (menu ed event)
         (old menu ed event) ;; build preexisting menu items
         (add-annotate-to-menu menu ed event)
         (void))))

    ;;;;;;;;;;;;;;;;;;;;;;;;; DrScheme menu bar ;;;;;;;;;;;;;;;;;;;;;;;;;

    ;; anno-snip-menu-items-mixin : drscheme:unit:frame% ->
    ;;  drscheme:unit:frame%
    ;; Mixin for use with drscheme:get/extend:extend-unit-frame.
    ;; Adds anno-snip-related items to the "Scheme" and "Insert" menus.
    (define (anno-snip-menu-items-mixin %) ;; see e.g. xml/text-box-tool.ss
      (class %
        (inherit get-insert-menu
                 get-language-menu
                 get-edit-target-object
                 register-capability-menu-item)
        (super-new)
        (define find-insertion-point ;; -> (union #f editor<%>)
          ;; returns the editor (if there is one) with the kbd focus
          ;; (see xml/text-box-tool.ss 373).
          (lambda ()
            (let ([editor (get-edit-target-object)])
              (and editor
                   (is-a? editor editor<%>)
                   (let loop ([editor editor])
                     (let ([focused (send editor get-focus-snip)])
                       (if (and focused
                                (is-a? focused editor-snip%))
                           (loop (send focused get-editor))
                           editor)))))))

        ;; Callback for inserting an anno-snip%:
        (define (insert-anno-snip menu evt)
          (let ([anno-snip (new anno-snip%)]
                [text (find-insertion-point)])
            (when text
              (send text insert anno-snip)
              (send text set-caret-owner anno-snip 'global))))

        ;; Callback for annotating current sexp or selection:
        (define (annotate-current-sexp/selection menu evt)
          (let ([text (find-insertion-point)]
                [bs (box 0)]  ; start
                [be (box 0)]) ; end
            (send text get-position bs be)
            (let ([start (unbox bs)]
                  [end (unbox be)])
              (if (= start end) ;; nothing selected
                  (let ([up-sexp (send text find-up-sexp start)])
                    (when up-sexp
                      (let ([fwd (send text get-forward-sexp up-sexp)])
                        (convert-to-annotated-sexp text up-sexp fwd))))
                  (convert-to-annotated-sexp text start end)))))

        ;; Add the "Annotate this expr" item to the Scheme menu:
        (make-object menu-item%
          annotate-item-label-string
          (get-language-menu)
          annotate-current-sexp/selection)
        ;; Add the "Insert an anno snip" item to the Insert menu:
        (let ([insert-snip
               (lambda (make-obj)
                 (let ([editor (find-insertion-point)])
                   (when editor
                     (let ([snip (make-obj)])
                       (send editor insert snip)
                       (send editor set-caret-owner snip 'display)))))]
              [demand-callback ;; : menu-item% -> void
               ;; enables the menu item when there is an editor available.
               (lambda (item)
                 (send item enable (find-insertion-point)))])
          (instantiate menu-item% (insert-annotated-expression-label-string
                                   (get-insert-menu)
                                   insert-anno-snip)
            [demand-callback demand-callback]))
        ))



    ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

    ;Advisable?
    ;(drscheme:language:register-capability 'drscheme:special:insert-anno-snip
    ;                                       (flat-contract boolean?)
    ;                                       #t)
    ;(drscheme:language:register-capability 'drscheme:special:insert-anno-snip
    ;                                       (flat-contract boolean?)
    ;                                       #t)
    ;(drscheme:get/extend:extend-definitions-text
    ;  MIXIN-THAT-APPLIES-TO-DEFINITIONS-BUT-NOT-TO-INTERACTIONS-OR-OTHER-CODE)
    (drscheme:get/extend:extend-unit-frame
     anno-snip-menu-items-mixin) ;; from code-desc-snip.ss

    ;;;;;;;;;;;;;;;;;;;;;;;;; End of implementation. ;;;;;;;;;;;;;;;;;;;;

;                                         
;     ;                       ;           
;     ;                       ;           
;     ;       ;;;    ;;;;     ;      ;;;; 
;   ;;;;;;   ;   ;  ;    ;  ;;;;;;  ;    ;
;     ;     ;    ;  ;         ;     ;     
;     ;     ;;;;;;   ;;       ;      ;;   
;     ;     ;          ;;     ;        ;; 
;     ;     ;            ;    ;          ;
;     ;      ;      ;    ;    ;     ;    ;
;      ;;;    ;;;;   ;;;;      ;;;   ;;;; 
;                                         
;                                         
;                                         

  (define test-w/text% ;; -> anno-snip% X scheme:text%
    (let ()
      (define (mk-test-frame)
        (new frame% [label "Annotated code snip test"] [width 500] [height 300]
             [alignment '(center center)]))
      (lambda ()
        (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 set-max-undo-history 'forever)
        (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)
        (values test-snip txt)
        )))

    ))