
(load-relative "loadtest.ss")

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;                            Editor Tests                                    ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;;;; Undo tests

(define e (make-object text%))

(stv e insert "Hello")
(st #t e is-modified?)
(stv e undo)
(st #f e is-modified?)
(stv e redo)
(st #t e is-modified?)
(stv e set-modified #f)
(st #f e is-modified?)
(stv e undo)
(st #t e is-modified?)
(stv e redo)
(st #f e is-modified?)
(stv e undo)
(st #t e is-modified?)
(stv e redo)
(st #f e is-modified?)
(stv e undo)
(stv e set-modified #f)
(st #f e is-modified?)
(stv e redo)
(st #t e is-modified?)
(st "Hello" e get-text)
(define undone? #f)
(stv e add-undo (letrec ([f (lambda ()
			      (set! undone? #t)
			      (send e add-undo f) ; reinstall self!
			      #f)])
		  f))
(stv e undo)
(st "Hello" e get-text)
(test #t 'undone? undone?)
(stv e undo)
(st "" e get-text)
(set! undone? #f)
(stv e redo)
(st "Hello" e get-text)
(test #f 'undone? undone?)
(stv e redo)
(st "Hello" e get-text)
(test #t 'undone? undone?)
(set! undone? #f)
(stv e redo)
(st "Hello" e get-text)
(test #f 'undone? undone?)
(stv e insert "x")
(st "Hellox" e get-text)
(stv e add-undo (lambda ()
		  (set! undone? #t)
		  #t)) ; do next one, too
(stv e undo)
(test #t 'undone? undone?)
(st "Hello" e get-text)

;; Editor ports

(let ([e (make-object text%)]
      [multi-mode? #f])
  (stv e insert "hello")
  (let ([p (open-input-text-editor e)])
    (test 'hello 'read (read p))
    (test eof 'read (read p)))
  (stv e insert " there")
  (let ([p (open-input-text-editor e)])
    (test 'hello 'read (read p))
    (test 'there 'read (read p))
    (test eof 'read (read p)))
  (stv e insert (make-object
		 (class* snip% 
		   (readable-snip<%>)
		   (define/public (read-one-special index src line col pos)
		     (if multi-mode?
			 (values 'multi 1 (= index 1))
			 (error 'ack)))
		   (super-new))))
  (let ([p (open-input-text-editor e)])
    (port-count-lines! p)
    (test '(1 0 1) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test 'hello 'read (read p))
    (test '(1 5 6) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test 'there 'read (read p))
    (test '(1 11 12) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test 'got-ack 'read (with-handlers ([not-break-exn? (lambda (x)
							   'got-ack)])
			   (read p)))
    (test '(1 12 13) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test eof 'read (read p)))
  (set! multi-mode? #t)
  (let ([p (open-input-text-editor e)])
    (port-count-lines! p)
    (test 'hello 'read (read p))
    (test 'there 'read (read p))
    (test 'multi 'read (read p))
    (test '(1 12 13) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test 'multi 'read (read p))
    (test '(1 13 14) 'pos (call-with-values (lambda () (port-next-location p)) list))
    (test eof 'read (read p)))
  (stv e insert (make-object image-snip% (build-path
					  (collection-path "icons") 
					  "plt.gif")))
  (let ([p (open-input-text-editor e)])
    (test 'hello 'read (read p))
    (test 'there 'read (read p))
    (test 'multi 'read (read p))
    (test 'multi 'read (read p))
    (test #t 'read (is-a? (read p) image-snip%))))
		 


(report-errs)
