Gecko [ dataharbor.africa ]

Name	Size	Permission
carray.i	3.18 KB	-rw-r--r--
class.swg	1.68 KB	-rw-r--r--
cstring.i	5.93 KB	-rw-r--r--
director.swg	2.94 KB	-rw-r--r--
ocaml.i	1.42 KB	-rw-r--r--
ocaml.swg	14.05 KB	-rw-r--r--
ocamldec.swg	5.21 KB	-rw-r--r--
ocamlkw.swg	1.04 KB	-rw-r--r--
preamble.swg	473 B	-rw-r--r--
std_common.i	531 B	-rw-r--r--
std_complex.i	1.51 KB	-rw-r--r--
std_deque.i	722 B	-rw-r--r--
std_list.i	4.22 KB	-rw-r--r--
std_map.i	2.28 KB	-rw-r--r--
std_pair.i	712 B	-rw-r--r--
std_string.i	3.13 KB	-rw-r--r--
std_vector.i	2.69 KB	-rw-r--r--
stl.i	357 B	-rw-r--r--
swig.ml	4.57 KB	-rw-r--r--
swig.mli	1.66 KB	-rw-r--r--
swigp4.ml	6.5 KB	-rw-r--r--
typecheck.i	4.59 KB	-rw-r--r--
typemaps.i	8.83 KB	-rw-r--r--
typeregister.swg	55 B	-rw-r--r--

Code Editor : 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

${this.title}

Code Editor : class.swg