SWIG exemples

 

Philippe Cassignol le 26/10/2008

J'ai voulu reprendre l'écriture de tclgtk.so, mais aprés deux mois d'inactivité, je n'y comprend plus rien !!!

Vouloir écrire un binding Gtk2 pour TCL alors que je ne connais pas le langage C, avec SWIG outil dont j'ai à peine compris les bases, le tout pour écrire un éditeur configurable dans le style d'Emacs, c'est de la folie.

Le soleil tapait fort cet été, j'ai du attraper une insolation, je ne voie pas d'autres explications.

Je vais repartir de zéros. Et tout d'abord bien comprendre le fonctionnement de SWIG en écrivant une série de petits exemples.

Tous les fichiers de chaques exemples sont regroupés dans un unique script shell sous forme de documents en ligne. C'est plus facile à manipuler ainsi. Il suffit d'exécuter le script shell et tous les fichiers sont créés, SWIG exécuté, la compilation et l'édition de liens de la librairie effectué et finalement le script TCL de test exécuté.


factorial.h

C'est exemple montre simplement le fonctionnement de SWIG.

factorial.c est le fichier C à rajouter à l'interpreteur TCL sous forme d'une librairie dynamique, ici il contient une seule fonction fact.

factorial.h est le fichier d'en tête, il reprend le protoype de la fonction C.

factorial.i est le fichier d'interface de SWIG, c'est la que tout ce passe. C'est la rédaction de ce fichier qui permet le miracle d'utiliser des fonctions C avec TCL sans rien connaitre du langage C n'y du fonctionnement interne de TCL.

Et à la fin un script TCL pour tester le tout.

   #!/bin/sh

   rm factorial.* 2>/dev/null

   #-------------------------------------------------------------------------
   # factorial.c
   (
   cat <<'EOF'

   int  fact(int n) {
   	if (n <= 1) return 1;
   	else return n*fact(n-1);
   }

   EOF
   ) > factorial.c

   #-------------------------------------------------------------------------
   # factorial.h
   (
   cat <<'EOF'
   int    fact(int);
   EOF
   ) > factorial.h

   #-------------------------------------------------------------------------
   # factorial.i
   (
   cat <<'EOF'
   %module factorial
   %{
       #include "factorial.h"
   %}
   %include factorial.h
   EOF
   ) > factorial.i

   #-------------------------------------------------------------------------

   swig -tcl factorial.i
   gcc -c -fpic factorial.c factorial_wrap.c -I/usr/include/tcl8.4
   gcc -shared factorial.o factorial_wrap.o -o factorial.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
       load ./factorial.so
       puts [ fact 4 ]
   EOF

L'exécution donne:

   24

testvar.c

C'est exemple illustre le mécanisme de passage de variables entre C et TCL.

   #!/bin/sh

   rm testvar.* 2>/dev/null

   #-------------------------------------------------------------------------
   # testvar.c
   (
   cat <<'EOF'
   #include <stdio.h>
   #include "testvar.h"

   int    nombre       ;
   char * chaine       ;

   void print_vars (void) {
       printf("nombre  : %d\n", nombre   );
       printf("chaine  : %s\n", chaine   );
   }

   int * new_pointeur (void) {
       int * ptr ;
       ptr = &nombre;
       return ptr;
   }

   void get_pointeur ( int * ptr ) {
       printf("Addresse Pointeur             : %x\n", &ptr );
       printf("Addresse Pointee              : %x\n",  ptr );
       if ( ptr != 0 )
           printf("Contenue de l'addresse pointee: %x\n", *ptr );
   }

   void set_pointeur (int * ptr, int val) {
       *ptr = val;
   }

   int mul (int a, int b) {
       return a * b ;
   }

   EOF
   ) > testvar.c

   #-------------------------------------------------------------------------
   # testvar.h
   (
   cat <<'EOF'
   #define PI 3.14159
   #define carre(valeur) mul((valeur), (valeur))

   enum  {lun, mar, mer, jeu, ven};
   int    nombre   ;
   char * chaine   ;
   void   print_vars     (void);
   int  * new_pointeur   (void);
   void   get_pointeur   (int * ptr);
   void   set_pointeur   (int * ptr, int val);
   int    mul            (int a, int b);
   EOF
   ) > testvar.h

   #-------------------------------------------------------------------------
   # testvar.i
   (
   cat <<'EOF'
   %module testvar
   %{
       #include "testvar.h"

       int my_carre(int val) {
           return carre(val) ;
       }
   %}

   %rename(carre) my_carre;
   %include testvar.h
   int my_carre(int val);

   EOF
   ) > testvar.i

   #-------------------------------------------------------------------------

   swig -tcl testvar.i
   gcc -c -fpic testvar.c testvar_wrap.c -I/usr/include/tcl8.4
   gcc -shared testvar.o testvar_wrap.o -o testvar.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
       load ./testvar.so
       puts "Macros chaine  : $PI"
       puts "Macros fonction: [carre 9]"

       puts "Enum: $jeu"
       puts "-------------------------------"
       puts "print_vars"
       print_vars
       puts "------------------------------"
       set nombre 4
       puts $nombre
       set chaine "Initial value"
       puts $chaine
       puts "------------------------------"
       puts "print_vars"
       print_vars
       puts "------------------------------"
       get_pointeur NULL
       puts "------------------------------"
       set ptr [ new_pointeur ]
       puts $ptr
       get_pointeur $ptr
       puts "------------------------------"
       set_pointeur $ptr 6
       puts $ptr
       get_pointeur $ptr
   EOF

L'exécution donne:

   Macros chaine  : 3.14159
   Macros fonction: 81
   Enum: 3
   -------------------------------
   print_vars
   nombre  : 0
   chaine  : (null)
   ------------------------------
   4
   Initial value
   ------------------------------
   print_vars
   nombre  : 4
   chaine  : Initial value
   ------------------------------
   Addresse Pointeur             : bfbb28e0
   Addresse Pointee              : 0
   ------------------------------
   _08952cb7_p_int
   Addresse Pointeur             : bfbb28e0
   Addresse Pointee              : b72c9508
   Contenue de l'addresse pointee: 4
   ------------------------------
   _08952cb7_p_int
   Addresse Pointeur             : bfbb28e0
   Addresse Pointee              : b72c9508
   Contenue de l'addresse pointee: 6

SWIG transforme les macros C en variables chaines TCL pour les constantes.

Mais rien n'est prévu pour les macros C fonctions, si on veut les utiliser en TCL il faut les transformer en fonctions C classiques ( int my_carre(int val) %rename(carre) my_carre ).

Les enum C sont égalements converties en variables TCL, chaque membre de l'enum est associé à un nombre.

Les variables C int * et char * sont converties en variables TCL, et leurs modifications dans le script TCL modifie également leurs valeurs C.

Les pointeurs C sont converties en variables chaines TCL de la forme _08c537b7_p_int. La valeur hexa correspond à l'addresse pointée à l'envers.


typemap.c

