GUIs Don't Have to be Hard, Part 1: Gooey O'Caml

[wtd]

Introduction

For many young programmers, new to the field, a special interest lies in creating graphical applications. Aside from any other reasons, perhaps this is because GUIs are seen as somehow "magical" and beyond the reach of mere mortals.

The flip side of this is that a lot of young programmers are afraid to start programming. or to continue past command-line applications.

To dispell some of the aura that surrounds GUI programming, I'll start out with some simple applications in one of my favorite languages, O'Caml, and using the GTK toolkit on Ubuntu Linux. Please ask for information on setting up the necessary tools.

First, though...

A look at the console, and the kind of thing we're leaving behind (for the most part). Let's say "Hello world".

code:

print_endline "Hello world";;

Pretty simple, isn't it? Almost feels like we haven't really done any programming at all. Well, we have. Our first GUI programs won't do much more either.

And now for graphical goodness...

code:

open GWindow open GMain;; let w = window    ~title:"Hello world"    ~height:300    ~width:300    ();; w#show ();; w#connect#destroy ~callback:Main.quit;; Main.main ()

Open

The "open" lines at the beginning of the program are simply syntactic conveniences. With them we can avoid typing, for instance:

code:

GWindow.window

Instead we simply write:

code:

window

The "window" function

This is a helper function which takes several labelled arguments and returns a new window. In this case we tell it the title of the window, as well as its height and width.

Once we've created a window we use a "let" binding to give the window a name.

Making the window show up

The window is an object, so we call a method on it to make it show up. Whereas must languages use "." for calling methods, O'Caml uses "#".

Connecting an event

The simplest event that affects almost every window is being destroyed. We trigger this by clicking the close button. We need to provide a function that the program runs when that happens. In this case it's the "quit" function in the "Main" module (from "GMain").

Putting it all in motion

In every GUI app there's a loop which runs continuously, waiting for things to happen. In this case, it takes the form of the "main" function in the "GMain.Main" module.

Compiling it

I called my source file "helloworld.ml", so I used to the following command to compile this program.

code:

ocamlc -I +lablgtk2 -o helloworld lablgtk.cma gtkInit.cmo helloworld.ml

More information on what's going on here can be made available upon request.

A little more

Let's put some text into the center of the screen.

code:

open GWindow open GMain open GMisc;; let w = window    ~title:"Label Test"    ~height:300    ~width:300    () let l = label    ~text:"Hello world!"    ~packing:w#add    ();; w#show ();; w#connect#destroy ~callback:Main.quit;; Main.main ()

What's new?

In this new program I've got most everything the way it was, but there are a few differences. I've create another object. This time it's a label with the text "Hello world!".

The interesting part is the packing argument. With this I provide a function which, when called, adds the object to whatever container it's supposed to belong to. In this case I simply gave it the window's "add" method.

Note: windows can only contain a single object. Yes, there are ways around this.

More than text... a control

We've added a simple text label to our window, but that doesn't do much. Instead, let's add a button that simply prints "Hello world" to the console.

code:

open GWindow open GMain open GButton;; let w = window    ~title:"Button Test"    ~height:300    ~width:300    ~border_width:30    () let b = button    ~label:"Say Hello"    ~packing:w#add    ();; w#show ();; w#connect#destroy ~callback:Main.quit;; b#connect#clicked ~callback:(fun _ -> print_endline "Hello world"); Main.main ()

Creating the button widget

code:

let b = button    ~label:"Say Hello"    ~packing:w#add    ()

There isn't much new here. The "label" argument is new, but self-explanatory. It's just the text that appears inside the button. Again, we pack the button by adding it to the window as it's sole contents.

Making the button do something

code:

b#connect#clicked ~callback:(fun _ -> print_endline "Hello world")

This looks a lot like the code we used to quit the application when the window is destroyed. It's just connecting an event with an action. We don't have a function, though, that will print "Hello world" to the screen.

Fortunately, O'Caml gives us the ability to define anonymous functions.

code:

fun _ -> print_endline "Hello world"

Here we create a simple anonymous function which takes a single argument which we don't care about (as denoted by the underscore), and then prints "Hello world" to the console.

Again, one widget at a time isn't useful

So let's look at a simple app with more than one widget. With this app we'll have a text entry field, a label for it, and a button, that when clicked prints the contents of the entry field to the console.

