source: project/gtk2/trunk/gtk2.scm @ 3103

Last change on this file since 3103 was 3103, checked in by Tony Sidaway, 13 years ago

Documentation

File size: 22.2 KB
Line 
1;;@title "GTK+ 2.0 binding"
2; Copyright (c) 2002-2007 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
3;
4; Permission is hereby granted, free of charge, to any person obtaining a copy of this
5; software and associated documentation files (the "Software"), to deal in the Software
6; without restriction, including without limitation the rights to use, copy, modify,
7; merge, publish, distribute, sublicense, and/or sell copies of the Software, and to
8; permit persons to whom the Software is furnished to do so, subject to the following
9; conditions:
10;
11; The above copyright notice and this permission notice shall be included in all copies
12; or substantial portions of the Software.
13;
14; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED,
15; INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
16; PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE
17; FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
18; OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER
19; DEALINGS IN THE SOFTWARE.
20(declare
21 (usual-integrations))
22(declare (foreign-declare #<<EOF
23
24#include <gtk/gtk.h>
25
26static void CG_collect_stringlist(C_word k, GSList *head, GSList *curr, C_word acc) {
27   if (curr == NULL) {
28     g_slist_free(head);
29     C_kontinue(k, acc);
30   } else {
31     int len = strlen((gchar const *) curr->data);
32     C_word space[C_SIZEOF_PAIR + C_SIZEOF_STRING(len)];
33     C_word *a = space;
34     C_word s = C_string(&a, len, (gchar *) curr->data);
35     g_free(curr->data);
36     CG_collect_stringlist(k, head, curr->next, C_pair(&a, s, acc));
37   }
38}
39
40static void CG_stock_list_ids(C_word argc, C_word self, C_word k) {
41   GSList *l = gtk_stock_list_ids();
42   CG_collect_stringlist(k, l, l, C_SCHEME_END_OF_LIST);
43}
44
45EOF
46))
47
48;;@ <synopsis>(require 'gtk2)</synopsis>
49;; The gtk extension module provides a wrapping for the GTK+ GUI
50;; toolkit library, version 2.0. It depends upon the gobject
51;; extension.
52
53;---------------------------------------------------------------------------;
54;;@section "General"
55
56;;@ Most of the functions supported by the GTK+ binding extension are
57;; automatically generated from <filename>*.defs</filename> files,
58;; taken from James Henstridge's <application>pygtk</application> GTK+
59;; binding for Python.
60;;
61;; The generated code is contained in internal modules which don't
62;; need to be <function>require</function>d separately - they're
63;; automatically included when the gtk2 module is loaded. Some of the
64;; generated code is not a good fit for Chicken, so it has been
65;; overridden by hand-written code<footnote><para>Isn't it nice having
66;; procedures in mutable global variables?</para></footnote> in the
67;; gtk2 module itself.
68;;
69;; Generated procedures usually have a name derived from the name of
70;; the C function they are wrapping: case is folded to lowercase, and
71;; underscores are replaced with hyphens, so for instance
72;; <literal>gtk_main_quit</literal> becomes
73;; <literal>gtk-main-quit</literal>.
74;;
75;; Methods on wrapped <classname>GtkObject</classname> subclasses are
76;; registered with the introspection facilities of the gobject module
77;; with calls to <function>gobject:register-method!</function>.
78
79(require 'gtk2-gobject)
80(require-for-syntax 'gtk2-gobject)
81
82(require 'srfi-4)
83
84(include "gobject-macros.scm")
85
86((foreign-safe-lambda* void ()
87                  "int argc = 1;"
88                  "char *argv[] = { \"gtkchicken\" , NULL };"
89                  "char **argv_p = &argv[0];"
90                  "gtk_init(&argc, &argv_p);"))
91
92;;(gtype:init-types-from-file "gdk-types")
93;;(gtype:init-types-from-file "gtk-types")
94
95(gtype:init-types-from-file "gdk-types-00")
96(gtype:init-types-from-file "gdk-types-01")
97
98(gtype:init-types-from-file "gtk-types-00")
99(gtype:init-types-from-file "gtk-types-01")
100(gtype:init-types-from-file "gtk-types-02")
101(gtype:init-types-from-file "gtk-types-03")
102(gtype:init-types-from-file "gtk-types-04")
103
104;;@function (gtk-signal-connect object signal-name handler-fn)
105;;An alias for <function>gsignal-connect</function>.
106(define gtk-signal-connect gsignal-connect)
107
108(require "gtk2/wrap-boxed")
109(require "gtk2/wrap-classes")
110(require "gtk2/wrap-enum")
111(require "gtk2/wrap-flags")
112(require "gtk2/wrap-functions")
113
114(require "gtk2/gdkevent")
115
116;; Override entry points to allow callbacks.
117
118;;@function (gtk-main)
119;;Pass control to the GTK+ main loop. This call does not return until
120;;the application indicates it is ready to terminate by calling
121;;<function>gtk-main-quit</function>.
122(define gtk-main
123  (foreign-safe-lambda void "gtk_main"))
124
125;;@function (gtk-main-iteration)
126;;Delegates directly to the C function
127;;<function>gtk_main_iteration</function>.
128(define gtk-main-iteration
129  (foreign-safe-lambda bool "gtk_main_iteration"))
130
131;---------------------------------------------------------------------------;
132;;@section "Timeouts, idle-handlers, and input-handlers"
133;;Input handlers are not currently supported.
134
135(define-record gtk:gtkfunction number kind thunk)
136
137(define gtk:gtkfunctions-freelist '())
138(define gtk:next-gtkfunction 1)
139(define gtk:gtkfunctions (make-hash-table =))
140(define gtk:timeout-handlers (make-hash-table =))
141(define gtk:idle-handlers (make-hash-table =))
142
143(define (gtk:reserve-function-number)
144  (if (null? gtk:gtkfunctions-freelist)
145      (let ((n gtk:next-gtkfunction))
146        (set! gtk:next-gtkfunction (+ n 1))
147        n)
148      (let ((n gtk:gtkfunctions-freelist))
149        (set! gtk:gtkfunctions-freelist (cdr n))
150        (car n))))
151
152(define (gtk:release-function-number n)
153  (set! gtk:gtkfunctions-freelist (cons n gtk:gtkfunctions-freelist)))
154
155(define-external (cg_gtk_function (c-pointer data))
156  bool
157  (let* ((n (gobject:gpointer-to-uint data))
158         (f (hash-table-ref/default gtk:gtkfunctions n #f)))
159    (if f
160        ((gtk:gtkfunction-thunk f))
161        (begin
162          (g-warning "cg_gtk_function: unknown callback number: " n)
163          #f))))
164
165(define-record gtk:timeout-handle number)
166(define-record-printer (gtk:timeout-handle h out)
167  (for-each (lambda (x) (display x out))
168            (list "#<gtk:timeout-handle " (gtk:timeout-handle-number h) ">")))
169
170;;@ Installs a timeout-handling procedure. After
171;;<parameter>interval</parameter> milliseconds, and every
172;;<parameter>interval</parameter> thereafter,
173;;<parameter>thunk</parameter> will be called with no arguments. If
174;;<parameter>thunk</parameter> returns <literal>#f</literal>, the
175;;timeout-handler will not run again (it will be removed). The
176;;semantics are derived from the underlying C procedure,
177;;<function>gtk_timeout_add</function>. This function returns a
178;;<structname>gtk:timeout-handle</structname> record, which can be
179;;passed in to <function>gtk-timeout-remove</function>.
180(define (gtk-timeout-add interval thunk)
181  (let* ((n (gtk:reserve-function-number))
182         (f (make-gtk:gtkfunction n 'timeout thunk)))
183    (hash-table-set! gtk:gtkfunctions n f)
184    (let ((h ((foreign-safe-lambda* unsigned-integer ((unsigned-integer interval)
185                                                 (unsigned-integer data))
186                               "return(gtk_timeout_add(interval, (GtkFunction) cg_gtk_function,"
187                               "                       GUINT_TO_POINTER(data)));")
188              interval
189              n)))
190      (hash-table-set! gtk:timeout-handlers h f)
191      (make-gtk:timeout-handle h))))
192
193;;@ Removes a previously-registered timeout handler, using a
194;;<structname>gtk:timeout-handle</structname> record returned by
195;;<function>gtk-timeout-add</function>.
196(define (gtk-timeout-remove handle)
197  (let* ((h (gtk:timeout-handle-number handle))
198         (f (hash-table-ref/default gtk:timeout-handlers h #f)))
199    (if (not f)
200        (error "gtk-timeout-remove: not found" handle)
201        (begin
202          (assert (eq? 'timeout (gtk:gtkfunction-kind f)))
203          ((foreign-safe-lambda void "gtk_timeout_remove" unsigned-integer) h)
204          (hash-table-delete! gtk:timeout-handlers h)
205          (hash-table-delete! gtk:gtkfunctions (gtk:gtkfunction-number f))
206          (gtk:release-function-number (gtk:gtkfunction-number f))))))
207
208(define-record gtk:idle-handle number)
209(define-record-printer (gtk:idle-handle h out)
210  (for-each (lambda (x) (display x out))
211            (list "#<gtk:idle-handle " (gtk:idle-handle-number h) ">")))
212
213;;@ Installs <parameter>thunk</parameter> as a GTK+ idle handler, as
214;;per the C function <function>gtk_idle_add</function>. Returns a
215;;<structname>gtk:idle-handle</structname> record, which may be used
216;;with <function>gtk-idle-remove</function>.
217(define (gtk-idle-add thunk)
218  (let* ((n (gtk:reserve-function-number))
219         (f (make-gtk:gtkfunction n 'idle thunk)))
220    (hash-table-set! gtk:gtkfunctions n f)
221    (let ((h ((foreign-safe-lambda* unsigned-integer ((unsigned-integer data))
222                               "return(gtk_idle_add((GtkFunction) cg_gtk_function,"
223                               "                    GUINT_TO_POINTER(data)));")
224              n)))
225      (hash-table-set! gtk:idle-handlers h f)
226      (make-gtk:idle-handle h))))
227
228;;@ Removes a previously installed GTK+ idle handler, using the
229;;<structname>gtk:idle-handle</structname> record returned from
230;;<function>gtk-idle-add</function>.
231(define (gtk-idle-remove handle)
232  (let* ((h (gtk:idle-handle-number handle))
233         (f (hash-table-ref/default gtk:idle-handlers h #f)))
234    (if (not f)
235        (error "gtk-idle-remove: not found" handle)
236        (begin
237          (assert (eq? 'idle (gtk:gtkfunction-kind f)))
238          ((foreign-safe-lambda void "gtk_idle_remove" unsigned-integer) h)
239          (hash-table-delete! gtk:idle-handlers h)
240          (hash-table-delete! gtk:gtkfunctions (gtk:gtkfunction-number f))
241          (gtk:release-function-number (gtk:gtkfunction-number f))))))
242
243;---------------------------------------------------------------------------;
244;;@section "GDK"
245
246;;@ Return a list (R G B) of the three colour components contained in
247;;a <structname>GdkColor</structname> structure.
248(define gdk-color->list
249  (let ((color-r (foreign-safe-lambda* int (((pointer "GdkColor") c)) "return(c->red);"))
250        (color-g (foreign-safe-lambda* int (((pointer "GdkColor") c)) "return(c->green);"))
251        (color-b (foreign-safe-lambda* int (((pointer "GdkColor") c)) "return(c->blue);")))
252    (lambda (c)
253      (let ((p (gboxed-pointer c)))
254        (list (color-r p)
255              (color-g p)
256              (color-b p))))))
257
258(gobject:register-method! "GdkColor"
259                          '->list
260                          'gdk-color->list
261                          gdk-color->list)
262
263;;@ Convert a list (R G B) into a <structname>GdkColor</structname>
264;;boxed object.
265(define list->gdk-color
266  (let ((t (gtype-from-name "GdkColor")))
267    (lambda (l)
268      (wrap-gboxed t
269                   (apply (foreign-safe-lambda* c-pointer ((int r) (int g) (int b))
270                                           "GdkColor c;"
271                                           "c.red = r;"
272                                           "c.green = g;"
273                                           "c.blue = b;"
274                                           "return(gdk_color_copy(&c));")
275                          l)
276                   #f))))
277
278;;@ Extract the pixel value from a <structname>GdkColor</structname>
279;;structure.
280(define gdk-color-pixel
281  (let ((color-p (foreign-safe-lambda* int (((pointer "GdkColor") c)) "return(c->pixel);")))
282    (lambda (c)
283      (color-p (gboxed-pointer c)))))
284
285(gobject:register-method! "GdkColor"
286                          'pixel
287                          'gdk-color-pixel
288                          gdk-color-pixel)
289
290;;@ Update the pixel value within a <structname>GdkColor</structname>
291;;structure.
292(define gdk-color-pixel-set!
293  (let ((color-p (foreign-safe-lambda* void (((pointer "GdkColor") c)
294                                        (int p))
295                                  "c->pixel = p;")))
296    (lambda (color newpixel)
297      (color-p (gboxed-pointer color) newpixel)
298      newpixel)))
299
300(gobject:register-method! "GdkColor"
301                          'pixel
302                          'gdk-color-pixel-set!
303                          gdk-color-pixel-set!)
304
305;;@ Convert a <structname>GdkRectangle</structname> into a list (x y
306;;width height).
307(define gdk-rectangle->list
308  (let ((gx (foreign-safe-lambda* integer (((pointer "GdkRectangle") p)) "return(p->x);"))
309        (gy (foreign-safe-lambda* integer (((pointer "GdkRectangle") p)) "return(p->y);"))
310        (gw (foreign-safe-lambda* integer (((pointer "GdkRectangle") p)) "return(p->width);"))
311        (gh (foreign-safe-lambda* integer (((pointer "GdkRectangle") p)) "return(p->height);")))
312    (lambda (r)
313      (let ((p (gboxed-pointer r)))
314        (list (gx p)
315              (gy p)
316              (gw p)
317              (gh p))))))
318
319(gobject:register-method! "GdkRectangle"
320                          '->list
321                          'gdk-rectangle->list
322                          gdk-rectangle->list)
323
324;;@ Convert a list (x y width height) into a
325;;<structname>GdkRectangle</structname> boxed object.
326(define list->gdk-rectangle
327  (let ((t (gtype-from-name "GdkRectangle")))
328    (lambda (l)
329      (wrap-gboxed t
330                   (apply (foreign-safe-lambda* c-pointer ((integer x) (integer y)
331                                                      (integer w) (integer h))
332                                           "static GType r_t = 0;"
333                                           "GdkRectangle r;"
334                                           "if (r_t == 0)"
335                                           "  r_t = g_type_from_name(\"GdkRectangle\");"
336                                           "r.x = x;"
337                                           "r.y = y;"
338                                           "r.width = w;"
339                                           "r.height = h;"
340                                           "return(g_boxed_copy(r_t, &r));")
341                          l)
342                   #f))))
343
344;;@ Returns multiple values: (x y state), where x and y make up the
345;;current pointer coordinate, and state is a list of GdkModifierType
346;;symbols.
347(define (gdk-window-get-pointer w)
348  (let ((v (make-s32vector 3)))
349    ((foreign-safe-lambda* void (((pointer "GdkWindow") w)
350                            (s32vector v))
351                      "int x, y;"
352                      "GdkModifierType state;"
353                      "gdk_window_get_pointer(w, &x, &y, &state);"
354                      "v[0] = x;"
355                      "v[1] = y;"
356                      "v[2] = (int) state;")
357     (g:unbox-GdkWindow w)
358     v)
359    (values (s32vector-ref v 0)
360            (s32vector-ref v 1)
361            (number->GdkModifierType (s32vector-ref v 2)))))
362
363(gobject:register-method! "GdkWindow"
364                          'get-pointer
365                          'gdk-window-get-pointer
366                          gdk-window-get-pointer)
367
368;---------------------------------------------------------------------------;
369; Fill in some missing methods, and override some inappropriately-wrapped methods.
370;;@section "Miscellaneous and overridden procedures"
371
372;;@function (gtk:gc-idle-timeout (#:optional value))
373;; If <parameter>value</parameter> is omitted, returns the current
374;; setting for the number of milliseconds of GTK idleness before a GC
375;; is forced; otherwise, sets the setting to the passed-in number of
376;; milliseconds. Only used when <function>gtk:gc-when-idle</function>
377;; has been enabled. Defaults to 1000 milliseconds.
378(define gtk:gc-idle-timeout (make-parameter 1000))
379
380;;@function (gtk:gc-when-idle (#:optional value))
381;; If <parameter>value</parameter> is omitted, returns
382;; <literal>#t</literal> if the GTK-idle-garbage-collector is enabled,
383;; or <literal>#f</literal> otherwise. If <parameter>value</parameter>
384;; is specified, enables the idle-garbage-collector unless
385;; <parameter>value</parameter> is <literal>#f</literal>. Defaults to
386;; being switched off.
387(define gtk:gc-when-idle
388  (let ((id #f)
389        (gc-idler (lambda ()
390                    (let loop ((collected #f))
391                      (when (zero? (gtk-events-pending))
392                        (if collected
393                            (begin
394                              (gtk-main-iteration)
395                              (loop #f))
396                            (let* ((gc-ran #f)
397                                   (id (gtk-timeout-add
398                                        (gtk:gc-idle-timeout)
399                                        (lambda ()
400;                                           (print* "(gc...") (flush-output) (time
401                                          (gc #t)
402;                                            ) (print "done)")
403                                          (set! gc-ran #t)
404                                          #f))))
405                              (gtk-main-iteration)
406                              (gtk-timeout-remove id)
407                              (loop gc-ran))))))))
408    (lambda arg
409      (if (pair? arg)
410          (if (car arg)
411              (if id
412                  #f
413                  (begin
414                    (set! id (gtk-idle-add gc-idler))
415                    #t))
416              (if id
417                  (begin
418                    (gtk-idle-remove id)
419                    (set! id #f)
420                    #t)
421                  #f))
422          (if id #t #f)))))
423
424;;@ Retrieve the date selected by a <classname>GtkCalendar</classname>
425;;widget, in the form of a list of three numbers, year, month, day:
426;;<literal>(2002 10 13)</literal>.
427(define (gtk-calendar-get-date cal)
428  (u32vector->list
429   (let ((u (make-u32vector 3)))
430     ((foreign-safe-lambda* void ((c-pointer cal)
431                             (u32vector u))
432                       "gtk_calendar_get_date(cal, &u[0], &u[1], &u[2]);")
433      (g:unbox-GtkCalendar cal)
434      u)
435     u)))
436
437;;@function (gtk-stock-list-ids)
438;;Returns a list of all current GTK+ <quote>stock ID</quote> strings.
439(define gtk-stock-list-ids (##core#primitive "CG_stock_list_ids"))
440
441;;@ Allocates a new instance of <classname>GtkTreeIter</classname>,
442;;for use with various GTK+ tree model and view functions.
443(define gtk-tree-iter-new
444  (let ((t (gtype-from-name "GtkTreeIter")))
445    (lambda ()
446      (wrap-gboxed t
447                   ((foreign-safe-lambda* c-pointer ()
448                                     "GtkTreeIter *r = g_new0(GtkTreeIter, 1);"
449                                     "return(r);"))
450                   #f))))
451
452;;@ Creates and returns a new instance of
453;;<classname>GtkListStore</classname> with the same number of columns
454;;as parameters to the function call. Each parameter should be a
455;;<structname>gtype</structname> record (as returned by
456;;<function>gtype-from-name</function>, for example, or as stored in
457;;variables such as <varname>gtype:string</varname> or
458;;<varname>gtype:boolean</varname>).
459(define (gtk-list-store-new . coltypes)
460  (let ((ctvec (list->u32vector (map gtype-number coltypes))))
461    (wrap-gobject
462     ((foreign-safe-lambda* c-pointer ((integer n)
463                                  (u32vector v))
464                       "return(gtk_list_store_newv(n, (GType*) v));")
465      (u32vector-length ctvec)
466      ctvec))))
467
468;;@ Creates and returns a new instance of
469;;<classname>GtkTreeStore</classname> with the same number of columns
470;;as parameters to the function call. Each parameter should be a
471;;<structname>gtype</structname> record, as for
472;;<function>gtk-list-store-new</function>.
473(define (gtk-tree-store-new . coltypes)
474  (let ((ctvec (list->u32vector (map gtype-number coltypes))))
475    (wrap-gobject
476     ((foreign-safe-lambda* c-pointer ((integer n)
477                                  (u32vector v))
478                       "return(gtk_tree_store_newv(n, (GType*) v));")
479      (u32vector-length ctvec)
480      ctvec))))
481
482;;@ Sets the number and type of columns associated with the
483;;<classname>GtkListStore</classname>
484;;<parameter>l</parameter>. <parameter>coltypes</parameter> are as for
485;;<function>gtk-list-store-new</function>.
486(define (gtk-list-store-set-column-types l . coltypes)
487  (let ((ctvec (list->u32vector (map gtype-number coltypes))))
488    ((foreign-safe-lambda* void ((c-pointer l)
489                            (integer n)
490                            (u32vector v))
491                      "gtk_list_store_set_column_types(GTK_LIST_STORE(l), n, (GType*) v);")
492     (gobject-pointer l)
493     (u32vector-length ctvec)
494     ctvec)))
495
496;;@ Sets the number and type of columns associated with the
497;;<classname>GtkTreeStore</classname>
498;;<parameter>t</parameter>. <parameter>coltypes</parameter> are as for
499;;<function>gtk-tree-store-new</function>.
500(define (gtk-tree-store-set-column-types t . coltypes)
501  (let ((ctvec (list->u32vector (map gtype-number coltypes))))
502    ((foreign-safe-lambda* void ((c-pointer t)
503                            (integer n)
504                            (u32vector v))
505                      "gtk_tree_store_set_column_types(GTK_TREE_STORE(t), n, (GType*) v);")
506     (gobject-pointer t)
507     (u32vector-length ctvec)
508     ctvec)))
509
510;;@ Stores the currently-selected row of the
511;;<classname>GtkTreeSelection</classname> <parameter>sel</parameter>
512;;(single-row-selection mode only) into the
513;;<classname>GtkTreeIter</classname> <parameter>iter</parameter>. If
514;;there is no current selection, <literal>#f</literal> is returned;
515;;otherwise, the associated <classname>GtkTreeModel</classname> is
516;;returned.
517(define (gtk-tree-selection-get-selected sel iter)
518  (wrap-gobject
519   ((foreign-safe-lambda* c-pointer ((c-pointer sel)
520                                (c-pointer iter))
521                     "GtkTreeModel *model = NULL;"
522                     "gboolean result = gtk_tree_selection_get_selected((GtkTreeSelection*)sel,"
523                     "                                                  &model,"
524                     "                                                  (GtkTreeIter*)iter);"
525                     "return(result ? model : NULL);")
526    (gobject-pointer sel)
527    (gboxed-pointer iter))))
528
529;;@ Extracts the <structfield>window</structfield> field of the
530;;<structname>GtkWidget</structname> struct associated with the
531;;passed-in object.
532(define gtk-widget-window
533  (let ((ww (foreign-safe-lambda* c-pointer (((pointer "GtkWidget") w))
534                             "return(w->window);")))
535    (lambda (w)
536      (wrap-gobject (ww (gobject-pointer w))))))
537
538(gobject:register-method! "GtkWidget"
539                          'window
540                          'gtk-widget-window
541                          gtk-widget-window)
542
543;;@ Extracts the <structfield>allocation</structfield> field of the
544;;<structname>GtkWidget</structname> struct associated with the
545;;passed-in object.
546(define gtk-widget-allocation
547  (let ((wa (foreign-safe-lambda* c-pointer (((pointer "GtkWidget") w))
548                             "return(&(w->allocation));")))
549    (lambda (w)
550      (g:box-GdkRectangle (wa (gobject-pointer w))))))
551
552(gobject:register-method! "GtkWidget"
553                          'allocation
554                          'gtk-widget-allocation
555                          gtk-widget-allocation)
556
557;;@ Extracts the <structfield>state</structfield> field of the
558;;<structname>GtkWidget</structname> struct associated with the
559;;passed-in object, and returns it in symbolic form.
560(define (gtk-widget-get-state w)
561  (number->GtkStateType
562   ((foreign-safe-lambda int "GTK_WIDGET_STATE" (pointer "GtkWidget"))
563    (gobject-pointer w))))
564
565(gobject:register-method! "GtkWidget"
566                          'get-state
567                          'gtk-widget-get-state
568                          gtk-widget-get-state)
569
570;;@ Retrieves the black GC from the passed-in style.
571(define (gtk-style-black-gc style)
572  (assert (GtkStyle? style))
573  (g:box-GdkGC
574   ((foreign-safe-lambda* c-pointer (((pointer "GtkStyle") style))
575                     "return(style->black_gc);")
576    (gobject-pointer style))))
577
578(gobject:register-method! "GtkStyle"
579                          'black-gc
580                          'gtk-style-black-gc
581                          gtk-style-black-gc)
582
583;;@ Retrieves the white GC from the passed-in style.
584(define (gtk-style-white-gc style)
585  (assert (GtkStyle? style))
586  (g:box-GdkGC
587   ((foreign-safe-lambda* c-pointer (((pointer "GtkStyle") style))
588                     "return(style->white_gc);")
589    (gobject-pointer style))))
590
591(gobject:register-method! "GtkStyle"
592                          'white-gc
593                          'gtk-style-white-gc
594                          gtk-style-white-gc)
595
596;;@ Retrieves the foreground GC from the passed-in style that is
597;;appropriate to the passed-in GtkStateType symbol.
598(define (gtk-style-fg-gc style state)
599  (assert (GtkStyle? style))
600  (g:box-GdkGC
601   ((foreign-safe-lambda* c-pointer (((pointer "GtkStyle") style)
602                                (int state))
603                     "return(style->fg_gc[state]);")
604    (gobject-pointer style)
605    (GtkStateType->number state))))
606
607(gobject:register-method! "GtkStyle"
608                          'fg-gc
609                          'gtk-style-fg-gc
610                          gtk-style-fg-gc)
611
612;;@ Inserts text <parameter>string</parameter> at the
613;;<parameter>position</parameter> passed in. Returns the new insertion
614;;position after the insert operation.
615(define (gtk-editable-insert-text editable string position)
616  ((foreign-safe-lambda* integer (((pointer "GtkEditable") e)
617                             (byte-vector bv)
618                             (unsigned-integer len)
619                             (integer in_pos))
620                    "gint pos = in_pos;"
621                    "gtk_editable_insert_text(e, (gchar const *) bv, len, &pos);"
622                    "return(pos);")
623   (g:unbox-GtkEditable editable)
624   (if (string? string)
625       (string->byte-vector string)
626       string)
627   (if (string? string)
628       (string-length string)
629       (byte-vector-length string))
630   position))
Note: See TracBrowser for help on using the repository browser.