Les typemaps, ils permettent d'intercepter les arguments et les valeurs de retour entre les fonctions C et leurs équivalents en TCL afin de les adapter.

Les trois typemaps les plus utilisés sont:

%typemap(in) pour les arguments des fonctions TCL -> C

%typemap(out) pour la valeur de retour des fonctions C -> TCL

%typemap(argout) pour les arguments passés comme valeurs de retour (pointeurs).

J'ai essayé de couvrir les cas les plus courrants.

   #!/bin/sh

   rm typemap.* 2>/dev/null

   #-------------------------------------------------------------------------
   # typemap.c
   (
   cat <<'EOF'

   int * get_int_ptr ( int nbr ) {
       static int n;
       n = nbr ;
       return &n;
   }

   int mul1 ( int n1, int n2 ) {
       return n1 * n2 ;
   }

   int mul2 ( int var1, int var2 ) {
       return var1 * var2 ;
   }

   int div2 ( int * a ) {
       return *a / 2 ;
   }

   void div4 ( int a, int *r) {
       *r = a / 4;
   }

   double * div3 ( int a ) {
       static double n;
       n = (double)a / 3;
       return &n ;
   }

   double * PI (void) {
       static double n ;
       n = 3.1415927 ;
       return &n ;
   }

   double div5 ( double * a ) {
      return *a / 5 ;
   }

   EOF
   ) > typemap.c

   #-------------------------------------------------------------------------
   # typemap.h
   (
   cat <<'EOF'
   int    * get_int_ptr ( int nbr )                   ;
   int      mul1        ( int n1, int n2)             ;
   int      mul2        ( int var1, int var2 )        ;
   int      div2        ( int * a )                   ;
   void     div4        ( int a, int * r)             ;
   double * div3        ( int a )                     ;
   double * PI          ( void )                      ;
   double   div5        ( double * a )                ;
   EOF
   ) > typemap.h

   #-------------------------------------------------------------------------
   # typemap.i
   (
   cat <<'EOF'
   %module typemap
   %{
       #include "typemap.h"
   %}

   /*--------------------------------- mul1 -------------------------------------*/
   /* Transforme 1 argument  TCL vers 2 arguments fonction C                     */

   %typemap(in) (int n1, int n2) {
      int value ;
      Tcl_GetIntFromObj(interp, $input, &value);
      $1 = value ;
      $2 = 10    ;
   }

   /*----------------------------------mul2--------------------------------------*/
   /* Intercepte les deux arguments d'une meme fonction                          */

   %typemap(in) int var1 {
       int value;
       Tcl_GetIntFromObj(interp, $input, &value);
       $1 = 10 * value;
   }

   %typemap(in) int var2 {
       int value;
       Tcl_GetIntFromObj(interp, $input, &value);
       $1 = 10 * value;
   }

   /*--------------------------------- div2 -------------------------------------*/
   /* Transforme une variable nombre TCL vers un pointeur int C                  */
   /*    On peut egalement utiliser des typemaps predefinis:                     */
   /*    %apply int * INPUT { int * a } ;                                        */

   %typemap(in) int * a {
      int value;
      int * ptr ;
      Tcl_GetIntFromObj(interp, $input, &value);
      $1 = &value ;
   }

   /*-------------------------------- div3 PI ------------------------------------*/
   /* Les fonctions C retournent un pointeur double, on le convertie en variable  */
   /* nombre TCL. Si la fonction C est PI on retourne un objet TCL pointeur.      */

   %typemap(out) double * {

       Tcl_Obj  * obj ;

       if ( strcmp("PI", "$symname") == 0 ) {
           obj =  SWIG_NewPointerObj($1, SWIGTYPE_p_double, 0);
           Tcl_SetObjResult(interp, obj);
       } else {
           Tcl_SetObjResult(interp,Tcl_NewDoubleObj( *$1 ) ) ;
       }
   }

   /*-------------------------------- div4 --------------------------------------*/
   /* void div4 ( int a, int * r)                                                */
   /*                                                                            */
   /* Ici la fonction C retourne sa valeur en initialisant un pointeur passé     */
   /* en arguments. Il faut deux typemaps un in pour passer de 1 arguments a 2   */
   /* arguments, et un argout pour convertir le pointeur en variable TCL nombre  */
   /* passe en valeur de retour                                                  */
   /* Typemap predefinie:                                                        */
   /*     %apply int * OUTPUT { int * r };                                       */

   %typemap(in) (int a, int * r) {
       int value  ;
       int retour ;

       Tcl_GetIntFromObj(interp, $input, &value);

       $1 = value   ;
       $2 = &retour ;
   }

   %typemap(argout) int * r {
       Tcl_SetObjResult(interp,Tcl_NewDoubleObj( *$1 ) ) ;
   }

   /*-------------------------------- div5 --------------------------------------*/
   /* double div5 ( double * a )                                                 */
   /*                                                                            */
   /* Casting de pointeur int vers double                                        */

   %typemap(in) double * a {
       int * ptr ;
       static double val ;

       SWIG_ConvertPtr($input, (void **) &ptr, $descriptor(int *), 0) ;
       val = (double) *ptr ;
       $1 = &val ;
   }

   /*----------------------------------------------------------------------------*/

   %include "typemap.h";

   EOF
   ) > typemap.i

   #-------------------------------------------------------------------------
   #
   swig -tcl typemap.i
   gcc -c -fpic typemap.c typemap_wrap.c -I /usr/include/tcl8.4
   gcc -shared typemap.o typemap_wrap.o -o typemap.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
   load typemap.so

   set n 8
   puts "nombre: $n"
   puts "mul1:  [ mul1  $n   ]"
   puts "mul2:  [ mul2  1 2  ]"
   puts "div2:  [ div2  $n   ]"
   puts "div4:  [ div4  $n   ]"
   puts "div3:  [ div3  $n   ]"
   puts "PI:    [ PI         ]"
   set   ptr    [ get_int_ptr $n ]
   puts "div5:  [ div5 $ptr ]"

   EOF

L'exécution donne:

   nombre: 8
   mul1:  80
   mul2:  200
   div2:  4
   div4:  2.0
   div3:  2.66666666667
   PI:    _981c31b7_p_double
   div5:  1.6

fonction.c

C'est exemple vient de la documentation de SWIG. Il montre comment passer des fonctions en argument. Le seul probléme c'est que les fonctions doivent être écrite en C.

Passer des fonctions en arguments et indispenssable pour écrire un binding GTK, ce sont les CALLBACKS. Si on ne peut pas les écrire en TCL, pas la peine d'aller plus loin.

Dans la doc de SWIG on peut lire:

And now, a final note about function pointer support. Although SWIG does not normally allow callback functions to be written in the target language, this can be accomplished with the use of typemaps and other advanced SWIG features. This is described in a later chapter.

Mais je n'ai jamais trouvé ce chapitre !!!!!

Pour passer une fonction en argument il faut obtenir l'addresse de cette fonction en mémoire, autrement dit un pointeur sur cette fonction. En C c'est facile c'est le nom de la fonction.