Oh yes, and nothing should happen if there's nothing in the entry field. If some text in the field is selected, only that text should be displayed.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open Gtk.Tags;; let w = window    ~title:"Hbox Test"    ~height:300    ~width:300    ~allow_shrink:true    () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       () let hb_top = hbox    ~spacing:4    ~packing:vb#pack    ()     let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let sep = separator `HORIZONTAL    ~packing:(vb#pack ~from:`END)    () let l = label    ~text:"Name:"    ~packing:(hb_top#pack ~expand:false)    () let e = entry    ~packing:(hb_top#pack ~expand:true)    () let b = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    if e#text <> "" then       match e#selection with            None -> print_endline e#text          | Some (first, last) ->              let s = e#get_chars first last in                 print_endline s;;        w#show ();; w#connect#destroy ~callback:Main.quit;; b#connect#clicked ~callback:print_name;; Main.main ()

Lots of opening going on

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open Gtk.Tags

In order, we have modules for windows, the main event loop that drives an application, buttons, miscellaneous controls (including labels), editable fields, like our entry field, containers (which we'll use to add multiple widgets to a window, and tags used to modify widgets.

First, the window

As usual, first I create a window, and the only thing that's new this time around is the "allow_shrink" argument. By setting this to true, I can resize the window to be smaller.

Next a box or three

code:

let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       ()

Here I create a vertical box with a spacing of 4 pixels between its contents and a 5 pixel border. I add it to the window.

code:

let hb_top = hbox    ~spacing:4    ~packing:vb#pack    ()

code:

let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    ()

Into this vertical box I add two horizontally oriented boxes. Each of these also has a spacing of 4 pixels. I pack the top box into the vertical box normally, but the bottom box I specify should be packed from the end of the vertical box, rather than the start, which is the default.

A separator

code:

let sep = separator `HORIZONTAL    ~packing:(vb#pack ~from:`END)    ()

To separate the two boxes, I create a simple horizontal separator and pack it into the vertical box from the end as well.

The actual controls

code:

