[m-dev.] For (style) review: Beginning a Gtk+ binding.

[Julien Fischer]

On Wed, 15 Mar 2006, Jonathan Morgan wrote:

> I have made a start on a binding for Gtk+ 2.0.  At the moment, it has just
> enough power to open a window and then destroy it.  As I am fairly new to
> Mercury, I would like someone to look through the attached files and give me
> any necessary style guidelines.

Here's a (slightly edited) version of the file mgtk.m that you posted,
that either conforms to the coding standards used by the Mercury project or
reflects my biases on those matters where the coding standard is silent.

Cheers,
Julien.
-------------- next part --------------
%-----------------------------------------------------------------------------%
% vim: ft=mercury ff=unix ts=4 sw=4 et
%-----------------------------------------------------------------------------%
% Copyright (C) 2006 The University of Melbourne.
% This file may only be copied under the terms of the GNU Library General
% Public License - see the file COPYING.LIB in the Mercury distribution.
%-----------------------------------------------------------------------------%

% File: mgtk.m.
% Author: Jonathan Morgan.
% Stability: very low.

% A Mercury interface to Gtk+.

% XXX: Use gtk_object_set instead of wrapping individual functions.
% XXX: Use an inheritance tree and casting.
% XXX: Implement callbacks for Gtk#.

%-----------------------------------------------------------------------------%

:- module mgtk.
:- interface.

:- import_module bool.
:- import_module io.
:- import_module list.
:- import_module string.

%-----------------------------------------------------------------------------%
%
% Section heading
%

:- type gtk_window.
:- type gtk_widget.
:- type gtk_object.
%:- type gtk_args - a generic type, for objectSet, among others.

%-----------------------------------------------------------------------------%
%
% Section heading (ideally the structure of the sections would be 
% replicated in the implementation - makes it easier to find your way around).
%
    
    % Comment describing this ...
    %
:- pred mgtk.init(list(string)::in, io::di, io::uo) is det.

    % Comment describing that ...
    %
:- pred mgtk.run(io::di, io::uo) is det.

:- pred mgtk.quit(io::di, io::uo) is det.

:- pred mgtk.new_window(gtk_window::out, io::di, io::uo) is det.

:- pred mgtk.make_widget(gtk_window::in, gtk_widget::out,
    io::di, io::uo) is det.

:- pred mgtk.show_widget(gtk_widget::in, io::di, io::uo) is det.

:- pred mgtk.delete_signal_connect(gtk_widget::in,
    pred(gtk_widget, bool, io, io)::pred(in, out, di, uo) is det,
    io::di, io::uo) is det.

:- pred mgtk.destroy_signal_connect(gtk_widget::in,
    pred(gtk_widget, io, io)::pred(in, di, uo) is det,
    io::di, io::uo) is det.

% :- pred mgtk.object_set(gtk_object::in, string::in, gtk_args::in,
%   io::di, io::uo) is det.

%-----------------------------------------------------------------------------%
%-----------------------------------------------------------------------------%

:- implementation.

