|
462
|
1 ;;; gtk-test.el --- Test harness for GTK widgets
|
|
|
2
|
|
|
3 ;; Copyright (C) 2000 Free Software Foundation
|
|
|
4
|
|
|
5 ;; Maintainer: William Perry <wmperry@gnu.org>
|
|
|
6 ;; Keywords: tests
|
|
|
7
|
|
|
8 ;; This file is part of XEmacs.
|
|
|
9
|
|
|
10 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
11 ;; under the terms of the GNU General Public License as published by
|
|
|
12 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
13 ;; any later version.
|
|
|
14
|
|
|
15 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
18 ;; General Public License for more details.
|
|
|
19
|
|
|
20 ;; You should have received a copy of the GNU General Public License
|
|
|
21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
|
|
|
23 ;; 02111-1307, USA.
|
|
|
24
|
|
|
25 ;;; Synched up with: Not in FSF
|
|
|
26
|
|
|
27 ;;; Commentary:
|
|
|
28
|
|
|
29 (require 'font)
|
|
|
30
|
|
|
31 (setq GTK_TOPLEVEL (lsh 1 4)
|
|
|
32 GTK_NO_WINDOW (lsh 1 5)
|
|
|
33 GTK_REALIZED (lsh 1 6)
|
|
|
34 GTK_MAPPED (lsh 1 7)
|
|
|
35 GTK_VISIBLE (lsh 1 8)
|
|
|
36 GTK_SENSITIVE (lsh 1 9)
|
|
|
37 GTK_PARENT_SENSITIVE (lsh 1 10)
|
|
|
38 GTK_CAN_FOCUS (lsh 1 11)
|
|
|
39 GTK_HAS_FOCUS (lsh 1 12)
|
|
|
40 GTK_CAN_DEFAULT (lsh 1 13)
|
|
|
41 GTK_HAS_DEFAULT (lsh 1 14)
|
|
|
42 GTK_HAS_GRAB (lsh 1 15)
|
|
|
43 GTK_RC_STYLE (lsh 1 16)
|
|
|
44 GTK_COMPOSITE_CHILD (lsh 1 17)
|
|
|
45 GTK_NO_REPARENT (lsh 1 18)
|
|
|
46 GTK_APP_PAINTABLE (lsh 1 19)
|
|
|
47 GTK_RECEIVES_DEFAULT (lsh 1 20))
|
|
|
48
|
|
|
49 (defun gtk-widget-visible (widget)
|
|
|
50 (= (logand (gtk-object-flags widget) GTK_VISIBLE) GTK_VISIBLE))
|
|
|
51
|
|
|
52 (defvar gtk-defined-tests nil
|
|
|
53 "A list describing the defined tests.
|
|
|
54 Each element is of the form (DESCRIPTION TYPE FUNCTION)")
|
|
|
55
|
|
|
56 (defvar gtk-test-directory nil)
|
|
|
57 (defun gtk-test-directory ()
|
|
|
58 (if (not gtk-test-directory)
|
|
|
59 (mapc (lambda (c)
|
|
|
60 (if (and (not gtk-test-directory)
|
|
|
61 (string= (file-name-nondirectory (car c)) "gtk-test.el"))
|
|
|
62 (setq gtk-test-directory (file-name-directory (car c)))))
|
|
|
63 load-history))
|
|
|
64 gtk-test-directory)
|
|
|
65
|
|
|
66 (defvar gtk-test-categories '((container . "Containers")
|
|
|
67 (basic . "Basic Widgets")
|
|
|
68 (composite . "Composite Widgets")
|
|
|
69 (gimp . "Gimp Widgets")
|
|
|
70 (misc . "Miscellaneous")
|
|
|
71 (extra . "GTK+ Extra")
|
|
|
72 (gdk . "GDK Primitives")
|
|
|
73 (gnome . "GNOME tests"))
|
|
|
74 "An assoc list mapping test categories to friendly names.")
|
|
|
75
|
|
|
76 (defvar gtk-test-open-glyph
|
|
|
77 (make-glyph [xpm :data "/* XPM */\nstatic char * book_open_xpm[] = {\n\"16 16 4 1\",\n\" c None s None\",\n\". c black\",\n\"X c #808080\",\n\"o c white\",\n\" \",\n\" .. \",\n\" .Xo. ... \",\n\" .Xoo. ..oo. \",\n\" .Xooo.Xooo... \",\n\" .Xooo.oooo.X. \",\n\" .Xooo.Xooo.X. \",\n\" .Xooo.oooo.X. \",\n\" .Xooo.Xooo.X. \",\n\" .Xooo.oooo.X. \",\n\" .Xoo.Xoo..X. \",\n\" .Xo.o..ooX. \",\n\" .X..XXXXX. \",\n\" ..X....... \",\n\" .. \",\n\" \"};"]))
|
|
|
78
|
|
|
79 (defvar gtk-test-closed-glyph
|
|
|
80 (make-glyph [xpm :data "/* XPM */\nstatic char * book_closed_xpm[] = {\n\"16 16 6 1\",\n\" c None s None\",\n\". c black\",\n\"X c red\",\n\"o c yellow\",\n\"O c #808080\",\n\"# c white\",\n\" \",\n\" .. \",\n\" ..XX. \",\n\" ..XXXXX. \",\n\" ..XXXXXXXX. \",\n\".ooXXXXXXXXX. \",\n\"..ooXXXXXXXXX. \",\n\".X.ooXXXXXXXXX. \",\n\".XX.ooXXXXXX.. \",\n\" .XX.ooXXX..#O \",\n\" .XX.oo..##OO. \",\n\" .XX..##OO.. \",\n\" .X.#OO.. \",\n\" ..O.. \",\n\" .. \",\n\" \"};\n"]))
|
|
|
81
|
|
|
82 (defvar gtk-test-mini-page-glyph
|
|
|
83 (make-glyph [xpm :data "/* XPM */\nstatic char * mini_page_xpm[] = {\n\"16 16 4 1\",\n\" c None s None\",\n\". c black\",\n\"X c white\",\n\"o c #808080\",\n\" \",\n\" ....... \",\n\" .XXXXX.. \",\n\" .XoooX.X. \",\n\" .XXXXX.... \",\n\" .XooooXoo.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" .XooooooX.o \",\n\" .XXXXXXXX.o \",\n\" ..........o \",\n\" oooooooooo \",\n\" \"};\n"]))
|
|
|
84
|
|
|
85 (defvar gtk-test-mini-gtk-glyph
|
|
|
86 (make-glyph [xpm :data "/* XPM */\nstatic char * gtk_mini_xpm[] = {\n\"15 20 17 1\",\n\" c None\",\n\". c #14121F\",\n\"+ c #278828\",\n\"@ c #9B3334\",\n\"# c #284C72\",\n\"$ c #24692A\",\n\"% c #69282E\",\n\"& c #37C539\",\n\"* c #1D2F4D\",\n\"= c #6D7076\",\n\"- c #7D8482\",\n\"; c #E24A49\",\n\"> c #515357\",\n\", c #9B9C9B\",\n\"' c #2FA232\",\n\") c #3CE23D\",\n\"! c #3B6CCB\",\n\" \",\n\" ***> \",\n\" >.*!!!* \",\n\" ***....#*= \",\n\" *!*.!!!**!!# \",\n\" .!!#*!#*!!!!# \",\n\" @%#!.##.*!!$& \",\n\" @;%*!*.#!#')) \",\n\" @;;@%!!*$&)'' \",\n\" @%.%@%$'&)$+' \",\n\" @;...@$'*'*)+ \",\n\" @;%..@$+*.')$ \",\n\" @;%%;;$+..$)# \",\n\" @;%%;@$$$'.$# \",\n\" %;@@;;$$+))&* \",\n\" %;;;@+$&)&* \",\n\" %;;@'))+> \",\n\" %;@'&# \",\n\" >%$$ \",\n\" >= \"};"]))
|
|
|
87
|
|
|
88
|
|
|
89 (defun build-option-menu (items history obj)
|
|
|
90 (let (omenu menu menu-item group i)
|
|
|
91 (setq omenu (gtk-option-menu-new)
|
|
|
92 menu (gtk-menu-new)
|
|
|
93 i 0)
|
|
|
94
|
|
|
95 (while items
|
|
|
96 (setq menu-item (gtk-radio-menu-item-new-with-label group (car (car items))))
|
|
|
97 (gtk-signal-connect menu-item 'activate (cdr (car items)) obj)
|
|
|
98 (setq group (gtk-radio-menu-item-group menu-item))
|
|
|
99 (gtk-menu-append menu menu-item)
|
|
|
100 (if (= i history)
|
|
|
101 (gtk-check-menu-item-set-active menu-item t))
|
|
|
102 (gtk-widget-show menu-item)
|
|
|
103 (setq items (cdr items))
|
|
|
104 (incf i))
|
|
|
105
|
|
|
106 (gtk-option-menu-set-menu omenu menu)
|
|
|
107 (gtk-option-menu-set-history omenu history)
|
|
|
108 omenu))
|
|
|
109
|
|
|
110 (defun gtk-test-notice-destroy (object symbol)
|
|
|
111 ;; Set variable to NIL to aid in object destruction.
|
|
|
112 (set symbol nil))
|
|
|
113
|
|
|
114 (defun gtk-test-make-sample-buttons (box maker)
|
|
|
115 ;; Create buttons and pack them in a premade BOX.
|
|
|
116 (mapcar (lambda (name)
|
|
|
117 (let ((button (funcall maker name)))
|
|
|
118 (gtk-box-pack-start box button t t 0)
|
|
|
119 (gtk-widget-show button)
|
|
|
120 button)) '("button1" "button2" "button3")))
|
|
|
121
|
|
|
122 (make-face 'gtk-test-face-large "A face with a large font, for use in GTK test cases")
|
|
|
123 (font-set-face-font 'gtk-test-face-large
|
|
|
124 (make-font :family '("LucidaBright" "Utopia" "Helvetica" "fixed")
|
|
|
125 :weight :normal
|
|
|
126 :size "36pt"))
|
|
|
127
|
|
|
128 (defvar gtk-test-shell nil
|
|
|
129 "Where non-dialog tests should realize their widgets.")
|
|
|
130
|
|
|
131 (defmacro gtk-define-test (title type name-stub dialog-p &rest body)
|
|
|
132 "Define a GTK demo/test.
|
|
|
133 TITLE is the friendly name of the test to show to the user.
|
|
|
134 TYPE is used to sort the items.
|
|
|
135 NAME-STUB is used to create the function definition.
|
|
|
136 DIALOG-P must be non-nil for demos that create their own top-level window.
|
|
|
137 BODY are the forms that actually create the demo.
|
|
|
138
|
|
|
139 They must pack their widgets into the dynamically bound WINDOW variable,
|
|
|
140 which is a GtkVBox.
|
|
|
141 "
|
|
|
142 `(progn
|
|
|
143 (if (not (assoc ,title gtk-defined-tests))
|
|
|
144 (push (list ,title (quote ,type)
|
|
|
145 (quote ,(intern (format "gtk-test-%s" name-stub)))) gtk-defined-tests))
|
|
|
146 (defun ,(intern (format "gtk-test-%s" name-stub)) ()
|
|
|
147 (let ((main-widget (if (not gtk-test-shell)
|
|
|
148 (gtk-window-new 'toplevel)
|
|
|
149 (gtk-frame-new ,title)))
|
|
|
150 (window nil))
|
|
|
151 (if gtk-test-shell
|
|
|
152 (progn
|
|
|
153 (mapc 'gtk-widget-destroy (gtk-container-children gtk-test-shell))
|
|
|
154 (gtk-box-pack-start gtk-test-shell main-widget nil nil 0))
|
|
|
155 (gtk-window-set-title main-widget ,title))
|
|
|
156 (if ,dialog-p
|
|
|
157 (let ((button (gtk-button-new-with-label ,title))
|
|
|
158 (blank (gtk-event-box-new)))
|
|
|
159 (setq window (gtk-hbox-new nil 0))
|
|
|
160 (gtk-signal-connect button 'clicked
|
|
|
161 (lambda (&rest ignored)
|
|
|
162 (let ((window nil))
|
|
|
163 ,@body
|
|
|
164 (gtk-widget-show-all window))))
|
|
|
165 (gtk-box-pack-start window
|
|
|
166 (gtk-label-new
|
|
|
167 (concat "This demo creates an external dialog.\n"
|
|
|
168 "Activate the button to see the demo."))
|
|
|
169 nil nil 0)
|
|
|
170 (gtk-box-pack-start window button nil nil 0)
|
|
|
171 (gtk-box-pack-start window blank t t 0)
|
|
|
172 (gtk-widget-show-all main-widget))
|
|
|
173 (setq window (gtk-vbox-new nil 0))
|
|
|
174 ,@body)
|
|
|
175 (gtk-container-add main-widget window)
|
|
|
176 (gtk-widget-show-all (or main-widget window))))))
|
|
|
177
|
|
|
178
|
|
|
179 ;;;; Pixmaps
|
|
|
180 (gtk-define-test
|
|
|
181 "Pixmaps" misc pixmap nil
|
|
|
182 (let* ((button (gtk-button-new))
|
|
|
183 (pixmap (gtk-pixmap-new xemacs-logo nil))
|
|
|
184 (label (gtk-label-new "Pixmap test"))
|
|
|
185 (hbox (gtk-hbox-new nil 0)))
|
|
|
186 (gtk-box-pack-start window button nil nil 0)
|
|
|
187 (gtk-widget-show button)
|
|
|
188 (gtk-container-set-border-width hbox 2)
|
|
|
189 (gtk-container-add hbox pixmap)
|
|
|
190 (gtk-container-add hbox label)
|
|
|
191 (gtk-container-add button hbox)
|
|
|
192 (gtk-widget-show pixmap)
|
|
|
193 (gtk-widget-show label)
|
|
|
194 (gtk-widget-show hbox)))
|
|
|
195
|
|
|
196
|
|
|
197 ;;;; Scrolled windows
|
|
|
198 (gtk-define-test
|
|
|
199 "Scrolled windows" container create-scrolled-windows nil
|
|
|
200 (let* ((scrolled-win (gtk-scrolled-window-new nil nil))
|
|
|
201 (viewport (gtk-viewport-new
|
|
|
202 (gtk-scrolled-window-get-hadjustment scrolled-win)
|
|
|
203 (gtk-scrolled-window-get-vadjustment scrolled-win)))
|
|
|
204 (table (gtk-table-new 20 20 nil))
|
|
|
205 (button nil))
|
|
|
206 (gtk-container-set-border-width window 0)
|
|
|
207 (gtk-container-set-border-width scrolled-win 10)
|
|
|
208 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
|
|
|
209 (gtk-box-pack-start window scrolled-win t t 0)
|
|
|
210 (gtk-table-set-row-spacings table 10)
|
|
|
211 (gtk-table-set-col-spacings table 10)
|
|
|
212 (gtk-scrolled-window-add-with-viewport scrolled-win table)
|
|
|
213 (gtk-container-set-focus-hadjustment
|
|
|
214 table (gtk-scrolled-window-get-hadjustment scrolled-win))
|
|
|
215 (gtk-container-set-focus-vadjustment
|
|
|
216 table (gtk-scrolled-window-get-vadjustment scrolled-win))
|
|
|
217 (loop for i from 0 to 19 do
|
|
|
218 (loop for j from 0 to 19 do
|
|
|
219 (setq button (gtk-button-new-with-label (format "button (%d, %d)\n" i j)))
|
|
|
220 (gtk-table-attach-defaults table button i (1+ i) j (1+ j))))
|
|
|
221 (gtk-widget-show-all scrolled-win)))
|
|
|
222
|
|
|
223
|
|
|
224 ;;;; Lists
|
|
|
225 (gtk-define-test
|
|
|
226 "List" basic create-list nil
|
|
|
227 (let ((list-items '("hello"
|
|
|
228 "world"
|
|
|
229 "blah"
|
|
|
230 "foo"
|
|
|
231 "bar"
|
|
|
232 "argh"
|
|
|
233 "wmperry"
|
|
|
234 "is a"
|
|
|
235 "wussy"
|
|
|
236 "programmer"))
|
|
|
237 (scrolled-win (gtk-scrolled-window-new nil nil))
|
|
|
238 (lyst (gtk-list-new))
|
|
|
239 (add (gtk-button-new-with-label "add"))
|
|
|
240 (remove (gtk-button-new-with-label "remove")))
|
|
|
241
|
|
|
242 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
|
|
|
243 (gtk-box-pack-start window scrolled-win t t 0)
|
|
|
244 (gtk-widget-show scrolled-win)
|
|
|
245
|
|
|
246 (gtk-list-set-selection-mode lyst 'multiple)
|
|
|
247 (gtk-list-set-selection-mode lyst 'browse)
|
|
|
248 (gtk-scrolled-window-add-with-viewport scrolled-win lyst)
|
|
|
249 (gtk-widget-show lyst)
|
|
|
250
|
|
|
251 (mapc (lambda (i)
|
|
|
252 (let ((list-item (gtk-list-item-new-with-label i)))
|
|
|
253 (gtk-container-add lyst list-item)
|
|
|
254 (gtk-widget-show list-item)))
|
|
|
255 list-items)
|
|
|
256
|
|
|
257 (gtk-signal-connect add 'clicked
|
|
|
258 (lambda (obj data) (message "Should add to the list")))
|
|
|
259 (gtk-box-pack-start window add nil t 0)
|
|
|
260 (gtk-widget-show add)
|
|
|
261
|
|
|
262 (gtk-signal-connect remove 'clicked
|
|
|
263 (lambda (obj list)
|
|
|
264 (if (gtk-list-selection list)
|
|
|
265 (gtk-list-remove-items list (gtk-list-selection list)))) lyst)
|
|
|
266 (gtk-box-pack-start window remove nil t 0)
|
|
|
267 (gtk-widget-show remove)
|
|
|
268
|
|
|
269 (gtk-signal-connect lyst 'select_child
|
|
|
270 (lambda (lyst child ignored)
|
|
|
271 (message "selected %S %d" child (gtk-list-child-position lyst child))))
|
|
|
272
|
|
|
273 (gtk-widget-set-usize scrolled-win 200 75)
|
|
|
274
|
|
|
275 (gtk-signal-connect lyst 'unselect_child (lambda (lyst child ignored)
|
|
|
276 (message "unselected %S" child)))))
|
|
|
277
|
|
|
278
|
|
|
279 ;;;; Tooltips
|
|
|
280 (defvar gtk-test-tooltips nil)
|
|
|
281
|
|
|
282 (gtk-define-test
|
|
|
283 "Tooltips" composite create-tooltips nil
|
|
|
284 (if (not gtk-test-tooltips)
|
|
|
285 (setq gtk-test-tooltips (gtk-tooltips-new)))
|
|
|
286 (let ((buttons (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
|
|
|
287 (tips '("This is button 1"
|
|
|
288 "This is button 2"
|
|
|
289 "This is button 3. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly.")))
|
|
|
290 (while buttons
|
|
|
291 (gtk-tooltips-set-tip gtk-test-tooltips (pop buttons) (pop tips) ""))))
|
|
|
292
|
|
|
293
|
|
|
294 ;;;; Panes
|
|
|
295 (defun toggle-resize (widget child)
|
|
|
296 (let* ((paned (gtk-widget-parent child))
|
|
|
297 (is-child1 (eq child (gtk-paned-child1 paned)))
|
|
|
298 resize shrink)
|
|
|
299 (setq resize (if is-child1
|
|
|
300 (gtk-paned-child1-resize paned)
|
|
|
301 (gtk-paned-child2-resize paned))
|
|
|
302 shrink (if is-child1
|
|
|
303 (gtk-paned-child1-shrink paned)
|
|
|
304 (gtk-paned-child2-shrink paned)))
|
|
|
305
|
|
|
306 (gtk-widget-ref child)
|
|
|
307 (gtk-container-remove paned child)
|
|
|
308 (if is-child1
|
|
|
309 (gtk-paned-pack1 paned child (not resize) shrink)
|
|
|
310 (gtk-paned-pack2 paned child (not resize) shrink))
|
|
|
311 (gtk-widget-unref child)))
|
|
|
312
|
|
|
313 (defun toggle-shrink (widget child)
|
|
|
314 (let* ((paned (gtk-widget-parent child))
|
|
|
315 (is-child1 (eq child (gtk-paned-child1 paned)))
|
|
|
316 resize shrink)
|
|
|
317 (setq resize (if is-child1
|
|
|
318 (gtk-paned-child1-resize paned)
|
|
|
319 (gtk-paned-child2-resize paned))
|
|
|
320 shrink (if is-child1
|
|
|
321 (gtk-paned-child1-shrink paned)
|
|
|
322 (gtk-paned-child2-shrink paned)))
|
|
|
323
|
|
|
324 (gtk-widget-ref child)
|
|
|
325 (gtk-container-remove paned child)
|
|
|
326 (if is-child1
|
|
|
327 (gtk-paned-pack1 paned child resize (not shrink))
|
|
|
328 (gtk-paned-pack2 paned child resize (not shrink)))
|
|
|
329 (gtk-widget-unref child)))
|
|
|
330
|
|
|
331 (defun create-pane-options (widget frame-label label1 label2)
|
|
|
332 (let (frame table label check-button)
|
|
|
333 (setq frame (gtk-frame-new frame-label))
|
|
|
334 (gtk-container-set-border-width frame 4)
|
|
|
335
|
|
|
336 (setq table (gtk-table-new 3 2 4))
|
|
|
337 (gtk-container-add frame table)
|
|
|
338
|
|
|
339 (setq label (gtk-label-new label1))
|
|
|
340 (gtk-table-attach-defaults table label 0 1 0 1)
|
|
|
341
|
|
|
342 (setq check-button (gtk-check-button-new-with-label "Resize"))
|
|
|
343 (gtk-table-attach-defaults table check-button 0 1 1 2)
|
|
|
344 (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child1 widget))
|
|
|
345
|
|
|
346 (setq check-button (gtk-check-button-new-with-label "Shrink"))
|
|
|
347 (gtk-table-attach-defaults table check-button 0 1 2 3)
|
|
|
348 (gtk-toggle-button-set-active check-button t)
|
|
|
349 (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child1 widget))
|
|
|
350
|
|
|
351 (setq label (gtk-label-new label2))
|
|
|
352 (gtk-table-attach-defaults table label 1 2 0 1)
|
|
|
353
|
|
|
354 (setq check-button (gtk-check-button-new-with-label "Resize"))
|
|
|
355 (gtk-table-attach-defaults table check-button 1 2 1 2)
|
|
|
356 (gtk-toggle-button-set-active check-button t)
|
|
|
357 (gtk-signal-connect check-button 'toggled 'toggle-resize (gtk-paned-child2 widget))
|
|
|
358
|
|
|
359 (setq check-button (gtk-check-button-new-with-label "Shrink"))
|
|
|
360 (gtk-table-attach-defaults table check-button 1 2 2 3)
|
|
|
361 (gtk-toggle-button-set-active check-button t)
|
|
|
362 (gtk-signal-connect check-button 'toggled 'toggle-shrink (gtk-paned-child2 widget))
|
|
|
363 frame))
|
|
|
364
|
|
|
365 (gtk-define-test
|
|
|
366 "Panes" container panes nil
|
|
|
367 (let (frame hpaned vpaned button vbox)
|
|
|
368 (gtk-container-set-border-width window 0)
|
|
|
369
|
|
|
370 (setq vpaned (gtk-vpaned-new))
|
|
|
371 (gtk-box-pack-start window vpaned t t 0)
|
|
|
372 (gtk-container-set-border-width vpaned 5)
|
|
|
373
|
|
|
374 (setq hpaned (gtk-hpaned-new))
|
|
|
375 (gtk-paned-add1 vpaned hpaned)
|
|
|
376
|
|
|
377 (setq frame (gtk-frame-new nil))
|
|
|
378 (gtk-frame-set-shadow-type frame 'in)
|
|
|
379 (gtk-widget-set-usize frame 60 60)
|
|
|
380 (gtk-paned-add1 hpaned frame)
|
|
|
381
|
|
|
382 (setq button (gtk-button-new-with-label "Hi there"))
|
|
|
383 (gtk-container-add frame button)
|
|
|
384
|
|
|
385 (setq frame (gtk-frame-new nil))
|
|
|
386 (gtk-frame-set-shadow-type frame 'in)
|
|
|
387 (gtk-widget-set-usize frame 80 60)
|
|
|
388 (gtk-paned-add2 hpaned frame)
|
|
|
389
|
|
|
390 (setq frame (gtk-frame-new nil))
|
|
|
391 (gtk-frame-set-shadow-type frame 'in)
|
|
|
392 (gtk-widget-set-usize frame 60 80)
|
|
|
393 (gtk-paned-add2 vpaned frame)
|
|
|
394
|
|
|
395 ;; Now create toggle buttons to control sizing
|
|
|
396 (gtk-box-pack-start window (create-pane-options hpaned "Horizontal" "Left" "Right") nil nil 0)
|
|
|
397 (gtk-box-pack-start window (create-pane-options vpaned "Vertical" "Top" "Bottom") nil nil 0)
|
|
|
398 (gtk-widget-show-all window)))
|
|
|
399
|
|
|
400
|
|
|
401 ;;;; Entry
|
|
|
402 (gtk-define-test
|
|
|
403 "Entry" basic entry nil
|
|
|
404 (let ((box1 nil)
|
|
|
405 (box2 nil)
|
|
|
406 (editable-check nil)
|
|
|
407 (sensitive-check nil)
|
|
|
408 (entry nil)
|
|
|
409 (cb nil)
|
|
|
410 (button nil)
|
|
|
411 (separator nil)
|
|
|
412 (cbitems '("item0"
|
|
|
413 "item1 item1"
|
|
|
414 "item2 item2 item2"
|
|
|
415 "item3 item3 item3 item3"
|
|
|
416 "item4 item4 item4 item4 item4"
|
|
|
417 "item5 item5 item5 item5 item5 item5"
|
|
|
418 "item6 item6 item6 item6 item6"
|
|
|
419 "item7 item7 item7 item7"
|
|
|
420 "item8 item8 item8"
|
|
|
421 "item9 item9")))
|
|
|
422 (gtk-container-set-border-width window 0)
|
|
|
423
|
|
|
424 (setq box1 (gtk-vbox-new nil 0))
|
|
|
425 (gtk-container-add window box1)
|
|
|
426 (gtk-widget-show box1)
|
|
|
427
|
|
|
428 (setq box2 (gtk-vbox-new nil 10))
|
|
|
429 (gtk-container-set-border-width box2 10)
|
|
|
430 (gtk-box-pack-start box1 box2 t t 0)
|
|
|
431 (gtk-widget-show box2)
|
|
|
432
|
|
|
433 (setq entry (gtk-entry-new))
|
|
|
434 (gtk-entry-set-text entry "hello world")
|
|
|
435 (gtk-editable-select-region entry 0 5)
|
|
|
436 (gtk-box-pack-start box2 entry t t 0)
|
|
|
437 (gtk-widget-show entry)
|
|
|
438
|
|
|
439 (setq cb (gtk-combo-new))
|
|
|
440 (gtk-combo-set-popdown-strings cb cbitems)
|
|
|
441 (gtk-entry-set-text (gtk-combo-entry cb) "hellow world")
|
|
|
442 (gtk-editable-select-region (gtk-combo-entry cb) 0 -1)
|
|
|
443 (gtk-box-pack-start box2 cb t t 0)
|
|
|
444 (gtk-widget-show cb)
|
|
|
445
|
|
|
446 (setq editable-check (gtk-check-button-new-with-label "Editable"))
|
|
|
447 (gtk-box-pack-start box2 editable-check nil t 0)
|
|
|
448 (gtk-signal-connect editable-check 'toggled
|
|
|
449 (lambda (obj data)
|
|
|
450 (gtk-entry-set-editable
|
|
|
451 data
|
|
|
452 (gtk-toggle-button-get-active obj))) entry)
|
|
|
453 (gtk-toggle-button-set-active editable-check t)
|
|
|
454 (gtk-widget-show editable-check)
|
|
|
455
|
|
|
456 (setq editable-check (gtk-check-button-new-with-label "Visible"))
|
|
|
457 (gtk-box-pack-start box2 editable-check nil t 0)
|
|
|
458 (gtk-signal-connect editable-check 'toggled
|
|
|
459 (lambda (obj data)
|
|
|
460 (gtk-entry-set-visibility data
|
|
|
461 (gtk-toggle-button-get-active obj))) entry)
|
|
|
462 (gtk-toggle-button-set-active editable-check t)
|
|
|
463 (gtk-widget-show editable-check)
|
|
|
464
|
|
|
465 (setq sensitive-check (gtk-check-button-new-with-label "Sensitive"))
|
|
|
466 (gtk-box-pack-start box2 sensitive-check nil t 0)
|
|
|
467 (gtk-signal-connect sensitive-check 'toggled
|
|
|
468 (lambda (obj data)
|
|
|
469 (gtk-widget-set-sensitive data
|
|
|
470 (gtk-toggle-button-get-active obj))) entry)
|
|
|
471 (gtk-toggle-button-set-active sensitive-check t)
|
|
|
472 (gtk-widget-show sensitive-check)))
|
|
|
473
|
|
|
474
|
|
|
475 ;;;; Various built-in dialog types
|
|
|
476 (gtk-define-test
|
|
|
477 "Font Dialog" composite font-selection t
|
|
|
478 (setq window (gtk-font-selection-dialog-new "font selection dialog"))
|
|
|
479 (gtk-font-selection-dialog-set-preview-text window "Set from Emacs Lisp!")
|
|
|
480 (gtk-signal-connect
|
|
|
481 (gtk-font-selection-dialog-cancel-button window)
|
|
|
482 'clicked (lambda (button dlg)
|
|
|
483 (gtk-widget-destroy dlg))
|
|
|
484 window)
|
|
|
485 (gtk-signal-connect
|
|
|
486 (gtk-font-selection-dialog-ok-button window)
|
|
|
487 'clicked
|
|
|
488 (lambda (button dlg)
|
|
|
489 (message "Font selected: %s" (gtk-font-selection-dialog-get-font-name dlg)))
|
|
|
490 window))
|
|
|
491
|
|
|
492 (gtk-define-test
|
|
|
493 "File Selection Dialog" composite file-selection t
|
|
|
494 (let (button)
|
|
|
495 (setq window (gtk-file-selection-new "file selection"))
|
|
|
496 (gtk-signal-connect
|
|
|
497 (gtk-file-selection-ok-button window)
|
|
|
498 'clicked (lambda (obj dlg) (message "You clicked ok: %s"
|
|
|
499 (gtk-file-selection-get-filename dlg)))
|
|
|
500 window)
|
|
|
501
|
|
|
502 (gtk-signal-connect
|
|
|
503 (gtk-file-selection-cancel-button window)
|
|
|
504 'clicked (lambda (obj dlg) (gtk-widget-destroy dlg)) window)
|
|
|
505
|
|
|
506 (gtk-file-selection-hide-fileop-buttons window)
|
|
|
507
|
|
|
508 (setq button (gtk-button-new-with-label "Hide Fileops"))
|
|
|
509 (gtk-signal-connect
|
|
|
510 button 'clicked
|
|
|
511 (lambda (obj dlg)
|
|
|
512 (gtk-file-selection-hide-fileop-buttons dlg)) window)
|
|
|
513
|
|
|
514 (gtk-box-pack-start (gtk-file-selection-action-area window)
|
|
|
515 button nil nil 0)
|
|
|
516 (gtk-widget-show button)
|
|
|
517
|
|
|
518 (setq button (gtk-button-new-with-label "Show Fileops"))
|
|
|
519 (gtk-signal-connect
|
|
|
520 button 'clicked
|
|
|
521 (lambda (obj dlg)
|
|
|
522 (gtk-file-selection-show-fileop-buttons dlg)) window)
|
|
|
523 (gtk-box-pack-start (gtk-file-selection-action-area window)
|
|
|
524 button nil nil 0)
|
|
|
525 (gtk-widget-show button)))
|
|
|
526
|
|
|
527 (gtk-define-test
|
|
|
528 "Color selection" composite color t
|
|
|
529 (setq window (gtk-color-selection-dialog-new "GTK color selection"))
|
|
|
530 (gtk-signal-connect (gtk-color-selection-dialog-cancel-button window)
|
|
|
531 'clicked
|
|
|
532 (lambda (button data)
|
|
|
533 (gtk-widget-destroy data)) window)
|
|
|
534 (gtk-signal-connect (gtk-color-selection-dialog-ok-button window)
|
|
|
535 'clicked
|
|
|
536 (lambda (button data)
|
|
|
537 (let ((rgba (gtk-color-selection-get-color
|
|
|
538 (gtk-color-selection-dialog-colorsel data)))
|
|
|
539 r g b a)
|
|
|
540 (setq r (pop rgba)
|
|
|
541 g (pop rgba)
|
|
|
542 b (pop rgba)
|
|
|
543 a (pop rgba))
|
|
|
544 (gtk-widget-destroy data)
|
|
|
545 (message-box
|
|
|
546 "You selected color: red (%04x) blue (%04x) green (%04x) alpha (%g)"
|
|
|
547 (* 65535 r) (* 65535 g) (* 65535 b) a)))
|
|
|
548 window))
|
|
|
549
|
|
|
550
|
|
|
551 ;;;; Dialog
|
|
|
552 (defun gtk-container-specific-children (parent predicate &optional data)
|
|
|
553 (let ((children nil))
|
|
|
554 (mapc (lambda (w)
|
|
|
555 (if (funcall predicate w data)
|
|
|
556 (push w children)))
|
|
|
557 (gtk-container-children parent))
|
|
|
558 children))
|
|
|
559
|
|
|
560 (gtk-define-test
|
|
|
561 "Dialog" basic dialog t
|
|
|
562 (let ((button nil)
|
|
|
563 (label nil))
|
|
|
564 (setq window (gtk-dialog-new))
|
|
|
565 (gtk-container-set-border-width window 0)
|
|
|
566 (gtk-widget-set-usize window 200 110)
|
|
|
567
|
|
|
568 (setq button (gtk-button-new-with-label "OK"))
|
|
|
569 (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
|
|
|
570 (gtk-widget-show button)
|
|
|
571 (gtk-signal-connect button 'clicked
|
|
|
572 (lambda (obj data)
|
|
|
573 (gtk-widget-destroy data))
|
|
|
574 window)
|
|
|
575
|
|
|
576 (setq button (gtk-button-new-with-label "Toggle"))
|
|
|
577 (gtk-signal-connect
|
|
|
578 button 'clicked
|
|
|
579 (lambda (button dlg)
|
|
|
580 (if (not (gtk-container-specific-children (gtk-dialog-vbox dlg)
|
|
|
581 (lambda (w ignored)
|
|
|
582 (= (gtk-object-type w) (gtk-label-get-type)))))
|
|
|
583 (let ((label (gtk-label-new "Dialog Test")))
|
|
|
584 (gtk-box-pack-start (gtk-dialog-vbox dlg) label t t 0)
|
|
|
585 (gtk-widget-show label))
|
|
|
586 (mapc 'gtk-widget-destroy
|
|
|
587 (gtk-container-specific-children (gtk-dialog-vbox dlg)
|
|
|
588 (lambda (w ignored)
|
|
|
589 (= (gtk-object-type w) (gtk-label-get-type)))))))
|
|
|
590 window)
|
|
|
591 (gtk-box-pack-start (gtk-dialog-action-area window) button t t 0)
|
|
|
592 (gtk-widget-show button)))
|
|
|
593
|
|
|
594
|
|
|
595 ;;;; Range controls
|
|
|
596 (gtk-define-test
|
|
|
597 "Range Controls" basic range-controls nil
|
|
|
598 (let* ((adjustment (gtk-adjustment-new 0.0 0.0 101.0 0.1 1.0 1.0))
|
|
|
599 (scale (gtk-hscale-new adjustment))
|
|
|
600 (scrollbar (gtk-hscrollbar-new adjustment)))
|
|
|
601 (gtk-widget-set-usize scale 150 30)
|
|
|
602 (gtk-range-set-update-policy scale 'delayed)
|
|
|
603 (gtk-scale-set-digits scale 2)
|
|
|
604 (gtk-scale-set-draw-value scale t)
|
|
|
605 (gtk-box-pack-start window scale t t 0)
|
|
|
606 (gtk-widget-show scale)
|
|
|
607
|
|
|
608 (gtk-range-set-update-policy scrollbar 'continuous)
|
|
|
609 (gtk-box-pack-start window scrollbar t t 0)
|
|
|
610 (gtk-widget-show scrollbar)))
|
|
|
611
|
|
|
612
|
|
|
613 ;;;; Ruler
|
|
|
614 '(gtk-define-test
|
|
|
615 "Rulers" gimp rulers nil
|
|
|
616 (let* ((table (gtk-table-new 2 2 nil))
|
|
|
617 (hruler nil)
|
|
|
618 (vruler nil)
|
|
|
619 (ebox (gtk-event-box-new)))
|
|
|
620
|
|
|
621 (gtk-widget-set-usize ebox 300 300)
|
|
|
622 (gtk-widget-set-events ebox '(pointer-motion-mask pointer-motion-hint-mask))
|
|
|
623 (gtk-container-set-border-width ebox 0)
|
|
|
624
|
|
|
625 (gtk-container-add window ebox)
|
|
|
626 (gtk-container-add ebox table)
|
|
|
627 (gtk-widget-show table)
|
|
|
628
|
|
|
629 (setq hruler (gtk-hruler-new))
|
|
|
630 (gtk-ruler-set-metric hruler 'centimeters)
|
|
|
631 (gtk-ruler-set-range hruler 100 0 0 20)
|
|
|
632 (gtk-table-attach table hruler 1 2 0 1 '(expand fill) 'fill 0 0)
|
|
|
633 (gtk-widget-show hruler)
|
|
|
634
|
|
|
635 (setq vruler (gtk-vruler-new))
|
|
|
636 (gtk-ruler-set-range vruler 5 15 0 20)
|
|
|
637 (gtk-table-attach table vruler 0 1 1 2 'fill '(expand fill) 0 0)
|
|
|
638 (gtk-widget-show vruler)
|
|
|
639
|
|
|
640 (gtk-signal-connect
|
|
|
641 ebox 'motion_notify_event
|
|
|
642 (lambda (object ev data)
|
|
|
643 (gtk-widget-event (car data) ev)
|
|
|
644 (gtk-widget-event (cdr data) ev))
|
|
|
645 (cons hruler vruler))))
|
|
|
646
|
|
|
647
|
|
|
648 ;;;; Toggle button types
|
|
|
649 (gtk-define-test
|
|
|
650 "Toggle Buttons" basic toggle-buttons nil
|
|
|
651 (gtk-container-set-border-width window 0)
|
|
|
652 (gtk-test-make-sample-buttons window 'gtk-toggle-button-new-with-label))
|
|
|
653
|
|
|
654 (gtk-define-test
|
|
|
655 "Check Buttons" basic check-buttons nil
|
|
|
656 (gtk-container-set-border-width window 0)
|
|
|
657 (gtk-test-make-sample-buttons window 'gtk-check-button-new-with-label))
|
|
|
658
|
|
|
659 (gtk-define-test
|
|
|
660 "Radio Buttons" basic radio-buttons nil
|
|
|
661 (gtk-container-set-border-width window 0)
|
|
|
662 (let ((group nil))
|
|
|
663 (gtk-test-make-sample-buttons window
|
|
|
664 (lambda (label)
|
|
|
665 (let ((button (gtk-radio-button-new-with-label group label)))
|
|
|
666 (setq group (gtk-radio-button-group button))
|
|
|
667 button)))))
|
|
|
668
|
|
|
669
|
|
|
670 ;;;; Button weirdness
|
|
|
671 (gtk-define-test
|
|
|
672 "Buttons" basic buttons nil
|
|
|
673 (let ((box1 nil)
|
|
|
674 (box2 nil)
|
|
|
675 (table nil)
|
|
|
676 (buttons nil)
|
|
|
677 (separator nil)
|
|
|
678 (connect-buttons (lambda (button1 button2)
|
|
|
679 (gtk-signal-connect button1 'clicked
|
|
|
680 (lambda (obj data)
|
|
|
681 (if (gtk-widget-visible data)
|
|
|
682 (gtk-widget-hide data)
|
|
|
683 (gtk-widget-show data))) button2))))
|
|
|
684
|
|
|
685 (gtk-container-set-border-width window 0)
|
|
|
686
|
|
|
687 (setq box1 (gtk-vbox-new nil 0))
|
|
|
688 (gtk-container-add window box1)
|
|
|
689
|
|
|
690 (setq table (gtk-table-new 3 3 nil))
|
|
|
691 (gtk-table-set-row-spacings table 5)
|
|
|
692 (gtk-table-set-col-spacings table 5)
|
|
|
693 (gtk-container-set-border-width table 10)
|
|
|
694 (gtk-box-pack-start box1 table t t 0)
|
|
|
695
|
|
|
696 (push (gtk-button-new-with-label "button9") buttons)
|
|
|
697 (push (gtk-button-new-with-label "button8") buttons)
|
|
|
698 (push (gtk-button-new-with-label "button7") buttons)
|
|
|
699 (push (gtk-button-new-with-label "button6") buttons)
|
|
|
700 (push (gtk-button-new-with-label "button5") buttons)
|
|
|
701 (push (gtk-button-new-with-label "button4") buttons)
|
|
|
702 (push (gtk-button-new-with-label "button3") buttons)
|
|
|
703 (push (gtk-button-new-with-label "button2") buttons)
|
|
|
704 (push (gtk-button-new-with-label "button1") buttons)
|
|
|
705
|
|
|
706 (funcall connect-buttons (nth 0 buttons) (nth 1 buttons))
|
|
|
707 (funcall connect-buttons (nth 1 buttons) (nth 2 buttons))
|
|
|
708 (funcall connect-buttons (nth 2 buttons) (nth 3 buttons))
|
|
|
709 (funcall connect-buttons (nth 3 buttons) (nth 4 buttons))
|
|
|
710 (funcall connect-buttons (nth 4 buttons) (nth 5 buttons))
|
|
|
711 (funcall connect-buttons (nth 5 buttons) (nth 6 buttons))
|
|
|
712 (funcall connect-buttons (nth 6 buttons) (nth 7 buttons))
|
|
|
713 (funcall connect-buttons (nth 7 buttons) (nth 8 buttons))
|
|
|
714 (funcall connect-buttons (nth 8 buttons) (nth 0 buttons))
|
|
|
715
|
|
|
716 (gtk-table-attach table (nth 0 buttons) 0 1 0 1 '(expand fill) '(expand fill) 0 0)
|
|
|
717 (gtk-table-attach table (nth 1 buttons) 1 2 1 2 '(expand fill) '(expand fill) 0 0)
|
|
|
718 (gtk-table-attach table (nth 2 buttons) 2 3 2 3 '(expand fill) '(expand fill) 0 0)
|
|
|
719 (gtk-table-attach table (nth 3 buttons) 0 1 2 3 '(expand fill) '(expand fill) 0 0)
|
|
|
720 (gtk-table-attach table (nth 4 buttons) 2 3 0 1 '(expand fill) '(expand fill) 0 0)
|
|
|
721 (gtk-table-attach table (nth 5 buttons) 1 2 2 3 '(expand fill) '(expand fill) 0 0)
|
|
|
722 (gtk-table-attach table (nth 6 buttons) 1 2 0 1 '(expand fill) '(expand fill) 0 0)
|
|
|
723 (gtk-table-attach table (nth 7 buttons) 2 3 1 2 '(expand fill) '(expand fill) 0 0)
|
|
|
724 (gtk-table-attach table (nth 8 buttons) 0 1 1 2 '(expand fill) '(expand fill) 0 0)
|
|
|
725 ))
|
|
|
726
|
|
|
727
|
|
|
728 ;;;; Testing labels and underlining
|
|
|
729 (gtk-define-test
|
|
|
730 "Labels" basic labels nil
|
|
|
731 (let ((hbox (gtk-hbox-new nil 5))
|
|
|
732 (vbox (gtk-vbox-new nil 5))
|
|
|
733 (frame nil)
|
|
|
734 (label nil))
|
|
|
735 (gtk-container-add window hbox)
|
|
|
736 (gtk-box-pack-start hbox vbox nil nil 0)
|
|
|
737 (gtk-container-set-border-width window 5)
|
|
|
738
|
|
|
739 (setq frame (gtk-frame-new "Normal Label")
|
|
|
740 label (gtk-label-new "This is a Normal label"))
|
|
|
741 (gtk-container-add frame label)
|
|
|
742 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
743
|
|
|
744 (setq frame (gtk-frame-new "Multi-line Label")
|
|
|
745 label (gtk-label-new "This is a multi-line label.\nSecond line\nThird line"))
|
|
|
746 (gtk-container-add frame label)
|
|
|
747 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
748
|
|
|
749 (setq frame (gtk-frame-new "Left Justified Label")
|
|
|
750 label (gtk-label-new "This is a Left-Justified\nMulti-line label.\nThird line"))
|
|
|
751 (gtk-label-set-justify label 'left)
|
|
|
752 (gtk-container-add frame label)
|
|
|
753 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
754
|
|
|
755 (setq frame (gtk-frame-new "Right Justified Label")
|
|
|
756 label (gtk-label-new "This is a Right-Justified\nMulti-line label.\nFourth line, (j/k)"))
|
|
|
757 (gtk-label-set-justify label 'right)
|
|
|
758 (gtk-container-add frame label)
|
|
|
759 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
760
|
|
|
761 ;; Start a second row so that we don't make a ridiculously tall window
|
|
|
762 (setq vbox (gtk-vbox-new nil 5))
|
|
|
763 (gtk-box-pack-start hbox vbox nil nil 0)
|
|
|
764
|
|
|
765 (setq frame (gtk-frame-new "Line wrapped label")
|
|
|
766 label (gtk-label-new
|
|
|
767 (concat "This is an example of a line-wrapped label. It should not be taking "
|
|
|
768 "up the entire " ;;; big space to test spacing
|
|
|
769 "width allocated to it, but automatically wraps the words to fit. "
|
|
|
770 "The time has come, for all good men, to come to the aid of their party. "
|
|
|
771 "The sixth sheik's six sheep's sick.\n"
|
|
|
772 " It supports multiple paragraphs correctly, and correctly adds "
|
|
|
773 "many extra spaces. ")))
|
|
|
774 (gtk-label-set-line-wrap label t)
|
|
|
775 (gtk-container-add frame label)
|
|
|
776 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
777
|
|
|
778 (setq frame (gtk-frame-new "Filled, wrapped label")
|
|
|
779 label (gtk-label-new
|
|
|
780 (concat
|
|
|
781 "This is an example of a line-wrapped, filled label. It should be taking "
|
|
|
782 "up the entire width allocated to it. Here is a seneance to prove "
|
|
|
783 "my point. Here is another sentence. "
|
|
|
784 "Here comes the sun, do de do de do.\n"
|
|
|
785 " This is a new paragraph.\n"
|
|
|
786 " This is another newer, longer, better paragraph. It is coming to an end, "
|
|
|
787 "unfortunately.")))
|
|
|
788 (gtk-label-set-justify label 'fill)
|
|
|
789 (gtk-label-set-line-wrap label t)
|
|
|
790 (gtk-container-add frame label)
|
|
|
791 (gtk-box-pack-start vbox frame nil nil 0)
|
|
|
792
|
|
|
793 (setq frame (gtk-frame-new "Underlined label")
|
|
|
794 label (gtk-label-new (concat "This label is underlined!\n"
|
|
|
795 "This one is underlined in ÆüËܸì¤ÎÆþÍÑquite a funky fashion")))
|
|
|
796 (gtk-label-set-justify label 'left)
|
|
|
797 (gtk-label-set-pattern label "_________________________ _ _________ _ _____ _ __ __ ___ ____ _____")
|
|
|
798 (gtk-container-add frame label)
|
|
|
799 (gtk-box-pack-start vbox frame nil nil 0)))
|
|
|
800
|
|
|
801
|
|
|
802 ;;;; Progress gauges
|
|
|
803 (gtk-define-test
|
|
|
804 "Progress bars" basic progress nil
|
|
|
805 (let* ((timer nil)
|
|
|
806 (adj (gtk-adjustment-new 1 0 100 1 1 1))
|
|
|
807 (label (gtk-label-new "progress..."))
|
|
|
808 (pbar (gtk-progress-bar-new-with-adjustment adj))
|
|
|
809 (button nil)
|
|
|
810 (timer (make-itimer)))
|
|
|
811
|
|
|
812 ;; The original test used GTK timers, but XEmacs already has
|
|
|
813 ;; perfectly good timer support, that ends up mapping onto GTK
|
|
|
814 ;; timers anyway, so we'll use those instead.
|
|
|
815 (set-itimer-function
|
|
|
816 timer
|
|
|
817 (lambda (bar adj)
|
|
|
818 (let ((val (gtk-adjustment-value adj)))
|
|
|
819 (setq val (+ 1 (if (>= val 100) 0 val)))
|
|
|
820 (gtk-adjustment-set-value adj val)
|
|
|
821 (gtk-widget-queue-draw bar))))
|
|
|
822
|
|
|
823 (set-itimer-function-arguments timer (list pbar adj))
|
|
|
824 (set-itimer-uses-arguments timer t)
|
|
|
825 (set-itimer-restart timer 0.1)
|
|
|
826 (set-itimer-value timer 0.1)
|
|
|
827 (set-itimer-is-idle timer nil)
|
|
|
828
|
|
|
829 (gtk-progress-set-format-string pbar "%v%%")
|
|
|
830 (gtk-signal-connect pbar 'destroy (lambda (obj timer)
|
|
|
831 (delete-itimer timer)) timer)
|
|
|
832
|
|
|
833 (gtk-misc-set-alignment label 0 0.5)
|
|
|
834 (gtk-box-pack-start window label nil t 0)
|
|
|
835 (gtk-widget-show label)
|
|
|
836 (gtk-widget-set-usize pbar 200 20)
|
|
|
837 (gtk-box-pack-start window pbar t t 0)
|
|
|
838
|
|
|
839 (setq button (gtk-check-button-new-with-label "Show text"))
|
|
|
840 (gtk-box-pack-start window button nil nil 0)
|
|
|
841 (gtk-signal-connect button 'clicked
|
|
|
842 (lambda (button bar)
|
|
|
843 (gtk-progress-set-show-text
|
|
|
844 bar
|
|
|
845 (gtk-toggle-button-get-active button))) pbar)
|
|
|
846 (gtk-widget-show button)
|
|
|
847
|
|
|
848 (setq button (gtk-check-button-new-with-label "Discrete blocks"))
|
|
|
849 (gtk-box-pack-start window button nil nil 0)
|
|
|
850 (gtk-signal-connect button 'clicked
|
|
|
851 (lambda (button bar)
|
|
|
852 (gtk-progress-bar-set-bar-style
|
|
|
853 bar
|
|
|
854 (if (gtk-toggle-button-get-active button)
|
|
|
855 'discrete
|
|
|
856 'continuous))) pbar)
|
|
|
857 (gtk-widget-show button)
|
|
|
858
|
|
|
859 (gtk-widget-show pbar)
|
|
|
860
|
|
|
861 (activate-itimer timer)))
|
|
|
862
|
|
|
863 (gtk-define-test
|
|
|
864 "Gamma Curve" gimp gamma-curve nil
|
|
|
865 (let ((curve (gtk-gamma-curve-new)))
|
|
|
866 (gtk-container-add window curve)
|
|
|
867 (gtk-widget-show-all curve)
|
|
|
868 (gtk-curve-set-range (gtk-gamma-curve-curve curve) 0 255 0 255)
|
|
|
869 (gtk-curve-set-gamma (gtk-gamma-curve-curve curve) 2)))
|
|
|
870
|
|
|
871
|
|
|
872 ;;;; Testing various button boxes and layout strategies.
|
|
|
873 (gtk-define-test
|
|
|
874 "Button Box" container button-box nil
|
|
|
875 (let ((main-vbox (gtk-vbox-new nil 0))
|
|
|
876 (vbox (gtk-vbox-new nil 0))
|
|
|
877 (hbox (gtk-hbox-new nil 0))
|
|
|
878 (frame-horz (gtk-frame-new "Horizontal Button Boxes"))
|
|
|
879 (frame-vert (gtk-frame-new "Vertical Button Boxes"))
|
|
|
880 (create-bbox (lambda (horizontal title spacing child-w child-h layout)
|
|
|
881 (let ((frame (gtk-frame-new title))
|
|
|
882 (bbox (if horizontal
|
|
|
883 (gtk-hbutton-box-new)
|
|
|
884 (gtk-vbutton-box-new))))
|
|
|
885 (gtk-container-set-border-width bbox 5)
|
|
|
886 (gtk-container-add frame bbox)
|
|
|
887 (gtk-button-box-set-layout bbox layout)
|
|
|
888 (gtk-button-box-set-spacing bbox spacing)
|
|
|
889 (gtk-button-box-set-child-size bbox child-w child-h)
|
|
|
890 (gtk-container-add bbox (gtk-button-new-with-label "OK"))
|
|
|
891 (gtk-container-add bbox (gtk-button-new-with-label "Cancel"))
|
|
|
892 (gtk-container-add bbox (gtk-button-new-with-label "Help"))
|
|
|
893 frame))))
|
|
|
894
|
|
|
895 (gtk-container-set-border-width window 10)
|
|
|
896 (gtk-container-add window main-vbox)
|
|
|
897
|
|
|
898 (gtk-box-pack-start main-vbox frame-horz t t 10)
|
|
|
899 (gtk-container-set-border-width vbox 10)
|
|
|
900 (gtk-container-add frame-horz vbox)
|
|
|
901
|
|
|
902 (gtk-box-pack-start main-vbox frame-vert t t 10)
|
|
|
903 (gtk-container-set-border-width hbox 10)
|
|
|
904 (gtk-container-add frame-vert hbox)
|
|
|
905
|
|
|
906 (gtk-box-pack-start vbox (funcall create-bbox t "Spread" 40 85 20 'spread) t t 0)
|
|
|
907 (gtk-box-pack-start vbox (funcall create-bbox t "Edge" 40 85 20 'edge) t t 0)
|
|
|
908 (gtk-box-pack-start vbox (funcall create-bbox t "Start" 40 85 20 'start) t t 0)
|
|
|
909 (gtk-box-pack-start vbox (funcall create-bbox t "End" 40 85 20 'end) t t 0)
|
|
|
910
|
|
|
911 (gtk-box-pack-start hbox (funcall create-bbox nil "Spread" 40 85 20 'spread) t t 0)
|
|
|
912 (gtk-box-pack-start hbox (funcall create-bbox nil "Edge" 40 85 20 'edge) t t 0)
|
|
|
913 (gtk-box-pack-start hbox (funcall create-bbox nil "Start" 40 85 20 'start) t t 0)
|
|
|
914 (gtk-box-pack-start hbox (funcall create-bbox nil "End" 40 85 20 'end) t t 0)))
|
|
|
915
|
|
|
916
|
|
|
917 ;;;; Cursors
|
|
|
918 '(gtk-define-test
|
|
|
919 "Cursors" cursors nil
|
|
|
920 (let ((cursors '(x-cursor arrow based-arrow-down based-arrow-up boat bogosity
|
|
|
921 bottom-left-corner bottom-right-corner bottom-side bottom-tee
|
|
|
922 box-spiral center-ptr circle clock coffee-mug cross cross-reverse
|
|
|
923 crosshair diamond-cross dot dotbox double-arrow draft-large
|
|
|
924 draft-small draped-box exchange fleur gobbler gumby hand1 hand2 heart
|
|
|
925 icon iron-cross left-ptr left-side left-tee leftbutton ll-angle
|
|
|
926 lr-angle man middlebutton mouse pencil pirate plus question-arrow
|
|
|
927 right-ptr right-side right-tee rightbutton rtl-logo sailboat
|
|
|
928 sb-down-arrow sb-h-double-arrow sb-left-arrow sb-right-arrow
|
|
|
929 sb-up-arrow sb-v-double-arrow shuttle sizing spider spraycan star
|
|
|
930 target tcross top-left-arrow top-left-corner top-right-corner top-side
|
|
|
931 top-tee trek ul-angle umbrella ur-angle watch xterm last-cursor))
|
|
|
932 (cursor-area nil)
|
|
|
933 (adjustment nil)
|
|
|
934 (spinner nil))
|
|
|
935 (setq cursor-area (gtk-event-box-new)
|
|
|
936 adjustment (gtk-adjustment-new 0 0 (length cursors) 1 1 1)
|
|
|
937 spinner (gtk-spin-button-new adjustment 1 3))
|
|
|
938 (gtk-widget-set-usize cursor-area 200 100)
|
|
|
939 (gtk-box-pack-start window cursor-area t t 0)
|
|
|
940 (gtk-box-pack-start window spinner nil nil 0)))
|
|
|
941
|
|
|
942
|
|
|
943 ;;;; Toolbar
|
|
|
944 (defun gtk-test-toolbar-create ()
|
|
|
945 (let ((toolbar (gtk-toolbar-new 'horizontal 'both)))
|
|
|
946 (gtk-toolbar-set-button-relief toolbar 'none)
|
|
|
947
|
|
|
948 (gtk-toolbar-append-item toolbar
|
|
|
949 "Horizonal" "Horizontal toolbar layout" "Toolbar/Horizontal"
|
|
|
950 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
951 (lambda (tbar)
|
|
|
952 (gtk-toolbar-set-orientation tbar 'horizontal)) toolbar)
|
|
|
953 (gtk-toolbar-append-item toolbar
|
|
|
954 "Vertical" "Vertical toolbar layout" "Toolbar/Vertical"
|
|
|
955 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
956 (lambda (tbar)
|
|
|
957 (gtk-toolbar-set-orientation tbar 'vertical)) toolbar)
|
|
|
958
|
|
|
959 (gtk-toolbar-append-space toolbar)
|
|
|
960 (gtk-toolbar-append-item toolbar
|
|
|
961 "Icons" "Only show toolbar icons" "Toolbar/IconsOnly"
|
|
|
962 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
963 (lambda (tbar)
|
|
|
964 (gtk-toolbar-set-style tbar 'icons)) toolbar)
|
|
|
965 (gtk-toolbar-append-item toolbar
|
|
|
966 "Text" "Only show toolbar text" "Toolbar/TextOnly"
|
|
|
967 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
968 (lambda (tbar)
|
|
|
969 (gtk-toolbar-set-style tbar 'text)) toolbar)
|
|
|
970 (gtk-toolbar-append-item toolbar
|
|
|
971 "Both" "Show toolbar icons and text" "Toolbar/Both"
|
|
|
972 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
973 (lambda (tbar)
|
|
|
974 (gtk-toolbar-set-style tbar 'both)) toolbar)
|
|
|
975
|
|
|
976 (gtk-toolbar-append-space toolbar)
|
|
|
977 (gtk-toolbar-append-item toolbar
|
|
|
978 "Small" "Use small spaces" ""
|
|
|
979 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
980 (lambda (tbar)
|
|
|
981 (gtk-toolbar-set-space-size tbar 5)) toolbar)
|
|
|
982 (gtk-toolbar-append-item toolbar
|
|
|
983 "Big" "Use big spaces" ""
|
|
|
984 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
985 (lambda (tbar)
|
|
|
986 (gtk-toolbar-set-space-size tbar 10)) toolbar)
|
|
|
987
|
|
|
988 (gtk-toolbar-append-space toolbar)
|
|
|
989 (gtk-toolbar-append-item toolbar
|
|
|
990 "Enable" "Enable tooltips" ""
|
|
|
991 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
992 (lambda (tbar)
|
|
|
993 (gtk-toolbar-set-tooltips tbar t)) toolbar)
|
|
|
994 (gtk-toolbar-append-item toolbar
|
|
|
995 "Disable" "Disable tooltips" ""
|
|
|
996 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
997 (lambda (tbar)
|
|
|
998 (gtk-toolbar-set-tooltips tbar nil)) toolbar)
|
|
|
999
|
|
|
1000 (gtk-toolbar-append-space toolbar)
|
|
|
1001 (gtk-toolbar-append-item toolbar
|
|
|
1002 "Borders" "Show borders" ""
|
|
|
1003 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
1004 (lambda (tbar)
|
|
|
1005 (gtk-toolbar-set-button-relief tbar 'normal)) toolbar)
|
|
|
1006 (gtk-toolbar-append-item toolbar
|
|
|
1007 "Borderless" "Hide borders" ""
|
|
|
1008 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
1009 (lambda (tbar)
|
|
|
1010 (gtk-toolbar-set-button-relief tbar 'none)) toolbar)
|
|
|
1011
|
|
|
1012 (gtk-toolbar-append-space toolbar)
|
|
|
1013 (gtk-toolbar-append-item toolbar
|
|
|
1014 "Empty" "Empty spaces" ""
|
|
|
1015 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
1016 (lambda (tbar)
|
|
|
1017 (gtk-toolbar-set-space-style tbar 'empty)) toolbar)
|
|
|
1018 (gtk-toolbar-append-item toolbar
|
|
|
1019 "Lines" "Lines in spaces" ""
|
|
|
1020 (gtk-pixmap-new gtk-test-open-glyph nil)
|
|
|
1021 (lambda (tbar)
|
|
|
1022 (gtk-toolbar-set-space-style tbar 'line)) toolbar)
|
|
|
1023 (gtk-widget-show-all toolbar)
|
|
|
1024 toolbar))
|
|
|
1025
|
|
|
1026 (gtk-define-test
|
|
|
1027 "Toolbar" container toolbar nil
|
|
|
1028 (gtk-box-pack-start window (gtk-test-toolbar-create) t t 0))
|
|
|
1029
|
|
|
1030
|
|
|
1031 ;;;; Text
|
|
|
1032 (gtk-define-test
|
|
|
1033 "Text" composite text nil
|
|
|
1034 (let ((text (gtk-text-new nil nil))
|
|
|
1035 (scrolled (gtk-scrolled-window-new nil nil))
|
|
|
1036 (bbox (gtk-hbutton-box-new))
|
|
|
1037 (button nil))
|
|
|
1038 (gtk-box-pack-start window scrolled t t 0)
|
|
|
1039 (gtk-box-pack-start window bbox nil nil 0)
|
|
|
1040 (gtk-widget-set-usize text 500 500)
|
|
|
1041 (gtk-container-add scrolled text)
|
|
|
1042
|
|
|
1043 (setq button (gtk-check-button-new-with-label "Editable"))
|
|
|
1044 (gtk-signal-connect button 'toggled
|
|
|
1045 (lambda (button text)
|
|
|
1046 (gtk-text-set-editable text (gtk-toggle-button-get-active button))) text)
|
|
|
1047 (gtk-container-add bbox button)
|
|
|
1048
|
|
|
1049 (setq button (gtk-check-button-new-with-label "Wrap words"))
|
|
|
1050 (gtk-signal-connect button 'toggled
|
|
|
1051 (lambda (button text)
|
|
|
1052 (gtk-text-set-word-wrap text (gtk-toggle-button-get-active button))) text)
|
|
|
1053 (gtk-container-add bbox button)
|
|
|
1054
|
|
|
1055 ;; put some default text in there.
|
|
|
1056 (gtk-widget-set-style text 'default)
|
|
|
1057 (let ((faces '(blue bold bold-italic gtk-test-face-large red text-cursor))
|
|
|
1058 (string nil))
|
|
|
1059 (mapc (lambda (face)
|
|
|
1060 (setq string (format "Sample text in the `%s' face\n" face))
|
|
|
1061 (gtk-text-insert text
|
|
|
1062 (face-font face)
|
|
|
1063 (face-foreground face)
|
|
|
1064 (face-background face)
|
|
|
1065 string (length string))) faces))
|
|
|
1066
|
|
|
1067
|
|
|
1068 ;; Tell the user their rights...
|
|
|
1069 (let ((file (locate-data-file "COPYING")))
|
|
|
1070 (gtk-text-freeze text)
|
|
|
1071 (save-excursion
|
|
|
1072 (set-buffer (get-buffer-create " *foo*"))
|
|
|
1073 (insert-file-contents file)
|
|
|
1074 (gtk-text-insert text nil nil nil (buffer-string) (point-max))
|
|
|
1075 (kill-buffer (current-buffer))))
|
|
|
1076 (gtk-text-thaw text)))
|
|
|
1077
|
|
|
1078
|
|
|
1079 ;;;; handle box
|
|
|
1080 (gtk-define-test
|
|
|
1081 "Handle box" container handles nil
|
|
|
1082 (let ((handle nil)
|
|
|
1083 (hbox (gtk-hbox-new nil 0)))
|
|
|
1084
|
|
|
1085 (gtk-box-pack-start window (gtk-label-new "Above") nil nil 0)
|
|
|
1086 (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
|
|
|
1087 (gtk-box-pack-start window hbox t t 0)
|
|
|
1088 (gtk-box-pack-start window (gtk-hseparator-new) nil nil 0)
|
|
|
1089 (gtk-box-pack-start window (gtk-label-new "Below") nil nil 0)
|
|
|
1090
|
|
|
1091 (setq handle (gtk-handle-box-new))
|
|
|
1092 (gtk-container-add handle (gtk-test-toolbar-create))
|
|
|
1093 (gtk-widget-show-all handle)
|
|
|
1094 (gtk-box-pack-start hbox handle nil nil 0)
|
|
|
1095 (gtk-signal-connect handle 'child_attached
|
|
|
1096 (lambda (box child data)
|
|
|
1097 (message "Child widget (%s) attached" child)))
|
|
|
1098 (gtk-signal-connect handle 'child_detached
|
|
|
1099 (lambda (box child data)
|
|
|
1100 (message "Child widget (%s) detached" child)))
|
|
|
1101
|
|
|
1102 (setq handle (gtk-handle-box-new))
|
|
|
1103 (gtk-container-add handle (gtk-label-new "Fooo!!!"))
|
|
|
1104 (gtk-box-pack-start hbox handle nil nil 0)
|
|
|
1105 (gtk-signal-connect handle 'child_attached
|
|
|
1106 (lambda (box child data)
|
|
|
1107 (message "Child widget (%s) attached" child)))
|
|
|
1108 (gtk-signal-connect handle 'child_detached
|
|
|
1109 (lambda (box child data)
|
|
|
1110 (message "Child widget (%s) detached" child)))))
|
|
|
1111
|
|
|
1112
|
|
|
1113 ;;;; Menus
|
|
|
1114 (gtk-define-test
|
|
|
1115 "Menus" basic menus nil
|
|
|
1116 (let ((menubar (gtk-menu-bar-new))
|
|
|
1117 (item nil)
|
|
|
1118 (right-justify nil))
|
|
|
1119 (gtk-box-pack-start window menubar nil nil 0)
|
|
|
1120 (mapc (lambda (menudesc)
|
|
|
1121 (if (not menudesc)
|
|
|
1122 (setq right-justify t)
|
|
|
1123 (setq item (gtk-build-xemacs-menu menudesc))
|
|
|
1124 (gtk-widget-show item)
|
|
|
1125 (if right-justify
|
|
|
1126 (gtk-menu-item-right-justify item))
|
|
|
1127 (gtk-menu-bar-append menubar item)))
|
|
|
1128 default-menubar)))
|
|
|
1129
|
|
|
1130
|
|
|
1131 ;;;; Spinbutton
|
|
|
1132 (gtk-define-test
|
|
|
1133 "Spinbutton" composite spinbutton nil
|
|
|
1134 (let (frame vbox vbox2 hbox label spin adj spin2 button)
|
|
|
1135
|
|
|
1136 (gtk-container-set-border-width window 5)
|
|
|
1137
|
|
|
1138 (setq frame (gtk-frame-new "Not accelerated")
|
|
|
1139 hbox (gtk-hbox-new nil 0))
|
|
|
1140
|
|
|
1141 (gtk-box-pack-start window frame t t 0)
|
|
|
1142 (gtk-container-add frame hbox)
|
|
|
1143
|
|
|
1144 (setq vbox (gtk-vbox-new nil 0)
|
|
|
1145 label (gtk-label-new "Day:")
|
|
|
1146 adj (gtk-adjustment-new 1.0 1.0 31.0 1.0 5.0 0.0)
|
|
|
1147 spin (gtk-spin-button-new adj 0 0))
|
|
|
1148
|
|
|
1149 (gtk-misc-set-alignment label 0 0.5)
|
|
|
1150 (gtk-spin-button-set-wrap spin t)
|
|
|
1151 (gtk-spin-button-set-shadow-type spin 'out)
|
|
|
1152 (gtk-box-pack-start hbox vbox t t 5)
|
|
|
1153 (gtk-box-pack-start vbox label nil t 0)
|
|
|
1154 (gtk-box-pack-start vbox spin nil t 0)
|
|
|
1155
|
|
|
1156 (setq vbox (gtk-vbox-new nil 0)
|
|
|
1157 label (gtk-label-new "Month:")
|
|
|
1158 adj (gtk-adjustment-new 1.0 1.0 12.0 1.0 5.0 0.0)
|
|
|
1159 spin (gtk-spin-button-new adj 0 0))
|
|
|
1160 (gtk-misc-set-alignment label 0 0.5)
|
|
|
1161 (gtk-spin-button-set-wrap spin t)
|
|
|
1162 (gtk-spin-button-set-shadow-type spin 'out)
|
|
|
1163 (gtk-box-pack-start hbox vbox t t 5)
|
|
|
1164 (gtk-box-pack-start vbox label nil t 0)
|
|
|
1165 (gtk-box-pack-start vbox spin nil t 0)
|
|
|
1166
|
|
|
1167 (setq vbox (gtk-vbox-new nil 0)
|
|
|
1168 label (gtk-label-new "Year:")
|
|
|
1169 adj (gtk-adjustment-new 1998.0 0.0 2100.0 1.0 100.0 0.0)
|
|
|
1170 spin (gtk-spin-button-new adj 0 0))
|
|
|
1171 (gtk-misc-set-alignment label 0 0.5)
|
|
|
1172 (gtk-spin-button-set-wrap spin t)
|
|
|
1173 (gtk-spin-button-set-shadow-type spin 'out)
|
|
|
1174 (gtk-widget-set-usize spin 55 0)
|
|
|
1175 (gtk-box-pack-start hbox vbox t t 5)
|
|
|
1176 (gtk-box-pack-start vbox label nil t 0)
|
|
|
1177 (gtk-box-pack-start vbox spin nil t 0)
|
|
|
1178
|
|
|
1179 (setq frame (gtk-frame-new "Accelerated")
|
|
|
1180 vbox (gtk-vbox-new nil 0))
|
|
|
1181
|
|
|
1182 (gtk-box-pack-start window frame t t 0)
|
|
|
1183 (gtk-container-add frame vbox)
|
|
|
1184
|
|
|
1185 (setq hbox (gtk-hbox-new nil 0))
|
|
|
1186 (gtk-box-pack-start vbox hbox nil t 5)
|
|
|
1187
|
|
|
1188 (setq vbox2 (gtk-vbox-new nil 0)
|
|
|
1189 label (gtk-label-new "Value:")
|
|
|
1190 adj (gtk-adjustment-new 0.0 -10000.0 10000.0 0.5 100.0 0.0)
|
|
|
1191 spin (gtk-spin-button-new adj 1.0 2))
|
|
|
1192 (gtk-misc-set-alignment label 0 0.5)
|
|
|
1193 (gtk-spin-button-set-wrap spin t)
|
|
|
1194 (gtk-widget-set-usize spin 100 0)
|
|
|
1195 (gtk-box-pack-start vbox2 label nil t 0)
|
|
|
1196 (gtk-box-pack-start vbox2 spin nil t 0)
|
|
|
1197 (gtk-box-pack-start hbox vbox2 t t 0)
|
|
|
1198
|
|
|
1199 (setq vbox2 (gtk-vbox-new nil 0)
|
|
|
1200 label (gtk-label-new "Digits:")
|
|
|
1201 adj (gtk-adjustment-new 2 1 5 1 1 0)
|
|
|
1202 spin2 (gtk-spin-button-new adj 0 0))
|
|
|
1203 (gtk-misc-set-alignment label 0 0.5)
|
|
|
1204 (gtk-spin-button-set-wrap spin2 t)
|
|
|
1205 (gtk-widget-set-usize spin2 100 0)
|
|
|
1206 (gtk-box-pack-start vbox2 label nil t 0)
|
|
|
1207 (gtk-box-pack-start vbox2 spin2 nil t 0)
|
|
|
1208 (gtk-box-pack-start hbox vbox2 t t 0)
|
|
|
1209 (gtk-signal-connect adj 'value_changed
|
|
|
1210 (lambda (adj spinners)
|
|
|
1211 (gtk-spin-button-set-digits
|
|
|
1212 (car spinners)
|
|
|
1213 (gtk-spin-button-get-value-as-int (cdr spinners))))
|
|
|
1214 (cons spin spin2))
|
|
|
1215
|
|
|
1216 (setq button (gtk-check-button-new-with-label "Snap to 0.5-ticks"))
|
|
|
1217 (gtk-signal-connect button 'clicked
|
|
|
1218 (lambda (button spin)
|
|
|
1219 (gtk-spin-button-set-snap-to-ticks
|
|
|
1220 spin
|
|
|
1221 (gtk-toggle-button-get-active button)))
|
|
|
1222 spin)
|
|
|
1223 (gtk-box-pack-start vbox button t t 0)
|
|
|
1224 (gtk-toggle-button-set-active button t)
|
|
|
1225
|
|
|
1226 (setq button (gtk-check-button-new-with-label "Numeric only input mode"))
|
|
|
1227 (gtk-signal-connect button 'clicked
|
|
|
1228 (lambda (button spin)
|
|
|
1229 (gtk-spin-button-set-numeric
|
|
|
1230 spin
|
|
|
1231 (gtk-toggle-button-get-active button)))
|
|
|
1232 spin)
|
|
|
1233 (gtk-box-pack-start vbox button t t 0)
|
|
|
1234 (gtk-toggle-button-set-active button t)
|
|
|
1235
|
|
|
1236 (setq label (gtk-label-new ""))
|
|
|
1237
|
|
|
1238 (setq hbox (gtk-hbutton-box-new))
|
|
|
1239 (gtk-box-pack-start vbox hbox nil t 5)
|
|
|
1240 (gtk-box-pack-start vbox label nil nil 5)
|
|
|
1241
|
|
|
1242 (setq button (gtk-button-new-with-label "Value as int"))
|
|
|
1243 (gtk-container-add hbox button)
|
|
|
1244 (gtk-signal-connect button 'clicked
|
|
|
1245 (lambda (obj data)
|
|
|
1246 (let ((spin (car data))
|
|
|
1247 (label (cdr data)))
|
|
|
1248 (gtk-label-set-text label
|
|
|
1249 (format "%d"
|
|
|
1250 (gtk-spin-button-get-value-as-int spin)))))
|
|
|
1251 (cons spin label))
|
|
|
1252
|
|
|
1253 (setq button (gtk-button-new-with-label "Value as float"))
|
|
|
1254 (gtk-container-add hbox button)
|
|
|
1255 (gtk-signal-connect button 'clicked
|
|
|
1256 (lambda (obj data)
|
|
|
1257 (let ((spin (car data))
|
|
|
1258 (label (cdr data)))
|
|
|
1259 (gtk-label-set-text label
|
|
|
1260 (format "%g"
|
|
|
1261 (gtk-spin-button-get-value-as-float spin)))))
|
|
|
1262 (cons spin label))))
|
|
|
1263
|
|
|
1264
|
|
|
1265 ;;;; Reparenting
|
|
|
1266 (gtk-define-test
|
|
|
1267 "Reparenting" misc reparenting nil
|
|
|
1268 (let ((label (gtk-label-new "Hello World"))
|
|
|
1269 (frame-1 (gtk-frame-new "Frame 1"))
|
|
|
1270 (frame-2 (gtk-frame-new "Frame 2"))
|
|
|
1271 (button nil)
|
|
|
1272 (hbox (gtk-hbox-new nil 5))
|
|
|
1273 (vbox-1 nil)
|
|
|
1274 (vbox-2 nil)
|
|
|
1275 (reparent-func (lambda (button data)
|
|
|
1276 (let ((label (car data))
|
|
|
1277 (new-parent (cdr data)))
|
|
|
1278 (gtk-widget-reparent label new-parent)))))
|
|
|
1279
|
|
|
1280 (gtk-box-pack-start window hbox t t 0)
|
|
|
1281 (gtk-box-pack-start hbox frame-1 t t 0)
|
|
|
1282 (gtk-box-pack-start hbox frame-2 t t 0)
|
|
|
1283
|
|
|
1284 (setq vbox-1 (gtk-vbox-new nil 0))
|
|
|
1285 (gtk-container-add frame-1 vbox-1)
|
|
|
1286 (setq vbox-2 (gtk-vbox-new nil 0))
|
|
|
1287 (gtk-container-add frame-2 vbox-2)
|
|
|
1288
|
|
|
1289 (setq button (gtk-button-new-with-label "switch"))
|
|
|
1290 (gtk-box-pack-start vbox-1 button nil nil 0)
|
|
|
1291 (gtk-signal-connect button 'clicked reparent-func (cons label vbox-2))
|
|
|
1292
|
|
|
1293 (setq button (gtk-button-new-with-label "switch"))
|
|
|
1294 (gtk-box-pack-start vbox-2 button nil nil 0)
|
|
|
1295 (gtk-signal-connect button 'clicked reparent-func (cons label vbox-1))
|
|
|
1296
|
|
|
1297 (gtk-box-pack-start vbox-2 label nil t 0)))
|
|
|
1298
|
|
|
1299
|
|
|
1300 ;;;; StatusBar
|
|
|
1301 (defvar statusbar-counter 1)
|
|
|
1302
|
|
|
1303 (gtk-define-test
|
|
|
1304 "Statusbar" composite statusbar nil
|
|
|
1305 (let ((bar (gtk-statusbar-new))
|
|
|
1306 (vbox nil)
|
|
|
1307 (button nil))
|
|
|
1308
|
|
|
1309 (setq vbox (gtk-vbox-new nil 0))
|
|
|
1310 (gtk-box-pack-start window vbox t t 0)
|
|
|
1311 (gtk-box-pack-end window bar t t 0)
|
|
|
1312
|
|
|
1313 (setq button (gtk-button-new-with-label "push something"))
|
|
|
1314 (gtk-box-pack-start-defaults vbox button)
|
|
|
1315 (gtk-signal-connect button 'clicked
|
|
|
1316 (lambda (button bar)
|
|
|
1317 (gtk-statusbar-push bar 1 (format "something %d" (incf statusbar-counter))))
|
|
|
1318 bar)
|
|
|
1319
|
|
|
1320 (setq button (gtk-button-new-with-label "pop"))
|
|
|
1321 (gtk-box-pack-start-defaults vbox button)
|
|
|
1322 (gtk-signal-connect button 'clicked
|
|
|
1323 (lambda (button bar)
|
|
|
1324 (gtk-statusbar-pop bar 1)) bar)
|
|
|
1325
|
|
|
1326 (setq button (gtk-button-new-with-label "steal #4"))
|
|
|
1327 (gtk-box-pack-start-defaults vbox button)
|
|
|
1328 (gtk-signal-connect button 'clicked
|
|
|
1329 (lambda (button bar)
|
|
|
1330 (gtk-statusbar-remove bar 1 4)) bar)
|
|
|
1331
|
|
|
1332 (setq button (gtk-button-new-with-label "dump stack"))
|
|
|
1333 (gtk-box-pack-start-defaults vbox button)
|
|
|
1334 (gtk-widget-set-sensitive button nil)
|
|
|
1335
|
|
|
1336 (setq button (gtk-button-new-with-label "test contexts"))
|
|
|
1337 (gtk-box-pack-start-defaults vbox button)
|
|
|
1338 (gtk-signal-connect button 'clicked
|
|
|
1339 (lambda (button bar)
|
|
|
1340 (let ((contexts '("any context" "idle messages" "some text"
|
|
|
1341 "hit the mouse" "hit the mouse2")))
|
|
|
1342 (message-box "%s"
|
|
|
1343 (mapconcat
|
|
|
1344 (lambda (ctx)
|
|
|
1345 (format "context=\"%s\", context_id=%d"
|
|
|
1346 ctx (gtk-statusbar-get-context-id bar ctx)))
|
|
|
1347 contexts "\n")))) bar)))
|
|
|
1348
|
|
|
1349
|
|
|
1350 ;;;; Columned List
|
|
|
1351 (gtk-define-test
|
|
|
1352 "Columnar List" composite clist nil
|
|
|
1353 (let ((titles '("auto resize" "not resizeable" "max width 100" "min width 50"
|
|
|
1354 "hide column" "Title 5" "Title 6" "Title 7" "Title 8" "Title 9"
|
|
|
1355 "Title 10" "Title 11"))
|
|
|
1356 hbox clist button separator scrolled-win check undo-button label)
|
|
|
1357
|
|
|
1358 (gtk-container-set-border-width window 0)
|
|
|
1359
|
|
|
1360 (setq scrolled-win (gtk-scrolled-window-new nil nil))
|
|
|
1361 (gtk-container-set-border-width scrolled-win 5)
|
|
|
1362 (gtk-scrolled-window-set-policy scrolled-win 'automatic 'automatic)
|
|
|
1363
|
|
|
1364 ;; create GtkCList here so we have a pointer to throw at the
|
|
|
1365 ;; button callbacks -- more is done with it later
|
|
|
1366 (setq clist (gtk-clist-new-with-titles (length titles) titles))
|
|
|
1367 (gtk-container-add scrolled-win clist)
|
|
|
1368
|
|
|
1369 ;; Make the columns live up to their titles.
|
|
|
1370 (gtk-clist-set-column-auto-resize clist 0 t)
|
|
|
1371 (gtk-clist-set-column-resizeable clist 1 nil)
|
|
|
1372 (gtk-clist-set-column-max-width clist 2 100)
|
|
|
1373 (gtk-clist-set-column-min-width clist 3 50)
|
|
|
1374
|
|
|
1375 (gtk-signal-connect clist 'click-column
|
|
|
1376 (lambda (clist column data)
|
|
|
1377 (cond
|
|
|
1378 ((= column 4)
|
|
|
1379 (gtk-clist-set-column-visibility clist column nil))
|
|
|
1380 ((= column (gtk-clist-sort-column clist))
|
|
|
1381 (gtk-clist-set-sort-type
|
|
|
1382 clist (if (eq (gtk-clist-sort-type clist) 'ascending)
|
|
|
1383 'descending
|
|
|
1384 'ascending)))
|
|
|
1385 (t
|
|
|
1386 (gtk-clist-set-sort-column clist column)))
|
|
|
1387 (gtk-clist-sort clist)))
|
|
|
1388
|
|
|
1389 ;; control buttons
|
|
|
1390 (setq hbox (gtk-hbox-new nil 5))
|
|
|
1391 (gtk-container-set-border-width hbox 5)
|
|
|
1392 (gtk-box-pack-start window hbox nil nil 0)
|
|
|
1393
|
|
|
1394 (setq button (gtk-button-new-with-label "Insert Row"))
|
|
|
1395 (gtk-box-pack-start hbox button t t 0)
|
|
|
1396 (gtk-signal-connect button 'clicked
|
|
|
1397 (lambda (button clist)
|
|
|
1398 (gtk-clist-append clist
|
|
|
1399 (list (format "CListRow %05d" (random 10000))
|
|
|
1400 "Column 1"
|
|
|
1401 "Column 2"
|
|
|
1402 "Column 3"
|
|
|
1403 "Column 4"
|
|
|
1404 "Column 5"
|
|
|
1405 "Column 6"
|
|
|
1406 "Column 7"
|
|
|
1407 "Column 8"
|
|
|
1408 "Column 0"
|
|
|
1409 "Column 10"
|
|
|
1410 "Column 11"))) clist)
|
|
|
1411
|
|
|
1412 (setq button (gtk-button-new-with-label "Add 1,000 Rows with Pixmaps"))
|
|
|
1413 (gtk-box-pack-start hbox button t t 0)
|
|
|
1414 (gtk-signal-connect button 'clicked
|
|
|
1415 (lambda (button clist)
|
|
|
1416 (let ((row 0) i)
|
|
|
1417 (gtk-clist-freeze clist)
|
|
|
1418 (loop for i from 0 to 1000 do
|
|
|
1419 (setq row
|
|
|
1420 (gtk-clist-append clist
|
|
|
1421 (list
|
|
|
1422 (format "CListRow %05d" (random 10000))
|
|
|
1423 "Column 1"
|
|
|
1424 "Column 2"
|
|
|
1425 "Column 3"
|
|
|
1426 "Column 4"
|
|
|
1427 "Column 5"
|
|
|
1428 "Column 6"
|
|
|
1429 "Column 7"
|
|
|
1430 "Column 8"
|
|
|
1431 "Column 0"
|
|
|
1432 "Column 10"
|
|
|
1433 "Column 11")))
|
|
|
1434 (gtk-clist-set-pixtext clist row 3 "gtk+" 5
|
|
|
1435 gtk-test-mini-gtk-glyph
|
|
|
1436 nil))
|
|
|
1437 (gtk-clist-thaw clist))) clist)
|
|
|
1438
|
|
|
1439 (setq button (gtk-button-new-with-label "Add 10,000 Rows"))
|
|
|
1440 (gtk-box-pack-start hbox button t t 0)
|
|
|
1441 (gtk-signal-connect button 'clicked
|
|
|
1442 (lambda (button clist)
|
|
|
1443 (gtk-clist-freeze clist)
|
|
|
1444 (loop for i from 0 to 10000 do
|
|
|
1445 (gtk-clist-append clist
|
|
|
1446 (list
|
|
|
1447 (format "CListRow %05d" (random 10000))
|
|
|
1448 "Column 1"
|
|
|
1449 "Column 2"
|
|
|
1450 "Column 3"
|
|
|
1451 "Column 4"
|
|
|
1452 "Column 5"
|
|
|
1453 "Column 6"
|
|
|
1454 "Column 7"
|
|
|
1455 "Column 8"
|
|
|
1456 "Column 0"
|
|
|
1457 "Column 10"
|
|
|
1458 "Column 11")))
|
|
|
1459 (gtk-clist-thaw clist)) clist)
|
|
|
1460
|
|
|
1461 ;; Second layer of buttons
|
|
|
1462 (setq hbox (gtk-hbox-new nil 5))
|
|
|
1463 (gtk-container-set-border-width hbox 5)
|
|
|
1464 (gtk-box-pack-start window hbox nil nil 0)
|
|
|
1465
|
|
|
1466 (setq button (gtk-button-new-with-label "Clear List"))
|
|
|
1467 (gtk-box-pack-start hbox button t t 0)
|
|
|
1468 (gtk-signal-connect button 'clicked (lambda (button clist)
|
|
|
1469 (gtk-clist-clear clist)) clist)
|
|
|
1470
|
|
|
1471 (setq button (gtk-button-new-with-label "Remove Selection"))
|
|
|
1472 (gtk-box-pack-start hbox button t t 0)
|
|
|
1473 (gtk-signal-connect button 'clicked (lambda (button clist)
|
|
|
1474 (error "Do not know how to do this yet.")))
|
|
|
1475 (gtk-widget-set-sensitive button nil)
|
|
|
1476
|
|
|
1477 (setq button (gtk-button-new-with-label "Undo Selection"))
|
|
|
1478 (gtk-box-pack-start hbox button t t 0)
|
|
|
1479 (gtk-signal-connect button 'clicked
|
|
|
1480 (lambda (button clist) (gtk-clist-undo-selection clist)))
|
|
|
1481
|
|
|
1482 (setq button (gtk-button-new-with-label "Warning Test"))
|
|
|
1483 (gtk-box-pack-start hbox button t t 0)
|
|
|
1484 (gtk-signal-connect button 'clicked 'ignore)
|
|
|
1485 (gtk-widget-set-sensitive button nil)
|
|
|
1486
|
|
|
1487 ;; Third layer of buttons
|
|
|
1488 (setq hbox (gtk-hbox-new nil 5))
|
|
|
1489 (gtk-container-set-border-width hbox 5)
|
|
|
1490 (gtk-box-pack-start window hbox nil nil 0)
|
|
|
1491
|
|
|
1492 (setq button (gtk-check-button-new-with-label "Show Title Buttons"))
|
|
|
1493 (gtk-box-pack-start hbox button nil t 0)
|
|
|
1494 (gtk-signal-connect button 'clicked (lambda (button clist)
|
|
|
1495 (if (gtk-toggle-button-get-active button)
|
|
|
1496 (gtk-clist-column-titles-show clist)
|
|
|
1497 (gtk-clist-column-titles-hide clist))) clist)
|
|
|
1498 (gtk-toggle-button-set-active button t)
|
|
|
1499
|
|
|
1500 (setq button (gtk-check-button-new-with-label "Reorderable"))
|
|
|
1501 (gtk-box-pack-start hbox check nil t 0)
|
|
|
1502 (gtk-signal-connect button 'clicked (lambda (button clist)
|
|
|
1503 (gtk-clist-set-reorderable
|
|
|
1504 clist
|
|
|
1505 (gtk-toggle-button-get-active button))) clist)
|
|
|
1506 (gtk-toggle-button-set-active button t)
|
|
|
1507
|
|
|
1508 (setq label (gtk-label-new "Selection Mode :"))
|
|
|
1509 (gtk-box-pack-start hbox label nil t 0)
|
|
|
1510
|
|
|
1511 (gtk-box-pack-start hbox (build-option-menu
|
|
|
1512 '(("Single" .
|
|
|
1513 (lambda (item clist)
|
|
|
1514 (gtk-clist-set-selection-mode clist 'single)))
|
|
|
1515 ("Browse" .
|
|
|
1516 (lambda (item clist)
|
|
|
1517 (gtk-clist-set-selection-mode clist 'browse)))
|
|
|
1518 ("Multiple" .
|
|
|
1519 (lambda (item clist)
|
|
|
1520 (gtk-clist-set-selection-mode clist 'multiple)))
|
|
|
1521 ("Extended" .
|
|
|
1522 (lambda (item clist)
|
|
|
1523 (gtk-clist-set-selection-mode clist 'extended))))
|
|
|
1524 3 clist) nil t 0)
|
|
|
1525
|
|
|
1526 ;; The rest of the clist configuration
|
|
|
1527 (gtk-box-pack-start window scrolled-win t t 0)
|
|
|
1528 (gtk-clist-set-row-height clist 18)
|
|
|
1529 (gtk-widget-set-usize clist -1 300)
|
|
|
1530
|
|
|
1531 (loop for i from 0 to 11 do
|
|
|
1532 (gtk-clist-set-column-width clist i 80))))
|
|
|
1533
|
|
|
1534
|
|
|
1535 ;;;; Notebook
|
|
|
1536 (defun set-tab-label (notebook page selected-p)
|
|
|
1537 (if page
|
|
|
1538 (let (label label-box pixwid)
|
|
|
1539 (setq label-box (gtk-hbox-new nil 0))
|
|
|
1540 (setq pixwid (gtk-pixmap-new
|
|
|
1541 (if selected-p gtk-test-open-glyph gtk-test-closed-glyph) nil))
|
|
|
1542 (gtk-box-pack-start label-box pixwid nil t 0)
|
|
|
1543 (gtk-misc-set-padding pixwid 3 1) ;
|
|
|
1544 (setq label (gtk-label-new
|
|
|
1545 (format "Page %d" (1+ (gtk-notebook-page-num notebook page)))))
|
|
|
1546 (gtk-box-pack-start label-box label nil t 0)
|
|
|
1547 (gtk-widget-show-all label-box)
|
|
|
1548 (gtk-notebook-set-tab-label notebook page label-box))))
|
|
|
1549
|
|
|
1550 (defun page-switch (widget page page-num data)
|
|
|
1551 (let ((oldpage (gtk-notebook-get-current-page widget))
|
|
|
1552 (label nil)
|
|
|
1553 (label-box nil)
|
|
|
1554 (pixwid nil))
|
|
|
1555 (if (eq page-num oldpage)
|
|
|
1556 nil
|
|
|
1557 (set-tab-label widget (gtk-notebook-get-nth-page widget oldpage) nil)
|
|
|
1558 (set-tab-label widget (gtk-notebook-get-nth-page widget page-num) t))))
|
|
|
1559
|
|
|
1560 (defun create-pages (notebook start end)
|
|
|
1561 (let (child button label hbox vbox label-box menu-box pixwid i)
|
|
|
1562 (setq i start)
|
|
|
1563 (while (<= i end)
|
|
|
1564 (setq child (gtk-frame-new (format "Page %d" i)))
|
|
|
1565 (gtk-container-set-border-width child 10)
|
|
|
1566
|
|
|
1567 (setq vbox (gtk-vbox-new t 0))
|
|
|
1568 (gtk-container-set-border-width vbox 10)
|
|
|
1569 (gtk-container-add child vbox)
|
|
|
1570
|
|
|
1571 (setq hbox (gtk-hbox-new t 0))
|
|
|
1572 (gtk-box-pack-start vbox hbox nil t 5)
|
|
|
1573
|
|
|
1574 (setq button (gtk-check-button-new-with-label "Fill Tab"))
|
|
|
1575 (gtk-box-pack-start hbox button t t 5)
|
|
|
1576 (gtk-toggle-button-set-active button t)
|
|
|
1577 (gtk-signal-connect
|
|
|
1578 button 'toggled
|
|
|
1579 (lambda (button data)
|
|
|
1580 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
|
|
|
1581 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
|
|
|
1582 (nth 0 packing)
|
|
|
1583 (gtk-toggle-button-get-active button)
|
|
|
1584 (nth 2 packing))))
|
|
|
1585 (cons notebook child))
|
|
|
1586
|
|
|
1587 (setq button (gtk-check-button-new-with-label "Expand Tab"))
|
|
|
1588 (gtk-box-pack-start hbox button t t 5)
|
|
|
1589 (gtk-signal-connect
|
|
|
1590 button 'toggled
|
|
|
1591 (lambda (button data)
|
|
|
1592 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
|
|
|
1593 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
|
|
|
1594 (gtk-toggle-button-get-active button)
|
|
|
1595 (nth 1 packing) (nth 2 packing))))
|
|
|
1596 (cons notebook child))
|
|
|
1597
|
|
|
1598 (setq button (gtk-check-button-new-with-label "Pack End"))
|
|
|
1599 (gtk-box-pack-start hbox button t t 5)
|
|
|
1600 (gtk-signal-connect
|
|
|
1601 button 'toggled
|
|
|
1602 (lambda (button data)
|
|
|
1603 (let ((packing (gtk-notebook-query-tab-label-packing (car data) (cdr data))))
|
|
|
1604 (gtk-notebook-set-tab-label-packing (car data) (cdr data)
|
|
|
1605 (nth 0 packing) (nth 1 packing)
|
|
|
1606 (if (gtk-toggle-button-get-active button) 'end 'start))))
|
|
|
1607 (cons notebook child))
|
|
|
1608
|
|
|
1609 (setq button (gtk-button-new-with-label "Hide Page"))
|
|
|
1610 (gtk-box-pack-end vbox button nil nil 5)
|
|
|
1611 (gtk-signal-connect button 'clicked
|
|
|
1612 (lambda (ignored child) (gtk-widget-hide child)) child)
|
|
|
1613
|
|
|
1614 (gtk-widget-show-all child)
|
|
|
1615
|
|
|
1616 (setq label-box (gtk-hbox-new nil 0))
|
|
|
1617 (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
|
|
|
1618 (gtk-box-pack-start label-box pixwid nil t 0)
|
|
|
1619 (gtk-misc-set-padding pixwid 3 1);
|
|
|
1620 (setq label (gtk-label-new (format "Page %d" i)))
|
|
|
1621 (gtk-box-pack-start label-box label nil t 0)
|
|
|
1622 (gtk-widget-show-all label-box)
|
|
|
1623
|
|
|
1624 (setq menu-box (gtk-hbox-new nil 0))
|
|
|
1625 (setq pixwid (gtk-pixmap-new gtk-test-closed-glyph nil))
|
|
|
1626 (gtk-box-pack-start menu-box pixwid nil t 0)
|
|
|
1627 (gtk-misc-set-padding pixwid 3 1)
|
|
|
1628 (setq label (gtk-label-new (format "Page %d" i)))
|
|
|
1629 (gtk-box-pack-start menu-box label nil t 0)
|
|
|
1630 (gtk-widget-show-all menu-box)
|
|
|
1631 (gtk-notebook-append-page-menu notebook child label-box menu-box)
|
|
|
1632 (incf i))))
|
|
|
1633
|
|
|
1634 (gtk-define-test
|
|
|
1635 "Notebook" container notebook nil
|
|
|
1636 (let (box1 box2 button separator omenu transparent label sample-notebook)
|
|
|
1637 (gtk-container-set-border-width window 0)
|
|
|
1638
|
|
|
1639 (setq sample-notebook (gtk-notebook-new))
|
|
|
1640 (gtk-signal-connect sample-notebook 'switch_page 'page-switch)
|
|
|
1641 (gtk-notebook-set-tab-pos sample-notebook 'top)
|
|
|
1642 (gtk-box-pack-start window sample-notebook t t 0)
|
|
|
1643 (gtk-container-set-border-width sample-notebook 10)
|
|
|
1644
|
|
|
1645 (create-pages sample-notebook 1 5)
|
|
|
1646
|
|
|
1647 (setq separator (gtk-hseparator-new))
|
|
|
1648 (gtk-box-pack-start window separator nil t 10)
|
|
|
1649
|
|
|
1650 (setq box2 (gtk-hbox-new nil 5))
|
|
|
1651 (gtk-container-set-border-width box2 10)
|
|
|
1652 (gtk-box-pack-start window box2 nil t 0)
|
|
|
1653
|
|
|
1654 (setq button (gtk-check-button-new-with-label "popup menu"))
|
|
|
1655 (gtk-box-pack-start box2 button t nil 0)
|
|
|
1656 (gtk-signal-connect button 'clicked
|
|
|
1657 (lambda (button notebook)
|
|
|
1658 (if (gtk-toggle-button-get-active button)
|
|
|
1659 (gtk-notebook-popup-enable notebook)
|
|
|
1660 (gtk-notebook-popup-disable notebook))) sample-notebook)
|
|
|
1661
|
|
|
1662 (setq button (gtk-check-button-new-with-label "homogeneous tabs"))
|
|
|
1663 (gtk-box-pack-start box2 button t nil 0)
|
|
|
1664 (gtk-signal-connect button 'clicked
|
|
|
1665 (lambda (button notebook)
|
|
|
1666 (gtk-notebook-set-homogeneous-tabs
|
|
|
1667 notebook
|
|
|
1668 (gtk-toggle-button-get-active button))) sample-notebook)
|
|
|
1669
|
|
|
1670 (setq box2 (gtk-hbox-new nil 5))
|
|
|
1671 (gtk-container-set-border-width box2 10)
|
|
|
1672 (gtk-box-pack-start window box2 nil t 0)
|
|
|
1673
|
|
|
1674 (setq label (gtk-label-new "Notebook Style :"))
|
|
|
1675 (gtk-box-pack-start box2 label nil t 0)
|
|
|
1676
|
|
|
1677 (setq omenu (build-option-menu '(("Standard" .
|
|
|
1678 (lambda (b n)
|
|
|
1679 (gtk-notebook-set-show-tabs n t)
|
|
|
1680 (gtk-notebook-set-scrollable n nil)))
|
|
|
1681 ("No tabs" .
|
|
|
1682 (lambda (b n)
|
|
|
1683 (gtk-notebook-set-show-tabs n nil)))
|
|
|
1684 ("Scrollable" .
|
|
|
1685 (lambda (b n)
|
|
|
1686 (gtk-notebook-set-show-tabs n t)
|
|
|
1687 (gtk-notebook-set-scrollable n t))))
|
|
|
1688 0
|
|
|
1689 sample-notebook))
|
|
|
1690 (gtk-box-pack-start box2 omenu nil t 0)
|
|
|
1691
|
|
|
1692 (setq button (gtk-button-new-with-label "Show all pages"))
|
|
|
1693 (gtk-box-pack-start box2 button nil t 0)
|
|
|
1694 (gtk-signal-connect
|
|
|
1695 button 'clicked (lambda (button notebook)
|
|
|
1696 (mapc 'gtk-widget-show (gtk-container-children notebook)))
|
|
|
1697 sample-notebook)
|
|
|
1698
|
|
|
1699 (setq box2 (gtk-hbox-new t 10))
|
|
|
1700 (gtk-container-set-border-width box2 10)
|
|
|
1701 (gtk-box-pack-start window box2 nil t 0)
|
|
|
1702
|
|
|
1703 (setq button (gtk-button-new-with-label "prev"))
|
|
|
1704 (gtk-signal-connect button 'clicked
|
|
|
1705 (lambda (button notebook)
|
|
|
1706 (gtk-notebook-prev-page notebook)) sample-notebook)
|
|
|
1707 (gtk-box-pack-start box2 button t t 0)
|
|
|
1708
|
|
|
1709 (setq button (gtk-button-new-with-label "next"))
|
|
|
1710 (gtk-signal-connect button 'clicked
|
|
|
1711 (lambda (button notebook)
|
|
|
1712 (gtk-notebook-next-page notebook)) sample-notebook)
|
|
|
1713 (gtk-box-pack-start box2 button t t 0)
|
|
|
1714
|
|
|
1715 (setq button (gtk-button-new-with-label "rotate"))
|
|
|
1716 (gtk-signal-connect button 'clicked
|
|
|
1717 (lambda (button notebook)
|
|
|
1718 (gtk-notebook-set-tab-pos
|
|
|
1719 notebook
|
|
|
1720 (case (gtk-notebook-tab-pos notebook)
|
|
|
1721 (top 'right)
|
|
|
1722 (right 'bottom)
|
|
|
1723 (bottom 'left)
|
|
|
1724 (left 'top))))
|
|
|
1725 sample-notebook)
|
|
|
1726
|
|
|
1727 (gtk-box-pack-start box2 button t t 0)))
|
|
|
1728
|
|
|
1729
|
|
|
1730 ;;;; Glade interfaces
|
|
|
1731 (if (and (featurep 'glade)
|
|
|
1732 (file-exists-p (expand-file-name "gtk-test.glade" (gtk-test-directory))))
|
|
|
1733 (gtk-define-test
|
|
|
1734 "Glade Interface" misc libglade t
|
|
|
1735 (glade-init)
|
|
|
1736 (glade-xml-get-type)
|
|
|
1737 (let ((xml (glade-xml-new (expand-file-name "gtk-test.glade" (gtk-test-directory))
|
|
|
1738 nil)))
|
|
|
1739 (setq window (glade-xml-get-widget xml "main_window"))
|
|
|
1740 (glade-xml-signal-autoconnect xml)))
|
|
|
1741 (fmakunbound 'gtk-test-libglade))
|
|
|
1742
|
|
|
1743
|
|
|
1744 ;;;; CTree
|
|
|
1745 (defvar gtk-test-ctree-hash nil)
|
|
|
1746
|
|
|
1747 (defun gtk-test-ctree-expand-directory (ctree dir parent)
|
|
|
1748 (ignore-errors
|
|
|
1749 (let ((dirs (directory-files dir t nil nil 5))
|
|
|
1750 (files (directory-files dir t nil nil t))
|
|
|
1751 (node nil))
|
|
|
1752 (mapc (lambda (d)
|
|
|
1753 (if (or (string-match "/\\.$" d)
|
|
|
1754 (string-match "/\\.\\.$" d))
|
|
|
1755 nil
|
|
|
1756 (setq node
|
|
|
1757 (gtk-ctree-insert-node ctree parent nil
|
|
|
1758 (list (file-name-nondirectory d) "")
|
|
|
1759 0 nil nil nil nil nil t))
|
|
|
1760 (puthash node d gtk-test-ctree-hash)
|
|
|
1761 (gtk-ctree-insert-node ctree node nil
|
|
|
1762 (list "" "")
|
|
|
1763 0 nil nil nil nil nil nil)
|
|
|
1764 (gtk-ctree-collapse ctree node)))
|
|
|
1765 dirs)
|
|
|
1766 (mapc (lambda (f)
|
|
|
1767 (gtk-ctree-insert-node ctree parent nil
|
|
|
1768 (list (file-name-nondirectory f)
|
|
|
1769 (user-login-name (nth 2 (file-attributes f))))
|
|
|
1770 0 nil nil nil nil t nil))
|
|
|
1771 files)
|
|
|
1772 (gtk-clist-columns-autosize ctree))))
|
|
|
1773
|
|
|
1774 (defun gtk-spin-button-new-with-label (label adjustment climb-rate digits)
|
|
|
1775 (let ((box (gtk-hbox-new nil 2))
|
|
|
1776 (spin (gtk-spin-button-new adjustment climb-rate digits))
|
|
|
1777 (lbl (gtk-label-new label)))
|
|
|
1778 (gtk-box-pack-start box lbl nil nil 0)
|
|
|
1779 (gtk-box-pack-start box spin t t 0)
|
|
|
1780 (cons box spin)))
|
|
|
1781
|
|
|
1782 (gtk-define-test
|
|
|
1783 "Columnar Tree" composite ctree nil
|
|
|
1784 (let ((scrolled (gtk-scrolled-window-new nil nil))
|
|
|
1785 (ctree (gtk-ctree-new-with-titles 2 0 '("File" "Owner")))
|
|
|
1786 (box (gtk-hbutton-box-new))
|
|
|
1787 (button nil))
|
|
|
1788 (setq gtk-test-ctree-hash (make-hash-table :test 'equal))
|
|
|
1789 (put scrolled 'child ctree)
|
|
|
1790 (put scrolled 'height 400)
|
|
|
1791 (put ctree 'line_style 'solid)
|
|
|
1792 (put ctree 'expander_style 'square)
|
|
|
1793
|
|
|
1794 (gtk-box-pack-start window scrolled t t 0)
|
|
|
1795 (gtk-box-pack-start window box nil nil 5)
|
|
|
1796
|
|
|
1797 (gtk-clist-freeze ctree)
|
|
|
1798 (gtk-test-ctree-expand-directory ctree "/" nil)
|
|
|
1799 (gtk-clist-thaw ctree)
|
|
|
1800
|
|
|
1801 (setq button (gtk-button-new-with-label "Expand all"))
|
|
|
1802 (put box 'child button)
|
|
|
1803 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1804 (gtk-ctree-expand-recursive tree nil)) ctree)
|
|
|
1805
|
|
|
1806 (setq button (gtk-button-new-with-label "Collaps all"))
|
|
|
1807 (put box 'child button)
|
|
|
1808 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1809 (gtk-ctree-collapse-recursive tree nil)) ctree)
|
|
|
1810
|
|
|
1811 (setq button (gtk-button-new-with-label "Change style"))
|
|
|
1812 (put box 'child button)
|
|
|
1813 (put button 'sensitive nil)
|
|
|
1814
|
|
|
1815 (setq box (gtk-hbox-new t 5))
|
|
|
1816 (gtk-box-pack-start window box nil nil 0)
|
|
|
1817
|
|
|
1818 (setq button (gtk-button-new-with-label "Select all"))
|
|
|
1819 (put box 'child button)
|
|
|
1820 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1821 (gtk-ctree-select-recursive tree nil)) ctree)
|
|
|
1822
|
|
|
1823 (setq button (gtk-button-new-with-label "Unselect all"))
|
|
|
1824 (put box 'child button)
|
|
|
1825 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1826 (gtk-ctree-unselect-recursive tree nil)) ctree)
|
|
|
1827
|
|
|
1828 (setq button (gtk-button-new-with-label "Remove all"))
|
|
|
1829 (put box 'child button)
|
|
|
1830 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1831 (gtk-clist-freeze tree)
|
|
|
1832 (gtk-ctree-recurse
|
|
|
1833 tree nil
|
|
|
1834 (lambda (tree subnode data)
|
|
|
1835 (gtk-ctree-remove-node tree subnode)))
|
|
|
1836 (gtk-clist-thaw tree)) ctree)
|
|
|
1837
|
|
|
1838 (setq button (gtk-check-button-new-with-label "Reorderable"))
|
|
|
1839 (put box 'child button)
|
|
|
1840 (gtk-signal-connect button 'clicked (lambda (button tree)
|
|
|
1841 (put tree 'reorderable
|
|
|
1842 (gtk-toggle-button-get-active button))) ctree)
|
|
|
1843
|
|
|
1844 (setq box (gtk-hbox-new t 5))
|
|
|
1845 (gtk-box-pack-start window box nil nil 0)
|
|
|
1846
|
|
|
1847 (gtk-box-pack-start box (build-option-menu
|
|
|
1848 '(("Dotted" . (lambda (item ctree) (put ctree 'line_style 'dotted)))
|
|
|
1849 ("Solid" . (lambda (item ctree) (put ctree 'line_style 'solid)))
|
|
|
1850 ("Tabbed" . (lambda (item ctree) (put ctree 'line_style 'tabbed)))
|
|
|
1851 ("None" . (lambda (item ctree) (put ctree 'line_style 'none))))
|
|
|
1852 0 ctree) nil t 0)
|
|
|
1853 (gtk-box-pack-start box (build-option-menu
|
|
|
1854 '(("Square" . (lambda (item ctree) (put ctree 'expander_style 'square)))
|
|
|
1855 ("Triangle" . (lambda (item ctree) (put ctree 'expander_style 'triangle)))
|
|
|
1856 ("Circular" . (lambda (item ctree) (put ctree 'expander_style 'circular)))
|
|
|
1857 ("None" . (lambda (item ctree) (put ctree 'expander_style 'none))))
|
|
|
1858 0 ctree) nil t 0)
|
|
|
1859 (gtk-box-pack-start box (build-option-menu
|
|
|
1860 '(("Left" . (lambda (item ctree)
|
|
|
1861 (gtk-clist-set-column-justification
|
|
|
1862 ctree (get ctree 'tree_column) 'left)))
|
|
|
1863 ("Right" . (lambda (item ctree)
|
|
|
1864 (gtk-clist-set-column-justification
|
|
|
1865 ctree (get ctree 'tree_column) 'right))))
|
|
|
1866 0 ctree) nil t 0)
|
|
|
1867 (gtk-box-pack-start box (build-option-menu
|
|
|
1868 '(("Single" .
|
|
|
1869 (lambda (item clist)
|
|
|
1870 (gtk-clist-set-selection-mode clist 'single)))
|
|
|
1871 ("Browse" .
|
|
|
1872 (lambda (item clist)
|
|
|
1873 (gtk-clist-set-selection-mode clist 'browse)))
|
|
|
1874 ("Multiple" .
|
|
|
1875 (lambda (item clist)
|
|
|
1876 (gtk-clist-set-selection-mode clist 'multiple)))
|
|
|
1877 ("Extended" .
|
|
|
1878 (lambda (item clist)
|
|
|
1879 (gtk-clist-set-selection-mode clist 'extended))))
|
|
|
1880 3 ctree) nil t 0)
|
|
|
1881
|
|
|
1882 (setq box (gtk-hbox-new t 5))
|
|
|
1883 (gtk-box-pack-start window box nil nil 0)
|
|
|
1884
|
|
|
1885 (let (adj spinner)
|
|
|
1886 (setq adj (gtk-adjustment-new (get ctree 'indent) 0 999 1 5 5)
|
|
|
1887 spinner (gtk-spin-button-new-with-label "Indent: " adj 1 3))
|
|
|
1888 (put box 'child (car spinner))
|
|
|
1889 (gtk-signal-connect adj 'value-changed
|
|
|
1890 (lambda (adj tree)
|
|
|
1891 (put tree 'indent (truncate (gtk-adjustment-value adj)))) ctree)
|
|
|
1892
|
|
|
1893 (setq adj (gtk-adjustment-new (get ctree 'spacing) 0 999 1 5 5)
|
|
|
1894 spinner (gtk-spin-button-new-with-label "Spacing: " adj 1 3))
|
|
|
1895 (put box 'child (car spinner))
|
|
|
1896 (gtk-signal-connect adj 'value-changed
|
|
|
1897 (lambda (adj tree)
|
|
|
1898 (put tree 'spacing (truncate (gtk-adjustment-value adj)))) ctree)
|
|
|
1899
|
|
|
1900 (setq adj (gtk-adjustment-new (get ctree 'row_height) 0 999 1 5 5)
|
|
|
1901 spinner (gtk-spin-button-new-with-label "Row Height: " adj 1 3))
|
|
|
1902 (put box 'child (car spinner))
|
|
|
1903 (gtk-signal-connect adj 'value-changed
|
|
|
1904 (lambda (adj tree)
|
|
|
1905 (put tree 'row_height (truncate (gtk-adjustment-value adj)))) ctree)
|
|
|
1906
|
|
|
1907 (setq button (gtk-check-button-new-with-label "Show logical root"))
|
|
|
1908 (put box 'child button)
|
|
|
1909 (gtk-signal-connect button 'clicked
|
|
|
1910 (lambda (button tree)
|
|
|
1911 (put tree 'show_stub (gtk-toggle-button-get-active button))) ctree))
|
|
|
1912
|
|
|
1913 (gtk-signal-connect ctree 'tree-expand
|
|
|
1914 (lambda (ctree node user-data)
|
|
|
1915 (gtk-clist-freeze ctree)
|
|
|
1916 (gtk-ctree-recurse
|
|
|
1917 ctree node
|
|
|
1918 (lambda (tree subnode user-data)
|
|
|
1919 (if (not (equal subnode node))
|
|
|
1920 (gtk-ctree-remove-node tree subnode))))
|
|
|
1921 (gtk-test-ctree-expand-directory ctree
|
|
|
1922 (gethash node gtk-test-ctree-hash)
|
|
|
1923 node)
|
|
|
1924 (gtk-clist-thaw ctree)))))
|
|
|
1925
|
|
|
1926
|
|
|
1927 ;;;; The main interface
|
|
|
1928
|
|
|
1929 (defun gtk-test-view-source (test)
|
|
|
1930 ;; View the source for this test in a XEmacs window.
|
|
|
1931 (if test
|
|
|
1932 (let ((path (expand-file-name "gtk-test.el" (gtk-test-directory))))
|
|
|
1933 (if (not (file-exists-p path))
|
|
|
1934 (error "Could not find source for gtk-test.el"))
|
|
|
1935 (find-file path)
|
|
|
1936 (widen)
|
|
|
1937 (goto-char (point-min))
|
|
|
1938 (if (not (re-search-forward (concat "(gtk-define-test[ \t\n]*\"" test "\"") nil t))
|
|
|
1939 (error "Could not find test: %s" test)
|
|
|
1940 (narrow-to-page)
|
|
|
1941 (goto-char (point-min))))))
|
|
|
1942
|
|
|
1943 (defvar gtk-test-selected-test nil)
|
|
|
1944
|
|
|
1945 (defun gtk-test ()
|
|
|
1946 (interactive)
|
|
|
1947 (let ((items nil)
|
|
|
1948 (box nil)
|
|
|
1949 (window nil)
|
|
|
1950 (category-trees nil)
|
|
|
1951 (tree nil)
|
|
|
1952 (pane nil)
|
|
|
1953 (scrolled nil)
|
|
|
1954 (src-button nil)
|
|
|
1955 (gc-button nil)
|
|
|
1956 (standalone-p (not (default-gtk-device)))
|
|
|
1957 (close-button nil))
|
|
|
1958 (gtk-init (list invocation-name))
|
|
|
1959 (if standalone-p
|
|
|
1960 (progn
|
|
|
1961 (gtk-object-destroy (gtk-adjustment-new 0 0 0 0 0 0))))
|
|
|
1962 (ignore-errors
|
|
|
1963 (or (fboundp 'gtk-test-gnome-pixmaps)
|
|
|
1964 (load-file (expand-file-name "gnome-test.el" (gtk-test-directory))))
|
|
|
1965 (or (fboundp 'gtk-test-color-combo)
|
|
|
1966 (load-file (expand-file-name "gtk-extra-test.el" (gtk-test-directory)))))
|
|
|
1967 (unwind-protect
|
|
|
1968 (progn
|
|
|
1969 (setq window (gtk-dialog-new)
|
|
|
1970 box (gtk-vbox-new nil 5)
|
|
|
1971 pane (gtk-hpaned-new)
|
|
|
1972 scrolled (gtk-scrolled-window-new nil nil)
|
|
|
1973 tree (gtk-tree-new)
|
|
|
1974 src-button (gtk-button-new-with-label "View source")
|
|
|
1975 gc-button (gtk-button-new-with-label "Garbage Collect")
|
|
|
1976 close-button (gtk-button-new-with-label "Quit"))
|
|
|
1977 (gtk-window-set-title window
|
|
|
1978 (format "%s/GTK %d.%d.%d"
|
|
|
1979 (if (featurep 'infodock) "InfoDock" "XEmacs")
|
|
|
1980 emacs-major-version emacs-minor-version
|
|
|
1981 (or emacs-patch-level emacs-beta-version)))
|
|
|
1982
|
|
|
1983 (gtk-scrolled-window-set-policy scrolled 'automatic 'automatic)
|
|
|
1984 (gtk-scrolled-window-add-with-viewport scrolled tree)
|
|
|
1985 (gtk-widget-set-usize scrolled 200 600)
|
|
|
1986
|
|
|
1987 (gtk-box-pack-start (gtk-dialog-vbox window) pane t t 5)
|
|
|
1988 (gtk-paned-pack1 pane scrolled t nil)
|
|
|
1989 (gtk-paned-pack2 pane box t nil)
|
|
|
1990 (setq gtk-test-shell box)
|
|
|
1991 (gtk-widget-show-all box)
|
|
|
1992
|
|
|
1993 (gtk-container-add (gtk-dialog-action-area window) close-button)
|
|
|
1994 (gtk-container-add (gtk-dialog-action-area window) src-button)
|
|
|
1995 (gtk-container-add (gtk-dialog-action-area window) gc-button)
|
|
|
1996
|
|
|
1997 (gtk-signal-connect gc-button 'clicked
|
|
|
1998 (lambda (obj data)
|
|
|
1999 (garbage-collect)))
|
|
|
2000 (gtk-signal-connect close-button 'clicked
|
|
|
2001 (lambda (obj data)
|
|
|
2002 (gtk-widget-destroy data)) window)
|
|
|
2003 (gtk-signal-connect src-button 'clicked
|
|
|
2004 (lambda (obj data)
|
|
|
2005 (gtk-test-view-source gtk-test-selected-test)))
|
|
|
2006
|
|
|
2007 ;; Try to be a nice person and sort the tests
|
|
|
2008 (setq gtk-defined-tests
|
|
|
2009 (sort gtk-defined-tests
|
|
|
2010 (lambda (a b)
|
|
|
2011 (string-lessp (car a) (car b)))))
|
|
|
2012
|
|
|
2013 ;; This adds all of the buttons to the window.
|
|
|
2014 (mapcar (lambda (test)
|
|
|
2015 (let* ((desc (nth 0 test))
|
|
|
2016 (type (nth 1 test))
|
|
|
2017 (func (nth 2 test))
|
|
|
2018 (parent (cdr-safe (assoc type category-trees)))
|
|
|
2019 (item (gtk-tree-item-new-with-label desc)))
|
|
|
2020 (put item 'test-function func)
|
|
|
2021 (put item 'test-description desc)
|
|
|
2022 (put item 'test-type type)
|
|
|
2023 (gtk-widget-show item)
|
|
|
2024 (if (not parent)
|
|
|
2025 (let ((subtree (gtk-tree-new)))
|
|
|
2026 (setq parent (gtk-tree-item-new-with-label
|
|
|
2027 (or (cdr-safe (assoc type gtk-test-categories))
|
|
|
2028 (symbol-name type))))
|
|
|
2029 (gtk-signal-connect subtree 'select-child
|
|
|
2030 (lambda (tree widget data)
|
|
|
2031 (setq gtk-test-selected-test (get widget 'test-description))
|
|
|
2032 (funcall (get widget 'test-function))))
|
|
|
2033 (gtk-tree-append tree parent)
|
|
|
2034 (gtk-tree-item-set-subtree parent subtree)
|
|
|
2035 (setq parent subtree)
|
|
|
2036 (push (cons type parent) category-trees)))
|
|
|
2037 (gtk-tree-append parent item)))
|
|
|
2038 gtk-defined-tests)
|
|
|
2039 (gtk-widget-show-all window)
|
|
|
2040 (if standalone-p
|
|
|
2041 (progn
|
|
|
2042 (gtk-signal-connect window 'destroy (lambda (w d)
|
|
|
2043 (gtk-main-quit)))
|
|
|
2044 (gtk-main)))))))
|
