/tags/rel-1-3-27/SWIG/Lib/ocaml/class.swg

(*Stream:class_ctors*)
let create_$classname_from_ptr raw_ptr =
  C_obj 
begin
  let h = Hashtbl.create 20 in
    List.iter (fun (nm,fn) -> Hashtbl.replace h nm fn) 
	[ "nop", (fun args -> C_void) ;
	  $classbody 
	 "&", (fun args -> raw_ptr) ;
       ":parents",
       (fun args ->
          C_list
	  (let out = ref [] in 
	    Hashtbl.iter (fun x y -> out := (x,y) :: !out) h ;
          (List.map	
	     (fun (x,y) ->
		C_string (String.sub x 2 ((String.length x) - 2)))
	     (List.filter
		(fun (x,y) ->
		   ((String.length x) > 2)
		   && x.[0] == ':' && x.[1] == ':') !out)))) ;
       ":classof", (fun args -> C_string "$realname") ;
       ":methods", (fun args -> 
	  C_list (let out = ref [] in 
	    Hashtbl.iter (fun x y -> out := (C_string x) :: !out) h ; !out))
	] ; 
	let rec invoke_inner raw_ptr mth arg = 
	begin
	  try
	    let application = Hashtbl.find h mth in
	      application
		(match arg with 
		     C_list l -> (C_list (raw_ptr :: l)) 
		   | C_void -> (C_list [ raw_ptr ])
		   | v -> (C_list [ raw_ptr ; v ]))
	  with Not_found -> 
		(* Try parent classes *)
		begin
		  let parent_classes = [
		    $baselist
		  ] in
		  let rec try_parent plist raw_ptr =
		    match plist with
			p :: tl -> 
			  begin
			    try
			      (invoke (p raw_ptr)) mth arg
			    with (BadMethodName (p,m,s)) -> 
			      try_parent tl raw_ptr
			  end
		      | [] ->
			  raise (BadMethodName (raw_ptr,mth,"$realname"))
		  in try_parent parent_classes raw_ptr
		end
	end in
	  (fun mth arg -> invoke_inner raw_ptr mth arg)
end

let _ = Callback.register 
          "create_$normalized_from_ptr"
          create_$classname_from_ptr


(*Stream:mli*)
val create_$classname_from_ptr : c_obj -> c_obj