let l = label    ~text:"Name:"    ~packing:(hb_top#pack ~expand:false)    () let e = entry    ~packing:(hb_top#pack ~expand:true)    () let b = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    ()

For all of the work we did setting up the layout, we have but three controls. The label we've seen before. We simply change how it's packed. Instead of adding it to the window, we pack it into the top horizontal box. Oh, and we tell it not to expand. Even if we increase the size of the window, it will not increase the size of the label.

The entry field is new, but not terribly surprising. It is allowed to expand, however.

The button's not new. We do tell it not to expand, and we pack it from the end, so it appears right-justified.

Making the button do something

The window code is familiar, so we'll skip over that.

Instead let's look at the code that makes the button actually do something.

code:

b#connect#clicked ~callback:print_name

Ok but to understand this we need to look at the print_name function.

code:

let print_name () =    if e#text <> "" then       match e#selection with            None -> print_endline e#text          | Some (first, last) ->              let s = e#get_chars first last in                 print_endline s

Here we use the "text" method of the entry field to get its contents as a string. If the field is not an empty string, then we can proceed.

Next we use the "selection" method. This either returns None or some set of start and end positions for the text selected. If it's None, then we print the entire string. Otherwise we use the "get_chars" method to retrieve the selected text and print that.

A minor modification

Up until now I've explicitly stated the size of the new window, but as we can see, clearly that was too large. What if we could get a window that's just the right size?

By commenting out a few lines in the code that creates the window we can do just that.

code:

let w = window    ~title:"Hbox Test"    (* ~height:300    ~width:300    ~allow_shrink:true *)    ()

And now for some tables

No, I'd like to take this last example a bit farther, and have it prompt for a first and last name. Now, these two fields should line up, so to keep everything lined up properly, we're going to have to use a table. If we simply used two horizontal boxes, they might not line up correctly if the labels were of different widths.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open Gtk.Tags;; let w = window ~title:"Table Test" () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       () let t = table   ~rows:2   ~columns:2   ~packing:vb#pack   ~col_spacings:4   ~row_spacings:4   ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let sep = separator `HORIZONTAL ~packing:(vb#pack ~from:`END) () let ls = [|    label       ~text:"First Name:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last Name:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> print_endline ("Hello, " ^ n)          | (n, "") -> print_endline ("Hello, " ^ n)          | (m, n) -> print_endline ("Hello, " ^ m ^ " " ^ n);; w#show ();; w#connect#destroy ~callback:Main.quit;; b#connect#clicked ~callback:print_name;; Main.main ()

Not a lot of new stuff

All told, much of this program is copied and pasted from the previous version.

Enter tables

code:

let t = table   ~rows:2   ~columns:2   ~packing:vb#pack   ~col_spacings:4   ~row_spacings:4   ()

Creation of the table is fairly self-explanatory.

Enter arrays

Rather than have two separate variables for the labels and entry fields, I used arrays. As a simpler example, an array of three numbers:

code:

[| 1; 2; 3 |]

O'Caml features terrific support for lists as well, but arrays are faster, and not any more difficult to work with, really.

Packing code

code:

t#attach ~top:0 ~left:1 ~expand:`X

You will notice that the packing code looks a bit different. When we put a widget into a table we say we're attaching it to that table, and we provide information on where in the table to attach it.

As with arrays, we start counting at zero, so the above describes a widget placed in the first row, and second column.

Printing the name

code:

let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> print_endline ("Hello, " ^ n)          | (n, "") -> print_endline ("Hello, " ^ n)          | (m, n) -> print_endline ("Hello, " ^ m ^ " " ^ n)

This is one area where we've really changed things, so let's look at it in detail.

code:

let fname = es.(0)#text and        lname = es.(1)#text    in

Here I'm creating a couple of local bindings for the text contents of the entry fields. These names are a bit more convenient.

code:

es.(0)

This is an example of accessing a specific element in an array.

code:

match (fname, lname) with

Here I've created a tuple containing the first and last name values, and I'm telling O'Caml I want to pattern match against those values.

code:

("", "") -> ()

The first pattern is two empty strings. In this case I do nothing.

code:

("", n) -> print_endline ("Hello, " ^ n)

Here I have the pattern where the first name is empty, but the last name is not. If it were, it would have been matched by the first pattern.

In this case I simply greet by the last name.

code:

(n, "") -> print_endline ("Hello, " ^ n)

This pattern says the first name is not empty (or it would have been matched previously), and the last name is empty.

In this case, I want to only greet the first name.

code:

(m, n) -> print_endline ("Hello, " ^ m ^ " " ^ n)

This is the default pattern. If nothing else matches, this will. With the other patterns I have in place, I know this means that neither is empty.

In this case I greet both.

Note: ^ is the O'Caml string concatenation operator.

Shedding the console

So far our output has been to the console. Instead, let's display our output in a dialog window. Only the "print_name" function's code changes, so I won't be posting the rest of the code.

code:

let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n)

On local functions

The print_name function now makes extensive use of local functions. The first is a function called "make_dialog" which takes the name to greet and generates an appropriate dialog window, automating much of the tedium involved, including handling events. The second simply takes the dialog generated by the first, and makes it show up on the screen.

Making a dialog

code:

make_dialog ~name =    let d = message_dialog       ~message:("Hello, " ^ name)       ~message_type:`INFO       ~title:"Hello!"       ~buttons:Buttons.close       ()    in       d#connect#response ~callback:(fun _ -> d#destroy ());       d

This fairly straightforward. I use the message_dialog function to create the dialog window which is bound to "d", locally. With the arguments I supply the message to be displayed, the type of message (in this case, info), the title of the dialog window, and the buttons to display.

The function then takes that dialog window and adds an event handler. In this case a function which takes an argument about which we don't care, and then destroys the dialog window.

The function then returns the dialog window, so some other function can manipulate it.

Showing the dialog

code:

let show_dialog ~name =    let d = make_dialog ~name in       d#show ()

The "show_dialog" function is very simple. It simply makes a dialog, then calls that dialog's show method.

When it all comes together

code:

match (fname, lname) with      ("", "") -> ()    | ("", n) -> show_dialog n    | (n, "") -> show_dialog n    | (m, n) -> show_dialog (m ^ " " ^ n)

Now for each pattern I need only call the very simple show_dialog function and all of the details are taken care of for me.

Organizing widgets a bit more

Going back to some cosmetic stuff, without changing how the app really works, let's look at grouping those entry fields a bit. Both the entry fields are for names, so having "Name" in both labels seems redundant. Let's create a labelled frame to hold both fields.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open GBin open Gtk.Tags;; let w = window ~title:"Dialog Test" () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       () let f = frame    ~label:"Name"    ~label_xalign:0.5    ~packing:vb#pack    ~shadow_type:`OUT    () let t = table    ~rows:2    ~columns:2    ~packing:f#add    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let ls = [|    label       ~text:"First:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n);; w#show ();; w#connect#destroy ~callback:Main.quit;; b#connect#clicked ~callback:print_name;; Main.main ()