:- pragma foreign_decl("C",
"
    #include <gtk/gtk.h>
").

%-----------------------------------------------------------------------------%

:- pragma foreign_type("C", gtk_window, "GtkWindow *").
:- pragma foreign_type("C", gtk_widget, "GtkWidget *").
:- pragma foreign_type("C", gtk_object, "GtkObject *").

:- pragma foreign_type("IL", gtk_window, "class [Gtk]Gtk.Window").
:- pragma foreign_type("IL", gtk_widget, "class [Gtk]Gtk.Widget").
:- pragma foreign_type("IL", gtk_object, "class [Gtk]Gtk.Object").

%-----------------------------------------------------------------------------%

:- pragma foreign_proc("C",
	mgtk.init(Args::in, IO0::di, IO::uo), 
	[may_call_mercury, promise_pure],
"
	MR_Word l;
	int     argc, i;
	char    **argv;

	/*
	** Convert arguments from a list of strings to an array of strings.
	*/
	argc = 0;
	for (l = Args; l != MR_list_empty(); l = MR_list_tail(l)) {
		argc++;
	}

	MR_incr_hp(MR_LVALUE_CAST(MR_Word, argv), argc + 1);

	for (i = 0, l = Args; l != list_empty(); l = list_tail(l), i++) {
		argv[i] = (char *) MR_list_head(l);
	}
	
	argv[i] = NULL;
	gtk_init((gint *)&argc, (gchar ***)&argv);
    IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.init(Args::in, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    // Note: Args are not used in Gtk#.
    Application.Init();
	IO = IO0;
").

:- pragma foreign_proc("C",
	mgtk.run(IO0::di, IO::uo), 
	[may_call_mercury, promise_pure],
"
	gtk_main();
	IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.run(IO0::di, IO::uo), 
	[may_call_mercury, promise_pure],
"
    Application.Run();
	IO = IO0;
").

:- pragma foreign_proc("C",
	mgtk.quit(IO0::di, IO::uo), 
	[may_call_mercury, promise_pure],
"
	gtk_main_quit();
	IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.quit(IO0::di, IO::uo), 
	[may_call_mercury, promise_pure],
"
	Application.Quit();
	IO = IO0;
").

:- pragma foreign_proc("C",
	mgtk.new_window(Window::out, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    Window = (GtkWindow *)gtk_window_new(GTK_WINDOW_TOPLEVEL);/*XXX*/
    IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.new_window(Window::out, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    Window = new Window("""");
    IO = IO0;
").

:- pragma foreign_proc("C",
	mgtk.make_widget(Window::in, Widget::out, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    Widget = GTK_WIDGET(Window);
    IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.make_widget(Window::in, Widget::out, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    Widget = (Widget)Window;
    IO = IO0;
").

    % In Gtk+ this could be bound as
    % g_object_set(G_OBJECT(widget), "GtkWidget::visible", TRUE, NULL);
    %
:- pragma foreign_proc("C",
	mgtk.show_widget(Widget::in, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    gtk_widget_show(Widget);
    IO = IO0;
").

:- pragma foreign_proc("C#",
	mgtk.show_widget(Widget::in, IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    Widget.Show();
    IO = IO0;
").

% This potentially provides the means of setting all Gtk+ properties from
% pure Mercury code.  I don't know whether anything similar is available for 
% Gtk#, but it might be possible to get at the properties directly in C#.
%
% :- pragma foreign_proc("C",
% 	mgtk.object_set(Object::in, String::in, Args::in, IO0::di, IO::uo), 
% 	[will_not_call_mercury, promise_pure], "
% {
%     g_object_set((GObject *)Object, String, gtk_args(Args), NULL);
%     IO = IO0;
% }
% ").

:- pragma foreign_proc("C",
	mgtk.delete_signal_connect(Widget::in,
        Closure::(pred(in, out, di, uo) is det), IO0::di, IO::uo), 
	[will_not_call_mercury, promise_pure],
"
    MR_Word Result;
    g_signal_connect(G_OBJECT(Widget), ""delete_event"",
            G_CALLBACK(mgtk_delete_callback), (gpointer)Closure);
    IO = IO0;
").

:- pragma foreign_decl("C", "

    gboolean mgtk_delete_callback(GtkWidget *, GdkEventAny *event,
        gpointer data);
").

:- pragma foreign_code("C", "

gboolean mgtk_delete_callback(GtkWidget *widget, GdkEventAny *event,
        gpointer data)
{

    MR_Word delete;
    MR_Word Closure = (MR_Word) data;

	mgtk_call_mercury_delete_callback(Closure, widget, &delete);
    return delete == MR_TRUE ? TRUE : FALSE; 
}  
").

:- pragma export(call_mercury_delete_callback(pred(in, out, di, uo) is det, 
    in, out, di, uo), "mgtk_call_mercury_delete_callback").
:- pred call_mercury_delete_callback(
    pred(gtk_widget, bool, io, io)::(pred(in, out, di, uo) is det), 
    gtk_widget::in, bool::out, io::di, io::uo) is det.
call_mercury_delete_callback(Closure, Widget, Result, !IO) :- 
    Closure(Widget, Result, !IO).

:- pragma foreign_decl("C", "
    
    void mgtk_destroy_callback(GtkWidget *, gpointer data);
").

:- pragma foreign_code("C", "

void mgtk_destroy_callback(GtkWidget *widget, gpointer data)
{
    MR_Word Closure = (MR_Word) data;
	mgtk_call_mercury_destroy_callback(Closure, widget);
}  
").

:- pragma foreign_proc("C",
	mgtk.destroy_signal_connect(Widget::in,
        Closure::(pred(in, di, uo) is det), IO0::di, IO::uo),
	[will_not_call_mercury, promise_pure],
"
    MR_Word Result;
    g_signal_connect(G_OBJECT(Widget), ""destroy"",
            G_CALLBACK(mgtk_destroy_callback), (gpointer)Closure);
    IO = IO0;
").

:- pragma export(call_mercury_initializer(pred(di, uo) is det, di, uo),
	"mgtk_call_mercury_initializer").
:- pred call_mercury_initializer(
		pred(io, io)::(pred(di, uo) is det), io::di, io::uo) is det.

call_mercury_initializer(Closure, !IO) :- Closure(!IO).

:- pragma export(
    call_mercury_destroy_callback(pred(in, di, uo) is det, in, di, uo),
    "mgtk_call_mercury_destroy_callback").
:- pred call_mercury_destroy_callback(
    pred(gtk_widget, io, io)::(pred(in, di, uo) is det), 
    gtk_widget::in, io::di, io::uo) is det.

call_mercury_destroy_callback(Closure, Widget, !IO) :- 
    Closure(Widget, !IO).

%-----------------------------------------------------------------------------%
:- end_module mgtk.
%-----------------------------------------------------------------------------%