Mais une fonction écrite en TCL, à quoi ça ressemble en mémoire ? peut'on seulement avoir un pointeur sur cette fonction ?

   #!/bin/sh

   rm fonction.* 2>/dev/null

   #------------------------------------------------------------------------
   # fonction.c
   (
   cat <<'EOF'

   #include <stdio.h>

   int binary_op(int a, int b, int (*op)(int,int)) {
       return op(a, b);
   }

   int add (int a, int b) {
       return a + b ;
   }

   int mul (int a, int b) {
       return a * b ;
   }

   int main (void) {
       printf("%d\n", binary_op(2, 5, add));
       printf("%d\n", binary_op(2, 5, mul));
   }

   EOF
   ) > fonction.c

   #-------------------------------------------------------------------------
   # gcc -c fonction.c
   # gcc fonction.o
   # ./a.out
   # exit 0

   #-------------------------------------------------------------------------
   # fonction.i
   (
   cat <<'EOF'
   %module fonction
   %{
       int binary_op(int a, int b, int (*op)(int,int));
       int add(int a, int b);
       int mul(int a, int b);
   %}

   int binary_op(int a, int b, int (*op)(int,int));

   %constant int add(int a, int b);

   %callback("%s_cb") ;
       int mul(int a, int b) ;
   %nocallback ;

   EOF
   ) > fonction.i

   #-------------------------------------------------------------------------

   swig -tcl fonction.i
   gcc -c -fpic fonction.c fonction_wrap.c -I/usr/include/tcl8.4
   gcc -shared fonction.o fonction_wrap.o -o fonction.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
       load ./fonction.so

       proc tcl_add { a b } { return [expr $a + $b] }

       puts $add
       puts [ binary_op 8 9 $add ]

       puts [ mul 2 5 ]

       puts $mul_cb
       puts [ binary_op 8 9 $mul_cb ]

       puts [ binary_op 2 5 tcl_add ]
   EOF

L'exécution donne:

   _262f28b7_p_f_int_int__int
   17
   10
   _312f28b7_p_f_int_int__int
   72
   TypeError in method 'binary_op', argument 3 of type 'int (*)(int,int)'

callback.i

Ma solution pour exécuter des callbacks écrite en TCL dans une fonction C.

J'utilise la fonction C Tcl_Eval(_interp, script).

Bon la on ne vois pas trés bien le fonctionnement, mais le truc c'est d'utiliser comme callback une fonction écrite en C qui exécute la fonction callback TCL passé en argument sous forme de script.

Je ne suis pas sur que ce soit la bonne méthode, mais ça marche, et mon savoir ne me permet pas de faire mieux.

   #!/bin/sh

   rm callback.* 2>/dev/null

   #-------------------------------------------------------------------------
   # callback.i
   (
   cat <<'EOF'

   %module callback

   %{
       #include <tcl.h>
       Tcl_Interp * _interp;

       void set_interp ( Tcl_Interp * i ) {
           _interp = i ;
       }

       void run_callback ( char * script ) {
           Tcl_Eval(_interp, script);
       }

   %}

   %typemap(in) Tcl_Interp * i {
       $1 = interp;
   }

   void set_interp ( Tcl_Interp * i );
   void run_callback ( char * script );

   EOF
   ) > callback.i

   #-------------------------------------------------------------------------

   swig -tcl callback.i
   gcc -c -fpic callback_wrap.c -I/usr/include/tcl8.4
   gcc -shared callback_wrap.o -o callback.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
       load ./callback.so

       set_interp NULL
       proc callback {} { puts "Execute Tcl script in C fonction" }
       run_callback callback
   EOF

L'exécution done:

   Execute Tcl script in C fonction

tclgtk.i

Une fenêtre GTK contenant un bouton, qui appelle une fonction TCL.

C'est l'exemple le plus simple possible réalisable.

C'est le point de départ de mon binding, aprés ce n'est plus que du remplissage, pour chaque widget il suffit d'ajouter le fichier d'en-tête correspondant d'adapter les typemaps et les commandes SWIG.

   #!/bin/sh

   rm tclgtk.* 2>/dev/null

   #-------------------------------------------------------------------------------
   # tclgtk.i
   (
   cat <<'EOF'
   %module tclgtk
   %{
       #include <gtk/gtk.h>
       #include <tcl.h>

       Tcl_Interp * _interp;

       void set_interp ( Tcl_Interp * i ) {
           _interp = i ;
       }

       void my_callback(GtkWidget *widget, char * tcl_script) {
           const char * msg;

           if ( Tcl_Eval(_interp, tcl_script) == TCL_ERROR ) {
               msg = Tcl_GetStringResult(_interp);
               Tcl_Panic("\n%s\n while executing\n", msg);
           }
       }

       gulong tcl_signal_connect ( GtkWidget   * widget,
                                   const gchar * detailed_signal,
                                   char        * tcl_script) {
           char * ptr;
           ptr = (char *)malloc( strlen(tcl_script)+1 );
           strcpy(ptr, tcl_script);

           g_signal_connect (G_OBJECT (widget), detailed_signal, G_CALLBACK (my_callback), ptr);
       }

   %}

   /*---------------------------------------------------------------------------*/

   %typemap(in) GtkContainer * {
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget *), 0 ) != 0 ) {
           Tcl_SetResult(interp, "SWIG_ConvertPtr error: GtkContainer *", TCL_VOLATILE);
      	return TCL_ERROR;
       }
   }

   /*------------------------------------------------------------*/
   /* Permet d'initialiser le pointeur * interp automatiquement  */

   %typemap(out) void gtk_init {
       set_interp(interp);
   }

   /*-------------------------------------------*/
   %include "glib-object.h"
   %include "glib/gmacros.h"
   %include "gtk/gtkmain.h"
   %include "gtk/gtkenums.h"
   %include "gtk/gtkwindow.h"

   /*-------------------------------------------*/
   typedef char gchar;
   %include "gtk/gtkbutton.h"

   /*-------------------------------------------*/
   %ignore _gtk_container_clear_resize_widgets;
   %include "gtk/gtkcontainer.h"

   /*-------------------------------------------*/
   %include "gtk/gtkwidget.h"

   /*-------------------------------------------*/
   #define __GLIB_GOBJECT_H_INSIDE__  1
   #define   GOBJECT_COMPILATION      1
   %ignore _g_signals_destroy;
   %ignore _GSignalQuery;
   %include "gobject/gsignal.h"

   /*------------------------------------------*/

   gulong tcl_signal_connect(GtkWidget   * widget,
                             const gchar * detailed_signal,
                             char        * tcl_script);

   EOF
   ) > tclgtk.i

   #-------------------------------------------------------------------------
   swig -I/usr/include/gtk-2.0 -I/usr/include/glib-2.0 -tcl tclgtk.i
   gcc  -c -fpic tclgtk_wrap.c -I /usr/include/tcl8.4 \
        `pkg-config --cflags gtk+-2.0` `pkg-config --libs gtk+-2.0`
   gcc  -shared tclgtk_wrap.o -o tclgtk.so  -lgtk-x11-2.0
   #-------------------------------------------------------------------------

   tclsh <<'EOF'

       load ./tclgtk.so

       proc tcl_fonction {} {
           puts "Hello World"
       }

       gtk_init NULL NULL

       set window [ gtk_window_new $GTK_WINDOW_TOPLEVEL ]
       puts "window: $window"

       set button [ gtk_button_new_with_label "Hello World" ]
       puts "button: $button"

       gtk_container_add $window $button

       gtk_widget_show_all $window

       tcl_signal_connect $button "clicked" tcl_fonction

       gtk_main

   EOF