What's new and what's gone

Obviously, the frame is new. Additionally, the horizontal separator is gone, since the frame provides a nice visual break by itself.

A frame only contains one widget. In this case that widget is the table we'd previously created. We also add a border to the table since there's no "padding" within a frame.

Fortunately, since a frame only contains one widget, packing widgets into it is straightforward.

Building a frame

code:

let f = frame    ~label:"Name"    ~label_xalign:0.5    ~packing:vb#pack    ~shadow_type:`OUT    ()

The label argument is pretty straightforward. The "label_xalign" argument governs how far over the label is. This is a floating point number from 0 to 1. In ths case 0.5 indicates the center.

The shadow_type argument is simply set to out here due to my own aesthetic preferences. In other words, I like the way it looks.

A few new things: notebooks and saving

In the previous example, I used a frame to group the name entry widgets. Now, let's use a notebook. It's easier to show you what that means than to describe it, though here I've only got one tab, so it may look a bit odd. Don't worry. More tabs are coming.

Also new in this revision is that I've added the ability to not only greet the person who enters their name, but also the ability to save that information to a file.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open Gtk.Tags;; let w = window ~title:"Notebook and Save Test" () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       () let n = notebook ~packing:vb#pack () let t = table    ~rows:2    ~columns:2    ~packing:(n#append_page ~tab_label:(label ~text:"Name" ())#coerce)    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let ls = [|    label       ~text:"First:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b_save = button    ~label:"Save"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let b_greet = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n) let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in    let save_info_to_file filename =           let fname = es.(0)#text           and lname = es.(1)#text           and fo = open_out filename in              output_string fo (fname ^ "\n");              output_string fo (lname ^ "\n");              flush fo;              close_out fo    in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ();; w#show ();; w#connect#destroy ~callback:Main.quit;; b_greet#connect#clicked ~callback:print_name;; b_save#connect#clicked ~callback:save_info;; Main.main ()

What's new?

code:

let n = notebook ~packing:vb#pack () let t = table    ~rows:2    ~columns:2    ~packing:(n#append_page ~tab_label:(label ~text:"Name" ())#coerce)    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()

The creation of the notebook and packing a widget (in this case the table) into it is pretty straightforward.

Also, we've added a "Save" button.

More important, though...

code:

let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in    let save_info_to_file filename =           let fname = es.(0)#text           and lname = es.(1)#text           and fo = open_out filename in              output_string fo (fname ^ "\n");              output_string fo (lname ^ "\n");              flush fo;              close_out fo    in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ()

The big addition is the code to save the contents of the two entry fields to a file, and to open a file chooser dialog window.

code:

let file_chooser = file_chooser_dialog `SAVE ()

Creating the file chooser window is simple. We simply have to provide it with a mode. In this case we're saving. Such a mode means we're given the option to specify a new filename.

code:

file_chooser#add_button_stock `CANCEL `CANCEL; file_chooser#add_select_button_stock `SAVE `ACCEPT

We then add the desired buttons to the window.

code:

if file_chooser#run () = `ACCEPT then    match file_chooser#filename with         None -> ()       | Some fn -> save_info_to_file fn else    file_chooser#destroy ()

We then run the dialog, and if the result is that we clicked the save button, check to see the filename that was selected. If no filename was selected, do nothing. Otherwise call the "save_info_to_file" function with the filename.

If the cancel button was clicked, simply destroy the dialog window.

code:

file_chooser#destroy ()

We clean up by making absolutely sure the dialog gets destroyed.

Actually saving the information to the file

code:

let save_info_to_file filename =    let fname = es.(0)#text    and lname = es.(1)#text    and fo = open_out filename    in       output_string fo (fname ^ "\n");       output_string fo (lname ^ "\n");       flush fo;       close_out fo

This is where the action is really taking place. We take the filename given to the function, open that file, and write each name to it on separate lines. We then flush the channel to make sure everything is written and then close the file.

Getting information back from a file

The previous example featured the ability to save data to a file. The only problem is that it showed no way to get that information back. This revision will do just that.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open Gtk.Tags;; let w = window ~title:"Notebook and Save/Load Test" () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:w#add       () let n = notebook ~packing:vb#pack () let t = table    ~rows:2    ~columns:2    ~packing:(n#append_page ~tab_label:(label ~text:"Name" ())#coerce)    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let ls = [|    label       ~text:"First:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b_load = button    ~label:"Load"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let b_save = button    ~label:"Save"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let b_greet = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n) let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in    let save_info_to_file filename =           let fname = es.(0)#text           and lname = es.(1)#text           and fo = open_out filename in              output_string fo (fname ^ "\n");              output_string fo (lname ^ "\n");              flush fo;              close_out fo    in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       () let load_info () =    let file_chooser = file_chooser_dialog `OPEN () in    let load_info_from_file filename =           let fi = open_in filename in              es.(0)#set_text (try input_line fi with End_of_file -> "");              es.(1)#set_text (try input_line fi with End_of_file -> "");              close_in fi    in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `OPEN `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> load_info_from_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ();; w#show ();; w#connect#destroy ~callback:Main.quit;; b_greet#connect#clicked ~callback:print_name;; b_save#connect#clicked ~callback:save_info;; b_load#connect#clicked ~callback:load_info;; Main.main ()

Not much new here

The "load_info" function is nearly identical to the "save-Info" function, except that it reads from a file, instead of writing to one.

Exception handling with "try ... with ..." is provided in case the file is too short and doesn't exactly conform to what we expect from a data file here.

A slight refactoring for greater flexibility

The use of local functions in the previous example was clever, but a poor choice ultimately. The ability to load data from a file and save data to one should not be tied to the action of opening a file chooser. By placing these functions in the top level of the program, they become available in other ways.

The next few revisions will show why that's important.

code:

let save_info_to_file filename =    let fname = es.(0)#text    and lname = es.(1)#text    and fo = open_out filename in       output_string fo (fname ^ "\n");       output_string fo (lname ^ "\n");       flush fo;       close_out fo let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       () let load_info_from_file filename =    let fi = open_in filename in       es.(0)#set_text (try input_line fi with End_of_file -> "");       es.(1)#set_text (try input_line fi with End_of_file -> "");       close_in fi let load_info () =    let file_chooser = file_chooser_dialog `OPEN () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `OPEN `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> load_info_from_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ()

Menus

Unfortunately our last demo suffers from a serious problem. We just have too many buttons on the bottom of the window. The save and load functions are the kind we'd expect to see in a menu, so let's put them there.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open GMenu open Gtk.Tags;; let w = window ~title:"Menu Test" () let master_vbox = vbox ~packing:w#add () let m = menu_bar ~packing:master_vbox#pack () let file_menu = menu () let file_item = menu_item    ~label:"File"    ~packing:m#append    () let load_item = image_menu_item    ~stock:`OPEN    ~packing:file_menu#append    () let save_item = image_menu_item    ~stock:`SAVE    ~packing:file_menu#append    () let sep_item = separator_item ~packing:file_menu#append () let quit_item = image_menu_item    ~stock:`QUIT    ~packing:file_menu#append    () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:master_vbox#pack       () let n = notebook ~packing:vb#pack () let t = table    ~rows:2    ~columns:2    ~packing:(n#append_page ~tab_label:(label ~text:"Name" ())#coerce)    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let ls = [|    label       ~text:"First:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b_greet = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n) let save_info_to_file filename =    let fname = es.(0)#text    and lname = es.(1)#text    and fo = open_out filename in       output_string fo (fname ^ "\n");       output_string fo (lname ^ "\n");       flush fo;       close_out fo let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       () let load_info_from_file filename =    let fi = open_in filename in       es.(0)#set_text (try input_line fi with End_of_file -> "");       es.(1)#set_text (try input_line fi with End_of_file -> "");       close_in fi let load_info () =    let file_chooser = file_chooser_dialog `OPEN () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `OPEN `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> load_info_from_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ();; w#show ();; w#connect#destroy ~callback:Main.quit;; b_greet#connect#clicked ~callback:print_name;; file_item#set_submenu file_menu;; load_item#connect#activate ~callback:load_info;; save_item#connect#activate ~callback:save_info;; quit_item#connect#activate ~callback:w#destroy;; Main.main ()

