-
Notifications
You must be signed in to change notification settings - Fork 7
/
web-browser.lisp
79 lines (67 loc) · 2.03 KB
/
web-browser.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
(ql:quickload '("iup-web"))
(defpackage #:iup-examples.web-browser
(:use #:common-lisp)
(:export #:web-browser))
(in-package #:iup-examples.web-browser)
(defvar *web* nil)
(defvar *url* "http://www.lispworks.com/documentation/HyperSpec/Front/index.htm")
(defun back (handle)
(declare (ignore handle))
(setf (iup:attribute *web* :backforward) -1)
iup:+default+)
(defun forward (handle)
(declare (ignore handle))
(setf (iup:attribute *web* :backforward) 1)
iup:+default+)
(defun stop (handle)
(declare (ignore handle))
(setf (iup:attribute *web* :stop) nil)
iup:+default+)
(defun reload (handle)
(declare (ignore handle))
(setf (iup:attribute *web* :reload) nil)
iup:+default+)
(defun goto (handle)
(declare (ignore handle))
(setf (iup:attribute *web* :value) *url*)
iup:+default+)
(defun web-browser ()
(iup:with-iup ()
(iup-web:open)
(let* ((btn-back (iup:button :title "Back" :action 'back))
(btn-forward (iup:button :title "Forward" :action 'forward))
(text (iup:text :expand :horizontal
:value *url*
:valuechanged_cb #'(lambda (handle)
(setf *url* (iup:attribute handle :value))
iup:+default+)))
(btn-load (iup:button :title "Load" :action 'goto))
(btn-reload (iup:button :title "Reload" :action 'reload))
(btn-stop (iup:button :title "Stop" :action 'stop))
(web (iup-web:web-browser :expand "YES"))
(dialog (iup:dialog
(iup:vbox
(list (iup:hbox
(list btn-back
btn-forward
text
btn-load
btn-reload
btn-stop)
:margin "5x5"
:gap "5")
web))
:title "IupWebBrowser"
:rastersize "800x600"
:map_cb #'(lambda (handle)
(declare (ignore handle))
(setf *web* web)
(goto nil)
iup:+default+))))
(iup:show dialog)
(iup:main-loop))))
#+sbcl
(sb-int:with-float-traps-masked
(:divide-by-zero :invalid)
(web-browser))
#-sbcl (web-browser)