L'exécution donne:

   ...
   gcc: -ldl: linker input file unused because linking not done
   gcc: -lglib-2.0: linker input file unused because linking not done
   window: _48b81108_p_GtkWidget
   button: _90e51008_p_GtkWidget
   Hello World
   Hello World

Dans les exemples du tutorial de GTK, on utilise des fonctions macros pour effectuer le casting de pointeurs.

   /*This packs the button into the window (a gtk container). */
   gtk_container_add (GTK_CONTAINER (window), button);

En TCL je ne peut pas utiliser les fonctions macros C, je ne peut pas non plus faire du casting de pointeurs. En TCL les pointeurs sont transformés par SWIG en chaînes ( _48b81108_p_GtkWidget ). La doc de SWIG déconseille de s'amuser à modifier les pointeurs avec TCL. Pas de _48b81108_p_GtkWidget vers _48b81108_p_GtkContainer à l'aide de la commande TCL regsub.

La solution utiliser des typemaps:

   %typemap(in) GtkContainer * {
      if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget *), 0 ) != 0 ) {
          Tcl_SetResult(interp, "SWIG_ConvertPtr error: GtkContainer *", TCL_VOLATILE);
      return TCL_ERROR;
      }
   }

De plus ça marche que si le pointeur est du type GtkWidget. Si il est d'un autre type il faut rajouter autant de lignes qu'il y a de types.

   %typemap(in) GtkTextBuffer * {
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkSourceBuffer *), 0 ) != 0)
       if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkTextBuffer *), 0 ) != 0)
         if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget *)  , 0 ) != 0) {
	   Tcl_SetResult(interp, "SWIG_ConvertPtr error: GtkTextBuffer *", TCL_VOLATILE);
	   return TCL_ERROR;
         }
   }

Je trouve ça laid et peu pratique, mais je ne sais pas comment faire autrement.


GtkTextIter

Un GtkTextIter représente une position entre deux caractères dans un GtkTextBuffer.

Dans gtktextiter.h :

   typedef struct {
     /* GtkTextIter is an opaque datatype; ignore all these fields.
        Initialize the iter with gtk_text_buffer_get_iter_*
        functions */
   } GtkTextIter;

Seul probléme toutes les fonctions "gtk_text_buffer_get_iter_*" sont de la forme:

   void gtk_text_buffer_get_iter_at_line (GtkTextBuffer *buffer,
                                          GtkTextIter *iter,
                                          gint line_number);

Elles initialisent les itérateurs par des pointeurs passés en arguments. En C cela donne:

   GtkTextIter  iter;

   gtk_text_buffer_get_iter_at_line (buffer, &iter, 4);

Mais en TCL je ne peut pas créer une variable GtkTextIter vide. Il n'existe aucune fonction de prévue pour cela dans GTK2.

Une astuce qui marche est de créer une variable TCL sur une GtkFrame est de l'utiliser comme un itérateur. Bon mais ce n'est pas le top, de plus comme la frame occupe plus de place en mémoire qu'un itérateur on pert de la mémoire inutilement.

Autre soucis la durée de vie de l'itérateur ? En GTK2 tous les GtkObjects sont effacés de la mémoire aprés utilisation. Un mécanisme de compteur de références est utilisé, que l'on peut d'ailleur modifier avec les fonctions styles g_object_ref()...

Mais un GtkIterateur n'hérite pas de GtkObject, c'est tout bêtement une structure.

D'aprés la doc ils parlent d'un mécanisme de libération de la mémoire pour les itérateurs:

Iterators are not valid indefinitely; whenever the buffer is modified in a way that affects the number of characters in the buffer, all outstanding iterators become invalid. (Note that deleting 5 characters and then reinserting 5 still invalidates iterators, though you end up with the same number of characters you pass through a state with a different number).

Mais je n'y comprend rien. Et est ce que ce mécanisme marche si l'on crée l'itérateur soit même avec malloc() ?

Par chance il existe une fonction pour libérer les itérateurs:

   /**
     gtk_text_iter_free:
     @iter: a dynamically-allocated iterator

     Free an iterator allocated on the heap. This function
     is intended for use in language bindings, and is not
     especially useful for applications, because iterators can
     simply be allocated on the stack.  **/

   void
   gtk_text_iter_free (GtkTextIter *iter)
   {
     g_return_if_fail (iter != NULL);

     g_slice_free (GtkTextIter, iter);
   }

Par sécurité donc chaque fois que j'utilise un itérateur en TCL, je le détruit avec gtk_text_iter_free aprés utilisation.

Voici l'exemple qui m'a servie a mettre tout cela au point. J'ai rajouter une fonction gtk_text_iter_new() pour créer les itérateurs.

Por tester mes programmes, un outil pour visualiser la mémoire pendant l'exécution m'interesse. Comme je débute en C je ne sais si ça existe sous Linux. Si quelqu'un peut me conseiller. Je pense que sous Windows dans les gros outils de développements pour les pros ça doit étre intégrés.

