(require-extension
 srfi-18 files extras webkit)

(define-record-type html
  (html xexpr) html?
  (xexpr html-xexpr))

(define interact
  (letrec ((open-output-element
	    (lambda (elt class)
	      (make-output-port
	       (lambda (str)
		 ((jso-ref elt 'appendChild)
		  (xexpr->jso
		   `(span ((class ,class)) ,str)
		   (jso-ref elt 'ownerDocument))))
	       void)))
	   (interact
	    (lambda (eval cmd in-elt out-elt)
	      (let ((ok?
		     (thread-join!
		      (thread-start!
		       (make-thread
			(lambda ()
			  (let ((input (open-output-element in-elt "input"))
				(result (open-output-element out-elt "result"))
				(output (open-output-element out-elt "output"))
				(error (open-output-element out-elt "error")))
			    (handle-exceptions
			     exn (begin
				   (print-error-message exn error)
				   (print-call-chain error)
				   #f)
			     (display cmd input)
			     (let ((v (parameterize ((current-input-port
						      (open-input-string cmd))
						     (current-output-port
						      output)
						     (current-error-port
						      error))
					(eval (read)))))
			       (cond
				((eqv? v (void))
				 (void))
				((html? v)
				 ((jso-ref out-elt 'appendChild)
				  (xexpr->jso
				   (html-xexpr v)
				   (jso-ref out-elt 'ownerDocument))))
				(else
				 (pretty-print v result))))
			     #t))))))))
		(gc #t)
		ok?))))
    interact))

(define (initialize-repl-window! window)
  (let ((chicken (jso-new (jso-ref window 'Object))))
    (set! (jso-ref chicken 'version) (chicken-version #t))
    (set! (jso-ref chicken 'interact) interact)
    (set! (jso-ref chicken 'eval) eval)
    (set! (jso-ref chicken 'expand) expand)
    (set! (jso-ref window 'chicken) chicken)))

(make-window
 (string-append
  "file://"
  (make-absolute-pathname (repository-path) "webkit-repl.html"))
 #:width 640 #:height 480
 #:scrollbar-visible? #t #:status-visible? #f
 #:initialize! initialize-repl-window!)

(main-loop)