GTK 3 Packing Buttons with GtkBuilder Example

The SML version of the C code for Example 3 from the GTK 3 reference manual.

This example demonstrates downcasting of an object to a subclass using GObject.ObjectClass.toDerived. This function checks at run-time whether the downcast object is an instance of the subclass and, if not, emits a critical warning. Use of downcasting is unavoidable when looking up an object created by GtkBuilder because the return value of Gtk.Builder.getObject is known to be only an instance of GObject.Object.t.

Download

Gtk3PackingButtonsWithGtkBuilder.tar.gz

See Using Make for build instructions.

Library dependencies

GLib 2.0 (GLib, GObject, Gio)
GTK 3.0 (Gtk)

File listings

example-3.sml

fun printHello () = print "Hello World\n"

(* Wrap Gtk.Builder.getObject to check for `NONE` and to downcast the result. *)
fun getObject subclass builder name =
  case Gtk.Builder.getObject builder name of
    SOME object => GObject.ObjectClass.toDerived subclass object
  | NONE => Giraffe.error 1 ["Error getting builder object: \"", name, "\" not found\n"]

fun main () =
  let
    val argv = Utf8CPtrArrayN.fromList (CommandLine.name () :: CommandLine.arguments ())
    val _ = Gtk.init argv

    (* Construct a GtkBuilder instance and load our UI description *)
    val builder = Gtk.Builder.new ()
    val _ =
      Gtk.Builder.addFromFile builder "builder.ui"
        handle
          GLib.Error (_, error) =>
            Giraffe.error 1 ["Error loading file: ", #get GLib.Error.message error, "\n"]

    (* Connect signal handlers to the constructed widgets. *)
    val window = getObject Gtk.WindowClass.t builder "window"
    val _ = Signal.connect window (Gtk.Widget.destroySig, Gtk.mainQuit)

    val button = getObject Gtk.ButtonClass.t builder "button1"
    val _ = Signal.connect button (Gtk.Button.clickedSig, printHello)

    val button = getObject Gtk.ButtonClass.t builder "button2"
    val _ = Signal.connect button (Gtk.Button.clickedSig, printHello)

    val button = getObject Gtk.ButtonClass.t builder "quit"
    val _ = Signal.connect button (Gtk.Button.clickedSig, Gtk.mainQuit)

    val () = Gtk.main ()
  in
    Giraffe.exit 0
  end
    handle e => Giraffe.error 1 ["Uncaught exception\n", exnMessage e, "\n"]

builder.ui

<interface>
  <object id="window" class="GtkWindow">
    <property name="visible">True</property>
    <property name="title">Grid</property>
    <property name="border-width">10</property>
    <child>
      <object id="grid" class="GtkGrid">
        <property name="visible">True</property>
        <child>
          <object id="button1" class="GtkButton">
            <property name="visible">True</property>
            <property name="label">Button 1</property>
          </object>
          <packing>
            <property name="left-attach">0</property>
            <property name="top-attach">0</property>
          </packing>
        </child>
        <child>
          <object id="button2" class="GtkButton">
            <property name="visible">True</property>
            <property name="label">Button 2</property>
          </object>
          <packing>
            <property name="left-attach">1</property>
            <property name="top-attach">0</property>
          </packing>
        </child>
        <child>
          <object id="quit" class="GtkButton">
            <property name="visible">True</property>
            <property name="label">Quit</property>
          </object>
          <packing>
            <property name="left-attach">0</property>
            <property name="top-attach">1</property>
            <property name="width">2</property>
          </packing>
        </child>
      </object>
      <packing>
      </packing>
    </child>
  </object>
</interface>

mlton-main.sml

val () = main ()

mlton.mlb

local
  $(SML_LIB)/basis/basis.mlb
  $(SML_LIB)/basis/mlton.mlb
  $(GIRAFFE_SML_LIB)/general/mlton.mlb
  $(GIRAFFE_SML_LIB)/glib-2.0/mlton.mlb
  $(GIRAFFE_SML_LIB)/gobject-2.0/mlton.mlb
  $(GIRAFFE_SML_LIB)/gio-2.0/mlton.mlb
  $(GIRAFFE_SML_LIB)/gtk-3.0/mlton.mlb
in
  example-3.sml
  mlton-main.sml
end

polyml-libs.sml

use "$(GIRAFFE_SML_LIB)/general/polyml.sml";
use "$(GIRAFFE_SML_LIB)/ffi/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gir/polyml.sml";
use "$(GIRAFFE_SML_LIB)/glib-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gobject-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gio-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gmodule-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/cairo-1.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/pango-1.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/pangocairo-1.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gdkpixbuf-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/atk-1.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gdk-3.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/xlib-2.0/polyml.sml";
use "$(GIRAFFE_SML_LIB)/gtk-3.0/polyml.sml";

polyml-app.sml

(* For each line of the form
 *
 *   use "<file>";
 *
 * <file> is taken as a build dependency.
 *)

use "example-3.sml";

app.mk

################################################################################
# Application-specific values

NAME := example-3


# MLton target
#
# Define:
#   SRC_MLTON       - the SML source files for MLton
#   TARGET_MLTON    - the binary to be built with MLton

ifdef MLTON_VERSION

SRC_MLTON := $(shell $(MLTON_MLTON) -mlb-path-var 'GIRAFFE_SML_LIB $(GIRAFFE_SML_LIBDIR)' -stop f mlton.mlb)

TARGET_MLTON := $(NAME)-mlton

endif


# Poly/ML target
#
# Define:
#   SRC_POLYML      - the SML source files for Poly/ML
#   TARGET_POLYML   - the binary to be built with Poly/ML

ifdef POLYML_VERSION

SRC_POLYML := $(shell cat polyml-app.sml | sed -n 's|^use "\([^"]*\)";$$|\1|p')

TARGET_POLYML := $(NAME)-polyml

endif


# Library dependencies
#
# Define:
#   LIB_NAMES       - list of the libraries that the application references

LIB_NAMES := \
	glib-2.0 \
	gobject-2.0 \
	gio-2.0 \
	gtk-3.0

# Note that LIB_NAMES does _not_ contain pkg-config names but GIR namespace
# names, which are also the directory names in $(GIRAFFEHOME)/lib/sml.
#
# One method to determine the list is as follows: for each instance of
#
#   $(GIRAFFE_SML_LIB)/$(LIB_NAME)/mlton.mlb
#
# in mlton.mlb, the list should include $(LIB_NAME).