Mais moi je cherche un truc tout simple et si possible qui marche en ligne de commande, pour pouvoir l'utiliser dans des scripts et des makefiles.

   #!/bin/sh

   #rm tclgtk.* 2>/dev/null

   #-------------------------------------------------------------------------------
   # tclgtk.i
   (
   cat <<'EOF'
   %module tclgtk
   %{
       #include <gtk/gtk.h>
       #include <tcl.h>

       Tcl_Interp * interp;

       void set_interp ( Tcl_Interp * i ) {
           interp = i ;
           printf("GtkFrame    size: %d\n", sizeof(GtkFrame));
           printf("GtkTextIter size: %d\n", sizeof(GtkTextIter));
       }

       /*-----------------------------------------------------------------------------------*/

       void my_signal_swapped_callback(char * tcl_script) {
           char * ptr;
           const char * msg;

           ptr = (char *)malloc( strlen(tcl_script)+1 );
           strcpy(ptr, tcl_script);

   	if ( Tcl_Eval(interp, ptr) == TCL_ERROR ) {
   	  msg = Tcl_GetStringResult(interp);
   	  Tcl_Panic("\n%s\n    while executing\n%s\n", msg, tcl_script);
           }
       }

       /*-----------------------------------------------------------------------------------*/

       gulong tcl_signal_connect_swapped ( GtkWidget   * widget,
                                           const gchar * detailed_signal,
                                           char        * tcl_script) {
           static char * ptr;
           ptr = (char *)malloc( strlen(tcl_script)+1 );
           strcpy(ptr, tcl_script);

           return g_signal_connect_swapped (G_OBJECT (widget), detailed_signal,
                                            G_CALLBACK (my_signal_swapped_callback),
                                            ptr);
       }

       /*-----------------------------------------------------------------------------------*/

       GtkTextIter * gtk_text_iter_new ( void ) {
          GtkTextIter *iter;
          iter = malloc(sizeof(GtkTextIter));
          return iter;
       }
   %}

   /*---------------------------------------------------------------------------------------*/

   %typemap(in) GtkContainer * {
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget *), 0 ) != 0 ) {
           Tcl_SetResult(interp, "SWIG_ConvertPtr error: GtkContainer *", TCL_VOLATILE);
      	return TCL_ERROR;
       }
   }

   %apply GtkContainer * { GtkWindow   * ,
                           GtkTextView * };

   %typemap(in) gint {
       int value;
       if (Tcl_GetIntFromObj(interp, $input, &value) == TCL_ERROR)
         return TCL_ERROR;
       $1 = (gint)value;
   }

   %typemap(in) gboolean {
       int value;
       if (Tcl_GetIntFromObj(interp, $input, &value) == TCL_ERROR)
         return TCL_ERROR;
       $1 = (gboolean)value;
   }

   %typemap(out) void gtk_init {
       set_interp(interp);
   }

   /*-------------------------------------------*/
   %include "glib-object.h"
   %include "glib/gmacros.h"
   %include "gtk/gtkmain.h"
   %include "gtk/gtkenums.h"
   %include "gtk/gtkwindow.h"

   /*-------------------------------------------*/
   %ignore _gtk_container_clear_resize_widgets;
   %include "gtk/gtkcontainer.h"

   /*-------------------------------------------*/
   %include "gtk/gtkwidget.h"

   /*-------------------------------------------*/
   #define __GLIB_GOBJECT_H_INSIDE__  1
   #define   GOBJECT_COMPILATION      1
   %ignore _g_signals_destroy;
   %ignore _GSignalQuery;
   %include "gobject/gsignal.h"

   /*-------------------------------------------*/
   %include "gtk/gtktextview.h"
   %include "gtk/gtktextbuffer.h"
   %include "gtk/gtktextiter.h"

   typedef char gchar;

   gulong tcl_signal_connect_swapped ( GtkWidget   * widget,
                                       const gchar * detailed_signal,
                                       char        * tcl_script);

   GtkTextIter * gtk_text_iter_new ( void );

   EOF
   ) > tclgtk.i

   #-------------------------------------------------------------------------
   #swig -I/usr/include/gtk-2.0 -I/usr/include/glib-2.0 -tcl tclgtk.i
   #gcc  -c -fpic tclgtk_wrap.c -I /usr/include/tcl8.4 \
   #     `pkg-config --cflags gtk+-2.0` `pkg-config --libs gtk+-2.0`
   #gcc  -shared tclgtk_wrap.o -o tclgtk.so  -lgtk-x11-2.0
   #-------------------------------------------------------------------------

   (
   cat <<'EOF'

       load ./tclgtk.so

       proc callback {} {
           global buffer

           set start [ gtk_text_iter_new ]
           set end   [ gtk_text_iter_new ]

           puts "$start $end"

           gtk_text_buffer_get_bounds $buffer $start $end
           puts [ gtk_text_buffer_get_text $buffer $start $end 0 ]

           gtk_text_iter_free $start
           gtk_text_iter_free $end
       }

       gtk_init NULL NULL

       set window [ gtk_window_new $GTK_WINDOW_TOPLEVEL ]
       gtk_window_set_default_size $window 400 300

       set buffer [ gtk_text_buffer_new NULL ]
       set view   [ gtk_text_view_new ]

       gtk_text_view_set_buffer $view $buffer
       gtk_container_add $window $view

       gtk_widget_show_all $window

       tcl_signal_connect_swapped $view "button-press-event" "callback"

       gtk_main

   EOF
   ) | tclsh

L'exécution donne:

   GtkFrame    size: 104
   GtkTextIter size: 56
   _18d61408_p_GtkTextIter _b06e1908_p_GtkTextIter

Nombre d'arguments variables

Gtk2 utilise beaucoup de fonctions avec un nombre d'arguments variables comme:

   GtkTextTag* gtk_text_buffer_create_tag ( GtkTextBuffer *buffer,
                                            const gchar   *tag_name,
                                            const gchar   *first_property_name,
                                            ...)

En C cela donne

   tag = gtk_text_buffer_create_tag (buffer, "blue_foreground", "foreground", "blue", NULL);

Un pointeur NULL marque la fin des arguments.

SWIG fournie la commande %varargs qui s'utilise comme suit:

   %varargs(10, const gchar *first_property_name = NULL) gtk_text_buffer_create_tag ;

En fait SWIG remplace la fonction avec un nombre d'arguments variables par une fonction wraper avec un nombre d'arguments fixes ici 10, initialisés par défault à NULL.

Seul probléme tous les arguments doivent être du même type. Dans la doc de SWIG on lit:

Argument replacement is not as useful when working with functions that accept mixed argument types such as printf(). Providing general purpose wrappers to such functions presents special problems (covered shortly).

La solution:

