Subject: Re: binding events with glade
From: Gabriel de Perthuis <Gabriel.de-Perthuis at laPoste.net>
To: lablgtk at math.nagoya-u.ac.jp
In-Reply-To: <1112702486.22493.84.camel at localhost.localdomain>
References: <1112702486.22493.84.camel at localhost.localdomain>
Content-Type: multipart/mixed; boundary="=-wFcQCnRYdQEKydSwTnPZ"
Date: Tue, 05 Apr 2005 16:29:52 +0200
Message-Id: <1112711393.22493.88.camel at localhost.localdomain>
Mime-Version: 1.0


--=-wFcQCnRYdQEKydSwTnPZ
Content-Type: text/plain
Content-Transfer-Encoding: 7bit

It was a very simple thing to do, so here is a patch that adds a
-virtual option to lablgladecc2, generating a class where signal
handlers are pure virtual methods.


--=-wFcQCnRYdQEKydSwTnPZ
Content-Disposition: attachment; filename=lablglade-virtual-patch
Content-Type: text/plain; name=lablglade-virtual-patch; charset=UTF-8
Content-Transfer-Encoding: 7bit

--- lablgtk2-2.4.0+2004.11.19/src/lablgladecc.ml	2004-07-09 15:52:21.000000000 +0200
+++ lablgtk2-2.4.0+2004.11.19.perso/src/lablgladecc.ml	2005-04-05 16:09:32.000000000 +0200
@@ -127,11 +127,19 @@ let parse_field lexbuf ~tag =
   do () done;
   Buffer.contents b
 
+type signal = {
+    shandler: string;
+    scamlhandler: string;
+    sgtkname: string;
+(* scamlname - for the widget#connect#signal option *)
+  }
+
 type wtree = {
     wclass: string;
     wname: string;
     wcamlname : string;
     wchildren: wtree list;
+    wsignals: signal list;
     mutable wrapped: bool;
   }
 
@@ -171,14 +179,22 @@ let is_top_widget wtree w =
   | _ -> false
 
 let rec parse_widget ~wclass ~wname lexbuf =
-  let widgets = ref [] in
-  while match token lexbuf with
+  let widgets = ref [] and signals = ref [] in
+    while match token lexbuf with
   | Tag ("widget", attrs, closed) ->
       widgets := parse_widget ~wclass:(List.assoc "class" attrs)
 	  ~wname:(List.assoc "id" attrs) lexbuf :: !widgets;
       true
   | Tag ("child",_,_) | Endtag "child" ->
       true
+  | Tag ("signal", attrs, closed) -> (
+      let h = List.assoc "handler" attrs in
+      signals := {
+	shandler = h;
+	scamlhandler = camlize h;
+	sgtkname = List.assoc "name" attrs} :: !signals;
+      if not closed then while token lexbuf <> Endtag "signal" do () done; true
+    )
   | Tag (tag,_,closed) ->
       if not closed then while token lexbuf <> Endtag tag do () done; true
   | Endtag "widget" ->
@@ -189,12 +205,23 @@ let rec parse_widget ~wclass ~wname lexb
       failwith "bad XML syntax"
   do () done;
   { wclass = wclass; wname = wname; wcamlname = camlize wname;
-    wchildren = List.rev !widgets; wrapped = false }
+    wchildren = List.rev !widgets; wsignals = List.rev !signals;
+    wrapped = false; }
 
 let rec flatten_tree w =
   let children = List.map ~f:flatten_tree w.wchildren in
   w :: List.flatten children
 
+let output_signal s =
+  printf "      method virtual %s : 'a\n" s.shandler;
+  printf "      initializer self#bind ~name:\"%s\" ~callback:self#%s\n" s.shandler s.scamlhandler
+
+let roots = ref []
+let embed = ref false
+let trace = ref false
+let virtual_ = ref false
+let output_classes = ref []
+
 let output_widget w =
   try
     let (modul, clas) = List.assoc w.wclass !classes in
@@ -212,18 +239,16 @@ let output_widget w =
     printf "      new %s (%s.cast\n" clas modul;
     printf "        (%s ~name:\"%s\" ~info:\"%s\" xmldata))\n"
       "Glade.get_widget_msg" w.wname w.wclass;
-    printf "    method %s = %s\n" w.wcamlname w.wcamlname
+    printf "    method %s = %s\n" w.wcamlname w.wcamlname;
+    if !virtual_ then
+      List.iter output_signal w.wsignals
   with Not_found -> 
     warning (sprintf "Widget %s::%s is not supported" w.wname w.wclass)
 ;;
 
-let roots = ref []
-let embed = ref false
-let trace = ref false
-let output_classes = ref []
-
 let output_wrapper ~file wtree =
-  printf "class %s %s?domain ?autoconnect(*=true*) () =\n"
+  printf "class"; if !virtual_ then printf " virtual";
+  printf " %s %s?domain ?autoconnect(*=true*) () =\n"
     wtree.wcamlname
     (if !embed then "" else
     if file = "<stdin>" then "~file " else "?(file=\"" ^ file ^ "\") ");
@@ -320,7 +345,7 @@ let process ?(file="<stdin>") chan =
       file;
     if !embed then printf "let data = \"%s\"\n\n" (String.escaped data);
     parse_body ~file lexbuf;
-    output_check_all ()
+    if not !virtual_ then output_check_all ()
   with Failure s ->
     eprintf "lablgladecc: in %s, before char %d, %s\n"
       file (Lexing.lexeme_start lexbuf) s
@@ -332,7 +357,7 @@ let output_test () =
     begin fun (clas, _) ->
       output_widget
         {wname = "a"^clas; wcamlname = camlize ("a"^clas);
-	 wclass = clas; wchildren = []; wrapped = true}
+	 wclass = clas; wchildren = []; wsignals = []; wrapped = true}
     end;
   print_string "  end\n\n";
   print_string "let _ = print_endline \"lablgladecc test finished\"\n"
@@ -344,6 +369,7 @@ let main () =
       "-embed", Arg.Set embed, " embed input file into generated program";
       "-trace", Arg.Set trace, " trace calls to handlers";
       "-debug", Arg.Set debug, " add debug code";
+      "-virtual", Arg.Set virtual_, " use virtual methods for event handlers";
       "-root", Arg.String (fun s -> roots := s :: !roots),
       "<widget>  generate only a wrapper for <widget> and its children";
       "-hide-default", Arg.Set hide_default_names, 

--=-wFcQCnRYdQEKydSwTnPZ--