What's with the box?

code:

let master_vbox = vbox ~packing:w#add ()

In GTK apps, a menubar is essentially just another widget which gets packed like any other. So we'll create a vertical box which can hold the menu, and then everything else we've previously created.

Creating the menubar

code:

let m = menu_bar ~packing:master_vbox#pack ()

Pretty straightforward. Moving on...

The File menu

code:

let file_menu = menu ()

Again, pretty straightforward. This is just a container for menu items.

code:

let file_item = menu_item    ~label:"File"    ~packing:m#append    ()

This may seem odd, but this is the actual "File" you click on in the menubar. It gets packed into the menubar with the "append" method.

Creating menu items

code:

let load_item = image_menu_item    ~stock:`OPEN    ~packing:file_menu#append    () let save_item = image_menu_item    ~stock:`SAVE    ~packing:file_menu#append    () let sep_item = separator_item ~packing:file_menu#append () let quit_item = image_menu_item    ~stock:`QUIT    ~packing:file_menu#append    ()

The above is pretty straightforward. It creates the various items in the File menu. In many cases we use stock menu items, complete with stock icons.

Connecting the "File" with the actual menu

code:

file_item#set_submenu file_menu

Here we actually make the "File" menu item in the menubar bring up the file menu.

Making menu items do something

code:

load_item#connect#activate ~callback:load_info;; save_item#connect#activate ~callback:save_info;; quit_item#connect#activate ~callback:w#destroy;;

As we have with buttons, we need to connect an event to a callback function. These are pretty straightforward.

Refining the save process

In the applications you're probably used to, there are usually two different save options. If you have a file open, just clicking "save" will save the changes back to that file. Clicking "Save as", though will prompt you for a new filename.

Currently our "save" works just like the "save as". So we need to keep track of the file that's open at any given time.

code:

open GWindow open GMain open GButton open GMisc open GEdit open GPack open GMenu open Gtk.Tags;; let current_filename = ref "" let w = window ~title:"Save As Test" () let master_vbox = vbox ~packing:w#add () let m = menu_bar ~packing:master_vbox#pack () let file_menu = menu () let file_item = menu_item    ~label:"File"    ~packing:m#append    () let load_item = image_menu_item    ~stock:`OPEN    ~packing:file_menu#append    () let save_item = image_menu_item    ~stock:`SAVE    ~packing:file_menu#append    () let save_as_item = image_menu_item    ~stock:`SAVE_AS    ~packing:file_menu#append    () let sep_item = separator_item ~packing:file_menu#append () let quit_item = image_menu_item    ~stock:`QUIT    ~packing:file_menu#append    () let vb = vbox    ~spacing:4    ~border_width:5    ~packing:master_vbox#pack    () let n = notebook ~packing:vb#pack () let t = table    ~rows:2    ~columns:2    ~packing:(n#append_page ~tab_label:(label ~text:"Name" ())#coerce)    ~col_spacings:4    ~row_spacings:4    ~border_width:5    ()   let hb_bottom = hbox    ~spacing:4    ~packing:(vb#pack ~from:`END)    () let ls = [|    label       ~text:"First:"       ~packing:(t#attach ~top:0 ~left:0 ~expand:`NONE)       () ;    label       ~text:"Last:"       ~packing:(t#attach ~top:1 ~left:0 ~expand:`NONE)       () |] let es = [|    entry       ~packing:(t#attach ~top:0 ~left:1 ~expand:`X)       () ;    entry       ~packing:(t#attach ~top:1 ~left:1 ~expand:`X)       () |] let b_greet = button    ~label:"Greet"    ~packing:(hb_bottom#pack ~from:`END ~expand:false ~fill:false)    () let print_name () =    let fname = es.(0)#text and        lname = es.(1)#text and        make_dialog ~name =           let d = message_dialog              ~message:("Hello, " ^ name)              ~message_type:`INFO              ~title:"Hello!"              ~buttons:Buttons.close              ()           in              d#connect#response ~callback:(fun _ -> d#destroy ());              d in    let show_dialog ~name =           let d = make_dialog ~name in              d#show ()    in       match (fname, lname) with            ("", "") -> ()          | ("", n) -> show_dialog n          | (n, "") -> show_dialog n          | (m, n) -> show_dialog (m ^ " " ^ n) let save_info_to_file filename =    let fname = es.(0)#text    and lname = es.(1)#text    and fo = open_out filename in       output_string fo (fname ^ "\n");       output_string fo (lname ^ "\n");       flush fo;       close_out fo;       current_filename := filename let save_info () =    let file_chooser = file_chooser_dialog `SAVE () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `SAVE `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> save_info_to_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       () let load_info_from_file filename =    let fi = open_in filename in       es.(0)#set_text (try input_line fi with End_of_file -> "");       es.(1)#set_text (try input_line fi with End_of_file -> "");       close_in fi;       current_filename := filename let load_info () =    let file_chooser = file_chooser_dialog `OPEN () in       file_chooser#add_button_stock `CANCEL `CANCEL;       file_chooser#add_select_button_stock `OPEN `ACCEPT;       if file_chooser#run () = `ACCEPT then          match file_chooser#filename with               None -> ()             | Some fn -> load_info_from_file fn       else          file_chooser#destroy ();       file_chooser#destroy ();       ();; w#show ();; w#connect#destroy ~callback:Main.quit;; b_greet#connect#clicked ~callback:print_name;; file_item#set_submenu file_menu;; load_item#connect#activate ~callback:load_info;; save_item#connect#activate ~callback:(fun () ->    if !current_filename = "" then       save_info ()    else       save_info_to_file !current_filename);; save_as_item#connect#activate ~callback:save_info;; quit_item#connect#activate ~callback:w#destroy;; Main.main ()