One way to do this is to use a special purpose library such as libffi (http://sources.redhat.com/libffi). libffi is a library that allows you to dynamically construct call-stacks and invoke procedures in a relatively platform independent manner. Details about the library can be found in the libffi distribution and are not repeated here.

Bon mais là je ne suis pas assez fort en C, je n'y comprend rien.

Apparemment ils utilisent une structure contenant une union pour convertir les arguments, et tout un tas de macros.

Restons à mon niveau voici un petit exemple trés simple qui montre l'utilisation de %varargs.

   #!/bin/sh

   rm test.* 2>/dev/null

   #-------------------------------------------------------------------------
   # test.c
   (
   cat <<'EOF'
   #include <stdio.h>
   #include <stdarg.h>

   int somme ( int * nbr, ... ) {

      int total = *nbr;
      int * val;
      va_list arg_ptr;

      va_start(arg_ptr, nbr);

      while (1) {
         val = va_arg(arg_ptr, int *);
         if ( val == NULL ) { break; }
         total += *val;
      }

      va_end(arg_ptr);
      return total;
   }
   EOF
   ) > test.c

   #-------------------------------------------------------------------------
   # test.h
   (
   cat <<'EOF'
   int somme ( int * nbr, ...);
   EOF
   ) > test.h

   #-------------------------------------------------------------------------
   # test.i
   (
   cat <<'EOF'
   %module test

   %{
      #include "test.h"
   %}

   %typemap(in) int * {
      int value;
      if (Tcl_GetIntFromObj(interp, $input, &value) == TCL_ERROR)
         return TCL_ERROR;
      $1 = &value;
   }

   %varargs(10, int * nbr = NULL) somme ;

   %include "test.h";

   EOF
   ) > test.i

   #-------------------------------------------------------------------------
   #
   swig -tcl test.i
   gcc -c -fpic test.c test_wrap.c -I /usr/include/tcl8.4
   gcc -shared test.o test_wrap.o -o test.so

   #-------------------------------------------------------------------------
   (
   cat <<'EOF'
   load test.so

   set a 1
   set b 2
   set c 3
   puts [ somme $a $b $c ]

   EOF
   ) | tclsh

GValue

Chaques widgets Gtk2 posédent des propriétées, pour le GtkToobar par exemple:

   Properties

     "orientation"          GtkOrientation        : Read / Write
     "show-arrow"           gboolean              : Read / Write
     "toolbar-style"        GtkToolbarStyle       : Read / Write
     "tooltips"             gboolean              : Read / Write

   Child Properties

     "expand"               gboolean              : Read / Write
     "homogeneous"          gboolean              : Read / Write

Et en plus ils héritent de toutes celles de leurs parents.

Ces propriétées sont modifiables par des fonctions du style de:

   void  g_object_get  (gpointer    object,
                        const gchar *first_property_name,
                        ...);

Ces fonctions ont un nombre d'arguments variables d'un type différent. Elles ne sont donc pas utilisables directement avec SWIG.

Heureusement il existe toutes une serie de fonctions qui font à peu prés la même chose :

   void g_object_set_property (GObject      *object,
                               const gchar  *property_name,
                               const GValue *value);

Dans gvalue.h :

   struct _GValue
   {
     /*< private >*/
     GType		g_type;

     /* public for GTypeValueTable methods */
     union {
       gint	v_int;
       guint	v_uint;
       glong	v_long;
       gulong	v_ulong;
       gint64      v_int64;
       guint64     v_uint64;
       gfloat	v_float;
       gdouble	v_double;
       gpointer	v_pointer;
     } data[2];
   };

C'est une structure qui contient une variable d'identification de type et une union.

Dans la doc de Gtk2 un exemple en C :

   GValue a = {0};
   g_value_init (&a, G_TYPE_INT);
   g_value_set_int (&a, 42);

Pour pouvoir utiliser les GValue en TCL je crée la fonction:

GValue * gvalue_new ( char * type, int setting )

elle renvoie un nouveau pointeur vers une GValue et l'initialise en même temps.

L'exemple suivant montre une GtkToolbar contenant un GtkToolButton et une GtkComboBoxEntry.

Les propriétées "border-width" du GtkToolButton et "expand" du GtkComboBoxEntry sont modifiées.

Penser à libérer la mémoire aprés utilisation avec "g_value_unset $gvalue".

   #!/bin/sh

   #rm test.* 2>/dev/null

   #-------------------------------------------------------------------------------
   # test.i
   (
   cat <<'EOF'
   %module test
   %{
       #include <gtk/gtk.h>
       #include <tcl.h>

       GValue * gvalue_new ( char * type, char * setting ) {
          GValue   * value;
          int        nbr;

          value = calloc(1, sizeof(GValue));

          if ( strcmp(type, "gint"    ) == 0 ) {
             g_value_init(value, G_TYPE_INT);
             nbr = atoi( (char *) setting );
             g_value_set_int (value, nbr);
          }

          if ( strcmp(type, "gboolean") == 0 ) {
             g_value_init(value, G_TYPE_BOOLEAN);
             nbr =  atoi( (char *) setting);
             g_value_set_boolean (value, nbr);
          }

          if ( strcmp(type, "string") == 0 ) {
             g_value_init (value, G_TYPE_STRING);
             g_value_set_string(value, setting);
          }

          return value;
       }
   %}

   /*---------------------------------------------------------------------------------------*/

   %typemap(in) GtkContainer * {
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkContainer *), 0 ) != 0 )
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget    *), 0 ) != 0 )
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkToolbar   *), 0 ) != 0 )
       if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkToolItem  *), 0 ) != 0 ) {
           Tcl_SetResult(interp, "SWIG_ConvertPtr error: GtkContainer *", TCL_VOLATILE);
      	return TCL_ERROR;
       }
   }

   %apply GtkContainer * { GtkWindow   * ,
                           GtkTextView * ,
                           GtkToolbar  * ,
                           GtkBox      * ,
                           GtkWidget   * ,
                           gpointer      ,
                           GObject     * };

   %apply char       * { gchar  * };
   %apply int          { gint     };
   %apply unsigned int { guint    };
   %apply int          { gboolean };

   /*-------------------------------------------*/
   %include "glib-object.h"
   %include "glib/gmacros.h"
   %include "gtk/gtkmain.h"
   %include "gtk/gtkenums.h"
   %include "gtk/gtkwindow.h"

   /*-------------------------------------------*/
   %ignore _gtk_container_clear_resize_widgets;
   %include "gtk/gtkcontainer.h"

   /*-------------------------------------------*/
   %include "gtk/gtkwidget.h"
   %include "gtk/gtkbox.h"
   %include "gtk/gtkvbox.h"

   /*-------------------------------------------*/
   %include "gtk/gtktoolbar.h"
   %include "gtk/gtktoolitem.h"
   %include "gtk/gtktoolbutton.h"
   %include "gtk/gtkcomboboxentry.h"

   /*-------------------------------------------*/
   #define __GLIB_GOBJECT_H_INSIDE__  1
   #define   GOBJECT_COMPILATION      1

   %include "gtk/gtkobject.h"
   %include "gobject/gobject.h"
   %include "gobject/gvalue.h"
   %include "gobject/gvaluetypes.h"

   /*-------------------------------------------*/

   GValue * gvalue_new ( char * type, char * setting );

   EOF
   ) > test.i

   #-------------------------------------------------------------------------
   swig -I/usr/include/gtk-2.0 -I/usr/include/glib-2.0 -tcl test.i
   gcc  -c -fpic test_wrap.c -I /usr/include/tcl8.4 \
        `pkg-config --cflags gtk+-2.0` `pkg-config --libs gtk+-2.0`
   gcc  -shared test_wrap.o -o test.so  -lgtk-x11-2.0
   ##-------------------------------------------------------------------------

   tclsh <<'EOF'
       load test.so

       gtk_init NULL NULL

       set window [ gtk_window_new $GTK_WINDOW_TOPLEVEL ]
       gtk_window_set_default_size $window 400 300

       set box [ gtk_vbox_new 0 0 ]
       gtk_container_add $window $box

       set bar [ gtk_toolbar_new ]
       gtk_box_pack_start $box $bar 0 0 0

       set item [ gtk_tool_button_new NULL "" ]

       set gvalue [ gvalue_new "string" "Hello World" ];
       g_object_set_property $item "label" $gvalue

       gtk_toolbar_insert $bar $item 0

       set gvalue [ gvalue_new "gint" "5" ]

       g_object_set_property $item "border-width" $gvalue
       puts [ g_strdup_value_contents $gvalue ]
       puts [ g_value_get_int $gvalue ]
       g_value_unset $gvalue

       set item  [ gtk_tool_item_new ]
       set entry [ gtk_combo_box_entry_new ]

       gtk_container_add $item $entry
       gtk_toolbar_insert $bar $item 1

       set gvalue [ gvalue_new "gboolean" "1" ]
       gtk_container_child_set_property $bar $item "expand" $gvalue
       puts [ g_strdup_value_contents $gvalue ]
       puts [ g_value_get_boolean $gvalue ]
       g_value_unset $gvalue

       gtk_widget_show_all $window

       gtk_main
   EOF

   exit 0

