(import scheme)
(import (chicken base))
(import (chicken string))
(import gtk-server)

(define gtk-server (start-gtk-server!))
(define (gtk #!rest args) (apply gtk-send! gtk-server args))

;; Get GtkSheet
(unless (equal? (gtk "gtk_server_require" "libwebkitgtk-3.0.so") "ok")
  (print "No libwebkitgtk library found!")
  (stop-gtk-server! gtk-server)
  (exit 1))

;; Import function
(gtk "gtk_server_define" "webkit_web_view_new" 'NONE 'WIDGET 0)
(gtk "gtk_server_define" "webkit_web_view_load_uri" 'NONE 'NONE 2 'WIDGET 'STRING)

;; Setup GUI
(gtk "gtk_init" 'NULL 'NULL)
(define win (gtk "gtk_window_new" 'GTK_WINDOW_TOPLEVEL))
(gtk "gtk_window_set_title" win "'Minimal Web Browser with CHICKEN Scheme and GTK-server'")
(gtk "gtk_window_set_default_size" win 1024 600)
(define box (gtk "gtk_vbox_new" 0 0))
;; Create entry to enter URL
(define url (gtk "gtk_entry_new"))
(gtk "gtk_box_pack_start" box url 0 0 1)
;; Create HTML renderer
(define html (gtk "webkit_web_view_new"))
(define scroll (gtk "gtk_scrolled_window_new" 0 0))
(gtk "gtk_scrolled_window_set_policy" scroll 1 1)
(gtk "gtk_scrolled_window_set_shadow_type" scroll 3)
(gtk "gtk_container_add" scroll html)
(gtk "gtk_box_pack_start" box scroll 1 1 1)
;; Load gtk-server.org by default
(gtk "gtk_entry_set_text" url "'http://www.gtk-server.org'")
(gtk "webkit_web_view_load_uri" html "'http://www.gtk-server.org'")
;; Pack everything together and wait for event
(gtk "gtk_container_add" win box)
(gtk "gtk_widget_show_all" win)

(define (string-prefix? prefix string)
  (let ((index (substring-index prefix string)))
    (and index (zero? index))))

(let loop ()
  (let ((event (gtk "gtk_server_callback wait")))
    (when (not (equal? event win))
      (when (equal? event url)
        (let ((go (gtk "gtk_entry_get_text" url)))
          (when (not (or (string-prefix? "http://" go)
                         (string-prefix? "https://" go)))
            (set! go (string-append "http://" go)))
          (gtk "webkit_web_view_load_uri" html go)))
      (loop))))

;; Exit GTK
(gtk "gtk_server_exit")
(stop-gtk-server! gtk-server)