Re: Functions from guile-gtk

[Martin Baulig]

Rob Browning <address@hidden> writes:

> Daniel Skarda <address@hidden> writes:
> 
> >      mylib_func (this, and, that, MYLIB_FOO_MASK | MYLIB_BAR_MASK);
> >      mylib_another_func (something, MYLIB_FOOBAR);
> > 
> >   Scheme:
> > 
> >      (mylib-func this and that '(foo bar))
> >      (mylib-another-func something 'foo)
> 
> Hmm, so is it also possible to get the integer values at the Scheme
> level for the various enumeration symbol translations?  And can a
> function like mylib-func also accept an integer as well as a symbol?

Hello,

well, for my GObject bindings, I'm using a more type-safe approach on
the scheme side.

In GNOME 2, there's a C type called GValue which can hold almost any
value - integers, strings, enums etc.

For instance, in C you define a new enum type like this:

====
    typedef TYPE_FOO (foo_get_type ())

    typedef enum {
        FOO_HELLO,
        FOO_TEST,
        FOO_BAR
    } Foo;

    static GEnumValue foo_values[] = {
        { FOO_HELLO, "a", "Hello" },
        { FOO_TEST,  "b", "Test" },
        { FOO_BAR,   "c", "Bar" },
        { 0, NULL, NULL }
    };

    GType G_GNUC_CONST /* GType is an integer number */
    foo_get_type (void)
    {
        static GType foo_type = 0;

        if (!foo_type)
            foo_type = g_enum_register_static ("foo", foo_values);

        return foo_type;
    }
====

Now you can use the new type `TYPE_FOO' wherever you like, for instance
in signal handlers, object parameters etc.

Let's assume you have a small C function like this:

====
    Foo
    test_foo (Foo value)
    {
        g_message (G_STRLOC ": %d", value);

        return value + 1;
    }
====

On the C side, you can easily convert the `Foo' enum into a GValue:

====
    GValue value = { 0, };
    Foo bar;

    g_value_init (&value, TYPE_FOO);
    g_value_set_enum (&value, FOO_HELLO);
    do_something_with_it (&value);
    bar = g_value_get_enum (&value);
    g_value_unset (&value);
====

If we use this for the scheme wrapper, things get really very easy.

First of all, I'm using a new smob type `gtype-instance' for all enums,
flags, etc. - basically for everything which can fit into a GValue:

====
typedef struct {
    GType type;
    SCM scm_type;
    gpointer data;
} GuileGTypeInstance;

scm_tc16_gtype_instance = scm_make_smob_type ("gtype-instance", 0);
scm_set_smob_mark (scm_tc16_gtype_instance, scm_gtype_instance_mark);
scm_set_smob_free (scm_tc16_gtype_instance, scm_gtype_instance_free);
scm_set_smob_print (scm_tc16_gtype_instance, scm_gtype_instance_print);

static int
scm_gtype_instance_print (SCM smob, SCM port, scm_print_state *pstate)
{
    GuileGTypeInstance *instance = (GuileGTypeInstance *) SCM_SMOB_DATA (smob);
    SCM class_name, class;

    class_name = scm_gtype_to_class_name (instance->scm_type);
    class = SCM_VARIABLE_REF (scm_lookup (class_name));
    /* This is implemented in scheme. */
    scm_call_3 (scm_sym_write_instance, class, smob, port);
    return 1;
}

SCM_DEFINE (scm_sys_gtype_create_basic_instance, 
"%gtype-create-basic-instance", 1, 0, 0,
            (SCM type),
            "")
#define FUNC_NAME s_scm_sys_gtype_create_basic_instance
{
    GuileGTypeInstance *instance;
    GValue *gvalue;
    GType gtype;

    SCM_ASSERT (SCM_IS_A_P (type, scm_class_gtype),
                type, SCM_ARG1, FUNC_NAME);

    gtype = (GType) SCM_SLOT (type, scm_si_gtype);

    gvalue = g_new0 (GValue, 1);
    g_value_init (gvalue, gtype);

    instance = scm_must_malloc (sizeof (GuileGTypeInstance), FUNC_NAME);
    instance->scm_type = type;
    instance->type = gtype;
    instance->data = gvalue;

    SCM_RETURN_NEWSMOB (scm_tc16_gtype_instance, instance);
}
#undef FUNC_NAME
====

Now, to wrap an enum type, I have the following:

====
SCM_DEFINE (scm_sys_gvalue_set_enum, "%gvalue-set-enum", 2, 0, 0,
            (SCM instance, SCM value),
            "")
#define FUNC_NAME s_scm_sys_gvalue_set_enum
{
    GuileGTypeInstance *ginstance;
    GEnumClass *enum_class;

    SCM_ASSERT (SCM_TYP16_PREDICATE (scm_tc16_gtype_instance, instance),
                instance, SCM_ARG1, FUNC_NAME);

    ginstance = (GuileGTypeInstance *) SCM_SMOB_DATA (instance);
    SCM_ASSERT (G_TYPE_IS_ENUM (ginstance->type),
                instance, SCM_ARG1, FUNC_NAME);

    enum_class = g_type_class_peek (ginstance->type);

    SCM_ASSERT (SCM_INUMP (value) &&
                (SCM_INUM (value) >= enum_class->minimum) &&
                (SCM_INUM (value) <= enum_class->maximum),
                value, SCM_ARG2, FUNC_NAME);

    g_value_set_enum (ginstance->data, SCM_INUM (value));

    return SCM_UNSPECIFIED;
}
#undef FUNC_NAME

SCM_DEFINE (scm_sys_gvalue_get_enum, "%gvalue-get-enum", 1, 0, 0,
            (SCM instance),
            "")
#define FUNC_NAME s_scm_sys_gvalue_get_enum
{
    GuileGTypeInstance *ginstance;
    GEnumClass *enum_class;

    SCM_ASSERT (SCM_TYP16_PREDICATE (scm_tc16_gtype_instance, instance),
                instance, SCM_ARG1, FUNC_NAME);

    ginstance = (GuileGTypeInstance *) SCM_SMOB_DATA (instance);
    SCM_ASSERT (G_TYPE_IS_ENUM (ginstance->type),
                instance, SCM_ARG1, FUNC_NAME);

    enum_class = g_type_class_peek (ginstance->type);

    return SCM_MAKINUM (g_value_get_enum (ginstance->data));
}
#undef FUNC_NAME

SCM_DEFINE (scm_gtype_instance_p, "gtype-instance?", 1, 0, 0,
            (SCM instance),
            "")
#define FUNC_NAME s_scm_gtype_instance_p
{
    return SCM_TYP16_PREDICATE (scm_tc16_gtype_instance, instance) ? SCM_BOOL_T 
: SCM_BOOL_F;
}
#undef FUNC_NAME

SCM_DEFINE (scm_gtype_instance_to_type, "gtype-instance->type", 1, 0, 0,
            (SCM instance),
            "")
#define FUNC_NAME s_scm_gtype_instance_to_type
{
    GuileGTypeInstance *ginstance;

    SCM_ASSERT (SCM_TYP16_PREDICATE (scm_tc16_gtype_instance, instance),
                instance, SCM_ARG1, FUNC_NAME);

    ginstance = (GuileGTypeInstance *) SCM_SMOB_DATA (instance);
    return ginstance->scm_type;
}
#undef FUNC_NAME

SCM_DEFINE (scm_sys_genum_get_values, "%genum-get-values", 1, 0, 0,
            (SCM type),
            "")
#define FUNC_NAME s_scm_sys_genum_get_values
{
    GType gtype;
    GEnumClass *enum_class;
    SCM vector;
    guint i;

    SCM_ASSERT (SCM_IS_A_P (type, scm_class_gtype),
                type, SCM_ARG1, FUNC_NAME);

    gtype = (GType) SCM_SLOT (type, scm_si_gtype);
    SCM_ASSERT (G_TYPE_IS_ENUM (gtype), 
                type, SCM_ARG1, FUNC_NAME);

    enum_class = g_type_class_ref (gtype);

    vector = scm_c_make_vector (enum_class->n_values, SCM_UNDEFINED);

    for (i = 0; i < enum_class->n_values; i++) {
        GEnumValue *current = &enum_class->values [i];
        SCM this;

        this = scm_list_3 (scm_mem2symbol (current->value_nick,
                                           strlen (current->value_nick)),
                           scm_makfrom0str (current->value_name),
                           SCM_MAKINUM (current->value));

        scm_vector_set_x (vector, SCM_MAKINUM (i), this);
    }

    return vector;
}
#undef FUNC_NAME

/* three little helper functions to make things a bit easier on the C side */
SCM
scm_c_make_genum (GType gtype, gint value)
{
    SCM type, instance;

    type = scm_c_make_gtype (gtype);
    instance = scm_sys_gtype_create_basic_instance (type);
    scm_sys_gvalue_set_enum (instance, SCM_MAKINUM (value));

    return instance;
}

gint
scm_c_get_enum (SCM instance)
{
    GuileGTypeInstance *ginstance;
    ginstance = (GuileGTypeInstance *) SCM_SMOB_DATA (instance);
    return g_value_get_enum (ginstance->data);
}

gboolean
scm_c_enum_is_a (GType gtype, SCM instance)
{
    GuileGTypeInstance *ginstance;
    ginstance = (GuileGTypeInstance *) SCM_SMOB_DATA (instance);
    return g_type_is_a (ginstance->type, gtype);
}

====

That's it, basically - the rest can be done in scheme.

With the old g-wrap, you needed three functions to define a new type -
`convert-to-scm', `convert-from-scm' and `scm-is-a'.

This can easily be done like this:

====
(add-type 'foo "Foo" 
          ;fn-convert-to-scm 
          (lambda (x) (list "scm_c_make_genum(TYPE_FOO, " x ")"))
          ;fn-convert-from-scm 
          (lambda (x) (list "scm_c_get_enum(" x ")"))
          ;fn-scm-is-a
          (lambda (x) (list "scm_c_enum_is_a(TYPE_FOO, " x ")")))
====

On the scheme side, I create a GOOPS class for each GType.

====
(use-modules (gnome gobject) (oop goops))
(define <foo> (gtype->class gtype-type-foo))

;;; To create a new instance of the `Foo' type:

(make <foo> #:value 0)
;; -> #<<foo> 4032f6f0 (Hello a 0)>

(make <foo> #:value 'Test)
;; -> #<<foo> 4034abc8 (Test b 1)>

(make <foo> #:value "c")  
;; -> #<<foo> 40346f18 (Bar c 2)>


;;; Store it in `foo' so we can play around with it
(define foo (make <foo> #:value 'Test))

;;; You can pass this to a C function
(test-foo foo)

;;; Get its type
(gtype-instance->type foo)
;; -> #<<gtype> foo 80882c0>

;;; Transform it into an integer
(genum->int foo)
;; -> 1

;;; Get the enum's symbol
(genum->symbol foo)
;; -> Test

;;; Get the enum's name
(genum->name foo)
;; -> "b"

;;; Get the enum's value table
(genum->value-table foo)
;; -> #((Hello "a" 0) (Test "b" 1) (Bar "c" 2))
====

The following is not yet done, but it should be trivial to do:

====
(define value-table #((Hello "a" 0) (Test "b" 1) (Bar "c" 2)))
(define gtype-type-foo (genum-register-static "Foo" value-table))
(define <foo> (gtype->class gtype-type-foo))
====

This'll create a new enum type and register it with the C runtime - and
you'll be able to use this type in C as well (either by passing gtype-type-foo
to a C function or by calling `g_type_from_name ("Foo")' in C).

Comments are very welcome :-)

Btw. the full source code for all of this is in GNOME CVS in the
guile-gobject module (you can browse it online at http://cvs.gnome.org/).

-- 
Martin Baulig
address@hidden (private)
address@hidden (work)