
(unit/sig framework:canvas^
  (import mred^
	  [preferences : framework:preferences^]
	  [frame : framework:frame^])
  
  (define basic<%> (interface ((class->interface editor-canvas%))))
  (define basic-mixin
    (mixin ((class->interface editor-canvas%)) (basic<%>) args
           (sequence
             (apply super-init args))))
           
  (define info<%> (interface (basic<%>)))
  (define info-mixin 
    (mixin (basic<%>) (info<%>) (parent [editor #f] . args)
	   (inherit has-focus? get-top-level-window)
	   (rename [super-on-focus on-focus]
		   [super-set-editor set-editor])
	   (override
	    [on-focus
	     (lambda (on?)
	       (super-on-focus on?)
	       (send (get-top-level-window) set-info-canvas (and on? this))
	       (when on?
		     (send (get-top-level-window) update-info)))]
	    [set-editor
	     (lambda (m)
	       (super-set-editor m)
	       (let ([tlw (get-top-level-window)])
		 (when (eq? this (send tlw get-info-canvas))
		   (send tlw update-info))))])
	   (sequence
	     (apply super-init parent editor args)
	     (unless (is-a? (get-top-level-window) frame:info<%>)
	       (error 'canvas:text-info-mixin
		      "expected to be placed into a frame or dialog implementing frame:info<%>, got: ~e" 
		      (get-top-level-window)))
	     (when (has-focus?)
	       (send (get-top-level-window) update-info)))))

  (define wide-snip<%> (interface (basic<%>)
			 add-wide-snip
			 add-tall-snip))

  ;; wx: this need to collude with
  ;;     the edit, since the edit has the right callbacks.
  (define wide-snip-mixin
    (mixin (basic<%>) (wide-snip<%>) args
      (inherit get-editor)
      (rename [super-on-size on-size])
      (private
	[wide-snips null]
	[tall-snips null]
	[update-snip-size
	 (lambda (width?)
	   (lambda (s)
	     (let* ([width (box 0)]
		    [height (box 0)]
		    [leftm (box 0)]
		    [rightm (box 0)]
		    [topm (box 0)]
		    [bottomm (box 0)]
		    [left-edge-box (box 0)]
		    [top-edge-box (box 0)]
		    [snip-media (send s get-editor)]
		    [edit (get-editor)])
	       (when edit
		 (send edit
		       run-after-edit-sequence
		       (lambda ()
			 (let ([admin (send edit get-admin)])
			   (send admin get-view #f #f width height)
			   (send s get-margin leftm topm rightm bottomm)


			   ;; when the width is to be maximized and there is a
			   ;; newline just behind the snip, we know that the left
			   ;; edge is zero. Special case for efficiency in the 
			   ;; console printer
			   (let ([fallback
				  (lambda ()
				    (send edit get-snip-position-and-location
					  s #f left-edge-box top-edge-box))])
			     (cond
			       [(not width?) (fallback)]
			       [(let ([prev (send s previous)])
				  (and prev
				       (member 'hard-newline (send prev get-flags))))
				(set-box! left-edge-box 0)]
			       [else (fallback)]))


			   (if width?
			       (let ([snip-width (max 0 (- (unbox width)
                                                           (unbox left-edge-box)
                                                           (unbox leftm)
                                                           (unbox rightm)
                                                           
						    ;; this two is the space that 
						    ;; the caret needs at the right of
						    ;; a buffer.
                                                           2))])
				 (send* s 
					(set-min-width snip-width)
					(set-max-width snip-width))
				 (when snip-media
				   (send snip-media set-max-width
					 (if (send snip-media auto-wrap)
					     snip-width
					     0))))
			       (let ([snip-height (max 0 (- (unbox height)
                                                            (unbox top-edge-box)
                                                            (unbox topm)
                                                            (unbox bottomm)))])
				 (send* s 
					(set-min-height snip-height)
					(set-max-height snip-height)))))))))))])
      (public
	[add-wide-snip
	 (lambda (snip)
	   (set! wide-snips (cons snip wide-snips))
	   ((update-snip-size #t) snip))]
	[add-tall-snip
	 (lambda (snip)
	   (set! tall-snips (cons snip tall-snips))
	   ((update-snip-size #f) snip))])
      (override
	[on-size
	 (lambda (width height)
	   (super-on-size width height)
	   (for-each (update-snip-size #t) wide-snips)
	   (for-each (update-snip-size #f) tall-snips))])
      (sequence
	(apply super-init args))))

  (define basic% (basic-mixin editor-canvas%))
  (define info% (info-mixin basic%))
  (define wide-snip% (wide-snip-mixin basic%)))