First off, a new variable

code:

let current_filename = ref ""

This variable holds a reference to a string which represents the currently open file. It starts out as an empty string, signifying that no file is open. The fact that this is a reference means we can change it later in the program. This capability will be important as we go on.

A new menu item

code:

let save_as_item = image_menu_item    ~stock:`SAVE_AS    ~packing:file_menu#append    ()

Of course, we have to add a new menu item to the file menu for this purpose. Nothing too dramatic here.

A few functions change a bit, but not much

code:

let save_info_to_file filename =    let fname = es.(0)#text    and lname = es.(1)#text    and fo = open_out filename in       output_string fo (fname ^ "\n");       output_string fo (lname ^ "\n");       flush fo;       close_out fo;       current_filename := filename

code:

let load_info_from_file filename =    let fi = open_in filename in       es.(0)#set_text (try input_line fi with End_of_file -> "");       es.(1)#set_text (try input_line fi with End_of_file -> "");       close_in fi;       current_filename := filename

For each of these functions we add a single line of code. At the end of each, we update the current-filename to be the same as the filename given to the function. If we're told to save info to a file, then that's the new current file. If we're told to load info from a particular file, then that becomes the new current file.

Event handlers have to change slightly

code:

save_item#connect#activate ~callback:(fun () ->    if !current_filename = "" then       save_info ()    else       save_info_to_file !current_filename)

The save item must now work a bit differently. If there is no current filename to work with, it must prompt for a filename. But, if there is a current filename, it should simply write the changes to that file without delay.

code:

save_as_item#connect#activate ~callback:save_info

The save as item simply prompts for a filename every time.

Work in progress

This post is a work in progress and will be revisited in the near future when I finish my own current experiment with GTK and O'Caml.

[rizzix]

this is very much similar to swing. except in swing you dont have the additional: Main.main ()

its the way the java threading framework is designed..

[wtd]

rizzix wrote:

this is very much similar to swing. except in swing you dont have the additional: Main.main ()

its the way the java threading framework is designed..

Yes, but there is an event loop there somewhere, even if it's implicit, rather than explicit.

[rizzix]

as i said its the way the java threading framework is designed... the "void run();" method of a class with the Runnable interface is called for the event loop.

[wtd]

Just a notice: new stuff. I've been editing the original post, so it won't show up as updated.