/[gtk-cffi]/gtk-cffi/gtk/button.lisp
ViewVC logotype

Contents of /gtk-cffi/gtk/button.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Sat Aug 18 13:55:28 2012 UTC (20 months ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +13 -1 lines
Added GtkSwitch GtkEntryCompletion GtkEntryBuffer
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
2 ;;;
3 ;;; button.lisp --- Wrappers for GtkButton, GtkCheckButton, GtkToggleButton,
4 ;;; GtkScaleButton, GtkRadioButton, GtkVolumeButton,
5 ;;; GtkLockButton
6 ;;;
7 ;;; Copyright (C) 2012, Roman Klochkov <kalimehtar@mail.ru>
8 ;;;
9
10 (in-package :gtk-cffi)
11
12 (defclass button (bin actionable activatable)
13 ())
14
15 (defcfun gtk-button-new :pointer)
16 (defcfun gtk-button-new-with-label :pointer (label :string))
17 (defcfun gtk-button-new-with-mnemonic :pointer (label :string))
18 (defcfun gtk-button-new-from-stock :pointer (label cffi-keyword))
19
20 (defmethod gconstructor ((button button)
21 &key label type &allow-other-keys)
22 "type can be :stock or :mnemonic, any other means button with label"
23 (initialize button '(label type))
24 (if label
25 (let ((creator
26 (case type
27 (:stock #'gtk-button-new-from-stock)
28 (:mnemonic #'gtk-button-new-with-mnemonic)
29 (otherwise #'gtk-button-new-with-label))))
30 (funcall creator label))
31 (gtk-button-new)))
32
33 (defslots button
34 relief relief-style
35 label :string
36 use-stock :boolean
37 use-underline :boolean
38 focus-on-click :boolean
39 image pobject
40 image-position position-type)
41
42 (deffuns button
43 (clicked :void)
44 (:get event-window pobject))
45
46 (defcfun gtk-button-set-alignment :void (button pobject) (x :float) (y :float))
47 (defmethod (setf alignment) (coords (button button))
48 (gtk-button-set-alignment button
49 (float (first coords))
50 (float (second coords))))
51 (save-setter button alignment)
52
53 (defcfun gtk-button-get-alignment :void
54 (button pobject) (x :pointer) (y :pointer))
55
56 (defmethod alignment ((button button))
57 (with-foreign-outs-list ((x :float) (y :float)) :ignore
58 (gtk-button-get-alignment button x y)))
59
60 (init-slots button)
61
62 (defclass toggle-button (button)
63 ())
64
65 (defcfun gtk-toggle-button-new :pointer)
66 (defcfun gtk-toggle-button-new-with-label :pointer (label :string))
67 (defcfun gtk-toggle-button-new-with-mnemonic :pointer (label :string))
68
69 (defmethod gconstructor ((toggle-button toggle-button) &key label type)
70 (initialize toggle-button '(label type))
71 (if label
72 (case type
73 (:mnemonic (gtk-toggle-button-new-with-mnemonic label))
74 (otherwise (gtk-toggle-button-new-with-label label)))
75 (gtk-toggle-button-new)))
76
77 (defslots toggle-button
78 mode :boolean
79 active :boolean
80 inconsistent :boolean)
81
82 (deffuns toggle-button
83 (toggled :void))
84
85 (init-slots toggle-button)
86
87 (defclass check-button (toggle-button)
88 ())
89
90 (defcfun gtk-check-button-new :pointer)
91 (defcfun gtk-check-button-new-with-label :pointer (label :string))
92 (defcfun gtk-check-button-new-with-mnemonic :pointer (label :string))
93
94 (defmethod gconstructor ((check-button check-button) &key label type)
95 (initialize check-button '(label type))
96 (if label
97 (case type
98 (:mnemonic (gtk-check-button-new-with-mnemonic label))
99 (otherwise (gtk-check-button-new-with-label label)))
100 (gtk-check-button-new)))
101
102 (defclass radio-button (check-button)
103 ())
104
105 (defcfun gtk-radio-button-new :pointer)
106 (defcfun gtk-radio-button-new-with-label :pointer (label :string))
107 (defcfun gtk-radio-button-new-with-mnemonic :pointer (label :string))
108
109 (defcfun gtk-radio-button-new-from-widget :pointer (group-member pobject))
110 (defcfun gtk-radio-button-new-with-label-from-widget :pointer
111 (group-member pobject) (label :string))
112 (defcfun gtk-radio-button-new-with-mnemonic-from-widget :pointer
113 (group-member pobject) (label :string))
114
115
116 (defmethod gconstructor ((radio-button radio-button) &key label type widget)
117 (initialize radio-button '(label type widget))
118 (if label
119 (case type
120 (:mnemonic (if widget
121 (gtk-radio-button-new-with-mnemonic-from-widget
122 widget label)
123 (gtk-radio-button-new-with-mnemonic label)))
124 (otherwise (if widget
125 (gtk-radio-button-new-with-label-from-widget widget
126 label)
127 (gtk-radio-button-new-with-label label))))
128 (if widget
129 (gtk-radio-button-new-from-widget widget)
130 (gtk-radio-button-new))))
131
132 (defclass radio-group (object)
133 ())
134
135 (defgeneric as-list (object)
136 (:method ((radio-button radio-button))
137 (convert-from-foreign (pointer radio-button)
138 '(g-slist :free-from-foreign nil))))
139
140 (defslot radio-button group (object radio-group))
141 (deffuns radio-button
142 (join-group :void (group-source pobject)))
143
144 (init-slots radio-button)
145
146 (defclass link-button (button)
147 ())
148
149 (defcfun gtk-link-button-new :pointer (uri :string))
150 (defcfun gtk-link-button-new-with-label :pointer (uri :string) (label :string))
151
152
153 (defmethod gconstructor ((link-button link-button) &key uri label)
154 (initialize link-button '(label uri))
155 (if label
156 (gtk-link-button-new-with-label uri label)
157 (gtk-link-button-new uri)))
158
159 (defslots link-button
160 uri :string
161 visited :boolean)
162
163 (init-slots link-button)
164
165 (defclass scale-button (button)
166 ())
167
168 (defcfun gtk-scale-button-new :pointer)
169
170 (defmethod gconstructor ((scale-button scale-button) &key)
171 (gtk-scale-button-new))
172
173 (defslots scale-button
174 adjustment pobject
175 value :double)
176
177 (deffuns scale-button
178 (:set icons (null-array :string))
179 (:get popup pobject)
180 (:get plus-button pobject)
181 (:get minus-button pobject))
182
183 (init-slots scale-button)
184
185 (defclass volume-button (scale-button)
186 ())
187
188 (defcfun gtk-volume-button-new :pointer)
189
190 (defmethod gconstructor ((volume-button volume-button) &key)
191 (gtk-volume-button-new))
192
193
194 (defclass lock-button (button)
195 ())
196
197 (defcfun gtk-lock-button-new :pointer (permission pobject))
198
199 (defmethod gconstructor ((lock-button lock-button) &key permission)
200 (initialize lock-button 'permission)
201 (gtk-lock-button-new permission))
202
203 (defslot lock-button permission pobject)

  ViewVC Help
Powered by ViewVC 1.1.5