Date: Fri,  9 Aug 2002 10:53:55 -0700
From-Tims-Fingers: true
To: tim at fungible.com
Cc: garrigue at kurims.kyoto-u.ac.jp, lablgtk at kaba.or.jp
In-reply-to: <20020809045034.996707F66 at lobus.fungible.com> (tim at fungible.com)
Subject: Re: Can't get keypresses from a GMisc.drawing_area
References: <20020809033428.1EC147F66 at lobus.fungible.com> <20020809123807R.garrigue at kurims.kyoto-u.ac.jp> <20020809045034.996707F66 at lobus.fungible.com>
Message-Id: <20020809181226.61C9E7F66 at lobus.fungible.com>
From: tim at fungible.com (Tim Freeman)

From: Jacques Garrigue <garrigue@kurims.kyoto-u.ac.jp>
>You can only get keypress events on the toplevel window.
>i.e. area#misc#toplevel

Well, not quite.  area#misc#toplevel is a GObj.widget option.
There doesn't seem to be any path from GObj.widget to a key_press method.

In C GTK programs, the method that gives you a toplevel gives you a
widget, and then you can inspect its type and downcast it to a
window.  OCAML doesn't let you downcast.

I have fixed this in my own copy of lablgtk 1.2.4, and I include a
patch below.  There were some decisions I made here that you may want
to make differently:

1. I don't think the "GObj.misc_ops.toplevel" method is very useful,
but I figure there might be people using it who would like this change
to be backward compatible, so I made a new method "toplevel_window"
that returns a different value.  If you want prettier code that isn't
backward-compatible, then you might want to just name the new method
"toplevel" instead of "toplevel_window".

2. I tried making "toplevel_window" return a GWindow.window option,
but if GObj.widget knows about GWindow.window I have to include
GWindow.window and GContainer.container in the type recursion that
defines GObj.widget.  In OCaml 3.04, this lost enough polymorphism
that I couldn't make it go through.  Instead, I avoided the type
recursion by making "toplevel_window" return a Gtk.window Gtk.obj.
The caller has to make a GWindow.window out of that.  Maybe with OCaml
3.05, you can have enough polymorphism in recursive types so this
isn't a problem.  In any case, making a big recursion is a big
reorganization of the code.

Here's sample code that now works.  If you type on the created window,
it will print "key pressed!" on its stdout:

let main () =
  let window = GWindow.window ~border_width: 10 () in
  let area =
    GMisc.drawing_area ~width:200 ~height:200 ~packing:window#add () in
    area#misc#realize ();
    let expose_event _ =
      Format.printf "expose_event.\n@?";
      false
    in
    let key_press_event _ =
      Format.printf "key pressed!\n@?";
      false;
    in
      area#event#connect#expose ~callback:expose_event;
      begin
        match area#misc#toplevel_window with
            Some x ->
              ignore ((new GWindow.window (x))#event#connect#key_press
                        ~callback:key_press_event);
          | None -> Format.printf "Ouch!  No toplevel!\n@?";
      end;
      window#show ();
      GMain.Main.main ();;
        
 main()

-- 
Tim Freeman       
tim@fungible.com
GPG public key fingerprint ECDF 46F8 3B80 BB9E 575D  7180 76DF FE00 34B1 5C78 

P. S. Here's the patch:

--- gObj.ml.orig	Fri Aug  9 10:49:42 2002
+++ gObj.ml	Fri Aug  9 10:49:44 2002
@@ -274,6 +274,14 @@
   method set_style (style : style) = Widget.set_style obj style#as_style
   (* get functions *)
   method name = Widget.get_name obj
+  method toplevel_window: Gtk.window Gtk.obj option =
+    (** This returns a Gtk.window Gtk.obj if one is available and forces the
+      caller to call new GWindow.window on that.  We can't return a
+      GWindow.window because that creates too much type recursion and we then
+      don't have sufficient polymorphism to carry on. *)
+    try Some (Object.try_cast (Widget.get_toplevel obj) "GtkWindow")
+    with Gpointer.Null -> None
+      | Gtk.Cannot_cast _ -> None
   method toplevel =
     try Some (new widget (Object.unsafe_cast (Widget.get_toplevel obj)))
     with Gpointer.Null -> None
--- gObj.mli.orig	Fri Aug  9 10:50:20 2002
+++ gObj.mli	Fri Aug  9 10:50:35 2002
@@ -187,6 +187,7 @@
     method show_all : unit -> unit
     method style : style
     method toplevel : widget option
+    method toplevel_window: Gtk.window Gtk.obj option
     method unmap : unit -> unit
     method unparent : unit -> unit
     method unrealize : unit -> unit