Date: Fri, 5 Sep 2003 17:26:56 +0100
To: lablgtk at kaba.or.jp
Subject: unmap event never sent to widgets?
Message-ID: <20030905162656.GA18479 at redhat.com>
Mime-Version: 1.0
Content-Type: text/plain; charset=us-ascii
Content-Disposition: inline
From: Richard Jones <rich at annexia.org>


Below is a much shortened version of the large Gtk program I'm working
on.  There are two problems with this program:

(a) I can never get Gtk to send an "unmap" event to my custom
widget. I need this, because my widget needs to unregister itself from
something when it is removed from the screen.

(b) In the particular program below, clicking the "red" or "green"
buttons once works, but subsequently no widget appears. The widget
appears to have died in some way. Why?

Rich.

http://www.annexia.org/tmp/maptest.ml

----------------------------------------------------------------------
(* Test map/unmap events.
 * Compile with:
 * ocamlc -w s -I +lablgtk2 lablgtk.cma gtkInit.cmo maptest.ml -o maptest
 *)

open GObj

class da ?packing ?show colour =
  let da = GMisc.drawing_area ?packing ?show () in

  object (self)
    inherit widget_full da#as_widget

    val drawable = lazy (new GDraw.drawable da#misc#window)
    method private drawable = Lazy.force drawable

    method repaint =
      prerr_endline (colour ^ ": repaint");

      let drawable = self#drawable in
      let (width, height) = drawable#size in
      drawable#set_background `WHITE;
      drawable#set_foreground `WHITE;
      drawable#rectangle ~x:0 ~y:0 ~width ~height ~filled:true ();
      drawable#set_foreground (`NAME colour);

      drawable#rectangle ~x:20 ~y:20 ~width:100 ~height:100 ~filled:true ()

    method map =
      prerr_endline (colour ^ ": map");

    method unmap =
      prerr_endline (colour ^ ": unmap");

    initializer
      prerr_endline (colour ^ ": created");
      da#event#connect#expose ~callback:(fun ev -> self#repaint; false);
      da#event#connect#map ~callback:(fun _ -> self#map; false);
      da#event#connect#unmap ~callback:(fun _ -> self#unmap; false);
      ()
  end

let may f = function None -> () | Some x -> f x

let () =
  (* Create the window. *)
  let window = GWindow.window () in
  window#connect#destroy ~callback:GMain.Main.quit;

  let vbox = GPack.vbox ~packing:window#add () in

  let frame = GBin.frame ~label:"The widget: "
		~width:300 ~height:200
		~packing:vbox#pack () in

  (* Create red and green versions of the custom widget. *)
  let red = new da "red" in
  let green = new da "green" in

  (* What is packed there now. *)
  let packed = ref None in

  let red_button =
    GButton.button ~label:"Show red widget" ~packing:vbox#pack () in
  red_button#connect#clicked
    ~callback:(fun () ->
		 may frame#remove !packed;
		 let w = red#coerce in
		 frame#add w;
		 packed := Some w);
  let green_button =
    GButton.button ~label:"Show green widget" ~packing:vbox#pack () in
  green_button#connect#clicked
    ~callback:(fun () ->
		 may frame#remove !packed;
		 let w = green#coerce in
		 frame#add w;
		 packed := Some w);

  window#show ();
  GMain.Main.main ()
----------------------------------------------------------------------


-- 
Richard Jones. http://www.annexia.org/ http://freshmeat.net/users/rwmj
Merjis Ltd. http://www.merjis.com/ - all your business data are belong to you.
MAKE+ is a sane replacement for GNU autoconf/automake. One script compiles,
RPMs, pkgs etc. Linux, BSD, Solaris. http://www.annexia.org/freeware/makeplus/