53 lines
2.6 KiB
Scheme
53 lines
2.6 KiB
Scheme
(define-c-library gtk '("gtk/gtk.h") "gtk-4" '((additional-versions (0))))
|
|
(define-c-library webkit '("webkit/webkit.h") "webkitgtk-6.0" '((additional-versions (4))))
|
|
(define G-APPLICATION-DEFAULT-FLAGS 0)
|
|
(define G-PRIORITY-HIGH -100)
|
|
(define window (make-c-null))
|
|
(define window-title (make-c-null))
|
|
(define webview (make-c-null))
|
|
(define webview-url (make-c-null))
|
|
(define main-interval 1000)
|
|
(define main #f)
|
|
(define-c-callback main-callback 'int '() (lambda () (when main (main)) 1))
|
|
|
|
(define-c-procedure gtk-application-new gtk 'gtk_application_new 'pointer '(pointer int))
|
|
(define-c-procedure gtk-application-window-new gtk 'gtk_application_window_new 'pointer '(pointer))
|
|
(define-c-procedure g-signal-connect-data gtk 'g_signal_connect_data 'long '(pointer pointer callback pointer pointer int))
|
|
(define-c-procedure g-timeout-add gtk 'g_timeout_add 'int '(int callback pointer))
|
|
(define-c-procedure g-application-run gtk 'g_application_run 'int '(pointer int pointer))
|
|
(define-c-procedure gtk-window-set-child gtk 'gtk_window_set_child 'void '(pointer pointer))
|
|
(define-c-procedure gtk-window-set-title gtk 'gtk_window_set_title 'void '(pointer pointer))
|
|
(define-c-procedure gtk-window-set-default-size gtk 'gtk_window_set_default_size 'void '(pointer int int))
|
|
(define-c-procedure gtk-window-present gtk 'gtk_window_present 'void '(pointer))
|
|
(define-c-procedure webkit-webview-new webkit 'webkit_web_view_new 'pointer '())
|
|
(define-c-procedure webkit-web-view-load-uri webkit 'webkit_web_view_load_uri 'void '(pointer pointer))
|
|
|
|
(define-c-callback
|
|
activate
|
|
'void
|
|
'(pointer pointer)
|
|
(lambda (app user-data)
|
|
(set! window (gtk-application-window-new app))
|
|
(set! webview (webkit-webview-new))
|
|
(gtk-window-set-child window webview)
|
|
(webkit-web-view-load-uri webview webview-url)
|
|
(gtk-window-set-title window window-title)
|
|
(gtk-window-set-default-size window 200 200)
|
|
(gtk-window-present window)
|
|
(g-timeout-add main-interval main-callback (make-c-null))))
|
|
|
|
(define (gtk-webview title url . options)
|
|
(when (and (not (null? options))
|
|
(assoc 'main (car options)))
|
|
(set! main (cdr (assoc 'main (car options)))))
|
|
(set! window-title (string->c-utf8 title))
|
|
(set! webview-url (string->c-utf8 url))
|
|
(let* ((app (gtk-application-new (make-c-null) G-APPLICATION-DEFAULT-FLAGS)))
|
|
(g-signal-connect-data app
|
|
(string->c-utf8 "activate")
|
|
activate
|
|
(make-c-null)
|
|
(make-c-null)
|
|
0)
|
|
(g-application-run app 0 (make-c-null))))
|