L'exécution donne:

   5
   5
   TRUE
   1

Typemap réduction

Pour tout widget GTK2 j'ai écrit le typemap(in):

   %typemap(in) _GtkWidget * {
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkSourceBuffer *), 0) != 0)
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkTextBuffer   *), 0) != 0)
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkTextIter     *), 0) != 0)
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkToolButton   *), 0) != 0)
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkToolItem     *), 0) != 0)
     if (SWIG_ConvertPtr($input, (void **) &$1, $descriptor(GtkWidget       *), 0) != 0) {
       Tcl_SetResult(interp, "%typemap(in) GtkWidget * error: $symname", TCL_VOLATILE);
       printf("Typemap input: %s", Tcl_GetString($input));
       return TCL_ERROR;
     }
   }

Dans la doc de SWIG on lit:

Since the code supplied to a typemap is inlined directly into wrapper functions, typemaps can result in a tremendous amount of code bloat.

If you had a large interface with hundreds of functions all accepting array parameters, this typemap would be replicated repeatedly--generating a huge amount of code. A better approach might be to consolidate some of the typemap into a function.

C'est exactement mon cas. Pour chaque fonction de GTK2 le même code du typemap est répété autant de fois. En utilisant une telle fonction j'ai réduit la taille de "tclgtk.so" de 2,8 Mo à 2.3 Mo.

L'exemple suivant ma servie à mettre au point cette fonction:

   #!/bin/sh

   rm test.* 2>/dev/null

   #-------------------------------------------------------------------------
   # test.c
   (
   cat <<'EOF'
   #include <stdio.h>
   #include "test.h"

   int * get_int_ptr ( int nbr ) {
       static int n;
       n = nbr ;
       printf("n:    %x %x\n", &n, n);
       return &n;
   }

   machin * get_machin_ptr ( int nbr ) {
       static machin n;
       n = (machin)nbr ;
       printf("n:    %x %x\n", &n, n);
       return &n;
   }

   bidule * get_bidule_ptr ( int nbr ) {
       static bidule n;
       n = (bidule)nbr ;
       printf("n:    %x %x\n", &n, n);
       return &n;
   }

   int mul2 ( int * a ) {
      return *a * 2 ;
   }

   EOF
   ) > test.c

   #-------------------------------------------------------------------------
   # test.h
   (
   cat <<'EOF'

   typedef int machin;
   typedef int bidule;

   int    * get_int_ptr    ( int nbr );
   machin * get_machin_ptr ( int nbr );
   bidule * get_bidule_ptr ( int nbr );

   int mul2 ( int * a ) ;

   EOF
   ) > test.h

   #-------------------------------------------------------------------------
   # test.i
   (
   cat <<'EOF'
   %module test
   %{
      #include "test.h"

      Tcl_Interp * interp;

      void set_interp ( Tcl_Interp * i ) {
         interp = i ;
      }

      /*--------------------------------------------------------------------------------*/
      /*                           typemap function                                     */

      int * typemap_in_int_p_function ( Tcl_Obj *input) {

         void * ptr;

         if ( SWIG_ConvertPtr(input, (void **) &ptr, SWIGTYPE_p_machin, 0 ) != 0 )
         if ( SWIG_ConvertPtr(input, (void **) &ptr, SWIGTYPE_p_bidule, 0 ) != 0 )
         if ( SWIG_ConvertPtr(input, (void **) &ptr, SWIGTYPE_p_int   , 0 ) != 0 ) {
            printf("Error typemap(in) int * a : %s\n", Tcl_GetString(input));
         }

         printf("ptr:  %x %x \n", &ptr, ptr );

         return ptr;
      }
      /*---------------------------------------------------------------------------------*/
   %}

   %typemap(in) Tcl_Interp * i {
      $1 = interp;
   }

   /*--------------------------------------------------------------------------------*/
   /*                        Typemap into a function.                                */

   %typemap(in) int * a {

      printf("$1: %x %x\n", &$1, $1);
      $1 = typemap_in_int_p_function($input);
      printf("$1: %x %x %x\n", &$1, $1, *$1);
   }

   /*-------------------------------------------------------------------------------*/
   /*                           Normal Typemap                                      */

   %typemap(in) _int * a {

      if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(machin *), 0 ) != 0 )
      if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(bidule *), 0 ) != 0 )
      if ( SWIG_ConvertPtr($input, (void **) &$1, $descriptor(int    *), 0 ) != 0 ) {
         Tcl_SetResult(interp, "%typemap(in) error: $symname", TCL_VOLATILE);
         printf("Typemap input: %s", Tcl_GetString($input));
         return TCL_ERROR;
      }
   }

   /*-------------------------------------------------------------------------------*/

   int    * get_int_ptr    ( int nbr )    ;
   machin * get_machin_ptr ( int nbr )    ;
   bidule * get_bidule_ptr ( int nbr )    ;

   int mul2 ( int * a ) ;

   void set_interp ( Tcl_Interp * i );

   EOF
   ) > test.i

   #----------------------------------------------------------------------------------
   #
   swig -tcl test.i
   gcc -c -fpic test.c test_wrap.c -I /usr/include/tcl8.4
   gcc -shared test.o test_wrap.o -o test.so

   #----------------------------------------------------------------------------------

   tclsh <<'EOF'
      load test.so

      set ptr [ get_int_ptr 1 ]
      puts "tcl: $ptr"
      puts [ mul2 $ptr ]

      set ptr [ get_machin_ptr 2 ]
      puts "tcl: $ptr"
      puts [ mul2 $ptr ]

      set ptr [ get_bidule_ptr 3 ]
      puts "tcl: $ptr"
      puts [ mul2 $ptr ]

   EOF

L'exécution donne:

   n:    b7326d44 1
   tcl: _446d32b7_p_int
   arg1: bf98fedc 0
   ptr:  bf98fea0 b7326d44
   arg1: bf98fedc b7326d44 1
   2
   n:    b7326d48 2
   tcl: _486d32b7_p_machin
   arg1: bf98fedc 0
   ptr:  bf98fea0 b7326d48
   arg1: bf98fedc b7326d48 2
   4
   n:    b7326d4c 3
   tcl: _4c6d32b7_p_bidule
   arg1: bf98fedc 0
   ptr:  bf98fea0 b7326d4c
   arg1: bf98fedc b7326d4c 3
   6

Structures et Arrays

