-
Notifications
You must be signed in to change notification settings - Fork 11
/
test-buttons.lisp
63 lines (61 loc) · 2.66 KB
/
test-buttons.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
(in-package :test-gtk)
(defmodel test-buttons (vbox)
((nclics :accessor nclics :initform (c-in 0)))
(:default-initargs
:kids (c? (the-kids
(mk-label :text (c? (trc "### executing toggled button rule")
(format nil "Toggled button active = ~a"
(with-widget (w :toggled-button)
(trc " FOUND WIDGET" w (value w))
(value w)))))
(mk-hseparator)
(mk-label :text (c? (format nil "Check button checked = ~a"
(widget-value :check-button))))
(mk-hseparator)
(mk-label :text (c? (trc "### executing radio button rule")
(format nil "Radio button selected = ~a"
(with-widget (w :radio-group)
(trc " FOUND WIDGET")
(value w)))))
(mk-hseparator)
(mk-label :text (c? (format nil "Button clicked ~a times"
(nclics (upper self test-buttons))))
:selectable t)
(mk-hseparator)
(mk-hbox
:kids (c? (the-kids
(mk-button :stock :apply
:tooltip "Click ....."
:on-clicked (callback (widget event data)
(incf (nclics (upper self test-buttons)))))
(mk-button :label "Continuable error"
:on-clicked (callback (widget event data)
(trc "issuing continuable error" widget event)
(error 'gtk-continuable-error :text "Oops!")))
(mk-button :label "Lisp error (Div 0)"
:on-clicked (callback (widget event data)
(print (let ((a 3)
(b 0))
(/ a b)))))
(mk-toggle-button :md-name :toggled-button
:markup (c? (with-markup (:foreground (if (value self) :red :blue))
"_Toggled Button")))
(mk-check-button :md-name :check-button
:markup (with-markup (:foreground :green)
"_Check Button")))))
(mk-hbox
:md-name :radio-group
:kids (kids-list?
(mk-radio-button :md-name :radio-1
:label "Radio 1")
(mk-radio-button :md-name :radio-2
:label "Radio 2" :init t)
(mk-radio-button :md-name :radio-3
:label "Radio 3")))
(mk-hbox
:kids (kids-list?
(mk-label :text (c? (trc "### executing toggled button rule 2")
(format nil "Toggled button active = ~a"
(with-widget (w :toggled-button)
(trc " FOUND WIDGET 2" w (value w))
(value w)))))))))))