-
Notifications
You must be signed in to change notification settings - Fork 9
/
webkit.lisp
111 lines (105 loc) · 6.42 KB
/
webkit.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
;;;; examples/webkit.lisp
;;;; Copyright (C) 2022-2023 Bohong Huang
;;;;
;;;; This program is free software: you can redistribute it and/or modify
;;;; it under the terms of the GNU Lesser General Public License as published by
;;;; the Free Software Foundation, either version 3 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;;; GNU Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public License
;;;; along with this program. If not, see <https://www.gnu.org/licenses/>.
(defpackage webkit.example
(:use #:cl #:gtk4)
(:export #:main))
(in-package #:webkit.example)
(defparameter *home-uri* "https://google.com")
(define-application (:name main
:id "org.bohonghuang.webkit-example")
(define-main-window (window (make-application-window :application *application*))
(let ((web-view (webkit:make-web-view )))
(setf (window-title window) "CL-GTK4-WEBKIT-EXAMPLE"
(window-default-size window) '(800 600))
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (window-title window) (if (webkit:web-view-loading-p web-view)
(webkit:web-view-uri web-view)
(webkit:web-view-title web-view)))))
(let ((box (make-box :orientation +orientation-vertical+
:spacing 0)))
(let ((toolbar (make-center-box)))
(widget-add-css-class toolbar "toolbar")
(let ((box (make-box :orientation +orientation-horizontal+
:spacing 4)))
(let ((button (make-button :icon-name "go-previous-symbolic")))
(connect button "clicked" (lambda (button)
(declare (ignore button))
(webkit:web-view-go-back web-view)))
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (widget-sensitive-p button) (webkit:web-view-can-go-back-p web-view))))
(box-append box button))
(let ((button (make-button :icon-name "go-next-symbolic")))
(connect button "clicked" (lambda (button)
(declare (ignore button))
(webkit:web-view-go-forward web-view)))
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (widget-sensitive-p button) (webkit:web-view-can-go-forward-p web-view))))
(box-append box button))
(let ((button (make-button :icon-name "go-home-symbolic")))
(connect button "clicked" (lambda (button)
(declare (ignore button))
(webkit:web-view-load-uri web-view *home-uri*)))
(box-append box button))
(setf (center-box-start-widget toolbar) box))
(let ((box (make-box :orientation +orientation-horizontal+
:spacing 4)))
(setf (widget-halign box) +align-fill+
(widget-hexpand-p box) t
(widget-margin-start box) 50
(widget-margin-end box) 50)
(let ((entry (make-entry)))
(setf (widget-halign entry) +align-fill+
(widget-hexpand-p entry) t)
(connect entry "activate" (lambda (entry)
(webkit:web-view-load-uri web-view (entry-buffer-text (entry-buffer entry)))))
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (entry-buffer-text (entry-buffer entry)) (webkit:web-view-uri web-view))))
(box-append box entry))
(let ((button (make-button :icon-name "view-refresh-symbolic")))
(connect button "clicked" (lambda (button)
(declare (ignore button))
(if (webkit:web-view-loading-p web-view)
(webkit:web-view-stop-loading web-view)
(webkit:web-view-reload web-view))))
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (button-icon-name button) (if (webkit:web-view-loading-p web-view)
"process-stop-symbolic"
"view-refresh-symbolic"))))
(box-append box button))
(setf (center-box-center-widget toolbar) box))
(box-append box toolbar))
(let ((progress-bar (make-progress-bar)))
(widget-add-css-class progress-bar "osd")
(connect web-view "load-changed" (lambda (web-view event)
(declare (ignore event))
(setf (progress-bar-fraction progress-bar)
(if (webkit:web-view-loading-p web-view)
(webkit:web-view-estimated-load-progress web-view)
0.0d0))))
(box-append box progress-bar))
(let ((web-view web-view))
(setf (widget-vexpand-p web-view) t
(widget-hexpand-p web-view) t)
(webkit:web-view-load-uri web-view *home-uri*)
(box-append box web-view))
(setf (window-child window) box)))
(unless (widget-visible-p window)
(window-present window))))