Par Arrays j'entend les tableaux en C et pas les Arrays du langage TCL qui sont des dictionnaires comme dans Python ou des tables de hachages comme dans Perl.

Les Arrays C correspondent plutot aux listes de TCL. Comme je suis nul en anglais je ne saisi pas trés bien la nuance dans la documention de SWIG. Quoi qu'il en soit ici quand je parle de Arrays ce sont les tableaux du langage C.

En GTK2 un GtkWidget est un pointeur vers une structure:

   typedef struct {
     /* The style for the widget. The style contains the
      *  colors the widget should be drawn in for each state
      *  along with graphics contexts used to draw with and
      *  the font to use for text.
      */
     GtkStyle *style;

     /* The widget's desired size.
      */
     GtkRequisition requisition;

     /* The widget's allocated size.
      */
     GtkAllocation allocation;

     /* The widget's window or its parent window if it does
      *  not have a window. (Which will be indicated by the
      *  GTK_NO_WINDOW flag being set).
      */
     GdkWindow *window;

     /* The widget's parent.
      */
     GtkWidget *parent;
   } GtkWidget;

Cette structure contient entre autre un membre *style, qui n'est lui même rien d'autre qu'un autre pointeur vers une structure:

   typedef struct {
     GdkColor fg[5];
     GdkColor bg[5];
     GdkColor light[5];
     GdkColor dark[5];
     GdkColor mid[5];
     GdkColor text[5];
     GdkColor base[5];
     GdkColor text_aa[5];		/* Halfway between text/base */

     GdkColor black;
     GdkColor white;
     PangoFontDescription *font_desc;

     gint xthickness;
     gint ythickness;

     GdkGC *fg_gc[5];
     GdkGC *bg_gc[5];
     GdkGC *light_gc[5];
     GdkGC *dark_gc[5];
     GdkGC *mid_gc[5];
     GdkGC *text_gc[5];
     GdkGC *base_gc[5];
     GdkGC *text_aa_gc[5];
     GdkGC *black_gc;
     GdkGC *white_gc;

     GdkPixmap *bg_pixmap[5];
   } GtkStyle;

Cette structure GtkStyle définit l'apparence du widget, couleurs, fontes ...

Elle contient un membre "GdkColor base", une array de 5 GdkColor, qui pour le widget GtkText correspond aux couleurs de fond respectivement NORMAL, ACTIVE, PRELIGHT, SELECTED, INSENSITIVE.

Et un GdkColor n'est bien sur rien d'autre qu'une structure:

   typedef struct {
     guint32 pixel;
     guint16 red;
     guint16 green;
     guint16 blue;
   } GdkColor;

Maintenant vous désirez afficher la valeur de la couleur rouge du fond INSENSITIVE d'un GtkTexView. En C rien de plus simple:

   view = gtk_text_view_new();
   ...
   printf("red: %d\n", view->style->base[GTK_STATE_INSENSITIVE].red);

Mais en TCL ?

Pour les structures SWIG crée automatiquement des fonctions wrapers pour accéder aux membres, ici ça donne:

   set style [ $view  cget -style ]
   set base  [ $style cget -base  ]

Mais la la variable $base n'est pas une liste TCL de 5 GdkColor, mais une chaine TCL représentant un pointeur sur le premier élément de l'array ( _445FG43_p_GdkColor_). Dans la doc de SWIG:

Arrays are fully supported by SWIG, but they are always handled as pointers instead of mapping them to a special array object or list in the target language. Like C, SWIG does not perform array bounds checking. It is up to the user to make sure the pointer points a suitably allocated region of memory.

La solution: SWIG founie une librairie de fonctions pour manipuler les arrays. Elle est dans /usr/share/swig1.3/typemaps/carrays.swg

   // Dans interface..i
   %include carrays.i
   %array_functions(GdkColor, gdk_color_array);

Ensuite dans le script TCL on a les fonctions:

   ...
   set colors [ new_gdk_color_array 5 ]
   ...
   set item   [ gdk_color_array_getitem $color 2 ]
   ...
   gdk_color_array_setitem $color 3 $item
   ...
   delete_gdk_color_array $color
   ...

De même pour manipuler les pointeurs on a la librairie cpointer.i

   // Dans interface.i
   %include cpointer.i
   %pointer_functions(int, int_ptr);

Ensuite dans le script TCL:

   ...
   set nbr [ new_int_ptr ]
   ...
   int_ptr_assign $nbr 10
   ...
   puts [ int_ptr_value $nbr ]
   ...
   delete_int_ptr $nbr
   ...

Ci dessous un petit exemple avec des structures et une array:

   #!/bin/sh

   # rm test.* 2>/dev/null

   #-------------------------------------------------------------------------
   # test.c
   (
   cat <<'EOF'
   #include <stdio.h>
   #include <stdlib.h>
   #include "test.h"

   vigne * vigne_new (void) {
      distances * ptr1;
      vigne     * ptr2;
      char      * n = "Las Figueres";

      ptr1 = malloc( sizeof(distances) );
      ptr1->rang  = 110;
      ptr1->inter = 250;

      ptr2 = malloc( sizeof(vigne) );
      ptr2->nom = n;
      ptr2->aire = 15278;
      ptr2->dist = ptr1;

      ptr2->base[0] = 100;
      ptr2->base[1] = 200;
      ptr2->base[2] = 300;

      return ptr2;
   }

   EOF
   ) > test.c

   #-------------------------------------------------------------------------
   # test.h
   (
   cat <<'EOF'

   typedef struct {
      int rang;
      int inter;
   } distances;

   typedef struct {
      char       * nom;
      int         aire;
      distances  * dist;
      int          base[3];
   } vigne;

   vigne * vigne_new (void);

   EOF
   ) > test.h

   #-------------------------------------------------------------------------
   # test.i
   (
   cat <<'EOF'

   %module test

   %{
      #include "test.h"
   %}

   %include cpointer.i
   %pointer_functions(int, intp);

   %include carrays.i
   %array_functions(int, inta);

   %include "test.h"

   EOF
   ) > test.i

   #-------------------------------------------------------------------------

   swig -tcl test.i
   gcc -c -fpic test.c test_wrap.c -I/usr/include/tcl8.4
   gcc -shared test.o test_wrap.o -o test.so

   #-------------------------------------------------------------------------

   tclsh <<'EOF'
       load ./test.so

       set v [vigne_new]

       puts $v
       puts [ $v cget -this ]
       puts [ $v cget -nom ]
       puts [ [ $v cget -dist ] cget -rang ]

       $v configure -aire 5555
       puts [ $v cget -aire ]

       set b0 [ $v cget -base ]

       puts $b0
       puts [ intp_value $b0 ]

       puts [ inta_getitem $b0 0 ]
       puts [ inta_getitem $b0 1 ]
       puts [ inta_getitem $b0 2 ]

   EOF

L'exécution donne:

   _10b30708_p_vigne
   _10b30708_p_vigne
   Las Figueres
   110
   5555
   _1cb30708_p_int
   100
   100
   200
   300