lablgtk-2.18.8/0000755000175000017500000000000013460263440012264 5ustar stephstephlablgtk-2.18.8/src/0000755000175000017500000000000013460263445013060 5ustar stephstephlablgtk-2.18.8/src/gMain.ml0000644000175000017500000000416613460263323014447 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GtkMain open GObj module Main = Main module Grab = struct open Grab let add (w : #widget) = add w#as_widget let remove (w : #widget) = remove w#as_widget let get_current () = new widget (get_current ()) end module Event = Event module Rc = Rc module Gc_custom = Gc_custom module Timeout = Glib.Timeout module Idle = Glib.Idle module Io = Glib.Io open Main let main = main let quit = quit let init = init let selection = GData.clipboard Gdk.Atom.primary let clipboard = GData.clipboard Gdk.Atom.clipboard lablgtk-2.18.8/src/gPango.ml0000644000175000017500000000640113460263323014621 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Pango open Font let to_pixels (x : units) = (x-1) / scale + 1 let from_pixels x : units = x * scale class metrics obj = object method ascent = get_ascent obj method descent = get_descent obj method approx_char_width = get_approximate_char_width obj method approx_digit_width = get_approximate_digit_width obj end class font_description fd = object method fd = fd method copy = new font_description (copy fd) method to_string = to_string fd method family = get_family fd method style = get_style fd method variant = get_variant fd method weight = get_weight fd method stretch = get_stretch fd method size = get_size fd method modify = modify fd end let font_description = from_string open Context class context obj = object (self) val obj = obj method as_context = obj method font_description = get_font_description obj method font_name = Font.to_string (get_font_description obj) method language = Language.to_string (get_language obj) method load_font desc = load_font obj (Font.from_string desc) method load_fontset ?(desc = self#font_description) ?(lang = self#language) () = load_fontset obj desc (Language.from_string lang) method get_metrics ?(desc = self#font_description) ?(lang = self#language) () = new metrics (get_metrics obj desc (Some (Language.from_string lang))) method create_layout = Layout.create obj end class context_rw obj = object inherit context obj method set_font_description desc = set_font_description obj desc method set_font_by_name desc = set_font_description obj (Font.from_string desc) method set_language lang = set_language obj (Language.from_string lang) end lablgtk-2.18.8/src/gtkRange.ml0000644000175000017500000000356513460263323015160 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open Tags open GtkRangeProps open GtkBase external _gtkrange_init : unit -> unit = "ml_gtkrange_init" let () = _gtkrange_init () module ProgressBar = ProgressBar module Range = Range module Scale = Scale module Scrollbar = Scrollbar module Ruler = Ruler lablgtk-2.18.8/src/gtkSignal.ml0000644000175000017500000001662413460263323015341 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open StdLabels open Gobject type id type 'a marshaller = 'a -> Closure.argv -> unit type ('a,'b) t = { name: string; classe: 'a; marshaller: 'b marshaller } type query = { id : int; signal_name : string; itype : string; flags : int; return : string; params : string array; } let enter_callback = ref (fun () -> ()) and exit_callback = ref (fun () -> ()) let stop_emit_ref = ref false let stop_emit () = stop_emit_ref := true type saved_state = State of bool let push_callback () = !enter_callback (); let old = !stop_emit_ref in stop_emit_ref := false; State old let pop_callback (State old) = let res = !stop_emit_ref in stop_emit_ref := old; !exit_callback (); res let user_handler = ref raise let safe_call ?(where="function call") f x = try f x with exn -> try !user_handler exn with exn -> Printf.eprintf "In %s, uncaught exception: %s\n" where (Printexc.to_string exn); if Printexc.backtrace_status () then Printexc.print_backtrace stderr; flush stderr external signal_new : string -> g_type -> Gobject.signal_type list -> unit = "ml_g_signal_new_me" external query : int -> query = "ml_g_signal_query" external list_ids : g_type -> int array = "ml_g_signal_list_ids" external connect_by_name : 'a obj -> name:string -> callback:g_closure -> after:bool -> id = "ml_g_signal_connect_closure" external emit_stop_by_name : 'a obj -> name:string -> unit = "ml_g_signal_stop_emission_by_name" external handler_block : 'a obj -> id -> unit = "ml_g_signal_handler_block" external handler_unblock : 'a obj -> id -> unit = "ml_g_signal_handler_unblock" external disconnect : 'a obj -> id -> unit = "ml_g_signal_handler_disconnect" external is_connected : 'a obj -> id -> bool = "ml_g_signal_handler_is_connected" let marshal_unit f _ = f () let marshal_int f argv = match Closure.get_args argv with | _ :: `INT n :: _ -> f n | _ -> invalid_arg "GtkSignal.marshal_int" let marshal_string f argv = match Closure.get_args argv with | _ :: `STRING (Some s) :: _ -> f s | _ -> invalid_arg "GtkSignal.marshal_string" let marshal1 conv1 name f argv = let arg1 = try Data.of_value conv1 (Closure.nth argv 1) with _ -> failwith ("GtkSignal.marshal1 : " ^ name) in f arg1 let marshal2 conv1 conv2 name f argv = let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in let arg1, arg2 = try get conv1 1, get conv2 2 with _ -> failwith ("GtkSignal.marshal2 : " ^ name) in f arg1 arg2 let marshal3 conv1 conv2 conv3 name f argv = let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in let arg1, arg2, arg3 = try get conv1 1, get conv2 2, get conv3 3 with _ -> failwith ("GtkSignal.marshal3 : " ^ name) in f arg1 arg2 arg3 let marshal4 conv1 conv2 conv3 conv4 name f argv = let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in let arg1, arg2, arg3, arg4 = try get conv1 1, get conv2 2, get conv3 3, get conv4 4 with _ -> failwith ("GtkSignal.marshal4 : " ^ name) in f arg1 arg2 arg3 arg4 let marshal5 conv1 conv2 conv3 conv4 conv5 name f argv = let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in let arg1, arg2, arg3, arg4, arg5 = try get conv1 1, get conv2 2, get conv3 3, get conv4 4, get conv5 5 with _ -> failwith ("GtkSignal.marshal5 : " ^ name) in f arg1 arg2 arg3 arg4 arg5 let marshal6 conv1 conv2 conv3 conv4 conv5 conv6 name f argv = let get conv pos = Data.of_value conv (Closure.nth argv ~pos) in let arg1, arg2, arg3, arg4, arg5, arg6 = try get conv1 1, get conv2 2, get conv3 3, get conv4 4, get conv5 5, get conv6 6 with _ -> failwith ("GtkSignal.marshal6 : " ^ name) in f arg1 arg2 arg3 arg4 arg5 arg6 let set_result conv argv res = Closure.set_result argv (conv.inj res) let marshal0_ret ~ret f argv = set_result ret argv (f ()) let marshal1_ret ~ret conv1 name f argv = set_result ret argv (marshal1 conv1 name f argv) let marshal2_ret ~ret conv1 conv2 name f argv = set_result ret argv (marshal2 conv1 conv2 name f argv) let marshal3_ret ~ret conv1 conv2 conv3 name f argv = set_result ret argv (marshal3 conv1 conv2 conv3 name f argv) let marshal4_ret ~ret conv1 conv2 conv3 conv4 name f argv = set_result ret argv (marshal4 conv1 conv2 conv3 conv4 name f argv) external emit_by_name : 'a obj -> name:string -> params:'b data_set array -> g_value = "ml_g_signal_emit_by_name" let emit_by_name_unit obj ~name ~params = ignore (emit_by_name obj ~name ~params) let emit (obj : 'a obj) ~(sgn : ('a, 'b) t) ~(emitter : cont:(_ data_set array -> 'c) -> 'b) ~(conv : g_value -> 'c) = emitter ~cont: (fun params -> conv(emit_by_name obj ~name:sgn.name ~params)) let emit_unit obj = emit obj ~emitter:(fun ~cont () -> cont [||]) ~conv:ignore () let emit_int = emit ~emitter:(fun ~cont n -> cont [|`INT n|]) ~conv:ignore external _override_class_closure : string -> g_type -> g_closure -> unit = "ml_g_signal_override_class_closure" let override_class_closure { name = name } t c = _override_class_closure name t c external chain_from_overridden : Closure.argv -> unit = "ml_g_signal_chain_from_overridden" let connect_aux ~name ~marshaller ~callback ?(after = false) (obj : 'a obj) = let callback argv = let old = push_callback () in (safe_call (marshaller callback) argv ~where: ("callback for signal " ^ name); if pop_callback old then emit_stop_by_name obj ~name else ()) in connect_by_name obj ~name ~callback: (Closure.create callback) ~after let connect ~sgn: ((sgn:('a, _) t)) ~callback ?after (obj : 'a obj) = connect_aux ~name:sgn.name ~marshaller:sgn.marshaller ~callback ?after obj let connect_property ~(prop:('a, _) property) ~callback (obj : 'a obj) = let name = "notify::" ^ prop.Gobject.name in let callback = fun () -> callback (get prop obj) in connect_aux ~name ~marshaller:marshal_unit ~callback obj lablgtk-2.18.8/src/ml_gtkspell.c0000644000175000017500000000550013460263323015534 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_glib.h" CAMLprim value ml_gtkspell_init (value unit) { ml_register_exn_map (GTKSPELL_ERROR, "gtkspell_error"); return Val_unit; } CAMLprim value ml_gtkspell_new_attach (value textview, value lang) { GError *err = NULL; gtkspell_new_attach (check_cast(GTK_TEXT_VIEW, textview), String_option_val (lang), &err); if (err) ml_raise_gerror (err); return Val_unit; } CAMLprim value ml_gtkspell_is_attached (value textview) { return Val_bool (gtkspell_get_from_text_view (check_cast(GTK_TEXT_VIEW, textview)) != NULL); } CAMLprim value ml_gtkspell_get_from_text_view (value view) { GtkSpell *s; s = gtkspell_get_from_text_view (check_cast(GTK_TEXT_VIEW, view)); return s ? ml_some (Val_pointer (s)) : Val_unit; } #define GtkSpell_val(v) (GtkSpell *)Pointer_val(v) ML_1 (gtkspell_detach, GtkSpell_val, Unit) CAMLprim value ml_gtkspell_set_language (value spell, value lang) { GError *err = NULL; if (! gtkspell_set_language (GtkSpell_val (spell), String_option_val (lang), &err)) ml_raise_gerror (err); return Val_unit; } ML_1 (gtkspell_recheck_all, GtkSpell_val, Unit) lablgtk-2.18.8/src/gnomecanvas_tags.var0000644000175000017500000000016013460263323017101 0ustar stephstephpackage "gnomeCanvas" type art_wind_rule = "ART_WIND_RULE_" [ `NONZERO | `INTERSECT | `ODDEVEN | `POSITIVE ] lablgtk-2.18.8/src/ml_gtk.c0000644000175000017500000011627513460263323014510 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_pango.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gdkpixbuf.h" #include "gobject_tags.h" #include "gdk_tags.h" #include "gtk_tags.h" void ml_raise_gtk (const char *errmsg) { static value * exn = NULL; if (exn == NULL) exn = caml_named_value ("gtkerror"); raise_with_string (*exn, (char*)errmsg); } /* conversion functions */ #include "gtk_tags.c" Make_Flags_val (Dest_defaults_val) Make_Flags_val (Target_flags_val) CAMLexport value Val_GtkWidget_func(gpointer w) { return (Val_GtkWidget((GtkWidget*)w)); } /* Init windows */ CAMLprim value ml_gtkwindow_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_message_dialog_get_type() + gtk_input_dialog_get_type() + gtk_color_selection_dialog_get_type() + gtk_file_selection_get_type() + gtk_font_selection_dialog_get_type() #ifndef _WIN32 + gtk_plug_get_type() + gtk_socket_get_type() #endif ; return Val_GType(t); } /* gtkobject.h */ #define gtk_object_ref_and_sink(w) (g_object_ref(w), gtk_object_sink(w)) #define ml_gtk_object_unref_later(w) ml_g_object_unref_later((GObject*)(w)) Make_Val_final_pointer_ext(GtkObject, _sink , gtk_object_ref_and_sink, ml_gtk_object_unref_later, 20) ML_1 (GTK_OBJECT_FLAGS, GtkObject_val, Val_int) ML_1 (gtk_object_ref_and_sink, GtkObject_val, Unit) /* gtkaccelgroup.h */ Make_OptFlags_val (Accel_flag_val) #define Signal_name_val(val) String_val(Field(val,0)) #define Val_GtkAccelGroup_new(val) (Val_GObject_new(&val->parent)) ML_0 (gtk_accel_group_new, Val_GtkAccelGroup_new) ML_1 (gtk_accel_group_lock, GtkAccelGroup_val, Unit) ML_1 (gtk_accel_group_unlock, GtkAccelGroup_val, Unit) ML_5 (gtk_accel_group_connect, GtkAccelGroup_val, Int_val, OptFlags_GdkModifier_val, OptFlags_Accel_flag_val, GClosure_val, Unit) ML_3 (gtk_accel_group_disconnect_key, GtkAccelGroup_val, Int_val, OptFlags_GdkModifier_val, Val_bool) ML_3 (gtk_accel_groups_activate, GObject_val, Int_val, OptFlags_GdkModifier_val, Val_bool) ML_2 (gtk_accelerator_valid, Int_val, OptFlags_GdkModifier_val, Val_bool) ML_1 (gtk_accelerator_set_default_mod_mask, OptFlags_GdkModifier_val, Unit) #define Val_GdkModifier_flags(v) ml_lookup_flags_getter(ml_table_gdkModifier,v) CAMLprim value ml_gtk_accelerator_parse(value acc) { CAMLparam0(); CAMLlocal2(vmods, tup); guint key; GdkModifierType mods; gtk_accelerator_parse(String_val(acc), &key, &mods); vmods = mods ? Val_GdkModifier_flags(mods) : Val_emptylist; tup = alloc_small(2, 0); Field(tup, 0) = Val_int(key); Field(tup, 1) = vmods; CAMLreturn(tup); } ML_2(gtk_accelerator_name, Int_val, OptFlags_GdkModifier_val, copy_string_g_free) ML_2(gtk_accelerator_get_label, Int_val, OptFlags_GdkModifier_val, copy_string_g_free) ML_1(gtk_accel_map_load,String_val,Unit) ML_1(gtk_accel_map_save,String_val,Unit) ML_3(gtk_accel_map_add_entry,String_val,Int_val, OptFlags_GdkModifier_val, Unit) ML_4(gtk_accel_map_change_entry,String_val,Int_val, OptFlags_GdkModifier_val, Bool_val, Val_bool) static void accel_map_func (gpointer data, const gchar *accel_path, guint accel_key, GdkModifierType accel_mods, gboolean changed) { value args[4]; args[0] = Val_string (accel_path); args[1] = Val_int(accel_key); Begin_roots1(args[0]); args[2] = Val_GdkModifier_flags(accel_mods); End_roots(); args[3] = Val_int(changed); caml_callbackN_exn (*(value*)data, 4, args); } CAMLprim value ml_gtk_accel_map_foreach(value func) { CAMLparam1(func); gtk_accel_map_foreach (&func, accel_map_func); CAMLreturn(Val_unit); } /* gtkstyle.h */ #define Val_GtkStyle_new(val) (Val_GObject_new(&val->parent_instance)) ML_0 (gtk_style_new, Val_GtkStyle_new) ML_1 (gtk_style_copy, GtkStyle_val, Val_GtkStyle_new) ML_2 (gtk_style_attach, GtkStyle_val, GdkWindow_val, Val_GtkStyle) ML_1 (gtk_style_detach, GtkStyle_val, Unit) ML_3 (gtk_style_set_background, GtkStyle_val, GdkWindow_val, State_type_val, Unit) ML_6 (gtk_draw_hline, GtkStyle_val, GdkWindow_val, State_type_val, Int_val, Int_val, Int_val, Unit) ML_bc6 (ml_gtk_draw_hline) ML_6 (gtk_draw_vline, GtkStyle_val, GdkWindow_val, State_type_val, Int_val, Int_val, Int_val, Unit) ML_bc6 (ml_gtk_draw_vline) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, bg, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, bg) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, fg, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, fg) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, light, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, light) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, dark, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, dark) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, mid, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, mid) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, base, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, base) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, text, Val_copy) Make_Array_Setter (gtk_style_set, GtkStyle_val, State_type_val, *GdkColor_val, text) Make_Extractor (gtk_style_get, GtkStyle_val, colormap, Val_GdkColormap) Make_Extractor (gtk_style_get, GtkStyle_val, depth, Val_int) ML_1 (gtk_style_get_font, GtkStyle_val, Val_GdkFont) ML_2 (gtk_style_set_font, GtkStyle_val, GdkFont_val, Unit) /* CAMLprim value ml_gtk_style_set_font (value st, value font) { GtkStyle *style = GtkStyle_val(st); if (style->font) gdk_font_unref(style->font); style->font = GdkFont_val(font); gdk_font_ref(style->font); return Val_unit; } */ /* Doesn't seem useful Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, dark_gc, Val_GdkGC) Make_Array_Extractor (gtk_style_get, GtkStyle_val, State_type_val, light_gc, Val_GdkGC) */ /* gtkobject.h */ ML_1 (gtk_object_destroy, GtkObject_val, Unit) ML_1 (gtk_object_sink, GtkObject_val, Unit) /* gtkdata.h */ /* gtkadjustment.h */ ML_6 (gtk_adjustment_new, Float_val, Float_val, Float_val, Float_val, Float_val, Float_val, Val_GtkObject_sink) ML_bc6 (ml_gtk_adjustment_new) ML_3 (gtk_adjustment_clamp_page, GtkAdjustment_val, Float_val, Float_val, Unit) /* ML_2 (gtk_adjustment_set_value, GtkAdjustment_val, Float_val, Unit) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, lower, copy_double) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, upper, copy_double) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, value, copy_double) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, step_increment, copy_double) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, page_increment, copy_double) Make_Extractor (gtk_adjustment_get, GtkAdjustment_val, page_size, copy_double) CAMLprim value ml_gtk_adjustment_set(value lower, value upper, value step_increment, value page_increment, value page_size, value adjustment) { GtkAdjustment *adj = GtkAdjustment_val(adjustment); #define Update_field(name) (adj->name = Option_val(name,Double_val,adj->name) Update_field(lower); Update_field(upper); Update_field(step_increment); Update_field(page_increment); Update_field(page_size); #undef Update_field return Val_unit; } ML_bc6(ml_gtk_adjustment_set) */ /* gtktooltips.h */ #define GtkTooltips_val(val) check_cast(GTK_TOOLTIPS,val) ML_0 (gtk_tooltips_new, Val_GtkAny) ML_1 (gtk_tooltips_enable, GtkTooltips_val, Unit) ML_1 (gtk_tooltips_disable, GtkTooltips_val, Unit) ML_2 (gtk_tooltips_set_delay, GtkTooltips_val, Int_val, Unit) ML_4 (gtk_tooltips_set_tip, GtkTooltips_val, GtkWidget_val, String_option_val, String_option_val, Unit) /* ML_3 (gtk_tooltips_set_colors, GtkTooltips_val, Option_val(arg2, GdkColor_val, NULL) Ignore, Option_val(arg3, GdkColor_val, NULL) Ignore, Unit) */ /* gtkwidget.h */ ML_1 (gtk_widget_unparent, GtkWidget_val, Unit) ML_1 (gtk_widget_show, GtkWidget_val, Unit) ML_1 (gtk_widget_show_now, GtkWidget_val, Unit) ML_1 (gtk_widget_show_all, GtkWidget_val, Unit) ML_1 (gtk_widget_hide, GtkWidget_val, Unit) ML_1 (gtk_widget_hide_all, GtkWidget_val, Unit) ML_1 (gtk_widget_map, GtkWidget_val, Unit) ML_1 (gtk_widget_unmap, GtkWidget_val, Unit) ML_1 (gtk_widget_realize, GtkWidget_val, Unit) ML_1 (gtk_widget_unrealize, GtkWidget_val, Unit) ML_1 (gtk_widget_queue_draw, GtkWidget_val, Unit) ML_1 (gtk_widget_queue_resize, GtkWidget_val, Unit) ML_2 (gtk_widget_draw, GtkWidget_val, Option_val(arg2,GdkRectangle_val,NULL) Ignore, Unit) /* ML_1 (gtk_widget_draw_focus, GtkWidget_val, Unit) ML_1 (gtk_widget_draw_default, GtkWidget_val, Unit) ML_1 (gtk_widget_draw_children, GtkWidget_val, Unit) */ ML_2 (gtk_widget_event, GtkWidget_val, GdkEvent_val, Val_bool) ML_1 (gtk_widget_activate, GtkWidget_val, Val_bool) ML_2 (gtk_widget_reparent, GtkWidget_val, GtkWidget_val, Unit) /* ML_3 (gtk_widget_popup, GtkWidget_val, Int_val, Int_val, Unit) */ CAMLprim value ml_gtk_widget_intersect (value w, value area) { GdkRectangle inter; if (gtk_widget_intersect(GtkWidget_val(w), GdkRectangle_val(area), &inter)) return ml_some (Val_copy (inter)); return Val_unit; } /* properties ML_1 (gtk_widget_grab_focus, GtkWidget_val, Unit) ML_1 (gtk_widget_grab_default, GtkWidget_val, Unit) ML_2 (gtk_widget_set_name, GtkWidget_val, String_val, Unit) ML_1 (gtk_widget_get_name, GtkWidget_val, Val_string) ML_2 (gtk_widget_set_sensitive, GtkWidget_val, Bool_val, Unit) ML_2 (gtk_widget_set_events, GtkWidget_val, Flags_Event_mask_val, Unit) ML_2 (gtk_widget_set_extension_events, GtkWidget_val, Extension_mode_val, Unit) ML_2 (gtk_widget_set_style, GtkWidget_val, GtkStyle_val, Unit) ML_1 (gtk_widget_get_style, GtkWidget_val, Val_GtkStyle) ML_3 (gtk_widget_set_usize, GtkWidget_val, Int_val, Int_val, Unit) ML_3 (gtk_widget_set_size_request, GtkWidget_val, Int_val, Int_val, Unit) */ ML_2 (gtk_widget_set_state, GtkWidget_val, State_type_val, Unit) ML_3 (gtk_widget_set_uposition, GtkWidget_val, Int_val, Int_val, Unit) ML_2 (gtk_widget_add_events, GtkWidget_val, Flags_Event_mask_val, Unit) ML_1 (gtk_widget_get_toplevel, GtkWidget_val, Val_GtkWidget) ML_2 (gtk_widget_get_ancestor, GtkWidget_val, Int_val, Val_GtkWidget) ML_1 (gtk_widget_get_colormap, GtkWidget_val, Val_GdkColormap) ML_1 (gtk_widget_get_visual, GtkWidget_val, (value)) CAMLprim value ml_gtk_widget_get_pointer (value w) { int x,y; value ret; gtk_widget_get_pointer (GtkWidget_val(w), &x, &y); ret = alloc_small (2,0); Field(ret,0) = Val_int(x); Field(ret,1) = Val_int(y); return ret; } ML_2 (gtk_widget_is_ancestor, GtkWidget_val, GtkWidget_val, Val_bool) ML_1 (gtk_widget_ensure_style, GtkWidget_val, Unit) ML_3 (gtk_widget_modify_fg, GtkWidget_val, State_type_val, GdkColor_val, Unit) ML_3 (gtk_widget_modify_bg, GtkWidget_val, State_type_val, GdkColor_val, Unit) ML_3 (gtk_widget_modify_text, GtkWidget_val, State_type_val, GdkColor_val,Unit) ML_3 (gtk_widget_modify_base, GtkWidget_val, State_type_val, GdkColor_val,Unit) ML_2 (gtk_widget_modify_font, GtkWidget_val, PangoFontDescription_val, Unit) ML_1 (gtk_widget_get_pango_context, GtkWidget_val, Val_PangoContext) ML_1 (gtk_widget_create_pango_context, GtkWidget_val, Val_PangoContext_new) ML_6 (gtk_widget_add_accelerator, GtkWidget_val, Signal_name_val, GtkAccelGroup_val, Char_val, OptFlags_GdkModifier_val, OptFlags_Accel_flag_val, Unit) ML_bc6 (ml_gtk_widget_add_accelerator) ML_4 (gtk_widget_remove_accelerator, GtkWidget_val, GtkAccelGroup_val, Char_val, OptFlags_GdkModifier_val, Unit) ML_3 (gtk_widget_set_accel_path, GtkWidget_val, String_val, GtkAccelGroup_val, Unit) /* ML_1 (gtk_widget_lock_accelerators, GtkWidget_val, Unit) ML_1 (gtk_widget_unlock_accelerators, GtkWidget_val, Unit) ML_1 (gtk_widget_accelerators_locked, GtkWidget_val, Val_bool) */ Make_Extractor (GtkWidget, GtkWidget_val, window, Val_GdkWindow) Make_Extractor (gtk_widget, GtkWidget_val, parent, Val_GtkWidget) static value Val_GtkAllocation (GtkAllocation allocation) { value ret = alloc_small (4, 0); Field(ret,0) = Val_int(allocation.x); Field(ret,1) = Val_int(allocation.y); Field(ret,2) = Val_int(allocation.width); Field(ret,3) = Val_int(allocation.height); return ret; } Make_Extractor (gtk_widget, GtkWidget_val, allocation, Val_GtkAllocation) ML_1(Val_GtkAllocation, *(GtkAllocation*)Pointer_val, (value)) ML_2 (gtk_widget_set_double_buffered, GtkWidget_val, Bool_val, Unit) ML_2 (gtk_widget_set_visual, GtkWidget_val, GdkVisual_val, Unit) ML_2 (gtk_widget_set_colormap, GtkWidget_val, GdkColormap_val, Unit) ML_1 (gtk_widget_set_default_visual, GdkVisual_val, Unit) ML_1 (gtk_widget_set_default_colormap, GdkColormap_val, Unit) ML_0 (gtk_widget_get_default_visual, Val_GdkVisual) ML_0 (gtk_widget_get_default_colormap, Val_GdkColormap) ML_1 (gtk_widget_push_visual, GdkVisual_val, Unit) ML_1 (gtk_widget_push_colormap, GdkColormap_val, Unit) ML_0 (gtk_widget_pop_visual, Unit) ML_0 (gtk_widget_pop_colormap, Unit) ML_4 (gtk_widget_render_icon, GtkWidget_val, String_val, Icon_size_val, String_option_val, Val_GdkPixbuf) CAMLprim value ml_gtk_widget_style_get_property (value w, value n) { CAMLparam2 (w, n); CAMLlocal1 (ret); GtkWidget *widget = GtkWidget_val (w); gchar *name = String_val (n); GParamSpec * pspec; pspec = gtk_widget_class_find_style_property (GTK_WIDGET_GET_CLASS (widget), name); if (pspec) { ret = ml_g_value_new (); GValue *gv = GValueptr_val (ret); g_value_init (gv, G_PARAM_SPEC_VALUE_TYPE (pspec)); gtk_widget_style_get_property (widget, name, gv); } else { invalid_argument("Gobject.Widget.style_get_property"); } CAMLreturn (ret); } #ifdef HASGTK212 ML_1 (gtk_widget_get_tooltip_markup, GtkWidget_val, Val_string) ML_2 (gtk_widget_set_tooltip_markup, GtkWidget_val, String_val, Unit) ML_1 (gtk_widget_get_tooltip_text, GtkWidget_val, Val_string) ML_2 (gtk_widget_set_tooltip_text, GtkWidget_val, String_val, Unit) ML_1 (gtk_widget_get_tooltip_window, GtkWidget_val, Val_GtkAny) ML_2 (gtk_widget_set_tooltip_window, GtkWidget_val, GtkWindow_val, Unit) ML_1 (gtk_widget_get_has_tooltip, GtkWidget_val, Val_bool) ML_2 (gtk_widget_set_has_tooltip, GtkWidget_val, Bool_val, Unit) ML_1 (gtk_widget_trigger_tooltip_query, GtkWidget_val, Unit) #else Unsupported_212(gtk_widget_get_tooltip_markup) Unsupported_212(gtk_widget_set_tooltip_markup) Unsupported_212(gtk_widget_get_tooltip_text) Unsupported_212(gtk_widget_set_tooltip_text) Unsupported_212(gtk_widget_get_tooltip_window) Unsupported_212(gtk_widget_set_tooltip_window) Unsupported_212(gtk_widget_get_has_tooltip) Unsupported_212(gtk_widget_set_has_tooltip) Unsupported_212(gtk_widget_trigger_tooltip_query) #endif /* gtkdnd.h */ CAMLprim value ml_gtk_drag_dest_set (value w, value f, value t, value a) { GtkTargetEntry *targets = (GtkTargetEntry *)NULL; int n_targets, i; CAMLparam4 (w,f,t,a); n_targets = Wosize_val(t); if (n_targets) targets = (GtkTargetEntry *) alloc (Wosize_asize(n_targets * sizeof(GtkTargetEntry)), Abstract_tag); for (i=0; ilength < 0) ml_raise_null_pointer(); ret = alloc_string (data->length); if (data->length) memcpy ((void*)ret, data->data, data->length); return ret; } ML_1 (gtk_selection_data_copy, GtkSelectionData_val, Val_GtkSelectionData) ML_4 (gtk_selection_data_set, GtkSelectionData_val, GdkAtom_val, Int_val, Insert((guchar*)String_option_val(arg4)) Option_val(arg4, string_length, -1) Ignore, Unit) ML_3 (gtk_selection_owner_set, GtkWidget_val, GdkAtom_val, Int32_val, Val_bool) ML_4 (gtk_selection_add_target, GtkWidget_val, GdkAtom_val, GdkAtom_val, Int_val, Unit) ML_4 (gtk_selection_convert, GtkWidget_val, GdkAtom_val, GdkAtom_val, Int32_val, Val_bool) ML_2 (gtk_selection_clear_targets, GtkWidget_val, GdkAtom_val, Unit) /* gtkclipboard.h */ ML_1 (gtk_clipboard_get, GdkAtom_val, Val_pointer) ML_1 (gtk_clipboard_clear, GtkClipboard_val, Unit) ML_2 (gtk_clipboard_set_text, GtkClipboard_val, SizedString_val, Unit) ML_2 (gtk_clipboard_wait_for_contents, GtkClipboard_val, GdkAtom_val, Val_GtkSelectionData) CAMLprim value ml_gtk_clipboard_wait_for_text (value c) { const char *res = gtk_clipboard_wait_for_text (GtkClipboard_val(c)); return (res != NULL ? ml_some(copy_string_g_free((char*)res)) : Val_unit); } #ifdef HASGTK26 ML_2 (gtk_clipboard_set_image, GtkClipboard_val, GdkPixbuf_val, Unit) CAMLprim value ml_gtk_clipboard_wait_for_image (value c) { GdkPixbuf *res = gtk_clipboard_wait_for_image (GtkClipboard_val(c)); return (res != NULL ? ml_some(Val_GdkPixbuf_new(res)) : Val_unit); } #else Unsupported_26(gtk_clipboard_set_image) Unsupported_26(gtk_clipboard_wait_for_image) #endif static void clipboard_received_func (GtkClipboard *clipboard, GtkSelectionData *selection_data, gpointer data) { value arg = Val_pointer (selection_data); callback_exn (*(value*)data, arg); ml_global_root_destroy (data); } CAMLprim value ml_gtk_clipboard_request_contents (value c, value a, value f) { void *f_p = ml_global_root_new (f); gtk_clipboard_request_contents (GtkClipboard_val(c), GdkAtom_val(a), clipboard_received_func, f_p); return Val_unit; } static void clipboard_text_received_func (GtkClipboard *clipboard, const gchar *text, gpointer data) { value arg = (text != NULL ? ml_some(copy_string(text)) : Val_unit); callback_exn (*(value*)data, arg); ml_global_root_destroy (data); } CAMLprim value ml_gtk_clipboard_request_text (value c, value f) { void *f_p = ml_global_root_new (f); gtk_clipboard_request_text (GtkClipboard_val(c), clipboard_text_received_func, f_p); return Val_unit; } /* static void clipboard_get_func (GtkClipboard *clipboard, GtkSelectionData *selection_data, guint info, gpointer data) { value arg = Val_pointer (selection_data); callback2 (Field(*(value*)data,0), arg, Val_int(info)); } static void clipboard_clear_func (GtkClipboard *clipboard, gpointer data) { callback (Field(*(value*)data,1), Val_unit); ml_global_root_destroy (data); } */ #ifdef HASGTK22 CAMLprim value ml_gtk_clipboard_wait_for_targets (value c) { CAMLparam0 (); CAMLlocal3 (new_cell, result, last_cell); GdkAtom *targets; gint n_targets; gtk_clipboard_wait_for_targets (GtkClipboard_val(c), &targets, &n_targets); last_cell = Val_unit; if (targets != NULL) { while (n_targets > 0) { result = Val_GdkAtom(targets[--n_targets]); new_cell = alloc_small(2,0); Field(new_cell,0) = result; Field(new_cell,1) = last_cell; last_cell = new_cell; } } g_free(targets); CAMLreturn (last_cell); } #else Unsupported_22(gtk_clipboard_wait_for_targets) #endif /* gtkcontainer.h */ #define GtkContainer_val(val) check_cast(GTK_CONTAINER,val) /* properties ML_2 (gtk_container_set_border_width, GtkContainer_val, Int_val, Unit) ML_1 (gtk_container_get_border_width, GtkContainer_val, Val_int) ML_2 (gtk_container_set_resize_mode, GtkContainer_val, Resize_mode_val, Unit) ML_1 (gtk_container_get_resize_mode, GtkContainer_val, Val_resize_mode) */ ML_2 (gtk_container_add, GtkContainer_val, GtkWidget_val, Unit) ML_2 (gtk_container_remove, GtkContainer_val, GtkWidget_val, Unit) ML_1 (gtk_container_check_resize, GtkContainer_val, Unit) ML_4 (gtk_container_child_get_property, GtkContainer_val, GtkWidget_val, String_val, GValue_val, Unit) ML_4 (gtk_container_child_set_property, GtkContainer_val, GtkWidget_val, String_val, GValue_val, Unit) static void ml_gtk_simple_callback (GtkWidget *w, gpointer data) { value val, *clos = (value*)data; val = Val_GtkWidget(w); callback_exn (*clos, val); } CAMLprim value ml_gtk_container_foreach (value w, value clos) { CAMLparam1(clos); gtk_container_foreach (GtkContainer_val(w), ml_gtk_simple_callback, &clos); CAMLreturn(Val_unit); } CAMLprim value ml_gtk_container_forall (value w, value clos) { CAMLparam1(clos); gtk_container_forall (GtkContainer_val(w), ml_gtk_simple_callback, &clos); CAMLreturn(Val_unit); } ML_2 (gtk_container_set_focus_child, GtkContainer_val, GtkWidget_val, Unit) ML_2 (gtk_container_set_focus_vadjustment, GtkContainer_val, GtkAdjustment_val, Unit) ML_2 (gtk_container_set_focus_hadjustment, GtkContainer_val, GtkAdjustment_val, Unit) /* gtkbin.h */ #define GtkBin_val(val) check_cast(GTK_BIN,val) ML_1 (gtk_bin_get_child, GtkBin_val, Val_GtkWidget) /* gtkitem.h */ ML_1 (gtk_item_select, GtkItem_val, Unit) ML_1 (gtk_item_deselect, GtkItem_val, Unit) ML_1 (gtk_item_toggle, GtkItem_val, Unit) /* gtkdialog.h */ static gboolean window_unref (gpointer w) { /* If the window exists, has no parent, is still not visible, and has only two references (mine and toplevel_list), then destroy it. */ if (GTK_WINDOW(w)->has_user_ref_count && !GTK_WIDGET_VISIBLE(w) && G_OBJECT(w)->ref_count == 2) gtk_object_destroy ((GtkObject*)w); gtk_object_unref((GtkObject*)w); return 0; } static void window_unref_later (GtkObject *p) { g_timeout_add_full(G_PRIORITY_HIGH_IDLE, 0, window_unref, (gpointer)(p), NULL); } Make_Val_final_pointer_ext (GtkObject, _window, gtk_object_ref, window_unref_later, 20) #define Val_GtkWidget_window(w) Val_GtkObject_window(GTK_OBJECT(w)) #define GtkDialog_val(val) check_cast(GTK_DIALOG,val) /* ML_0 (gtk_dialog_new, Val_GtkWidget_window) */ Make_Extractor (GtkDialog, GtkDialog_val, action_area, Val_GtkWidget) Make_Extractor (GtkDialog, GtkDialog_val, vbox, Val_GtkWidget) ML_2 (gtk_dialog_response, GtkDialog_val, Int_val, Unit) ML_3 (gtk_dialog_add_button, GtkDialog_val, String_val, Int_val, Unit) ML_3 (gtk_dialog_set_response_sensitive, GtkDialog_val, Int_val, Bool_val, Unit) ML_2 (gtk_dialog_set_default_response, GtkDialog_val, Int_val, Unit) ML_1 (gtk_dialog_run, GtkDialog_val, Val_int) /* gtk_dialog_add_action_widget */ /* gtkinputdialog.h */ /* ML_0 (gtk_input_dialog_new, Val_GtkWidget_window) */ /* gtkfileselection.h */ #define GtkFileSelection_val(val) check_cast(GTK_FILE_SELECTION,val) ML_1 (gtk_file_selection_new, String_val, Val_GtkWidget_window) ML_2 (gtk_file_selection_complete, GtkFileSelection_val, String_val, Unit) /* properties ML_2 (gtk_file_selection_set_filename, GtkFileSelection_val, String_val, Unit) ML_1 (gtk_file_selection_get_filename, GtkFileSelection_val, Val_string) ML_1 (gtk_file_selection_show_fileop_buttons, GtkFileSelection_val, Unit) ML_1 (gtk_file_selection_hide_fileop_buttons, GtkFileSelection_val, Unit) ML_2 (gtk_file_selection_set_select_multiple, GtkFileSelection_val, Bool_val, Unit) ML_1 (gtk_file_selection_get_select_multiple, GtkFileSelection_val, Val_bool) */ CAMLprim value ml_gtk_file_selection_get_selections (value sel) { gchar** selections = gtk_file_selection_get_selections(GtkFileSelection_val(sel)); gchar** orig = selections; value ret = Val_unit; CAMLparam1(ret); CAMLlocal2(prev,next); for (prev = (value)((&ret)-1); *selections != NULL; selections++) { next = alloc(2,0); Store_field(prev, 1, next); Store_field(next, 0, Val_string(*selections)); prev = next; } Field(prev,1) = Val_unit; g_strfreev(orig); CAMLreturn(ret); } Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, ok_button, Val_GtkWidget) Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, cancel_button, Val_GtkWidget) Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, help_button, Val_GtkWidget) Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, file_list, Val_GtkWidget) Make_Extractor (gtk_file_selection_get, GtkFileSelection_val, dir_list, Val_GtkWidget) /* gtkwindow.h */ ML_1 (gtk_window_new, Window_type_val, Val_GtkWidget_window) /* ML_2 (gtk_window_set_title, GtkWindow_val, String_val, Unit) */ ML_3 (gtk_window_set_wmclass, GtkWindow_val, String_val, String_val, Unit) Make_Extractor (gtk_window_get, GtkWindow_val, wmclass_name, Val_optstring) Make_Extractor (gtk_window_get, GtkWindow_val, wmclass_class, Val_optstring) ML_2 (gtk_window_add_accel_group, GtkWindow_val, GtkAccelGroup_val, Unit) ML_2 (gtk_window_remove_accel_group, GtkWindow_val, GtkAccelGroup_val, Unit) ML_1 (gtk_window_activate_focus, GtkWindow_val, Val_bool) ML_1 (gtk_window_activate_default, GtkWindow_val, Val_bool) CAMLprim value ml_gtk_window_set_geometry_hints ( value win, value pos, value min_size, value max_size, value base_size, value aspect, value resize_inc, value win_gravity, value user_pos, value user_size, value wid ) { GdkWindowHints hints = 0; GdkGeometry geom; if (pos != Val_unit && Field(pos,0) != Val_unit) hints |= GDK_HINT_POS; if (min_size != Val_unit) { hints |= GDK_HINT_MIN_SIZE; geom.min_width = Int_val (Field(Field(min_size,0),0)); geom.min_height = Int_val (Field(Field(min_size,0),1)); } if (max_size != Val_unit) { hints |= GDK_HINT_MAX_SIZE; geom.max_width = Int_val (Field(Field(max_size,0),0)); geom.max_height = Int_val (Field(Field(max_size,0),1)); } if (base_size != Val_unit) { hints |= GDK_HINT_BASE_SIZE; geom.base_width = Int_val (Field(Field(base_size,0),0)); geom.base_height = Int_val (Field(Field(base_size,0),1)); } if (aspect != Val_unit) { hints |= GDK_HINT_ASPECT; geom.min_aspect = Double_val (Field(Field(aspect,0),0)); geom.max_aspect = Double_val (Field(Field(aspect,0),1)); } if (resize_inc != Val_unit) { hints |= GDK_HINT_RESIZE_INC; geom.width_inc = Int_val (Field(Field(resize_inc,0),0)); geom.height_inc = Int_val (Field(Field(resize_inc,0),1)); } if (win_gravity != Val_unit) { hints |= GDK_HINT_WIN_GRAVITY; geom.win_gravity = Gravity_val (Field(win_gravity,0)); } if (user_pos != Val_unit && Field(user_pos,0) != Val_unit) hints |= GDK_HINT_USER_POS; if (user_size != Val_unit && Field(user_size,0) != Val_unit) hints |= GDK_HINT_USER_SIZE; gtk_window_set_geometry_hints (GtkWindow_val(win), GtkWidget_val(wid), &geom, hints); return Val_unit; } ML_bc11 (ml_gtk_window_set_geometry_hints) static value wrap_widget (gpointer arg) { return Val_GtkWidget(arg); } CAMLprim value ml_gtk_window_list_toplevels(value unit) { return Val_GList(gtk_window_list_toplevels(), wrap_widget); } ML_3 (gtk_window_add_mnemonic, GtkWindow_val, Int_val, GtkWidget_val, Unit) ML_3 (gtk_window_remove_mnemonic, GtkWindow_val, Int_val, GtkWidget_val, Unit) ML_3 (gtk_window_mnemonic_activate, GtkWindow_val, Int_val(arg3) Ignore, OptFlags_GdkModifier_val(arg2) Ignore, Unit) ML_1 (gtk_window_get_focus, GtkWindow_val, Val_GtkWidget) ML_2 (gtk_window_set_focus, GtkWindow_val, GtkWidget_val, Unit) ML_2 (gtk_window_set_default, GtkWindow_val, GtkWidget_val, Unit) ML_1 (gtk_window_present, GtkWindow_val, Unit) ML_1 (gtk_window_iconify, GtkWindow_val, Unit) ML_1 (gtk_window_deiconify, GtkWindow_val, Unit) ML_1 (gtk_window_stick, GtkWindow_val, Unit) ML_1 (gtk_window_unstick, GtkWindow_val, Unit) ML_1 (gtk_window_maximize, GtkWindow_val, Unit) ML_1 (gtk_window_unmaximize, GtkWindow_val, Unit) #ifdef HASGTK22 ML_1 (gtk_window_fullscreen, GtkWindow_val, Unit) ML_1 (gtk_window_unfullscreen, GtkWindow_val, Unit) #else Unsupported (gtk_window_fullscreen) Unsupported (gtk_window_unfullscreen) #endif ML_2 (gtk_window_set_decorated, GtkWindow_val, Bool_val, Unit) ML_2 (gtk_window_set_mnemonic_modifier, GtkWindow_val, Flags_GdkModifier_val, Unit) ML_3 (gtk_window_move, GtkWindow_val, Int_val, Int_val, Unit) ML_2 (gtk_window_parse_geometry, GtkWindow_val, String_val, Val_bool) ML_1 (gtk_window_reshow_with_initial_size, GtkWindow_val, Unit) ML_3 (gtk_window_resize, GtkWindow_val, Int_val, Int_val, Unit) ML_2 (gtk_window_set_role, GtkWindow_val, String_val, Unit) ML_1 (gtk_window_get_role, GtkWindow_val, Val_optstring) /* gtkmessagedialog.h */ #define GtkMessageDialog_val(v) check_cast(GTK_MESSAGE_DIALOG,v) ML_4 (gtk_message_dialog_new, Option_val(arg1,GtkWindow_val,NULL) Ignore, Insert(0) Message_type_val, Buttons_type_val, /* The NULL below causes a spurious warning, but is correct */ Insert(String_val(arg4)[0] != 0 ? "%s" : NULL) String_val, Val_GtkWidget_window) #ifdef HASGTK24 ML_2 (gtk_message_dialog_set_markup, GtkMessageDialog_val, String_val, Unit) #else Unsupported_24(gtk_message_dialog_set_markup) #endif /* gtkaboutdialog.h */ #ifdef HASGTK26 static void ml_activate_link_func (GtkAboutDialog *about, const gchar *link, gpointer data) { value v_link, *closure; closure = data; v_link = copy_string (link); callback_exn (*closure, v_link); } CAMLprim value ml_gtk_about_dialog_set_url_hook (value hook) { gtk_about_dialog_set_url_hook (&ml_activate_link_func, ml_global_root_new (hook), ml_global_root_destroy); return Val_unit; } CAMLprim value ml_gtk_about_dialog_set_email_hook (value hook) { gtk_about_dialog_set_email_hook (&ml_activate_link_func, ml_global_root_new (hook), ml_global_root_destroy); return Val_unit; } #define GtkAboutDialog_val(v) (check_cast (GTK_ABOUT_DIALOG, v)) CAMLprim value ml_gtk_about_dialog_set_artists (value dialog, value l) { gchar **s_l = strv_of_string_list (l); gtk_about_dialog_set_artists (GtkAboutDialog_val (dialog), (const gchar **) s_l); g_strfreev (s_l); return Val_unit; } ML_1 (gtk_about_dialog_get_artists, GtkAboutDialog_val, string_list_of_strv) CAMLprim value ml_gtk_about_dialog_set_authors (value dialog, value l) { gchar **s_l = strv_of_string_list (l); gtk_about_dialog_set_authors (GtkAboutDialog_val (dialog), (const gchar **) s_l); g_strfreev (s_l); return Val_unit; } ML_1 (gtk_about_dialog_get_authors, GtkAboutDialog_val, string_list_of_strv) CAMLprim value ml_gtk_about_dialog_set_documenters (value dialog, value l) { gchar **s_l = strv_of_string_list (l); gtk_about_dialog_set_documenters (GtkAboutDialog_val (dialog), (const gchar **) s_l); g_strfreev (s_l); return Val_unit; } ML_1 (gtk_about_dialog_get_documenters, GtkAboutDialog_val, string_list_of_strv) ML_0 (gtk_about_dialog_new, Val_GtkWidget_window) #else Unsupported_26(gtk_about_dialog_set_url_hook) Unsupported_26(gtk_about_dialog_set_email_hook) Unsupported_26(gtk_about_dialog_set_artists) Unsupported_26(gtk_about_dialog_get_artists) Unsupported_26(gtk_about_dialog_set_authors) Unsupported_26(gtk_about_dialog_get_authors) Unsupported_26(gtk_about_dialog_set_documenters) Unsupported_26(gtk_about_dialog_get_documenters) Unsupported_26(gtk_about_dialog_new) #endif /* gtkcolorsel.h */ #define GtkColorSelectionDialog_val(val) check_cast(GTK_COLOR_SELECTION_DIALOG,val) Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, ok_button, Val_GtkWidget) Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, cancel_button, Val_GtkWidget) Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, help_button, Val_GtkWidget) Make_Extractor (gtk_color_selection_dialog, GtkColorSelectionDialog_val, colorsel, Val_GtkWidget) /* gtkfontsel.h */ #define GtkFontSelectionDialog_val(val) \ check_cast(GTK_FONT_SELECTION_DIALOG,val) Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, fontsel, Val_GtkWidget) Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, ok_button, Val_GtkWidget) Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, apply_button, Val_GtkWidget) Make_Extractor (gtk_font_selection_dialog, GtkFontSelectionDialog_val, cancel_button, Val_GtkWidget) /* gtkplug.h */ #ifdef _WIN32 Unsupported(gtk_plug_new) #else ML_1 (gtk_plug_new, GdkNativeWindow_val, Val_GtkWidget_window) #endif /* gtksocket.h */ #ifdef _WIN32 Unsupported(gtk_socket_steal) #else #define GtkSocket_val(val) check_cast(GTK_SOCKET,val) ML_2 (gtk_socket_steal, GtkSocket_val, GdkNativeWindow_val, Unit) #endif /* gtkmain.h */ CAMLprim value ml_gtk_init (value argv) { CAMLparam1 (argv); int argc = Wosize_val(argv), i; CAMLlocal1 (copy); copy = (argc ? alloc (argc, Abstract_tag) : Atom(0)); for (i = 0; i < argc; i++) Field(copy,i) = Field(argv,i); if( !gtk_init_check (&argc, (char ***)©) ){ ml_raise_gtk ("ml_gtk_init: initialization failed"); } argv = (argc ? alloc (argc, 0) : Atom(0)); for (i = 0; i < argc; i++) modify(&Field(argv,i), Field(copy,i)); CAMLreturn (argv); } ML_0 (gtk_set_locale, Val_string) ML_0 (gtk_disable_setlocale, Unit) ML_0 (gtk_main, Unit) ML_1 (gtk_main_iteration_do, Bool_val, Val_bool) ML_0 (gtk_main_quit, Unit) ML_1 (gtk_grab_add, GtkWidget_val, Unit) ML_1 (gtk_grab_remove, GtkWidget_val, Unit) ML_0 (gtk_grab_get_current, Val_GtkWidget) CAMLprim value ml_gtk_get_version (value unit) { value ret = alloc_small(3,0); Field(ret,0) = Val_int(gtk_major_version); Field(ret,1) = Val_int(gtk_minor_version); Field(ret,2) = Val_int(gtk_micro_version); return ret; } ML_0 (gtk_get_current_event_time, copy_int32) ML_0 (gtk_get_current_event, Val_GdkEvent) ML_1 (gtk_get_event_widget, GdkEvent_val, Val_GtkWidget) ML_2 (gtk_propagate_event, GtkWidget_val, GdkEvent_val, Unit) /* gtkrc.h */ ML_1 (gtk_rc_add_default_file, String_val, Unit) ML_1 (gtk_rc_parse, String_val, Unit) ML_1 (gtk_rc_parse_string, String_val, Unit) /* gtktooltip.h */ #ifdef HASGTK212 ML_2 (gtk_tooltip_set_markup, GtkTooltip_val, String_val, Unit) ML_2 (gtk_tooltip_set_text, GtkTooltip_val, String_val, Unit) /* Note: gtk_tooltip_set_text duplicates the string */ ML_2 (gtk_tooltip_set_icon, GtkTooltip_val, GdkPixbuf_val, Unit) ML_3 (gtk_tooltip_set_icon_from_stock, GtkTooltip_val, String_val, Icon_size_val, Unit) ML_2 (gtk_tooltip_set_custom, GtkTooltip_val, GtkWidget_val, Unit) ML_1 (gtk_tooltip_trigger_tooltip_query, GdkDisplay_val, Unit) ML_2 (gtk_tooltip_set_tip_area, GtkTooltip_val, GdkRectangle_val, Unit) #else Unsupported_212(gtk_tooltip_set_markup) Unsupported_212(gtk_tooltip_set_text) Unsupported_212(gtk_tooltip_set_icon) Unsupported_212(gtk_tooltip_set_icon_from_stock) Unsupported_212(gtk_tooltip_set_custom) Unsupported_212(gtk_tooltip_trigger_tooltip_query) Unsupported_212(gtk_tooltip_set_tip_area) #endif /* HASGTK212 */ lablgtk-2.18.8/src/gtkPack.ml0000644000175000017500000001064613460263323015000 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkPackProps open GtkBase external _gtkpack_init : unit -> unit = "ml_gtkpack_init" let () = _gtkpack_init () module Box = struct include Box let pack box ?from:( dir = (`START : pack_type)) ?(expand=false) ?(fill=true) ?(padding=0) child = (match dir with `START -> pack_start | `END -> pack_end) box child ~expand ~fill ~padding end module BBox = struct include ButtonBox (* Omitted defaults setting *) type bbox_style = [ `DEFAULT_STYLE|`SPREAD|`EDGE|`START|`END ] external get_child_width : [>`buttonbox] obj -> int = "ml_gtk_button_box_get_child_min_width" external get_child_height : [>`buttonbox] obj -> int = "ml_gtk_button_box_get_child_min_height" external get_child_ipadx : [>`buttonbox] obj -> int = "ml_gtk_button_box_get_child_ipad_x" external get_child_ipady : [>`buttonbox] obj -> int = "ml_gtk_button_box_get_child_ipad_y" external set_child_size : [>`buttonbox] obj -> width:int -> height:int -> unit = "ml_gtk_button_box_set_child_size" external set_child_ipadding : [>`buttonbox] obj -> x:int -> y:int -> unit = "ml_gtk_button_box_set_child_ipadding" let set_child_size w ?width ?height () = set_child_size w ~width:(may_default get_child_width w ~opt:width) ~height:(may_default get_child_height w ~opt:height) let set_child_ipadding w ?x ?y () = set_child_ipadding w ~x:(may_default get_child_ipadx w ~opt:x) ~y:(may_default get_child_ipady w ~opt:y) let set ?child_width ?child_height ?child_ipadx ?child_ipady ?layout w = if child_width <> None || child_height <> None then set_child_size w ?width:child_width ?height:child_height (); if child_ipadx <> None || child_ipady <> None then set_child_ipadding w ?x:child_ipadx ?y:child_ipady (); may layout ~f:(set P.layout_style w) end module Fixed = Fixed module Layout = Layout module Paned = Paned module Table = struct include Table let has_x : expand_type -> bool = function `X|`BOTH -> true | `Y|`NONE -> false let has_y : expand_type -> bool = function `Y|`BOTH -> true | `X|`NONE -> false let attach t ~left ~top ?(right=left+1) ?(bottom=top+1) ?(expand=`NONE) ?(fill=`BOTH) ?(shrink=`NONE) ?(xpadding=0) ?(ypadding=0) w = let xoptions = if has_x shrink then [`SHRINK] else [] in let xoptions = if has_x fill then `FILL::xoptions else xoptions in let xoptions = if has_x expand then `EXPAND::xoptions else xoptions in let yoptions = if has_y shrink then [`SHRINK] else [] in let yoptions = if has_y fill then `FILL::yoptions else yoptions in let yoptions = if has_y expand then `EXPAND::yoptions else yoptions in attach t w ~left ~top ~right ~bottom ~xoptions ~yoptions ~xpadding ~ypadding end module Notebook = Notebook module SizeGroup = SizeGroup lablgtk-2.18.8/src/gutf8.ml0000644000175000017500000001150113460263323014440 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open StdLabels type unichar = int type unistring = unichar array module Error = struct type error = | NO_CONVERSION | ILLEGAL_SEQUENCE | FAILED | PARTIAL_INPUT | BAD_URI | NOT_ABSOLUTE_PATH exception Error of error * string let raise_bad_utf8 () = raise (Error (ILLEGAL_SEQUENCE, "Invalid byte sequence for UTF-8 string")) end open Error let rec log64 n = if n = 0 then 0 else 1 + log64 (n lsr 5) let utf8_storage_len n = if n < 0x80 then 1 else log64 (n lsr 1) (* this function is not exported, so it's OK to do a few 'unsafe' things *) let write_unichar s ~pos (c : unichar) = let len = utf8_storage_len c in let p = !pos in if len = 1 then Bytes.unsafe_set s p (Char.unsafe_chr c) else begin Bytes.unsafe_set s p (Char.unsafe_chr (((1 lsl len - 1) lsl (8-len)) lor (c lsr ((len-1)*6)))); for i = 1 to len-1 do Bytes.unsafe_set s (p+i) (Char.unsafe_chr (((c lsr ((len-1-i)*6)) land 0x3f) lor 0x80)) done; end; pos := p + len let sub_string s ~pos ~len = Bytes.sub_string s pos len let from_unichar (n : unichar) = let s = Bytes.create 6 and pos = ref 0 in write_unichar s ~pos n; sub_string s ~pos:0 ~len:!pos let from_unistring (s : unistring) = let len = Array.length s in let r = Bytes.create (len*6) in let pos = ref 0 in for i = 0 to len-1 do write_unichar r ~pos s.(i) done; sub_string r ~pos:0 ~len:!pos let rec hi_bits n = if n land 0x80 = 0 then 0 else 1 + hi_bits (n lsl 1) let to_unichar s ~pos : unichar = let c = Char.code s.[!pos] in incr pos; let n = hi_bits c in if n = 0 then c else (* if string is valid then 2 <= n <= 6 *) let u = ref (c land (1 lsl (7-n) - 1)) in for i = 1 to n-1 do let c = Char.code s.[!pos] in u := !u lsl 6 + c land 0x3f ; incr pos done; !u let first_char s = to_unichar s ~pos:(ref 0) let validate c = c < 0x110000 && (c land 0x7FFFF800) <> 0xD800 && (c < 0xFDD0 || c > 0xFDEF) && (c land 0xFFFE) <> 0xFFFE let to_unichar_validated s ~pos : unichar = let c = Char.code s.[!pos] in incr pos; let n = hi_bits c in if n = 0 then c else begin if n = 1 || n > 6 then raise_bad_utf8 () ; if !pos + n > String.length s then raise (Error(PARTIAL_INPUT, "partial UTF-8 character")); let u = ref (c land (1 lsl (7-n) - 1)) in for i = 1 to n-1 do let c = Char.code s.[!pos] in if c lsr 6 <> 0b10 then raise_bad_utf8 () ; u := !u lsl 6 + c land 0x3f ; incr pos done; let v = !u in (* reject overlong sequences && invalid values *) if utf8_storage_len v <> n || not (validate v) then raise_bad_utf8 () ; v end let rec end_of_char s ~pos = let c = Char.code s.[pos] in if (c land 0xc0) = 0x80 then end_of_char s ~pos:(pos+1) else pos let next s ~pos = let c = Char.code s.[pos] in let n = hi_bits c in if n = 0 then pos + 1 else if n = 1 then end_of_char s ~pos:(pos+1) else pos + n let length s = let len = String.length s in let rec loop count ~pos = if pos >= len then count else loop (count+1) ~pos:(next s ~pos) in loop 0 ~pos:0 let to_unistring s : unistring = let len = length s in let us = Array.make len 0 in let pos = ref 0 in for i = 0 to len - 1 do us.(i) <- to_unichar s ~pos done; us lablgtk-2.18.8/src/ml_gvaluecaml.c0000644000175000017500000000454213460263323016034 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_gvaluecaml.h" static gpointer caml_boxed_copy (gpointer boxed) { value *val = boxed; return ml_global_root_new (*val); } GType g_caml_get_type() { static GType type = G_TYPE_INVALID; if (type == G_TYPE_INVALID) type = g_boxed_type_register_static ("Caml", caml_boxed_copy, ml_global_root_destroy); return type; } CAMLprim value ml_g_caml_get_type(value unit) { return Val_GType(G_TYPE_CAML); } void g_value_store_caml_value (GValue *val, value arg) { g_return_if_fail (G_VALUE_HOLDS(val, G_TYPE_CAML)); g_value_set_boxed (val, &arg); } lablgtk-2.18.8/src/gtkSourceView2.props0000644000175000017500000002464513460263323017036 0ustar stephsteph(*********************************************************************************) (* *) (* lablgtksourceview, OCaml binding for the GtkSourceView text widget *) (* *) (* Copyright (C) 2005 Stefano Zacchiroli *) (* Copyright (C) 2006 Stefano Zacchiroli *) (* Maxence Guesdon *) (* *) (* This library is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Lesser General Public License as *) (* published by the Free Software Foundation; either version 2.1 of the *) (* License, or (at your option) any later version. *) (* *) (* This library is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Lesser General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this library; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) (* USA *) (* *) (*********************************************************************************) prefix "Gtk" header { open GtkSourceView2_types open SourceView2Enums } boxed { GdkEvent "GdkEvent.any" } classes { GdkPixbuf "GdkPixbuf.pixbuf" } class SourceStyleScheme type "source_style_scheme obj" set wrapsig : GObject { } class SourceStyleSchemeManager type "source_style_scheme_manager obj" wrap : GObject { (* "scheme-ids" GStrv : Read *) (* "search-path" GStrv : Read / Write *) method get_search_path : "string list" method set_search_path : "string list -> unit" method get_scheme_ids : "string list" method append_search_path : "string -> unit" / Wrap method prepend_search_path : "string -> unit" / Wrap method get_scheme : "string -> source_style_scheme obj option" method force_rescan : "unit -> unit" / Wrap } class SourceCompletionInfo type "source_completion_info obj" wrap wrapsig : GtkWidget { "max-height" gint : Read / Write / Construct "max-width" gint : Read / Write / Construct "shrink-height" gboolean : Read / Write / Construct "shrink-width" gboolean : Read / Write / Construct method move_to_iter : "Gtk.text_view obj -> Gtk.text_iter -> unit" method set_sizing : "width:int -> height:int -> shrink_width:bool -> shrink_height:bool -> unit" / Wrap method set_widget : "Gtk.widget obj -> unit" method get_widget : "Gtk.widget obj" method process_resize : "unit" / Wrap signal before_show } class SourceCompletionProposal type "source_completion_proposal obj" wrap wrapsig : GObject { "icon" GdkPixbuf : Read "info" string : Read "label" string : Read "markup" string : Read "text" string : Read signal changed } class SourceCompletionItem type "source_completion_proposal obj" tag "sourcecompletionproposal" wrap wrapsig : GObject { "icon" GdkPixbuf : Read / Write "info" string : Read / Write "label" string : Read / Write "markup" string : Read / Write "text" string : Read / Write signal changed } class SourceCompletionProvider type "source_completion_provider obj" abstract wrap wrapsig : GObject { method get_name : "string" method get_icon : "GdkPixbuf.pixbuf option" method populate : "source_completion_context obj -> unit" method get_activation : "source_completion_activation_flags list" (* method match : "source_completion_context obj -> bool" *) method get_info_widget : "source_completion_proposal obj -> Gtk.widget obj option" method update_info : "source_completion_proposal obj -> source_completion_info obj -> unit" method get_start_iter : "source_completion_context obj -> source_completion_proposal obj -> Gtk.text_iter" method activate_proposal : "source_completion_proposal obj -> Gtk.text_iter -> bool" method get_interactive_delay : "int" method get_priority : "int" } class SourceCompletionContext type "source_completion_context obj" wrap wrapsig : GObject { "completion" GtkSourceCompletion : Read / Write / Construct Only / NoWrap "iter" GtkTextIter : Read / Write / NoWrap method get_activation : "source_completion_activation_flags list" method set_activation : "source_completion_activation_flags list -> unit" / Wrap method add_proposals : "source_completion_provider obj -> source_completion_proposal obj list -> bool -> unit" signal cancelled } class SourceCompletion type "source_completion obj" wrap wrapsig : GObject { "accelerators" guint : Read / Write / Construct "auto-complete-delay" guint : Read / Write / Construct "proposal-page-size" guint : Read / Write / Construct "provider-page-size" guint : Read / Write / Construct "remember-info-visibility" gboolean : Read / Write / Construct "select-on-show" gboolean : Read / Write / Construct "show-headers" gboolean : Read / Write / Construct "show-icons" gboolean : Read / Write / Construct "view" GtkSourceView : Read / Write / Construct Only / NoWrap method add_provider : "source_completion_provider obj -> bool" method remove_provider : "source_completion_provider obj -> bool" method block_interactive : "unit" / Wrap method get_providers : "source_completion_provider obj list" method create_context : "Gtk.text_iter -> source_completion_context obj" method hide : "unit" / Wrap method move_window : "Gtk.text_iter -> unit" method show : "source_completion_provider obj list -> source_completion_context obj -> bool" method unblock_interactive : "unit" / Wrap signal activate_proposal signal hide signal move_cursor: GtkScrollStep gint signal move_page: GtkScrollStep gint signal populate_context : GtkSourceCompletionContext / NoWrap signal show } class SourceLanguage type "source_language obj" set wrap wrapsig : GObject { (* Property access is broken in gtkSourceView 2.4.1 (see Bugzilla #564142), so we use methods instead: *) } class SourceLanguageManager type "source_language_manager obj" set wrapsig : GObject { (* "search-path" GStrv : Read / Write "language-ids" GStrv : Read / Write *) } class SourceMark type "source_mark obj" set wrap wrapsig : GObject { "category" gchararray_opt : Read / Write / Construct Only } class SourceUndoManager type "source_undo_manager obj" set wrap wrapsig : GObject { method can_undo : "bool" / Wrap method can_redo : "bool" / Wrap method undo : "unit" / Wrap method redo : "unit" / Wrap method begin_not_undoable_action : "unit" / Wrap method end_not_undoable_action : "unit" / Wrap method can_undo_changed : "unit" / Wrap method can_redo_changed : "unit" / Wrap signal can_redo_changed signal can_undo_changed } class SourceBuffer type "source_buffer obj" set wrap wrapsig : GObject { "can-redo" gboolean : Read "can-undo" gboolean : Read "highlight-matching-brackets" gboolean : Read / Write "highlight-syntax" gboolean : Read / Write "language" GtkSourceLanguage_opt: Read / Write / NoWrap "max-undo-levels" gint : Read / Write "style-scheme" GtkSourceStyleScheme_opt : Read / Write / NoWrap "undo-manager" GtkSourceUndoManager : Read / Write / Construct / NoWrap signal highlight_updated: GtkTextIter GtkTextIter signal source_mark_updated: GtkSourceMark } class SourceView type "source_view obj" set wrap wrapsig : Widget { "auto-indent" gboolean : Read / Write "highlight-current-line" gboolean : Read / Write "indent-on-tab" gboolean : Read / Write "indent-width" gint : Read / Write "insert-spaces-instead-of-tabs" gboolean : Read / Write "right-margin-position" guint : Read / Write "show-line-marks" gboolean : Read / Write "show-line-numbers" gboolean : Read / Write "show-right-margin" gboolean : Read / Write "smart-home-end" GtkSourceSmartHomeEndType : Read / Write "tab-width" guint : Read / Write method get_completion : "source_completion obj" method get_draw_spaces : "source_draw_spaces_flags list" method set_draw_spaces : "source_draw_spaces_flags list -> unit" method get_mark_category_priority : "category:string -> int" / Wrap method set_mark_category_priority: "category:string -> int -> unit" / Wrap method get_mark_category_pixbuf: "category:string -> GdkPixbuf.pixbuf option" / Wrap method set_mark_category_pixbuf: "category:string -> GdkPixbuf.pixbuf option -> unit" / Wrap method get_mark_category_background: "category:string -> Gdk.color option" / Wrap method set_mark_category_background: "category:string -> Gdk.color option -> unit" / Wrap signal line_mark_activated : GtkTextIter GdkEvent signal move_lines : gboolean gint signal move_words : gint signal redo signal show_completion signal smart_home_end : GtkTextIter gint signal undo } lablgtk-2.18.8/src/gdkKeysyms.ml0000644000175000017500000013060613460263323015545 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gdk let _VoidSymbol : keysym = 0xFFFFFF let _BackSpace : keysym = 0xFF08 let _Tab : keysym = 0xFF09 let _Linefeed : keysym = 0xFF0A let _Clear : keysym = 0xFF0B let _Return : keysym = 0xFF0D let _Pause : keysym = 0xFF13 let _Scroll_Lock : keysym = 0xFF14 let _Sys_Req : keysym = 0xFF15 let _Escape : keysym = 0xFF1B let _Delete : keysym = 0xFFFF let _Multi_key : keysym = 0xFF20 let _SingleCandidate : keysym = 0xFF3C let _MultipleCandidate : keysym = 0xFF3D let _PreviousCandidate : keysym = 0xFF3E let _Kanji : keysym = 0xFF21 let _Muhenkan : keysym = 0xFF22 let _Henkan_Mode : keysym = 0xFF23 let _Henkan : keysym = 0xFF23 let _Romaji : keysym = 0xFF24 let _Hiragana : keysym = 0xFF25 let _Katakana : keysym = 0xFF26 let _Hiragana_Katakana : keysym = 0xFF27 let _Zenkaku : keysym = 0xFF28 let _Hankaku : keysym = 0xFF29 let _Zenkaku_Hankaku : keysym = 0xFF2A let _Touroku : keysym = 0xFF2B let _Massyo : keysym = 0xFF2C let _Kana_Lock : keysym = 0xFF2D let _Kana_Shift : keysym = 0xFF2E let _Eisu_Shift : keysym = 0xFF2F let _Eisu_toggle : keysym = 0xFF30 let _Zen_Koho : keysym = 0xFF3D let _Mae_Koho : keysym = 0xFF3E let _Home : keysym = 0xFF50 let _Left : keysym = 0xFF51 let _Up : keysym = 0xFF52 let _Right : keysym = 0xFF53 let _Down : keysym = 0xFF54 let _Prior : keysym = 0xFF55 let _Page_Up : keysym = 0xFF55 let _Next : keysym = 0xFF56 let _Page_Down : keysym = 0xFF56 let _End : keysym = 0xFF57 let _Begin : keysym = 0xFF58 let _Select : keysym = 0xFF60 let _Print : keysym = 0xFF61 let _Execute : keysym = 0xFF62 let _Insert : keysym = 0xFF63 let _Undo : keysym = 0xFF65 let _Redo : keysym = 0xFF66 let _Menu : keysym = 0xFF67 let _Find : keysym = 0xFF68 let _Cancel : keysym = 0xFF69 let _Help : keysym = 0xFF6A let _Break : keysym = 0xFF6B let _Mode_switch : keysym = 0xFF7E let _script_switch : keysym = 0xFF7E let _Num_Lock : keysym = 0xFF7F let _KP_Space : keysym = 0xFF80 let _KP_Tab : keysym = 0xFF89 let _KP_Enter : keysym = 0xFF8D let _KP_F1 : keysym = 0xFF91 let _KP_F2 : keysym = 0xFF92 let _KP_F3 : keysym = 0xFF93 let _KP_F4 : keysym = 0xFF94 let _KP_Home : keysym = 0xFF95 let _KP_Left : keysym = 0xFF96 let _KP_Up : keysym = 0xFF97 let _KP_Right : keysym = 0xFF98 let _KP_Down : keysym = 0xFF99 let _KP_Prior : keysym = 0xFF9A let _KP_Page_Up : keysym = 0xFF9A let _KP_Next : keysym = 0xFF9B let _KP_Page_Down : keysym = 0xFF9B let _KP_End : keysym = 0xFF9C let _KP_Begin : keysym = 0xFF9D let _KP_Insert : keysym = 0xFF9E let _KP_Delete : keysym = 0xFF9F let _KP_Equal : keysym = 0xFFBD let _KP_Multiply : keysym = 0xFFAA let _KP_Add : keysym = 0xFFAB let _KP_Separator : keysym = 0xFFAC let _KP_Subtract : keysym = 0xFFAD let _KP_Decimal : keysym = 0xFFAE let _KP_Divide : keysym = 0xFFAF let _KP_0 : keysym = 0xFFB0 let _KP_1 : keysym = 0xFFB1 let _KP_2 : keysym = 0xFFB2 let _KP_3 : keysym = 0xFFB3 let _KP_4 : keysym = 0xFFB4 let _KP_5 : keysym = 0xFFB5 let _KP_6 : keysym = 0xFFB6 let _KP_7 : keysym = 0xFFB7 let _KP_8 : keysym = 0xFFB8 let _KP_9 : keysym = 0xFFB9 let _F1 : keysym = 0xFFBE let _F2 : keysym = 0xFFBF let _F3 : keysym = 0xFFC0 let _F4 : keysym = 0xFFC1 let _F5 : keysym = 0xFFC2 let _F6 : keysym = 0xFFC3 let _F7 : keysym = 0xFFC4 let _F8 : keysym = 0xFFC5 let _F9 : keysym = 0xFFC6 let _F10 : keysym = 0xFFC7 let _F11 : keysym = 0xFFC8 let _L1 : keysym = 0xFFC8 let _F12 : keysym = 0xFFC9 let _L2 : keysym = 0xFFC9 let _F13 : keysym = 0xFFCA let _L3 : keysym = 0xFFCA let _F14 : keysym = 0xFFCB let _L4 : keysym = 0xFFCB let _F15 : keysym = 0xFFCC let _L5 : keysym = 0xFFCC let _F16 : keysym = 0xFFCD let _L6 : keysym = 0xFFCD let _F17 : keysym = 0xFFCE let _L7 : keysym = 0xFFCE let _F18 : keysym = 0xFFCF let _L8 : keysym = 0xFFCF let _F19 : keysym = 0xFFD0 let _L9 : keysym = 0xFFD0 let _F20 : keysym = 0xFFD1 let _L10 : keysym = 0xFFD1 let _F21 : keysym = 0xFFD2 let _R1 : keysym = 0xFFD2 let _F22 : keysym = 0xFFD3 let _R2 : keysym = 0xFFD3 let _F23 : keysym = 0xFFD4 let _R3 : keysym = 0xFFD4 let _F24 : keysym = 0xFFD5 let _R4 : keysym = 0xFFD5 let _F25 : keysym = 0xFFD6 let _R5 : keysym = 0xFFD6 let _F26 : keysym = 0xFFD7 let _R6 : keysym = 0xFFD7 let _F27 : keysym = 0xFFD8 let _R7 : keysym = 0xFFD8 let _F28 : keysym = 0xFFD9 let _R8 : keysym = 0xFFD9 let _F29 : keysym = 0xFFDA let _R9 : keysym = 0xFFDA let _F30 : keysym = 0xFFDB let _R10 : keysym = 0xFFDB let _F31 : keysym = 0xFFDC let _R11 : keysym = 0xFFDC let _F32 : keysym = 0xFFDD let _R12 : keysym = 0xFFDD let _F33 : keysym = 0xFFDE let _R13 : keysym = 0xFFDE let _F34 : keysym = 0xFFDF let _R14 : keysym = 0xFFDF let _F35 : keysym = 0xFFE0 let _R15 : keysym = 0xFFE0 let _Shift_L : keysym = 0xFFE1 let _Shift_R : keysym = 0xFFE2 let _Control_L : keysym = 0xFFE3 let _Control_R : keysym = 0xFFE4 let _Caps_Lock : keysym = 0xFFE5 let _Shift_Lock : keysym = 0xFFE6 let _Meta_L : keysym = 0xFFE7 let _Meta_R : keysym = 0xFFE8 let _Alt_L : keysym = 0xFFE9 let _Alt_R : keysym = 0xFFEA let _Super_L : keysym = 0xFFEB let _Super_R : keysym = 0xFFEC let _Hyper_L : keysym = 0xFFED let _Hyper_R : keysym = 0xFFEE let _ISO_Lock : keysym = 0xFE01 let _ISO_Level2_Latch : keysym = 0xFE02 let _ISO_Level3_Shift : keysym = 0xFE03 let _ISO_Level3_Latch : keysym = 0xFE04 let _ISO_Level3_Lock : keysym = 0xFE05 let _ISO_Group_Shift : keysym = 0xFF7E let _ISO_Group_Latch : keysym = 0xFE06 let _ISO_Group_Lock : keysym = 0xFE07 let _ISO_Next_Group : keysym = 0xFE08 let _ISO_Next_Group_Lock : keysym = 0xFE09 let _ISO_Prev_Group : keysym = 0xFE0A let _ISO_Prev_Group_Lock : keysym = 0xFE0B let _ISO_First_Group : keysym = 0xFE0C let _ISO_First_Group_Lock : keysym = 0xFE0D let _ISO_Last_Group : keysym = 0xFE0E let _ISO_Last_Group_Lock : keysym = 0xFE0F let _ISO_Left_Tab : keysym = 0xFE20 let _ISO_Move_Line_Up : keysym = 0xFE21 let _ISO_Move_Line_Down : keysym = 0xFE22 let _ISO_Partial_Line_Up : keysym = 0xFE23 let _ISO_Partial_Line_Down : keysym = 0xFE24 let _ISO_Partial_Space_Left : keysym = 0xFE25 let _ISO_Partial_Space_Right : keysym = 0xFE26 let _ISO_Set_Margin_Left : keysym = 0xFE27 let _ISO_Set_Margin_Right : keysym = 0xFE28 let _ISO_Release_Margin_Left : keysym = 0xFE29 let _ISO_Release_Margin_Right : keysym = 0xFE2A let _ISO_Release_Both_Margins : keysym = 0xFE2B let _ISO_Fast_Cursor_Left : keysym = 0xFE2C let _ISO_Fast_Cursor_Right : keysym = 0xFE2D let _ISO_Fast_Cursor_Up : keysym = 0xFE2E let _ISO_Fast_Cursor_Down : keysym = 0xFE2F let _ISO_Continuous_Underline : keysym = 0xFE30 let _ISO_Discontinuous_Underline : keysym = 0xFE31 let _ISO_Emphasize : keysym = 0xFE32 let _ISO_Center_Object : keysym = 0xFE33 let _ISO_Enter : keysym = 0xFE34 let _dead_grave : keysym = 0xFE50 let _dead_acute : keysym = 0xFE51 let _dead_circumflex : keysym = 0xFE52 let _dead_tilde : keysym = 0xFE53 let _dead_macron : keysym = 0xFE54 let _dead_breve : keysym = 0xFE55 let _dead_abovedot : keysym = 0xFE56 let _dead_diaeresis : keysym = 0xFE57 let _dead_abovering : keysym = 0xFE58 let _dead_doubleacute : keysym = 0xFE59 let _dead_caron : keysym = 0xFE5A let _dead_cedilla : keysym = 0xFE5B let _dead_ogonek : keysym = 0xFE5C let _dead_iota : keysym = 0xFE5D let _dead_voiced_sound : keysym = 0xFE5E let _dead_semivoiced_sound : keysym = 0xFE5F let _dead_belowdot : keysym = 0xFE60 let _First_Virtual_Screen : keysym = 0xFED0 let _Prev_Virtual_Screen : keysym = 0xFED1 let _Next_Virtual_Screen : keysym = 0xFED2 let _Last_Virtual_Screen : keysym = 0xFED4 let _Terminate_Server : keysym = 0xFED5 let _AccessX_Enable : keysym = 0xFE70 let _AccessX_Feedback_Enable : keysym = 0xFE71 let _RepeatKeys_Enable : keysym = 0xFE72 let _SlowKeys_Enable : keysym = 0xFE73 let _BounceKeys_Enable : keysym = 0xFE74 let _StickyKeys_Enable : keysym = 0xFE75 let _MouseKeys_Enable : keysym = 0xFE76 let _MouseKeys_Accel_Enable : keysym = 0xFE77 let _Overlay1_Enable : keysym = 0xFE78 let _Overlay2_Enable : keysym = 0xFE79 let _AudibleBell_Enable : keysym = 0xFE7A let _Pointer_Left : keysym = 0xFEE0 let _Pointer_Right : keysym = 0xFEE1 let _Pointer_Up : keysym = 0xFEE2 let _Pointer_Down : keysym = 0xFEE3 let _Pointer_UpLeft : keysym = 0xFEE4 let _Pointer_UpRight : keysym = 0xFEE5 let _Pointer_DownLeft : keysym = 0xFEE6 let _Pointer_DownRight : keysym = 0xFEE7 let _Pointer_Button_Dflt : keysym = 0xFEE8 let _Pointer_Button1 : keysym = 0xFEE9 let _Pointer_Button2 : keysym = 0xFEEA let _Pointer_Button3 : keysym = 0xFEEB let _Pointer_Button4 : keysym = 0xFEEC let _Pointer_Button5 : keysym = 0xFEED let _Pointer_DblClick_Dflt : keysym = 0xFEEE let _Pointer_DblClick1 : keysym = 0xFEEF let _Pointer_DblClick2 : keysym = 0xFEF0 let _Pointer_DblClick3 : keysym = 0xFEF1 let _Pointer_DblClick4 : keysym = 0xFEF2 let _Pointer_DblClick5 : keysym = 0xFEF3 let _Pointer_Drag_Dflt : keysym = 0xFEF4 let _Pointer_Drag1 : keysym = 0xFEF5 let _Pointer_Drag2 : keysym = 0xFEF6 let _Pointer_Drag3 : keysym = 0xFEF7 let _Pointer_Drag4 : keysym = 0xFEF8 let _Pointer_Drag5 : keysym = 0xFEFD let _Pointer_EnableKeys : keysym = 0xFEF9 let _Pointer_Accelerate : keysym = 0xFEFA let _Pointer_DfltBtnNext : keysym = 0xFEFB let _Pointer_DfltBtnPrev : keysym = 0xFEFC let _3270_Duplicate : keysym = 0xFD01 let _3270_FieldMark : keysym = 0xFD02 let _3270_Right2 : keysym = 0xFD03 let _3270_Left2 : keysym = 0xFD04 let _3270_BackTab : keysym = 0xFD05 let _3270_EraseEOF : keysym = 0xFD06 let _3270_EraseInput : keysym = 0xFD07 let _3270_Reset : keysym = 0xFD08 let _3270_Quit : keysym = 0xFD09 let _3270_PA1 : keysym = 0xFD0A let _3270_PA2 : keysym = 0xFD0B let _3270_PA3 : keysym = 0xFD0C let _3270_Test : keysym = 0xFD0D let _3270_Attn : keysym = 0xFD0E let _3270_CursorBlink : keysym = 0xFD0F let _3270_AltCursor : keysym = 0xFD10 let _3270_KeyClick : keysym = 0xFD11 let _3270_Jump : keysym = 0xFD12 let _3270_Ident : keysym = 0xFD13 let _3270_Rule : keysym = 0xFD14 let _3270_Copy : keysym = 0xFD15 let _3270_Play : keysym = 0xFD16 let _3270_Setup : keysym = 0xFD17 let _3270_Record : keysym = 0xFD18 let _3270_ChangeScreen : keysym = 0xFD19 let _3270_DeleteWord : keysym = 0xFD1A let _3270_ExSelect : keysym = 0xFD1B let _3270_CursorSelect : keysym = 0xFD1C let _3270_PrintScreen : keysym = 0xFD1D let _3270_Enter : keysym = 0xFD1E let _space : keysym = 0x020 let _exclam : keysym = 0x021 let _quotedbl : keysym = 0x022 let _numbersign : keysym = 0x023 let _dollar : keysym = 0x024 let _percent : keysym = 0x025 let _ampersand : keysym = 0x026 let _apostrophe : keysym = 0x027 let _quoteright : keysym = 0x027 let _parenleft : keysym = 0x028 let _parenright : keysym = 0x029 let _asterisk : keysym = 0x02a let _plus : keysym = 0x02b let _comma : keysym = 0x02c let _minus : keysym = 0x02d let _period : keysym = 0x02e let _slash : keysym = 0x02f let _0 : keysym = 0x030 let _1 : keysym = 0x031 let _2 : keysym = 0x032 let _3 : keysym = 0x033 let _4 : keysym = 0x034 let _5 : keysym = 0x035 let _6 : keysym = 0x036 let _7 : keysym = 0x037 let _8 : keysym = 0x038 let _9 : keysym = 0x039 let _colon : keysym = 0x03a let _semicolon : keysym = 0x03b let _less : keysym = 0x03c let _equal : keysym = 0x03d let _greater : keysym = 0x03e let _question : keysym = 0x03f let _at : keysym = 0x040 let _A : keysym = 0x041 let _B : keysym = 0x042 let _C : keysym = 0x043 let _D : keysym = 0x044 let _E : keysym = 0x045 let _F : keysym = 0x046 let _G : keysym = 0x047 let _H : keysym = 0x048 let _I : keysym = 0x049 let _J : keysym = 0x04a let _K : keysym = 0x04b let _L : keysym = 0x04c let _M : keysym = 0x04d let _N : keysym = 0x04e let _O : keysym = 0x04f let _P : keysym = 0x050 let _Q : keysym = 0x051 let _R : keysym = 0x052 let _S : keysym = 0x053 let _T : keysym = 0x054 let _U : keysym = 0x055 let _V : keysym = 0x056 let _W : keysym = 0x057 let _X : keysym = 0x058 let _Y : keysym = 0x059 let _Z : keysym = 0x05a let _bracketleft : keysym = 0x05b let _backslash : keysym = 0x05c let _bracketright : keysym = 0x05d let _asciicircum : keysym = 0x05e let _underscore : keysym = 0x05f let _grave : keysym = 0x060 let _quoteleft : keysym = 0x060 let _a : keysym = 0x061 let _b : keysym = 0x062 let _c : keysym = 0x063 let _d : keysym = 0x064 let _e : keysym = 0x065 let _f : keysym = 0x066 let _g : keysym = 0x067 let _h : keysym = 0x068 let _i : keysym = 0x069 let _j : keysym = 0x06a let _k : keysym = 0x06b let _l : keysym = 0x06c let _m : keysym = 0x06d let _n : keysym = 0x06e let _o : keysym = 0x06f let _p : keysym = 0x070 let _q : keysym = 0x071 let _r : keysym = 0x072 let _s : keysym = 0x073 let _t : keysym = 0x074 let _u : keysym = 0x075 let _v : keysym = 0x076 let _w : keysym = 0x077 let _x : keysym = 0x078 let _y : keysym = 0x079 let _z : keysym = 0x07a let _braceleft : keysym = 0x07b let _bar : keysym = 0x07c let _braceright : keysym = 0x07d let _asciitilde : keysym = 0x07e let _nobreakspace : keysym = 0x0a0 let _exclamdown : keysym = 0x0a1 let _cent : keysym = 0x0a2 let _sterling : keysym = 0x0a3 let _currency : keysym = 0x0a4 let _yen : keysym = 0x0a5 let _brokenbar : keysym = 0x0a6 let _section : keysym = 0x0a7 let _diaeresis : keysym = 0x0a8 let _copyright : keysym = 0x0a9 let _ordfeminine : keysym = 0x0aa let _guillemotleft : keysym = 0x0ab let _notsign : keysym = 0x0ac let _hyphen : keysym = 0x0ad let _registered : keysym = 0x0ae let _macron : keysym = 0x0af let _degree : keysym = 0x0b0 let _plusminus : keysym = 0x0b1 let _twosuperior : keysym = 0x0b2 let _threesuperior : keysym = 0x0b3 let _acute : keysym = 0x0b4 let _mu : keysym = 0x0b5 let _paragraph : keysym = 0x0b6 let _periodcentered : keysym = 0x0b7 let _cedilla : keysym = 0x0b8 let _onesuperior : keysym = 0x0b9 let _masculine : keysym = 0x0ba let _guillemotright : keysym = 0x0bb let _onequarter : keysym = 0x0bc let _onehalf : keysym = 0x0bd let _threequarters : keysym = 0x0be let _questiondown : keysym = 0x0bf let _Agrave : keysym = 0x0c0 let _Aacute : keysym = 0x0c1 let _Acircumflex : keysym = 0x0c2 let _Atilde : keysym = 0x0c3 let _Adiaeresis : keysym = 0x0c4 let _Aring : keysym = 0x0c5 let _AE : keysym = 0x0c6 let _Ccedilla : keysym = 0x0c7 let _Egrave : keysym = 0x0c8 let _Eacute : keysym = 0x0c9 let _Ecircumflex : keysym = 0x0ca let _Ediaeresis : keysym = 0x0cb let _Igrave : keysym = 0x0cc let _Iacute : keysym = 0x0cd let _Icircumflex : keysym = 0x0ce let _Idiaeresis : keysym = 0x0cf let _ETH : keysym = 0x0d0 let _Eth : keysym = 0x0d0 let _Ntilde : keysym = 0x0d1 let _Ograve : keysym = 0x0d2 let _Oacute : keysym = 0x0d3 let _Ocircumflex : keysym = 0x0d4 let _Otilde : keysym = 0x0d5 let _Odiaeresis : keysym = 0x0d6 let _multiply : keysym = 0x0d7 let _Ooblique : keysym = 0x0d8 let _Ugrave : keysym = 0x0d9 let _Uacute : keysym = 0x0da let _Ucircumflex : keysym = 0x0db let _Udiaeresis : keysym = 0x0dc let _Yacute : keysym = 0x0dd let _THORN : keysym = 0x0de let _Thorn : keysym = 0x0de let _ssharp : keysym = 0x0df let _agrave : keysym = 0x0e0 let _aacute : keysym = 0x0e1 let _acircumflex : keysym = 0x0e2 let _atilde : keysym = 0x0e3 let _adiaeresis : keysym = 0x0e4 let _aring : keysym = 0x0e5 let _ae : keysym = 0x0e6 let _ccedilla : keysym = 0x0e7 let _egrave : keysym = 0x0e8 let _eacute : keysym = 0x0e9 let _ecircumflex : keysym = 0x0ea let _ediaeresis : keysym = 0x0eb let _igrave : keysym = 0x0ec let _iacute : keysym = 0x0ed let _icircumflex : keysym = 0x0ee let _idiaeresis : keysym = 0x0ef let _eth : keysym = 0x0f0 let _ntilde : keysym = 0x0f1 let _ograve : keysym = 0x0f2 let _oacute : keysym = 0x0f3 let _ocircumflex : keysym = 0x0f4 let _otilde : keysym = 0x0f5 let _odiaeresis : keysym = 0x0f6 let _division : keysym = 0x0f7 let _oslash : keysym = 0x0f8 let _ugrave : keysym = 0x0f9 let _uacute : keysym = 0x0fa let _ucircumflex : keysym = 0x0fb let _udiaeresis : keysym = 0x0fc let _yacute : keysym = 0x0fd let _thorn : keysym = 0x0fe let _ydiaeresis : keysym = 0x0ff let _Aogonek : keysym = 0x1a1 let _breve : keysym = 0x1a2 let _Lstroke : keysym = 0x1a3 let _Lcaron : keysym = 0x1a5 let _Sacute : keysym = 0x1a6 let _Scaron : keysym = 0x1a9 let _Scedilla : keysym = 0x1aa let _Tcaron : keysym = 0x1ab let _Zacute : keysym = 0x1ac let _Zcaron : keysym = 0x1ae let _Zabovedot : keysym = 0x1af let _aogonek : keysym = 0x1b1 let _ogonek : keysym = 0x1b2 let _lstroke : keysym = 0x1b3 let _lcaron : keysym = 0x1b5 let _sacute : keysym = 0x1b6 let _caron : keysym = 0x1b7 let _scaron : keysym = 0x1b9 let _scedilla : keysym = 0x1ba let _tcaron : keysym = 0x1bb let _zacute : keysym = 0x1bc let _doubleacute : keysym = 0x1bd let _zcaron : keysym = 0x1be let _zabovedot : keysym = 0x1bf let _Racute : keysym = 0x1c0 let _Abreve : keysym = 0x1c3 let _Lacute : keysym = 0x1c5 let _Cacute : keysym = 0x1c6 let _Ccaron : keysym = 0x1c8 let _Eogonek : keysym = 0x1ca let _Ecaron : keysym = 0x1cc let _Dcaron : keysym = 0x1cf let _Dstroke : keysym = 0x1d0 let _Nacute : keysym = 0x1d1 let _Ncaron : keysym = 0x1d2 let _Odoubleacute : keysym = 0x1d5 let _Rcaron : keysym = 0x1d8 let _Uring : keysym = 0x1d9 let _Udoubleacute : keysym = 0x1db let _Tcedilla : keysym = 0x1de let _racute : keysym = 0x1e0 let _abreve : keysym = 0x1e3 let _lacute : keysym = 0x1e5 let _cacute : keysym = 0x1e6 let _ccaron : keysym = 0x1e8 let _eogonek : keysym = 0x1ea let _ecaron : keysym = 0x1ec let _dcaron : keysym = 0x1ef let _dstroke : keysym = 0x1f0 let _nacute : keysym = 0x1f1 let _ncaron : keysym = 0x1f2 let _odoubleacute : keysym = 0x1f5 let _udoubleacute : keysym = 0x1fb let _rcaron : keysym = 0x1f8 let _uring : keysym = 0x1f9 let _tcedilla : keysym = 0x1fe let _abovedot : keysym = 0x1ff let _Hstroke : keysym = 0x2a1 let _Hcircumflex : keysym = 0x2a6 let _Iabovedot : keysym = 0x2a9 let _Gbreve : keysym = 0x2ab let _Jcircumflex : keysym = 0x2ac let _hstroke : keysym = 0x2b1 let _hcircumflex : keysym = 0x2b6 let _idotless : keysym = 0x2b9 let _gbreve : keysym = 0x2bb let _jcircumflex : keysym = 0x2bc let _Cabovedot : keysym = 0x2c5 let _Ccircumflex : keysym = 0x2c6 let _Gabovedot : keysym = 0x2d5 let _Gcircumflex : keysym = 0x2d8 let _Ubreve : keysym = 0x2dd let _Scircumflex : keysym = 0x2de let _cabovedot : keysym = 0x2e5 let _ccircumflex : keysym = 0x2e6 let _gabovedot : keysym = 0x2f5 let _gcircumflex : keysym = 0x2f8 let _ubreve : keysym = 0x2fd let _scircumflex : keysym = 0x2fe let _kra : keysym = 0x3a2 let _kappa : keysym = 0x3a2 let _Rcedilla : keysym = 0x3a3 let _Itilde : keysym = 0x3a5 let _Lcedilla : keysym = 0x3a6 let _Emacron : keysym = 0x3aa let _Gcedilla : keysym = 0x3ab let _Tslash : keysym = 0x3ac let _rcedilla : keysym = 0x3b3 let _itilde : keysym = 0x3b5 let _lcedilla : keysym = 0x3b6 let _emacron : keysym = 0x3ba let _gcedilla : keysym = 0x3bb let _tslash : keysym = 0x3bc let _ENG : keysym = 0x3bd let _eng : keysym = 0x3bf let _Amacron : keysym = 0x3c0 let _Iogonek : keysym = 0x3c7 let _Eabovedot : keysym = 0x3cc let _Imacron : keysym = 0x3cf let _Ncedilla : keysym = 0x3d1 let _Omacron : keysym = 0x3d2 let _Kcedilla : keysym = 0x3d3 let _Uogonek : keysym = 0x3d9 let _Utilde : keysym = 0x3dd let _Umacron : keysym = 0x3de let _amacron : keysym = 0x3e0 let _iogonek : keysym = 0x3e7 let _eabovedot : keysym = 0x3ec let _imacron : keysym = 0x3ef let _ncedilla : keysym = 0x3f1 let _omacron : keysym = 0x3f2 let _kcedilla : keysym = 0x3f3 let _uogonek : keysym = 0x3f9 let _utilde : keysym = 0x3fd let _umacron : keysym = 0x3fe let _overline : keysym = 0x47e let _kana_fullstop : keysym = 0x4a1 let _kana_openingbracket : keysym = 0x4a2 let _kana_closingbracket : keysym = 0x4a3 let _kana_comma : keysym = 0x4a4 let _kana_conjunctive : keysym = 0x4a5 let _kana_middledot : keysym = 0x4a5 let _kana_WO : keysym = 0x4a6 let _kana_a : keysym = 0x4a7 let _kana_i : keysym = 0x4a8 let _kana_u : keysym = 0x4a9 let _kana_e : keysym = 0x4aa let _kana_o : keysym = 0x4ab let _kana_ya : keysym = 0x4ac let _kana_yu : keysym = 0x4ad let _kana_yo : keysym = 0x4ae let _kana_tsu : keysym = 0x4af let _kana_tu : keysym = 0x4af let _prolongedsound : keysym = 0x4b0 let _kana_A : keysym = 0x4b1 let _kana_I : keysym = 0x4b2 let _kana_U : keysym = 0x4b3 let _kana_E : keysym = 0x4b4 let _kana_O : keysym = 0x4b5 let _kana_KA : keysym = 0x4b6 let _kana_KI : keysym = 0x4b7 let _kana_KU : keysym = 0x4b8 let _kana_KE : keysym = 0x4b9 let _kana_KO : keysym = 0x4ba let _kana_SA : keysym = 0x4bb let _kana_SHI : keysym = 0x4bc let _kana_SU : keysym = 0x4bd let _kana_SE : keysym = 0x4be let _kana_SO : keysym = 0x4bf let _kana_TA : keysym = 0x4c0 let _kana_CHI : keysym = 0x4c1 let _kana_TI : keysym = 0x4c1 let _kana_TSU : keysym = 0x4c2 let _kana_TU : keysym = 0x4c2 let _kana_TE : keysym = 0x4c3 let _kana_TO : keysym = 0x4c4 let _kana_NA : keysym = 0x4c5 let _kana_NI : keysym = 0x4c6 let _kana_NU : keysym = 0x4c7 let _kana_NE : keysym = 0x4c8 let _kana_NO : keysym = 0x4c9 let _kana_HA : keysym = 0x4ca let _kana_HI : keysym = 0x4cb let _kana_FU : keysym = 0x4cc let _kana_HU : keysym = 0x4cc let _kana_HE : keysym = 0x4cd let _kana_HO : keysym = 0x4ce let _kana_MA : keysym = 0x4cf let _kana_MI : keysym = 0x4d0 let _kana_MU : keysym = 0x4d1 let _kana_ME : keysym = 0x4d2 let _kana_MO : keysym = 0x4d3 let _kana_YA : keysym = 0x4d4 let _kana_YU : keysym = 0x4d5 let _kana_YO : keysym = 0x4d6 let _kana_RA : keysym = 0x4d7 let _kana_RI : keysym = 0x4d8 let _kana_RU : keysym = 0x4d9 let _kana_RE : keysym = 0x4da let _kana_RO : keysym = 0x4db let _kana_WA : keysym = 0x4dc let _kana_N : keysym = 0x4dd let _voicedsound : keysym = 0x4de let _semivoicedsound : keysym = 0x4df let _kana_switch : keysym = 0xFF7E let _Arabic_comma : keysym = 0x5ac let _Arabic_semicolon : keysym = 0x5bb let _Arabic_question_mark : keysym = 0x5bf let _Arabic_hamza : keysym = 0x5c1 let _Arabic_maddaonalef : keysym = 0x5c2 let _Arabic_hamzaonalef : keysym = 0x5c3 let _Arabic_hamzaonwaw : keysym = 0x5c4 let _Arabic_hamzaunderalef : keysym = 0x5c5 let _Arabic_hamzaonyeh : keysym = 0x5c6 let _Arabic_alef : keysym = 0x5c7 let _Arabic_beh : keysym = 0x5c8 let _Arabic_tehmarbuta : keysym = 0x5c9 let _Arabic_teh : keysym = 0x5ca let _Arabic_theh : keysym = 0x5cb let _Arabic_jeem : keysym = 0x5cc let _Arabic_hah : keysym = 0x5cd let _Arabic_khah : keysym = 0x5ce let _Arabic_dal : keysym = 0x5cf let _Arabic_thal : keysym = 0x5d0 let _Arabic_ra : keysym = 0x5d1 let _Arabic_zain : keysym = 0x5d2 let _Arabic_seen : keysym = 0x5d3 let _Arabic_sheen : keysym = 0x5d4 let _Arabic_sad : keysym = 0x5d5 let _Arabic_dad : keysym = 0x5d6 let _Arabic_tah : keysym = 0x5d7 let _Arabic_zah : keysym = 0x5d8 let _Arabic_ain : keysym = 0x5d9 let _Arabic_ghain : keysym = 0x5da let _Arabic_tatweel : keysym = 0x5e0 let _Arabic_feh : keysym = 0x5e1 let _Arabic_qaf : keysym = 0x5e2 let _Arabic_kaf : keysym = 0x5e3 let _Arabic_lam : keysym = 0x5e4 let _Arabic_meem : keysym = 0x5e5 let _Arabic_noon : keysym = 0x5e6 let _Arabic_ha : keysym = 0x5e7 let _Arabic_heh : keysym = 0x5e7 let _Arabic_waw : keysym = 0x5e8 let _Arabic_alefmaksura : keysym = 0x5e9 let _Arabic_yeh : keysym = 0x5ea let _Arabic_fathatan : keysym = 0x5eb let _Arabic_dammatan : keysym = 0x5ec let _Arabic_kasratan : keysym = 0x5ed let _Arabic_fatha : keysym = 0x5ee let _Arabic_damma : keysym = 0x5ef let _Arabic_kasra : keysym = 0x5f0 let _Arabic_shadda : keysym = 0x5f1 let _Arabic_sukun : keysym = 0x5f2 let _Arabic_switch : keysym = 0xFF7E let _Serbian_dje : keysym = 0x6a1 let _Macedonia_gje : keysym = 0x6a2 let _Cyrillic_io : keysym = 0x6a3 let _Ukrainian_ie : keysym = 0x6a4 let _Ukranian_je : keysym = 0x6a4 let _Macedonia_dse : keysym = 0x6a5 let _Ukrainian_i : keysym = 0x6a6 let _Ukranian_i : keysym = 0x6a6 let _Ukrainian_yi : keysym = 0x6a7 let _Ukranian_yi : keysym = 0x6a7 let _Cyrillic_je : keysym = 0x6a8 let _Serbian_je : keysym = 0x6a8 let _Cyrillic_lje : keysym = 0x6a9 let _Serbian_lje : keysym = 0x6a9 let _Cyrillic_nje : keysym = 0x6aa let _Serbian_nje : keysym = 0x6aa let _Serbian_tshe : keysym = 0x6ab let _Macedonia_kje : keysym = 0x6ac let _Byelorussian_shortu : keysym = 0x6ae let _Cyrillic_dzhe : keysym = 0x6af let _Serbian_dze : keysym = 0x6af let _numerosign : keysym = 0x6b0 let _Serbian_DJE : keysym = 0x6b1 let _Macedonia_GJE : keysym = 0x6b2 let _Cyrillic_IO : keysym = 0x6b3 let _Ukrainian_IE : keysym = 0x6b4 let _Ukranian_JE : keysym = 0x6b4 let _Macedonia_DSE : keysym = 0x6b5 let _Ukrainian_I : keysym = 0x6b6 let _Ukranian_I : keysym = 0x6b6 let _Ukrainian_YI : keysym = 0x6b7 let _Ukranian_YI : keysym = 0x6b7 let _Cyrillic_JE : keysym = 0x6b8 let _Serbian_JE : keysym = 0x6b8 let _Cyrillic_LJE : keysym = 0x6b9 let _Serbian_LJE : keysym = 0x6b9 let _Cyrillic_NJE : keysym = 0x6ba let _Serbian_NJE : keysym = 0x6ba let _Serbian_TSHE : keysym = 0x6bb let _Macedonia_KJE : keysym = 0x6bc let _Byelorussian_SHORTU : keysym = 0x6be let _Cyrillic_DZHE : keysym = 0x6bf let _Serbian_DZE : keysym = 0x6bf let _Cyrillic_yu : keysym = 0x6c0 let _Cyrillic_a : keysym = 0x6c1 let _Cyrillic_be : keysym = 0x6c2 let _Cyrillic_tse : keysym = 0x6c3 let _Cyrillic_de : keysym = 0x6c4 let _Cyrillic_ie : keysym = 0x6c5 let _Cyrillic_ef : keysym = 0x6c6 let _Cyrillic_ghe : keysym = 0x6c7 let _Cyrillic_ha : keysym = 0x6c8 let _Cyrillic_i : keysym = 0x6c9 let _Cyrillic_shorti : keysym = 0x6ca let _Cyrillic_ka : keysym = 0x6cb let _Cyrillic_el : keysym = 0x6cc let _Cyrillic_em : keysym = 0x6cd let _Cyrillic_en : keysym = 0x6ce let _Cyrillic_o : keysym = 0x6cf let _Cyrillic_pe : keysym = 0x6d0 let _Cyrillic_ya : keysym = 0x6d1 let _Cyrillic_er : keysym = 0x6d2 let _Cyrillic_es : keysym = 0x6d3 let _Cyrillic_te : keysym = 0x6d4 let _Cyrillic_u : keysym = 0x6d5 let _Cyrillic_zhe : keysym = 0x6d6 let _Cyrillic_ve : keysym = 0x6d7 let _Cyrillic_softsign : keysym = 0x6d8 let _Cyrillic_yeru : keysym = 0x6d9 let _Cyrillic_ze : keysym = 0x6da let _Cyrillic_sha : keysym = 0x6db let _Cyrillic_e : keysym = 0x6dc let _Cyrillic_shcha : keysym = 0x6dd let _Cyrillic_che : keysym = 0x6de let _Cyrillic_hardsign : keysym = 0x6df let _Cyrillic_YU : keysym = 0x6e0 let _Cyrillic_A : keysym = 0x6e1 let _Cyrillic_BE : keysym = 0x6e2 let _Cyrillic_TSE : keysym = 0x6e3 let _Cyrillic_DE : keysym = 0x6e4 let _Cyrillic_IE : keysym = 0x6e5 let _Cyrillic_EF : keysym = 0x6e6 let _Cyrillic_GHE : keysym = 0x6e7 let _Cyrillic_HA : keysym = 0x6e8 let _Cyrillic_I : keysym = 0x6e9 let _Cyrillic_SHORTI : keysym = 0x6ea let _Cyrillic_KA : keysym = 0x6eb let _Cyrillic_EL : keysym = 0x6ec let _Cyrillic_EM : keysym = 0x6ed let _Cyrillic_EN : keysym = 0x6ee let _Cyrillic_O : keysym = 0x6ef let _Cyrillic_PE : keysym = 0x6f0 let _Cyrillic_YA : keysym = 0x6f1 let _Cyrillic_ER : keysym = 0x6f2 let _Cyrillic_ES : keysym = 0x6f3 let _Cyrillic_TE : keysym = 0x6f4 let _Cyrillic_U : keysym = 0x6f5 let _Cyrillic_ZHE : keysym = 0x6f6 let _Cyrillic_VE : keysym = 0x6f7 let _Cyrillic_SOFTSIGN : keysym = 0x6f8 let _Cyrillic_YERU : keysym = 0x6f9 let _Cyrillic_ZE : keysym = 0x6fa let _Cyrillic_SHA : keysym = 0x6fb let _Cyrillic_E : keysym = 0x6fc let _Cyrillic_SHCHA : keysym = 0x6fd let _Cyrillic_CHE : keysym = 0x6fe let _Cyrillic_HARDSIGN : keysym = 0x6ff let _Greek_ALPHAaccent : keysym = 0x7a1 let _Greek_EPSILONaccent : keysym = 0x7a2 let _Greek_ETAaccent : keysym = 0x7a3 let _Greek_IOTAaccent : keysym = 0x7a4 let _Greek_IOTAdiaeresis : keysym = 0x7a5 let _Greek_OMICRONaccent : keysym = 0x7a7 let _Greek_UPSILONaccent : keysym = 0x7a8 let _Greek_UPSILONdieresis : keysym = 0x7a9 let _Greek_OMEGAaccent : keysym = 0x7ab let _Greek_accentdieresis : keysym = 0x7ae let _Greek_horizbar : keysym = 0x7af let _Greek_alphaaccent : keysym = 0x7b1 let _Greek_epsilonaccent : keysym = 0x7b2 let _Greek_etaaccent : keysym = 0x7b3 let _Greek_iotaaccent : keysym = 0x7b4 let _Greek_iotadieresis : keysym = 0x7b5 let _Greek_iotaaccentdieresis : keysym = 0x7b6 let _Greek_omicronaccent : keysym = 0x7b7 let _Greek_upsilonaccent : keysym = 0x7b8 let _Greek_upsilondieresis : keysym = 0x7b9 let _Greek_upsilonaccentdieresis : keysym = 0x7ba let _Greek_omegaaccent : keysym = 0x7bb let _Greek_ALPHA : keysym = 0x7c1 let _Greek_BETA : keysym = 0x7c2 let _Greek_GAMMA : keysym = 0x7c3 let _Greek_DELTA : keysym = 0x7c4 let _Greek_EPSILON : keysym = 0x7c5 let _Greek_ZETA : keysym = 0x7c6 let _Greek_ETA : keysym = 0x7c7 let _Greek_THETA : keysym = 0x7c8 let _Greek_IOTA : keysym = 0x7c9 let _Greek_KAPPA : keysym = 0x7ca let _Greek_LAMDA : keysym = 0x7cb let _Greek_LAMBDA : keysym = 0x7cb let _Greek_MU : keysym = 0x7cc let _Greek_NU : keysym = 0x7cd let _Greek_XI : keysym = 0x7ce let _Greek_OMICRON : keysym = 0x7cf let _Greek_PI : keysym = 0x7d0 let _Greek_RHO : keysym = 0x7d1 let _Greek_SIGMA : keysym = 0x7d2 let _Greek_TAU : keysym = 0x7d4 let _Greek_UPSILON : keysym = 0x7d5 let _Greek_PHI : keysym = 0x7d6 let _Greek_CHI : keysym = 0x7d7 let _Greek_PSI : keysym = 0x7d8 let _Greek_OMEGA : keysym = 0x7d9 let _Greek_alpha : keysym = 0x7e1 let _Greek_beta : keysym = 0x7e2 let _Greek_gamma : keysym = 0x7e3 let _Greek_delta : keysym = 0x7e4 let _Greek_epsilon : keysym = 0x7e5 let _Greek_zeta : keysym = 0x7e6 let _Greek_eta : keysym = 0x7e7 let _Greek_theta : keysym = 0x7e8 let _Greek_iota : keysym = 0x7e9 let _Greek_kappa : keysym = 0x7ea let _Greek_lamda : keysym = 0x7eb let _Greek_lambda : keysym = 0x7eb let _Greek_mu : keysym = 0x7ec let _Greek_nu : keysym = 0x7ed let _Greek_xi : keysym = 0x7ee let _Greek_omicron : keysym = 0x7ef let _Greek_pi : keysym = 0x7f0 let _Greek_rho : keysym = 0x7f1 let _Greek_sigma : keysym = 0x7f2 let _Greek_finalsmallsigma : keysym = 0x7f3 let _Greek_tau : keysym = 0x7f4 let _Greek_upsilon : keysym = 0x7f5 let _Greek_phi : keysym = 0x7f6 let _Greek_chi : keysym = 0x7f7 let _Greek_psi : keysym = 0x7f8 let _Greek_omega : keysym = 0x7f9 let _Greek_switch : keysym = 0xFF7E let _leftradical : keysym = 0x8a1 let _topleftradical : keysym = 0x8a2 let _horizconnector : keysym = 0x8a3 let _topintegral : keysym = 0x8a4 let _botintegral : keysym = 0x8a5 let _vertconnector : keysym = 0x8a6 let _topleftsqbracket : keysym = 0x8a7 let _botleftsqbracket : keysym = 0x8a8 let _toprightsqbracket : keysym = 0x8a9 let _botrightsqbracket : keysym = 0x8aa let _topleftparens : keysym = 0x8ab let _botleftparens : keysym = 0x8ac let _toprightparens : keysym = 0x8ad let _botrightparens : keysym = 0x8ae let _leftmiddlecurlybrace : keysym = 0x8af let _rightmiddlecurlybrace : keysym = 0x8b0 let _topleftsummation : keysym = 0x8b1 let _botleftsummation : keysym = 0x8b2 let _topvertsummationconnector : keysym = 0x8b3 let _botvertsummationconnector : keysym = 0x8b4 let _toprightsummation : keysym = 0x8b5 let _botrightsummation : keysym = 0x8b6 let _rightmiddlesummation : keysym = 0x8b7 let _lessthanequal : keysym = 0x8bc let _notequal : keysym = 0x8bd let _greaterthanequal : keysym = 0x8be let _integral : keysym = 0x8bf let _therefore : keysym = 0x8c0 let _variation : keysym = 0x8c1 let _infinity : keysym = 0x8c2 let _nabla : keysym = 0x8c5 let _approximate : keysym = 0x8c8 let _similarequal : keysym = 0x8c9 let _ifonlyif : keysym = 0x8cd let _implies : keysym = 0x8ce let _identical : keysym = 0x8cf let _radical : keysym = 0x8d6 let _includedin : keysym = 0x8da let _includes : keysym = 0x8db let _intersection : keysym = 0x8dc let _union : keysym = 0x8dd let _logicaland : keysym = 0x8de let _logicalor : keysym = 0x8df let _partialderivative : keysym = 0x8ef let _function : keysym = 0x8f6 let _leftarrow : keysym = 0x8fb let _uparrow : keysym = 0x8fc let _rightarrow : keysym = 0x8fd let _downarrow : keysym = 0x8fe let _blank : keysym = 0x9df let _soliddiamond : keysym = 0x9e0 let _checkerboard : keysym = 0x9e1 let _ht : keysym = 0x9e2 let _ff : keysym = 0x9e3 let _cr : keysym = 0x9e4 let _lf : keysym = 0x9e5 let _nl : keysym = 0x9e8 let _vt : keysym = 0x9e9 let _lowrightcorner : keysym = 0x9ea let _uprightcorner : keysym = 0x9eb let _upleftcorner : keysym = 0x9ec let _lowleftcorner : keysym = 0x9ed let _crossinglines : keysym = 0x9ee let _horizlinescan1 : keysym = 0x9ef let _horizlinescan3 : keysym = 0x9f0 let _horizlinescan5 : keysym = 0x9f1 let _horizlinescan7 : keysym = 0x9f2 let _horizlinescan9 : keysym = 0x9f3 let _leftt : keysym = 0x9f4 let _rightt : keysym = 0x9f5 let _bott : keysym = 0x9f6 let _topt : keysym = 0x9f7 let _vertbar : keysym = 0x9f8 let _emspace : keysym = 0xaa1 let _enspace : keysym = 0xaa2 let _em3space : keysym = 0xaa3 let _em4space : keysym = 0xaa4 let _digitspace : keysym = 0xaa5 let _punctspace : keysym = 0xaa6 let _thinspace : keysym = 0xaa7 let _hairspace : keysym = 0xaa8 let _emdash : keysym = 0xaa9 let _endash : keysym = 0xaaa let _signifblank : keysym = 0xaac let _ellipsis : keysym = 0xaae let _doubbaselinedot : keysym = 0xaaf let _onethird : keysym = 0xab0 let _twothirds : keysym = 0xab1 let _onefifth : keysym = 0xab2 let _twofifths : keysym = 0xab3 let _threefifths : keysym = 0xab4 let _fourfifths : keysym = 0xab5 let _onesixth : keysym = 0xab6 let _fivesixths : keysym = 0xab7 let _careof : keysym = 0xab8 let _figdash : keysym = 0xabb let _leftanglebracket : keysym = 0xabc let _decimalpoint : keysym = 0xabd let _rightanglebracket : keysym = 0xabe let _marker : keysym = 0xabf let _oneeighth : keysym = 0xac3 let _threeeighths : keysym = 0xac4 let _fiveeighths : keysym = 0xac5 let _seveneighths : keysym = 0xac6 let _trademark : keysym = 0xac9 let _signaturemark : keysym = 0xaca let _trademarkincircle : keysym = 0xacb let _leftopentriangle : keysym = 0xacc let _rightopentriangle : keysym = 0xacd let _emopencircle : keysym = 0xace let _emopenrectangle : keysym = 0xacf let _leftsinglequotemark : keysym = 0xad0 let _rightsinglequotemark : keysym = 0xad1 let _leftdoublequotemark : keysym = 0xad2 let _rightdoublequotemark : keysym = 0xad3 let _prescription : keysym = 0xad4 let _minutes : keysym = 0xad6 let _seconds : keysym = 0xad7 let _latincross : keysym = 0xad9 let _hexagram : keysym = 0xada let _filledrectbullet : keysym = 0xadb let _filledlefttribullet : keysym = 0xadc let _filledrighttribullet : keysym = 0xadd let _emfilledcircle : keysym = 0xade let _emfilledrect : keysym = 0xadf let _enopencircbullet : keysym = 0xae0 let _enopensquarebullet : keysym = 0xae1 let _openrectbullet : keysym = 0xae2 let _opentribulletup : keysym = 0xae3 let _opentribulletdown : keysym = 0xae4 let _openstar : keysym = 0xae5 let _enfilledcircbullet : keysym = 0xae6 let _enfilledsqbullet : keysym = 0xae7 let _filledtribulletup : keysym = 0xae8 let _filledtribulletdown : keysym = 0xae9 let _leftpointer : keysym = 0xaea let _rightpointer : keysym = 0xaeb let _club : keysym = 0xaec let _diamond : keysym = 0xaed let _heart : keysym = 0xaee let _maltesecross : keysym = 0xaf0 let _dagger : keysym = 0xaf1 let _doubledagger : keysym = 0xaf2 let _checkmark : keysym = 0xaf3 let _ballotcross : keysym = 0xaf4 let _musicalsharp : keysym = 0xaf5 let _musicalflat : keysym = 0xaf6 let _malesymbol : keysym = 0xaf7 let _femalesymbol : keysym = 0xaf8 let _telephone : keysym = 0xaf9 let _telephonerecorder : keysym = 0xafa let _phonographcopyright : keysym = 0xafb let _caret : keysym = 0xafc let _singlelowquotemark : keysym = 0xafd let _doublelowquotemark : keysym = 0xafe let _cursor : keysym = 0xaff let _leftcaret : keysym = 0xba3 let _rightcaret : keysym = 0xba6 let _downcaret : keysym = 0xba8 let _upcaret : keysym = 0xba9 let _overbar : keysym = 0xbc0 let _downtack : keysym = 0xbc2 let _upshoe : keysym = 0xbc3 let _downstile : keysym = 0xbc4 let _underbar : keysym = 0xbc6 let _jot : keysym = 0xbca let _quad : keysym = 0xbcc let _uptack : keysym = 0xbce let _circle : keysym = 0xbcf let _upstile : keysym = 0xbd3 let _downshoe : keysym = 0xbd6 let _rightshoe : keysym = 0xbd8 let _leftshoe : keysym = 0xbda let _lefttack : keysym = 0xbdc let _righttack : keysym = 0xbfc let _hebrew_doublelowline : keysym = 0xcdf let _hebrew_aleph : keysym = 0xce0 let _hebrew_bet : keysym = 0xce1 let _hebrew_beth : keysym = 0xce1 let _hebrew_gimel : keysym = 0xce2 let _hebrew_gimmel : keysym = 0xce2 let _hebrew_dalet : keysym = 0xce3 let _hebrew_daleth : keysym = 0xce3 let _hebrew_he : keysym = 0xce4 let _hebrew_waw : keysym = 0xce5 let _hebrew_zain : keysym = 0xce6 let _hebrew_zayin : keysym = 0xce6 let _hebrew_chet : keysym = 0xce7 let _hebrew_het : keysym = 0xce7 let _hebrew_tet : keysym = 0xce8 let _hebrew_teth : keysym = 0xce8 let _hebrew_yod : keysym = 0xce9 let _hebrew_finalkaph : keysym = 0xcea let _hebrew_kaph : keysym = 0xceb let _hebrew_lamed : keysym = 0xcec let _hebrew_finalmem : keysym = 0xced let _hebrew_mem : keysym = 0xcee let _hebrew_finalnun : keysym = 0xcef let _hebrew_nun : keysym = 0xcf0 let _hebrew_samech : keysym = 0xcf1 let _hebrew_samekh : keysym = 0xcf1 let _hebrew_ayin : keysym = 0xcf2 let _hebrew_finalpe : keysym = 0xcf3 let _hebrew_pe : keysym = 0xcf4 let _hebrew_finalzade : keysym = 0xcf5 let _hebrew_finalzadi : keysym = 0xcf5 let _hebrew_zade : keysym = 0xcf6 let _hebrew_zadi : keysym = 0xcf6 let _hebrew_qoph : keysym = 0xcf7 let _hebrew_kuf : keysym = 0xcf7 let _hebrew_resh : keysym = 0xcf8 let _hebrew_shin : keysym = 0xcf9 let _hebrew_taw : keysym = 0xcfa let _hebrew_taf : keysym = 0xcfa let _Hebrew_switch : keysym = 0xFF7E let _Thai_kokai : keysym = 0xda1 let _Thai_khokhai : keysym = 0xda2 let _Thai_khokhuat : keysym = 0xda3 let _Thai_khokhwai : keysym = 0xda4 let _Thai_khokhon : keysym = 0xda5 let _Thai_khorakhang : keysym = 0xda6 let _Thai_ngongu : keysym = 0xda7 let _Thai_chochan : keysym = 0xda8 let _Thai_choching : keysym = 0xda9 let _Thai_chochang : keysym = 0xdaa let _Thai_soso : keysym = 0xdab let _Thai_chochoe : keysym = 0xdac let _Thai_yoying : keysym = 0xdad let _Thai_dochada : keysym = 0xdae let _Thai_topatak : keysym = 0xdaf let _Thai_thothan : keysym = 0xdb0 let _Thai_thonangmontho : keysym = 0xdb1 let _Thai_thophuthao : keysym = 0xdb2 let _Thai_nonen : keysym = 0xdb3 let _Thai_dodek : keysym = 0xdb4 let _Thai_totao : keysym = 0xdb5 let _Thai_thothung : keysym = 0xdb6 let _Thai_thothahan : keysym = 0xdb7 let _Thai_thothong : keysym = 0xdb8 let _Thai_nonu : keysym = 0xdb9 let _Thai_bobaimai : keysym = 0xdba let _Thai_popla : keysym = 0xdbb let _Thai_phophung : keysym = 0xdbc let _Thai_fofa : keysym = 0xdbd let _Thai_phophan : keysym = 0xdbe let _Thai_fofan : keysym = 0xdbf let _Thai_phosamphao : keysym = 0xdc0 let _Thai_moma : keysym = 0xdc1 let _Thai_yoyak : keysym = 0xdc2 let _Thai_rorua : keysym = 0xdc3 let _Thai_ru : keysym = 0xdc4 let _Thai_loling : keysym = 0xdc5 let _Thai_lu : keysym = 0xdc6 let _Thai_wowaen : keysym = 0xdc7 let _Thai_sosala : keysym = 0xdc8 let _Thai_sorusi : keysym = 0xdc9 let _Thai_sosua : keysym = 0xdca let _Thai_hohip : keysym = 0xdcb let _Thai_lochula : keysym = 0xdcc let _Thai_oang : keysym = 0xdcd let _Thai_honokhuk : keysym = 0xdce let _Thai_paiyannoi : keysym = 0xdcf let _Thai_saraa : keysym = 0xdd0 let _Thai_maihanakat : keysym = 0xdd1 let _Thai_saraaa : keysym = 0xdd2 let _Thai_saraam : keysym = 0xdd3 let _Thai_sarai : keysym = 0xdd4 let _Thai_saraii : keysym = 0xdd5 let _Thai_saraue : keysym = 0xdd6 let _Thai_sarauee : keysym = 0xdd7 let _Thai_sarau : keysym = 0xdd8 let _Thai_sarauu : keysym = 0xdd9 let _Thai_phinthu : keysym = 0xdda let _Thai_maihanakat_maitho : keysym = 0xdde let _Thai_baht : keysym = 0xddf let _Thai_sarae : keysym = 0xde0 let _Thai_saraae : keysym = 0xde1 let _Thai_sarao : keysym = 0xde2 let _Thai_saraaimaimuan : keysym = 0xde3 let _Thai_saraaimaimalai : keysym = 0xde4 let _Thai_lakkhangyao : keysym = 0xde5 let _Thai_maiyamok : keysym = 0xde6 let _Thai_maitaikhu : keysym = 0xde7 let _Thai_maiek : keysym = 0xde8 let _Thai_maitho : keysym = 0xde9 let _Thai_maitri : keysym = 0xdea let _Thai_maichattawa : keysym = 0xdeb let _Thai_thanthakhat : keysym = 0xdec let _Thai_nikhahit : keysym = 0xded let _Thai_leksun : keysym = 0xdf0 let _Thai_leknung : keysym = 0xdf1 let _Thai_leksong : keysym = 0xdf2 let _Thai_leksam : keysym = 0xdf3 let _Thai_leksi : keysym = 0xdf4 let _Thai_lekha : keysym = 0xdf5 let _Thai_lekhok : keysym = 0xdf6 let _Thai_lekchet : keysym = 0xdf7 let _Thai_lekpaet : keysym = 0xdf8 let _Thai_lekkao : keysym = 0xdf9 let _Hangul : keysym = 0xff31 let _Hangul_Start : keysym = 0xff32 let _Hangul_End : keysym = 0xff33 let _Hangul_Hanja : keysym = 0xff34 let _Hangul_Jamo : keysym = 0xff35 let _Hangul_Romaja : keysym = 0xff36 let _Hangul_Codeinput : keysym = 0xff37 let _Hangul_Jeonja : keysym = 0xff38 let _Hangul_Banja : keysym = 0xff39 let _Hangul_PreHanja : keysym = 0xff3a let _Hangul_PostHanja : keysym = 0xff3b let _Hangul_SingleCandidate : keysym = 0xff3c let _Hangul_MultipleCandidate : keysym = 0xff3d let _Hangul_PreviousCandidate : keysym = 0xff3e let _Hangul_Special : keysym = 0xff3f let _Hangul_switch : keysym = 0xFF7E let _Hangul_Kiyeog : keysym = 0xea1 let _Hangul_SsangKiyeog : keysym = 0xea2 let _Hangul_KiyeogSios : keysym = 0xea3 let _Hangul_Nieun : keysym = 0xea4 let _Hangul_NieunJieuj : keysym = 0xea5 let _Hangul_NieunHieuh : keysym = 0xea6 let _Hangul_Dikeud : keysym = 0xea7 let _Hangul_SsangDikeud : keysym = 0xea8 let _Hangul_Rieul : keysym = 0xea9 let _Hangul_RieulKiyeog : keysym = 0xeaa let _Hangul_RieulMieum : keysym = 0xeab let _Hangul_RieulPieub : keysym = 0xeac let _Hangul_RieulSios : keysym = 0xead let _Hangul_RieulTieut : keysym = 0xeae let _Hangul_RieulPhieuf : keysym = 0xeaf let _Hangul_RieulHieuh : keysym = 0xeb0 let _Hangul_Mieum : keysym = 0xeb1 let _Hangul_Pieub : keysym = 0xeb2 let _Hangul_SsangPieub : keysym = 0xeb3 let _Hangul_PieubSios : keysym = 0xeb4 let _Hangul_Sios : keysym = 0xeb5 let _Hangul_SsangSios : keysym = 0xeb6 let _Hangul_Ieung : keysym = 0xeb7 let _Hangul_Jieuj : keysym = 0xeb8 let _Hangul_SsangJieuj : keysym = 0xeb9 let _Hangul_Cieuc : keysym = 0xeba let _Hangul_Khieuq : keysym = 0xebb let _Hangul_Tieut : keysym = 0xebc let _Hangul_Phieuf : keysym = 0xebd let _Hangul_Hieuh : keysym = 0xebe let _Hangul_A : keysym = 0xebf let _Hangul_AE : keysym = 0xec0 let _Hangul_YA : keysym = 0xec1 let _Hangul_YAE : keysym = 0xec2 let _Hangul_EO : keysym = 0xec3 let _Hangul_E : keysym = 0xec4 let _Hangul_YEO : keysym = 0xec5 let _Hangul_YE : keysym = 0xec6 let _Hangul_O : keysym = 0xec7 let _Hangul_WA : keysym = 0xec8 let _Hangul_WAE : keysym = 0xec9 let _Hangul_OE : keysym = 0xeca let _Hangul_YO : keysym = 0xecb let _Hangul_U : keysym = 0xecc let _Hangul_WEO : keysym = 0xecd let _Hangul_WE : keysym = 0xece let _Hangul_WI : keysym = 0xecf let _Hangul_YU : keysym = 0xed0 let _Hangul_EU : keysym = 0xed1 let _Hangul_YI : keysym = 0xed2 let _Hangul_I : keysym = 0xed3 let _Hangul_J_Kiyeog : keysym = 0xed4 let _Hangul_J_SsangKiyeog : keysym = 0xed5 let _Hangul_J_KiyeogSios : keysym = 0xed6 let _Hangul_J_Nieun : keysym = 0xed7 let _Hangul_J_NieunJieuj : keysym = 0xed8 let _Hangul_J_NieunHieuh : keysym = 0xed9 let _Hangul_J_Dikeud : keysym = 0xeda let _Hangul_J_Rieul : keysym = 0xedb let _Hangul_J_RieulKiyeog : keysym = 0xedc let _Hangul_J_RieulMieum : keysym = 0xedd let _Hangul_J_RieulPieub : keysym = 0xede let _Hangul_J_RieulSios : keysym = 0xedf let _Hangul_J_RieulTieut : keysym = 0xee0 let _Hangul_J_RieulPhieuf : keysym = 0xee1 let _Hangul_J_RieulHieuh : keysym = 0xee2 let _Hangul_J_Mieum : keysym = 0xee3 let _Hangul_J_Pieub : keysym = 0xee4 let _Hangul_J_PieubSios : keysym = 0xee5 let _Hangul_J_Sios : keysym = 0xee6 let _Hangul_J_SsangSios : keysym = 0xee7 let _Hangul_J_Ieung : keysym = 0xee8 let _Hangul_J_Jieuj : keysym = 0xee9 let _Hangul_J_Cieuc : keysym = 0xeea let _Hangul_J_Khieuq : keysym = 0xeeb let _Hangul_J_Tieut : keysym = 0xeec let _Hangul_J_Phieuf : keysym = 0xeed let _Hangul_J_Hieuh : keysym = 0xeee let _Hangul_RieulYeorinHieuh : keysym = 0xeef let _Hangul_SunkyeongeumMieum : keysym = 0xef0 let _Hangul_SunkyeongeumPieub : keysym = 0xef1 let _Hangul_PanSios : keysym = 0xef2 let _Hangul_KkogjiDalrinIeung : keysym = 0xef3 let _Hangul_SunkyeongeumPhieuf : keysym = 0xef4 let _Hangul_YeorinHieuh : keysym = 0xef5 let _Hangul_AraeA : keysym = 0xef6 let _Hangul_AraeAE : keysym = 0xef7 let _Hangul_J_PanSios : keysym = 0xef8 let _Hangul_J_KkogjiDalrinIeung : keysym = 0xef9 let _Hangul_J_YeorinHieuh : keysym = 0xefa let _Korean_Won : keysym = 0xeff lablgtk-2.18.8/src/gtkData.ml0000644000175000017500000001641313460263323014771 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open GtkBaseProps open Gtk open Tags module AccelGroup = struct external create : unit -> accel_group = "ml_gtk_accel_group_new" external lock : accel_group -> unit = "ml_gtk_accel_group_lock" external unlock : accel_group -> unit = "ml_gtk_accel_group_unlock" external connect : accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> ?flags:accel_flag list -> callback:g_closure -> unit = "ml_gtk_accel_group_connect" let connect ~key ?modi ?flags ~callback g = connect g ~key ?modi ?flags ~callback:(Closure.create (fun _ -> callback ())) external disconnect : accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool = "ml_gtk_accel_group_disconnect_key" let disconnect ~key ?modi g = disconnect g ~key ?modi external groups_activate : 'a obj -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool = "ml_gtk_accel_groups_activate" let groups_activate ~key ?modi obj = groups_activate obj ~key ?modi (* XXX In the following functions, optional arguments are useless! *) (* Should remove the key label in lablgtk3 ? *) external valid : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> bool = "ml_gtk_accelerator_valid" external set_default_mod_mask : Gdk.Tags.modifier list option -> unit = "ml_gtk_accelerator_set_default_mod_mask" external parse : string -> Gdk.keysym * Gdk.Tags.modifier list = "ml_gtk_accelerator_parse" external name : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> string = "ml_gtk_accelerator_name" external get_label : key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> string = "ml_gtk_accelerator_get_label" end module AccelMap = struct external load : string -> unit = "ml_gtk_accel_map_load" external save : string -> unit = "ml_gtk_accel_map_save" external add_entry : string -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> unit = "ml_gtk_accel_map_add_entry" let add_entry ?(key=0) ?modi s = add_entry s ~key ?modi external change_entry : string -> Gdk.keysym -> Gdk.Tags.modifier list option -> bool -> bool = "ml_gtk_accel_map_change_entry" let change_entry ?(key=0) ?modi ?(replace=true) s = change_entry s key modi replace external foreach : (path:string -> key:int -> modi:Gdk.Tags.modifier list -> changed:bool -> unit) -> unit = "ml_gtk_accel_map_foreach" end module Style = struct external create : unit -> style = "ml_gtk_style_new" external copy : style -> style = "ml_gtk_style_copy" external attach : style -> Gdk.window -> style = "ml_gtk_style_attach" external detach : style -> unit = "ml_gtk_style_detach" external set_window_background : style -> Gdk.window -> state_type -> unit = "ml_gtk_style_set_background" external draw_hline : style -> Gdk.window -> state_type -> x:int -> x:int -> y:int -> unit = "ml_gtk_draw_hline_bc" "ml_gtk_draw_hline" external draw_vline : style -> Gdk.window -> state_type -> y:int -> y:int -> x:int -> unit = "ml_gtk_draw_vline_bc" "ml_gtk_draw_vline" external get_bg : style -> state_type -> Gdk.color = "ml_gtk_style_get_bg" external set_bg : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_bg" external get_fg : style -> state_type -> Gdk.color = "ml_gtk_style_get_fg" external set_fg : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_fg" external get_light : style -> state_type -> Gdk.color = "ml_gtk_style_get_light" external set_light : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_light" external get_dark : style -> state_type -> Gdk.color = "ml_gtk_style_get_dark" external set_dark : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_dark" external get_mid : style -> state_type -> Gdk.color = "ml_gtk_style_get_mid" external set_mid : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_mid" external get_base : style -> state_type -> Gdk.color = "ml_gtk_style_get_base" external set_base : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_base" external get_text : style -> state_type -> Gdk.color = "ml_gtk_style_get_text" external set_text : style -> state_type -> Gdk.color -> unit = "ml_gtk_style_set_text" external get_colormap : style -> Gdk.colormap = "ml_gtk_style_get_colormap" external get_font : style -> Gdk.font = "ml_gtk_style_get_font" external set_font : style -> Gdk.font -> unit = "ml_gtk_style_set_font" (* external get_dark_gc : style -> state:state_type -> Gdk.gc = "ml_gtk_style_get_dark_gc" external get_light_gc : style -> state:state_type -> Gdk.gc = "ml_gtk_style_get_light_gc" let set st ?:background ?:font = let may_set f = may fun:(f st) in may_set set_background background; may_set set_font font *) end module Adjustment = struct include Adjustment external create : value:float -> lower:float -> upper:float -> step_incr:float -> page_incr:float -> page_size:float -> adjustment obj = "ml_gtk_adjustment_new_bc" "ml_gtk_adjustment_new" external clamp_page : [>`adjustment] obj -> lower:float -> upper:float -> unit = "ml_gtk_adjustment_clamp_page" end module Tooltips = struct external create : unit -> tooltips obj = "ml_gtk_tooltips_new" external enable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_enable" external disable : [>`tooltips] obj -> unit = "ml_gtk_tooltips_disable" external set_delay : [>`tooltips] obj -> int -> unit = "ml_gtk_tooltips_set_delay" external set_tip : [>`tooltips] obj -> [>`widget] obj -> ?text:string -> ?privat:string -> unit = "ml_gtk_tooltips_set_tip" end lablgtk-2.18.8/src/gData.mli0000644000175000017500000001223413460263323014600 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk (** Non-Widgets objects carrying data *) (** {3 GtkAdjustement} *) (** @gtkdoc gtk GtkAdjustment *) class adjustment_signals : [> adjustment] obj -> object inherit GObj.gtkobj_signals method changed : callback:(unit -> unit) -> GtkSignal.id method value_changed : callback:(unit -> unit) -> GtkSignal.id method notify_lower : callback:(float -> unit) -> GtkSignal.id method notify_page_increment : callback:(float -> unit) -> GtkSignal.id method notify_page_size : callback:(float -> unit) -> GtkSignal.id method notify_step_increment : callback:(float -> unit) -> GtkSignal.id method notify_upper : callback:(float -> unit) -> GtkSignal.id method notify_value : callback:(float -> unit) -> GtkSignal.id end (** A GtkObject representing an adjustable bounded value @gtkdoc gtk GtkAdjustment *) class adjustment : Gtk.adjustment obj -> object inherit GObj.gtkobj val obj : Gtk.adjustment obj method as_adjustment : Gtk.adjustment obj method clamp_page : lower:float -> upper:float -> unit method connect : adjustment_signals method set_value : float -> unit method lower : float method upper : float method value : float method step_increment : float method page_increment : float method page_size : float method set_bounds : ?lower:float -> ?upper:float -> ?step_incr:float -> ?page_incr:float -> ?page_size:float -> unit -> unit method set_lower : float -> unit method set_page_increment : float -> unit method set_page_size : float -> unit method set_step_increment : float -> unit method set_upper : float -> unit method set_value : float -> unit end (** @gtkdoc gtk GtkAdjustment @param lower default value is [0.] @param upper default value is [100.] @param step_incr default value is [1.] @param page_incr default value is [10.] @param page_size default value is [10.] *) val adjustment : ?value:float -> ?lower:float -> ?upper:float -> ?step_incr:float -> ?page_incr:float -> ?page_size:float -> unit -> adjustment val as_adjustment : adjustment -> Gtk.adjustment obj val conv_adjustment : adjustment Gobject.data_conv val conv_adjustment_option : adjustment option Gobject.data_conv (** {3 Tooltips} *) (** Add tips to your widgets @gtkdoc gtk GtkTooltips *) class tooltips : Gtk.tooltips obj -> object inherit GObj.gtkobj val obj : Gtk.tooltips obj method as_tooltips : Gtk.tooltips obj method connect : GObj.gtkobj_signals method disable : unit -> unit method enable : unit -> unit method set_delay : int -> unit method set_tip : ?text:string -> ?privat:string -> GObj.widget -> unit end (** @gtkdoc gtk GtkTooltips *) val tooltips : ?delay:int -> unit -> tooltips (** {3 Clipboards} *) (** Storing data on clipboards @gtkdoc gtk gtk-Clipboards *) class clipboard_skel : Gtk.clipboard Lazy.t -> object method as_clipboard : Gtk.clipboard method clear : unit -> unit method get_contents : target:Gdk.atom -> GObj.selection_data method set_image : GdkPixbuf.pixbuf -> unit method set_text : string -> unit method image : GdkPixbuf.pixbuf option method text : string option method targets : Gdk.atom list end class clipboard : selection:Gdk.atom -> object inherit clipboard_skel method set_contents : targets:string list -> get:(GObj.selection_context -> info:int -> time:int32 -> unit) -> clear:(unit -> unit) -> unit end (** @gtkdoc gtk gtk-Clipboards *) val clipboard : Gdk.atom -> clipboard val as_clipboard : clipboard -> Gtk.clipboard lablgtk-2.18.8/src/gdk_tags.var0000644000175000017500000001140313460263323015347 0ustar stephsteph(* $Id$ *) package "gdk" type noconv platform = [ `X11 | `WIN32 | `QUARTZ ] type event_type = "GDK_" [ `NOTHING | `DELETE | `DESTROY | `EXPOSE | `MOTION_NOTIFY | `BUTTON_PRESS | `TWO_BUTTON_PRESS "GDK_2BUTTON_PRESS" | `THREE_BUTTON_PRESS "GDK_3BUTTON_PRESS" | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `CONFIGURE | `MAP | `UNMAP | `PROPERTY_NOTIFY | `SELECTION_CLEAR | `SELECTION_REQUEST | `SELECTION_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `DRAG_ENTER | `DRAG_LEAVE | `DRAG_MOTION | `DRAG_STATUS | `DROP_START | `DROP_FINISHED | `CLIENT_EVENT | `VISIBILITY_NOTIFY | `NO_EXPOSE | `SCROLL | `WINDOW_STATE | `SETTING ] type flags event_mask = "GDK_" [ `EXPOSURE | `POINTER_MOTION | `POINTER_MOTION_HINT | `BUTTON_MOTION | `BUTTON1_MOTION | `BUTTON2_MOTION | `BUTTON3_MOTION | `BUTTON_PRESS | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `STRUCTURE | `PROPERTY_CHANGE | `VISIBILITY_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `SUBSTRUCTURE | `SCROLL | `ALL_EVENTS ] "_MASK" type extension_mode = "GDK_EXTENSION_EVENTS_" [ `NONE | `ALL | `CURSOR ] type visibility_state "gdkVisibilityState" = "GDK_VISIBILITY_" [ `UNOBSCURED | `PARTIAL | `FULLY_OBSCURED ] type input_source "gdkInputSource" = "GDK_SOURCE_" [ `MOUSE | `PEN | `ERASER | `CURSOR ] type scroll_direction "gdkScrollDirection" = "GDK_SCROLL_" [ `UP | `DOWN | `LEFT | `RIGHT ] type crossing_mode "gdkCrossingMode" = "GDK_CROSSING_" [ `NORMAL | `GRAB | `UNGRAB ] type notify_type "gdkNotifyType" = "GDK_NOTIFY_" [ `ANCESTOR | `VIRTUAL | `INFERIOR | `NONLINEAR | `NONLINEAR_VIRTUAL | `UNKNOWN ] type setting_action "gdkSettingAction" = "GDK_SETTING_ACTION_" [ `NEW | `CHANGED | `DELETED ] type window_state "gdkWindowState" = "GDK_WINDOW_STATE_" [ `WITHDRAWN | `ICONIFIED | `MAXIMIZED | `STICKY | `FULLSCREEN ] type fill_rule = "GDK_" [ `EVEN_ODD_RULE | `WINDING_RULE ] type overlap_type = "GDK_OVERLAP_RECTANGLE_" [ `IN | `OUT | `PART ] type function_type = "GDK_" [ `COPY | `INVERT | `XOR ] type fill = "GDK_" [ `SOLID | `TILED | `STIPPLED | `OPAQUE_STIPPLED ] type subwindow_mode = "GDK_" [ `CLIP_BY_CHILDREN | `INCLUDE_INFERIORS ] type line_style = "GDK_LINE_" [ `SOLID | `ON_OFF_DASH | `DOUBLE_DASH ] type cap_style = "GDK_CAP_" [ `NOT_LAST | `BUTT | `ROUND | `PROJECTING ] type join_style = "GDK_JOIN_" [ `MITER | `ROUND | `BEVEL ] type modifier "gdkModifier" = "GDK_" [ `SHIFT | `LOCK | `CONTROL | `MOD1 | `MOD2 | `MOD3 | `MOD4 | `MOD5 | `BUTTON1 | `BUTTON2 | `BUTTON3 | `BUTTON4 | `BUTTON5 | `SUPER | `HYPER | `META | `RELEASE ] "_MASK" type image_type "gdkImageType" = "GDK_IMAGE_" [ `NORMAL | `SHARED | `FASTEST ] type visual_type "gdkVisualType" = "GDK_VISUAL_" [ `STATIC_GRAY | `GRAYSCALE | `STATIC_COLOR | `PSEUDO_COLOR | `TRUE_COLOR | `DIRECT_COLOR ] type font_type = "GDK_FONT_" [ `FONT | `FONTSET ] type drag_action "gdkDragAction" = "GDK_ACTION_" [ `DEFAULT | `COPY | `MOVE | `LINK | `PRIVATE | `ASK ] type rgb_dither "gdkRgbDither" = "GDK_RGB_DITHER_" [ `NONE | `NORMAL | `MAX ] type xdata = [ `BYTES "8" | `SHORTS "16" | `INT32S "32" | `NONE "0" ] type property_state = "GDK_PROPERTY_" [ `NEW_VALUE | `DELETE ] type property_mode = "GDK_PROP_MODE_" [ `REPLACE | `PREPEND | `APPEND ] type gravity = "GDK_GRAVITY_" [ `NORTH_WEST | `NORTH | `NORTH_EAST | `WEST | `CENTER | `EAST | `SOUTH_WEST | `SOUTH | `SOUTH_EAST | `STATIC ] type window_type_hint = "GDK_WINDOW_TYPE_HINT_" [ `NORMAL | `DIALOG | `MENU | `TOOLBAR | `SPLASHSCREEN | `UTILITY | `DOCK | `DESKTOP ] type cursor_type "gdkCursorType" = "GDK_" [ | `X_CURSOR | `ARROW | `BASED_ARROW_DOWN | `BASED_ARROW_UP | `BOAT | `BOGOSITY | `BOTTOM_LEFT_CORNER | `BOTTOM_RIGHT_CORNER | `BOTTOM_SIDE | `BOTTOM_TEE | `BOX_SPIRAL | `CENTER_PTR | `CIRCLE | `CLOCK | `COFFEE_MUG | `CROSS | `CROSS_REVERSE | `CROSSHAIR | `DIAMOND_CROSS | `DOT | `DOTBOX | `DOUBLE_ARROW | `DRAFT_LARGE | `DRAFT_SMALL | `DRAPED_BOX | `EXCHANGE | `FLEUR | `GOBBLER | `GUMBY | `HAND1 | `HAND2 | `HEART | `ICON | `IRON_CROSS | `LEFT_PTR | `LEFT_SIDE | `LEFT_TEE | `LEFTBUTTON | `LL_ANGLE | `LR_ANGLE | `MAN | `MIDDLEBUTTON | `MOUSE | `PENCIL | `PIRATE | `PLUS | `QUESTION_ARROW | `RIGHT_PTR | `RIGHT_SIDE | `RIGHT_TEE | `RIGHTBUTTON | `RTL_LOGO | `SAILBOAT | `SB_DOWN_ARROW | `SB_H_DOUBLE_ARROW | `SB_LEFT_ARROW | `SB_RIGHT_ARROW | `SB_UP_ARROW | `SB_V_DOUBLE_ARROW | `SHUTTLE | `SIZING | `SPIDER | `SPRAYCAN | `STAR | `TARGET | `TCROSS | `TOP_LEFT_ARROW | `TOP_LEFT_CORNER | `TOP_RIGHT_CORNER | `TOP_SIDE | `TOP_TEE | `TREK | `UL_ANGLE | `UMBRELLA | `UR_ANGLE | `WATCH | `XTERM ] lablgtk-2.18.8/src/gtkList.props0000644000175000017500000000241313460263323015561 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } boxed { GdkEventButton "GdkEvent.Button.t" } class ListItem : Item { (* omit signals *) } class List set wrap : Container { "selection-mode" GtkSelectionMode : Read / Write signal select_child : GtkWidget signal selection_changed signal unselect_child : GtkWidget } class Clist "GtkCList" set wrap wrapsig abstract : Container { "n-columns" guint : Read / Write / Construct Only "sort-type" GtkSortType : Read / Write "reorderable" gboolean : Read / Write "row-height" guint : Read / Write "selection-mode" GtkSelectionMode : Read / Write "shadow-type" GtkShadowType : Read / Write "titles-active" gboolean : Read / Write "use-drag-icons" gboolean : Read / Write (* not all signals *) signal click_column : gint signal resize_column : gint gint signal scroll_horizontal : GtkScrollType pos:gfloat signal scroll_vertical : GtkScrollType pos:gfloat signal select_all signal select_row : row:gint column:gint event:GdkEventButton_opt signal unselect_all signal unselect_row : row:gint column:gint event:GdkEventButton_opt } lablgtk-2.18.8/src/varcc.ml40000644000175000017500000001736513460263323014603 0ustar stephsteph(* -*- caml -*- *) (* $Id$ *) (* Compile a list of variant tags into CPP defines *) open StdLabels (* hash_variant, from ctype.ml *) let hash_variant s = let accu = ref 0 in for i = 0 to String.length s - 1 do accu := 223 * !accu + Char.code s.[i] done; (* reduce to 31 bits *) accu := !accu land (1 lsl 31 - 1); (* make it signed for 64 bits architectures *) if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu let camlize id = let b = Buffer.create (String.length id + 4) in for i = 0 to String.length id - 1 do if id.[i] >= 'A' && id.[i] <= 'Z' then begin if i > 0 then Buffer.add_char b '_'; Buffer.add_char b (Char.lowercase id.[i]) end else Buffer.add_char b id.[i] done; Buffer.contents b open Genlex let lexer = make_lexer ["type"; "="; "["; "]"; "`"; "|"] let may_string = parser [< ' String s >] -> s | [< >] -> "" let may_bar = parser [< ' Kwd "|" >] -> () | [< >] -> () let rec ident_list = parser [< ' Kwd "`"; ' Ident x; trans = may_string; _ = may_bar; s >] -> (x, trans) :: ident_list s | [< >] -> [] let static = ref false let rec star ?(acc=[]) p = parser [< x = p ; s >] -> star ~acc:(x::acc) p s | [< >] -> List.rev acc let flag = parser [< ' Ident ("public"|"private"|"noconv"|"flags" as s) >] -> s let protect = parser [< ' Ident "protect" ; ' Ident m >] -> Some m | [<>] -> None let may o f = match o with | Some v -> f v | None -> () open Printf let hashes = Hashtbl.create 57 let all_convs = ref [] let package = ref "" let pkgprefix = ref "" let declaration ~hc ~cc = parser [< ' Kwd "type"; flags = star flag; guard = protect; ' Ident mlname; name = may_string; ' Kwd "="; prefix = may_string; ' Kwd "["; _ = may_bar; tags = ident_list; ' Kwd "]"; suffix = may_string >] -> let oh x = fprintf hc x and oc x = fprintf cc x in let name = if name = "" then !pkgprefix ^ mlname else name in (* Output tag values to headers *) let first = ref true in List.iter tags ~f: begin fun (tag, _) -> let hash = hash_variant tag in try let tag' = Hashtbl.find hashes hash in if tag <> tag' then failwith (String.concat ~sep:" " ["Doublon tag:";tag;"and";tag']) with Not_found -> Hashtbl.add hashes hash tag; if !first then begin oh "/* %s : tags and macros */\n" name; first := false end; oh "#define MLTAG_%s\t((value)(%d*2+1))\n" tag hash; end; if List.mem "noconv" flags then () else (* compute C name *) let ctag tag trans = if trans <> "" then trans else let tag = if tag.[0] = '_' then String.sub tag ~pos:1 ~len:(String.length tag -1) else tag in match if prefix = "" then None, "" else Some (prefix.[String.length prefix - 1]), String.sub prefix ~pos:0 ~len:(String.length prefix - 1) with Some '#', prefix -> prefix ^ String.uncapitalize tag ^ suffix | Some '^', prefix -> prefix ^ String.uppercase tag ^ suffix | _ -> prefix ^ tag ^ suffix and cname = String.capitalize name in all_convs := (name, mlname, tags, flags) :: !all_convs; let tags = List.sort tags ~cmp: (fun (tag1,_) (tag2,_) -> compare (hash_variant tag1) (hash_variant tag2)) in (* Output table to code file *) oc "/* %s : conversion table */\n" name; let static = if !static && not (List.mem "public" flags) || List.mem "private" flags then "static " else "" in oc "%sconst lookup_info ml_table_%s[] = {\n" static name; may guard (fun m -> oc "#ifdef %s\n" m) ; oc " { 0, %d },\n" (List.length tags); List.iter tags ~f: begin fun (tag,trans) -> oc " { MLTAG_%s, %s },\n" tag (ctag tag trans) end; may guard (fun m -> oc "#else\n {0, 0 }\n#endif /* %s */\n" m) ; oc "};\n\n"; (* Output macros to headers *) if not !first then oh "\n"; if static = "" then oh "extern const lookup_info ml_table_%s[];\n" name; oh "#define Val_%s(data) ml_lookup_from_c (ml_table_%s, data)\n" name name; oh "#define %s_val(key) ml_lookup_to_c (ml_table_%s, key)\n\n" cname name; | [< ' Ident "package"; ' String s >] -> package := s | [< ' Ident "prefix"; ' String s >] -> pkgprefix := s | [< >] -> raise End_of_file let process ic ~hc ~cc = all_convs := []; let chars = Stream.of_channel ic in let s = lexer chars in try while true do declaration s ~hc ~cc done with End_of_file -> if !all_convs <> [] && !package <> "" then begin let oc x = fprintf cc x in oc "CAMLprim value ml_%s_get_tables ()\n{\n" (camlize !package); oc " static const lookup_info *ml_lookup_tables[] = {\n"; let convs = List.rev !all_convs in List.iter convs ~f:(fun (s,_,_,_) -> oc " ml_table_%s,\n" s); oc " };\n"; (* When he have only one conversion, we must return it directly instead of * an array that would be converted to a tuple *) if List.length convs = 1 then oc " return (value)ml_lookup_tables[0];" else oc " return (value)ml_lookup_tables;"; oc "}\n"; let mlc = open_out (!package ^ "Enums.ml") in let ppf = Format.formatter_of_out_channel mlc in let out fmt = Format.fprintf ppf fmt in out "(** %s enums *)\n\n" !package ; out "open Gpointer\n@."; List.iter convs ~f: begin fun (_,name,tags,_) -> out "@[type %s =@ @[[ `%s" name (fst (List.hd tags)); List.iter (List.tl tags) ~f: (fun (s,_) -> out "@ | `%s" s); out " ]@]@]@." end; out "\n(**/**)\n" ; out "\nexternal _get_tables : unit ->\n"; let (_,name0,_,_) = List.hd convs in out " %s variant_table\n" name0; List.iter (List.tl convs) ~f: (fun (_,s,_,_) -> out " * %s variant_table\n" s); out " = \"ml_%s_get_tables\"\n\n" (camlize !package); out "@[let %s" name0; List.iter (List.tl convs) ~f:(fun (_,s,_,_) -> out ",@ %s" s); out " = _get_tables ()@]\n@."; let enum = if List.length convs > 10 then begin out "let _make_enum = Gobject.Data.enum@."; "_make_enum" end else "Gobject.Data.enum" in List.iter convs ~f: begin fun (_,s,_,flags) -> let conv = if List.mem "flags" flags then "Gobject.Data.flags" else enum in out "let %s_conv = %s %s@." s conv s end; close_out mlc end | Stream.Error err -> failwith (Printf.sprintf "Parsing error \"%s\" at character %d on input stream" err (Stream.count chars)) let main () = let inputs = ref [] in let header = ref "" in let code = ref "" in Arg.parse [ "-h", Arg.String ((:=) header), "file to output macros (file.h)"; "-c", Arg.String ((:=) code), "file to output conversion tables (file.c)"; "-static", Arg.Set static, "do not export conversion tables" ] (fun s -> inputs := s :: !inputs) "usage: varcc [options] file.var"; let inputs = List.rev !inputs in begin match inputs with | [] -> if !header = "" then header := "a.h"; if !code = "" then code := "a.c" | ip :: _ -> let rad = if Filename.check_suffix ip ".var" then Filename.chop_extension ip else ip in if !header = "" then header := rad ^ ".h"; if !code = "" then code := rad ^ ".c" end; let hc = open_out !header and cc = open_out !code in if inputs = [] then process stdin ~hc ~cc else begin List.iter inputs ~f: begin fun file -> let ic = open_in file in try process ic ~hc ~cc; close_in ic with exn -> close_in ic; prerr_endline ("Error in " ^ file); raise exn end end; close_out hc; close_out cc let _ = Printexc.print main () lablgtk-2.18.8/src/gtkBase.props0000644000175000017500000002511213460263323015521 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk module Internal = struct external allocation_at_pointer : Gpointer.boxed -> rectangle = "ml_Val_GtkAllocation" let allocation = {kind=`POINTER;inj=(fun _ -> failwith "GtkProps.Internal.allocation"); proj=(function `POINTER(Some p) -> allocation_at_pointer p | _ -> failwith "GtkProps.Internal.allocation")} end } oheader{ open GtkBaseProps } conversions { GtkAllocation "Internal.allocation" GtkSelectionData_nocopy "(unsafe_pointer : Gtk.selection_data data_conv)" GdkGravity "GdkEnums.gravity_conv" } boxed { GdkEvent "GdkEvent.any" GdkEventButton "GdkEvent.Button.t" GdkEventMotion "GdkEvent.Motion.t" GdkEventExpose "GdkEvent.Expose.t" GdkEventKey "GdkEvent.Key.t" GdkEventCrossing "GdkEvent.Crossing.t" GdkEventConfigure "GdkEvent.Configure.t" GdkEventFocus "GdkEvent.Focus.t" GdkEventProperty "GdkEvent.Property.t" GdkEventSelection "GdkEvent.Selection.t" GdkEventProximity "GdkEvent.Proximity.t" } classes { GdkPixbuf "GdkPixbuf.pixbuf" GtkStyle "Gtk.style" } class Widget abstract : Object { "app-paintable" gboolean : Read / Write "can-default" gboolean : Read / Write "can-focus" gboolean : Read / Write "composite-child" gboolean : Read "events" GdkEventMask : Read / Write "extension-events" GdkExtensionMode : Read / Write "has-default" gboolean : Read / Write "has-focus" gboolean : Read / Write "has-tooltip" gboolean : Read / Write "height-request" gint : Read / Write "is-focus" gboolean : Read / Write "name" gchararray : Read / Write "parent" GtkContainer_opt : Read / Write "receives-default" gboolean : Read / Write "sensitive" gboolean : Read / Write "style" GtkStyle : Read / Write "tooltip-markup" gchararray : Read / Write "tooltip-text" gchararray : Read / Write "visible" gboolean : Read / Write "width-request" gint : Read / Write (* misc *) signal show signal hide signal map signal unmap signal query_tooltip : x:int y:int kbd:bool GtkTooltip -> bool signal realize signal unrealize signal state_changed : GtkStateType signal parent_set : GtkWidget_opt signal size_allocate : GtkAllocation signal style_set : GtkStyle_opt (* selection *) signal selection_get : GtkSelectionData_nocopy info:int time:int32 signal selection_received : GtkSelectionData time:int32 (* dnd *) signal drag_begin : GdkDragContext signal drag_data_delete : GdkDragContext signal drag_data_get : GdkDragContext GtkSelectionData_nocopy info:int time:int32 signal drag_data_received : GdkDragContext x:int y:int GtkSelectionData info:int time:int32 signal drag_drop : GdkDragContext x:int y:int time:int32 -> bool signal drag_end : GdkDragContext signal drag_leave : GdkDragContext time:int32 signal drag_motion : GdkDragContext x:int y:int time:int32 -> bool (* events *) signal event : GdkEvent -> bool signal event_after : GdkEvent (* events share the same marshaller signal button_press_event : GdkEventButton -> bool signal button_release_event : GdkEventButton -> bool signal motion_notify_event : GdkEventMotion -> bool signal delete_event : GdkEvent -> bool signal destroy_event : GdkEvent -> bool signal expose_event : GdkEventExpose -> bool signal key_press_event : GdkEventKey -> bool signal key_release_event : GdkEventKey -> bool signal enter_notify_event : GdkEventCrossing -> bool signal leave_notify_event : GdkEventCrossing -> bool signal configure_event : GdkEventConfigure -> bool signal focus_in_event : GdkEventFocus -> bool signal focus_out_event : GdkEventFocus -> bool signal map_event : GdkEvent -> bool signal unmap_event : GdkEvent -> bool signal property_notify_event : GdkEventProperty -> bool signal selection_clear_event : GdkEventSelection -> bool signal selection_request_event : GdkEventSelection -> bool signal selection_notify_event : GdkEventSelection -> bool signal proximity_in_event : GdkEventProximity -> bool signal proximity_out_event : GdkEventProximity -> bool *) (* methods *) method set_double_buffered : "bool -> unit" method style_get_property : "string -> g_value" } class Container abstract : Widget { "border-width" guint : Read / Write / Wrap "child" GtkWidget : Write "resize-mode" GtkResizeMode : Read / Write / Wrap method check_resize method add : "[>`widget] obj -> unit" method remove : "[>`widget] obj -> unit" method forall : "f:(widget obj -> unit) -> unit" method foreach : "f:(widget obj -> unit) -> unit" (* Called by Widget.grab_focus *) method set_focus_child : "[>`widget] optobj -> unit" method set_focus_vadjustment : "[>`adjustment] optobj -> unit" method set_focus_hadjustment : "[>`adjustment] optobj -> unit" method child_set_property : "[>`widget] obj -> string -> g_value -> unit" method child_get_property : "[>`widget] obj -> string -> g_value -> unit" signal add : GtkWidget / Wrap signal remove : GtkWidget / Wrap signal check_resize signal set_focus : GtkWidget_opt } class Bin abstract : Container { method get_child : "widget obj" } class Item abstract wrapsig : Bin { method select method deselect method toggle signal select signal deselect signal toggle } class Adjustment set wrap wrapsig : Object { "lower" gdouble : Read / Write "page-increment" gdouble : Read / Write "page-size" gdouble : Read / Write "step-increment" gdouble : Read / Write "upper" gdouble : Read / Write "value" gdouble : Read / Write signal changed signal value_changed } (* Window and Dialogs *) class Window set wrap : Bin { "title" gchararray : Read / Write "accept-focus" gboolean : Read / Write / NoSet "allow-grow" gboolean : Read / Write "allow-shrink" gboolean : Read / Write "decorated" gboolean : Read / Write "default-height" gint : Read / Write / NoSet "default-width" gint : Read / Write / NoSet "deletable" gboolean : Read / Write "destroy-with-parent" gboolean : Read / Write / NoSet "focus-on-map" gboolean : Read / Write "gravity" GdkGravity : Read / Write / NoSet "has-toplevel-focus" gboolean : Read "icon" GdkPixbuf_opt : Read / Write "icon-name" gchararray : Read / Write "is-active" gboolean : Read "modal" gboolean : Read / Write "window-position"(position) GtkWindowPosition : Read / Write "opacity" gdouble : Read / Write / NoSet "resizable" gboolean : Read / Write "role" gchararray : Read / Write / NoSet "screen" GdkScreen : Read / Write "skip-pager-hint" gboolean : Read / Write / NoSet "skip-taskbar-hint" gboolean : Read / Write / NoSet "startup-id" gchararray : Write / NoWrap / NoSet "transient-for" GtkWindow_opt : Read / Write / NoWrap / NoSet "type" GtkWindowType : Read / Write / Construct Only "type-hint" GdkWindowTypeHint : Read / Write "urgency-hint" gboolean : Read / Write method present method iconify method deiconify method stick method unstick method maximize method unmaximize method fullscreen method unfullscreen method set_decorated : "bool -> unit" method set_mnemonic_modifier : "Gdk.Tags.modifier list -> unit" method move : "x:int -> y:int -> unit" method parse_geometry : "string -> bool" method reshow_with_initial_size method resize : "width:int -> height:int -> unit" method set_role : "string -> unit" method get_role : "string" signal activate_default signal activate_focus signal frame_event : GdkEvent signal keys_changed signal move_focus : GtkDirectionType signal set_focus : GtkWidget_opt } class Dialog wrap : Window { "has-separator" gboolean : Read / Write signal close signal response : gint } class FileSelection abstract set wrap : Dialog { "filename" gchararray : Read / Write "select-multiple" gboolean : Read / Write "show-fileops" gboolean : Read / Write } class ColorSelectionDialog : Dialog {} class FontSelectionDialog : Dialog {} (* class InputDialog : Dialog {} *) class MessageDialog abstract wrap : Dialog { "buttons" GtkButtonsType : Write / Construct Only "message-type" GtkMessageType : Read / Write / Construct } class AboutDialog abstract set wrap : Dialog { "program-name" (name) gchararray : Read / Write / NoWrap / NoSet (* "artists" GStrv : Read / Write *) (* "authors" GStrv : Read / Write *) "comments" gchararray : Read / Write "copyright" gchararray : Read / Write (* "documenters" GStrv : Read / Write *) "license" gchararray : Read / Write "logo" GdkPixbuf : Read / Write "logo-icon-name" gchararray : Read / Write "translator-credits" gchararray : Read / Write "version" gchararray : Read / Write "website" gchararray : Read / Write "website-label" gchararray : Read / Write "wrap-license" gboolean : Read / Write method set_artists : "string list -> unit" method get_artists : "string list" method set_authors : "string list -> unit" method get_authors : "string list" method set_documenters : "string list -> unit" method get_documenters : "string list" } class Plug abstract wrapsig : Bin { signal embedded } class Socket wrapsig : Container { method steal : "Gdk.native_window -> unit" signal plug_added signal plug_removed } lablgtk-2.18.8/src/ml_gtksourceview.c0000755000175000017500000004374013460263323016623 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gobject.h" #include "ml_gdkpixbuf.h" #include "ml_pango.h" #include "ml_gtktext.h" #include "gtk_tags.h" #include "gdk_tags.h" #include "sourceView_tags.h" #include #include "sourceView_tags.c" Make_OptFlags_val(Source_search_flag_val) CAMLprim value ml_gtk_source_tag_style_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_tag_style_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_tag_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_tag_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_tag_table_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_tag_table_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_style_scheme_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_style_scheme_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_language_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_language_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_languages_manager_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_languages_manager_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_marker_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_marker_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_buffer_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_buffer_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_view_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_view_get_type(); return Val_GType(t); } static gpointer string_val(value v) { return String_val(v); } GSList *ml_gslist_of_string_list(value list) { return GSList_val(list, string_val); } /* CAMLprim value ml_gtk_source_languages_manager_set_lang_files_dirs(GObject *obj, value list) { GSList *gslist = ml_gslist_of_string_list(list); g_object_set_property(obj, "lang-files-dirs", gslist); return Val_unit; } */ #define GtkSourceStyleScheme_val(val) check_cast(GTK_SOURCE_STYLE_SCHEME,val) #define Val_GtkSourceStyleScheme(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceStyleScheme_new(val) (Val_GObject_new((GObject*)val)) #define Val_GtkSourceLanguage(val) (Val_GObject((GObject*)val)) #define GtkSourceLanguage_val(val) check_cast(GTK_SOURCE_LANGUAGE,val) #define GtkSourceLanguagesManager_val(val)\ check_cast(GTK_SOURCE_LANGUAGES_MANAGER,val) #define GtkSourceTagStyle_val(val) Pointer_val(val) #define Val_GtkSourceTagStyle(val) Val_pointer(val) #define Val_GtkSourceTagStyle_new(val) (Val_pointer((GtkSourceTagStyle*)val)) #define Val_option_GtkSourceTagStyle(val) Val_option(val,Val_GtkSourceTagStyle) #define GtkSourceTag_val(val) check_cast(GTK_SOURCE_TAG,val) #define Val_GtkSourceTag(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceTag_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceTagTable_val(val) check_cast(GTK_SOURCE_TAG_TABLE,val) #define Val_GtkSourceTagTable(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceTagTable_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceMarker_val(val) check_cast(GTK_SOURCE_MARKER,val) #define Val_GtkSourceMarker(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceMarker_new(val) (Val_GObject_new((GObject*)val)) #define Val_option_GtkSourceMarker(val) Val_option(val,Val_GtkSourceMarker) #define GtkSourceBuffer_val(val) check_cast(GTK_SOURCE_BUFFER,val) #define Val_GtkSourceBuffer(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceBuffer_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceView_val(val) check_cast(GTK_SOURCE_VIEW,val) #define GtkTextIter_val(val) ((GtkTextIter*)MLPointer_val(val)) #define Val_GtkTextIter(it) (copy_memblock_indirected(it,sizeof(GtkTextIter))) #define Val_option_GtkAny(v) Val_option(v,Val_GtkAny) #define string_list_of_GSList(l) Val_GSList(l, (value_in) Val_string) static gpointer gtksourcetag_val(value v) { return GtkSourceTag_val(v); } GSList *gslist_of_source_tag_list(value list) { return GSList_val(list, gtksourcetag_val); } static value val_gtksourcetag (gpointer v) { return Val_GtkSourceTag(v); } value source_tag_list_of_GSList(gpointer list) { return Val_GSList(list, val_gtksourcetag); } static value val_gtksourcemarker(gpointer v) { return Val_GtkSourceMarker(v); } value source_marker_list_of_GSList(gpointer list) { return Val_GSList(list, val_gtksourcemarker); } static value val_gtksourcelanguage(gpointer v) { return Val_GtkSourceLanguage(v); } value source_language_list_of_GSList(gpointer list) { return Val_GSList(list, val_gtksourcelanguage); } #define STS_GET(prop,conv) \ CAMLprim value ml_gtk_source_tag_style_get_##prop (value v) \ { CAMLparam1(v);\ GtkSourceTagStyle *sts = Pointer_val(v);\ CAMLreturn(conv (sts->prop));} #define STS_SET(prop,conv) \ CAMLprim value ml_gtk_source_tag_style_set_##prop (value arg1, value arg2) \ { CAMLparam2(arg1,arg2);\ GtkSourceTagStyle *sts = Pointer_val(arg1);\ sts->prop = conv(arg2);\ CAMLreturn(Val_unit);} #define Val_GdkColor_addr(v) Val_GdkColor(&v) STS_GET(background,Val_GdkColor_addr) STS_GET(bold,Val_bool) STS_GET(foreground,Val_GdkColor_addr) STS_GET(italic,Val_bool) STS_GET(strikethrough,Val_bool) STS_GET(underline,Val_bool) STS_SET(background,*GdkColor_val) STS_SET(bold,Bool_val) STS_SET(foreground,*GdkColor_val) STS_SET(italic,Bool_val) STS_SET(strikethrough,Bool_val) STS_SET(underline,Bool_val) #define STS_CHANGE_MASK(name,themask) \ CAMLprim value ml_gtk_source_tag_style_set_use_##name (value v, value b) \ { CAMLparam2(v,b);\ GtkSourceTagStyle *sts = Pointer_val(v);\ if (Bool_val(b)) \ sts->mask = sts->mask | themask ;\ else \ sts->mask = sts->mask & (0xFFFF - themask); \ CAMLreturn(Val_unit); } #define STS_GET_MASK(name,themask) \ CAMLprim value ml_gtk_source_tag_style_get_use_##name (value v) \ { CAMLparam1(v);\ GtkSourceTagStyle *sts = Pointer_val(v);\ CAMLreturn((Val_bool(sts->mask & themask)));} STS_CHANGE_MASK(background,GTK_SOURCE_TAG_STYLE_USE_BACKGROUND) STS_CHANGE_MASK(foreground,GTK_SOURCE_TAG_STYLE_USE_FOREGROUND) STS_GET_MASK(background,GTK_SOURCE_TAG_STYLE_USE_BACKGROUND) STS_GET_MASK(foreground,GTK_SOURCE_TAG_STYLE_USE_FOREGROUND) /* CAMLprim value ml_source_tag_style_get_background (value v) { GtkSourceTagStyle *sts = Pointer_val(v); CAMLreturn(Val_GdkColor_addr(sts->background));} */ ML_0 (gtk_source_style_scheme_get_default, Val_GtkSourceStyleScheme_new) ML_2 (gtk_source_style_scheme_get_tag_style, GtkSourceStyleScheme_val, String_val, Val_option_GtkSourceTagStyle) ML_1 (gtk_source_style_scheme_get_name, GtkSourceStyleScheme_val, Val_string) /* Internal function of gtk_source_language */ GtkSourceLanguage *_gtk_source_language_new_from_file (const gchar *filename, GtkSourceLanguagesManager *lm); ML_2 (_gtk_source_language_new_from_file, String_val, GtkSourceLanguagesManager_val, Val_option_GtkAny) ML_1 (gtk_source_language_get_name, GtkSourceLanguage_val, Val_string) ML_1 (gtk_source_language_get_section, GtkSourceLanguage_val, Val_string) ML_1 (gtk_source_language_get_escape_char, GtkSourceLanguage_val, Val_int) ML_1 (gtk_source_language_get_tags, GtkSourceLanguage_val, source_tag_list_of_GSList) ML_1 (gtk_source_language_get_style_scheme, GtkSourceLanguage_val, Val_GtkSourceStyleScheme) ML_2 (gtk_source_language_set_style_scheme, GtkSourceLanguage_val, GtkSourceStyleScheme_val, Unit) ML_0 (gtk_source_languages_manager_new, Val_GtkAny_sink) ML_2 (gtk_source_languages_manager_get_language_from_mime_type, GtkSourceLanguagesManager_val, String_val, Val_option_GtkAny) ML_1 (gtk_source_languages_manager_get_lang_files_dirs, GtkSourceLanguagesManager_val, string_list_of_GSList) ML_1 (gtk_source_languages_manager_get_available_languages, GtkSourceLanguagesManager_val, source_language_list_of_GSList) ML_2 (gtk_source_language_get_tag_style, GtkSourceLanguage_val, String_val, Val_GtkSourceTagStyle) ML_3 (gtk_source_language_set_tag_style, GtkSourceLanguage_val, String_val, GtkSourceTagStyle_val, Unit) ML_2 (gtk_source_language_get_tag_default_style, GtkSourceLanguage_val, String_val, Val_GtkSourceTagStyle) ML_4 (gtk_syntax_tag_new, String_val, String_val, String_val, String_val, Val_GtkSourceTag_new) ML_3 (gtk_pattern_tag_new, String_val, String_val, String_val, Val_GtkSourceTag_new) ML_8 (gtk_keyword_list_tag_new, String_val, String_val, ml_gslist_of_string_list, Bool_val, Bool_val, Bool_val, String_option_val, String_option_val, Val_GtkSourceTag_new) ML_bc8 (ml_gtk_keyword_list_tag_new) ML_3 (gtk_line_comment_tag_new, String_val, String_val, String_val, Val_GtkSourceTag_new) ML_5 (gtk_string_tag_new, String_val, String_val, String_val, String_val, Bool_val, Val_GtkSourceTag_new) ML_1 (gtk_source_tag_get_style,GtkSourceTag_val,Val_option_GtkSourceTagStyle) ML_2 (gtk_source_tag_set_style,GtkSourceTag_val,GtkSourceTagStyle_val,Unit) ML_0 (gtk_source_tag_style_new, Val_GtkSourceTagStyle_new) ML_1 (gtk_source_tag_style_copy, GtkSourceTagStyle_val, Val_GtkSourceTagStyle) ML_0 (gtk_source_tag_table_new, Val_GtkSourceTagTable_new) ML_1 (gtk_source_tag_table_remove_source_tags, GtkSourceTagTable_val,Unit) ML_2 (gtk_source_tag_table_add_tags, GtkSourceTagTable_val, gslist_of_source_tag_list, Unit) ML_2 (gtk_source_marker_set_marker_type, GtkSourceMarker_val, String_val, Unit) ML_1 (gtk_source_marker_get_marker_type, GtkSourceMarker_val, Val_string) ML_1 (gtk_source_marker_get_line, GtkSourceMarker_val, Val_int) ML_1 (gtk_source_marker_get_name, GtkSourceMarker_val, Val_string) ML_1 (gtk_source_marker_get_buffer, GtkSourceMarker_val, Val_GtkSourceBuffer) ML_1 (gtk_source_marker_next, GtkSourceMarker_val, Val_GtkSourceMarker) ML_1 (gtk_source_marker_prev, GtkSourceMarker_val, Val_GtkSourceMarker) ML_1 (gtk_source_buffer_new, GtkSourceTagTable_val, Val_GtkSourceBuffer_new) ML_1 (gtk_source_buffer_new_with_language, GtkSourceLanguage_val, Val_GtkAny_sink) ML_1 (gtk_source_buffer_can_undo, GtkSourceBuffer_val, Val_bool) ML_1 (gtk_source_buffer_can_redo, GtkSourceBuffer_val, Val_bool) ML_1 (gtk_source_buffer_undo, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_redo, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_begin_not_undoable_action, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_end_not_undoable_action, GtkSourceBuffer_val, Unit) ML_4 (gtk_source_buffer_create_marker, GtkSourceBuffer_val, String_option_val, String_option_val, GtkTextIter_val, Val_GtkSourceMarker) ML_3 (gtk_source_buffer_move_marker, GtkSourceBuffer_val, GtkSourceMarker_val, GtkTextIter_val, Unit) ML_2 (gtk_source_buffer_delete_marker, GtkSourceBuffer_val, GtkSourceMarker_val, Unit) ML_2 (gtk_source_buffer_get_marker, GtkSourceBuffer_val, String_val, Val_option_GtkSourceMarker) ML_1 (gtk_source_buffer_get_first_marker, GtkSourceBuffer_val, Val_option_GtkSourceMarker) ML_1 (gtk_source_buffer_get_last_marker, GtkSourceBuffer_val, Val_option_GtkSourceMarker) ML_2 (gtk_source_buffer_get_next_marker, GtkSourceBuffer_val, GtkTextIter_val, Val_option_GtkSourceMarker) ML_2 (gtk_source_buffer_get_prev_marker, GtkSourceBuffer_val, GtkTextIter_val, Val_option_GtkSourceMarker) CAMLprim value ml_gtk_source_buffer_get_iter_at_marker(value vbuf, value vmark) { CAMLparam2(vbuf,vmark); GtkTextIter iter; gtk_source_buffer_get_iter_at_marker(GtkSourceBuffer_val(vbuf), &iter, GtkSourceMarker_val(vmark)); CAMLreturn(Val_GtkTextIter(&iter)); } ML_3 (gtk_source_buffer_get_markers_in_region, GtkSourceBuffer_val, GtkTextIter_val, GtkTextIter_val, source_marker_list_of_GSList); ML_2 (gtk_source_buffer_set_bracket_match_style, GtkSourceBuffer_val, GtkSourceTagStyle_val, Unit); ML_0 (gtk_source_view_new, Val_GtkWidget_sink) ML_1 (gtk_source_view_new_with_buffer, GtkSourceBuffer_val, Val_GtkWidget_sink) ML_3 (gtk_source_view_set_marker_pixbuf, GtkSourceView_val, String_val, GdkPixbuf_val, Unit) ML_2 (gtk_source_view_get_marker_pixbuf, GtkSourceView_val, String_val, Val_GdkPixbuf) ML_1 (gtk_source_iter_find_matching_bracket, GtkTextIter_val, Val_bool) #define Make_search(dir) \ CAMLprim value ml_gtk_source_iter_##dir##_search (value ti,\ value str,\ value flag,\ value ti_stop,\ value ti_start,\ value ti_lim)\ { CAMLparam5(ti,str,flag,ti_start,ti_stop);\ CAMLxparam1(ti_lim);\ CAMLlocal2(res,coup);\ GtkTextIter* ti1,*ti2;\ gboolean b;\ ti1=gtk_text_iter_copy(GtkTextIter_val(ti_start));\ ti2=gtk_text_iter_copy(GtkTextIter_val(ti_stop));\ b=gtk_source_iter_##dir##_search(GtkTextIter_val(ti),\ String_val(str),\ OptFlags_Source_search_flag_val(flag),\ ti1,\ ti2,\ Option_val(ti_lim,GtkTextIter_val,NULL));\ if (!b) res = Val_unit;\ else \ { res = alloc(1,0);\ coup = alloc_tuple(2);\ Store_field(coup,0,Val_GtkTextIter(ti1));\ Store_field(coup,1,Val_GtkTextIter(ti2));\ Store_field(res,0,coup);};\ CAMLreturn(res);} Make_search(forward); Make_search(backward); ML_bc6(ml_gtk_source_iter_forward_search); ML_bc6(ml_gtk_source_iter_backward_search); /* This code was taken from gedit */ /* assign a unique name */ static G_CONST_RETURN gchar * get_widget_name (GtkWidget *w) { const gchar *name; name = gtk_widget_get_name (w); g_return_val_if_fail (name != NULL, NULL); if (strcmp (name, g_type_name (GTK_WIDGET_TYPE (w))) == 0) { static guint d = 0; gchar *n; n = g_strdup_printf ("%s_%u_%u", name, d, g_random_int ()); d++; gtk_widget_set_name (w, n); g_free (n); name = gtk_widget_get_name (w); } return name; } /* There is no clean way to set the cursor-color, so we are stuck * with the following hack: set the name of each widget and parse * a gtkrc string. */ static void gtk_modify_cursor_color (GtkWidget *textview, GdkColor *color) { static const char cursor_color_rc[] = "style \"svs-cc\"\n" "{\n" "GtkSourceView::cursor-color=\"#%04x%04x%04x\"\n" "}\n" "widget \"*.%s\" style : application \"svs-cc\"\n"; const gchar *name; gchar *rc_temp; name = get_widget_name (textview); g_return_if_fail (name != NULL); if (color != NULL) { rc_temp = g_strdup_printf (cursor_color_rc, color->red, color->green, color->blue, name); } else { GtkRcStyle *rc_style; rc_style = gtk_widget_get_modifier_style (textview); rc_temp = g_strdup_printf (cursor_color_rc, rc_style->text [GTK_STATE_NORMAL].red, rc_style->text [GTK_STATE_NORMAL].green, rc_style->text [GTK_STATE_NORMAL].blue, name); } gtk_rc_parse_string (rc_temp); gtk_widget_reset_rc_styles (textview); g_free (rc_temp); } /* end of gedit code */ ML_2(gtk_modify_cursor_color,GtkWidget_val,GdkColor_val,Unit); lablgtk-2.18.8/src/panel_tags.var0000644000175000017500000000025713460263323015706 0ustar stephstephtype background_type = "PANEL_" [ `NO_BACKGROUND | `COLOR_BACKGROUND | `PIXMAP_BACKGROUND ] type panel_flags = "PANEL_APPLET_" [ `EXPAND_MAJOR | `EXPAND_MINOR | `HAS_HANDLE ] lablgtk-2.18.8/src/gtkStock.ml0000644000175000017500000002663713460263323015214 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject open Gtk (** Stock Items: prebuilt common menu/toolbar items and corresponding icons *) external _gtkstock_init : unit -> unit = "ml_gtkstock_init" let () = _gtkstock_init () type gtk_stock_id = [ | `ABOUT (** since GTK 2.6 *) | `ADD | `APPLY | `BOLD | `CANCEL | `CAPS_LOCK_WARNING (** since GTK 2.16 *) | `CDROM | `CLEAR | `CLOSE | `COLOR_PICKER (** since GTK 2.2 *) | `CONVERT | `CONNECT (** since GTK 2.6 *) | `COPY | `CUT | `DELETE | `DIALOG_AUTHENTICATION (** since GTK 2.4 *) | `DIALOG_INFO | `DIALOG_WARNING | `DIALOG_ERROR | `DIALOG_QUESTION | `DIRECTORY (** since GTK 2.6 *) | `DISCONNECT (** since GTK 2.6 *) | `DND | `DND_MULTIPLE | `EDIT (** since GTK 2.6 *) | `EXECUTE | `FILE (** since GTK 2.6 *) | `FIND | `FIND_AND_REPLACE | `FLOPPY | `FULLSCREEN (** since GTK 2.8 *) | `GOTO_BOTTOM | `GOTO_FIRST | `GOTO_LAST | `GOTO_TOP | `GO_BACK | `GO_DOWN | `GO_FORWARD | `GO_UP | `HARDDISK (** since GTK 2.4 *) | `HELP | `HOME | `INDEX | `INDENT (** since GTK 2.4 *) | `INFO (** since GTK 2.8 *) | `ITALIC | `JUMP_TO | `JUSTIFY_CENTER | `JUSTIFY_FILL | `JUSTIFY_LEFT | `JUSTIFY_RIGHT | `LEAVE_FULLSCREEN (** since GTK 2.8 *) | `MISSING_IMAGE | `MEDIA_FORWARD (** since GTK 2.6 *) | `MEDIA_NEXT (** since GTK 2.6 *) | `MEDIA_PAUSE (** since GTK 2.6 *) | `MEDIA_PLAY (** since GTK 2.6 *) | `MEDIA_PREVIOUS (** since GTK 2.6 *) | `MEDIA_RECORD (** since GTK 2.6 *) | `MEDIA_REWIND (** since GTK 2.6 *) | `MEDIA_STOP (** since GTK 2.6 *) | `NETWORK (** since GTK 2.4 *) | `NEW | `NO | `OK | `OPEN | `ORIENTATION_LANDSCAPE (** since GTK 2.10 *) | `ORIENTATION_PORTRAIT (** since GTK 2.10 *) | `ORIENTATION_REVERSE_LANDSCAPE (** since GTK 2.10 *) | `ORIENTATION_REVERSE_PORTRAIT (** since GTK 2.10 *) | `PAGE_SETUP (** since GTK 2.14 *) | `PASTE | `PREFERENCES | `PRINT | `PRINT_ERROR | `PRINT_PAUSED | `PRINT_PREVIEW | `PRINT_REPORT | `PRINT_WARNING | `PROPERTIES | `QUIT | `REDO | `REFRESH | `REMOVE | `REVERT_TO_SAVED | `SAVE | `SAVE_AS | `SELECT_ALL (** since GTK 2.10 *) | `SELECT_COLOR | `SELECT_FONT | `SORT_ASCENDING | `SORT_DESCENDING | `SPELL_CHECK | `STOP | `STRIKETHROUGH | `UNDELETE | `UNDERLINE | `UNDO | `UNINDENT (** since GTK 2.4 *) | `YES | `ZOOM_100 | `ZOOM_FIT | `ZOOM_IN | `ZOOM_OUT ] type id = [gtk_stock_id | `STOCK of string] let id_table = Hashtbl.create 37 let convert_id : id -> string = function | `STOCK s -> s | id -> Hashtbl.find id_table id let conv = { kind = `STRING; proj = (function `STRING (Some s) -> `STOCK s | _ -> failwith "GtkStock.get_id"); inj = (fun id -> `STRING (Some (convert_id id))) } (* awk '/^#define GTK_STOCK_/ { sub(/GTK_STOCK_/, "", $2) ; print "`" $2 ", " $3 ";"}' /mnt/garnome/root-cvs/include/gtk-2.0/gtk/gtkstock.h *) let () = List.iter (fun (k,d) -> Hashtbl.add id_table k d) [ `DIALOG_AUTHENTICATION, "gtk-dialog-authentication"; `DIALOG_INFO, "gtk-dialog-info"; `DIALOG_WARNING, "gtk-dialog-warning"; `DIALOG_ERROR, "gtk-dialog-error"; `DIALOG_QUESTION, "gtk-dialog-question"; `DND, "gtk-dnd"; `DND_MULTIPLE, "gtk-dnd-multiple"; `ABOUT, "gtk-about"; `ADD, "gtk-add"; `APPLY, "gtk-apply"; `BOLD, "gtk-bold"; `CANCEL, "gtk-cancel"; `CAPS_LOCK_WARNING, "gtk-caps-lock-warning"; `CDROM, "gtk-cdrom"; `CLEAR, "gtk-clear"; `CLOSE, "gtk-close"; `COLOR_PICKER, "gtk-color-picker"; `CONVERT, "gtk-convert"; `CONNECT, "gtk-connect"; `COPY, "gtk-copy"; `CUT, "gtk-cut"; `DELETE, "gtk-delete"; `DIRECTORY, "gtk-directory"; `DISCONNECT, "gtk-disconnect"; `EDIT, "gtk-edit"; `EXECUTE, "gtk-execute"; `FILE, "gtk-file"; `FIND, "gtk-find"; `FIND_AND_REPLACE, "gtk-find-and-replace"; `FLOPPY, "gtk-floppy"; `FULLSCREEN, "gtk-fullscreen"; `GOTO_BOTTOM, "gtk-goto-bottom"; `GOTO_FIRST, "gtk-goto-first"; `GOTO_LAST, "gtk-goto-last"; `GOTO_TOP, "gtk-goto-top"; `GO_BACK, "gtk-go-back"; `GO_DOWN, "gtk-go-down"; `GO_FORWARD, "gtk-go-forward"; `GO_UP, "gtk-go-up"; `HARDDISK, "gtk-harddisk"; `HELP, "gtk-help"; `HOME, "gtk-home"; `INDEX, "gtk-index"; `INDENT, "gtk-indent"; `INFO, "gtk-info"; `ITALIC, "gtk-italic"; `JUMP_TO, "gtk-jump-to"; `JUSTIFY_CENTER, "gtk-justify-center"; `JUSTIFY_FILL, "gtk-justify-fill"; `JUSTIFY_LEFT, "gtk-justify-left"; `JUSTIFY_RIGHT, "gtk-justify-right"; `LEAVE_FULLSCREEN, "gtk-leave-fullscreen"; (*@ *) `MISSING_IMAGE, "gtk-missing-image"; `MEDIA_FORWARD, "gtk-media-forward"; `MEDIA_NEXT, "gtk-media-next"; `MEDIA_PAUSE, "gtk-media-pause"; `MEDIA_PLAY, "gtk-media-play"; `MEDIA_PREVIOUS, "gtk-media-previous"; `MEDIA_RECORD, "gtk-media-record"; `MEDIA_REWIND, "gtk-media-rewind"; `MEDIA_STOP, "gtk-media-stop"; `NETWORK, "gtk-network"; `NEW, "gtk-new"; `NO, "gtk-no"; `OK, "gtk-ok"; `OPEN, "gtk-open"; `ORIENTATION_PORTRAIT, "gtk-orientation-portrait"; `ORIENTATION_LANDSCAPE, "gtk-orientation-landscape"; `ORIENTATION_REVERSE_LANDSCAPE, "gtk-orientation-reverse-landscape"; `ORIENTATION_REVERSE_PORTRAIT, "gtk-orientation-reverse-portrait"; `PAGE_SETUP, "gtk-page-setup"; `PASTE, "gtk-paste"; `PREFERENCES, "gtk-preferences"; `PRINT, "gtk-print"; `PRINT_ERROR, "gtk-print-error"; `PRINT_PAUSED, "gtk-print-paused"; `PRINT_PREVIEW, "gtk-print-preview"; `PRINT_REPORT, "gtk-print-report"; `PRINT_WARNING, "gtk-print-warning"; `PROPERTIES, "gtk-properties"; `QUIT, "gtk-quit"; `REDO, "gtk-redo"; `REFRESH, "gtk-refresh"; `REMOVE, "gtk-remove"; `REVERT_TO_SAVED, "gtk-revert-to-saved"; `SAVE, "gtk-save"; `SAVE_AS, "gtk-save-as"; `SELECT_ALL, "gtk-select-all"; (*@ *) `SELECT_COLOR, "gtk-select-color"; `SELECT_FONT, "gtk-select-font"; `SORT_ASCENDING, "gtk-sort-ascending"; `SORT_DESCENDING, "gtk-sort-descending"; `SPELL_CHECK, "gtk-spell-check"; `STOP, "gtk-stop"; `STRIKETHROUGH, "gtk-strikethrough"; `UNDELETE, "gtk-undelete"; `UNDERLINE, "gtk-underline"; `UNDO, "gtk-undo"; `UNINDENT, "gtk-unindent"; `YES, "gtk-yes"; `ZOOM_100, "gtk-zoom-100"; `ZOOM_FIT, "gtk-zoom-fit"; `ZOOM_IN, "gtk-zoom-in"; `ZOOM_OUT, "gtk-zoom-out"; ] module Icon_source = struct external new_icon_source : unit -> icon_source = "ml_gtk_icon_source_new" external set_filename : icon_source -> string -> unit = "ml_gtk_icon_source_set_filename" external set_pixbuf : icon_source -> GdkPixbuf.pixbuf -> unit = "ml_gtk_icon_source_set_pixbuf" external set_direction_wildcarded : icon_source -> bool -> unit = "ml_gtk_icon_source_set_direction_wildcarded" external set_state_wildcarded : icon_source -> bool -> unit = "ml_gtk_icon_source_set_state_wildcarded" external set_size_wildcarded : icon_source -> bool -> unit = "ml_gtk_icon_source_set_size_wildcarded" external set_direction : icon_source -> Gtk.Tags.text_direction -> unit = "ml_gtk_icon_source_set_direction" external set_state : icon_source -> Gtk.Tags.state_type -> unit = "ml_gtk_icon_source_set_state" external set_size : icon_source -> Gtk.Tags.icon_size -> unit = "ml_gtk_icon_source_set_size" end module Icon_set = struct external new_icon_set : unit -> icon_set = "ml_gtk_icon_set_new" external new_from_pixbuf : GdkPixbuf.pixbuf -> icon_set = "ml_gtk_icon_set_new_from_pixbuf" external add_source : icon_set -> icon_source -> unit = "ml_gtk_icon_set_add_source" external get_sizes : icon_set -> Gtk.Tags.icon_size list = "ml_gtk_icon_set_get_sizes" end module Icon_factory = struct external new_factory : unit -> icon_factory = "ml_gtk_icon_factory_new" external add : icon_factory -> string -> icon_set -> unit = "ml_gtk_icon_factory_add" external lookup : icon_factory -> string -> icon_set = "ml_gtk_icon_factory_lookup" external add_default : icon_factory -> unit = "ml_gtk_icon_factory_add_default" external remove_default : icon_factory -> unit = "ml_gtk_icon_factory_remove_default" external lookup_default : string -> icon_set = "ml_gtk_icon_factory_lookup_default" end let make_icon_source ?filename ?pixbuf ?direction ?state ?size () = let s = Icon_source.new_icon_source () in Gaux.may (Icon_source.set_filename s) filename ; Gaux.may (Icon_source.set_pixbuf s) pixbuf ; Gaux.may (fun p -> Icon_source.set_direction_wildcarded s false ; Icon_source.set_direction s p) direction ; Gaux.may (fun p -> Icon_source.set_state_wildcarded s false ; Icon_source.set_state s p) state ; Gaux.may (fun p -> Icon_source.set_size_wildcarded s false ; Icon_source.set_size s p) size ; s let make_icon_set ?pixbuf sources = let s = match pixbuf with | None -> Icon_set.new_icon_set () | Some pb -> Icon_set.new_from_pixbuf pb in List.iter (Icon_set.add_source s) sources ; s let make_icon_factory ?(default = true) ?icons () = let f = Icon_factory.new_factory () in Gaux.may icons ~f:(List.iter (fun (n, i) -> Icon_factory.add f (convert_id n) i)) ; if default then Icon_factory.add_default f ; f type item = { stock_id : string ; label : string ; modifier : Gdk.Tags.modifier list ; keyval : Gdk.keysym ; } module Item = struct external add : item -> unit = "ml_gtk_stock_add" external list_ids : unit -> string list = "ml_gtk_stock_list_ids" external lookup : string -> item = "ml_gtk_stock_lookup" let lookup id = lookup (convert_id id) end lablgtk-2.18.8/src/glade.ml0000644000175000017500000001664313460263323014473 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gtk (* GladeXML widget *) type glade_xml = [`data|`glade_xml] external init : unit -> unit = "ml_glade_init" (* external gnome_init : unit -> unit = "ml_glade_gnome_init" *) external create : ?file:string -> ?data:string -> ?root:string -> ?domain:string -> unit -> glade_xml obj = "ml_glade_xml_new" external _signal_autoconnect : [> `glade_xml] obj -> (string * unit obj * string * unit obj option * bool -> unit) -> unit = "ml_glade_xml_signal_autoconnect_full" let signal_autoconnect self ~f = _signal_autoconnect self (fun (handler, obj, signal, target, after) -> f ~handler ~signal ~after ?target obj) external _signal_connect : [> `glade_xml] obj -> string -> (string * unit obj * string * unit obj option * bool -> unit) -> unit = "ml_glade_xml_signal_connect_full" let signal_connect self ~handler ~f = _signal_connect self handler (fun (handler, obj, signal, target, after) -> f ~signal ~after ?target obj) external get_widget : [> `glade_xml] obj -> name:string -> widget obj = "ml_glade_xml_get_widget" external get_widget_name : [> `widget] obj -> string = "ml_glade_get_widget_name" external get_widget_tree : [> `widget] obj -> glade_xml obj = "ml_glade_get_widget_tree" let get_widget_msg ~name ?info xml = try get_widget ~name xml with Gpointer.Null -> let name = match info with None -> name | Some s -> s^":"^name in failwith ("Glade error: " ^ name ^ " is not accessible.") (* Signal handlers *) open Gobject type handler = [ `Simple of (unit -> unit) | `Object of string * (unit obj -> unit) | `Custom of (Closure.argv -> data_get list -> unit) ] let ($) f g x = g (f x) let gtk_bool b argv _ = Closure.set_result argv (`BOOL b) let known_handlers : (string, handler) Hashtbl.t = Hashtbl.create 11 let add_handler ~name handler = Hashtbl.add known_handlers name handler open GtkBase let _ = List.iter ~f:(fun (name,h) -> add_handler ~name h) [ "gtk_widget_destroy",`Object ("GtkObject", Object.cast $ Object.destroy); "gtk_main_quit", `Simple GtkMain.Main.quit; "gtk_widget_show", `Object ("GtkWidget", Widget.cast $ Widget.show); "gtk_widget_hide", `Object ("GtkWidget", Widget.cast $ Widget.hide); "gtk_widget_grab_focus", `Object ("GtkWidget", Widget.cast $ fun w -> set Widget.P.has_focus w true); "gtk_window_activate_default", `Object ("GtkWindow", fun w -> ignore (GtkWindow.Window.activate_default (GtkWindow.Window.cast w))); "gtk_true", `Custom (gtk_bool true); "gtk_false", `Custom (gtk_bool false); ] open Printf let check_handler ?target ?(name="") handler = match handler with `Simple f -> fun _ -> f () | `Object (cls, f) -> begin match target with None -> eprintf "Glade-warning: %s requires an object argument.\n" name; raise Not_found | Some obj -> if Gobject.is_a obj cls then fun _ -> f obj else begin eprintf "Glade-warning: %s expects a %s argument.\n" name cls; raise Not_found end end | `Custom f -> if target <> None then eprintf "Glade-warning: %s does not take an object argument.\n" name; fun argv -> f argv (Closure.get_args argv) let bind_handlers ?(extra=[]) ?(warn=false) xml = signal_autoconnect xml ~f: begin fun ~handler:name ~signal ~after ?target obj -> try let handler = try List.assoc name extra with Not_found -> Hashtbl.find known_handlers name in let callback = check_handler ?target ~name handler in ignore (GtkSignal.connect_by_name obj ~name:signal ~after ~callback:(Closure.create callback)) with Not_found -> if warn then eprintf "Glade.bind_handlers: no handler for %s\n" name end; flush stderr let bind_handler ~name ~handler ?(warn=true) xml = let warn = ref warn in signal_connect xml ~handler:name ~f: begin fun ~signal ~after ?target obj -> warn := false; let callback = check_handler ?target ~name handler in ignore (GtkSignal.connect_by_name obj ~name:signal ~after ~callback:(Closure.create callback)) end; if !warn then begin eprintf "Glade-warning: handler %s is not used\n" name; flush stderr end (* To list bindings *) let ($) f g x = g (f x) let show_option sh = function None -> "None" | Some x -> "Some " ^ sh x let print_binding oc ~handler ~signal ~after ?target obj = Printf.fprintf oc "object=%s, signal=%s, handler=%s, target=%s\n" (get_widget_name (GtkBase.Widget.cast obj)) signal handler (show_option (GtkBase.Widget.cast $ get_widget_name) target) let print_bindings oc xml = signal_autoconnect xml ~f:(print_binding oc); flush oc let trace_handlers oc xml = signal_autoconnect xml ~f: begin fun ~handler ~signal ~after ?target obj -> let callback _ = if signal = "" then Printf.fprintf oc "Glade-debug: handler %s called\n" handler else Printf.fprintf oc "Glade-debug: %s called by signal %s on widget %s\n" handler signal (get_widget_name (GtkBase.Widget.cast obj)); flush oc in ignore (GtkSignal.connect_by_name obj ~name:signal ~after ~callback:(Closure.create callback)) end (* class skeleton, for use in generated wrappers *) let create ?file ?data ?root ?domain () = init (); create ?file ?data ?root ?domain () class xml ?trace ?(autoconnect = true) (xmldata : glade_xml Gtk.obj) = let () = match trace with Some oc -> trace_handlers oc xmldata | None -> () in let () = if autoconnect then bind_handlers xmldata in object (self) val xml = xmldata method xml = xmldata method bind ~name ~callback = bind_handler ~name ~handler:(`Simple callback) ~warn:true xmldata end lablgtk-2.18.8/src/xml_lexer.mll0000644000175000017500000001375313460263323015571 0ustar stephsteph{ type error = | Illegal_character of char | Bad_entity of string | Unterminated of string | Tag_expected | Attribute_expected | Other of string let error_string = function | Illegal_character c -> "illegal character '" ^ Char.escaped c ^ "'" | Bad_entity s -> "\"&" ^ s ^ ";\" is not a valid entity" | Unterminated s -> "unterminated " ^ s ^ " starts here" | Tag_expected -> "a tag was expected" | Attribute_expected -> "an attribute value was expected" | Other s -> s exception Error of error * int type token = | Tag of string * (string * string) list * bool | Chars of string | Endtag of string | EOF let start_pos = ref 0 let reset_pos lexbuf = start_pos := Lexing.lexeme_start lexbuf let raise_unterminated msg = raise (Error (Unterminated msg, !start_pos)) let buffer = Buffer.create 128 let reset_string lexbuf = reset_pos lexbuf ; Buffer.reset buffer let strip_ws = ref true let entities = ref [ "lt" , "<"; "gt" , ">"; "amp" , "&"; "apos", "'"; "quot", "\"" ] let ws = [ ' '; '\009'; '\010'; '\012'; '\013' ] let trim_ws s = let len = String.length s in let start = ref 0 in let stop = ref (len - 1) in while !start < len && List.mem s.[!start] ws do incr start done ; while !stop >= !start && List.mem s.[!stop] ws do decr stop done ; if !start <> 0 || !stop <> len - 1 then String.sub s !start (!stop - !start + 1) else s } let space = [' ' '\009' '\010' '\012' '\013'] let name = ['A'-'Z' 'a'-'z' '_' ':'] ['A'-'Z' 'a'-'z' '0'-'9' '_' ':' '.' '-']* rule token = parse | "" { () } | eof { raise_unterminated "comment" } | _ { comment lexbuf } and skip_prolog_or_pi = parse | "?>" { () } | eof { raise_unterminated "prolog or PI" } | _ { skip_prolog_or_pi lexbuf } and skip_doctype = parse | '\"' [^ '\"' ]* '\"' { skip_doctype lexbuf } | ''' [^ ''' ]* ''' { skip_doctype lexbuf } | '[' { skip_intsubset lexbuf; skip_doctype lexbuf } | '>' { () } | eof { raise_unterminated "DOCTYPE" } | [^ ''' '\"' '[' '>']+ { skip_doctype lexbuf } and skip_intsubset = parse | ']' | eof { () } | '\"' [^ '\"' ]* '\"' { skip_intsubset lexbuf } | ''' [^ ''' ]* ''' { skip_intsubset lexbuf } | [^ ''' '\"' ']']+ { skip_intsubset lexbuf } lablgtk-2.18.8/src/gObj.ml0000644000175000017500000003674013460263323014300 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject open Gtk open GtkData open GtkBase (* GObject *) class ['a] gobject_signals obj = object val obj : 'a obj = obj val after = false method after = {< after = true >} method private connect : 'b. ('a,'b) GtkSignal.t -> callback:'b -> _ = fun sgn ~callback -> GtkSignal.connect obj ~sgn ~after ~callback method private notify : 'b. ('a, 'b) property -> callback:('b -> unit) -> _ = fun prop ~callback -> GtkSignal.connect_property obj ~prop ~callback end class gobject_ops obj = object val obj = obj method get_oid = get_oid obj method get_type = Type.name (get_type obj) method disconnect = GtkSignal.disconnect obj method handler_block = GtkSignal.handler_block obj method handler_unblock = GtkSignal.handler_unblock obj method set_property : 'a. string -> 'a data_set -> unit = Property.set_dyn obj method get_property = Property.get_dyn obj method freeze_notify () = Property.freeze_notify obj method thaw_notify () = Property.thaw_notify obj end (* GtkObject *) class type ['a] objvar = object val obj : 'a obj end class gtkobj obj = object val obj = obj method destroy () = Object.destroy obj method get_oid = get_oid obj end class gtkobj_signals_impl obj = object (self) inherit ['a] gobject_signals obj method destroy = self#connect Object.S.destroy end class type gtkobj_signals = object ('a) method after : 'a method destroy : callback:(unit -> unit) -> GtkSignal.id end (* Widget *) module Widget = GtkBase.Widget module Event = Widget.Signals.Event module Signals = Widget.S module P = Widget.P class event_signals obj = object (self) inherit ['a] gobject_signals (obj :> Gtk.widget obj) method any = self#connect Event.any method after_any = self#connect Signals.event_after method button_press = self#connect Event.button_press method button_release = self#connect Event.button_release method client = self#connect Event.client method configure = self#connect Event.configure method delete = self#connect Event.delete method destroy = self#connect Event.destroy method enter_notify = self#connect Event.enter_notify method expose = self#connect Event.expose method focus_in = self#connect Event.focus_in method focus_out = self#connect Event.focus_out method key_press = self#connect Event.key_press method key_release = self#connect Event.key_release method leave_notify = self#connect Event.leave_notify method map = self#connect Event.map method motion_notify = self#connect Event.motion_notify method property_notify = self#connect Event.property_notify method proximity_in = self#connect Event.proximity_in method proximity_out = self#connect Event.proximity_out method scroll = self#connect Event.scroll method selection_clear = self#connect Event.selection_clear method selection_notify = self#connect Event.selection_notify method selection_request = self#connect Event.selection_request method unmap = self#connect Event.unmap method visibility_notify = self#connect Event.visibility_notify method window_state = self#connect Event.window_state end class event_ops obj = object val obj = (obj :> Gtk.widget obj) method add = Widget.add_events obj method connect = new event_signals obj method send : Gdk.Tags.event_type Gdk.event -> bool = Widget.event obj method set_extensions = set Widget.P.extension_events obj end let iter_setcol set style = List.iter ~f:(fun (state, color) -> set style state (GDraw.color color)) class style st = object val style = st method as_style = style method copy = {< style = Style.copy style >} method colormap = Style.get_colormap style method font = Style.get_font style method bg = Style.get_bg style method set_bg = iter_setcol Style.set_bg style method fg = Style.get_fg style method set_fg = iter_setcol Style.set_fg style method light = Style.get_light style method set_light = iter_setcol Style.set_light style method dark = Style.get_dark style method set_dark = iter_setcol Style.set_dark style method mid = Style.get_mid style method set_mid = iter_setcol Style.set_mid style method base = Style.get_base style method set_base = iter_setcol Style.set_base style method text = Style.get_text style method set_text = iter_setcol Style.set_text style method set_font = Style.set_font style end class selection_input (sel : Gtk.selection_data) = object val sel = sel method selection = Selection.selection sel method target = Gdk.Atom.name (Selection.target sel) end class selection_data sel = object inherit selection_input sel method typ = Gdk.Atom.name (Selection.seltype sel) method data = Selection.get_data sel method format = Selection.format sel end class selection_context sel = object inherit selection_input sel method return ?typ ?(format=8) data = let typ = match typ with Some t -> Gdk.Atom.intern t | _ -> Selection.target sel in Selection.set sel ~typ ~format ~data:(Some data) end class drag_signals obj = object (self) inherit ['a] gobject_signals obj method private connect_drag : 'b. ('a, Gdk.drag_context -> 'b) GtkSignal.t -> callback:(drag_context -> 'b) -> _ = fun sgn ~callback -> self#connect sgn (fun context -> callback (new drag_context context)) method beginning = self#connect_drag Signals.drag_begin method ending = self#connect_drag Signals.drag_end method data_delete = self#connect_drag Signals.drag_data_delete method leave = self#connect_drag Signals.drag_leave method motion = self#connect_drag Signals.drag_motion method drop = self#connect_drag Signals.drag_drop method data_get ~callback = self#connect Signals.drag_data_get ~callback: begin fun context seldata ~info ~time -> callback (new drag_context context) (new selection_context seldata) ~info ~time end method data_received ~callback = self#connect Signals.drag_data_received ~callback:(fun context ~x ~y data -> callback (new drag_context context) ~x ~y (new selection_data data)) end and drag_ops obj = object val obj = obj method connect = new drag_signals obj method dest_set ?(flags=[`ALL]) ?(actions=[]) targets = DnD.dest_set obj ~flags ~actions ~targets:(Array.of_list targets) method dest_unset () = DnD.dest_unset obj method get_data ~target ?(time=Int32.zero) (context : drag_context) = DnD.get_data obj context#context ~target:(Gdk.Atom.intern target) ~time method highlight () = DnD.highlight obj method unhighlight () = DnD.unhighlight obj method source_set ?modi:m ?(actions=[]) targets = DnD.source_set obj ?modi:m ~actions ~targets:(Array.of_list targets) method source_set_icon ?(colormap = Gdk.Color.get_system_colormap ()) (pix : GDraw.pixmap) = DnD.source_set_icon obj ~colormap pix#pixmap ?mask:pix#mask method source_unset () = DnD.source_unset obj end and drag_context context = object inherit GDraw.drag_context context method context = context method finish = DnD.finish context method source_widget = new widget (unsafe_cast (DnD.get_source_widget context)) method set_icon_widget (w : widget) = DnD.set_icon_widget context (w#as_widget) method set_icon_pixmap ?(colormap = Gdk.Color.get_system_colormap ()) (pix : GDraw.pixmap) = DnD.set_icon_pixmap context ~colormap pix#pixmap ?mask:pix#mask end and misc_signals obj = object (self) inherit gtkobj_signals_impl obj method show = self#connect Signals.show method hide = self#connect Signals.hide method map = self#connect Signals.map method unmap = self#connect Signals.unmap method query_tooltip = self#connect Signals.query_tooltip method realize = self#connect Signals.realize method unrealize = self#connect Signals.unrealize method state_changed = self#connect Signals.state_changed method size_allocate = self#connect Signals.size_allocate method parent_set ~callback = self#connect Signals.parent_set ~callback: begin function None -> callback None | Some w -> callback (Some (new widget (unsafe_cast w))) end method style_set ~callback = self#connect Signals.style_set ~callback: (fun opt -> callback (may opt ~f:(new style))) method selection_get ~callback = self#connect Signals.selection_get ~callback: begin fun seldata ~info ~time -> callback (new selection_context seldata) ~info ~time end method selection_received ~callback = self#connect Signals.selection_received ~callback:(fun data -> callback (new selection_data data)) end and misc_ops obj = object (self) inherit gobject_ops obj method get_flag = Object.get_flag obj method connect = new misc_signals obj method show () = Widget.show obj method unparent () = Widget.unparent obj method show_all () = Widget.show_all obj method hide () = Widget.hide obj method hide_all () = Widget.hide_all obj method map () = Widget.map obj method unmap () = Widget.unmap obj method realize () = Widget.realize obj method unrealize () = Widget.unrealize obj method draw = Widget.draw obj method activate () = Widget.activate obj method reparent (w : widget) = Widget.reparent obj w#as_widget (* method popup = popup obj *) method intersect = Widget.intersect obj method grab_focus () = set P.has_focus obj true method grab_default () = set P.has_default obj true method is_ancestor (w : widget) = Widget.is_ancestor obj w#as_widget method add_accelerator : 'a. sgn:('a, unit -> unit) GtkSignal.t -> _ = fun ~sgn:sg ~group ?modi ?flags key -> let sg = {sg with GtkSignal.classe = `widget} in Widget.add_accelerator obj ~sgn:sg group ~key ?modi ?flags method remove_accelerator ~group ?modi key = Widget.remove_accelerator obj group ~key ?modi (* method lock_accelerators () = lock_accelerators obj *) method set_name = set P.name obj method set_state = Widget.set_state obj method set_sensitive = set P.sensitive obj method set_can_default = set P.can_default obj method set_can_focus = set P.can_focus obj method set_app_paintable = set P.app_paintable obj method set_double_buffered = Widget.set_double_buffered obj method set_size_request = Widget.size_params [] ~cont:(fun p () -> set_params obj p) method set_size_chars ?desc ?lang ?width ?height () = let metrics = (self#pango_context : GPango.context)#get_metrics ?desc ?lang () in let width = may_map width ~f: (fun w -> w * GPango.to_pixels metrics#approx_digit_width) and height = may_map height ~f: (fun h -> h * GPango.to_pixels (metrics#ascent+metrics#descent)) in self#set_size_request ?width ?height () method set_style (style : style) = set P.style obj style#as_style method modify_fg = iter_setcol Widget.modify_fg obj method modify_bg = iter_setcol Widget.modify_bg obj method modify_text = iter_setcol Widget.modify_text obj method modify_base = iter_setcol Widget.modify_base obj method modify_font = Widget.modify_font obj method modify_font_by_name s = Widget.modify_font obj (Pango.Font.from_string s) method create_pango_context = new GPango.context_rw (Widget.create_pango_context obj) (* get functions *) method name = get P.name obj method toplevel = try new widget (unsafe_cast (Widget.get_toplevel obj)) with Gpointer.Null -> failwith "GObj.misc_ops#toplevel" method window = Widget.window obj method colormap = Widget.get_colormap obj method visual = Widget.get_visual obj method visual_depth = Gdk.Visual.depth (Widget.get_visual obj) method pointer = Widget.get_pointer obj method style = new style (get P.style obj) method visible = self#get_flag `VISIBLE method parent = may_map (fun w -> new widget (unsafe_cast w)) (get P.parent obj) method allocation = Widget.allocation obj method pango_context = new GPango.context (Widget.get_pango_context obj) (* icon *) method render_icon ?detail ~size id = Widget.render_icon obj (GtkStock.convert_id id) size detail (* selection *) method convert_selection ~target ?(time=Int32.zero) sel = Selection.convert obj ~sel ~target:(Gdk.Atom.intern target) ~time method grab_selection ?(time=Int32.zero) sel = Selection.owner_set obj ~sel ~time method add_selection_target ~target ?(info=0) sel = Selection.add_target obj ~sel ~target:(Gdk.Atom.intern target) ~info method clear_selection_targets sel = Selection.clear_targets obj ~sel (* tooltip *) method has_tooltip = get P.has_tooltip obj method tooltip_markup = get P.tooltip_markup obj method tooltip_text = get P.tooltip_text obj method set_has_tooltip = set P.has_tooltip obj method set_tooltip_markup = set P.tooltip_markup obj method set_tooltip_text = set P.tooltip_text obj end and widget obj = object (self) inherit gtkobj obj method as_widget = (obj :> Gtk.widget obj) method misc = new misc_ops (obj :> Gtk.widget obj) method drag = new drag_ops (unsafe_cast obj : Gtk.widget obj) method coerce = (self :> widget) end (* just to check that GDraw.misc_ops is compatible with misc_ops *) let _ = fun (x : #GDraw.misc_ops) -> (x : misc_ops) class widget_signals_impl (obj : [>Gtk.widget] obj) = gtkobj_signals_impl obj class type widget_signals = gtkobj_signals class ['a] widget_impl (obj : 'a obj) = widget obj class widget_full obj = object inherit widget obj method connect = new widget_signals_impl obj end let as_widget (w : widget) = w#as_widget let wrap_widget w = new widget (unsafe_cast w) let unwrap_widget w = unsafe_cast w#as_widget let conv_widget_option = { kind = `OBJECT; proj = (function `OBJECT c -> may_map ~f:wrap_widget c | _ -> failwith "GObj.get_object"); inj = (fun c -> `OBJECT (may_map ~f:unwrap_widget c)) } let conv_widget = { kind = `OBJECT; proj = (function `OBJECT (Some c) -> wrap_widget c | `OBJECT None -> raise Gpointer.Null | _ -> failwith "GObj.get_object"); inj = (fun c -> `OBJECT (Some (unwrap_widget c))) } let pack_return self ~packing ~show = may packing ~f:(fun f -> (f (self :> widget) : unit)); if show <> Some false then self#misc#show (); self lablgtk-2.18.8/src/gdkPixbuf.ml0000644000175000017500000002601113460263323015330 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gdk type pixbuf = [`pixbuf] obj type colorspace = [ `RGB ] type alpha_mode = [ `BILEVEL | `FULL ] type interpolation = [ `NEAREST | `TILES | `BILINEAR | `HYPER ] type gdkpixbuferror = | ERROR_CORRUPT_IMAGE | ERROR_INSUFFICIENT_MEMORY | ERROR_BAD_OPTION | ERROR_UNKNOWN_TYPE | ERROR_UNSUPPORTED_OPERATION | ERROR_FAILED exception GdkPixbufError of gdkpixbuferror * string external _init : unit -> unit = "ml_gdkpixbuf_init" let () = _init () ; Callback.register_exception "gdk_pixbuf_error" (GdkPixbufError (ERROR_CORRUPT_IMAGE, "")) external set_marshal_use_rle : bool -> unit = "ml_gdk_pixbuf_set_marshal_use_rle" (* Accessors *) external get_n_channels : pixbuf -> int = "ml_gdk_pixbuf_get_n_channels" external get_has_alpha : pixbuf -> bool = "ml_gdk_pixbuf_get_has_alpha" external get_bits_per_sample : pixbuf -> int = "ml_gdk_pixbuf_get_bits_per_sample" external get_width : pixbuf -> int = "ml_gdk_pixbuf_get_width" external get_height : pixbuf -> int = "ml_gdk_pixbuf_get_height" external get_rowstride : pixbuf -> int = "ml_gdk_pixbuf_get_rowstride" external _get_pixels : pixbuf -> Obj.t * int = "ml_gdk_pixbuf_get_pixels" let get_pixels pixbuf = let obj, pos = _get_pixels pixbuf in let get_length (_, pixbuf) = get_rowstride pixbuf * get_height pixbuf + pos in let r = Gpointer.unsafe_create_region ~path:[|0|] ~get_length (obj, pixbuf) in Gpointer.sub ~pos r (* Constructors *) external _create : colorspace:colorspace -> has_alpha:bool -> bits:int -> width:int -> height:int -> pixbuf = "ml_gdk_pixbuf_new" let create ~width ~height ?(bits=8) ?(colorspace=`RGB) ?(has_alpha=false) () = _create ~colorspace ~has_alpha ~bits ~width ~height let cast o : pixbuf = Gobject.try_cast o "GdkPixbuf" external copy : pixbuf -> pixbuf = "ml_gdk_pixbuf_copy" external subpixbuf : pixbuf -> src_x:int -> src_y:int -> width:int -> height:int -> pixbuf = "ml_gdk_pixbuf_new_subpixbuf" external from_file : string -> pixbuf = "ml_gdk_pixbuf_new_from_file" external get_file_info : string -> string * int * int = "ml_gdk_pixbuf_get_file_info" external from_file_at_size : string -> width:int -> height:int -> pixbuf = "ml_gdk_pixbuf_new_from_file_at_size" external from_xpm_data : string array -> pixbuf = "ml_gdk_pixbuf_new_from_xpm_data" external _from_data : Gpointer.region -> has_alpha:bool -> bits:int -> width:int -> height:int -> rowstride:int -> pixbuf = "ml_gdk_pixbuf_new_from_data_bc" "ml_gdk_pixbuf_new_from_data" let from_data ~width ~height ?(bits=8) ?rowstride ?(has_alpha=false) data = let nc = if has_alpha then 4 else 3 in let rowstride = match rowstride with None -> width * nc | Some r -> r in if bits <> 8 || rowstride < width * nc || width <= 0 || height <= 0 || Gpointer.length data < rowstride * (height - 1) + width * nc then invalid_arg "GdkPixbuf.from_data"; _from_data data ~has_alpha ~bits ~width ~height ~rowstride external _get_from_drawable : pixbuf -> [>`drawable] obj -> colormap -> src_x:int -> src_y:int -> dest_x:int -> dest_y:int -> width:int -> height:int -> unit = "ml_gdk_pixbuf_get_from_drawable_bc" "ml_gdk_pixbuf_get_from_drawable" let get_from_drawable ~dest ?(dest_x=0) ?(dest_y=0) ?width ?height ?(src_x=0) ?(src_y=0) ?(colormap=Gdk.Rgb.get_cmap()) src = let dw, dh = Gdk.Drawable.get_size src in let mw = min (dw - src_x) (get_width dest - dest_x) and mh = min (dh - src_y) (get_height dest - dest_y) in let width = default mw ~opt:width and height = default mh ~opt:height in if src_x < 0 || src_y < 0 || dest_x < 0 || dest_y < 0 || width <= 0 || height <= 0 || width > mw || height > mh then invalid_arg "GdkPixbuf.get_from_drawable"; _get_from_drawable dest src colormap ~src_x ~src_y ~dest_x ~dest_y ~width ~height (* Render *) external _render_alpha : src:pixbuf -> bitmap -> src_x:int -> src_y:int -> dest_x:int -> dest_y:int -> width:int -> height:int -> threshold:int -> unit = "ml_gdk_pixbuf_render_threshold_alpha_bc" "ml_gdk_pixbuf_render_threshold_alpha" let render_alpha bm ?(dest_x=0) ?(dest_y=0) ?width ?height ?(threshold=128) ?(src_x=0) ?(src_y=0) src = let width = may_default get_width src ~opt:width and height = may_default get_height src ~opt:height in _render_alpha ~src bm ~src_x ~src_y ~dest_x ~dest_y ~width ~height ~threshold external _draw_pixbuf : src:pixbuf -> [>`drawable] obj -> gc -> src_x:int -> src_y:int -> dest_x:int -> dest_y:int -> width:int -> height:int -> dither:Tags.rgb_dither -> x_dither:int -> y_dither:int -> unit = "ml_gdk_pixbuf_render_to_drawable_bc" "ml_gdk_pixbuf_render_to_drawable" let draw_pixbuf dw gc ?(dest_x=0) ?(dest_y=0) ?width ?height ?(dither=`NONE) ?(x_dither=0) ?(y_dither=0) ?(src_x=0) ?(src_y=0) src = let width = may_default get_width src ~opt:width and height = may_default get_height src ~opt:height in _draw_pixbuf dw gc ~src ~src_x ~src_y ~dest_x ~dest_y ~width ~height ~dither ~x_dither ~y_dither let render_to_drawable dw ?(gc=Gdk.GC.create dw) = draw_pixbuf dw gc external _render_to_drawable_alpha : src:pixbuf -> [>`drawable] obj -> src_x:int -> src_y:int -> dest_x:int -> dest_y:int -> width:int -> height:int -> alpha:alpha_mode -> threshold:int -> dither:Tags.rgb_dither -> x_dither:int -> y_dither:int -> unit = "ml_gdk_pixbuf_render_to_drawable_alpha_bc" "ml_gdk_pixbuf_render_to_drawable_alpha" let render_to_drawable_alpha dw ?(dest_x=0) ?(dest_y=0) ?width ?height ?(alpha=`FULL) ?(threshold=128) ?(dither=`NONE) ?(x_dither=0) ?(y_dither=0) ?(src_x=0) ?(src_y=0) src = let width = may_default get_width src ~opt:width and height = may_default get_height src ~opt:height in _render_to_drawable_alpha ~src dw ~src_x ~src_y ~dest_x ~dest_y ~width ~height ~dither ~x_dither ~y_dither ~alpha ~threshold external _create_pixmap : pixbuf -> threshold:int -> pixmap * bitmap option = "ml_gdk_pixbuf_render_pixmap_and_mask" let create_pixmap ?(threshold=128) pb = _create_pixmap pb ~threshold (* Transform *) external _add_alpha : pixbuf -> subst:bool -> r:int -> g:int -> b:int -> pixbuf = "ml_gdk_pixbuf_add_alpha" let add_alpha ?transparent pb = match transparent with None -> _add_alpha pb ~subst:false ~r:0 ~g:0 ~b:0 | Some (r, g, b) -> _add_alpha pb ~subst:true ~r ~g ~b external fill : pixbuf -> int32 -> unit = "ml_gdk_pixbuf_fill" external _saturate_and_pixelate : pixbuf -> dest:pixbuf -> saturation:float -> pixelate:bool -> unit = "ml_gdk_pixbuf_saturate_and_pixelate" let saturate_and_pixelate ~dest ~saturation ~pixelate src = _saturate_and_pixelate src ~dest ~saturation ~pixelate external _copy_area : src:pixbuf -> src_x:int -> src_y:int -> width:int -> height:int -> dest:pixbuf -> dest_x:int -> dest_y:int -> unit = "ml_gdk_pixbuf_copy_area_bc" "ml_gdk_pixbuf_copy_area" let copy_area ~dest ?(dest_x=0) ?(dest_y=0) ?width ?height ?(src_x=0) ?(src_y=0) src = let mw = min (get_width src - src_x) (get_width dest - dest_x) and mh = min (get_height src - src_y) (get_height dest - dest_y) in let width = match width with Some w -> w | None -> mw and height = match height with Some h -> h | None -> mh in if src_x < 0 || src_y < 0 || dest_x < 0 || dest_y < 0 || width <= 0 || height <= 0 || width > mw || height > mh then invalid_arg "GdkPixbuf.copy_area"; _copy_area ~src ~src_x ~src_y ~width ~height ~dest ~dest_x ~dest_y let get_size sz sc ~ssrc ~sdest ~dest ~ofs = match sz, sc with None, None -> (sdest - dest, (float dest +. ofs) /. float ssrc) | None, Some sc -> (truncate(float ssrc *. sc -. ofs), sc) | Some sz, None -> (sz, (float sz +. ofs) /. float ssrc) | Some sz, Some sc -> (sz, sc) external _scale : src:pixbuf -> dest:pixbuf -> dest_x:int -> dest_y:int -> width:int -> height:int -> ofs_x:float -> ofs_y:float -> scale_x:float -> scale_y:float -> interp:interpolation -> unit = "ml_gdk_pixbuf_scale_bc" "ml_gdk_pixbuf_scale" let scale ~dest ?(dest_x=0) ?(dest_y=0) ?width ?height ?(ofs_x=0.) ?(ofs_y=0.) ?scale_x ?scale_y ?(interp=`BILINEAR) src = let width, scale_x = get_size width scale_x ~ssrc:(get_width src) ~sdest:(get_width dest) ~dest:dest_x ~ofs:ofs_x and height, scale_y = get_size height scale_y ~ssrc:(get_height src) ~sdest:(get_height dest) ~dest:dest_y ~ofs:ofs_y in _scale ~src ~dest ~dest_x ~dest_y ~width ~height ~ofs_x ~ofs_y ~scale_x ~scale_y ~interp external _composite : src:pixbuf -> dest:pixbuf -> dest_x:int -> dest_y:int -> width:int -> height:int -> ofs_x:float -> ofs_y:float -> scale_x:float -> scale_y:float -> interp:interpolation -> alpha:int -> unit = "ml_gdk_pixbuf_composite_bc" "ml_gdk_pixbuf_composite" let composite ~dest ~alpha ?(dest_x=0) ?(dest_y=0) ?width ?height ?(ofs_x=0.) ?(ofs_y=0.) ?scale_x ?scale_y ?(interp=`BILINEAR) src = let width, scale_x = get_size width scale_x ~ssrc:(get_width src) ~sdest:(get_width dest) ~dest:dest_x ~ofs:ofs_x and height, scale_y = get_size height scale_y ~ssrc:(get_height src) ~sdest:(get_height dest) ~dest:dest_y ~ofs:ofs_y in _composite ~src ~dest ~dest_x ~dest_y ~width ~height ~ofs_x ~ofs_y ~scale_x ~scale_y ~interp ~alpha (* Saving *) external save : filename:string -> typ:string -> ?options:(string * string) list -> pixbuf -> unit = "ml_gdk_pixbuf_save" external save_to_callback : pixbuf -> typ:string -> ?options:(string * string) list -> (string -> unit) -> unit = "ml_gdk_pixbuf_save_to_callback" let save_to_buffer pb ~typ ?options buffer = save_to_callback pb ~typ ?options (Buffer.add_string buffer) lablgtk-2.18.8/src/glGtk.ml0000644000175000017500000001012513460263323014454 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk type visual_options = [ | `USE_GL | `BUFFER_SIZE of int | `LEVEL of int | `RGBA | `DOUBLEBUFFER | `STEREO | `AUX_BUFFERS of int | `RED_SIZE of int | `GREEN_SIZE of int | `BLUE_SIZE of int | `ALPHA_SIZE of int | `DEPTH_SIZE of int | `STENCIL_SIZE of int | `ACCUM_GREEN_SIZE of int | `ACCUM_ALPHA_SIZE of int ] type gl_area = [Gtk.drawing_area|`glarea] module GtkRaw = struct external create : visual_options list -> share:[>`glarea] optobj -> gl_area obj = "ml_gtk_gl_area_new" external swap_buffers : [>`glarea] obj -> unit = "ml_gtk_gl_area_swap_buffers" external make_current : [>`glarea] obj -> bool = "ml_gtk_gl_area_make_current" end class area_signals obj = object (connect) inherit GObj.widget_signals_impl (obj : [> gl_area] obj) method display ~callback = (new GObj.event_signals obj)#after#expose ~callback: begin fun ev -> if GdkEvent.Expose.count ev = 0 then if GtkRaw.make_current obj then callback () else prerr_endline "GlGtk-WARNING **: could not make current"; true end method reshape ~callback = (new GObj.event_signals obj)#after#configure ~callback: begin fun ev -> if GtkRaw.make_current obj then begin callback ~width:(GdkEvent.Configure.width ev) ~height:(GdkEvent.Configure.height ev) end else prerr_endline "GlGtk-WARNING **: could not make current"; true end method realize ~callback = (new GObj.misc_signals (obj :> Gtk.widget obj))#after#realize ~callback: begin fun ev -> if GtkRaw.make_current obj then callback () else prerr_endline "GlGtk-WARNING **: could not make current" end end class area obj = object (self) inherit GObj.widget (obj : gl_area obj) method as_area = obj method event = new GObj.event_ops obj method connect = new area_signals obj method set_size = GtkMisc.DrawingArea.size obj method swap_buffers () = GtkRaw.swap_buffers obj method make_current () = if not (GtkRaw.make_current obj) then raise (Gl.GLerror "make_current") end let area options ?share ?(width=0) ?(height=0) ?packing ?show () = let share = match share with Some (x : area) -> Some x#as_area | None -> None in let w = GtkRaw.create options ~share:(Gpointer.optboxed share) in if width <> 0 || height <> 0 then GtkMisc.DrawingArea.size w ~width ~height; GtkBase.Widget.add_events w [`EXPOSURE]; GObj.pack_return (new area w) ~packing ~show let region_of_raw raw = Gpointer.unsafe_create_region ~path:[|1|] ~get_length:Raw.byte_size raw lablgtk-2.18.8/src/gMisc.mli0000644000175000017500000004067713460263323014636 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** Miscellaneous widgets *) (** @gtkdoc gtk GtkSeparator @gtkdoc gtk GtkHSeparator @gtkdoc gtk GtkVSeparator *) val separator : Tags.orientation -> ?packing:(widget -> unit) -> ?show:bool -> unit -> widget_full (** {3 Statusbar} *) class statusbar_context : Gtk.statusbar obj -> Gtk.statusbar_context -> object val context : Gtk.statusbar_context val obj : Gtk.statusbar obj method context : Gtk.statusbar_context method flash : ?delay:int -> string -> unit (** @param delay default value is [1000] ms *) method pop : unit -> unit method push : string -> statusbar_message method remove : statusbar_message -> unit end (** Report messages of minor importance to the user @gtkdoc gtk GtkStatusbar *) class statusbar : Gtk.statusbar obj -> object inherit GPack.box val obj : Gtk.statusbar obj method new_context : name:string -> statusbar_context method has_resize_grip : bool method set_has_resize_grip : bool -> unit end (** @gtkdoc gtk GtkStatusbar *) val statusbar : ?has_resize_grip:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> statusbar (** {3 Status icon} *) (** @gtkdoc gtk GtkStatusIcon *) class status_icon_signals : Gtk.status_icon Gobject.obj -> object method activate : callback:(unit -> unit) -> GtkSignal.id method popup_menu : callback:(int -> int -> unit) -> GtkSignal.id method size_changed : callback:(int -> unit) -> GtkSignal.id method notify_blinking : callback:(bool -> unit) -> GtkSignal.id method notify_screen : callback:(Gdk.screen -> unit) -> GtkSignal.id method notify_visible : callback:(bool -> unit) -> GtkSignal.id end (** Display an icon in the system tray. @gtkdoc gtk GtkStatusIcon *) class status_icon : Gtk.gtk_status_icon -> object val obj : Gtk.status_icon Gobject.obj method connect : status_icon_signals method blinking : bool method get_icon_name : string method get_pixbuf : GdkPixbuf.pixbuf method screen : Gdk.screen method get_size : int method get_stock : string method visible : bool method is_embedded : bool method set_blinking : bool -> unit method set_from_file : string -> unit method set_from_icon_name : string -> unit method set_from_pixbuf : GdkPixbuf.pixbuf -> unit method set_from_stock : string -> unit method set_screen : Gdk.screen -> unit method set_tooltip : string -> unit method set_visible : bool -> unit end val status_icon : ?screen:Gdk.screen -> ?visible:bool -> ?blinking:bool -> unit -> status_icon val status_icon_from_pixbuf : ?screen:Gdk.screen -> ?visible:bool -> ?blinking:bool -> GdkPixbuf.pixbuf -> status_icon val status_icon_from_file : ?screen:Gdk.screen -> ?visible:bool -> ?blinking:bool -> string -> status_icon val status_icon_from_stock : ?screen:Gdk.screen -> ?visible:bool -> ?blinking:bool -> string -> status_icon val status_icon_from_icon_name : ?screen:Gdk.screen -> ?visible:bool -> ?blinking:bool -> string -> status_icon (** {3 Calendar} *) (** @gtkdoc gtk GtkCalendar *) class calendar_signals : 'a obj -> object inherit GObj.widget_signals constraint 'a = [> calendar] val obj : 'a obj method day_selected : callback:(unit -> unit) -> GtkSignal.id method day_selected_double_click : callback:(unit -> unit) -> GtkSignal.id method month_changed : callback:(unit -> unit) -> GtkSignal.id method next_month : callback:(unit -> unit) -> GtkSignal.id method next_year : callback:(unit -> unit) -> GtkSignal.id method prev_month : callback:(unit -> unit) -> GtkSignal.id method prev_year : callback:(unit -> unit) -> GtkSignal.id method notify_day : callback:(int -> unit) -> GtkSignal.id method notify_month : callback:(int -> unit) -> GtkSignal.id method notify_year : callback:(int -> unit) -> GtkSignal.id end (** Display a calendar and/or allow the user to select a date @gtkdoc gtk GtkCalendar *) class calendar : Gtk.calendar obj -> object inherit GObj.widget val obj : Gtk.calendar obj method day : int method month : int method year : int method set_day : int -> unit method set_month : int -> unit method set_year : int -> unit method event : event_ops method clear_marks : unit method connect : calendar_signals method date : int * int * int method display_options : Tags.calendar_display_options list -> unit method freeze : unit -> unit method mark_day : int -> unit method select_day : int -> unit method select_month : month:int -> year:int -> unit method thaw : unit -> unit method unmark_day : int -> unit method is_day_marked : int -> bool method num_marked_dates : int end (** @gtkdoc gtk GtkCalendar *) val calendar : ?options:Tags.calendar_display_options list -> ?packing:(widget -> unit) -> ?show:bool -> unit -> calendar (** {3 Drawing Area} *) (** A widget for custom user interface elements @gtkdoc gtk GtkDrawingArea *) class drawing_area : ([> Gtk.drawing_area] as 'a) obj -> object inherit GObj.widget_full val obj : 'a obj method event : event_ops method set_size : width:int -> height:int -> unit end (** @gtkdoc gtk GtkDrawingArea *) val drawing_area : ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> drawing_area (** {3 Curve} *) (** Allows direct editing of a curve @gtkdoc gtk GtkCurve *) class curve : Gtk.curve obj -> object inherit drawing_area val obj : Gtk.curve obj method reset : unit -> unit method set_gamma : int -> unit method set_vector : float array -> unit method get_vector : int -> float array method curve_type : GtkEnums.curve_type method max_x : float method max_y : float method min_x : float method min_y : float method set_curve_type : GtkEnums.curve_type -> unit method set_max_x : float -> unit method set_max_y : float -> unit method set_min_x : float -> unit method set_min_y : float -> unit end (** @gtkdoc gtk GtkCurve *) val curve : ?width:int -> ?height:int -> ?curve_type:GtkEnums.curve_type -> ?max_x:float -> ?max_y:float -> ?min_x:float -> ?min_y:float -> ?packing:(widget -> unit) -> ?show:bool -> unit -> curve (** {3 Misc. Widgets} *) (** A base class for widgets with alignments and padding @gtkdoc gtk GtkMisc *) class misc : ([> Gtk.misc] as 'a) obj -> object inherit GObj.widget val obj : 'a obj method set_xalign : float -> unit method set_yalign : float -> unit method set_xpad : int -> unit method set_ypad : int -> unit method xalign : float method yalign : float method xpad : int method ypad : int end (** Produces an arrow pointing in one of the four cardinal directions @gtkdoc gtk GtkArrow *) class arrow : ([> Gtk.arrow] as 'a) obj -> object inherit misc val obj : 'a obj method set_kind : Tags.arrow_type -> unit method set_shadow : Tags.shadow_type -> unit method kind : Tags.arrow_type method shadow : Tags.shadow_type end (** @gtkdoc gtk GtkArrow @param kind default value is [`RIGHT] @param shadow default value is [`OUT] *) val arrow : ?kind:Tags.arrow_type -> ?shadow:Tags.shadow_type -> ?xalign:float -> ?yalign:float -> ?xpad:int -> ?ypad:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> arrow type image_type = [ `EMPTY | `PIXMAP | `IMAGE | `PIXBUF | `STOCK | `ICON_SET | `ANIMATION | `ICON_NAME | `GICON ] (** A widget displaying an image @gtkdoc gtk GtkImage *) class image : 'a obj -> object inherit misc constraint 'a = [> Gtk.image] val obj : 'a obj method clear : unit -> unit (** since Gtk 2.8 *) method storage_type : image_type method set_image : Gdk.image -> unit method set_pixmap : GDraw.pixmap -> unit method set_mask : Gdk.bitmap option -> unit method set_file : string -> unit method set_pixbuf : GdkPixbuf.pixbuf -> unit method set_stock : GtkStock.id -> unit method set_icon_set : icon_set -> unit method set_icon_size : Tags.icon_size -> unit method set_pixel_size : int -> unit method image : Gdk.image method pixmap : GDraw.pixmap method mask : Gdk.bitmap option method pixbuf : GdkPixbuf.pixbuf method pixel_size : int method stock : GtkStock.id method icon_set : icon_set method icon_size : Tags.icon_size end (** @gtkdoc gtk GtkImage *) val image : ?file:string -> ?image:Gdk.image -> ?pixbuf:GdkPixbuf.pixbuf -> ?pixel_size:int -> ?pixmap:Gdk.pixmap -> ?mask:Gdk.bitmap -> ?stock:GtkStock.id -> ?icon_set:icon_set -> ?icon_size:Tags.icon_size -> ?xalign:float -> ?yalign:float -> ?xpad:int -> ?ypad:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> image (* Use an image as a pixmap... *) val pixmap : #GDraw.pixmap -> ?xalign:float -> ?yalign:float -> ?xpad:int -> ?ypad:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> image (** {4 Labels} *) (** @gtkdoc gtk GtkLabel *) class label_skel : 'a obj -> object inherit misc constraint 'a = [> Gtk.label] val obj : 'a obj method cursor_position : int method selection_bound : int method selection_bounds : (int * int) option method select_region : int -> int -> unit method set_justify : Tags.justification -> unit method set_label : string -> unit method set_line_wrap : bool -> unit method set_mnemonic_widget : widget option -> unit method set_pattern : string -> unit method set_selectable : bool -> unit method set_text : string -> unit method set_use_markup : bool -> unit method set_use_underline : bool -> unit method justify : Tags.justification method label : string method line_wrap : bool method mnemonic_keyval : int method mnemonic_widget : widget option method selectable : bool method text : string method use_markup : bool method use_underline : bool method angle : float (** @since GTK 2.6 *) method set_angle : float -> unit (** @since GTK 2.6 *) method max_width_chars : int (** @since GTK 2.6 *) method set_max_width_chars : int -> unit (** @since GTK 2.6 *) method single_line_mode : bool (** @since GTK 2.6 *) method set_single_line_mode : bool -> unit (** @since GTK 2.6 *) method width_chars : int (** @since GTK 2.6 *) method set_width_chars : int -> unit (** @since GTK 2.6 *) method ellipsize : PangoEnums.ellipsize_mode (** @since GTK 2.6 *) method set_ellipsize : PangoEnums.ellipsize_mode -> unit (** @since GTK 2.6 *) end (** A widget that displays a small to medium amount of text @gtkdoc gtk GtkLabel *) class label : Gtk.label obj -> object inherit label_skel val obj : Gtk.label obj method connect : widget_signals end (** @gtkdoc gtk GtkLabel @param markup overrides [text] if both are present @param use_underline default value is [false] @param justify default value is [`LEFT] @param selectable default value is [false] @param line_wrap default values is [false] *) val label : ?text:string -> ?markup:string -> (* overrides ~text if present *) ?use_underline:bool -> ?mnemonic_widget:#widget -> ?justify:Tags.justification -> ?line_wrap:bool -> ?pattern:string -> ?selectable:bool -> ?ellipsize:PangoEnums.ellipsize_mode -> ?xalign:float -> ?yalign:float -> ?xpad:int -> ?ypad:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> label val label_cast : < as_widget : 'a obj ; .. > -> label (** {4 Tips query} *) (** @gtkdoc gtk GtkTipsQuery @deprecated . *) class tips_query_signals : Gtk.tips_query obj -> object inherit GObj.widget_signals method start_query : callback:(unit -> unit) -> GtkSignal.id method stop_query : callback:(unit -> unit) -> GtkSignal.id method widget_entered : callback:(widget option -> text:string -> privat:string -> unit) -> GtkSignal.id method widget_selected : callback:(widget option -> text:string -> privat:string -> GdkEvent.Button.t -> bool) -> GtkSignal.id method notify_caller : callback:(GObj.widget option -> unit) -> GtkSignal.id method notify_emit_always : callback:(bool -> unit) -> GtkSignal.id method notify_label_inactive : callback:(string -> unit) -> GtkSignal.id method notify_label_no_tip : callback:(string -> unit) -> GtkSignal.id end (** Displays help about widgets in the user interface @gtkdoc gtk GtkTipsQuery @deprecated . *) class tips_query : Gtk.tips_query obj -> object inherit label_skel val obj : Gtk.tips_query obj method connect : tips_query_signals method start : unit -> unit method stop : unit -> unit method set_caller : widget option -> unit method set_emit_always : bool -> unit method set_label_inactive : string -> unit method set_label_no_tip : string -> unit method caller : widget option method emit_always : bool method label_inactive : string method label_no_tip : string end (** @gtkdoc gtk GtkTipsQuery @deprecated . *) val tips_query : ?caller:#widget -> ?emit_always:bool -> ?label_inactive:string -> ?label_no_tip:string -> ?xalign:float -> ?yalign:float -> ?xpad:int -> ?ypad:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> tips_query (** {3 Color and font selection} *) (** A widget used to select a color @gtkdoc gtk GtkColorSelection *) class color_selection : Gtk.color_selection obj -> object inherit GObj.widget_full val obj : Gtk.color_selection obj method alpha : int method color : Gdk.color method set_alpha : int -> unit method set_border_width : int -> unit method set_color : Gdk.color -> unit method set_has_opacity_control : bool -> unit method set_has_palette : bool -> unit method has_opacity_control : bool method has_palette : bool end (** @gtkdoc gtk GtkColorSelection *) val color_selection : ?alpha:int -> ?color:Gdk.color -> ?has_opacity_control:bool -> ?has_palette:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> color_selection (** A widget for selecting fonts. @gtkdoc gtk GtkFontSelection *) class font_selection : Gtk.font_selection obj -> object inherit GObj.widget_full val obj : Gtk.font_selection obj method event : event_ops method font_name : string method preview_text : string method set_border_width : int -> unit method set_font_name : string -> unit method set_preview_text : string -> unit end (** @gtkdoc gtk GtkFontSelection *) val font_selection : ?font_name:string -> ?preview_text:string -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> font_selection lablgtk-2.18.8/src/gToolbox.mli0000644000175000017500000002000713460263323015352 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** Useful functions for LablGTK. *) (** {2 Menus} *) (** Tree description of a menu *) type menu_entry = [ `I of string * (unit -> unit) | `C of string * bool * (bool -> unit) | `R of (string * bool * (bool -> unit)) list | `M of string * menu_entry list | `S ] (** Build a menu from a tree description *) val build_menu : GMenu.menu -> entries: menu_entry list -> unit (** Popup a menu created from the given list of labels and functions. *) val popup_menu : entries: menu_entry list -> button: int -> time: int32 -> unit (** {2 Parametrized dialog windows} *) (**This function is used to display a question in a dialog box, with a parametrized list of buttons. The function returns the number of the clicked button (starting at 1), or 0 if the window is savagedly destroyed. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param title the title of the dialog @param buttons the list of button labels. @param default the index of the default answer @param icon a widget (usually a pixmap) which can be displayed on the left of the window. @param message the text to display *) val question_box : ?parent:#GWindow.window_skel -> title:string -> buttons:string list -> ?default:int -> ?icon:#GObj.widget -> string -> int (**This function is used to display a message in a dialog box with just an Ok button. We use [question_box] with just an ok button. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param title the title of the dialog @param icon a widget (usually a pixmap) which can be displayed on the left of the window. @param ok the text for the ok button (default is "Ok") @param message the text to display *) val message_box : ?parent:#GWindow.window_skel -> title:string -> ?icon:#GObj.widget -> ?ok:string -> string -> unit (** Make the user type in a string. @return [None] if the user clicked on cancel, or [Some s] if the user clicked on the ok button. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param title the title of the dialog @param ok the text for the confirmation button (default is "Ok") @param cancel the text for the cancel button (default is "Cancel") @param text the default text displayed in the entry widget @param message the text to display *) val input_string : ?parent:#GWindow.window_skel -> title:string -> ?ok:string -> ?cancel:string -> ?text:string -> string -> string option (** Make the user type in a text. @return [None] if the user clicked on cancel, or [Some s] if the user clicked on the ok button. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param title the title of the dialog @param ok the text for the confirmation button (default is "Ok") @param cancel the text for the cancel button (default is "Cancel") @param text the default text displayed in the entry widget (utf8) @param message the text to display *) val input_text : ?parent:#GWindow.window_skel -> title:string -> ?ok:string -> ?cancel:string -> ?text:string -> string -> string option (**This function allows the user to select a file and returns the selected file name. A VOIR : multi-selection ? *) val select_file : title:string -> ?dir:string ref -> ?filename:string -> unit -> string option (** A tree. *) type 'a tree = [ `L of 'a | `N of 'a * 'a tree list] (** A class to make the user select a node in a tree. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param tree is the tree to display. @param label gives a label from the data of a node. @param info gives a (Utf8) string from the data of a node, to give more information to the user when he selects a node. @param width is the width of the tree widget @param height is the height of the tree widget *) class ['a] tree_selection : tree:'a tree -> label:('a -> string) -> info:('a -> string) -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> object inherit GObj.widget val obj : Gtk.widget Gtk.obj val mutable selection : 'a option method clear_selection : unit -> unit method selection : 'a option method wview : GText.view method wtree : GBroken.tree end (** A function to make the user select a node in a tree. @param parent the parent window in the front of which it should be displayed. this also sets the [destroy_with_parent] property. @param tree the to build a tree selection widget @param ok the text for the confirmation button (default is "Ok") @param cancel the text for the cancel button (default is "Cancel") @param title is the title of the window. @return The data associated to the selected node, or None if the user canceled the selection. *) val tree_selection_dialog : ?parent:#GWindow.window_skel -> tree:'a tree -> label:('a -> string) -> info:('a -> string) -> title:string -> ?ok:string -> ?cancel:string -> ?width:int -> ?height:int -> ?show:bool -> unit -> 'a option (** {2 Keyboard shortcuts} Associate messages to key combinations. *) (** A keyboard shorcut: a combination of Alt, Control and Shift and a letter. *) type key_combination = [ `A | `C | `S ] list * char (** A shortcut specification: name of a GTK+ signal to emit, keyboard shortcuts and the message to send. The name must be unique. *) type 'a shortcut_specification = { name : string; keys : key_combination list; message : 'a; } (** Setup the given shortcut spec list for the given window and callback. This create the GTK+ signal, associate the keyboard shortcuts to it, make the window listen to these shortcuts and eventually call the given callback with the messages from the shortcut specification. *) val create_shortcuts : window:#GWindow.window_skel -> shortcuts:'a shortcut_specification list -> callback:('a -> unit) -> unit (** {2 Miscellaneous functions} *) (** Resize the columns of a clist according to the length of the content and the title of each column.*) val autosize_clist : 'a GList.clist -> unit lablgtk-2.18.8/src/ml_gtkrange.c0000644000175000017500000001436013460263323015515 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkrange_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_progress_bar_get_type() + gtk_hscale_get_type() + gtk_vscale_get_type() + gtk_hscrollbar_get_type() + gtk_vscrollbar_get_type() + gtk_hruler_get_type() + gtk_vruler_get_type(); return Val_GType(t); } /* gtkprogress.h */ /* #define GtkProgress_val(val) check_cast(GTK_PROGRESS,val) ML_2 (gtk_progress_set_show_text, GtkProgress_val, Bool_val, Unit) ML_3 (gtk_progress_set_text_alignment, GtkProgress_val, Option_val(arg2,Float_val,(GtkProgress_val(arg1))->x_align) Ignore, Option_val(arg3,Float_val,(GtkProgress_val(arg1))->y_align) Ignore, Unit) ML_2 (gtk_progress_set_format_string, GtkProgress_val, String_val, Unit) ML_2 (gtk_progress_set_adjustment, GtkProgress_val, GtkAdjustment_val, Unit) ML_4 (gtk_progress_configure, GtkProgress_val, Float_val, Float_val, Float_val, Unit) ML_2 (gtk_progress_set_percentage, GtkProgress_val, Float_val, Unit) ML_2 (gtk_progress_set_value, GtkProgress_val, Float_val, Unit) ML_1 (gtk_progress_get_value, GtkProgress_val, copy_double) ML_1 (gtk_progress_get_current_percentage, GtkProgress_val, copy_double) ML_2 (gtk_progress_set_activity_mode, GtkProgress_val, Bool_val, Unit) ML_1 (gtk_progress_get_current_text, GtkProgress_val, Val_string) Make_Extractor (gtk_progress_get, GtkProgress_val, adjustment, Val_GtkAny) */ /* gtkprogressbar.h */ #define GtkProgressBar_val(val) check_cast(GTK_PROGRESS_BAR,val) ML_0 (gtk_progress_bar_new, Val_GtkWidget_sink) ML_2 (gtk_progress_bar_set_orientation, GtkProgressBar_val,Progress_bar_orientation_val, Unit) ML_1 (gtk_progress_bar_get_orientation, GtkProgressBar_val,Val_progress_bar_orientation) ML_2 (gtk_progress_bar_set_pulse_step, GtkProgressBar_val,Float_val, Unit) ML_1 (gtk_progress_bar_get_pulse_step, GtkProgressBar_val,copy_double) ML_2 (gtk_progress_bar_set_fraction, GtkProgressBar_val,Float_val, Unit) ML_1 (gtk_progress_bar_get_fraction, GtkProgressBar_val,copy_double) ML_2 (gtk_progress_bar_set_text, GtkProgressBar_val,String_val, Unit) ML_1 (gtk_progress_bar_get_text, GtkProgressBar_val,Val_string) ML_1 (gtk_progress_bar_pulse, GtkProgressBar_val, Unit) /*ML_1 (gtk_progress_bar_new_with_adjustment, GtkAdjustment_val, Val_GtkWidget_sink) ML_2 (gtk_progress_bar_set_bar_style, GtkProgressBar_val, Progress_bar_style_val, Unit) ML_2 (gtk_progress_bar_set_discrete_blocks, GtkProgressBar_val, Int_val, Unit) ML_2 (gtk_progress_bar_set_activity_step, GtkProgressBar_val, Int_val, Unit) ML_2 (gtk_progress_bar_set_activity_blocks, GtkProgressBar_val, Int_val, Unit) */ /* ML_2 (gtk_progress_bar_update, GtkProgressBar_val, Float_val, Unit) */ /* gtkrange.h */ #define GtkRange_val(val) check_cast(GTK_RANGE,val) ML_1 (gtk_range_get_adjustment, GtkRange_val, Val_GtkAny) ML_2 (gtk_range_set_adjustment, GtkRange_val, GtkAdjustment_val, Unit) ML_2 (gtk_range_set_update_policy, GtkRange_val, Update_type_val, Unit) /* gtkscale.h */ /* #define GtkScale_val(val) check_cast(GTK_SCALE,val) ML_2 (gtk_scale_set_digits, GtkScale_val, Int_val, Unit) ML_2 (gtk_scale_set_draw_value, GtkScale_val, Bool_val, Unit) ML_2 (gtk_scale_set_value_pos, GtkScale_val, Position_type_val, Unit) ML_1 (gtk_scale_get_digits, GtkScale_val, Val_int) ML_1 (gtk_scale_get_draw_value, GtkScale_val, Val_bool) ML_1 (gtk_scale_get_value_pos, GtkScale_val, Val_position) ML_1 (gtk_hscale_new, GtkAdjustment_val, Val_GtkWidget_sink) ML_1 (gtk_vscale_new, GtkAdjustment_val, Val_GtkWidget_sink) */ /* gtkscrollbar.h */ ML_1 (gtk_hscrollbar_new, GtkAdjustment_val, Val_GtkWidget_sink) ML_1 (gtk_vscrollbar_new, GtkAdjustment_val, Val_GtkWidget_sink) /* gtkruler.h */ #define GtkRuler_val(val) check_cast(GTK_RULER,val) ML_2 (gtk_ruler_set_metric, GtkRuler_val, Metric_type_val, Unit) ML_5 (gtk_ruler_set_range, GtkRuler_val, Float_val, Float_val, Float_val, Float_val, Unit) Make_Extractor (gtk_ruler_get, GtkRuler_val, lower, copy_double) Make_Extractor (gtk_ruler_get, GtkRuler_val, upper, copy_double) Make_Extractor (gtk_ruler_get, GtkRuler_val, position, copy_double) Make_Extractor (gtk_ruler_get, GtkRuler_val, max_size, copy_double) ML_1 (gtk_ruler_draw_ticks, GtkRuler_val, Unit) ML_1 (gtk_ruler_draw_pos, GtkRuler_val, Unit) ML_0 (gtk_hruler_new, Val_GtkWidget_sink) ML_0 (gtk_vruler_new, Val_GtkWidget_sink) lablgtk-2.18.8/src/sourceView2_tags.var0000644000175000017500000000456713460263323017034 0ustar stephsteph(*****************************************************************************) (* *) (* lablgtksourceview, OCaml binding for the GtkSourceView text widget *) (* *) (* Copyright (C) 2005 Stefano Zacchiroli *) (* Copyright (C) 2006 Stefano Zacchiroli *) (* Maxence Guesdon *) (* *) (* This library is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Lesser General Public License as *) (* published by the Free Software Foundation; either version 2.1 of the *) (* License, or (at your option) any later version. *) (* *) (* This library is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Lesser General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this library; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) (* USA *) (* *) (*****************************************************************************) package "sourceView2" type source_search_flag = "GTK_SOURCE_SEARCH_" [ `VISIBLE_ONLY | `TEXT_ONLY | `CASE_INSENSITIVE] type source_smart_home_end_type = "GTK_SOURCE_SMART_HOME_END_" [ `DISABLED| `BEFORE| `AFTER| `ALWAYS ] (* Only NBSP is supported *) type source_draw_spaces_flags = "GTK_SOURCE_DRAW_SPACES_" [ `SPACE | `TAB | `NEWLINE | `NBSP | `LEADING | `TEXT | `TRAILING ] type source_completion_activation_flags = "GTK_SOURCE_COMPLETION_ACTIVATION_" [ `INTERACTIVE | `USER_REQUESTED ] lablgtk-2.18.8/src/ml_gtkaction.c0000644000175000017500000002015213460263323015672 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$*/ #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gtk.h" #include "gtk_tags.h" CAMLprim value ml_gtkaction_init(value unit) { GType t = #ifdef HASGTK24 gtk_action_get_type () + gtk_toggle_action_get_type () + gtk_radio_action_get_type () + gtk_toggle_action_get_type () + gtk_action_group_get_type () + gtk_ui_manager_get_type () ; #else 0; #endif return Val_GType(t); } #ifdef HASGTK24 #define gobject_list_of_GSList(l) Val_GSList(l, (value_in) Val_GObject) #define gobject_list_of_GSList_free(l) Val_GSList_free (l, (value_in) Val_GObject) #define gobject_list_of_GList(l) Val_GList (l, (value_in) Val_GObject) #define gobject_list_of_GList_free(l) Val_GList_free (l, (value_in) Val_GObject) /* gtkaction.h */ #define GtkAction_val(val) check_cast(GTK_ACTION, val) ML_1 (gtk_action_activate, GtkAction_val, Unit) ML_2 (gtk_action_connect_proxy, GtkAction_val, GtkWidget_val, Unit) ML_2 (gtk_action_disconnect_proxy, GtkAction_val, GtkWidget_val, Unit) ML_1 (gtk_action_get_proxies, GtkAction_val, gobject_list_of_GSList) ML_1 (gtk_action_connect_accelerator, GtkAction_val, Unit) ML_1 (gtk_action_disconnect_accelerator, GtkAction_val, Unit) ML_2 (gtk_action_set_accel_path, GtkAction_val, String_val, Unit) ML_2 (gtk_action_set_accel_group, GtkAction_val, GtkAccelGroup_val, Unit) ML_1 (gtk_action_is_sensitive, GtkAction_val, Val_bool) ML_1 (gtk_action_is_visible, GtkAction_val, Val_bool) ML_2 (gtk_action_block_activate_from, GtkAction_val, GtkWidget_val, Unit) ML_2 (gtk_action_unblock_activate_from, GtkAction_val, GtkWidget_val, Unit) /* gtktoggleaction.h */ #define GtkToggleAction_val(val) check_cast(GTK_TOGGLE_ACTION, val) ML_1 (gtk_toggle_action_toggled, GtkToggleAction_val, Unit) ML_2 (gtk_toggle_action_set_active, GtkToggleAction_val, Bool_val, Unit) ML_1 (gtk_toggle_action_get_active, GtkToggleAction_val, Val_bool) /* gtkradioaction.h */ #define GtkRadioAction_val(val) check_cast(GTK_RADIO_ACTION, val) CAMLprim value ml_gtk_radio_action_set_group(value ac, value grp) { GtkRadioAction *grp_ac = Option_val(grp, GtkRadioAction_val, NULL); GSList *slist = grp_ac ? gtk_radio_action_get_group(grp_ac) : NULL; gtk_radio_action_set_group(GtkRadioAction_val(ac), slist); return Val_unit; } ML_1 (gtk_radio_action_get_current_value, GtkRadioAction_val, Val_int) /* gtkactiongroup.h */ #define GtkActionGroup_val(val) check_cast(GTK_ACTION_GROUP, val) ML_2 (gtk_action_group_get_action, GtkActionGroup_val, String_val, Val_GAnyObject) ML_1 (gtk_action_group_list_actions, GtkActionGroup_val, gobject_list_of_GList_free) ML_2 (gtk_action_group_add_action, GtkActionGroup_val, GtkAction_val, Unit) ML_3 (gtk_action_group_add_action_with_accel, GtkActionGroup_val, GtkAction_val, String_option_val, Unit) ML_2 (gtk_action_group_remove_action, GtkActionGroup_val, GtkAction_val, Unit) /* gtkuimanager.h */ #define GtkUIManager_val(val) check_cast(GTK_UI_MANAGER, val) ML_3 (gtk_ui_manager_insert_action_group, GtkUIManager_val, GtkActionGroup_val, Int_val, Unit) ML_2 (gtk_ui_manager_remove_action_group, GtkUIManager_val, GtkActionGroup_val, Unit) ML_1 (gtk_ui_manager_get_action_groups, GtkUIManager_val, gobject_list_of_GList) ML_1 (gtk_ui_manager_get_accel_group, GtkUIManager_val, Val_GtkAccelGroup) CAMLprim value ml_gtk_ui_manager_get_widget (value m, value n) { GtkWidget *w = gtk_ui_manager_get_widget (GtkUIManager_val(m), String_val(n)); if (w == NULL) raise_not_found(); return Val_GAnyObject(w); } CAMLprim value ml_gtk_ui_manager_get_action (value m, value n) { GtkAction *a = gtk_ui_manager_get_action (GtkUIManager_val(m), String_val(n)); if (a == NULL) raise_not_found(); return Val_GAnyObject(a); } CAMLprim value ml_gtk_ui_manager_add_ui_from_string(value uim, value s) { GError *error = NULL; guint id; id = gtk_ui_manager_add_ui_from_string(GtkUIManager_val(uim), String_val(s), string_length(s), &error); if (error != NULL) ml_raise_gerror (error); return Val_int(id); } CAMLprim value ml_gtk_ui_manager_add_ui_from_file(value uim, value s) { GError *error = NULL; guint id; id = gtk_ui_manager_add_ui_from_file(GtkUIManager_val(uim), String_val(s), &error); if (error != NULL) ml_raise_gerror (error); return Val_int(id); } ML_2 (gtk_ui_manager_remove_ui, GtkUIManager_val, Int_val, Unit) ML_1 (gtk_ui_manager_ensure_update, GtkUIManager_val, Unit) ML_1 (gtk_ui_manager_new_merge_id, GtkUIManager_val, Val_int) ML_7 (gtk_ui_manager_add_ui, GtkUIManager_val, Int_val, String_val, String_val, String_option_val, Ui_manager_item_type_val, Bool_val, Unit) ML_bc7(ml_gtk_ui_manager_add_ui) Make_Flags_val(Ui_manager_item_type_val) ML_2 (gtk_ui_manager_get_toplevels, GtkUIManager_val, Flags_Ui_manager_item_type_val, gobject_list_of_GSList_free) #else /* HASGTK24 */ Unsupported_24(gtk_action_activate) Unsupported_24(gtk_action_connect_proxy) Unsupported_24(gtk_action_disconnect_proxy) Unsupported_24(gtk_action_get_proxies) Unsupported_24(gtk_action_connect_accelerator) Unsupported_24(gtk_action_disconnect_accelerator) Unsupported_24(gtk_action_set_accel_path) Unsupported_24(gtk_action_set_accel_group) Unsupported_24(gtk_action_is_sensitive) Unsupported_24(gtk_action_is_visible) Unsupported_24(gtk_action_block_activate_from) Unsupported_24(gtk_action_unblock_activate_from) Unsupported_24(gtk_toggle_action_toggled) Unsupported_24(gtk_toggle_action_set_active) Unsupported_24(gtk_toggle_action_get_active) Unsupported_24(gtk_radio_action_set_group) Unsupported_24(gtk_radio_action_get_current_value) Unsupported_24(gtk_action_group_get_action) Unsupported_24(gtk_action_group_list_actions) Unsupported_24(gtk_action_group_add_action) Unsupported_24(gtk_action_group_add_action_with_accel) Unsupported_24(gtk_action_group_remove_action) Unsupported_24(gtk_ui_manager_insert_action_group) Unsupported_24(gtk_ui_manager_remove_action_group) Unsupported_24(gtk_ui_manager_get_action_groups) Unsupported_24(gtk_ui_manager_get_accel_group) Unsupported_24(gtk_ui_manager_get_widget) Unsupported_24(gtk_ui_manager_get_toplevels) Unsupported_24(gtk_ui_manager_get_action) Unsupported_24(gtk_ui_manager_add_ui_from_string) Unsupported_24(gtk_ui_manager_add_ui_from_file) Unsupported_24(gtk_ui_manager_remove_ui) Unsupported_24(gtk_ui_manager_ensure_update) Unsupported_24(gtk_ui_manager_add_ui) Unsupported_24(gtk_ui_manager_add_ui_bc) Unsupported_24(gtk_ui_manager_new_merge_id) Unsupported_24(gtk_ui_manager_new_merge_id_bc) #endif /* HASGTK24 */ lablgtk-2.18.8/src/varcc.ml0000644000175000017500000005206713460263323014515 0ustar stephsteph(* -*- caml -*- *) (* $Id$ *) (* Compile a list of variant tags into CPP defines *) open StdLabels (* hash_variant, from ctype.ml *) let hash_variant s = let accu = ref 0 in (* reduce to 31 bits *) (for i = 0 to (String.length s) - 1 do accu := (223 * !accu) + (Char.code s.[i]) done; accu := !accu land ((1 lsl 31) - 1); (* make it signed for 64 bits architectures *) if !accu > 0x3FFFFFFF then !accu - (1 lsl 31) else !accu) let camlize id = let b = Buffer.create ((String.length id) + 4) in (for i = 0 to (String.length id) - 1 do if (id.[i] >= 'A') && (id.[i] <= 'Z') then (if i > 0 then Buffer.add_char b '_' else (); Buffer.add_char b (Char.lowercase id.[i])) else Buffer.add_char b id.[i] done; Buffer.contents b) open Genlex let lexer = make_lexer [ "type"; "="; "["; "]"; "`"; "|" ] let may_string (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; s) | _ -> "" let may_bar (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "|") -> (Stream.junk __strm; ()) | _ -> () let rec ident_list (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "`") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident x) -> (Stream.junk __strm; let trans = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in let _ = (try may_bar __strm with | Stream.Failure -> raise (Stream.Error "")) in (x, trans) :: (ident_list __strm)) | _ -> raise (Stream.Error ""))) | _ -> [] let static = ref false let rec star ?(acc = []) p (__strm : _ Stream.t) = match try Some (p __strm) with | Stream.Failure -> None with | Some x -> let s = __strm in star ~acc: (x :: acc) p s | _ -> List.rev acc let flag (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident (("public" | "private" | "noconv" | "flags" as s))) -> (Stream.junk __strm; s) | _ -> raise Stream.Failure let protect (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident "protect") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident m) -> (Stream.junk __strm; Some m) | _ -> raise (Stream.Error ""))) | _ -> None let may o f = match o with | Some v -> f v | None -> () open Printf let hashes = Hashtbl.create 57 let all_convs = ref [] let package = ref "" let pkgprefix = ref "" let declaration ~hc ~cc (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "type") -> (Stream.junk __strm; let flags = (try star flag __strm with | Stream.Failure -> raise (Stream.Error "")) in let guard = (try protect __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Ident mlname) -> (Stream.junk __strm; let name = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "=") -> (Stream.junk __strm; let prefix = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "[") -> (Stream.junk __strm; let _ = (try may_bar __strm with | Stream.Failure -> raise (Stream.Error "")) in let tags = (try ident_list __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "]") -> (Stream.junk __strm; let suffix = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in let oh x = fprintf hc x and oc x = fprintf cc x in let name = if name = "" then !pkgprefix ^ mlname else name in (* Output tag values to headers *) let first = ref true in (List.iter tags ~f: (fun (tag, _) -> let hash = hash_variant tag in try let tag' = Hashtbl.find hashes hash in if tag <> tag' then failwith (String.concat ~sep: " " [ "Doublon tag:"; tag; "and"; tag' ]) else () with | Not_found -> (Hashtbl.add hashes hash tag; if !first then (oh "/* %s : tags and macros */\n" name; first := false) else (); oh "#define MLTAG_%s\t((value)(%d*2+1))\n" tag hash)); if List.mem "noconv" flags then () else (* compute C name *) (let ctag tag trans = if trans <> "" then trans else (let tag = if tag.[0] = '_' then String.sub tag ~pos: 1 ~len: ((String.length tag) - 1) else tag in match if prefix = "" then (None, "") else ((Some prefix. [ (String. length prefix) - 1 ]), (String.sub prefix ~pos: 0 ~len: ((String. length prefix) - 1))) with | (Some '#', prefix) -> prefix ^ ((String. uncapitalize tag) ^ suffix) | (Some '^', prefix) -> prefix ^ ((String.uppercase tag) ^ suffix) | _ -> prefix ^ (tag ^ suffix)) and cname = String.capitalize name in (all_convs := (name, mlname, tags, flags) :: !all_convs; let tags = List.sort tags ~cmp: (fun (tag1, _) (tag2, _) -> compare (hash_variant tag1) (hash_variant tag2)) in (* Output table to code file *) (oc "/* %s : conversion table */\n" name; let static = if (!static && (not (List.mem "public" flags))) || (List.mem "private" flags) then "static " else "" in (* Output macros to headers *) (oc "%sconst lookup_info ml_table_%s[] = {\n" static name; may guard (fun m -> oc "#ifdef %s\n" m); oc " { 0, %d },\n" (List.length tags); List.iter tags ~f: (fun (tag, trans) -> oc " { MLTAG_%s, %s },\n" tag (ctag tag trans)); may guard (fun m -> oc "#else\n {0, 0 }\n#endif /* %s */\n" m); oc "};\n\n"; if not !first then oh "\n" else (); if static = "" then oh "extern const lookup_info ml_table_%s[];\n" name else (); oh "#define Val_%s(data) ml_lookup_from_c (ml_table_%s, data)\n" name name; oh "#define %s_val(key) ml_lookup_to_c (ml_table_%s, key)\n\n" cname name)))))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some (Ident "package") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; package := s) | _ -> raise (Stream.Error ""))) | Some (Ident "prefix") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; pkgprefix := s) | _ -> raise (Stream.Error ""))) | _ -> raise End_of_file let process ic ~hc ~cc = (all_convs := []; let chars = Stream.of_channel ic in let s = lexer chars in try while true do declaration s ~hc ~cc done with | End_of_file -> if (!all_convs <> []) && (!package <> "") then (let oc x = fprintf cc x in (oc "CAMLprim value ml_%s_get_tables ()\n{\n" (camlize !package); oc " static const lookup_info *ml_lookup_tables[] = {\n"; let convs = List.rev !all_convs in (* When he have only one conversion, we must return it directly instead of * an array that would be converted to a tuple *) (List.iter convs ~f: (fun (s, _, _, _) -> oc " ml_table_%s,\n" s); oc " };\n"; if (List.length convs) = 1 then oc " return (value)ml_lookup_tables[0];" else oc " return (value)ml_lookup_tables;"; oc "}\n"; let mlc = open_out (!package ^ "Enums.ml") in let ppf = Format.formatter_of_out_channel mlc in let out fmt = Format.fprintf ppf fmt in (out "(** %s enums *)\n\n" !package; out "open Gpointer\n@."; List.iter convs ~f: (fun (_, name, tags, _) -> (out "@[type %s =@ @[[ `%s" name (fst (List.hd tags)); List.iter (List.tl tags) ~f: (fun (s, _) -> out "@ | `%s" s); out " ]@]@]@.")); out "\n(**/**)\n"; out "\nexternal _get_tables : unit ->\n"; let (_, name0, _, _) = List.hd convs in (out " %s variant_table\n" name0; List.iter (List.tl convs) ~f: (fun (_, s, _, _) -> out " * %s variant_table\n" s); out " = \"ml_%s_get_tables\"\n\n" (camlize !package); out "@[let %s" name0; List.iter (List.tl convs) ~f: (fun (_, s, _, _) -> out ",@ %s" s); out " = _get_tables ()@]\n@."; let enum = if (List.length convs) > 10 then (out "let _make_enum = Gobject.Data.enum@."; "_make_enum") else "Gobject.Data.enum" in (List.iter convs ~f: (fun (_, s, _, flags) -> let conv = if List.mem "flags" flags then "Gobject.Data.flags" else enum in out "let %s_conv = %s %s@." s conv s); close_out mlc)))))) else () | Stream.Error err -> failwith (Printf.sprintf "Parsing error \"%s\" at character %d on input stream" err (Stream.count chars))) let main () = let inputs = ref [] in let header = ref "" in let code = ref "" in (Arg.parse [ ("-h", (Arg.String (( := ) header)), "file to output macros (file.h)"); ("-c", (Arg.String (( := ) code)), "file to output conversion tables (file.c)"); ("-static", (Arg.Set static), "do not export conversion tables") ] (fun s -> inputs := s :: !inputs) "usage: varcc [options] file.var"; let inputs = List.rev !inputs in ((match inputs with | [] -> (if !header = "" then header := "a.h" else (); if !code = "" then code := "a.c" else ()) | ip :: _ -> let rad = if Filename.check_suffix ip ".var" then Filename.chop_extension ip else ip in (if !header = "" then header := rad ^ ".h" else (); if !code = "" then code := rad ^ ".c" else ())); let hc = open_out !header and cc = open_out !code in (if inputs = [] then process stdin ~hc ~cc else List.iter inputs ~f: (fun file -> let ic = open_in file in try (process ic ~hc ~cc; close_in ic) with | exn -> (close_in ic; prerr_endline ("Error in " ^ file); raise exn)); close_out hc; close_out cc))) let _ = Printexc.print main () lablgtk-2.18.8/src/ml_domain.h0000644000175000017500000000316113460263323015164 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #define G_LOG_DOMAIN "LablGTK" lablgtk-2.18.8/src/gnoCanvas.ml0000644000175000017500000004440313460263323015331 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open GnomeCanvas type items_properties = [ | `NO_WIDGET | `NO_FILL_COLOR | `NO_OUTLINE_COLOR | `NO_FONT | `NO_TEXT | `NO_BPATH | `NO_PIXBUF | `ANCHOR of Gtk.Tags.anchor_type | `ARROW_SHAPE_A of float | `ARROW_SHAPE_B of float | `ARROW_SHAPE_C of float | `BPATH of PathDef.t | `CAP_STYLE of Gdk.GC.gdkCapStyle | `CLIP of bool | `CLIP_HEIGHT of float | `CLIP_WIDTH of float | `CURSOR_BLINK of bool | `CURSOR_VISIBLE of bool | `DASH of float * float array | `EDITABLE of bool | `FAMILY of string | `FILL_COLOR of string | `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap | `FIRST_ARROWHEAD of bool | `FONT of string | `GROW_HEIGHT of bool | `HEIGHT of float | `JOIN_STYLE of Gdk.GC.gdkJoinStyle | `JUSTIFICATION of Gtk.Tags.justification | `LAST_ARROWHEAD of bool | `LEFT_MARGIN of int | `LINE_STYLE of Gdk.GC.gdkLineStyle | `MARKUP of string | `OUTLINE_COLOR of string | `OUTLINE_COLOR_RGBA of int32 | `OUTLINE_STIPPLE of Gdk.bitmap | `PIXBUF of GdkPixbuf.pixbuf | `POINTS of float array | `RIGHT_MARGIN of int | `RISE of int | `SCALE of float | `SIZE of int | `SIZE_PIXELS of bool | `SIZE_POINTS of float | `SMOOTH of bool | `TEXT of string | `VISIBLE of bool | `WEIGHT of int | `WIDGET of GObj.widget | `WIDTH of float | `WIDTH_PIXELS of int | `WIDTH_UNITS of float | `X of float | `X1 of float | `X2 of float | `X_OFFSET of float | `Y of float | `Y1 of float | `Y2 of float | `Y_OFFSET of float ] let encode tbl v = `INT (Gpointer.encode_variant tbl v) let propertize = function | `ANCHOR a -> "anchor", encode GtkEnums.anchor_type a | `ARROW_SHAPE_A v -> "arrow_shape_a", `FLOAT v | `ARROW_SHAPE_B v -> "arrow_shape_b", `FLOAT v | `ARROW_SHAPE_C v -> "arrow_shape_c", `FLOAT v | `BPATH p -> "bpath" , `POINTER (Some p) | `CAP_STYLE c -> "cap_style", encode GdkEnums.cap_style c | `CLIP b -> "clip", `BOOL b | `CLIP_HEIGHT v -> "clip_height", `FLOAT v | `CLIP_WIDTH v -> "clip_width", `FLOAT v | `CURSOR_BLINK b -> "cursor_blink", `BOOL b | `CURSOR_VISIBLE b -> "cursor_visible", `BOOL b | `DASH (off, d) -> "dash", `POINTER (Some (Conv.convert_dash off d)) | `EDITABLE b -> "editable", `BOOL b | `FAMILY s -> "family", `STRING (Some s) | `FILL_COLOR c -> "fill_color", `STRING (Some c) | `FILL_COLOR_RGBA c -> "fill_color_rgba", `INT32 c | `FILL_STIPPLE (d : Gdk.bitmap) -> "fill_stipple", `OBJECT (Some (Gobject.coerce d)) | `FIRST_ARROWHEAD b -> "first_arrowhead", `BOOL b | `FONT t -> "font", `STRING (Some t) | `GROW_HEIGHT b -> "grow_height", `BOOL b | `HEIGHT v -> "height", `FLOAT v | `JOIN_STYLE c -> "join_style", encode GdkEnums.join_style c | `JUSTIFICATION j -> "justification", encode GtkEnums.justification j | `LAST_ARROWHEAD b -> "last_arrowhead", `BOOL b | `LEFT_MARGIN i -> "left_margin", `INT i | `LINE_STYLE c -> "line_style", encode GdkEnums.line_style c | `OUTLINE_COLOR c -> "outline_color", `STRING (Some c) | `OUTLINE_COLOR_RGBA c -> "outline_color_rgba", `INT32 c | `OUTLINE_STIPPLE (d : Gdk.bitmap) -> "outline_stipple", `OBJECT (Some (Gobject.coerce d)) | `MARKUP s -> "markup", `STRING (Some s) | `PIXBUF (p : GdkPixbuf.pixbuf) -> "pixbuf", `OBJECT (Some (Gobject.coerce p)) | `POINTS p -> "points", `POINTER (Some (Conv.convert_points p)) | `RIGHT_MARGIN i -> "right_margin", `INT i | `RISE i -> "rise", `INT i | `SCALE f -> "scale", `FLOAT f | `SIZE i -> "size", `INT i | `SIZE_PIXELS b -> "size_pixels", `BOOL b | `SIZE_POINTS f -> "size-points", `FLOAT f | `SMOOTH b -> "smooth", `BOOL b | `TEXT t -> "text", `STRING (Some t) | `VISIBLE b -> "visible", `BOOL b | `WEIGHT i -> "weight", `INT i | `WIDGET (w : GObj.widget) -> "widget", `OBJECT (Some (Gobject.coerce w#as_widget)) | `WIDTH v -> "width", `FLOAT v | `WIDTH_PIXELS v -> "width_pixels", `INT v | `WIDTH_UNITS v -> "width_units", `FLOAT v | `X v -> "x", `FLOAT v | `X1 v -> "x1", `FLOAT v | `X2 v -> "x2", `FLOAT v | `X_OFFSET v -> "x_offset", `FLOAT v | `Y v -> "y", `FLOAT v | `Y1 v -> "y1", `FLOAT v | `Y2 v -> "y2", `FLOAT v | `Y_OFFSET v -> "y_offset", `FLOAT v | `NO_FILL_COLOR -> "fill_color", `STRING None | `NO_OUTLINE_COLOR -> "outline_color", `STRING None | `NO_FONT -> "font", `STRING None | `NO_TEXT -> "text", `STRING None | `NO_BPATH -> "bpath", `POINTER None | `NO_PIXBUF -> "pixbuf", `OBJECT None | `NO_WIDGET -> "widget", `OBJECT None let set_properties obj p = List.iter (fun p -> let p, d = propertize p in Gobject.Property.set_dyn obj p d) p; Item.set obj type item_event = [ | `BUTTON_PRESS of GdkEvent.Button.t | `TWO_BUTTON_PRESS of GdkEvent.Button.t | `THREE_BUTTON_PRESS of GdkEvent.Button.t | `BUTTON_RELEASE of GdkEvent.Button.t | `MOTION_NOTIFY of GdkEvent.Motion.t | `KEY_PRESS of GdkEvent.Key.t | `KEY_RELEASE of GdkEvent.Key.t | `ENTER_NOTIFY of GdkEvent.Crossing.t | `LEAVE_NOTIFY of GdkEvent.Crossing.t | `FOCUS_CHANGE of GdkEvent.Focus.t ] let event_proxy : (item_event -> bool) -> GnomeCanvas.item_event -> bool = fun cb ev -> match GdkEvent.get_type ev with | `BUTTON_PRESS -> cb (`BUTTON_PRESS (GdkEvent.unsafe_cast ev)) | `TWO_BUTTON_PRESS -> cb (`TWO_BUTTON_PRESS (GdkEvent.unsafe_cast ev)) | `THREE_BUTTON_PRESS -> cb (`THREE_BUTTON_PRESS (GdkEvent.unsafe_cast ev)) | `BUTTON_RELEASE -> cb (`BUTTON_RELEASE (GdkEvent.unsafe_cast ev)) | `MOTION_NOTIFY -> cb (`MOTION_NOTIFY (GdkEvent.unsafe_cast ev)) | `KEY_PRESS -> cb (`KEY_PRESS (GdkEvent.unsafe_cast ev)) | `KEY_RELEASE -> cb (`KEY_RELEASE (GdkEvent.unsafe_cast ev)) | `ENTER_NOTIFY -> cb (`ENTER_NOTIFY (GdkEvent.unsafe_cast ev)) | `LEAVE_NOTIFY -> cb (`LEAVE_NOTIFY (GdkEvent.unsafe_cast ev)) | `FOCUS_CHANGE -> cb (`FOCUS_CHANGE (GdkEvent.unsafe_cast ev)) class item_signals obj = object (self) inherit GObj.gtkobj_signals_impl obj method event ~callback = self#connect Item.Signals.event ~callback:(event_proxy callback) end class type base_item_t = object inherit GObj.gtkobj val obj : 'a Gtk.obj constraint 'a = [> GnomeCanvas.item] method parent : group_t method reparent : group_t -> unit method as_item : GnomeCanvas.item Gtk.obj method connect : item_signals method get_bounds : float array method grab : Gdk.Tags.event_mask list -> Gdk.cursor -> int32 -> unit method grab_focus : unit -> unit method hide : unit -> unit method i2c_affine : float array method i2w : x:float -> y:float -> float * float method i2w_affine : float array method lower : int -> unit method lower_to_bottom : unit -> unit method move : x:float -> y:float -> unit method canvas : canvas_t method xform : [`IDENTITY|`TRANSL of float array|`AFFINE of float array] method affine_relative : float array -> unit method affine_absolute : float array -> unit method raise : int -> unit method raise_to_top : unit -> unit method show : unit -> unit method ungrab : int32 -> unit method w2i : x:float -> y:float -> float * float end and group_t = object inherit base_item_t val obj : GnomeCanvas.group Gtk.obj method as_group : GnomeCanvas.group Gtk.obj method get_items : base_item_t list method set : GnomeCanvas.group_p list -> unit end and canvas_t = object inherit GPack.layout val obj : GnomeCanvas.canvas Gtk.obj method aa : bool method c2w : cx:int -> cy:int -> float * float method get_center_scroll_region : bool method get_item_at : x:float -> y:float -> base_item_t method get_scroll_offsets : int * int method get_scroll_region : float array method root : group_t method scroll_to : x:int -> y:int -> unit method set_center_scroll_region : bool -> unit method set_pixels_per_unit : float -> unit method set_scroll_region : x1:float -> y1:float -> x2:float -> y2:float -> unit method update_now : unit -> unit method w2c : wx:float -> wy:float -> int * int method w2c_affine : float array method w2c_d : wx:float -> wy:float -> float * float method window_to_world : winx:float -> winy:float -> float * float method world_to_window : wox:float -> woy:float -> float * float end let new_group : ('a Gtk.obj -> group_t) ref = ref (fun _ -> assert false) let new_base_item : ('a Gtk.obj -> base_item_t) ref = ref (fun _ -> assert false) class base_item obj = object inherit GObj.gtkobj obj method as_item = (obj :> GnomeCanvas.item Gtk.obj) method connect = new item_signals (obj :> GnomeCanvas.item Gtk.obj) method parent = !new_group (Item.parent obj) method reparent grp = Item.reparent obj (grp : group_t)#as_group method canvas = new canvas (Item.canvas obj) method xform = Item.xform obj method affine_relative = Item.affine_relative obj method affine_absolute = Item.affine_absolute obj method move = Item.move obj method raise = Item.raise obj method lower = Item.lower obj method raise_to_top () = Item.raise_to_top obj method lower_to_bottom () = Item.lower_to_bottom obj method show () = Item.show obj method hide () = Item.hide obj method grab = Item.grab obj method ungrab = Item.ungrab obj method w2i = Item.w2i obj method i2w = Item.i2w obj method i2w_affine = Item.i2w_affine obj method i2c_affine = Item.i2c_affine obj method grab_focus () = Item.grab_focus obj method get_bounds = Item.get_bounds obj end and canvas obj = object inherit GPack.layout (obj : GnomeCanvas.canvas Gtk.obj) val aa = { Gobject.name = "aa"; Gobject.conv = Gobject.Data.boolean } method root = !new_group (Canvas.root obj) method aa = Gobject.get aa obj method set_scroll_region = Canvas.set_scroll_region obj method get_scroll_region = Canvas.get_scroll_region obj method set_center_scroll_region = Canvas.set_center_scroll_region obj method get_center_scroll_region = Canvas.get_center_scroll_region obj method set_pixels_per_unit = Canvas.set_pixels_per_unit obj method scroll_to = Canvas.scroll_to obj method get_scroll_offsets = Canvas.get_scroll_offsets obj method update_now () = Canvas.update_now obj method get_item_at ~x ~y = !new_base_item (Canvas.get_item_at obj ~x ~y) method w2c_affine = Canvas.w2c_affine obj method w2c = Canvas.w2c obj method w2c_d = Canvas.w2c_d obj method c2w = Canvas.c2w obj method window_to_world = Canvas.window_to_world obj method world_to_window = Canvas.world_to_window obj end let () = new_base_item := new base_item class group grp_obj = object inherit base_item (grp_obj : GnomeCanvas.group Gtk.obj) method as_group = grp_obj method get_items = List.map (new base_item) (Group.get_items grp_obj) method set (p : GnomeCanvas.group_p list) = set_properties grp_obj p end let () = new_group := new group class ['p] item obj = object inherit base_item obj method set (p : 'p list) = set_properties obj p end let canvas ?(aa=false) = GContainer.pack_container [] ~create:(fun pl -> let w = if aa then Canvas.new_canvas_aa () else Canvas.new_canvas () in Gobject.set_params w pl; new canvas w) let wrap_item o (typ : (_, 'p) Types.t) = if not (Types.is_a o typ) then raise (Gobject.Cannot_cast (Gobject.Type.name (Gobject.get_type o), Types.name typ)) ; (new item o : 'p item) let construct_item (typ : (_, 'p) Types.t) ~props parent = let i = Item.new_item parent#as_group typ in let o = (new item i : 'p item) in if props <> [] then o#set props ; o let unoption_list ~rest l = List.fold_right (fun o acc -> match o with Some v -> v :: acc | None -> acc) l rest let group ?x ?y parent = let i = Item.new_item parent#as_group Types.group in let g = new group i in let props = unoption_list ~rest:[] [ ( match x with None -> None | Some v -> Some (`X v) ) ; ( match y with None -> None | Some v -> Some (`Y v) ) ; ] in if props <> [] then g#set props ; g type rect = GnomeCanvas.re_p item let rect ?x1 ?y1 ?x2 ?y2 ?fill_color ?(props=[]) p = let props = unoption_list ~rest:props [ ( match x1 with None -> None | Some v -> Some (`X1 v) ) ; ( match y1 with None -> None | Some v -> Some (`Y1 v) ) ; ( match x2 with None -> None | Some v -> Some (`X2 v) ) ; ( match y2 with None -> None | Some v -> Some (`Y2 v) ) ; ( match fill_color with None -> None | Some v -> Some (`FILL_COLOR v) ) ; ] in construct_item Types.rect ~props p type ellipse = GnomeCanvas.re_p item let ellipse ?x1 ?y1 ?x2 ?y2 ?fill_color ?(props=[]) p = let props = unoption_list ~rest:props [ ( match x1 with None -> None | Some v -> Some (`X1 v) ) ; ( match y1 with None -> None | Some v -> Some (`Y1 v) ) ; ( match x2 with None -> None | Some v -> Some (`X2 v) ) ; ( match y2 with None -> None | Some v -> Some (`Y2 v) ) ; ( match fill_color with None -> None | Some v -> Some (`FILL_COLOR v) ) ; ] in construct_item Types.ellipse ~props p class text txt_obj = object inherit [GnomeCanvas.text_p] item (txt_obj : GnomeCanvas.text Gtk.obj) method text_height = Gobject.Property.get txt_obj GnomeCanvas.Text.text_height method text_width = Gobject.Property.get txt_obj GnomeCanvas.Text.text_width end let text ?x ?y ?text ?font ?size ?anchor ?(props=[]) p = let props = unoption_list ~rest:props [ ( match x with None -> None | Some v -> Some (`X v) ) ; ( match y with None -> None | Some v -> Some (`Y v) ) ; ( match text with None -> None | Some v -> Some (`TEXT v) ) ; ( match font with None -> None | Some v -> Some (`FONT v) ) ; ( match size with None -> None | Some v -> Some (`SIZE v) ) ; ( match anchor with None -> None | Some v -> Some (`ANCHOR v) ) ; ] in let i = Item.new_item p#as_group Types.text in let o = new text i in if props <> [] then o#set props ; o type line = GnomeCanvas.line_p item let line ?points ?fill_color ?(props=[]) p = let props = unoption_list ~rest:props [ ( match points with None -> None | Some v -> Some (`POINTS v) ) ; ( match fill_color with None -> None | Some v -> Some (`FILL_COLOR v) ) ; ] in construct_item Types.line ~props p type bpath = GnomeCanvas.bpath_p item let bpath ?bpath ?fill_color ?(props=[]) p = let props = unoption_list ~rest:props [ ( match bpath with None -> None | Some v -> Some (`BPATH v) ) ; ( match fill_color with None -> None | Some v -> Some (`FILL_COLOR v) ) ; ] in construct_item Types.bpath ~props p type pixbuf = GnomeCanvas.pixbuf_p item let pixbuf ?x ?y ?pixbuf ?width ?height ?(props=[]) p = let width = match (width, pixbuf) with | (None, Some p) -> Some (`WIDTH (float (GdkPixbuf.get_width p))) | (None, _) -> None | (Some v, _) -> Some (`WIDTH v) in let height = match (height, pixbuf) with | (None, Some p) -> Some (`HEIGHT (float (GdkPixbuf.get_height p))) | (None, _) -> None | (Some v, _) -> Some (`HEIGHT v) in let props = unoption_list ~rest:props [ ( match x with None -> None | Some v -> Some (`X v) ) ; ( match y with None -> None | Some v -> Some (`Y v) ) ; ( match pixbuf with None -> None | Some v -> Some (`PIXBUF v) ) ; width ; height ; ] in construct_item Types.pixbuf ~props p type polygon = GnomeCanvas.polygon_p item let polygon ?points ?fill_color ?(props=[]) p = let props = unoption_list ~rest:props [ ( match points with None -> None | Some v -> Some (`POINTS v) ) ; ( match fill_color with None -> None | Some v -> Some (`FILL_COLOR v) ) ; ] in construct_item Types.polygon ~props p type widget = GnomeCanvas.widget_p item let widget ?widget ?x ?y ?width ?height ?(props=[]) p = let w = match widget with None -> None | Some wi -> Some (`WIDGET wi#coerce) in let props = unoption_list ~rest:props [ ( match x with None -> None | Some v -> Some (`X v) ) ; ( match y with None -> None | Some v -> Some (`Y v) ) ; ( match width with None -> None | Some v -> Some (`WIDTH v) ) ; ( match height with None -> None | Some v -> Some (`HEIGHT v) ) ; w ] in construct_item Types.widget ~props p class rich_text rchtxt_obj = object inherit [GnomeCanvas.rich_text_p] item (rchtxt_obj : GnomeCanvas.rich_text Gtk.obj) method cut_clipboard () = RichText.cut_clipboard obj method copy_clipboard () = RichText.copy_clipboard obj method paste_clipboard () = RichText.paste_clipboard obj method get_buffer = new GText.buffer (RichText.get_buffer obj) end let rich_text ?x ?y ?text ?width ?height ?(props=[]) p = let props = unoption_list ~rest:props [ ( match x with None -> None | Some v -> Some (`X v) ) ; ( match y with None -> None | Some v -> Some (`Y v) ) ; ( match width with None -> None | Some v -> Some (`WIDTH v) ) ; ( match height with None -> None | Some v -> Some (`HEIGHT v) ) ; ( match text with None -> None | Some t -> Some (`TEXT t) ) ; ] in let i = Item.new_item p#as_group Types.rich_text in let o = new rich_text i in if props <> [] then o#set props ; o lablgtk-2.18.8/src/gtkFile.ml0000644000175000017500000001451313460263323014776 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) external _gtkfile_init : unit -> unit = "ml_gtkfile_init" let () = _gtkfile_init () module FileFilter = struct external create : unit -> Gtk.file_filter Gtk.obj = "ml_gtk_file_filter_new" external set_name : [> Gtk.file_filter] Gtk.obj -> string -> unit = "ml_gtk_file_filter_set_name" external get_name : [> Gtk.file_filter] Gtk.obj -> string = "ml_gtk_file_filter_get_name" external add_mime_type : [> Gtk.file_filter] Gtk.obj -> string -> unit = "ml_gtk_file_filter_add_mime_type" external add_pattern : [> Gtk.file_filter] Gtk.obj -> string -> unit = "ml_gtk_file_filter_add_pattern" external add_custom : [> Gtk.file_filter] Gtk.obj -> GtkEnums.file_filter_flags list -> callback:((GtkEnums.file_filter_flags * string) list -> bool) -> unit = "ml_gtk_file_filter_add_custom" end module FileChooser = struct include GtkFileProps.FileChooser type error = | ERROR_NONEXISTENT | ERROR_BAD_FILENAME exception Error of error * string let () = Callback.register_exception "gtk_file_chooser_error" (Error (ERROR_NONEXISTENT, "")) external set_current_name : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_set_current_name" external get_filename : [> Gtk.file_chooser] Gtk.obj -> string option = "ml_gtk_file_chooser_get_filename" external set_filename : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_set_filename" external select_filename : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_select_filename" external unselect_filename : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_unselect_filename" external select_all : [> Gtk.file_chooser] Gtk.obj -> unit = "ml_gtk_file_chooser_select_all" external unselect_all : [> Gtk.file_chooser] Gtk.obj -> unit = "ml_gtk_file_chooser_unselect_all" external get_filenames : [> Gtk.file_chooser] Gtk.obj -> string list = "ml_gtk_file_chooser_get_filenames" external get_current_folder : [> Gtk.file_chooser] Gtk.obj -> string option = "ml_gtk_file_chooser_get_current_folder" external set_current_folder : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_set_current_folder" external get_uri : [> Gtk.file_chooser] Gtk.obj -> string option = "ml_gtk_file_chooser_get_uri" external set_uri : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_set_uri" external select_uri : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_select_uri" external unselect_uri : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_unselect_uri" external get_uris : [> Gtk.file_chooser] Gtk.obj -> string list = "ml_gtk_file_chooser_get_uris" external get_current_folder_uri : [> Gtk.file_chooser] Gtk.obj -> string = "ml_gtk_file_chooser_get_current_folder_uri" external set_current_folder_uri : [> Gtk.file_chooser] Gtk.obj -> string -> bool = "ml_gtk_file_chooser_set_current_folder_uri" external get_preview_filename : [> Gtk.file_chooser] Gtk.obj -> string option = "ml_gtk_file_chooser_get_preview_filename" external get_preview_uri : [> Gtk.file_chooser] Gtk.obj -> string option = "ml_gtk_file_chooser_get_preview_uri" external add_filter : [> Gtk.file_chooser] Gtk.obj -> Gtk.file_filter Gtk.obj -> unit = "ml_gtk_file_chooser_add_filter" external remove_filter : [> Gtk.file_chooser] Gtk.obj -> Gtk.file_filter Gtk.obj -> unit = "ml_gtk_file_chooser_remove_filter" external list_filters : [> Gtk.file_chooser] Gtk.obj -> Gtk.file_filter Gtk.obj list = "ml_gtk_file_chooser_list_filters" external add_shortcut_folder : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_add_shortcut_folder" external remove_shortcut_folder : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_remove_shortcut_folder" external list_shortcut_folders : [> Gtk.file_chooser] Gtk.obj -> string list = "ml_gtk_file_chooser_list_shortcut_folders" external add_shortcut_folder_uri : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_add_shortcut_folder_uri" external remove_shortcut_folder_uri : [> Gtk.file_chooser] Gtk.obj -> string -> unit = "ml_gtk_file_chooser_remove_shortcut_folder_uri" external list_shortcut_folder_uris : [> Gtk.file_chooser] Gtk.obj -> string list = "ml_gtk_file_chooser_list_shortcut_folder_uris" let dialog_create pl : [Gtk.dialog|Gtk.file_chooser] Gtk.obj = GtkObject.make "GtkFileChooserDialog" pl let widget_create pl : [Gtk.widget|Gtk.file_chooser] Gtk.obj = GtkObject.make "GtkFileChooserWidget" pl end module FileChooserButton = GtkFileProps.FileChooserButton lablgtk-2.18.8/src/gObj.mli0000644000175000017500000003466413460263323014454 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk (** Base classes for objects and widgets *) (** {3 GObject} *) class gobject_ops : 'a obj -> object val obj : 'a obj method get_oid : int method get_type : string method disconnect : GtkSignal.id -> unit method handler_block : GtkSignal.id -> unit method handler_unblock : GtkSignal.id -> unit method set_property : 'a. string -> 'a Gobject.data_set -> unit method get_property : string -> Gobject.data_get method freeze_notify : unit -> unit method thaw_notify : unit -> unit end class ['a] gobject_signals : 'a obj -> object ('b) val obj : 'a obj val after : bool method after : 'b method private connect : 'c. ('a,'c) GtkSignal.t -> callback:'c -> GtkSignal.id method private notify : 'b. ('a, 'b) Gobject.property -> callback:('b -> unit) -> GtkSignal.id end (** {3 GtkObject} *) class type ['a] objvar = object val obj : 'a obj (* needed for pre 3.10 method private obj : 'a obj *) end class gtkobj : ([> `gtk] as 'a) obj -> object val obj : 'a obj method destroy : unit -> unit method get_oid : int end class gtkobj_signals_impl : ([>`gtk] as 'a) obj -> object ('b) inherit ['a] gobject_signals method destroy : callback:(unit -> unit) -> GtkSignal.id end class type gtkobj_signals = object ('a) method after : 'a method destroy : callback:(unit -> unit) -> GtkSignal.id end (** {3 GtkWidget} *) class event_signals : [> widget] obj -> object ('a) method after : 'a method any : callback:(Gdk.Tags.event_type Gdk.event -> bool) -> GtkSignal.id method after_any : callback:(Gdk.Tags.event_type Gdk.event -> unit) -> GtkSignal.id method button_press : callback:(GdkEvent.Button.t -> bool) -> GtkSignal.id method button_release : callback:(GdkEvent.Button.t -> bool) -> GtkSignal.id method client : callback:(GdkEvent.Client.t -> bool) -> GtkSignal.id method configure : callback:(GdkEvent.Configure.t -> bool) -> GtkSignal.id method delete : callback:([`DELETE] Gdk.event -> bool) -> GtkSignal.id method destroy : callback:([`DESTROY] Gdk.event -> bool) -> GtkSignal.id method enter_notify : callback:(GdkEvent.Crossing.t -> bool) -> GtkSignal.id method expose : callback:(GdkEvent.Expose.t -> bool) -> GtkSignal.id method focus_in : callback:(GdkEvent.Focus.t -> bool) -> GtkSignal.id method focus_out : callback:(GdkEvent.Focus.t -> bool) -> GtkSignal.id method key_press : callback:(GdkEvent.Key.t -> bool) -> GtkSignal.id method key_release : callback:(GdkEvent.Key.t -> bool) -> GtkSignal.id method leave_notify : callback:(GdkEvent.Crossing.t -> bool) -> GtkSignal.id method map : callback:([`MAP] Gdk.event -> bool) -> GtkSignal.id method motion_notify : callback:(GdkEvent.Motion.t -> bool) -> GtkSignal.id method property_notify : callback:(GdkEvent.Property.t -> bool) -> GtkSignal.id method proximity_in : callback:(GdkEvent.Proximity.t -> bool) -> GtkSignal.id method proximity_out : callback:(GdkEvent.Proximity.t -> bool) -> GtkSignal.id method scroll : callback:(GdkEvent.Scroll.t -> bool) -> GtkSignal.id method selection_clear : callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id method selection_notify : callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id method selection_request : callback:(GdkEvent.Selection.t -> bool) -> GtkSignal.id method unmap : callback:([`UNMAP] Gdk.event -> bool) -> GtkSignal.id method visibility_notify : callback:(GdkEvent.Visibility.t -> bool) -> GtkSignal.id method window_state : callback:(GdkEvent.WindowState.t -> bool) -> GtkSignal.id end class event_ops : [> widget] obj -> object method add : Gdk.Tags.event_mask list -> unit method connect : event_signals method send : GdkEvent.any -> bool method set_extensions : Gdk.Tags.extension_mode -> unit end (** @gtkdoc gtk GtkStyle *) class style : Gtk.style -> object ('a) val style : Gtk.style method as_style : Gtk.style method base : Gtk.Tags.state_type -> Gdk.color method bg : Gtk.Tags.state_type -> Gdk.color method colormap : Gdk.colormap method copy : 'a method dark : Gtk.Tags.state_type -> Gdk.color method fg : Gtk.Tags.state_type -> Gdk.color method font : Gdk.font method light : Gtk.Tags.state_type -> Gdk.color method mid : Gtk.Tags.state_type -> Gdk.color method set_bg : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_base : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_dark : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_fg : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_font : Gdk.font -> unit method set_light : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_mid : (Gtk.Tags.state_type * GDraw.color) list -> unit method set_text : (Gtk.Tags.state_type * GDraw.color) list -> unit method text : Gtk.Tags.state_type -> Gdk.color end (** @gtkdoc gtk gtk-Selections *) class selection_data : Gtk.selection_data -> object val sel : Gtk.selection_data method data : string (* May raise Gpointer.Null *) method format : int method selection : Gdk.atom method typ : string method target : string end (** @gtkdoc gtk gtk-Selections *) class selection_context : Gtk.selection_data -> object val sel : Gtk.selection_data method selection : Gdk.atom method target : string method return : ?typ:string -> ?format:int -> string -> unit end (** @gtkdoc gtk gtk-Drag-and-Drop *) class drag_ops : Gtk.widget obj -> object method connect : drag_signals method dest_set : ?flags:Tags.dest_defaults list -> ?actions:Gdk.Tags.drag_action list -> target_entry list -> unit method dest_unset : unit -> unit method get_data : target:string -> ?time:int32 -> drag_context ->unit method highlight : unit -> unit method source_set : ?modi:Gdk.Tags.modifier list -> ?actions:Gdk.Tags.drag_action list -> target_entry list -> unit method source_set_icon : ?colormap:Gdk.colormap -> GDraw.pixmap -> unit method source_unset : unit -> unit method unhighlight : unit -> unit end (** @gtkdoc gtk GtkWidget *) and misc_ops : Gtk.widget obj -> object inherit gobject_ops val obj : Gtk.widget obj method activate : unit -> bool method add_accelerator : 'a. sgn:('a, unit -> unit) GtkSignal.t -> group:accel_group -> ?modi:Gdk.Tags.modifier list -> ?flags:Tags.accel_flag list -> Gdk.keysym -> unit method add_selection_target : target:string -> ?info:int -> Gdk.atom -> unit method allocation : rectangle method clear_selection_targets : Gdk.atom -> unit method colormap : Gdk.colormap method connect : misc_signals method convert_selection : target:string -> ?time:int32 -> Gdk.atom -> bool method create_pango_context : GPango.context_rw method draw : Gdk.Rectangle.t option -> unit method get_flag : Tags.widget_flags -> bool method grab_default : unit -> unit method grab_focus : unit -> unit method grab_selection : ?time:int32 -> Gdk.atom -> bool method has_tooltip : bool method hide : unit -> unit method hide_all : unit -> unit method intersect : Gdk.Rectangle.t -> Gdk.Rectangle.t option method is_ancestor : widget -> bool method map : unit -> unit method modify_bg : (Gtk.Tags.state_type * GDraw.color) list -> unit method modify_base : (Gtk.Tags.state_type * GDraw.color) list -> unit method modify_fg : (Gtk.Tags.state_type * GDraw.color) list -> unit method modify_text : (Gtk.Tags.state_type * GDraw.color) list -> unit method modify_font : Pango.font_description -> unit method modify_font_by_name : string -> unit method name : string method parent : widget option method pango_context : GPango.context method pointer : int * int method realize : unit -> unit method remove_accelerator : group:accel_group -> ?modi:Gdk.Tags.modifier list -> Gdk.keysym -> unit method render_icon : ?detail:string -> size:Gtk.Tags.icon_size -> GtkStock.id -> GdkPixbuf.pixbuf method reparent : widget -> unit method set_app_paintable : bool -> unit method set_can_default : bool -> unit method set_can_focus : bool -> unit method set_double_buffered : bool -> unit method set_has_tooltip : bool -> unit method set_name : string -> unit method set_sensitive : bool -> unit method set_size_chars : ?desc:Pango.font_description -> ?lang:string -> ?width:int -> ?height:int -> unit -> unit method set_state : Tags.state_type -> unit method set_style : style -> unit method set_size_request : ?width:int -> ?height:int -> unit -> unit method set_tooltip_markup : string -> unit method set_tooltip_text : string -> unit method show : unit -> unit method show_all : unit -> unit method style : style method tooltip_markup : string method tooltip_text : string method toplevel : widget method unmap : unit -> unit method unparent : unit -> unit method unrealize : unit -> unit method visible : bool method visual : Gdk.visual method visual_depth : int method window : Gdk.window end (** @gtkdoc gtk GtkWidget *) and widget : ([> Gtk.widget] as 'a) obj -> object inherit gtkobj val obj : 'a obj method as_widget : Gtk.widget obj method coerce : widget method drag : drag_ops method misc : misc_ops end (** @gtkdoc gtk GtkWidget *) and misc_signals : Gtk.widget obj -> object ('b) inherit gtkobj_signals method hide : callback:(unit -> unit) -> GtkSignal.id method map : callback:(unit -> unit) -> GtkSignal.id method parent_set : callback:(widget option -> unit) -> GtkSignal.id method query_tooltip : callback:(x:int -> y:int -> kbd:bool -> tooltip -> bool) -> GtkSignal.id method realize : callback:(unit -> unit) -> GtkSignal.id method unrealize : callback:(unit -> unit) -> GtkSignal.id method selection_get : callback:(selection_context -> info:int -> time:int32 -> unit) -> GtkSignal.id method selection_received : callback:(selection_data -> time:int32 -> unit) -> GtkSignal.id method show : callback:(unit -> unit) -> GtkSignal.id method size_allocate : callback:(Gtk.rectangle -> unit) -> GtkSignal.id method state_changed : callback:(Gtk.Tags.state_type -> unit) -> GtkSignal.id method style_set : callback:(unit -> unit) -> GtkSignal.id method unmap : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk gtk-Drag-and-Drop *) and drag_context : Gdk.drag_context -> object val context : Gdk.drag_context method context : Gdk.drag_context method finish : success:bool -> del:bool -> time:int32 -> unit method source_widget : widget method set_icon_pixmap : ?colormap:Gdk.colormap -> GDraw.pixmap -> hot_x:int -> hot_y:int -> unit method set_icon_widget : widget -> hot_x:int -> hot_y:int -> unit method status : ?time:int32 -> Gdk.Tags.drag_action option -> unit method suggested_action : Gdk.Tags.drag_action method targets : string list end (** @gtkdoc gtk gtk-Drag-and-Drop *) and drag_signals : Gtk.widget obj -> object ('a) method after : 'a method beginning : callback:(drag_context -> unit) -> GtkSignal.id method data_delete : callback:(drag_context -> unit) -> GtkSignal.id method data_get : callback: (drag_context -> selection_context -> info:int -> time:int32 -> unit) -> GtkSignal.id method data_received : callback:(drag_context -> x:int -> y:int -> selection_data -> info:int -> time:int32 -> unit) -> GtkSignal.id method drop : callback:(drag_context -> x:int -> y:int -> time:int32 -> bool) -> GtkSignal.id method ending : callback:(drag_context -> unit) -> GtkSignal.id method leave : callback:(drag_context -> time:int32 -> unit) -> GtkSignal.id method motion : callback:(drag_context -> x:int -> y:int -> time:int32 -> bool) -> GtkSignal.id end (** @gtkdoc gtk GtkWidget *) class ['a] widget_impl : ([> Gtk.widget] as 'a) obj -> object inherit widget inherit ['a] objvar end (** @gtkdoc gtk GtkWidget *) class type widget_signals = gtkobj_signals (** @gtkdoc gtk GtkWidget *) class widget_signals_impl : ([> Gtk.widget] as 'a) obj -> object inherit ['a] gobject_signals inherit widget_signals end (** @gtkdoc gtk GtkWidget *) class widget_full : ([> Gtk.widget] as 'a) obj -> object inherit widget val obj : 'a obj method connect : widget_signals end (** @gtkdoc gtk GtkWidget *) val as_widget : widget -> Gtk.widget obj val pack_return : (#widget as 'a) -> packing:(widget -> unit) option -> show:bool option -> 'a (* To use in initializers to provide a ?packing: option *) val conv_widget : widget Gobject.data_conv val conv_widget_option : widget option Gobject.data_conv lablgtk-2.18.8/src/buildrsvg.bat0000755000175000017500000000070213460263323015546 0ustar stephsteph@echo off rem set objext to "o" and libext to "dll.a" for mingw set objext=obj set libext=lib echo Library extension is "%libext%", object extension is "%objext%" echo Builing lablrsvg.cma... ocamlc -c rsvg.mli ocamlc -a -o lablrsvg.cma rsvg.ml -cclib -llablrsvg -dllib -llablrsvg -cclib librsvg-2.%libext% del rsvg.cmo echo Building lablrsvg.cmxa... ocamlopt -a -o lablrsvg.cmxa rsvg.ml -cclib -llablrsvg -cclib librsvg-2.%libext% del rsvg.%objext% lablgtk-2.18.8/src/ml_gnomedruid.c0000644000175000017500000001040113460263323016040 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gdkpixbuf.h" #include "gnomeui_tags.h" #include "gnomeui_tags.c" #define GnomeDruid_val(val) check_cast(GNOME_DRUID,val) #define GnomeDruidPage_val(val) check_cast(GNOME_DRUID_PAGE,val) #define GnomeDruidPageEdge_val(val) check_cast(GNOME_DRUID_PAGE_EDGE,val) #define GnomeDruidPageStandard_val(val) check_cast(GNOME_DRUID_PAGE_STANDARD,val) /* gnome-druid.h */ ML_0(gnome_druid_new, Val_GtkWidget_sink) ML_5(gnome_druid_set_buttons_sensitive, GnomeDruid_val, Bool_val, Bool_val, Bool_val, Bool_val, Unit) ML_2(gnome_druid_prepend_page, GnomeDruid_val, GnomeDruidPage_val, Unit) ML_3(gnome_druid_insert_page, GnomeDruid_val, GnomeDruidPage_val, GnomeDruidPage_val, Unit) ML_2(gnome_druid_append_page, GnomeDruid_val, GnomeDruidPage_val, Unit) ML_2(gnome_druid_set_page, GnomeDruid_val, GnomeDruidPage_val, Unit) /* gnome-druid-page-edge.h */ #define GdkPixbuf_option_val(v) Option_val(v,GdkPixbuf_val,NULL) ML_7(gnome_druid_page_edge_new_with_vals, Edge_position_val, Bool_val, \ String_option_val, String_option_val, \ GdkPixbuf_option_val, GdkPixbuf_option_val, GdkPixbuf_option_val, Val_GtkWidget_sink) ML_bc7(ml_gnome_druid_page_edge_new_with_vals) ML_2(gnome_druid_page_edge_set_bg_color, GnomeDruidPageEdge_val, GdkColor_val, Unit) ML_2(gnome_druid_page_edge_set_textbox_color, GnomeDruidPageEdge_val, GdkColor_val, Unit) ML_2(gnome_druid_page_edge_set_logo_bg_color, GnomeDruidPageEdge_val, GdkColor_val, Unit) ML_2(gnome_druid_page_edge_set_title_color, GnomeDruidPageEdge_val, GdkColor_val, Unit) ML_2(gnome_druid_page_edge_set_text_color, GnomeDruidPageEdge_val, GdkColor_val, Unit) ML_2(gnome_druid_page_edge_set_text, GnomeDruidPageEdge_val, String_val, Unit) ML_2(gnome_druid_page_edge_set_title, GnomeDruidPageEdge_val, String_val, Unit) ML_2(gnome_druid_page_edge_set_logo, GnomeDruidPageEdge_val, GdkPixbuf_val, Unit) ML_2(gnome_druid_page_edge_set_watermark, GnomeDruidPageEdge_val, GdkPixbuf_val, Unit) ML_2(gnome_druid_page_edge_set_top_watermark, GnomeDruidPageEdge_val, GdkPixbuf_val, Unit) /* gnome-druid-page-standard.h */ Make_Extractor(gnome_druid_page_standard, GnomeDruidPageStandard_val, vbox, Val_GtkWidget) ML_0(gnome_druid_page_standard_new, Val_GtkWidget_sink) ML_2(gnome_druid_page_standard_set_contents_background, GnomeDruidPageStandard_val, GdkColor_val, Unit) ML_4(gnome_druid_page_standard_append_item, GnomeDruidPageStandard_val, String_option_val, GtkWidget_val, String_option_val, Unit) lablgtk-2.18.8/src/gEdit.mli0000644000175000017500000004125213460263323014616 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj (** Editable Widgets *) (** {3 GtkEditable} *) (** @gtkdoc gtk GtkEditable *) class editable_signals : [> editable] obj -> object inherit GObj.widget_signals method changed : callback:(unit -> unit) -> GtkSignal.id method delete_text : callback:(start:int -> stop:int -> unit) -> GtkSignal.id method insert_text : callback:(string -> pos:int ref -> unit) -> GtkSignal.id end (** Interface for text-editing widgets @gtkdoc gtk GtkEditable *) class editable : ([> Gtk.editable] as 'a) obj -> object inherit ['a] GObj.widget_impl method copy_clipboard : unit -> unit method cut_clipboard : unit -> unit method delete_selection : unit -> unit method delete_text : start:int -> stop:int -> unit method editable : bool method get_chars : start:int -> stop:int -> string method insert_text : string -> pos:int -> int method paste_clipboard : unit -> unit method position : int method select_region : start:int -> stop:int -> unit method selection : (int * int) option method set_position : int -> unit method set_editable : bool -> unit end (** {3 GtkEntry & GtkEntryCompletion} *) (** @since GTK 2.4 @gtkdoc gtk GtkEntryCompletion *) class entry_completion_signals : [> `entrycompletion ] Gtk.obj -> object ('a) method after : 'a method action_activated : callback:(int -> unit) -> GtkSignal.id method match_selected : callback:(GTree.model_filter -> Gtk.tree_iter -> bool) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkEntryCompletion *) class entry_completion : ([> `entrycompletion|`celllayout] as 'a) Gtk.obj -> object inherit GTree.cell_layout val obj : 'a Gtk.obj method as_entry_completion : Gtk.entry_completion method misc : GObj.gobject_ops method connect : entry_completion_signals method minimum_key_length : int method set_minimum_key_length : int -> unit method model : GTree.model method set_model : GTree.model -> unit method get_entry : GObj.widget option method complete : unit -> unit method insert_action_text : int -> string -> unit method insert_action_markup : int -> string -> unit method delete_action : int -> unit method set_match_func : (string -> Gtk.tree_iter -> bool) -> unit method set_text_column : string GTree.column -> unit end (** @gtkdoc gtk GtkEntry *) class entry_signals : [> Gtk.entry] obj -> object inherit editable_signals method activate : callback:(unit -> unit) -> GtkSignal.id method copy_clipboard : callback:(unit -> unit) -> GtkSignal.id method cut_clipboard : callback:(unit -> unit) -> GtkSignal.id method delete_from_cursor : callback:(Gtk.Tags.delete_type -> int -> unit) -> GtkSignal.id method insert_at_cursor : callback:(string -> unit) -> GtkSignal.id method move_cursor : callback:(Gtk.Tags.movement_step -> int -> extend:bool -> unit) -> GtkSignal.id method paste_clipboard : callback:(unit -> unit) -> GtkSignal.id method populate_popup : callback:(GMenu.menu -> unit) -> GtkSignal.id method toggle_overwrite : callback:(unit -> unit) -> GtkSignal.id method notify_activates_default : callback:(bool -> unit) -> GtkSignal.id method notify_has_frame : callback:(bool -> unit) -> GtkSignal.id method notify_invisible_char : callback:(int -> unit) -> GtkSignal.id method notify_max_length : callback:(int -> unit) -> GtkSignal.id method notify_scroll_offset : callback:(int -> unit) -> GtkSignal.id method notify_text : callback:(string -> unit) -> GtkSignal.id method notify_visibility : callback:(bool -> unit) -> GtkSignal.id method notify_width_chars : callback:(int -> unit) -> GtkSignal.id method notify_xalign : callback:(float -> unit) -> GtkSignal.id method notify_overwrite_mode : callback:(bool -> unit) -> GtkSignal.id (** @Since GTK 2.14 *) method icon_press : callback:(GtkEnums.entry_icon_position -> GdkEvent.Button.t -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) method icon_released : callback:(GtkEnums.entry_icon_position -> GdkEvent.Button.t -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) method notify_primary_icon_activatable : callback:(bool -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) method notify_primary_icon_sensitive : callback:(bool -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) method notify_secondary_icon_activatable : callback:(bool -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) method notify_secondary_icon_sensitive : callback:(bool -> unit) -> GtkSignal.id (** @Since GTK 2.16 *) end (** A single line text entry field @gtkdoc gtk GtkEntry *) class entry : ([> Gtk.entry] as 'a) obj -> object inherit editable inherit ['a] GObj.objvar method as_entry : Gtk.entry Gtk.obj method connect : entry_signals method event : event_ops method append_text : string -> unit method prepend_text : string -> unit method scroll_offset : int method text : string method text_length : int method set_activates_default : bool -> unit method set_editable : bool -> unit method set_has_frame : bool -> unit method set_invisible_char : int -> unit method set_max_length : int -> unit method set_text : string -> unit method set_visibility : bool -> unit method set_width_chars : int -> unit method set_xalign : float -> unit method activates_default : bool method editable : bool method has_frame : bool method invisible_char : int method max_length : int method visibility : bool method width_chars : int method xalign : float method set_completion : entry_completion -> unit (** @since GTK 2.4 *) method get_completion : entry_completion option (** @since GTK 2.4 *) method overwrite_mode : bool (** @Since GTK 2.14 *) method set_overwrite_mode : bool -> unit (** @Since GTK 2.14 *) method primary_icon_activatable : bool (** @Since GTK 2.16 *) method primary_icon_sensitive : bool (** @Since GTK 2.16 *) method set_primary_icon_activatable : bool -> unit (** @Since GTK 2.16 *) method set_primary_icon_name : string -> unit (** @Since GTK 2.16, empty string to delete *) method set_primary_icon_pixbuf : GdkPixbuf.pixbuf -> unit (** @Since GTK 2.16 *) method set_primary_icon_sensitive : bool -> unit (** @Since GTK 2.16 *) method set_primary_icon_stock : GtkStock.id -> unit (** @Since GTK 2.16 *) method set_primary_icon_tooltip_markup : string -> unit (** @Since GTK 2.16 *) method set_primary_icon_tooltip_text : string -> unit (** @Since GTK 2.16 *) method secondary_icon_activatable : bool (** @Since GTK 2.16 *) method secondary_icon_sensitive : bool (** @Since GTK 2.16 *) method set_secondary_icon_activatable : bool -> unit (** @Since GTK 2.16 *) method set_secondary_icon_name : string -> unit (** @Since GTK 2.16, empty string to delete *) method set_secondary_icon_pixbuf : GdkPixbuf.pixbuf -> unit (** @Since GTK 2.16 *) method set_secondary_icon_sensitive : bool -> unit (** @Since GTK 2.16 *) method set_secondary_icon_stock : GtkStock.id -> unit (** @Since GTK 2.16 *) method set_secondary_icon_tooltip_markup : string -> unit (** @Since GTK 2.16 *) method set_secondary_icon_tooltip_text : string -> unit (** @Since GTK 2.16 *) end (** @gtkdoc gtk GtkEntry *) val entry : ?text:string -> ?visibility:bool -> ?max_length:int -> ?activates_default:bool -> ?editable:bool -> ?has_frame:bool -> ?width_chars:int -> ?xalign:float -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> entry (** @since GTK 2.4 @gtkdoc gtk GtkEntryCompletion *) val entry_completion : ?model:#GTree.model -> ?minimum_key_length:int -> ?entry:entry -> unit -> entry_completion (** {4 GtkSpinButton} *) (** @gtkdoc gtk GtkSpinButton *) class spin_button_signals : [> Gtk.spin_button] obj -> object inherit entry_signals method change_value : callback:(Gtk.Tags.scroll_type -> unit) -> GtkSignal.id method input : callback:(unit -> int) -> GtkSignal.id method output : callback:(unit -> bool) -> GtkSignal.id method value_changed : callback:(unit -> unit) -> GtkSignal.id method wrapped : callback:(unit -> unit) -> GtkSignal.id (** @since GTK 2.10 *) method notify_adjustment : callback:(GData.adjustment -> unit) -> GtkSignal.id method notify_digits : callback:(int -> unit) -> GtkSignal.id method notify_numeric : callback:(bool -> unit) -> GtkSignal.id method notify_rate : callback:(float -> unit) -> GtkSignal.id method notify_snap_to_ticks : callback:(bool -> unit) -> GtkSignal.id method notify_update_policy : callback:(GtkEnums.spin_button_update_policy -> unit) -> GtkSignal.id method notify_value : callback:(float -> unit) -> GtkSignal.id method notify_wrap : callback:(bool -> unit) -> GtkSignal.id end (** Retrieve an integer or floating-point number from the user @gtkdoc gtk GtkSpinButton *) class spin_button : Gtk.spin_button obj -> object inherit GObj.widget val obj : Gtk.spin_button obj method connect : spin_button_signals method event : GObj.event_ops method spin : Tags.spin_type -> unit method update : unit method value_as_int : int method set_adjustment : GData.adjustment -> unit method set_digits : int -> unit method set_numeric : bool -> unit method set_rate : float -> unit method set_snap_to_ticks : bool -> unit method set_update_policy : [`ALWAYS|`IF_VALID] -> unit method set_value : float -> unit method set_wrap : bool -> unit method adjustment : GData.adjustment method digits : int method numeric : bool method rate : float method snap_to_ticks : bool method update_policy : [`ALWAYS|`IF_VALID] method value : float method wrap : bool end (** @gtkdoc gtk GtkSpinButton *) val spin_button : ?adjustment:GData.adjustment -> ?rate:float -> ?digits:int -> ?numeric:bool -> ?snap_to_ticks:bool -> ?update_policy:[`ALWAYS|`IF_VALID] -> ?value:float -> ?wrap:bool -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> spin_button (** {3 GtkCombo} *) (** A text entry field with a dropdown list @gtkdoc gtk GtkCombo *) class combo : Gtk.combo obj -> object inherit GObj.widget val obj : Gtk.combo obj method disable_activate : unit -> unit method entry : entry method list : GList.liste method set_item_string : GList.list_item -> string -> unit method set_popdown_strings : string list -> unit method set_allow_empty : bool -> unit method set_case_sensitive : bool -> unit method set_enable_arrow_keys : bool -> unit method set_value_in_list : bool -> unit method allow_empty : bool method case_sensitive : bool method enable_arrow_keys : bool method value_in_list : bool end (** @gtkdoc gtk GtkCombo *) val combo : ?popdown_strings:string list -> ?allow_empty:bool -> ?case_sensitive:bool -> ?enable_arrow_keys:bool -> ?value_in_list:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> combo (** {3 GtkComboBox} *) (** @since GTK 2.4 @gtkdoc gtk GtkComboBox *) class combo_box_signals : [> Gtk.combo_box] Gtk.obj -> object inherit GContainer.container_signals method changed : callback:(unit -> unit) -> GtkSignal.id method notify_active : callback:(int -> unit) -> GtkSignal.id method notify_add_tearoffs : callback:(bool -> unit) -> GtkSignal.id method notify_focus_on_click : callback:(bool -> unit) -> GtkSignal.id method notify_has_frame : callback:(bool -> unit) -> GtkSignal.id method notify_wrap_width : callback:(int -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkComboBox *) class combo_box : ([> Gtk.combo_box] as 'a) Gtk.obj -> object inherit GContainer.bin inherit GTree.cell_layout val obj : 'a Gtk.obj method event : GObj.event_ops method active : int method active_iter : Gtk.tree_iter option method connect : combo_box_signals method model : GTree.model method set_active : int -> unit method set_active_iter : Gtk.tree_iter option -> unit method set_column_span_column : int GTree.column -> unit method set_model : GTree.model -> unit method set_row_span_column : int GTree.column -> unit method set_wrap_width : int -> unit method wrap_width : int method add_tearoffs : bool (** @since GTK 2.6 *) method set_add_tearoffs : bool -> unit (** @since GTK 2.6 *) method focus_on_click : bool (** @since GTK 2.6 *) method set_focus_on_click : bool -> unit (** @since GTK 2.6 *) method has_frame : bool (** @since GTK 2.6 *) method set_has_frame : bool -> unit (** @since GTK 2.6 *) method set_row_separator_func : (GTree.model -> Gtk.tree_iter -> bool) option -> unit (** @since GTK 2.6 *) end (** @since GTK 2.4 @gtkdoc gtk GtkComboBox *) val combo_box : ?model:#GTree.model -> ?active:int -> ?add_tearoffs:bool -> ?focus_on_click:bool -> ?has_frame:bool -> ?wrap_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> combo_box (** @since GTK 2.4 @gtkdoc gtk GtkComboBoxEntry *) class combo_box_entry : ([> Gtk.combo_box_entry] as 'a) Gtk.obj -> object inherit combo_box val obj : 'a Gtk.obj method text_column : string GTree.column method set_text_column : string GTree.column -> unit method entry : entry end (** @since GTK 2.4 @gtkdoc gtk GtkComboBoxEntry *) val combo_box_entry : ?model:#GTree.model -> ?text_column:string GTree.column -> ?active:int -> ?add_tearoffs:bool -> ?focus_on_click:bool -> ?has_frame:bool -> ?wrap_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> combo_box_entry (** {4 Convenience API for text-only ComboBoxes} *) type 'a text_combo = 'a * (GTree.list_store * string GTree.column) constraint 'a = #combo_box val text_combo_add : 'a text_combo -> string -> unit val text_combo_get_active : 'a text_combo -> string option (** A convenience function for creating simple {!GEdit.combo_box}. Creates a simple {!GTree.list_store} with a single text column, adds [strings] in it, creates a {!GTree.cell_renderer_text} and connects it with the model. @since GTK 2.4 @gtkdoc gtk GtkComboBox *) val combo_box_text : ?strings:string list -> ?use_markup:bool -> ?active:int -> ?add_tearoffs:bool -> ?focus_on_click:bool -> ?has_frame:bool -> ?wrap_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> combo_box text_combo (** A convenience function. See {!GEdit.combo_box_text} @since GTK 2.4 @gtkdoc gtk GtkComboBoxEntry *) val combo_box_entry_text : ?strings:string list -> ?active:int -> ?add_tearoffs:bool -> ?focus_on_click:bool -> ?has_frame:bool -> ?wrap_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> combo_box_entry text_combo lablgtk-2.18.8/src/gaux.ml0000644000175000017500000000361513460263323014356 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (* Option handling *) let may ~f x = match x with None -> () | Some x -> let _ = f x in () let may_map ~f x = match x with None -> None | Some x -> Some (f x) let default x ~opt = match opt with None -> x | Some y -> y let may_default f x ~opt = match opt with None -> f x | Some y -> y lablgtk-2.18.8/src/ml_gnomecanvas.c0000644000175000017500000003713413460263323016220 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" static inline value copy_two_doubles(double a, double b) { CAMLparam0(); CAMLlocal3(va, vb, v); va = copy_double(a); vb = copy_double(b); v = alloc_small(2, 0); Field(v, 0) = va; Field(v, 1) = vb; CAMLreturn(v); } static inline value copy_double_array(double *a, size_t len) { value v; register unsigned int i; v = alloc(len * Double_wosize, Double_array_tag); for(i=0; ixform) { CAMLparam0(); CAMLlocal2(arr, v); mlsize_t len; if( GTK_OBJECT_FLAGS(GTK_OBJECT(item)) & GNOME_CANVAS_ITEM_AFFINE_FULL ) len = 6; else len = 2; arr = alloc_small(Double_wosize * len, Double_array_tag); memcpy(Bp_val(arr), item->xform, len * sizeof (double)); v = alloc_small(2, 0); Field(v, 0) = (len == 6) ? ML_TAG_AFFINE : ML_TAG_TRANSL; Field(v, 1) = arr; CAMLreturn(v); } else return ML_TAG_IDENTITY; } #ifndef ARCH_ALIGN_DOUBLE CAMLprim value ml_gnome_canvas_item_affine_relative(value i, value a) { if(Wosize_val(a) != 6 * Double_wosize) invalid_argument("affine transform"); gnome_canvas_item_affine_relative(GnomeCanvasItem_val(i), (double *)a); return Val_unit; } CAMLprim value ml_gnome_canvas_item_affine_absolute(value i, value a) { if(Wosize_val(a) == 0) gnome_canvas_item_affine_absolute(GnomeCanvasItem_val(i), NULL); else if(Wosize_val(a) == 6 * Double_wosize) gnome_canvas_item_affine_absolute(GnomeCanvasItem_val(i), (double *)a); else invalid_argument("affine transform"); return Val_unit; } #else CAMLprim value ml_gnome_canvas_item_affine_relative(value i, value a) { double coords[6]; if(Wosize_val(a) != 6 * Double_wosize) invalid_argument("affine transform"); memcpy(coords, Bp_val(a), sizeof coords); gnome_canvas_item_affine_relative(GnomeCanvasItem_val(i), coords); return Val_unit; } CAMLprim value ml_gnome_canvas_item_affine_absolute(value i, value a) { double coords[6]; if(Wosize_val(a) == 0) gnome_canvas_item_affine_absolute(GnomeCanvasItem_val(i), NULL); else if(Wosize_val(a) == 6 * Double_wosize) { memcpy(coords, Bp_val(a), sizeof coords); gnome_canvas_item_affine_absolute(GnomeCanvasItem_val(i), coords); } else invalid_argument("affine transform"); return Val_unit; } #endif /* ARCH_ALIGN_DOUBLE */ CAMLprim value ml_gnome_canvas_item_set(value i) { gnome_canvas_item_set(GnomeCanvasItem_val(i), NULL); return Val_unit; } ML_3 (gnome_canvas_item_move, GnomeCanvasItem_val, Double_val, Double_val, Unit) ML_2 (gnome_canvas_item_raise, GnomeCanvasItem_val, Int_val, Unit) ML_2 (gnome_canvas_item_lower, GnomeCanvasItem_val, Int_val, Unit) ML_1 (gnome_canvas_item_raise_to_top, GnomeCanvasItem_val, Unit) ML_1 (gnome_canvas_item_lower_to_bottom, GnomeCanvasItem_val, Unit) ML_1 (gnome_canvas_item_show, GnomeCanvasItem_val, Unit) ML_1 (gnome_canvas_item_hide, GnomeCanvasItem_val, Unit) ML_4 (gnome_canvas_item_grab, GnomeCanvasItem_val, Flags_Event_mask_val, GdkCursor_val, Int32_val, Unit) ML_2 (gnome_canvas_item_ungrab, GnomeCanvasItem_val, Int32_val, Unit) CAMLprim value ml_gnome_canvas_item_w2i(value i, value x, value y) { double ox = Double_val(x); double oy = Double_val(y); gnome_canvas_item_w2i(GnomeCanvasItem_val(i), &ox, &oy); return copy_two_doubles(ox, oy); } CAMLprim value ml_gnome_canvas_item_i2w(value i, value x, value y) { double ox = Double_val(x); double oy = Double_val(y); gnome_canvas_item_i2w(GnomeCanvasItem_val(i), &ox, &oy); return copy_two_doubles(ox, oy); } #ifndef ARCH_ALIGN_DOUBLE CAMLprim value ml_gnome_canvas_item_i2w_affine(value i) { GnomeCanvasItem *item = GnomeCanvasItem_val(i); value v = alloc_small(6 * Double_wosize, Double_array_tag); gnome_canvas_item_i2w_affine(item, (double *)v); return v; } CAMLprim value ml_gnome_canvas_item_i2c_affine(value i) { GnomeCanvasItem *item = GnomeCanvasItem_val(i); value v = alloc_small(6 * Double_wosize, Double_array_tag); gnome_canvas_item_i2c_affine(item, (double *)v); return v; } #else CAMLprim value ml_gnome_canvas_item_i2w_affine(value i) { GnomeCanvasItem *item = GnomeCanvasItem_val(i); value v = alloc_small(6 * Double_wosize, Double_array_tag); double coords[6]; gnome_canvas_item_i2w_affine(item, coords); memcpy(Bp_val(v), coords, sizeof coords); return v; } CAMLprim value ml_gnome_canvas_item_i2c_affine(value i) { GnomeCanvasItem *item = GnomeCanvasItem_val(i); value v = alloc_small(6 * Double_wosize, Double_array_tag); double coords[6]; gnome_canvas_item_i2c_affine(item, coords); memcpy(Bp_val(v), coords, sizeof coords); return v; } #endif /* ARCH_ALIGN_DOUBLE */ ML_2 (gnome_canvas_item_reparent, GnomeCanvasItem_val, GnomeCanvasGroup_val, Unit) ML_1 (gnome_canvas_item_grab_focus, GnomeCanvasItem_val, Unit) CAMLprim value ml_gnome_canvas_item_get_bounds(value i) { double p[4]; gnome_canvas_item_get_bounds(GnomeCanvasItem_val(i), &p[0], &p[1], &p[2], &p[3]); return copy_double_array(p, 4); } /* gnome_canvas_item_request_update */ /* GnomeCanvasGroup */ CAMLprim value ml_gnome_canvas_group_get_items(value cg) { return Val_GList(GnomeCanvasGroup_val(cg)->item_list, (value_in)Val_GObject); } /* Converion functions for properties */ CAMLprim value ml_gnome_canvas_convert_points(value arr) { int len = Wosize_val(arr) / Double_wosize; GnomeCanvasPoints *p; if(len % 2) invalid_argument("GnomeCanvas.convert_points: odd number of coords"); p = gnome_canvas_points_new(len / 2); memcpy(p->coords, Bp_val(arr), Bosize_val(arr)); return Val_gboxed_new(gnome_canvas_points_get_type(), p); } CAMLprim value ml_gnome_canvas_get_points(value arg) { GnomeCanvasPoints *p = Pointer_val(arg); value ret = alloc(p->num_points * 2 * Double_wosize, Double_array_tag); memcpy(Bp_val(ret), p->coords, p->num_points * 2 * sizeof(double)); return ret; } #define artvpathdash_free(d) g_free((d)->dash); g_free(d) Make_Val_final_pointer_ext(ArtVpathDash, _new, Ignore, artvpathdash_free, 1) CAMLprim value ml_gnome_canvas_convert_dash(value off, value dash) { ArtVpathDash *d; int len = Wosize_val(dash) / Double_wosize; d = g_malloc(sizeof *d); d->offset = Double_val(off); d->n_dash = len; d->dash = g_malloc(d->n_dash * sizeof (double)); memcpy(d->dash, Bp_val(dash), Bosize_val(dash)); return Val_ArtVpathDash_new(d); } CAMLprim value ml_gnome_canvas_get_dash(value dash) { CAMLparam1(dash); CAMLlocal3(ret,dashes,offset); ArtVpathDash *d = Pointer_val(dash); dashes = alloc(d->n_dash * Double_wosize, Double_array_tag); memcpy(Bp_val(dashes), d->dash, d->n_dash * sizeof (double)); offset = copy_double(d->offset); ret = alloc_small(2, 0); Field(ret,0) = offset; Field(ret,1) = dashes; CAMLreturn (ret); } /* gome-canvas-path-def.h */ Make_Val_final_pointer_ext(GnomeCanvasPathDef, _new, Ignore, gnome_canvas_path_def_unref, 1) #define GnomeCanvasPathDef_val(v) ((GnomeCanvasPathDef *)Pointer_val(v)) CAMLprim value ml_gnome_canvas_path_def_new(value olen, value unit) { gint len = Option_val(olen, Int_val, -1); GnomeCanvasPathDef *p; if(len < 0) p = gnome_canvas_path_def_new(); else p = gnome_canvas_path_def_new_sized(len); return Val_GnomeCanvasPathDef_new(p); } ML_1 (gnome_canvas_path_def_duplicate, GnomeCanvasPathDef_val, Val_GnomeCanvasPathDef_new) static gpointer path_def_val(value v) { return GnomeCanvasPathDef_val(v); } CAMLprim value ml_gnome_canvas_path_def_concat(value plist) { GSList *l = GSList_val(plist, path_def_val); return Val_GnomeCanvasPathDef_new(gnome_canvas_path_def_concat(l)); } ML_1 (gnome_canvas_path_def_reset, GnomeCanvasPathDef_val, Unit) ML_3 (gnome_canvas_path_def_moveto, GnomeCanvasPathDef_val, Double_val, Double_val, Unit) ML_3 (gnome_canvas_path_def_lineto, GnomeCanvasPathDef_val, Double_val, Double_val, Unit) ML_3 (gnome_canvas_path_def_lineto_moving, GnomeCanvasPathDef_val, Double_val, Double_val, Unit) ML_7 (gnome_canvas_path_def_curveto, GnomeCanvasPathDef_val, Double_val, Double_val, Double_val, Double_val, Double_val, Double_val, Unit) ML_bc7 (ml_gnome_canvas_path_def_curveto) ML_1 (gnome_canvas_path_def_closepath, GnomeCanvasPathDef_val, Unit) ML_1 (gnome_canvas_path_def_closepath_current, GnomeCanvasPathDef_val, Unit) ML_1 (gnome_canvas_path_def_length, GnomeCanvasPathDef_val, Val_int) ML_1 (gnome_canvas_path_def_is_empty, GnomeCanvasPathDef_val, Val_bool) ML_1 (gnome_canvas_path_def_has_currentpoint, GnomeCanvasPathDef_val, Val_bool) /* gnome-canvas-rich-text.h */ #define GnomeCanvasRichText_val(val) check_cast(GNOME_CANVAS_RICH_TEXT,val) ML_1 (gnome_canvas_rich_text_cut_clipboard, GnomeCanvasRichText_val, Unit) ML_1 (gnome_canvas_rich_text_copy_clipboard, GnomeCanvasRichText_val, Unit) ML_1 (gnome_canvas_rich_text_paste_clipboard, GnomeCanvasRichText_val, Unit) ML_1 (gnome_canvas_rich_text_get_buffer, GnomeCanvasRichText_val, Val_GAnyObject) lablgtk-2.18.8/src/gnomeCanvas.ml0000644000175000017500000003331513460263323015653 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) type canvas = [Gtk.layout|`canvas] type item = [`gtk|`canvasitem] type group = [item|`canvasgroup] type clipgroup = [group|`canvasclipgroup] type shape = [item|`canvasshape] type r_e = [shape|`canvasre] type rect = [r_e|`canvasrectangle] type ellipse = [r_e|`canvasellipse] type bpath = [shape|`canvasbpath] type polygon = [shape|`canvaspolygon] type text = [item|`canvastext] type line = [item|`canvasline] type pixbuf = [item|`canvaspixbuf] type widget = [item|`canvaswidget] type rich_text = [item|`canvasrichtext] type path_def (* GnomeCanvas *) module Canvas = struct external new_canvas : unit -> canvas Gobject.obj = "ml_gnome_canvas_new" external new_canvas_aa : unit -> canvas Gobject.obj = "ml_gnome_canvas_new_aa" external root : [> canvas] Gobject.obj -> group Gobject.obj = "ml_gnome_canvas_root" external set_scroll_region : [> canvas] Gobject.obj -> x1:float -> y1:float -> x2:float -> y2:float -> unit = "ml_gnome_canvas_set_scroll_region" external get_scroll_region : [> canvas] Gobject.obj -> float array = "ml_gnome_canvas_get_scroll_region" external set_center_scroll_region : [> canvas] Gobject.obj -> bool -> unit = "ml_gnome_canvas_set_center_scroll_region" external get_center_scroll_region : [> canvas] Gobject.obj -> bool = "ml_gnome_canvas_get_center_scroll_region" external set_pixels_per_unit : [> canvas] Gobject.obj -> float -> unit = "ml_gnome_canvas_set_pixels_per_unit" external scroll_to : [> canvas] Gobject.obj -> x:int -> y:int -> unit = "ml_gnome_canvas_scroll_to" external get_scroll_offsets : [> canvas] Gobject.obj -> int * int = "ml_gnome_canvas_get_scroll_offsets" external update_now : [> canvas] Gobject.obj -> unit = "ml_gnome_canvas_update_now" external get_item_at : [> canvas] Gobject.obj -> x:float -> y:float -> item Gobject.obj = "ml_gnome_canvas_get_item_at" external w2c_affine : [> canvas] Gobject.obj -> float array = "ml_gnome_canvas_w2c_affine" external w2c : [> canvas] Gobject.obj -> wx:float -> wy:float -> int * int = "ml_gnome_canvas_w2c" external w2c_d : [> canvas] Gobject.obj -> wx:float -> wy:float -> float * float = "ml_gnome_canvas_w2c_d" external c2w : [> canvas] Gobject.obj -> cx:int -> cy:int -> float * float = "ml_gnome_canvas_c2w" external window_to_world : [> canvas] Gobject.obj -> winx:float -> winy:float -> float * float = "ml_gnome_canvas_window_to_world" external world_to_window : [> canvas] Gobject.obj -> wox:float -> woy:float -> float * float = "ml_gnome_canvas_world_to_window" end module PathDef = struct type t = Gpointer.boxed external new_path : ?size:int -> unit -> t = "ml_gnome_canvas_path_def_new" external duplicate : t -> t = "ml_gnome_canvas_path_def_duplicate" external concat : t list -> t = "ml_gnome_canvas_path_def_concat" external reset : t -> unit = "ml_gnome_canvas_path_def_reset" external moveto : t -> float -> float -> unit = "ml_gnome_canvas_path_def_moveto" external lineto : t -> float -> float -> unit = "ml_gnome_canvas_path_def_lineto" external lineto_moving : t -> float -> float -> unit = "ml_gnome_canvas_path_def_lineto_moving" external curveto : t -> float -> float -> float -> float -> float -> float -> unit = "ml_gnome_canvas_path_def_curveto_bc" "ml_gnome_canvas_path_def_curveto" external closepath : t -> unit = "ml_gnome_canvas_path_def_closepath" external closepath_current : t -> unit = "ml_gnome_canvas_path_def_closepath_current" external length : t -> int = "ml_gnome_canvas_path_def_length" external is_empty : t -> bool = "ml_gnome_canvas_path_def_is_empty" external has_currentpoint : t -> bool = "ml_gnome_canvas_path_def_has_currentpoint" end type group_p = [`X of float| `Y of float] type shape_p = [`FILL_COLOR of string| `OUTLINE_COLOR of string | `NO_FILL_COLOR| `NO_OUTLINE_COLOR | `FILL_COLOR_RGBA of int32| `FILL_STIPPLE of Gdk.bitmap | `OUTLINE_COLOR_RGBA of int32| `OUTLINE_STIPPLE of Gdk.bitmap | `WIDTH_UNITS of float| `WIDTH_PIXELS of int | `DASH of float * float array | `CAP_STYLE of Gdk.GC.gdkCapStyle | `JOIN_STYLE of Gdk.GC.gdkJoinStyle] type re_p = [shape_p| `X1 of float| `Y1 of float| `X2 of float| `Y2 of float] type text_p = [`X of float| `Y of float| `TEXT of string| `FONT of string | `NO_TEXT| `NO_FONT| `NO_FILL_COLOR | `SIZE of int| `SIZE_POINTS of float| `FILL_COLOR of string | `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap | `CLIP of bool| `CLIP_WIDTH of float| `CLIP_HEIGHT of float | `X_OFFSET of float| `Y_OFFSET of float | `JUSTIFICATION of Gtk.Tags.justification | `ANCHOR of Gtk.Tags.anchor_type| `FAMILY of string | `MARKUP of string | `RISE of int | `SCALE of float | `WEIGHT of int] type line_p = [`ARROW_SHAPE_A of float| `ARROW_SHAPE_B of float| `ARROW_SHAPE_C of float | `FILL_COLOR of string| `NO_FILL_COLOR | `WIDTH_UNITS of float| `WIDTH_PIXELS of int | `POINTS of float array| `FIRST_ARROWHEAD of bool | `LAST_ARROWHEAD of bool| `SMOOTH of bool | `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap | `CAP_STYLE of Gdk.GC.gdkCapStyle| `JOIN_STYLE of Gdk.GC.gdkJoinStyle | `LINE_STYLE of Gdk.GC.gdkLineStyle] type bpath_p = [shape_p| `BPATH of PathDef.t| `NO_BPATH] type pixbuf_p = [`X of float| `Y of float | `WIDTH of float| `HEIGHT of float | `ANCHOR of Gtk.Tags.anchor_type | `PIXBUF of GdkPixbuf.pixbuf| `NO_PIXBUF] type polygon_p = [shape_p| `POINTS of float array] type widget_p = [`X of float| `Y of float | `WIDTH of float| `HEIGHT of float | `SIZE_PIXELS of bool | `ANCHOR of Gtk.Tags.anchor_type | `WIDGET of GObj.widget| `NO_WIDGET] type rich_text_p = [`X of float| `Y of float | `TEXT of string | `WIDTH of float| `HEIGHT of float | `EDITABLE of bool | `VISIBLE of bool | `JUSTIFICATION of Gtk.Tags.justification | `ANCHOR of Gtk.Tags.anchor_type | `CURSOR_VISIBLE of bool| `CURSOR_BLINK of bool | `GROW_HEIGHT of bool | `LEFT_MARGIN of int| `RIGHT_MARGIN of int] module Types : sig type ('a, 'b) t constraint 'a = [> `gtk|`canvasitem] val group : (group, group_p) t val rect : ([item|`canvasshape|`canvasRE|`canvasrect], re_p) t val ellipse : ([item|`canvasshape|`canvasRE|`canvasellipse], re_p) t val text : ([item|`canvastext], text_p) t val line : ([item|`canvasline], line_p) t val bpath : ([item|`canvasshape|`canvasbpath], bpath_p) t val pixbuf : ([item|`canvaspixbuf], pixbuf_p) t val polygon : ([item|`canvasshape|`canvaspolygon], polygon_p) t val widget : ([item|`canvaswidget], widget_p) t val rich_text : (rich_text, rich_text_p) t val shape : ([item|`canvasshape], shape_p) t val rect_ellipse : ([item|`canvasshape|`canvasRE], re_p) t val points : Gobject.g_type val is_a : 'a Gobject.obj -> ('b, 'c) t -> bool val name : ('a, 'b) t -> string end = struct type ('a, 'b) t = Gobject.g_type constraint 'a = [> `gtk|`canvasitem] external register_types : unit -> Gobject.g_type array = "ml_gnome_canvas_register_types" let canvas_types = register_types () let group = canvas_types.(4) let rect = canvas_types.(11) let ellipse = canvas_types.(3) let text = canvas_types.(14) let line = canvas_types.(6) let bpath = canvas_types.(1) let pixbuf = canvas_types.(7) let polygon = canvas_types.(9) let shape = canvas_types.(13) let rect_ellipse = canvas_types.(10) let widget = canvas_types.(2) let rich_text = canvas_types.(12) let points = canvas_types.(8) let is_a obj typ = Gobject.Type.is_a (Gobject.get_type obj) typ let name = Gobject.Type.name end (* GnomeCanvasItem *) type item_event = [ `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE | `MOTION_NOTIFY | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE ] Gdk.event module Item = struct external new_item : [> group] Gobject.obj -> ('a, 'b) Types.t -> 'a Gobject.obj = "ml_gnome_canvas_item_new" external parent : [> item] Gobject.obj -> group Gobject.obj = "ml_gnome_canvas_item_parent" external canvas : [> item] Gobject.obj -> canvas Gobject.obj = "ml_gnome_canvas_item_canvas" external xform : [> item] Gobject.obj -> [`IDENTITY|`TRANSL of float array|`AFFINE of float array] = "ml_gnome_canvas_item_xform" external affine_relative : [> item] Gobject.obj -> float array -> unit = "ml_gnome_canvas_item_affine_relative" external affine_absolute : [> item] Gobject.obj -> float array -> unit = "ml_gnome_canvas_item_affine_absolute" external set : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_set" (* Must call [set] after using [Gobject.Property.set] *) external move : [> item] Gobject.obj -> x:float -> y:float -> unit = "ml_gnome_canvas_item_move" external raise : [> item] Gobject.obj -> int -> unit = "ml_gnome_canvas_item_raise" external lower : [> item] Gobject.obj -> int -> unit = "ml_gnome_canvas_item_lower" external raise_to_top : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_raise_to_top" external lower_to_bottom : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_lower_to_bottom" external show : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_show" external hide : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_hide" external grab : [> item] Gobject.obj -> Gdk.Tags.event_mask list -> Gdk.cursor -> int32 -> unit = "ml_gnome_canvas_item_grab" external ungrab : [> item] Gobject.obj -> int32 -> unit = "ml_gnome_canvas_item_ungrab" external w2i : [> item] Gobject.obj -> x:float -> y:float -> float * float = "ml_gnome_canvas_item_w2i" external i2w : [> item] Gobject.obj -> x:float -> y:float -> float * float = "ml_gnome_canvas_item_i2w" external i2w_affine : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_i2w_affine" external i2c_affine : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_i2c_affine" external reparent : [> item] Gobject.obj -> group Gobject.obj -> unit = "ml_gnome_canvas_item_reparent" external grab_focus : [> item] Gobject.obj -> unit = "ml_gnome_canvas_item_grab_focus" external get_bounds : [> item] Gobject.obj -> float array = "ml_gnome_canvas_item_get_bounds" module Signals = struct let marshal = GtkBase.Widget.Signals.Event.marshal let event : ([> `canvasitem], item_event -> bool) GtkSignal.t = { GtkSignal.name = "event"; GtkSignal.classe = `canvasitem; GtkSignal.marshaller = marshal; } end end (* GnomeCanvasGroup *) module Group = struct external get_items : [> group] Gobject.obj -> item Gobject.obj list = "ml_gnome_canvas_group_get_items" end module Text = struct let text_width = { Gobject.name = "text-width"; Gobject.conv = Gobject.Data.double } let text_height = { Gobject.name = "text-height"; Gobject.conv = Gobject.Data.double } end (* GnomeCanvasRichText *) module RichText = struct external cut_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_cut_clipboard" external copy_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_copy_clipboard" external paste_clipboard : [> rich_text] Gobject.obj -> unit = "ml_gnome_canvas_rich_text_paste_clipboard" external get_buffer : [> rich_text] Gobject.obj -> Gtk.text_buffer = "ml_gnome_canvas_rich_text_get_buffer" end (* Conversion functions for properties *) module Conv = struct external convert_points : float array -> Gpointer.boxed = "ml_gnome_canvas_convert_points" external convert_dash : float -> float array -> Gpointer.boxed = "ml_gnome_canvas_convert_dash" external get_points : Gpointer.boxed -> float array = "ml_gnome_canvas_get_points" external get_dash : Gpointer.boxed -> float * float array = "ml_gnome_canvas_get_dash" open Gaux open Gobject let points = { kind = `OTHER (Type.from_name "GnomeCanvasPoints"); inj = (fun x -> `POINTER (may_map convert_points x)); proj = (fun x -> may_map get_points (Data.pointer.proj x)) } let art_vpath_dash = { kind = `POINTER; inj = (fun x -> `POINTER (may_map (fun (x,y) -> convert_dash x y) x)); proj = (fun x -> may_map get_dash (Data.pointer.proj x)) } let path_def = { kind = `POINTER; inj = Data.unsafe_pointer_option.inj; proj = (fun x -> may_map PathDef.duplicate (Data.unsafe_pointer_option.proj x)) } end lablgtk-2.18.8/src/gdk.mli0000644000175000017500000004160513460263323014331 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject type color type colormap type visual type screen = [`gdkscreen] obj type region type gc type window = [`drawable|`gdkwindow] obj type pixmap = [`drawable|`gdkpixmap] obj type bitmap = [`drawable|`gdkpixmap|`gdkbitmap] obj type font type image = [`gdkimage] obj type atom type keysym = int type +'a event type drag_context = [`dragcontext] Gobject.obj type cursor type xid = int32 type native_window type device type display exception Error of string module Tags : sig type event_type = [ `NOTHING | `DELETE | `DESTROY | `EXPOSE | `MOTION_NOTIFY | `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `CONFIGURE | `MAP | `UNMAP | `PROPERTY_NOTIFY | `SELECTION_CLEAR | `SELECTION_REQUEST | `SELECTION_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `DRAG_ENTER | `DRAG_LEAVE | `DRAG_MOTION | `DRAG_STATUS | `DROP_START | `DROP_FINISHED | `CLIENT_EVENT | `VISIBILITY_NOTIFY | `NO_EXPOSE | `SCROLL | `WINDOW_STATE | `SETTING ] type event_mask = [ `EXPOSURE | `POINTER_MOTION | `POINTER_MOTION_HINT | `BUTTON_MOTION | `BUTTON1_MOTION | `BUTTON2_MOTION | `BUTTON3_MOTION | `BUTTON_PRESS | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `STRUCTURE | `PROPERTY_CHANGE | `VISIBILITY_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `SUBSTRUCTURE | `SCROLL | `ALL_EVENTS ] type extension_mode = [ `NONE | `ALL | `CURSOR ] type visibility_state = [ `UNOBSCURED | `PARTIAL | `FULLY_OBSCURED ] type input_source = [ `MOUSE | `PEN | `ERASER | `CURSOR ] type scroll_direction = [ `UP | `DOWN | `LEFT | `RIGHT ] type notify_type = [ `ANCESTOR | `VIRTUAL | `INFERIOR | `NONLINEAR | `NONLINEAR_VIRTUAL | `UNKNOWN ] type crossing_mode = [ `NORMAL | `GRAB | `UNGRAB ] type setting_action = [ `NEW | `CHANGED | `DELETED ] type window_state = [ `WITHDRAWN | `ICONIFIED | `MAXIMIZED | `STICKY ] type modifier = [ `SHIFT | `LOCK | `CONTROL | `MOD1 | `MOD2 | `MOD3 | `MOD4 | `MOD5 | `BUTTON1 | `BUTTON2 | `BUTTON3 | `BUTTON4 | `BUTTON5 | `SUPER | `HYPER | `META | `RELEASE ] type drag_action = [ `DEFAULT | `COPY | `MOVE | `LINK | `PRIVATE | `ASK ] type rgb_dither = [ `NONE | `NORMAL | `MAX] type property_state = [ `NEW_VALUE | `DELETE ] type property_mode = [ `REPLACE | `PREPEND | `APPEND ] type xdata = [ `BYTES of string | `SHORTS of int array | `INT32S of int32 array ] type xdata_ret = [ xdata | `NONE ] type gravity = [ `NORTH_WEST | `NORTH | `NORTH_EAST | `WEST | `CENTER | `EAST | `SOUTH_WEST | `SOUTH | `SOUTH_EAST | `STATIC ] type window_type_hint = [ `NORMAL | `DIALOG | `MENU | `TOOLBAR | `SPLASHSCREEN | `UTILITY | `DOCK | `DESKTOP ] end module Convert : sig val test_modifier : Tags.modifier -> int -> bool val modifier : int -> Tags.modifier list val window_state : int -> Tags.window_state list end module Atom : sig (* Currently Gtk2 does not implement ?dont_create... *) val intern : ?dont_create:bool -> string -> atom val name : atom -> string val none : atom val primary : atom val secondary : atom val clipboard : atom val string : atom end module Property : sig val change : window:window -> typ:atom -> ?mode:Tags.property_mode -> atom -> Tags.xdata -> unit val get : window:window -> ?max_length:int -> ?delete:bool -> atom -> (atom * Tags.xdata) option val delete : window:window -> atom -> unit end module Screen : sig val width : ?screen:screen -> unit -> int val height : ?screen:screen -> unit -> int val get_pango_context : ?screen:screen -> unit -> Pango.context (* Screens are only supported with Gtk+-2.2 *) val default : unit -> screen end module Visual : sig type visual_type = [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ] val get_best : ?depth:int -> ?kind:visual_type -> unit -> visual val get_type : visual -> visual_type val depth : visual -> int val red_mask : visual -> int val red_shift : visual -> int val red_prec : visual -> int val green_mask : visual -> int val green_shift : visual -> int val green_prec : visual -> int val blue_mask : visual -> int val blue_shift : visual -> int val blue_prec : visual -> int end module Image : sig type image_type = [ `FASTEST|`NORMAL|`SHARED ] val create : kind:image_type -> visual:visual -> width:int -> height:int -> image val get : [>`drawable] obj -> x:int -> y:int -> width:int -> height:int -> image val put_pixel : image -> x:int -> y:int -> pixel:int -> unit val get_pixel : image -> x:int -> y:int -> int val destroy : image -> unit val width : image -> int val height : image -> int val depth : image -> int val get_visual : image -> visual end module Color : sig val get_system_colormap : unit -> colormap val get_colormap : ?privat:bool -> visual -> colormap val get_visual : colormap -> visual type spec = [ | `BLACK | `NAME of string | `RGB of int * int * int | `WHITE ] val alloc : colormap:colormap -> spec -> color val red : color -> int val blue : color -> int val green : color -> int val pixel : color -> int end module Rectangle : sig type t val create : x:int -> y:int -> width:int -> height:int -> t val x : t -> int val y : t -> int val width : t -> int val height : t -> int end module Drawable : sig val cast : 'a obj -> [`drawable] obj val get_visual : [>`drawable] obj -> visual val get_depth : [>`drawable] obj -> int val get_colormap : [>`drawable] obj -> colormap val get_size : [>`drawable] obj -> int * int end module Window : sig val cast : 'a obj -> window val create_foreign : native_window -> window val get_parent : window -> window val get_position : window -> int * int val get_pointer_location : window -> int * int val root_parent : unit -> window val clear : window -> unit val clear_area : window -> x:int -> y:int -> width:int -> height:int -> unit val get_xwindow : [>`drawable] obj -> xid val native_of_xid : xid -> native_window val xid_of_native : native_window -> xid type background_pixmap = [ `NONE|`PARENT_RELATIVE|`PIXMAP of pixmap ] val set_back_pixmap : window -> background_pixmap -> unit val set_cursor : window -> cursor -> unit val set_transient_for : window -> window -> unit (* for backward compatibility for lablgtk1 programs *) val get_visual : window -> visual end module PointArray : sig type t = { len: int } val create : len:int -> t val set : t -> pos:int -> x:int -> y:int -> unit end module Region : sig type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ] type gdkOverlapType = [ `IN|`OUT|`PART ] val create : unit -> region val destroy : region -> unit val polygon : (int * int) list -> gdkFillRule -> region val intersect : region -> region -> region val union : region -> region -> region val subtract : region -> region -> region val xor : region -> region -> region val union_with_rect : region -> Rectangle.t -> region val offset : region -> x:int -> y:int -> unit val shrink : region -> x:int -> y:int -> unit val empty : region -> bool val equal : region -> region -> bool val point_in : region -> x:int -> y:int -> bool val rect_in : region -> Rectangle.t -> gdkOverlapType val get_clipbox : region -> Rectangle.t -> unit end module GC : sig type gdkFunction = [ `COPY|`INVERT|`XOR ] type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ] type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ] type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ] type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ] type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ] val create : [>`drawable] obj -> gc val set_foreground : gc -> color -> unit val set_background : gc -> color -> unit val set_font : gc -> font -> unit val set_function : gc -> gdkFunction -> unit val set_fill : gc -> gdkFill -> unit val set_tile : gc -> pixmap -> unit val set_stipple : gc -> pixmap -> unit val set_ts_origin : gc -> x:int -> y:int -> unit val set_clip_origin : gc -> x:int -> y:int -> unit val set_clip_mask : gc -> bitmap -> unit val set_clip_rectangle : gc -> Rectangle.t -> unit val set_clip_region : gc -> region -> unit val set_subwindow : gc -> gdkSubwindowMode -> unit val set_exposures : gc -> bool -> unit val set_line_attributes : gc -> width:int -> style:gdkLineStyle -> cap:gdkCapStyle -> join:gdkJoinStyle -> unit val set_dashes : gc -> offset:int -> int list -> unit val copy : dst:gc -> gc -> unit type values = { foreground : color; background : color; font : font option; fonction : gdkFunction; fill : gdkFill; tile : pixmap option; stipple : pixmap option; clip_mask : bitmap option; subwindow_mode : gdkSubwindowMode; ts_x_origin : int; ts_y_origin : int; clip_x_origin : int; clip_y_origin : int; graphics_exposures : bool; line_width : int; line_style : gdkLineStyle; cap_style : gdkCapStyle; join_style : gdkJoinStyle; } val get_values : gc -> values end module Pixmap : sig val cast : 'a obj -> pixmap val destroy : [> `gdkpixmap] obj -> unit val create : ?window:window -> width:int -> height:int -> ?depth:int -> unit -> pixmap val create_from_data : ?window:window -> width:int -> height:int -> ?depth:int -> fg:color -> bg:color -> string -> pixmap val create_from_xpm : ?window:window -> ?colormap:colormap -> ?transparent:color -> file:string -> unit -> pixmap * bitmap val create_from_xpm_d : ?window:window -> ?colormap:colormap -> ?transparent:color -> data:string array -> unit -> pixmap * bitmap end module Bitmap : sig val cast : 'a obj -> bitmap val create : ?window:window -> width:int -> height:int -> unit -> bitmap val create_from_data : ?window:window -> width:int -> height:int -> string -> bitmap end module Font : sig val load : string -> font val load_fontset : string -> font val string_width : font -> string -> int val char_width : font -> char -> int val string_height : font -> string -> int val char_height : font -> char -> int val string_measure : font -> string -> int val char_measure : font -> char -> int val get_type : font -> [`FONT | `FONTSET] val ascent : font -> int val descent : font -> int end module Draw : sig val point : [>`drawable] obj -> gc -> x:int -> y:int -> unit val line : [>`drawable] obj -> gc -> x:int -> y:int -> x:int -> y:int -> unit val rectangle : [>`drawable] obj -> gc -> x:int -> y:int -> width:int -> height:int -> ?filled:bool -> unit -> unit val arc : [>`drawable] obj -> gc -> x:int -> y:int -> width:int -> height:int -> ?filled:bool -> ?start:float -> ?angle:float -> unit -> unit val polygon : [>`drawable] obj -> gc -> ?filled:bool ->(int * int) list -> unit val string : [>`drawable] obj -> font:font -> gc -> x:int -> y:int -> string -> unit val layout : [>`drawable] obj -> gc -> x: int -> y: int -> Pango.layout -> ?fore:color -> ?back:color -> unit val image : [>`drawable] obj -> gc -> ?xsrc:int -> ?ysrc:int -> ?xdest:int -> ?ydest:int -> ?width:int -> ?height:int -> image -> unit val pixmap : [>`drawable] obj -> gc -> ?xsrc:int -> ?ysrc:int -> ?xdest:int -> ?ydest:int -> ?width:int -> ?height:int -> pixmap -> unit val points : [>`drawable] obj -> gc -> (int * int) list -> unit val lines : [>`drawable] obj -> gc -> (int * int) list -> unit val segments : [>`drawable] obj -> gc -> ((int * int) * (int * int)) list -> unit end module Rgb : sig val init : unit -> unit val get_visual : unit -> visual val get_cmap : unit -> colormap val draw_image : [>`drawable] obj -> gc -> width:int -> height:int -> ?x:int -> ?y:int -> ?dither:Tags.rgb_dither -> ?row_stride:int -> Gpointer.region -> unit (* [row_stride] defaults to [width*3] *) end module DnD : sig val drag_status : drag_context -> Tags.drag_action option -> time:int32 -> unit val drag_context_suggested_action : drag_context -> Tags.drag_action val drag_context_targets : drag_context -> atom list end module Truecolor : sig val color_creator : visual -> (red: int -> green: int -> blue: int -> int) (* [color_creator visual] creates a function to calculate the pixel color id for given red, green and blue component value ([0..65535]) at the client side. [visual] must have `TRUE_COLOR or `DIRECT_COLOR type. This function improves the speed of the color query of true color visual greatly. *) (* WARN: this approach is not theoretically correct for true color visual, because we need gamma correction. *) val color_parser : visual -> int -> int * int * int end module X : (* X related functions *) sig val flush : unit -> unit (* also in GtkMain *) val beep : unit -> unit end module Cursor : sig type cursor_type = [ | `X_CURSOR | `ARROW | `BASED_ARROW_DOWN | `BASED_ARROW_UP | `BOAT | `BOGOSITY | `BOTTOM_LEFT_CORNER | `BOTTOM_RIGHT_CORNER | `BOTTOM_SIDE | `BOTTOM_TEE | `BOX_SPIRAL | `CENTER_PTR | `CIRCLE | `CLOCK | `COFFEE_MUG | `CROSS | `CROSS_REVERSE | `CROSSHAIR | `DIAMOND_CROSS | `DOT | `DOTBOX | `DOUBLE_ARROW | `DRAFT_LARGE | `DRAFT_SMALL | `DRAPED_BOX | `EXCHANGE | `FLEUR | `GOBBLER | `GUMBY | `HAND1 | `HAND2 | `HEART | `ICON | `IRON_CROSS | `LEFT_PTR | `LEFT_SIDE | `LEFT_TEE | `LEFTBUTTON | `LL_ANGLE | `LR_ANGLE | `MAN | `MIDDLEBUTTON | `MOUSE | `PENCIL | `PIRATE | `PLUS | `QUESTION_ARROW | `RIGHT_PTR | `RIGHT_SIDE | `RIGHT_TEE | `RIGHTBUTTON | `RTL_LOGO | `SAILBOAT | `SB_DOWN_ARROW | `SB_H_DOUBLE_ARROW | `SB_LEFT_ARROW | `SB_RIGHT_ARROW | `SB_UP_ARROW | `SB_V_DOUBLE_ARROW | `SHUTTLE | `SIZING | `SPIDER | `SPRAYCAN | `STAR | `TARGET | `TCROSS | `TOP_LEFT_ARROW | `TOP_LEFT_CORNER | `TOP_RIGHT_CORNER | `TOP_SIDE | `TOP_TEE | `TREK | `UL_ANGLE | `UMBRELLA | `UR_ANGLE | `WATCH | `XTERM ] val create : cursor_type -> cursor val create_from_pixmap : pixmap -> mask:bitmap -> fg:color -> bg:color -> x:int -> y:int -> cursor val create_from_pixbuf : [`pixbuf] Gobject.obj -> x:int -> y:int -> cursor (** @since GTK 2.4 *) val get_image : cursor -> [`pixbuf] obj (** @since GTK 2.8 *) (* val destroy : cursor -> unit -- done by GC *) end module Display : sig (** @since Gtk+-2.2 *) val default : unit -> display val window_at_pointer : ?display:display -> unit -> (window * int * int) option end module Windowing : sig val platform : [`QUARTZ | `WIN32 | `X11] end lablgtk-2.18.8/src/gdkprivate-win32.h0000644000175000017500000003532313460263323016332 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* GDK - The GIMP Drawing Kit * Copyright (C) 1995-1997 Peter Mattis, Spencer Kimball and Josh MacDonald * Copyright (C) 1998-2002 Tor Lillqvist * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Library General Public * License as published by the Free Software Foundation; either * version 2 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Library General Public License for more details. * * You should have received a copy of the GNU Library General Public * License along with this library; if not, write to the * Free Software Foundation, Inc., 59 Temple Place - Suite 330, * Boston, MA 02111-1307, USA. */ /* * Modified by the GTK+ Team and others 1997-1999. See the AUTHORS * file for a list of people on the GTK+ Team. See the ChangeLog * files for a list of changes. These files are distributed with * GTK+ at ftp://ftp.gtk.org/pub/gtk/. */ #ifndef __GDK_PRIVATE_WIN32_H__ #define __GDK_PRIVATE_WIN32_H__ #ifndef STRICT #define STRICT /* We want strict type checks */ #endif #include #include /* Make up for mingw32 header lossage */ /* PS_JOIN_MASK is missing from the mingw32 headers */ #ifndef PS_JOIN_MASK #define PS_JOIN_MASK (PS_JOIN_BEVEL|PS_JOIN_MITER|PS_JOIN_ROUND) #endif /* CLR_INVALID is missing */ #ifndef CLR_INVALID #define CLR_INVALID CLR_NONE #endif /* Some charsets are missing */ #ifndef JOHAB_CHARSET #define JOHAB_CHARSET 130 #endif #ifndef VIETNAMESE_CHARSET #define VIETNAMESE_CHARSET 163 #endif #ifndef FS_VIETNAMESE #define FS_VIETNAMESE 0x100 #endif #ifndef VM_OEM_PLUS #define VK_OEM_PLUS 0xBB #endif #ifndef VK_OEM_COMMA #define VK_OEM_COMMA 0xBC #endif #ifndef VK_OEM_MINUS #define VK_OEM_MINUS 0xBD #endif #ifndef VK_OEM_PERIOD #define VK_OEM_PERIOD 0xBE #endif #ifndef VK_OEM_1 #define VK_OEM_1 0xBA #endif #ifndef VK_OEM_2 #define VK_OEM_2 0xBF #endif #ifndef VK_OEM_3 #define VK_OEM_3 0xC0 #endif #ifndef VK_OEM_4 #define VK_OEM_4 0xDB #endif #ifndef VK_OEM_5 #define VK_OEM_5 0xDC #endif #ifndef VK_OEM_6 #define VK_OEM_6 0xDD #endif #ifndef VK_OEM_7 #define VK_OEM_7 0xDE #endif #ifndef VK_OEM_8 #define VK_OEM_8 0xDF #endif /* Missing messages */ #ifndef WM_SYNCPAINT #define WM_SYNCPAINT 0x88 #endif #ifndef WM_MOUSEWHEEL #define WM_MOUSEWHEEL 0X20A #endif #ifndef WM_GETOBJECT #define WM_GETOBJECT 0x003D #endif #ifndef WM_NCXBUTTONDOWN #define WM_NCXBUTTONDOWN 0x00AB #endif #ifndef WM_NCXBUTTONUP #define WM_NCXBUTTONUP 0x00AC #endif #ifndef WM_NCXBUTTONDBLCLK #define WM_NCXBUTTONDBLCLK 0x00AD #endif #ifndef WM_MENURBUTTONUP #define WM_MENURBUTTONUP 0x0122 #endif #ifndef WM_MENUDRAG #define WM_MENUDRAG 0x0123 #endif #ifndef WM_MENUGETOBJECT #define WM_MENUGETOBJECT 0x0124 #endif #ifndef WM_UNINITMENUPOPUP #define WM_UNINITMENUPOPUP 0x0125 #endif #ifndef WM_MENUCOMMAND #define WM_MENUCOMMAND 0x0126 #endif #ifndef WM_CHANGEUISTATE #define WM_CHANGEUISTATE 0x0127 #endif #ifndef WM_UPDATEUISTATE #define WM_UPDATEUISTATE 0x0128 #endif #ifndef WM_QUERYUISTATE #define WM_QUERYUISTATE 0x0129 #endif #ifndef WM_XBUTTONDOWN #define WM_XBUTTONDOWN 0x020B #endif #ifndef WM_XBUTTONUP #define WM_XBUTTONUP 0x020C #endif #ifndef WM_XBUTTONDBLCLK #define WM_XBUTTONDBLCLK 0x020D #endif #ifndef WM_IME_REQUEST #define WM_IME_REQUEST 0x0288 #endif #ifndef WM_MOUSEHOVER #define WM_MOUSEHOVER 0x02A1 #endif #ifndef WM_MOUSELEAVE #define WM_MOUSELEAVE 0x02A3 #endif #ifndef WM_NCMOUSEHOVER #define WM_NCMOUSEHOVER 0x02A0 #endif #ifndef WM_NCMOUSELEAVE #define WM_NCMOUSELEAVE 0x02A2 #endif #ifndef WM_APPCOMMAND #define WM_APPCOMMAND 0x0319 #endif #ifndef WM_HANDHELDFIRST #define WM_HANDHELDFIRST 0x0358 #endif #ifndef WM_HANDHELDLAST #define WM_HANDHELDLAST 0x035F #endif #ifndef WM_AFXFIRST #define WM_AFXFIRST 0x0360 #endif #ifndef WM_AFXLAST #define WM_AFXLAST 0x037F #endif #ifndef CopyCursor #define CopyCursor(pcur) ((HCURSOR)CopyIcon((HICON)(pcur))) #endif #include #include #include #include #include #include #include #include #include #include #ifdef __cplusplus extern "C" { #endif /* __cplusplus */ /* Define some of the X11 constants also here, just for laziness */ /* Error codes */ #define Success 0 /* Grabbing status */ #define GrabSuccess 0 #define AlreadyGrabbed 2 typedef struct _GdkGCWin32Data GdkGCWin32Data; typedef struct _GdkDrawableWin32Data GdkDrawableWin32Data; typedef struct _GdkWindowWin32Data GdkWindowWin32Data; typedef struct _GdkColormapPrivateWin32 GdkColormapPrivateWin32; typedef struct _GdkCursorPrivate GdkCursorPrivate; typedef struct _GdkWin32SingleFont GdkWin32SingleFont; typedef struct _GdkFontPrivateWin32 GdkFontPrivateWin32; typedef struct _GdkImagePrivateWin32 GdkImagePrivateWin32; typedef struct _GdkVisualPrivate GdkVisualPrivate; typedef struct _GdkRegionPrivate GdkRegionPrivate; typedef struct _GdkICPrivate GdkICPrivate; #define GDK_DRAWABLE_WIN32DATA(win) ((GdkDrawableWin32Data *)(((GdkDrawablePrivate*)(win))->klass_data)) #define GDK_WINDOW_WIN32DATA(win) ((GdkWindowWin32Data *)(((GdkDrawablePrivate*)(win))->klass_data)) #define GDK_GC_WIN32DATA(gc) ((GdkGCWin32Data *)(((GdkGCPrivate*)(gc))->klass_data)) struct _GdkGCWin32Data { /* A Windows Device Context (DC) is not equivalent to an X11 * GC. We can use a DC only in the window for which it was * allocated, or (in the case of a memory DC) with the bitmap that * has been selected into it. Thus, we have to release and * reallocate a DC each time the GdkGC is used to paint into a new * window or pixmap. We thus keep all the necessary values in the * GdkGCWin32Data struct. */ HDC xgc; GdkGCValuesMask values_mask; gulong foreground; /* Pixel values from GdkColor, */ gulong background; /* not Win32 COLORREFs */ GdkFont *font; gint rop2; GdkFill fill_style; GdkPixmap *tile; GdkPixmap *stipple; HRGN clip_region; GdkSubwindowMode subwindow_mode; gint ts_x_origin; gint ts_y_origin; gint clip_x_origin; gint clip_y_origin; gint graphics_exposures; gint pen_width; DWORD pen_style; HANDLE hwnd; /* If a DC is allocated, for which window * or what bitmap is selected into it */ HPALETTE holdpal; }; struct _GdkDrawableWin32Data { HANDLE xid; GdkImage *image; /* For GdkPixmaps, a pointer to the GdkImage * containing the pixels. */ }; struct _GdkWindowWin32Data { GdkDrawableWin32Data drawable; DWORD owner_thread_id; /* We must keep the event mask here to filter them ourselves */ gint event_mask; /* Values for bg_type */ #define GDK_WIN32_BG_NORMAL 0 #define GDK_WIN32_BG_PIXEL 1 #define GDK_WIN32_BG_PIXMAP 2 #define GDK_WIN32_BG_PARENT_RELATIVE 3 #define GDK_WIN32_BG_TRANSPARENT 4 /* We draw the background ourselves at WM_ERASEBKGND */ guchar bg_type; gulong bg_pixel; /* GdkColor pixel, not COLORREF */ GdkPixmap *bg_pixmap; HCURSOR xcursor; /* Window size hints */ gint hint_flags; gint hint_x, hint_y; gint hint_min_width, hint_min_height; gint hint_max_width, hint_max_height; gboolean extension_events_selected; HKL input_locale; CHARSETINFO charset_info; }; struct _GdkCursorPrivate { GdkCursor cursor; HCURSOR xcursor; }; struct _GdkWin32SingleFont { HFONT xfont; UINT charset; UINT codepage; FONTSIGNATURE fs; GdkFont* font_set; }; struct _GdkFontPrivateWin32 { GdkFontPrivate base; GSList *fonts; /* List of GdkWin32SingleFonts */ GSList *names; }; struct _GdkVisualPrivate { GdkVisual visual; }; typedef enum { GDK_WIN32_PE_STATIC, GDK_WIN32_PE_AVAILABLE, GDK_WIN32_PE_INUSE } GdkWin32PalEntryState; struct _GdkColormapPrivateWin32 { GdkColormapPrivate base; HPALETTE hpal; gint current_size; /* Current size of hpal */ GdkWin32PalEntryState *use; gint private_val; GHashTable *hash; GdkColorInfo *info; }; struct _GdkImagePrivateWin32 { GdkImagePrivate base; GdkDrawable *pixmap; }; struct _GdkRegionPrivate { GdkRegion region; HRGN xregion; }; void gdk_win32_selection_init (void); void gdk_win32_dnd_exit (void); void gdk_xid_table_insert (HANDLE *hnd, gpointer data); void gdk_xid_table_remove (HANDLE xid); gpointer gdk_xid_table_lookup (HANDLE xid); GdkGC * _gdk_win32_gc_new (GdkDrawable *drawable, GdkGCValues *values, GdkGCValuesMask values_mask); COLORREF gdk_win32_colormap_color_pack (GdkColormapPrivateWin32 *colormap_private, gulong pixel); void gdk_win32_colormap_color_unpack (GdkColormapPrivateWin32 *colormap_private, COLORREF color, GdkColor *result); HDC gdk_gc_predraw (GdkDrawable *drawable, GdkGCPrivate *gc_private, GdkGCValuesMask usage); void gdk_gc_postdraw (GdkDrawable *drawable, GdkGCPrivate *gc_private, GdkGCValuesMask usage); void gdk_win32_clear_hdc_cache (void); void gdk_win32_clear_hdc_cache_for_hwnd (HWND hwnd); GdkPixmap* gdk_win32_pixmap_new (GdkWindow *window, GdkVisual *visual, gint width, gint height, gint depth); void gdk_win32_blit (gboolean use_fg_bg, GdkDrawable *drawable, GdkGC *gc, GdkPixmap *src, gint xsrc, gint ysrc, gint xdest, gint ydest, gint width, gint height); GdkImagePrivateWin32 *gdk_win32_image_alloc (void); HRGN gdk_win32_bitmap_to_region (GdkPixmap *pixmap); void gdk_win32_dropfiles_store(gchar *data); void gdk_selection_property_delete (GdkWindow *); gint gdk_nmbstowcs (GdkWChar *dest, const gchar *src, gint src_len, gint dest_max); gint gdk_nmbstowchar_ts (wchar_t *dest, const gchar *src, gint src_len, gint dest_max); gchar *gdk_nwchar_ts_to_mbs (const wchar_t *src, gint src_len); void gdk_wchar_text_handle (GdkFont *font, const wchar_t *wcstr, int wclen, void (*handler)(GdkWin32SingleFont *, const wchar_t *, int, void *), void *arg); void gdk_win32_api_failed (const gchar *where, gint line, const gchar *api); void gdk_other_api_failed (const gchar *where, gint line, const gchar *api); void gdk_win32_gdi_failed (const gchar *where, gint line, const gchar *api); #ifdef __GNUC__ #define WIN32_API_FAILED(api) gdk_win32_api_failed (__FILE__ ":" __PRETTY_FUNCTION__, __LINE__, api) #define WIN32_GDI_FAILED(api) gdk_win32_gdi_failed (__FILE__ ":" __PRETTY_FUNCTION__, __LINE__, api) #define OTHER_API_FAILED(api) gdk_other_api_failed (__FILE__ ":" __PRETTY_FUNCTION__, __LINE__, api) #else #define WIN32_API_FAILED(api) gdk_win32_api_failed (__FILE__, __LINE__, api) #define WIN32_GDI_FAILED(api) gdk_win32_gdi_failed (__FILE__, __LINE__, api) #define OTHER_API_FAILED(api) gdk_other_api_failed (__FILE__, __LINE__, api) #endif #ifdef G_ENABLE_DEBUG gchar *gdk_win32_color_to_string (const GdkColor *color); gchar *gdk_win32_cap_style_to_string (GdkCapStyle cap_style); gchar *gdk_win32_fill_style_to_string (GdkFill fill); gchar *gdk_win32_function_to_string (GdkFunction function); gchar *gdk_win32_join_style_to_string (GdkJoinStyle join_style); gchar *gdk_win32_line_style_to_string (GdkLineStyle line_style); gchar *gdk_win32_drawable_type_to_string (GdkDrawableType type); gchar *gdk_win32_drawable_description (GdkDrawable *d); gchar *gdk_win32_message_name (UINT msg); void gdk_win32_print_paletteentries (const PALETTEENTRY *pep, const int nentries); void gdk_win32_print_system_palette (void); void gdk_win32_print_hpalette (HPALETTE hpal); #endif extern LRESULT CALLBACK gdk_WindowProc (HWND, UINT, WPARAM, LPARAM); extern GdkDrawableClass _gdk_win32_drawable_class; extern HWND gdk_root_window; GDKVAR gchar *gdk_progclass; extern gboolean gdk_event_func_from_window_proc; extern gint gdk_max_colors; extern HDC gdk_DC; extern HINSTANCE gdk_DLLInstance; extern HINSTANCE gdk_ProgInstance; GDKVAR GdkAtom gdk_selection_property; extern GdkAtom text_uri_list_atom; extern GdkAtom compound_text_atom; extern GdkAtom gdk_clipboard_atom; extern GdkAtom gdk_win32_dropfiles_atom; extern GdkAtom gdk_ole2_dnd_atom; extern WORD cf_rtf; extern WORD cf_utf8_string; typedef enum { GDK_WIN32_DND_NONE = 0, GDK_WIN32_DND_PENDING = 1, GDK_WIN32_DND_DROPPED = 2, GDK_WIN32_DND_FAILED = 3, GDK_WIN32_DND_DRAGGING = 4, } GdkWin32DndState; extern GdkWin32DndState gdk_win32_dnd_target_state; extern GdkWin32DndState gdk_win32_dnd_source_state; extern DWORD windows_version; #define IS_WIN_NT(dwVersion) (dwVersion < 0x80000000) #ifdef __cplusplus } #endif /* __cplusplus */ #endif /* __GDK_PRIVATE_WIN32_H__ */ lablgtk-2.18.8/src/ml_gtktree.c0000644000175000017500000016205613460263323015366 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" #include "ml_gtktree.h" /* Forward declaration */ GType custom_model_get_type (void); /* Init all */ CAMLprim value ml_gtktree_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_tree_view_get_type() + gtk_tree_view_column_get_type() + gtk_tree_store_get_type() + gtk_cell_renderer_pixbuf_get_type() + gtk_cell_renderer_text_get_type() + gtk_cell_renderer_toggle_get_type () + gtk_list_store_get_type() + gtk_tree_model_sort_get_type() + gtk_tree_path_get_type() + custom_model_get_type () #ifdef HASGTK24 + gtk_tree_model_filter_get_type() #endif #ifdef HASGTK26 + gtk_cell_renderer_progress_get_type() + gtk_cell_renderer_combo_get_type() + gtk_icon_view_get_type() #endif #ifdef HASGTK210 + gtk_cell_renderer_accel_get_type () #endif ; return Val_GType(t); } /* gtktreemodel.h */ /* "Lighter" version: allocate in the ocaml heap */ CAMLprim value ml_gtk_tree_iter_copy (value it) { /* Only valid if in old generation and compaction off */ return Val_GtkTreeIter(GtkTreeIter_val(it)); } CAMLprim value ml_alloc_GtkTreeIter(value v) { return alloc_memblock_indirected(sizeof(GtkTreeIter)); } #define GtkTreeModel_val(val) check_cast(GTK_TREE_MODEL,val) Make_Val_final_pointer_compare (GtkTreePath, Ignore, gtk_tree_path_compare, gtk_tree_path_free, 1) #define Val_GtkTreePath_copy(p) (Val_GtkTreePath(gtk_tree_path_copy(p))) #define GtkTreePath_val(val) ((GtkTreePath*)Pointer_val(val)) Make_Val_final_pointer (GtkTreeRowReference, Ignore, gtk_tree_row_reference_free, 5) #define GtkTreeRowReference_val(val) ((GtkTreeRowReference*)Pointer_val(val)) /* TreePath */ ML_0 (gtk_tree_path_new, Val_GtkTreePath) ML_1 (gtk_tree_path_new_from_string, String_val, Val_GtkTreePath) ML_1 (gtk_tree_path_to_string, GtkTreePath_val, copy_string_g_free) ML_2 (gtk_tree_path_append_index, GtkTreePath_val, Int_val, Unit) ML_2 (gtk_tree_path_prepend_index, GtkTreePath_val, Int_val, Unit) ML_1 (gtk_tree_path_get_depth, GtkTreePath_val, Val_int) CAMLprim value ml_gtk_tree_path_get_indices(value p) { gint *indices = gtk_tree_path_get_indices(GtkTreePath_val(p)); gint i, depth = gtk_tree_path_get_depth(GtkTreePath_val(p)); value ret = alloc_tuple(depth); for (i = 0; i < depth; i++) Field(ret,i) = Val_int(indices[i]); return ret; } ML_1 (gtk_tree_path_copy, GtkTreePath_val, Val_GtkTreePath) ML_1 (gtk_tree_path_next, GtkTreePath_val, Unit) ML_1 (gtk_tree_path_prev, GtkTreePath_val, Val_bool) ML_1 (gtk_tree_path_up, GtkTreePath_val, Val_bool) ML_1 (gtk_tree_path_down, GtkTreePath_val, Unit) ML_2 (gtk_tree_path_is_ancestor, GtkTreePath_val, GtkTreePath_val, Val_bool) /* RowReference */ ML_2 (gtk_tree_row_reference_new, GtkTreeModel_val, GtkTreePath_val, Val_GtkTreeRowReference) ML_1 (gtk_tree_row_reference_valid, GtkTreeRowReference_val, Val_bool) ML_1 (gtk_tree_row_reference_get_path, GtkTreeRowReference_val, Val_GtkTreePath) /* already copied! */ /* TreeModel */ #define Val_TreeModel_flags(f) ml_lookup_flags_getter(ml_table_tree_model_flags,f) ML_1 (gtk_tree_model_get_flags, GtkTreeModel_val, Val_TreeModel_flags) ML_1 (gtk_tree_model_get_n_columns, GtkTreeModel_val, Val_int) ML_2 (gtk_tree_model_get_column_type, GtkTreeModel_val, Int_val, Val_GType) ML_3 (gtk_tree_model_get_iter, GtkTreeModel_val, GtkTreeIter_val, GtkTreePath_val, Val_bool) ML_2 (gtk_tree_model_get_path, GtkTreeModel_val, GtkTreeIter_val, Val_GtkTreePath) ML_4 (gtk_tree_model_get_value, GtkTreeModel_val, GtkTreeIter_val, Int_val, GValue_val, Unit) ML_2 (gtk_tree_model_get_iter_first, GtkTreeModel_val, GtkTreeIter_val, Val_bool) ML_2 (gtk_tree_model_iter_next, GtkTreeModel_val, GtkTreeIter_val, Val_bool) ML_2 (gtk_tree_model_iter_has_child, GtkTreeModel_val, GtkTreeIter_val, Val_bool) ML_2 (gtk_tree_model_iter_n_children, GtkTreeModel_val, GtkTreeIter_optval, Val_int) ML_4 (gtk_tree_model_iter_nth_child, GtkTreeModel_val, GtkTreeIter_val, GtkTreeIter_optval, Int_val, Val_bool) ML_3 (gtk_tree_model_iter_parent, GtkTreeModel_val, GtkTreeIter_val, GtkTreeIter_val, Val_bool) static gboolean gtk_tree_model_foreach_func(GtkTreeModel *model, GtkTreePath *path, GtkTreeIter *iter, gpointer data) { value *closure = data; CAMLparam0(); CAMLlocal3(vpath, viter, vret); vpath = Val_GtkTreePath_copy(path); viter = Val_GtkTreeIter(iter); vret = callback2_exn(*closure, vpath, viter); if (Is_exception_result(vret)) { CAML_EXN_LOG("gtk_tree_model_foreach_func"); CAMLreturn(FALSE); } CAMLreturn(Bool_val(vret)); } CAMLprim value ml_gtk_tree_model_foreach(value m, value cb) { CAMLparam1(cb); gtk_tree_model_foreach(GtkTreeModel_val(m), gtk_tree_model_foreach_func, &cb); CAMLreturn(Val_unit); } ML_3 (gtk_tree_model_row_changed, GtkTreeModel_val, GtkTreePath_val, GtkTreeIter_val, Unit) /* gtktreestore.h */ #define GtkTreeStore_val(val) check_cast(GTK_TREE_STORE,val) CAMLprim value ml_gtk_tree_store_newv(value arr) { CAMLparam1(arr); int n_columns = Wosize_val(arr); int i; GType *types = (GType*) (n_columns ? alloc (Wosize_asize(n_columns * sizeof(GType)), Abstract_tag) : 0); for (i=0; iparent)); } ML_4 (gtk_tree_store_set_value, GtkTreeStore_val, GtkTreeIter_val, Int_val, GValue_val, Unit) #ifdef HASGTK22 ML_2 (gtk_tree_store_remove, GtkTreeStore_val, GtkTreeIter_val, Val_bool) #else ML_2 (gtk_tree_store_remove, GtkTreeStore_val, GtkTreeIter_val, Val_false Ignore) #endif ML_4 (gtk_tree_store_insert, GtkTreeStore_val, GtkTreeIter_val, Option_val(arg3,GtkTreeIter_val,NULL) Ignore, Int_val, Unit) ML_4 (gtk_tree_store_insert_before, GtkTreeStore_val, GtkTreeIter_val, Option_val(arg3,GtkTreeIter_val,NULL) Ignore, GtkTreeIter_val, Unit) ML_4 (gtk_tree_store_insert_after, GtkTreeStore_val, GtkTreeIter_val, Option_val(arg3,GtkTreeIter_val,NULL) Ignore, GtkTreeIter_val, Unit) ML_3 (gtk_tree_store_append, GtkTreeStore_val, GtkTreeIter_val, Option_val(arg3,GtkTreeIter_val,NULL) Ignore, Unit) ML_3 (gtk_tree_store_prepend, GtkTreeStore_val, GtkTreeIter_val, Option_val(arg3,GtkTreeIter_val,NULL) Ignore, Unit) ML_3 (gtk_tree_store_is_ancestor, GtkTreeStore_val, GtkTreeIter_val, GtkTreeIter_val, Val_bool) ML_2 (gtk_tree_store_iter_depth, GtkTreeStore_val, GtkTreeIter_val, Val_int) ML_1 (gtk_tree_store_clear, GtkTreeStore_val, Unit) #ifdef HASGTK22 ML_2 (gtk_tree_store_iter_is_valid, GtkTreeStore_val, GtkTreeIter_val, Val_bool) ML_3 (gtk_tree_store_swap, GtkTreeStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_3 (gtk_tree_store_move_before, GtkTreeStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_3 (gtk_tree_store_move_after, GtkTreeStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) #else Unsupported(gtk_tree_store_iter_is_valid) Unsupported(gtk_tree_store_swap) Unsupported(gtk_tree_store_move_before) Unsupported(gtk_tree_store_move_after) #endif /* GtkListStore */ #define GtkListStore_val(val) check_cast(GTK_LIST_STORE,val) CAMLprim value ml_gtk_list_store_newv(value arr) { CAMLparam1(arr); int n_columns = Wosize_val(arr); int i; GType *types = (GType*) (n_columns ? alloc (Wosize_asize(n_columns * sizeof(GType)), Abstract_tag) : 0); for (i=0; iparent)); } ML_4 (gtk_list_store_set_value, GtkListStore_val, GtkTreeIter_val, Int_val, GValue_val, Unit) #ifdef HASGTK22 ML_2 (gtk_list_store_remove, GtkListStore_val, GtkTreeIter_val, Val_bool) #else ML_2 (gtk_list_store_remove, GtkListStore_val, GtkTreeIter_val, Unit) #endif ML_3 (gtk_list_store_insert, GtkListStore_val, GtkTreeIter_val, Int_val, Unit) ML_3 (gtk_list_store_insert_before, GtkListStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_3 (gtk_list_store_insert_after, GtkListStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_2 (gtk_list_store_append, GtkListStore_val, GtkTreeIter_val, Unit) ML_2 (gtk_list_store_prepend, GtkListStore_val, GtkTreeIter_val, Unit) ML_1 (gtk_list_store_clear, GtkListStore_val, Unit) #ifdef HASGTK22 ML_2 (gtk_list_store_iter_is_valid, GtkListStore_val, GtkTreeIter_val, Val_bool) ML_3 (gtk_list_store_swap, GtkListStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_3 (gtk_list_store_move_before, GtkListStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) ML_3 (gtk_list_store_move_after, GtkListStore_val, GtkTreeIter_val, GtkTreeIter_val, Unit) #else Unsupported(gtk_list_store_iter_is_valid) Unsupported(gtk_list_store_swap) Unsupported(gtk_list_store_move_before) Unsupported(gtk_list_store_move_after) #endif /* GtkTreeSelection */ #define GtkTreeSelection_val(val) check_cast(GTK_TREE_SELECTION,val) ML_2 (gtk_tree_selection_set_mode, GtkTreeSelection_val, Selection_mode_val, Unit) ML_1 (gtk_tree_selection_get_mode, GtkTreeSelection_val, Val_selection_mode) static gboolean gtk_tree_selection_func(GtkTreeSelection *s, GtkTreeModel *m, GtkTreePath *p, gboolean cs, gpointer clos_p) { value vp = Val_GtkTreePath_copy(p); value ret = callback2_exn(*(value*)clos_p, vp, Val_bool(cs)); if (Is_exception_result(ret)) { CAML_EXN_LOG("gtk_tree_selection_func"); return TRUE; } return Bool_val(ret); } CAMLprim value ml_gtk_tree_selection_set_select_function (value s, value clos) { value *clos_p = ml_global_root_new(clos); gtk_tree_selection_set_select_function (GtkTreeSelection_val(s), gtk_tree_selection_func, clos_p, ml_global_root_destroy); return Val_unit; } static void gtk_tree_selection_foreach_func(GtkTreeModel *model, GtkTreePath *path, GtkTreeIter *iter, gpointer data) { value p = Val_GtkTreePath_copy(path); value ret = callback_exn(*(value*)data, p); if (Is_exception_result(ret)) CAML_EXN_LOG("gtk_tree_selection_foreach_func"); } CAMLprim value ml_gtk_tree_selection_selected_foreach (value s, value clos) { CAMLparam1(clos); gtk_tree_selection_selected_foreach(GtkTreeSelection_val(s), gtk_tree_selection_foreach_func, &clos); CAMLreturn(Val_unit); } #ifdef HASGTK22 ML_1 (gtk_tree_selection_count_selected_rows, GtkTreeSelection_val, Val_int) #else Unsupported(gtk_tree_selection_count_selected_rows) #endif ML_2 (gtk_tree_selection_select_path, GtkTreeSelection_val, GtkTreePath_val, Unit) ML_2 (gtk_tree_selection_unselect_path, GtkTreeSelection_val, GtkTreePath_val, Unit) ML_2 (gtk_tree_selection_select_iter, GtkTreeSelection_val, GtkTreeIter_val, Unit) ML_2 (gtk_tree_selection_unselect_iter, GtkTreeSelection_val, GtkTreeIter_val, Unit) ML_2 (gtk_tree_selection_path_is_selected, GtkTreeSelection_val, GtkTreePath_val, Val_bool) ML_2 (gtk_tree_selection_iter_is_selected, GtkTreeSelection_val, GtkTreeIter_val, Val_bool) ML_1 (gtk_tree_selection_select_all, GtkTreeSelection_val, Unit) ML_1 (gtk_tree_selection_unselect_all, GtkTreeSelection_val, Unit) ML_3 (gtk_tree_selection_select_range, GtkTreeSelection_val, GtkTreePath_val, GtkTreePath_val, Unit) #ifdef HASGTK22 ML_3 (gtk_tree_selection_unselect_range, GtkTreeSelection_val, GtkTreePath_val, GtkTreePath_val, Unit) #else Unsupported(gtk_tree_selection_unselect_range) #endif /* GtkCellRenderer{Text,...} */ #define GtkCellRenderer_val(val) check_cast(GTK_CELL_RENDERER,val) #define GtkCellRendererText_val(val) check_cast(GTK_CELL_RENDERER_TEXT,val) ML_0 (gtk_cell_renderer_pixbuf_new, Val_GtkAny_sink) ML_0 (gtk_cell_renderer_text_new, Val_GtkAny_sink) ML_2 (gtk_cell_renderer_text_set_fixed_height_from_font, GtkCellRendererText_val, Int_val, Unit) ML_0 (gtk_cell_renderer_toggle_new, Val_GtkAny_sink) /* GtkTreeViewColumn */ #define GtkTreeViewColumn_val(val) check_cast(GTK_TREE_VIEW_COLUMN,val) ML_0 (gtk_tree_view_column_new, Val_GtkWidget_sink) ML_1 (gtk_tree_view_column_clear, GtkTreeViewColumn_val, Unit) ML_3 (gtk_tree_view_column_pack_start, GtkTreeViewColumn_val, GtkCellRenderer_val, Int_val, Unit) ML_3 (gtk_tree_view_column_pack_end, GtkTreeViewColumn_val, GtkCellRenderer_val, Int_val, Unit) ML_2 (gtk_tree_view_column_clear_attributes, GtkTreeViewColumn_val, GtkCellRenderer_val, Unit) ML_4 (gtk_tree_view_column_add_attribute, GtkTreeViewColumn_val, GtkCellRenderer_val, String_val, Int_val, Unit) ML_2 (gtk_tree_view_column_set_sort_column_id, GtkTreeViewColumn_val, Int_val, Unit) ML_1 (gtk_tree_view_column_get_sort_column_id, GtkTreeViewColumn_val, Val_int) static void gtk_tree_cell_data_func(GtkTreeViewColumn *tree_column, GtkCellRenderer *cell, GtkTreeModel *tree_model, GtkTreeIter *iter, gpointer data) { value *closure = data; CAMLparam0(); CAMLlocal3(vmod,vit,ret); vmod = Val_GAnyObject(tree_model); vit = Val_GtkTreeIter(iter); ret = callback2_exn(*closure, vmod, vit); if (Is_exception_result(ret)) CAML_EXN_LOG_VERBOSE("gtk_tree_cell_data_func",ret); CAMLreturn0; } CAMLprim value ml_gtk_tree_view_column_set_cell_data_func(value vcol, value cr, value cb) { value *glob_root = NULL; if (Is_block(cb)) glob_root = ml_global_root_new(Field(cb, 0)); gtk_tree_view_column_set_cell_data_func (GtkTreeViewColumn_val(vcol), GtkCellRenderer_val(cr), (Is_block(cb) ? gtk_tree_cell_data_func : NULL), glob_root, ml_global_root_destroy); return Val_unit; } CAMLprim value ml_gtk_tree_view_column_get_button (value vcol) { return (Val_GtkWidget(GtkTreeViewColumn_val(vcol)->button)); } /* GtkTreeView */ #define GtkTreeView_val(val) check_cast(GTK_TREE_VIEW,val) ML_0 (gtk_tree_view_new, Val_GtkWidget_sink) ML_1 (gtk_tree_view_new_with_model, GtkTreeModel_val, Val_GtkWidget_sink) ML_1 (gtk_tree_view_get_selection, GtkTreeView_val, Val_GtkWidget) ML_1 (gtk_tree_view_columns_autosize, GtkTreeView_val, Unit) ML_2 (gtk_tree_view_append_column, GtkTreeView_val, GtkTreeViewColumn_val, Val_int) ML_2 (gtk_tree_view_remove_column, GtkTreeView_val, GtkTreeViewColumn_val, Val_int) ML_3 (gtk_tree_view_insert_column, GtkTreeView_val, GtkTreeViewColumn_val, Int_val, Val_int) ML_2 (gtk_tree_view_get_column, GtkTreeView_val, Int_val, Val_GtkWidget) ML_3 (gtk_tree_view_move_column_after, GtkTreeView_val, GtkTreeViewColumn_val, GtkTreeViewColumn_val, Unit) ML_3 (gtk_tree_view_scroll_to_point, GtkTreeView_val, Int_val, Int_val, Unit) ML_4 (gtk_tree_view_scroll_to_cell, GtkTreeView_val, GtkTreePath_val, GtkTreeViewColumn_val, Insert(Bool_val(arg4)) Insert(Bool_val(arg4) ? Float_val(Field(Field(arg4,0),0)) : 0) (Bool_val(arg4) ? Float_val(Field(Field(arg4,0),1)) : 0) Ignore, Unit) ML_3 (gtk_tree_view_row_activated, GtkTreeView_val, GtkTreePath_val, GtkTreeViewColumn_val, Unit) ML_1 (gtk_tree_view_expand_all, GtkTreeView_val, Unit) ML_1 (gtk_tree_view_collapse_all, GtkTreeView_val, Unit) ML_3 (gtk_tree_view_expand_row, GtkTreeView_val, GtkTreePath_val, Bool_val, Unit) #ifdef HASGTK22 ML_2 (gtk_tree_view_expand_to_path, GtkTreeView_val, GtkTreePath_val, Unit) #else Unsupported(gtk_tree_view_expand_to_path) #endif ML_2 (gtk_tree_view_collapse_row, GtkTreeView_val, GtkTreePath_val, Unit) ML_2 (gtk_tree_view_row_expanded, GtkTreeView_val, GtkTreePath_val, Val_bool) ML_4 (gtk_tree_view_set_cursor, GtkTreeView_val, GtkTreePath_val, GtkTreeViewColumn_val, Bool_val, Unit) #ifdef HASGTK22 ML_5 (gtk_tree_view_set_cursor_on_cell, GtkTreeView_val, GtkTreePath_val, GtkTreeViewColumn_val, GtkCellRenderer_val, Bool_val, Unit) #else Unsupported(gtk_tree_view_set_cursor_on_cell) #endif CAMLprim value ml_gtk_tree_view_get_cursor (value arg) { CAMLparam0(); CAMLlocal1(ret); GtkTreePath *path; GtkTreeViewColumn *col; gtk_tree_view_get_cursor(GtkTreeView_val(arg), &path, &col); ret = alloc_tuple(2); Store_field(ret,0,Val_option(path,Val_GtkTreePath)); Store_field(ret,1,Val_option(col,Val_GtkWidget)); CAMLreturn(ret); } CAMLprim value ml_gtk_tree_view_get_path_at_pos(value treeview, value x, value y) { gint cell_x; gint cell_y; GtkTreePath *gpath; GtkTreeViewColumn *gcolumn; if (gtk_tree_view_get_path_at_pos( GtkTreeView_val(treeview), Int_val(x), Int_val(y), &gpath, &gcolumn, &cell_x, &cell_y)) { /* return Some */ CAMLparam0 (); CAMLlocal1(tup); tup = alloc_tuple(4); Store_field(tup,0,Val_GtkTreePath(gpath)); Store_field(tup,1,Val_GtkAny(gcolumn)); Store_field(tup,2,Val_int(cell_x)); Store_field(tup,3,Val_int(cell_y)); CAMLreturn(ml_some (tup)); } return Val_unit; } CAMLprim value ml_gtk_tree_view_get_cell_area(value treeview, value path, value col) { CAMLparam0 (); GdkRectangle grect; gtk_tree_view_get_cell_area( GtkTreeView_val(treeview), Option_val(path,GtkTreePath_val,NULL), Option_val(col,GtkTreeViewColumn_val,NULL), &grect); CAMLreturn (Val_copy (grect)); } CAMLprim value ml_gtk_tree_view_enable_model_drag_dest (value tv, value t, value a) { CAMLparam3 (tv,t,a); GtkTargetEntry *targets = NULL; int i, n_targets = Wosize_val(t); if (n_targets) targets = (GtkTargetEntry *) alloc ( Wosize_asize(n_targets * sizeof(GtkTargetEntry)) , Abstract_tag ); for (i=0; idata; path = Val_GtkTreePath(p); cell = alloc_small(2, Tag_cons); Field(cell, 0) = path; Field(cell, 1) = list; list = cell; l=l->prev; } g_list_free(head); CAMLreturn(list); } ML_1 (gtk_icon_view_select_all, GtkIconView_val, Unit) ML_1 (gtk_icon_view_unselect_all, GtkIconView_val, Unit) ML_2 (gtk_icon_view_item_activated, GtkIconView_val, GtkTreePath_val, Unit) #else Unsupported_26(gtk_icon_view_get_path_at_pos) Unsupported_26(gtk_icon_view_selected_foreach) Unsupported_26(gtk_icon_view_select_path) Unsupported_26(gtk_icon_view_unselect_path) Unsupported_26(gtk_icon_view_path_is_selected) Unsupported_26(gtk_icon_view_get_selected_items) Unsupported_26(gtk_icon_view_select_all) Unsupported_26(gtk_icon_view_unselect_all) Unsupported_26(gtk_icon_view_item_activated) #endif /* HASGTK26 */ /* Custom models: this code is inspired by the code of Robert Schneck */ extern void caml_minor_collection(void); #if 0 /* Debugging code */ char *buf1; char buf2[1000]; #define USER_DATA(iter) (iter?(long)((iter)->user_data):0) #define USER_DATA2(iter) (iter?(long)((iter)->user_data2):0) #define USER_DATA3(iter) (iter?(long)((iter)->user_data3):0) #define PRINT4(iter) iter,USER_DATA(iter),USER_DATA2(iter),USER_DATA3(iter) #define PRINT4_VALID(iter) iter, (long)(iter)->user_data, (long)(iter)->user_data2, (long)(iter)->user_data3 #define PATH_STRING(path) (buf1 = (path) ? gtk_tree_path_to_string(path) : "[]", strcpy(buf2,buf1), (path) ? g_free(buf1) : 0, buf2) #define debug_print printf #else #define debug_print(...) #endif value callback4(value closure, value arg1, value arg2, value arg3, value arg4) { value arg[4]; arg[0] = arg1; arg[1] = arg2; arg[2] = arg3; arg[3] = arg4; return callbackN(closure, 4, arg); } #define ACCESS_PUBLIC_METHOD(method,object, name, block) \ {static value method_hash = 0; \ if (method_hash==0) method_hash = caml_hash_variant(name); \ {value method = caml_get_public_method(object,method_hash); \ if ((void*)method == NULL) \ {printf("Internal error: could not access method '%s'\n", name); \ exit(2);}; \ block ; }}; /***************************************************************************** * GObject stuff *****************************************************************************/ /* Some boilerplate GObject defines. 'klass' is used instead of 'class', because 'class' is a C++ keyword */ #define TYPE_CUSTOM_MODEL (custom_model_get_type ()) #define CUSTOM_MODEL(obj) (G_TYPE_CHECK_INSTANCE_CAST ((obj), TYPE_CUSTOM_MODEL, Custom_model)) #define CUSTOM_MODEL_CLASS(klass) (G_TYPE_CHECK_CLASS_CAST ((klass), TYPE_CUSTOM_MODEL, Custom_model_class)) #define IS_CUSTOM_MODEL(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), TYPE_CUSTOM_MODEL)) #define IS_CUSTOM_MODEL_CLASS(klass) (G_TYPE_CHECK_CLASS_TYPE ((klass), TYPE_CUSTOM_MODEL)) #define CUSTOM_MODEL_GET_CLASS(obj) (G_TYPE_INSTANCE_GET_CLASS ((obj), TYPE_CUSTOM_MODEL, Custom_model_class)) static GObjectClass *parent_class = NULL; /* GObject stuff - nothing to worry about */ typedef struct _Custom_model Custom_model; typedef struct _Custom_model_class Custom_model_class; struct _Custom_model { GObject parent; /* this MUST be the first member */ gint stamp; value callback_object; }; /* Custom_model_class: more boilerplate GObject stuff */ struct _Custom_model_class { GObjectClass parent_class; }; /* boring declarations of local functions */ /* GObject stuff */ static void custom_model_init (Custom_model *pkg_tree); static void custom_model_class_init (Custom_model_class *klass); static void custom_model_tree_model_init (GtkTreeModelIface *iface); static void custom_model_finalize (GObject *object); /* tree model stuff */ static GtkTreeModelFlags custom_model_get_flags (GtkTreeModel *tree_model); static gint custom_model_get_n_columns (GtkTreeModel *tree_model); static GType custom_model_get_column_type (GtkTreeModel *tree_model, gint index); static gboolean custom_model_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreePath *path); static GtkTreePath *custom_model_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter); static void custom_model_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, gint column, GValue *value); static gboolean custom_model_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter); static gboolean custom_model_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent); static gboolean custom_model_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter); static gint custom_model_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter); static gboolean custom_model_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent, gint n); static gboolean custom_model_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *child); static void custom_model_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter); static void custom_model_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter); GType custom_model_get_type (void) { /* Some boilerplate type registration stuff */ static GType custom_model_type = 0; if (!custom_model_type) { static const GTypeInfo custom_model_info = { sizeof (Custom_model_class), NULL, /* base_init */ NULL, /* base_finalize */ (GClassInitFunc) custom_model_class_init, NULL, /* class finalize */ NULL, /* class_data */ sizeof (Custom_model), 0, /* n_preallocs */ (GInstanceInitFunc) custom_model_init }; static const GInterfaceInfo tree_model_info = { (GInterfaceInitFunc) custom_model_tree_model_init, NULL, NULL }; custom_model_type = g_type_register_static (G_TYPE_OBJECT, "Custom_model", &custom_model_info, (GTypeFlags)0); /* Here we register our GtkTreeModel interface with the type system */ g_type_add_interface_static (custom_model_type, GTK_TYPE_TREE_MODEL, &tree_model_info); } return custom_model_type; } /* more boilerplate GObject stuff */ static void custom_model_class_init (Custom_model_class *klass) { GObjectClass *object_class; parent_class = (GObjectClass*) g_type_class_peek_parent (klass); object_class = (GObjectClass*) klass; object_class->finalize = custom_model_finalize; } static void custom_model_tree_model_init (GtkTreeModelIface *iface) { iface->get_flags = custom_model_get_flags; iface->get_n_columns = custom_model_get_n_columns; iface->get_column_type = custom_model_get_column_type; iface->get_iter = custom_model_get_iter; iface->get_path = custom_model_get_path; iface->get_value = custom_model_get_value; iface->iter_next = custom_model_iter_next; iface->iter_children = custom_model_iter_children; iface->iter_has_child = custom_model_iter_has_child; iface->iter_n_children = custom_model_iter_n_children; iface->iter_nth_child = custom_model_iter_nth_child; iface->iter_parent = custom_model_iter_parent; iface->ref_node = custom_model_ref_node; iface->unref_node = custom_model_unref_node; } /* called every time a new custom model object is created */ static void custom_model_init (Custom_model *custom_model) { debug_print("custom_model_init %p\n",custom_model); do { custom_model->stamp = g_random_int (); } while (custom_model->stamp == 0); } /* called just before a custom model object is destroyed */ static void custom_model_finalize (GObject *object) { /* must chain up - finalize parent */ (* parent_class->finalize) (object); } /***************************************************************************** * Tree Model interface stuff *****************************************************************************/ #define UNWRAP_OPTION(id,expr,block) \ {value id##_aux = expr; \ value id = Option_val(id##_aux,/* blank */,0); \ block } #define decode_iter_option(custom_model,iter) \ (iter ? ml_some(decode_iter(custom_model,iter)) : Val_unit) void encode_iter(Custom_model *custom_model, GtkTreeIter *iter, value v) { debug_print("encode_iter %p %p %p\n",custom_model,iter,(void*)v); g_return_if_fail (IS_CUSTOM_MODEL (custom_model)); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_encode_iter", { value triple = callback2(method,callback_object,v); value v1 = Field(triple,0); value v2 = Field(triple,1); value v3 = Field(triple,2); /* Ideally, the user would already have ensured all these were stable... and in any case, it is always up to the user to ensure that they will not get garbage collected */ if((Is_block(v1) && (char*)v1 < (char*)caml_young_end && (char*)v1 > (char*)caml_young_start) || (Is_block(v2) && (char*)v2 < (char*)caml_young_end && (char*)v2 > (char*)caml_young_start) || (Is_block(v3) && (char*)v3 < (char*)caml_young_end && (char*)v3 > (char*)caml_young_start)) { caml_register_global_root (&v1); caml_register_global_root (&v2); caml_register_global_root (&v3); caml_minor_collection(); caml_remove_global_root (&v1); caml_remove_global_root (&v2); caml_remove_global_root (&v3); } iter->stamp = custom_model->stamp; iter->user_data = (gpointer) v1; iter->user_data2 = (gpointer) v2; iter->user_data3 = (gpointer) v3; }) } } value decode_iter(Custom_model *custom_model, GtkTreeIter *iter) { debug_print("decode_iter %p %p:%ld:%ld:%ld\n",custom_model,PRINT4(iter)); g_return_val_if_fail (IS_CUSTOM_MODEL (custom_model), 0); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object, "custom_decode_iter", return callback4(method,callback_object, (value)iter->user_data, (value)iter->user_data2, (value)iter->user_data3);) } } static GtkTreeModelFlags custom_model_get_flags (GtkTreeModel *tree_model) { debug_print("get_flags %p\n",tree_model); g_return_val_if_fail (IS_CUSTOM_MODEL (tree_model), 0); { Custom_model *custom_model = (Custom_model *) tree_model; value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object, "custom_flags", { value flags_list = callback(method, callback_object); GtkTreeModelFlags flags = (GtkTreeModelFlags) 0; static value iter_persist_hash=0; static value list_only_hash=0; if (iter_persist_hash==0) iter_persist_hash=caml_hash_variant("ITERS_PERSIST"); if (list_only_hash==0) list_only_hash=caml_hash_variant("LIST_ONLY"); while (flags_list != Val_int(0)) { value flag = Field(flags_list,0); flags_list = Field(flags_list,1); if (flag == iter_persist_hash) flags = flags | GTK_TREE_MODEL_ITERS_PERSIST; if (flag == list_only_hash) flags = flags | GTK_TREE_MODEL_LIST_ONLY; } return flags; }) } } static gint custom_model_get_n_columns (GtkTreeModel *tree_model) { debug_print("get_n_columns %p\n",tree_model); g_return_val_if_fail (IS_CUSTOM_MODEL (tree_model), 0); { Custom_model *custom_model = (Custom_model *) tree_model; value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_n_columns", { value n_columns = callback(method,callback_object); return Int_val(n_columns);})} } static GType custom_model_get_column_type (GtkTreeModel *tree_model, gint index) { debug_print("get_column_type %p %d\n",tree_model,index); g_return_val_if_fail (IS_CUSTOM_MODEL (tree_model), G_TYPE_INVALID); { Custom_model *custom_model = (Custom_model *) tree_model; value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_get_column_type", { value t = callback2(method,callback_object, Val_int(index)); return GType_val(t);})} } static gboolean custom_model_get_iter (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreePath *path) { debug_print("get_iter %p %p %s\n",tree_model,iter,PATH_STRING(path)); g_return_val_if_fail (iter != NULL, FALSE); g_return_val_if_fail (path != NULL, FALSE); g_return_val_if_fail (IS_CUSTOM_MODEL (tree_model), FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_get_iter", /* This copy is needed because GTK will eventually free the path; and Val_GtkTreePath creates a Caml value which frees the path upon finalization; don't want to free twice! The alternative (of avoiding both copy and finalization) means trusting the OCaml programmer not to store the path somewhere... */ { UNWRAP_OPTION(res, callback2(method, callback_object, Val_GtkTreePath(gtk_tree_path_copy(path))), if (res) { encode_iter(custom_model,iter,res); return TRUE; } else { return FALSE;) }})} } static GtkTreePath * custom_model_get_path (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("get_path %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_val_if_fail(iter != NULL, NULL); g_return_val_if_fail (IS_CUSTOM_MODEL (tree_model), NULL); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (iter->stamp == custom_model->stamp, NULL); {value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object,"custom_get_path", /* This copy is needed because Caml will eventually free the path from the callback when that Caml value is finalized; and GTK will eventually free the path we return to it. */ { value path = callback2(method,callback_object, decode_iter(custom_model,iter)); return gtk_tree_path_copy(GtkTreePath_val(path));})}} } static void custom_model_get_value (GtkTreeModel *tree_model, GtkTreeIter *iter, gint column, GValue *value_arg) { debug_print("get_value %p %p:%ld:%ld:%ld %d\n",tree_model,PRINT4(iter),column); g_return_if_fail(iter != NULL); g_return_if_fail (IS_CUSTOM_MODEL (tree_model)); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_if_fail (iter->stamp == custom_model->stamp); { value callback_object = custom_model->callback_object; value row = decode_iter(custom_model,iter); value wrap = Val_GValue_wrap(value_arg); ACCESS_PUBLIC_METHOD(method,callback_object,"custom_get_value", callback4(method,callback_object, row,Val_int(column),wrap);)}} } static gboolean custom_model_iter_next (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("iter_next %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_val_if_fail(iter != NULL, FALSE); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (iter->stamp == custom_model->stamp, FALSE); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_iter_next", { value row = decode_iter(custom_model, iter); UNWRAP_OPTION(res,callback2(method,callback_object, row), if (res) { encode_iter(custom_model,iter,res); return TRUE; } else { return FALSE; })})}} } static gboolean custom_model_iter_children (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent) { debug_print("iter_children %p %p %p:%ld:%ld:%ld\n",tree_model,iter,PRINT4(parent)); g_return_val_if_fail (iter != NULL, FALSE); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (parent == NULL || parent->stamp == custom_model->stamp, FALSE); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object,"custom_iter_children", { value arg = decode_iter_option(custom_model,parent); UNWRAP_OPTION(res, callback2(method,callback_object,arg), if (res) { encode_iter(custom_model,iter,res); return TRUE; } else { return FALSE; })})}} } static gboolean custom_model_iter_has_child (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("iter_has_child %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_val_if_fail (iter != NULL, FALSE); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (iter->stamp == custom_model->stamp, FALSE); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object,"custom_iter_has_child", { value row = decode_iter(custom_model,iter); return Bool_val(callback2(method,callback_object, row));})}} } static gint custom_model_iter_n_children (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("iter_n_children %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),0); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (iter == NULL || iter->stamp == custom_model->stamp, 0); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object, "custom_iter_n_children", { value arg = decode_iter_option(custom_model,iter); return Int_val(callback2(method,callback_object, arg));})}} } static gboolean custom_model_iter_nth_child (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *parent, gint n) { debug_print("iter_nth_child %p %p %p:%ld:%ld:%ld %d\n",tree_model,iter,PRINT4(parent),n); g_return_val_if_fail(iter != NULL, FALSE); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (parent == NULL || parent->stamp == custom_model->stamp, FALSE); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object, "custom_iter_nth_child", { value arg = decode_iter_option(custom_model,parent); UNWRAP_OPTION(res,callback3(method, callback_object, arg, Val_int(n)), if (res) { encode_iter(custom_model,iter,res); return TRUE; } else { return FALSE; })})}} } static gboolean custom_model_iter_parent (GtkTreeModel *tree_model, GtkTreeIter *iter, GtkTreeIter *child) { debug_print("iter_parent %p %p %p:%ld:%ld:%ld\n",tree_model,iter,PRINT4(child)); g_return_val_if_fail(iter != NULL, FALSE); g_return_val_if_fail(IS_CUSTOM_MODEL (tree_model),FALSE); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_val_if_fail (child != NULL, FALSE); g_return_val_if_fail (child->stamp == custom_model->stamp, FALSE); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method,callback_object, "custom_iter_parent", { value row = decode_iter(custom_model,child); UNWRAP_OPTION(res,callback2(method,callback_object,row), if (res) { encode_iter(custom_model,iter,res); return TRUE; } else { return FALSE; })})}} } static void custom_model_ref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("ref_node %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_if_fail(iter != NULL); g_return_if_fail (IS_CUSTOM_MODEL (tree_model)); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_if_fail (iter->stamp == custom_model->stamp); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object, "custom_ref_node", { value row = decode_iter(custom_model,iter); callback2(method, callback_object, row);})}} } static void custom_model_unref_node (GtkTreeModel *tree_model, GtkTreeIter *iter) { debug_print("unref_node %p %p:%ld:%ld:%ld\n",tree_model,PRINT4(iter)); g_return_if_fail(iter != NULL); g_return_if_fail (IS_CUSTOM_MODEL (tree_model)); { Custom_model *custom_model = (Custom_model *) tree_model; g_return_if_fail (iter->stamp == custom_model->stamp); { value callback_object = custom_model->callback_object; ACCESS_PUBLIC_METHOD(method, callback_object, "custom_unref_node", { value row = decode_iter(custom_model,iter); callback2(method, callback_object, row);})}} } /***************************************************************************** * Creating a new custom model object *****************************************************************************/ Custom_model * custom_model_new (void) { Custom_model *new_custom_model; new_custom_model = (Custom_model*) g_object_new (TYPE_CUSTOM_MODEL, NULL); g_assert( new_custom_model != NULL ); return new_custom_model; } CAMLprim value ml_custom_model_create(value unit) { Custom_model *new_custom_model = custom_model_new(); return Val_GObject_new(&new_custom_model->parent); } CAMLprim value ml_register_custom_model_callback_object(value custom_model, value callback_object) { GObject *obj = GObject_val(custom_model); g_return_val_if_fail (IS_CUSTOM_MODEL (obj),Val_unit); if(Is_block(callback_object) && (char*)callback_object < (char*)caml_young_end && (char*)callback_object > (char*)caml_young_start) { caml_register_global_root (&callback_object); caml_minor_collection(); caml_remove_global_root (&callback_object); } debug_print("register_custom_model_callback_object %p %p\n",obj,(void*)callback_object); ((Custom_model *)obj)->callback_object = callback_object; return Val_unit; } /***************************************************************************** * Caml callbacks for signals *****************************************************************************/ CAMLprim value ml_custom_model_row_inserted (value tree_model_val, value path, value row) { GtkTreeModel *tree_model = GtkTreeModel_val(tree_model_val); g_return_val_if_fail(IS_CUSTOM_MODEL(tree_model), Val_unit); { Custom_model *custom_model = (Custom_model *) tree_model; GtkTreeIter iter; encode_iter (custom_model,&iter,row); debug_print("row_inserted %p %s %p:%ld:%ld:%ld\n",custom_model, PATH_STRING(GtkTreePath_val(path)),PRINT4_VALID(&iter)); gtk_tree_model_row_inserted (tree_model, GtkTreePath_val(path), &iter); return Val_unit;} } CAMLprim value ml_custom_model_row_changed (value tree_model_val, value path, value row) { GtkTreeModel *tree_model = GtkTreeModel_val(tree_model_val); g_return_val_if_fail(IS_CUSTOM_MODEL(tree_model), Val_unit); { Custom_model *custom_model = (Custom_model *) tree_model; GtkTreeIter iter; encode_iter (custom_model,&iter,row); debug_print("row_changed %p %s %p:%ld:%ld:%ld\n", custom_model,PATH_STRING(GtkTreePath_val(path)),PRINT4_VALID(&iter)); gtk_tree_model_row_changed (tree_model, GtkTreePath_val(path), &iter); return Val_unit;} } CAMLprim value ml_custom_model_row_has_child_toggled (value tree_model_val, value path, value row) { GtkTreeModel *tree_model = GtkTreeModel_val(tree_model_val); g_return_val_if_fail(IS_CUSTOM_MODEL(tree_model), Val_unit); { Custom_model *custom_model = (Custom_model *) tree_model; GtkTreeIter iter; encode_iter (custom_model,&iter,row); debug_print("row_has_child_toggled %p %s %p:%ld:%ld:%ld\n",custom_model, PATH_STRING(GtkTreePath_val(path)),PRINT4_VALID(&iter)); gtk_tree_model_row_has_child_toggled (tree_model, GtkTreePath_val(path), &iter); return Val_unit;} } CAMLprim value ml_custom_model_row_deleted (value tree_model_val, value path) { debug_print("row_deleted %p %s\n",(GtkTreeModel_val(tree_model_val)),PATH_STRING(GtkTreePath_val(path))); gtk_tree_model_row_deleted (GtkTreeModel_val(tree_model_val), GtkTreePath_val(path)); return Val_unit; } CAMLprim value ml_custom_model_rows_reordered (value tree_model_val, value path, value row_option, value new_order) { debug_print("rows_reordered\n"); UNWRAP_OPTION(row, row_option, if (row) { GtkTreeModel *tree_model = GtkTreeModel_val(tree_model_val); g_return_val_if_fail(IS_CUSTOM_MODEL(tree_model), Val_unit); { Custom_model *custom_model = (Custom_model *) tree_model; GtkTreeIter iter; encode_iter(custom_model,&iter,row); gtk_tree_model_rows_reordered (tree_model, GtkTreePath_val(path), &iter, (gint*) &Field(new_order,0)); }} else { gtk_tree_model_rows_reordered (GtkTreeModel_val(tree_model_val), GtkTreePath_val(path), NULL, (gint*) &Field(new_order,0)); } return Val_unit;) } #ifdef HASGTK28 CAMLprim value ml_gtk_tree_view_get_visible_range(value treeview) { CAMLparam1(treeview); CAMLlocal1(result); GtkTreePath *startp, *endp; if (! gtk_tree_view_get_visible_range(GtkTreeView_val(treeview), &startp, &endp)) CAMLreturn(Val_unit); result = alloc_tuple(2); Store_field(result, 0, Val_GtkTreePath(startp)); Store_field(result, 1, Val_GtkTreePath(endp)); CAMLreturn(ml_some(result)); } #else Unsupported_28(gtk_tree_view_get_visible_range) #endif lablgtk-2.18.8/src/sourceView_tags.var0000644000175000017500000000413213460263323016736 0ustar stephsteph(*********************************************************************************) (* *) (* lablgtksourceview, OCaml binding for the GtkSourceView text widget *) (* *) (* Copyright (C) 2005 Stefano Zacchiroli *) (* Copyright (C) 2006 Stefano Zacchiroli *) (* Maxence Guesdon *) (* *) (* This library is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Lesser General Public License as *) (* published by the Free Software Foundation; either version 2.1 of the *) (* License, or (at your option) any later version. *) (* *) (* This library is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Lesser General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this library; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) (* USA *) (* *) (*********************************************************************************) package "sourceView" type source_search_flag = "GTK_SOURCE_SEARCH_" [ `VISIBLE_ONLY | `TEXT_ONLY | `CASE_INSENSITIVE] lablgtk-2.18.8/src/gdk.ml0000644000175000017500000007174513460263323014170 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject type color type colormap type visual type screen = [`gdkscreen] obj type region type gc type window = [`drawable|`gdkwindow] obj type pixmap = [`drawable|`gdkpixmap] obj type bitmap = [`drawable|`gdkpixmap|`gdkbitmap] obj type font type image = [`gdkimage] obj type atom type keysym = int type +'a event type drag_context = [`dragcontext] Gobject.obj type cursor type xid = int32 type native_window type device type display exception Error of string let _ = Callback.register_exception "gdkerror" (Error"") external _gdk_init : unit -> unit = "ml_gdk_init" let () = _gdk_init () module Tags = struct type event_type = [ `NOTHING | `DELETE | `DESTROY | `EXPOSE | `MOTION_NOTIFY | `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `CONFIGURE | `MAP | `UNMAP | `PROPERTY_NOTIFY | `SELECTION_CLEAR | `SELECTION_REQUEST | `SELECTION_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `DRAG_ENTER | `DRAG_LEAVE | `DRAG_MOTION | `DRAG_STATUS | `DROP_START | `DROP_FINISHED | `CLIENT_EVENT | `VISIBILITY_NOTIFY | `NO_EXPOSE | `SCROLL | `WINDOW_STATE | `SETTING ] type event_mask = [ `EXPOSURE | `POINTER_MOTION | `POINTER_MOTION_HINT | `BUTTON_MOTION | `BUTTON1_MOTION | `BUTTON2_MOTION | `BUTTON3_MOTION | `BUTTON_PRESS | `BUTTON_RELEASE | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE | `STRUCTURE | `PROPERTY_CHANGE | `VISIBILITY_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `SUBSTRUCTURE | `SCROLL | `ALL_EVENTS ] type extension_mode = [ `NONE | `ALL | `CURSOR ] type visibility_state = [ `UNOBSCURED | `PARTIAL | `FULLY_OBSCURED ] type input_source = [ `MOUSE | `PEN | `ERASER | `CURSOR ] type scroll_direction = [ `UP | `DOWN | `LEFT | `RIGHT ] type notify_type = [ `ANCESTOR | `VIRTUAL | `INFERIOR | `NONLINEAR | `NONLINEAR_VIRTUAL | `UNKNOWN ] type crossing_mode = [ `NORMAL | `GRAB | `UNGRAB ] type setting_action = [ `NEW | `CHANGED | `DELETED ] type window_state = [ `WITHDRAWN | `ICONIFIED | `MAXIMIZED | `STICKY ] type modifier = [ `SHIFT | `LOCK | `CONTROL | `MOD1 | `MOD2 | `MOD3 | `MOD4 | `MOD5 | `BUTTON1 | `BUTTON2 | `BUTTON3 | `BUTTON4 | `BUTTON5 | `SUPER | `HYPER | `META | `RELEASE ] type drag_action = [ `DEFAULT | `COPY | `MOVE | `LINK | `PRIVATE | `ASK ] type rgb_dither = [ `NONE | `NORMAL | `MAX] type property_state = [ `NEW_VALUE | `DELETE ] type property_mode = [ `REPLACE | `PREPEND | `APPEND ] type xdata = [ `BYTES of string | `SHORTS of int array | `INT32S of int32 array ] type xdata_ret = [ xdata | `NONE ] type gravity = [ `NORTH_WEST | `NORTH | `NORTH_EAST | `WEST | `CENTER | `EAST | `SOUTH_WEST | `SOUTH | `SOUTH_EAST | `STATIC ] type window_type_hint = [ `NORMAL | `DIALOG | `MENU | `TOOLBAR | `SPLASHSCREEN | `UTILITY | `DOCK | `DESKTOP ] end open Tags module Convert = struct external test_modifier : modifier -> int -> bool = "ml_test_GdkModifier_val" let modifier i = List.filter [`SHIFT;`LOCK;`CONTROL;`MOD1;`MOD2;`MOD3;`MOD4;`MOD5; `BUTTON1;`BUTTON2;`BUTTON3;`BUTTON4;`BUTTON5;`SUPER; `HYPER;`META;`RELEASE] ~f:(fun m -> test_modifier m i) external test_window_state : window_state -> int -> bool = "ml_test_GdkWindowState_val" let window_state i = List.filter [ `WITHDRAWN; `ICONIFIED; `MAXIMIZED; `STICKY ] ~f:(fun m -> test_window_state m i) end module Atom = struct external intern : string -> bool -> atom = "ml_gdk_atom_intern" let intern ?(dont_create=false) name = intern name dont_create external name : atom -> string = "ml_gdk_atom_name" let none = intern "NONE" let primary = intern "PRIMARY" let secondary = intern "SECONDARY" let clipboard = intern "CLIPBOARD" let string = intern "STRING" end module Property = struct external change : window -> property:atom -> typ:atom -> mode:property_mode -> xdata -> unit = "ml_gdk_property_change" let change ~window ~typ ?(mode=`REPLACE) property data = change window ~property ~typ ~mode data external get : window -> property:atom -> max_length:int -> delete:bool -> (atom * xdata) option = "ml_gdk_property_get" let get ~window ?(max_length=65000) ?(delete=false) property = get window ~property ~max_length ~delete external delete : window:window -> atom -> unit = "ml_gdk_property_delete" end module Screen = struct external get_width : screen -> int = "ml_gdk_screen_get_width" external width : unit -> int = "ml_gdk_screen_width" let width ?screen () = match screen with None -> width () | Some s -> get_width s external get_height : screen -> int = "ml_gdk_screen_get_height" external height : unit -> int = "ml_gdk_screen_height" let height ?screen () = match screen with None -> height () | Some s -> get_height s external get_pango_context_for : screen -> Pango.context = "ml_gdk_pango_context_get_for_screen" external get_pango_context : unit -> Pango.context = "ml_gdk_pango_context_get" let get_pango_context ?screen () = match screen with None -> get_pango_context () | Some s -> get_pango_context_for s (* Only with Gtk-2.2 *) external default : unit -> screen = "ml_gdk_screen_get_default" end module Visual = struct type visual_type = [ `STATIC_GRAY|`GRAYSCALE|`STATIC_COLOR |`PSEUDO_COLOR|`TRUE_COLOR|`DIRECT_COLOR ] external get_best : ?depth:int -> ?kind:visual_type -> unit -> visual = "ml_gdk_visual_get_best" external get_type : visual -> visual_type = "ml_GdkVisual_type" external depth : visual -> int = "ml_GdkVisual_depth" external red_mask : visual -> int = "ml_GdkVisual_red_mask" external red_shift : visual -> int = "ml_GdkVisual_red_shift" external red_prec : visual -> int = "ml_GdkVisual_red_prec" external green_mask : visual -> int = "ml_GdkVisual_green_mask" external green_shift : visual -> int = "ml_GdkVisual_green_shift" external green_prec : visual -> int = "ml_GdkVisual_green_prec" external blue_mask : visual -> int = "ml_GdkVisual_blue_mask" external blue_shift : visual -> int = "ml_GdkVisual_blue_shift" external blue_prec : visual -> int = "ml_GdkVisual_blue_prec" end module Image = struct type image_type = [ `NORMAL|`SHARED|`FASTEST ] let cast w : image = Gobject.try_cast w "GdkImage" let destroy = Gobject.unsafe_unref external create : kind: image_type -> visual: visual -> width: int -> height: int -> image = "ml_gdk_image_new" external get : [>`drawable] obj -> x: int -> y: int -> width: int -> height: int -> image = "ml_gdk_drawable_get_image" external put_pixel : image -> x: int -> y: int -> pixel: int -> unit = "ml_gdk_image_put_pixel" external get_pixel : image -> x: int -> y: int -> int = "ml_gdk_image_get_pixel" external width : image -> int = "ml_gdk_image_width" external height : image -> int = "ml_gdk_image_height" external depth : image -> int = "ml_gdk_image_depth" external get_visual : image -> visual = "ml_gdk_image_visual" end module Color = struct external color_white : colormap -> color = "ml_gdk_color_white" external color_black : colormap -> color = "ml_gdk_color_black" external color_parse : string -> color = "ml_gdk_color_parse" external color_alloc : colormap -> color -> bool = "ml_gdk_color_alloc" external color_create : red:int -> green:int -> blue:int -> color = "ml_GdkColor" external get_system_colormap : unit -> colormap = "ml_gdk_colormap_get_system" external colormap_new : visual -> privat:bool -> colormap = "ml_gdk_colormap_new" let get_colormap ?(privat=false) vis = colormap_new vis ~privat external get_visual : colormap -> visual = "ml_gdk_colormap_get_visual" type spec = [ `BLACK | `NAME of string | `RGB of int * int * int | `WHITE] let color_alloc ~colormap color = if not (color_alloc colormap color) then raise (Error"Color.alloc"); color let alloc ~colormap color = match color with `WHITE -> color_white colormap | `BLACK -> color_black colormap | `NAME s -> color_alloc ~colormap (color_parse s) | `RGB (red,green,blue) -> color_alloc ~colormap (color_create ~red ~green ~blue) external red : color -> int = "ml_GdkColor_red" external blue : color -> int = "ml_GdkColor_blue" external green : color -> int = "ml_GdkColor_green" external pixel : color -> int = "ml_GdkColor_pixel" end module Rectangle = struct type t external create : x:int -> y:int -> width:int -> height:int -> t = "ml_GdkRectangle" external x : t -> int = "ml_GdkRectangle_x" external y : t -> int = "ml_GdkRectangle_y" external width : t -> int = "ml_GdkRectangle_width" external height : t -> int = "ml_GdkRectangle_height" end module Drawable = struct let cast w : [`drawable] obj = Gobject.try_cast w "GdkDrawable" external get_visual : [>`drawable] obj -> visual = "ml_gdk_drawable_get_visual" external get_depth : [>`drawable] obj -> int = "ml_gdk_drawable_get_depth" external get_colormap : [>`drawable] obj -> colormap = "ml_gdk_drawable_get_colormap" external get_size : [>`drawable] obj -> int * int = "ml_gdk_drawable_get_size" end module Windowing = struct external get : unit -> [`QUARTZ | `WIN32 | `X11] = "ml_gdk_get_platform" let platform = get () end module Window = struct let cast w : window = Gobject.try_cast w "GdkWindow" external create_foreign : native_window -> window = "ml_gdk_window_foreign_new" type background_pixmap = [ `NONE | `PARENT_RELATIVE | `PIXMAP of pixmap] external get_parent : window -> window = "ml_gdk_window_get_parent" external get_position : window -> int * int = "ml_gdk_window_get_position" external get_pointer_location : window -> int * int = "ml_gdk_window_get_pointer_location" external root_parent : unit -> window = "ml_GDK_ROOT_PARENT" external set_back_pixmap : window -> pixmap -> int -> unit = "ml_gdk_window_set_back_pixmap" external set_cursor : window -> cursor -> unit = "ml_gdk_window_set_cursor" external clear : window -> unit = "ml_gdk_window_clear" external clear_area : window -> x:int -> y:int -> width:int -> height:int -> unit = "ml_gdk_window_clear" external get_xwindow : [>`drawable] obj -> xid = "ml_GDK_WINDOW_XWINDOW" let set_back_pixmap w pix = let null_pixmap = (Obj.magic Gpointer.boxed_null : pixmap) in match pix with `NONE -> set_back_pixmap w null_pixmap 0 | `PARENT_RELATIVE -> set_back_pixmap w null_pixmap 1 | `PIXMAP(pixmap) -> set_back_pixmap w pixmap 0 (* anything OK, Maybe... *) (* for backward compatibility for lablgtk1 programs *) let get_visual = Drawable.get_visual let xid_of_native (w : native_window) : xid = if Windowing.platform = `X11 then Obj.magic w else failwith "Gdk.Window.xid_of_native only allowed for X11" let native_of_xid (id : xid) : native_window = if Windowing.platform = `X11 then Obj.magic id else failwith "Gdk.Window.native_of_xid only allowed for X11" external set_transient_for : window -> window -> unit = "ml_gdk_window_set_transient_for" end module PointArray = struct type t = { len: int} [@@ boxed] external create : len:int -> t = "ml_point_array_new" external set : t -> pos:int -> x:int -> y:int -> unit = "ml_point_array_set" let set arr ~pos = if pos < 0 || pos >= arr.len then invalid_arg "PointArray.set"; set arr ~pos end module SegmentArray = struct type t = { len: int} [@@ boxed] external create : len:int -> t = "ml_segment_array_new" external set : t -> pos:int -> x1:int -> y1:int -> x2:int -> y2: int -> unit = "ml_segment_array_set_bc" "ml_segment_array_set" let set arr ~pos = if pos < 0 || pos >= arr.len then invalid_arg "SegmentArray.set"; set arr ~pos end module Region = struct type gdkFillRule = [ `EVEN_ODD_RULE|`WINDING_RULE ] type gdkOverlapType = [ `IN|`OUT|`PART ] external create : unit -> region = "ml_gdk_region_new" external destroy : region -> unit = "ml_gdk_region_destroy" external polygon : PointArray.t -> gdkFillRule -> region = "ml_gdk_region_polygon" let polygon l = let len = List.length l in let arr = PointArray.create ~len in List.fold_left l ~init:0 ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1); polygon arr external copy : region -> region = "ml_gdk_region_copy" external intersect : region -> region -> region = "ml_gdk_region_intersect" external union : region -> region -> region = "ml_gdk_region_union" external subtract : region -> region -> region = "ml_gdk_region_subtract" external xor : region -> region -> region = "ml_gdk_region_xor" external union_with_rect : region -> Rectangle.t -> region = "ml_gdk_region_union_with_rect" let intersect r1 r2 = let r3 = copy r1 in intersect r3 r2; r3 let union r1 r2 = let r3 = copy r1 in union r3 r2; r3 let subtract r1 r2 = let r3 = copy r1 in subtract r3 r2; r3 let xor r1 r2 = let r3 = copy r1 in xor r3 r2; r3 let union_with_rect r1 r2 = let r3 = copy r1 in union_with_rect r3 r2; r3 external offset : region -> x:int -> y:int -> unit = "ml_gdk_region_offset" external shrink : region -> x:int -> y:int -> unit = "ml_gdk_region_shrink" external empty : region -> bool = "ml_gdk_region_empty" external equal : region -> region -> bool = "ml_gdk_region_equal" external point_in : region -> x:int -> y:int -> bool = "ml_gdk_region_point_in" external rect_in : region -> Rectangle.t -> gdkOverlapType = "ml_gdk_region_rect_in" external get_clipbox : region -> Rectangle.t -> unit = "ml_gdk_region_get_clipbox" end module GC = struct type gdkFunction = [ `COPY|`INVERT|`XOR ] type gdkFill = [ `SOLID|`TILED|`STIPPLED|`OPAQUE_STIPPLED ] type gdkSubwindowMode = [ `CLIP_BY_CHILDREN|`INCLUDE_INFERIORS ] type gdkLineStyle = [ `SOLID|`ON_OFF_DASH|`DOUBLE_DASH ] type gdkCapStyle = [ `NOT_LAST|`BUTT|`ROUND|`PROJECTING ] type gdkJoinStyle = [ `MITER|`ROUND|`BEVEL ] external create : [>`drawable] obj -> gc = "ml_gdk_gc_new" external set_foreground : gc -> color -> unit = "ml_gdk_gc_set_foreground" external set_background : gc -> color -> unit = "ml_gdk_gc_set_background" external set_font : gc -> font -> unit = "ml_gdk_gc_set_font" external set_function : gc -> gdkFunction -> unit = "ml_gdk_gc_set_function" external set_fill : gc -> gdkFill -> unit = "ml_gdk_gc_set_fill" external set_tile : gc -> pixmap -> unit = "ml_gdk_gc_set_tile" external set_stipple : gc -> pixmap -> unit = "ml_gdk_gc_set_stipple" external set_ts_origin : gc -> x:int -> y:int -> unit = "ml_gdk_gc_set_ts_origin" external set_clip_origin : gc -> x:int -> y:int -> unit = "ml_gdk_gc_set_clip_origin" external set_clip_mask : gc -> bitmap -> unit = "ml_gdk_gc_set_clip_mask" external set_clip_rectangle : gc -> Rectangle.t -> unit = "ml_gdk_gc_set_clip_rectangle" external set_clip_region : gc -> region -> unit = "ml_gdk_gc_set_clip_region" external set_subwindow : gc -> gdkSubwindowMode -> unit = "ml_gdk_gc_set_subwindow" external set_exposures : gc -> bool -> unit = "ml_gdk_gc_set_exposures" external set_line_attributes : gc -> width:int -> style:gdkLineStyle -> cap:gdkCapStyle -> join:gdkJoinStyle -> unit = "ml_gdk_gc_set_line_attributes" external set_dashes : gc -> offset:int -> int list -> unit = "ml_gdk_gc_set_dashes" external copy : dst:gc -> gc -> unit = "ml_gdk_gc_copy" type values = { foreground : color; background : color; font : font option; fonction : gdkFunction; fill : gdkFill; tile : pixmap option; stipple : pixmap option; clip_mask : bitmap option; subwindow_mode : gdkSubwindowMode; ts_x_origin : int; ts_y_origin : int; clip_x_origin : int; clip_y_origin : int; graphics_exposures : bool; line_width : int; line_style : gdkLineStyle; cap_style : gdkCapStyle; join_style : gdkJoinStyle; } external get_values : gc -> values = "ml_gdk_gc_get_values" end module Pixmap = struct let cast w : pixmap = Gobject.try_cast w "GdkPixmap" let destroy = Gobject.unsafe_unref open Gpointer external create : window optboxed -> width:int -> height:int -> depth:int -> pixmap = "ml_gdk_pixmap_new" let create ?window ~width ~height ?(depth = -1) () = try create (optboxed window) ~width ~height ~depth with _ -> failwith "Gdk.Pixmap.create" external create_from_data : window optboxed -> string -> width:int -> height:int -> depth:int -> fg:color -> bg:color -> pixmap = "ml_gdk_pixmap_create_from_data_bc" "ml_gdk_pixmap_create_from_data" let create_from_data ?window ~width ~height ?(depth = -1) ~fg ~bg data = try create_from_data (optboxed window) data ~width ~height ~depth ~fg ~bg with _ -> failwith "Gdk.Pixmap.create_from_data" external create_from_xpm : ?window:window -> ?colormap:colormap -> ?transparent:color -> file:string -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm" external create_from_xpm_d : ?window:window -> ?colormap:colormap -> ?transparent:color -> data:string array -> unit -> pixmap * bitmap = "ml_gdk_pixmap_colormap_create_from_xpm_d" end module Bitmap = struct let cast w : bitmap = let w = Gobject.try_cast w "GdkPixmap" in if Drawable.get_depth w <> 1 then raise (Gobject.Cannot_cast("GdkPixmap","GdkBitmap")); w open Gpointer let create ?window ~width ~height () : bitmap = Gobject.unsafe_cast (Pixmap.create ?window ~width ~height ~depth:1 ()) external create_from_data : window optboxed -> string -> width:int -> height:int -> bitmap = "ml_gdk_bitmap_create_from_data" let create_from_data ?window ~width ~height data = try create_from_data (optboxed window) data ~width ~height with _ -> failwith "Gdk.Bitmap.create_from_data" end module Font = struct external load : string -> font = "ml_gdk_font_load" external load_fontset : string -> font = "ml_gdk_fontset_load" external string_width : font -> string -> int = "ml_gdk_string_width" external char_width : font -> char -> int = "ml_gdk_char_width" external string_height : font -> string -> int = "ml_gdk_string_height" external char_height : font -> char -> int = "ml_gdk_char_height" external string_measure : font -> string -> int = "ml_gdk_string_measure" external char_measure : font -> char -> int = "ml_gdk_char_measure" external get_type : font -> [`FONT | `FONTSET] = "ml_GdkFont_type" external ascent : font -> int = "ml_GdkFont_ascent" external descent : font -> int = "ml_GdkFont_descent" end module Draw = struct external point : [>`drawable] obj -> gc -> x:int -> y:int -> unit = "ml_gdk_draw_point" external line : [>`drawable] obj -> gc -> x:int -> y:int -> x:int -> y:int -> unit = "ml_gdk_draw_line_bc" "ml_gdk_draw_line" external rectangle : [>`drawable] obj -> gc -> filled:bool -> x:int -> y:int -> width:int -> height:int -> unit = "ml_gdk_draw_rectangle_bc" "ml_gdk_draw_rectangle" let rectangle w gc ~x ~y ~width ~height ?(filled=false) () = rectangle w gc ~x ~y ~width ~height ~filled external arc : [>`drawable] obj -> gc -> filled:bool -> x:int -> y:int -> width:int -> height:int -> start:int -> angle:int -> unit = "ml_gdk_draw_arc_bc" "ml_gdk_draw_arc" let arc w gc ~x ~y ~width ~height ?(filled=false) ?(start=0.) ?(angle=360.) () = arc w gc ~x ~y ~width ~height ~filled ~start:(truncate(start *. 64.)) ~angle:(truncate(angle *. 64.)) let f_pointarray f l = let array_of_points l = let len = List.length l in let arr = PointArray.create ~len in List.fold_left l ~init:0 ~f:(fun pos (x,y) -> PointArray.set arr ~pos ~x ~y; pos+1); arr in f (array_of_points l) let f_segmentarray f l = let array_of_segments l = let len = List.length l in let arr = SegmentArray.create ~len in List.fold_left l ~init:0 ~f:(fun pos ((x1,y1),(x2,y2)) -> SegmentArray.set arr ~pos ~x1 ~y1 ~x2 ~y2; pos+1); arr in f (array_of_segments l) external polygon : [>`drawable] obj -> gc -> filled:bool -> PointArray.t -> unit = "ml_gdk_draw_polygon" let polygon w gc ?(filled=false) = function | [] -> () | l -> f_pointarray (polygon w gc ~filled) l external string : [>`drawable] obj -> font: font -> gc -> x: int -> y: int -> string -> unit = "ml_gdk_draw_string_bc" "ml_gdk_draw_string" external layout : [>`drawable] obj -> gc -> x: int -> y: int -> Pango.layout -> ?fore:color -> ?back:color -> unit = "ml_gdk_draw_layout_with_colors_bc" "ml_gdk_draw_layout_with_colors" external image_ : [>`drawable] obj -> gc -> image -> xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> width: int -> height: int -> unit = "ml_gdk_draw_image_bc" "ml_gdk_draw_image" let image w gc ?(xsrc=0) ?(ysrc=0) ?(xdest=0) ?(ydest=0) ?(width= -1) ?(height= -1) image = image_ w gc image ~xsrc ~ysrc ~xdest ~ydest ~width ~height (* external bitmap : [>`drawable] obj -> gc -> bitmap: bitmap -> xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> width: int -> height: int -> unit = "ml_gdk_draw_bitmap_bc" "ml_gdk_draw_bitmap" *) external pixmap_ : [>`drawable] obj -> gc -> pixmap -> xsrc: int -> ysrc: int -> xdest: int -> ydest: int -> width: int -> height: int -> unit = "ml_gdk_draw_pixmap_bc" "ml_gdk_draw_pixmap" let pixmap w gc ?(xsrc=0) ?(ysrc=0) ?(xdest=0) ?(ydest=0) ?(width= -1) ?(height= -1) pixmap = pixmap_ w gc pixmap ~xsrc ~ysrc ~xdest ~ydest ~width ~height external points : [>`drawable] obj -> gc -> PointArray.t -> unit = "ml_gdk_draw_points" let points w gc l = f_pointarray (points w gc) l external lines : [>`drawable] obj -> gc -> PointArray.t -> unit = "ml_gdk_draw_lines" let lines w gc l = f_pointarray (lines w gc) l external segments : [>`drawable] obj -> gc -> SegmentArray.t -> unit = "ml_gdk_draw_segments" let segments w gc = function | [] -> () | l -> f_segmentarray (segments w gc) l end module Rgb = struct external init : unit -> unit = "ml_gdk_rgb_init" external get_visual : unit -> visual = "ml_gdk_rgb_get_visual" external get_cmap : unit -> colormap = "ml_gdk_rgb_get_cmap" external draw_image_ : [>`drawable] obj -> gc -> x:int -> y:int -> width:int -> height:int -> dither:rgb_dither -> buf:Gpointer.region -> row_stride:int -> unit = "ml_gdk_draw_rgb_image_bc" "ml_gdk_draw_rgb_image" let draw_image w gc ~width ~height ?(x=0) ?(y=0) ?(dither=`NORMAL) ?(row_stride=width*3) buf = if height <= 0 || width <= 0 || row_stride < width * 3 || Gpointer.length buf < row_stride * (height - 1) + width then invalid_arg "Gdk.Rgb.draw_image"; draw_image_ w gc ~x ~y ~width ~height ~dither ~buf ~row_stride end module DnD = struct external drag_status : drag_context -> drag_action option -> time:int32 -> unit = "ml_gdk_drag_status" external drag_context_suggested_action : drag_context -> drag_action = "ml_GdkDragContext_suggested_action" external drag_context_targets : drag_context -> atom list = "ml_GdkDragContext_targets" end module Truecolor = struct (* Truecolor quick color query *) type visual_shift_prec = { red_shift : int; red_prec : int; green_shift : int; green_prec : int; blue_shift : int; blue_prec : int } let shift_prec visual = { red_shift = Visual.red_shift visual; red_prec = Visual.red_prec visual; green_shift = Visual.green_shift visual; green_prec = Visual.green_prec visual; blue_shift = Visual.blue_shift visual; blue_prec = Visual.blue_prec visual; } let color_creator visual = match Visual.get_type visual with `TRUE_COLOR | `DIRECT_COLOR -> let shift_prec = shift_prec visual in (* Format.eprintf "red : %d %d, " shift_prec.red_shift shift_prec.red_prec; Format.eprintf "green : %d %d, " shift_prec.green_shift shift_prec.green_prec; Format.eprintf "blue : %d %d" shift_prec.blue_shift shift_prec.blue_prec; Format.pp_print_newline Format.err_formatter (); *) let red_lsr = 16 - shift_prec.red_prec and green_lsr = 16 - shift_prec.green_prec and blue_lsr = 16 - shift_prec.blue_prec in fun ~red: red ~green: green ~blue: blue -> (((red lsr red_lsr) lsl shift_prec.red_shift) lor ((green lsr green_lsr) lsl shift_prec.green_shift) lor ((blue lsr blue_lsr) lsl shift_prec.blue_shift)) | _ -> raise (Invalid_argument "Gdk.Truecolor.color_creator") let color_parser visual = match Visual.get_type visual with `TRUE_COLOR | `DIRECT_COLOR -> let shift_prec = shift_prec visual in let red_lsr = 16 - shift_prec.red_prec and green_lsr = 16 - shift_prec.green_prec and blue_lsr = 16 - shift_prec.blue_prec in let mask = 1 lsl 16 - 1 in fun pixel -> ((pixel lsr shift_prec.red_shift) lsl red_lsr) land mask, ((pixel lsr shift_prec.green_shift) lsl green_lsr) land mask, ((pixel lsr shift_prec.blue_shift) lsl blue_lsr) land mask | _ -> raise (Invalid_argument "Gdk.Truecolor.color_parser") end module X = struct (* X related functions *) external flush : unit -> unit = "ml_gdk_flush" external beep : unit -> unit = "ml_gdk_beep" end module Cursor = struct type cursor_type = [ | `X_CURSOR | `ARROW | `BASED_ARROW_DOWN | `BASED_ARROW_UP | `BOAT | `BOGOSITY | `BOTTOM_LEFT_CORNER | `BOTTOM_RIGHT_CORNER | `BOTTOM_SIDE | `BOTTOM_TEE | `BOX_SPIRAL | `CENTER_PTR | `CIRCLE | `CLOCK | `COFFEE_MUG | `CROSS | `CROSS_REVERSE | `CROSSHAIR | `DIAMOND_CROSS | `DOT | `DOTBOX | `DOUBLE_ARROW | `DRAFT_LARGE | `DRAFT_SMALL | `DRAPED_BOX | `EXCHANGE | `FLEUR | `GOBBLER | `GUMBY | `HAND1 | `HAND2 | `HEART | `ICON | `IRON_CROSS | `LEFT_PTR | `LEFT_SIDE | `LEFT_TEE | `LEFTBUTTON | `LL_ANGLE | `LR_ANGLE | `MAN | `MIDDLEBUTTON | `MOUSE | `PENCIL | `PIRATE | `PLUS | `QUESTION_ARROW | `RIGHT_PTR | `RIGHT_SIDE | `RIGHT_TEE | `RIGHTBUTTON | `RTL_LOGO | `SAILBOAT | `SB_DOWN_ARROW | `SB_H_DOUBLE_ARROW | `SB_LEFT_ARROW | `SB_RIGHT_ARROW | `SB_UP_ARROW | `SB_V_DOUBLE_ARROW | `SHUTTLE | `SIZING | `SPIDER | `SPRAYCAN | `STAR | `TARGET | `TCROSS | `TOP_LEFT_ARROW | `TOP_LEFT_CORNER | `TOP_RIGHT_CORNER | `TOP_SIDE | `TOP_TEE | `TREK | `UL_ANGLE | `UMBRELLA | `UR_ANGLE | `WATCH | `XTERM ] external create : cursor_type -> cursor = "ml_gdk_cursor_new" external create_from_pixmap : pixmap -> mask:bitmap -> fg:color -> bg:color -> x:int -> y:int -> cursor = "ml_gdk_cursor_new_from_pixmap_bc" "ml_gdk_cursor_new_from_pixmap" external create_from_pixbuf : [`pixbuf] obj -> x:int -> y:int -> cursor = "ml_gdk_cursor_new_from_pixbuf" (** @since GTK 2.4 *) external get_image : cursor -> [`pixbuf] obj = "ml_gdk_cursor_get_image" (** @since GTK 2.8 *) end module Display = struct (* since Gtk+-2.2 *) external default : unit -> display = "ml_gdk_display_get_default" external get_window_at_pointer : display -> (window * int * int) option = "ml_gdk_display_get_window_at_pointer" let window_at_pointer ?display () = get_window_at_pointer (match display with None -> default () | Some disp -> disp) end lablgtk-2.18.8/src/gtkList.ml0000644000175000017500000003143013460263323015027 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gtk open Tags open GtkListProps open GtkBase external _gtklist_init : unit -> unit = "ml_gtklist_init" let () = _gtklist_init () module ListItem = struct include ListItem external create_with_label : string -> list_item obj = "ml_gtk_list_item_new_with_label" let create ?label () = match label with None -> create [] | Some label -> create_with_label label end module Liste = struct include Liste external insert_item : [>`list] obj -> [>`listitem] obj -> pos:int -> unit = "ml_gtk_list_insert_item" let insert_items l wl ~pos = let wl = if pos < 0 then wl else List.rev wl in List.iter wl ~f:(insert_item l ~pos) let append_items l = insert_items l ~pos:(-1) let prepend_items l = insert_items l ~pos:0 external clear_items : [>`list] obj -> start:int -> stop:int -> unit = "ml_gtk_list_clear_items" external select_item : [>`list] obj -> pos:int -> unit = "ml_gtk_list_select_item" external unselect_item : [>`list] obj -> pos:int -> unit = "ml_gtk_list_unselect_item" external select_child : [>`list] obj -> [>`listitem] obj -> unit = "ml_gtk_list_select_child" external unselect_child : [>`list] obj -> [>`listitem] obj -> unit = "ml_gtk_list_unselect_child" external child_position : [>`list] obj -> [>`listitem] obj -> int = "ml_gtk_list_child_position" end module CList = struct include Clist external create : cols:int -> clist obj = "ml_gtk_clist_new" external create_with_titles : string array -> clist obj = "ml_gtk_clist_new_with_titles" external get_rows : [>`clist] obj -> int = "ml_gtk_clist_get_rows" external get_columns : [>`clist] obj -> int = "ml_gtk_clist_get_columns" external get_focus_row : [>`clist] obj -> int = "ml_gtk_clist_get_focus_row" external set_hadjustment : [>`clist] obj -> [>`adjustment] obj -> unit = "ml_gtk_clist_set_hadjustment" external set_vadjustment : [>`clist] obj -> [>`adjustment] obj -> unit = "ml_gtk_clist_set_vadjustment" external get_hadjustment : [>`clist] obj -> adjustment obj = "ml_gtk_clist_get_hadjustment" external get_vadjustment : [>`clist] obj -> adjustment obj = "ml_gtk_clist_get_vadjustment" external set_shadow_type : [>`clist] obj -> shadow_type -> unit = "ml_gtk_clist_set_shadow_type" external set_selection_mode : [>`clist] obj -> selection_mode -> unit = "ml_gtk_clist_set_selection_mode" external set_reorderable : [>`clist] obj -> bool -> unit = "ml_gtk_clist_set_reorderable" external set_use_drag_icons : [>`clist] obj -> bool -> unit = "ml_gtk_clist_set_use_drag_icons" external set_button_actions : [>`clist] obj -> int -> button_action list -> unit = "ml_gtk_clist_set_button_actions" external freeze : [>`clist] obj -> unit = "ml_gtk_clist_freeze" external thaw : [>`clist] obj -> unit = "ml_gtk_clist_thaw" external column_titles_show : [>`clist] obj -> unit = "ml_gtk_clist_column_titles_show" external column_titles_hide : [>`clist] obj -> unit = "ml_gtk_clist_column_titles_hide" external column_title_active : [>`clist] obj -> int -> unit = "ml_gtk_clist_column_title_active" external column_title_passive : [>`clist] obj -> int -> unit = "ml_gtk_clist_column_title_passive" external column_titles_active : [>`clist] obj -> unit = "ml_gtk_clist_column_titles_active" external column_titles_passive : [>`clist] obj -> unit = "ml_gtk_clist_column_titles_passive" external set_column_title : [>`clist] obj -> int -> string -> unit = "ml_gtk_clist_set_column_title" external get_column_title : [>`clist] obj -> int -> string = "ml_gtk_clist_get_column_title" external set_column_widget : [>`clist] obj -> int -> [>`widget] obj -> unit = "ml_gtk_clist_set_column_widget" external get_column_widget : [>`clist] obj -> int -> widget obj = "ml_gtk_clist_get_column_widget" external set_column_justification : [>`clist] obj -> int -> justification -> unit = "ml_gtk_clist_set_column_justification" external set_column_visibility : [>`clist] obj -> int -> bool -> unit = "ml_gtk_clist_set_column_visibility" external set_column_resizeable : [>`clist] obj -> int -> bool -> unit = "ml_gtk_clist_set_column_resizeable" external set_column_auto_resize : [>`clist] obj -> int -> bool -> unit = "ml_gtk_clist_set_column_auto_resize" external columns_autosize : [>`clist] obj -> unit = "ml_gtk_clist_columns_autosize" external optimal_column_width : [>`clist] obj -> int -> int = "ml_gtk_clist_optimal_column_width" external set_column_width : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_set_column_width" external set_column_min_width : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_set_column_min_width" external set_column_max_width : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_set_column_max_width" external set_row_height : [>`clist] obj -> int -> unit = "ml_gtk_clist_set_row_height" external moveto : [>`clist] obj -> int -> int -> row_align:clampf -> col_align:clampf -> unit = "ml_gtk_clist_moveto" external row_is_visible : [>`clist] obj -> int -> visibility = "ml_gtk_clist_row_is_visible" external get_cell_type : [>`clist] obj -> int -> int -> cell_type = "ml_gtk_clist_get_cell_type" external set_text : [>`clist] obj -> int -> int -> string -> unit = "ml_gtk_clist_set_text" external get_text : [>`clist] obj -> int -> int -> string = "ml_gtk_clist_get_text" external set_pixmap : [>`clist] obj -> int -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit = "ml_gtk_clist_set_pixmap" external get_pixmap : [>`clist] obj -> int -> int -> Gdk.pixmap option * Gdk.bitmap option = "ml_gtk_clist_get_pixmap" external set_pixtext : [>`clist] obj -> int -> int -> string -> int -> Gdk.pixmap -> Gdk.bitmap Gpointer.optboxed -> unit = "ml_gtk_clist_set_pixtext_bc" "ml_gtk_clist_set_pixtext" external set_foreground : [>`clist] obj -> row:int -> Gdk.color Gpointer.optboxed -> unit = "ml_gtk_clist_set_foreground" external set_background : [>`clist] obj -> row:int -> Gdk.color Gpointer.optboxed -> unit = "ml_gtk_clist_set_background" external get_cell_style : [>`clist] obj -> int -> int -> Gtk.style = "ml_gtk_clist_get_cell_style" external set_cell_style : [>`clist] obj -> int -> int -> Gtk.style -> unit = "ml_gtk_clist_set_cell_style" external get_row_style : [>`clist] obj -> row:int -> Gtk.style = "ml_gtk_clist_get_row_style" external set_row_style : [>`clist] obj -> row:int -> Gtk.style -> unit = "ml_gtk_clist_set_row_style" external set_selectable : [>`clist] obj -> row:int -> bool -> unit = "ml_gtk_clist_set_selectable" external get_selectable : [>`clist] obj -> row:int -> bool = "ml_gtk_clist_get_selectable" external set_shift : [>`clist] obj -> int -> int -> vertical:int -> horizontal:int -> unit = "ml_gtk_clist_set_shift" external insert : [>`clist] obj -> row:int -> Gpointer.optstring array -> int = "ml_gtk_clist_insert" let insert w ~row texts = let len = get_columns w in if List.length texts > len then invalid_arg "CList.insert"; let arr = Array.make (get_columns w) None in List.fold_left texts ~init:0 ~f:(fun pos text -> arr.(pos) <- text; pos+1); let r = insert w ~row (Array.map ~f:Gpointer.optstring arr) in if r = -1 then invalid_arg "GtkCList::insert"; r external remove : [>`clist] obj -> row:int -> unit = "ml_gtk_clist_remove" external set_row_data : [>`clist] obj -> row:int -> Obj.t -> unit = "ml_gtk_clist_set_row_data" external get_row_data : [>`clist] obj -> row:int -> Obj.t = "ml_gtk_clist_get_row_data" external select : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_select_row" external unselect : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_unselect_row" external clear : [>`clist] obj -> unit = "ml_gtk_clist_clear" external get_row_column : [>`clist] obj -> x:int -> y:int -> int * int = "ml_gtk_clist_get_selection_info" external select_all : [>`clist] obj -> unit = "ml_gtk_clist_select_all" external unselect_all : [>`clist] obj -> unit = "ml_gtk_clist_unselect_all" external swap_rows : [>`clist] obj -> int -> int -> unit = "ml_gtk_clist_swap_rows" external row_move : [>`clist] obj -> int -> dst:int -> unit = "ml_gtk_clist_row_move" external set_sort_column : [>`clist] obj -> int -> unit = "ml_gtk_clist_set_sort_column" external set_sort_type : [>`clist] obj -> sort_type -> unit = "ml_gtk_clist_set_sort_type" external sort : [>`clist] obj -> unit = "ml_gtk_clist_sort" external set_auto_sort : [>`clist] obj -> bool -> unit = "ml_gtk_clist_set_auto_sort" let set_titles_show w = function true -> column_titles_show w | false -> column_titles_hide w let set_titles_active w = function true -> column_titles_active w | false -> column_titles_passive w let setter ~cont ?hadjustment ?vadjustment ?(button_actions=[]) ?titles_show = cont (fun w -> let may_set f param = may param ~f:(f w) in may_set set_hadjustment hadjustment; may_set set_vadjustment vadjustment; List.iter button_actions ~f:(fun (n,act) -> set_button_actions w n act); may_set set_titles_show titles_show) let set_sort w ?auto ?column ?dir:sort_type () = may auto ~f:(set_auto_sort w); may column ~f:(set_sort_column w); may sort_type ~f:(set_sort_type w) let set_cell w ?text ?pixmap ?mask ?(spacing=0) ?style row col = begin match text, pixmap with | Some text, None -> set_text w row col text | None, Some pm -> set_pixmap w row col pm (Gpointer.optboxed mask) | Some text, Some pm -> set_pixtext w row col text spacing pm (Gpointer.optboxed mask) | _ -> () end; may style ~f:(set_cell_style w row col) let set_column w ?widget ?title ?title_active ?justification ?visibility ?resizeable ?auto_resize ?width ?min_width ?max_width col = let may_set f param = may param ~f:(f w col) in may_set set_column_widget widget; may_set set_column_title title; may title_active ~f:(fun active -> if active then column_title_active w col else column_title_passive w col); may_set set_column_justification justification; may_set set_column_visibility visibility; may_set set_column_resizeable resizeable; may_set set_column_auto_resize auto_resize; may_set set_column_width width; may_set set_column_min_width min_width; may_set set_column_max_width max_width let set_row w ?foreground ?background ?selectable ?style row = let may_set f = may ~f:(f w ~row) in may_set set_foreground foreground; may_set set_background background; may_set set_selectable selectable; may_set set_row_style style external get_row_state : [>`clist] obj -> int -> Gtk.Tags.state_type = "ml_gtk_clist_get_row_state" let emit_scroll = GtkSignal.emit ~conv:ignore ~emitter: (fun ~cont t ~(pos:clampf) -> cont [|`INT(Gpointer.encode_variant GtkEnums.scroll_type t); `FLOAT pos|]) end lablgtk-2.18.8/src/gUtil.mli0000644000175000017500000001227413460263323014650 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** {3 Utility classes for programming with GTK objects} *) open GObj (** A nice function to use with [#install_printer] *) val print_widget : Format.formatter -> #widget -> unit (** The memo class provides an easy way to remember the real class of a widget. Insert all widgets of class in one single [t memo], and you can then recover their original ML object with [#find]. *) class ['a] memo : unit -> object constraint 'a = val tbl : (int, 'a) Hashtbl.t method add : 'a -> unit method find : widget -> 'a method remove : widget -> unit end (** {4 The ML signal mechanism} It allows one to add GTK-like signals to arbitrary objects. *) val next_callback_id : unit -> GtkSignal.id class ['a] signal : unit -> object val mutable callbacks : (GtkSignal.id * ('a -> unit)) list method callbacks : (GtkSignal.id * ('a -> unit)) list method call : 'a -> unit method connect : after:bool -> callback:('a -> unit) -> GtkSignal.id method disconnect : GtkSignal.id -> bool end (** As with GTK signals, you can use [GtkSignal.stop_emit] inside a callback to prevent other callbacks from being called. *) class virtual ml_signals : (GtkSignal.id -> bool) list -> object ('a) val after : bool method after : 'a method disconnect : GtkSignal.id -> unit val mutable disconnectors : (GtkSignal.id -> bool) list end class virtual add_ml_signals : 'a Gtk.obj -> (GtkSignal.id -> bool) list -> object method disconnect : GtkSignal.id -> unit val mutable disconnectors : (GtkSignal.id -> bool) list end (** To add ML signals to a LablGTK object: {[ class mywidget_signals obj ~mysignal1 ~mysignal2 = object inherit somewidget_signals obj inherit add_ml_signals obj [mysignal1#disconnect; mysignal2#disconnect] method mysignal1 = mysignal1#connect ~after method mysignal2 = mysignal2#connect ~after end class mywidget obj = object (self) inherit somewidget obj val mysignal1 = new signal obj val mysignal2 = new signal obj method connect = new mywidget_signals obj ~mysignal1 ~mysignal2 method call1 = mysignal1#call method call2 = mysignal2#call end ]} You can also add ML signals to an arbitrary object; just inherit from [ml_signals] in place of [widget_signals]+[add_ml_signals]. {[ class mysignals ~mysignal1 ~mysignal2 = object inherit ml_signals [mysignal1#disconnect; mysignal2#disconnect] method mysignal1 = mysignal1#connect ~after method mysignal2 = mysignal2#connect ~after end ]} *) (** {4 Propagating state modifications} The variable class provides an easy way to propagate state modifications. A new variable is created by [new variable init]. The [#set] method just calls the [set] signal, which by default only calls [real_set]. [real_set] sets the variable and calls [changed] when needed. Deep equality is used to compare values, but check is only done if there are callbacks for [changed]. *) class ['a] variable_signals : set:'a signal -> changed:'a signal -> object ('b) val after : bool method after : 'b method set : callback:('a -> unit) -> GtkSignal.id method changed : callback:('a -> unit) -> GtkSignal.id method disconnect : GtkSignal.id -> unit val mutable disconnectors : (GtkSignal.id -> bool) list end class ['a] variable : 'a -> object val set : 'a signal val changed : 'a signal val mutable x : 'a method connect : 'a variable_signals method get : 'a method set : 'a -> unit method private equal : 'a -> 'a -> bool method private real_set : 'a -> unit end lablgtk-2.18.8/src/gtkBroken.ml0000644000175000017500000001005313460263323015332 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open Tags open GtkBrokenProps open GtkBase external _gtkbroken_init : unit -> unit = "ml_gtkbroken_init" let () = _gtkbroken_init () module TreeItem = struct include TreeItem external create_with_label : string -> tree_item obj = "ml_gtk_tree_item_new_with_label" let create ?label () = match label with None -> create [] | Some label -> create_with_label label external subtree : [>`treeitem] obj -> tree obj = "ml_GTK_TREE_ITEM_SUBTREE" end module Tree = struct include Tree external insert : [>`tree] obj -> [>`treeitem] obj -> pos:int -> unit = "ml_gtk_tree_insert" external remove_items : [>`tree] obj -> [>`treeitem] obj list -> unit = "ml_gtk_tree_remove_items" external clear_items : [>`tree] obj -> start:int -> stop:int -> unit = "ml_gtk_tree_clear_items" external select_item : [>`tree] obj -> pos:int -> unit = "ml_gtk_tree_select_item" external unselect_item : [>`tree] obj -> pos:int -> unit = "ml_gtk_tree_unselect_item" external child_position : [>`tree] obj -> [>`treeitem] obj -> int = "ml_gtk_tree_child_position" external set_selection_mode : [>`tree] obj -> selection_mode -> unit = "ml_gtk_tree_set_selection_mode" external set_view_mode : [>`tree] obj -> [`LINE|`ITEM] -> unit = "ml_gtk_tree_set_view_mode" external set_view_lines : [>`tree] obj -> bool -> unit = "ml_gtk_tree_set_view_lines" external selection : [>`tree] obj -> tree_item obj list = "ml_gtk_tree_selection" let set ?selection_mode ?view_mode ?view_lines w = let may_set f = may ~f:(f w) in may_set set_selection_mode selection_mode; may_set set_view_mode view_mode; may_set set_view_lines view_lines end module OldEditable = OldEditable module Text = struct include Text external set_point : [>`text] obj -> int -> unit = "ml_gtk_text_set_point" external get_point : [>`text] obj -> int = "ml_gtk_text_get_point" external get_length : [>`text] obj -> int = "ml_gtk_text_get_length" external freeze : [>`text] obj -> unit = "ml_gtk_text_freeze" external thaw : [>`text] obj -> unit = "ml_gtk_text_thaw" external insert : [>`text] obj -> ?font:Gdk.font -> ?foreground:Gdk.color -> ?background:Gdk.color -> string -> unit = "ml_gtk_text_insert" external forward_delete: [>`text] obj -> int -> unit = "ml_gtk_text_forward_delete" external backward_delete: [>`text] obj -> int -> unit = "ml_gtk_text_backward_delete" end lablgtk-2.18.8/src/ml_gtkmisc.c0000644000175000017500000002266113460263323015357 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gdkpixbuf.h" #include "ml_gtk.h" #include "gtk_tags.h" #include "gdk_tags.h" /* Init all */ CAMLprim value ml_gtkmisc_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_gamma_curve_get_type() + gtk_statusbar_get_type() + #ifdef HASGTK210 gtk_status_icon_get_type() + #endif gtk_calendar_get_type() + gtk_drawing_area_get_type() + gtk_curve_get_type() + gtk_misc_get_type() + gtk_arrow_get_type() + gtk_image_get_type() + gtk_label_get_type() + gtk_tips_query_get_type() + gtk_pixmap_get_type() + gtk_hseparator_get_type() + gtk_vseparator_get_type() + gtk_preview_get_type () + gtk_font_selection_get_type() + gtk_color_selection_get_type(); return Val_GType(t); } /* gtkgamma.h */ #define GtkGammaCurve_val(val) check_cast(GTK_GAMMA_CURVE,val) Make_Extractor (gtk_gamma_curve_get, GtkGammaCurve_val, gamma, copy_double) /* gtkstatusbar.h */ #define GtkStatusbar_val(val) check_cast(GTK_STATUSBAR,val) ML_2 (gtk_statusbar_get_context_id, GtkStatusbar_val, String_val, Val_int) ML_3 (gtk_statusbar_push, GtkStatusbar_val, Int_val, String_val, Val_int) ML_2 (gtk_statusbar_pop, GtkStatusbar_val, Int_val, Unit) ML_3 (gtk_statusbar_remove, GtkStatusbar_val, Int_val, Int_val, Unit) ML_1 (gtk_statusbar_get_has_resize_grip, GtkStatusbar_val, Val_bool) ML_2 (gtk_statusbar_set_has_resize_grip, GtkStatusbar_val, Bool_val, Unit) /* gtkstatusicon.h */ #ifdef HASGTK210 #define GtkStatusIcon_val(val) check_cast(GTK_STATUS_ICON, val) #define Val_GtkStatusIcon_new(val) Val_GObject_new(val) ML_2 (gtk_status_icon_set_from_pixbuf, GtkStatusIcon_val, GdkPixbuf_val, Unit) ML_2 (gtk_status_icon_set_from_file, GtkStatusIcon_val, String_val, Unit) ML_2 (gtk_status_icon_set_from_stock, GtkStatusIcon_val, String_val, Unit) ML_2 (gtk_status_icon_set_from_icon_name, GtkStatusIcon_val, String_val, Unit) ML_1 (gtk_status_icon_get_pixbuf, GtkStatusIcon_val, Val_GdkPixbuf) ML_1 (gtk_status_icon_get_stock, GtkStatusIcon_val, Val_string) ML_1 (gtk_status_icon_get_icon_name, GtkStatusIcon_val, Val_string) ML_1 (gtk_status_icon_get_size, GtkStatusIcon_val, Val_int) #ifdef HASGTK212 ML_2 (gtk_status_icon_set_screen, GtkStatusIcon_val, GdkScreen_val, Unit) ML_1 (gtk_status_icon_get_screen, GtkStatusIcon_val, Val_GdkScreen) #else Unsupported_212(gtk_status_icon_set_screen) Unsupported_212(gtk_status_icon_get_screen) #endif ML_2 (gtk_status_icon_set_tooltip, GtkStatusIcon_val, String_val, Unit) ML_2 (gtk_status_icon_set_visible, GtkStatusIcon_val, Bool_val, Unit) ML_1 (gtk_status_icon_get_visible, GtkStatusIcon_val, Val_bool) ML_2 (gtk_status_icon_set_blinking, GtkStatusIcon_val, Bool_val, Unit) ML_1 (gtk_status_icon_get_blinking, GtkStatusIcon_val, Val_bool) ML_1 (gtk_status_icon_is_embedded, GtkStatusIcon_val, Val_bool) /* void gtk_status_icon_position_menu (GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer user_data); gboolean gtk_status_icon_get_geometry (GtkStatusIcon *status_icon, GdkScreen **screen, GdkRectangle *area, GtkOrientation *orientation); guint32 gtk_status_icon_get_x11_window_id (GtkStatusIcon *status_icon); */ #else Unsupported_210(gtk_status_icon_set_from_pixbuf) Unsupported_210(gtk_status_icon_set_from_file) Unsupported_210(gtk_status_icon_set_from_stock) Unsupported_210(gtk_status_icon_set_from_icon_name) Unsupported_210(gtk_status_icon_get_pixbuf) Unsupported_210(gtk_status_icon_get_stock) Unsupported_210(gtk_status_icon_get_icon_name) Unsupported_210(gtk_status_icon_get_size) Unsupported_210(gtk_status_icon_set_screen) Unsupported_210(gtk_status_icon_get_screen) Unsupported_210(gtk_status_icon_set_tooltip) Unsupported_210(gtk_status_icon_set_visible) Unsupported_210(gtk_status_icon_get_visible) Unsupported_210(gtk_status_icon_set_blinking) Unsupported_210(gtk_status_icon_get_blinking) Unsupported_210(gtk_status_icon_is_embedded) #endif /* gtkcalendar.h */ #define GtkCalendar_val(val) check_cast(GTK_CALENDAR,val) ML_3 (gtk_calendar_select_month, GtkCalendar_val, Int_val, Int_val, Unit) ML_2 (gtk_calendar_select_day, GtkCalendar_val, Int_val, Unit) ML_2 (gtk_calendar_mark_day, GtkCalendar_val, Int_val, Unit) ML_2 (gtk_calendar_unmark_day, GtkCalendar_val, Int_val, Unit) ML_1 (gtk_calendar_clear_marks, GtkCalendar_val, Unit) Make_Flags_val (Calendar_display_options_val) ML_2 (gtk_calendar_display_options, GtkCalendar_val, Flags_Calendar_display_options_val, Unit) CAMLprim value ml_gtk_calendar_get_date (value w) { guint year, month, day; value ret; gtk_calendar_get_date (GtkCalendar_val(w), &year, &month, &day); ret = alloc_small (3, 0); Field(ret,0) = Val_int(year); Field(ret,1) = Val_int(month); Field(ret,2) = Val_int(day); return ret; } ML_1 (gtk_calendar_freeze, GtkCalendar_val, Unit) ML_1 (gtk_calendar_thaw, GtkCalendar_val, Unit) Make_Extractor (gtk_calendar_get, GtkCalendar_val, num_marked_dates, Val_int) CAMLprim value ml_gtk_calendar_is_day_marked (value c, value d) { guint day = Int_val(d) - 1; if (day >= 31) invalid_argument("gtk_calendar_is_day_marked: date ouf of range"); return Val_bool(GtkCalendar_val(c)->marked_date[day]); } /* gtkdrawingarea.h */ #define GtkDrawingArea_val(val) check_cast(GTK_DRAWING_AREA,val) ML_3 (gtk_drawing_area_size, GtkDrawingArea_val, Int_val, Int_val, Unit) /* gtkcurve.h */ #include #define GtkCurve_val(val) check_cast(GTK_CURVE,val) ML_1 (gtk_curve_reset, GtkCurve_val, Unit) ML_2 (gtk_curve_set_gamma, GtkCurve_val, Float_val, Unit) value ml_gtk_curve_set_vector (value curve, value points) { guint len = Wosize_val(points) / Double_wosize; gfloat* vect = g_malloc(len * sizeof(gfloat)); int i; for (i = 0; i < len; i++) vect[i] = Double_field(points,i); gtk_curve_set_vector(GtkCurve_val(curve), len, vect); g_free(vect); return Val_unit; } value ml_gtk_curve_get_vector (value curve, value vlen) { int i, len = Int_val(vlen); gfloat* vect = g_malloc(len * sizeof(gfloat)); value ret; gtk_curve_get_vector(GtkCurve_val(curve), len, vect); ret = caml_alloc(len*Double_wosize, Double_array_tag); for (i = 0; i < len; i++) Store_double_field(ret, i, vect[i]); g_free(vect); return ret; } /* gtkmisc.h */ /* gtkarrow.h */ /* gtkimage.h */ #define GtkImage_val(val) check_cast(GTK_IMAGE,val) #ifdef HASGTK28 ML_1(gtk_image_clear, GtkImage_val, Unit) #else Unsupported_28(gtk_image_clear) #endif /* gtklabel.h */ #define GtkLabel_val(val) check_cast(GTK_LABEL,val) ML_2 (gtk_label_set_text, GtkLabel_val, String_val, Unit) ML_1 (gtk_label_get_text, GtkLabel_val, Val_string) ML_3 (gtk_label_select_region, GtkLabel_val, Int_val, Int_val, Unit) CAMLprim value ml_gtk_label_get_selection_bounds (value label) { gint s, e; value r; if (gtk_label_get_selection_bounds (GtkLabel_val(label), &s, &e)) { r = alloc_small(2, 0); Field(r, 0) = Val_int(s); Field(r, 1) = Val_int(e); r = ml_some(r); } else r = Val_unit; return r; } /* gtktipsquery.h */ #define GtkTipsQuery_val(val) check_cast(GTK_TIPS_QUERY,val) ML_1 (gtk_tips_query_start_query, GtkTipsQuery_val, Unit) ML_1 (gtk_tips_query_stop_query, GtkTipsQuery_val, Unit) /* gtkpixmap.h */ /* gtk[hv]separator.h */ lablgtk-2.18.8/src/gData.ml0000644000175000017500000001307113460263323014427 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkBase open GtkData open GObj open OgtkBaseProps class adjustment_signals obj = object (self) inherit gtkobj_signals_impl obj inherit adjustment_sigs end class adjustment obj = object (self) inherit gtkobj obj inherit adjustment_props method as_adjustment : Gtk.adjustment obj = obj method connect = new adjustment_signals obj method clamp_page = Adjustment.clamp_page obj method set_bounds ?lower ?upper ?step_incr ?page_incr ?page_size () = may self#set_lower lower; may self#set_upper upper; may self#set_step_increment step_incr; may self#set_page_increment page_incr; may self#set_page_size page_size end let adjustment ?(value=0.) ?(lower=0.) ?(upper=100.) ?(step_incr=1.) ?(page_incr=10.) ?(page_size=10.) () = let w = Adjustment.create ~value ~lower ~upper ~step_incr ~page_incr ~page_size in new adjustment w let as_adjustment (adj : adjustment) = adj#as_adjustment let wrap_adjustment w = new adjustment (unsafe_cast w) let unwrap_adjustment w = unsafe_cast w#as_adjustment let conv_adjustment_option = { kind = `OBJECT; proj = (function `OBJECT c -> may_map ~f:wrap_adjustment c | _ -> failwith "GObj.get_object"); inj = (fun c -> `OBJECT (may_map ~f:unwrap_adjustment c)) } let conv_adjustment = { kind = `OBJECT; proj = (function `OBJECT (Some c) -> wrap_adjustment c | `OBJECT None -> raise Gpointer.Null | _ -> failwith "GObj.get_object"); inj = (fun c -> `OBJECT (Some (unwrap_adjustment c))) } class tooltips obj = object inherit gtkobj (obj : Gtk.tooltips obj) method as_tooltips = obj method connect = new gtkobj_signals_impl obj method enable () = Tooltips.enable obj method disable () = Tooltips.disable obj method set_tip ?text ?privat w = Tooltips.set_tip obj (as_widget w) ?text ?privat method set_delay = Tooltips.set_delay obj end let tooltips ?delay () = let tt = Tooltips.create () in may delay ~f:(Tooltips.set_delay tt); new tooltips tt class clipboard_skel clip = object (self) method as_clipboard = Lazy.force clip method clear () = self#call_clear; Clipboard.clear self#as_clipboard method set_text = self#call_clear; Clipboard.set_text self#as_clipboard method text = Clipboard.wait_for_text self#as_clipboard method set_image = self#call_clear; Clipboard.set_image self#as_clipboard method image = Clipboard.wait_for_image self#as_clipboard method targets = Clipboard.wait_for_targets self#as_clipboard method get_contents ~target = new GObj.selection_data (Clipboard.wait_for_contents self#as_clipboard ~target) method private call_clear = () end (* Additions by SooHyoung Oh *) let default_get_cb context ~info ~time = () class clipboard ~selection = object (self) inherit clipboard_skel (lazy (GtkBase.Clipboard.get selection)) val mutable widget = None val mutable get_cb = default_get_cb val mutable clear_cb = None method private call_get context ~info ~time = get_cb context ~info ~time method private call_clear = match clear_cb with None -> () | Some cb -> get_cb <- default_get_cb; clear_cb <- None; cb () method private init_widget = match widget with Some w -> w | None -> let w = new GObj.widget (GtkBin.Invisible.create []) in widget <- Some w; ignore (w#misc#connect#selection_get ~callback:self#call_get); ignore ((new GObj.event_signals w#as_widget)#selection_clear ~callback:(fun _ -> self#call_clear; true)); w method set_contents ~targets ~get:get_func ~clear:clear_func = let widget : widget = self#init_widget in self#call_clear; get_cb <- get_func; clear_cb <- Some clear_func; widget#misc#grab_selection selection; widget#misc#clear_selection_targets selection; List.iter (fun target -> widget#misc#add_selection_target ~target selection) targets end let clipboard selection = new clipboard ~selection let as_clipboard clip = clip#as_clipboard lablgtk-2.18.8/src/gtkEdit.ml0000644000175000017500000001136513460263323015006 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject open Gtk open Tags open GtkEditProps open GtkBase external _gtkedit_init : unit -> unit = "ml_gtkedit_init" let () = _gtkedit_init () module Editable = struct include Editable let marshal_insert f argv = match List.tl (Closure.get_args argv) with | `STRING _ :: `INT len :: `POINTER(Some p) :: _ -> (* XXX These two accesses are implementation-dependent *) let s = Gpointer.peek_string (Closure.get_pointer argv ~pos:1) ~len and pos = ref (Gpointer.peek_int p) in (f s ~pos : unit); Gpointer.poke_int p !pos | _ -> invalid_arg "GtkEdit.Editable.marshal_insert" let () = Internal.marshal_insert := marshal_insert end module Entry = Entry module SpinButton = struct include SpinButton let get_value_as_int w = truncate (floor (get P.value w +. 0.5)) end (* module Text = struct let cast w : text obj = Object.try_cast w "GtkText" external create : [>`adjustment] optobj -> [>`adjustment] optobj -> text obj = "ml_gtk_text_new" let create ?hadjustment ?vadjustment () = create (Gpointer.optboxed hadjustment) (Gpointer.optboxed vadjustment) external set_word_wrap : [>`text] obj -> bool -> unit = "ml_gtk_text_set_word_wrap" external set_line_wrap : [>`text] obj -> bool -> unit = "ml_gtk_text_set_line_wrap" external set_adjustment : [>`text] obj -> ?horizontal:[>`adjustment] obj -> ?vertical:[>`adjustment] obj -> unit -> unit = "ml_gtk_text_set_adjustments" external get_hadjustment : [>`text] obj -> adjustment obj = "ml_gtk_text_get_hadj" external get_vadjustment : [>`text] obj -> adjustment obj = "ml_gtk_text_get_vadj" external set_point : [>`text] obj -> int -> unit = "ml_gtk_text_set_point" external get_point : [>`text] obj -> int = "ml_gtk_text_get_point" external get_length : [>`text] obj -> int = "ml_gtk_text_get_length" external freeze : [>`text] obj -> unit = "ml_gtk_text_freeze" external thaw : [>`text] obj -> unit = "ml_gtk_text_thaw" external insert : [>`text] obj -> ?font:Gdk.font -> ?foreground:Gdk.Color.t -> ?background:Gdk.Color.t -> string -> unit = "ml_gtk_text_insert" let set ?hadjustment ?vadjustment ?word_wrap w = if hadjustment <> None || vadjustment <> None then set_adjustment w ?horizontal: hadjustment ?vertical: vadjustment (); may word_wrap ~f:(set_word_wrap w) end *) module Combo = struct include Combo external entry : [>`combo] obj -> entry obj = "ml_gtk_combo_entry" external list : [>`combo] obj -> liste obj = "ml_gtk_combo_list" let set_popdown_strings combo strings = GtkList.Liste.clear_items (list combo) ~start:0 ~stop:(-1); List.iter strings ~f: begin fun s -> let li = GtkList.ListItem.create_with_label s in Widget.show li; Container.add (list combo) li end external disable_activate : [>`combo] obj -> unit = "ml_gtk_combo_disable_activate" external set_item_string : [>`combo] obj -> [>`item] obj -> string -> unit = "ml_gtk_combo_set_item_string" end module ComboBox = GtkEditProps.ComboBox module ComboBoxEntry = GtkEditProps.ComboBoxEntry module EntryCompletion = GtkEditProps.EntryCompletion lablgtk-2.18.8/src/gAction.mli0000644000175000017500000002534613460263323015154 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject (** Action-based menus and toolbars *) (** {3 GtkAction} *) (** @since GTK 2.4 @gtkdoc gtk GtkAction *) class action_signals : ([> Gtk.action ] as 'b) obj -> object ('a) val obj : 'b obj val after : bool method after : < after : 'a; .. > as 'a method activate : callback:(unit -> unit) -> GtkSignal.id method notify_hide_if_empty : callback:(bool -> unit) -> GtkSignal.id method notify_icon_name : callback:(string -> unit) -> GtkSignal.id method notify_is_important : callback:(bool -> unit) -> GtkSignal.id method notify_label : callback:(string -> unit) -> GtkSignal.id method notify_name : callback:(string -> unit) -> GtkSignal.id method notify_sensitive : callback:(bool -> unit) -> GtkSignal.id method notify_short_label : callback:(string -> unit) -> GtkSignal.id method notify_stock_id : callback:(GtkStock.id -> unit) -> GtkSignal.id method notify_tooltip : callback:(string -> unit) -> GtkSignal.id method notify_visible : callback:(bool -> unit) -> GtkSignal.id method notify_visible_horizontal : callback:(bool -> unit) -> GtkSignal.id method notify_visible_vertical : callback:(bool -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkAction *) class action_skel : ([> Gtk.action ] as 'a) obj -> object val obj : 'a obj method as_action : Gtk.action obj (** Properties *) method hide_if_empty : bool method set_hide_if_empty : bool -> unit method is_important : bool method set_is_important : bool -> unit method icon_name : string (** @since GTK 2.10 *) method set_icon_name : string -> unit (** @since GTK 2.10 *) method label : string method set_label : string -> unit method name : string method sensitive : bool method set_sensitive : bool -> unit method short_label : string method set_short_label : string -> unit method stock_id : GtkStock.id method set_stock_id : GtkStock.id -> unit method tooltip : string method set_tooltip : string -> unit method visible : bool method set_visible : bool -> unit method visible_horizontal : bool method set_visible_horizontal : bool -> unit method visible_vertical : bool method set_visible_vertical : bool -> unit (** Other methods *) method is_sensitive : bool method is_visible : bool method activate : unit -> unit method connect_proxy : GObj.widget -> unit method disconnect_proxy : GObj.widget -> unit method get_proxies : GObj.widget list method connect_accelerator : unit -> unit method disconnect_accelerator : unit -> unit method set_accel_path : string -> unit method set_accel_group : Gtk.accel_group -> unit method block_activate_from : GObj.widget -> unit method unblock_activate_from : GObj.widget -> unit end (** @since GTK 2.4 @gtkdoc gtk GtkAction *) class action : ([> Gtk.action ] as 'a) obj -> object inherit action_skel val obj : 'a obj method connect : action_signals end (** @since GTK 2.4 @gtkdoc gtk GtkAction *) val action : name:string -> unit -> action (** @since GTK 2.4 @gtkdoc gtk GtkToggleAction *) class toggle_action_signals : ([> Gtk.toggle_action ] as 'b) obj -> object inherit action_signals val obj : 'b obj method toggled : callback:(unit -> unit) -> GtkSignal.id method notify_draw_as_radio : callback:(bool -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkToggleAction *) class toggle_action_skel : ([> Gtk.toggle_action ] as 'a) obj -> object inherit action_skel val obj : 'a obj method draw_as_radio : bool method get_active : bool method set_active : bool -> unit method set_draw_as_radio : bool -> unit method toggled : unit -> unit end (** @since GTK 2.4 @gtkdoc gtk GtkToggleAction *) class toggle_action : ([> Gtk.toggle_action ] as 'a) obj -> object inherit toggle_action_skel val obj : 'a obj method connect : toggle_action_signals end (** @since GTK 2.4 @gtkdoc gtk GtkToggleAction *) val toggle_action : name:string -> unit -> toggle_action (** @since GTK 2.4 @gtkdoc gtk GtkRadioAction *) class radio_action_signals : ([> Gtk.radio_action] as 'b) obj -> object inherit toggle_action_signals val obj : 'b obj method changed : callback:(int -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkRadioAction *) class radio_action : ([> Gtk.radio_action] as 'a) obj -> object inherit toggle_action_skel val obj : 'a obj method connect : radio_action_signals method as_radio_action : Gtk.radio_action obj method get_current_value : int method set_group : Gtk.radio_action Gtk.group -> unit method set_value : int -> unit method value : int end (** @since GTK 2.4 @gtkdoc gtk GtkRadioAction *) val radio_action : ?group:radio_action -> name:string -> value:int -> unit -> radio_action (** {3 GtkActionGroup} *) (** @since GTK 2.4 @gtkdoc gtk GtkActionGroup *) class action_group_signals : ([> Gtk.action_group ] as 'b) obj -> object ('a) val after : bool val obj : 'b obj method after : 'a method connect_proxy : callback:(action -> GObj.widget -> unit) -> GtkSignal.id method disconnect_proxy : callback:(action -> GObj.widget -> unit) -> GtkSignal.id method post_activate : callback:(action -> unit) -> GtkSignal.id method pre_activate : callback:(action -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkActionGroup *) class action_group : ([> Gtk.action_group ] as 'a) obj -> object val obj : 'a obj method as_group : Gtk.action_group obj method connect : action_group_signals method sensitive : bool method set_sensitive : bool -> unit method visible : bool method set_visible : bool -> unit method add_action : #action_skel -> unit method add_action_with_accel : ?accel:string -> #action_skel -> unit method remove_action : #action_skel -> unit method get_action : string -> action method list_actions : action list method name : string end (** @since GTK 2.4 @gtkdoc gtk GtkActionGroup *) val action_group : name:string -> unit -> action_group type 'a entry = action_group -> 'a val add_action : string -> ?callback:(action -> unit) -> ?stock:GtkStock.id -> ?label:string -> ?accel:string -> ?tooltip:string -> unit entry val add_toggle_action : string -> ?active:bool -> ?callback:(toggle_action -> unit) -> ?stock:GtkStock.id -> ?label:string -> ?accel:string -> ?tooltip:string -> unit entry val add_radio_action : string -> int -> ?stock:GtkStock.id -> ?label:string -> ?accel:string -> ?tooltip:string -> radio_action entry val group_radio_actions : ?init_value:int -> ?callback:(int -> unit) -> radio_action entry list -> unit entry val add_actions : action_group -> unit entry list -> unit (** {3 GtkUIManager} *) (** @since GTK 2.4 @gtkdoc gtk GtkUIManager *) class ui_manager_signals : ([> Gtk.ui_manager] as 'b) Gtk.obj -> object ('a) val after : bool val obj : 'b Gtk.obj method after : 'a method actions_changed : callback:(unit -> unit) -> GtkSignal.id method add_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method connect_proxy : callback:(action -> GObj.widget -> unit) -> GtkSignal.id method disconnect_proxy : callback:(action -> GObj.widget -> unit) -> GtkSignal.id method post_activate : callback:(action -> unit) -> GtkSignal.id method pre_activate : callback:(action -> unit) -> GtkSignal.id method notify_add_tearoffs : callback:(bool -> unit) -> GtkSignal.id method notify_ui : callback:(string -> unit) -> GtkSignal.id end type ui_id val invalid_id : ui_id (** @since GTK 2.4 @gtkdoc gtk GtkUIManager *) class ui_manager : ([> Gtk.ui_manager] as 'a) Gtk.obj -> object val obj : 'a Gtk.obj method as_ui_manager : Gtk.ui_manager Gtk.obj method add_tearoffs : bool method add_ui_from_file : string -> ui_id (** @raise Glib.Markup.Error if the XML is invalid @raise Glib.GError if an error occurs while reading the file *) method add_ui_from_string : string -> ui_id (** @raise Glib.Markup.Error if the XML is invalid *) method connect : ui_manager_signals method ensure_update : unit -> unit method get_accel_group : Gtk.accel_group method get_action : string -> action (** @raise Not_found if no widget exist at the given path *) method get_action_groups : action_group list method get_widget : string -> GObj.widget (** @raise Not_found if no widget exist at the given path *) method get_toplevels : GtkEnums.ui_manager_item_type list -> GObj.widget list method insert_action_group : action_group -> int -> unit method new_merge_id : unit -> ui_id method add_ui : ui_id -> path:string -> name:string -> action:string option -> GtkEnums.ui_manager_item_type -> top:bool -> unit method remove_action_group : action_group -> unit method remove_ui : ui_id -> unit method set_add_tearoffs : bool -> unit method ui : string end (** @since GTK 2.4 @gtkdoc gtk GtkUIManager *) val ui_manager : unit -> ui_manager lablgtk-2.18.8/src/glib.mli0000644000175000017500000002374313460263323014504 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** Interface to Glib functions @gtkdoc glib index *) type unichar = int type unistring = unichar array exception GError of string (** {3 Main Event Loop} *) (** The Main Event Loop @gtkdoc glib glib-The-Main-Event-Loop *) module Main : sig type t val create : bool -> t val iteration : bool -> bool val pending : unit -> bool val is_running : t -> bool val quit : t -> unit val destroy : t -> unit type locale_category = [ `ALL | `COLLATE | `CTYPE | `MESSAGES | `MONETARY | `NUMERIC | `TIME ] val setlocale : locale_category -> string option -> string val wrap_poll_func : unit -> unit end val int_of_priority : [< `HIGH | `DEFAULT | `HIGH_IDLE | `DEFAULT_IDLE | `LOW] -> int (** @gtkdoc glib glib-The-Main-Event-Loop *) module Timeout : sig type id val add : ms:int -> callback:(unit -> bool) -> id val remove : id -> unit end (** @gtkdoc glib glib-The-Main-Event-Loop *) module Idle : sig type id val add : ?prio:int -> (unit -> bool) -> id val remove : id -> unit end (** {3 IO Channels} *) (** IO Channels @gtkdoc glib glib-IO-Channels *) module Io : sig (** Io condition, called from the main loop *) type channel type condition = [ `ERR | `HUP | `IN | `NVAL | `OUT | `PRI] type id val channel_of_descr : Unix.file_descr -> channel val add_watch : cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id val remove : id -> unit val read : channel -> buf:bytes -> pos:int -> len:int -> int val read_chars : channel -> buf:bytes -> pos:int -> len:int -> int end (** {3 Message Logging} *) (** @gtkdoc glib glib-Message-Logging *) module Message : sig type log_level = [ `CRITICAL | `DEBUG | `ERROR | `FLAG_FATAL | `FLAG_RECURSION | `INFO | `MESSAGE | `WARNING] val log_level : [< log_level|`CUSTOM of int] -> int type log_handler val set_log_handler : ?domain:string -> levels:log_level list -> (level:int -> string -> unit) -> log_handler val remove_log_handler : log_handler -> unit val set_always_fatal : log_level list -> unit val set_fatal_mask : ?domain:string -> [log_level|`CUSTOM of int] list -> unit val log : ?domain:string -> [log_level|`CUSTOM of int] -> ('a, unit, string, unit) format4 -> 'a end (* module Thread : sig val init : unit -> unit (* Call only once! *) val enter : unit -> unit val leave : unit -> unit end *) (** {3 Character Sets} *) (** Character Set Conversion @gtkdoc glib glib-Character-Set-Conversion *) module Convert : sig type error = | NO_CONVERSION (** Conversion between the requested character sets is not supported *) | ILLEGAL_SEQUENCE (** Invalid byte sequence in conversion input *) | FAILED (** Conversion failed for some reason *) | PARTIAL_INPUT (** Partial character sequence at end of input *) | BAD_URI (** URI is invalid *) | NOT_ABSOLUTE_PATH (** Pathname is not an absolute path *) exception Error of error * string val convert : string -> to_codeset:string -> from_codeset:string -> string (** @raise Error . *) val convert_with_fallback : ?fallback:string -> to_codeset:string -> from_codeset:string -> string -> string (** @raise Error . *) (** All internal strings are encoded in utf8: you should use the following conversion functions *) val locale_from_utf8 : string -> string (** Converts the input string from [UTF-8] to the encoding of the current locale. If the locale's encoding is [UTF-8], the string is simply validated and returned unmodified. @raise Error if the conversion fails @raise Error if the string is not a valid [UTF-8] string *) val locale_to_utf8 : string -> string (** @raise Error . *) (** Converts the input string from the encoding of the current locale to [UTF-8]. If the locale's encoding is [UTF-8], the string is simply validated and returned unmodified. @raise Error if the conversion fails @raise Error if the string is not a valid [UTF-8] string *) val filename_from_utf8 : string -> string (** @raise Error . *) val filename_to_utf8 : string -> string (** @raise Error . *) val filename_from_uri : string -> string option * string (** @raise Error . *) val filename_to_uri : ?hostname:string -> string -> string (** @raise Error . *) val get_charset : unit -> bool * string (** Obtains the character set for the current locale. @return the pair [u,s] where [u] is true if the character set is [UTF-8] and [s] is the character set name *) end (** Unicode Manipulation @gtkdoc glib glib-Unicode-Manipulation *) module Unichar : sig val to_lower : unichar -> unichar val to_upper : unichar -> unichar val to_title : unichar -> unichar val digit_value : unichar -> int val xdigit_value : unichar -> int val validate : unichar -> bool val isalnum : unichar -> bool val isalpha : unichar -> bool val iscntrl : unichar -> bool val isdigit : unichar -> bool val isgraph : unichar -> bool val islower : unichar -> bool val isprint : unichar -> bool val ispunct : unichar -> bool val isspace : unichar -> bool val isupper : unichar -> bool val isxdigit : unichar -> bool val istitle : unichar -> bool val isdefined : unichar -> bool val iswide : unichar -> bool end (** Unicode Manipulation @gtkdoc glib glib-Unicode-Manipulation *) module Utf8 : sig (** UTF-8 handling, and conversion to UCS-4 *) (** If you read an UTF-8 string from somewhere, you should validate it, or risk random segmentation faults *) val validate : string -> bool val length : string -> int (** [from_unichar 0xiii] converts a code point [iii] (usually in hexadecimal form) into a string containing the UTF-8 encoded character [0xiii]. See {{:http://www.unicode.org/}unicode.org} for charmaps. Does not check that the given code point is a valid unicode point. *) val from_unichar : unichar -> string val from_unistring : unistring -> string (** [to_unichar_validated] decodes an UTF-8 encoded code point and checks for incomplete characters, invalid characters and overlong encodings. @raise Convert.Error if invalid *) val to_unichar_validated : string -> pos:int ref -> unichar (** [to_unichar] decodes an UTF-8 encoded code point. Result is undefined if [pos] does not point to a valid UTF-8 encoded character. *) val to_unichar : string -> pos:int ref -> unichar (** [to_unistring] decodes an UTF-8 encoded string into an array of [unichar]. The string {e must} be valid. *) val to_unistring : string -> unistring val first_char : string -> unichar val offset_to_pos : string -> pos:int -> off:int -> int type normalize_mode = [ `DEFAULT | `DEFAULT_COMPOSE | `ALL | `ALL_COMPOSE ] val normalize : string -> normalize_mode -> string val uppercase : string -> string val lowercase : string -> string val casefold : string -> string val collate : string -> string -> int val collate_key : string -> string end (** @gtkdoc glib glib-Simple-XML-Subset-Parser *) module Markup : sig type error = | BAD_UTF8 | EMPTY | PARSE | UNKNOWN_ELEMENT | UNKNOWN_ATTRIBUTE | INVALID_CONTENT exception Error of error * string val escape_text : string -> string end (** {3 Miscellaneous Utility Functions} *) val get_prgname : unit -> string val set_prgname : string -> unit val get_application_name : unit -> string (** @since GTK 2.2 *) val set_application_name : string -> unit (** @since GTK 2.2 *) val get_user_name : unit -> string val get_real_name : unit -> string val get_home_dir : unit -> string option val get_tmp_dir : unit -> string val find_program_in_path : string -> string (** @raise Not_found if the program is not found in the path or is not executable *) val getenv : string -> string (** @raise Not_found if the environment variable is not found. *) val setenv : string -> string -> bool -> unit (** @raise Failure if the environment variable couldn't be set. @since GTK 2.4 *) val unsetenv : string -> unit (** @since GTK 2.4 *) val get_user_cache_dir : unit -> string (** @since GTK 2.6 *) val get_user_data_dir : unit -> string (** @since GTK 2.6 *) val get_user_config_dir : unit -> string (** @since GTK 2.6 *) val get_system_data_dirs : unit -> string list (** @since GTK 2.6 *) val get_system_config_dirs : unit -> string list (** @since GTK 2.6 *) val usleep : int -> unit lablgtk-2.18.8/src/lablgladecc.ml0000644000175000017500000004055713460263323015635 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Printf let debug = ref false let hide_default_names = ref false let warning s = prerr_string "Warning: "; prerr_endline s (* One can roughly get defined classes by: *) (* grep Object.try_cast *.ml | sed 's/gtk\([^.]*\)[^"]*"Gtk\([^"]*\)".*/ "Gtk\2", ("Gtk\1.\2", "G\1.\2");/' *) (* But you also need to do some post-editing. Do not forget H and V classes *) let classes = ref [ "GtkWidget", ("GtkBase.Widget", "GObj.widget_full"); "GtkContainer", ("GtkBase.Container", "GContainer.container"); "GtkBin", ("GtkBase.Container", "GContainer.container"); "GtkItem", ("GtkBase.Container", "GContainer.container"); "GtkAlignment", ("GtkBin.Alignment", "GBin.alignment"); "GtkEventBox", ("GtkBin.EventBox", "GBin.event_box"); "GtkFrame", ("GtkBin.Frame", "GBin.frame"); "GtkAspectFrame", ("GtkBin.AspectFrame", "GBin.aspect_frame"); "GtkHandleBox", ("GtkBin.HandleBox", "GBin.handle_box"); "GtkViewport", ("GtkBin.Viewport", "GBin.viewport"); "GtkScrolledWindow", ("GtkBin.ScrolledWindow", "GBin.scrolled_window"); "GtkSocket", ("GtkWindow.Socket", "GWindow.socket"); "GtkInvisible", ("GtkBase.Container", "GContainer.container"); "GtkButton", ("GtkButton.Button", "GButton.button"); "button", ("GtkButton.Button", "GButton.button"); "GtkToggleButton", ("GtkButton.ToggleButton", "GButton.toggle_button"); "GtkCheckButton", ("GtkButton.ToggleButton", "GButton.toggle_button"); "GtkRadioButton", ("GtkButton.RadioButton", "GButton.radio_button"); "GtkToolbar", ("GtkButton.Toolbar", "GButton.toolbar"); "GtkEditable", ("GtkEdit.Editable", "GEdit.editable"); "GtkEntry", ("GtkEdit.Entry", "GEdit.entry"); "GtkSpinButton", ("GtkEdit.SpinButton", "GEdit.spin_button"); "GtkCombo", ("GtkEdit.Combo", "GEdit.combo"); "GtkListItem", ("GtkList.ListItem", "GList.list_item"); "GtkList", ("GtkList.Liste", "GList.liste"); "GtkCList", ("GtkList.CList", "GList.clist"); "GtkMenuItem", ("GtkMenu.MenuItem", "GMenu.menu_item"); "GtkSeparatorMenuItem", ("GtkMenu.MenuItem", "GMenu.menu_item"); "GtkTearoffMenuItem", ("GtkMenu.MenuItem", "GMenu.menu_item"); "GtkCheckMenuItem", ("GtkMenu.CheckMenuItem", "GMenu.check_menu_item"); "GtkRadioMenuItem", ("GtkMenu.RadioMenuItem", "GMenu.radio_menu_item"); "GtkImageMenuItem", ("GtkMenu.ImageMenuItem", "GMenu.image_menu_item"); "GtkOptionMenu", ("GtkMenu.OptionMenu", "GMenu.option_menu"); "GtkMenuShell", ("GtkMenu.MenuShell", "GMenu.menu_shell"); "GtkMenu", ("GtkMenu.Menu", "GMenu.menu"); "GtkMenuBar", ("GtkMenu.MenuBar", "GMenu.menu_shell"); "GtkColorSelection", ("GtkMisc.ColorSelection", "GMisc.color_selection"); "GtkStatusbar", ("GtkMisc.Statusbar", "GMisc.statusbar"); "GtkCalendar", ("GtkMisc.Calendar", "GMisc.calendar"); "GtkDrawingArea", ("GtkMisc.DrawingArea", "GMisc.drawing_area"); "GtkCurve", ("GtkMisc.DrawingArea", "GMisc.drawing_area"); "GtkMisc", ("GtkMisc.Misc", "GMisc.misc"); "GtkArrow", ("GtkMisc.Arrow", "GMisc.arrow"); "GtkImage", ("GtkMisc.Image", "GMisc.image"); "GtkLabel", ("GtkMisc.Label", "GMisc.label"); "GtkTipsQuery", ("GtkMisc.TipsQuery", "GMisc.tips_query"); "GtkPixmap", ("GtkMisc.Image", "GMisc.image"); "GtkSeparator", ("GtkMisc.Separator", "GObj.widget_full"); "GtkHSeparator", ("GtkMisc.Separator", "GObj.widget_full"); "GtkVSeparator", ("GtkMisc.Separator", "GObj.widget_full"); "GtkFontSelection", ("GtkMisc.FontSelection", "GMisc.font_selection"); "GtkBox", ("GtkPack.Box", "GPack.box"); "GtkHBox", ("GtkPack.Box", "GPack.box"); "GtkVBox", ("GtkPack.Box", "GPack.box"); "GtkBBox", ("GtkPack.BBox", "GPack.button_box"); "GtkHButtonBox", ("GtkPack.BBox", "GPack.button_box"); "GtkVButtonBox", ("GtkPack.BBox", "GPack.button_box"); "GtkFixed", ("GtkPack.Fixed", "GPack.fixed"); "GtkLayout", ("GtkPack.Layout", "GPack.layout"); (* "GtkPacker", ("GtkPack.Packer", "GPack.packer"); *) "GtkHPaned", ("GtkPack.Paned", "GPack.paned"); "GtkVPaned", ("GtkPack.Paned", "GPack.paned"); "GtkTable", ("GtkPack.Table", "GPack.table"); "GtkNotebook", ("GtkPack.Notebook", "GPack.notebook"); (* "GtkProgress", ("GtkRange.Progress", "GRange.progress"); *) "GtkProgressBar", ("GtkRange.ProgressBar", "GRange.progress_bar"); "GtkRange", ("GtkRange.Range", "GRange.range"); "GtkScale", ("GtkRange.Scale", "GRange.scale"); "GtkHScale", ("GtkRange.Scale", "GRange.scale"); "GtkVScale", ("GtkRange.Scale", "GRange.scale"); "GtkScrollbar", ("GtkRange.Scrollbar", "GRange.range"); "GtkHScrollbar", ("GtkRange.Scrollbar", "GRange.range"); "GtkVScrollbar", ("GtkRange.Scrollbar", "GRange.range"); "GtkRuler", ("GtkRange.Ruler", "GRange.ruler"); "GtkHRuler", ("GtkRange.Ruler", "GRange.ruler"); "GtkVRuler", ("GtkRange.Ruler", "GRange.ruler"); (* "GtkTextMark", ("GtkText.Mark", "GText.mark"); *) "GtkTextTag", ("GtkText.Tag", "GText.tag"); (* "GtkTextTagTable", ("GtkText.TagTable", "GText.tag_table");*) "GtkTextBuffer", ("GtkText.Buffer", "GText.buffer"); (* "GtkTextChildAnchor", ("GtkText.ChildAnchor", "GText.child_anchor");*) "GtkTextView", ("GtkText.View", "GText.view"); "GtkTreeItem", ("GtkTree.TreeItem", "GTree.tree_item"); "GtkTreeView", ("GtkTree.TreeView", "GTree.view"); "GtkTree", ("GtkTree.Tree", "GTree.tree"); "GtkCTree", ("GtkBase.Container", "GContainer.container"); "GtkWindow", ("GtkWindow.Window", "GWindow.window"); "GtkDialog", ("GtkWindow.Dialog", "GWindow.dialog_any"); "GtkMessageDialog", ("GtWindow.MessageDialog", "GWindow.message_dialog"); "GtkAboutDialog", ("GtkWindow.AboutDialog", "GWindow.about_dialog"); "GtkInputDialog", ("GtkWindow.Dialog", "GWindow.dialog"); "GtkFileSelection", ("GtkWindow.FileSelection", "GWindow.file_selection"); "GtkFontSelectionDialog", ("GtkWindow.FontSelectionDialog", "GWindow.font_selection_dialog"); "GtkColorSelectionDialog", ("GtkWindow.ColorSelectionDialog", "GWindow.color_selection_dialog"); "GtkPlug", ("GtkWindow.Plug", "GWindow.plug"); "GtkFileChooserButton", ("GtkFile.FileChooserButton", "GFile.chooser_button"); "GtkColorButton", ("GtkButton.ColorButton", "GButton.color_button"); "GtkFontButton", ("GtkButton.FontButton", "GButton.font_button"); "GtkExpander", ("GtkBin.Expander", "GBin.expander"); "GtkToolItem", ("GtkButton.ToolItem", "GButton.tool_item"); "GtkToolButton", ("GtkButton.ToolButton", "GButton.tool_button"); "GtkToggleToolButton", ("GtkButton.ToggleToolButton", "GButton.toggle_tool_button"); "GtkRadioToolButton", ("GtkButton.RadioToolButton", "GButton.radio_tool_button"); "GtkSeparatorToolItem", ("GtkButton.SeparatorToolItem", "GButton.separator_tool_item"); "GtkIconView", ("GtkTree.IconView", "GTree.icon_view"); "GtkComboBox", ("GtkEdit.ComboBox", "GEdit.combo_box"); "GtkComboBoxEntry", ("GtkEdit.ComboBoxEntry", "GEdit.combo_box_entry"); ] open Xml_lexer let parse_header lexbuf = match token lexbuf with | Tag ("glade-interface",_,_) -> () | _ -> failwith "no glade-interface declaration" let parse_field lexbuf ~tag = let b = Buffer.create 80 and first = ref true in while match token lexbuf with Chars s -> if not !first then Buffer.add_char b '\n' else first := false; Buffer.add_string b s; true | Endtag tag' when tag = tag' -> false | _ -> failwith "bad field" do () done; Buffer.contents b type wtree = { wclass: string; wname: string; wcamlname : string; winternal: bool; wchildren: wtree list; mutable wrapped: bool; } exception Unsupported (* map arbitrary strings to caml identifiers. Clashes may occur! *) let camlize s = match s with | "" -> "_" | s -> let s = String.uncapitalize_ascii s in let s = Bytes.unsafe_of_string s in for i = 0 to Bytes.length s - 1 do match Bytes.get s i with | 'a'..'z'| 'A'..'Z' | '0'..'9' -> () | _ -> Bytes.set s i '_' done; Bytes.unsafe_to_string s (* this name is a default one created by glade? *) let is_default_name s = let l = String.length s in let rec search p = if p < 0 then raise Not_found else match s.[p] with | '0'..'9' -> search (p-1) | _ -> p+1 in try let pos = search (l-1) in pos > 0 && pos <> l with | _ -> false let is_top_widget wtree w = match wtree.wchildren with | [w'] -> w.wcamlname = w'.wcamlname && not w.winternal | _ -> false let rec parse_widget ~wclass ~wname ~internal lexbuf = let widgets = ref [] in while match token lexbuf with | Tag ("widget", attrs, closed) -> widgets := parse_widget ~wclass:(List.assoc "class" attrs) ~internal ~wname:(List.assoc "id" attrs) lexbuf :: !widgets; true | Tag ("child",attrs,_) -> let is_internal = try List.assoc "internal-child" attrs <> "" with Not_found -> false in Stack.push is_internal internal; true | Endtag "child" -> ignore(Stack.pop internal); true | Tag (tag,_,closed) -> if not closed then while token lexbuf <> Endtag tag do () done; true | Endtag "widget" -> false | Chars _ -> true | Endtag _ | EOF -> failwith "bad XML syntax" do () done; let internal = try Stack.top internal with _ -> false in { wclass = wclass; wname = wname; wcamlname = camlize wname; winternal = internal; wchildren = List.rev !widgets; wrapped = false } let rec flatten_tree w = let children = List.map ~f:flatten_tree w.wchildren in w :: List.flatten children let output_widget w = try let (modul, clas) = List.assoc w.wclass !classes in w.wrapped <- true; begin match clas with | "GList.clist" -> printf " val %s : int %s =\n" w.wcamlname clas | _ -> printf " val %s =\n" w.wcamlname end; if !debug then printf " prerr_endline \"creating %s:%s\";\n" w.wclass w.wcamlname; 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 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 check_all = ref false let output_wrapper ~file wtree = printf "class %s %s?domain ?autoconnect(*=true*) () =\n" wtree.wcamlname (if !embed then "" else if file = "" then "~file " else "?(file=\"" ^ file ^ "\") "); output_classes := wtree.wcamlname :: !output_classes; printf " let xmldata = Glade.create %s ~root:\"%s\" ?domain () in\n" (if !embed then "~data " else "~file ") wtree.wname; print_string " object (self)\n"; printf " inherit Glade.xml %s?autoconnect xmldata\n" (if !trace then "~trace:stderr " else ""); let widgets = {wtree with wcamlname= "toplevel"} :: flatten_tree wtree in let is_hidden w = w.wcamlname = "_" || (!hide_default_names && not (is_top_widget wtree w) && is_default_name w.wname) in List.iter (List.filter (fun w -> not (is_hidden w)) widgets) ~f:output_widget; (* reparent method *) begin match wtree.wchildren with | [w] -> printf " method reparent parent =\n"; if not (is_hidden w) then printf " %s#misc#reparent parent;\n" w.wcamlname; printf " toplevel#destroy ()\n"; | _ -> () end; printf " method check_widgets () = ()\n"; (* useless, since they are already built anyway List.iter widgets ~f: (fun w -> if w.wrapped then printf " ignore self#%s;\n" w.wcamlname); *) printf " end\n" let output_check_all () = printf "\nlet check_all ?(show=false) () =\n"; printf " ignore (GMain.Main.init ());\n"; List.iter (fun cl -> printf " let %s = new %s () in\n" cl cl; printf " if show then %s#toplevel#misc#show_all ();\n" cl; printf " %s#check_widgets ();\n" cl) !output_classes; printf " if show then GMain.Main.main ()\n"; printf ";;\n"; ;; let parse_body ~file lexbuf = while match token lexbuf with Tag("project", _, closed) -> if not closed then while token lexbuf <> Endtag "project" do () done; true | Tag("widget", attrs, false) -> let wtree = parse_widget ~wclass:(List.assoc "class" attrs) ~internal:(Stack.create ()) ~wname:(List.assoc "id" attrs) lexbuf in let rec output_roots wtree = if List.mem wtree.wname ~set:!roots then output_wrapper ~file wtree; List.iter ~f:output_roots wtree.wchildren in if !roots = [] then output_wrapper ~file wtree else output_roots wtree; true | Tag(tag, _, closed) -> if not closed then while token lexbuf <> Endtag tag do () done; true | Chars _ -> true | Endtag "glade-interface" -> false | Endtag _ -> failwith "bad XML syntax" | EOF -> false do () done let process ?(file="") chan = let lexbuf, data = if !embed then begin let b = Buffer.create 1024 in let buf = String.create 1024 in while let len = input chan buf 0 1024 in Buffer.add_subbytes b buf 0 len; len > 0 do () done; let data = Buffer.contents b in Lexing.from_string data, data end else Lexing.from_channel chan, "" in try parse_header lexbuf; printf "(* Automatically generated from %s by lablgladecc *)\n\n" file; if !embed then printf "let data = \"%s\"\n\n" (String.escaped data); parse_body ~file lexbuf; if !check_all then output_check_all () with Failure s -> eprintf "lablgladecc: in %s, before char %d, %s\n" file (Lexing.lexeme_start lexbuf) s let output_test () = print_string "(* Test class definitions *)\n\n"; print_string "class test xmldata =\n object\n"; List.iter !classes ~f: begin fun (clas, _) -> output_widget {wname = "a"^clas; wcamlname = camlize ("a"^clas); winternal=false; wclass = clas; wchildren = []; wrapped = true} end; print_string " end\n\n"; print_string "let _ = print_endline \"lablgladecc test finished\"\n" let main () = let files = ref [] and test = ref false in Arg.parse [ "-test", Arg.Set test, " check lablgladecc (takes no input)"; "-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"; "-root", Arg.String (fun s -> roots := s :: !roots), " generate only a wrapper for and its children"; "-hide-default", Arg.Set hide_default_names, " hide widgets with default names like 'label23'"; "-check-all", Arg.Set check_all, " create check_all function"; ] (fun s -> files := s :: !files) "lablgladecc2 [] []"; if !test then output_test () else if !files = [] then process ~file:"" stdin else List.iter (List.rev !files) ~f: begin fun file -> let chan = open_in file in process ~file chan; close_in chan end let () = main () lablgtk-2.18.8/src/gtkBin.props0000644000175000017500000000604713460263323015365 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } oheader{ open GtkPackProps } classes { GtkAdjustment "Gtk.adjustment obj" } class Bin abstract : Container {} class Alignment set wrap : Bin { "xalign" gfloat : Read / Write "yalign" gfloat : Read / Write "xscale" gfloat : Read / Write "yscale" gfloat : Read / Write "bottom-padding" guint : Read / Write / NoSet "left-padding" guint : Read / Write / NoSet "right-padding" guint : Read / Write / NoSet "top-padding" guint : Read / Write / NoSet } class Frame set wrap : Bin { "label" gchararray_opt : Read / Write "label-widget" GtkWidget_opt : Read / Write / NoSet "label-xalign" gfloat : Read / Write "label-yalign" gfloat : Read / Write "shadow-type" GtkShadowType : Read / Write } class AspectFrame set wrap : Frame { "obey-child" gboolean : Read / Write "ratio" gfloat : Read / Write "xalign" gfloat : Read / Write "yalign" gfloat : Read / Write } class EventBox : Bin {} class Invisible : Bin { "screen" GdkScreen : Read / Write } class HandleBox set wrap wrapsig : Bin { "handle-position" GtkPositionType : Read / Write "snap-edge" GtkPositionType : Read / Write "shadow_type" GtkShadowType : Read / Write "snap-edge-set" gboolean : Read / Write / NoSet / NoWrap signal child_attached : GtkWidget signal child_detached : GtkWidget } class ScrolledWindow set wrap : Bin { "hadjustment" GtkAdjustment : Read / Write / Construct "vadjustment" GtkAdjustment : Read / Write / Construct "hscrollbar-policy"(hpolicy) GtkPolicyType : Read / Write "vscrollbar-policy"(vpolicy) GtkPolicyType : Read / Write "window-placement"(placement) GtkCornerType : Read / Write "shadow-type" GtkShadowType : Read / Write method add_with_viewport : "[>`widget] obj -> unit" signal move_focus_out : GtkDirectionType signal scroll_child : GtkScrollType gboolean } class Viewport set wrap : Bin { "hadjustment" GtkAdjustment : Read / Write "vadjustment" GtkAdjustment : Read / Write "shadow-type" GtkShadowType : Read / Write signal set_scroll_adjustments : GtkAdjustment_opt GtkAdjustment_opt } class Expander set wrap wrapsig : Bin { "expanded" gboolean : Read / Write / Construct "label" gchararray : Read / Write / Construct "label-widget" GtkWidget : Read / Write / NoSet "spacing" gint : Read / Write "use-underline" gboolean : Read / Write / Construct signal activate } lablgtk-2.18.8/src/gtkBin.ml0000644000175000017500000000377113460263323014633 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open Tags open GtkBinProps open GtkBase external _gtkbin_init : unit -> unit = "ml_gtkbin_init" let () = _gtkbin_init () module Alignment = Alignment module EventBox = EventBox module Frame = Frame module AspectFrame = AspectFrame module HandleBox = HandleBox module Viewport = Viewport module ScrolledWindow = ScrolledWindow module Invisible = Invisible module Expander = Expander lablgtk-2.18.8/src/ml_gtkbin.c0000644000175000017500000001362213460263323015171 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkbin_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_alignment_get_type() + gtk_event_box_get_type() + gtk_invisible_get_type() + gtk_frame_get_type() + gtk_aspect_frame_get_type() + gtk_handle_box_get_type() + gtk_viewport_get_type() + gtk_scrolled_window_get_type() #ifdef HASGTK24 + gtk_expander_get_type() #endif ; return Val_GType(t); } /* gtkalignment.h */ /* #define GtkAlignment_val(val) check_cast(GTK_ALIGNMENT,val) ML_4 (gtk_alignment_new, Float_val, Float_val, Float_val, Float_val, Val_GtkWidget_sink) CAMLprim value ml_gtk_alignment_set (value x, value y, value xscale, value yscale, value val) { GtkAlignment *alignment = GtkAlignment_val(val); gtk_alignment_set (alignment, Option_val(x, Float_val, alignment->xalign), Option_val(y, Float_val, alignment->yalign), Option_val(xscale, Float_val, alignment->xscale), Option_val(yscale, Float_val, alignment->xscale)); return Val_unit; } */ /* gtkeventbox.h */ /* gtkframe.h */ /* gtkaspectframe.h */ /* #define GtkAspectFrame_val(val) check_cast(GTK_ASPECT_FRAME,val) ML_5 (gtk_aspect_frame_new, Optstring_val, Float_val, Float_val, Float_val, Bool_val, Val_GtkWidget_sink) ML_5 (gtk_aspect_frame_set, GtkAspectFrame_val, Float_val, Float_val, Float_val, Bool_val, Unit) Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, xalign, copy_double) Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, yalign, copy_double) Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, ratio, copy_double) Make_Extractor (gtk_aspect_frame_get, GtkAspectFrame_val, obey_child, Val_bool) */ /* gtkhandlebox.h */ /* #define GtkHandleBox_val(val) check_cast(GTK_HANDLE_BOX,val) ML_0 (gtk_handle_box_new, Val_GtkWidget_sink) ML_2 (gtk_handle_box_set_shadow_type, GtkHandleBox_val, Shadow_type_val, Unit) ML_2 (gtk_handle_box_set_handle_position, GtkHandleBox_val, Position_type_val, Unit) ML_2 (gtk_handle_box_set_snap_edge, GtkHandleBox_val, Position_type_val, Unit) */ /* gtkinvisible.h */ /* private class ML_0 (gtk_invisible_new, Val_GtkWidget_sink) */ /* gtkviewport.h */ /* #define GtkViewport_val(val) check_cast(GTK_VIEWPORT,val) ML_2 (gtk_viewport_new, GtkAdjustment_val, GtkAdjustment_val, Val_GtkWidget_sink) ML_1 (gtk_viewport_get_hadjustment, GtkViewport_val, Val_GtkWidget_sink) ML_1 (gtk_viewport_get_vadjustment, GtkViewport_val, Val_GtkWidget) ML_2 (gtk_viewport_set_hadjustment, GtkViewport_val, GtkAdjustment_val, Unit) ML_2 (gtk_viewport_set_vadjustment, GtkViewport_val, GtkAdjustment_val, Unit) ML_2 (gtk_viewport_set_shadow_type, GtkViewport_val, Shadow_type_val, Unit) */ /* gtkscrolledwindow.h */ #define GtkScrolledWindow_val(val) check_cast(GTK_SCROLLED_WINDOW,val) /* ML_2 (gtk_scrolled_window_new, GtkAdjustment_val ,GtkAdjustment_val, Val_GtkWidget_sink) ML_2 (gtk_scrolled_window_set_hadjustment, GtkScrolledWindow_val , GtkAdjustment_val, Unit) ML_2 (gtk_scrolled_window_set_vadjustment, GtkScrolledWindow_val , GtkAdjustment_val, Unit) ML_1 (gtk_scrolled_window_get_hadjustment, GtkScrolledWindow_val, Val_GtkWidget) ML_1 (gtk_scrolled_window_get_vadjustment, GtkScrolledWindow_val, Val_GtkWidget) ML_3 (gtk_scrolled_window_set_policy, GtkScrolledWindow_val, Policy_type_val, Policy_type_val, Unit) ML_2 (gtk_scrolled_window_set_shadow_type, GtkScrolledWindow_val, Shadow_type_val, Unit) ML_1 (gtk_scrolled_window_get_shadow_type, GtkScrolledWindow_val, Val_shadow_type) Make_Extractor (gtk_scrolled_window_get, GtkScrolledWindow_val, hscrollbar_policy, Val_policy_type) Make_Extractor (gtk_scrolled_window_get, GtkScrolledWindow_val, vscrollbar_policy, Val_policy_type) ML_2 (gtk_scrolled_window_set_placement, GtkScrolledWindow_val, Corner_type_val, Unit) */ ML_2 (gtk_scrolled_window_add_with_viewport, GtkScrolledWindow_val, GtkWidget_val, Unit) lablgtk-2.18.8/src/gText.ml0000644000175000017500000006526613460263323014517 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gtk open GtkBase open GtkText open OgtkTextProps open GObj type mark_name = [`INSERT | `SEL_BOUND | `NAME of string] let mark_name = function `INSERT -> "insert" | `SEL_BOUND -> "selection_bound" | `NAME s -> s type mark = [mark_name | `MARK of text_mark] class child_anchor obj = object method get_oid = Gobject.get_oid obj method as_childanchor : text_child_anchor = obj method widgets = List.map (new widget) (ChildAnchor.get_widgets obj) method deleted = ChildAnchor.get_deleted obj end let child_anchor () = new child_anchor (ChildAnchor.create []) class tag_signals obj = object (self) inherit ['a] gobject_signals obj method event = self#connect Tag.S.event end type tag_property0 = [ | `ACCUMULATIVE_MARGIN of bool | `BACKGROUND of string | `BACKGROUND_FULL_HEIGHT of bool | `BACKGROUND_FULL_HEIGHT_SET of bool | `BACKGROUND_GDK of Gdk.color | `BACKGROUND_SET of bool | `BACKGROUND_STIPPLE of Gdk.bitmap | `BACKGROUND_STIPPLE_SET of bool | `DIRECTION of Tags.text_direction | `EDITABLE of bool | `EDITABLE_SET of bool | `FAMILY of string | `FAMILY_SET of bool | `FONT of string | `FONT_DESC of Pango.font_description | `FOREGROUND of string | `FOREGROUND_GDK of Gdk.color | `FOREGROUND_SET of bool | `FOREGROUND_STIPPLE of Gdk.bitmap | `FOREGROUND_STIPPLE_SET of bool | `INDENT of int | `INDENT_SET of bool | `INVISIBLE of bool | `INVISIBLE_SET of bool | `JUSTIFICATION of Tags.justification | `JUSTIFICATION_SET of bool | `LANGUAGE of string | `LANGUAGE_SET of bool | `LEFT_MARGIN of int | `LEFT_MARGIN_SET of bool | `PARAGRAPH_BACKGROUND of string | `PARAGRAPH_BACKGROUND_GDK of Gdk.color | `PARAGRAPH_BACKGROUND_SET of bool | `PIXELS_ABOVE_LINES of int | `PIXELS_ABOVE_LINES_SET of bool | `PIXELS_BELOW_LINES of int | `PIXELS_BELOW_LINES_SET of bool | `PIXELS_INSIDE_WRAP of int | `PIXELS_INSIDE_WRAP_SET of bool | `RIGHT_MARGIN of int | `RIGHT_MARGIN_SET of bool | `RISE of int | `RISE_SET of bool | `SCALE_SET of bool | `SIZE of int | `SIZE_POINTS of float | `SIZE_SET of bool | `STRETCH of Pango.Tags.stretch | `STRETCH_SET of bool | `STRIKETHROUGH of bool | `STRIKETHROUGH_SET of bool | `STYLE of Pango.Tags.style | `STYLE_SET of bool | `TABS_SET of bool | `UNDERLINE of Pango.Tags.underline | `UNDERLINE_SET of bool | `VARIANT of Pango.Tags.variant | `VARIANT_SET of bool | `WEIGHT_SET of bool | `WRAP_MODE of Tags.wrap_mode | `WRAP_MODE_SET of bool ] type tag_property = [ | `WEIGHT of Pango.Tags.weight | `SCALE of Pango.Tags.scale | tag_property0 ] let text_tag_param (x : tag_property) = text_tag_param (match x with | `WEIGHT w -> `WEIGHT (Pango.Tags.weight_to_int w) | `SCALE s -> `SCALE (Pango.Tags.scale_to_float s) | #tag_property0 as x -> x) class tag obj = object (self) method get_oid = Gobject.get_oid obj method as_tag : text_tag = obj method connect = new tag_signals obj method priority = Tag.get_priority obj method set_priority p = Tag.set_priority obj p (* [BM] my very first polymorphic method in OCaml...*) method event : 'a. 'a Gtk.obj -> GdkEvent.any -> Gtk.text_iter -> bool = Tag.event obj method set_property p = Gobject.set_params obj [text_tag_param p] method set_properties l = Gobject.set_params obj (List.map text_tag_param l) method get_property : 'a. (_,'a) Gobject.property -> 'a = Gobject.Property.get obj end let tag ?name () = new tag (Tag.create ?name []) type contents = [ `CHAR of Glib.unichar | `PIXBUF of GdkPixbuf.pixbuf | `CHILD of child_anchor | `UNKNOWN ] class nocopy_iter it = object(self) val it = (it:text_iter) method as_iter = it method assign (r : nocopy_iter) = Iter.assign it r#as_iter method forward_char = Iter.forward_char it method backward_char = Iter.backward_char it method forward_chars n = Iter.forward_chars it n method backward_chars n = Iter.backward_chars it n method forward_line = Iter.forward_line it method backward_line = Iter.backward_line it method forward_lines n = Iter.forward_lines it n method backward_lines n = Iter.backward_lines it n method forward_word_end = Iter.forward_word_end it method forward_word_ends n = Iter.forward_word_ends it n method backward_word_start = Iter.backward_word_start it method backward_word_starts n = Iter.backward_word_starts it n method forward_cursor_position = Iter.forward_cursor_position it method backward_cursor_position = Iter.backward_cursor_position it method forward_cursor_positions n = Iter.forward_cursor_positions it n method backward_cursor_positions n = Iter.backward_cursor_positions it n method forward_sentence_end = Iter.forward_sentence_end it method backward_sentence_start = Iter.backward_sentence_start it method forward_sentence_ends n = Iter.forward_sentence_ends it n method backward_sentence_starts n = Iter.backward_sentence_starts it n method forward_to_end = Iter.forward_to_end it method forward_to_line_end = Iter.forward_to_line_end it method forward_to_tag_toggle (tag : tag option) = Iter.forward_to_tag_toggle it (may_map tag ~f:(fun t -> t#as_tag)) method backward_to_tag_toggle (tag : tag option) = Iter.backward_to_tag_toggle it (may_map tag ~f:(fun t -> t#as_tag)) method set_offset = Iter.set_offset it method set_line = Iter.set_line it method set_line_offset = Iter.set_line_offset it method set_line_index = Iter.set_line_index it method set_visible_line_index = Iter.set_visible_line_index it method set_visible_line_offset = Iter.set_visible_line_offset it method forward_find_char ?(limit : iter option) f = Iter.forward_find_char it f (may_map limit ~f:(fun t -> t#as_iter)) method backward_find_char ?(limit : iter option) f = Iter.backward_find_char it f (may_map limit ~f:(fun t -> t#as_iter)) end and iter it = object (self) val nocopy = new nocopy_iter it val it = (it: text_iter) method nocopy = nocopy method as_iter = it method copy = new iter (Iter.copy it) method buffer = Iter.get_buffer it method offset = Iter.get_offset it method line = Iter.get_line it method line_offset = Iter.get_line_offset it method line_index = Iter.get_line_index it method visible_line_index = Iter.get_visible_line_index it method visible_line_offset = Iter.get_visible_line_offset it method char = Iter.get_char it method contents : contents = let c = Iter.get_char it in if c <> 0xfffc then `CHAR c else match Iter.get_pixbuf it with Some p -> `PIXBUF p | None -> match Iter.get_child_anchor it with Some c -> `CHILD (new child_anchor c) | None -> `UNKNOWN method get_slice ~(stop:iter) = Iter.get_slice it stop#as_iter method get_text ~(stop:iter) = Iter.get_text it stop#as_iter method get_visible_slice ~(stop:iter) = Iter.get_visible_slice it stop#as_iter method get_visible_text ~(stop:iter) = Iter.get_visible_text it stop#as_iter method marks = Iter.get_marks it method get_toggled_tags b = List.map (fun x -> new tag x) (Iter.get_toggled_tags it b) method begins_tag (tag : tag option) = Iter.begins_tag it (may_map tag ~f:(fun t -> t#as_tag)) method ends_tag (tag : tag option) = Iter.ends_tag it (may_map tag ~f:(fun t -> t#as_tag)) method toggles_tag (tag : tag option) = Iter.toggles_tag it (may_map tag ~f:(fun t -> t#as_tag)) method has_tag (t : tag) = Iter.has_tag it t#as_tag method tags = List.map (fun t -> new tag t) (Iter.get_tags it) method editable = Iter.editable it method can_insert = Iter.can_insert it method starts_word = Iter.starts_word it method ends_word = Iter.ends_word it method inside_word = Iter.inside_word it method starts_line = Iter.starts_line it method ends_line = Iter.ends_line it method starts_sentence = Iter.starts_sentence it method ends_sentence = Iter.ends_sentence it method inside_sentence = Iter.inside_sentence it method is_cursor_position = Iter.is_cursor_position it method chars_in_line = Iter.get_chars_in_line it method bytes_in_line = Iter.get_bytes_in_line it method language = Pango.Language.to_string (Iter.get_language it) method is_end = Iter.is_end it method is_start = Iter.is_start it method forward_char = let s = self#copy in s#nocopy#forward_char; s method backward_char = let s = self#copy in s#nocopy#backward_char; s method forward_chars n = let s = self#copy in s#nocopy#forward_chars n; s method backward_chars n = let s = self#copy in s#nocopy#backward_chars n; s method forward_line = let s = self#copy in s#nocopy#forward_line; s method backward_line = let s = self#copy in s#nocopy#backward_line; s method forward_lines n = let s = self#copy in s#nocopy#forward_lines n; s method backward_lines n = let s = self#copy in s#nocopy#backward_lines n; s method forward_word_end = let s = self#copy in s#nocopy#forward_word_end; s method forward_word_ends n = let s = self#copy in s#nocopy#forward_word_ends n; s method backward_word_start = let s = self#copy in s#nocopy#backward_word_start; s method backward_word_starts n = let s = self#copy in s#nocopy#backward_word_starts n; s method forward_cursor_position = let s = self#copy in s#nocopy#forward_cursor_position; s method backward_cursor_position = let s = self#copy in s#nocopy#backward_cursor_position; s method forward_cursor_positions n = let s = self#copy in s#nocopy#forward_cursor_positions n; s method backward_cursor_positions n = let s = self#copy in s#nocopy#backward_cursor_positions n; s method forward_sentence_end = let s = self#copy in s#nocopy#forward_sentence_end; s method backward_sentence_start = let s = self#copy in s#nocopy#backward_sentence_start; s method forward_sentence_ends n = let s = self#copy in s#nocopy#forward_sentence_ends n; s method backward_sentence_starts n = let s = self#copy in s#nocopy#backward_sentence_starts n; s method set_offset n = let s = self#copy in s#nocopy#set_offset n; s method set_line n = let s = self#copy in s#nocopy#set_line n; s method set_line_offset n = let s = self#copy in s#nocopy#set_line_offset n; s method set_line_index n = let s = self#copy in s#nocopy#set_line_index n; s method set_visible_line_index n = let s = self#copy in s#nocopy#set_visible_line_index n; s method set_visible_line_offset n = let s = self#copy in s#nocopy#set_visible_line_offset n; s method forward_to_end = let s = self#copy in s#nocopy#forward_to_end; s method forward_to_line_end = let s = self#copy in s#nocopy#forward_to_line_end; s method forward_to_tag_toggle (tag : tag option) = let s = self#copy in s#nocopy#forward_to_tag_toggle tag; s method backward_to_tag_toggle (tag : tag option) = let s = self#copy in s#nocopy#backward_to_tag_toggle tag; s method equal (a:iter) = Iter.equal it a#as_iter method compare (a:iter) = Iter.compare it a#as_iter method in_range ~(start:iter) ~(stop:iter) = Iter.in_range it start#as_iter stop#as_iter method forward_search ?flags ?(limit:iter option) s = may_map (Iter.forward_search it s ?flags (may_map limit ~f:(fun t -> t#as_iter))) ~f:(fun (s,t) -> new iter s, new iter t) method backward_search ?flags ?(limit : iter option) s = may_map (Iter.backward_search it s ?flags (may_map limit ~f:(fun t -> t#as_iter))) ~f:(fun (s,t) -> new iter s, new iter t) method forward_find_char ?limit f = let s = self#copy in s#nocopy#forward_find_char ?limit f; s method backward_find_char ?limit f = let s = self#copy in s#nocopy#backward_find_char ?limit f; s end (* let iter i = new iter (Iter.copy i) *) let as_iter (it : iter) = it#as_iter class tag_table_signals obj = object inherit ['a] gobject_signals obj inherit text_tag_table_sigs end class tag_table_skel obj = object val obj = (obj :> text_tag_table) method get_oid = Gobject.get_oid obj method as_tag_table : text_tag_table = obj method add = TagTable.add obj method remove = TagTable.remove obj method lookup = TagTable.lookup obj method size = TagTable.get_size obj end class tag_table obj = object inherit tag_table_skel obj method connect = new tag_table_signals obj end let tag_table () = new tag_table (TagTable.create []) class type buffer_signals_skel_type = object method apply_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method begin_user_action : callback:(unit -> unit) -> GtkSignal.id method changed : callback:(unit -> unit) -> GtkSignal.id method delete_range : callback:(start:iter -> stop:iter -> unit) -> GtkSignal.id method end_user_action : callback:(unit -> unit) -> GtkSignal.id method insert_child_anchor : callback:(iter -> Gtk.text_child_anchor -> unit) -> GtkSignal.id method insert_pixbuf : callback:(iter -> GdkPixbuf.pixbuf -> unit) -> GtkSignal.id method insert_text : callback:(iter -> string -> unit) -> GtkSignal.id method mark_deleted : callback:(Gtk.text_mark -> unit) -> GtkSignal.id method mark_set : callback:(iter -> Gtk.text_mark -> unit) -> GtkSignal.id method modified_changed : callback:(unit -> unit) -> GtkSignal.id method remove_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method notify_cursor_position : callback:(int -> unit) -> GtkSignal.id method notify_has_selection : callback:(bool -> unit) -> GtkSignal.id method notify_tag_table : callback:(Gtk.text_tag_table -> unit) -> GtkSignal.id end class type ['b] buffer_signals_type = object ('a) inherit buffer_signals_skel_type method after : 'a method private connect : 'c. ('b, 'c) GtkSignal.t -> callback:'c -> GtkSignal.id method private notify : 'c. ('b, 'c) Gobject.property -> callback:('c -> unit) -> GtkSignal.id end class virtual buffer_signals_skel = object(self) inherit text_buffer_sigs method apply_tag ~callback = self#connect Buffer.S.apply_tag ~callback:(fun tag start stop -> callback (new tag tag) ~start:(new iter start) ~stop:(new iter stop)) method delete_range ~callback = self#connect Buffer.S.delete_range ~callback:(fun start stop -> callback ~start:(new iter start) ~stop:(new iter stop)) method insert_child_anchor ~callback = self#connect Buffer.S.insert_child_anchor ~callback:(fun iter -> callback (new iter iter)) method insert_pixbuf ~callback = self#connect Buffer.S.insert_pixbuf ~callback:(fun iter -> callback (new iter iter)) method insert_text ~callback = self#connect Buffer.S.insert_text ~callback:(fun iter -> callback (new iter iter)) method mark_set ~callback = self#connect Buffer.S.mark_set ~callback:(fun it -> callback (new iter it)) method remove_tag ~callback = self#connect Buffer.S.remove_tag ~callback:(fun tag start stop -> callback (new tag tag) ~start:(new iter start) ~stop:(new iter stop)) end class buffer_signals obj = object inherit ['a] gobject_signals obj inherit buffer_signals_skel end exception No_such_mark of string type position = [ `OFFSET of int | `LINE of int | `LINECHAR of int * int | `LINEBYTE of int * int | `START | `END | `ITER of iter | mark ] class buffer_skel obj = object(self) val obj = (obj :> text_buffer) method private obj = obj inherit text_buffer_props method get_oid = Gobject.get_oid obj method as_buffer = obj method line_count = Buffer.get_line_count obj method char_count = Buffer.get_char_count obj (* method tag_table = Buffer.get_tag_table obj *) method insert ?iter ?(tag_names : string list = []) ?(tags : tag list = []) text = match tags,tag_names with | [],[] -> begin match iter with | None -> Buffer.insert_at_cursor obj text | Some iter -> Buffer.insert obj (as_iter iter) text end | _ -> begin match iter with | None -> let insert_iter () = self#get_iter_at_mark `INSERT in let start_offset = (insert_iter ())#offset in Buffer.insert_at_cursor obj text; let start = self#get_iter_at_char start_offset in List.iter tags ~f:(self#apply_tag ~start ~stop:(insert_iter ())); List.iter tag_names ~f:(self#apply_tag_by_name ~start ~stop:(insert_iter ())) | Some iter -> let start_offset = iter#offset in Buffer.insert obj (as_iter iter) text; let start = self#get_iter_at_char start_offset in List.iter tags ~f:(self#apply_tag ~start ~stop:iter); List.iter tag_names ~f:(self#apply_tag_by_name ~start ~stop:iter) end method insert_interactive ?iter ?(default_editable = true) text = match iter with | None -> Buffer.insert_interactive_at_cursor obj text default_editable | Some iter -> Buffer.insert_interactive obj (as_iter iter) text default_editable method insert_range ~iter ~start ~stop = Buffer.insert_range obj (as_iter iter) (as_iter start) (as_iter stop) method insert_range_interactive ~iter ~start ~stop ?(default_editable = true) () = Buffer.insert_range_interactive obj (as_iter iter) (as_iter start) (as_iter stop) default_editable method delete ~start ~stop = Buffer.delete obj (as_iter start) (as_iter stop) method delete_interactive ~start ~stop ?(default_editable = true) () = Buffer.delete_interactive obj (as_iter start) (as_iter stop) default_editable method set_text text = Buffer.set_text obj text method get_text ?start ?stop ?(slice=false) ?(visible=false) () = let start,stop = match start,stop with | None,None -> Buffer.get_bounds obj | Some start,None -> as_iter start, Buffer.get_start_iter obj | None,Some stop -> Buffer.get_end_iter obj, as_iter stop | Some start,Some stop -> as_iter start, as_iter stop in (if slice then Buffer.get_slice else Buffer.get_text) obj start stop (not visible) method insert_pixbuf ~iter ~pixbuf = Buffer.insert_pixbuf obj (as_iter iter) pixbuf method create_mark ?name ?(left_gravity=true) iter = Buffer.create_mark obj name (as_iter iter) left_gravity method get_mark : mark -> _ = function `MARK mark -> mark | #mark_name as mark -> let name = mark_name mark in match Buffer.get_mark obj name with | None -> raise (No_such_mark name) | Some m -> m method move_mark mark ~where = Buffer.move_mark obj (self#get_mark mark) (as_iter where) method delete_mark mark = Buffer.delete_mark obj (self#get_mark mark) method place_cursor ~where = Buffer.place_cursor obj (as_iter where) method select_range ins bound = Buffer.select_range obj (as_iter ins) (as_iter bound) method apply_tag (tag : tag) ~start ~stop = Buffer.apply_tag obj tag#as_tag (as_iter start) (as_iter stop) method remove_tag (tag : tag) ~start ~stop = Buffer.remove_tag obj tag#as_tag (as_iter start) (as_iter stop) method apply_tag_by_name name ~start ~stop = Buffer.apply_tag_by_name obj name (as_iter start) (as_iter stop) method remove_tag_by_name name ~start ~stop = Buffer.remove_tag_by_name obj name (as_iter start) (as_iter stop) method remove_all_tags ~start ~stop = Buffer.remove_all_tags obj (as_iter start) (as_iter stop) method create_tag ?name properties = let t = new tag (Buffer.create_tag_0 obj name) in if properties <> [] then t#set_properties properties; t method get_iter (pos : position) = let it = match pos with `START -> Buffer.get_start_iter obj | `END -> Buffer.get_end_iter obj | `OFFSET n -> Buffer.get_iter_at_offset obj n | `LINE n -> Buffer.get_iter_at_line obj n | `LINECHAR (l,c) -> Buffer.get_iter_at_line_offset obj l c | `LINEBYTE (l,c) -> Buffer.get_iter_at_line_index obj l c | `ITER it -> it#as_iter | #mark as mark -> Buffer.get_iter_at_mark obj (self#get_mark mark) in new iter it method get_iter_at_char ?line char_offset = match line,char_offset with | Some v, 0 -> new iter (Buffer.get_iter_at_line obj v) | None , v -> new iter (Buffer.get_iter_at_offset obj v) | Some l, c -> new iter (Buffer.get_iter_at_line_offset obj l c) method get_iter_at_byte ~line index = new iter (Buffer.get_iter_at_line_index obj line index) method get_iter_at_mark mark = new iter (Buffer.get_iter_at_mark obj (self#get_mark mark)) method start_iter = new iter (Buffer.get_start_iter obj) method end_iter = new iter (Buffer.get_end_iter obj) method bounds = let s,t=Buffer.get_bounds obj in new iter s,new iter t method modified = Buffer.get_modified obj method set_modified setting = Buffer.set_modified obj setting method delete_selection ?(interactive=true) ?(default_editable=true) () = Buffer.delete_selection obj interactive default_editable method selection_bounds = let start, stop = Buffer.get_selection_bounds obj in (new iter start, new iter stop) method begin_user_action () = Buffer.begin_user_action obj method end_user_action () = Buffer.end_user_action obj method create_child_anchor (iter:iter) = new child_anchor (Buffer.create_child_anchor obj iter#as_iter) method insert_child_anchor (iter:iter) (child_anchor:child_anchor) = Buffer.insert_child_anchor obj iter#as_iter child_anchor#as_childanchor method paste_clipboard ?iter ?(default_editable=true) clipboard = Buffer.paste_clipboard obj (GData.as_clipboard clipboard) (may_map as_iter iter) default_editable method copy_clipboard clip = Buffer.copy_clipboard obj (GData.as_clipboard clip) method cut_clipboard ?(default_editable=true) clipboard = Buffer.cut_clipboard obj (GData.as_clipboard clipboard) default_editable method add_selection_clipboard clip = Buffer.add_selection_clipboard obj (GData.as_clipboard clip) method remove_selection_clipboard clip = Buffer.remove_selection_clipboard obj (GData.as_clipboard clip) end class buffer obj = object inherit buffer_skel obj method connect = new buffer_signals obj end let buffer ?tag_table ?text () = let tag_table = match tag_table with None -> None | Some x -> Some x#as_tag_table in let b = new buffer (Buffer.create ?tag_table []) in match text with None -> b | Some t -> b#set_text t; b class view_signals obj = object inherit widget_signals_impl (obj : [> Gtk.text_view] obj) inherit text_view_sigs end class view_skel obj = object (self) inherit [_] widget_impl obj inherit text_view_props method event = new GObj.event_ops obj method as_view = (obj :> text_view obj) method set_buffer (b:buffer) = View.set_buffer obj (b#as_buffer) method buffer = new buffer (View.get_buffer obj) method scroll_to_mark ?(within_margin=0.) ?(use_align=false) ?(xalign=0.) ?(yalign=0.) mark = View.scroll_to_mark obj (self#buffer#get_mark mark) within_margin use_align xalign yalign method scroll_to_iter ?(within_margin=0.) ?(use_align=false) ?(xalign=0.) ?(yalign=0.) iter = View.scroll_to_iter obj (as_iter iter) within_margin use_align xalign yalign method scroll_mark_onscreen mark = View.scroll_mark_onscreen obj (self#buffer#get_mark mark) method move_mark_onscreen mark = View.move_mark_onscreen obj (self#buffer#get_mark mark) method place_cursor_onscreen () = View.place_cursor_onscreen obj method visible_rect = View.get_visible_rect obj method get_iter_location iter = View.get_iter_location obj (as_iter iter) method get_line_at_y y = let it, n = View.get_line_at_y obj y in (new iter it, n) method get_line_yrange iter = View.get_line_yrange obj (as_iter iter) method get_iter_at_location ~x ~y = new iter (View.get_iter_at_location obj x y) method buffer_to_window_coords ~tag ~x ~y = View.buffer_to_window_coords obj tag x y method window_to_buffer_coords ~tag ~x ~y = View.window_to_buffer_coords obj tag x y method get_window win = View.get_window obj win method get_window_type win = View.get_window_type obj win method set_border_window_size ~typ ~size = View.set_border_window_size obj typ size method get_border_window_size typ = View.get_border_window_size obj typ method forward_display_line iter = View.forward_display_line obj (as_iter iter) method backward_display_line iter = View.backward_display_line obj (as_iter iter) method forward_display_line_end iter = View.forward_display_line_end obj (as_iter iter) method backward_display_line_start iter = View.backward_display_line_start obj (as_iter iter) method starts_display_line iter = View.starts_display_line obj (as_iter iter) method move_visually iter count = View.move_visually obj (as_iter iter) count method add_child_at_anchor (w : widget) (anchor : child_anchor) = View.add_child_at_anchor obj w#as_widget anchor#as_childanchor method add_child_in_window ~(child : widget) ~which_window ~x ~y = View.add_child_in_window obj child#as_widget which_window x y method move_child ~(child : widget) ~x ~y = View.move_child obj child#as_widget x y end class view obj = object inherit view_skel obj method connect = new view_signals obj end let view ?(buffer:buffer option) = View.make_params [] ~cont:( GContainer.pack_container ~create:(fun pl -> let w = match buffer with | None -> View.create [] | Some b -> View.create_with_buffer b#as_buffer in Gobject.set_params w pl; new view w)) lablgtk-2.18.8/src/gnoDruid.mli0000644000175000017500000001315113460263323015332 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** Druids (a.k.a. Wizards) *) class type druid_page = object method as_druidpage : GnomeDruid.druidpage Gtk.obj end (** @gtkdoc libgnomeui GnomeDruid *) class druid_signals : GnomeDruid.druid Gtk.obj -> object ('a) inherit GContainer.container_signals method cancel : callback:(unit -> unit) -> GtkSignal.id method help : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc libgnomeui GnomeDruid *) class druid : GnomeDruid.druid Gtk.obj -> object inherit GContainer.container val obj : GnomeDruid.druid Gtk.obj method connect : druid_signals method set_show_finish : bool -> unit method set_show_help : bool -> unit method show_finish : bool method show_help : bool method set_buttons_sensitive : back:bool -> next:bool -> cancel:bool -> help:bool -> unit method prepend_page : #druid_page -> unit method insert_page : #druid_page -> #druid_page -> unit method append_page : #druid_page -> unit method set_page : #druid_page -> unit end (** @gtkdoc libgnomeui GnomeDruid *) val druid : ?show_finish:bool -> ?show_help:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> druid (** @gtkdoc libgnomeui GnomeDruidPage *) class druid_page_signals : GnomeDruid.druidpage Gtk.obj -> object ('a) inherit GContainer.container_signals method back : callback:(druid -> bool) -> GtkSignal.id method cancel : callback:(druid -> bool) -> GtkSignal.id method finish : callback:(druid -> unit) -> GtkSignal.id method next : callback:(druid -> bool) -> GtkSignal.id method prepare : callback:(druid -> unit) -> GtkSignal.id end (** @gtkdoc libgnomeui GnomeDruidPage *) class druid_page_skel : ([> GnomeDruid.druidpage] as 'a) Gtk.obj -> object inherit GContainer.container val obj : 'a Gtk.obj method as_druidpage : GnomeDruid.druidpage Gtk.obj method connect : druid_page_signals end (** @gtkdoc libgnomeui GnomeDruidPageEdge *) class druid_page_edge : GnomeDruid.page_edge Gtk.obj -> object inherit druid_page_skel val obj : GnomeDruid.page_edge Gtk.obj method set_bg_color : Gdk.color -> unit method set_logo : GdkPixbuf.pixbuf -> unit method set_logo_bg_color : Gdk.color -> unit method set_resize_mode : Gtk.Tags.resize_mode -> unit method set_text : string -> unit method set_text_color : Gdk.color -> unit method set_textbox_color : Gdk.color -> unit method set_title : string -> unit method set_title_color : Gdk.color -> unit method set_top_watermark : GdkPixbuf.pixbuf -> unit method set_watermark : GdkPixbuf.pixbuf -> unit end (** @gtkdoc libgnomeui GnomeDruidPageEdge *) val druid_page_edge : position:GnomeDruid.Page_Edge.edge_position -> aa:bool -> ?title:string -> ?text:string -> ?logo:GdkPixbuf.pixbuf -> ?watermark:GdkPixbuf.pixbuf -> ?top_watermark:GdkPixbuf.pixbuf -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> druid_page_edge (** @gtkdoc libgnomeui GnomeDruidPageStandard *) class druid_page_standard : GnomeDruid.page_standard Gtk.obj -> object inherit druid_page_skel val obj : GnomeDruid.page_standard Gtk.obj method vbox : GPack.box method append_item : ?question:string -> ?additional_info:string -> GObj.widget -> unit method set_background : string -> unit method set_border_width : int -> unit method set_logo : GdkPixbuf.pixbuf -> unit method set_logo_background : string -> unit method set_resize_mode : Gtk.Tags.resize_mode -> unit method set_title : string -> unit method set_title_foreground : string -> unit end (** @gtkdoc libgnomeui GnomeDruidPageStandard *) val druid_page_standard : ?background:string -> ?logo:GdkPixbuf.pixbuf -> ?logo_background:string -> ?title:string -> ?title_foreground:string -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> druid_page_standard lablgtk-2.18.8/src/gList.mli0000644000175000017500000002240713460263323014645 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** Widget for packing a list of selectable items *) (** {3 GtkListItem} *) (** An item in a {!GList.liste} @gtkdoc gtk GtkListItem @deprecated . *) class list_item : Gtk.list_item obj -> object inherit GContainer.container val obj : Gtk.list_item obj method event : event_ops method as_item : Gtk.list_item obj method connect : item_signals method deselect : unit -> unit method select : unit -> unit method toggle : unit -> unit end (** @gtkdoc gtk GtkListItem @deprecated . *) val list_item : ?label:string -> ?packing:(list_item -> unit) -> ?show:bool -> unit -> list_item (** {3 GtkList} *) (** @gtkdoc gtk GtkList *) class liste_signals : Gtk.liste obj -> object inherit GContainer.container_signals val obj : Gtk.liste obj method select_child : callback:(list_item -> unit) -> GtkSignal.id method selection_changed : callback:(unit -> unit) -> GtkSignal.id method unselect_child : callback:(list_item -> unit) -> GtkSignal.id end (** Widget for packing a list of selectable items @gtkdoc gtk GtkList @deprecated . *) class liste : Gtk.liste obj -> object inherit [list_item] GContainer.item_container val obj : Gtk.liste obj method child_position : list_item -> int method clear_items : start:int -> stop:int -> unit method connect : liste_signals method insert : list_item -> pos:int -> unit method select_item : pos:int -> unit method unselect_item : pos:int -> unit method private wrap : Gtk.widget obj -> list_item method set_selection_mode : Tags.selection_mode -> unit method selection_mode : Tags.selection_mode end (** @gtkdoc gtk GtkList @deprecated . *) val liste : ?selection_mode:Tags.selection_mode -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> liste (** {3 GtkCList} *) (** @gtkdoc gtk GtkCList *) class clist_signals : 'a obj -> object inherit GContainer.container_signals constraint 'a = [> clist] val obj : 'a obj method click_column : callback:(int -> unit) -> GtkSignal.id method resize_column : callback:(int -> int -> unit) -> GtkSignal.id method select_all : callback:(unit -> unit) -> GtkSignal.id method unselect_all : callback:(unit -> unit) -> GtkSignal.id method select_row : callback:(row:int -> column:int -> event:GdkEvent.Button.t option -> unit) -> GtkSignal.id method unselect_row : callback:(row:int -> column:int -> event:GdkEvent.Button.t option -> unit) -> GtkSignal.id method scroll_horizontal : callback:(Tags.scroll_type -> pos:clampf -> unit) -> GtkSignal.id method scroll_vertical : callback:(Tags.scroll_type -> pos:clampf -> unit) -> GtkSignal.id method notify_n_columns : callback:(int -> unit) -> GtkSignal.id method notify_reorderable : callback:(bool -> unit) -> GtkSignal.id method notify_row_height : callback:(int -> unit) -> GtkSignal.id method notify_selection_mode : callback:(GtkEnums.selection_mode -> unit) -> GtkSignal.id method notify_shadow_type : callback:(GtkEnums.shadow_type -> unit) -> GtkSignal.id method notify_sort_type : callback:(GtkEnums.sort_type -> unit) -> GtkSignal.id method notify_titles_active : callback:(bool -> unit) -> GtkSignal.id method notify_use_drag_icons : callback:(bool -> unit) -> GtkSignal.id end (** A multi-columned scrolling list widget @gtkdoc gtk GtkCList @deprecated . *) class ['a] clist : Gtk.clist obj -> object inherit GObj.widget val obj : Gtk.clist obj method event : event_ops method append : string list -> int method cell_pixmap : int -> int -> GDraw.pixmap option method cell_style : int -> int -> style option method cell_text : int -> int -> string method cell_type : int -> int -> Tags.cell_type method clear : unit -> unit method column_title : int -> string method column_widget : int -> widget method columns : int method columns_autosize : unit -> unit method connect : clist_signals method focus_row : int method freeze : unit -> unit method get_row_column : x:int -> y:int -> int * int method get_row_data : int -> 'a method hadjustment : GData.adjustment method insert : row:int -> string list -> int method moveto : ?row_align:clampf -> ?col_align:clampf -> int -> int -> unit method optimal_column_width : int -> int method prepend : string list -> int method remove : row:int -> unit method row_is_visible : int -> Tags.visibility method row_move : int -> dst:int -> unit method row_selectable : int -> bool method row_style : int -> style option method rows : int method scroll_vertical : Tags.scroll_type -> pos:clampf -> unit method scroll_horizontal : Tags.scroll_type -> pos:clampf -> unit method select : int -> int -> unit method select_all : unit -> unit method set_border_width : int -> unit method set_button_actions : int -> Tags.button_action list -> unit method set_cell : ?text:string -> ?pixmap:GDraw.pixmap -> ?spacing:int -> ?style:style -> int -> int -> unit method set_column : ?widget:widget -> ?title:string -> ?title_active:bool -> ?justification:Tags.justification -> ?visibility:bool -> ?resizeable:bool -> ?auto_resize:bool -> ?width:int -> ?min_width:int -> ?max_width:int -> int -> unit method set_hadjustment : GData.adjustment -> unit method set_reorderable : bool -> unit method set_row : ?foreground:GDraw.optcolor -> ?background:GDraw.optcolor -> ?selectable:bool -> ?style:style -> int -> unit method set_row_data : int -> data:'a -> unit method set_row_height : int -> unit method set_selection_mode : Tags.selection_mode -> unit method set_shadow_type : Tags.shadow_type -> unit method set_shift : int -> int -> vertical:int -> horizontal:int -> unit method set_sort : ?auto:bool -> ?column:int -> ?dir:Tags.sort_type -> unit -> unit method set_titles_active : bool -> unit method set_titles_show : bool -> unit method set_use_drag_icons : bool -> unit method set_vadjustment : GData.adjustment -> unit method sort : unit -> unit method swap_rows : int -> int -> unit method thaw : unit -> unit method unselect : int -> int -> unit method unselect_all : unit -> unit method vadjustment : GData.adjustment method get_row_state : int -> Gtk.Tags.state_type end (** @gtkdoc gtk GtkCList @deprecated . *) val clist : ?columns:int -> ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?titles:string list -> ?button_actions:(int * Tags.button_action list) list -> ?titles_show:bool -> ?auto_sort:bool -> ?sort_column:int -> ?sort_type:Tags.sort_type -> ?reorderable:bool -> ?row_height:int -> ?selection_mode:Tags.selection_mode -> ?shadow_type:Tags.shadow_type -> ?titles_active:bool -> ?use_drag_icons:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> string clist val clist_poly : ?columns:int -> ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?titles:string list -> ?button_actions:(int * Tags.button_action list) list -> ?titles_show:bool -> ?auto_sort:bool -> ?sort_column:int -> ?sort_type:Tags.sort_type -> ?reorderable:bool -> ?row_height:int -> ?selection_mode:Tags.selection_mode -> ?shadow_type:Tags.shadow_type -> ?titles_active:bool -> ?use_drag_icons:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> 'a clist lablgtk-2.18.8/src/gBin.ml0000644000175000017500000001251613460263323014271 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open GtkBinProps open GtkBase open GtkBin open GObj open OgtkBinProps open GContainer let param = Gobject.param class scrolled_window obj = object inherit [Gtk.scrolled_window] bin_impl obj inherit scrolled_window_props method connect = new container_signals_impl obj method add_with_viewport w = ScrolledWindow.add_with_viewport obj (as_widget w) end let scrolled_window ?hadjustment ?vadjustment = ScrolledWindow.make_params [] ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) ~cont:( pack_container ~create:(fun pl -> new scrolled_window (ScrolledWindow.create pl))) class event_box obj = object inherit bin obj method connect = new container_signals_impl obj method event = new GObj.event_ops (obj :> Gtk.event_box obj) end let event_box = pack_container [] ~create:(fun pl -> new event_box (EventBox.create pl)) class invisible obj = object inherit bin obj method connect = new container_signals_impl obj method event = new GObj.event_ops (obj :> Gtk.invisible obj) end let invisible = pack_container [] ~create:(fun pl -> new invisible (Invisible.create pl)) class handle_box_signals (obj : [> handle_box] obj) = object inherit container_signals_impl obj inherit handle_box_sigs end class handle_box obj = object inherit [Gtk.handle_box] bin_impl obj method connect = new handle_box_signals obj method event = new GObj.event_ops obj inherit handle_box_props end let handle_box = HandleBox.make_params [] ~cont:( pack_container ~create:(fun pl -> new handle_box (HandleBox.create pl))) class frame_skel obj = object inherit [[> frame]] bin_impl obj inherit frame_props end class frame obj = object inherit frame_skel (obj : Gtk.frame obj) method connect = new container_signals_impl obj end let frame = Frame.make_params [] ~cont:( pack_container ~create:(fun pl -> new frame (Frame.create pl))) class aspect_frame obj = object inherit frame_skel (obj : Gtk.aspect_frame obj) method connect = new container_signals_impl obj inherit aspect_frame_props end let aspect_frame = AspectFrame.make_params [] ~cont:( Frame.make_params ~cont:( pack_container ~create:(fun pl -> new aspect_frame (AspectFrame.create pl)))) class viewport obj = object inherit [Gtk.viewport] bin_impl obj method connect = new container_signals_impl obj method event = new event_ops obj inherit viewport_props end let viewport ?hadjustment ?vadjustment = Viewport.make_params [] ?hadjustment:(may_map ~f:GData.as_adjustment hadjustment) ?vadjustment:(may_map ~f:GData.as_adjustment vadjustment) ~cont:( pack_container ~create:(fun pl -> new viewport (Viewport.create pl))) class alignment obj = object inherit [Gtk.alignment] bin_impl obj method connect = new container_signals_impl obj inherit alignment_props end let alignment ?padding = let pl = match padding with | None -> [] | Some (t, b, l, r) -> [ param Alignment.P.top_padding t ; param Alignment.P.bottom_padding b ; param Alignment.P.left_padding l ; param Alignment.P.right_padding r ] in Alignment.make_params pl ~cont:( pack_container ~create:(fun pl -> new alignment (Alignment.create pl))) let alignment_cast w = new alignment (Alignment.cast w#as_widget) class expander_signals obj = object inherit GContainer.container_signals_impl (obj : [> Gtk.expander] Gtk.obj) inherit OgtkBinProps.expander_sigs end class expander obj = object inherit [[> Gtk.expander]] GContainer.bin_impl obj inherit OgtkBinProps.expander_props method connect = new expander_signals obj end let expander = GtkBin.Expander.make_params [] ~cont:( GContainer.pack_container ~create:(fun pl -> new expander (GtkBin.Expander.create pl))) lablgtk-2.18.8/src/gtkTree.ml0000644000175000017500000004775113460263323015030 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open Tags open GtkTreeProps open GtkBase external _gtktree_init : unit -> unit = "ml_gtktree_init" let () = _gtktree_init () module TreePath = struct external create_ : unit -> tree_path = "ml_gtk_tree_path_new" external from_string : string -> tree_path = "ml_gtk_tree_path_new_from_string" external to_string : tree_path -> string = "ml_gtk_tree_path_to_string" external append_index : tree_path -> int -> unit = "ml_gtk_tree_path_append_index" let create l = let p = create_ () in List.iter (append_index p) l; p external prepend_index : tree_path -> int -> unit = "ml_gtk_tree_path_prepend_index" external get_depth : tree_path -> int = "ml_gtk_tree_path_get_depth" external get_indices : tree_path -> int array = "ml_gtk_tree_path_get_indices" external copy : tree_path -> tree_path = "ml_gtk_tree_path_copy" external next : tree_path -> unit = "ml_gtk_tree_path_next" external prev : tree_path -> bool = "ml_gtk_tree_path_prev" external up : tree_path -> bool = "ml_gtk_tree_path_up" external down : tree_path -> unit = "ml_gtk_tree_path_down" external is_ancestor : tree_path -> tree_path -> bool = "ml_gtk_tree_path_is_ancestor" open Gobject open Data let () = Internal.tree_path_string := {kind=`STRING; inj=(fun x -> string.inj (to_string x)); proj=(fun x -> from_string (string.proj x))}; Internal.tree_path_copy := {kind=`POINTER; inj=unsafe_pointer.inj; proj=(fun x -> copy (unsafe_pointer.proj x))} end module RowReference = struct external create : [>`treemodel] obj -> tree_path -> row_reference = "ml_gtk_tree_row_reference_new" external get_path : row_reference -> tree_path = "ml_gtk_tree_row_reference_get_path" external valid : row_reference -> bool = "ml_gtk_tree_row_reference_valid" end module TreeModel = struct let cast w : tree_model = Object.try_cast w "GtkTreeModel" external get_flags : [>`treemodel] obj -> GtkEnums.tree_model_flags list = "ml_gtk_tree_model_get_flags" external get_n_columns : [>`treemodel] obj -> int = "ml_gtk_tree_model_get_n_columns" external get_column_type : [>`treemodel] obj -> int -> Gobject.g_type = "ml_gtk_tree_model_get_column_type" external alloc_iter : unit -> tree_iter = "ml_alloc_GtkTreeIter" external copy_iter : tree_iter -> tree_iter = "ml_gtk_tree_iter_copy" external get_iter : [>`treemodel] obj -> tree_iter -> tree_path -> bool = "ml_gtk_tree_model_get_iter" let get_iter m p = let i = alloc_iter () in if get_iter m i p then i else failwith "GtkTree.TreeModel.get_iter" external get_path : [>`treemodel] obj -> tree_iter -> tree_path = "ml_gtk_tree_model_get_path" external get_value : [>`treemodel] obj -> row:tree_iter -> column:int -> Gobject.g_value -> unit = "ml_gtk_tree_model_get_value" external _get_iter_first : [>`treemodel] obj -> tree_iter -> bool = "ml_gtk_tree_model_get_iter_first" let get_iter_first m = let i = alloc_iter () in if _get_iter_first m i then Some i else None external iter_next : [>`treemodel] obj -> tree_iter -> bool = "ml_gtk_tree_model_iter_next" external iter_has_child : [>`treemodel] obj -> tree_iter -> bool = "ml_gtk_tree_model_iter_has_child" external iter_n_children : [>`treemodel] obj -> tree_iter option -> int = "ml_gtk_tree_model_iter_n_children" external iter_nth_child : [>`treemodel] obj -> tree_iter -> parent:tree_iter option -> int -> bool = "ml_gtk_tree_model_iter_nth_child" let iter_children m ?(nth=0) p = let i = alloc_iter () in if iter_nth_child m i p nth then i else invalid_arg "GtkTree.TreeModel.iter_children" external iter_parent : [>`treemodel] obj -> tree_iter -> child:tree_iter -> bool = "ml_gtk_tree_model_iter_parent" let iter_parent m child = let i = alloc_iter () in if iter_parent m i ~child then Some i else None external foreach : [>`treemodel] obj -> (tree_path -> tree_iter -> bool) -> unit = "ml_gtk_tree_model_foreach" external row_changed : [>`treemodel] obj -> tree_path -> tree_iter -> unit = "ml_gtk_tree_model_row_changed" end module TreeStore = struct open TreeModel let cast w : tree_store = Object.try_cast w "GtkTreeStore" external create : Gobject.g_type array -> tree_store = "ml_gtk_tree_store_newv" external set_value : tree_store -> row:tree_iter -> column:int -> Gobject.g_value -> unit = "ml_gtk_tree_store_set_value" external remove : tree_store -> tree_iter -> bool = "ml_gtk_tree_store_remove" external insert : tree_store -> iter:tree_iter -> ?parent:tree_iter -> int -> unit = "ml_gtk_tree_store_insert" let insert st ?parent pos = let iter = alloc_iter () in insert st ~iter ?parent pos; iter external insert_before : tree_store -> iter:tree_iter -> ?parent:tree_iter -> tree_iter -> unit = "ml_gtk_tree_store_insert_before" let insert_before st ?parent pos = let iter = alloc_iter () in insert_before st ~iter ?parent pos; iter external insert_after : tree_store -> iter:tree_iter -> ?parent:tree_iter -> tree_iter -> unit = "ml_gtk_tree_store_insert_after" let insert_after st ?parent pos = let iter = alloc_iter () in insert_after st ~iter ?parent pos; iter external append : tree_store -> iter:tree_iter -> ?parent:tree_iter -> unit = "ml_gtk_tree_store_append" let append st ?parent () = let iter = alloc_iter () in append st ~iter ?parent; iter external prepend : tree_store -> iter:tree_iter -> ?parent:tree_iter -> unit = "ml_gtk_tree_store_prepend" let prepend st ?parent () = let iter = alloc_iter () in prepend st ~iter ?parent; iter external is_ancestor : tree_store -> iter:tree_iter -> descendant:tree_iter -> bool = "ml_gtk_tree_store_is_ancestor" external iter_depth : tree_store -> tree_iter -> int = "ml_gtk_tree_store_iter_depth" external clear : tree_store -> unit = "ml_gtk_tree_store_clear" external iter_is_valid : tree_store -> tree_iter -> bool = "ml_gtk_tree_store_iter_is_valid" external swap : tree_store -> tree_iter -> tree_iter -> bool = "ml_gtk_tree_store_swap" external move_before : tree_store -> iter:tree_iter -> pos:tree_iter -> bool = "ml_gtk_tree_store_move_before" external move_after : tree_store -> iter:tree_iter -> pos:tree_iter -> bool = "ml_gtk_tree_store_move_after" end module ListStore = struct open TreeModel let cast w : list_store = Object.try_cast w "GtkListStore" external create : Gobject.g_type array -> list_store = "ml_gtk_list_store_newv" external set_value : list_store -> row:tree_iter -> column:int -> Gobject.g_value -> unit = "ml_gtk_list_store_set_value" external remove : list_store -> tree_iter -> bool = "ml_gtk_list_store_remove" external insert : list_store -> iter:tree_iter -> int -> unit = "ml_gtk_list_store_insert" let insert st pos = let iter = alloc_iter () in insert st ~iter pos; iter external insert_before : list_store -> iter:tree_iter -> tree_iter -> unit = "ml_gtk_list_store_insert_before" let insert_before st pos = let iter = alloc_iter () in insert_before st ~iter pos; iter external insert_after : list_store -> iter:tree_iter -> tree_iter -> unit = "ml_gtk_list_store_insert_after" let insert_after st pos = let iter = alloc_iter () in insert_after st ~iter pos; iter external append : list_store -> iter:tree_iter -> unit = "ml_gtk_list_store_append" let append st () = let iter = alloc_iter () in append st ~iter; iter external prepend : list_store -> iter:tree_iter -> unit = "ml_gtk_list_store_prepend" let prepend st () = let iter = alloc_iter () in prepend st ~iter; iter external clear : list_store -> unit = "ml_gtk_list_store_clear" external iter_is_valid : list_store -> tree_iter -> bool = "ml_gtk_list_store_iter_is_valid" external swap : list_store -> tree_iter -> tree_iter -> bool = "ml_gtk_list_store_swap" external move_before : list_store -> iter:tree_iter -> pos:tree_iter -> bool = "ml_gtk_list_store_move_before" external move_after : list_store -> iter:tree_iter -> pos:tree_iter -> bool = "ml_gtk_list_store_move_after" end module TreeSelection = struct include TreeSelection external set_mode : tree_selection -> selection_mode -> unit = "ml_gtk_tree_selection_set_mode" external get_mode : tree_selection -> selection_mode = "ml_gtk_tree_selection_get_mode" external set_select_function : tree_selection -> (tree_path -> bool -> bool) -> unit = "ml_gtk_tree_selection_set_select_function" external selected_foreach : tree_selection -> (tree_path -> unit) -> unit = "ml_gtk_tree_selection_selected_foreach" let get_selected_rows s = let l = ref [] in selected_foreach s (fun p -> l := p :: !l); List.rev !l external count_selected_rows : tree_selection -> int = "ml_gtk_tree_selection_count_selected_rows" external select_path : tree_selection -> tree_path -> unit = "ml_gtk_tree_selection_select_path" external path_is_selected : tree_selection -> tree_path -> bool = "ml_gtk_tree_selection_path_is_selected" external unselect_path : tree_selection -> tree_path -> unit = "ml_gtk_tree_selection_unselect_path" external select_iter : tree_selection -> tree_iter -> unit = "ml_gtk_tree_selection_select_iter" external unselect_iter : tree_selection -> tree_iter -> unit = "ml_gtk_tree_selection_unselect_iter" external iter_is_selected : tree_selection -> tree_iter -> bool = "ml_gtk_tree_selection_iter_is_selected" external select_all : tree_selection -> unit = "ml_gtk_tree_selection_select_all" external unselect_all : tree_selection -> unit = "ml_gtk_tree_selection_unselect_all" external select_range : tree_selection -> tree_path -> tree_path -> unit = "ml_gtk_tree_selection_select_range" external unselect_range : tree_selection -> tree_path -> tree_path -> unit = "ml_gtk_tree_selection_unselect_range" end module TreeViewColumn = struct include TreeViewColumn external clear : [>`treeviewcolumn] obj -> unit = "ml_gtk_tree_view_column_clear" external pack_start : [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> bool -> unit = "ml_gtk_tree_view_column_pack_start" external pack_end : [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> bool -> unit = "ml_gtk_tree_view_column_pack_end" external clear_attributes : [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> unit = "ml_gtk_tree_view_column_clear_attributes" let pack obj ?(expand=true) ?(from:[`START|`END]=`START) crr = (if from = `START then pack_start else pack_end) obj crr expand external add_attribute : [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> string -> int -> unit = "ml_gtk_tree_view_column_add_attribute" external set_sort_column_id : [>`treeviewcolumn] obj -> int -> unit = "ml_gtk_tree_view_column_set_sort_column_id" external get_sort_column_id : [>`treeviewcolumn] obj -> int = "ml_gtk_tree_view_column_get_sort_column_id" external set_cell_data_func : [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> ([`treemodel] obj -> tree_iter -> unit) option -> unit = "ml_gtk_tree_view_column_set_cell_data_func" external get_button : [>`treeviewcolumn] obj -> Gtk.button obj = "ml_gtk_tree_view_column_get_button" end module TreeView = struct include TreeView external get_selection : [>`treeview] obj -> tree_selection = "ml_gtk_tree_view_get_selection" external columns_autosize : [>`treeview] obj -> unit = "ml_gtk_tree_view_columns_autosize" external append_column : [>`treeview] obj -> [>`treeviewcolumn] obj -> int = "ml_gtk_tree_view_append_column" external remove_column : [>`treeview] obj -> [>`treeviewcolumn] obj -> int = "ml_gtk_tree_view_remove_column" external insert_column : [>`treeview] obj -> [>`treeviewcolumn] obj -> int -> int = "ml_gtk_tree_view_insert_column" external get_column : [>`treeview] obj -> int -> tree_view_column obj = "ml_gtk_tree_view_get_column" external move_column_after : [>`treeview] obj -> [>`treeviewcolumn] obj -> [>`treeviewcolumn] obj -> int = "ml_gtk_tree_view_move_column_after" external scroll_to_point : [>`treeview] obj -> int -> int -> unit = "ml_gtk_tree_view_scroll_to_point" external scroll_to_cell : [>`treeview] obj -> tree_path -> [>`treeviewcolumn] obj -> ?align:(float * float) -> unit = "ml_gtk_tree_view_scroll_to_cell" let scroll_to_cell v ?align = scroll_to_cell v ?align external row_activated : [>`treeview] obj -> tree_path -> [>`treeviewcolumn] obj -> unit = "ml_gtk_tree_view_row_activated" external expand_all : [>`treeview] obj -> unit = "ml_gtk_tree_view_expand_all" external collapse_all : [>`treeview] obj -> unit = "ml_gtk_tree_view_collapse_all" external expand_row : [>`treeview] obj -> tree_path -> all:bool -> unit = "ml_gtk_tree_view_expand_row" external expand_to_path : [>`treeview] obj -> tree_path -> unit = "ml_gtk_tree_view_expand_to_path" external collapse_row : [>`treeview] obj -> tree_path -> unit = "ml_gtk_tree_view_collapse_row" external row_expanded : [>`treeview] obj -> tree_path -> bool = "ml_gtk_tree_view_row_expanded" external set_cursor : [>`treeview] obj -> tree_path -> [>`treeviewcolumn] obj -> edit:bool -> unit = "ml_gtk_tree_view_set_cursor" external set_cursor_on_cell : [>`treeview] obj -> tree_path -> [>`treeviewcolumn] obj -> [>`cellrenderer] obj -> edit:bool -> unit = "ml_gtk_tree_view_set_cursor_on_cell" external get_cursor : [>`treeview] obj -> tree_path option * tree_view_column obj option = "ml_gtk_tree_view_get_cursor" external get_path_at_pos : [>`treeview] obj -> x:int -> y:int -> (tree_path * tree_view_column obj * int * int) option = "ml_gtk_tree_view_get_path_at_pos" external get_cell_area : [>`treeview] obj -> ?path:tree_path -> ?col:tree_view_column obj -> unit -> Gdk.Rectangle.t = "ml_gtk_tree_view_get_cell_area" external set_row_separator_func : [>`treeview] obj -> (Gtk.tree_model -> Gtk.tree_iter -> bool) option -> unit = "ml_gtk_tree_view_set_row_separator_func" (** @since GTK 2.12 *) module Tooltip = struct external set_cell : [>`treeview] obj -> Gtk.tooltip -> ?path:Gtk.tree_path -> ?col:tree_view_column obj -> ?cell:[>`cellrenderer] obj -> unit -> unit = "ml_gtk_tree_view_set_tooltip_cell_bc" "ml_gtk_tree_view_set_tooltip_cell" external set_row : [>`treeview] obj -> Gtk.tooltip -> Gtk.tree_path -> unit = "ml_gtk_tree_view_set_tooltip_row" external get_context : [>`treeview] obj -> x: int -> y: int -> kbd: bool -> (int * int * (Gtk.tree_model * Gtk.tree_path * Gtk.tree_iter) option) = "ml_gtk_tree_view_get_tooltip_context" external get_column : [>`treeview] obj -> int = "ml_gtk_tree_view_get_tooltip_column" external set_column : [>`treeview] obj -> int -> unit = "ml_gtk_tree_view_set_tooltip_column" end module Dnd = struct external get_dest_row_at_pos : [>`treeview] obj -> x: int -> y: int -> ( Gtk.tree_path * GtkEnums.tree_view_drop_position ) option = "ml_gtk_tree_view_get_dest_row_at_pos" external enable_model_drag_dest : [>`treeview] obj -> targets: target_entry array -> actions: Gdk.Tags.drag_action list -> unit = "ml_gtk_tree_view_enable_model_drag_dest" external unset_rows_drag_dest : [>`treeview] obj -> unit = "ml_gtk_tree_view_unset_rows_drag_dest" external enable_model_drag_source : [>`treeview] obj -> ?modi: Gdk.Tags.modifier list -> targets: target_entry array -> actions: Gdk.Tags.drag_action list -> unit = "ml_gtk_tree_view_enable_model_drag_source" external unset_rows_drag_source : [>`treeview] obj -> unit = "ml_gtk_tree_view_unset_rows_drag_source" end end module CellRenderer = CellRenderer module CellRendererPixbuf = CellRendererPixbuf module CellRendererText = CellRendererText module CellRendererToggle = CellRendererToggle module CellRendererProgress = CellRendererProgress module CellRendererCombo = CellRendererCombo module CellRendererAccel = CellRendererAccel module CellLayout = struct include GtkTreeProps.CellLayout let pack layout ?(expand=false) ?from:( dir = (`START : pack_type)) renderer = (match dir with `START -> pack_start | `END -> pack_end) layout renderer ~expand end module TreeModelSort = TreeModelSort module TreeSortable = TreeSortable module TreeModelFilter = TreeModelFilter module IconView = IconView module CustomModel = struct (* Do not change the name of this methods: they are hard coded in ml_gtktree.c. They must remain public. *) class virtual ['row,'a,'b,'c] callback = object method virtual custom_encode_iter : 'row -> 'a * 'b * 'c method virtual custom_decode_iter : 'a -> 'b -> 'c -> 'row method virtual custom_n_columns : int method virtual custom_get_column_type : int -> Gobject.g_type method virtual custom_get_iter : Gtk.tree_path -> 'row option method virtual custom_get_path : 'row -> Gtk.tree_path method virtual custom_get_value : 'row -> int -> Gobject.g_value -> unit method virtual custom_iter_next : 'row -> 'row option method virtual custom_iter_children : 'row option -> 'row option method virtual custom_iter_has_child : 'row -> bool method virtual custom_iter_n_children : 'row option -> int method virtual custom_iter_nth_child : 'row option -> int -> 'row option method virtual custom_iter_parent : 'row -> 'row option method custom_ref_node (_:'row) : unit = () method custom_unref_node (_:'row) : unit = () end external create : unit -> tree_model_custom = "ml_custom_model_create" external register_callback : tree_model_custom -> ('row,'a,'b,'c) #callback -> unit = "ml_register_custom_model_callback_object" external custom_row_inserted : tree_model_custom -> Gtk.tree_path -> 'row -> unit = "ml_custom_model_row_inserted" external custom_row_changed : tree_model_custom -> Gtk.tree_path -> 'row -> unit = "ml_custom_model_row_changed" external custom_row_has_child_toggled : tree_model_custom -> Gtk.tree_path -> 'row -> unit = "ml_custom_model_row_has_child_toggled" external custom_row_deleted : tree_model_custom -> 'row -> unit = "ml_custom_model_row_deleted" external custom_rows_reordered : tree_model_custom -> Gtk.tree_path -> 'row option -> int array -> unit = "ml_custom_model_rows_reordered" end lablgtk-2.18.8/src/absvalue/0000755000175000017500000000000013523300020014637 5ustar stephstephlablgtk-2.18.8/src/absvalue/caml/0000755000175000017500000000000013460263323015571 5ustar stephstephlablgtk-2.18.8/src/absvalue/caml/mlvalues.h0000644000175000017500000002754013460263323017602 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #ifndef CAML_GTK_MLVALUES_H #define CAML_MLVALUES_H #define CAML_GTK_MLVALUES_H #ifndef CAML_NAME_SPACE #include #endif #include #include /* Definitions word: Four bytes on 32 and 16 bit architectures, eight bytes on 64 bit architectures. long: A C integer having the same number of bytes as a word. val: The ML representation of something. A long or a block or a pointer outside the heap. If it is a block, it is the (encoded) address of an object. If it is a long, it is encoded as well. block: Something allocated. It always has a header and some fields or some number of bytes (a multiple of the word size). field: A word-sized val which is part of a block. bp: Pointer to the first byte of a block. (a char *) op: Pointer to the first field of a block. (a value *) hp: Pointer to the header of a block. (a char *) int32: Four bytes on all architectures. int64: Eight bytes on all architectures. Remark: A block size is always a multiple of the word size, and at least one word plus the header. bosize: Size (in bytes) of the "bytes" part. wosize: Size (in words) of the "fields" part. bhsize: Size (in bytes) of the block with its header. whsize: Size (in words) of the block with its header. hd: A header. tag: The value of the tag field of the header. color: The value of the color field of the header. This is for use only by the GC. */ typedef struct {} *value; typedef uintnat header_t; typedef uintnat mlsize_t; typedef unsigned int tag_t; /* Actually, an unsigned char */ typedef uintnat color_t; typedef uintnat mark_t; /* Longs vs blocks. */ /* #define Is_long(x) (((intnat)(x) & 1) != 0) #define Is_block(x) (((intnat)(x) & 1) == 0) */ CAMLextern int Is_long(value); CAMLextern int Is_block(value); /* Conversion macro names are always of the form "to_from". */ /* Example: Val_long as in "Val from long" or "Val of long". */ /* #define Val_long(x) ((value)(((intnat)(x) << 1) + 1)) #define Long_val(x) ((intnat)(x) >> 1) */ CAMLextern intnat Long_val(value); CAMLextern value Val_long(intnat); #define Max_long ((1L << (8 * sizeof(value) - 2)) - 1) #define Min_long (-(1L << (8 * sizeof(value) - 2))) #define Val_int(x) Val_long(x) #define Int_val(x) ((int) Long_val(x)) #define Unsigned_long_val(x) ((uintnat)(x) >> 1) #define Unsigned_int_val(x) ((int) Unsigned_long_val(x)) /* Structure of the header: For 16-bit and 32-bit architectures: +--------+-------+-----+ | wosize | color | tag | +--------+-------+-----+ bits 31 10 9 8 7 0 For 64-bit architectures: +--------+-------+-----+ | wosize | color | tag | +--------+-------+-----+ bits 63 10 9 8 7 0 */ #define Tag_hd(hd) ((tag_t) ((hd) & 0xFF)) #define Wosize_hd(hd) ((mlsize_t) ((hd) >> 10)) #define Hd_val(val) (((header_t *) (val)) [-1]) /* Also an l-value. */ #define Hd_op(op) (Hd_val (op)) /* Also an l-value. */ #define Hd_bp(bp) (Hd_val (bp)) /* Also an l-value. */ #define Hd_hp(hp) (* ((header_t *) (hp))) /* Also an l-value. */ #define Hp_val(val) ((char *) (((header_t *) (val)) - 1)) #define Hp_op(op) (Hp_val (op)) #define Hp_bp(bp) (Hp_val (bp)) #define Val_op(op) ((value) (op)) #define Val_hp(hp) ((value) (((header_t *) (hp)) + 1)) #define Op_hp(hp) ((value *) Val_hp (hp)) #define Bp_hp(hp) ((char *) Val_hp (hp)) #define Num_tags (1 << 8) #ifdef ARCH_SIXTYFOUR #define Max_wosize ((1L << 54) - 1) #else #define Max_wosize ((1 << 22) - 1) #endif #define Wosize_val(val) (Wosize_hd (Hd_val (val))) #define Wosize_op(op) (Wosize_val (op)) #define Wosize_bp(bp) (Wosize_val (bp)) #define Wosize_hp(hp) (Wosize_hd (Hd_hp (hp))) #define Whsize_wosize(sz) ((sz) + 1) #define Wosize_whsize(sz) ((sz) - 1) #define Wosize_bhsize(sz) ((sz) / sizeof (value) - 1) #define Bsize_wsize(sz) ((sz) * sizeof (value)) #define Wsize_bsize(sz) ((sz) / sizeof (value)) #define Bhsize_wosize(sz) (Bsize_wsize (Whsize_wosize (sz))) #define Bhsize_bosize(sz) ((sz) + sizeof (header_t)) #define Bosize_val(val) (Bsize_wsize (Wosize_val (val))) #define Bosize_op(op) (Bosize_val (Val_op (op))) #define Bosize_bp(bp) (Bosize_val (Val_bp (bp))) #define Bosize_hd(hd) (Bsize_wsize (Wosize_hd (hd))) #define Whsize_hp(hp) (Whsize_wosize (Wosize_hp (hp))) #define Whsize_val(val) (Whsize_hp (Hp_val (val))) #define Whsize_bp(bp) (Whsize_val (Val_bp (bp))) #define Whsize_hd(hd) (Whsize_wosize (Wosize_hd (hd))) #define Bhsize_hp(hp) (Bsize_wsize (Whsize_hp (hp))) #define Bhsize_hd(hd) (Bsize_wsize (Whsize_hd (hd))) #ifdef ARCH_BIG_ENDIAN #define Tag_val(val) (((unsigned char *) (val)) [-1]) /* Also an l-value. */ #define Tag_hp(hp) (((unsigned char *) (hp)) [sizeof(value)-1]) /* Also an l-value. */ #else #define Tag_val(val) (((unsigned char *) (val)) [-sizeof(value)]) /* Also an l-value. */ #define Tag_hp(hp) (((unsigned char *) (hp)) [0]) /* Also an l-value. */ #endif /* The lowest tag for blocks containing no value. */ #define No_scan_tag 251 /* 1- If tag < No_scan_tag : a tuple of fields. */ /* Pointer to the first field. */ #define Op_val(x) ((value *) (x)) /* Fields are numbered from 0. */ #define Field(x, i) (((value *)(x)) [i]) /* Also an l-value. */ typedef int32 opcode_t; typedef opcode_t * code_t; /* NOTE: [Forward_tag] and [Infix_tag] must be just under [No_scan_tag], with [Infix_tag] the lower one. See [caml_oldify_one] in minor_gc.c for more details. NOTE: Update stdlib/obj.ml whenever you change the tags. */ /* Forward_tag: forwarding pointer that the GC may silently shortcut. See stdlib/lazy.ml. */ #define Forward_tag 250 #define Forward_val(v) Field(v, 0) /* If tag == Infix_tag : an infix header inside a closure */ /* Infix_tag must be odd so that the infix header is scanned as an integer */ /* Infix_tag must be 1 modulo 4 and infix headers can only occur in blocks with tag Closure_tag (see compact.c). */ #define Infix_tag 249 #define Infix_offset_hd(hd) (Bosize_hd(hd)) #define Infix_offset_val(v) Infix_offset_hd(Hd_val(v)) /* Another special case: objects */ #define Object_tag 248 #define Class_val(val) Field((val), 0) #define Oid_val(val) Long_val(Field((val), 1)) CAMLextern value caml_get_public_method (value obj, value tag); /* called as: callback(caml_get_public_method(obj, hash_variant(name)), obj) */ /* Special case of tuples of fields: closures */ #define Closure_tag 247 #define Code_val(val) (((code_t *) (val)) [0]) /* Also an l-value. */ /* This tag is used (with Forward_tag) to implement lazy values. See major_gc.c and stdlib/lazy.ml. */ #define Lazy_tag 246 /* Another special case: variants */ CAMLextern value caml_hash_variant(char * tag); /* 2- If tag >= No_scan_tag : a sequence of bytes. */ /* Pointer to the first byte */ #define Bp_val(v) ((char *) (v)) #define Val_bp(p) ((value) (p)) /* Bytes are numbered from 0. */ #define Byte(x, i) (((char *) (x)) [i]) /* Also an l-value. */ #define Byte_u(x, i) (((unsigned char *) (x)) [i]) /* Also an l-value. */ /* Abstract things. Their contents is not traced by the GC; therefore they must not contain any [value]. */ #define Abstract_tag 251 /* Strings. */ #define String_tag 252 #define String_val(x) ((char *) Bp_val(x)) CAMLextern mlsize_t caml_string_length (value); /* size in bytes */ /* Floating-point numbers. */ #define Double_tag 253 #define Double_wosize ((sizeof(double) / sizeof(value))) #ifndef ARCH_ALIGN_DOUBLE #define Double_val(v) (* (double *)(v)) #define Store_double_val(v,d) (* (double *)(v) = (d)) #else CAMLextern double caml_Double_val (value); CAMLextern void caml_Store_double_val (value,double); #define Double_val(v) caml_Double_val(v) #define Store_double_val(v,d) caml_Store_double_val(v,d) #endif /* Arrays of floating-point numbers. */ #define Double_array_tag 254 #define Double_field(v,i) Double_val((value)((double *)(v) + (i))) #define Store_double_field(v,i,d) do{ \ mlsize_t caml__temp_i = (i); \ double caml__temp_d = (d); \ Store_double_val((value)((double *) v + caml__temp_i), caml__temp_d); \ }while(0) /* Custom blocks. They contain a pointer to a "method suite" of functions (for finalization, comparison, hashing, etc) followed by raw data. The contents of custom blocks is not traced by the GC; therefore, they must not contain any [value]. See [custom.h] for operations on method suites. */ #define Custom_tag 255 #define Data_custom_val(v) ((void *) &Field((v), 1)) struct custom_operations; /* defined in [custom.h] */ /* Int32.t, Int64.t and Nativeint.t are represented as custom blocks. */ #define Int32_val(v) (*((int32 *) Data_custom_val(v))) #define Nativeint_val(v) (*((intnat *) Data_custom_val(v))) #ifndef ARCH_ALIGN_INT64 #define Int64_val(v) (*((int64 *) Data_custom_val(v))) #else CAMLextern int64 caml_Int64_val(value v); #define Int64_val(v) caml_Int64_val(v) #endif /* 3- Atoms are 0-tuples. They are statically allocated once and for all. */ CAMLextern header_t caml_atom_table[]; #define Atom(tag) (Val_hp (&(caml_atom_table [(tag)]))) /* Is_atom tests whether a well-formed block is statically allocated outside the heap. For the bytecode system, only zero-sized block (Atoms) fall in this class. For the native-code generator, data emitted by the code generator (as described in the table caml_data_segments) are also atoms. */ #ifndef NATIVE_CODE #define Is_atom(v) ((v) >= Atom(0) && (v) <= Atom(255)) #else CAMLextern char * caml_static_data_start, * caml_static_data_end; #define Is_atom(v) \ ((((char *)(v) >= caml_static_data_start \ && (char *)(v) < caml_static_data_end) \ || ((v) >= Atom(0) && (v) <= Atom(255)))) #endif /* Booleans are integers 0 or 1 */ #define Val_bool(x) Val_int((x) != 0) #define Bool_val(x) Int_val(x) #define Val_false Val_int(0) #define Val_true Val_int(1) #define Val_not(x) ((value)((int)Val_false + (int)Val_true - (int)(x))) /* The unit value is 0 (tagged) */ #define Val_unit Val_int(0) /* List constructors */ #define Val_emptylist Val_int(0) #define Tag_cons 0 /* The table of global identifiers */ extern value caml_global_data; #endif /* CAML_MLVALUES_H */ lablgtk-2.18.8/src/absvalue/caml/callback.h0000644000175000017500000000543613460263323017506 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* Callbacks from C to Caml */ #ifndef CAML_GTK_CALLBACK_H #define CAML_CALLBACK_H #define CAML_GTK_CALLBACK_H #ifndef CAML_NAME_SPACE #include #endif #include "mlvalues.h" CAMLextern value caml_callback (value closure, value arg); CAMLextern value caml_callback2 (value closure, value arg1, value arg2); CAMLextern value caml_callback3 (value closure, value arg1, value arg2, value arg3); CAMLextern value caml_callbackN (value closure, int narg, value args[]); CAMLextern value caml_callback_exn (value closure, value arg); CAMLextern value caml_callback2_exn (value closure, value arg1, value arg2); CAMLextern value caml_callback3_exn (value closure, value arg1, value arg2, value arg3); CAMLextern value caml_callbackN_exn (value closure, int narg, value args[]); #define Make_exception_result(v) ((intnat)(v) | 2) #define Is_exception_result(v) (((intnat)(v) & 3) == 2) #define Extract_exception(v) ((value)((intnat)(v) & ~3)) CAMLextern value * caml_named_value (char * name); CAMLextern void caml_main (char ** argv); CAMLextern void caml_startup (char ** argv); CAMLextern int caml_callback_depth; #endif lablgtk-2.18.8/src/gobject.mli0000644000175000017500000002076313460263323015203 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) type -'a obj type g_type type g_class type g_value type g_closure type basic = [ `BOOL of bool | `CAML of Obj.t | `CHAR of char | `FLOAT of float | `INT of int | `INT64 of int64 | `POINTER of Gpointer.boxed option | `STRING of string option ] type data_get = [ basic | `NONE | `OBJECT of unit obj option ] type 'a data_set = [ basic | `OBJECT of 'a obj option | `INT32 of int32 | `LONG of nativeint ] type base_data = [ `BOOLEAN | `CHAR | `UCHAR | `INT | `UINT | `LONG | `ULONG | `INT64 | `UINT64 | `ENUM | `FLAGS | `FLOAT | `DOUBLE | `STRING | `POINTER | `BOXED | `OBJECT ] type data_kind = [ `INT32 | `UINT32 | `OTHER of g_type | base_data ] type data_conv_get = [ `INT32 of int32 | data_get ] type 'a data_conv = { kind : data_kind; proj : data_conv_get -> 'a; inj : 'a -> unit data_set } type ('a, 'b) property = { name : string; conv : 'b data_conv } type fundamental_type = [ `INVALID | `NONE | `INTERFACE | `PARAM | base_data ] type signal_type = [ `RUN_FIRST | `RUN_LAST | `NO_RECURSE | `ACTION | `NO_HOOKS ] exception Cannot_cast of string * string val get_type : 'a obj -> g_type val is_a : 'a obj -> string -> bool val try_cast : 'a obj -> string -> 'b obj val get_oid : 'a obj -> int external unsafe_cast : 'a obj -> 'b obj = "%identity" external coerce : 'a obj -> unit obj = "%identity" external coerce_option : 'a obj option -> unit obj option = "%identity" (* [coerce] and [coerce_option] are safe *) type +'a param val dyn_param : string -> 'a data_set -> 'b param val param : ('a,'b) property -> 'b -> 'a param val unsafe_create : classe:string -> 'a param list -> 'a obj (* This type is NOT safe *) val unsafe_unref : 'a obj -> unit (* Creates a NULL pointer; many places do not check for them! *) val get_ref_count : 'a obj -> int (* Number of references to an object (for debugging) *) val set : ('a, 'b) property -> 'a obj -> 'b -> unit (* Will not raise an exception but may emit a Glib warning and ignore the property if it does not exist. *) val get : ('a, 'b) property -> 'a obj -> 'b (* [get prop o] may raise [Invalid_argument prop_name] *) val set_params : 'a obj -> 'a param list -> unit (* May emit a Glib warning and ignore the non existent properties. *) module Type : sig val init : unit -> unit val name : g_type -> string val from_name : string -> g_type val parent : g_type -> g_type val depth : g_type -> int val is_a : g_type -> g_type -> bool val fundamental : g_type -> fundamental_type val of_fundamental : fundamental_type -> g_type val interface_prerequisites : g_type -> g_type list (* [Benjamin] Experimental stub: the new class has the same size as its parent. No init functions right now. *) val register_static : parent:g_type -> name:string -> g_type val caml : g_type end module Value : sig val create_empty : unit -> g_value val init : g_value -> g_type -> unit val create : g_type -> g_value val release : g_value -> unit val get_type : g_value -> g_type val copy : g_value -> g_value -> unit val reset : g_value -> unit val type_compatible : g_type -> g_type -> bool val type_transformable : g_type -> g_type -> bool val transform : g_value -> g_value -> bool val get : g_value -> data_get val set : g_value -> 'a data_set -> unit val get_pointer : g_value -> Gpointer.boxed val get_nativeint : g_value -> nativeint val get_int32 : g_value -> int32 val get_conv : data_kind -> g_value -> data_conv_get end module Closure : sig type args type argv = { result : g_value; nargs : int; args : args; } val create : (argv -> unit) -> g_closure val nth : argv -> pos:int -> g_value val result : argv -> g_value val get_result_type : argv -> g_type val get_type : argv -> pos:int -> g_type val get : argv -> pos:int -> data_get val set_result : argv -> 'a data_set -> unit val get_args : argv -> data_get list val get_pointer : argv -> pos:int -> Gpointer.boxed val get_nativeint : argv -> pos:int -> nativeint val get_int32 : argv -> pos:int -> int32 end module Data : sig val boolean : bool data_conv val char : char data_conv val uchar : char data_conv val int : int data_conv val uint : int data_conv val long : int data_conv val ulong : int data_conv val flags : ([> ] as 'a) Gpointer.variant_table -> 'a list data_conv val enum : ([> ] as 'a) Gpointer.variant_table -> 'a data_conv val int32 : int32 data_conv val uint32 : int32 data_conv val int64 : int64 data_conv val uint64 : int64 data_conv val float : float data_conv val double : float data_conv val string : string data_conv val string_option : string option data_conv (* pointers disable copy *) val pointer : Gpointer.boxed option data_conv val unsafe_pointer : 'a data_conv val unsafe_pointer_option : 'a option data_conv (* use boxed to enable copy of parameter *) val boxed : g_type -> Gpointer.boxed option data_conv val unsafe_boxed : g_type -> 'a data_conv val unsafe_boxed_option : g_type -> 'a option data_conv val gobject : 'a obj data_conv val gobject_option : 'a obj option data_conv val gobject_by_name : string -> 'a obj data_conv val caml : 'a data_conv val caml_option : 'a option data_conv val wrap : inj:('a -> 'b) -> proj:('b -> 'a) -> 'b data_conv -> 'a data_conv val of_value : 'a data_conv -> g_value -> 'a val to_value : 'a data_conv -> 'a -> g_value val get_type : 'a data_conv -> g_type end module Property : sig val freeze_notify : 'a obj -> unit val thaw_notify : 'a obj -> unit val notify : 'a obj -> string -> unit val set_value : 'a obj -> string -> g_value -> unit (* [set_value o name] may raise [Invalid_argument name] *) val get_value : 'a obj -> string -> g_value -> unit (* [get_value o name] may raise [Invalid_argument name] *) val get_type : 'a obj -> string -> g_type (* [get_type o name] may raise [Invalid_argument name] *) val set_dyn : 'a obj -> string -> 'b data_set -> unit (* Will not raise an exception but may emit a Glib warning and ignore the property if it does not exist. *) val get_dyn : 'a obj -> string -> data_get (* [set_type o name] may raise [Invalid_argument name] *) val set : 'a obj -> ('a, 'b) property -> 'b -> unit (* Will not raise an exception but may emit a Glib warning and ignore the property if it does not exist. *) val get : 'a obj -> ('a, 'b) property -> 'b (* [get o prop] may raise [Invalid_argument prop_name] *) val get_some : 'a obj -> ('a, 'b option) property -> 'b val check : 'a obj -> ('a, 'b) property -> unit val may_cons : ('a,'b) property -> 'b option -> 'a param list -> 'a param list val may_cons_opt : ('a,'b option) property -> 'b option -> 'a param list -> 'a param list end lablgtk-2.18.8/src/lablgtk2.in0000755000175000017500000000402413460263323015110 0ustar stephsteph#!/bin/sh thread="no" localdir="no" usedll="@USEDLL@" threads_lib="@THREADS_LIB@" verbose="no" extra="no" init="yes" toplevel="ocaml" libraries="" libpath="" lablgtkdir="@INSTALLDIR@" initobjs="@INITOBJS@" thinitobjs="@THINITOBJS@" cmd="$0" if test -n "@LABLGLDIR@"; then libpath="-I @LABLGLDIR@" fi while test -n "$1"; do case $1 in -help) echo "Usage: lablgtk2 [script-file]" echo " -thread use the threaded version of the toplevel" echo " -all load all extensions" echo " -noinit do not initialize gtk" echo " -localdir use libraries in the same directory (before install)" echo " -verbose show actions executed" exit 0 ;; -thread) thread=yes ;; -localdir) localdir=yes ;; -all) extra=yes ;; -noinit) init=no ;; -nothinit) thinitobjs="" ;; -verbose) verbose=yes ;; *) break ;; esac shift done if test $localdir = yes; then lablgtkdir=`dirname "$cmd"` CAML_LD_LIBRARY_PATH=${lablgtkdir}:$CAML_LD_LIBRARY_PATH if test $verbose = yes; then echo CAML_LD_LIBRARY_PATH=$CAML_LD_LIBRARY_PATH fi fi libpath="-I $lablgtkdir $libpath" if test $extra = yes; then libraries="@MLLIBS@" else libraries="lablgtk.cma" fi if test $thread = yes; then case "$threads_lib" in no) echo "Threads are not supported on this platform"; exit 2 ;; system) libpath="$libpath -I +threads" libraries="unix.cma threads.cma $libraries @THOBJS@" ;; *) libpath="$libpath -I +vmthreads" usedll="no" ;; # use different stdlib.cma esac initobjs="$initobjs $thinitobjs" elif test $extra = yes; then case "$threads_lib" in system) libraries="unix.cma $libraries";; *) usedll="no";; # some libraries require posix threads esac fi if test $usedll = no; then toplevel="$lablgtkdir/lablgtktop" libraries="" fi if test $init = yes; then libraries="$libraries $initobjs" fi if test $verbose = yes; then echo $toplevel -w s $libpath $libraries $*; fi exec $toplevel -w s $libpath $libraries $* lablgtk-2.18.8/src/gtkThread.ml0000644000175000017500000001073213460263323015325 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open GtkMain (* Job handling for Windows *) let jobs : (unit -> unit) Queue.t = Queue.create () let m = Mutex.create () let with_jobs f = Mutex.lock m; let y = f jobs in Mutex.unlock m; y let loop_id = ref None let reset () = loop_id := None let cannot_sync () = match !loop_id with None -> true | Some id -> Thread.id (Thread.self ()) = id let gui_safe () = not (Sys.os_type = "Win32") || !loop_id = Some(Thread.id (Thread.self ())) let has_jobs () = not (with_jobs Queue.is_empty) let n_jobs () = with_jobs Queue.length let do_next_job () = with_jobs Queue.take () let has_timeout = ref false let async j x = with_jobs (fun jobs -> Queue.add (fun () -> GtkSignal.safe_call j x ~where:"asynchronous call") jobs; if not !has_timeout then begin has_timeout := true; ignore (Glib.Timeout.add 1 (fun () -> has_timeout := false; false)) end) type 'a result = Val of 'a | Exn of exn | NA let sync f x = if cannot_sync () then f x else let m = Mutex.create () in let res = ref NA in Mutex.lock m; let c = Condition.create () in let j x = let y = try Val (f x) with e -> Exn e in Mutex.lock m; res := y; Mutex.unlock m; Condition.signal c in async j x; while !res = NA do Condition.wait c m done; match !res with Val y -> y | Exn e -> raise e | NA -> assert false let do_jobs_delay = ref 0.013;; let set_do_jobs_delay d = do_jobs_delay := max 0. d;; let do_jobs () = for i = 1 to n_jobs () do do_next_job () done; true (* We check first whether there are some event pending, and run some iterations. We then need to delay, thus focing a thread switch. *) let busy_waiting = ref (try Sys.getenv "LABLGTK_BUSY_WAIT" <> "0" with _ -> false) let thread_main_real () = try let loop = (Glib.Main.create true) in Main.loops := loop :: !Main.loops; Glib.Main.wrap_poll_func (); (* mark polling as blocking *) loop_id := Some (Thread.id (Thread.self ())); while Glib.Main.is_running loop do if not !busy_waiting then ignore (Glib.Main.iteration true) (* blocking *) else begin let i = ref 0 in (* Non blocking busy waiting *) Thread.delay !do_jobs_delay; while !i < 100 && Glib.Main.pending () do Glib.Main.iteration true; incr i done end; do_jobs () done; Main.loops := List.tl !Main.loops; with exn -> Main.loops := List.tl !Main.loops; raise exn let thread_main () = sync thread_main_real () let main () = GtkMain.Main.main_func := thread_main; thread_main () let start () = reset (); Thread.create main () (* The code below would do nothing... let _ = let mutex = Mutex.create () in let depth = ref 0 in GtkSignal.enter_callback := (fun () -> if !depth = 0 then Mutex.lock mutex; incr depth); GtkSignal.exit_callback := (fun () -> decr depth; if !depth = 0 then Mutex.unlock mutex) *) lablgtk-2.18.8/src/gtkSpell.mli0000644000175000017500000000375113460263323015351 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** GtkSpell interface *) type error = BACKEND exception Error of error * string val attach : ?lang:string -> #GText.view -> unit (** Starts spell checking on the GtkTextView. @raise Error . *) val is_attached : #GText.view -> bool val detach : #GText.view -> unit val recheck_all : #GText.view -> unit val set_language : #GText.view -> string option -> unit (** @raise Error . *) lablgtk-2.18.8/src/propcc.ml40000644000175000017500000006132013460263323014761 0ustar stephsteph(* -*- caml -*- *) (* $Id$ *) open StdLabels open MoreLabels let caml_keywords = ["type","kind"; "class","classe"; "list", "liste"] let caml_modules = ["List", "Liste"] let is_not_uppercase = function | 'A' .. 'Z' -> false | _ -> true let camlize id = let b = Buffer.create (String.length id + 4) in for i = 0 to String.length id - 1 do match id.[i] with | 'A' .. 'Z' as c -> if i > 0 && (is_not_uppercase id.[i-1] || (i < String.length id - 1 && is_not_uppercase id.[i+1])) then Buffer.add_char b '_' ; Buffer.add_char b (Char.lowercase c) | '-' -> Buffer.add_char b '_' | c -> Buffer.add_char b c done; let s = Buffer.contents b in try List.assoc s caml_keywords with Not_found -> s let camlizeM s = try List.assoc s caml_modules with Not_found -> s let check_suffix s suff = let len1 = String.length s and len2 = String.length suff in len1 > len2 && String.sub s (len1-len2) len2 = suff (* Arity of a caml type. Doesn't handle object types... *) let arity s = let parens = ref 0 and arity = ref 0 in for i = 0 to String.length s - 1 do if s.[i] = '(' || s.[i] = '[' then incr parens else if s.[i] = ')' || s.[i] = ']' then decr parens else if !parens = 0 && s.[i] = '-' && s.[i+1] = '>' then incr arity done; if !parens <> 0 then failwith ("bad type : " ^ s); !arity let rec min_labelled = function | [] -> [] | a :: l -> let l = min_labelled l in if l = [] && a = "" then [] else a::l (* The real data *) let conversions = Hashtbl.create 17 let enums = [ "Gtk", "GtkEnums", [ "Justification"; "ArrowType"; "ShadowType"; "ResizeMode"; "ReliefStyle"; "ImageType"; "WindowType"; "WindowPosition"; "ButtonsType"; "MessageType"; "ButtonBoxStyle"; "PositionType"; "Orientation"; "ToolbarStyle"; "IconSize"; "PolicyType"; "CornerType"; "SelectionMode"; "SortType"; "WrapMode"; "SpinButtonUpdatePolicy"; "UpdateType"; "ProgressBarStyle"; "ProgressBarOrientation"; "CellRendererMode"; "CellRendererAccelMode"; "TreeViewColumnSizing"; "SortType"; "TextDirection"; "SizeGroupMode"; (* in signals *) "MovementStep"; "ScrollStep"; "ScrollType"; "MenuDirectionType"; "DeleteType"; "StateType"; (* for canvas *) "AnchorType"; "DirectionType"; ]; "Gdk", "GdkEnums", [ "ExtensionMode"; "WindowTypeHint"; "EventMask"; (* for canvas *) "CapStyle"; "JoinStyle"; "LineStyle"]; "Pango", "PangoEnums", [ "Stretch"; "Style"; "Underline"; "Variant"; "EllipsizeMode" ]; (* GtkSourceView *) "Gtk","SourceView2Enums", ["SourceSmartHomeEndType"; "SourceDrawSpacesFlags"] ] (* These types must be registered with g_boxed_register! *) let boxeds = [ "Gdk", ["Color"; "Font";]; "Pango", ["FontDescription";]; "Gtk", ["IconSet";"SelectionData";"TextIter";"TreePath"; "TreeIter";]; ] let classes = [ "Gdk", [ "Image"; "Pixmap"; "Bitmap"; "Screen"; "DragContext";]; "Gtk", [ "Style"; "TreeStore"; "TreeModel"; "TreeModelFilter"; "Tooltip" ] ] let specials = [ "GtkWidget", "GObj.conv_widget"; "GtkWidget_opt", "GObj.conv_widget_option"; "GtkAdjustment", "GData.conv_adjustment"; "GtkAdjustment_opt", "GData.conv_adjustment_option"; ] let add_pointer conv gtk name = Hashtbl.add conversions gtk (Printf.sprintf "(%s : %s data_conv)" conv name); Hashtbl.add conversions (gtk ^ "_opt") (Printf.sprintf "(%s_option : %s option data_conv)" conv name) let add_object = add_pointer "gobject" let add_boxed = add_pointer "unsafe_pointer" (* the type is not used *) let () = List.iter ~f:(fun t -> Hashtbl.add conversions ("g"^t) t) [ "boolean"; "char"; "uchar"; "int"; "uint"; "long"; "ulong"; "int32"; "uint32"; "int64"; "uint64"; "float"; "double" ]; List.iter ~f:(fun (gtype,conv) -> Hashtbl.add conversions gtype conv) [ "gchararray", "string"; "gchararray_opt", "string_option"; "string", "string"; "bool", "boolean"; "int", "int"; "int32", "int32"; "float", "float"; ]; List.iter enums ~f:(fun (pre, modu, l) -> List.iter l ~f: begin fun name -> Hashtbl.add conversions (pre ^ name) (Printf.sprintf "%s.%s_conv" modu (camlize name)) end); List.iter boxeds ~f:(fun (pre, l) -> List.iter l ~f:(fun name -> add_boxed (pre^name) (pre^"."^camlize name))); List.iter classes ~f:(fun (pre,l) -> List.iter l ~f:(fun t -> add_object (pre^t) (pre^"."^camlize t))); add_object "GObject" "unit obj"; add_object "GtkWidget" "Gtk.widget obj" open Genlex let lexer = make_lexer ["{"; "}"; ":"; "/"; "("; ")";"->";"method";"signal"] let rec star ?(acc=[]) p = parser [< x = p ; s >] -> star ~acc:(x::acc) p s | [< >] -> List.rev acc let may_token tok s = if Stream.peek s = Some tok then Stream.junk s let ident = parser [< ' Ident id >] -> id let string = parser [< ' String s >] -> s let may_colon p def = parser | [< ' Kwd":"; s >] -> p s | [< >] -> def let may_string def = parser [< ' String s >] -> s | [< >] -> def let may_name s = parser [< ' Kwd"("; ' Ident id; ' Kwd")" >] -> id | [< >] -> (camlize s) let next_attr = parser [< ' Kwd"/"; ' Ident id; ids = star ~acc:[id] ident >] -> String.concat ~sep:"" ids let attributes = ["Read";"Write";"Construct";"ConstructOnly";"NoSet";"Set"; "NoWrap";"Wrap";"NoGet";"VSet";"NoVSet"] let label_type2 id = parser | [< ' Kwd":"; ' Ident ty >] -> (id,ty) | [< >] -> ("",id) let label_type = parser [< ' Ident id ; lty = label_type2 id >] -> lty type marshal = Function of string | Types of (string list * string list * string) let return_type (l,types) = parser [< ' Kwd"->"; ' Ident ret >] -> Types (l, types, ret) | [< >] -> Types (l, types, "") let marshaller = parser | [< ' String s >] -> Function s | [< ' Kwd":"; types = star label_type; s >] -> return_type (List.split types) s | [< >] -> Types ([], [], "") let simple_attr = parser [< ' Kwd"/"; ' Ident s >] -> s let field = parser [< ' String name; mlname = may_name name; ' Ident gtype; ' Kwd":"; ' Ident attr0; attrs = star ~acc:[attr0] next_attr >] -> if not (List.for_all attrs ~f:(List.mem ~set:attributes)) then raise (Stream.Error "bad attribute"); `Prop (name, mlname, gtype, attrs) | [< ' Kwd"method"; ' Ident name; ty = may_colon string "unit"; attrs = star simple_attr >] -> if not (List.for_all attrs ~f:(List.mem ~set:["Wrap"])) then raise (Stream.Error "bad attribute"); `Method (name, ty, attrs) | [< ' Kwd"signal"; ' Ident name; m = marshaller; l = star simple_attr >] -> if not (List.for_all l ~f:(List.mem ~set:["Wrap";"NoWrap"])) then raise (Stream.Error "bad attribute"); `Signal (name, m, l) let split_fields l = List.fold_right l ~init:([],[],[]) ~f: (fun field (props,meths,sigs) -> match field with `Prop p -> (p::props,meths,sigs) | `Method m -> (props,m::meths,sigs) | `Signal s -> (props,meths,s::sigs)) let verb_braces = ref 0 let rec verbatim buf = parser | [< ''}' ; s >] -> if !verb_braces = 0 then Buffer.contents buf else begin decr verb_braces; Buffer.add_char buf '}'; verbatim buf s; end | [< ''{'; s >] -> Buffer.add_char buf '{'; incr verb_braces; verbatim buf s | [< ''\\' ; 'c ; s >] -> if c <> '}' && c <> '{' then Buffer.add_char buf '\\'; Buffer.add_char buf c; verbatim buf s | [< 'c ; s >] -> Buffer.add_char buf c; verbatim buf s let read_pair = parser | [< ' Ident cls ; data = may_string (camlize cls) >] -> (cls,data) let qualifier = parser | [< ' Ident id ; data = may_string "" >] -> (id,data) let prefix = ref "" let tagprefix = ref "" let decls = ref [] let headers = ref [] let oheaders = ref [] let checks = ref false let class_qualifiers = ["abstract";"notype";"hv";"set";"wrap";"wrapset";"vset";"tag";"wrapsig"; "type";"gobject";] let process_phrase ~chars = parser [< ' Ident"class"; ' Ident name; gtk_name = may_string (!prefix ^ name); attrs = star qualifier; parent = may_colon ident ""; ' Kwd"{"; fields = star field; ' Kwd"}" >] -> if List.exists attrs ~f: (fun (x,_) -> not (List.mem x class_qualifiers)) then raise (Stream.Error "bad qualifier"); let attrs = ("parent",parent) :: attrs in let attrs = if parent = "GObject" then ("gobject","")::attrs else attrs in let props, meths, sigs = split_fields fields in decls := (name, gtk_name, attrs, props, meths, sigs) :: !decls | [< ' Ident"header"; ' Kwd"{" >] -> let h = verbatim (Buffer.create 1000) chars in headers := !headers @ [h] | [< ' Ident"oheader"; ' Kwd"{" >] -> let h = verbatim (Buffer.create 1000) chars in oheaders := !oheaders @ [h] | [< ' Ident"prefix"; ' String id >] -> prefix := id | [< ' Ident"tagprefix"; ' String id >] -> tagprefix := id | [< ' Ident"conversions"; pre1 = may_string ""; pre2 = may_string pre1; ' Kwd"{"; l = star read_pair; ' Kwd"}" >] -> List.iter l ~f:(fun (k,d) -> Hashtbl.add conversions (pre1^k) (if pre2="" then d else pre2^"."^d)) | [< ' Ident"classes"; ' Kwd"{"; l = star read_pair; ' Kwd"}" >] -> List.iter l ~f:(fun (k,d) -> add_object k d) | [< ' Ident"boxed"; ' Kwd"{"; l = star read_pair; ' Kwd"}" >] -> List.iter l ~f:(fun (k,d) -> add_boxed k d) | [< ' _ >] -> raise (Stream.Error "") | [< >] -> raise End_of_file let all_props = Hashtbl.create 137 let all_pnames = Hashtbl.create 137 let outfile = ref "" let ooutfile = ref "" let process_file f = let base = Filename.chop_extension f in let baseM = String.capitalize base in prefix := baseM; (* Input *) (* Redefining saves space in bytecode! *) headers := ["open Gobject"; "open Data"; "module Object = GtkObject"]; oheaders := ["open GtkSignal"; "open Gobject"; "open Data"; "let set = set"; "let get = get"; "let param = param"]; let ic = open_in f in let chars = Stream.of_channel ic in let s = lexer chars in begin try while true do process_phrase ~chars s done with End_of_file -> () | Stream.Error _ | Stream.Failure -> Printf.eprintf "Parse error in file `%s' before char %d\n" f (Stream.count chars); exit 2 | exn -> Printf.eprintf "Exception %s in file `%s' before char %d\n" (Printexc.to_string exn) f (Stream.count chars); exit 2 end; (* Preproccess *) let type_name name ~attrs = try List.assoc "type" attrs with Not_found -> if List.mem_assoc "gobject" attrs then camlize name else if !prefix <> "" then !prefix ^ "." ^ camlize name ^ " obj" else camlize name ^ " obj" in let decls = List.rev !decls in let decls = List.filter decls ~f:(fun (_,_,attrs,_,_,_) -> not (List.mem_assoc "notype" attrs)) in List.iter decls ~f: (fun (name, gtk_name, attrs, _, _, _) -> add_object gtk_name (type_name name ~attrs)); (* Output modules *) if !outfile = "" then outfile := base ^ "Props.ml"; let oc = open_out !outfile in let ppf = Format.formatter_of_out_channel oc in let out fmt = Format.fprintf ppf fmt in List.iter !headers ~f:(fun s -> out "%s@." s); let decls = List.map decls ~f: begin fun (name, gtk_name, attrs, props, meths, sigs) -> (name, gtk_name, attrs, List.filter props ~f: begin fun (name,_,gtype,_) -> try ignore (Hashtbl.find conversions gtype); try let count, _ = Hashtbl.find all_props (name,gtype) in incr count; true with Not_found -> Hashtbl.add all_props (name,gtype) (ref 1, ref ""); true with Not_found -> prerr_endline ("Warning: no conversion for type " ^ gtype ^ " in class " ^ gtk_name); false end, meths, List.filter sigs ~f: begin function | _, Function _, _ -> true | _, Types(_, l, ret), _ -> List.for_all (if ret = "" then l else ret::l) ~f: (fun ty -> if Hashtbl.mem conversions ty then true else (prerr_endline ("Warning: no conversion for type " ^ ty ^ " in class " ^ gtk_name); false)) end) end in let defprop ~name ~mlname ~gtype ~tag = let conv = Hashtbl.find conversions gtype in out "@ @[let %s " mlname; if tag <> "gtk" then out ": ([>`%s],_) property " tag; out "=@ @[{name=\"%s\";@ conv=%s}@]@]" name conv in let shared_props = Hashtbl.fold all_props ~init:[] ~f: begin fun ~key:(name,gtype) ~data:(count,rpname) acc -> if !count <= 1 then acc else let pname = camlize name in let pname = if Hashtbl.mem all_pnames pname then pname ^ "_" ^ gtype else (Hashtbl.add all_pnames pname (); pname) in rpname := "PrivateProps." ^ pname; (pname,name,gtype) :: acc end in if shared_props <> [] then begin out "@[module PrivateProps = struct"; List.iter (List.sort compare shared_props) ~f: (fun (pname,name,gtype) -> defprop ~name ~mlname:pname ~gtype ~tag:"gtk"); out "@]\nend\n@."; end; (* Redefining saves space in bytecode! *) out "let may_cons = Property.may_cons\n"; out "let may_cons_opt = Property.may_cons_opt\n@."; let may_cons_props props = if props <> [] then begin out "@ @[let pl = "; List.iter props ~f: begin fun (name,mlname,gtype,_) -> let op = if check_suffix gtype "_opt" then "may_cons_opt" else "may_cons" in out "(@;<0>%s P.%s %s " op (camlize name) mlname; end; out "pl"; for k = 1 to List.length props do out ")" done; out " in@]" end in let omarshaller ~gtk_class ~name ppf (l,tyl,ret) = let out fmt = Format.fprintf ppf fmt in out "fun f ->@ @[marshal%d" (List.length l); if ret <> "" then out "_ret@ ~ret:%s" (Hashtbl.find conversions ret); List.iter tyl ~f:(fun ty -> out "@ %s" ty); out "@ \"%s::%s\"" gtk_class name; if List.for_all l ~f:((=) "") then out " f" else begin let l = min_labelled l in out "@ @[(fun "; for i = 1 to List.length l do out "x%d " i done; out "->@ f"; let i = ref 0 in List.iter l ~f: (fun p -> incr i; if p="" then out "@ x%d" !i else out "@ ~%s:x%d" p !i); out ")@]"; end; out "@]" in List.iter decls ~f: begin fun (name, gtk_class, attrs, props, meths, sigs) -> out "@[module %s = struct" (camlizeM name); out "@ @[let cast w : %s =@ try_cast w \"%s\"@]" (type_name name ~attrs) gtk_class; let tag = try List.assoc "tag" attrs with Not_found -> !tagprefix ^ String.lowercase name in if props <> [] then begin out "@ @[module P = struct"; List.iter props ~f: begin fun (name, _, gtype, attrs) -> let count, rpname = Hashtbl.find all_props (name,gtype) in if !count > 1 then begin out "@ let %s : ([>`%s],_) property = %s" (camlize name) tag !rpname end else defprop ~name ~mlname:(camlize name) ~gtype ~tag end; out "@]@ end" end; if sigs <> [] then begin out "@ @[module S = struct@ open GtkSignal"; List.iter sigs ~f: begin fun (name,marshaller,_) -> out "@ @[let %s =" (camlize name); out "@ @[{name=\"%s\";@ classe=`%s;@ marshaller=" name tag; begin match marshaller with | Function s -> out "%s" s | Types ([], [], "") -> out "marshal_unit" | Types ([], [], ret) -> out "fun f -> marshal0_ret ~ret:%s f" (Hashtbl.find conversions ret) | Types (l, tyl, ret) -> omarshaller ~gtk_class ~name ppf (l, List.map (Hashtbl.find conversions) tyl, ret) end; out "}@]@]"; end; out "@]@ end"; end; if not (List.mem_assoc "abstract" attrs) then begin let cprops = List.filter props ~f:(fun (_,_,_,a) -> List.mem "ConstructOnly" a && not (List.mem "NoSet" a)) in out "@ @[let create"; List.iter cprops ~f:(fun (_,name,_,_) -> out " ?%s" name); if List.mem_assoc "hv" attrs then begin out " (dir : Gtk.Tags.orientation) pl : %s =" (type_name name ~attrs); may_cons_props cprops; out "@ @[Object.make"; out "@ (if dir = `HORIZONTAL then \"%sH%s\" else \"%sV%s\")@ pl" !prefix name !prefix name; out "@]@]"; end else begin out " pl : %s =" (type_name name ~attrs); may_cons_props cprops; if List.mem_assoc "gobject" attrs then out "@ Gobject.unsafe_create" else out "@ Object.make"; out " \"%s\" pl@]" gtk_class; end end; List.iter meths ~f: begin fun (name, typ, attrs) -> out "@ @[external %s :" name; out "@ @[[>`%s] obj ->@ %s@]" tag typ; let cname = camlize ("ml" ^ gtk_class) ^ "_" ^ name in out "@ = \""; if arity typ > 4 then out "%s_bc\" \"" cname; out "%s\"@]" cname; end; let set_props = let set = List.mem_assoc "set" attrs in List.filter props ~f: (fun (_,_,_,a) -> (set || List.mem "Set" a) && List.mem "Write" a && not (List.mem "ConstructOnly" a || List.mem "NoSet" a)) in if set_props <> [] then begin let props = set_props in out "@ @[@[let make_params ~cont pl"; List.iter props ~f:(fun (_,name,_,_) -> out "@ ?%s" name); out " =@]"; may_cons_props props; out "@ cont pl@]"; end; if !checks && (props <> [] || sigs <> []) then begin if List.mem_assoc "abstract" attrs then out "@ @[let check w =" else begin out "@ @[let check () ="; out "@ let w = create%s [] in" (if List.mem_assoc "hv" attrs then " `HORIZONTAL" else ""); end; if props <> [] then out "@ let c p = Property.check w p in"; if sigs <> [] then begin out "@ let closure = Closure.create ignore in"; out "@ let s name = GtkSignal.connect_by_name"; out " w ~name ~closure ~after:false in"; end; out "@ @["; List.iter props ~f: (fun (name,_,gtype,attrs) -> if List.mem "Read" attrs then out "c P.%s;@ " (camlize name)); List.iter sigs ~f:(fun (name,_,_) -> out "s %s;@ " name); out "()@]"; end; out "@]@.end\n@." end; close_out oc; (* Output classes *) if !ooutfile = "" then ooutfile := "o" ^ !outfile; let oc = open_out !ooutfile in let ppf = Format.formatter_of_out_channel oc in let out fmt = Format.fprintf ppf fmt in List.iter !oheaders ~f:(fun s -> out "%s@." s); out "open %s@." (String.capitalize (Filename.chop_extension !outfile)); out "@["; let oprop ~name ~gtype ppf pname = try let conv = List.assoc gtype specials in Format.fprintf ppf "{%s.P.%s with conv=%s}" (camlizeM name) (camlize pname) conv with Not_found -> Format.fprintf ppf "%s.P.%s" (camlizeM name) (camlize pname) in List.iter decls ~f: begin fun (name, gtk_class, attrs, props, meths, sigs) -> let wrap = List.mem_assoc "wrap" attrs in let wrapset = wrap || List.mem_assoc "wrapset" attrs in let wr_props = List.filter props ~f: (fun (_,_,_,set) -> let has = List.mem ~set in (wrapset || has "Wrap") && has "Write" && not (has "ConstructOnly" || has "NoWrap")) and rd_props = List.filter props ~f: (fun (_,_,_,set) -> let has = List.mem ~set in (wrap || has "Wrap") && has "Read" && not (has "NoWrap" || has "NoGet")) and wr_meths = List.filter meths ~f:(fun (_,_,attrs) -> List.mem "Wrap" attrs) in if wr_props <> [] || rd_props <> [] || wr_meths <> [] then begin (* pre 3.10 out "@ @[class virtual %s_props = object (self)" (camlize name); out "@ method private virtual obj : _ obj"; List.iter wr_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method set_%s =@ set %a self#obj@]" mlname (oprop ~name ~gtype) pname); List.iter rd_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method %s =@ get %a self#obj@]" mlname (oprop ~name ~gtype) pname); List.iter wr_meths ~f:(fun (mname,typ,_) -> out "@ @[method %s %s=@ %s.%s self#obj@]" mname (if typ = "unit" then "() " else "") (camlizeM name) mname); *) (* post 3.10 *) out "@ @[class virtual %s_props = object" (camlize name); out "@ val virtual obj : _ obj"; List.iter wr_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method set_%s =@ set %a obj@]" mlname (oprop ~name ~gtype) pname); List.iter rd_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method %s =@ get %a obj@]" mlname (oprop ~name ~gtype) pname); List.iter wr_meths ~f:(fun (mname,typ,_) -> out "@ @[method %s %s=@ %s.%s obj@]" mname (if typ = "unit" then "() " else "") (camlizeM name) mname); out "@]@ end@ "; (* #notify: easy connection to the "foo::notify" signal for the "foo" * properties. *) out "@ @[class virtual %s_notify obj = object (self)" (camlize name); out "@ val obj : 'a obj = obj"; out "@ method private notify : 'b. ('a, 'b) property ->"; out "@ callback:('b -> unit) -> _ ="; out "@ fun prop ~callback -> GtkSignal.connect_property obj"; out "@ ~prop ~callback"; List.iter rd_props ~f:(fun (pname, mlname, gtype, _) -> out "@ @[method %s =@ self#notify %a@]" mlname (oprop ~name ~gtype) pname); out "@]@ end@ "; end; let vset = List.mem_assoc "vset" attrs in let vprops = List.filter props ~f: (fun (_,_,_,set) -> let has = List.mem ~set in (vset || has "VSet") && has "Write" && not (has "ConstructOnly" || has "NoVSet")) in if vprops <> [] then begin out "@ @[let %s_param = function" (camlize name); List.iter vprops ~f:(fun (pname,mlname,gtype,_) -> out "@ @[| `%s p ->@ param %a p@]" (String.uppercase mlname) (oprop ~name ~gtype) pname); out "@]@ "; end; let wsig = List.mem_assoc "wrapsig" attrs in let wsigs = List.filter sigs ~f: (fun (_,_,attrs) -> List.mem "Wrap" attrs || wsig && not (List.mem "NoWrap" attrs)) in if wsigs <> [] then begin out "@ @[class virtual %s_sigs = object (self)" (camlize name); out "@ @[method private virtual connect :"; out "@ 'b. ('a,'b) GtkSignal.t -> callback:'b -> GtkSignal.id@]"; out "@ @[method private virtual notify :"; out "@ 'b. ('a,'b) property -> callback:('b -> unit) -> GtkSignal.id@]"; List.iter wsigs ~f: begin fun (sname, types,_) -> match types with Types(l, tyl,ret) when List.exists tyl ~f:(List.mem_assoc ~map:specials) -> let convs = List.map tyl ~f: (fun ty -> try List.assoc ty specials with Not_found -> Hashtbl.find conversions ty) in out "@ @[method %s =@ self#connect" sname; out "@ @[{%s.S.%s with@ marshaller = %a}@]@]" (camlizeM name) sname (omarshaller ~gtk_class ~name:sname) (l, convs,ret) | _ -> out "@ @[method %s =@ self#connect %s.S.%s@]" sname (camlizeM name) sname end; (* notify: easy connection to "foo::notify" signals for "foo" * properties. *) List.iter rd_props ~f:(fun (pname, mlname, gtype, _) -> out "@ @[method notify_%s ~callback =" mlname; out "@ @[self#notify %a ~callback@]@]" (oprop ~name ~gtype) pname); out "@]@ end@ "; end end; out "@."; close_out oc; outfile := ""; ooutfile := "" let main () = Arg.parse [ "-checks", Arg.Set checks, "generate code for checks"; "-o", Arg.String (fun s -> outfile := s), "basic output file name"; "-oo", Arg.String (fun s -> ooutfile := s), "wrappers output file name" ] process_file "usage: propcc file.props ..." let () = Printexc.print main () lablgtk-2.18.8/src/.depend0000644000175000017500000007534113460263323014325 0ustar stephstephgaux.cmo : gaux.cmx : gpointer.cmo : gpointer.cmi gpointer.cmx : gpointer.cmi gutf8.cmo : gutf8.cmi gutf8.cmx : gutf8.cmi glib.cmo : gutf8.cmi glib.cmi glib.cmx : gutf8.cmx glib.cmi gobject.cmo : gpointer.cmi gaux.cmo gobject.cmi gobject.cmx : gpointer.cmx gaux.cmx gobject.cmi gdkEnums.cmo : gpointer.cmi gobject.cmi gdkEnums.cmx : gpointer.cmx gobject.cmx pangoEnums.cmo : gpointer.cmi gobject.cmi pangoEnums.cmx : gpointer.cmx gobject.cmx gtkEnums.cmo : gpointer.cmi gobject.cmi gtkEnums.cmx : gpointer.cmx gobject.cmx pango.cmo : gpointer.cmi gobject.cmi glib.cmi gaux.cmo pango.cmx : gpointer.cmx gobject.cmx glib.cmx gaux.cmx gdk.cmo : pango.cmo gpointer.cmi gobject.cmi gaux.cmo gdk.cmi gdk.cmx : pango.cmx gpointer.cmx gobject.cmx gaux.cmx gdk.cmi gdkEvent.cmo : gpointer.cmi gdk.cmi gaux.cmo gdkEvent.cmx : gpointer.cmx gdk.cmx gaux.cmx gdkKeysyms.cmo : gdk.cmi gdkKeysyms.cmx : gdk.cmx gdkPixbuf.cmo : gpointer.cmi gobject.cmi gdk.cmi gaux.cmo gdkPixbuf.cmi gdkPixbuf.cmx : gpointer.cmx gobject.cmx gdk.cmx gaux.cmx gdkPixbuf.cmi gtk.cmo : gpointer.cmi gobject.cmi gtk.cmx : gpointer.cmx gobject.cmx gtkSignal.cmo : gobject.cmi gtkSignal.cmi gtkSignal.cmx : gobject.cmx gtkSignal.cmi gtkStock.cmo : gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gaux.cmo gtkStock.cmx : gtk.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx gaux.cmx gtkObject.cmo : gtk.cmo gobject.cmi gtkObject.cmx : gtk.cmx gobject.cmx gtkBaseProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gpointer.cmi gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdkEnums.cmo gdk.cmi gtkBaseProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gpointer.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdkEnums.cmx gdk.cmx gtkBinProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdk.cmi gtkBinProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdk.cmx gtkButtonProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gdk.cmi gtkButtonProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gdk.cmx gtkEditProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gtkEditProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gtkListProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdkEvent.cmo gtkListProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdkEvent.cmx gtkMenuProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gtkMenuProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gtkMiscProps.cmo : pangoEnums.cmo gtkStock.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gtkMiscProps.cmx : pangoEnums.cmx gtkStock.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdk.cmx gtkPackProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdk.cmi gtkPackProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdk.cmx gtkRangeProps.cmo : pangoEnums.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gtkRangeProps.cmx : pangoEnums.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gtkTextProps.cmo : pangoEnums.cmo pango.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gtkTextProps.cmx : pangoEnums.cmx pango.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdk.cmx gtkTreeProps.cmo : pangoEnums.cmo pango.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gtkTreeProps.cmx : pangoEnums.cmx pango.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx gtkFileProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gtkFileProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gtkActionProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gtkActionProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gtkBrokenProps.cmo : gtkSignal.cmi gtkObject.cmo gtk.cmo gobject.cmi gtkBrokenProps.cmx : gtkSignal.cmx gtkObject.cmx gtk.cmx gobject.cmx gtkAssistantProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdkPixbuf.cmi gtkAssistantProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdkPixbuf.cmx gtkData.cmo : gtkBaseProps.cmo gtk.cmo gobject.cmi gdk.cmi gaux.cmo gtkData.cmx : gtkBaseProps.cmx gtk.cmx gobject.cmx gdk.cmx gaux.cmx gtkBase.cmo : pango.cmo gtkStock.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtkBaseProps.cmo gtk.cmo gpointer.cmi gobject.cmi \ gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gaux.cmo gtkBase.cmx : pango.cmx gtkStock.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtkBaseProps.cmx gtk.cmx gpointer.cmx gobject.cmx \ gdkPixbuf.cmx gdkEvent.cmx gdk.cmx gaux.cmx gtkPack.cmo : gtkPackProps.cmo gtkBase.cmo gtk.cmo gobject.cmi gaux.cmo gtkPack.cmx : gtkPackProps.cmx gtkBase.cmx gtk.cmx gobject.cmx gaux.cmx gtkButton.cmo : gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtkButtonProps.cmo \ gtkBase.cmo gtk.cmo gpointer.cmi gobject.cmi gaux.cmo gtkButton.cmx : gtkStock.cmx gtkSignal.cmx gtkEnums.cmx gtkButtonProps.cmx \ gtkBase.cmx gtk.cmx gpointer.cmx gobject.cmx gaux.cmx gtkAssistant.cmo : gtkBase.cmo gtkAssistantProps.cmo gtk.cmo gobject.cmi \ gaux.cmo gtkAssistant.cmx : gtkBase.cmx gtkAssistantProps.cmx gtk.cmx gobject.cmx \ gaux.cmx gtkMenu.cmo : gtkStock.cmo gtkMenuProps.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi gaux.cmo gtkMenu.cmx : gtkStock.cmx gtkMenuProps.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx gaux.cmx gtkMisc.cmo : gtkMiscProps.cmo gtkBase.cmo gtk.cmo gobject.cmi gaux.cmo gtkMisc.cmx : gtkMiscProps.cmx gtkBase.cmx gtk.cmx gobject.cmx gaux.cmx gtkWindow.cmo : gtkEnums.cmo gtkBaseProps.cmo gtkBase.cmo gtk.cmo \ gpointer.cmi gobject.cmi gdk.cmi gaux.cmo gtkWindow.cmx : gtkEnums.cmx gtkBaseProps.cmx gtkBase.cmx gtk.cmx \ gpointer.cmx gobject.cmx gdk.cmx gaux.cmx gtkList.cmo : gtkSignal.cmi gtkListProps.cmo gtkEnums.cmo gtkBase.cmo \ gtk.cmo gpointer.cmi gdk.cmi gaux.cmo gtkList.cmx : gtkSignal.cmx gtkListProps.cmx gtkEnums.cmx gtkBase.cmx \ gtk.cmx gpointer.cmx gdk.cmx gaux.cmx gtkBin.cmo : gtkBinProps.cmo gtkBase.cmo gtk.cmo gaux.cmo gtkBin.cmx : gtkBinProps.cmx gtkBase.cmx gtk.cmx gaux.cmx gtkEdit.cmo : gtkList.cmo gtkEditProps.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi gaux.cmo gtkEdit.cmx : gtkList.cmx gtkEditProps.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx gaux.cmx gtkRange.cmo : gtkRangeProps.cmo gtkBase.cmo gtk.cmo gaux.cmo gtkRange.cmx : gtkRangeProps.cmx gtkBase.cmx gtk.cmx gaux.cmx gtkText.cmo : pango.cmo gtkTextProps.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi glib.cmi gdkPixbuf.cmi gdk.cmi gaux.cmo gtkText.cmx : pango.cmx gtkTextProps.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx glib.cmx gdkPixbuf.cmx gdk.cmx gaux.cmx gtkTree.cmo : gtkTreeProps.cmo gtkEnums.cmo gtkBase.cmo gtk.cmo gobject.cmi \ gdk.cmi gaux.cmo gtkTree.cmx : gtkTreeProps.cmx gtkEnums.cmx gtkBase.cmx gtk.cmx gobject.cmx \ gdk.cmx gaux.cmx gtkFile.cmo : gtkObject.cmo gtkFileProps.cmo gtkEnums.cmo gtk.cmo gtkFile.cmx : gtkObject.cmx gtkFileProps.cmx gtkEnums.cmx gtk.cmx gtkMain.cmo : gtk.cmo glib.cmi gdkEvent.cmo gdk.cmi gtkMain.cmx : gtk.cmx glib.cmx gdkEvent.cmx gdk.cmx gtkBroken.cmo : gtkBrokenProps.cmo gtkBase.cmo gtk.cmo gdk.cmi gaux.cmo gtkBroken.cmx : gtkBrokenProps.cmx gtkBase.cmx gtk.cmx gdk.cmx gaux.cmx gPango.cmo : pango.cmo gaux.cmo gPango.cmx : pango.cmx gaux.cmx gDraw.cmo : gtkBase.cmo gpointer.cmi gobject.cmi gdkPixbuf.cmi gdk.cmi \ gaux.cmo gDraw.cmi gDraw.cmx : gtkBase.cmx gpointer.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx \ gaux.cmx gDraw.cmi gObj.cmo : pango.cmo gtkStock.cmo gtkSignal.cmi gtkData.cmo gtkBase.cmo \ gtk.cmo gpointer.cmi gobject.cmi gdk.cmi gaux.cmo gPango.cmo gDraw.cmi \ gObj.cmi gObj.cmx : pango.cmx gtkStock.cmx gtkSignal.cmx gtkData.cmx gtkBase.cmx \ gtk.cmx gpointer.cmx gobject.cmx gdk.cmx gaux.cmx gPango.cmx gDraw.cmx \ gObj.cmi ogtkBaseProps.cmo : gtkSignal.cmi gtkBaseProps.cmo gobject.cmi gObj.cmi ogtkBaseProps.cmx : gtkSignal.cmx gtkBaseProps.cmx gobject.cmx gObj.cmx gData.cmo : ogtkBaseProps.cmo gtkData.cmo gtkBin.cmo gtkBase.cmo gtk.cmo \ gpointer.cmi gobject.cmi gaux.cmo gObj.cmi gData.cmi gData.cmx : ogtkBaseProps.cmx gtkData.cmx gtkBin.cmx gtkBase.cmx gtk.cmx \ gpointer.cmx gobject.cmx gaux.cmx gObj.cmx gData.cmi ogtkBaseProps.cmo : gtkSignal.cmi gtkBaseProps.cmo gobject.cmi gObj.cmi ogtkBaseProps.cmx : gtkSignal.cmx gtkBaseProps.cmx gobject.cmx gObj.cmx ogtkBinProps.cmo : gtkSignal.cmi gtkPackProps.cmo gtkBinProps.cmo \ gobject.cmi gObj.cmi gData.cmi ogtkBinProps.cmx : gtkSignal.cmx gtkPackProps.cmx gtkBinProps.cmx \ gobject.cmx gObj.cmx gData.cmx ogtkButtonProps.cmo : gtkSignal.cmi gtkButtonProps.cmo gobject.cmi gObj.cmi ogtkButtonProps.cmx : gtkSignal.cmx gtkButtonProps.cmx gobject.cmx gObj.cmx ogtkEditProps.cmo : gtkSignal.cmi gtkEditProps.cmo gobject.cmi gData.cmi ogtkEditProps.cmx : gtkSignal.cmx gtkEditProps.cmx gobject.cmx gData.cmx ogtkListProps.cmo : gtkSignal.cmi gtkListProps.cmo gobject.cmi ogtkListProps.cmx : gtkSignal.cmx gtkListProps.cmx gobject.cmx ogtkMenuProps.cmo : gtkSignal.cmi gtkMenuProps.cmo gobject.cmi ogtkMenuProps.cmx : gtkSignal.cmx gtkMenuProps.cmx gobject.cmx ogtkMiscProps.cmo : gtkSignal.cmi gtkMiscProps.cmo gobject.cmi gdkEvent.cmo \ gObj.cmi ogtkMiscProps.cmx : gtkSignal.cmx gtkMiscProps.cmx gobject.cmx gdkEvent.cmx \ gObj.cmx ogtkPackProps.cmo : gtkSignal.cmi gtkPackProps.cmo gobject.cmi gObj.cmi ogtkPackProps.cmx : gtkSignal.cmx gtkPackProps.cmx gobject.cmx gObj.cmx ogtkRangeProps.cmo : gtkSignal.cmi gtkRangeProps.cmo gobject.cmi gData.cmi ogtkRangeProps.cmx : gtkSignal.cmx gtkRangeProps.cmx gobject.cmx gData.cmx ogtkTextProps.cmo : gtkTextProps.cmo gtkSignal.cmi gobject.cmi gData.cmi ogtkTextProps.cmx : gtkTextProps.cmx gtkSignal.cmx gobject.cmx gData.cmx ogtkTreeProps.cmo : gtkTreeProps.cmo gtkSignal.cmi gobject.cmi gObj.cmi \ gData.cmi ogtkTreeProps.cmx : gtkTreeProps.cmx gtkSignal.cmx gobject.cmx gObj.cmx \ gData.cmx ogtkFileProps.cmo : gtkSignal.cmi gtkFileProps.cmo gobject.cmi gObj.cmi ogtkFileProps.cmx : gtkSignal.cmx gtkFileProps.cmx gobject.cmx gObj.cmx ogtkActionProps.cmo : gtkSignal.cmi gtkActionProps.cmo gobject.cmi gObj.cmi ogtkActionProps.cmx : gtkSignal.cmx gtkActionProps.cmx gobject.cmx gObj.cmx ogtkBrokenProps.cmo : gtkSignal.cmi gtkBrokenProps.cmo gobject.cmi gData.cmi ogtkBrokenProps.cmx : gtkSignal.cmx gtkBrokenProps.cmx gobject.cmx gData.cmx ogtkAssistantProps.cmo : gtkSignal.cmi gtkAssistantProps.cmo gobject.cmi ogtkAssistantProps.cmx : gtkSignal.cmx gtkAssistantProps.cmx gobject.cmx gMain.cmo : gtkMain.cmo gtk.cmo glib.cmi gdk.cmi gObj.cmi gData.cmi \ gMain.cmi gMain.cmx : gtkMain.cmx gtk.cmx glib.cmx gdk.cmx gObj.cmx gData.cmx \ gMain.cmi gContainer.cmo : ogtkBaseProps.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi gaux.cmo gObj.cmi gData.cmi gContainer.cmi gContainer.cmx : ogtkBaseProps.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx gaux.cmx gObj.cmx gData.cmx gContainer.cmi gPack.cmo : ogtkPackProps.cmo gtkPack.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi gaux.cmo gObj.cmi gData.cmi gContainer.cmi gPack.cmi gPack.cmx : ogtkPackProps.cmx gtkPack.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx gaux.cmx gObj.cmx gData.cmx gContainer.cmx gPack.cmi gButton.cmo : ogtkButtonProps.cmo gtkButtonProps.cmo gtkButton.cmo \ gtkBase.cmo gtk.cmo gobject.cmi gaux.cmo gObj.cmi gData.cmi \ gContainer.cmi gButton.cmi gButton.cmx : ogtkButtonProps.cmx gtkButtonProps.cmx gtkButton.cmx \ gtkBase.cmx gtk.cmx gobject.cmx gaux.cmx gObj.cmx gData.cmx \ gContainer.cmx gButton.cmi gText.cmo : pango.cmo ogtkTextProps.cmo gtkText.cmo gtkSignal.cmi \ gtkBase.cmo gtk.cmo gobject.cmi glib.cmi gdkPixbuf.cmi gdkEvent.cmo \ gdk.cmi gaux.cmo gObj.cmi gData.cmi gContainer.cmi gText.cmi gText.cmx : pango.cmx ogtkTextProps.cmx gtkText.cmx gtkSignal.cmx \ gtkBase.cmx gtk.cmx gobject.cmx glib.cmx gdkPixbuf.cmx gdkEvent.cmx \ gdk.cmx gaux.cmx gObj.cmx gData.cmx gContainer.cmx gText.cmi gMenu.cmo : ogtkMenuProps.cmo ogtkBaseProps.cmo gtkStock.cmo gtkMenu.cmo \ gtkData.cmo gtkBase.cmo gtk.cmo gobject.cmi gaux.cmo gObj.cmi \ gContainer.cmi gButton.cmi gMenu.cmi gMenu.cmx : ogtkMenuProps.cmx ogtkBaseProps.cmx gtkStock.cmx gtkMenu.cmx \ gtkData.cmx gtkBase.cmx gtk.cmx gobject.cmx gaux.cmx gObj.cmx \ gContainer.cmx gButton.cmx gMenu.cmi gMisc.cmo : ogtkMiscProps.cmo gtkSignal.cmi gtkMiscProps.cmo gtkMisc.cmo \ gtkBase.cmo gtk.cmo gobject.cmi glib.cmi gaux.cmo gPack.cmi gObj.cmi \ gDraw.cmi gContainer.cmi gMisc.cmi gMisc.cmx : ogtkMiscProps.cmx gtkSignal.cmx gtkMiscProps.cmx gtkMisc.cmx \ gtkBase.cmx gtk.cmx gobject.cmx glib.cmx gaux.cmx gPack.cmx gObj.cmx \ gDraw.cmx gContainer.cmx gMisc.cmi gTree.cmo : pango.cmo ogtkTreeProps.cmo ogtkBaseProps.cmo gtkTree.cmo \ gtkEnums.cmo gtkBase.cmo gtk.cmo gpointer.cmi gobject.cmi gdkPixbuf.cmi \ gdkEnums.cmo gdk.cmi gaux.cmo gObj.cmi gData.cmi gContainer.cmi gTree.cmi gTree.cmx : pango.cmx ogtkTreeProps.cmx ogtkBaseProps.cmx gtkTree.cmx \ gtkEnums.cmx gtkBase.cmx gtk.cmx gpointer.cmx gobject.cmx gdkPixbuf.cmx \ gdkEnums.cmx gdk.cmx gaux.cmx gObj.cmx gData.cmx gContainer.cmx gTree.cmi gList.cmo : ogtkListProps.cmo gtkList.cmo gtkBase.cmo gtk.cmo gpointer.cmi \ gobject.cmi gaux.cmo gObj.cmi gDraw.cmi gData.cmi gContainer.cmi \ gList.cmi gList.cmx : ogtkListProps.cmx gtkList.cmx gtkBase.cmx gtk.cmx gpointer.cmx \ gobject.cmx gaux.cmx gObj.cmx gDraw.cmx gData.cmx gContainer.cmx \ gList.cmi gFile.cmo : ogtkFileProps.cmo gtkSignal.cmi gtkFile.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gaux.cmo gPack.cmi gObj.cmi gContainer.cmi gFile.cmi gFile.cmx : ogtkFileProps.cmx gtkSignal.cmx gtkFile.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gaux.cmx gPack.cmx gObj.cmx gContainer.cmx gFile.cmi gWindow.cmo : ogtkFileProps.cmo ogtkBaseProps.cmo gtkWindow.cmo gtkStock.cmo \ gtkMisc.cmo gtkMain.cmo gtkFile.cmo gtkEnums.cmo gtkBaseProps.cmo \ gtkBase.cmo gtk.cmo gobject.cmi gdk.cmi gaux.cmo gPack.cmi gObj.cmi \ gMisc.cmi gList.cmi gFile.cmi gContainer.cmi gButton.cmi gWindow.cmi gWindow.cmx : ogtkFileProps.cmx ogtkBaseProps.cmx gtkWindow.cmx gtkStock.cmx \ gtkMisc.cmx gtkMain.cmx gtkFile.cmx gtkEnums.cmx gtkBaseProps.cmx \ gtkBase.cmx gtk.cmx gobject.cmx gdk.cmx gaux.cmx gPack.cmx gObj.cmx \ gMisc.cmx gList.cmx gFile.cmx gContainer.cmx gButton.cmx gWindow.cmi gAssistant.cmo : ogtkAssistantProps.cmo gtkWindow.cmo gtkMisc.cmo \ gtkBase.cmo gtkAssistant.cmo gtk.cmo gaux.cmo gWindow.cmi gObj.cmi \ gContainer.cmi gAssistant.cmi gAssistant.cmx : ogtkAssistantProps.cmx gtkWindow.cmx gtkMisc.cmx \ gtkBase.cmx gtkAssistant.cmx gtk.cmx gaux.cmx gWindow.cmx gObj.cmx \ gContainer.cmx gAssistant.cmi gBin.cmo : ogtkBinProps.cmo gtkBinProps.cmo gtkBin.cmo gtkBase.cmo gtk.cmo \ gobject.cmi gaux.cmo gObj.cmi gData.cmi gContainer.cmi gBin.cmi gBin.cmx : ogtkBinProps.cmx gtkBinProps.cmx gtkBin.cmx gtkBase.cmx gtk.cmx \ gobject.cmx gaux.cmx gObj.cmx gData.cmx gContainer.cmx gBin.cmi gEdit.cmo : ogtkEditProps.cmo gtkEdit.cmo gtkBase.cmo gtk.cmo gobject.cmi \ gaux.cmo gTree.cmi gObj.cmi gMenu.cmi gList.cmi gData.cmi gContainer.cmi \ gEdit.cmi gEdit.cmx : ogtkEditProps.cmx gtkEdit.cmx gtkBase.cmx gtk.cmx gobject.cmx \ gaux.cmx gTree.cmx gObj.cmx gMenu.cmx gList.cmx gData.cmx gContainer.cmx \ gEdit.cmi gRange.cmo : ogtkRangeProps.cmo gtkRange.cmo gtkBase.cmo gtk.cmo gaux.cmo \ gObj.cmi gData.cmi gRange.cmi gRange.cmx : ogtkRangeProps.cmx gtkRange.cmx gtkBase.cmx gtk.cmx gaux.cmx \ gObj.cmx gData.cmx gRange.cmi gAction.cmo : ogtkActionProps.cmo gtkSignal.cmi gtkActionProps.cmo gtk.cmo \ gobject.cmi gaux.cmo gObj.cmi gAction.cmi gAction.cmx : ogtkActionProps.cmx gtkSignal.cmx gtkActionProps.cmx gtk.cmx \ gobject.cmx gaux.cmx gObj.cmx gAction.cmi gBroken.cmo : ogtkEditProps.cmo ogtkBrokenProps.cmo ogtkBaseProps.cmo \ gtkBroken.cmo gtkBase.cmo gtk.cmo gpointer.cmi gobject.cmi gaux.cmo \ gObj.cmi gEdit.cmi gDraw.cmi gData.cmi gContainer.cmi gBroken.cmi gBroken.cmx : ogtkEditProps.cmx ogtkBrokenProps.cmx ogtkBaseProps.cmx \ gtkBroken.cmx gtkBase.cmx gtk.cmx gpointer.cmx gobject.cmx gaux.cmx \ gObj.cmx gEdit.cmx gDraw.cmx gData.cmx gContainer.cmx gBroken.cmi gUtil.cmo : gtkSignal.cmi gObj.cmi gUtil.cmi gUtil.cmx : gtkSignal.cmx gObj.cmx gUtil.cmi gToolbox.cmo : gtkSignal.cmi gtkMain.cmo gobject.cmi gdkKeysyms.cmo \ gdkEvent.cmo gWindow.cmi gText.cmi gPack.cmi gObj.cmi gMisc.cmi gMenu.cmi \ gMain.cmi gEdit.cmi gButton.cmi gBroken.cmi gBin.cmi gToolbox.cmi gToolbox.cmx : gtkSignal.cmx gtkMain.cmx gobject.cmx gdkKeysyms.cmx \ gdkEvent.cmx gWindow.cmx gText.cmx gPack.cmx gObj.cmx gMisc.cmx gMenu.cmx \ gMain.cmx gEdit.cmx gButton.cmx gBroken.cmx gBin.cmx gToolbox.cmi glGtk.cmo : gtkMisc.cmo gtkBase.cmo gtk.cmo gpointer.cmi gdkEvent.cmo \ gaux.cmo gObj.cmi glGtk.cmi glGtk.cmx : gtkMisc.cmx gtkBase.cmx gtk.cmx gpointer.cmx gdkEvent.cmx \ gaux.cmx gObj.cmx glGtk.cmi glade.cmo : gtkWindow.cmo gtkSignal.cmi gtkMain.cmo gtkBase.cmo gtk.cmo \ gpointer.cmi gobject.cmi glade.cmi glade.cmx : gtkWindow.cmx gtkSignal.cmx gtkMain.cmx gtkBase.cmx gtk.cmx \ gpointer.cmx gobject.cmx glade.cmi rsvg.cmo : gdkPixbuf.cmi gaux.cmo rsvg.cmi rsvg.cmx : gdkPixbuf.cmx gaux.cmx rsvg.cmi gnomeCanvas.cmo : gtkSignal.cmi gtkBase.cmo gtk.cmo gpointer.cmi gobject.cmi \ gdkPixbuf.cmi gdk.cmi gaux.cmo gObj.cmi gnomeCanvas.cmx : gtkSignal.cmx gtkBase.cmx gtk.cmx gpointer.cmx gobject.cmx \ gdkPixbuf.cmx gdk.cmx gaux.cmx gObj.cmx gnoCanvas.cmo : gtkEnums.cmo gtk.cmo gpointer.cmi gobject.cmi \ gnomeCanvas.cmo gdkPixbuf.cmi gdkEvent.cmo gdkEnums.cmo gdk.cmi gText.cmi \ gPack.cmi gObj.cmi gContainer.cmi gnoCanvas.cmi gnoCanvas.cmx : gtkEnums.cmx gtk.cmx gpointer.cmx gobject.cmx \ gnomeCanvas.cmx gdkPixbuf.cmx gdkEvent.cmx gdkEnums.cmx gdk.cmx gText.cmx \ gPack.cmx gObj.cmx gContainer.cmx gnoCanvas.cmi gnomeDruid.cmo : gtkSignal.cmi gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gnomeDruid.cmx : gtkSignal.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx gnoDruid.cmo : gtk.cmo gobject.cmi gnomeDruid.cmo gPack.cmi gObj.cmi \ gContainer.cmi gnoDruid.cmi gnoDruid.cmx : gtk.cmx gobject.cmx gnomeDruid.cmx gPack.cmx gObj.cmx \ gContainer.cmx gnoDruid.cmi panel.cmo : gtkSignal.cmi gtkEnums.cmo gtk.cmo gobject.cmi gdk.cmi gObj.cmi \ gContainer.cmi panel.cmi panel.cmx : gtkSignal.cmx gtkEnums.cmx gtk.cmx gobject.cmx gdk.cmx gObj.cmx \ gContainer.cmx panel.cmi gtkSpell.cmo : gtk.cmo gtkSpell.cmi gtkSpell.cmx : gtk.cmx gtkSpell.cmi gtkSourceView2.cmo : sourceView2Enums.cmo gtkSourceView2_types.cmi \ gtkSourceView2Props.cmo gtkBase.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi \ gdk.cmi gaux.cmo gtkSourceView2.cmx : sourceView2Enums.cmx gtkSourceView2_types.cmi \ gtkSourceView2Props.cmx gtkBase.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx \ gdk.cmx gaux.cmx gSourceView2.cmo : sourceView2Enums.cmo ogtkSourceView2Props.cmo gtkText.cmo \ gtkStock.cmo gtkSourceView2_types.cmi gtkSourceView2.cmo gtkBase.cmo \ gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gaux.cmo gWindow.cmi gText.cmi \ gObj.cmi gContainer.cmi gSourceView2.cmi gSourceView2.cmx : sourceView2Enums.cmx ogtkSourceView2Props.cmx gtkText.cmx \ gtkStock.cmx gtkSourceView2_types.cmi gtkSourceView2.cmx gtkBase.cmx \ gtk.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx gaux.cmx gWindow.cmx gText.cmx \ gObj.cmx gContainer.cmx gSourceView2.cmi gtkInit.cmo : gtkMain.cmo gtkInit.cmx : gtkMain.cmx gtkBaseProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gpointer.cmi gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdkEnums.cmo gdk.cmi gtkBaseProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gpointer.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdkEnums.cmx gdk.cmx gtkBinProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdk.cmi gtkBinProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdk.cmx gtkButtonProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gdk.cmi gtkButtonProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gdk.cmx gtkEditProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gtkEditProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gtkListProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdkEvent.cmo gtkListProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdkEvent.cmx gtkMenuProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gtkMenuProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gtkMiscProps.cmo : pangoEnums.cmo gtkStock.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gtkMiscProps.cmx : pangoEnums.cmx gtkStock.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdk.cmx gtkPackProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdk.cmi gtkPackProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdk.cmx gtkRangeProps.cmo : pangoEnums.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gtkRangeProps.cmx : pangoEnums.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gtkTextProps.cmo : pangoEnums.cmo pango.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gtkTextProps.cmx : pangoEnums.cmx pango.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdkEvent.cmx gdk.cmx gtkTreeProps.cmo : pangoEnums.cmo pango.cmo gtkSignal.cmi gtkObject.cmo \ gtkEnums.cmo gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gtkTreeProps.cmx : pangoEnums.cmx pango.cmx gtkSignal.cmx gtkObject.cmx \ gtkEnums.cmx gtk.cmx gobject.cmx gdkPixbuf.cmx gdk.cmx gtkFileProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gtkFileProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gtkActionProps.cmo : gtkStock.cmo gtkSignal.cmi gtkObject.cmo gtkEnums.cmo \ gtk.cmo gobject.cmi gtkActionProps.cmx : gtkStock.cmx gtkSignal.cmx gtkObject.cmx gtkEnums.cmx \ gtk.cmx gobject.cmx gtkBrokenProps.cmo : gtkSignal.cmi gtkObject.cmo gtk.cmo gobject.cmi gtkBrokenProps.cmx : gtkSignal.cmx gtkObject.cmx gtk.cmx gobject.cmx gtkAssistantProps.cmo : gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo \ gobject.cmi gdkPixbuf.cmi gtkAssistantProps.cmx : gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx \ gobject.cmx gdkPixbuf.cmx ogtkBaseProps.cmo : gtkSignal.cmi gtkBaseProps.cmo gobject.cmi gObj.cmi ogtkBaseProps.cmx : gtkSignal.cmx gtkBaseProps.cmx gobject.cmx gObj.cmx ogtkBinProps.cmo : gtkSignal.cmi gtkPackProps.cmo gtkBinProps.cmo \ gobject.cmi gObj.cmi gData.cmi ogtkBinProps.cmx : gtkSignal.cmx gtkPackProps.cmx gtkBinProps.cmx \ gobject.cmx gObj.cmx gData.cmx ogtkButtonProps.cmo : gtkSignal.cmi gtkButtonProps.cmo gobject.cmi gObj.cmi ogtkButtonProps.cmx : gtkSignal.cmx gtkButtonProps.cmx gobject.cmx gObj.cmx ogtkEditProps.cmo : gtkSignal.cmi gtkEditProps.cmo gobject.cmi gData.cmi ogtkEditProps.cmx : gtkSignal.cmx gtkEditProps.cmx gobject.cmx gData.cmx ogtkListProps.cmo : gtkSignal.cmi gtkListProps.cmo gobject.cmi ogtkListProps.cmx : gtkSignal.cmx gtkListProps.cmx gobject.cmx ogtkMenuProps.cmo : gtkSignal.cmi gtkMenuProps.cmo gobject.cmi ogtkMenuProps.cmx : gtkSignal.cmx gtkMenuProps.cmx gobject.cmx ogtkMiscProps.cmo : gtkSignal.cmi gtkMiscProps.cmo gobject.cmi gdkEvent.cmo \ gObj.cmi ogtkMiscProps.cmx : gtkSignal.cmx gtkMiscProps.cmx gobject.cmx gdkEvent.cmx \ gObj.cmx ogtkPackProps.cmo : gtkSignal.cmi gtkPackProps.cmo gobject.cmi gObj.cmi ogtkPackProps.cmx : gtkSignal.cmx gtkPackProps.cmx gobject.cmx gObj.cmx ogtkRangeProps.cmo : gtkSignal.cmi gtkRangeProps.cmo gobject.cmi gData.cmi ogtkRangeProps.cmx : gtkSignal.cmx gtkRangeProps.cmx gobject.cmx gData.cmx ogtkTextProps.cmo : gtkTextProps.cmo gtkSignal.cmi gobject.cmi gData.cmi ogtkTextProps.cmx : gtkTextProps.cmx gtkSignal.cmx gobject.cmx gData.cmx ogtkTreeProps.cmo : gtkTreeProps.cmo gtkSignal.cmi gobject.cmi gObj.cmi \ gData.cmi ogtkTreeProps.cmx : gtkTreeProps.cmx gtkSignal.cmx gobject.cmx gObj.cmx \ gData.cmx ogtkFileProps.cmo : gtkSignal.cmi gtkFileProps.cmo gobject.cmi gObj.cmi ogtkFileProps.cmx : gtkSignal.cmx gtkFileProps.cmx gobject.cmx gObj.cmx ogtkActionProps.cmo : gtkSignal.cmi gtkActionProps.cmo gobject.cmi gObj.cmi ogtkActionProps.cmx : gtkSignal.cmx gtkActionProps.cmx gobject.cmx gObj.cmx ogtkBrokenProps.cmo : gtkSignal.cmi gtkBrokenProps.cmo gobject.cmi gData.cmi ogtkBrokenProps.cmx : gtkSignal.cmx gtkBrokenProps.cmx gobject.cmx gData.cmx ogtkAssistantProps.cmo : gtkSignal.cmi gtkAssistantProps.cmo gobject.cmi ogtkAssistantProps.cmx : gtkSignal.cmx gtkAssistantProps.cmx gobject.cmx gtkThread.cmo : gtkSignal.cmi gtkMain.cmo glib.cmi gtkThread.cmi gtkThread.cmx : gtkSignal.cmx gtkMain.cmx glib.cmx gtkThread.cmi gtkThTop.cmo : gtkThread.cmi gtkThTop.cmx : gtkThread.cmx gtkSourceView.cmo : sourceViewEnums.cmo gtkSourceView_types.cmi \ gtkSourceViewProps.cmo gtkBase.cmo gtk.cmo gobject.cmi glib.cmi \ gdkPixbuf.cmi gdk.cmi gaux.cmo gtkSourceView.cmx : sourceViewEnums.cmx gtkSourceView_types.cmi \ gtkSourceViewProps.cmx gtkBase.cmx gtk.cmx gobject.cmx glib.cmx \ gdkPixbuf.cmx gdk.cmx gaux.cmx gSourceView.cmo : ogtkTextProps.cmo ogtkSourceViewProps.cmo gtkText.cmo \ gtkSourceView_types.cmi gtkSourceView.cmo gtkBase.cmo gtk.cmo gobject.cmi \ gdk.cmi gaux.cmo gText.cmi gObj.cmi gContainer.cmi gSourceView.cmi gSourceView.cmx : ogtkTextProps.cmx ogtkSourceViewProps.cmx gtkText.cmx \ gtkSourceView_types.cmi gtkSourceView.cmx gtkBase.cmx gtk.cmx gobject.cmx \ gdk.cmx gaux.cmx gText.cmx gObj.cmx gContainer.cmx gSourceView.cmi gtkSourceViewProps.cmo : gtkSourceView_types.cmi gtkSignal.cmi gtkObject.cmo \ gtk.cmo gobject.cmi gdk.cmi gtkSourceViewProps.cmx : gtkSourceView_types.cmi gtkSignal.cmx gtkObject.cmx \ gtk.cmx gobject.cmx gdk.cmx ogtkSourceViewProps.cmo : gtkSourceViewProps.cmo gtkSignal.cmi gobject.cmi ogtkSourceViewProps.cmx : gtkSourceViewProps.cmx gtkSignal.cmx gobject.cmx sourceViewEnums.cmo : gpointer.cmi gobject.cmi sourceViewEnums.cmx : gpointer.cmx gobject.cmx gtkSourceView2Props.cmo : sourceView2Enums.cmo gtkSourceView2_types.cmi \ gtkSignal.cmi gtkObject.cmo gtkEnums.cmo gtk.cmo gobject.cmi \ gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gtkSourceView2Props.cmx : sourceView2Enums.cmx gtkSourceView2_types.cmi \ gtkSignal.cmx gtkObject.cmx gtkEnums.cmx gtk.cmx gobject.cmx \ gdkPixbuf.cmx gdkEvent.cmx gdk.cmx ogtkSourceView2Props.cmo : gtkSourceView2Props.cmo gtkSignal.cmi gobject.cmi ogtkSourceView2Props.cmx : gtkSourceView2Props.cmx gtkSignal.cmx gobject.cmx sourceViewEnums.cmo : gpointer.cmi gobject.cmi sourceViewEnums.cmx : gpointer.cmx gobject.cmx gtkSignal.cmo : gobject.cmi gtkSignal.cmi gtkSignal.cmx : gobject.cmx gtkSignal.cmi gAction.cmi : gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gobject.cmi \ gObj.cmi gAssistant.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gdkPixbuf.cmi \ gdkEnums.cmo gdk.cmi gWindow.cmi gObj.cmi gContainer.cmi gBin.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gObj.cmi gData.cmi \ gContainer.cmi gBroken.cmi : gtkSignal.cmi gtk.cmo gobject.cmi gdk.cmi gObj.cmi gEdit.cmi \ gDraw.cmi gData.cmi gContainer.cmi gButton.cmi : gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gdk.cmi \ gObj.cmi gData.cmi gContainer.cmi gContainer.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gobject.cmi gObj.cmi \ gData.cmi gData.cmi : gtkSignal.cmi gtk.cmo gobject.cmi gdkPixbuf.cmi gdk.cmi gObj.cmi gDraw.cmi : pango.cmo gpointer.cmi gobject.cmi gdkPixbuf.cmi gdk.cmi gEdit.cmi : gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gdkPixbuf.cmi \ gdkEvent.cmo gTree.cmi gObj.cmi gMenu.cmi gList.cmi gData.cmi \ gContainer.cmi gFile.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gPack.cmi gObj.cmi \ gContainer.cmi gList.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gdkEvent.cmo gObj.cmi \ gDraw.cmi gData.cmi gContainer.cmi gMain.cmi : gtk.cmo glib.cmi gdkEvent.cmo gdk.cmi gObj.cmi gData.cmi gMenu.cmi : gtkStock.cmo gtkSignal.cmi gtk.cmo gdk.cmi gObj.cmi \ gContainer.cmi gButton.cmi gMisc.cmi : pangoEnums.cmo gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo \ gobject.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gPack.cmi gObj.cmi \ gDraw.cmi gContainer.cmi gObj.cmi : pango.cmo gtkStock.cmo gtkSignal.cmi gtk.cmo gobject.cmi \ gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gPango.cmo gDraw.cmi gPack.cmi : gtkSignal.cmi gtkPack.cmo gtkEnums.cmo gtk.cmo gdk.cmi gObj.cmi \ gData.cmi gContainer.cmi gRange.cmi : pangoEnums.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gObj.cmi \ gData.cmi gSourceView.cmi : sourceViewEnums.cmo gtkSourceView_types.cmi gtkSignal.cmi \ gtkEnums.cmo gtk.cmo glib.cmi gdkPixbuf.cmi gdk.cmi gText.cmi gObj.cmi gSourceView2.cmi : sourceView2Enums.cmo ogtkSourceView2Props.cmo \ gtkStock.cmo gtkSourceView2_types.cmi gtkSignal.cmi gtkEnums.cmo gtk.cmo \ gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gWindow.cmi gText.cmi gObj.cmi \ gContainer.cmi gText.cmi : pango.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gobject.cmi \ glib.cmi gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gObj.cmi gData.cmi gToolbox.cmi : gtk.cmo gWindow.cmi gText.cmi gObj.cmi gMenu.cmi gList.cmi \ gBroken.cmi gTree.cmi : pango.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gobject.cmi \ gdkPixbuf.cmi gdkEnums.cmo gdk.cmi gObj.cmi gData.cmi gContainer.cmi gUtil.cmi : gtkSignal.cmi gtk.cmo gObj.cmi gWindow.cmi : gtkStock.cmo gtkSignal.cmi gtkEnums.cmo gtk.cmo gdkPixbuf.cmi \ gdkEnums.cmo gdk.cmi gPack.cmi gObj.cmi gMisc.cmi gList.cmi gFile.cmi \ gContainer.cmi gButton.cmi gdk.cmi : pango.cmo gpointer.cmi gobject.cmi gdkPixbuf.cmi : gpointer.cmi gobject.cmi gdk.cmi glGtk.cmi : gtkSignal.cmi gtk.cmo gpointer.cmi gObj.cmi glade.cmi : gtk.cmo gobject.cmi glib.cmi : gnoCanvas.cmi : gtkSignal.cmi gtk.cmo gobject.cmi gnomeCanvas.cmo \ gdkPixbuf.cmi gdkEvent.cmo gdk.cmi gText.cmi gPack.cmi gObj.cmi gnoDruid.cmi : gtkSignal.cmi gtk.cmo gnomeDruid.cmo gdkPixbuf.cmi gdk.cmi \ gPack.cmi gObj.cmi gContainer.cmi gobject.cmi : gpointer.cmi gpointer.cmi : gtkSignal.cmi : gobject.cmi gtkSourceView2_types.cmi : gtk.cmo gtkSourceView_types.cmi : gtk.cmo gtkSpell.cmi : gText.cmi gtkThread.cmi : gutf8.cmi : panel.cmi : gtkSignal.cmi gtkEnums.cmo gtk.cmo gdk.cmi gObj.cmi \ gContainer.cmi rsvg.cmi : gdkPixbuf.cmi xml_lexer.cmi : lablgtk-2.18.8/src/gobject_tags.var0000644000175000017500000000101013460263323016210 0ustar stephsteph(* $Id$ *) (* package "gobject" *) type fundamental_type = "G_TYPE_" [ `INVALID | `NONE | `INTERFACE | `CHAR | `UCHAR | `BOOLEAN | `INT | `UINT | `LONG | `ULONG | `INT64 | `UINT64 | `ENUM | `FLAGS | `FLOAT | `DOUBLE | `STRING | `POINTER | `BOXED | `PARAM | `OBJECT ] type noconv data = [ `NONE | `CHAR | `CAML | `BOOL | `INT | `FLOAT | `STRING | `OBJECT | `POINTER | `INT64 | `INT32 | `LONG ] type signal_type = "G_SIGNAL_" [ `RUN_FIRST | `RUN_LAST | `NO_RECURSE | `ACTION | `NO_HOOKS ] lablgtk-2.18.8/src/gSourceView2.mli0000644000175000017500000005021213460263323016102 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** {2 GtkSourceView interface} *) open Gtk open GText open SourceView2Enums (** {2 GtkSourceStyleScheme} *) class source_style_scheme : GtkSourceView2_types.source_style_scheme obj -> object method as_source_style_scheme : GtkSourceView2_types.source_style_scheme obj method name : string method description : string end (** {2 GtkSourceStyleSchemeManager} *) class source_style_scheme_manager : GtkSourceView2_types.source_style_scheme_manager obj -> object method search_path: string list method set_search_path: string list -> unit method append_search_path: string -> unit method prepend_search_path: string -> unit method style_scheme_ids: string list method style_scheme: string -> source_style_scheme option method force_rescan: unit -> unit end val source_style_scheme_manager : default:bool -> source_style_scheme_manager (** {2 GtkSourceCompletionInfo} *) class source_completion_info_signals : (GtkSourceView2_types.source_completion_info as 'b) obj -> object ('a) inherit GContainer.container_signals method before_show : callback:(unit -> unit) -> GtkSignal.id method notify_max_height : callback:(int -> unit) -> GtkSignal.id method notify_max_width : callback:(int -> unit) -> GtkSignal.id method notify_shrink_height : callback:(bool -> unit) -> GtkSignal.id method notify_shrink_width : callback:(bool -> unit) -> GtkSignal.id end class source_completion_info : ([> GtkSourceView2_types.source_completion_info ] as 'a) obj -> object inherit GWindow.window val obj : 'a obj method as_source_completion_info : GtkSourceView2_types.source_completion_info obj method max_height : int method max_width : int method process_resize : unit -> unit method set_max_height : int -> unit method set_max_width : int -> unit method set_shrink_height : bool -> unit method set_shrink_width : bool -> unit method set_sizing : width:int -> height:int -> shrink_width:bool -> shrink_height:bool -> unit method set_widget : GObj.widget -> unit method shrink_height : bool method shrink_width : bool method widget : GObj.widget end (** {2 GtkSourceCompletionProposal} *) class source_completion_proposal_signals : GtkSourceView2_types.source_completion_proposal obj -> object ('a) method after : 'a method changed : callback:(unit -> unit) -> GtkSignal.id method notify_icon : callback:(GdkPixbuf.pixbuf -> unit) -> GtkSignal.id method notify_info : callback:(string -> unit) -> GtkSignal.id method notify_label : callback:(string -> unit) -> GtkSignal.id method notify_markup : callback:(string -> unit) -> GtkSignal.id method notify_text : callback:(string -> unit) -> GtkSignal.id end class source_completion_proposal : GtkSourceView2_types.source_completion_proposal obj -> object method as_source_completion_proposal : GtkSourceView2_types.source_completion_proposal obj method connect : source_completion_proposal_signals method icon : GdkPixbuf.pixbuf method info : string method label : string method markup : string method text : string end class source_completion_item : GtkSourceView2_types.source_completion_proposal obj -> object inherit source_completion_proposal method set_icon : GdkPixbuf.pixbuf -> unit method set_info : string -> unit method set_label : string -> unit method set_markup : string -> unit method set_text : string -> unit end val source_completion_item : ?label:string -> ?text:string -> ?icon:GdkPixbuf.pixbuf -> ?info:string -> unit -> source_completion_item val source_completion_item_with_markup : ?label:string -> ?text:string -> ?icon:GdkPixbuf.pixbuf -> ?info:string -> unit -> source_completion_item val source_completion_item_from_stock : ?label:string -> ?text:string -> stock:GtkStock.id -> info:string -> unit -> source_completion_item (** {2 GtkSourceCompletionProvider} *) class source_completion_provider : GtkSourceView2_types.source_completion_provider obj -> object method as_source_completion_provider : GtkSourceView2_types.source_completion_provider obj method icon : GdkPixbuf.pixbuf option method name : string method populate : source_completion_context -> unit method activation : source_completion_activation_flags list method matched : source_completion_context -> bool method info_widget : source_completion_proposal -> GObj.widget option method update_info : source_completion_proposal -> source_completion_info -> unit method start_iter : source_completion_context -> source_completion_proposal -> GText.iter method activate_proposal : source_completion_proposal -> GText.iter -> bool method interactive_delay : int method priority : int end (** {2 GtkSourceCompletionContext} *) and source_completion_context_signals : GtkSourceView2_types.source_completion_context obj -> object ('a) method after : 'a method cancelled : callback:(unit -> unit) -> GtkSignal.id end and source_completion_context : GtkSourceView2_types.source_completion_context obj -> object method as_source_completion_context : GtkSourceView2_types.source_completion_context obj method activation : source_completion_activation_flags list method add_proposals : source_completion_provider -> source_completion_proposal list -> bool -> unit method connect : source_completion_context_signals method iter : GText.iter method set_iter : GText.iter -> unit method set_activation : source_completion_activation_flags list -> unit end class type custom_completion_provider = object method name : string method icon : GdkPixbuf.pixbuf option method populate : source_completion_context -> unit method matched : source_completion_context -> bool method activation : source_completion_activation_flags list method info_widget : source_completion_proposal -> GObj.widget option method update_info : source_completion_proposal -> source_completion_info -> unit method start_iter : source_completion_context -> source_completion_proposal -> GText.iter -> bool method activate_proposal : source_completion_proposal -> GText.iter -> bool method interactive_delay : int method priority : int end val source_completion_provider : custom_completion_provider -> source_completion_provider (** {2 GtkSourceCompletion} *) class source_completion_signals : GtkSourceView2_types.source_completion obj -> object ('a) method after : 'a method activate_proposal : callback:(unit -> unit) -> GtkSignal.id method hide : callback:(unit -> unit) -> GtkSignal.id method move_cursor : callback:(GtkEnums.scroll_step -> int -> unit) -> GtkSignal.id method move_page : callback:(GtkEnums.scroll_step -> int -> unit) -> GtkSignal.id method populate_context : callback:(source_completion_context -> unit) -> GtkSignal.id method show : callback:(unit -> unit) -> GtkSignal.id method notify_accelerators : callback:(int -> unit) -> GtkSignal.id method notify_auto_complete_delay : callback:(int -> unit) -> GtkSignal.id method notify_proposal_page_size : callback:(int -> unit) -> GtkSignal.id method notify_provider_page_size : callback:(int -> unit) -> GtkSignal.id method notify_remember_info_visibility : callback:(bool -> unit) -> GtkSignal.id method notify_select_on_show : callback:(bool -> unit) -> GtkSignal.id method notify_show_headers : callback:(bool -> unit) -> GtkSignal.id method notify_show_icons : callback:(bool -> unit) -> GtkSignal.id end class source_completion : GtkSourceView2_types.source_completion obj -> object method accelerators : int method add_provider : source_completion_provider -> bool method as_source_completion : GtkSourceView2_types.source_completion obj method auto_complete_delay : int method block_interactive : unit -> unit method connect : source_completion_signals method create_context : GText.iter -> source_completion_context method hide : unit -> unit method move_window : GText.iter -> unit method proposal_page_size : int method providers : source_completion_provider list method provider_page_size : int method remember_info_visibility : bool method remove_provider : source_completion_provider -> bool method select_on_show : bool method set_accelerators : int -> unit method set_auto_complete_delay : int -> unit method set_proposal_page_size : int -> unit method set_provider_page_size : int -> unit method set_remember_info_visibility : bool -> unit method set_select_on_show : bool -> unit method set_show_headers : bool -> unit method set_show_icons : bool -> unit method show : source_completion_provider list -> source_completion_context -> bool method show_headers : bool method show_icons : bool method unblock_interactive : unit -> unit end (** {2 GtkSourceLanguage} *) class source_language: GtkSourceView2_types.source_language obj -> object method as_source_language: GtkSourceView2_types.source_language obj method misc: GObj.gobject_ops method hidden: bool method id: string method name: string method section: string method metadata: string -> string option method mime_types: string list method globs: string list method style_name: string -> string option method style_ids: string list end (** {2 GtkSourceLanguageManager} *) class source_language_manager: GtkSourceView2_types.source_language_manager obj -> object method get_oid: int method as_source_language_manager: GtkSourceView2_types.source_language_manager obj method set_search_path : string list -> unit method search_path : string list method language_ids : string list method language : string -> source_language option method guess_language: ?filename:string -> ?content_type:string -> unit -> source_language option end val source_language_manager : default:bool -> source_language_manager (** {2 GtkSourceMark} *) class source_mark: ((GtkSourceView2_types.source_mark obj) as 'a) -> object method as_source_mark : 'a method coerce: GText.mark method category: string option method next: ?category:string -> unit -> source_mark option method prev: ?category:string -> unit -> source_mark option end val source_mark : ?category:string -> unit -> source_mark (** {2 GtkSourceUndoManager} *) class source_undo_manager_signals : (GtkSourceView2_types.source_undo_manager as 'b) obj -> object ('a) method after : 'a method can_redo_changed : callback:(unit -> unit) -> GtkSignal.id method can_undo_changed : callback:(unit -> unit) -> GtkSignal.id end class source_undo_manager: (GtkSourceView2_types.source_undo_manager as 'b) obj -> object val obj : 'b obj method as_source_undo_manager : GtkSourceView2_types.source_undo_manager obj method begin_not_undoable_action : unit -> unit method connect : source_undo_manager_signals method can_redo : bool method can_redo_changed : unit -> unit method can_undo : bool method can_undo_changed : unit -> unit method end_not_undoable_action : unit -> unit method redo : unit -> unit method undo : unit -> unit end class type custom_undo_manager = object method can_undo : bool method can_redo : bool method undo : unit -> unit method redo : unit -> unit method begin_not_undoable_action : unit -> unit method end_not_undoable_action : unit -> unit method can_undo_changed : unit -> unit method can_redo_changed : unit -> unit end val source_undo_manager : custom_undo_manager -> source_undo_manager (** {2 GtkSourceBuffer} *) class source_buffer_signals: (GtkSourceView2_types.source_buffer as 'b) obj -> object ('a) inherit ['b] GText.buffer_signals_type method changed : callback:(unit -> unit) -> GtkSignal.id method highlight_updated: callback:(Gtk.text_iter -> Gtk.text_iter -> unit) -> GtkSignal.id method source_mark_updated: callback:(GtkSourceView2_types.source_mark obj -> unit) -> GtkSignal.id method notify_can_redo : callback:(bool -> unit) -> GtkSignal.id method notify_can_undo : callback:(bool -> unit) -> GtkSignal.id method notify_highlight_matching_brackets : callback:(bool -> unit) -> GtkSignal.id method notify_highlight_syntax : callback:(bool -> unit) -> GtkSignal.id method notify_max_undo_levels : callback:(int -> unit) -> GtkSignal.id end and source_buffer: GtkSourceView2_types.source_buffer obj -> object inherit GText.buffer_skel val obj: GtkSourceView2_types.source_buffer obj method as_source_buffer: GtkSourceView2_types.source_buffer obj method connect: source_buffer_signals method misc: GObj.gobject_ops method highlight_syntax: bool method set_highlight_syntax: bool -> unit method language: source_language option method set_language: source_language option -> unit method highlight_matching_brackets: bool method set_highlight_matching_brackets: bool -> unit method style_scheme: source_style_scheme option method set_style_scheme: source_style_scheme option -> unit method max_undo_levels: int method set_max_undo_levels: int -> unit method undo: unit -> unit method redo: unit -> unit method can_undo: bool method can_redo: bool method begin_not_undoable_action: unit -> unit method end_not_undoable_action: unit -> unit method create_source_mark: ?name:string -> ?category:string -> GText.iter -> source_mark method source_marks_at_line: ?category:string -> int -> source_mark list method source_marks_at_iter: ?category:string -> GText.iter -> source_mark list method remove_source_marks : ?category:string -> start:GText.iter -> stop:GText.iter -> unit -> unit method forward_iter_to_source_mark: ?category:string -> GText.iter -> bool method backward_iter_to_source_mark: ?category:string -> GText.iter -> bool method iter_has_context_class: GText.iter -> string -> bool method iter_forward_to_context_class_toggle: GText.iter -> string -> bool method iter_backward_to_context_class_toggle: GText.iter -> string -> bool method ensure_highlight: start:GText.iter -> stop:GText.iter -> unit method undo_manager : source_undo_manager method set_undo_manager : source_undo_manager -> unit end val source_buffer: ?language:source_language -> ?style_scheme:source_style_scheme -> ?tag_table:GText.tag_table -> ?text:string -> ?undo_manager:source_undo_manager -> ?highlight_matching_brackets:bool -> ?highlight_syntax:bool -> ?max_undo_levels:int -> unit -> source_buffer (** {2 GtkSourceView} *) class source_view_signals: ([> GtkSourceView2_types.source_view ] as 'b) obj -> object ('a) inherit GText.view_signals method line_mark_activated : callback:(Gtk.text_iter -> GdkEvent.any -> unit) -> GtkSignal.id method move_lines : callback:(bool -> int -> unit) -> GtkSignal.id method move_words : callback:(int -> unit) -> GtkSignal.id method redo: callback:(unit -> unit) -> GtkSignal.id method show_completion : callback:(unit -> unit) -> GtkSignal.id method smart_home_end : callback:(Gtk.text_iter -> int -> unit) -> GtkSignal.id method undo: callback:(unit -> unit) -> GtkSignal.id method notify_auto_indent : callback:(bool -> unit) -> GtkSignal.id method notify_highlight_current_line : callback:(bool -> unit) -> GtkSignal.id method notify_indent_on_tab : callback:(bool -> unit) -> GtkSignal.id method notify_indent_width : callback:(int -> unit) -> GtkSignal.id method notify_insert_spaces_instead_of_tabs : callback:(bool -> unit) -> GtkSignal.id method notify_right_margin_position : callback:(int -> unit) -> GtkSignal.id method notify_show_line_marks : callback:(bool -> unit) -> GtkSignal.id method notify_show_line_numbers : callback:(bool -> unit) -> GtkSignal.id method notify_show_right_margin : callback:(bool -> unit) -> GtkSignal.id method notify_smart_home_end : callback:(SourceView2Enums.source_smart_home_end_type -> unit) -> GtkSignal.id method notify_tab_width : callback:(int -> unit) -> GtkSignal.id end class source_view: GtkSourceView2_types.source_view obj -> object inherit GText.view_skel inherit OgtkSourceView2Props.source_view_props val obj: GtkSourceView2_types.source_view obj method completion : source_completion method connect: source_view_signals method source_buffer: source_buffer method set_show_line_numbers: bool -> unit method show_line_numbers: bool method set_highlight_current_line: bool -> unit method highlight_current_line: bool method set_tab_width: int -> unit method tab_width: int method set_auto_indent: bool -> unit method auto_indent: bool method set_insert_spaces_instead_of_tabs: bool -> unit method insert_spaces_instead_of_tabs: bool method set_cursor_color: Gdk.color -> unit method set_cursor_color_by_name: string -> unit method draw_spaces: source_draw_spaces_flags list method set_draw_spaces: source_draw_spaces_flags list -> unit method get_mark_category_priority: category:string -> int method set_mark_category_priority: category:string -> int -> unit method get_mark_category_pixbuf: category:string -> GdkPixbuf.pixbuf option method set_mark_category_pixbuf: category:string -> GdkPixbuf.pixbuf option -> unit method get_mark_category_background: category:string -> Gdk.color option method set_mark_category_background: category:string -> Gdk.color option -> unit end val source_view : ?source_buffer:source_buffer -> ?draw_spaces:source_draw_spaces_flags list -> ?auto_indent:bool -> ?highlight_current_line:bool -> ?indent_on_tab:bool -> ?indent_width:int -> ?insert_spaces_instead_of_tabs:bool -> ?right_margin_position:int -> ?show_line_marks:bool -> ?show_line_numbers:bool -> ?show_right_margin:bool -> ?smart_home_end:source_smart_home_end_type -> ?tab_width:int -> ?editable:bool -> ?cursor_visible:bool -> ?justification:GtkEnums.justification -> ?wrap_mode:GtkEnums.wrap_mode -> ?accepts_tab:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> source_view (** {2 Misc} *) val iter_forward_search : GText.iter -> source_search_flag list -> start:< as_iter : Gtk.text_iter; .. > -> stop:< as_iter : Gtk.text_iter; .. > -> ?limit:< as_iter : Gtk.text_iter; .. > -> string -> (GText.iter * GText.iter) option val iter_backward_search : GText.iter -> source_search_flag list -> start:< as_iter : Gtk.text_iter; .. > -> stop:< as_iter : Gtk.text_iter; .. > -> ?limit:< as_iter : Gtk.text_iter; .. > -> string -> (GText.iter * GText.iter) option lablgtk-2.18.8/src/gdk_pixbuf_mlsource.ml0000644000175000017500000000653313460263323017447 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) let print_binary_string oc s = let len = String.length s in let off = ref 0 in while !off < len do if !off mod 20 = 0 then output_string oc "\\\n" ; Printf.fprintf oc "\\%03d" (int_of_char s.[!off]) ; incr off done let add_to_list v x = v := x :: !v let rec zip2 = function | [] -> [] | x :: y :: tl -> (x, y) :: zip2 tl | _ -> invalid_arg "zip2" let (rle, files) = let rle = ref true in let pairs = ref false in let anon_args = ref [] in let cli_args = [ "--rle", Arg.Set rle, "Enables run-length encoding for the generated pixel data (default)" ; "--raw", Arg.Clear rle, "Disables run-length encoding for the generated pixel data" ; "--build-list", Arg.Set pairs, "Enables (name, image) pair parsing mode"; ] in let usg_msg = let exe = Filename.basename Sys.executable_name in Printf.sprintf "\ usage: %s [options] [image] %s [options] --build-list [ [name] [image] ...]" exe exe in Arg.parse cli_args (add_to_list anon_args) usg_msg ; anon_args := List.rev !anon_args ; let files = if !pairs then begin try zip2 !anon_args with Invalid_argument _ -> Arg.usage cli_args usg_msg ; exit 1 end else match !anon_args with | x :: _ -> [ "pixbuf", x ] | [] -> Arg.usage cli_args usg_msg ; exit 1 in (!rle, files) let _ = Gobject.Type.init (); GdkPixbuf.set_marshal_use_rle rle ; let data = List.map (fun (name, fname) -> (name, Marshal.to_string (GdkPixbuf.from_file fname) [])) files in List.iter (fun (name, pixdata) -> Printf.printf " let %s_data = \"%a\" let %s () : GdkPixbuf.pixbuf = Marshal.from_string %s_data 0 " name print_binary_string pixdata name name) data lablgtk-2.18.8/src/ml_gtknew.c0000644000175000017500000002514413460263323015214 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" static value ml_class_init=0; static void class_init (value class) { callback_exn(ml_class_init, class); } CAMLprim value set_ml_class_init (value class_func) { if (!ml_class_init) register_global_root (&ml_class_init); ml_class_init = class_func; return Val_unit; } CAMLprim value ml_gtk_type_new (value type) { return Val_GtkWidget_sink(gtk_type_new(Int_val(type))); } struct widget_info { guint size; guint class_size; guint (*get_type_func)(void); } widget_info_array[] = { { sizeof(GtkObject), sizeof(GtkObjectClass), gtk_object_get_type }, { sizeof(GtkWidget), sizeof(GtkWidgetClass), gtk_widget_get_type }, { sizeof(GtkMisc), sizeof(GtkMiscClass), gtk_misc_get_type }, { sizeof(GtkLabel), sizeof(GtkLabelClass), gtk_label_get_type }, { sizeof(GtkAccelLabel), sizeof(GtkAccelLabelClass), gtk_accel_label_get_type }, { sizeof(GtkTipsQuery), sizeof(GtkTipsQueryClass), gtk_tips_query_get_type }, { sizeof(GtkArrow), sizeof(GtkArrowClass), gtk_arrow_get_type }, { sizeof(GtkImage), sizeof(GtkImageClass), gtk_image_get_type }, { sizeof(GtkPixmap), sizeof(GtkPixmapClass), gtk_pixmap_get_type }, { sizeof(GtkContainer), sizeof(GtkContainerClass), gtk_container_get_type }, { sizeof(GtkBin), sizeof(GtkBinClass), gtk_bin_get_type }, { sizeof(GtkAlignment), sizeof(GtkAlignmentClass), gtk_alignment_get_type }, { sizeof(GtkFrame), sizeof(GtkFrameClass), gtk_frame_get_type }, { sizeof(GtkAspectFrame), sizeof(GtkAspectFrameClass), gtk_aspect_frame_get_type }, { sizeof(GtkButton), sizeof(GtkButtonClass), gtk_button_get_type }, { sizeof(GtkToggleButton), sizeof(GtkToggleButtonClass), gtk_toggle_button_get_type }, { sizeof(GtkCheckButton), sizeof(GtkCheckButtonClass), gtk_check_button_get_type }, { sizeof(GtkRadioButton), sizeof(GtkRadioButtonClass), gtk_radio_button_get_type }, { sizeof(GtkOptionMenu), sizeof(GtkOptionMenuClass), gtk_option_menu_get_type }, { sizeof(GtkItem), sizeof(GtkItemClass), gtk_item_get_type }, { sizeof(GtkMenuItem), sizeof(GtkMenuItemClass), gtk_menu_item_get_type }, { sizeof(GtkCheckMenuItem), sizeof(GtkCheckMenuItemClass), gtk_check_menu_item_get_type }, { sizeof(GtkRadioMenuItem), sizeof(GtkRadioMenuItemClass), gtk_radio_menu_item_get_type }, { sizeof(GtkTearoffMenuItem), sizeof(GtkTearoffMenuItemClass), gtk_tearoff_menu_item_get_type }, { sizeof(GtkListItem), sizeof(GtkListItemClass), gtk_list_item_get_type }, { sizeof(GtkTreeItem), sizeof(GtkTreeItemClass), gtk_tree_item_get_type }, { sizeof(GtkWindow), sizeof(GtkWindowClass), gtk_window_get_type }, { sizeof(GtkColorSelectionDialog), sizeof(GtkColorSelectionDialogClass), gtk_color_selection_dialog_get_type }, { sizeof(GtkDialog), sizeof(GtkDialogClass), gtk_dialog_get_type }, { sizeof(GtkInputDialog), sizeof(GtkInputDialogClass), gtk_input_dialog_get_type }, { sizeof(GtkFileSelection), sizeof(GtkFileSelectionClass), gtk_file_selection_get_type }, { sizeof(GtkFontSelectionDialog), sizeof(GtkFontSelectionDialogClass), gtk_font_selection_dialog_get_type }, { sizeof(GtkPlug), sizeof(GtkPlugClass), gtk_plug_get_type }, { sizeof(GtkEventBox), sizeof(GtkEventBoxClass), gtk_event_box_get_type }, { sizeof(GtkHandleBox), sizeof(GtkHandleBoxClass), gtk_handle_box_get_type }, { sizeof(GtkScrolledWindow), sizeof(GtkScrolledWindowClass), gtk_scrolled_window_get_type }, { sizeof(GtkViewport), sizeof(GtkViewportClass), gtk_viewport_get_type }, { sizeof(GtkBox), sizeof(GtkBoxClass), gtk_box_get_type }, { sizeof(GtkButtonBox), sizeof(GtkButtonBoxClass), gtk_button_box_get_type }, { sizeof(GtkHButtonBox), sizeof(GtkHButtonBoxClass), gtk_hbutton_box_get_type }, { sizeof(GtkVButtonBox), sizeof(GtkVButtonBoxClass), gtk_vbutton_box_get_type }, { sizeof(GtkVBox), sizeof(GtkVBoxClass), gtk_vbox_get_type }, { sizeof(GtkColorSelection), sizeof(GtkColorSelectionClass), gtk_color_selection_get_type }, { sizeof(GtkGammaCurve), sizeof(GtkGammaCurveClass), gtk_gamma_curve_get_type }, { sizeof(GtkHBox), sizeof(GtkHBoxClass), gtk_hbox_get_type }, { sizeof(GtkCombo), sizeof(GtkComboClass), gtk_combo_get_type }, { sizeof(GtkStatusbar), sizeof(GtkStatusbarClass), gtk_statusbar_get_type }, { sizeof(GtkStatusIcon), sizeof(GtkStatusIconClass), gtk_status_icon_get_type }, { sizeof(GtkCList), sizeof(GtkCListClass), gtk_clist_get_type }, { sizeof(GtkCTree), sizeof(GtkCTreeClass), gtk_ctree_get_type }, { sizeof(GtkFixed), sizeof(GtkFixedClass), gtk_fixed_get_type }, { sizeof(GtkNotebook), sizeof(GtkNotebookClass), gtk_notebook_get_type }, { sizeof(GtkFontSelection), sizeof(GtkFontSelectionClass), gtk_font_selection_get_type }, { sizeof(GtkPaned), sizeof(GtkPanedClass), gtk_paned_get_type }, { sizeof(GtkHPaned), sizeof(GtkHPanedClass), gtk_hpaned_get_type }, { sizeof(GtkVPaned), sizeof(GtkVPanedClass), gtk_vpaned_get_type }, { sizeof(GtkLayout), sizeof(GtkLayoutClass), gtk_layout_get_type }, { sizeof(GtkList), sizeof(GtkListClass), gtk_list_get_type }, { sizeof(GtkMenuShell), sizeof(GtkMenuShellClass), gtk_menu_shell_get_type }, { sizeof(GtkMenuBar), sizeof(GtkMenuBarClass), gtk_menu_bar_get_type }, { sizeof(GtkMenu), sizeof(GtkMenuClass), gtk_menu_get_type }, { sizeof(GtkPacker), sizeof(GtkPackerClass), gtk_packer_get_type }, { sizeof(GtkSocket), sizeof(GtkSocketClass), gtk_socket_get_type }, { sizeof(GtkTable), sizeof(GtkTableClass), gtk_table_get_type }, { sizeof(GtkToolbar), sizeof(GtkToolbarClass), gtk_toolbar_get_type }, { sizeof(GtkTree), sizeof(GtkTreeClass), gtk_tree_get_type }, { sizeof(GtkCalendar), sizeof(GtkCalendarClass), gtk_calendar_get_type }, { sizeof(GtkDrawingArea), sizeof(GtkDrawingAreaClass), gtk_drawing_area_get_type }, { sizeof(GtkCurve), sizeof(GtkCurveClass), gtk_curve_get_type }, { sizeof(GtkEditable), sizeof(GtkEditableClass), gtk_editable_get_type }, { sizeof(GtkEntry), sizeof(GtkEntryClass), gtk_entry_get_type }, { sizeof(GtkSpinButton), sizeof(GtkSpinButtonClass), gtk_spin_button_get_type }, { sizeof(GtkText), sizeof(GtkTextClass), gtk_text_get_type }, { sizeof(GtkRuler), sizeof(GtkRulerClass), gtk_ruler_get_type }, { sizeof(GtkHRuler), sizeof(GtkHRulerClass), gtk_hruler_get_type }, { sizeof(GtkVRuler), sizeof(GtkVRulerClass), gtk_vruler_get_type }, { sizeof(GtkRange), sizeof(GtkRangeClass), gtk_range_get_type }, { sizeof(GtkScale), sizeof(GtkScaleClass), gtk_scale_get_type }, { sizeof(GtkHScale), sizeof(GtkHScaleClass), gtk_hscale_get_type }, { sizeof(GtkVScale), sizeof(GtkVScaleClass), gtk_vscale_get_type }, { sizeof(GtkScrollbar), sizeof(GtkScrollbarClass), gtk_scrollbar_get_type }, { sizeof(GtkHScrollbar), sizeof(GtkHScrollbarClass), gtk_hscrollbar_get_type }, { sizeof(GtkVScrollbar), sizeof(GtkVScrollbarClass), gtk_vscrollbar_get_type }, { sizeof(GtkSeparator), sizeof(GtkSeparatorClass), gtk_separator_get_type }, { sizeof(GtkHSeparator), sizeof(GtkHSeparatorClass), gtk_hseparator_get_type }, { sizeof(GtkVSeparator), sizeof(GtkVSeparatorClass), gtk_vseparator_get_type }, { sizeof(GtkProgress), sizeof(GtkProgressClass), gtk_progress_get_type }, { sizeof(GtkProgressBar), sizeof(GtkProgressBarClass), gtk_progress_bar_get_type }, { sizeof(GtkData), sizeof(GtkDataClass), gtk_data_get_type }, { sizeof(GtkAdjustment), sizeof(GtkAdjustmentClass), gtk_adjustment_get_type }, { sizeof(GtkTooltips), sizeof(GtkTooltipsClass), gtk_tooltips_get_type }, { sizeof(GtkItemFactory), sizeof(GtkItemFactoryClass), gtk_item_factory_get_type } }; CAMLprim value ml_gtk_type_unique (value name, value parent, value nsignals) { struct widget_info * wi; GtkTypeInfo ttt_info; wi = widget_info_array + Int_val(parent); ttt_info.type_name = String_val(name); ttt_info.object_size = wi->size; ttt_info.class_size = wi->class_size + Int_val(nsignals)*sizeof(void *); ttt_info.class_init_func = (GtkClassInitFunc) class_init; ttt_info.object_init_func = (GtkObjectInitFunc) NULL; ttt_info.reserved_1 = NULL; ttt_info.reserved_2 = NULL; ttt_info.base_class_init_func = (GtkClassInitFunc) NULL; return Val_int(gtk_type_unique(wi->get_type_func (), &ttt_info)); } static guint sig[100]; CAMLprim value ml_gtk_object_class_add_signals (value class, value signals, value nsignals) { int i; for (i=0; iclass_size+Int_val(num)*sizeof(void *); return Val_int(gtk_signal_new (String_val(name), Int_val(run_type), ((GtkObjectClass *)classe)->type, offset, gtk_signal_default_marshaller, GTK_TYPE_NONE, 0)); *(((int *)classe)+offset) = 0; } lablgtk-2.18.8/src/check_externals.ml40000644000175000017500000000702513460263323016637 0ustar stephsteph(* $Id$ *) (* Check that all external statements differ in a .ml or .mli file *) open StdLabels (*** Objective Caml simplified lexer ***) type token = Ident of string | Num of int | Sym of char | String of string | Char of string | EOF let rec implode l = let s = String.create (List.length l) in let i = ref 0 in List.iter l ~f:(fun c -> s.[!i] <- c; incr i); s let rec skip tok = parser [< ' tok' ; s >] -> if tok <> tok' then skip tok s let rec star ~acc p = parser [< x = p ; s >] -> star ~acc:(x::acc) p s | [< >] -> List.rev acc let alphanum = parser [< ' ('A'..'Z'|'a'..'z'|'0'..'9'|'\''|'_' as c) >] -> c let num = parser [< ' ('0'..'9'|'_' as c) >] -> c let escaped = parser [< ' ('0'..'9' as c1); ' ('0'..'9' as c2); ' ('0'..'9' as c3) >] -> [c1;c2;c3] | [< ' c >] -> [c] let char = parser [< ''\\'; l = escaped; ''\'' >] -> implode ('\\'::l) | [< ' c ; ''\'' >] -> String.make 1 c let rec string ~acc = parser [< ''"' >] -> implode (List.rev acc) | [< ''\''; l = escaped; s >] -> string ~acc:(List.rev_append l ('\''::acc)) s | [< ' c ; s >] -> string ~acc:(c::acc) s let rec token = parser [< ' ('A'..'Z'|'a'..'z'|'_' as c); l = star alphanum ~acc:[c] >] -> Ident (implode l) | [< ' ('0'..'9' as c); l = star ~acc:[c] num >] -> Num (int_of_string (implode l)) | [< ''('; r = may_comment >] -> r | [< ''\''; s >] -> (try Char (char s) with _ -> token s) (* skip type variables... *) | [< ''"'; s = string ~acc:[] >] -> String s | [< ' (' '|'\n'|'\r'|'\t'); s >] -> token s | [< ' c >] -> Sym c | [< >] -> raise End_of_file and may_comment = parser [< ''*'; s >] -> let s' = lexer s in skip (Sym '*') s'; may_close_comment s' | [< >] -> Sym '(' and may_close_comment = parser [< ' Sym ')'; ' tok >] -> tok | [< s >] -> skip (Sym '*') s; may_close_comment s and lexer s = [< ' token s ; lexer s >] (**** The actual checker ***) let defs = Hashtbl.create 13 let add impl name = try let name' = Hashtbl.find defs impl in Printf.eprintf "externals [%s] and [%s] have same implementation \"%s\"\n" name' name impl with Not_found -> Hashtbl.add defs impl name let may_string = parser [< ' String s >] -> s | [< >] -> "" let rec skip_type = parser [< ' Sym '=' >] -> () | [< ' Sym '('; _ = skip (Sym ')'); s >] -> skip_type s | [< ' Sym '['; _ = skip (Sym ']'); s >] -> skip_type s | [< ' _; s >] -> skip_type s let check_external = parser [< ' Ident name; ' Sym ':'; _ = skip_type; ' String impl; native1 = may_string; native2 = may_string >] -> if impl <> "" && impl.[0] <> '%' then add impl name; let native = match native1, native2 with ("noalloc"|"float"), ("noalloc"|"float") -> "" | ("noalloc"|"float"), n -> n | n, _ -> n in if native <> "" then add native name let check f = prerr_endline ("processing " ^ f); let ic = open_in f in let chars = Stream.of_channel ic in let s = lexer chars in try while true do skip (Ident"external") s; check_external s done with End_of_file -> () | Stream.Error _ | Stream.Failure -> Printf.eprintf "Parse error in file `%s' before char %d\n" f (Stream.count chars); exit 2 | exn -> Printf.eprintf "Exception %s in file `%s' before char %d\n" (Printexc.to_string exn) f (Stream.count chars); exit 2 let main () = Arg.parse [] check "usage: check_externals file.ml ..." let () = Printexc.print main () lablgtk-2.18.8/src/gHtml.ml0000644000175000017500000000533013460263323014461 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open GtkBase open GObj open GtkXmHTML class xmhtml obj = object (self) inherit widget_full (obj : GtkXmHTML.xmhtml obj) method event = new GObj.event_ops obj method freeze = freeze obj method thaw = thaw obj method source = source obj method set_fonts = set_font_familty obj method set_fonts_fixed = set_font_familty_fixed obj method set_anchor_buttons = set_anchor_buttons obj method set_anchor_cursor = set_anchor_cursor obj method set_anchor_underline = set_anchor_underline_type obj method set_anchor_visited_underline = set_anchor_visited_underline_type obj method set_anchor_target_underline = set_anchor_target_underline_type obj method set_topline = set_topline obj method topline = get_topline obj method set_strict_checking = set_strict_checking obj method set_bad_html_warnings = set_bad_html_warnings obj method set_imagemap_draw = set_imagemap_draw obj end let xmhtml ?source ?border_width ?width ?height ?packing ?show () = let w = create () in Container.set w ?border_width ?width ?height; may source ~f:(GtkXmHTML.source w); pack_return (new xmhtml w) ~packing ~show lablgtk-2.18.8/src/gtkSourceView_types.mli0000644000175000017500000000554713460263323017616 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* * lablgtksourceview, OCaml binding for the GtkSourceView text widget * * Copyright (C) 2005 Stefano Zacchiroli * * This library is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as * published by the Free Software Foundation; either version 2.1 of the * License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 * USA *) type source_tag_style = [`sourcetagstyle] type source_tag = [`texttag|`sourcetag] type source_tag_table = [`texttagtable |`sourcetagtable] type source_style_scheme = [`sourcestylescheme] type source_view = [Gtk.text_view|`sourceview] type source_marker = [`sourcemarker] type source_buffer = [`textbuffer|`sourcebuffer] type source_language = [`sourcelanguage] type source_languages_manager = [`sourcelanguagesmanager] lablgtk-2.18.8/src/win32.h0000644000175000017500000000320313460263323014164 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #ifdef _WIN32 #define LC_MESSAGES 0 #else #endif lablgtk-2.18.8/src/gtkxmhtml_tags.var0000644000175000017500000000055113460263323016623 0ustar stephsteph(* $Id$ *) type string_direction = "TSTRING_DIRECTION_" [ | `R_TO_L | `L_TO_R ] type alignment = "TALIGNMENT_" [ | `END | `CENTER | `BEGINNING ] type line_type = "LINE_" [ | `SOLID | `DASHED | `SINGLE | `DOUBLE | `STRIKE | `UNDER | `NONE "NO_LINE" ] type dither_type = "Xm" [ | `QUICK | `BEST | `FAST | `SLOW | `DISABLED ] lablgtk-2.18.8/src/ml_gtktext.c0000644000175000017500000006604713460263323015416 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* Author: Benjamin Monate */ #include #include #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gobject.h" #include "ml_gdkpixbuf.h" #include "ml_pango.h" #include "ml_gtktext.h" #include "gtk_tags.h" #include "gdk_tags.h" /* Init all */ CAMLprim value ml_gtktext_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_text_view_get_type() + gtk_text_buffer_get_type() + gtk_text_child_anchor_get_type() + gtk_text_mark_get_type() + gtk_text_tag_get_type() + gtk_text_tag_table_get_type(); return Val_GType(t); } CAMLprim value Val_GtkTextMark_func(gpointer val){ return(Val_GtkTextMark(val)); } static value Val_GtkTextMark_opt(GtkTextMark *mrk) { return Val_option(mrk, Val_GtkTextMark); } /* TextIter are not GObjects. They are stack allocated. */ /* This is the Custom_block version for latter... static void text_iter_free (value v) { gtk_text_iter_free((GtkTextIter*)v); } static struct custom_operations textiter_custom_operations = {"gtk_textiter/2.0/",text_iter_free,custom_compare_default, custom_hash_default,custom_serialize_default,custom_deserialize_default} ; #define GtkTextIter_val(val) ((GtkTextIter*)Data_custom_val(val)) CAMLprim value Val_GtkTextIter_new(GtkTextIter* val){ value res = alloc_custom(&textiter_custom_operations,1,1,2); Field(res,1)=(value)gtk_text_iter_copy(val); return(res); } */ /* This is the classical version for lablgtk */ /* #define GtkTextIter_val(val) ((GtkTextIter*)Pointer_val(val)) Make_Val_final_pointer_ext(GtkTextIter, _mine,Ignore,gtk_text_iter_free,1) CAMLprim value Val_GtkTextIter(GtkTextIter* it){ return(Val_GtkTextIter_mine(gtk_text_iter_copy(it))); } ML_1 (gtk_text_iter_copy, GtkTextIter_val, Val_GtkTextIter_mine) */ CAMLprim value ml_gtk_text_iter_copy (value it) { /* Only valid if in old generation and compaction off */ return Val_GtkTextIter(GtkTextIter_val(it)); } /* Defined from Gtk 3.2 onwards, and explicitely written for bindings */ CAMLprim value ml_gtk_text_iter_assign (value it1, value it2) { CAMLparam2(it1, it2); GtkTextIter* iter = GtkTextIter_val(it1); GtkTextIter* other = GtkTextIter_val(it2); g_return_val_if_fail (iter != NULL, Val_unit); g_return_val_if_fail (other != NULL, Val_unit); *iter = *other; CAMLreturn(Val_unit); } /* gtktextmark */ ML_2(gtk_text_mark_set_visible, GtkTextMark_val, Bool_val, Unit) ML_1(gtk_text_mark_get_visible, GtkTextMark_val, Val_bool) ML_1(gtk_text_mark_get_deleted, GtkTextMark_val, Val_bool) ML_1(gtk_text_mark_get_name, GtkTextMark_val, Val_option_string) Make_Val_option(GtkTextBuffer) ML_1(gtk_text_mark_get_buffer, GtkTextMark_val, Val_option_GtkTextBuffer) ML_1(gtk_text_mark_get_left_gravity, GtkTextMark_val, Val_bool) /* gtktexttag */ ML_1(gtk_text_tag_new, String_val, Val_GtkTextTag_new) ML_1(gtk_text_tag_get_priority, GtkTextTag_val, Val_int) ML_2(gtk_text_tag_set_priority, GtkTextTag_val, Int_val, Unit) ML_4(gtk_text_tag_event, GtkTextTag_val, GObject_val, GdkEvent_val, GtkTextIter_val, Val_bool) /* export needed conversion */ ML_1(Wrap_mode_val, (value), Val_int) /* gtktexttagtable */ ML_0(gtk_text_tag_table_new, Val_GtkTextTagTable_new) ML_2(gtk_text_tag_table_add, GtkTextTagTable_val, GtkTextTag_val,Unit) ML_2(gtk_text_tag_table_remove, GtkTextTagTable_val, GtkTextTag_val,Unit) Make_Val_option(GtkTextTag) ML_2(gtk_text_tag_table_lookup, GtkTextTagTable_val, String_val, Val_option_GtkTextTag) ML_1(gtk_text_tag_table_get_size, GtkTextTagTable_val, Val_int) static void tag_foreach_func (GtkTextTag* t, gpointer user_data) { value arg = Val_GtkTextTag(t); callback_exn (*(value*)user_data, arg); } CAMLprim value ml_gtk_text_tag_table_foreach (value t, value fun) { CAMLparam1(fun); gtk_text_tag_table_foreach(GtkTextTagTable_val(t), tag_foreach_func, &fun); CAMLreturn(Val_unit); } /* gtktextbuffer */ ML_1 (gtk_text_buffer_new, Option_val(arg1,GtkTextTagTable_val,NULL) Ignore, Val_GtkTextBuffer_new) ML_1 (gtk_text_buffer_get_line_count,GtkTextBuffer_val,Val_int) ML_1 (gtk_text_buffer_get_char_count,GtkTextBuffer_val,Val_int) /* ML_1 (gtk_text_buffer_get_tag_table,GtkTextBuffer_val,Val_GtkTextTagTable) */ /* [Benjamin] WARNING : something strange happens here : various segfaults we we insert non constant string a lot of times and the signal "insert-text" is connected. See : let bug () = let w = GWindow.window ~title:"Insertion bug" () in let b = GText.buffer () in b#set_text "Initial text\n"; GText.view ~buffer:b ~packing:(w#add) (); w#show (); b#connect#insert_text (fun it s -> Gc.full_major (); Printf.printf "Handler got: \"%s\"\n" s; flush stdout); b#connect#delete_range (fun ~start ~stop -> Gc.full_major ()); let s = "azert"^"yuiop" in let iter_ref = ref b#start_iter in for i = 0 to 10 do let start = !iter_ref#offset in Printf.printf "Number %d, \"%s\", %d\n" i s start; flush stdout; let iter = !iter_ref#copy in b#insert ~iter s; let iter' = iter#copy in b#delete (b#get_iter (`OFFSET(start+2))) iter'; iter_ref := iter' done ;; The GC seems to free/move the string too early... An explicite allocation of the string seems to fix it. Jacques : any idea of what is happening ? Update: This has probably something to do with garbage at the end of the caml string. [Jacques] No, I think the first answer is right: the GC is moving the string. Caml string are correctly 0-terminated, so this is not the cause. By the way, I had problems with "light" textiters for the same reason. Now the above code is OK, but replacing [full_major] by [compact] it will fail, as will do most code... Disabling compaction is essential. Note that I also allocate stable strings in the old generation now, to avoid problems with alloca on Linux. */ ML_3 (gtk_text_buffer_insert, GtkTextBuffer_val, GtkTextIter_val, SizedString_val, Unit) ML_2 (gtk_text_buffer_insert_at_cursor, GtkTextBuffer_val, SizedString_val, Unit) ML_4 (gtk_text_buffer_insert_interactive,GtkTextBuffer_val, GtkTextIter_val, SizedString_val, Bool_val, Val_bool) ML_3 (gtk_text_buffer_insert_interactive_at_cursor,GtkTextBuffer_val, SizedString_val, Bool_val, Val_bool) ML_4 (gtk_text_buffer_insert_range,GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val,GtkTextIter_val,Unit) ML_5 (gtk_text_buffer_insert_range_interactive,GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val,GtkTextIter_val,Bool_val,Val_bool) ML_3 (gtk_text_buffer_delete,GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val,Unit) ML_4 (gtk_text_buffer_delete_interactive,GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val,Bool_val,Val_bool) ML_2 (gtk_text_buffer_set_text, GtkTextBuffer_val, SizedString_val, Unit) ML_4 (gtk_text_buffer_get_text, GtkTextBuffer_val, GtkTextIter_val,GtkTextIter_val,Bool_val, copy_string_g_free) ML_4 (gtk_text_buffer_get_slice, GtkTextBuffer_val, GtkTextIter_val,GtkTextIter_val,Bool_val, copy_string_g_free) ML_3 (gtk_text_buffer_insert_pixbuf, GtkTextBuffer_val, GtkTextIter_val,GdkPixbuf_val,Unit) ML_4 (gtk_text_buffer_create_mark, GtkTextBuffer_val, String_option_val, GtkTextIter_val, Bool_val, Val_GtkTextMark) ML_2 (gtk_text_buffer_get_mark, GtkTextBuffer_val, String_val, Val_GtkTextMark_opt) ML_1 (gtk_text_buffer_get_insert, GtkTextBuffer_val, Val_GtkTextMark) ML_1 (gtk_text_buffer_get_selection_bound, GtkTextBuffer_val, Val_GtkTextMark) ML_3(gtk_text_buffer_move_mark, GtkTextBuffer_val, GtkTextMark_val, GtkTextIter_val, Unit) ML_3(gtk_text_buffer_move_mark_by_name, GtkTextBuffer_val, String_val, GtkTextIter_val, Unit) ML_2 (gtk_text_buffer_delete_mark, GtkTextBuffer_val, GtkTextMark_val,Unit) ML_2 (gtk_text_buffer_delete_mark_by_name, GtkTextBuffer_val, String_val, Unit) ML_2 (gtk_text_buffer_place_cursor, GtkTextBuffer_val, GtkTextIter_val, Unit) #ifdef HASGTK24 ML_3 (gtk_text_buffer_select_range, GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val, Unit) #else Unsupported_24(gtk_text_buffer_select_range) #endif ML_4 (gtk_text_buffer_apply_tag, GtkTextBuffer_val, GtkTextTag_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_4 (gtk_text_buffer_remove_tag, GtkTextBuffer_val, GtkTextTag_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_4 (gtk_text_buffer_apply_tag_by_name, GtkTextBuffer_val, String_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_4 (gtk_text_buffer_remove_tag_by_name, GtkTextBuffer_val, String_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_3 (gtk_text_buffer_remove_all_tags, GtkTextBuffer_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_2_name (ml_gtk_text_buffer_create_tag_0,gtk_text_buffer_create_tag, GtkTextBuffer_val, Split(Option_val(arg2,String_val,NULL), Id, NULL Ignore), Val_GtkTextTag) CAMLprim value ml_gtk_text_buffer_create_tag_1 (value arg1, value arg2, value arg3) { return (Val_GtkTextTag (gtk_text_buffer_create_tag (GtkTextBuffer_val(arg1),Option_val(arg2,String_val,NULL), String_val(arg3),NULL)));}; CAMLprim value ml_gtk_text_buffer_create_tag_2 (value arg1, value arg2, value arg3, value arg4) { return (Val_GtkTextTag (gtk_text_buffer_create_tag (GtkTextBuffer_val(arg1),Option_val(arg2,String_val,NULL), String_val(arg3),String_val(arg4),NULL)));}; CAMLprim value ml_gtk_text_buffer_get_iter_at_line_offset(value tb, value l, value c) { CAMLparam3(tb,l,c); GtkTextIter res; gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer_val(tb), &res, Int_val(l), Int_val(c)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_iter_at_offset(value tb, value l) { CAMLparam2(tb,l); GtkTextIter res; gtk_text_buffer_get_iter_at_offset(GtkTextBuffer_val(tb), &res, Int_val(l)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_iter_at_line(value tb, value l) { CAMLparam2(tb,l); GtkTextIter res; gtk_text_buffer_get_iter_at_line(GtkTextBuffer_val(tb), &res, Int_val(l)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_iter_at_line_index(value tb, value l, value c) { CAMLparam3(tb,l,c); GtkTextIter res; gtk_text_buffer_get_iter_at_line_offset(GtkTextBuffer_val(tb), &res, Int_val(l), Int_val(c)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_iter_at_mark(value tb, value l) { CAMLparam2(tb,l); GtkTextIter res; gtk_text_buffer_get_iter_at_mark(GtkTextBuffer_val(tb), &res, GtkTextMark_val(l)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_start_iter(value tb) { CAMLparam1(tb); GtkTextIter res; gtk_text_buffer_get_start_iter(GtkTextBuffer_val(tb), &res); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_end_iter(value tb) { CAMLparam1(tb); GtkTextIter res; gtk_text_buffer_get_end_iter(GtkTextBuffer_val(tb), &res); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_buffer_get_bounds(value tb) { CAMLparam1(tb); CAMLlocal1(res); GtkTextIter res1,res2; gtk_text_buffer_get_bounds(GtkTextBuffer_val(tb), &res1, &res2); res = alloc_tuple(2); Store_field(res,0,Val_GtkTextIter(&res1)); Store_field(res,1,Val_GtkTextIter(&res2)); CAMLreturn(res); } ML_1 (gtk_text_buffer_get_modified, GtkTextBuffer_val, Val_bool) ML_2 (gtk_text_buffer_set_modified, GtkTextBuffer_val, Bool_val, Unit) ML_3 (gtk_text_buffer_delete_selection, GtkTextBuffer_val, Bool_val, Bool_val, Val_bool) CAMLprim value ml_gtk_text_buffer_get_selection_bounds(value tb) { CAMLparam1(tb); CAMLlocal1(res); GtkTextIter res1,res2; gtk_text_buffer_get_selection_bounds(GtkTextBuffer_val(tb), &res1, &res2); res = alloc_tuple(2); Store_field(res,0,Val_GtkTextIter(&res1)); Store_field(res,1,Val_GtkTextIter(&res2)); CAMLreturn(res); } ML_1(gtk_text_buffer_begin_user_action,GtkTextBuffer_val,Unit) ML_1(gtk_text_buffer_end_user_action,GtkTextBuffer_val,Unit) /* no ref returned to the caller. */ ML_2(gtk_text_buffer_create_child_anchor, GtkTextBuffer_val,GtkTextIter_val,Val_GtkTextChildAnchor) ML_3(gtk_text_buffer_insert_child_anchor, GtkTextBuffer_val,GtkTextIter_val,GtkTextChildAnchor_val,Unit) CAMLprim value ml_gtk_text_buffer_paste_clipboard (value arg1, value arg2, value arg3, value arg4) { gtk_text_buffer_paste_clipboard (GtkTextBuffer_val(arg1), GtkClipboard_val(arg2), Option_val(arg3,GtkTextIter_val,NULL), Bool_val(arg4) ); return(Val_unit); } ML_2(gtk_text_buffer_copy_clipboard, GtkTextBuffer_val, GtkClipboard_val, Unit) ML_3(gtk_text_buffer_cut_clipboard, GtkTextBuffer_val, GtkClipboard_val, Bool_val, Unit) ML_2(gtk_text_buffer_add_selection_clipboard, GtkTextBuffer_val, GtkClipboard_val, Unit) ML_2(gtk_text_buffer_remove_selection_clipboard, GtkTextBuffer_val, GtkClipboard_val, Unit) /* gtktextview.h */ ML_1 (Val_delete_type, Int_val, (value)) ML_1 (Val_movement_step, Int_val, (value)) ML_0 (gtk_text_view_new, Val_GtkWidget_sink) ML_1 (gtk_text_view_new_with_buffer, GtkTextBuffer_val, Val_GtkWidget_sink) ML_2 (gtk_text_view_set_buffer, GtkTextView_val, GtkTextBuffer_val, Unit) ML_1 (gtk_text_view_get_buffer, GtkTextView_val, Val_GtkTextBuffer) ML_6(gtk_text_view_scroll_to_mark, GtkTextView_val, GtkTextMark_val, Float_val, Bool_val, Float_val,Float_val, Unit) ML_bc6(ml_gtk_text_view_scroll_to_mark) ML_6(gtk_text_view_scroll_to_iter, GtkTextView_val, GtkTextIter_val, Float_val, Bool_val, Float_val,Float_val, Val_bool) ML_bc6(ml_gtk_text_view_scroll_to_iter) ML_2(gtk_text_view_scroll_mark_onscreen, GtkTextView_val, GtkTextMark_val,Unit) ML_2(gtk_text_view_move_mark_onscreen, GtkTextView_val, GtkTextMark_val, Val_bool) ML_1(gtk_text_view_place_cursor_onscreen, GtkTextView_val, Val_bool) CAMLprim value ml_gtk_text_view_get_visible_rect (value tv) { GdkRectangle res; gtk_text_view_get_visible_rect(GtkTextView_val(tv), &res); return Val_copy(res); } CAMLprim value ml_gtk_text_view_get_iter_location (value tv, value ti) { GdkRectangle res; gtk_text_view_get_iter_location(GtkTextView_val(tv),GtkTextIter_val(ti), &res); return Val_copy(res); } CAMLprim value ml_gtk_text_view_get_line_at_y (value tv, value y) { CAMLparam2(tv,y); CAMLlocal1(res); GtkTextIter res1; int res2; gtk_text_view_get_line_at_y(GtkTextView_val(tv),&res1, Int_val(y),&res2); res = alloc_tuple(2); Store_field(res,0,Val_GtkTextIter(&res1)); Store_field(res,1,Val_int(res2)); CAMLreturn(res); } CAMLprim value ml_gtk_text_view_get_line_yrange (value tv, value ti) { CAMLparam2(tv,ti); CAMLlocal1(res); int y,h; gtk_text_view_get_line_yrange(GtkTextView_val(tv), GtkTextIter_val(ti), &y,&h); res = alloc_tuple(2); Store_field(res,0,Val_int(y)); Store_field(res,1,Val_int(h)); CAMLreturn(res); } CAMLprim value ml_gtk_text_view_get_iter_at_location (value tv, value x, value y) { CAMLparam3(tv,x,y); GtkTextIter res; gtk_text_view_get_iter_at_location(GtkTextView_val(tv),&res, Int_val(x),Int_val(y)); CAMLreturn(Val_GtkTextIter(&res)); } CAMLprim value ml_gtk_text_view_buffer_to_window_coords (value tv, value tt, value x, value y) { CAMLparam4(tv,tt,x,y); CAMLlocal1(res); int bx,by = 0; gtk_text_view_buffer_to_window_coords(GtkTextView_val(tv), Text_window_type_val(tt), Int_val(x),Int_val(y), &bx,&by); res = alloc_tuple(2); Store_field(res,0,Val_int(bx)); Store_field(res,1,Val_int(by)); CAMLreturn(res); } CAMLprim value ml_gtk_text_view_window_to_buffer_coords (value tv, value tt, value x, value y) { CAMLparam4(tv,tt,x,y); CAMLlocal1(res); int bx,by = 0; gtk_text_view_window_to_buffer_coords(GtkTextView_val(tv), Text_window_type_val(tt), Int_val(x),Int_val(y), &bx,&by); res = alloc_tuple(2); Store_field(res,0,Val_int(bx)); Store_field(res,1,Val_int(by)); CAMLreturn(res); } Make_Val_option(GdkWindow) ML_2(gtk_text_view_get_window, GtkTextView_val, Text_window_type_val, Val_option_GdkWindow) ML_2(gtk_text_view_get_window_type,GtkTextView_val,GdkWindow_val, Val_text_window_type) ML_3(gtk_text_view_set_border_window_size,GtkTextView_val, Text_window_type_val,Int_val, Unit) ML_2(gtk_text_view_get_border_window_size,GtkTextView_val, Text_window_type_val,Val_int) ML_2(gtk_text_view_forward_display_line,GtkTextView_val, GtkTextIter_val,Val_bool) ML_2(gtk_text_view_backward_display_line,GtkTextView_val, GtkTextIter_val,Val_bool) ML_2(gtk_text_view_forward_display_line_end,GtkTextView_val, GtkTextIter_val,Val_bool) ML_2(gtk_text_view_backward_display_line_start,GtkTextView_val, GtkTextIter_val,Val_bool) ML_2(gtk_text_view_starts_display_line,GtkTextView_val, GtkTextIter_val,Val_bool) ML_3(gtk_text_view_move_visually,GtkTextView_val, GtkTextIter_val,Int_val,Val_bool) ML_3(gtk_text_view_add_child_at_anchor,GtkTextView_val, GtkWidget_val,GtkTextChildAnchor_val,Unit) ML_0(gtk_text_child_anchor_new,Val_GtkTextChildAnchor_new) CAMLprim value ml_gtk_text_child_anchor_get_widgets (value tca) { return Val_GList_free (gtk_text_child_anchor_get_widgets(GtkTextChildAnchor_val(tca)), Val_GtkWidget_func); } ML_1(gtk_text_child_anchor_get_deleted,GtkTextChildAnchor_val,Val_bool) ML_5(gtk_text_view_add_child_in_window,GtkTextView_val, GtkWidget_val,Text_window_type_val,Int_val,Int_val, Unit) ML_4(gtk_text_view_move_child,GtkTextView_val, GtkWidget_val,Int_val,Int_val, Unit) /* gtktextiter */ ML_1 (gtk_text_iter_get_buffer, GtkTextIter_val, Val_GtkTextBuffer) ML_1 (gtk_text_iter_get_offset, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_line, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_line_offset, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_line_index, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_visible_line_index, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_visible_line_offset, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_char, GtkTextIter_val, Val_int) ML_2 (gtk_text_iter_get_slice, GtkTextIter_val, GtkTextIter_val, copy_string_g_free) ML_2 (gtk_text_iter_get_text, GtkTextIter_val, GtkTextIter_val, copy_string_g_free) ML_2 (gtk_text_iter_get_visible_slice, GtkTextIter_val, GtkTextIter_val, copy_string_g_free) ML_2 (gtk_text_iter_get_visible_text, GtkTextIter_val, GtkTextIter_val, copy_string_g_free) CAMLprim value ml_gtk_text_iter_get_pixbuf(value ti) { GdkPixbuf *ret = gtk_text_iter_get_pixbuf(GtkTextIter_val(ti)); return Val_option(ret,Val_GdkPixbuf); } CAMLprim value ml_gtk_text_iter_get_marks(value ti) { return Val_GSList_free(gtk_text_iter_get_marks(GtkTextIter_val(ti)), Val_GtkTextMark_func); } CAMLprim value ml_gtk_text_iter_get_toggled_tags(value ti, value b) { return Val_GSList_free (gtk_text_iter_get_toggled_tags(GtkTextIter_val(ti), Bool_val(b)), Val_GtkTextMark_func); } CAMLprim value ml_gtk_text_iter_get_child_anchor(value ti) { GtkTextChildAnchor *ret = gtk_text_iter_get_child_anchor(GtkTextIter_val(ti)); return Val_option(ret,Val_GtkTextChildAnchor); } ML_2 (gtk_text_iter_begins_tag,GtkTextIter_val, Option_val(arg2,GtkTextTag_val,NULL) Ignore, Val_bool) ML_2 (gtk_text_iter_ends_tag,GtkTextIter_val, Option_val(arg2,GtkTextTag_val,NULL) Ignore, Val_bool) ML_2 (gtk_text_iter_toggles_tag,GtkTextIter_val, Option_val(arg2,GtkTextTag_val,NULL) Ignore, Val_bool) ML_2 (gtk_text_iter_has_tag,GtkTextIter_val, GtkTextTag_val, Val_bool) CAMLprim value ml_gtk_text_iter_get_tags(value ti) { return Val_GSList_free(gtk_text_iter_get_tags(GtkTextIter_val(ti)), Val_GtkTextMark_func); } ML_2 (gtk_text_iter_editable,GtkTextIter_val, Bool_val, Val_bool) ML_2 (gtk_text_iter_can_insert,GtkTextIter_val, Bool_val, Val_bool) ML_1 (gtk_text_iter_starts_word, GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_ends_word, GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_inside_word,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_starts_line,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_ends_line,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_starts_sentence,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_ends_sentence,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_inside_sentence,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_is_cursor_position,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_get_chars_in_line, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_bytes_in_line, GtkTextIter_val, Val_int) ML_1 (gtk_text_iter_get_language, GtkTextIter_val, Val_PangoLanguage) ML_1 (gtk_text_iter_is_end,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_is_start,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_forward_char,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_backward_char,GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_chars,GtkTextIter_val, Int_val, Val_bool) ML_2 (gtk_text_iter_backward_chars,GtkTextIter_val, Int_val, Val_bool) ML_1 (gtk_text_iter_forward_line,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_backward_line,GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_lines,GtkTextIter_val, Int_val, Val_bool) ML_2 (gtk_text_iter_backward_lines,GtkTextIter_val, Int_val, Val_bool) ML_1 (gtk_text_iter_forward_word_end,GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_word_ends,GtkTextIter_val, Int_val, Val_bool) ML_1 (gtk_text_iter_backward_word_start,GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_backward_word_starts,GtkTextIter_val, Int_val, Val_bool) ML_1 (gtk_text_iter_forward_cursor_position,GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_backward_cursor_position,GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_cursor_positions, GtkTextIter_val, Int_val, Val_bool) ML_2 (gtk_text_iter_backward_cursor_positions, GtkTextIter_val, Int_val, Val_bool) ML_1 (gtk_text_iter_forward_sentence_end, GtkTextIter_val, Val_bool) ML_1 (gtk_text_iter_backward_sentence_start, GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_sentence_ends, GtkTextIter_val, Int_val, Val_bool) ML_2 (gtk_text_iter_backward_sentence_starts, GtkTextIter_val, Int_val, Val_bool) ML_2 (gtk_text_iter_set_offset, GtkTextIter_val, Int_val, Unit) ML_2 (gtk_text_iter_set_line, GtkTextIter_val, Int_val, Unit) ML_2 (gtk_text_iter_set_line_offset, GtkTextIter_val, Int_val, Unit) ML_2 (gtk_text_iter_set_line_index, GtkTextIter_val, Int_val, Unit) ML_2 (gtk_text_iter_set_visible_line_index, GtkTextIter_val, Int_val, Unit) ML_2 (gtk_text_iter_set_visible_line_offset, GtkTextIter_val, Int_val, Unit) ML_1 (gtk_text_iter_forward_to_end, GtkTextIter_val, Unit) ML_1 (gtk_text_iter_forward_to_line_end, GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_forward_to_tag_toggle, GtkTextIter_val, Option_val(arg2,GtkTextTag_val,NULL) Ignore, Val_bool) ML_2 (gtk_text_iter_backward_to_tag_toggle, GtkTextIter_val, Option_val(arg2,GtkTextTag_val,NULL) Ignore, Val_bool) ML_2 (gtk_text_iter_equal, GtkTextIter_val, GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_compare, GtkTextIter_val, GtkTextIter_val, Val_int) ML_3 (gtk_text_iter_in_range, GtkTextIter_val, GtkTextIter_val, GtkTextIter_val, Val_bool) ML_2 (gtk_text_iter_order, GtkTextIter_val, GtkTextIter_val, Unit) Make_OptFlags_val(Text_search_flag_val) #define Make_search(dir) \ CAMLprim value ml_gtk_text_iter_##dir##_search (value ti_start, \ value str,\ value flag,\ value ti_lim)\ { CAMLparam4(ti_start,str,flag,ti_lim);\ CAMLlocal2(res,coup);\ GtkTextIter* ti1,*ti2;\ gboolean b;\ ti1=gtk_text_iter_copy(GtkTextIter_val(ti_start));\ ti2=gtk_text_iter_copy(GtkTextIter_val(ti_start));\ b=gtk_text_iter_##dir##_search(GtkTextIter_val(ti_start),\ String_val(str),\ OptFlags_Text_search_flag_val(flag),\ ti1,\ ti2,\ Option_val(ti_lim,GtkTextIter_val,NULL));\ if (!b) res = Val_unit;\ else \ { res = alloc(1,0);\ coup = alloc_tuple(2);\ Store_field(coup,0,Val_GtkTextIter(ti1));\ Store_field(coup,1,Val_GtkTextIter(ti2));\ Store_field(res,0,coup);};\ CAMLreturn(res);} Make_search(forward); Make_search(backward); static gboolean ml_gtk_text_char_predicate(gunichar ch, gpointer user_data) { value res, *clos = user_data; res = callback_exn (*clos, Val_int(ch)); if (Is_exception_result (res)) { CAML_EXN_LOG ("ml_gtk_text_char_predicate"); return FALSE; } return Bool_val(res); } CAMLprim value ml_gtk_text_iter_forward_find_char(value i,value fun,value ito) { CAMLparam1(fun); CAMLreturn (Val_bool (gtk_text_iter_forward_find_char(GtkTextIter_val(i), ml_gtk_text_char_predicate, &fun, Option_val(ito,GtkTextIter_val,NULL)))); } CAMLprim value ml_gtk_text_iter_backward_find_char(value i,value fun,value ito) { CAMLparam1(fun); CAMLreturn (Val_bool (gtk_text_iter_backward_find_char(GtkTextIter_val(i), ml_gtk_text_char_predicate, &fun, Option_val(ito,GtkTextIter_val,NULL)))); } lablgtk-2.18.8/src/ml_glib.h0000644000175000017500000000432713460263323014637 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ CAMLexport value copy_string_g_free (char *str); /* for g_strings only */ typedef value (*value_in)(gpointer); typedef gpointer (*value_out)(value); /* should not trigger GC */ CAMLexport value Val_GList (GList *list, value_in); CAMLexport value Val_GList_free (GList *list, value_in); CAMLexport GList *GList_val (value list, value_out); CAMLexport value Val_GSList (GSList *list, value_in); CAMLexport value Val_GSList_free (GSList *list, value_in); CAMLexport GSList *GSList_val (value list, value_out); CAMLexport void ml_register_exn_map (GQuark domain, char *caml_name); CAMLexport void ml_raise_gerror(GError *) Noreturn; lablgtk-2.18.8/src/gdkPixbuf.mli0000644000175000017500000001534113460263323015505 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** Object for manipulating image data @gtkdoc gdk-pixbuf index *) (** {3 The GdkPixbuf Structure} *) (* Types *) (** @gtkdoc gdk-pixbuf gdk-pixbuf-gdk-pixbuf *) type pixbuf = [`pixbuf] Gobject.obj type colorspace = [ `RGB] type alpha_mode = [ `BILEVEL | `FULL] type interpolation = [ `BILINEAR | `HYPER | `NEAREST | `TILES] type gdkpixbuferror = | ERROR_CORRUPT_IMAGE | ERROR_INSUFFICIENT_MEMORY | ERROR_BAD_OPTION | ERROR_UNKNOWN_TYPE | ERROR_UNSUPPORTED_OPERATION | ERROR_FAILED exception GdkPixbufError of gdkpixbuferror * string external set_marshal_use_rle : bool -> unit = "ml_gdk_pixbuf_set_marshal_use_rle" (** {3 Creation} *) (** @gtkdoc gdk-pixbuf gdk-pixbuf-creating*) val create : width:int -> height:int -> ?bits:int -> ?colorspace:colorspace -> ?has_alpha:bool -> unit -> pixbuf val cast : 'a Gobject.obj -> pixbuf external copy : pixbuf -> pixbuf = "ml_gdk_pixbuf_copy" external subpixbuf : pixbuf -> src_x:int -> src_y:int -> width:int -> height:int -> pixbuf = "ml_gdk_pixbuf_new_subpixbuf" (** @gtkdoc gdk-pixbuf gdk-pixbuf-file-loading *) external from_file : string -> pixbuf = "ml_gdk_pixbuf_new_from_file" (** @since GTK 2.4 *) external get_file_info : string -> string * int * int = "ml_gdk_pixbuf_get_file_info" (** @since GTK 2.4 @gtkdoc gdk-pixbuf gdk-pixbuf-file-loading *) external from_file_at_size : string -> width:int -> height:int -> pixbuf = "ml_gdk_pixbuf_new_from_file_at_size" external from_xpm_data : string array -> pixbuf = "ml_gdk_pixbuf_new_from_xpm_data" val from_data : width:int -> height:int -> ?bits:int -> ?rowstride:int -> ?has_alpha:bool -> Gpointer.region -> pixbuf (** @gtkdoc gdk gdk-Pixbufs *) val get_from_drawable : dest:pixbuf -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?src_x:int -> ?src_y:int -> ?colormap:Gdk.colormap -> [>`drawable] Gobject.obj -> unit (** {3 Accessors} *) external get_n_channels : pixbuf -> int = "ml_gdk_pixbuf_get_n_channels" external get_has_alpha : pixbuf -> bool = "ml_gdk_pixbuf_get_has_alpha" external get_bits_per_sample : pixbuf -> int = "ml_gdk_pixbuf_get_bits_per_sample" external get_width : pixbuf -> int = "ml_gdk_pixbuf_get_width" external get_height : pixbuf -> int = "ml_gdk_pixbuf_get_height" external get_rowstride : pixbuf -> int = "ml_gdk_pixbuf_get_rowstride" val get_pixels : pixbuf -> Gpointer.region (** {3 Rendering} *) (** @gtkdoc gdk gdk-Drawing-Primitives *) val draw_pixbuf : [>`drawable] Gobject.obj -> Gdk.gc -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?dither:Gdk.Tags.rgb_dither -> ?x_dither:int -> ?y_dither:int -> ?src_x:int -> ?src_y:int -> pixbuf -> unit (** @gtkdoc gdk gdk-Pixbufs @deprecated use {!GdkPixbuf.draw_pixbuf} *) val render_to_drawable : [>`drawable] Gobject.obj -> ?gc:Gdk.gc -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?dither:Gdk.Tags.rgb_dither -> ?x_dither:int -> ?y_dither:int -> ?src_x:int -> ?src_y:int -> pixbuf -> unit (** @gtkdoc gdk gdk-Pixbufs *) val render_alpha : Gdk.bitmap -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?threshold:int -> ?src_x:int -> ?src_y:int -> pixbuf -> unit (** @gtkdoc gdk gdk-Pixbufs @deprecated use {!GdkPixbuf.draw_pixbuf} *) val render_to_drawable_alpha : [>`drawable] Gobject.obj -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?alpha:alpha_mode -> ?threshold:int -> ?dither:Gdk.Tags.rgb_dither -> ?x_dither:int -> ?y_dither:int -> ?src_x:int -> ?src_y:int -> pixbuf -> unit (** @gtkdoc gdk gdk-Pixbufs *) val create_pixmap : ?threshold:int -> pixbuf -> Gdk.pixmap * Gdk.bitmap option (** {3 Transform} *) (** @gtkdoc gdk-pixbuf gdk-pixbuf-util *) val add_alpha : ?transparent:int * int * int -> pixbuf -> pixbuf (** @gtkdoc gdk-pixbuf gdk-pixbuf-util *) val fill : pixbuf -> int32 -> unit (** @gtkdoc gdk-pixbuf gdk-pixbuf-util *) val saturate_and_pixelate : dest:pixbuf -> saturation:float -> pixelate:bool -> pixbuf -> unit (** @gtkdoc gdk-pixbuf gdk-pixbuf-util *) val copy_area : dest:pixbuf -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?src_x:int -> ?src_y:int -> pixbuf -> unit (** @gtkdoc gdk-pixbuf gdk-pixbuf-scaling *) val scale : dest:pixbuf -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?ofs_x:float -> ?ofs_y:float -> ?scale_x:float -> ?scale_y:float -> ?interp:interpolation -> pixbuf -> unit (** @gtkdoc gdk-pixbuf gdk-pixbuf-scaling *) val composite : dest:pixbuf -> alpha:int -> ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?ofs_x:float -> ?ofs_y:float -> ?scale_x:float -> ?scale_y:float -> ?interp:interpolation -> pixbuf -> unit (** {3 Saving} *) (** @gtkdoc gdk-pixbuf gdk-pixbuf-file-saving *) external save : filename:string -> typ:string -> ?options:(string * string) list -> pixbuf -> unit = "ml_gdk_pixbuf_save" (** @since GTK 2.4 *) external save_to_callback : pixbuf -> typ:string -> ?options:(string * string) list -> (string -> unit) -> unit = "ml_gdk_pixbuf_save_to_callback" (** @since GTK 2.4 *) val save_to_buffer : pixbuf -> typ:string -> ?options:(string * string) list -> Buffer.t -> unit lablgtk-2.18.8/src/wrappers.h0000644000175000017500000004217013460263323015073 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #ifndef _wrappers_ #define _wrappers_ /* Yell if a caml callback raised an exception */ #define CAML_EXN_LOG(name) g_critical("%s: callback raised an exception", name) #define CAML_EXN_LOG_VERBOSE(name,exn) g_critical("%s: callback raised exception %s", name, format_caml_exception(Extract_exception(exn))) #include #include #include #include CAMLextern char *young_start, *young_end; /* from minor_gc.h */ CAMLexport value copy_memblock_indirected (void *src, asize_t size); value alloc_memblock_indirected (asize_t size); CAMLexport value ml_alloc_custom(struct custom_operations * ops, uintnat size, mlsize_t mem, mlsize_t max); CAMLprim value ml_some (value); value ml_cons (value, value); CAMLexport void ml_raise_null_pointer (void) Noreturn; CAMLexport value Val_pointer (void *); CAMLprim value copy_string_check (const char*); value copy_string_or_null (const char *); value Val_option_string (const char *s); value string_list_of_strv (const char * const *v); value string_list_of_strv2 (char **v); char ** strv_of_string_list (value list); CAMLprim value *ml_global_root_new (value v); CAMLexport void ml_global_root_destroy (void *data); /* enums <-> polymorphic variants */ typedef struct { value key; int data; } lookup_info; CAMLexport value ml_lookup_from_c (const lookup_info table[], int data); CAMLexport int ml_lookup_to_c (const lookup_info table[], value key); CAMLexport value ml_lookup_flags_getter (const lookup_info table[], int data); /* Compatibility */ #include #if GTK_CHECK_VERSION(2,2,0) && !defined(DISABLE_GTK22) #define HASGTK22 #endif #if GTK_CHECK_VERSION(2,4,0) && !defined(DISABLE_GTK24) #define HASGTK24 #endif #if GTK_CHECK_VERSION(2,5,3) && !defined(DISABLE_GTK26) #define HASGTK26 #endif #if GTK_CHECK_VERSION(2,8,0) && !defined(DISABLE_GTK28) #define HASGTK28 #endif #if GTK_CHECK_VERSION(2,10,0) && !defined(DISABLE_GTK210) #define HASGTK210 #endif #if GTK_CHECK_VERSION(2,12,0) && !defined(DISABLE_GTK212) #define HASGTK212 #endif /* Wrapper generators */ #define Unsupported_22(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.2"); } #define Unsupported Unsupported_22 #define Unsupported_24(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.4"); } #define Unsupported_26(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.6"); } #define Unsupported_28(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.8"); } #define Unsupported_210(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.10"); } #define Unsupported_212(cname) \ CAMLprim value ml_##cname () \ { failwith(#cname " unsupported in Gtk 2.x < 2.12"); } #define ID(x) (x) #define ML_0(cname, conv) \ CAMLprim value ml_##cname (value unit) { return conv (cname ()); } #define ML_1(cname, conv1, conv) \ CAMLprim value ml_##cname (value arg1) { return conv (cname (conv1 (arg1))); } #define ML_1_post(cname, conv1, conv, post) \ CAMLprim value ml_##cname (value arg1) \ { value ret = conv (cname (conv1(arg1))); post; return ret; } #define ML_2(cname, conv1, conv2, conv) \ CAMLprim value ml_##cname (value arg1, value arg2) \ { return conv (cname (conv1(arg1), conv2(arg2))); } #define ML_2_name(mlname, cname, conv1, conv2, conv) \ CAMLprim value mlname (value arg1, value arg2) \ { return conv (cname (conv1(arg1), conv2(arg2))); } #define ML_3(cname, conv1, conv2, conv3, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } #define ML_3_name(mlname, cname, conv1, conv2, conv3, conv) \ CAMLprim value mlname (value arg1, value arg2, value arg3) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3))); } #define ML_4(cname, conv1, conv2, conv3, conv4, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } #define ML_4_name(mlname, cname, conv1, conv2, conv3, conv4, conv) \ CAMLprim value mlname (value arg1, value arg2, value arg3, value arg4) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4))); } #define ML_5(cname, conv1, conv2, conv3, conv4, conv5, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5))); } #define ML_5_name(mlname, cname, conv1, conv2, conv3, conv4, conv5, conv) \ CAMLprim value mlname (value arg1, value arg2, value arg3, value arg4, \ value arg5) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5))); } #define ML_6(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6))); } #define ML_7(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7))); } #define ML_8(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8))); } #define ML_9(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv9, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9))); } #define ML_9_name(mlname, cname, conv1, conv2, conv3, conv4, conv5, conv6, \ conv7, conv8, conv9, conv) \ CAMLprim value mlname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9))); } #define ML_10(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv9, conv10, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9, value arg10)\ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9), conv10(arg10))); } #define ML_11(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv9, conv10, conv11, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9, value arg10, value arg11) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9), conv10(arg10), conv11(arg11))); } #define ML_12(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv9, conv10, conv11, conv12, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9, value arg10, value arg11, value arg12) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9), conv10(arg10), conv11(arg11), \ conv12(arg12))); } #define ML_13(cname, conv1, conv2, conv3, conv4, conv5, conv6, conv7, conv8, \ conv9, conv10, conv11, conv12, conv13, conv) \ CAMLprim value ml_##cname (value arg1, value arg2, value arg3, value arg4, \ value arg5, value arg6, value arg7, value arg8, \ value arg9, value arg10, value arg11, value arg12, \ value arg13) \ { return conv (cname (conv1(arg1), conv2(arg2), conv3(arg3), conv4(arg4), \ conv5(arg5), conv6(arg6), conv7(arg7), conv8(arg8), \ conv9(arg9), conv10(arg10), conv11(arg11), \ conv12(arg12), conv13(arg13))); } /* Use with care: needs the argument index */ #define Ignore(x) #define Insert(x) (x), #define Split(x,f,g) f(x), g(x) Ignore #define Split3(x,f,g,h) f(x), g(x), h(x) Ignore #define Pair(x,f,g) f(Field(x,0)), g(Field(x,1)) Ignore #define Triple(x,f,g,h) f(Field(x,0)), g(Field(x,1)), h(Field(x,2)) Ignore /* For more than 5 arguments */ #define ML_bc6(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5]); } #define ML_bc7(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6]); } #define ML_bc8(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7]); } #define ML_bc9(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7],argv[8]); } #define ML_bc10(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7],argv[8],argv[9]); } #define ML_bc11(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7],argv[8],argv[9],argv[10]); } #define ML_bc12(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7],argv[8],argv[9],argv[10],argv[11]); } #define ML_bc13(cname) \ CAMLprim value cname##_bc (value *argv, int argn) \ { return cname(argv[0],argv[1],argv[2],argv[3],argv[4],argv[5],argv[6], \ argv[7],argv[8],argv[9],argv[10],argv[11],argv[12]); } /* result conversion */ #define Unit(x) ((x), Val_unit) #define Id(x) x #define Val_char Val_int /* parameter conversion */ #define Bool_ptr(x) ((long) x - 1) #define Char_val Int_val #define Float_val Double_val /* #define Float_val(x) ((float)Double_val(x)) */ #define SizedString_val(x) String_val(x), string_length(x) #define Option_val(val,unwrap,default) \ ((long)val-1 ? unwrap(Field(val,0)) : default) #define String_option_val(s) Option_val(s,String_val,NULL) /* Strings are not always old, so they may move around... */ /* problems with alloca on Linux #define StableString_val(val) \ ((char*)(val) < young_end && (char*)(val) > young_start ? \ memcpy(alloca(Bosize_val(val)), (char*)(val), Bosize_val(val)) : \ String_val(val)) */ /* Utility */ #define Copy_array(ret,l,src,conv) \ if (!l) ret = Atom(0); \ else if (l <= Max_young_wosize) { int i; ret = alloc_tuple(l); \ for(i=0;ifield); } #define Make_Setter(name,conv1,conv2,field) \ CAMLprim value ml_##name##_##field (value val, value new) \ { (conv1(val))->field = conv2(new); return Val_unit; } #define Make_Array_Extractor(name,conv1,conv2,field,conv) \ CAMLprim value ml_##name##_##field (value val, value index) \ { return conv ((conv1(val))->field[conv2(index)]); } #define Make_Array_Setter(name,conv1,conv2,conv3,field) \ CAMLprim value ml_##name##_##field (value val, value index, value new) \ { (conv1(val))->field[conv2(index)] = conv3(new); return Val_unit; } /* ML value is [flag list] */ #define Make_Flags_val(conv) \ CAMLprim int Flags_##conv (value list) \ { int flags = 0L; \ while(Is_block(list)){ flags |= conv(Field(list,0)); list = Field(list,1); }\ return flags; } /* ML value is [flag list option] */ #define Make_OptFlags_val(conv) \ CAMLprim int OptFlags_##conv (value list) \ { int flags = 0L; \ if (Is_block(list)) list = Field(list,0); \ while(Is_block(list)){ flags |= conv(Field(list,0)); list = Field(list,1); }\ return flags; } #define Val_copy(val) copy_memblock_indirected (&val, sizeof(val)) #define Val_string copy_string_check #define Val_optstring copy_string_or_null #define Optstring_val(v) (string_length(v) ? String_val(v) : (char*)NULL) #define Val_option(v,f) (v ? ml_some(f(v)) : Val_unit) #define Make_Val_option(T) \ value Val_option_##T(T* v) { return Val_option(v,Val_##T); } #define Check_null(v) (v ? v : (ml_raise_null_pointer (), v)) #define Val_nativeint copy_nativeint #define Val_int64 copy_int64 #endif /* _wrappers_ */ lablgtk-2.18.8/src/build.ml.in0000755000175000017500000001267313460263323015125 0ustar stephsteph(* $Id$ *) (* A script to build lablgtk2 libraries *) open StdLabels let ocamlc = ref "ocamlc.opt" let ocamlopt = ref "ocamlopt.opt" let flags = ref "-thread -w s" let ccomp_orig = "@TOOLCHAIN@" (* "msvc" for MSVC *) let ccomp_type = ref ccomp_orig let split ?(sep = [' ';'\t';'\r';'\n']) s = let len = String.length s in let rec loop last cur acc = if cur > len then acc else let next = cur+1 in if cur = len || List.mem s.[cur] sep then if cur > last then loop next next (String.sub s ~pos:last ~len:(cur-last) :: acc) else loop next next acc else loop last next acc in List.rev (loop 0 0 []) let lablgtk_mls = split "@LABLGTK_MLS@" let extra_mls = split "@EXTRA_MLS@" let prop_mls = split "@PROP_MLS@" let gtk_libs = "@GTKLIBS@" let glade_mls = split "@GLADE_MLS@" let glade_libs = "@GLADE_LIBS@" let rsvg_mls = split "@RSVG_MLS@" let rsvg_libs = "@RSVG_LIBS@" let canvas_mls = split "@CANVAS_MLS@" let canvas_libs = "@CANVAS_LIBS@" let sourceview2_mls = split "@SOURCEVIEW2_MLS@" let sourceview2_libs = "@SOURCEVIEW2_LIBS@" (* Hack to check for mingw *) let () = try let ic = open_in "../Makefile.config" in while true do let s = input_line ic in match split ~sep:[' ';'\t';'='] s with "CCOMPTYPE" :: cc :: _ -> ccomp_type := cc | _ -> () done with _ -> () let rename_libs libs = match ccomp_orig, !ccomp_type with | "msvc", "msvc" -> libs | "msvc", _ -> let libs = List.map (split libs) ~f: (fun nm -> if Filename.check_suffix nm ".lib" then "-l"^Filename.chop_extension nm^".dll" else nm) in String.concat " " libs | _, "msvc" -> let libs = List.map (split libs) ~f: (fun nm -> if String.length nm > 2 && String.sub nm ~pos:0 ~len:2 = "-l" then String.sub nm ~pos:2 ~len:(String.length nm - 2) ^ ".lib" else nm) in String.concat " " libs | _, _ -> libs let exe cmd args = let cmd = String.concat " " (cmd :: !flags :: args) in print_endline cmd; flush stdout; let err = Sys.command cmd in if err > 0 then failwith ("error "^string_of_int err) let may_remove f = if Sys.file_exists f then Sys.remove f type descr = { mlis: string list; mls: string list; extra: string list; libs: string; name: string; cname: string } let libs = let lib ~mls ~libs ~name ?(extra=[]) ?(mlis=[]) ?(cname=name) () = {mlis; mls; extra; libs=rename_libs libs; name; cname} in [ lib ~mls:lablgtk_mls ~extra:extra_mls ~libs:gtk_libs ~name:"lablgtk" ~cname:"lablgtk2" (); lib ~mls:glade_mls ~libs:glade_libs ~name:"lablglade" ~cname:"lablglade2" (); lib ~mls:rsvg_mls ~libs:rsvg_libs ~name:"lablrsvg" (); lib ~mls:canvas_mls ~libs:canvas_libs ~name:"lablgnomecanvas" (); lib ~mls:sourceview2_mls ~libs:sourceview2_libs ~name:"lablgtksourceview2" ~mlis:["gtkSourceView2_types"] ()] let compopts = [] (*["gtkSignal", ["-pp"; "\"camlp4o pa_macro.cmo -D HAS_PRINTEXC_BACKTRACE\""]] *) let compile ~comp file = let opts = try List.assoc file compopts with Not_found -> [] in exe comp (opts @ ["-c"; file ^ ".ml"]) let byte d = if d.mls <> [] then begin List.iter d.mlis ~f:(fun file -> exe !ocamlc ["-c"; file^".mli"]); List.iter (d.mls @ d.extra) ~f: begin fun file -> if Sys.file_exists (file ^ ".mli") then exe !ocamlc ["-c"; file^".mli"]; compile !ocamlc file end; let lib_cmos = List.map d.mls ~f:(fun nm -> nm ^".cmo") in exe !ocamlc (Printf.sprintf "-a -o %s.cma -cclib -l%s -dllib -l%s" d.name d.cname d.cname :: ("-cclib \""^d.libs^"\"") :: lib_cmos); List.iter lib_cmos ~f:may_remove; let msname = "lib"^d.cname^".lib" and mgname = "lib"^d.cname^".a" in if !ccomp_type = "msvc" then begin if Sys.file_exists mgname && not (Sys.file_exists msname) then begin Printf.eprintf "This is a MSVC port. Renaming %s to %s\n" mgname msname; Sys.rename mgname msname end; end else begin if Sys.file_exists msname && not (Sys.file_exists mgname) then begin Printf.eprintf "This is a Mingw port. Renaming %s to %s\n" msname mgname; Sys.rename msname mgname end; end end let native d = if d.mls <> [] then begin List.iter (d.mls @ d.extra) ~f:(compile ~comp:!ocamlopt); let lib_cmxs = List.map d.mls ~f:(fun nm -> nm ^ ".cmx") in exe !ocamlopt (Printf.sprintf "-a -o %s.cmxa -cclib -l%s" d.name d.cname :: ("-cclib \""^d.libs^"\"") :: lib_cmxs); List.iter d.mls ~f:(fun nm -> may_remove (nm ^ ".obj"); may_remove (nm ^ ".o")) end let () = try let arg = if Array.length Sys.argv > 1 then Sys.argv.(1) else "" in if arg <> "" && arg <> "byte" && arg <> "opt" then begin prerr_endline "ocaml build.ml [ byte | opt | link ]"; prerr_endline " byte build bytecode library only"; prerr_endline " opt build both bytecode and native (default)"; exit 2 end; List.iter byte libs; if arg = "opt" || arg <> "byte" then begin try List.iter native libs with Failure err -> prerr_endline ("Native build failed: " ^ err); prerr_endline "You can still use the bytecode version" end; List.iter prop_mls ~f:(fun nm -> may_remove (nm ^ ".cmi"); may_remove (nm ^ ".cmx")); if !ccomp_type = "msvc" then prerr_endline "Now ready to use on an OCaml MSVC port" else prerr_endline "Now ready to use on an OCaml Mingw port" with Failure err -> prerr_endline ("Bytecode failed: " ^ err) lablgtk-2.18.8/src/gMenu.ml0000644000175000017500000002421613460263323014465 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkData open GtkBase open GtkMenu open OgtkBaseProps open OgtkMenuProps open GObj open GContainer (* Menu type *) class menu_shell_signals obj = object (self) inherit container_signals_impl obj method deactivate = self#connect MenuShell.S.deactivate end class type virtual ['a] pre_menu = object inherit ['a] item_container method as_menu : Gtk.menu Gtk.obj method deactivate : unit -> unit method connect : menu_shell_signals method event : event_ops method popup : button:int -> time:int32 -> unit method popdown : unit -> unit method set_accel_group : accel_group -> unit method set_accel_path : string -> unit end (* Menu items *) class menu_item_signals obj = object (self) inherit container_signals_impl (obj : [>menu_item] obj) inherit item_sigs method activate = self#connect MenuItem.S.activate end class ['a] pre_menu_item_skel obj = object inherit container obj method as_item = (obj :> Gtk.menu_item obj) method set_submenu (w : 'a pre_menu) = MenuItem.set_submenu obj w#as_menu method remove_submenu () = MenuItem.remove_submenu obj method get_submenu = match MenuItem.get_submenu obj with | None -> None | Some w -> Some (new GObj.widget w) method activate () = MenuItem.activate obj method select () = MenuItem.select obj method deselect () = MenuItem.deselect obj method set_right_justified = MenuItem.set_right_justified obj method right_justified = MenuItem.get_right_justified obj method add_accelerator ~group ?modi:m ?flags key= Widget.add_accelerator obj ~sgn:MenuItem.S.activate group ?flags ?modi:m ~key end class menu_item obj = object inherit [menu_item] pre_menu_item_skel obj method connect = new menu_item_signals obj method event = new GObj.event_ops obj end class menu_item_skel = [menu_item] pre_menu_item_skel let pack_item ?packing ?(show=true) self = may packing ~f:(fun f -> (f (self :> menu_item) : unit)); if show then self#misc#show (); self let menu_item ?use_mnemonic ?label ?right_justified ?packing ?show () = let w = MenuItem.create ?use_mnemonic ?label () in may right_justified ~f:(MenuItem.set_right_justified w); pack_item (new menu_item w) ?packing ?show let tearoff_item ?packing ?show () = let w = MenuItem.tearoff_create () in pack_item (new menu_item w) ?packing ?show let separator_item ?packing ?show () = let w = MenuItem.separator_create () in pack_item (new menu_item w) ?packing ?show class image_menu_item obj = object inherit menu_item_skel (obj : Gtk.image_menu_item obj) method set_image w = set ImageMenuItem.P.image obj (as_widget w) method image = new widget (get ImageMenuItem.P.image obj) method connect = new menu_item_signals obj method event = new GObj.event_ops obj end let image_menu_item ?image ?label ?(use_mnemonic=false) ?stock ?right_justified ?packing ?show () = let w = ImageMenuItem.create ?label ?stock ~use_mnemonic () in may right_justified ~f:(MenuItem.set_right_justified w); may image ~f:(fun im -> set ImageMenuItem.P.image w im#as_widget); pack_item (new image_menu_item w) ?packing ?show class check_menu_item_signals obj = object (self) inherit menu_item_signals obj method toggled = self#connect CheckMenuItem.S.toggled end class check_menu_item obj = object inherit menu_item_skel obj method set_active = set CheckMenuItem.P.active obj method set_inconsistent = set CheckMenuItem.P.inconsistent obj method inconsistent = get CheckMenuItem.P.inconsistent obj method set_show_toggle = CheckMenuItem.set_show_toggle obj method active = get CheckMenuItem.P.active obj method toggled () = CheckMenuItem.toggled obj method connect = new check_menu_item_signals obj method event = new GObj.event_ops obj end let check_menu_item ?label ?use_mnemonic ?active ?show_toggle ?right_justified ?packing ?show () = let w = CheckMenuItem.create ?use_mnemonic ?label () in CheckMenuItem.set w ?active ?show_toggle ?right_justified; pack_item (new check_menu_item w) ?packing ?show class radio_menu_item obj = object inherit check_menu_item (obj : Gtk.radio_menu_item obj) method group = Some obj method set_group = RadioMenuItem.set_group obj end let radio_menu_item ?group ?label ?use_mnemonic ?active ?show_toggle ?right_justified ?packing ?show () = let w = RadioMenuItem.create ?use_mnemonic ?group ?label () in CheckMenuItem.set w ?active ?show_toggle ?right_justified; pack_item (new radio_menu_item w) ?packing ?show (* Menus *) class menu_shell obj = object inherit [menu_item] item_container obj method private wrap w = new menu_item (MenuItem.cast w) method insert w = MenuShell.insert obj w#as_item method deactivate () = MenuShell.deactivate obj method connect = new menu_shell_signals obj method event = new GObj.event_ops obj end class menu obj = object inherit menu_shell obj method popup = Menu.popup obj method popdown () = Menu.popdown obj method as_menu : Gtk.menu obj = obj method set_accel_group = Menu.set_accel_group obj method set_accel_path = Menu.set_accel_path obj end let menu ?accel_path ?border_width ?packing ?show () = let w = Menu.create [] in may border_width ~f:(set Container.P.border_width w); may accel_path ~f:(fun ap -> Menu.set_accel_path w ap); let self = new menu w in may packing ~f:(fun f -> (f self : unit)); if show <> Some false then self#misc#show (); self (* Option Menu (GtkButton?) *) class option_menu obj = object inherit GButton.button_skel obj method connect = new GButton.button_signals obj method set_menu (menu : menu) = set OptionMenu.P.menu obj menu#as_menu method get_menu = new menu (get OptionMenu.P.menu obj) method remove_menu () = OptionMenu.remove_menu obj method set_history = OptionMenu.set_history obj end let option_menu ?menu = let pl = match menu with None -> [] | Some m -> [Gobject.param OptionMenu.P.menu m#as_menu] in GContainer.pack_container pl ~create: (fun pl -> new option_menu (OptionMenu.create pl)) (* Menu Bar *) let menu_bar = pack_container [] ~create:(fun p -> new menu_shell (MenuBar.create p)) (* Menu Factory *) class ['a] factory ?(accel_group=AccelGroup.create ()) ?(accel_path="/") ?(accel_modi=[`CONTROL]) ?(accel_flags=[`VISIBLE]) (menu_shell : 'a) = object (self) val menu_shell : #menu_shell = menu_shell val group = accel_group val m = accel_modi val flags = (accel_flags:Gtk.Tags.accel_flag list) val accel_path = accel_path method menu = menu_shell method accel_group = group method private bind ?(modi=m) ?key ?callback (item : menu_item) label = menu_shell#append item; let accel_path = accel_path ^ label ^ "/" in (* Default accel path value *) GtkData.AccelMap.add_entry accel_path ?key ~modi:m; (* Register this accel path *) GtkBase.Widget.set_accel_path item#as_widget accel_path accel_group; may callback ~f:(fun callback -> item#connect#activate ~callback) method add_item ?key ?callback ?submenu label = let item = menu_item ~use_mnemonic:true ~label () in self#bind item ?key ?callback label; may (submenu : menu option) ~f:item#set_submenu; item method add_image_item ?(image : widget option) ?key ?callback ?stock ?label () = let item = image_menu_item ~use_mnemonic:true ?image ?label ?stock () in match stock with | None -> self#bind (item : image_menu_item :> menu_item) ?key ?callback (default "/" ~opt:label); item | Some s -> try let st = GtkStock.Item.lookup s in self#bind (item : image_menu_item :> menu_item) ?key:(if st.GtkStock.keyval=0 then key else None) ?callback (default "/" ~opt:label); item with Not_found -> item method add_check_item ?active ?key ?callback label = let item = check_menu_item ~label ~use_mnemonic:true ?active () in self#bind (item : check_menu_item :> menu_item) label ?key ?callback:(may_map callback ~f:(fun f () -> f item#active)); item method add_radio_item ?group ?active ?key ?callback label = let item = radio_menu_item ~label ~use_mnemonic:true ?group ?active () in self#bind (item : radio_menu_item :> menu_item) label ?key ?callback:(may_map callback ~f:(fun f () -> f item#active)); item method add_separator () = separator_item ~packing:menu_shell#append () method add_submenu ?key label = let item = menu_item ~use_mnemonic:true ~label () in self#bind item ?key label; menu ~packing:item#set_submenu () method add_tearoff () = tearoff_item ~packing:menu_shell#append () end lablgtk-2.18.8/src/gEdit.ml0000644000175000017500000002556313460263323014454 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open GtkBase open GtkEdit open OgtkEditProps open GObj class editable_signals obj = object inherit widget_signals_impl (obj : [>editable] obj) inherit editable_sigs end class editable obj = object inherit ['a] widget_impl obj method select_region = Editable.select_region obj method insert_text = Editable.insert_text obj method delete_text = Editable.delete_text obj method get_chars = Editable.get_chars obj method cut_clipboard () = Editable.cut_clipboard obj method copy_clipboard () = Editable.copy_clipboard obj method paste_clipboard () = Editable.paste_clipboard obj method delete_selection () = Editable.delete_selection obj method set_position = Editable.set_position obj method position = Editable.get_position obj method set_editable = Editable.set_editable obj method editable = Editable.get_editable obj method selection = Editable.get_selection_bounds obj end class entry_completion_signals obj = object (self) inherit [[> `entrycompletion]] GObj.gobject_signals obj method action_activated = self#connect EntryCompletion.S.action_activated method match_selected ~callback = self#connect EntryCompletion.S.match_selected ~callback:(fun model iter -> callback (new GTree.model_filter model) iter) end class entry_completion obj = object method as_entry_completion = (obj :> Gtk.entry_completion) method set_minimum_key_length = Gobject.set EntryCompletion.P.minimum_key_length obj method minimum_key_length = Gobject.get EntryCompletion.P.minimum_key_length obj method set_model (m : GTree.model) = Gobject.set EntryCompletion.P.model obj m#as_model method model = (* not compliant with Comment #1 in Gtk bug http://bugzilla.gnome.org/show_bug.cgi?555087 new GTree.model_filter (Gobject.try_cast (Gobject.get EntryCompletion.P.model obj) "GtkTreeModelFilter") *) new GTree.model (Gobject.get EntryCompletion.P.model obj) method misc = new GObj.gobject_ops obj method connect = new entry_completion_signals obj method get_entry = may_map (new GObj.widget) (EntryCompletion.get_entry obj) method complete () = EntryCompletion.complete obj method insert_action_text = EntryCompletion.insert_action_text obj method insert_action_markup = EntryCompletion.insert_action_markup obj method delete_action = EntryCompletion.delete_action obj method set_text_column c = EntryCompletion.set_text_column obj (c : string GTree.column).GTree.index method set_match_func = EntryCompletion.set_match_func obj inherit GTree.cell_layout obj val obj = obj end class entry_signals obj = object (self) inherit editable_signals obj inherit entry_sigs method populate_popup ~callback = self#connect Entry.S.populate_popup ~callback: (fun m -> callback (new GMenu.menu m)) end class entry obj = object inherit editable obj method connect = new entry_signals obj inherit entry_props method as_entry = (obj :> Gtk.entry obj) method event = new GObj.event_ops obj method append_text = Entry.append_text obj method prepend_text = Entry.prepend_text obj method text_length = Entry.text_length obj method get_completion = may_map (new entry_completion) (Entry.get_completion obj) method set_completion (c : entry_completion) = Entry.set_completion obj c#as_entry_completion method set_primary_icon_name s = set Entry.P.primary_icon_name obj (if s = "" then None else Some s) method set_secondary_icon_name s = set Entry.P.secondary_icon_name obj (if s = "" then None else Some s) end let pack_sized ~create pl = Widget.size_params pl ~cont: (fun pl ?packing ?show () -> pack_return (create pl) ~packing ~show) let entry = Entry.make_params [] ~cont:( pack_sized ~create:(fun pl -> new entry (Entry.create pl))) let entry_completion ?model = EntryCompletion.make_params [] ?model:(may_map (fun m -> m#as_model) model) ~cont:(fun pl ?entry () -> let c = new entry_completion (EntryCompletion.create pl) in may (fun e -> e#set_completion c) entry ; c) class spin_button_signals obj = object inherit entry_signals obj inherit spin_button_sigs end class spin_button obj = object inherit [Gtk.spin_button] widget_impl obj method connect = new spin_button_signals obj method event = new event_ops obj inherit spin_button_props method value_as_int = SpinButton.get_value_as_int obj method spin = SpinButton.spin obj method update = SpinButton.update obj end let spin_button ?adjustment = SpinButton.make_params [] ?adjustment:(may_map ~f:GData.as_adjustment adjustment) ~cont:( pack_sized ~create:(fun pl -> new spin_button (SpinButton.create pl))) class combo obj = object inherit [Gtk.combo] widget_impl obj inherit combo_props method entry = new entry (Combo.entry obj) method list = new GList.liste (Combo.list obj) method set_popdown_strings = Combo.set_popdown_strings obj method disable_activate () = Combo.disable_activate obj method set_item_string (item : GList.list_item) = Combo.set_item_string obj item#as_item end let combo ?popdown_strings = Combo.make_params [] ~cont:( GContainer.pack_container ~create:(fun pl -> let w = Combo.create pl in may (Combo.set_popdown_strings w) popdown_strings; new combo w)) class combo_box_signals obj = object inherit GContainer.container_signals_impl (obj :> Gtk.combo_box Gtk.obj) inherit OgtkEditProps.combo_box_sigs end class combo_box _obj = object inherit [[> Gtk.combo_box]] GContainer.bin_impl _obj inherit OgtkEditProps.combo_box_props inherit GTree.cell_layout _obj method event = new GObj.event_ops obj method connect = new combo_box_signals obj method model = new GTree.model (Gobject.get GtkEdit.ComboBox.P.model obj) method set_model (m : GTree.model) = Gobject.set GtkEdit.ComboBox.P.model obj m#as_model method set_row_span_column (col : int GTree.column) = Gobject.set GtkEdit.ComboBox.P.row_span_column obj col.GTree.index method set_column_span_column (col : int GTree.column) = Gobject.set GtkEdit.ComboBox.P.column_span_column obj col.GTree.index method active_iter = GtkEdit.ComboBox.get_active_iter obj method set_active_iter = GtkEdit.ComboBox.set_active_iter obj method set_row_separator_func fo = GtkEdit.ComboBox.set_row_separator_func obj (Gaux.may_map (fun f m -> f (new GTree.model m)) fo) end let combo_box ?model = let model = Gaux.may_map (fun m -> m#as_model) model in GtkEdit.ComboBox.make_params ?model [] ~cont:( GtkBase.Widget.size_params ~cont:(fun pl ?packing ?show () -> let c = new combo_box (GtkEdit.ComboBox.create pl) in GObj.pack_return c ~packing ~show)) class combo_box_entry _obj = object (self) inherit combo_box _obj method text_column = let model_id = Gobject.get_oid (Gobject.get GtkEdit.ComboBox.P.model _obj) in let col_list_id = try Hashtbl.find GTree.model_ids model_id with Not_found -> 0 in { GTree.index = Gobject.get GtkEdit.ComboBoxEntry.P.text_column _obj ; GTree.conv = Gobject.Data.string ; GTree.creator = col_list_id } method set_text_column (col : string GTree.column) = let model_id = Gobject.get_oid (Gobject.get GtkEdit.ComboBox.P.model _obj) in begin try if Hashtbl.find GTree.model_ids model_id <> col.GTree.creator then invalid_arg "combo_box_entry#set_text_column: bad column" with Not_found -> () end ; Gobject.set GtkEdit.ComboBoxEntry.P.text_column obj col.GTree.index method entry = new entry (GtkEdit.Entry.cast self#child#as_widget) end let combo_box_entry ?model ?text_column = let model = Gaux.may_map (fun m -> m#as_model) model in GtkEdit.ComboBox.make_params ?model (Gobject.Property.may_cons GtkEdit.ComboBoxEntry.P.text_column (Gaux.may_map (fun c -> c.GTree.index) text_column) []) ~cont:( GtkBase.Widget.size_params ~cont:(fun pl ?packing ?show () -> GObj.pack_return (new combo_box_entry (GtkEdit.ComboBoxEntry.create pl)) ~packing ~show )) type 'a text_combo = 'a * (GTree.list_store * string GTree.column) constraint 'a = #combo_box let text_combo_add ((_, (lstore, column)) : 'a text_combo) str = let row = lstore#append () in lstore#set ~row ~column str let text_combo_get_active ((combo, (lstore, column)) : 'a text_combo) = match combo#active_iter with | None -> None | Some row -> Some (lstore#get ~row ~column) let combo_box_text ?(strings=[]) ?(use_markup=false) = let (store, column) as model = GTree.store_of_list Gobject.Data.string strings in GtkEdit.ComboBox.make_params ~model:store#as_model [] ~cont:( GtkBase.Widget.size_params ~cont:(fun pl ?packing ?show () -> let combo = new combo_box (GtkEdit.ComboBox.create pl) in let r = GTree.cell_renderer_text [] in combo#pack r ; combo#add_attribute r (if use_markup then "markup" else "text") column ; GObj.pack_return combo ~packing ~show, model)) let combo_box_entry_text ?(strings=[]) = let (store, column) as model = GTree.store_of_list Gobject.Data.string strings in GtkEdit.ComboBox.make_params ~model:store#as_model [ Gobject.param GtkEdit.ComboBoxEntry.P.text_column column.GTree.index ] ~cont:( GtkBase.Widget.size_params ~cont:(fun pl ?packing ?show () -> let combo = new combo_box_entry (GtkEdit.ComboBoxEntry.create pl) in GObj.pack_return combo ~packing ~show, model)) lablgtk-2.18.8/src/gtkSpell.ml0000644000175000017500000000540413460263323015175 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) type error = BACKEND exception Error of error * string external _init : unit -> unit = "ml_gtkspell_init" let () = _init () ; Callback.register_exception "gtkspell_error" (Error (BACKEND, "")) (* unsafe! lifecycle of the GtkSpell struct is tied to the GtkTextView *) type t external _new_attach : Gtk.text_view Gtk.obj -> string option -> unit = "ml_gtkspell_new_attach" external _is_attached : Gtk.text_view Gtk.obj -> bool = "ml_gtkspell_is_attached" external _get_from_text_view : Gtk.text_view Gtk.obj -> t option = "ml_gtkspell_get_from_text_view" external _detach : t -> unit = "ml_gtkspell_detach" external _set_language : t -> string option -> unit = "ml_gtkspell_set_language" external _recheck_all : t -> unit = "ml_gtkspell_recheck_all" let attach ?lang view = _new_attach view#as_view lang let is_attached view = _is_attached view#as_view let detach view = match _get_from_text_view view#as_view with | None -> () | Some s -> _detach s let recheck_all view = match _get_from_text_view view#as_view with | None -> () | Some s -> _recheck_all s let set_language view lang = match _get_from_text_view view#as_view with | None -> () | Some s -> _set_language s lang lablgtk-2.18.8/src/gtkMenu.ml0000644000175000017500000001143713460263323015025 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkMenuProps open GtkBase external _gtkmenu_init : unit -> unit = "ml_gtkmenu_init" let () = _gtkmenu_init () module MenuItem = struct include MenuItem external create_with_label : string -> menu_item obj = "ml_gtk_menu_item_new_with_label" external create_with_mnemonic : string -> menu_item obj = "ml_gtk_menu_item_new_with_mnemonic" external separator_create : unit -> menu_item obj = "ml_gtk_separator_menu_item_new" external tearoff_create : unit -> menu_item obj = "ml_gtk_tearoff_menu_item_new" let create ?(use_mnemonic=false) ?label () = match label with None -> create [] | Some label -> if use_mnemonic then create_with_mnemonic label else create_with_label label end module ImageMenuItem = struct include ImageMenuItem external create_with_label : string -> image_menu_item obj = "ml_gtk_image_menu_item_new_with_label" external create_with_mnemonic : string -> image_menu_item obj = "ml_gtk_image_menu_item_new_with_mnemonic" external create_from_stock : string -> accel_group option -> image_menu_item obj = "ml_gtk_image_menu_item_new_from_stock" let create_from_stock ?accel_group s = create_from_stock (GtkStock.convert_id s) accel_group let create ?label ?(use_mnemonic=false) ?stock ?accel_group () = match stock with | None -> begin match label with | None -> create [] | Some l -> if use_mnemonic then create_with_mnemonic l else create_with_label l end | Some s -> create_from_stock ?accel_group s end module CheckMenuItem = struct include CheckMenuItem external create_with_label : string -> check_menu_item obj = "ml_gtk_check_menu_item_new_with_label" external create_with_mnemonic : string -> check_menu_item obj = "ml_gtk_check_menu_item_new_with_mnemonic" let create ?(use_mnemonic=false) ?label () = match label with None -> create [] | Some label -> if use_mnemonic then create_with_mnemonic label else create_with_label label let set ?active ?show_toggle ?right_justified w = may active ~f:(set P.active w); may show_toggle ~f:(set_show_toggle w); may right_justified ~f:(MenuItem.set_right_justified w) end module RadioMenuItem = struct include RadioMenuItem external create : radio_menu_item group -> radio_menu_item obj = "ml_gtk_radio_menu_item_new" external create_with_label : radio_menu_item group -> string -> radio_menu_item obj = "ml_gtk_radio_menu_item_new_with_label" external create_with_mnemonic : radio_menu_item group -> string -> radio_menu_item obj = "ml_gtk_radio_menu_item_new_with_mnemonic" let create ?(group = None) ?(use_mnemonic=false) ?label () = match label with None -> create group | Some label -> if use_mnemonic then create_with_mnemonic group label else create_with_label group label end module OptionMenu = OptionMenu module MenuShell = MenuShell module Menu = struct include Menu let popup ?parent_menu ?parent_item w = popup w (Gpointer.optboxed parent_menu) (Gpointer.optboxed parent_item) let set ?active ?accel_group w = may active ~f:(set_active w); may accel_group ~f:(set_accel_group w) end module MenuBar = MenuBar lablgtk-2.18.8/src/panel.mli0000644000175000017500000000621013460263323014654 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** Writing panel applets @gtkdoc panel-applet panelapplet *) type panel_applet = [ `panelapplet | Gtk.event_box] type flags = [ `EXPAND_MAJOR | `EXPAND_MINOR | `HAS_HANDLE] type background_type = [ | `NO_BACKGROUND | `COLOR_BACKGROUND of Gdk.color | `PIXMAP_BACKGROUND of Gdk.pixmap ] type orient_type = [ `UP | `DOWN | `LEFT | `RIGHT ] type verb = string * (string -> unit) (** @gtkdoc panel-applet panelapplet *) class applet_signals : panel_applet Gtk.obj -> object inherit GContainer.container_signals val obj : panel_applet Gtk.obj method change_background : callback:(background_type -> unit) -> GtkSignal.id method change_orient : callback:(orient_type -> unit) -> GtkSignal.id method change_size : callback:(int -> unit) -> GtkSignal.id method move_focus_out_of_applet : callback:(GtkEnums.direction_type -> unit) -> GtkSignal.id end (** @gtkdoc panel-applet panelapplet *) class applet : ([> panel_applet] as 'a) Gtk.obj -> object inherit GContainer.bin val obj : 'a Gtk.obj method connect : applet_signals method event : GObj.event_ops method get_background : background_type method get_orient : orient_type method get_size : int method get_flags : flags list method set_flags : flags list -> unit method setup_menu : xml:string -> verb list -> unit method setup_menu_from_file : ?dir:string -> file:string -> ?app_name:string -> verb list -> unit end (** A generic 'main' routine for applets. *) val factory_main : iid:string -> (applet -> iid:string -> bool) -> bool lablgtk-2.18.8/src/gtkdoc.ml0000644000175000017500000001130413460263323014657 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) let default_base_uri = "http://developer.gnome.org/gtk2/stable" let base_uri = ref default_base_uri let _ = Odoc_args.add_option ("-base-uri", Arg.String ((:=) base_uri), "base URI of the GTK/GNOME documentation") let may ov f = match ov with | None -> () | Some v -> f v (* ocamldoc generates tons of tags. This seriously inflates the size of the HTML pages so here we redefine the function to only define the 'Start' 'next' and 'Up' links. *) let make_prepare_header style index module_list = fun b ?(nav=None) ?(comments=[]) t -> let link l dest = Printf.bprintf b "\n" l dest in let link_file l dest = link l (fst (Odoc_html.Naming.html_files dest)) in Buffer.add_string b "\n" ; Buffer.add_string b style ; link "Start" index ; may nav (fun (pre_opt, post_opt, name) -> may pre_opt (link_file "previous") ; may post_opt (link_file "next") ; match Odoc_info.Name.father name with | "" -> link "Up" index | s -> link_file "Up" s ) ; Printf.bprintf b "%s\n\n" t let gtkdoc = function | Odoc_info.Raw name :: _ -> begin match Str.split (Str.regexp "[ \t]+") name with | dir :: widget :: _ -> let dir = if !base_uri = default_base_uri then dir ^ "/stable" else dir in Printf.sprintf "GTK documentation: \ %s\ " !base_uri dir widget widget | _ -> failwith "bad @gtkdoc format" end | _ -> failwith "bad @gtkdoc format" open Odoc_info.Value open Odoc_info.Module IFDEF OCAML_400 THEN module Generator (G : Odoc_html.Html_generator) = struct class html = object (self) inherit G.html as super method prepare_header module_list = header <- make_prepare_header style self#index module_list method html_of_class b ?complete ?with_link c = super#html_of_class b ?complete ?with_link c ; Buffer.add_string b "
" initializer tag_functions <- ("gtkdoc", gtkdoc) :: tag_functions end end let _ = Odoc_args.extend_html_generator (module Generator : Odoc_gen.Html_functor) ELSE class gtkdoc = object (self) inherit Odoc_html.html as super method html_of_value b v = v.val_code <- None ; super#html_of_value b v method html_of_attribute b a = a.att_value.val_code <- None ; super#html_of_attribute b a method html_of_method b m = m.met_value.val_code <- None ; super#html_of_method b m method generate_for_module pre post modu = modu.m_code <- None ; super#generate_for_module pre post modu method prepare_header module_list = header <- make_prepare_header style self#index module_list method html_of_class b ?complete ?with_link c = super#html_of_class b ?complete ?with_link c ; Buffer.add_string b "
" initializer tag_functions <- ("gtkdoc", gtkdoc) :: tag_functions end let _ = Odoc_info.Args.set_doc_generator (Some (new gtkdoc :> Odoc_info.Args.doc_generator)) END lablgtk-2.18.8/src/ml_gtktree.h0000644000175000017500000000426413460263323015367 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #define GtkTreeIter_val(val) ((GtkTreeIter*)MLPointer_val(val)) #define Val_GtkTreeIter(it) (copy_memblock_indirected(it,sizeof(GtkTreeIter))) #define GtkTreeIter_optval(v) Option_val(v, GtkTreeIter_val, NULL) #define GtkTreePath_optval(v) Option_val(v, GtkTreePath_val, NULL) #define GtkTreeModel_optval(v) Option_val(v, GtkTreeModel_val, NULL) #define GtkCellRenderer_optval(v) Option_val(v, GtkCellRenderer_val, NULL) #define GtkTreeViewColumn_optval(v) Option_val(v, GtkTreeViewColumn_val, NULL) gboolean ml_gtk_row_separator_func (GtkTreeModel *model, GtkTreeIter *iter, gpointer data); lablgtk-2.18.8/src/ml_gobject.c0000644000175000017500000005255013460263323015333 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gvaluecaml.h" #include "gobject_tags.h" #include "gobject_tags.c" /* gobject.h */ static GQueue objects_to_unref; /* initialized to zeroes (empty queue) */ CAMLprim value ml_g_object_do_unref (value unit) { while (! g_queue_is_empty (&objects_to_unref)) { gpointer d = g_queue_pop_tail (&objects_to_unref); g_object_unref (G_OBJECT (d)); } return Val_unit; } CAMLexport void ml_g_object_unref_later (GObject *p) { g_queue_push_head (&objects_to_unref, p); } Make_Val_final_pointer(GObject, g_object_ref, ml_g_object_unref_later, 0) Make_Val_final_pointer_ext (GObject, _new, Ignore, ml_g_object_unref_later, 20) ML_1 (G_TYPE_FROM_INSTANCE, GObject_val, Val_GType) // ML_1 (g_object_ref, GObject_val, Unit) CAMLprim value ml_g_object_unref (value val) { if (Field(val,1)) g_object_unref (GObject_val(val)); Field(val,1) = 0; return Val_unit; } Make_Extractor(g_object, GObject_val, ref_count, Val_int) ML_1 (g_object_freeze_notify, GObject_val, Unit) ML_1 (g_object_thaw_notify, GObject_val, Unit) ML_2 (g_object_notify, GObject_val, String_val, Unit) ML_3 (g_object_set_property, GObject_val, String_val, GValue_val, Unit) ML_3 (g_object_get_property, GObject_val, String_val, GValue_val, Unit) static GType my_g_object_get_property_type(GObject *obj, const char *prop) { GParamSpec *pspec = g_object_class_find_property (G_OBJECT_GET_CLASS(obj), prop); if (pspec == NULL) { g_warning("LablGtk tried to access the unsupported property %s",prop); caml_invalid_argument(prop); } return pspec->value_type; } ML_2 (my_g_object_get_property_type, GObject_val, String_val, Val_GType) static GType internal_g_object_get_property_type(GObject *obj, const char *prop) { GParamSpec *pspec = g_object_class_find_property (G_OBJECT_GET_CLASS(obj), prop); if (pspec == NULL) { g_warning("LablGtk tried to access the unsupported property %s",prop); return G_TYPE_INVALID; } return pspec->value_type; } /* gtype.h */ ML_0 (g_type_init, Unit) ML_1 (g_type_name, GType_val, Val_string) ML_1 (g_type_from_name, String_val, Val_GType) ML_1 (g_type_parent, GType_val, Val_GType) ML_1 (g_type_depth, GType_val, Val_int) ML_2 (g_type_is_a, GType_val, GType_val, Val_bool) ML_1 (G_TYPE_FUNDAMENTAL, GType_val, Val_fundamental_type) ML_1 (Fundamental_type_val, (value), Val_GType) #ifdef HASGTK22 CAMLprim value ml_g_type_interface_prerequisites(value type) { value res = Val_unit; CAMLparam1(res); CAMLlocal1(tmp); guint n; GType *intf = g_type_interface_prerequisites(GType_val(type), &n); while (n-- > 0) { tmp = res; res = alloc_small(2,0); Field(res,0) = Val_GType(intf[n]); Field(res,1) = tmp; } CAMLreturn(res); } #else Unsupported(g_type_interface_prerequisites) #endif CAMLprim value ml_g_type_register_static(value parent_type, value type_name) { GTypeQuery query; GType derived, parent; parent = GType_val (parent_type); g_type_query (parent, &query); if (query.type == G_TYPE_INVALID) failwith ("g_type_register_static: invalid parent g_type"); { const GTypeInfo info = { query.class_size, NULL, /* base_init */ NULL, /* base_finalize */ NULL, /* class_init */ NULL, /* class_finalize */ NULL, /* class_data */ query.instance_size, 0, /* n_preallocs */ NULL, /* instance_init */ NULL }; /* the contents of the GTypeInfo struct seem to be copied, so it should be ok to use a not really static one (ie one on the stack) */ derived = g_type_register_static(parent, String_val(type_name), &info, 0); } return Val_GType (derived); } /* gclosure.h */ Make_Val_final_pointer(GClosure, g_closure_ref, g_closure_unref, 0) #define g_closure_ref_and_sink(w) (g_closure_ref(w), g_closure_sink(w)) Make_Val_final_pointer_ext(GClosure, _sink , g_closure_ref_and_sink, g_closure_unref, 20) static void notify_destroy(gpointer unit, GClosure *c) { // printf("release %p\n", &c->data); remove_global_root((value*)&c->data); } static void marshal (GClosure *closure, GValue *ret, guint nargs, const GValue *args, gpointer hint, gpointer marshall_data) { value vargs = alloc(3,0); CAMLparam1 (vargs); Store_field(vargs, 0, (ret ? Val_GValue_wrap(ret) : alloc(2,0))); Store_field(vargs, 1, Val_int(nargs)); Store_field(vargs, 2, Val_GValue_wrap((GValue*)args)); callback_exn ((value)closure->data, vargs); CAMLreturn0; } CAMLprim value ml_g_closure_new (value clos) { GClosure* closure = g_closure_new_simple(sizeof(GClosure), (gpointer)clos); // printf("register %p\n", &closure->data); register_global_root((value*)&closure->data); g_closure_add_invalidate_notifier(closure, NULL, notify_destroy); g_closure_set_marshal(closure, marshal); return Val_GClosure_sink(closure); } /* gvalue.h / gparamspec.h */ static void ml_final_GValue (value val) { GValue *gv = GValueptr_val(val); if (gv != NULL && gv->g_type != 0) g_value_unset(gv); } static struct custom_operations ml_custom_GValue = { "GValue/2.0/", ml_final_GValue, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; CAMLprim value ml_g_value_new(void) { value ret = alloc_custom(&ml_custom_GValue, sizeof(value)+sizeof(GValue), 20, 1000); /* create an MLPointer */ Field(ret,1) = (value)2; ((GValue*)&Field(ret,2))->g_type = 0; return ret; } CAMLprim value Val_GValue_copy(GValue *gv) { value ret = ml_g_value_new(); *((GValue*)&Field(ret,2)) = *gv; return ret; } CAMLprim value ml_g_value_release(value val) { ml_final_GValue (val); Store_pointer(val,NULL); return Val_unit; } CAMLprim GValue* GValue_val(value val) { void *v = MLPointer_val(val); if (v == NULL) invalid_argument("GValue_val"); return (GValue*)v; } ML_1 (G_VALUE_TYPE, GValue_val, Val_GType) ML_2 (g_value_init, GValue_val, GType_val, Unit) ML_2 (g_value_copy, GValue_val, GValue_val, Unit) ML_1 (g_value_reset, GValue_val, Unit) ML_2 (g_value_type_compatible, GType_val, GType_val, Val_bool) ML_2 (g_value_type_transformable, GType_val, GType_val, Val_bool) ML_2 (g_value_transform, GValue_val, GValue_val, Val_bool) CAMLprim value ml_g_value_shift (value args, value index) { return Val_GValue_wrap (&GValue_val(args)[Int_val(index)]); } /* gboxed finalization */ static void ml_final_gboxed (value val) { gpointer p = Pointer_val(val); if (p != NULL) g_boxed_free ((GType)Field(val,2), p); p = NULL; } static struct custom_operations ml_custom_gboxed = { "gboxed/2.0/", ml_final_gboxed, custom_compare_default, custom_hash_default, custom_serialize_default, custom_deserialize_default }; CAMLprim value Val_gboxed(GType t, gpointer p) { value ret = alloc_custom(&ml_custom_gboxed, 2*sizeof(value), 10, 1000); Store_pointer(ret, g_boxed_copy (t,p)); Field(ret,2) = (value)t; return ret; } CAMLprim value Val_gboxed_new(GType t, gpointer p) { value ret = alloc_custom(&ml_custom_gboxed, 2*sizeof(value), 10, 1000); Store_pointer(ret, p); Field(ret,2) = (value)t; return ret; } /* Read/Write a value */ #define DATA (val->data[0]) static value g_value_get_mlvariant (GValue *val) { CAMLparam0(); CAMLlocal1(tmp); value ret = MLTAG_NONE; GType type; value tag = (value)0; if (! G_IS_VALUE(val)) invalid_argument("Gobject.Value.get"); type = G_VALUE_TYPE(val); switch (G_TYPE_FUNDAMENTAL(type)) { /* This is such a pain that we access the data directly :-( */ /* We do like in gvaluetypes.c */ case G_TYPE_CHAR: case G_TYPE_UCHAR: tag = MLTAG_CHAR; tmp = Val_int(DATA.v_int); break; case G_TYPE_BOOLEAN: tag = MLTAG_BOOL; tmp = Val_bool(DATA.v_int); break; case G_TYPE_INT: case G_TYPE_UINT: tag = MLTAG_INT; tmp = Val_int (DATA.v_int); break; case G_TYPE_LONG: case G_TYPE_ULONG: case G_TYPE_ENUM: case G_TYPE_FLAGS: tag = MLTAG_INT; tmp = Val_long (DATA.v_long); break; case G_TYPE_FLOAT: tag = MLTAG_FLOAT; tmp = copy_double ((double)DATA.v_float); break; case G_TYPE_DOUBLE: tag = MLTAG_FLOAT; tmp = copy_double (DATA.v_double); break; case G_TYPE_STRING: tag = MLTAG_STRING; tmp = Val_option (DATA.v_pointer, copy_string); break; case G_TYPE_INTERFACE: /* assume interfaces are for objects */ case G_TYPE_OBJECT: tag = MLTAG_OBJECT; tmp = Val_option ((GObject*)DATA.v_pointer, Val_GObject); break; case G_TYPE_BOXED: if (type == G_TYPE_CAML) { value *data = g_value_get_boxed (val); if (data != NULL) { tag = MLTAG_CAML; tmp = *data; } } else { tag = MLTAG_POINTER; tmp = (DATA.v_pointer == NULL ? Val_unit : ml_some(Val_gboxed(type, DATA.v_pointer))); } break; case G_TYPE_POINTER: tag = MLTAG_POINTER; tmp = Val_option (DATA.v_pointer, Val_pointer); break; case G_TYPE_INT64: case G_TYPE_UINT64: tag = MLTAG_INT64; tmp = copy_int64 (DATA.v_int64); break; } if ((long)tag != 0) { ret = alloc_small(2,0); Field(ret,0) = tag; Field(ret,1) = tmp; } CAMLreturn(ret); } ML_1 (g_value_get_mlvariant, GValue_val, ID) static void g_value_set_mlvariant (GValue *val, value arg) { value tag = Field(arg,0); value data = Field(arg,1); GType type = G_VALUE_TYPE(val); switch (G_TYPE_FUNDAMENTAL(type)) { case G_TYPE_CHAR: case G_TYPE_UCHAR: if (tag != MLTAG_CHAR) break; DATA.v_int = Int_val(data); return; case G_TYPE_BOOLEAN: if (tag != MLTAG_BOOL) break; DATA.v_int = Int_val(data); return; case G_TYPE_INT: case G_TYPE_UINT: if (tag == MLTAG_INT || tag == MLTAG_BOOL) DATA.v_int = Int_val(data); else if (tag == MLTAG_INT32) DATA.v_int = Int32_val(data); else break; return; case G_TYPE_LONG: case G_TYPE_ULONG: case G_TYPE_ENUM: case G_TYPE_FLAGS: switch ((long)tag) { case (long)MLTAG_INT: DATA.v_long = Int_val(data); return; case (long)MLTAG_INT32: DATA.v_long = Int32_val(data); return; case (long)MLTAG_LONG: DATA.v_long = Nativeint_val(data); return; }; break; case G_TYPE_FLOAT: if (tag != MLTAG_FLOAT) break; DATA.v_float = (float)Double_val(data); return; case G_TYPE_DOUBLE: if (tag != MLTAG_FLOAT) break; DATA.v_double = (double)Double_val(data); return; case G_TYPE_STRING: if (tag != MLTAG_STRING) break; g_value_set_string(val, String_option_val(data)); return; case G_TYPE_INTERFACE: /* assume interfaces are for objects */ case G_TYPE_OBJECT: if (tag != MLTAG_OBJECT) break; g_value_set_object(val, Option_val(data,GObject_val,NULL)); return; case G_TYPE_BOXED: if (tag == MLTAG_CAML && type == G_TYPE_CAML) g_value_store_caml_value (val, data); else if (tag == MLTAG_POINTER) g_value_set_boxed(val, Option_val(data,MLPointer_val,NULL)); else break; return; case G_TYPE_POINTER: if (tag != MLTAG_POINTER && tag != MLTAG_OBJECT) break; DATA.v_pointer = Option_val(data,MLPointer_val,NULL); return; case G_TYPE_INT64: case G_TYPE_UINT64: if (tag == MLTAG_INT64) DATA.v_int64 = Int64_val(data); else if (tag == MLTAG_INT) DATA.v_int64 = Int_val(data); else if (tag == MLTAG_INT32) DATA.v_int64 = Int32_val(data); else if (tag == MLTAG_LONG) DATA.v_int64 = Nativeint_val(data); else break; return; default: failwith ("Gobject.Value.set : cannot set this value"); } /* fprintf(stderr,"value has type %s\n", g_type_name(type)); */ failwith ("GObject.Value.set : argument type mismatch"); return; } ML_2 (g_value_set_mlvariant, GValue_val, ID, Unit) CAMLprim value ml_g_value_get_nativeint(value arg) { GValue *val = GValue_val(arg); switch(G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(val))) { case G_TYPE_INT: case G_TYPE_UINT: return copy_nativeint (DATA.v_int); case G_TYPE_LONG: case G_TYPE_ULONG: case G_TYPE_ENUM: case G_TYPE_FLAGS: return copy_nativeint (DATA.v_long); default: invalid_argument ("Gobject.get_nativeint"); } return Val_unit; } CAMLprim value ml_g_value_get_int32(value arg) { GValue *val = GValue_val(arg); switch(G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(val))) { case G_TYPE_INT: case G_TYPE_UINT: return copy_int32 (DATA.v_int); case G_TYPE_ENUM: case G_TYPE_FLAGS: return copy_int32 (DATA.v_long); default: failwith ("Gobject.get_int32"); } return Val_unit; } CAMLprim value ml_g_value_get_pointer (value arg) { gpointer p = NULL; GValue *val = GValue_val(arg); switch(G_TYPE_FUNDAMENTAL(G_VALUE_TYPE(val))) { case G_TYPE_STRING: case G_TYPE_BOXED: case G_TYPE_POINTER: p = DATA.v_pointer; break; default: failwith ("Gobject.get_pointer"); } return Val_pointer(p); } #undef DATA /* gobject.h / properties */ CAMLprim value ml_g_object_new (value type, value params) { int i, n; value cell = params; GParameter *params_copy = NULL, *param; GObjectClass *class = g_type_class_ref(GType_val(type)); GParamSpec *pspec; GObject *ret; for (n = 0; cell != Val_unit; cell = Field(cell,1)) n++; if (n > 0) { params_copy = (GParameter*)calloc(n, sizeof(GParameter)); param = params_copy; for (cell = params; cell != Val_unit; cell = Field(cell,1)) { param->name = String_val(Field(Field(cell,0),0)); pspec = g_object_class_find_property (class, param->name); if (!pspec) failwith ("Gobject.create"); g_value_init (¶m->value, pspec->value_type); g_value_set_mlvariant (¶m->value, Field(Field(cell,0),1)); param++; } } ret = g_object_newv (GType_val(type), n, params_copy); if (n > 0) { for (i=0; in_params, 0); \ Store_field(ml_query, 0, Val_int(query->signal_id)); \ Store_field(ml_query, 1, caml_copy_string (query->signal_name)); \ Store_field(ml_query, 2, caml_copy_string (g_type_name(query->itype))); \ Store_field(ml_query, 3, Val_int(query->signal_flags)); \ Store_field(ml_query, 4, caml_copy_string (g_type_name(query->return_type)));\ for (i = 0; i < query->n_params; i++) \ Store_field(ml_params, i, Val_string(g_type_name(query->param_types[i]))); \ Store_field(ml_query, 5, ml_params) Make_Flags_val (Signal_type_val) CAMLprim value ml_g_signal_new_me(value o_name, value o_classe, value o_signal_flags) { const gchar* name = String_val(o_name); GSignalFlags signal_flags = Flags_Signal_type_val(o_signal_flags); GType itype = GType_val(o_classe); guint class_offset = 0; GSignalAccumulator accumulator = NULL; gpointer accu_data = NULL; GSignalCMarshaller marshaller = g_cclosure_marshal_VOID__POINTER; GType return_type = G_TYPE_NONE; guint nparams = 0; g_signal_new (name, itype, signal_flags, class_offset, accumulator, accu_data, marshaller, return_type, nparams); return (Val_int(0)); } CAMLprim value ml_g_signal_query(value ml_i) { CAMLparam1(ml_i); CAMLlocal2(ml_query, ml_query_params); GSignalQuery* query; guint i = Int_val(ml_i); query = malloc(sizeof(GSignalQuery)); g_signal_query(i, query); if (query->signal_id == 0) invalid_argument("g_signal_query"); Copy_GSignalQuery(ml_query, ml_query_params, query); free(query); CAMLreturn(ml_query); } CAMLprim value ml_g_signal_list_ids(value type) { CAMLparam1(type); CAMLlocal1(ret); guint n_ids; guint *ids; ids = g_signal_list_ids(GType_val(type), &n_ids); Copy_array(ret, n_ids, ids, Val_int); free(ids); CAMLreturn(ret); } ML_4 (g_signal_connect_closure, GObject_val, String_val, GClosure_val, Bool_val, Val_long) ML_2 (g_signal_handler_block, GObject_val, Long_val, Unit) ML_2 (g_signal_handler_unblock, GObject_val, Long_val, Unit) ML_2 (g_signal_handler_disconnect, GObject_val, Long_val, Unit) ML_2 (g_signal_handler_is_connected, GObject_val, Long_val, Val_bool) ML_2 (g_signal_stop_emission_by_name, GObject_val, String_val, Unit) CAMLprim value ml_g_signal_emit_by_name (value obj, value sig, value params) { value ret = Val_unit; CAMLparam4(obj,sig,params,ret); GObject *instance = GObject_val(obj); GValue *iparams = (GValue*)calloc(1 + Wosize_val(params), sizeof(GValue)); GQuark detail = 0; GType itype = G_TYPE_FROM_INSTANCE (instance); GType return_type; guint signal_id; unsigned int i; GSignalQuery query; if(!g_signal_parse_name(String_val(sig), itype, &signal_id, &detail, TRUE)) failwith("GtkSignal.emit_by_name : bad signal name"); g_value_init (iparams, itype); g_value_set_object (iparams, instance); g_signal_query (signal_id, &query); if (Wosize_val(params) != query.n_params) failwith("GtkSignal.emit_by_name : bad parameters number"); return_type = query.return_type & ~G_SIGNAL_TYPE_STATIC_SCOPE; if (return_type != G_TYPE_NONE) { ret = ml_g_value_new(); g_value_init (GValue_val(ret), return_type); } for (i = 0; i < query.n_params; i++) { g_value_init (&iparams[i+1], query.param_types[i] & ~G_SIGNAL_TYPE_STATIC_SCOPE); g_value_set_mlvariant (&iparams[i+1], Field(params,i)); } g_signal_emitv (iparams, signal_id, detail, (ret == Val_unit ? 0 : GValue_val(ret))); for (i = 0; i < query.n_params + 1; i++) g_value_unset (iparams + i); free (iparams); CAMLreturn(ret); } CAMLprim value ml_g_signal_override_class_closure(value vname, value vt, value vc) { GType t = GType_val(vt); guint signal_id = g_signal_lookup(String_val(vname), t); g_signal_override_class_closure (signal_id, t, GClosure_val(vc)); return Val_unit; } CAMLprim value ml_g_signal_chain_from_overridden (value clos_argv) { CAMLparam1(clos_argv); value val; GValue *ret, *args; val = Field(clos_argv, 0); ret = Tag_val(val) == Abstract_tag ? GValue_val (val) : NULL; val = Field(clos_argv, 2); args = Tag_val(val) == Abstract_tag ? GValue_val (val) : NULL; g_signal_chain_from_overridden (args, ret); CAMLreturn(Val_unit); } lablgtk-2.18.8/src/gtkNew.ml0000644000175000017500000000756213460263323014656 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gtk type t (* if you modify this type modify widget_info_array in ml_gtknew.c in accordance *) type object_type = | OBJECT | WIDGET | MISC | LABEL | ACCELLABEL | TIPSQUERY | ARROW | IMAGE | PIXMAP | CONTAINER | BIN | ALIGNMENT | FRAME | ASPECTFRAME | BUTTON | TOGGLEBUTTON | CHECKBUTTON | RADIOBUTTON | OPTIONMENU | ITEM | MENUITEM | CHECKMENUITEM | RADIOMENUITEM | TEAROFFMENUITEM | LISTITEM | TREEITEM | WINDOW | COLORSELECTIONDIALOG | DIALOG | INPUTDIALOG | FILESELECTION | FONTSELECTIONDIALOG | PLUG | EVENTBOX | HANDLEBOX | SCROLLEDWINDOW | VIEWPORT | BOX | BUTTONBOX | HBUTTONBOX | VBUTTONBOX | VBOX | COLORSELECTION | GAMMACURVE | HBOX | COMBO | STATUSBAR | STATUSICON | CLIST | CTREE | FIXED | NOTEBOOK | FONTSELECTION | PANED | HPANED | VPANED | LAYOUT | LIST | MENUSHELL | MENUBAR | MENU | PACKER | SOCKET | TABLE | TOOLBAR | TREE | CALENDAR | DRAWINGAREA | CURVE | EDITABLE | ENTRY | SPINBUTTON | TEXT | RULER | HRULER | VRULER | RANGE | SCALE | HSCALE | VSCALE | SCROLLBAR | HSCROLLBAR | VSCROLLBAR | SEPARATOR | HSEPARATOR | VSEPARATOR | PREVIEW | PROGRESS | PROGRESSBAR | DATA | ADJUSTMENT | TOOLTIPS | ITEMFACTORY external set_ml_class_init : (t -> unit) -> unit = "set_ml_class_init" external signal_new : string -> int -> t -> object_type -> int -> int = "ml_gtk_signal_new" external object_class_add_signals : t -> int array -> int -> unit = "ml_gtk_object_class_add_signals" external type_unique : name:string -> parent:object_type -> nsignals:int -> gtk_type = "ml_gtk_type_unique" external type_new : gtk_type -> unit obj = "ml_gtk_type_new" open GtkSignal let make_new_widget ~name ~parent ~(signals : ('a, unit -> unit) GtkSignal.t list) = let nsignals = List.length signals in let new_type = type_unique ~name ~parent ~nsignals in let signal_num_array = Array.create nsignals 0 in let class_init_func classe = List.fold_left signals ~init:0 ~f: (fun i signal -> signal_num_array.(i) <- signal_new signal.name 1 classe parent i; i+1); object_class_add_signals classe signal_num_array nsignals in new_type, (fun () -> set_ml_class_init class_init_func; type_new new_type) (* , signal_num_array *) lablgtk-2.18.8/src/gtkInit.ml0000644000175000017500000000325513460263323015023 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (* Does the initialization for toplevels *) let locale = GtkMain.Main.init () lablgtk-2.18.8/src/gtkTree.props0000644000175000017500000003026413460263323015552 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk module Internal = struct let tree_path_string = ref (unsafe_pointer : tree_path data_conv) let tree_path_copy = ref (unsafe_pointer : tree_path data_conv) end } conversions { GtkTreePathString "!Internal.tree_path_string" GtkTreePathCopy "!Internal.tree_path_copy" GtkTreeViewGridLines "GtkEnums.tree_view_grid_lines_conv" } classes { GdkPixbuf "GdkPixbuf.pixbuf" GtkAdjustment "Gtk.adjustment obj" GtkTreeModel "Gtk.tree_model obj" } class TreeView set wrap wrapsig : Container { "enable-search" gboolean : Read / Write "expander-column" GtkTreeViewColumn_opt: Read / Write / NoSet / NoWrap "fixed-height-mode" gboolean : Read / Write "hadjustment" GtkAdjustment : Read / Write "headers-clickable" gboolean : Write "headers-visible" gboolean : Read / Write "model" GtkTreeModel_opt : Read / Write / NoWrap "reorderable" gboolean : Read / Write "rules-hint" gboolean : Read / Write "search-column" gint : Read / Write "vadjustment" GtkAdjustment : Read / Write (* new properties in GTK+ 2.6 *) "hover-expand" gboolean : Read / Write / NoSet "hover-selection" gboolean : Read / Write / NoSet (* new properties in GTK+ 2.10 *) "enable-grid-lines" GtkTreeViewGridLines : Read / Write / NoSet "enable-tree-lines" gboolean : Read / Write / NoSet (* new properties in GTK+ 2.12 *) "tooltip-column" gint : Read / Write method get_visible_range : "(tree_path * tree_path) option" signal columns_changed signal cursor_changed signal expand_collapse_cursor_row : logical:gboolean expand:gboolean all:gboolean -> gboolean signal move_cursor : GtkMovementStep gint -> gboolean signal row_activated : GtkTreePathCopy GtkTreeViewColumn / NoWrap signal row_collapsed : GtkTreeIter GtkTreePathCopy signal row_expanded : GtkTreeIter GtkTreePathCopy signal select_all : -> gboolean signal select_cursor_parent : -> gboolean signal select_cursor_row : start_editing:gboolean -> gboolean signal set_scroll_adjustments : GtkAdjustment_opt GtkAdjustment_opt signal start_interactive_search : -> gboolean signal test_collapse_row : GtkTreeIter GtkTreePathCopy -> gboolean signal test_expand_row : GtkTreeIter GtkTreePathCopy -> gboolean signal toggle_cursor_row : -> gboolean signal unselect_all : -> gboolean } class CellRenderer vset : Object { "cell-background" gchararray : Write "cell-background-gdk" GdkColor : Read / Write "cell-background-set" gboolean : Read / Write "height" gint : Read / Write "is-expanded" gboolean : Read / Write "is-expander" gboolean : Read / Write "mode" GtkCellRendererMode : Read / Write "visible" gboolean : Read / Write "width" gint : Read / Write "xalign" gfloat : Read / Write "xpad" guint : Read / Write "yalign" gfloat : Read / Write "ypad" guint : Read / Write } class CellRendererPixbuf vset : CellRenderer { "pixbuf" GdkPixbuf : Read / Write "pixbuf-expander-closed" GdkPixbuf : Read / Write "pixbuf-expander-open" GdkPixbuf : Read / Write "stock-detail" gchararray : Read / Write "stock-id" gchararray : Read / Write "stock-size" GtkIconSize : Read / Write } class CellRendererText vset : CellRenderer { "attributes" PangoAttrList : Read / Write "background" gchararray : Write "background-gdk" GdkColor : Read / Write "background-set" gboolean : Read / Write "editable" gboolean : Read / Write "editable-set" gboolean : Read / Write / NoVSet "family" gchararray : Read / Write "family-set" gboolean : Read / Write / NoVSet "font" gchararray : Read / Write "font-desc" PangoFontDescription : Read / Write "foreground" gchararray : Write "foreground-gdk" GdkColor : Read / Write "foreground-set" gboolean : Read / Write "markup" gchararray : Write "rise" gint : Read / Write "rise-set" gboolean : Read / Write / NoVSet "scale" gdouble : Read / Write "scale-set" gboolean : Read / Write / NoVSet "single-paragraph-mode" gboolean : Read / Write "size" gint : Read / Write "size-points" gdouble : Read / Write "size-set" gboolean : Read / Write / NoVSet "stretch" PangoStretch : Read / Write "stretch-set" gboolean : Read / Write / NoVSet "strikethrough" gboolean : Read / Write "strikethrough-set" gboolean : Read / Write / NoVSet "style" PangoStyle : Read / Write "style-set" gboolean : Read / Write / NoVSet "text" gchararray : Read / Write "underline" PangoUnderline : Read / Write "underline-set" gboolean : Read / Write / NoVSet "variant" PangoVariant : Read / Write "variant-set" gboolean : Read / Write / NoVSet "weight" gint : Read / Write "weight-set" gboolean : Read / Write / NoVSet method set_fixed_height_from_font : "int -> unit" signal edited : GtkTreePathString string } class CellRendererToggle vset : CellRenderer { "activatable" gboolean : Read / Write "active" gboolean : Read / Write "inconsistent" gboolean : Read / Write "radio" gboolean : Read / Write signal toggled : GtkTreePathString } class CellRendererProgress vset : CellRenderer { "value" gint : Read / Write "text" gchararray_opt : Read / Write } class CellRendererCombo : CellRendererText { "model" GtkTreeModel_opt : Read / Write / NoWrap "text_column" gint : Read / Write / NoWrap "has_entry" gboolean : Read / Write signal changed : GtkTreePathString GtkTreeIter } class CellRendererAccel : CellRendererText { "accel-key" gint : Read / Write "accel-mode" GtkCellRendererAccelMode : Read / Write "accel-mods" gint : Read / Write "keycode" gint : Read / Write signal accel_cleared : GtkTreePathString signal accel_edited : GtkTreePathString accel_key:int accel_mods:int hardware_keycode:int } class CellLayout abstract : Object { method pack_start : "Gtk.cell_renderer Gtk.obj -> expand:bool -> unit" method pack_end : "Gtk.cell_renderer Gtk.obj -> expand:bool -> unit" method reorder : "Gtk.cell_renderer Gtk.obj -> int -> unit" method clear method add_attribute : "Gtk.cell_renderer Gtk.obj -> string -> int -> unit" method clear_attributes : "Gtk.cell_renderer Gtk.obj -> unit" method set_cell_data_func : "Gtk.cell_renderer Gtk.obj -> ([`treemodel] obj -> tree_iter -> unit) option -> unit" } class TreeViewColumn wrap : Object { "alignment" gfloat : Read / Write "clickable" gboolean : Read / Write "expand" gboolean : Read / Write "fixed-width" gint : Read / Write "max-width" gint : Read / Write "min-width" gint : Read / Write "reorderable" gboolean : Read / Write "resizable" gboolean : Read / Write "sizing" GtkTreeViewColumnSizing : Read / Write "sort-indicator" gboolean : Read / Write "sort-order" GtkSortType : Read / Write "title" gchararray : Read / Write "visible" gboolean : Read / Write "widget" GtkWidget_opt : Read / Write "width" gint : Read signal clicked } class TreeSelection abstract : GObject { signal changed } class TreeModel abstract wrapsig : GObject { signal row_changed : GtkTreePathCopy GtkTreeIter signal row_deleted : GtkTreePathCopy signal row_has_child_toggled : GtkTreePathCopy GtkTreeIter signal row_inserted : GtkTreePathCopy GtkTreeIter signal rows_reordered : GtkTreePathCopy GtkTreeIter (* gpointer *) } (* class ListStore : TreeModel {} *) class TreeModelSort : GObject { "model" GtkTreeModel : Read / Write / Construct Only method convert_child_path_to_path : "Gtk.tree_path -> Gtk.tree_path" method convert_child_iter_to_iter : "Gtk.tree_iter -> Gtk.tree_iter" method convert_path_to_child_path : "Gtk.tree_path -> Gtk.tree_path" method convert_iter_to_child_iter : "Gtk.tree_iter -> Gtk.tree_iter" method reset_default_sort_func (* method clear_cache *) method iter_is_valid : "Gtk.tree_iter -> bool" } class TreeSortable abstract wrapsig : GObject { signal sort_column_changed method sort_column_changed method get_sort_column_id : "(int * Gtk.Tags.sort_type) option" method set_sort_column_id : "int -> Gtk.Tags.sort_type -> unit" method set_sort_func : "int -> ([`treemodel] Gobject.obj -> Gtk.tree_iter -> Gtk.tree_iter -> int) -> unit" method set_default_sort_func : "([`treemodel] Gobject.obj -> Gtk.tree_iter -> Gtk.tree_iter -> int) -> unit" method has_default_sort_func : "bool" } class TreeModelFilter : GObject { "child-model" GtkTreeModel : Read / Write / Construct Only "virtual-root" GtkTreePath : Read / Write / Construct Only method set_visible_func : "([`treemodel] Gobject.obj -> Gtk.tree_iter -> bool) -> unit" method set_visible_column : "int -> unit" method convert_child_path_to_path : "Gtk.tree_path -> Gtk.tree_path" method convert_child_iter_to_iter : "Gtk.tree_iter -> Gtk.tree_iter" method convert_path_to_child_path : "Gtk.tree_path -> Gtk.tree_path" method convert_iter_to_child_iter : "Gtk.tree_iter -> Gtk.tree_iter" method refilter (* method clear_cache *) } class IconView set wrap wrapsig : Container { "column-spacing" gint : Read / Write / NoSet "columns" gint : Read / Write "item-width" gint : Read / Write / NoSet "margin" gint : Read / Write / NoSet "markup-column" gint : Read / Write / NoWrap / NoSet "model" GtkTreeModel_opt : Read / Write / NoWrap "orientation" GtkOrientation : Read / Write "pixbuf-column" gint : Read / Write / NoWrap / NoSet "row-spacing" gint : Read / Write / NoSet "selection-mode" GtkSelectionMode : Read / Write "spacing" gint : Read / Write / NoSet "text-column" gint : Read / Write / NoWrap / NoSet signal item_activated : GtkTreePath signal selection_changed (* signal set_scroll_adjustments : GtkAdjustment GtkAdjustment *) method get_path_at_pos : "int -> int -> Gtk.tree_path option" method selected_foreach : "(Gtk.tree_path -> unit) -> unit" method select_path : "Gtk.tree_path -> unit" method unselect_path : "Gtk.tree_path -> unit" method path_is_selected : "Gtk.tree_path -> bool" method get_selected_items : "Gtk.tree_path list" method select_all method unselect_all method item_activated : "Gtk.tree_path -> unit" } lablgtk-2.18.8/src/check_externals.ml0000644000175000017500000001677013460263323016562 0ustar stephsteph(* $Id$ *) (* Check that all external statements differ in a .ml or .mli file *) open StdLabels (*** Objective Caml simplified lexer ***) type token = | Ident of string | Num of int | Sym of char | String of string | Char of string | EOF let rec implode l = let s = String.create (List.length l) in let i = ref 0 in (List.iter l ~f: (fun c -> (s.[!i] <- c; incr i)); s) let rec skip tok (__strm : _ Stream.t) = match Stream.peek __strm with | Some tok' -> (Stream.junk __strm; let s = __strm in if tok <> tok' then skip tok s else ()) | _ -> raise Stream.Failure let rec star ~acc p (__strm : _ Stream.t) = match try Some (p __strm) with | Stream.Failure -> None with | Some x -> let s = __strm in star ~acc: (x :: acc) p s | _ -> List.rev acc let alphanum (__strm : _ Stream.t) = match Stream.peek __strm with | Some (('A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '\'' | '_' as c)) -> (Stream.junk __strm; c) | _ -> raise Stream.Failure let num (__strm : _ Stream.t) = match Stream.peek __strm with | Some (('0' .. '9' | '_' as c)) -> (Stream.junk __strm; c) | _ -> raise Stream.Failure let escaped (__strm : _ Stream.t) = match Stream.peek __strm with | Some (('0' .. '9' as c1)) -> (Stream.junk __strm; (match Stream.peek __strm with | Some (('0' .. '9' as c2)) -> (Stream.junk __strm; (match Stream.peek __strm with | Some (('0' .. '9' as c3)) -> (Stream.junk __strm; [ c1; c2; c3 ]) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some c -> (Stream.junk __strm; [ c ]) | _ -> raise Stream.Failure let char (__strm : _ Stream.t) = match Stream.peek __strm with | Some '\\' -> (Stream.junk __strm; let l = (try escaped __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some '\'' -> (Stream.junk __strm; implode ('\\' :: l)) | _ -> raise (Stream.Error ""))) | Some c -> (Stream.junk __strm; (match Stream.peek __strm with | Some '\'' -> (Stream.junk __strm; String.make 1 c) | _ -> raise (Stream.Error ""))) | _ -> raise Stream.Failure let rec string ~acc (__strm : _ Stream.t) = match Stream.peek __strm with | Some '"' -> (Stream.junk __strm; implode (List.rev acc)) | Some '\'' -> (Stream.junk __strm; let l = (try escaped __strm with | Stream.Failure -> raise (Stream.Error "")) in let s = __strm in string ~acc: (List.rev_append l ('\'' :: acc)) s) | Some c -> (Stream.junk __strm; let s = __strm in string ~acc: (c :: acc) s) | _ -> raise Stream.Failure let rec token (__strm : _ Stream.t) = match Stream.peek __strm with | Some (('A' .. 'Z' | 'a' .. 'z' | '_' as c)) -> (Stream.junk __strm; let l = (try star alphanum ~acc: [ c ] __strm with | Stream.Failure -> raise (Stream.Error "")) in Ident (implode l)) | Some (('0' .. '9' as c)) -> (Stream.junk __strm; let l = (try star ~acc: [ c ] num __strm with | Stream.Failure -> raise (Stream.Error "")) in Num (int_of_string (implode l))) | Some '(' -> (Stream.junk __strm; (try may_comment __strm with | Stream.Failure -> raise (Stream.Error ""))) | Some '\'' -> (Stream.junk __strm; let s = __strm in (try Char (char s) with | _ -> token s)) | (* skip type variables... *) Some '"' -> (Stream.junk __strm; let s = (try string ~acc: [] __strm with | Stream.Failure -> raise (Stream.Error "")) in String s) | Some (' ' | '\n' | '\r' | '\t') -> (Stream.junk __strm; token __strm) | Some c -> (Stream.junk __strm; Sym c) | _ -> raise End_of_file and may_comment (__strm : _ Stream.t) = match Stream.peek __strm with | Some '*' -> (Stream.junk __strm; let s = __strm in let s' = lexer s in (skip (Sym '*') s'; may_close_comment s')) | _ -> Sym '(' and may_close_comment (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Sym ')') -> (Stream.junk __strm; (match Stream.peek __strm with | Some tok -> (Stream.junk __strm; tok) | _ -> raise (Stream.Error ""))) | _ -> let s = __strm in (skip (Sym '*') s; may_close_comment s) and lexer s = Stream.lcons (fun _ -> token s) (Stream.slazy (fun _ -> lexer s)) (**** The actual checker ***) let defs = Hashtbl.create 13 let add impl name = try let name' = Hashtbl.find defs impl in Printf.eprintf "externals [%s] and [%s] have same implementation \"%s\"\n" name' name impl with | Not_found -> Hashtbl.add defs impl name let may_string (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; s) | _ -> "" let rec skip_type (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Sym '=') -> (Stream.junk __strm; ()) | Some (Sym '(') -> (Stream.junk __strm; let _ = (try skip (Sym ')') __strm with | Stream.Failure -> raise (Stream.Error "")) in skip_type __strm) | Some (Sym '[') -> (Stream.junk __strm; let _ = (try skip (Sym ']') __strm with | Stream.Failure -> raise (Stream.Error "")) in skip_type __strm) | Some _ -> (Stream.junk __strm; skip_type __strm) | _ -> raise Stream.Failure let check_external (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident name) -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Sym ':') -> (Stream.junk __strm; let _ = (try skip_type __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (String impl) -> (Stream.junk __strm; let native1 = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in let native2 = (try may_string __strm with | Stream.Failure -> raise (Stream.Error "")) in (if (impl <> "") && (impl.[0] <> '%') then add impl name else (); let native = (match (native1, native2) with | (("noalloc" | "float"), ("noalloc" | "float")) -> "" | (("noalloc" | "float"), n) -> n | (n, _) -> n) in if native <> "" then add native name else ())) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> raise Stream.Failure let check f = (prerr_endline ("processing " ^ f); let ic = open_in f in let chars = Stream.of_channel ic in let s = lexer chars in try while true do skip (Ident "external") s; check_external s done with | End_of_file -> () | Stream.Error _ | Stream.Failure -> (Printf.eprintf "Parse error in file `%s' before char %d\n" f (Stream.count chars); exit 2) | exn -> (Printf.eprintf "Exception %s in file `%s' before char %d\n" (Printexc.to_string exn) f (Stream.count chars); exit 2)) let main () = Arg.parse [] check "usage: check_externals file.ml ..." let () = Printexc.print main () lablgtk-2.18.8/src/gtkButton.ml0000644000175000017500000001374213460263323015375 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkButtonProps open GtkBase external _gtkbutton_init : unit -> unit = "ml_gtkbutton_init" let () = _gtkbutton_init () module Button = struct include Button let make_params ~cont p ?label ?use_mnemonic ?stock = let label, use_stock = match stock with None -> label, None | Some id -> Some (GtkStock.convert_id id), Some true in make_params ~cont p ?label ?use_underline:use_mnemonic ?use_stock external pressed : [>`button] obj -> unit = "ml_gtk_button_pressed" external released : [>`button] obj -> unit = "ml_gtk_button_released" external clicked : [>`button] obj -> unit = "ml_gtk_button_clicked" external enter : [>`button] obj -> unit = "ml_gtk_button_enter" external leave : [>`button] obj -> unit = "ml_gtk_button_leave" end module ToggleButton = struct include ToggleButton let create_check pl : toggle_button obj = Object.make "GtkCheckButton" pl external toggled : [>`toggle] obj -> unit = "ml_gtk_toggle_button_toggled" end module RadioButton = struct include RadioButton let create ?group p = create (Property.may_cons P.group group p) end module Toolbar = struct include Toolbar external insert_space : [>`toolbar] obj -> pos:int -> unit = "ml_gtk_toolbar_insert_space" let insert_space w ?(pos = -1) () = insert_space w ~pos external insert_button : [>`toolbar] obj -> kind:[`BUTTON|`TOGGLEBUTTON|`RADIOBUTTON] -> text:string -> tooltip:string -> tooltip_private:string -> icon:[>`widget] optobj -> pos:int -> button obj = "ml_gtk_toolbar_insert_element_bc" "ml_gtk_toolbar_insert_element" let insert_button w ?(kind=`BUTTON) ?(text="") ?(tooltip="") ?(tooltip_private="") ?icon ?(pos = -1) ?callback () = let b =insert_button w ~kind ~text ~tooltip ~tooltip_private ~pos ~icon:(Gpointer.optboxed icon) in may callback ~f: (fun callback -> GtkSignal.connect b ~sgn:Button.S.clicked ~callback); b external insert_widget : [>`toolbar] obj -> [>`widget] obj -> tooltip:string -> tooltip_private:string -> pos:int -> unit = "ml_gtk_toolbar_insert_widget" let insert_widget w ?(tooltip="") ?(tooltip_private="") ?(pos = -1) w' = insert_widget w w' ~tooltip ~tooltip_private ~pos external set_tooltips : [>`toolbar] obj -> bool -> unit = "ml_gtk_toolbar_set_tooltips" external get_tooltips : [>`toolbar] obj -> bool = "ml_gtk_toolbar_get_tooltips" let set ?orientation ?style ?tooltips w = may orientation ~f:(set P.orientation w); may style ~f:(set P.toolbar_style w); may tooltips ~f:(set_tooltips w) external unset_style : [>`toolbar] obj -> unit = "ml_gtk_toolbar_unset_style" external get_icon_size : [>`toolbar] obj -> Tags.icon_size = "ml_gtk_toolbar_get_icon_size" external set_icon_size : [>`toolbar] obj -> Tags.icon_size -> unit = "ml_gtk_toolbar_set_icon_size" external unset_icon_size : [>`toolbar] obj -> unit = "ml_gtk_toolbar_unset_icon_size" (* extended API in GTK 2.4 *) external insert : [>`toolbar] obj -> [>`toolitem] obj -> pos:int -> unit = "ml_gtk_toolbar_insert" external get_item_index : [>`toolbar] obj -> [>`toolitem] obj -> int = "ml_gtk_toolbar_get_item_index" external get_n_items : [>`toolbar] obj -> int = "ml_gtk_toolbar_get_n_items" external get_nth_item : [>`toolbar] obj -> int -> [`toolitem] obj = "ml_gtk_toolbar_get_nth_item" external get_drop_index : [>`toolbar] obj -> int -> int -> int = "ml_gtk_toolbar_get_drop_index" external set_drop_highlight_item : [>`toolbar] obj -> [>`toolitem] obj option -> int -> unit = "ml_gtk_toolbar_set_drop_highlight_item" external get_relief_style : [>`toolbar] obj -> GtkEnums.relief_style = "ml_gtk_toolbar_get_relief_style" end module ColorButton = ColorButton module FontButton = FontButton module LinkButton = struct include LinkButton external create : string -> [>`linkbutton] obj = "ml_gtk_link_button_new" external create_with_label : string -> string -> [>`linkbutton] obj = "ml_gtk_link_button_new_with_label" external set_uri_hook : ([>`linkbutton] obj -> string -> unit) -> unit = "ml_gtk_link_button_set_uri_hook" end module ToolItem = ToolItem module SeparatorToolItem = SeparatorToolItem module ToolButton = ToolButton module ToggleToolButton = ToggleToolButton module RadioToolButton = RadioToolButton module MenuToolButton = MenuToolButton lablgtk-2.18.8/src/ml_gobject.h0000644000175000017500000000542613460263323015340 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* Defined in ml_gobject.h */ #define GObject_val(val) ((GObject*)Pointer_val(val)) CAMLexport value Val_GObject (GObject *); CAMLexport value Val_GObject_new (GObject *); #define Val_GAnyObject(val) Val_GObject(G_OBJECT(val)) #define Val_GAnyObject_new(val) Val_GObject_new(G_OBJECT(val)) CAMLexport void ml_g_object_unref_later (GObject *); #define GType_val(t) ((GType)Addr_val(t)) #define Val_GType Val_addr #define GClosure_val(val) ((GClosure*)Pointer_val(val)) CAMLexport value Val_GClosure (GClosure *); #define GValueptr_val(val) ((GValue*)MLPointer_val(val)) CAMLexport GValue *GValue_val(value); /* check for NULL pointer */ CAMLexport value Val_GValue_copy(GValue *); /* copy from the stack */ #define Val_GValue_wrap Val_pointer /* just wrap a pointer */ CAMLexport value ml_g_value_new(void); CAMLexport value Val_gboxed(GType t, gpointer p); /* finalized gboxed */ CAMLexport value Val_gboxed_new(GType t, gpointer p); /* without copy */ /* Macro utilities for export */ /* used in ml_gtk.h for instance */ #ifdef G_DISABLE_CAST_CHECKS #define check_cast(f,v) f(Pointer_val(v)) #else #define check_cast(f,v) (Pointer_val(v) == NULL ? NULL : f(Pointer_val(v))) #endif lablgtk-2.18.8/src/propcc.ml0000644000175000017500000015036613460263323014706 0ustar stephsteph(* -*- caml -*- *) (* $Id$ *) open StdLabels open MoreLabels let caml_keywords = [ ("type", "kind"); ("class", "classe"); ("list", "liste") ] let caml_modules = [ ("List", "Liste") ] let is_not_uppercase = function | 'A' .. 'Z' -> false | _ -> true let camlize id = let b = Buffer.create ((String.length id) + 4) in (for i = 0 to (String.length id) - 1 do (match id.[i] with | ('A' .. 'Z' as c) -> (if (i > 0) && ((is_not_uppercase id.[i - 1]) || ((i < ((String.length id) - 1)) && (is_not_uppercase id.[i + 1]))) then Buffer.add_char b '_' else (); Buffer.add_char b (Char.lowercase c)) | '-' -> Buffer.add_char b '_' | c -> Buffer.add_char b c) done; let s = Buffer.contents b in try List.assoc s caml_keywords with | Not_found -> s) let camlizeM s = try List.assoc s caml_modules with | Not_found -> s let check_suffix s suff = let len1 = String.length s and len2 = String.length suff in (len1 > len2) && ((String.sub s (len1 - len2) len2) = suff) (* Arity of a caml type. Doesn't handle object types... *) let arity s = let parens = ref 0 and arity = ref 0 in (for i = 0 to (String.length s) - 1 do if (s.[i] = '(') || (s.[i] = '[') then incr parens else if (s.[i] = ')') || (s.[i] = ']') then decr parens else if (!parens = 0) && ((s.[i] = '-') && (s.[i + 1] = '>')) then incr arity else () done; if !parens <> 0 then failwith ("bad type : " ^ s) else (); !arity) let rec min_labelled = function | [] -> [] | a :: l -> let l = min_labelled l in if (l = []) && (a = "") then [] else a :: l (* The real data *) let conversions = Hashtbl.create 17 let enums = [ ("Gtk", "GtkEnums", [ "Justification"; "ArrowType"; "ShadowType"; "ResizeMode"; "ReliefStyle"; "ImageType"; "WindowType"; "WindowPosition"; "ButtonsType"; "MessageType"; "ButtonBoxStyle"; "PositionType"; "Orientation"; "ToolbarStyle"; "IconSize"; "PolicyType"; "CornerType"; "SelectionMode"; "SortType"; "WrapMode"; "SpinButtonUpdatePolicy"; "UpdateType"; "ProgressBarStyle"; "ProgressBarOrientation"; "CellRendererMode"; "CellRendererAccelMode"; "TreeViewColumnSizing"; "SortType"; "TextDirection"; "SizeGroupMode"; (* in signals *) "MovementStep"; "ScrollStep"; "ScrollType"; "MenuDirectionType"; "DeleteType"; "StateType"; (* for canvas *) "AnchorType"; "DirectionType" ]); ("Gdk", "GdkEnums", [ "ExtensionMode"; "WindowTypeHint"; "EventMask"; (* for canvas *) "CapStyle"; "JoinStyle"; "LineStyle" ]); ("Pango", "PangoEnums", [ "Stretch"; "Style"; "Underline"; "Variant"; "EllipsizeMode" ]); (* GtkSourceView *) ("Gtk", "SourceView2Enums", [ "SourceSmartHomeEndType"; "SourceDrawSpacesFlags" ]) ] (* These types must be registered with g_boxed_register! *) let boxeds = [ ("Gdk", [ "Color"; "Font" ]); ("Pango", [ "FontDescription" ]); ("Gtk", [ "IconSet"; "SelectionData"; "TextIter"; "TreePath"; "TreeIter" ]) ] let classes = [ ("Gdk", [ "Image"; "Pixmap"; "Bitmap"; "Screen"; "DragContext" ]); ("Gtk", [ "Style"; "TreeStore"; "TreeModel"; "TreeModelFilter"; "Tooltip" ]) ] let specials = [ ("GtkWidget", "GObj.conv_widget"); ("GtkWidget_opt", "GObj.conv_widget_option"); ("GtkAdjustment", "GData.conv_adjustment"); ("GtkAdjustment_opt", "GData.conv_adjustment_option") ] let add_pointer conv gtk name = (Hashtbl.add conversions gtk (Printf.sprintf "(%s : %s data_conv)" conv name); Hashtbl.add conversions (gtk ^ "_opt") (Printf.sprintf "(%s_option : %s option data_conv)" conv name)) let add_object = add_pointer "gobject" let add_boxed = add_pointer "unsafe_pointer" (* the type is not used *) let () = (List.iter ~f: (fun t -> Hashtbl.add conversions ("g" ^ t) t) [ "boolean"; "char"; "uchar"; "int"; "uint"; "long"; "ulong"; "int32"; "uint32"; "int64"; "uint64"; "float"; "double" ]; List.iter ~f: (fun (gtype, conv) -> Hashtbl.add conversions gtype conv) [ ("gchararray", "string"); ("gchararray_opt", "string_option"); ("string", "string"); ("bool", "boolean"); ("int", "int"); ("int32", "int32"); ("float", "float") ]; List.iter enums ~f: (fun (pre, modu, l) -> List.iter l ~f: (fun name -> Hashtbl.add conversions (pre ^ name) (Printf.sprintf "%s.%s_conv" modu (camlize name)))); List.iter boxeds ~f: (fun (pre, l) -> List.iter l ~f: (fun name -> add_boxed (pre ^ name) (pre ^ ("." ^ (camlize name))))); List.iter classes ~f: (fun (pre, l) -> List.iter l ~f: (fun t -> add_object (pre ^ t) (pre ^ ("." ^ (camlize t))))); add_object "GObject" "unit obj"; add_object "GtkWidget" "Gtk.widget obj") open Genlex let lexer = make_lexer [ "{"; "}"; ":"; "/"; "("; ")"; "->"; "method"; "signal" ] let rec star ?(acc = []) p (__strm : _ Stream.t) = match try Some (p __strm) with | Stream.Failure -> None with | Some x -> let s = __strm in star ~acc: (x :: acc) p s | _ -> List.rev acc let may_token tok s = if (Stream.peek s) = (Some tok) then Stream.junk s else () let ident (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident id) -> (Stream.junk __strm; id) | _ -> raise Stream.Failure let string (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; s) | _ -> raise Stream.Failure let may_colon p def (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd ":") -> (Stream.junk __strm; p __strm) | _ -> def let may_string def (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; s) | _ -> def let may_name s (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "(") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident id) -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd ")") -> (Stream.junk __strm; id) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> camlize s let next_attr (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "/") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident id) -> (Stream.junk __strm; let ids = (try star ~acc: [ id ] ident __strm with | Stream.Failure -> raise (Stream.Error "")) in String.concat ~sep: "" ids) | _ -> raise (Stream.Error ""))) | _ -> raise Stream.Failure let attributes = [ "Read"; "Write"; "Construct"; "ConstructOnly"; "NoSet"; "Set"; "NoWrap"; "Wrap"; "NoGet"; "VSet"; "NoVSet" ] let label_type2 id (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd ":") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident ty) -> (Stream.junk __strm; (id, ty)) | _ -> raise (Stream.Error ""))) | _ -> ("", id) let label_type (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident id) -> (Stream.junk __strm; (try label_type2 id __strm with | Stream.Failure -> raise (Stream.Error ""))) | _ -> raise Stream.Failure type marshal = | Function of string | Types of ((string list) * (string list) * string) let return_type (l, types) (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "->") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident ret) -> (Stream.junk __strm; Types (l, types, ret)) | _ -> raise (Stream.Error ""))) | _ -> Types (l, types, "") let marshaller (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String s) -> (Stream.junk __strm; Function s) | Some (Kwd ":") -> (Stream.junk __strm; let types = (try star label_type __strm with | Stream.Failure -> raise (Stream.Error "")) in let s = __strm in return_type (List.split types) s) | _ -> Types ([], [], "") let simple_attr (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Kwd "/") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident s) -> (Stream.junk __strm; s) | _ -> raise (Stream.Error ""))) | _ -> raise Stream.Failure let field (__strm : _ Stream.t) = match Stream.peek __strm with | Some (String name) -> (Stream.junk __strm; let mlname = (try may_name name __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Ident gtype) -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd ":") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident attr0) -> (Stream.junk __strm; let attrs = (try star ~acc: [ attr0 ] next_attr __strm with | Stream.Failure -> raise (Stream.Error "")) in (if not (List.for_all attrs ~f: (List.mem ~set: attributes)) then raise (Stream.Error "bad attribute") else (); `Prop (name, mlname, gtype, attrs))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some (Kwd "method") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident name) -> (Stream.junk __strm; let ty = (try may_colon string "unit" __strm with | Stream.Failure -> raise (Stream.Error "")) in let attrs = (try star simple_attr __strm with | Stream.Failure -> raise (Stream.Error "")) in (if not (List.for_all attrs ~f: (List.mem ~set: [ "Wrap" ])) then raise (Stream.Error "bad attribute") else (); `Method (name, ty, attrs))) | _ -> raise (Stream.Error ""))) | Some (Kwd "signal") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident name) -> (Stream.junk __strm; let m = (try marshaller __strm with | Stream.Failure -> raise (Stream.Error "")) in let l = (try star simple_attr __strm with | Stream.Failure -> raise (Stream.Error "")) in (if not (List.for_all l ~f: (List.mem ~set: [ "Wrap"; "NoWrap" ])) then raise (Stream.Error "bad attribute") else (); `Signal (name, m, l))) | _ -> raise (Stream.Error ""))) | _ -> raise Stream.Failure let split_fields l = List.fold_right l ~init: ([], [], []) ~f: (fun field (props, meths, sigs) -> match field with | `Prop p -> ((p :: props), meths, sigs) | `Method m -> (props, (m :: meths), sigs) | `Signal s -> (props, meths, (s :: sigs))) let verb_braces = ref 0 let rec verbatim buf (__strm : _ Stream.t) = match Stream.peek __strm with | Some '}' -> (Stream.junk __strm; let s = __strm in if !verb_braces = 0 then Buffer.contents buf else (decr verb_braces; Buffer.add_char buf '}'; verbatim buf s)) | Some '{' -> (Stream.junk __strm; let s = __strm in (Buffer.add_char buf '{'; incr verb_braces; verbatim buf s)) | Some '\\' -> (Stream.junk __strm; (match Stream.peek __strm with | Some c -> (Stream.junk __strm; let s = __strm in (if (c <> '}') && (c <> '{') then Buffer.add_char buf '\\' else (); Buffer.add_char buf c; verbatim buf s)) | _ -> raise (Stream.Error ""))) | Some c -> (Stream.junk __strm; let s = __strm in (Buffer.add_char buf c; verbatim buf s)) | _ -> raise Stream.Failure let read_pair (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident cls) -> (Stream.junk __strm; let data = (try may_string (camlize cls) __strm with | Stream.Failure -> raise (Stream.Error "")) in (cls, data)) | _ -> raise Stream.Failure let qualifier (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident id) -> (Stream.junk __strm; let data = (try may_string "" __strm with | Stream.Failure -> raise (Stream.Error "")) in (id, data)) | _ -> raise Stream.Failure let prefix = ref "" let tagprefix = ref "" let decls = ref [] let headers = ref [] let oheaders = ref [] let checks = ref false let class_qualifiers = [ "abstract"; "notype"; "hv"; "set"; "wrap"; "wrapset"; "vset"; "tag"; "wrapsig"; "type"; "gobject" ] let process_phrase ~chars (__strm : _ Stream.t) = match Stream.peek __strm with | Some (Ident "class") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Ident name) -> (Stream.junk __strm; let gtk_name = (try may_string (!prefix ^ name) __strm with | Stream.Failure -> raise (Stream.Error "")) in let attrs = (try star qualifier __strm with | Stream.Failure -> raise (Stream.Error "")) in let parent = (try may_colon ident "" __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let fields = (try star field __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "}") -> (Stream.junk __strm; if List.exists attrs ~f: (fun (x, _) -> not (List.mem x class_qualifiers)) then raise (Stream.Error "bad qualifier") else (); let attrs = ("parent", parent) :: attrs in let attrs = if parent = "GObject" then ("gobject", "") :: attrs else attrs in let (props, meths, sigs) = split_fields fields in decls := (name, gtk_name, attrs, props, meths, sigs) :: !decls) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some (Ident "header") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let h = verbatim (Buffer.create 1000) chars in headers := !headers @ [ h ]) | _ -> raise (Stream.Error ""))) | Some (Ident "oheader") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let h = verbatim (Buffer.create 1000) chars in oheaders := !oheaders @ [ h ]) | _ -> raise (Stream.Error ""))) | Some (Ident "prefix") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (String id) -> (Stream.junk __strm; prefix := id) | _ -> raise (Stream.Error ""))) | Some (Ident "tagprefix") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (String id) -> (Stream.junk __strm; tagprefix := id) | _ -> raise (Stream.Error ""))) | Some (Ident "conversions") -> (Stream.junk __strm; let pre1 = (try may_string "" __strm with | Stream.Failure -> raise (Stream.Error "")) in let pre2 = (try may_string pre1 __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let l = (try star read_pair __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "}") -> (Stream.junk __strm; List.iter l ~f: (fun (k, d) -> Hashtbl.add conversions (pre1 ^ k) (if pre2 = "" then d else pre2 ^ ("." ^ d)))) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some (Ident "classes") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let l = (try star read_pair __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "}") -> (Stream.junk __strm; List.iter l ~f: (fun (k, d) -> add_object k d)) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some (Ident "boxed") -> (Stream.junk __strm; (match Stream.peek __strm with | Some (Kwd "{") -> (Stream.junk __strm; let l = (try star read_pair __strm with | Stream.Failure -> raise (Stream.Error "")) in (match Stream.peek __strm with | Some (Kwd "}") -> (Stream.junk __strm; List.iter l ~f: (fun (k, d) -> add_boxed k d)) | _ -> raise (Stream.Error ""))) | _ -> raise (Stream.Error ""))) | Some _ -> (Stream.junk __strm; raise (Stream.Error "")) | _ -> raise End_of_file let all_props = Hashtbl.create 137 let all_pnames = Hashtbl.create 137 let outfile = ref "" let ooutfile = ref "" let process_file f = let base = Filename.chop_extension f in let baseM = String.capitalize base in (* Input *) (* Redefining saves space in bytecode! *) (prefix := baseM; headers := [ "open Gobject"; "open Data"; "module Object = GtkObject" ]; oheaders := [ "open GtkSignal"; "open Gobject"; "open Data"; "let set = set"; "let get = get"; "let param = param" ]; let ic = open_in f in let chars = Stream.of_channel ic in let s = lexer chars in ((try while true do process_phrase ~chars s done with | End_of_file -> () | Stream.Error _ | Stream.Failure -> (Printf.eprintf "Parse error in file `%s' before char %d\n" f (Stream.count chars); exit 2) | exn -> (Printf.eprintf "Exception %s in file `%s' before char %d\n" (Printexc.to_string exn) f (Stream.count chars); exit 2)); (* Preproccess *) let type_name name ~attrs = try List.assoc "type" attrs with | Not_found -> if List.mem_assoc "gobject" attrs then camlize name else if !prefix <> "" then !prefix ^ ("." ^ ((camlize name) ^ " obj")) else (camlize name) ^ " obj" in let decls = List.rev !decls in let decls = List.filter decls ~f: (fun (_, _, attrs, _, _, _) -> not (List.mem_assoc "notype" attrs)) in (* Output modules *) (List.iter decls ~f: (fun (name, gtk_name, attrs, _, _, _) -> add_object gtk_name (type_name name ~attrs)); if !outfile = "" then outfile := base ^ "Props.ml" else (); let oc = open_out !outfile in let ppf = Format.formatter_of_out_channel oc in let out fmt = Format.fprintf ppf fmt in (List.iter !headers ~f: (fun s -> out "%s@." s); let decls = List.map decls ~f: (fun (name, gtk_name, attrs, props, meths, sigs) -> (name, gtk_name, attrs, (List.filter props ~f: (fun (name, _, gtype, _) -> try (ignore (Hashtbl.find conversions gtype); try let (count, _) = Hashtbl.find all_props (name, gtype) in (incr count; true) with | Not_found -> (Hashtbl.add all_props (name, gtype) ((ref 1), (ref "")); true)) with | Not_found -> (prerr_endline ("Warning: no conversion for type " ^ (gtype ^ (" in class " ^ gtk_name))); false))), meths, (List.filter sigs ~f: (function | (_, Function _, _) -> true | (_, Types (_, l, ret), _) -> List.for_all (if ret = "" then l else ret :: l) ~f: (fun ty -> if Hashtbl.mem conversions ty then true else (prerr_endline ("Warning: no conversion for type " ^ (ty ^ (" in class " ^ gtk_name))); false)))))) in let defprop ~name ~mlname ~gtype ~tag = let conv = Hashtbl.find conversions gtype in (out "@ @[let %s " mlname; if tag <> "gtk" then out ": ([>`%s],_) property " tag else (); out "=@ @[{name=\"%s\";@ conv=%s}@]@]" name conv) in let shared_props = Hashtbl.fold all_props ~init: [] ~f: (fun ~key: ((name, gtype)) ~data: ((count, rpname)) acc -> if !count <= 1 then acc else (let pname = camlize name in let pname = if Hashtbl.mem all_pnames pname then pname ^ ("_" ^ gtype) else (Hashtbl.add all_pnames pname (); pname) in (rpname := "PrivateProps." ^ pname; (pname, name, gtype) :: acc))) in (* Redefining saves space in bytecode! *) (if shared_props <> [] then (out "@[module PrivateProps = struct"; List.iter (List.sort compare shared_props) ~f: (fun (pname, name, gtype) -> defprop ~name ~mlname: pname ~gtype ~tag: "gtk"); out "@]\nend\n@.") else (); out "let may_cons = Property.may_cons\n"; out "let may_cons_opt = Property.may_cons_opt\n@."; let may_cons_props props = if props <> [] then (out "@ @[let pl = "; List.iter props ~f: (fun (name, mlname, gtype, _) -> let op = if check_suffix gtype "_opt" then "may_cons_opt" else "may_cons" in out "(@;<0>%s P.%s %s " op (camlize name) mlname); out "pl"; for k = 1 to List.length props do out ")" done; out " in@]") else () in let omarshaller ~gtk_class ~name ppf (l, tyl, ret) = let out fmt = Format.fprintf ppf fmt in (out "fun f ->@ @[marshal%d" (List.length l); if ret <> "" then out "_ret@ ~ret:%s" (Hashtbl.find conversions ret) else (); List.iter tyl ~f: (fun ty -> out "@ %s" ty); out "@ \"%s::%s\"" gtk_class name; if List.for_all l ~f: (( = ) "") then out " f" else (let l = min_labelled l in (out "@ @[(fun "; for i = 1 to List.length l do out "x%d " i done; out "->@ f"; let i = ref 0 in (List.iter l ~f: (fun p -> (incr i; if p = "" then out "@ x%d" !i else out "@ ~%s:x%d" p !i)); out ")@]"))); out "@]") in (* Output classes *) (List.iter decls ~f: (fun (name, gtk_class, attrs, props, meths, sigs) -> (out "@[module %s = struct" (camlizeM name); out "@ @[let cast w : %s =@ try_cast w \"%s\"@]" (type_name name ~attrs) gtk_class; let tag = try List.assoc "tag" attrs with | Not_found -> !tagprefix ^ (String.lowercase name) in (if props <> [] then (out "@ @[module P = struct"; List.iter props ~f: (fun (name, _, gtype, attrs) -> let (count, rpname) = Hashtbl.find all_props (name, gtype) in if !count > 1 then out "@ let %s : ([>`%s],_) property = %s" (camlize name) tag !rpname else defprop ~name ~mlname: (camlize name) ~gtype ~tag); out "@]@ end") else (); if sigs <> [] then (out "@ @[module S = struct@ open GtkSignal"; List.iter sigs ~f: (fun (name, marshaller, _) -> (out "@ @[let %s =" (camlize name); out "@ @[{name=\"%s\";@ classe=`%s;@ marshaller=" name tag; (match marshaller with | Function s -> out "%s" s | Types ([], [], "") -> out "marshal_unit" | Types ([], [], ret) -> out "fun f -> marshal0_ret ~ret:%s f" (Hashtbl.find conversions ret) | Types (l, tyl, ret) -> omarshaller ~gtk_class ~name ppf (l, (List.map (Hashtbl.find conversions) tyl), ret)); out "}@]@]")); out "@]@ end") else (); if not (List.mem_assoc "abstract" attrs) then (let cprops = List.filter props ~f: (fun (_, _, _, a) -> (List.mem "ConstructOnly" a) && (not (List.mem "NoSet" a))) in (out "@ @[let create"; List.iter cprops ~f: (fun (_, name, _, _) -> out " ?%s" name); if List.mem_assoc "hv" attrs then (out " (dir : Gtk.Tags.orientation) pl : %s =" (type_name name ~attrs); may_cons_props cprops; out "@ @[Object.make"; out "@ (if dir = `HORIZONTAL then \"%sH%s\" else \"%sV%s\")@ pl" !prefix name !prefix name; out "@]@]") else (out " pl : %s =" (type_name name ~attrs); may_cons_props cprops; if List.mem_assoc "gobject" attrs then out "@ Gobject.unsafe_create" else out "@ Object.make"; out " \"%s\" pl@]" gtk_class))) else (); List.iter meths ~f: (fun (name, typ, attrs) -> (out "@ @[external %s :" name; out "@ @[[>`%s] obj ->@ %s@]" tag typ; let cname = (camlize ("ml" ^ gtk_class)) ^ ("_" ^ name) in (out "@ = \""; if (arity typ) > 4 then out "%s_bc\" \"" cname else (); out "%s\"@]" cname))); let set_props = let set = List.mem_assoc "set" attrs in List.filter props ~f: (fun (_, _, _, a) -> (set || (List.mem "Set" a)) && ((List.mem "Write" a) && (not ((List.mem "ConstructOnly" a) || (List.mem "NoSet" a))))) in (if set_props <> [] then (let props = set_props in (out "@ @[@[let make_params ~cont pl"; List.iter props ~f: (fun (_, name, _, _) -> out "@ ?%s" name); out " =@]"; may_cons_props props; out "@ cont pl@]")) else (); if !checks && ((props <> []) || (sigs <> [])) then (if List.mem_assoc "abstract" attrs then out "@ @[let check w =" else (out "@ @[let check () ="; out "@ let w = create%s [] in" (if List.mem_assoc "hv" attrs then " `HORIZONTAL" else "")); if props <> [] then out "@ let c p = Property.check w p in" else (); if sigs <> [] then (out "@ let closure = Closure.create ignore in"; out "@ let s name = GtkSignal.connect_by_name"; out " w ~name ~closure ~after:false in") else (); out "@ @["; List.iter props ~f: (fun (name, _, gtype, attrs) -> if List.mem "Read" attrs then out "c P.%s;@ " (camlize name) else ()); List.iter sigs ~f: (fun (name, _, _) -> out "s %s;@ " name); out "()@]") else (); out "@]@.end\n@.")))); close_out oc; if !ooutfile = "" then ooutfile := "o" ^ !outfile else (); let oc = open_out !ooutfile in let ppf = Format.formatter_of_out_channel oc in let out fmt = Format.fprintf ppf fmt in (List.iter !oheaders ~f: (fun s -> out "%s@." s); out "open %s@." (String.capitalize (Filename.chop_extension !outfile)); out "@["; let oprop ~name ~gtype ppf pname = try let conv = List.assoc gtype specials in Format.fprintf ppf "{%s.P.%s with conv=%s}" (camlizeM name) (camlize pname) conv with | Not_found -> Format.fprintf ppf "%s.P.%s" (camlizeM name) (camlize pname) in (* pre 3.10 out "@ @[class virtual %s_props = object (self)" (camlize name); out "@ method private virtual obj : _ obj"; List.iter wr_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method set_%s =@ set %a self#obj@]" mlname (oprop ~name ~gtype) pname); List.iter rd_props ~f:(fun (pname,mlname,gtype,_) -> out "@ @[method %s =@ get %a self#obj@]" mlname (oprop ~name ~gtype) pname); List.iter wr_meths ~f:(fun (mname,typ,_) -> out "@ @[method %s %s=@ %s.%s self#obj@]" mname (if typ = "unit" then "() " else "") (camlizeM name) mname); *) (* post 3.10 *) (* #notify: easy connection to the "foo::notify" signal for the "foo" * properties. *) (* notify: easy connection to "foo::notify" signals for "foo" * properties. *) (List.iter decls ~f: (fun (name, gtk_class, attrs, props, meths, sigs) -> let wrap = List.mem_assoc "wrap" attrs in let wrapset = wrap || (List.mem_assoc "wrapset" attrs) in let wr_props = List.filter props ~f: (fun (_, _, _, set) -> let has = List.mem ~set in (wrapset || (has "Wrap")) && ((has "Write") && (not ((has "ConstructOnly") || (has "NoWrap"))))) and rd_props = List.filter props ~f: (fun (_, _, _, set) -> let has = List.mem ~set in (wrap || (has "Wrap")) && ((has "Read") && (not ((has "NoWrap") || (has "NoGet"))))) and wr_meths = List.filter meths ~f: (fun (_, _, attrs) -> List.mem "Wrap" attrs) in (if (wr_props <> []) || ((rd_props <> []) || (wr_meths <> [])) then (out "@ @[class virtual %s_props = object" (camlize name); out "@ val virtual obj : _ obj"; List.iter wr_props ~f: (fun (pname, mlname, gtype, _) -> out "@ @[method set_%s =@ set %a obj@]" mlname (oprop ~name ~gtype) pname); List.iter rd_props ~f: (fun (pname, mlname, gtype, _) -> out "@ @[method %s =@ get %a obj@]" mlname (oprop ~name ~gtype) pname); List.iter wr_meths ~f: (fun (mname, typ, _) -> out "@ @[method %s %s=@ %s.%s obj@]" mname (if typ = "unit" then "() " else "") (camlizeM name) mname); out "@]@ end@ "; out "@ @[class virtual %s_notify obj = object (self)" (camlize name); out "@ val obj : 'a obj = obj"; out "@ method private notify : 'b. ('a, 'b) property ->"; out "@ callback:('b -> unit) -> _ ="; out "@ fun prop ~callback -> GtkSignal.connect_property obj"; out "@ ~prop ~callback"; List.iter rd_props ~f: (fun (pname, mlname, gtype, _) -> out "@ @[method %s =@ self#notify %a@]" mlname (oprop ~name ~gtype) pname); out "@]@ end@ ") else (); let vset = List.mem_assoc "vset" attrs in let vprops = List.filter props ~f: (fun (_, _, _, set) -> let has = List.mem ~set in (vset || (has "VSet")) && ((has "Write") && (not ((has "ConstructOnly") || (has "NoVSet"))))) in (if vprops <> [] then (out "@ @[let %s_param = function" (camlize name); List.iter vprops ~f: (fun (pname, mlname, gtype, _) -> out "@ @[| `%s p ->@ param %a p@]" (String.uppercase mlname) (oprop ~name ~gtype) pname); out "@]@ ") else (); let wsig = List.mem_assoc "wrapsig" attrs in let wsigs = List.filter sigs ~f: (fun (_, _, attrs) -> (List.mem "Wrap" attrs) || (wsig && (not (List.mem "NoWrap" attrs)))) in if wsigs <> [] then (out "@ @[class virtual %s_sigs = object (self)" (camlize name); out "@ @[method private virtual connect :"; out "@ 'b. ('a,'b) GtkSignal.t -> callback:'b -> GtkSignal.id@]"; out "@ @[method private virtual notify :"; out "@ 'b. ('a,'b) property -> callback:('b -> unit) -> GtkSignal.id@]"; List.iter wsigs ~f: (fun (sname, types, _) -> match types with | Types (l, tyl, ret) when List.exists tyl ~f: (List.mem_assoc ~map: specials) -> let convs = List.map tyl ~f: (fun ty -> try List.assoc ty specials with | Not_found -> Hashtbl. find conversions ty) in (out "@ @[method %s =@ self#connect" sname; out "@ @[{%s.S.%s with@ marshaller = %a}@]@]" (camlizeM name) sname (omarshaller ~gtk_class ~name: sname) (l, convs, ret)) | _ -> out "@ @[method %s =@ self#connect %s.S.%s@]" sname (camlizeM name) sname); List.iter rd_props ~f: (fun (pname, mlname, gtype, _) -> (out "@ @[method notify_%s ~callback =" mlname; out "@ @[self#notify %a ~callback@]@]" (oprop ~name ~gtype) pname)); out "@]@ end@ ") else ()))); out "@."; close_out oc; outfile := ""; ooutfile := "")))))))) let main () = Arg.parse [ ("-checks", (Arg.Set checks), "generate code for checks"); ("-o", (Arg.String (fun s -> outfile := s)), "basic output file name"); ("-oo", (Arg.String (fun s -> ooutfile := s)), "wrappers output file name") ] process_file "usage: propcc file.props ..." let () = Printexc.print main () lablgtk-2.18.8/src/wrappers.c0000644000175000017500000001473313460263323015072 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" CAMLexport value copy_memblock_indirected (void *src, asize_t size) { mlsize_t wosize = Wosize_asize(size); value ret; if (!src) ml_raise_null_pointer (); ret = alloc_shr (wosize+2, Abstract_tag); Field(ret,1) = (value)2; memcpy ((value *) ret + 2, src, size); return ret; } value alloc_memblock_indirected (asize_t size) { value ret = alloc_shr (Wosize_asize(size)+2, Abstract_tag); Field(ret,1) = (value)2; return ret; } static long gc_speed = 10; CAMLprim value ml_set_gc_speed(value percent) { gc_speed = Int_val(percent); return Val_unit; } CAMLprim value ml_get_gc_speed(value unit) { return Val_int(gc_speed); } /* Reimplement the old behaviour of alloc_custom, to be sure that values do not move around */ CAMLexport value ml_alloc_custom(struct custom_operations * ops, uintnat size, mlsize_t mem, mlsize_t max) { mlsize_t wosize; value result; wosize = 1 + (size + sizeof(value) - 1) / sizeof(value); result = caml_alloc_shr(wosize, Custom_tag); Custom_ops_val(result) = ops; caml_adjust_gc_speed(mem*gc_speed, max*100); return caml_check_urgent_gc(result); } CAMLprim value ml_some (value v) { CAMLparam1(v); value ret = alloc_small(1,0); Field(ret,0) = v; CAMLreturn(ret); } value ml_cons (value v, value l) { CAMLparam2(v, l); value cell = alloc_small(2, Tag_cons); Field(cell, 0) = v; Field(cell, 1) = l; CAMLreturn(cell); } void ml_raise_null_pointer () { static value * exn = NULL; if (exn == NULL) exn = caml_named_value ("null_pointer"); raise_constant (*exn); } CAMLexport value Val_pointer (void *ptr) { value ret = alloc_small (2, Abstract_tag); if (!ptr) ml_raise_null_pointer (); Field(ret,1) = (value)ptr; return ret; } CAMLprim value copy_string_check (const char*str) { if (!str) ml_raise_null_pointer (); return copy_string ((char*) str); } value copy_string_or_null (const char*str) { return copy_string (str ? (char*) str : ""); } value Val_option_string (const char *s) { return Val_option (s, Val_string); } CAMLprim value *ml_global_root_new (value v) { value *p = stat_alloc(sizeof(value)); *p = v; register_global_root (p); return p; } CAMLexport void ml_global_root_destroy (void *data) { remove_global_root ((value *)data); stat_free (data); } CAMLexport value ml_lookup_from_c (const lookup_info table[], int data) { int i; for (i = table[0].data; i > 0; i--) if (table[i].data == data) return table[i].key; invalid_argument ("ml_lookup_from_c"); } CAMLexport int ml_lookup_to_c (const lookup_info table[], value key) { int first = 1, last = table[0].data, current; while (first < last) { current = (first+last)/2; if (table[current].key >= key) last = current; else first = current + 1; } if (table[first].key == key) return table[first].data; invalid_argument ("ml_lookup_to_c"); } CAMLexport value ml_lookup_flags_getter (const lookup_info table[], int data) { CAMLparam0(); CAMLlocal2(cell, l); int i; l = Val_emptylist; for (i = table[0].data; i > 0; i--) if ((table[i].data & data) == table[i].data) { cell = alloc_small(2, Tag_cons); Field(cell, 0) = table[i].key; Field(cell, 1) = l; l = cell; } CAMLreturn(l); } ML_2 (ml_lookup_from_c, (lookup_info*), Int_val, 0+) ML_2 (ml_lookup_to_c, (lookup_info*), 0+, Val_int) gchar ** strv_of_string_list (value list) { gchar **str_v; gsize i, len; value l; for (len = 0, l = list; l != Val_emptylist; len++, l = Field (l, 1)) ; l = list; str_v = g_new (gchar *, len+1); for (i = 0; i < len; i++) { str_v[i] = g_strdup (String_val (Field (l, 0))); l = Field (l, 1); } str_v[len] = NULL; return str_v; } value string_list_of_strv (const gchar * const *v) { CAMLparam0(); CAMLlocal4(head, l, cell, s); gsize i; if (v == NULL) CAMLreturn (Val_emptylist); i = 0; head = l = Val_emptylist; while (v[i] != NULL) { s = copy_string (v[i]); cell = alloc_small (2, Tag_cons); Field (cell, 0) = s; Field (cell, 1) = Val_emptylist; if (l == Val_emptylist) head = l = cell; else { Field (l, 1) = cell; l = cell; } i++; } CAMLreturn (head); } value string_list_of_strv2 (gchar **v) { return string_list_of_strv((const gchar* const*)v); } #ifdef ABSVALUE CAMLexport intnat Long_val(value x) { return (intnat)x >> 1; } CAMLexport value Val_long(intnat x) { return (value)((x << 1) + 1); } CAMLexport int Is_long(value x) { return ((intnat)(x) & 1) != 0; } CAMLexport int Is_block(value x) { return ((intnat)(x) & 1) == 0; } #endif lablgtk-2.18.8/src/ml_gtksourceview2.c0000644000175000017500000011072213460263323016675 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gobject.h" #include "ml_gdkpixbuf.h" #include "ml_pango.h" #include "ml_gtktext.h" #include "gtk_tags.h" #include "gdk_tags.h" #include "sourceView2_tags.h" #include #include "sourceView2_tags.c" Make_OptFlags_val(Source_search_flag_val) Make_Val_final_pointer_ext(GObject, _sink, g_object_ref_sink, ml_g_object_unref_later, 20) CAMLprim value ml_gtk_source_completion_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_completion_get_type() + gtk_source_completion_context_get_type() + gtk_source_completion_provider_get_type() + gtk_source_completion_proposal_get_type() + gtk_source_completion_info_get_type() + gtk_source_completion_item_get_type() ; return Val_GType(t); } CAMLprim value ml_gtk_source_completion_provider_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_completion_provider_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_style_scheme_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_style_scheme_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_style_scheme_manager_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_style_scheme_manager_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_language_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_language_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_language_manager_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_language_manager_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_buffer_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_buffer_get_type(); return Val_GType(t); } CAMLprim value ml_gtk_source_view_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_source_view_get_type(); return Val_GType(t); } static gpointer string_val(value v) { return String_val(v); } GSList *ml_gslist_of_string_list(value list) { return GSList_val(list, string_val); } #define GtkSourceCompletionProvider_val(val) check_cast(GTK_SOURCE_COMPLETION_PROVIDER,val) #define Val_GtkSourceCompletionProvider(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletionProvider_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceCompletionItem_val(val) check_cast(GTK_SOURCE_COMPLETION_ITEM,val) #define Val_GtkSourceCompletionItem(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletionItem_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceCompletionProposal_val(val) check_cast(GTK_SOURCE_COMPLETION_PROPOSAL,val) #define Val_GtkSourceCompletionProposal(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletionProposal_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceCompletionInfo_val(val) check_cast(GTK_SOURCE_COMPLETION_INFO,val) #define Val_GtkSourceCompletionInfo(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletionInfo_new(val) (Val_GObject_sink((GObject*)val)) #define GtkSourceCompletionContext_val(val) check_cast(GTK_SOURCE_COMPLETION_CONTEXT,val) #define Val_GtkSourceCompletionContext(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletionContext_new(val) (Val_GObject_sink((GObject*)val)) // static Make_Val_option(GtkSourceCompletionContext) #define GtkSourceCompletion_val(val) check_cast(GTK_SOURCE_COMPLETION,val) #define Val_GtkSourceCompletion(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceCompletion_new(val) (Val_GObject_sink((GObject*)val)) // static Make_Val_option(GtkSourceCompletion) #define GtkSourceStyleScheme_val(val) check_cast(GTK_SOURCE_STYLE_SCHEME,val) #define Val_GtkSourceStyleScheme(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceStyleScheme_new(val) (Val_GObject_new((GObject*)val)) static Make_Val_option(GtkSourceStyleScheme) #define GtkSourceStyleSchemeManager_val(val) \ check_cast(GTK_SOURCE_STYLE_SCHEME_MANAGER,val) #define Val_GtkSourceStyleSchemeManager(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceLanguage(val) (Val_GObject((GObject*)val)) static Make_Val_option(GtkSourceLanguage) #define GtkSourceLanguage_val(val) check_cast(GTK_SOURCE_LANGUAGE,val) #define GtkSourceLanguageManager_val(val)\ check_cast(GTK_SOURCE_LANGUAGE_MANAGER,val) #define Val_GtkSourceLanguageManager(val) (Val_GObject((GObject*)val)) #define GtkSourceTagStyle_val(val) Pointer_val(val) #define GtkSourceMark_val(val) check_cast(GTK_SOURCE_MARK,val) #define Val_GtkSourceMark(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceMark_new(val) (Val_GObject_new((GObject*)val)) static Make_Val_option(GtkSourceMark) #define GtkSourceUndoManager_val(val) check_cast(GTK_SOURCE_UNDO_MANAGER,val) #define Val_GtkSourceUndoManager(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceUndoManager_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceBuffer_val(val) check_cast(GTK_SOURCE_BUFFER,val) #define Val_GtkSourceBuffer(val) (Val_GObject((GObject*)val)) #define Val_GtkSourceBuffer_new(val) (Val_GObject_new((GObject*)val)) #define GtkSourceView_val(val) check_cast(GTK_SOURCE_VIEW,val) #define GtkTextIter_val(val) ((GtkTextIter*)MLPointer_val(val)) #define Val_GtkTextIter(it) (copy_memblock_indirected(it,sizeof(GtkTextIter))) #define string_list_of_GSList(l) Val_GSList(l, (value_in) Val_string) #define GdkPixbuf_option_val(val) Option_val(val, GdkPixbuf_val, NULL) #define GdkColor_option_val(val) Option_val(val, GdkColor_val, NULL) static value val_gtksourcemark(gpointer v) { return Val_GtkSourceMark(v); } value source_marker_list_of_GSList(gpointer list) { return Val_GSList(list, val_gtksourcemark); } static value val_gtksourcelanguage(gpointer v) { return Val_GtkSourceLanguage(v); } value source_language_list_of_GSList(gpointer list) { return Val_GSList(list, val_gtksourcelanguage); } // Completion Make_Flags_val(Source_completion_activation_flags_val) #define Val_Activation_flags(val) \ ml_lookup_flags_getter(ml_table_source_completion_activation_flags, val) // Completion provider typedef struct _CustomObject CustomCompletionProvider; typedef struct _CustomObjectClass CustomCompletionProviderClass; struct _CustomObject { GObject parent; /* this MUST be the first member */ value* caml_object; }; struct _CustomObjectClass { GObjectClass parent; /* this MUST be the first member */ }; typedef struct _CustomObject CustomObject; typedef struct _CustomObjectClass CustomObjectClass; static void custom_object_finalize (GObject *object) { GObjectClass *parent_class; CustomObject* custom = (CustomObject*) object; parent_class = (GObjectClass*) g_type_class_peek_parent (object); ml_global_root_destroy(custom->caml_object); (*parent_class->finalize)(object); } GType custom_completion_provider_get_type(); #define TYPE_CUSTOM_COMPLETION_PROVIDER (custom_completion_provider_get_type ()) #define IS_CUSTOM_COMPLETION_PROVIDER(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), TYPE_CUSTOM_COMPLETION_PROVIDER)) #define METHOD(obj, n) (Field(*(obj->caml_object), n)) // #define METHOD(obj, name) (callback(caml_get_public_method(obj->caml_object, hash_variant(name)), obj->caml_object)) #define METHOD1(obj, n, arg1) (callback(Field(*(obj->caml_object), n), arg1)) #define METHOD2(obj, n, arg1, arg2) (callback2(Field(*(obj->caml_object), n), arg1, arg2)) #define METHOD3(obj, n, arg1, arg2, arg3) (callback3(Field(*(obj->caml_object), n), arg1, arg2, arg3)) CAMLprim value ml_custom_completion_provider_new (value obj) { CAMLparam1(obj); CustomCompletionProvider* p = (CustomCompletionProvider*) g_object_new (TYPE_CUSTOM_COMPLETION_PROVIDER, NULL); g_assert (p != NULL); p->caml_object = ml_global_root_new(obj); CAMLreturn (Val_GtkSourceCompletionProvider_new(p)); } gchar* custom_completion_provider_get_name (GtkSourceCompletionProvider* p) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), NULL); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return g_strdup(string_val (METHOD1(obj, 0, Val_unit))); } GdkPixbuf* custom_completion_provider_get_icon (GtkSourceCompletionProvider* p) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), NULL); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return GdkPixbuf_option_val (METHOD1(obj, 1, Val_unit)); } void custom_completion_provider_populate (GtkSourceCompletionProvider* p, GtkSourceCompletionContext *context) { g_return_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p)); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; METHOD1(obj, 2, Val_GtkSourceCompletionContext(context)); } GtkSourceCompletionActivation custom_completion_provider_get_activation (GtkSourceCompletionProvider* p) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), 0); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Flags_Source_completion_activation_flags_val (METHOD1(obj, 3, Val_unit)); } gboolean custom_completion_provider_match (GtkSourceCompletionProvider* p, GtkSourceCompletionContext *context) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), FALSE); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Bool_val (METHOD1(obj, 4, Val_GtkSourceCompletionContext(context))); } GtkWidget* custom_completion_provider_get_info_widget (GtkSourceCompletionProvider* p, GtkSourceCompletionProposal *proposal) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), NULL); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Option_val (METHOD1(obj, 5, Val_GtkSourceCompletionProposal(proposal)), GtkWidget_val, NULL); } void custom_completion_provider_update_info (GtkSourceCompletionProvider* p, GtkSourceCompletionProposal *proposal, GtkSourceCompletionInfo *info) { g_return_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p)); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; METHOD2(obj, 6, Val_GtkSourceCompletionProposal(proposal), Val_GtkSourceCompletionInfo(info)); } gboolean custom_completion_provider_get_start_iter (GtkSourceCompletionProvider* p, GtkSourceCompletionContext *context, GtkSourceCompletionProposal *proposal, GtkTextIter *iter) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), FALSE); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Bool_val (METHOD3(obj, 7, Val_GtkSourceCompletionContext(context), Val_GtkSourceCompletionProposal(proposal), Val_GtkTextIter(iter))); } gboolean custom_completion_provider_activate_proposal (GtkSourceCompletionProvider* p, GtkSourceCompletionProposal *proposal, GtkTextIter *iter) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), FALSE); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Bool_val (METHOD2(obj, 8, Val_GtkSourceCompletionProposal(proposal), Val_GtkTextIter(iter))); } gint custom_completion_provider_get_interactive_delay (GtkSourceCompletionProvider* p) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), 0); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Int_val (METHOD1(obj, 9, Val_unit)); } gint custom_completion_provider_get_priority (GtkSourceCompletionProvider* p) { g_return_val_if_fail (IS_CUSTOM_COMPLETION_PROVIDER(p), 0); CustomCompletionProvider *obj = (CustomCompletionProvider *) p; return Int_val (METHOD1(obj, 10, Val_unit)); } static void custom_completion_provider_interface_init (GtkSourceCompletionProviderIface *iface, gpointer data) { iface->get_name = custom_completion_provider_get_name; iface->get_icon = custom_completion_provider_get_icon; iface->populate = custom_completion_provider_populate; iface->match = custom_completion_provider_match; iface->get_activation = custom_completion_provider_get_activation; iface->get_info_widget = custom_completion_provider_get_info_widget; iface->update_info = custom_completion_provider_update_info; iface->get_start_iter = custom_completion_provider_get_start_iter; iface->activate_proposal = custom_completion_provider_activate_proposal; iface->get_interactive_delay = custom_completion_provider_get_interactive_delay; iface->get_priority = custom_completion_provider_get_priority; } static void custom_completion_provider_class_init (CustomCompletionProviderClass *c) { GObjectClass *object_class; object_class = (GObjectClass*) c; object_class->finalize = custom_object_finalize; } GType custom_completion_provider_get_type (void) { /* Some boilerplate type registration stuff */ static GType custom_completion_provider_type = 0; if (custom_completion_provider_type == 0) { const GTypeInfo custom_completion_provider_info = { sizeof (CustomCompletionProviderClass), NULL, /* base_init */ NULL, /* base_finalize */ (GClassInitFunc) custom_completion_provider_class_init, NULL, /* class finalize */ NULL, /* class_data */ sizeof (CustomCompletionProvider), 0, /* n_preallocs */ NULL }; static const GInterfaceInfo source_completion_provider_info = { (GInterfaceInitFunc) custom_completion_provider_interface_init, NULL, NULL }; custom_completion_provider_type = g_type_register_static (G_TYPE_OBJECT, "custom_completion_provider", &custom_completion_provider_info, (GTypeFlags)0); /* Here we register our GtkTreeModel interface with the type system */ g_type_add_interface_static (custom_completion_provider_type, GTK_TYPE_SOURCE_COMPLETION_PROVIDER, &source_completion_provider_info); } return custom_completion_provider_type; } ML_1 (gtk_source_completion_provider_get_name, GtkSourceCompletionProvider_val, Val_string) ML_1 (gtk_source_completion_provider_get_icon, GtkSourceCompletionProvider_val, Val_option_GdkPixbuf) ML_2 (gtk_source_completion_provider_populate, GtkSourceCompletionProvider_val, GtkSourceCompletionContext_val, Unit) ML_1 (gtk_source_completion_provider_get_activation, GtkSourceCompletionProvider_val, Val_Activation_flags) ML_2 (gtk_source_completion_provider_match, GtkSourceCompletionProvider_val, GtkSourceCompletionContext_val, Val_bool) // FIXME : this should return a widget option? ML_2 (gtk_source_completion_provider_get_info_widget, GtkSourceCompletionProvider_val, GtkSourceCompletionProposal_val, Val_GtkWidget) ML_3 (gtk_source_completion_provider_update_info, GtkSourceCompletionProvider_val, GtkSourceCompletionProposal_val, GtkSourceCompletionInfo_val, Unit) CAMLprim value ml_gtk_source_completion_provider_get_start_iter (value provider, value context, value proposal) { CAMLparam3(provider, context, proposal); GtkTextIter res; gtk_source_completion_provider_get_start_iter(GtkSourceCompletionProvider_val(provider), GtkSourceCompletionContext_val(context), GtkSourceCompletionProposal_val(proposal), &res); CAMLreturn(Val_GtkTextIter(&res)); } ML_3 (gtk_source_completion_provider_activate_proposal, GtkSourceCompletionProvider_val, GtkSourceCompletionProposal_val, GtkTextIter_val, Val_bool) ML_1 (gtk_source_completion_provider_get_interactive_delay, GtkSourceCompletionProvider_val, Val_int) ML_1 (gtk_source_completion_provider_get_priority, GtkSourceCompletionProvider_val, Val_int) // Completion proposal ML_4 (gtk_source_completion_item_new, String_val, String_val, GdkPixbuf_option_val, String_option_val, Val_GtkSourceCompletionItem_new) ML_4 (gtk_source_completion_item_new_with_markup, String_val, String_val, GdkPixbuf_option_val, String_option_val, Val_GtkSourceCompletionItem_new) ML_4 (gtk_source_completion_item_new_from_stock, String_val, String_val, String_val, String_val, Val_GtkSourceCompletionItem_new) // Completion info ML_3 (gtk_source_completion_info_move_to_iter, GtkSourceCompletionInfo_val, GtkTextView_val, GtkTextIter_val, Unit) ML_5 (gtk_source_completion_info_set_sizing, GtkSourceCompletionInfo_val, Int_val, Int_val, Bool_val, Bool_val, Unit) ML_2 (gtk_source_completion_info_set_widget, GtkSourceCompletionInfo_val, GtkWidget_val, Unit) ML_1 (gtk_source_completion_info_get_widget, GtkSourceCompletionInfo_val, Val_GtkWidget) ML_1 (gtk_source_completion_info_process_resize, GtkSourceCompletionInfo_val, Unit) // Completion context CAMLexport value Val_GtkSourceCompletionProposal_func(gpointer w) { return Val_GtkSourceCompletionProposal(w); } CAMLexport gpointer GtkSourceCompletionProposal_val_func(value val) { CAMLparam1(val); CAMLreturnT (gpointer, GtkSourceCompletionProvider_val(val)); } #define Val_Proposals(val) Val_GList(val, Val_GtkSourceCompletionProposal_func) #define Proposals_val(val) GList_val(val, GtkSourceCompletionProposal_val_func) CAMLexport value ml_gtk_source_completion_context_set_activation (value context, value flags) { g_object_set (GtkSourceCompletionContext_val(context), "activation", Flags_Source_completion_activation_flags_val(flags), NULL); return Val_unit; } ML_1 (gtk_source_completion_context_get_activation, GtkSourceCompletionContext_val, Val_Activation_flags) ML_4 (gtk_source_completion_context_add_proposals, GtkSourceCompletionContext_val, GtkSourceCompletionProvider_val, Proposals_val, Bool_val, Unit) ML_1 (gtk_source_completion_block_interactive, GtkSourceCompletion_val, Unit) CAMLexport value Val_GtkSourceCompletionProvider_func(gpointer w) { return Val_GtkSourceCompletionProvider(w); } CAMLexport gpointer GtkSourceCompletionProvider_val_func(value val) { return GtkSourceCompletionProvider_val(val); } #define Val_Providers(val) Val_GList(val, Val_GtkSourceCompletionProvider_func) #define Providers_val(val) GList_val(val, GtkSourceCompletionProvider_val_func) CAMLexport value ml_gtk_source_completion_add_provider (value completion, value provider) { return Val_bool (gtk_source_completion_add_provider (GtkSourceCompletion_val(completion), GtkSourceCompletionProvider_val(provider), NULL)); } CAMLexport value ml_gtk_source_completion_remove_provider (value completion, value provider) { return Val_bool (gtk_source_completion_remove_provider (GtkSourceCompletion_val(completion), GtkSourceCompletionProvider_val(provider), NULL)); } ML_1 (gtk_source_completion_get_providers, GtkSourceCompletion_val, Val_Providers) ML_3 (gtk_source_completion_show, GtkSourceCompletion_val, Providers_val, GtkSourceCompletionContext_val, Val_bool) ML_1 (gtk_source_completion_hide, GtkSourceCompletion_val, Unit) // gtk_source_completion_get_info_window ML_1 (gtk_source_completion_get_view, GtkSourceCompletion_val, Val_GtkSourceBuffer) ML_2 (gtk_source_completion_create_context, GtkSourceCompletion_val, GtkTextIter_val, Val_GtkSourceCompletionContext_new) ML_2 (gtk_source_completion_move_window, GtkSourceCompletion_val, GtkTextIter_val, Unit) ML_1 (gtk_source_completion_unblock_interactive, GtkSourceCompletion_val, Unit) // Style ML_1 (gtk_source_style_scheme_get_name, GtkSourceStyleScheme_val, Val_string) ML_1 (gtk_source_style_scheme_get_description, GtkSourceStyleScheme_val, Val_string) ML_0 (gtk_source_style_scheme_manager_new, Val_GtkAny_sink) ML_0 (gtk_source_style_scheme_manager_get_default, Val_GtkSourceStyleSchemeManager) ML_2 (gtk_source_style_scheme_manager_get_scheme, GtkSourceStyleSchemeManager_val, String_val, Val_option_GtkSourceStyleScheme) ML_1 (gtk_source_style_scheme_manager_get_scheme_ids, GtkSourceStyleSchemeManager_val, string_list_of_strv) ML_1 (gtk_source_style_scheme_manager_get_search_path, GtkSourceStyleSchemeManager_val, string_list_of_strv) ML_2 (gtk_source_style_scheme_manager_set_search_path, GtkSourceStyleSchemeManager_val, strv_of_string_list, Unit) ML_2 (gtk_source_style_scheme_manager_prepend_search_path, GtkSourceStyleSchemeManager_val, String_val, Unit) ML_2 (gtk_source_style_scheme_manager_append_search_path, GtkSourceStyleSchemeManager_val, String_val, Unit) ML_1 (gtk_source_style_scheme_manager_force_rescan, GtkSourceStyleSchemeManager_val, Unit) ML_1 (gtk_source_language_get_id, GtkSourceLanguage_val, Val_string) ML_1 (gtk_source_language_get_name, GtkSourceLanguage_val, Val_string) ML_1 (gtk_source_language_get_section, GtkSourceLanguage_val, Val_string) ML_1 (gtk_source_language_get_hidden, GtkSourceLanguage_val, Val_bool) ML_2 (gtk_source_language_get_metadata, GtkSourceLanguage_val, String_option_val, Val_optstring) ML_1 (gtk_source_language_get_mime_types, GtkSourceLanguage_val, string_list_of_strv2) ML_1 (gtk_source_language_get_globs, GtkSourceLanguage_val, string_list_of_strv2) ML_2 (gtk_source_language_get_style_name, GtkSourceLanguage_val, String_val, Val_optstring) ML_1 (gtk_source_language_get_style_ids, GtkSourceLanguage_val, string_list_of_strv2) ML_0 (gtk_source_language_manager_new, Val_GtkAny_sink) ML_0(gtk_source_language_manager_get_default,Val_GtkSourceLanguageManager) /* This function leaks the strv. It needs to be freed before returning. */ ML_2(gtk_source_language_manager_set_search_path,GtkSourceLanguageManager_val, strv_of_string_list,Unit) #if 0 // I need to find a test for this code CAMLprim value ml_gtk_source_language_manager_set_search_path(value lm, value sl) { gchar** strv = strv_of_string_list(sl); gchar **index = strv; gtk_source_language_manager_set_search_path(GtkSourceLanguageManager_val(lm),strv); while(*index != NULL) {g_free(*strv); strv++; }; g_free(strv); return Val_unit; } #endif ML_1(gtk_source_language_manager_get_search_path,GtkSourceLanguageManager_val, string_list_of_strv) ML_1(gtk_source_language_manager_get_language_ids,GtkSourceLanguageManager_val, string_list_of_strv) ML_2(gtk_source_language_manager_get_language,GtkSourceLanguageManager_val, String_val,Val_option_GtkSourceLanguage) ML_3 (gtk_source_language_manager_guess_language, GtkSourceLanguageManager_val, String_option_val, String_option_val, Val_option_GtkSourceLanguage) ML_2 (gtk_source_mark_new, String_val, String_val, Val_GtkSourceMark_new) ML_1 (gtk_source_mark_get_category, GtkSourceMark_val, Val_string) ML_2 (gtk_source_mark_next, GtkSourceMark_val, String_option_val, Val_option_GtkSourceMark) ML_2 (gtk_source_mark_prev, GtkSourceMark_val, String_option_val, Val_option_GtkSourceMark) // SourceUndoManager // Defining a custom one: boilerplate typedef struct _CustomObject CustomUndoManager; typedef struct _CustomObjectClass CustomUndoManagerClass; GType custom_undo_manager_get_type(); #define TYPE_CUSTOM_UNDO_MANAGER (custom_undo_manager_get_type ()) #define IS_CUSTOM_UNDO_MANAGER(obj) (G_TYPE_CHECK_INSTANCE_TYPE ((obj), TYPE_CUSTOM_UNDO_MANAGER)) CAMLprim value ml_custom_undo_manager_new (value obj) { CAMLparam1(obj); CustomUndoManager* p = (CustomUndoManager*) g_object_new (TYPE_CUSTOM_UNDO_MANAGER, NULL); g_assert (p != NULL); p->caml_object = ml_global_root_new(obj); CAMLreturn (Val_GtkSourceUndoManager_new(p)); } gboolean custom_undo_manager_can_undo (GtkSourceUndoManager* p) { g_return_val_if_fail (IS_CUSTOM_UNDO_MANAGER(p), FALSE); CustomUndoManager *obj = (CustomUndoManager *) p; return Bool_val (METHOD1(obj, 0, Val_unit)); } gboolean custom_undo_manager_can_redo (GtkSourceUndoManager* p) { g_return_val_if_fail (IS_CUSTOM_UNDO_MANAGER(p), FALSE); CustomUndoManager *obj = (CustomUndoManager *) p; return Bool_val (METHOD1(obj, 1, Val_unit)); } void custom_undo_manager_undo (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 2, Val_unit); } void custom_undo_manager_redo (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 3, Val_unit); } void custom_undo_manager_begin_not_undoable_action (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 4, Val_unit); } void custom_undo_manager_end_not_undoable_action (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 5, Val_unit); } void custom_undo_manager_can_undo_changed (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 6, Val_unit); } void custom_undo_manager_can_redo_changed (GtkSourceUndoManager* p) { g_return_if_fail (IS_CUSTOM_UNDO_MANAGER(p)); CustomUndoManager *obj = (CustomUndoManager *) p; METHOD1(obj, 7, Val_unit); } void custom_undo_manager_class_init (CustomUndoManagerClass* c) { GObjectClass *object_class; object_class = (GObjectClass*) c; object_class->finalize = custom_object_finalize; } void custom_undo_manager_interface_init (GtkSourceUndoManagerIface *iface, gpointer data) { iface->can_undo = custom_undo_manager_can_undo; iface->can_redo = custom_undo_manager_can_redo; iface->undo = custom_undo_manager_undo; iface->redo = custom_undo_manager_redo; iface->begin_not_undoable_action = custom_undo_manager_begin_not_undoable_action; iface->end_not_undoable_action = custom_undo_manager_end_not_undoable_action; iface->can_undo_changed = custom_undo_manager_can_undo_changed; iface->can_redo_changed = custom_undo_manager_can_redo_changed; } GType custom_undo_manager_get_type (void) { /* Some boilerplate type registration stuff */ static GType custom_undo_manager_type = 0; if (custom_undo_manager_type == 0) { const GTypeInfo custom_undo_manager_info = { sizeof (CustomUndoManagerClass), NULL, /* base_init */ NULL, /* base_finalize */ (GClassInitFunc) custom_undo_manager_class_init, NULL, /* class finalize */ NULL, /* class_data */ sizeof (CustomUndoManager), 0, /* n_preallocs */ NULL }; static const GInterfaceInfo source_undo_manager_info = { (GInterfaceInitFunc) custom_undo_manager_interface_init, NULL, NULL }; custom_undo_manager_type = g_type_register_static (G_TYPE_OBJECT, "custom_undo_manager", &custom_undo_manager_info, (GTypeFlags)0); /* Here we register our GtkTreeModel interface with the type system */ g_type_add_interface_static (custom_undo_manager_type, GTK_TYPE_SOURCE_UNDO_MANAGER, &source_undo_manager_info); } return custom_undo_manager_type; } ML_1 (gtk_source_undo_manager_can_undo, GtkSourceUndoManager_val, Val_bool) ML_1 (gtk_source_undo_manager_can_redo, GtkSourceUndoManager_val, Val_bool) ML_1 (gtk_source_undo_manager_undo, GtkSourceUndoManager_val, Unit) ML_1 (gtk_source_undo_manager_redo, GtkSourceUndoManager_val, Unit) ML_1 (gtk_source_undo_manager_begin_not_undoable_action, GtkSourceUndoManager_val, Unit) ML_1 (gtk_source_undo_manager_end_not_undoable_action, GtkSourceUndoManager_val, Unit) ML_1 (gtk_source_undo_manager_can_undo_changed, GtkSourceUndoManager_val, Unit) ML_1 (gtk_source_undo_manager_can_redo_changed, GtkSourceUndoManager_val, Unit) // SourceBuffer ML_1 (gtk_source_buffer_new, GtkTextTagTable_val, Val_GtkSourceBuffer_new) ML_1 (gtk_source_buffer_new_with_language, GtkSourceLanguage_val, Val_GtkAny_sink) ML_1 (gtk_source_buffer_can_undo, GtkSourceBuffer_val, Val_bool) ML_1 (gtk_source_buffer_can_redo, GtkSourceBuffer_val, Val_bool) ML_1 (gtk_source_buffer_undo, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_redo, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_begin_not_undoable_action, GtkSourceBuffer_val, Unit) ML_1 (gtk_source_buffer_end_not_undoable_action, GtkSourceBuffer_val, Unit) ML_4 (gtk_source_buffer_create_source_mark, GtkSourceBuffer_val, String_option_val, String_option_val, GtkTextIter_val, Val_GtkSourceMark) ML_4 (gtk_source_buffer_remove_source_marks, GtkSourceBuffer_val, GtkTextIter_val, GtkTextIter_val, String_option_val, Unit) ML_3 (gtk_source_buffer_get_source_marks_at_iter, GtkSourceBuffer_val, GtkTextIter_val,String_option_val, source_marker_list_of_GSList) ML_3 (gtk_source_buffer_get_source_marks_at_line, GtkSourceBuffer_val, Int_val,String_option_val, source_marker_list_of_GSList) ML_3 (gtk_source_buffer_forward_iter_to_source_mark, GtkSourceBuffer_val, GtkTextIter_val, String_option_val, Val_bool) ML_3 (gtk_source_buffer_backward_iter_to_source_mark, GtkSourceBuffer_val, GtkTextIter_val, String_option_val, Val_bool) ML_3 (gtk_source_buffer_iter_has_context_class, GtkSourceBuffer_val, GtkTextIter_val, String_val, Val_bool) ML_3 (gtk_source_buffer_iter_forward_to_context_class_toggle, GtkSourceBuffer_val, GtkTextIter_val, String_val, Val_bool) ML_3 (gtk_source_buffer_iter_backward_to_context_class_toggle, GtkSourceBuffer_val, GtkTextIter_val, String_val, Val_bool) ML_3 (gtk_source_buffer_ensure_highlight, GtkSourceBuffer_val, GtkTextIter_val, GtkTextIter_val, Unit) ML_2 (gtk_source_buffer_set_highlight_matching_brackets, GtkSourceBuffer_val, Bool_val, Unit); ML_0 (gtk_source_view_new, Val_GtkWidget_sink) ML_1 (gtk_source_view_new_with_buffer, GtkSourceBuffer_val, Val_GtkWidget_sink) ML_2 (gtk_source_view_get_mark_category_priority, GtkSourceView_val, String_val, Val_int) ML_3 (gtk_source_view_set_mark_category_priority, GtkSourceView_val, String_val, Int_val, Unit) ML_3 (gtk_source_view_set_mark_category_pixbuf, GtkSourceView_val, String_val, GdkPixbuf_option_val, Unit) ML_2 (gtk_source_view_get_mark_category_pixbuf, GtkSourceView_val, String_val, Val_option_GdkPixbuf) ML_3 (gtk_source_view_set_mark_category_background, GtkSourceView_val, String_val, GdkColor_option_val, Unit) CAMLprim value ml_gtk_source_view_get_mark_category_background (value sv, value s, value c) { CAMLparam3(sv, s, c); CAMLlocal2(color, result); GdkColor dest; if (gtk_source_view_get_mark_category_background( GtkSourceView_val(sv), String_val(s), &dest)) { color = Val_copy(dest); result = alloc_small(1, 0); Field(result, 0) = color; } else result = Val_unit; CAMLreturn(result); } ML_1 (gtk_source_view_get_completion, GtkSourceView_val, Val_GtkSourceCompletion) Make_Flags_val(Source_draw_spaces_flags_val) #define Val_flags_Draw_spaces_flags(val) \ ml_lookup_flags_getter(ml_table_source_draw_spaces_flags, val) ML_1 (gtk_source_view_get_draw_spaces, GtkSourceView_val, Val_flags_Draw_spaces_flags) ML_2 (gtk_source_view_set_draw_spaces, GtkSourceView_val, Flags_Source_draw_spaces_flags_val, Unit) /* This code was taken from gedit */ /* assign a unique name */ static G_CONST_RETURN gchar * get_widget_name (GtkWidget *w) { const gchar *name; name = gtk_widget_get_name (w); g_return_val_if_fail (name != NULL, NULL); if (strcmp (name, g_type_name (GTK_WIDGET_TYPE (w))) == 0) { static guint d = 0; gchar *n; n = g_strdup_printf ("%s_%u_%u", name, d, g_random_int()); d++; gtk_widget_set_name (w, n); g_free (n); name = gtk_widget_get_name (w); } return name; } /* There is no clean way to set the cursor-color, so we are stuck * with the following hack: set the name of each widget and parse * a gtkrc string. */ static void gtk_modify_cursor_color (GtkWidget *textview, GdkColor *color) { static const char cursor_color_rc[] = "style \"svs-cc\"\n" "{\n" "GtkSourceView::cursor-color=\"#%04x%04x%04x\"\n" "}\n" "widget \"*.%s\" style : application \"svs-cc\"\n"; const gchar *name; gchar *rc_temp; name = get_widget_name (textview); g_return_if_fail (name != NULL); if (color != NULL) { rc_temp = g_strdup_printf (cursor_color_rc, color->red, color->green, color->blue, name); } else { GtkRcStyle *rc_style; rc_style = gtk_widget_get_modifier_style (textview); rc_temp = g_strdup_printf (cursor_color_rc, rc_style->text [GTK_STATE_NORMAL].red, rc_style->text [GTK_STATE_NORMAL].green, rc_style->text [GTK_STATE_NORMAL].blue, name); } gtk_rc_parse_string (rc_temp); gtk_widget_reset_rc_styles (textview); g_free (rc_temp); } /* end of gedit code */ ML_2(gtk_modify_cursor_color,GtkWidget_val,GdkColor_val,Unit); #define Make_search(dir) \ CAMLprim value ml_gtk_source_iter_##dir##_search (value ti,\ value str,\ value flag,\ value ti_stop,\ value ti_start,\ value ti_lim)\ { CAMLparam5(ti,str,flag,ti_start,ti_stop);\ CAMLxparam1(ti_lim);\ CAMLlocal2(res,coup);\ GtkTextIter* ti1,*ti2;\ gboolean b;\ ti1=gtk_text_iter_copy(GtkTextIter_val(ti_start));\ ti2=gtk_text_iter_copy(GtkTextIter_val(ti_stop));\ b=gtk_source_iter_##dir##_search(GtkTextIter_val(ti),\ String_val(str),\ OptFlags_Source_search_flag_val(flag),\ ti1,\ ti2,\ Option_val(ti_lim,GtkTextIter_val,NULL));\ if (!b) res = Val_unit;\ else \ { res = alloc(1,0);\ coup = alloc_tuple(2);\ Store_field(coup,0,Val_GtkTextIter(ti1));\ Store_field(coup,1,Val_GtkTextIter(ti2));\ Store_field(res,0,coup);};\ CAMLreturn(res);} Make_search(forward); Make_search(backward); ML_bc6(ml_gtk_source_iter_forward_search); ML_bc6(ml_gtk_source_iter_backward_search); lablgtk-2.18.8/src/gBin.mli0000644000175000017500000002517413460263323014446 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** Containers with just one child *) (** {3 GtkScrolledWindow } *) (** Adds scrollbars to its child widget @gtkdoc gtk GtkScrolledWindow *) class scrolled_window : Gtk.scrolled_window obj -> object inherit GContainer.bin val obj : Gtk.scrolled_window obj method connect : container_signals method add_with_viewport : widget -> unit method set_hadjustment : GData.adjustment -> unit method set_hpolicy : Tags.policy_type -> unit method set_placement : Tags.corner_type -> unit method set_shadow_type : Tags.shadow_type -> unit method set_vadjustment : GData.adjustment -> unit method set_vpolicy : Tags.policy_type -> unit method hadjustment : GData.adjustment method shadow_type : Gtk.Tags.shadow_type method hpolicy : Tags.policy_type method placement : Tags.corner_type method vadjustment : GData.adjustment method vpolicy : Tags.policy_type end (** @gtkdoc gtk GtkScrolledWindow *) val scrolled_window : ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?hpolicy:Tags.policy_type -> ?vpolicy:Tags.policy_type -> ?placement:Tags.corner_type -> ?shadow_type:Gtk.Tags.shadow_type -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> scrolled_window (** {3 GtkEventBox} *) (** A widget used to catch events for widgets which do not have their own window @gtkdoc gtk GtkEventBox *) class event_box : ([> Gtk.event_box] as 'a) obj -> object inherit GContainer.bin val obj : 'a obj method connect : container_signals method event : event_ops end (** @gtkdoc gtk GtkEventBox *) val event_box : ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> event_box class invisible : ([> Gtk.invisible] as 'a) obj -> object inherit GContainer.bin val obj : 'a obj method connect : container_signals method event : event_ops end val invisible : ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> invisible (** {3 GtkHandleBox} *) (** @gtkdoc gtk GtkHandleBox *) class handle_box_signals : 'a obj -> object inherit GContainer.container_signals constraint 'a = [> handle_box] val obj : 'a obj method child_attached : callback:(widget -> unit) -> GtkSignal.id method child_detached : callback:(widget -> unit) -> GtkSignal.id method notify_handle_position : callback:(GtkEnums.position_type -> unit) -> GtkSignal.id method notify_shadow_type : callback:(GtkEnums.shadow_type -> unit) -> GtkSignal.id method notify_snap_edge : callback:(GtkEnums.position_type -> unit) -> GtkSignal.id end (** A widget for detachable window portions @gtkdoc gtk GtkHandleBox *) class handle_box : Gtk.handle_box obj -> object inherit GContainer.bin val obj : Gtk.handle_box obj method event : event_ops method connect : handle_box_signals method set_handle_position : Tags.position -> unit method set_shadow_type : Tags.shadow_type -> unit method set_snap_edge : Tags.position -> unit method handle_position : Tags.position method shadow_type : Tags.shadow_type method snap_edge : Tags.position end (** @gtkdoc gtk GtkHandleBox *) val handle_box : ?handle_position:Tags.position -> ?snap_edge:Tags.position -> ?shadow_type:Tags.shadow_type -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> handle_box (** {3 GtkFrame & GtkAspectFrame} *) class frame_skel : 'a obj -> object inherit GContainer.bin constraint 'a = [> frame] val obj : 'a obj method set_label : string option -> unit method set_label_widget : GObj.widget option -> unit method set_label_xalign : float -> unit method set_label_yalign : float -> unit method set_shadow_type : Tags.shadow_type -> unit method label : string option method label_widget : GObj.widget option method label_xalign : float method label_yalign : float method shadow_type : Tags.shadow_type end (** A bin with a decorative frame and optional label @gtkdoc gtk GtkFrame *) class frame : Gtk.frame obj -> object inherit frame_skel val obj : Gtk.frame obj method connect : GContainer.container_signals end (** @gtkdoc gtk GtkFrame *) val frame : ?label:string -> ?label_xalign:clampf -> ?label_yalign:clampf -> ?shadow_type:Tags.shadow_type -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> frame (** A frame that constrains its child to a particular aspect ratio @gtkdoc gtk GtkAspectFrame *) class aspect_frame : Gtk.aspect_frame obj -> object inherit frame val obj : Gtk.aspect_frame obj method set_obey_child : bool -> unit method set_ratio : float -> unit method set_xalign : float -> unit method set_yalign : float -> unit method obey_child : bool method ratio : float method xalign : float method yalign : float end (** @gtkdoc gtk GtkAspectFrame *) val aspect_frame : ?obey_child:bool -> ?ratio:float -> ?xalign:clampf -> ?yalign:clampf -> ?label:string -> ?label_xalign:clampf -> ?label_yalign:clampf -> ?shadow_type:Tags.shadow_type -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> aspect_frame (** {3 GtkViewport} *) (** @gtkdoc gtk GtkViewport *) class viewport : Gtk.viewport obj -> object inherit GContainer.bin val obj : Gtk.viewport obj method connect : container_signals method event : event_ops method set_hadjustment : GData.adjustment -> unit method set_shadow_type : Tags.shadow_type -> unit method set_vadjustment : GData.adjustment -> unit method hadjustment : GData.adjustment method shadow_type : Tags.shadow_type method vadjustment : GData.adjustment end (** @gtkdoc gtk GtkViewport *) val viewport : ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?shadow_type:Tags.shadow_type -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> viewport (** {3 GtkAlignment} A widget which controls the alignment and size of its child *) (** @gtkdoc gtk GtkAlignment *) class alignment : Gtk.alignment obj -> object inherit GContainer.bin val obj : Gtk.alignment obj method connect : container_signals method set_xalign : Gtk.clampf -> unit method set_yalign : Gtk.clampf -> unit method set_xscale : Gtk.clampf -> unit method set_yscale : Gtk.clampf -> unit method xalign : Gtk.clampf method yalign : Gtk.clampf method xscale : Gtk.clampf method yscale : Gtk.clampf method set_top_padding : int -> unit (** @since GTK 2.4 *) method set_bottom_padding : int -> unit (** @since GTK 2.4 *) method set_left_padding : int -> unit (** @since GTK 2.4 *) method set_right_padding : int -> unit (** @since GTK 2.4 *) method top_padding : int (** @since GTK 2.4 *) method bottom_padding : int (** @since GTK 2.4 *) method left_padding : int (** @since GTK 2.4 *) method right_padding : int (** @since GTK 2.4 *) end (** @gtkdoc gtk GtkAlignment *) val alignment : ?padding:int * int * int * int -> ?xalign:Gtk.clampf -> ?yalign:Gtk.clampf -> ?xscale:Gtk.clampf -> ?yscale:Gtk.clampf -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> alignment val alignment_cast : #widget -> alignment (** {3 GtkExpander} A container which can hide its child *) (** @since GTK 2.4 @gtkdoc gtk GtkExpander *) class expander_signals : ([> Gtk.expander] as 'a) Gtk.obj -> object inherit GContainer.container_signals val obj : 'a obj method activate : callback:(unit -> unit) -> GtkSignal.id method notify_expanded : callback:(bool -> unit) -> GtkSignal.id method notify_label : callback:(string -> unit) -> GtkSignal.id method notify_label_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_spacing : callback:(int -> unit) -> GtkSignal.id method notify_use_underline : callback:(bool -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkExpander *) class expander : ([> Gtk.expander ] as 'a) Gtk.obj -> object inherit GContainer.bin val obj : 'a Gtk.obj method connect : expander_signals method expanded : bool method label : string method label_widget : GObj.widget method set_expanded : bool -> unit method set_label : string -> unit method set_label_widget : GObj.widget -> unit method set_spacing : int -> unit method set_use_underline : bool -> unit method spacing : int method use_underline : bool end (** @since GTK 2.4 @gtkdoc gtk GtkExpander *) val expander : ?expanded:bool -> ?label:string -> ?spacing:int -> ?use_underline:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> expander lablgtk-2.18.8/src/xml_lexer.mli0000644000175000017500000000750513460263323015564 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** Simple XML lexer *) (** This module provides an [ocamllex] lexer for XML files. It only supports the most basic features of the XML specification. The lexer altogether ignores the following 'events': comments, processing instructions, XML prolog and doctype declaration. The predefined entities ([&], [<], etc.) are supported. The replacement text for other entities whose entity value consist of character data can be provided to the lexer (see {!Xml_lexer.entities}). Internal entities declarations are {e not} taken into account (the lexer just skips the doctype declaration). [CDATA] sections and character references are supported. See {!Xml_lexer.strip_ws} about whitespace handling. *) (** {3 Error reporting} *) type error = | Illegal_character of char | Bad_entity of string | Unterminated of string | Tag_expected | Attribute_expected | Other of string val error_string : error -> string exception Error of error * int (** This exception is raised in case of an error during the parsing. The [int] argument indicates the character position in the buffer. Note that some non-conforming XML documents might not trigger an error. *) (** {3 API} *) (** The type of the XML document elements *) type token = | Tag of string * (string * string) list * bool (** [Tag (name, attributes, empty)] denotes an opening tag with the specified [name] and [attributes]. If [empty], then the tag ended in "/>", meaning that it has no sub-elements. *) | Chars of string (** Some text between the tags *) | Endtag of string (** A closing tag *) | EOF (** End of input *) val strip_ws : bool ref (** Whitespace handling: if [strip_ws] is [true] (the default), whitespaces next to a tag are ignored. Character data consisting only of whitespaces is thus suppressed (i.e. [Chars ""] tokens are skipped). *) val entities : (string * string) list ref (** An association list of entities definitions. Initially, it contains the predefined entities ([ ["amp", "&"; "lt", "<" ...] ]). *) val token : Lexing.lexbuf -> token (** The entry point of the lexer. @return the next token in the buffer @raise Error in case of an invalid XML document *) lablgtk-2.18.8/src/gdkEvent.ml0000644000175000017500000002167013460263323015162 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gdk open Tags external unsafe_copy : Gpointer.boxed -> [< event_type] event = "ml_gdk_event_copy" external copy : ([< event_type] as 'a) event -> 'a event = "ml_gdk_event_copy" external get_type : 'a event -> 'a = "ml_GdkEventAny_type" external get_window : 'a event -> window = "ml_GdkEventAny_window" external get_send_event : 'a event -> bool = "ml_GdkEventAny_send_event" type timed = [ `MOTION_NOTIFY | `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE | `SCROLL | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `PROPERTY_NOTIFY | `SELECTION_CLEAR | `SELECTION_REQUEST | `SELECTION_NOTIFY | `PROXIMITY_IN | `PROXIMITY_OUT | `DRAG_ENTER | `DRAG_LEAVE | `DRAG_MOTION | `DRAG_STATUS | `DROP_START | `DROP_FINISHED ] external get_time : [< timed] event -> int32 = "ml_gdk_event_get_time" external create : ([< event_type] as 'a) -> 'a event = "ml_gdk_event_new" external set_window : 'a event -> window -> unit = "ml_gdk_event_set_window" type any = event_type event external unsafe_cast : [< event_type] event -> [< event_type] event = "%identity" let cast ~(kind : ([< event_type] as 'a) list) (ev : any) : 'a event = if List.mem (Obj.magic (get_type ev) : [> ]) kind then unsafe_cast ev else invalid_arg "GdkEvent.cast" module Expose = struct type t = [ `EXPOSE ] event let cast ev : t = cast ev ~kind:[`EXPOSE] external area : t -> Rectangle.t = "ml_GdkEventExpose_area" external region : t -> region = "ml_GdkEventExpose_region" external count : t -> int = "ml_GdkEventExpose_count" end module Visibility = struct type t = [ `VISIBILITY_NOTIFY ] event let cast ev : t = cast ev ~kind:[`VISIBILITY_NOTIFY] external visibility : t -> visibility_state = "ml_GdkEventVisibility_state" end module Motion = struct type t = [ `MOTION_NOTIFY ] event let cast ev : t = cast ev ~kind:[`MOTION_NOTIFY] let time = get_time external x : t -> float = "ml_GdkEventMotion_x" external y : t -> float = "ml_GdkEventMotion_y" external axes : t -> (float * float) option = "ml_GdkEventMotion_axes" external state : t -> int = "ml_GdkEventMotion_state" external is_hint : t -> bool = "ml_GdkEventMotion_is_hint" external device : t -> device = "ml_GdkEventMotion_device" external x_root : t -> float = "ml_GdkEventMotion_x_root" external y_root : t -> float = "ml_GdkEventMotion_y_root" end module Button = struct type types = [ `BUTTON_PRESS|`TWO_BUTTON_PRESS|`THREE_BUTTON_PRESS|`BUTTON_RELEASE ] type t = types event let cast ev : t = cast ev ~kind:[`BUTTON_PRESS;`TWO_BUTTON_PRESS; `THREE_BUTTON_PRESS;`BUTTON_RELEASE] let time = get_time external x : t -> float = "ml_GdkEventButton_x" external y : t -> float = "ml_GdkEventButton_y" external axes : t -> (float * float) option = "ml_GdkEventButton_axes" external state : t -> int = "ml_GdkEventButton_state" external button : t -> int = "ml_GdkEventButton_button" external device : t -> device = "ml_GdkEventButton_device" external x_root : t -> float = "ml_GdkEventButton_x_root" external y_root : t -> float = "ml_GdkEventButton_y_root" external set_type : t -> [< types] -> unit = "ml_gdk_event_set_type" external set_button : t -> int -> unit = "ml_gdk_event_button_set_button" end module Scroll = struct type t = [ `SCROLL ] event let cast ev : t = cast ev ~kind:[`SCROLL] let time = get_time external x : t -> float = "ml_GdkEventScroll_x" external y : t -> float = "ml_GdkEventScroll_y" external state : t -> int = "ml_GdkEventScroll_state" external direction : t -> scroll_direction = "ml_GdkEventScroll_direction" external device : t -> device = "ml_GdkEventScroll_device" external x_root : t -> float = "ml_GdkEventScroll_x_root" external y_root : t -> float = "ml_GdkEventScroll_y_root" end module Key = struct type t = [ `KEY_PRESS|`KEY_RELEASE ] event let cast ev : t = cast ev ~kind:[`KEY_PRESS;`KEY_RELEASE] let time = get_time external state : t -> int = "ml_GdkEventKey_state" external keyval : t -> keysym = "ml_GdkEventKey_keyval" external string : t -> string = "ml_GdkEventKey_string" external hardware_keycode : t -> int = "ml_GdkEventKey_hardware_keycode" external group : t -> int = "ml_GdkEventKey_group" let state ev = Convert.modifier (state ev) end module Crossing = struct type t = [ `ENTER_NOTIFY|`LEAVE_NOTIFY ] event let cast ev : t = cast ev ~kind:[`ENTER_NOTIFY;`LEAVE_NOTIFY] external subwindow : t -> window = "ml_GdkEventCrossing_subwindow" let time = get_time external x : t -> float = "ml_GdkEventCrossing_x" external y : t -> float = "ml_GdkEventCrossing_y" external x_root : t -> float = "ml_GdkEventCrossing_x_root" external y_root : t -> float = "ml_GdkEventCrossing_y_root" external mode : t -> crossing_mode = "ml_GdkEventCrossing_mode" external detail : t -> notify_type = "ml_GdkEventCrossing_detail" external focus : t -> bool = "ml_GdkEventCrossing_focus" external state : t -> int = "ml_GdkEventCrossing_state" end module Focus = struct type t = [ `FOCUS_CHANGE ] event let cast ev : t = cast ev ~kind:[`FOCUS_CHANGE] external focus_in : t -> bool = "ml_GdkEventFocus_in" end module Configure = struct type t = [ `CONFIGURE ] event let cast ev : t = cast ev ~kind:[`CONFIGURE] external x : t -> int = "ml_GdkEventConfigure_x" external y : t -> int = "ml_GdkEventConfigure_y" external width : t -> int = "ml_GdkEventConfigure_width" external height : t -> int = "ml_GdkEventConfigure_height" end module Property = struct type t = [ `PROPERTY_NOTIFY ] event let cast ev : t = cast ev ~kind:[`PROPERTY_NOTIFY] external atom : t -> atom = "ml_GdkEventProperty_atom" let time = get_time external state : t -> int = "ml_GdkEventProperty_state" end module Selection = struct type t = [ `SELECTION_CLEAR|`SELECTION_REQUEST|`SELECTION_NOTIFY ] event let cast ev : t = cast ev ~kind:[`SELECTION_CLEAR;`SELECTION_REQUEST;`SELECTION_NOTIFY] external selection : t -> atom = "ml_GdkEventSelection_selection" external target : t -> atom = "ml_GdkEventSelection_target" external property : t -> atom = "ml_GdkEventSelection_property" external requestor : t -> native_window = "ml_GdkEventSelection_requestor" let time = get_time end module Proximity = struct type t = [ `PROXIMITY_IN|`PROXIMITY_OUT ] event let cast ev : t = cast ev ~kind:[`PROXIMITY_IN;`PROXIMITY_OUT] let time = get_time external device : t -> device = "ml_GdkEventProximity_device" end module Client = struct type t = [ `CLIENT_EVENT ] event let cast ev : t = cast ev ~kind:[`CLIENT_EVENT] external window : t -> window = "ml_GdkEventClient_window" external message_type : t -> atom = "ml_GdkEventClient_message_type" external data : t -> xdata_ret = "ml_GdkEventClient_data" end module Setting = struct type t = [ `SETTING ] event let cast ev : t = cast ev ~kind:[`SETTING] external action : t -> setting_action = "ml_GdkEventSetting_action" external name : t -> string = "ml_GdkEventSetting_name" end module WindowState = struct type t = [ `WINDOW_STATE ] event let cast ev : t = cast ev ~kind:[`WINDOW_STATE] external changed_mask : t -> int = "ml_GdkEventWindowState_changed_mask" external new_window_state : t -> int = "ml_GdkEventWindowState_new_window_state" let changed_mask ev = Convert.window_state (changed_mask ev) let new_window_state ev = Convert.window_state (new_window_state ev) end lablgtk-2.18.8/src/gnoCanvas.mli0000644000175000017500000002262313460263323015502 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** [libgnomecanvas] bindings *) type items_properties = [ | `NO_WIDGET | `NO_FILL_COLOR | `NO_OUTLINE_COLOR | `NO_FONT | `NO_TEXT | `NO_BPATH | `NO_PIXBUF | `ANCHOR of Gtk.Tags.anchor_type | `ARROW_SHAPE_A of float | `ARROW_SHAPE_B of float | `ARROW_SHAPE_C of float | `BPATH of GnomeCanvas.PathDef.t | `CAP_STYLE of Gdk.GC.gdkCapStyle | `CLIP of bool | `CLIP_HEIGHT of float | `CLIP_WIDTH of float | `CURSOR_BLINK of bool | `CURSOR_VISIBLE of bool | `DASH of float * float array | `EDITABLE of bool | `FAMILY of string | `FILL_COLOR of string | `FILL_COLOR_RGBA of int32 | `FILL_STIPPLE of Gdk.bitmap | `FIRST_ARROWHEAD of bool | `FONT of string | `GROW_HEIGHT of bool | `HEIGHT of float | `JOIN_STYLE of Gdk.GC.gdkJoinStyle | `JUSTIFICATION of Gtk.Tags.justification | `LAST_ARROWHEAD of bool | `LEFT_MARGIN of int | `LINE_STYLE of Gdk.GC.gdkLineStyle | `MARKUP of string | `OUTLINE_COLOR of string | `OUTLINE_COLOR_RGBA of int32 | `OUTLINE_STIPPLE of Gdk.bitmap | `PIXBUF of GdkPixbuf.pixbuf | `POINTS of float array | `RIGHT_MARGIN of int | `RISE of int | `SCALE of float | `SIZE of int | `SIZE_PIXELS of bool | `SIZE_POINTS of float | `SMOOTH of bool | `TEXT of string | `VISIBLE of bool | `WEIGHT of int | `WIDGET of GObj.widget | `WIDTH of float | `WIDTH_PIXELS of int | `WIDTH_UNITS of float | `X of float | `X1 of float | `X2 of float | `X_OFFSET of float | `Y of float | `Y1 of float | `Y2 of float | `Y_OFFSET of float ] val propertize : [< items_properties] -> string * unit Gobject.data_set type item_event = [ | `BUTTON_PRESS of GdkEvent.Button.t | `TWO_BUTTON_PRESS of GdkEvent.Button.t | `THREE_BUTTON_PRESS of GdkEvent.Button.t | `BUTTON_RELEASE of GdkEvent.Button.t | `MOTION_NOTIFY of GdkEvent.Motion.t | `KEY_PRESS of GdkEvent.Key.t | `KEY_RELEASE of GdkEvent.Key.t | `ENTER_NOTIFY of GdkEvent.Crossing.t | `LEAVE_NOTIFY of GdkEvent.Crossing.t | `FOCUS_CHANGE of GdkEvent.Focus.t ] class item_signals : 'b Gtk.obj -> object constraint 'b = [> GnomeCanvas.item] inherit GObj.gtkobj_signals val obj : 'b Gtk.obj method event : callback:(item_event -> bool) -> GtkSignal.id end (** @gtkdoc libgnomecanvas GnomeCanvasItem *) class base_item : ([> GnomeCanvas.item] as 'b) Gtk.obj -> object inherit GObj.gtkobj val obj : 'b Gtk.obj method parent : group method reparent : group -> unit method as_item : GnomeCanvas.item Gtk.obj method connect : item_signals method get_bounds : float array method grab : Gdk.Tags.event_mask list -> Gdk.cursor -> int32 -> unit method grab_focus : unit -> unit method hide : unit -> unit method i2c_affine : float array method i2w : x:float -> y:float -> float * float method i2w_affine : float array method lower : int -> unit method lower_to_bottom : unit -> unit method move : x:float -> y:float -> unit method canvas : canvas method xform : [`IDENTITY|`TRANSL of float array|`AFFINE of float array] method affine_relative : float array -> unit method affine_absolute : float array -> unit method raise : int -> unit method raise_to_top : unit -> unit method show : unit -> unit method ungrab : int32 -> unit method w2i : x:float -> y:float -> float * float end (** @gtkdoc libgnomecanvas GnomeCanvasGroup *) and group : GnomeCanvas.group Gtk.obj -> object inherit base_item val obj : GnomeCanvas.group Gtk.obj method as_group : GnomeCanvas.group Gtk.obj method get_items : base_item list method set : GnomeCanvas.group_p list -> unit end (** @gtkdoc libgnomecanvas GnomeCanvas *) and canvas : GnomeCanvas.canvas Gtk.obj -> object inherit GPack.layout val obj : GnomeCanvas.canvas Gtk.obj method aa : bool method c2w : cx:int -> cy:int -> float * float method get_center_scroll_region : bool method get_item_at : x:float -> y:float -> base_item (** @raise Not_found . *) method get_scroll_offsets : int * int method get_scroll_region : float array method root : group method scroll_to : x:int -> y:int -> unit method set_center_scroll_region : bool -> unit method set_pixels_per_unit : float -> unit method set_scroll_region : x1:float -> y1:float -> x2:float -> y2:float -> unit method update_now : unit -> unit method w2c : wx:float -> wy:float -> int * int method w2c_affine : float array method w2c_d : wx:float -> wy:float -> float * float method window_to_world : winx:float -> winy:float -> float * float method world_to_window : wox:float -> woy:float -> float * float end (** @gtkdoc libgnomecanvas GnomeCanvasItem *) class ['p] item : ([> GnomeCanvas.item] as 'a) Gtk.obj -> object inherit base_item val obj : 'a Gtk.obj constraint 'p = [< items_properties] method set : 'p list -> unit end (** @gtkdoc libgnomecanvas GnomeCanvas *) val canvas : ?aa:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> canvas (** @gtkdoc libgnomecanvas GnomeCanvasGroup *) val group : ?x:float -> ?y:float -> #group -> group val wrap_item : [> GnomeCanvas.item] Gtk.obj -> ('a, 'p) GnomeCanvas.Types.t -> 'p item type rect = GnomeCanvas.re_p item (** @gtkdoc libgnomecanvas GnomeCanvasRect *) val rect : ?x1:float -> ?y1:float -> ?x2:float -> ?y2:float -> ?fill_color:string -> ?props:GnomeCanvas.re_p list -> #group -> rect type ellipse = GnomeCanvas.re_p item (** @gtkdoc libgnomecanvas GnomeCanvasEllipse *) val ellipse : ?x1:float -> ?y1:float -> ?x2:float -> ?y2:float -> ?fill_color:string -> ?props:GnomeCanvas.re_p list -> #group -> ellipse (** @gtkdoc libgnomecanvas GnomeCanvasText *) class text : GnomeCanvas.text Gtk.obj -> object inherit [GnomeCanvas.text_p] item val obj : GnomeCanvas.text Gtk.obj method text_height : float method text_width : float end (** @gtkdoc libgnomecanvas GnomeCanvasText *) val text : ?x:float -> ?y:float -> ?text:string -> ?font:string -> ?size:int -> ?anchor:Gtk.Tags.anchor_type -> ?props:GnomeCanvas.text_p list -> #group -> text type line = GnomeCanvas.line_p item (** @gtkdoc libgnomecanvas GnomeCanvasLine *) val line : ?points:float array -> ?fill_color:string -> ?props:GnomeCanvas.line_p list -> #group -> line type bpath = GnomeCanvas.bpath_p item (** @gtkdoc libgnomecanvas GnomeCanvasBpath *) val bpath : ?bpath:GnomeCanvas.PathDef.t -> ?fill_color:string -> ?props:GnomeCanvas.bpath_p list -> #group -> bpath type pixbuf = GnomeCanvas.pixbuf_p item (** @gtkdoc libgnomecanvas GnomeCanvasPixbuf *) val pixbuf : ?x:float -> ?y:float -> ?pixbuf:GdkPixbuf.pixbuf -> ?width:float -> ?height:float -> ?props:GnomeCanvas.pixbuf_p list -> #group -> pixbuf type polygon = GnomeCanvas.polygon_p item (** @gtkdoc libgnomecanvas GnomeCanvasPolygon *) val polygon : ?points:float array -> ?fill_color:string -> ?props:GnomeCanvas.polygon_p list -> #group -> polygon type widget = GnomeCanvas.widget_p item (** @gtkdoc libgnomecanvas GnomeCanvasWidget *) val widget : ?widget:< coerce: GObj.widget; .. > -> ?x:float -> ?y:float -> ?width:float -> ?height:float -> ?props:GnomeCanvas.widget_p list -> #group -> widget (** @gtkdoc libgnomecanvas GnomeCanvasRichtext *) class rich_text : GnomeCanvas.rich_text Gtk.obj -> object inherit [GnomeCanvas.rich_text_p] item val obj : GnomeCanvas.rich_text Gtk.obj method copy_clipboard : unit -> unit method cut_clipboard : unit -> unit method paste_clipboard : unit -> unit method get_buffer : GText.buffer end (** @gtkdoc libgnomecanvas GnomeCanvasRichtext *) val rich_text : ?x:float -> ?y:float -> ?text:string -> ?width:float -> ?height:float -> ?props:GnomeCanvas.rich_text_p list -> #group -> rich_text lablgtk-2.18.8/src/glade.mli0000644000175000017500000001042113460263323014630 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (* This module provides some low-level interfacing with libglade *) external init : unit -> unit = "ml_glade_init" (* You must call [init] before importing any glade specification *) (* Returns immediately if already initialized *) (* The raw glade XML widget *) type glade_xml = [ `data | `glade_xml] val create : ?file:string -> ?data:string -> ?root:string -> ?domain:string -> unit -> glade_xml Gtk.obj (* One of [file] or [data] must be given, [data] is preferred when *) (* both are given. If [root] is omitted the first widget is used *) (* as root. [domain] is for localization. *) val signal_autoconnect : [> `glade_xml] Gtk.obj -> f:(handler:string -> signal:string -> after:bool -> ?target:unit Gtk.obj -> unit Gtk.obj -> unit) -> unit external get_widget : [> `glade_xml] Gtk.obj -> name:string -> Gtk.widget Gtk.obj = "ml_glade_xml_get_widget" external get_widget_name : [> `widget] Gtk.obj -> string = "ml_glade_get_widget_name" external get_widget_tree : [> `widget] Gtk.obj -> glade_xml Gtk.obj = "ml_glade_get_widget_tree" val get_widget_msg : name:string -> ?info:string -> [> `glade_xml] Gtk.obj -> Gtk.widget Gtk.obj (* Same as get_widget, but fails with a useful message including info, rather than just raising Gpointer.Null *) (* Handler bindings *) type handler = [ `Simple of unit -> unit | `Object of string * (unit Gtk.obj -> unit) | `Custom of Gobject.Closure.argv -> Gobject.data_get list -> unit] val gtk_bool : bool -> Gobject.Closure.argv -> 'a -> unit val add_handler : name:string -> handler -> unit (* Add a global handler for some well known name. The default ones (gtk_main_quit, gtk_widget_destroy, ...) are already defined. *) val bind_handlers : ?extra:(string * handler) list -> ?warn:bool -> [> `glade_xml] Gtk.obj -> unit (* Bind handlers on a glade widget. You may add some local bindings specific to this widget. Warn for missing handlers. *) val bind_handler : name:string -> handler:handler -> ?warn:bool -> [> `glade_xml] Gtk.obj -> unit (* Bind an individual handler. Warn if unused. *) val print_bindings : out_channel -> [> `glade_xml] Gtk.obj -> unit (* List all the bindings in a xml widget *) val trace_handlers : out_channel -> [> `glade_xml] Gtk.obj -> unit (* trace calls to glade handlers *) (* Class skeleton, for use in generated wrappers *) class xml : ?trace:out_channel -> ?autoconnect:bool -> glade_xml Gtk.obj -> object val xml : glade_xml Gtk.obj method xml : glade_xml Gtk.obj method bind : name:string -> callback:(unit -> unit) -> unit end (* wrap a glade_xml widget, and run signal_autoconnect (default) *) lablgtk-2.18.8/src/gtkMisc.ml0000644000175000017500000000436013460263323015011 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkMiscProps open GtkBase external _gtkmisc_init : unit -> unit = "ml_gtkmisc_init" let () = _gtkmisc_init () module GammaCurve = GammaCurve module ColorSelection = ColorSelection module Statusbar = Statusbar module StatusIcon = GtkStatusIcon module Calendar = Calendar module DrawingArea = DrawingArea module Curve = Curve module Misc = struct include Misc let all_params ~cont = make_params ~cont:(Widget.size_params ~cont) end module Arrow = Arrow module Image = Image module Label = Label module TipsQuery = TipsQuery module Separator = Separator module FontSelection = FontSelection lablgtk-2.18.8/src/gContainer.mli0000644000175000017500000001225213460263323015651 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj (** Widgets which contain other widgets *) class focus : 'a obj -> object constraint 'a = [> `container] val obj : 'a obj (* method circulate : Tags.direction_type -> bool *) method set : widget option -> unit method set_hadjustment : GData.adjustment option -> unit method set_vadjustment : GData.adjustment option -> unit end (** {3 GtkContainer} *) (** Base class for widgets which contain other widgets @gtkdoc gtk GtkContainer *) class container : ([> Gtk.container] as 'a) obj -> object inherit GObj.widget val obj : 'a obj method add : widget -> unit method children : widget list (* using foreach *) method all_children : widget list (* using forall *) method remove : widget -> unit method focus : focus method set_border_width : int -> unit method set_resize_mode : Tags.resize_mode -> unit method border_width : int method resize_mode : Tags.resize_mode end (** @gtkdoc gtk GtkContainer *) class ['a] container_impl :([> Gtk.container] as 'a) obj -> object inherit container inherit ['a] GObj.objvar end (** @gtkdoc gtk GtkContainer *) class type container_signals = object inherit GObj.widget_signals method add : callback:(widget -> unit) -> GtkSignal.id method remove : callback:(widget -> unit) -> GtkSignal.id method notify_border_width : callback:(int -> unit) -> GtkSignal.id method notify_resize_mode : callback:(GtkEnums.resize_mode -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkContainer *) class container_signals_impl : ([> Gtk.container] as 'a) obj -> object inherit ['a] GObj.gobject_signals inherit container_signals end (** @gtkdoc gtk GtkContainer *) class container_full : ([> Gtk.container] as 'a) obj -> object inherit container val obj : 'a obj method connect : container_signals end (** @raise Gtk.Cannot_cast "GtkContainer" *) val cast_container : widget -> container_full (** @gtkdoc gtk GtkContainer *) val pack_container : create:(([> Gtk.container] as 'a) Gobject.param list -> (#GObj.widget as 'b)) -> 'a Gobject.param list -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> 'b (** {3 GtkBin} *) (** @gtkdoc gtk GtkBin *) class bin : ([> Gtk.bin] as 'a) obj -> object inherit container val obj : 'a obj method child : widget (** @raise Gpointer.Null if the widget has no child. *) end (** @gtkdoc gtk GtkBin *) class ['a] bin_impl :([> Gtk.bin] as 'a) obj -> object inherit bin inherit ['a] GObj.objvar end (** {3 GtkItem} *) (** @gtkdoc gtk GtkContainer *) class virtual ['a] item_container : ([> Gtk.container] as 'c) obj -> object constraint 'a = < as_item : [>`widget] obj; .. > inherit GObj.widget val obj : 'c obj method add : 'a -> unit method append : 'a -> unit method children : 'a list method all_children : 'a list method virtual insert : 'a -> pos:int -> unit method prepend : 'a -> unit method remove : 'a -> unit method focus : focus method set_border_width : int -> unit method set_resize_mode : Tags.resize_mode -> unit method border_width : int method resize_mode : Tags.resize_mode method private virtual wrap : Gtk.widget obj -> 'a end (** @gtkdoc gtk GtkItem *) class item_signals : [> Gtk.item] obj -> object inherit container_signals method deselect : callback:(unit -> unit) -> GtkSignal.id method select : callback:(unit -> unit) -> GtkSignal.id method toggle : callback:(unit -> unit) -> GtkSignal.id end lablgtk-2.18.8/src/ml_gtkpack.c0000644000175000017500000002066613460263323015345 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" Make_Flags_val (Attach_options_val) /* Init all */ CAMLprim value ml_gtkpack_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_hbox_get_type() + gtk_vbox_get_type() + gtk_hbutton_box_get_type() + gtk_vbutton_box_get_type() + gtk_fixed_get_type() + gtk_layout_get_type() + gtk_notebook_get_type() + gtk_hpaned_get_type() + gtk_vpaned_get_type() + gtk_table_get_type() + gtk_size_group_get_type(); return Val_GType(t); } /* gtkbox.h */ #define GtkBox_val(val) check_cast(GTK_BOX,val) ML_5 (gtk_box_pack_start, GtkBox_val, GtkWidget_val, Bool_val, Bool_val, Int_val, Unit) ML_5 (gtk_box_pack_end, GtkBox_val, GtkWidget_val, Bool_val, Bool_val, Int_val, Unit) ML_3 (gtk_box_reorder_child, GtkBox_val, GtkWidget_val, Int_val, Unit) CAMLprim value ml_gtk_box_query_child_packing (value box, value child) { int expand, fill; unsigned int padding; GtkPackType pack_type; value ret; gtk_box_query_child_packing (GtkBox_val(box), GtkWidget_val(child), &expand, &fill, &padding, &pack_type); ret = alloc_small(4,0); Field(ret,0) = Val_bool(expand); Field(ret,1) = Val_bool(fill); Field(ret,2) = Val_int(padding); Field(ret,3) = Val_pack_type(pack_type); return ret; } CAMLprim value ml_gtk_box_set_child_packing (value vbox, value vchild, value vexpand, value vfill, value vpadding, value vpack) { GtkBox *box = GtkBox_val(vbox); GtkWidget *child = GtkWidget_val(vchild); int expand, fill; unsigned int padding; GtkPackType pack; gtk_box_query_child_packing (box, child, &expand, &fill, &padding, &pack); gtk_box_set_child_packing (box, child, Option_val(vexpand, Bool_val, expand), Option_val(vfill, Bool_val, fill), Option_val(vpadding, Int_val, padding), Option_val(vpack, Pack_type_val, pack)); return Val_unit; } ML_bc6 (ml_gtk_box_set_child_packing) /* gtkbbox.h */ #define GtkButtonBox_val(val) check_cast(GTK_BUTTON_BOX,val) Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_min_width, Val_int) Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_min_height, Val_int) Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_ipad_x, Val_int) Make_Extractor (gtk_button_box_get, GtkButtonBox_val, child_ipad_y, Val_int) Make_Extractor (gtk_button_box_get, GtkButtonBox_val, layout_style, Val_button_box_style) ML_3 (gtk_button_box_set_child_size, GtkButtonBox_val, Int_val, Int_val, Unit) ML_3 (gtk_button_box_set_child_ipadding, GtkButtonBox_val, Int_val, Int_val, Unit) #ifdef HASGTK24 ML_2 (gtk_button_box_get_child_secondary, GtkButtonBox_val, GtkWidget_val, Val_bool) ML_3 (gtk_button_box_set_child_secondary, GtkButtonBox_val, GtkWidget_val, Bool_val, Unit) #else Unsupported_24 (gtk_button_box_get_child_secondary) Unsupported_24 (gtk_button_box_set_child_secondary) #endif /* gtkfixed.h */ #define GtkFixed_val(val) check_cast(GTK_FIXED,val) ML_4 (gtk_fixed_put, GtkFixed_val, GtkWidget_val, (gint16)Long_val, (gint16)Long_val, Unit) ML_4 (gtk_fixed_move, GtkFixed_val, GtkWidget_val, (gint16)Long_val, (gint16)Long_val, Unit) ML_2 (gtk_fixed_set_has_window, GtkFixed_val, Int_val, Unit) ML_1 (gtk_fixed_get_has_window, GtkFixed_val, Val_bool) /* gtklayout.h */ #define GtkLayout_val(val) check_cast(GTK_LAYOUT,val) ML_4 (gtk_layout_put, GtkLayout_val, GtkWidget_val, Int_val, Int_val, Unit) ML_4 (gtk_layout_move, GtkLayout_val, GtkWidget_val, Int_val, Int_val, Unit) ML_1 (gtk_layout_freeze, GtkLayout_val, Unit) ML_1 (gtk_layout_thaw, GtkLayout_val, Unit) Make_Extractor(gtk_layout, GtkLayout_val, bin_window, Val_GdkWindow) /* gtknotebook.h */ #define GtkNotebook_val(val) check_cast(GTK_NOTEBOOK,val) #ifdef HASGTK24 ML_5 (gtk_notebook_insert_page_menu, GtkNotebook_val, GtkWidget_val, GtkWidget_val, GtkWidget_val, Option_val(arg5,Int_val,(-1)) Ignore, Val_int) #else CAMLprim value ml_gtk_notebook_insert_page_menu(value nb, value w1, value w2, value w3, value pos) { gtk_notebook_insert_page_menu(GtkNotebook_val(nb), GtkWidget_val(w1), GtkWidget_val(w2), GtkWidget_val(w3), Option_val(pos,Int_val,-1)); return Val_int(gtk_notebook_get_current_page(GtkNotebook_val(nb))); } #endif ML_2 (gtk_notebook_remove_page, GtkNotebook_val, Int_val, Unit) ML_1 (gtk_notebook_get_current_page, GtkNotebook_val, Val_int) ML_2 (gtk_notebook_get_nth_page, GtkNotebook_val, Int_val, Val_GtkWidget) ML_2 (gtk_notebook_page_num, GtkNotebook_val, GtkWidget_val, Val_int) ML_1 (gtk_notebook_next_page, GtkNotebook_val, Unit) ML_1 (gtk_notebook_prev_page, GtkNotebook_val, Unit) ML_2 (gtk_notebook_get_tab_label, GtkNotebook_val, GtkWidget_val, Val_GtkWidget) ML_3 (gtk_notebook_set_tab_label, GtkNotebook_val, GtkWidget_val, GtkWidget_val, Unit) ML_2 (gtk_notebook_get_menu_label, GtkNotebook_val, GtkWidget_val, Val_GtkWidget) ML_3 (gtk_notebook_set_menu_label, GtkNotebook_val, GtkWidget_val, GtkWidget_val, Unit) ML_3 (gtk_notebook_reorder_child, GtkNotebook_val, GtkWidget_val, Int_val, Unit) ML_3 (gtk_notebook_set_tab_reorderable, GtkNotebook_val, GtkWidget_val, Bool_val, Unit) ML_2 (gtk_notebook_get_tab_reorderable, GtkNotebook_val, GtkWidget_val, Val_bool) /* gtkpaned.h */ #define GtkPaned_val(val) check_cast(GTK_PANED,val) ML_2 (gtk_paned_add1, GtkPaned_val, GtkWidget_val, Unit) ML_2 (gtk_paned_add2, GtkPaned_val, GtkWidget_val, Unit) ML_4 (gtk_paned_pack1, GtkPaned_val, GtkWidget_val, Int_val, Int_val, Unit) ML_4 (gtk_paned_pack2, GtkPaned_val, GtkWidget_val, Int_val, Int_val, Unit) Make_Extractor (gtk_paned, GtkPaned_val, child1, Val_GtkWidget) Make_Extractor (gtk_paned, GtkPaned_val, child2, Val_GtkWidget) /* gtktable.h */ #define GtkTable_val(val) check_cast(GTK_TABLE,val) ML_10 (gtk_table_attach, GtkTable_val, GtkWidget_val, Int_val, Int_val, Int_val, Int_val, Flags_Attach_options_val, Flags_Attach_options_val, Int_val, Int_val, Unit) ML_bc10 (ml_gtk_table_attach) ML_3 (gtk_table_set_row_spacing, GtkTable_val, Int_val, Int_val, Unit) ML_3 (gtk_table_set_col_spacing, GtkTable_val, Int_val, Int_val, Unit) /* gtksizegroup.h */ #define GtkSizeGroup_val(val) check_cast(GTK_SIZE_GROUP,val) ML_2 (gtk_size_group_add_widget, GtkSizeGroup_val, GtkWidget_val, Unit) ML_2 (gtk_size_group_remove_widget, GtkSizeGroup_val, GtkWidget_val, Unit) lablgtk-2.18.8/src/gtkWindow.ml0000644000175000017500000001674613460263323015400 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkBaseProps open GtkBase external _gtkwindow_init : unit -> unit = "ml_gtkwindow_init" let () = _gtkwindow_init () module Window = struct include Window external set_wmclass : [>`window] obj -> name:string -> clas:string -> unit = "ml_gtk_window_set_wmclass" external get_wmclass_name : [>`window] obj -> string = "ml_gtk_window_get_wmclass_name" external get_wmclass_class : [>`window] obj -> string = "ml_gtk_window_get_wmclass_class" external add_accel_group : [>`window] obj -> accel_group -> unit = "ml_gtk_window_add_accel_group" external remove_accel_group : [>`window] obj -> accel_group -> unit = "ml_gtk_window_remove_accel_group" external activate_focus : [>`window] obj -> bool = "ml_gtk_window_activate_focus" external activate_default : [>`window] obj -> bool = "ml_gtk_window_activate_default" external set_geometry_hints : [>`window] obj -> ?pos: bool -> ?min_size: int * int -> ?max_size: int * int -> ?base_size: int * int -> ?aspect: float * float -> ?resize_inc: int * int -> ?win_gravity: Gdk.Tags.gravity -> ?user_pos: bool -> ?user_size: bool -> [>`widget] obj -> unit = "ml_gtk_window_set_geometry_hints_bc" "ml_gtk_window_set_geometry_hints" external list_toplevels : unit -> window obj list = "ml_gtk_window_list_toplevels" external add_mnemonic : [>`window] obj -> Gdk.keysym -> [>`widget] obj -> unit = "ml_gtk_window_add_mnemonic" external remove_mnemonic : [>`window] obj -> Gdk.keysym -> [>`widget] obj -> unit = "ml_gtk_window_remove_mnemonic" external activate_mnemonic : [>`window] obj -> ?modi: Gdk.Tags.modifier list -> Gdk.keysym -> unit = "ml_gtk_window_mnemonic_activate" external get_focus : [>`window] obj -> widget obj = "ml_gtk_window_get_focus" (* set_focus/default are called by Widget.grab_focus/default *) external set_focus : [>`window] obj -> [>`widget] obj -> unit = "ml_gtk_window_set_focus" external set_default : [>`window] obj -> [>`widget] obj -> unit = "ml_gtk_window_set_default" (* see gtk.props for others *) let set_wmclass ?name ?clas:wm_class w = set_wmclass w ~name:(may_default get_wmclass_name w ~opt:name) ~clas:(may_default get_wmclass_class w ~opt:wm_class) end module Dialog = struct include Dialog external action_area : [>`dialog] obj -> button_box obj = "ml_GtkDialog_action_area" external vbox : [>`dialog] obj -> box obj = "ml_GtkDialog_vbox" external add_button : [>`dialog] obj -> string -> int -> unit = "ml_gtk_dialog_add_button" external response : [>`dialog] obj -> int -> unit = "ml_gtk_dialog_response" external set_response_sensitive : [>`dialog] obj -> int -> bool -> unit = "ml_gtk_dialog_set_response_sensitive" external set_default_response : [>`dialog] obj -> int -> unit = "ml_gtk_dialog_set_default_response" external run : [>`dialog] obj -> int = "ml_gtk_dialog_run" let std_response = Gpointer.encode_variant GtkEnums.response let decode_response = Gpointer.decode_variant GtkEnums.response end module MessageDialog = struct include MessageDialog external create : ?parent:[>`window] obj -> message_type:Gtk.Tags.message_type -> buttons:Gtk.Tags.buttons -> message:string -> unit -> message_dialog obj = "ml_gtk_message_dialog_new" external set_markup : [>`messagedialog] obj -> string -> unit = "ml_gtk_message_dialog_set_markup" end module AboutDialog = struct include AboutDialog external create : unit -> Gtk.about_dialog obj = "ml_gtk_about_dialog_new" external set_email_hook : (string -> unit) -> unit = "ml_gtk_about_dialog_set_email_hook" external set_url_hook : (string -> unit) -> unit = "ml_gtk_about_dialog_set_url_hook" end module FileSelection = struct include FileSelection external create : string -> file_selection obj = "ml_gtk_file_selection_new" external complete : [>`fileselection] obj -> filter:string -> unit = "ml_gtk_file_selection_complete" external get_ok_button : [>`fileselection] obj -> button obj = "ml_gtk_file_selection_get_ok_button" external get_cancel_button : [>`fileselection] obj -> button obj = "ml_gtk_file_selection_get_cancel_button" external get_help_button : [>`fileselection] obj -> button obj = "ml_gtk_file_selection_get_help_button" external get_file_list : [>`fileselection] obj -> clist obj = "ml_gtk_file_selection_get_file_list" external get_dir_list : [>`fileselection] obj -> clist obj = "ml_gtk_file_selection_get_dir_list" external get_selections : [>`fileselection] obj -> string list = "ml_gtk_file_selection_get_selections" end module ColorSelectionDialog = struct include ColorSelectionDialog external ok_button : [>`colorselectiondialog] obj -> button obj = "ml_gtk_color_selection_dialog_ok_button" external cancel_button : [>`colorselectiondialog] obj -> button obj = "ml_gtk_color_selection_dialog_cancel_button" external help_button : [>`colorselectiondialog] obj -> button obj = "ml_gtk_color_selection_dialog_help_button" external colorsel : [>`colorselectiondialog] obj -> color_selection obj = "ml_gtk_color_selection_dialog_colorsel" end module FontSelectionDialog = struct include FontSelectionDialog external font_selection : [>`fontselectiondialog] obj -> font_selection obj = "ml_gtk_font_selection_dialog_fontsel" external ok_button : [>`fontselectiondialog] obj -> button obj = "ml_gtk_font_selection_dialog_ok_button" external apply_button : [>`fontselectiondialog] obj -> button obj = "ml_gtk_font_selection_dialog_apply_button" external cancel_button : [>`fontselectiondialog] obj -> button obj = "ml_gtk_font_selection_dialog_cancel_button" end module Plug = struct include Plug external create : Gdk.native_window -> plug obj = "ml_gtk_plug_new" end module Socket = Socket lablgtk-2.18.8/src/ml_gtkxmhtml.c0000644000175000017500000001162413460263323015732 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtkxmhtml_tags.h" /* conversion functions */ #include "gtkxmhtml_tags.c" Make_Flags_val (Line_type_val) #define GtkXmHTML_val(val) ((GtkXmHTML*)GtkObject_val(val)) ML_0 (gtk_xmhtml_new, Val_GtkAny_sink) ML_1 (gtk_xmhtml_freeze, GtkXmHTML_val, Unit) ML_1 (gtk_xmhtml_thaw, GtkXmHTML_val, Unit) ML_2 (gtk_xmhtml_source, GtkXmHTML_val, String_val, Unit) ML_2 (gtk_xmhtml_set_string_direction, GtkXmHTML_val, String_direction_val, Unit) ML_2 (gtk_xmhtml_set_alignment, GtkXmHTML_val, Alignment_val, Unit) /* ML_2 (gtk_xmhtml_outline, GtkXmHTML_val, Bool_val, Unit) */ ML_3 (gtk_xmhtml_set_font_familty, GtkXmHTML_val, String_val, String_val, Unit) ML_3 (gtk_xmhtml_set_font_familty_fixed, GtkXmHTML_val, String_val, String_val, Unit) ML_2 (gtk_xmhtml_set_font_charset, GtkXmHTML_val, String_val, Unit) ML_2 (gtk_xmhtml_set_allow_body_colors, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_hilight_on_enter, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_anchor_underline_type, GtkXmHTML_val, Flags_Line_type_val, Unit) ML_2 (gtk_xmhtml_set_anchor_visited_underline_type, GtkXmHTML_val, Flags_Line_type_val, Unit) ML_2 (gtk_xmhtml_set_anchor_target_underline_type, GtkXmHTML_val, Flags_Line_type_val, Unit) ML_2 (gtk_xmhtml_set_allow_color_switching, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_dithering, GtkXmHTML_val, Dither_type_val, Unit) ML_2 (gtk_xmhtml_set_allow_font_switching, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_max_image_colors, GtkXmHTML_val, Int_val, Unit) ML_2 (gtk_xmhtml_set_allow_images, GtkXmHTML_val, Bool_val, Unit) ML_4 (gtk_xmhtml_set_plc_intervals, GtkXmHTML_val, Int_val, Int_val, Int_val, Unit) /* ML_2 (gtk_xmhtml_set_def_body_image_url, GtkXmHTML_val, String_val, Unit) */ ML_2 (gtk_xmhtml_set_anchor_buttons, GtkXmHTML_val, Bool_val, Unit) CAMLprim value ml_gtk_xmhtml_set_anchor_cursor(value html, value cursor) { gtk_xmhtml_set_anchor_cursor (GtkXmHTML_val(html), Option_val(cursor, GdkCursor_val, NULL), Bool_val(cursor)); return Val_unit; } ML_2 (gtk_xmhtml_set_topline, GtkXmHTML_val, Int_val, Unit) ML_1 (gtk_xmhtml_get_topline, GtkXmHTML_val, Val_int) ML_2 (gtk_xmhtml_set_freeze_animations, GtkXmHTML_val, Bool_val, Unit) /* ML_1 (gtk_xmhtml_get_source, GtkXmHTML_val, copy_string) */ ML_2 (gtk_xmhtml_set_screen_gamma, GtkXmHTML_val, Float_val, Unit) /* ML_2 (gtk_xmhtml_set_event_proc, GtkXmHTML_val, ???, Unit) */ ML_2 (gtk_xmhtml_set_perfect_colors, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_uncompress_command, GtkXmHTML_val, String_val, Unit) ML_2 (gtk_xmhtml_set_strict_checking, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_bad_html_warnings, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_allow_form_coloring, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_imagemap_draw, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_mime_type, GtkXmHTML_val, String_val, Unit) ML_2 (gtk_xmhtml_set_alpha_processing, GtkXmHTML_val, Bool_val, Unit) ML_2 (gtk_xmhtml_set_rgb_conv_mode, GtkXmHTML_val, Dither_type_val, Unit) lablgtk-2.18.8/src/ml_gdk.h0000644000175000017500000001043513460263323014464 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #define GdkAtom_val(val) ((GdkAtom)Long_val(val)) #define Val_GdkAtom(val) (Val_long((long)val)) #define GdkColormap_val(val) check_cast(GDK_COLORMAP,val) #define Val_GdkColormap Val_GAnyObject #define GdkColor_val(val) ((GdkColor*)MLPointer_val(val)) #define Val_GdkColor Val_pointer #define GdkRectangle_val(val) ((GdkRectangle*)MLPointer_val(val)) #define Val_GdkRectangle Val_pointer #define GdkDrawable_val(val) check_cast(GDK_DRAWABLE,val) #define GdkWindow_val(val) check_cast(GDK_WINDOW,val) #define Val_GdkWindow Val_GAnyObject #define GdkCursor_val(val) ((GdkCursor*)Pointer_val(val)) #define GdkDisplay_val(val) ((GdkDisplay*) val) #define Val_GdkDisplay(display) ((value) display) CAMLexport GdkPixmap *GdkPixmap_val (value); /* check argument */ #define Val_GdkPixmap Val_GAnyObject #define Val_GdkPixmap_no_ref Val_GAnyObject_new #define GdkBitmap_val(val) ((GdkBitmap*)GdkPixmap_val(val)) #define Val_GdkBitmap Val_GdkPixmap #define Val_GdkBitmap_no_ref Val_GdkPixmap_no_ref #ifndef UnsafeImage CAMLexport GdkImage *GdkImage_val (value); /* check argument */ #else #define GdkImage_val(val) check_cast(GDK_IMAGE,val) #endif #define Val_GdkImage Val_GAnyObject #define Val_GdkImage_new Val_GAnyObject_new #define GdkFont_val(val) ((GdkFont*)Pointer_val(val)) CAMLexport value Val_GdkFont (GdkFont *); CAMLexport GdkRegion *GdkRegion_val (value); /* check argument */ CAMLexport value Val_GdkRegion (GdkRegion *); /* finalizer is destroy! */ #define GdkGC_val(val) check_cast(GDK_GC,val) #define Val_GdkGC Val_GAnyObject #define Val_GdkGC_no_ref Val_GAnyObject_new #define GdkEvent_val (GdkEvent*)MLPointer_val CAMLexport value Val_GdkEvent (GdkEvent *); #define GdkVisual_val(val) ((GdkVisual*) val) #define Val_GdkVisual(visual) ((value) visual) #define GdkScreen_val(val) check_cast(GDK_SCREEN,val) #define Val_GdkScreen Val_GAnyObject #define GdkDevice_val(val) ((GdkDevice*) val) #define Val_GdkDevice(device) ((value) device) // Future replacement for XID? #ifdef GDK_NATIVE_WINDOW_POINTER #define GdkNativeWindow_val Pointer_val #define Val_GdkNativeWindow Val_pointer #else #define Val_GdkNativeWindow copy_int32 #define GdkNativeWindow_val Int32_val #endif #ifdef _WIN32 #define Val_XID(id) copy_int32((long) id) #else #define Val_XID copy_int32 #endif #define XID_val Int32_val CAMLexport int OptFlags_GdkModifier_val (value); CAMLexport int Flags_GdkModifier_val (value); CAMLexport int Flags_Event_mask_val (value); CAMLexport lookup_info *ml_table_extension_events; #define Extension_events_val(key) ml_lookup_to_c(ml_table_extension_events,key) #define GdkDragContext_val(val) check_cast(GDK_DRAG_CONTEXT,val) #define Val_GdkDragContext Val_GAnyObject CAMLexport int Flags_GdkDragAction_val (value); lablgtk-2.18.8/src/ml_glade.c0000644000175000017500000001125013460263323014762 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" ML_0 (glade_init, Unit) /* ML_0 (glade_gnome_init, Unit) */ #define GladeXML_val(val) (check_cast(GLADE_XML,val)) /* glade_xml_new_with_domain and glade_xml_new_from_memory are deprecated */ #ifndef glade_xml_new_with_domain #define glade_xml_new_with_domain glade_xml_new #endif #ifndef glade_xml_new_from_memory #define glade_xml_new_from_memory glade_xml_new_from_buffer #endif CAMLprim value ml_glade_xml_new (value file, value data, value root, value domain) { GladeXML *ret; if (Is_block(data)) ret = glade_xml_new_from_memory (String_val(Field(data,0)), string_length(Field(data,0)), String_option_val(root), String_option_val(domain)); else if (Is_block(file)) ret = glade_xml_new_with_domain (String_val(Field(file,0)), String_option_val(root), String_option_val(domain)); else invalid_argument ("Glade.create"); return Val_GObject_new (&ret->parent); } void ml_glade_callback_marshal (const gchar *handler_name, GObject *object, const gchar *signal_name, const gchar *signal_data, GObject *connect_object, gboolean after, gpointer user_data) { value vargs = alloc(5,0); value tmp; CAMLparam1 (vargs); #define set(variable, expr) tmp = expr; initialize(&variable, tmp); set(Field(vargs,0), Val_string(handler_name)); set(Field(vargs,1), Val_GObject(object)); set(Field(vargs,2), Val_string(signal_name)); set(Field(vargs,3), Val_option(connect_object, Val_GObject)); set(Field(vargs,4), Val_bool(after)); #undef set callback_exn (*(value*)user_data, vargs); CAMLreturn0; } CAMLprim value ml_glade_xml_signal_autoconnect_full (value self, value clos) { value *clos_p = ml_global_root_new (clos); glade_xml_signal_autoconnect_full (GladeXML_val(self), ml_glade_callback_marshal, clos_p); return Val_unit; } CAMLprim value ml_glade_xml_signal_connect_full (value self, value name, value clos) { value *clos_p = ml_global_root_new (clos); glade_xml_signal_connect_full (GladeXML_val(self), String_val(name), ml_glade_callback_marshal, clos_p); return Val_unit; } ML_2 (glade_xml_get_widget, GladeXML_val, String_val, Val_GtkWidget) ML_1 (glade_get_widget_name, GtkWidget_val, Val_string) ML_1 (glade_get_widget_tree, GtkWidget_val, Val_GtkAny) lablgtk-2.18.8/src/gtkSourceView2_types.mli0000644000175000017500000000630113460263323017665 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* * lablgtksourceview, OCaml binding for the GtkSourceView text widget * * Copyright (C) 2005 Stefano Zacchiroli * * This library is free software; you can redistribute it and/or modify * it under the terms of the GNU Lesser General Public License as * published by the Free Software Foundation; either version 2.1 of the * License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, but * WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 * USA *) type source_style_scheme = [`sourcestylescheme] type source_style_scheme_manager = [`sourcestyleschememanager] type source_completion_info = [ Gtk.window | `sourcecompletioninfo ] type source_completion_provider = [ `sourcecompletionprovider ] type source_completion_proposal = [ `sourcecompletionproposal ] type source_completion_activation = [ `sourcecompletionactivation ] type source_completion_context = [ `sourcecompletioncontext ] type source_completion = [ `sourcecompletion ] type source_view = [ Gtk.text_view | `sourceview ] type source_mark = [ `sourcemark ] type source_buffer = [`textbuffer|`sourcebuffer] type source_language = [`sourcelanguage] type source_language_manager = [`sourcelanguagemanager] type source_undo_manager = [`sourceundomanager] lablgtk-2.18.8/src/ml_gtkbroken.c0000644000175000017500000001174213460263323015702 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* GtkTree and GtkText are broken, but some people still want them */ #define GTK_ENABLE_BROKEN 1 #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkbroken_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_tree_item_get_type() + gtk_tree_get_type() + gtk_old_editable_get_type () + gtk_text_get_type () ; return Val_GType(t); } #define Tree_view_mode_val(val) \ (val == MLTAG_ITEM ? GTK_TREE_VIEW_ITEM : GTK_TREE_VIEW_LINE) /* gtktreeitem.h */ #define GtkTreeItem_val(val) check_cast(GTK_TREE_ITEM,val) ML_0 (gtk_tree_item_new, Val_GtkWidget_sink) ML_1 (gtk_tree_item_new_with_label, String_val, Val_GtkWidget_sink) ML_2 (gtk_tree_item_set_subtree, GtkTreeItem_val, GtkWidget_val, Unit) ML_1 (gtk_tree_item_remove_subtree, GtkTreeItem_val, Unit) ML_1 (gtk_tree_item_expand, GtkTreeItem_val, Unit) ML_1 (gtk_tree_item_collapse, GtkTreeItem_val, Unit) ML_1 (GTK_TREE_ITEM_SUBTREE, GtkTreeItem_val, Val_GtkWidget) /* gtktree.h */ #define GtkTree_val(val) check_cast(GTK_TREE,val) ML_0 (gtk_tree_new, Val_GtkWidget_sink) ML_3 (gtk_tree_insert, GtkTree_val, GtkWidget_val, Int_val, Unit) ML_3 (gtk_tree_clear_items, GtkTree_val, Int_val, Int_val, Unit) ML_2 (gtk_tree_select_item, GtkTree_val, Int_val, Unit) ML_2 (gtk_tree_unselect_item, GtkTree_val, Int_val, Unit) ML_2 (gtk_tree_child_position, GtkTree_val, GtkWidget_val, Val_int) ML_2 (gtk_tree_set_selection_mode, GtkTree_val, Selection_mode_val, Unit) ML_2 (gtk_tree_set_view_mode, GtkTree_val, Tree_view_mode_val, Unit) ML_2 (gtk_tree_set_view_lines, GtkTree_val, Bool_val, Unit) static value val_gtkany (gpointer p) { return Val_GtkAny(p); } CAMLprim value ml_gtk_tree_selection (value tree) { GList *selection = GTK_TREE_SELECTION_OLD(GtkTree_val(tree)); return Val_GList(selection, val_gtkany); } static gpointer gtkobject_val (value val) { return GtkObject_val(val); } CAMLprim value ml_gtk_tree_remove_items (value tree, value items) { GList *items_list = GList_val (items, gtkobject_val); gtk_tree_remove_items (GtkTree_val(tree), items_list); return Val_unit; } /* gtkoldeditable.h */ #define GtkOldEditable_val(val) check_cast(GTK_OLD_EDITABLE,val) ML_3 (gtk_old_editable_claim_selection, GtkOldEditable_val, Bool_val, Int_val, Unit) ML_1 (gtk_old_editable_changed, GtkOldEditable_val, Unit) /* gtktext.h */ #define GtkText_val(val) check_cast(GTK_TEXT,val) ML_2 (gtk_text_set_point, GtkText_val, Int_val, Unit) ML_1 (gtk_text_get_point, GtkText_val, Val_int) ML_1 (gtk_text_get_length, GtkText_val, Val_int) ML_1 (gtk_text_freeze, GtkText_val, Unit) ML_1 (gtk_text_thaw, GtkText_val, Unit) CAMLprim value ml_gtk_text_insert (value text, value font, value fore, value back, value str) { gtk_text_insert (GtkText_val(text), Option_val(font,GdkFont_val,NULL), Option_val(fore,GdkColor_val,NULL), Option_val(back,GdkColor_val,NULL), String_val(str), string_length(str)); return Val_unit; } ML_2 (gtk_text_forward_delete, GtkText_val, Int_val, Val_int) ML_2 (gtk_text_backward_delete, GtkText_val, Int_val, Val_int) lablgtk-2.18.8/src/gFile.ml0000644000175000017500000002123713460263323014440 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open GtkFile class filter obj = object inherit GObj.gtkobj obj method as_file_filter = (obj :> Gtk.file_filter Gtk.obj) method set_name = FileFilter.set_name obj method name = FileFilter.get_name obj method add_mime_type = FileFilter.add_mime_type obj method add_pattern = FileFilter.add_pattern obj method add_custom = FileFilter.add_custom obj end let filter ?name ?(patterns=[]) ?(mime_types=[]) () = let w = FileFilter.create () in Gaux.may (FileFilter.set_name w) name ; List.iter (FileFilter.add_pattern w) patterns ; List.iter (FileFilter.add_mime_type w) mime_types ; new filter w class type chooser_signals = object method current_folder_changed : callback:(unit -> unit) -> GtkSignal.id method file_activated : callback:(unit -> unit) -> GtkSignal.id method selection_changed : callback:(unit -> unit) -> GtkSignal.id method update_preview : callback:(unit -> unit) -> GtkSignal.id method confirm_overwrite : callback:(unit -> GtkEnums.file_chooser_confirmation) -> GtkSignal.id method notify_action : callback:(GtkEnums.file_chooser_action -> unit) -> GtkSignal.id method notify_do_overwrite_confirmation : callback:(bool -> unit) -> GtkSignal.id method notify_extra_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_local_only : callback:(bool -> unit) -> GtkSignal.id method notify_preview_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_preview_widget_active : callback:(bool -> unit) -> GtkSignal.id method notify_select_multiple : callback:(bool -> unit) -> GtkSignal.id method notify_show_hidden : callback:(bool -> unit) -> GtkSignal.id method notify_use_preview_label : callback:(bool -> unit) -> GtkSignal.id end class type chooser = object method set_action : GtkEnums.file_chooser_action -> unit method action : GtkEnums.file_chooser_action method set_local_only : bool -> unit method local_only : bool method set_select_multiple : bool -> unit method select_multiple : bool method set_current_name : string -> unit method show_hidden : bool method set_show_hidden : bool -> unit method set_filename : string -> bool method filename : string option method select_filename : string -> bool method unselect_filename : string -> unit method get_filenames : string list method set_current_folder : string -> bool method current_folder : string option method set_uri : string -> bool method uri : string option method select_uri : string -> bool method unselect_uri : string -> unit method get_uris : string list method set_current_folder_uri : string -> bool method current_folder_uri : string method select_all : unit method unselect_all : unit method set_preview_widget : GObj.widget -> unit method preview_widget : GObj.widget method set_preview_widget_active : bool -> unit method preview_widget_active : bool method preview_filename : string option method preview_uri : string option method set_use_preview_label : bool -> unit method use_preview_label : bool method set_extra_widget : GObj.widget -> unit method extra_widget : GObj.widget method add_filter : filter -> unit method remove_filter : filter -> unit method list_filters : filter list method set_filter : filter -> unit method filter : filter method add_shortcut_folder : string -> unit method remove_shortcut_folder : string -> unit method list_shortcut_folders : string list method add_shortcut_folder_uri : string -> unit method remove_shortcut_folder_uri : string -> unit method list_shortcut_folder_uris : string list method do_overwrite_confirmation : bool method set_do_overwrite_confirmation : bool -> unit end class virtual chooser_impl = object (self) val virtual obj : 'a Gtk.obj inherit OgtkFileProps.file_chooser_props method set_current_name = FileChooser.set_current_name obj method set_filename = FileChooser.set_filename obj method filename = FileChooser.get_filename obj method select_filename = FileChooser.select_filename obj method unselect_filename = FileChooser.unselect_filename obj method select_all = FileChooser.select_all obj method unselect_all = FileChooser.unselect_all obj method get_filenames = FileChooser.get_filenames obj method set_current_folder = FileChooser.set_current_folder obj method current_folder = FileChooser.get_current_folder obj method set_uri = FileChooser.set_uri obj method uri = FileChooser.get_uri obj method select_uri = FileChooser.select_uri obj method unselect_uri = FileChooser.unselect_uri obj method get_uris = FileChooser.get_uris obj method set_current_folder_uri = FileChooser.set_current_folder_uri obj method current_folder_uri = FileChooser.get_current_folder_uri obj method preview_filename = FileChooser.get_preview_filename obj method preview_uri = FileChooser.get_preview_uri obj method add_filter (f : filter) = FileChooser.add_filter obj f#as_file_filter method remove_filter (f : filter) = FileChooser.remove_filter obj f#as_file_filter method list_filters = List.map (new filter) (FileChooser.list_filters obj ) method set_filter (f : filter) = Gobject.set FileChooser.P.filter obj f#as_file_filter method filter = new filter (Gobject.get FileChooser.P.filter obj) method add_shortcut_folder = FileChooser.add_shortcut_folder obj method remove_shortcut_folder = FileChooser.remove_shortcut_folder obj method list_shortcut_folders = FileChooser.list_shortcut_folders obj method add_shortcut_folder_uri = FileChooser.add_shortcut_folder_uri obj method remove_shortcut_folder_uri = FileChooser.remove_shortcut_folder_uri obj method list_shortcut_folder_uris = FileChooser.list_shortcut_folder_uris obj end class chooser_widget_signals obj = object inherit GObj.widget_signals_impl obj inherit OgtkFileProps.file_chooser_sigs end class chooser_widget obj = object inherit [_] GObj.widget_impl obj inherit chooser_impl method event = new GObj.event_ops obj method connect = new chooser_widget_signals obj end let may_cons = Gobject.Property.may_cons let chooser_widget ~action ?backend ?packing ?show () = let w = FileChooser.widget_create (may_cons FileChooser.P.file_system_backend backend [ Gobject.param FileChooser.P.action action ]) in let o = new chooser_widget w in GObj.pack_return o ~packing ~show class chooser_button_signals obj = object inherit GContainer.container_signals_impl obj inherit OgtkFileProps.file_chooser_sigs end class chooser_button obj = object method private obj = obj inherit GPack.box_skel obj inherit chooser_impl inherit OgtkFileProps.file_chooser_button_props method connect = new chooser_button_signals obj end let chooser_button ~action ?title ?width_chars ?backend = GContainer.pack_container (Gobject.param FileChooser.P.action action :: (may_cons FileChooser.P.file_system_backend backend ( may_cons FileChooserButton.P.title title ( may_cons FileChooserButton.P.width_chars width_chars [])))) ~create:(fun pl -> new chooser_button (FileChooserButton.create pl)) lablgtk-2.18.8/src/gtkSignal.mli0000644000175000017500000001377513460263323015516 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject (** Signals *) type id type 'a marshaller = 'a -> Closure.argv -> unit type ('a,'b) t = { name: string; classe: 'a; marshaller: 'b marshaller } (** When writing marshallers, beware that the list omits the 0th argument of argv, which is the referent object *) type query = { id : int; signal_name : string; itype : string; flags : int; return : string; params : string array; } val stop_emit : unit -> unit (** Call [stop_emit ()] in a callback to prohibit further handling of the current signal invocation, by calling [emit_stop_by_name]. Be careful about where you use it, since the concept of current signal may be tricky. *) val connect : sgn:('a, 'b) t -> callback:'b -> ?after:bool -> 'a obj -> id (** You may use [stop_emit] inside the callback *) val connect_property : prop:('a, 'b) Gobject.property -> callback:('b -> unit) -> 'a Gobject.obj -> id (** Connect to the "notify::foo" signal associated with a property. These are emitted each time the property "foo" is set (including when it is set to the same value). *) val user_handler : (exn -> unit) ref (** A hook to allow changing the behaviour of exceptions in callbacks The default behaviour of printing the exception and ignoring it is obtained when [user_handler] is set to [Pervasives.raise] *) val safe_call : ?where:string -> ('a -> unit) -> 'a -> unit (** Safe wrapper for function calls. Tries to handle exceptions with user_handler, and reports an error otherwise. *) external signal_new : string -> g_type -> Gobject.signal_type list -> unit = "ml_g_signal_new_me" external list_ids : g_type -> int array = "ml_g_signal_list_ids" external query : int -> query = "ml_g_signal_query" external connect_by_name : 'a obj -> name:string -> callback:g_closure -> after:bool -> id = "ml_g_signal_connect_closure" external disconnect : 'a obj -> id -> unit = "ml_g_signal_handler_disconnect" external emit_stop_by_name : 'a obj -> name:string -> unit = "ml_g_signal_stop_emission_by_name" (** Unsafe: use [stop_emit] instead. *) external handler_block : 'a obj -> id -> unit = "ml_g_signal_handler_block" external handler_unblock : 'a obj -> id -> unit = "ml_g_signal_handler_unblock" (** {4 Marshallers} Some marshaller functions, to build signals *) val marshal_unit : (unit -> unit) marshaller val marshal_int : (int -> unit) marshaller val marshal_string : (string -> unit) marshaller val marshal1 : 'a data_conv -> string -> ('a -> unit) marshaller val marshal2 : 'a data_conv -> 'b data_conv -> string -> ('a -> 'b -> unit) marshaller val marshal3 : 'a data_conv -> 'b data_conv -> 'c data_conv -> string -> ('a -> 'b -> 'c -> unit) marshaller val marshal4 : 'a data_conv -> 'b data_conv -> 'c data_conv -> 'd data_conv -> string -> ('a -> 'b -> 'c -> 'd -> unit) marshaller val marshal5 : 'a data_conv -> 'b data_conv -> 'c data_conv -> 'd data_conv -> 'e data_conv -> string -> ('a -> 'b -> 'c -> 'd -> 'e -> unit) marshaller val marshal6 : 'a data_conv -> 'b data_conv -> 'c data_conv -> 'd data_conv -> 'e data_conv -> 'f data_conv -> string -> ('a -> 'b -> 'c -> 'd -> 'e -> 'f -> unit) marshaller val marshal0_ret : ret:'a data_conv -> (unit -> 'a) marshaller val marshal1_ret : ret:'a data_conv -> 'b data_conv -> string -> ('b -> 'a) marshaller val marshal2_ret : ret:'a data_conv -> 'b data_conv -> 'c data_conv -> string -> ('b -> 'c -> 'a) marshaller val marshal3_ret : ret:'a data_conv -> 'b data_conv -> 'c data_conv -> 'd data_conv -> string -> ('b -> 'c -> 'd -> 'a) marshaller val marshal4_ret : ret:'a data_conv -> 'b data_conv -> 'c data_conv -> 'd data_conv -> 'e data_conv -> string -> ('b -> 'c -> 'd -> 'e -> 'a) marshaller (** {4 Emitter functions} *) val emit : 'a Gobject.obj -> sgn:('a, 'b) t -> emitter:(cont:('c Gobject.data_set array -> 'd) -> 'b) -> conv:(Gobject.g_value -> 'd) -> 'b val emit_unit : 'a obj -> sgn:('a, unit -> unit) t -> unit val emit_int : 'a obj -> sgn:('a, int -> unit) t -> int -> unit (** {4 Default handler override} *) val override_class_closure : ('a, 'b) t -> g_type -> g_closure -> unit external chain_from_overridden : Closure.argv -> unit = "ml_g_signal_chain_from_overridden" (**/**) (* Internal functions. *) val enter_callback : (unit -> unit) ref val exit_callback : (unit -> unit) ref type saved_state val push_callback : unit -> saved_state val pop_callback : saved_state -> bool lablgtk-2.18.8/src/gtkObject.ml0000644000175000017500000000351113460263323015321 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open Gtk open Gobject let cast w : [`gtk] obj = try_cast w "GtkObject" external _ref_and_sink : [>`gtk] obj -> unit = "ml_gtk_object_ref_and_sink" let make ~classe params = let obj = unsafe_create ~classe params in _ref_and_sink obj; obj lablgtk-2.18.8/src/gtkRange.props0000644000175000017500000000413313460263323015703 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } classes { GtkAdjustment "Gtk.adjustment obj" } class Ruler hv set wrap : Widget { "lower" gdouble : Read / Write "upper" gdouble : Read / Write "max-size" gdouble : Read / Write "position" gdouble : Read / Write method set_metric : "Tags.metric_type -> unit" } class Range abstract set wrap wrapsig : Widget { "adjustment" GtkAdjustment : Read / Write / Construct "inverted" gboolean : Read / Write "update-policy" GtkUpdateType : Read / Write signal adjust_bounds : gdouble signal move_slider : GtkScrollType signal change_value : GtkScrollType gdouble signal value_changed } class Scale hv set wrap : Range { "digits" gint : Read / Write "draw-value" gboolean : Read / Write "value-pos" GtkPositionType : Read / Write signal format_value : gdouble -> string } class Scrollbar hv : Range {} (* deprecated class Progress abstract : Widget { "activity-mode" gboolean : Read / Write "show-text" gboolean : Read / Write "text-xalign" gfloat : Read / Write / NoSet "text-yalign" gfloat : Read / Write / NoSet } *) class ProgressBar : Widget { "adjustment" GtkAdjustment : Read / Write / Wrap "orientation" GtkProgressBarOrientation : Read / Write / Set / Wrap "activity-blocks" guint : Read / Write "activity-step" guint : Read / Write "bar-style" GtkProgressBarStyle : Read / Write "discrete-blocks" guint : Read / Write "fraction" gdouble : Read / Write / Wrap "pulse-step" gdouble : Read / Write / Set / Wrap "text" gchararray : Read / Write / Wrap "ellipsize" PangoEllipsizeMode : Read / Write / Wrap method pulse } lablgtk-2.18.8/src/ml_pango.c0000644000175000017500000002441613460263323015022 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_pango.h" #include "pango_tags.h" #include "gtk_tags.h" #ifndef HASGTK22 #define PANGO_WRAP_WORD_CHAR -1 #endif #include "pango_tags.c" CAMLprim value ml_pango_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = pango_font_description_get_type(); return Val_GType(t); } /* PangoFontDescription */ Make_Val_final_pointer_ext (PangoFontDescription, _new, Ignore, pango_font_description_free, 20) ML_1(pango_font_description_from_string, String_val, Val_PangoFontDescription_new) ML_1(pango_font_description_copy, PangoFontDescription_val, Val_PangoFontDescription_new) ML_1(pango_font_description_to_string, PangoFontDescription_val, copy_string_g_free) ML_2(pango_font_description_set_family, PangoFontDescription_val, String_val, Unit) ML_1(pango_font_description_get_family, PangoFontDescription_val, Val_string) ML_2(pango_font_description_set_style, PangoFontDescription_val, Pango_style_val, Unit) ML_1(pango_font_description_get_style, PangoFontDescription_val, Val_pango_style) ML_2(pango_font_description_set_variant, PangoFontDescription_val, Pango_variant_val, Unit) ML_1(pango_font_description_get_variant, PangoFontDescription_val, Val_pango_variant) ML_2(pango_font_description_set_weight, PangoFontDescription_val, Int_val, Unit) ML_1(pango_font_description_get_weight, PangoFontDescription_val, Val_int) ML_2(pango_font_description_set_stretch, PangoFontDescription_val, Pango_stretch_val, Unit) ML_1(pango_font_description_get_stretch, PangoFontDescription_val, Val_pango_stretch) ML_2(pango_font_description_set_size, PangoFontDescription_val, Int_val, Unit) ML_1(pango_font_description_get_size, PangoFontDescription_val, Val_int) /* PangoFontMetrics */ Make_Val_final_pointer (PangoFontMetrics, pango_font_metrics_ref, pango_font_metrics_unref, 20) Make_Val_final_pointer_ext (PangoFontMetrics, _new, Ignore, pango_font_metrics_unref, 20) ML_1 (pango_font_metrics_get_ascent, PangoFontMetrics_val, Val_int) ML_1 (pango_font_metrics_get_descent, PangoFontMetrics_val, Val_int) ML_1 (pango_font_metrics_get_approximate_char_width, PangoFontMetrics_val, Val_int) ML_1 (pango_font_metrics_get_approximate_digit_width, PangoFontMetrics_val, Val_int) /* PangoFont */ #define Val_PangoFont_new(val) Val_GObject_new(G_OBJECT(val)) ML_2 (pango_font_get_metrics, PangoFont_val, PangoLanguage_val, Val_PangoFontMetrics_new) /* PangoFontMap */ #define Val_PangoFontMap_new(val) Val_GObject_new(G_OBJECT(val)) ML_3 (pango_font_map_load_font, PangoFontMap_val, PangoContext_val, PangoFontDescription_val, Val_PangoFont_new) /* Enums */ CAMLprim value ml_PANGO_SCALE () { return(Val_int(PANGO_SCALE)); } /* This one uses the generated MLTAG but not the conversion functions because we have defined float values */ CAMLprim value ml_Pango_scale_val (value val) { double r; if (Is_block(val)) return Field(val,1); /* `CUSTOM */ switch((long)val) { case (long)MLTAG_XX_SMALL: r = PANGO_SCALE_XX_SMALL ;break; case (long)MLTAG_X_SMALL: r = PANGO_SCALE_X_SMALL ;break; case (long)MLTAG_SMALL: r = PANGO_SCALE_SMALL ;break; case (long)MLTAG_MEDIUM: r = PANGO_SCALE_MEDIUM ;break; case (long)MLTAG_LARGE: r = PANGO_SCALE_LARGE ;break; case (long)MLTAG_X_LARGE: r = PANGO_SCALE_X_LARGE ;break; case (long)MLTAG_XX_LARGE: r = PANGO_SCALE_XX_LARGE ;break; default: printf("Bug in ml_PangoScale_val. Please report"); r=1; break; } return copy_double(r); } /* PangoLanguage */ ML_1 (pango_language_from_string, String_val, Val_PangoLanguage) ML_1 (pango_language_to_string, PangoLanguage_val, Val_optstring) ML_2 (pango_language_matches, PangoLanguage_val, String_val, Val_bool) /* PangoContext */ ML_1 (pango_context_get_font_description, PangoContext_val, Val_PangoFontDescription) ML_2 (pango_context_set_font_description, PangoContext_val, PangoFontDescription_val, Unit) ML_1 (pango_context_get_language, PangoContext_val, Val_PangoLanguage) ML_2 (pango_context_set_language, PangoContext_val, PangoLanguage_val, Unit) ML_2 (pango_context_load_font, PangoContext_val, PangoFontDescription_val, Val_PangoFont_new) ML_3 (pango_context_load_fontset, PangoContext_val, PangoFontDescription_val, PangoLanguage_val, Val_PangoFont_new) ML_3 (pango_context_get_metrics, PangoContext_val, PangoFontDescription_val, Option_val(arg3,PangoLanguage_val,NULL) Ignore, Val_PangoFontMetrics_new) /* PangoLayout */ #define Val_PangoLayout_new(val) Val_GObject_new(G_OBJECT(val)) ML_1 (pango_layout_new, PangoContext_val, Val_PangoLayout_new) ML_1 (pango_layout_copy, PangoLayout_val, Val_PangoLayout_new) ML_1 (pango_layout_get_context, PangoLayout_val, Val_PangoContext) ML_2 (pango_layout_set_text, PangoLayout_val, SizedString_val, Unit) ML_1 (pango_layout_get_text, PangoLayout_val, Val_string) ML_2 (pango_layout_set_markup, PangoLayout_val, SizedString_val, Unit) ML_4 (pango_layout_set_markup_with_accel, PangoLayout_val, SizedString_val, Int_val, NULL Ignore, Unit) ML_2 (pango_layout_set_font_description, PangoLayout_val, PangoFontDescription_val, Unit) ML_2 (pango_layout_set_width, PangoLayout_val, Int_val, Unit) ML_1 (pango_layout_get_width, PangoLayout_val, Val_int) ML_2 (pango_layout_set_wrap, PangoLayout_val, Pango_wrap_mode_val, Unit) ML_1 (pango_layout_get_wrap, PangoLayout_val, Val_pango_wrap_mode) ML_2 (pango_layout_set_indent, PangoLayout_val, Int_val, Unit) ML_1 (pango_layout_get_indent, PangoLayout_val, Val_int) ML_2 (pango_layout_set_spacing, PangoLayout_val, Int_val, Unit) ML_1 (pango_layout_get_spacing, PangoLayout_val, Val_int) ML_2 (pango_layout_set_justify, PangoLayout_val, Bool_val, Unit) ML_1 (pango_layout_get_justify, PangoLayout_val, Val_bool) ML_2 (pango_layout_set_single_paragraph_mode, PangoLayout_val, Bool_val, Unit) ML_1 (pango_layout_get_single_paragraph_mode, PangoLayout_val, Val_bool) ML_1 (pango_layout_context_changed, PangoLayout_val, Unit) ML_1 (pango_layout_get_baseline, PangoLayout_val, Val_int) ML_1 (pango_layout_get_line_count, PangoLayout_val, Val_int) ML_1 (pango_layout_is_wrapped, PangoLayout_val, Val_bool) ML_1 (pango_layout_is_ellipsized, PangoLayout_val, Val_bool) ML_1 (pango_layout_get_alignment, PangoLayout_val, Val_pango_alignment) ML_2 (pango_layout_set_alignment, PangoLayout_val, Pango_alignment_val, Unit) CAMLprim value ml_pango_layout_get_size(value layout) { int width, height; value res = alloc_tuple(2); pango_layout_get_size(PangoLayout_val(layout), &width, &height); Field(res,0) = Val_int(width); Field(res,1) = Val_int(height); return res; } CAMLprim value ml_pango_layout_get_pixel_size(value layout) { int width, height; value res = alloc_tuple(2); pango_layout_get_pixel_size(PangoLayout_val(layout), &width, &height); Field(res,0) = Val_int(width); Field(res,1) = Val_int(height); return res; } CAMLexport value Val_PangoRectangle(PangoRectangle *rect) { value res = alloc_tuple(4); Field(res,0) = Val_int(rect->x); Field(res,1) = Val_int(rect->y); Field(res,2) = Val_int(rect->width); Field(res,3) = Val_int(rect->height); return res; } CAMLprim value ml_pango_layout_index_to_pos(value layout, value index) { PangoRectangle pos; pango_layout_index_to_pos(PangoLayout_val(layout), Int_val(index), &pos); return Val_PangoRectangle(&pos); } CAMLprim value ml_pango_layout_xy_to_index(value layout, value x, value y) { int index, trailing; gboolean exact; value res; exact = pango_layout_xy_to_index(PangoLayout_val(layout), Int_val(x), Int_val(y), &index, &trailing); res = alloc_tuple(3); Field(res,0) = Val_int(index); Field(res,1) = Val_int(trailing); Field(res,2) = Val_bool(exact); return res; } CAMLprim value ml_pango_layout_get_extent(value layout) { PangoRectangle ink; pango_layout_get_extents(PangoLayout_val(layout), &ink, NULL); return Val_PangoRectangle(&ink); } CAMLprim value ml_pango_layout_get_pixel_extent(value layout) { PangoRectangle ink; pango_layout_get_pixel_extents(PangoLayout_val(layout), &ink, NULL); return Val_PangoRectangle(&ink); } #ifdef HASGTK26 ML_1(pango_layout_get_ellipsize, PangoLayout_val, Val_pango_ellipsize_mode) ML_2(pango_layout_set_ellipsize, PangoLayout_val, Pango_ellipsize_mode_val, Unit) #else Unsupported_26(pango_layout_get_ellipsize) Unsupported_26(pango_layout_set_ellipsize) #endif /* HASGTK26 */ lablgtk-2.18.8/src/ml_gtkfile.c0000644000175000017500000002076613460263323015347 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gtk.h" #include "gtk_tags.h" CAMLprim value ml_gtkfile_init(value unit) { #ifdef HASGTK24 GType t = #ifdef HASGTK26 gtk_file_chooser_button_get_type () + #endif gtk_file_chooser_dialog_get_type () + gtk_file_chooser_widget_get_type (); ml_register_exn_map (GTK_FILE_CHOOSER_ERROR, "gtk_file_chooser_error"); return Val_GType(t); #else return Val_unit; #endif } #ifdef HASGTK24 #define GtkFileChooser_val(val) check_cast(GTK_FILE_CHOOSER,val) static value some_string_and_free(gchar *s) { value v = s ? ml_some(copy_string(s)) : Val_unit; g_free(s); return v; } #define string_list_of_GSList(l) Val_GSList_free(l, (value_in) copy_string_g_free) #define widget_list_of_GSList(l) Val_GSList_free(l, (value_in) Val_GObject) ML_2 (gtk_file_chooser_set_current_name, GtkFileChooser_val, String_val, Unit) ML_1 (gtk_file_chooser_get_filename, GtkFileChooser_val, some_string_and_free) ML_2 (gtk_file_chooser_set_filename, GtkFileChooser_val, String_val, Val_bool) ML_2 (gtk_file_chooser_select_filename, GtkFileChooser_val, String_val, Val_bool) ML_2 (gtk_file_chooser_unselect_filename, GtkFileChooser_val, String_val, Unit) ML_1 (gtk_file_chooser_select_all, GtkFileChooser_val, Unit) ML_1 (gtk_file_chooser_unselect_all, GtkFileChooser_val, Unit) ML_1 (gtk_file_chooser_get_filenames, GtkFileChooser_val, string_list_of_GSList) ML_2 (gtk_file_chooser_set_current_folder, GtkFileChooser_val, String_val, Val_bool) ML_1 (gtk_file_chooser_get_current_folder, GtkFileChooser_val, some_string_and_free) ML_1 (gtk_file_chooser_get_uri, GtkFileChooser_val, some_string_and_free) ML_2 (gtk_file_chooser_set_uri, GtkFileChooser_val, String_val, Val_bool) ML_2 (gtk_file_chooser_select_uri, GtkFileChooser_val, String_val, Val_bool) ML_2 (gtk_file_chooser_unselect_uri, GtkFileChooser_val, String_val, Unit) ML_1 (gtk_file_chooser_get_uris, GtkFileChooser_val, string_list_of_GSList) ML_2 (gtk_file_chooser_set_current_folder_uri, GtkFileChooser_val, String_val, Val_bool) ML_1 (gtk_file_chooser_get_current_folder_uri, GtkFileChooser_val, copy_string_g_free) ML_1 (gtk_file_chooser_get_preview_filename, GtkFileChooser_val, some_string_and_free) ML_1 (gtk_file_chooser_get_preview_uri, GtkFileChooser_val, some_string_and_free) #define GtkFileFilter_val(val) check_cast(GTK_FILE_FILTER, val) ML_0 (gtk_file_filter_new, Val_GtkAny_sink) ML_2 (gtk_file_filter_set_name, GtkFileFilter_val, String_val, Unit) ML_1 (gtk_file_filter_get_name, GtkFileFilter_val, copy_string_or_null); ML_2 (gtk_file_filter_add_mime_type, GtkFileFilter_val, String_val, Unit) ML_2 (gtk_file_filter_add_pattern, GtkFileFilter_val, String_val, Unit) static gboolean ml_gtk_file_filter_func (const GtkFileFilterInfo *filter_info, gpointer data) { value *cb = data; CAMLparam0(); CAMLlocal4(r, l, v, s); l = Val_emptylist; #define CONS_MEMBER(memb, flag) \ if (filter_info->contains & GTK_FILE_FILTER_##flag) { \ s = copy_string (filter_info->memb); \ v = alloc_small(2, 0); \ Field(v, 0) = MLTAG_##flag; \ Field(v, 1) = s; \ l = ml_cons (v, l); \ } CONS_MEMBER (mime_type, MIME_TYPE) CONS_MEMBER (display_name, DISPLAY_NAME) CONS_MEMBER (uri, URI) CONS_MEMBER (filename, FILENAME) #undef CONS_MEMBER r = callback_exn (*cb, l); if (Is_exception_result (r)) CAMLreturn(TRUE); CAMLreturn (Bool_val(r)); } Make_Flags_val(File_filter_flags_val) CAMLprim value ml_gtk_file_filter_add_custom(value obj, value needed, value cb) { value *clos = ml_global_root_new(cb); gtk_file_filter_add_custom (GtkFileFilter_val(obj), Flags_File_filter_flags_val(needed), ml_gtk_file_filter_func, clos, ml_global_root_destroy); return Val_unit; } ML_2 (gtk_file_chooser_add_filter, GtkFileChooser_val, GtkFileFilter_val, Unit) ML_2 (gtk_file_chooser_remove_filter, GtkFileChooser_val, GtkFileFilter_val, Unit) ML_1 (gtk_file_chooser_list_filters, GtkFileChooser_val, widget_list_of_GSList) CAMLprim value ml_gtk_file_chooser_add_shortcut_folder(value w, value f) { GError *err = NULL; gtk_file_chooser_add_shortcut_folder(GtkFileChooser_val(w), String_val(f), &err); if (err) ml_raise_gerror(err); return Val_unit; } CAMLprim value ml_gtk_file_chooser_remove_shortcut_folder(value w, value f) { GError *err = NULL; gtk_file_chooser_remove_shortcut_folder(GtkFileChooser_val(w), String_val(f), &err); if (err) ml_raise_gerror(err); return Val_unit; } ML_1 (gtk_file_chooser_list_shortcut_folders, GtkFileChooser_val, string_list_of_GSList) CAMLprim value ml_gtk_file_chooser_add_shortcut_folder_uri(value w, value f) { GError *err = NULL; gtk_file_chooser_add_shortcut_folder_uri(GtkFileChooser_val(w), String_val(f), &err); if (err) ml_raise_gerror(err); return Val_unit; } CAMLprim value ml_gtk_file_chooser_remove_shortcut_folder_uri(value w, value f) { GError *err = NULL; gtk_file_chooser_remove_shortcut_folder_uri(GtkFileChooser_val(w), String_val(f), &err); if (err) ml_raise_gerror(err); return Val_unit; } ML_1 (gtk_file_chooser_list_shortcut_folder_uris, GtkFileChooser_val, string_list_of_GSList) #else /* HASGTK24 */ Unsupported_24(gtk_file_chooser_set_current_name) Unsupported_24(gtk_file_chooser_get_filename) Unsupported_24(gtk_file_chooser_set_filename) Unsupported_24(gtk_file_chooser_select_filename) Unsupported_24(gtk_file_chooser_unselect_filename) Unsupported_24(gtk_file_chooser_select_all) Unsupported_24(gtk_file_chooser_unselect_all) Unsupported_24(gtk_file_chooser_get_filenames) Unsupported_24(gtk_file_chooser_set_current_folder) Unsupported_24(gtk_file_chooser_get_current_folder) Unsupported_24(gtk_file_chooser_get_uri) Unsupported_24(gtk_file_chooser_set_uri) Unsupported_24(gtk_file_chooser_select_uri) Unsupported_24(gtk_file_chooser_unselect_uri) Unsupported_24(gtk_file_chooser_get_uris) Unsupported_24(gtk_file_chooser_set_current_folder_uri) Unsupported_24(gtk_file_chooser_get_current_folder_uri) Unsupported_24(gtk_file_chooser_get_preview_filename) Unsupported_24(gtk_file_chooser_get_preview_uri) Unsupported_24(gtk_file_filter_new) Unsupported_24(gtk_file_filter_set_name) Unsupported_24(gtk_file_filter_get_name) Unsupported_24(gtk_file_filter_add_mime_type) Unsupported_24(gtk_file_filter_add_pattern) Unsupported_24(gtk_file_filter_add_custom) Unsupported_24(gtk_file_chooser_add_filter) Unsupported_24(gtk_file_chooser_remove_filter) Unsupported_24(gtk_file_chooser_list_filters) Unsupported_24(gtk_file_chooser_list_shortcut_folders) Unsupported_24(gtk_file_chooser_add_shortcut_folder) Unsupported_24(gtk_file_chooser_remove_shortcut_folder) Unsupported_24(gtk_file_chooser_add_shortcut_folder_uri) Unsupported_24(gtk_file_chooser_remove_shortcut_folder_uri) Unsupported_24(gtk_file_chooser_list_shortcut_folder_uris) #endif /* HASGTK24 */ lablgtk-2.18.8/src/ml_gtkmenu.c0000644000175000017500000001772013460263323015370 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkmenu_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_menu_item_get_type() + gtk_image_menu_item_get_type() + gtk_check_menu_item_get_type() + gtk_radio_menu_item_get_type() + gtk_option_menu_get_type() + gtk_menu_bar_get_type() + gtk_menu_get_type(); return Val_GType(t); } /* gtkmenuitem.h */ #define GtkMenuItem_val(val) check_cast(GTK_MENU_ITEM,val) ML_0 (gtk_menu_item_new, Val_GtkWidget_sink) ML_0 (gtk_separator_menu_item_new, Val_GtkWidget_sink) ML_0 (gtk_tearoff_menu_item_new, Val_GtkWidget_sink) ML_1 (gtk_menu_item_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_menu_item_new_with_mnemonic, String_val, Val_GtkWidget_sink) ML_2 (gtk_menu_item_set_submenu, GtkMenuItem_val, GtkWidget_val, Unit) Make_Val_option(GtkWidget) ML_1 (gtk_menu_item_get_submenu, GtkMenuItem_val, Val_option_GtkWidget) ML_1 (gtk_menu_item_remove_submenu, GtkMenuItem_val, Unit) ML_2 (gtk_menu_item_set_accel_path, GtkMenuItem_val, String_val, Unit) ML_1 (gtk_menu_item_activate, GtkMenuItem_val, Unit) ML_1 (gtk_menu_item_select, GtkMenuItem_val, Unit) ML_1 (gtk_menu_item_deselect, GtkMenuItem_val, Unit) ML_2 (gtk_menu_item_set_right_justified, GtkMenuItem_val, Bool_val, Unit) ML_1 (gtk_menu_item_get_right_justified, GtkMenuItem_val, Val_bool) CAMLprim value ml_gtk_menu_item_toggle_size_request(value sm,value i) { CAMLparam2(sm,i); CAMLlocal1(res); int j; j = Int_val(i); gtk_menu_item_toggle_size_request(GtkMenuItem_val(sm),&j); CAMLreturn( Val_unit ); } ML_2 (gtk_menu_item_toggle_size_allocate, GtkMenuItem_val, Int_val, Unit) /* gtkimagemenuitem.h */ #define GtkImageMenuItem_val(val) check_cast(GTK_IMAGE_MENU_ITEM,val) ML_0 (gtk_image_menu_item_new, Val_GtkWidget_sink) ML_1 (gtk_image_menu_item_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_image_menu_item_new_with_mnemonic, String_val, Val_GtkWidget_sink) ML_2 (gtk_image_menu_item_new_from_stock, String_val, Option_val(arg2,GtkAccelGroup_val,NULL) Ignore, Val_GtkWidget_sink) ML_2 (gtk_image_menu_item_set_image, GtkImageMenuItem_val, GtkWidget_val, Unit) ML_1 (gtk_image_menu_item_get_image, GtkImageMenuItem_val, Val_GtkWidget) /* gtkcheckmenuitem.h */ #define GtkCheckMenuItem_val(val) check_cast(GTK_CHECK_MENU_ITEM,val) ML_0 (gtk_check_menu_item_new, Val_GtkWidget_sink) ML_1 (gtk_check_menu_item_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_check_menu_item_new_with_mnemonic, String_val, Val_GtkWidget_sink) ML_2 (gtk_check_menu_item_set_active, GtkCheckMenuItem_val, Bool_val, Unit) ML_2 (gtk_check_menu_item_set_inconsistent, GtkCheckMenuItem_val, Bool_val, Unit) ML_1 (gtk_check_menu_item_get_inconsistent, GtkCheckMenuItem_val, Val_bool) ML_2 (gtk_check_menu_item_set_show_toggle, GtkCheckMenuItem_val, Bool_val, Unit) ML_1 (gtk_check_menu_item_toggled, GtkCheckMenuItem_val, Unit) Make_Extractor (gtk_check_menu_item_get, GtkCheckMenuItem_val, active, Val_bool) /* gtkradiomenuitem.h */ #define GtkRadioMenuItem_val(val) check_cast(GTK_RADIO_MENU_ITEM,val) static GSList* item_group_val(value val) { return (val == Val_unit ? NULL : gtk_radio_menu_item_group(GtkRadioMenuItem_val(Field(val,0)))); } ML_1 (gtk_radio_menu_item_new, item_group_val, Val_GtkWidget_sink) ML_2 (gtk_radio_menu_item_new_with_label, item_group_val, String_val, Val_GtkWidget_sink) ML_2 (gtk_radio_menu_item_new_with_mnemonic, item_group_val, String_val, Val_GtkWidget_sink) ML_2 (gtk_radio_menu_item_set_group, GtkRadioMenuItem_val, item_group_val, Unit) /* gtkoptionmenu.h */ #define GtkOptionMenu_val(val) check_cast(GTK_OPTION_MENU,val) /* ML_0 (gtk_option_menu_new, Val_GtkWidget_sink) ML_1 (gtk_option_menu_get_menu, GtkOptionMenu_val, Val_GtkWidget_sink) ML_2 (gtk_option_menu_set_menu, GtkOptionMenu_val, GtkWidget_val, Unit) */ ML_1 (gtk_option_menu_remove_menu, GtkOptionMenu_val, Unit) ML_2 (gtk_option_menu_set_history, GtkOptionMenu_val, Int_val, Unit) /* gtkmenushell.h */ #define GtkMenuShell_val(val) check_cast(GTK_MENU_SHELL,val) ML_2 (gtk_menu_shell_append, GtkMenuShell_val, GtkWidget_val, Unit) ML_2 (gtk_menu_shell_prepend, GtkMenuShell_val, GtkWidget_val, Unit) ML_3 (gtk_menu_shell_insert, GtkMenuShell_val, GtkWidget_val, Int_val, Unit) ML_1 (gtk_menu_shell_deactivate, GtkMenuShell_val, Unit) /* gtkmenu.h */ #define GtkMenu_val(val) check_cast(GTK_MENU,val) ML_0 (gtk_menu_new, Val_GtkWidget_sink) ML_5 (gtk_menu_popup, GtkMenu_val, GtkWidget_val, GtkWidget_val, Insert(NULL) Insert(NULL) Int_val, Int32_val, Unit) static void menu_popup_cb(GtkMenu *menu, gint *x, gint *y, gboolean *push_in, gpointer clos) { value res = caml_callback3(*(value*)clos, Val_int(*x), Val_int(*y), Val_bool(*push_in)); *x = Int_val(Field(res,0)); *y = Int_val(Field(res,1)); *push_in = Int_val(Field(res,2)); caml_remove_global_root(clos); stat_free(clos); } CAMLprim value ml_gtk_menu_popup_at (value menu, value button, value time, value func) { value *clos = stat_alloc(sizeof(value)); *clos = func; caml_register_global_root(clos); gtk_menu_popup(GtkMenu_val(menu), NULL, NULL, &menu_popup_cb, clos, Option_val(button,Int_val,0), Option_val(time,Int32_val,0)); return Val_unit; } ML_1 (gtk_menu_popdown, GtkMenu_val, Unit) ML_1 (gtk_menu_get_active, GtkMenu_val, Val_GtkWidget) ML_2 (gtk_menu_set_active, GtkMenu_val, Int_val, Unit) ML_2 (gtk_menu_set_accel_group, GtkMenu_val, GtkAccelGroup_val, Unit) ML_1 (gtk_menu_get_accel_group, GtkMenu_val, Val_GtkAccelGroup) ML_2 (gtk_menu_set_accel_path, GtkMenu_val, String_val, Unit) CAMLprim value ml_gtk_menu_attach_to_widget (value menu, value widget) { gtk_menu_attach_to_widget (GtkMenu_val(menu), GtkWidget_val(widget), NULL); return Val_unit; } ML_1 (gtk_menu_get_attach_widget, GtkMenu_val, Val_GtkWidget) ML_1 (gtk_menu_detach, GtkMenu_val, Unit) /* gtkmenubar.h */ /* #define GtkMenuBar_val(val) check_cast(GTK_MENU_BAR,val) ML_0 (gtk_menu_bar_new, Val_GtkWidget_sink) */ lablgtk-2.18.8/src/ml_gtkbutton.c0000644000175000017500000002271113460263323015733 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkbutton_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_button_get_type() + gtk_check_button_get_type() + gtk_toggle_button_get_type() + gtk_radio_button_get_type() + gtk_toolbar_get_type() + #ifdef HASGTK24 gtk_color_button_get_type() + gtk_font_button_get_type() + gtk_tool_item_get_type() + gtk_separator_tool_item_get_type() + gtk_tool_button_get_type() + gtk_toggle_tool_button_get_type() + gtk_radio_tool_button_get_type() + #endif #ifdef HASGTK26 gtk_menu_tool_button_get_type() + #endif #ifdef HASGTK210 gtk_link_button_get_type () + #endif #ifdef HASGTK212 gtk_scale_button_get_type () + #endif 0; return Val_GType(t); } /* gtkbutton.h */ #define GtkButton_val(val) check_cast(GTK_BUTTON,val) /* ML_0 (gtk_button_new, Val_GtkWidget_sink) ML_1 (gtk_butTon_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_button_new_with_mnemonic, String_val, Val_GtkWidget_sink) ML_1 (gtk_button_new_from_stock, String_val, Val_GtkWidget_sink) */ ML_1 (gtk_button_pressed, GtkButton_val, Unit) ML_1 (gtk_button_released, GtkButton_val, Unit) ML_1 (gtk_button_clicked, GtkButton_val, Unit) ML_1 (gtk_button_enter, GtkButton_val, Unit) ML_1 (gtk_button_leave, GtkButton_val, Unit) /* properties ML_2 (gtk_button_set_relief, GtkButton_val, Relief_style_val, Unit) ML_1 (gtk_button_get_relief, GtkButton_val, Val_relief_style) ML_2 (gtk_button_set_label, GtkButton_val, String_val, Unit) ML_1 (gtk_button_get_label, GtkButton_val, Val_optstring) */ /* gtktogglebutton.h */ #define GtkToggleButton_val(val) check_cast(GTK_TOGGLE_BUTTON,val) /* ML_0 (gtk_toggle_button_new, Val_GtkWidget_sink) ML_1 (gtk_toggle_button_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_toggle_button_new_with_mnemonic, String_val, Val_GtkWidget_sink) ML_2 (gtk_toggle_button_set_mode, GtkToggleButton_val, Bool_val, Unit) ML_2 (gtk_toggle_button_set_active, GtkToggleButton_val, Bool_val, Unit) */ ML_1 (gtk_toggle_button_toggled, GtkToggleButton_val, Unit) /* gtkcheckbutton.h */ /* #define GtkCheckButton_val(val) check_cast(GTK_CHECK_BUTTON,val) ML_0 (gtk_check_button_new, Val_GtkWidget_sink) ML_1 (gtk_check_button_new_with_label, String_val, Val_GtkWidget_sink) ML_1 (gtk_check_button_new_with_mnemonic, String_val, Val_GtkWidget_sink) */ /* gtkradiobutton.h */ /* #define GtkRadioButton_val(val) check_cast(GTK_RADIO_BUTTON,val) static GSList* button_group_val(value val) { return (val == Val_unit ? NULL : gtk_radio_button_group(GtkRadioButton_val(Field(val,0)))); } ML_1 (gtk_radio_button_new, button_group_val, Val_GtkWidget_sink) ML_2 (gtk_radio_button_new_with_label, button_group_val, String_val, Val_GtkWidget_sink) ML_2 (gtk_radio_button_new_with_mnemonic, button_group_val, String_val, Val_GtkWidget_sink) ML_2 (gtk_radio_button_set_group, GtkRadioButton_val, button_group_val, Unit) */ /* gtktoolbar.h */ #define GtkToolbar_val(val) check_cast(GTK_TOOLBAR,val) /* ML_0 (gtk_toolbar_new, Val_GtkWidget_sink) */ ML_2 (gtk_toolbar_insert_space, GtkToolbar_val, Int_val, Unit) ML_7 (gtk_toolbar_insert_element, GtkToolbar_val, Toolbar_child_val, Insert(NULL) Optstring_val, Optstring_val, Optstring_val, GtkWidget_val, Insert(NULL) Insert(NULL) Int_val, Val_GtkWidget) ML_bc7 (ml_gtk_toolbar_insert_element) ML_5 (gtk_toolbar_insert_widget, GtkToolbar_val, GtkWidget_val, Optstring_val, Optstring_val, Int_val, Unit) /* ML_2 (gtk_toolbar_set_orientation, GtkToolbar_val, Orientation_val, Unit) ML_2 (gtk_toolbar_set_style, GtkToolbar_val, Toolbar_style_val, Unit) ML_2 (gtk_toolbar_set_space_size, GtkToolbar_val, Int_val, Unit) ML_2 (gtk_toolbar_set_space_style, GtkToolbar_val, Toolbar_space_style_val, Unit) */ ML_1 (gtk_toolbar_unset_style, GtkToolbar_val, Unit) ML_2 (gtk_toolbar_set_tooltips, GtkToolbar_val, Bool_val, Unit) ML_1 (gtk_toolbar_get_icon_size, GtkToolbar_val, Val_icon_size) ML_2 (gtk_toolbar_set_icon_size, GtkToolbar_val, Icon_size_val, Unit) ML_1 (gtk_toolbar_unset_icon_size, GtkToolbar_val, Unit) /* extended API in GTK 2.4 */ #ifdef HASGTK24 #define GtkToolItem_val(val) check_cast(GTK_TOOL_ITEM,val) ML_2 (gtk_tool_item_set_homogeneous, GtkToolItem_val, Bool_val, Unit) ML_1 (gtk_tool_item_get_homogeneous, GtkToolItem_val, Val_bool) ML_2 (gtk_tool_item_set_expand, GtkToolItem_val, Bool_val, Unit) ML_1 (gtk_tool_item_get_expand, GtkToolItem_val, Val_bool) ML_2 (gtk_tool_item_set_use_drag_window, GtkToolItem_val, Bool_val, Unit) ML_1 (gtk_tool_item_get_use_drag_window, GtkToolItem_val, Val_bool) ML_4 (gtk_tool_item_set_tooltip, GtkToolItem_val, GtkTooltips_val, String_val, String_val, Unit) #define GtkToggleToolButton_val(val) check_cast(GTK_TOGGLE_TOOL_BUTTON,val) ML_2 (gtk_toggle_tool_button_set_active, GtkToggleToolButton_val, Bool_val, Unit) ML_1 (gtk_toggle_tool_button_get_active, GtkToggleToolButton_val, Val_bool) ML_3 (gtk_toolbar_insert, GtkToolbar_val, GtkToolItem_val, Int_val, Unit) ML_2 (gtk_toolbar_get_item_index, GtkToolbar_val, GtkToolItem_val, Val_int) ML_1 (gtk_toolbar_get_n_items, GtkToolbar_val, Val_int) ML_2 (gtk_toolbar_get_nth_item, GtkToolbar_val, Int_val, Val_GtkWidget) ML_3 (gtk_toolbar_get_drop_index, GtkToolbar_val, Int_val, Int_val, Val_int) #define OptGtkToolItem_val(i) Option_val(i,GtkToolItem_val,NULL) ML_3 (gtk_toolbar_set_drop_highlight_item, GtkToolbar_val, OptGtkToolItem_val, Int_val, Unit) ML_1 (gtk_toolbar_get_tooltips, GtkToolbar_val, Val_bool) ML_1 (gtk_toolbar_get_relief_style, GtkToolbar_val, Val_relief_style) #else Unsupported_24(gtk_tool_item_set_homogeneous) Unsupported_24(gtk_tool_item_get_homogeneous) Unsupported_24(gtk_tool_item_set_expand) Unsupported_24(gtk_tool_item_get_expand) Unsupported_24(gtk_tool_item_set_use_drag_window) Unsupported_24(gtk_tool_item_get_use_drag_window) Unsupported_24(gtk_tool_item_set_tooltip) Unsupported_24(gtk_toggle_tool_button_set_active) Unsupported_24(gtk_toggle_tool_button_get_active) Unsupported_24(gtk_toolbar_insert) Unsupported_24(gtk_toolbar_get_item_index) Unsupported_24(gtk_toolbar_get_n_items) Unsupported_24(gtk_toolbar_get_nth_item) Unsupported_24(gtk_toolbar_get_drop_index) Unsupported_24(gtk_toolbar_set_drop_highlight_item) Unsupported_24(gtk_toolbar_get_tooltips) Unsupported_24(gtk_toolbar_get_relief_style) #endif /* HASGTK24 */ #ifdef HASGTK26 #define GtkMenuToolButton_val(val) check_cast(GTK_MENU_TOOL_BUTTON,val) ML_4 (gtk_menu_tool_button_set_arrow_tooltip, GtkMenuToolButton_val, GtkTooltips_val, String_val, String_val, Unit) #else Unsupported_26(gtk_menu_tool_button_set_arrow_tooltip) #endif /* HASGTK26 */ /* gtklinkbutton.h */ #ifdef HASGTK210 ML_1(gtk_link_button_new, String_val, Val_GtkWidget_sink) ML_2(gtk_link_button_new_with_label, String_val, String_val, Val_GtkWidget_sink) static void ml_g_link_button_func(GtkLinkButton *button, const gchar *link, gpointer user_data) { value *clos = user_data; CAMLparam0(); CAMLlocal2(ml_link,ret); ml_link = Val_string(link); ret = callback2_exn(*clos, Val_GtkWidget(button),ml_link); if (Is_exception_result(ret)) { CAML_EXN_LOG("gtk_link_button_func"); } CAMLreturn0; } CAMLprim value ml_gtk_link_button_set_uri_hook (value clos) { value *clos_p = ml_global_root_new (clos); gtk_link_button_set_uri_hook (ml_g_link_button_func, clos_p, ml_global_root_destroy); return Val_unit; } #else Unsupported_210(gtk_link_button_set_uri_hook) Unsupported_210(gtk_link_button_new) Unsupported_210(gtk_link_button_new_with_label) #endif lablgtk-2.18.8/src/gPack.ml0000644000175000017500000002347713460263323014447 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkBase open GtkPack open OgtkPackProps open GObj open GContainer module P = Box.P class box_skel obj = object inherit [[> Gtk.box]] container_impl obj method pack ?from:f ?expand ?fill ?padding w = Box.pack obj (as_widget w) ?from:f ?expand ?fill ?padding method set_homogeneous = set P.homogeneous obj method homogeneous = get P.homogeneous obj method set_spacing = set P.spacing obj method spacing = get P.spacing obj method set_child_packing ?from:f ?expand ?fill ?padding w = Box.set_child_packing obj (as_widget w) ?from:f ?expand ?fill ?padding method reorder_child w = Box.reorder_child obj (as_widget w) end class box obj = object inherit box_skel obj method connect = new container_signals_impl obj end let box dir = Box.make_params [] ~cont:( pack_container ~create:(fun p -> new box (Box.create dir p))) let vbox = box `VERTICAL let hbox = box `HORIZONTAL class button_box obj = object inherit box_skel obj method connect = new container_signals_impl obj method set_layout = set BBox.P.layout_style obj method layout = get BBox.P.layout_style obj method set_child_size = BBox.set_child_size obj method set_child_ipadding = BBox.set_child_ipadding obj method get_child_secondary (w : widget) = BBox.get_child_secondary obj w#as_widget method set_child_secondary (w : widget) = BBox.set_child_secondary obj w#as_widget end let button_box dir ?spacing ?child_width ?child_height ?child_ipadx ?child_ipady ?layout = pack_container [] ~create:(fun p -> let p = Property.may_cons Box.P.spacing spacing ( Property.may_cons BBox.P.layout_style layout p) in let w = BBox.create dir p in BBox.set w ?child_width ?child_height ?child_ipadx ?child_ipady ?layout; new button_box w) class table obj = object inherit container_full (obj : Gtk.table obj) method private obj = obj inherit table_props method attach ~left ~top ?right ?bottom ?expand ?fill ?shrink ?xpadding ?ypadding w = Table.attach obj (as_widget w) ~left ~top ?right ?bottom ?expand ?fill ?shrink ?xpadding ?ypadding method set_row_spacing = Table.set_row_spacing obj method set_col_spacing = Table.set_col_spacing obj end let table = Table.make_params [] ~cont:( pack_container ~create:(fun p -> new table (Table.create p))) class fixed obj = object inherit container_full (obj : Gtk.fixed obj) method event = new GObj.event_ops obj method put w = Fixed.put obj (as_widget w) method move w = Fixed.move obj (as_widget w) method set_has_window = Fixed.set_has_window obj method has_window = Fixed.get_has_window obj end let fixed ?has_window = pack_container [] ~create:(fun p -> let w = new fixed (Fixed.create p) in may has_window ~f:w#set_has_window; w) class layout obj = object inherit container_full obj method event = new GObj.event_ops obj method put w = Layout.put obj (as_widget w) method move w = Layout.move obj (as_widget w) method set_hadjustment adj = set Layout.P.hadjustment obj (GData.as_adjustment adj) method set_vadjustment adj = set Layout.P.vadjustment obj (GData.as_adjustment adj) method set_width = set Layout.P.width obj method set_height = set Layout.P.height obj method hadjustment = new GData.adjustment (get Layout.P.hadjustment obj) method vadjustment = new GData.adjustment (get Layout.P.vadjustment obj) method freeze () = Layout.freeze obj method bin_window = Layout.bin_window obj method thaw () = Layout.thaw obj method width = get Layout.P.width obj method height = get Layout.P.height obj end let layout ?hadjustment ?vadjustment ?layout_width ?layout_height = Layout.make_params [] ?hadjustment:(may_map GData.as_adjustment hadjustment) ?vadjustment:(may_map GData.as_adjustment hadjustment) ?width:layout_width ?height:layout_height ~cont:( pack_container ~create:(fun p -> new layout (Layout.create p))) (* class packer obj = object inherit container_full (obj : Gtk.packer obj) method pack ?side ?anchor ?expand ?fill ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y w = let options = Packer.build_options ?expand ?fill () in if border_width == None && pad_x == None && pad_y == None && i_pad_x == None && i_pad_y == None then Packer.add_defaults obj (as_widget w) ?side ?anchor ~options else Packer.add obj (as_widget w) ?side ?anchor ~options ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y method set_child_packing ?side ?anchor ?expand ?fill ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y w = Packer.set_child_packing obj (as_widget w) ?side ?anchor ~options:(Packer.build_options ?expand ?fill ()) ?border_width ?pad_x ?pad_y ?i_pad_x ?i_pad_y method reorder_child w = Packer.reorder_child obj (as_widget w) method set_spacing = Packer.set_spacing obj method set_defaults = Packer.set_defaults obj end let packer ?spacing ?border_width ?width ?height ?packing ?show () = let w = Packer.create () in may spacing ~f:(Packer.set_spacing w); Container.set w ?border_width ?width ?height; pack_return (new packer w) ~packing ~show *) class paned obj = object inherit [Gtk.paned] container_impl obj inherit paned_props method connect = new container_signals_impl obj method event = new GObj.event_ops obj method add w = if List.length (Container.children obj) = 2 then raise(Error "Gpack.paned#add: already full"); Container.add obj (as_widget w) method add1 w = try ignore(Paned.child1 obj); raise(Error "GPack.paned#add1: already full") with _ -> Paned.add1 obj (as_widget w) method add2 w = try ignore(Paned.child2 obj); raise(Error "GPack.paned#add2: already full") with _ -> Paned.add2 obj (as_widget w) method pack1 ?(resize=false) ?(shrink=false) w = try ignore(Paned.child1 obj); raise(Error "GPack.paned#pack1: already full") with _ -> Paned.pack1 obj (as_widget w) ~resize ~shrink method pack2 ?(resize=false) ?(shrink=false) w = try ignore(Paned.child2 obj); raise(Error "GPack.paned#pack2: already full") with _ -> Paned.pack2 obj (as_widget w) ~resize ~shrink method child1 = new widget (Paned.child1 obj) method child2 = new widget (Paned.child2 obj) end let paned dir = pack_container [] ~create:(fun p -> new paned (Paned.create dir p)) class notebook_signals obj = object (self) inherit container_signals_impl obj method switch_page ~callback = self#connect Notebook.S.switch_page (fun _ arg1 -> callback arg1) inherit notebook_sigs end class notebook obj = object (self) inherit [Gtk.notebook] GContainer.container_impl obj inherit notebook_props method as_notebook = (obj :> Gtk.notebook obj) method event = new GObj.event_ops obj method connect = new notebook_signals obj method insert_page ?tab_label ?menu_label ?pos child = Notebook.insert_page_menu obj (as_widget child) ~tab_label:(Gpointer.may_box tab_label ~f:as_widget) ~menu_label:(Gpointer.may_box menu_label ~f:as_widget) ?pos method append_page ?tab_label ?menu_label child = self#insert_page ?tab_label ?menu_label child method prepend_page = self#insert_page ~pos:0 method remove_page = Notebook.remove_page obj method current_page = get Notebook.P.page obj method previous_page () = Notebook.prev_page obj method goto_page = set Notebook.P.page obj method next_page () = Notebook.next_page obj method page_num w = Notebook.page_num obj (as_widget w) method get_nth_page n = new widget (Notebook.get_nth_page obj n) method get_tab_label w = new widget (Notebook.get_tab_label obj (as_widget w)) method get_menu_label w = new widget (Notebook.get_menu_label obj (as_widget w)) method reorder_child (w : widget) i = Notebook.reorder_child obj (as_widget w) i method set_page ?tab_label ?menu_label page = let child = as_widget page in may tab_label ~f:(fun lbl -> Notebook.set_tab_label obj child (as_widget lbl)); may menu_label ~f:(fun lbl -> Notebook.set_menu_label obj child (as_widget lbl)) method set_tab_reorderable (w : widget) = Notebook.set_tab_reorderable obj (as_widget w) method get_tab_reorderable (w : widget) = Notebook.get_tab_reorderable obj (as_widget w) end let notebook = Notebook.make_params [] ~cont:( pack_container ~create:(fun p -> new notebook (Notebook.create p))) lablgtk-2.18.8/src/glGtk.mli0000644000175000017500000000621313460263323014630 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj type visual_options = [ `USE_GL | `BUFFER_SIZE of int | `LEVEL of int | `RGBA | `DOUBLEBUFFER | `STEREO | `AUX_BUFFERS of int | `RED_SIZE of int | `GREEN_SIZE of int | `BLUE_SIZE of int | `ALPHA_SIZE of int | `DEPTH_SIZE of int | `STENCIL_SIZE of int | `ACCUM_GREEN_SIZE of int | `ACCUM_ALPHA_SIZE of int ] type gl_area = [Gtk.drawing_area|`glarea] module GtkRaw : sig external create : visual_options list -> share:[>`glarea] optobj -> gl_area obj = "ml_gtk_gl_area_new" external swap_buffers : [>`glarea] obj -> unit = "ml_gtk_gl_area_swap_buffers" external make_current : [>`glarea] obj -> bool = "ml_gtk_gl_area_make_current" end class area_signals : 'a obj -> object inherit GObj.widget_signals constraint 'a = [> gl_area] val obj : 'a obj method display : callback:(unit -> unit) -> GtkSignal.id method realize : callback:(unit -> unit) -> GtkSignal.id method reshape : callback:(width:int -> height:int -> unit) -> GtkSignal.id end class area : gl_area obj -> object inherit GObj.widget val obj : gl_area obj method event : event_ops method as_area : gl_area obj method connect : area_signals method make_current : unit -> unit method set_size : width:int -> height:int -> unit method swap_buffers : unit -> unit end val area : visual_options list -> ?share:area -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> area val region_of_raw : 'a Raw.t -> Gpointer.region lablgtk-2.18.8/src/rsvg.ml0000644000175000017500000001070313460263323014367 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) type size_fun = int -> int -> int * int let round f = int_of_float (if f < 0. then f -. 0.5 else f +. 0.5) let at_size rw rh w h = (if rw < 0 then w else rw), (if rh < 0 then h else rh) let at_zoom zx zy w h = if w < 0 || h < 0 then (w, h) else (round (float w *. zx)), (round (float h *. zy)) let at_max_size mw mh w h = if w < 0 || h < 0 then (w, h) else let zx = float mw /. float w in let zy = float mh /. float h in let z = min zx zy in (round (float w *. z)), (round (float h *. z)) let at_zoom_with_max zx zy mw mh w h = if w < 0 || h < 0 then (w, h) else let rw = round (float w *. zx) in let rh = round (float h *. zy) in if rw > mw || rh > mh then let zx = float mw /. float w in let zy = float mh /. float h in let z = min zx zy in (round (float w *. z)), (round (float h *. z)) else (rw, rh) type error = FAILED exception Error of error * string external _init : unit -> unit = "ml_rsvg_init" let _ = Callback.register_exception "ml_rsvg_exn" (Error (FAILED, "")) ; _init () type t external new_handle : unit -> t = "ml_rsvg_handle_new" external new_handle_gz : unit -> t = "ml_rsvg_handle_new_gz" external set_size_callback : t -> size_fun -> unit = "ml_rsvg_handle_set_size_callback" external free_handle : t -> unit = "ml_rsvg_handle_free" external close : t -> unit = "ml_rsvg_handle_close" external write : t -> string -> off:int -> len:int -> unit = "ml_rsvg_handle_write" external get_pixbuf : t -> GdkPixbuf.pixbuf = "ml_rsvg_handle_get_pixbuf" external set_dpi : t -> float -> unit = "ml_rsvg_handle_set_dpi" external set_default_dpi : float -> unit = "ml_rsvg_set_default_dpi" type input = | Rsvg_SubString of string * int * int | Rsvg_Buffer of int * (bytes -> int) let render ?(gz=false) ?dpi ?size_cb input = let h = if gz then new_handle_gz () else new_handle () in Gaux.may (set_size_callback h) size_cb ; Gaux.may (set_dpi h) dpi ; try begin match input with | Rsvg_SubString (s, off, len) -> write h s ~off ~len | Rsvg_Buffer (len, fill) -> let buff = Bytes.create len in let c = ref (fill buff) in while !c > 0 do write h (Bytes.unsafe_to_string buff) 0 !c ; c := fill buff done end ; close h ; let pb = get_pixbuf h in free_handle h ; pb with exn -> free_handle h ; raise exn let render_from_string ?gz ?dpi ?size_cb ?pos ?len s = let off = Gaux.default 0 ~opt:pos in let len = Gaux.default (String.length s - off) ~opt:len in render ?gz ?dpi ?size_cb (Rsvg_SubString (s, off, len)) let render_from_file ?(gz=false) ?dpi ?size_cb fname = let ic = if gz then open_in_bin fname else open_in fname in let pb = try render ~gz ?dpi ?size_cb (Rsvg_Buffer (4096, (fun b -> input ic b 0 (Bytes.length b)))) with exn -> close_in ic ; raise exn in close_in ic ; pb lablgtk-2.18.8/src/gButton.mli0000644000175000017500000004133413460263323015205 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** A widget that creates a signal when clicked on *) (** {3 GtkButton} *) (** @gtkdoc gtk GtkButton *) class button_skel : 'a obj -> object inherit GContainer.bin constraint 'a = [> button] val obj : 'a obj method clicked : unit -> unit method set_relief : Tags.relief_style -> unit method relief : Tags.relief_style method set_label : string -> unit method label : string method set_use_stock : bool -> unit method use_stock : bool method set_use_underline : bool -> unit method use_underline : bool method grab_default : unit -> unit method event : event_ops method set_focus_on_click : bool -> unit method focus_on_click : bool method image : GObj.widget (** @since GTK 2.6 *) method set_image : GObj.widget -> unit (** @since GTK 2.6 *) method unset_image : unit -> unit (** @since GTK 2.6 *) method image_position : GtkEnums.position_type (** @since GTK 2.10 *) method set_image_position : GtkEnums.position_type -> unit (** @since GTK 2.10 *) method set_xalign : float -> unit (** @since GTK 2.4 *) method xalign : float (** @since GTK 2.4 *) method set_yalign : float -> unit (** @since GTK 2.4 *) method yalign : float (** @since GTK 2.4 *) end (** @gtkdoc gtk GtkButton *) class button_signals : 'b obj -> object ('a) inherit GContainer.container_signals constraint 'b = [> button] val obj : 'b obj method clicked : callback:(unit -> unit) -> GtkSignal.id method enter : callback:(unit -> unit) -> GtkSignal.id method leave : callback:(unit -> unit) -> GtkSignal.id method pressed : callback:(unit -> unit) -> GtkSignal.id method released : callback:(unit -> unit) -> GtkSignal.id method notify_focus_on_click : callback:(bool -> unit) -> GtkSignal.id method notify_image : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_image_position : callback:(GtkEnums.position_type -> unit) -> GtkSignal.id method notify_label : callback:(string -> unit) -> GtkSignal.id method notify_relief : callback:(GtkEnums.relief_style -> unit) -> GtkSignal.id method notify_use_stock : callback:(bool -> unit) -> GtkSignal.id method notify_use_underline : callback:(bool -> unit) -> GtkSignal.id method notify_xalign : callback:(float -> unit) -> GtkSignal.id method notify_yalign : callback:(float -> unit) -> GtkSignal.id end (** A widget that creates a signal when clicked on @gtkdoc gtk GtkButton *) class button : Gtk.button obj -> object inherit button_skel val obj : Gtk.button obj method connect : button_signals end (** @gtkdoc gtk GtkButton *) val button : ?label:string -> ?use_mnemonic:bool -> ?stock:GtkStock.id -> ?relief:Tags.relief_style -> ?packing:(widget -> unit) -> ?show:bool -> unit -> button (** {4 GtkToggleButton & GtkRadioButton} *) (** @gtkdoc gtk GtkToggleButton *) class toggle_button_signals : 'b obj -> object ('a) inherit button_signals constraint 'b = [> toggle_button] val obj : 'b obj method toggled : callback:(unit -> unit) -> GtkSignal.id end (** Create buttons which retain their state @gtkdoc gtk GtkToggleButton *) class toggle_button : 'a obj -> object inherit button_skel constraint 'a = [> Gtk.toggle_button] val obj : 'a obj method active : bool method connect : toggle_button_signals method set_active : bool -> unit method set_draw_indicator : bool -> unit end (** @gtkdoc gtk GtkToggleButton *) val toggle_button : ?label:string -> ?use_mnemonic:bool -> ?stock:GtkStock.id -> ?relief:Tags.relief_style -> ?active:bool -> ?draw_indicator:bool -> ?packing:(widget -> unit) -> ?show:bool -> unit -> toggle_button (** @gtkdoc gtk GtkCheckButton *) val check_button : ?label:string -> ?use_mnemonic:bool -> ?stock:GtkStock.id -> ?relief:Tags.relief_style -> ?active:bool -> ?draw_indicator:bool -> ?packing:(widget -> unit) -> ?show:bool -> unit -> toggle_button (** A choice from multiple check buttons @gtkdoc gtk GtkRadioButton *) class radio_button : Gtk.radio_button obj -> object inherit toggle_button val obj : Gtk.radio_button obj method group : Gtk.radio_button group method set_group : Gtk.radio_button group -> unit end (** @gtkdoc gtk GtkRadioButton *) val radio_button : ?group:Gtk.radio_button group -> ?label:string -> ?use_mnemonic:bool -> ?stock:GtkStock.id -> ?relief:Tags.relief_style -> ?active:bool -> ?draw_indicator:bool -> ?packing:(widget -> unit) -> ?show:bool -> unit -> radio_button (** {4 GtkColorButton & GtkFontButton} *) (** @gtkdoc gtk GtkColorButton @since GTK 2.4 *) class color_button_signals : ([> Gtk.color_button] as 'a) Gtk.obj -> object inherit button_signals val obj : 'a Gtk.obj method color_set : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkColorButton @since GTK 2.4 *) class color_button : ([> Gtk.color_button] as 'a) Gtk.obj -> object inherit button_skel val obj : 'a Gtk.obj method alpha : int method set_alpha : int -> unit method color : Gdk.color method set_color : Gdk.color -> unit method title : string method set_title : string -> unit method use_alpha : bool method set_use_alpha : bool -> unit method connect : color_button_signals end (** A button to launch a color selection dialog @gtkdoc gtk GtkColorButton @since GTK 2.4 *) val color_button : ?color:Gdk.color -> ?title:string -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> color_button (** @gtkdoc gtk GtkFontButton @since GTK 2.4 *) class font_button_signals : ([> Gtk.font_button] as 'a) Gtk.obj -> object inherit button_signals val obj : 'a Gtk.obj method font_set : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkFontButton @since GTK 2.4 *) class font_button : ([> Gtk.font_button] as 'a) Gtk.obj -> object inherit button_skel val obj : 'a Gtk.obj method font_name : string method set_font_name : string -> unit method show_size : bool method set_show_size : bool -> unit method show_style : bool method set_show_style : bool -> unit method title : string method set_title : string -> unit method use_font : bool method set_use_font : bool -> unit method use_size : bool method set_use_size : bool -> unit method connect : font_button_signals end (** A button to launch a font selection dialog @gtkdoc gtk GtkFontButton @since GTK 2.4 *) val font_button : ?font_name:string -> ?title:string -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> font_button (** {3 GtkToolbar} *) class type tool_item_o = object method as_tool_item : Gtk.tool_item obj end (** @gtkdoc gtk GtkToolbar *) class toolbar_signals : ([> Gtk.toolbar] as 'a) obj -> object inherit GContainer.container_signals method orientation_changed : callback:(GtkEnums.orientation -> unit) -> GtkSignal.id method style_changed : callback:(GtkEnums.toolbar_style -> unit) -> GtkSignal.id method focus_home_or_end : callback:(bool -> bool) -> GtkSignal.id (** @since GTK 2.4 *) method move_focus : callback:(GtkEnums.direction_type -> bool) -> GtkSignal.id (** @since GTK 2.4 *) method popup_context_menu : callback:(int -> int -> int -> bool) -> GtkSignal.id (** @since GTK 2.4 *) end (** Create bars of buttons and other widgets @gtkdoc gtk GtkToolbar *) class toolbar : Gtk.toolbar obj -> object inherit GContainer.container val obj : Gtk.toolbar obj method connect : toolbar_signals method insert_button : ?text:string -> ?tooltip:string -> ?tooltip_private:string -> ?icon:widget -> ?pos:int -> ?callback:(unit -> unit) -> unit -> button method insert_radio_button : ?text:string -> ?tooltip:string -> ?tooltip_private:string -> ?icon:widget -> ?pos:int -> ?callback:(unit -> unit) -> unit -> radio_button method insert_space : ?pos:int -> unit -> unit method insert_toggle_button : ?text:string -> ?tooltip:string -> ?tooltip_private:string -> ?icon:widget -> ?pos:int -> ?callback:(unit -> unit) -> unit -> toggle_button method insert_widget : ?tooltip:string -> ?tooltip_private:string -> ?pos:int -> widget -> unit method orientation : Tags.orientation method set_orientation : Tags.orientation -> unit method style : Tags.toolbar_style method set_style : Tags.toolbar_style -> unit method unset_style : unit -> unit method icon_size : Tags.icon_size method set_icon_size : Tags.icon_size -> unit method unset_icon_size : unit -> unit method get_tooltips : bool method set_tooltips : bool -> unit (** Extended API, available in GTK 2.4 *) method show_arrow : bool (** @since GTK 2.4 *) method set_show_arrow : bool -> unit (** @since GTK 2.4 *) method relief_style : Tags.relief_style (** @since GTK 2.4 *) method get_drop_index : int -> int -> int (** @since GTK 2.4 *) method set_drop_highlight_item : (#tool_item_o * int) option -> unit (** @since GTK 2.4 *) method get_item_index : #tool_item_o -> int (** @since GTK 2.4 *) method get_n_items : int (** @since GTK 2.4 *) method get_nth_item : int -> [`toolitem ] Gtk.obj (** @since GTK 2.4 *) method insert : ?pos:int -> #tool_item_o -> unit (** @since GTK 2.4 @param pos default value is [-1] i.e. end of the toolbar *) end (** @gtkdoc gtk GtkToolbar *) val toolbar : ?orientation:Tags.orientation -> ?style:Tags.toolbar_style -> ?tooltips:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> toolbar (** {4 ToolItems for the new toolbar API} *) (** @gtkdoc gtk GtkToolItem @since GTK 2.4 *) class tool_item_skel : ([> Gtk.tool_item] as 'a) obj -> object inherit GContainer.bin val obj : 'a obj method as_tool_item : Gtk.tool_item obj method is_important : bool method set_is_important : bool -> unit method visible_horizontal : bool method set_visible_horizontal : bool -> unit method visible_vertical : bool method set_visible_vertical : bool -> unit method set_homogeneous : bool -> unit method get_homogeneous : bool method set_expand : bool -> unit method get_expand : bool method set_tooltip : GData.tooltips -> string -> string -> unit method set_use_drag_window : bool -> unit method get_use_drag_window : bool end (** @gtkdoc gtk GtkToolItem @since GTK 2.4 *) class tool_item : ([> Gtk.tool_item] as 'a) obj -> object inherit tool_item_skel val obj : 'a obj method connect : GContainer.container_signals end (** @gtkdoc gtk GtkToolItem @since GTK 2.4 *) val tool_item : ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> tool_item (** @gtkdoc gtk GtkSeparatorToolItem @since GTK 2.4 *) class separator_tool_item : ([> Gtk.separator_tool_item] as 'a) obj -> object inherit tool_item val obj : 'a obj method draw : bool method set_draw : bool -> unit end (** @gtkdoc gtk GtkSeparatorToolItem @since GTK 2.4 *) val separator_tool_item : ?draw:bool -> ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> separator_tool_item (** @gtkdoc gtk GtkToolButton @since GTK 2.4 *) class tool_button_signals : ([> Gtk.tool_button] as 'a) obj -> object inherit GContainer.container_signals val obj : 'a obj method clicked : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkToolButton @since GTK 2.4 *) class tool_button_skel : ([> Gtk.tool_button] as 'a) obj -> object inherit tool_item_skel val obj : 'a obj method icon_widget : GObj.widget method set_icon_widget : GObj.widget -> unit method label : string method set_label : string -> unit method label_widget : GObj.widget method set_label_widget : GObj.widget -> unit method stock_id : GtkStock.id method set_stock_id : GtkStock.id -> unit method use_underline : bool method set_use_underline : bool -> unit end (** @gtkdoc gtk GtkToolButton @since GTK 2.4 *) class tool_button : ([> Gtk.tool_button] as 'a) obj -> object inherit tool_button_skel val obj : 'a obj method connect : tool_button_signals end (** @gtkdoc gtk GtkToolButton @since GTK 2.4 *) val tool_button : ?label:string -> ?stock:GtkStock.id -> ?use_underline:bool -> ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> tool_button (** @gtkdoc gtk GtkToggleToolButton @since GTK 2.4 *) class toggle_tool_button_signals : ([> Gtk.toggle_tool_button] as 'a) obj -> object inherit tool_button_signals val obj : 'a obj method toggled : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkToggleToolButton @since GTK 2.4 *) class toggle_tool_button : ([> Gtk.toggle_tool_button] as 'a) obj -> object inherit tool_button_skel val obj : 'a obj method connect : toggle_tool_button_signals method set_active : bool -> unit method get_active : bool end (** @gtkdoc gtk GtkToggleToolButton @since GTK 2.4 *) val toggle_tool_button : ?active:bool -> ?label:string -> ?stock:GtkStock.id -> ?use_underline:bool -> ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> toggle_tool_button (** @gtkdoc gtk GtkRadioToolButton @since GTK 2.4 *) class radio_tool_button : ([> Gtk.radio_tool_button] as 'a) obj -> object inherit toggle_tool_button val obj : 'a obj method group : Gtk.radio_tool_button group method set_group : Gtk.radio_tool_button group -> unit end (** @gtkdoc gtk GtkRadioToolButton @since GTK 2.4 *) val radio_tool_button : ?group:radio_tool_button -> ?active:bool -> ?label:string -> ?stock:GtkStock.id -> ?use_underline:bool -> ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> radio_tool_button (** @gtkdoc gtk GtkMenuToolButton @since GTK 2.6 *) class menu_tool_button : ([> Gtk.menu_tool_button] as 'a) obj -> object inherit tool_button val obj : 'a obj method menu : Gtk.menu Gtk.obj method set_menu : Gtk.menu Gtk.obj -> unit method set_arrow_tooltip : GData.tooltips -> string -> string -> unit end (** @gtkdoc gtk GtkMenuToolButton @since GTK 2.6 *) val menu_tool_button : ?menu: -> ?label:string -> ?stock:GtkStock.id -> ?use_underline:bool -> ?homogeneous:bool -> ?expand:bool -> ?packing:(tool_item_o -> unit) -> ?show:bool -> unit -> menu_tool_button (** @gtkdoc gtk GtkLinkButton @since GTK 2.10 *) class link_button : ([> Gtk.link_button] as 'a) Gtk.obj -> object inherit button_skel val obj : 'a Gtk.obj method uri : string method set_uri : string -> unit end (** A button for URL @gtkdoc gtk GtkLinkButton @since GTK 2.10 *) val link_button : ?label:string -> string -> ?packing:(widget -> unit) -> ?show:bool -> unit -> link_button lablgtk-2.18.8/src/gtkThTop.ml0000644000175000017500000000362113460263323015153 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* GtkThTop: alternative to GtkThInit. *) (* Runs the main loop in the main thread, and the toplevel loop in another thread, since the GUI must run in the main thread when using the Quartz backend. *) open GtkThread let thread = Thread.create (fun () -> Toploop.loop Format.std_formatter) () and () = main ();; lablgtk-2.18.8/src/gtkText.props0000644000175000017500000001605313460263323015577 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } boxed { GdkEvent "GdkEvent.any" } classes { GdkPixbuf "GdkPixbuf.pixbuf" GtkAdjustment "Gtk.adjustment obj" GtkMenu "Gtk.menu obj" } class TextView wrap wrapsig : Container { "editable" gboolean : Read / Write / Set "cursor-visible" gboolean : Read / Write / Set "indent" gint : Read / Write "justification" GtkJustification : Read / Write / Set "left-margin" gint : Read / Write "pixels-above-lines" gint : Read / Write "pixels-below-lines" gint : Read / Write "pixels-inside-wrap" gint : Read / Write "right-margin" gint : Read / Write "tabs" PangoTabArray : Read / Write "wrap-mode" GtkWrapMode : Read / Write / Set (* API extended in GTK 2.4 *) "accepts-tab" gboolean : Read / Write / Set signal copy_clipboard signal cut_clipboard signal delete_from_cursor : GtkDeleteType gint signal insert_at_cursor : gchararray signal move_cursor : GtkMovementStep gint extend:gboolean signal move_focus : GtkDirectionType signal page_horizontally : gint extend:gboolean signal paste_clipboard signal populate_popup : GtkMenu signal set_anchor signal set_scroll_adjustments : GtkAdjustment_opt GtkAdjustment_opt signal toggle_overwrite } class TextBuffer wrap : GObject { "tag-table" GtkTextTagTable : Read / Write / Construct Only "cursor-position" gint : Read "has-selection" gboolean : Read signal apply_tag : GtkTextTag GtkTextIter GtkTextIter signal begin_user_action / Wrap signal changed / Wrap signal delete_range : GtkTextIter GtkTextIter signal end_user_action / Wrap signal insert_child_anchor : GtkTextIter GtkTextChildAnchor signal insert_pixbuf : GtkTextIter GdkPixbuf signal insert_text : GtkTextIter string (*len:int*) signal mark_deleted : GtkTextMark / Wrap signal mark_set : GtkTextIter GtkTextMark signal modified_changed / Wrap signal remove_tag : GtkTextTag GtkTextIter GtkTextIter } class TextChildAnchor : GObject { method get_widgets : "widget obj list" method get_deleted : "bool" } class TextMark : GObject { method set_visible : "bool -> unit" method get_visible : "bool" method get_deleted : "bool" method get_name : "string option" method get_buffer : "text_buffer option" method get_left_gravity : "bool" } class TextTag vset : GObject { "accumulative-margin" gboolean : Read / Write "background" gchararray : Write "background-full-height" gboolean : Read / Write "background-full-height-set" gboolean : Read / Write "background-gdk" GdkColor : Read / Write "background-set" gboolean : Read / Write "background-stipple" GdkBitmap : Read / Write "background-stipple-set" gboolean : Read / Write "direction" GtkTextDirection : Read / Write "editable" gboolean : Read / Write "editable-set" gboolean : Read / Write "family" gchararray : Read / Write "family-set" gboolean : Read / Write "font" gchararray : Read / Write "font-desc" PangoFontDescription : Read / Write "foreground" gchararray : Write "foreground-gdk" GdkColor : Read / Write "foreground-set" gboolean : Read / Write "foreground-stipple" GdkBitmap : Read / Write "foreground-stipple-set" gboolean : Read / Write "indent" gint : Read / Write "indent-set" gboolean : Read / Write "invisible" gboolean : Read / Write "invisible-set" gboolean : Read / Write "justification" GtkJustification : Read / Write "justification-set" gboolean : Read / Write "language" gchararray : Read / Write "language-set" gboolean : Read / Write "left-margin" gint : Read / Write "left-margin-set" gboolean : Read / Write "name" gchararray : Read / Write / Construct Only "paragraph-background" gchararray : Read / Write "paragraph-background-gdk" GdkColor : Read / Write "paragraph-background-set" gboolean : Read / Write "pixels-above-lines" gint : Read / Write "pixels-above-lines-set" gboolean : Read / Write "pixels-below-lines" gint : Read / Write "pixels-below-lines-set" gboolean : Read / Write "pixels-inside-wrap" gint : Read / Write "pixels-inside-wrap-set" gboolean : Read / Write "right-margin" gint : Read / Write "right-margin-set" gboolean : Read / Write "rise" gint : Read / Write "rise-set" gboolean : Read / Write "scale" gdouble : Read / Write "scale-set" gboolean : Read / Write "size" gint : Read / Write "size-points" gdouble : Read / Write "size-set" gboolean : Read / Write "stretch" PangoStretch : Read / Write "stretch-set" gboolean : Read / Write "strikethrough" gboolean : Read / Write "strikethrough-set" gboolean : Read / Write "style" PangoStyle : Read / Write "style-set" gboolean : Read / Write "tabs" PangoTabArray : Read / Write "tabs-set" gboolean : Read / Write "underline" PangoUnderline : Read / Write "underline-set" gboolean : Read / Write "variant" PangoVariant : Read / Write "variant-set" gboolean : Read / Write "weight" gint : Read / Write "weight-set" gboolean : Read / Write "wrap-mode" GtkWrapMode : Read / Write "wrap-mode-set" gboolean : Read / Write method get_priority : "int" method set_priority : "int -> unit" method event : "'a obj -> 'b Gdk.event -> text_iter -> bool" signal event : origin:GObject GdkEvent GtkTextIter -> bool } class TextTagTable wrapsig : GObject { method add : "text_tag -> unit" method remove : "text_tag -> unit" method lookup : "string -> text_tag option" method get_size : "int" signal tag_added : GtkTextTag signal tag_changed : GtkTextTag size:bool signal tag_removed : GtkTextTag } lablgtk-2.18.8/src/gtkThread.mli0000644000175000017500000000762413460263323015504 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (* Basic functions *) (** The main loop to use with threads. [GMain.main] does not work! This changes [GMain.main] to call [threaded_main] rather than [GtkMain.Main.default_main], so subsequent calls will work. The first call sets the GUI thread, and subsequent calls to [main] will be automatically routed through [sync]. With system threads, the ocaml giant lock is now released on polling, so that other ocaml threads can run without busy wait. *) val main : unit -> unit (** Setting [busy_waiting] to [true] forces the main loop to be non-blocking. This is required with VM threads. The default value is set to [true] at startup if the environment variable [LABLGTK_BUSY_WAIT] is set to something other than [0]. *) val busy_waiting : bool ref (** Start the main loop in a new GUI thread. Do not use recursively. Do not use with the Quartz backend, as the GUI must imperatively run in the main thread. *) val start : unit -> Thread.t (** The real main function *) val thread_main : unit -> unit (** Forget the current GUI thread. The next call to [main] will register its caller as GUI thread. *) val reset : unit -> unit (* Jobs are needed for windows and quartz, as you cannot do GTK work from another thread. Even under Unix some calls need to come from the main thread. The basic idea is to either use async (if you don't need a result) or sync whenever you call a GTK related function from another thread (for instance with the threaded toplevel). With sync, beware of deadlocks! *) (** Add an asynchronous job (to do in the main thread) *) val async : ('a -> unit) -> 'a -> unit (** Add a synchronous job (to do in the main thread) *) val sync : ('a -> 'b) -> 'a -> 'b (** Whether it is safe to call most GTK functions directly from the current thread *) val gui_safe : unit -> bool (** Allow other threads to run, and process the message queue. The following ensures that messages will be processed even if another main loop is running: [Glib.Timeout.add ~ms:100 ~callback:GtkThread.do_jobs] *) val do_jobs : unit -> bool (** Set the delay used in the main loop when [busy_waiting] is [true]. Higher value will make the application less CPU-consuming, but (relatively) less reactive. Default value is [0.013] .*) val set_do_jobs_delay : float -> unit lablgtk-2.18.8/src/gAssistant.mli0000644000175000017500000001074513460263323015705 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id: $ *) open Gtk open GObj (** Assistants *) (** {3 GtkAssistant} *) (** @gtkdoc gtk GtkAssistant *) (** @gtkdoc gtk GtkAssistant *) class assistant_signals : ([> Gtk.assistant] as 'a) obj -> object inherit GContainer.container_signals val obj : 'a obj method apply : callback:(unit -> unit) -> GtkSignal.id method cancel : callback:(unit -> unit) -> GtkSignal.id method close : callback:(unit -> unit) -> GtkSignal.id method leave : callback:(unit -> unit) -> GtkSignal.id method prepare : callback:(unit -> unit) -> GtkSignal.id end (** Toplevel widget which can contain other widgets in different pages @gtkdoc gtk GtkAssistant *) class assistant : ([> Gtk.assistant] as 'a) obj -> object inherit GWindow.window_skel val obj : 'a obj method connect : assistant_signals method set_current_page : int -> unit method add_action_widget : Gtk.widget Gtk.obj -> unit method append_page : ?page_type:GtkEnums.assistant_page_type -> ?title:string -> ?header_image:GdkPixbuf.pixbuf -> ?side_image:GdkPixbuf.pixbuf -> ?complete:bool -> Gtk.widget Gtk.obj -> int method current_page : int method insert_page : ?page_type:GtkEnums.assistant_page_type -> ?title:string -> ?header_image:GdkPixbuf.pixbuf -> ?side_image:GdkPixbuf.pixbuf -> ?complete:bool -> position:int -> Gtk.widget Gtk.obj -> int method n_pages : int method nth_page : int -> Gtk.widget Gtk.obj method page_complete : Gtk.widget Gtk.obj -> bool method page_header_image : Gtk.widget Gtk.obj -> GdkPixbuf.pixbuf method page_side_image : Gtk.widget Gtk.obj -> GdkPixbuf.pixbuf method page_title : Gtk.widget Gtk.obj -> string method page_type : Gtk.widget Gtk.obj -> GtkEnums.assistant_page_type method prepend_page : ?page_type:GtkEnums.assistant_page_type -> ?title:string -> ?header_image:GdkPixbuf.pixbuf -> ?side_image:GdkPixbuf.pixbuf -> ?complete:bool -> Gtk.widget Gtk.obj -> int method remove_action_widget : Gtk.widget Gtk.obj -> unit method set_page_complete : Gtk.widget Gtk.obj -> bool -> unit method set_page_header_image : Gtk.widget Gtk.obj -> GdkPixbuf.pixbuf -> unit method set_page_side_image : Gtk.widget Gtk.obj -> GdkPixbuf.pixbuf -> unit method set_page_title : Gtk.widget Gtk.obj -> string -> unit method set_page_type : Gtk.widget Gtk.obj -> GtkEnums.assistant_page_type -> unit method update_buttons_state : unit end (** @gtkdoc gtk GtkPlug *) val assistant : ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:GdkEnums.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> assistant lablgtk-2.18.8/src/ml_panel.c0000644000175000017500000001424013460263323015007 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_gobject.h" #include "ml_gtk.h" #include "ml_gdk.h" #include "panel_tags.h" #include "panel_tags.c" #include "gtk_tags.h" #define Panel_applet_val(v) check_cast(PANEL_APPLET,v) #define Val_orient_type Val_arrow_type ML_1(panel_applet_get_orient, Panel_applet_val, Val_orient_type) ML_1(panel_applet_get_size, Panel_applet_val, Val_int) CAMLprim value ml_panel_applet_get_background(value app) { GdkColor c; GdkPixmap *pixmap; PanelAppletBackgroundType typ; CAMLparam0(); CAMLlocal3(v, d, tag); typ = panel_applet_get_background(Panel_applet_val(app), &c, &pixmap); tag = Val_background_type(typ); switch(typ) { case PANEL_NO_BACKGROUND: v = tag; break; case PANEL_COLOR_BACKGROUND: d = Val_copy(c); v = alloc_small(2, 0); Field(v, 0) = tag; Field(v, 1) = d; break; case PANEL_PIXMAP_BACKGROUND: d = Val_GdkPixmap(pixmap); v = alloc_small(2, 0); Field(v, 0) = tag; Field(v, 1) = d; break; } CAMLreturn(v); } #define Val_Panel_flags(f) ml_lookup_flags_getter(ml_table_panel_flags,f) ML_1 (panel_applet_get_flags, Panel_applet_val, Val_Panel_flags) Make_Flags_val(Panel_flags_val) ML_2(panel_applet_set_flags, Panel_applet_val, Flags_Panel_flags_val, Unit) static void ml_bonoboui_verb_fn(BonoboUIComponent *component, gpointer user_data, const char *cname) { value *clos = user_data; value verb; verb = copy_string(cname); callback_exn(*clos, verb); } static inline unsigned int list_length(value l) { unsigned int len = 0; while(l != Val_emptylist) { len++; l = Field(l, 1); } return len; } static BonoboUIVerb* bonoboui_verbs_of_value(value verbs) { unsigned int i, len = list_length(verbs); BonoboUIVerb *bonob_verbs; bonob_verbs = stat_alloc((len + 1) * sizeof (BonoboUIVerb)); /* the global roots for the menu are leaked. libpanelapplet does not provide hooks to be notified of closures destruction */ for(i=0; i< len; i++) { value ml_verb = Field(verbs, 0); bonob_verbs[i].cname = String_val(Field(ml_verb, 0)); bonob_verbs[i].cb = ml_bonoboui_verb_fn; bonob_verbs[i].user_data = ml_global_root_new(Field(ml_verb, 1)); verbs = Field(verbs, 1); } memset(bonob_verbs + len, 0, sizeof (BonoboUIVerb)); return bonob_verbs; } CAMLprim value ml_panel_applet_setup_menu(value app, value xml, value verbs) { BonoboUIVerb *bonob_verbs = bonoboui_verbs_of_value(verbs); panel_applet_setup_menu(Panel_applet_val(app), String_val(xml), bonob_verbs, NULL); stat_free(bonob_verbs); return Val_unit; } CAMLprim value ml_panel_applet_setup_menu_from_file(value app, value opt_dir, value file, value opt_appname, value verbs) { BonoboUIVerb *bonob_verbs = bonoboui_verbs_of_value(verbs); panel_applet_setup_menu_from_file(Panel_applet_val(app), String_option_val(opt_dir), String_val(file), String_option_val(opt_appname), bonob_verbs, NULL); stat_free(bonob_verbs); return Val_unit; } static void weak_notify(gpointer data, GObject *applet) { value *glob_root = data; Field (*glob_root, 1) = 0; ml_global_root_destroy(glob_root); } static gboolean ml_panel_applet_factory_callback(PanelApplet *applet, const gchar *iid, gpointer user_data) { value *ml_obj, *ml_factory = user_data; CAMLparam0(); CAMLlocal3(ml_app, ml_iid, ret); ml_app = Val_pointer(applet); ml_obj = ml_global_root_new(ml_app); g_object_weak_ref(G_OBJECT(applet), weak_notify, ml_obj); ml_iid = copy_string(iid); ret = callback2_exn(*ml_factory, ml_app, ml_iid); if(Is_exception_result(ret) || ! Bool_val(ret)) CAMLreturn(FALSE); else CAMLreturn(TRUE); } CAMLprim value ml_panel_applet_factory_main(value arg_arr, value iid, value ml_factory_cb) { CAMLparam1(ml_factory_cb); int i, res; int argc = Wosize_val(arg_arr); char *prog_name, *argv[ argc ]; for(i=0; i Gtk.file_filter ] as 'a) Gtk.obj -> object inherit GObj.gtkobj val obj : 'a Gtk.obj method as_file_filter : Gtk.file_filter Gtk.obj method add_mime_type : string -> unit method add_pattern : string -> unit method add_custom : GtkEnums.file_filter_flags list -> callback:((GtkEnums.file_filter_flags * string) list -> bool) -> unit method name : string method set_name : string -> unit end (** @since GTK 2.4 @gtkdoc gtk gtk-gtkfilefilter *) val filter : ?name:string -> ?patterns:string list -> ?mime_types:string list -> unit -> filter (** {3 GtkFileChooser} *) (** @since GTK 2.4 @gtkdoc gtk GtkFileChooser *) class type chooser_signals = object method current_folder_changed : callback:(unit -> unit) -> GtkSignal.id method selection_changed : callback:(unit -> unit) -> GtkSignal.id method update_preview : callback:(unit -> unit) -> GtkSignal.id method file_activated : callback:(unit -> unit) -> GtkSignal.id method confirm_overwrite : callback:(unit -> GtkEnums.file_chooser_confirmation) -> GtkSignal.id (** since Gtk 2.8 *) method notify_action : callback:(GtkEnums.file_chooser_action -> unit) -> GtkSignal.id method notify_do_overwrite_confirmation : callback:(bool -> unit) -> GtkSignal.id method notify_extra_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_local_only : callback:(bool -> unit) -> GtkSignal.id method notify_preview_widget : callback:(GObj.widget -> unit) -> GtkSignal.id method notify_preview_widget_active : callback:(bool -> unit) -> GtkSignal.id method notify_select_multiple : callback:(bool -> unit) -> GtkSignal.id method notify_show_hidden : callback:(bool -> unit) -> GtkSignal.id method notify_use_preview_label : callback:(bool -> unit) -> GtkSignal.id end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooser *) class type chooser = object method set_action : GtkEnums.file_chooser_action -> unit method action : GtkEnums.file_chooser_action method set_local_only : bool -> unit method local_only : bool method set_select_multiple : bool -> unit method select_multiple : bool method set_current_name : string -> unit method show_hidden : bool method set_show_hidden : bool -> unit method set_filename : string -> bool method filename : string option method select_filename : string -> bool method unselect_filename : string -> unit method get_filenames : string list method set_current_folder : string -> bool method current_folder : string option method set_uri : string -> bool method uri : string option method select_uri : string -> bool method unselect_uri : string -> unit method get_uris : string list method set_current_folder_uri : string -> bool method current_folder_uri : string method select_all : unit method unselect_all : unit method set_preview_widget : GObj.widget -> unit method preview_widget : GObj.widget method set_preview_widget_active : bool -> unit method preview_widget_active : bool method preview_filename : string option method preview_uri : string option method set_use_preview_label : bool -> unit method use_preview_label : bool method set_extra_widget : GObj.widget -> unit method extra_widget : GObj.widget method add_filter : filter -> unit method remove_filter : filter -> unit method list_filters : filter list method set_filter : filter -> unit method filter : filter method add_shortcut_folder : string -> unit (** @raise GtkFile.FileChooser.Error if operation fails *) method remove_shortcut_folder : string -> unit (** @raise GtkFile.FileChooser.Error if operation fails *) method list_shortcut_folders : string list method add_shortcut_folder_uri : string -> unit (** @raise GtkFile.FileChooser.Error if operation fails *) method remove_shortcut_folder_uri : string -> unit (** @raise GtkFile.FileChooser.Error if operation fails *) method list_shortcut_folder_uris : string list method do_overwrite_confirmation : bool (** since Gtk 2.8 *) method set_do_overwrite_confirmation : bool -> unit (** since Gtk 2.8 *) end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserWidget *) class chooser_widget_signals : ([> Gtk.widget|Gtk.file_chooser] as 'a) Gtk.obj -> object inherit GObj.widget_signals inherit chooser_signals end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserWidget *) class chooser_widget : ([> Gtk.widget|Gtk.file_chooser] as 'a) Gtk.obj -> object inherit GObj.widget inherit chooser val obj : 'a Gtk.obj method event : GObj.event_ops method connect : chooser_widget_signals end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserWidget *) val chooser_widget : action:GtkEnums.file_chooser_action -> ?backend:string -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> chooser_widget (** @since GTK 2.6 @gtkdoc gtk GtkFileChooserButton *) class chooser_button_signals : ([> Gtk.container | `filechooser] as 'a) Gtk.obj -> object inherit GContainer.container_signals inherit chooser_signals end (** @since GTK 2.6 @gtkdoc gtk GtkFileChooserButton *) class chooser_button : ([> Gtk.file_chooser_button] as 'a) Gtk.obj -> object inherit GPack.box_skel inherit chooser val obj : 'a Gtk.obj method connect : chooser_button_signals method title : string method set_title : string -> unit method width_chars : int method set_width_chars : int -> unit end val chooser_button : action:GtkEnums.file_chooser_action -> ?title:string -> ?width_chars:int -> ?backend:string -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> chooser_button (**/**) class virtual chooser_impl : object val virtual obj : [> Gtk.file_chooser] Gtk.obj inherit chooser end lablgtk-2.18.8/src/gtkBase.ml0000644000175000017500000004443613460263323015000 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkBaseProps module Object = struct include GtkObject let try_cast = Gobject.try_cast external destroy : [>`gtk] obj -> unit = "ml_gtk_object_destroy" external get_flags : [>`gtk] obj -> int = "ml_GTK_OBJECT_FLAGS" let get_flag obj wf = (get_flags obj) land (Gpointer.encode_variant GtkEnums.widget_flags wf) <> 0 module S = struct open GtkSignal let destroy = { name = "destroy"; classe = `gtk; marshaller = marshal_unit } end end module Widget = struct include Widget let size_params ~cont pl ?width ?height = let may_cons = Property.may_cons in cont ( may_cons P.width_request width ( may_cons P.height_request height pl)) external unparent : [>`widget] obj -> unit = "ml_gtk_widget_unparent" external show : [>`widget] obj -> unit = "ml_gtk_widget_show" external show_now : [>`widget] obj -> unit = "ml_gtk_widget_show_now" external show_all : [>`widget] obj -> unit = "ml_gtk_widget_show_all" external hide : [>`widget] obj -> unit = "ml_gtk_widget_hide" external hide_all : [>`widget] obj -> unit = "ml_gtk_widget_hide_all" external map : [>`widget] obj -> unit = "ml_gtk_widget_map" external unmap : [>`widget] obj -> unit = "ml_gtk_widget_unmap" external realize : [>`widget] obj -> unit = "ml_gtk_widget_realize" external unrealize : [>`widget] obj -> unit = "ml_gtk_widget_unrealize" external queue_draw : [>`widget] obj -> unit = "ml_gtk_widget_queue_draw" external queue_resize : [>`widget] obj -> unit = "ml_gtk_widget_queue_resize" external draw : [>`widget] obj -> Gdk.Rectangle.t option -> unit = "ml_gtk_widget_draw" (* external draw_focus : [>`widget] obj -> unit = "ml_gtk_widget_draw_focus" external draw_default : [>`widget] obj -> unit = "ml_gtk_widget_draw_default" *) external event : [>`widget] obj -> 'a Gdk.event -> bool = "ml_gtk_widget_event" external activate : [>`widget] obj -> bool = "ml_gtk_widget_activate" external reparent : [>`widget] obj -> [>`widget] obj -> unit = "ml_gtk_widget_reparent" (* external popup : [>`widget] obj -> x:int -> y:int -> unit = "ml_gtk_widget_popup" *) external intersect : [>`widget] obj -> Gdk.Rectangle.t -> Gdk.Rectangle.t option = "ml_gtk_widget_intersect" external set_state : [>`widget] obj -> state_type -> unit = "ml_gtk_widget_set_state" external set_uposition : [>`widget] obj -> x:int -> y:int -> unit = "ml_gtk_widget_set_uposition" external add_events : [>`widget] obj -> Gdk.Tags.event_mask list -> unit = "ml_gtk_widget_add_events" external get_toplevel : [>`widget] obj -> widget obj = "ml_gtk_widget_get_toplevel" external get_ancestor : [>`widget] obj -> g_type -> widget obj = "ml_gtk_widget_get_ancestor" external get_colormap : [>`widget] obj -> Gdk.colormap = "ml_gtk_widget_get_colormap" external get_visual : [>`widget] obj -> Gdk.visual = "ml_gtk_widget_get_visual" external get_pointer : [>`widget] obj -> int * int = "ml_gtk_widget_get_pointer" external is_ancestor : [>`widget] obj -> [>`widget] obj -> bool = "ml_gtk_widget_is_ancestor" external ensure_style : [>`widget] obj -> unit = "ml_gtk_widget_ensure_style" external modify_fg : [>`widget] obj -> state_type -> Gdk.color -> unit = "ml_gtk_widget_modify_fg" external modify_bg : [>`widget] obj -> state_type -> Gdk.color -> unit = "ml_gtk_widget_modify_bg" external modify_text : [>`widget] obj -> state_type -> Gdk.color -> unit = "ml_gtk_widget_modify_text" external modify_base : [>`widget] obj -> state_type -> Gdk.color -> unit = "ml_gtk_widget_modify_base" external modify_font : [>`widget] obj -> Pango.font_description -> unit = "ml_gtk_widget_modify_font" external get_pango_context : [>`widget] obj -> Pango.context = "ml_gtk_widget_get_pango_context" external create_pango_context : [>`widget] obj -> Pango.context = "ml_gtk_widget_create_pango_context" external render_icon : [>`widget] obj -> string -> Gtk.Tags.icon_size -> string option -> GdkPixbuf.pixbuf = "ml_gtk_widget_render_icon" external add_accelerator : ([>`widget] as 'a) obj -> sgn:('a,unit->unit) GtkSignal.t -> accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> ?flags:accel_flag list -> unit = "ml_gtk_widget_add_accelerator_bc" "ml_gtk_widget_add_accelerator" external remove_accelerator : [>`widget] obj -> accel_group -> key:Gdk.keysym -> ?modi:Gdk.Tags.modifier list -> unit = "ml_gtk_widget_remove_accelerator" external set_accel_path : [>`widget] obj -> string -> accel_group -> unit = "ml_gtk_widget_set_accel_path" (* external lock_accelerators : [>`widget] obj -> unit = "ml_gtk_widget_lock_accelerators" external unlock_accelerators : [>`widget] obj -> unit = "ml_gtk_widget_unlock_accelerators" external accelerators_locked : [>`widget] obj -> bool = "ml_gtk_widget_accelerators_locked" *) external window : [>`widget] obj -> Gdk.window = "ml_GtkWidget_window" external allocation : [>`widget] obj -> rectangle = "ml_gtk_widget_allocation" external set_colormap : [>`widget] obj -> Gdk.colormap -> unit = "ml_gtk_widget_set_colormap" external set_visual : [>`widget] obj -> Gdk.visual -> unit = "ml_gtk_widget_set_visual" external set_default_colormap : Gdk.colormap -> unit = "ml_gtk_widget_set_default_colormap" external set_default_visual : Gdk.visual -> unit = "ml_gtk_widget_set_default_visual" external get_default_colormap : unit -> Gdk.colormap = "ml_gtk_widget_get_default_colormap" external get_default_visual : unit -> Gdk.visual = "ml_gtk_widget_get_default_visual" external push_colormap : Gdk.colormap -> unit = "ml_gtk_widget_push_colormap" external push_visual : Gdk.visual -> unit = "ml_gtk_widget_push_visual" external pop_colormap : unit -> unit = "ml_gtk_widget_pop_colormap" external pop_visual : unit -> unit = "ml_gtk_widget_pop_visual" (** @since GTK 2.12 *) module Tooltip = struct external get_markup : [>`widget] obj -> string = "ml_gtk_widget_get_tooltip_markup" external set_markup : [>`widget] obj -> string -> unit = "ml_gtk_widget_set_tooltip_markup" external get_text : [>`widget] obj -> string = "ml_gtk_widget_get_tooltip_text" external set_text : [>`widget] obj -> string -> unit = "ml_gtk_widget_set_tooltip_text" external get_window : [>`widget] obj -> Gtk.window obj = "ml_gtk_widget_get_tooltip_window" external set_window : [>`widget] obj -> [>`window] obj -> unit = "ml_gtk_widget_set_tooltip_window" external get_has_tooltip : [>`widget] obj -> bool = "ml_gtk_widget_get_has_tooltip" external set_has_tooltip : [>`widget] obj -> bool -> unit = "ml_gtk_widget_set_has_tooltip" external trigger_query : [>`widget] obj -> unit = "ml_gtk_widget_trigger_tooltip_query" end module Signals = struct open GtkSignal let marshal f _ = function | `OBJECT(Some p) :: _ -> f (cast p) | _ -> invalid_arg "GtkBase.Widget.Signals.marshal" let marshal_opt f _ = function | `OBJECT(Some obj) :: _ -> f (Some (cast obj)) | `OBJECT None :: _ -> f None | _ -> invalid_arg "GtkBase.Widget.Signals.marshal_opt" module Event = struct let marshal f argv = match Closure.get_args argv with | _ :: [`POINTER(Some p)] -> let ev = GdkEvent.unsafe_copy p in Closure.set_result argv (`BOOL(f ev)) | _ -> invalid_arg "GtkBase.Widget.Event.marshal" let any : ([>`widget], Gdk.Tags.event_type Gdk.event -> bool) t = { name = "event"; classe = `widget; marshaller = marshal } let button_press : ([>`widget], GdkEvent.Button.t -> bool) t = { name = "button_press_event"; classe = `widget; marshaller = marshal } let button_release : ([>`widget], GdkEvent.Button.t -> bool) t = { name = "button_release_event"; classe = `widget; marshaller = marshal } let motion_notify : ([>`widget], GdkEvent.Motion.t -> bool) t = { name = "motion_notify_event"; classe = `widget; marshaller = marshal } let delete : ([>`widget], [`DELETE] Gdk.event -> bool) t = { name = "delete_event"; classe = `widget; marshaller = marshal } let destroy : ([>`widget], [`DESTROY] Gdk.event -> bool) t = { name = "destroy_event"; classe = `widget; marshaller = marshal } let expose : ([>`widget], GdkEvent.Expose.t -> bool) t = { name = "expose_event"; classe = `widget; marshaller = marshal } let key_press : ([>`widget], GdkEvent.Key.t -> bool) t = { name = "key_press_event"; classe = `widget; marshaller = marshal } let key_release : ([>`widget], GdkEvent.Key.t -> bool) t = { name = "key_release_event"; classe = `widget; marshaller = marshal } let enter_notify : ([>`widget], GdkEvent.Crossing.t -> bool) t = { name = "enter_notify_event"; classe = `widget; marshaller = marshal } let leave_notify : ([>`widget], GdkEvent.Crossing.t -> bool) t = { name = "leave_notify_event"; classe = `widget; marshaller = marshal } let configure : ([>`widget], GdkEvent.Configure.t -> bool) t = { name = "configure_event"; classe = `widget; marshaller = marshal } let focus_in : ([>`widget], GdkEvent.Focus.t -> bool) t = { name = "focus_in_event"; classe = `widget; marshaller = marshal } let focus_out : ([>`widget], GdkEvent.Focus.t -> bool) t = { name = "focus_out_event"; classe = `widget; marshaller = marshal } let map : ([>`widget], [`MAP] Gdk.event -> bool) t = { name = "map_event"; classe = `widget; marshaller = marshal } let unmap : ([>`widget], [`UNMAP] Gdk.event -> bool) t = { name = "unmap_event"; classe = `widget; marshaller = marshal } let property_notify : ([>`widget], GdkEvent.Property.t -> bool) t = { name = "property_notify_event"; classe = `widget; marshaller = marshal } let scroll : ([>`widget], GdkEvent.Scroll.t -> bool) t = { name = "scroll_event"; classe = `widget; marshaller = marshal } let selection_clear : ([>`widget], GdkEvent.Selection.t -> bool) t = { name = "selection_clear_event"; classe = `widget; marshaller = marshal } let selection_request : ([>`widget], GdkEvent.Selection.t -> bool) t = { name = "selection_request_event"; classe = `widget; marshaller = marshal } let selection_notify : ([>`widget], GdkEvent.Selection.t -> bool) t = { name = "selection_notify_event"; classe = `widget; marshaller = marshal } let proximity_in : ([>`widget], GdkEvent.Proximity.t -> bool) t = { name = "proximity_in_event"; classe = `widget; marshaller = marshal } let proximity_out : ([>`widget], GdkEvent.Proximity.t -> bool) t = { name = "proximity_out_event"; classe = `widget; marshaller = marshal } let client : ([>`widget], GdkEvent.Client.t -> bool) t = { name = "client_event"; classe = `widget; marshaller = marshal } let visibility_notify : ([>`widget], GdkEvent.Visibility.t -> bool) t = { name = "visibility_notify_event"; classe = `widget; marshaller = marshal } let window_state : ([>`widget], GdkEvent.WindowState.t -> bool) t = { name = "window_state_event"; classe = `widget; marshaller = marshal } end end end module Container = struct include Container let make_params ~cont pl ?border_width = Widget.size_params pl ~cont:(fun p -> cont (Property.may_cons P.border_width border_width p)) let children w = let l = ref [] in foreach w ~f:(fun c -> l := c :: !l); List.rev !l end module Bin = Bin module Item = Item (* Clipboard provides high-level access to Selection *) module Clipboard = struct external get : Gdk.atom -> clipboard = "ml_gtk_clipboard_get" external clear : clipboard -> unit = "ml_gtk_clipboard_clear" external set_text : clipboard -> string -> unit = "ml_gtk_clipboard_set_text" external set_image : clipboard -> GdkPixbuf.pixbuf -> unit = "ml_gtk_clipboard_set_image" external wait_for_contents : clipboard -> target:Gdk.atom -> selection_data = "ml_gtk_clipboard_wait_for_contents" external wait_for_text : clipboard -> string option = "ml_gtk_clipboard_wait_for_text" external wait_for_image : clipboard -> GdkPixbuf.pixbuf option = "ml_gtk_clipboard_wait_for_image" external wait_for_targets : clipboard -> Gdk.atom list = "ml_gtk_clipboard_wait_for_targets" external request_contents : clipboard -> target:Gdk.atom -> callback:(selection_data -> unit) -> unit = "ml_gtk_clipboard_request_contents" external request_text : clipboard -> callback:(string option -> unit) -> unit = "ml_gtk_clipboard_request_text" end (* Use of Selection is deprecated: rather use simpler Clipboard module *) module Selection = struct external selection : selection_data -> Gdk.atom = "ml_gtk_selection_data_selection" external target : selection_data -> Gdk.atom = "ml_gtk_selection_data_target" external seltype : selection_data -> Gdk.atom = "ml_gtk_selection_data_type" external format : selection_data -> int = "ml_gtk_selection_data_format" external get_data : selection_data -> string = "ml_gtk_selection_data_get_data" (* May raise Gpointer.null *) external set : selection_data -> typ:Gdk.atom -> format:int -> data:string option -> unit = "ml_gtk_selection_data_set" (* Create a memory-managed copy of the data *) external copy : selection_data -> selection_data = "ml_gtk_selection_data_copy" external owner_set : [>`widget] obj -> sel:Gdk.atom -> time:int32 -> bool = "ml_gtk_selection_owner_set" external add_target : [>`widget] obj -> sel:Gdk.atom -> target:Gdk.atom -> info:int -> unit = "ml_gtk_selection_add_target" external convert : [> `widget] obj -> sel:Gdk.atom -> target:Gdk.atom -> time:int32 -> bool = "ml_gtk_selection_convert" external clear_targets : [>`widget] obj -> sel:Gdk.atom -> unit = "ml_gtk_selection_clear_targets" end module DnD = struct external dest_set : [>`widget] obj -> flags:dest_defaults list -> targets:target_entry array -> actions:Gdk.Tags.drag_action list -> unit = "ml_gtk_drag_dest_set" external dest_unset : [>`widget] obj -> unit = "ml_gtk_drag_dest_unset" external finish : Gdk.drag_context -> success:bool -> del:bool -> time:int32 -> unit = "ml_gtk_drag_finish" external get_data : [>`widget] obj -> Gdk.drag_context -> target:Gdk.atom -> time:int32 -> unit = "ml_gtk_drag_get_data" external get_source_widget : Gdk.drag_context -> widget obj = "ml_gtk_drag_get_source_widget" external highlight : [>`widget] obj -> unit = "ml_gtk_drag_highlight" external unhighlight : [>`widget] obj -> unit = "ml_gtk_drag_unhighlight" external set_icon_widget : Gdk.drag_context -> [>`widget] obj -> hot_x:int -> hot_y:int -> unit = "ml_gtk_drag_set_icon_widget" external set_icon_pixmap : Gdk.drag_context -> colormap:Gdk.colormap -> Gdk.pixmap -> ?mask:Gdk.bitmap -> hot_x:int -> hot_y:int -> unit = "ml_gtk_drag_set_icon_pixmap_bc" "ml_gtk_drag_set_icon_pixmap" external set_icon_default : Gdk.drag_context -> unit = "ml_gtk_drag_set_icon_default" external set_default_icon : colormap:Gdk.colormap -> Gdk.pixmap -> ?mask:Gdk.bitmap -> hot_x:int -> hot_y:int -> unit = "ml_gtk_drag_set_default_icon" external source_set : [>`widget] obj -> ?modi:Gdk.Tags.modifier list -> targets:target_entry array -> actions:Gdk.Tags.drag_action list -> unit = "ml_gtk_drag_source_set" external source_set_icon : [>`widget] obj -> colormap:Gdk.colormap -> Gdk.pixmap -> ?mask:Gdk.bitmap -> unit = "ml_gtk_drag_source_set_icon" external source_unset : [>`widget] obj -> unit = "ml_gtk_drag_source_unset" (* external dest_handle_event : [>`widget] -> *) end (** @since GTK 2.12 *) module Tooltip = struct external set_markup : tooltip -> string -> unit = "ml_gtk_tooltip_set_markup" external set_text : tooltip -> string -> unit = "ml_gtk_tooltip_set_text" external set_icon : tooltip -> GdkPixbuf.pixbuf -> unit = "ml_gtk_tooltip_set_icon" external set_icon_from_stock : tooltip -> string -> Gtk.Tags.icon_size -> unit = "ml_gtk_tooltip_set_icon_from_stock" let set_icon_from_stock tt id = set_icon_from_stock tt (GtkStock.convert_id id) external set_custom : tooltip -> [>`widget] obj -> unit = "ml_gtk_tooltip_set_custom" external trigger_query : Gdk.display -> unit = "ml_gtk_tooltip_trigger_tooltip_query" external set_tip_area : tooltip -> Gdk.Rectangle.t -> unit = "ml_gtk_tooltip_set_tip_area" end lablgtk-2.18.8/src/gUtil.ml0000644000175000017500000001003113460263323014464 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open GObj let print_widget ppf (o : #widget) = Format.fprintf ppf "<%s@@0x%x>" o#misc#get_type o#get_oid class ['a] memo () = object val tbl : (int, 'a) Hashtbl.t = Hashtbl.create 7 method add (obj : 'a) = Hashtbl.add tbl obj#get_oid obj method find (obj : widget) = Hashtbl.find tbl obj#get_oid method remove (obj : widget) = Hashtbl.remove tbl obj#get_oid end let signal_id = ref 0 let next_callback_id () : GtkSignal.id = decr signal_id; Obj.magic (!signal_id : int) class ['a] signal () = object (self) val mutable callbacks : (GtkSignal.id * ('a -> unit)) list = [] method callbacks = callbacks method connect ~after ~callback = let id = next_callback_id () in callbacks <- if after then callbacks @ [id,callback] else (id,callback)::callbacks; id method call arg = List.exists callbacks ~f: begin fun (_,f) -> let old = GtkSignal.push_callback () in try f arg; GtkSignal.pop_callback old with exn -> GtkSignal.pop_callback old; raise exn end; () method disconnect key = List.mem_assoc key ~map:callbacks && (callbacks <- List.remove_assoc key callbacks; true) end class virtual ml_signals disconnectors = object (self) val after = false method after = {< after = true >} val mutable disconnectors : (GtkSignal.id -> bool) list = disconnectors method disconnect key = ignore (List.exists disconnectors ~f:(fun f -> f key)) end class virtual add_ml_signals obj disconnectors = object (self) val mutable disconnectors : (GtkSignal.id -> bool) list = disconnectors method disconnect key = if List.exists disconnectors ~f:(fun f -> f key) then () else GtkSignal.disconnect obj key end class ['a] variable_signals ~(set : 'a signal) ~(changed : 'a signal) = object inherit ml_signals [changed#disconnect; set#disconnect] method changed = changed#connect ~after method set = set#connect ~after end class ['a] variable x = object (self) val changed = new signal () val set = new signal () method connect = new variable_signals ~set ~changed val mutable x : 'a = x method get = x method set = set#call method private equal : 'a -> 'a -> bool = (=) method private real_set y = let x0 = x in x <- y; if changed#callbacks <> [] && not (self#equal x x0) then changed#call y initializer ignore (set#connect ~after:false ~callback:self#real_set) end lablgtk-2.18.8/src/gtkBroken.props0000644000175000017500000000221613460263323016067 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } classes { GtkAdjustment "Gtk.adjustment obj" } class TreeItem wrapsig : Item { method set_subtree : "[>`widget] obj -> unit" method remove_subtree method collapse method expand signal collapse signal expand } class Tree : Container { signal select_child : GtkWidget signal selection_changed signal unselect_child : GtkWidget } class OldEditable abstract wrapsig : Editable { "text-position" gint : Read / Write method claim_selection : "claim:bool -> time:int -> unit" method changed signal activate signal copy_clipboard signal cut_clipboard signal paste_clipboard signal move_cursor : int int signal move_word : int signal move_page : int signal move_to_row : int signal move_to_column : int } class Text wrap set : OldEditable { "hadjustment" GtkAdjustment : Read / Write "vadjustment" GtkAdjustment : Read / Write "editable" gboolean : Read / Write / NoWrap "line-wrap" gboolean : Read / Write "word_wrap" gboolean : Read / Write } lablgtk-2.18.8/src/gtkThInit.ml0000644000175000017500000000347613460263323015324 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* GtkThInit: Start the main thread in a threaded toplevel *) (* Never use with the Quartz backend, as the GUI must run in the main thread *) (* See GtkThTop for another way to obtain the same result *) let thread = GtkThread.start () lablgtk-2.18.8/src/gTree.mli0000644000175000017500000007377413460263323014646 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject open Gtk open GObj open GContainer (** Tree and list widgets @gtkdoc gtk TreeWidget *) (** {3 New GtkTreeView/Model framework} *) type 'a column = {index: int; conv: 'a data_conv; creator: int} class column_list : object method add : 'a data_conv -> 'a column method id : int method types : g_type list method lock : unit -> unit end class row_reference : Gtk.row_reference -> model:[> `treemodel ] obj -> object method as_ref : Gtk.row_reference method iter : tree_iter method path : tree_path method valid : bool end (** {4 Models} *) (** @gtkdoc gtk GtkTreeModel *) class model_signals : [> `treemodel] obj -> object ('a) method after : 'a method row_changed : callback:(tree_path -> tree_iter -> unit) -> GtkSignal.id method row_deleted : callback:(tree_path -> unit) -> GtkSignal.id method row_has_child_toggled : callback:(tree_path -> tree_iter -> unit) -> GtkSignal.id method row_inserted : callback:(tree_path -> tree_iter -> unit) -> GtkSignal.id method rows_reordered : callback:(tree_path -> tree_iter -> unit) -> GtkSignal.id end val model_ids : (int,int) Hashtbl.t (** @gtkdoc gtk GtkTreeModel *) class model : ([> `treemodel] as 'a) obj -> object val obj : 'a obj val id : int method as_model : Gtk.tree_model method misc : gobject_ops method coerce : model method flags : GtkEnums.tree_model_flags list method n_columns : int method get_column_type : int -> Gobject.g_type method get_iter : tree_path -> tree_iter method get_path : tree_iter -> tree_path method get_row_reference : tree_path -> row_reference method get : row:tree_iter -> column:'b column -> 'b method get_iter_first : tree_iter option method iter_next : tree_iter -> bool method iter_has_child : tree_iter -> bool method iter_n_children : tree_iter option -> int method iter_children : ?nth:int -> tree_iter option -> tree_iter (** @raise Invalid_argument if arguments do not designate a valid node *) method iter_parent : tree_iter -> tree_iter option method foreach : (tree_path -> tree_iter -> bool) -> unit method row_changed : tree_path -> tree_iter -> unit end (** @gtkdoc gtk GtkTreeSortable *) class tree_sortable_signals : ([> `treesortable|`treemodel] as 'a) obj -> object inherit model_signals method sort_column_changed : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkTreeSortable *) class tree_sortable : ([> `treesortable|`treemodel] as 'a) obj -> object inherit model val obj : 'a obj method connect : tree_sortable_signals method sort_column_changed : unit -> unit method get_sort_column_id : (int * Gtk.Tags.sort_type) option method set_sort_column_id : int -> Gtk.Tags.sort_type -> unit method set_sort_func : int -> (model -> Gtk.tree_iter -> Gtk.tree_iter -> int) -> unit method set_default_sort_func : (model -> Gtk.tree_iter -> Gtk.tree_iter -> int) -> unit method has_default_sort_func : bool end (** Special value for the [#set_sort_column_id] method of {!GTree.tree_sortable}. *) val default_sort_column_id : int val unsorted_sort_column_id : int (** @gtkdoc gtk GtkTreeStore *) class tree_store : Gtk.tree_store -> object inherit tree_sortable val obj : Gtk.tree_store method append : ?parent:tree_iter -> unit -> tree_iter method clear : unit -> unit method insert : ?parent:tree_iter -> int -> tree_iter method insert_after : ?parent:tree_iter -> tree_iter -> tree_iter method insert_before : ?parent:tree_iter -> tree_iter -> tree_iter method is_ancestor : iter:tree_iter -> descendant:tree_iter -> bool method iter_depth : tree_iter -> int method iter_is_valid : tree_iter -> bool (** @since GTK 2.2 *) method move_after : iter:tree_iter -> pos:tree_iter -> bool (** @since GTK 2.2 *) method move_before : iter:tree_iter -> pos:tree_iter -> bool (** @since GTK 2.2 *) method prepend : ?parent:tree_iter -> unit -> tree_iter method remove : tree_iter -> bool method set : row:tree_iter -> column:'a column -> 'a -> unit method swap : tree_iter -> tree_iter -> bool (** @since GTK 2.2 *) end (** @gtkdoc gtk GtkTreeStore *) val tree_store : column_list -> tree_store (** @gtkdoc gtk GtkListStore *) class list_store : Gtk.list_store -> object inherit tree_sortable val obj : Gtk.list_store method append : unit -> tree_iter method clear : unit -> unit method insert : int -> tree_iter method insert_after : tree_iter -> tree_iter method insert_before : tree_iter -> tree_iter method iter_is_valid : tree_iter -> bool (** @since GTK 2.2 *) method move_after : iter:tree_iter -> pos:tree_iter -> bool (** @since GTK 2.2 *) method move_before : iter:tree_iter -> pos:tree_iter -> bool (** @since GTK 2.2 *) method prepend : unit -> tree_iter method remove : tree_iter -> bool method set : row:tree_iter -> column:'a column -> 'a -> unit method swap : tree_iter -> tree_iter -> bool (** @since GTK 2.2 *) end (** @gtkdoc gtk GtkListStore *) val list_store : column_list -> list_store (** Convenience function to map a caml list into a {!GTree.list_store} with a single column *) val store_of_list : 'a Gobject.data_conv -> 'a list -> list_store * 'a column (** @gtkdoc gtk GtkTreeModelSort *) class model_sort : Gtk.tree_model_sort -> object inherit tree_sortable val obj : Gtk.tree_model_sort method model : model method convert_child_path_to_path : Gtk.tree_path -> Gtk.tree_path method convert_child_iter_to_iter : Gtk.tree_iter -> Gtk.tree_iter method convert_path_to_child_path : Gtk.tree_path -> Gtk.tree_path method convert_iter_to_child_iter : Gtk.tree_iter -> Gtk.tree_iter method reset_default_sort_func : unit -> unit method iter_is_valid : Gtk.tree_iter -> bool (** @since GTK 2.2 *) end (** @gtkdoc gtk GtkTreeModelSort *) val model_sort : #model -> model_sort (** @since GTK 2.4 @gtkdoc gtk GtkTreeModelFilter *) class model_filter : Gtk.tree_model_filter -> object inherit model val obj : Gtk.tree_model_filter method connect : model_signals method child_model : model method virtual_root : Gtk.tree_path method set_visible_func : (model -> Gtk.tree_iter -> bool) -> unit method set_visible_column : bool column -> unit method convert_child_path_to_path : Gtk.tree_path -> Gtk.tree_path method convert_child_iter_to_iter : Gtk.tree_iter -> Gtk.tree_iter method convert_path_to_child_path : Gtk.tree_path -> Gtk.tree_path method convert_iter_to_child_iter : Gtk.tree_iter -> Gtk.tree_iter method refilter : unit -> unit end (** @since GTK 2.4 @gtkdoc gtk GtkTreeModelFilter *) val model_filter : ?virtual_root:Gtk.tree_path -> #model -> model_filter module Path : sig val create : int list -> Gtk.tree_path val copy : Gtk.tree_path -> Gtk.tree_path val get_indices : Gtk.tree_path -> int array val from_string : string -> Gtk.tree_path val to_string : Gtk.tree_path -> string val get_depth : Gtk.tree_path -> int val is_ancestor : Gtk.tree_path -> Gtk.tree_path -> bool (** {5 Mutating functions} *) val append_index : Gtk.tree_path -> int -> unit val prepend_index : Gtk.tree_path -> int -> unit val next : Gtk.tree_path -> unit val prev : Gtk.tree_path -> bool val up : Gtk.tree_path -> bool val down : Gtk.tree_path -> unit end (** {4 Selection} *) (** @gtkdoc gtk GtkTreeSelection *) class selection_signals : tree_selection -> object ('a) method after : 'a method changed : callback:(unit -> unit) -> GtkSignal.id end (** The selection object for {!GTree.view} @gtkdoc gtk GtkTreeSelection *) class selection : Gtk.tree_selection -> object val obj : Gtk.tree_selection method connect : selection_signals method misc : gobject_ops method count_selected_rows : int (** @since GTK 2.2 *) method get_mode : Tags.selection_mode method get_selected_rows : tree_path list method iter_is_selected : tree_iter -> bool method path_is_selected : tree_path -> bool method select_all : unit -> unit method select_iter : tree_iter -> unit method select_path : tree_path -> unit method select_range : tree_path -> tree_path -> unit method set_mode : Tags.selection_mode -> unit method set_select_function : (tree_path -> bool -> bool) -> unit method unselect_all : unit -> unit method unselect_iter : tree_iter -> unit method unselect_path : tree_path -> unit method unselect_range : tree_path -> tree_path -> unit (** @since GTK 2.2 *) end (** {4 Views} *) class type cell_renderer = object method as_renderer : Gtk.cell_renderer obj end (** @since GTK 2.4 @gtkdoc gtk GtkCellLayout *) class cell_layout : ([> Gtk.cell_layout] as 'a) Gtk.obj -> object method pack : ?expand:bool -> ?from:Tags.pack_type -> #cell_renderer -> unit (** @param expand default value is [false] @param from default value is [`START] *) method reorder : #cell_renderer -> int -> unit method clear : unit -> unit method add_attribute : #cell_renderer -> string -> 'b column -> unit method clear_attributes : #cell_renderer -> unit method set_cell_data_func : #cell_renderer -> (model -> Gtk.tree_iter -> unit) -> unit method unset_cell_data_func : #cell_renderer -> unit end (** @gtkdoc gtk GtkTreeViewColumn *) class view_column_signals : [> `gtk | `treeviewcolumn] obj -> object inherit GObj.gtkobj_signals method clicked : callback:(unit -> unit) -> GtkSignal.id end (** A visible column in a {!GTree.view} widget @gtkdoc gtk GtkTreeViewColumn *) class view_column : tree_view_column obj -> object inherit GObj.gtkobj inherit cell_layout val obj : tree_view_column obj method as_column : Gtk.tree_view_column obj method misc : GObj.gobject_ops method alignment : float method clickable : bool method connect : view_column_signals method expand : bool method fixed_width : int method get_sort_column_id : int method max_width : int method min_width : int method reorderable : bool method resizable : bool method set_alignment : float -> unit method set_clickable : bool -> unit method set_expand : bool -> unit method set_fixed_width : int -> unit method set_max_width : int -> unit method set_min_width : int -> unit method set_reorderable : bool -> unit method set_resizable : bool -> unit method set_sizing : Tags.tree_view_column_sizing -> unit method set_sort_column_id : int -> unit method set_sort_indicator : bool -> unit method set_sort_order : Tags.sort_type -> unit method set_title : string -> unit method set_visible : bool -> unit method set_widget : widget option -> unit method sizing : Tags.tree_view_column_sizing method sort_indicator : bool method sort_order : Tags.sort_type method title : string method visible : bool method widget : widget option method width : int end (** @gtkdoc gtk GtkTreeViewColumn *) val view_column : ?title:string -> ?renderer:(#cell_renderer * (string * 'a column) list) -> unit -> view_column (** @gtkdoc gtk GtkTreeView *) class view_signals : [> tree_view] obj -> object ('a) inherit GContainer.container_signals method columns_changed : callback:(unit -> unit) -> GtkSignal.id method cursor_changed : callback:(unit -> unit) -> GtkSignal.id method expand_collapse_cursor_row : callback:(logical:bool -> expand:bool -> all:bool -> bool) -> GtkSignal.id method move_cursor : callback:(Tags.movement_step -> int -> bool) -> GtkSignal.id method row_activated : callback:(tree_path -> view_column -> unit) -> GtkSignal.id method row_collapsed : callback:(tree_iter -> tree_path -> unit) -> GtkSignal.id method row_expanded : callback:(tree_iter -> tree_path -> unit) -> GtkSignal.id method select_all : callback:(unit -> bool) -> GtkSignal.id method select_cursor_parent : callback:(unit -> bool) -> GtkSignal.id method select_cursor_row : callback:(start_editing:bool -> bool) -> GtkSignal.id method set_scroll_adjustments : callback:(GData.adjustment option -> GData.adjustment option -> unit) -> GtkSignal.id method start_interactive_search : callback:(unit -> bool) -> GtkSignal.id method test_collapse_row : callback:(tree_iter -> tree_path -> bool) -> GtkSignal.id method test_expand_row : callback:(tree_iter -> tree_path -> bool) -> GtkSignal.id method toggle_cursor_row : callback:(unit -> bool) -> GtkSignal.id method unselect_all : callback:(unit -> bool) -> GtkSignal.id method notify_enable_search : callback:(bool -> unit) -> GtkSignal.id method notify_enable_tree_lines : callback:(bool -> unit) -> GtkSignal.id method notify_enable_grid_lines : callback:(GtkEnums.tree_view_grid_lines -> unit) -> GtkSignal.id method notify_fixed_height_mode : callback:(bool -> unit) -> GtkSignal.id method notify_hadjustment : callback:(GData.adjustment -> unit) -> GtkSignal.id method notify_headers_visible : callback:(bool -> unit) -> GtkSignal.id method notify_hover_expand : callback:(bool -> unit) -> GtkSignal.id method notify_hover_selection : callback:(bool -> unit) -> GtkSignal.id method notify_reorderable : callback:(bool -> unit) -> GtkSignal.id method notify_rules_hint : callback:(bool -> unit) -> GtkSignal.id method notify_search_column : callback:(int -> unit) -> GtkSignal.id method notify_tooltip_column : callback:(int -> unit) -> GtkSignal.id method notify_vadjustment : callback:(GData.adjustment -> unit) -> GtkSignal.id end (** A widget for displaying both trees and lists @gtkdoc gtk GtkTreeView *) class view : tree_view obj -> object inherit GContainer.container val obj : tree_view obj method as_tree_view : Gtk.tree_view Gtk.obj method connect : view_signals method append_column : view_column -> int method collapse_all : unit -> unit method collapse_row : tree_path -> unit method enable_search : bool method event : GObj.event_ops method expand_all : unit -> unit method expand_row : ?all:bool -> tree_path -> unit (** @param all default value is [false] *) method expand_to_path : tree_path -> unit (** @since GTK 2.2 *) method expander_column : view_column option method fixed_height_mode : bool method get_column : int -> view_column method get_cursor : unit -> tree_path option * view_column option method get_path_at_pos : x:int -> y:int -> (tree_path * view_column * int * int) option method get_cell_area : ?path:tree_path -> ?col:view_column -> unit -> Gdk.Rectangle.t method get_visible_range : unit -> (tree_path * tree_path) option method hadjustment : GData.adjustment method headers_visible : bool method insert_column : view_column -> int -> int method model : model method move_column : view_column -> after:view_column -> int method remove_column : view_column -> int method reorderable : bool method row_activated : tree_path -> view_column -> unit method row_expanded : tree_path -> bool method rules_hint : bool method scroll_to_cell : ?align:float * float -> tree_path -> view_column -> unit method scroll_to_point : int -> int -> unit method search_column : int method selection : selection method set_cursor : ?cell:#cell_renderer -> ?edit:bool -> tree_path -> view_column -> unit (** @since GTK 2.2 *) (** @param edit default value is [false] *) method set_enable_search : bool -> unit method set_expander_column : view_column option -> unit method set_fixed_height_mode : bool -> unit method set_hadjustment : GData.adjustment -> unit method set_headers_clickable : bool -> unit method set_headers_visible : bool -> unit method set_model : model option -> unit method set_reorderable : bool -> unit method set_rules_hint : bool -> unit method set_search_column : int -> unit method set_tooltip_column : int -> unit method set_vadjustment : GData.adjustment -> unit method tooltip_column : int method vadjustment : GData.adjustment method hover_expand : bool (** @since GTK 2.6 *) method set_hover_expand : bool -> unit (** @since GTK 2.6 *) method hover_selection : bool (** @since GTK 2.6 *) method set_hover_selection : bool -> unit (** @since GTK 2.6 *) method set_row_separator_func : (model -> tree_iter -> bool) option -> unit (** @since GTK 2.6 *) method enable_grid_lines : GtkEnums.tree_view_grid_lines (** @since GTK 2.10 *) method enable_tree_lines : bool (** @since GTK 2.10 *) method set_enable_grid_lines : GtkEnums.tree_view_grid_lines -> unit (** @since GTK 2.10 *) method set_enable_tree_lines : bool -> unit (** @since GTK 2.10 *) end (** @gtkdoc gtk GtkTreeView *) val view : ?model:#model -> ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?enable_search:bool -> ?fixed_height_mode:bool -> ?headers_clickable:bool -> ?headers_visible:bool -> ?reorderable:bool -> ?rules_hint:bool -> ?search_column:int -> ?tooltip_column:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> view (** @param enable_search default value is [true] @param fixed_height_mode default value is [false] @param headers_clickable default value is [false] @param headers_visible default value is [true] @param reorderable default value is [false] @param rules_hint default value is [false] *) (** {4 Cell Renderers} *) type cell_properties = [ `CELL_BACKGROUND of string | `CELL_BACKGROUND_GDK of Gdk.color | `CELL_BACKGROUND_SET of bool | `HEIGHT of int | `IS_EXPANDED of bool | `IS_EXPANDER of bool | `MODE of Tags.cell_renderer_mode | `VISIBLE of bool | `WIDTH of int | `XALIGN of float | `XPAD of int | `YALIGN of float | `YPAD of int ] type cell_properties_pixbuf = [ cell_properties | `PIXBUF of GdkPixbuf.pixbuf | `PIXBUF_EXPANDER_CLOSED of GdkPixbuf.pixbuf | `PIXBUF_EXPANDER_OPEN of GdkPixbuf.pixbuf | `STOCK_DETAIL of string | `STOCK_ID of string | `STOCK_SIZE of Tags.icon_size ] type cell_properties_text = [ cell_properties | `BACKGROUND of string | `BACKGROUND_GDK of Gdk.color | `BACKGROUND_SET of bool | `EDITABLE of bool | `FAMILY of string | `FONT of string | `FONT_DESC of Pango.font_description | `FOREGROUND of string | `FOREGROUND_GDK of Gdk.color | `FOREGROUND_SET of bool | `MARKUP of string | `RISE of int | `SCALE of Pango.Tags.scale | `SINGLE_PARAGRAPH_MODE of bool | `SIZE of int | `SIZE_POINTS of float | `STRETCH of Pango.Tags.stretch | `STRIKETHROUGH of bool | `STYLE of Pango.Tags.style | `TEXT of string | `UNDERLINE of Pango.Tags.underline | `VARIANT of Pango.Tags.variant | `WEIGHT of Pango.Tags.weight ] type cell_properties_toggle = [ cell_properties | `ACTIVATABLE of bool | `ACTIVE of bool | `INCONSISTENT of bool | `RADIO of bool ] type cell_properties_progress = [ cell_properties | `VALUE of int | `TEXT of string option ] type cell_properties_combo = [ cell_properties_text | `MODEL of model option | `TEXT_COLUMN of string column | `HAS_ENTRY of bool ] type cell_properties_accel = [ cell_properties_text | `KEY of Gdk.keysym | `ACCEL_MODE of GtkEnums.cell_renderer_accel_mode | `MODS of GdkEnums.modifier list | `KEYCODE of int ] (** @gtkdoc gtk GtkCellRenderer *) class type ['a, 'b] cell_renderer_skel = object inherit GObj.gtkobj val obj : 'a obj method as_renderer : Gtk.cell_renderer obj method get_property : ('a, 'c) property -> 'c method set_properties : 'b list -> unit end (** @gtkdoc gtk GtkCellRenderer *) class virtual ['a, 'b] cell_renderer_impl : ([>Gtk.cell_renderer] as 'a) obj -> object inherit ['a,'b] cell_renderer_skel method private virtual param : 'b -> 'a param end (** @gtkdoc gtk GtkCellRendererPixbuf *) class cell_renderer_pixbuf : Gtk.cell_renderer_pixbuf obj -> object inherit[Gtk.cell_renderer_pixbuf,cell_properties_pixbuf] cell_renderer_skel method connect : GObj.gtkobj_signals_impl end (** @gtkdoc gtk GtkCellRendererText *) class cell_renderer_text_signals : ([>Gtk.cell_renderer_text] as 'a) obj -> object inherit GObj.gtkobj_signals val obj : 'a obj method edited : callback:(Gtk.tree_path -> string -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkCellRendererText *) class cell_renderer_text : Gtk.cell_renderer_text obj -> object inherit [Gtk.cell_renderer_text,cell_properties_text] cell_renderer_skel method connect : cell_renderer_text_signals method set_fixed_height_from_font : int -> unit end (** @gtkdoc gtk GtkCellRendererToggle *) class cell_renderer_toggle_signals : Gtk.cell_renderer_toggle obj -> object inherit GObj.gtkobj_signals method toggled : callback:(Gtk.tree_path -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkCellRendererToggle *) class cell_renderer_toggle : Gtk.cell_renderer_toggle obj -> object inherit[Gtk.cell_renderer_toggle,cell_properties_toggle] cell_renderer_skel method connect : cell_renderer_toggle_signals end (** @since GTK 2.6 @gtkdoc gtk GtkCellRendererProgress *) class cell_renderer_progress : Gtk.cell_renderer_progress obj -> object inherit[Gtk.cell_renderer_progress,cell_properties_progress] cell_renderer_skel method connect : GObj.gtkobj_signals_impl end (** @since GTK 2.6 @gtkdoc gtk GtkCellRendererCombo *) class cell_renderer_combo_signals : ([>Gtk.cell_renderer_combo] as 'a) obj -> object inherit cell_renderer_text_signals val obj : 'a obj method changed : callback:(Gtk.tree_path -> Gtk.tree_iter -> unit) -> GtkSignal.id end (** @since GTK 2.6 @gtkdoc gtk GtkCellRendererCombo *) class cell_renderer_combo : Gtk.cell_renderer_combo obj -> object inherit[Gtk.cell_renderer_combo,cell_properties_combo] cell_renderer_skel method connect : cell_renderer_combo_signals method set_fixed_height_from_font : int -> unit end (** @since GTK 2.10 @gtkdoc gtk GtkCellRendererText *) class cell_renderer_accel_signals : Gtk.cell_renderer_accel obj -> object inherit GObj.gtkobj_signals method edited : callback:(Gtk.tree_path -> string -> unit) -> GtkSignal.id method accel_edited : callback:(tree_path -> accel_key:int -> accel_mods:int -> hardware_keycode:int -> unit) -> GtkSignal.id method accel_cleared : callback:(tree_path -> unit) -> GtkSignal.id end (** @since GTK 2.10 @gtkdoc gtk GtkCellRendererAccel *) class cell_renderer_accel : Gtk.cell_renderer_accel obj -> object inherit[Gtk.cell_renderer_accel,cell_properties_accel] cell_renderer_skel method connect : cell_renderer_accel_signals end (** @gtkdoc gtk GtkCellRendererPixbuf *) val cell_renderer_pixbuf : cell_properties_pixbuf list -> cell_renderer_pixbuf (** @gtkdoc gtk GtkCellRendererText *) val cell_renderer_text : cell_properties_text list -> cell_renderer_text (** @gtkdoc gtk GtkCellRendererToggle *) val cell_renderer_toggle : cell_properties_toggle list -> cell_renderer_toggle (** @since GTK 2.6 @gtkdoc gtk GtkCellRendererProgress *) val cell_renderer_progress : cell_properties_progress list -> cell_renderer_progress (** @since GTK 2.6 @gtkdoc gtk GtkCellRendererCombo *) val cell_renderer_combo : cell_properties_combo list -> cell_renderer_combo (** @since GTK 2.10 @gtkdoc gtk GtkCellRendererAccel *) val cell_renderer_accel : cell_properties_accel list -> cell_renderer_accel (** {3 GtkIconView} *) (** @gtkdoc gtk GtkIconView @since GTK 2.6 *) class icon_view_signals : [> Gtk.icon_view] Gtk.obj -> object inherit GContainer.container_signals method item_activated : callback:(Gtk.tree_path -> unit) -> GtkSignal.id method selection_changed : callback:(unit -> unit) -> GtkSignal.id method notify_column_spacing : callback:(int -> unit) -> GtkSignal.id method notify_columns : callback:(int -> unit) -> GtkSignal.id method notify_item_width : callback:(int -> unit) -> GtkSignal.id method notify_margin : callback:(int -> unit) -> GtkSignal.id method notify_orientation : callback:(GtkEnums.orientation -> unit) -> GtkSignal.id method notify_row_spacing : callback:(int -> unit) -> GtkSignal.id method notify_selection_mode : callback:(GtkEnums.selection_mode -> unit) -> GtkSignal.id method notify_spacing : callback:(int -> unit) -> GtkSignal.id end (** A widget which displays a list of icons in a grid @gtkdoc gtk GtkIconView @since GTK 2.6 *) class icon_view : ([> Gtk.icon_view] as 'a) Gtk.obj -> object inherit GContainer.container val obj : 'a Gtk.obj method connect : icon_view_signals method event : GObj.event_ops (** Properties *) method model : model method set_model : model option -> unit method set_markup_column : string column -> unit method set_pixbuf_column : GdkPixbuf.pixbuf column -> unit method set_text_column : string column -> unit method orientation : GtkEnums.orientation method set_orientation : GtkEnums.orientation -> unit method selection_mode : GtkEnums.selection_mode method set_selection_mode : GtkEnums.selection_mode -> unit method column_spacing : int method set_column_spacing : int -> unit method item_width : int method set_item_width : int -> unit method margin : int method set_margin : int -> unit method columns : int method set_columns : int -> unit method row_spacing : int method set_row_spacing : int -> unit method spacing : int method set_spacing : int -> unit method get_path_at_pos : int -> int -> Gtk.tree_path option method selected_foreach : (Gtk.tree_path -> unit) -> unit method get_selected_items : Gtk.tree_path list method path_is_selected : Gtk.tree_path -> bool method select_path : Gtk.tree_path -> unit method unselect_path : Gtk.tree_path -> unit method select_all : unit -> unit method unselect_all : unit -> unit method item_activated : Gtk.tree_path -> unit end (** A widget which displays a list of icons in a grid @gtkdoc gtk GtkIconView @since GTK 2.6 *) val icon_view : ?model:#model -> ?columns:int -> ?orientation:GtkEnums.orientation -> ?selection_mode:GtkEnums.selection_mode -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> icon_view class type virtual ['obj,'row,'a,'b,'c] custom_tree_model_type = object inherit model val obj : 'obj method connect : model_signals (** Signal emitters *) method custom_row_changed : Gtk.tree_path -> 'row -> unit method custom_row_deleted : Gtk.tree_path -> unit method custom_row_has_child_toggled : Gtk.tree_path -> 'row -> unit method custom_row_inserted : Gtk.tree_path -> 'row -> unit method custom_rows_reordered : Gtk.tree_path -> 'row option -> int array -> unit (** Override these to implement a cache of rows *) method custom_unref_node : 'row -> unit method custom_ref_node : 'row -> unit method custom_flags : GtkEnums.tree_model_flags list (** Functions of the custom model. They must act exactly as described in the documentation of Gtk orelse Gtk may emit fatal errors. *) method virtual custom_get_iter : Gtk.tree_path -> 'row option method virtual custom_get_path : 'row -> Gtk.tree_path method virtual custom_value : Gobject.g_type -> 'row -> column:int -> Gobject.basic (** [custom_value typ row ~column] is the value to set in [row] for column [column]. It must must be of the type [typ], i.e. the type declared for column [column]. *) method virtual custom_iter_children : 'row option -> 'row option method virtual custom_iter_has_child : 'row -> bool method virtual custom_iter_n_children : 'row option -> int method virtual custom_iter_next : 'row -> 'row option method virtual custom_iter_nth_child : 'row option -> int -> 'row option method virtual custom_iter_parent : 'row -> 'row option method virtual custom_decode_iter : 'a -> 'b -> 'c -> 'row method virtual custom_encode_iter : 'row -> 'a * 'b * 'c (** For internal use only. Do not override these methods. *) method custom_n_columns : int method custom_get_column_type : int -> Gobject.g_type method custom_get_value : 'row -> int -> Gobject.g_value -> unit end (** A base class to inherit from to make a custom tree model. *) class virtual ['row,'a,'b,'c] custom_tree_model : column_list -> [Gtk.tree_model_custom,'row,'a,'b,'c] custom_tree_model_type lablgtk-2.18.8/src/gDraw.ml0000644000175000017500000002107713460263323014460 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gdk type color = [ | `COLOR of Gdk.color | `WHITE | `BLACK | `NAME of string | `RGB of int * int * int ] let default_colormap = GtkBase.Widget.get_default_colormap let color ?(colormap = default_colormap ()) (c : color) = match c with | `COLOR col -> col | #Gdk.Color.spec as def -> Color.alloc ~colormap def let conv_color : color data_conv = { kind = `POINTER; proj = (function `POINTER (Some c) -> `COLOR (Obj.magic c) | _ -> failwith "GDraw.get_color"); inj = (fun c -> `POINTER (Some (Obj.magic (color c : Gdk.color)))) } type optcolor = [ | `COLOR of Gdk.color | `WHITE | `BLACK | `NAME of string | `RGB of int * int * int | `DEFAULT ] let optcolor ?colormap (c : optcolor) = match c with | `DEFAULT -> None | #color as c -> Some (color ?colormap c) let conv_optcolor : optcolor data_conv = { kind = `POINTER; proj = (function `POINTER (Some c) -> `COLOR (Obj.magic c) | `POINTER None -> `DEFAULT | _ -> failwith "GDraw.get_color"); inj = (fun c -> `POINTER (Obj.magic (optcolor c : Gdk.color option))) } class drawable ?(colormap = default_colormap ()) w = object (self) val colormap = colormap val mutable gc = GC.create w val w = w method colormap = colormap method gc = gc method set_gc x = gc <- x method color = color ~colormap method set_foreground col = GC.set_foreground gc (self#color col) method set_background col = GC.set_background gc (self#color col) method size = Drawable.get_size w method depth = Drawable.get_depth w method gc_values = GC.get_values gc method set_clip_region = GC.set_clip_region gc method set_clip_origin = GC.set_clip_origin gc method set_clip_mask = GC.set_clip_mask gc method set_clip_rectangle = GC.set_clip_rectangle gc method set_line_attributes ?width ?style ?cap ?join () = let v = GC.get_values gc in GC.set_line_attributes gc ~width:(default v.GC.line_width ~opt:width) ~style:(default v.GC.line_style ~opt:style) ~cap:(default v.GC.cap_style ~opt:cap) ~join:(default v.GC.join_style ~opt:join) method point = Draw.point w gc method line = Draw.line w gc method rectangle = Draw.rectangle w gc method arc = Draw.arc w gc method polygon = Draw.polygon w gc method string s = Draw.string w gc s method put_layout ~x ~y ?fore ?back lay = Draw.layout w gc ~x ~y lay ?fore:(may_map self#color fore) ?back:(may_map self#color back) method put_image ~x ~y = Draw.image w gc ~xdest:x ~ydest:y method get_image = Image.get w method put_pixmap ~x ~y = Draw.pixmap w gc ~xdest:x ~ydest:y method put_rgb_data = Rgb.draw_image w gc method put_pixbuf ~x ~y = GdkPixbuf.draw_pixbuf w gc ~dest_x:x ~dest_y:y method get_pixbuf ?dest_x ?dest_y ?width ?height ?src_x ?src_y dest = GdkPixbuf.get_from_drawable ~dest ?dest_x ?dest_y ?width ?height ?src_x ?src_y ~colormap w method points = Draw.points w gc method lines = Draw.lines w gc method segments = Draw.segments w gc end class pixmap ?colormap ?mask pm = object inherit drawable ?colormap pm as pixmap val bitmap = may_map mask ~f: begin fun x -> let mask = new drawable x in mask#set_foreground `WHITE; mask end val mask : Gdk.bitmap option = mask method pixmap : Gdk.pixmap = w method mask = mask method set_line_attributes ?width ?style ?cap ?join () = pixmap#set_line_attributes ?width ?style ?cap ?join (); may bitmap ~f:(fun m -> m#set_line_attributes ?width ?style ?cap ?join ()) method point ~x ~y = pixmap#point ~x ~y; may bitmap ~f:(fun m -> m#point ~x ~y) method line ~x ~y ~x:x' ~y:y' = pixmap#line ~x ~y ~x:x' ~y:y'; may bitmap ~f:(fun m -> m#line ~x ~y ~x:x' ~y:y') method rectangle ~x ~y ~width ~height ?filled () = pixmap#rectangle ~x ~y ~width ~height ?filled (); may bitmap ~f:(fun m -> m#rectangle ~x ~y ~width ~height ?filled ()) method arc ~x ~y ~width ~height ?filled ?start ?angle () = pixmap#arc ~x ~y ~width ~height ?filled ?start ?angle (); may bitmap ~f:(fun m -> m#arc ~x ~y ~width ~height ?filled ?start ?angle ()); method polygon ?filled l = pixmap#polygon ?filled l; may bitmap ~f:(fun m -> m#polygon ?filled l) method string s ~font ~x ~y = pixmap#string s ~font ~x ~y; may bitmap ~f:(fun m -> m#string s ~font ~x ~y) method points pts = pixmap#points pts; may bitmap ~f:(fun m -> m#points pts) method lines pts = pixmap#lines pts; may bitmap ~f:(fun m -> m#lines pts) method segments lns = pixmap#segments lns; may bitmap ~f:(fun m -> m#segments lns) method put_layout ~x ~y ?fore ?back lay = pixmap#put_layout ~x ~y ?fore ?back lay; may bitmap ~f:(fun (m : #drawable) -> m#put_layout ~x ~y lay) end class type misc_ops = object method colormap : colormap method realize : unit -> unit method visual_depth : int method window : window end let pixmap ~width ~height ?(mask=false) ?(window : < misc : #misc_ops; .. > option) ?colormap () = let window, depth, colormap = match window with Some w -> begin try w#misc#realize (); Some w#misc#window, w#misc#visual_depth, match colormap with Some c -> c | None -> w#misc#colormap with Gpointer.Null -> failwith "GDraw.pixmap : window" end | None -> let colormap = match colormap with Some c -> c | None -> default_colormap () in None, (Gdk.Visual.depth (Gdk.Color.get_visual colormap)), colormap in let mask = if not mask then None else let bm = Bitmap.create ?window ~width ~height () in let mask = new drawable bm in mask#set_foreground `BLACK; mask#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); Some bm in new pixmap (Pixmap.create ?window ~width ~height ~depth ()) ~colormap ?mask let pixmap_from_xpm ~file ?window ?colormap ?transparent () = let window = try may_map window ~f:(fun w -> w#misc#realize (); w#misc#window) with Gpointer.Null -> invalid_arg "GDraw.pixmap_from_xpm : window" in let colormap = if colormap <> None || window <> None then colormap else Some (default_colormap ()) in let pm, mask = try Pixmap.create_from_xpm ~file ?window ?colormap ?transparent:(may_map transparent ~f:(fun c -> color c)) () with _ -> invalid_arg ("GDraw.pixmap_from_xpm : " ^ file) in new pixmap pm ?colormap ~mask let pixmap_from_xpm_d ~data ?window ?colormap ?transparent () = let window = try may_map window ~f:(fun w -> w#misc#realize (); w#misc#window) with Gpointer.Null -> failwith "GDraw.pixmap_from_xpm_d : no window" in let pm, mask = Pixmap.create_from_xpm_d ~data ?colormap ?window ?transparent:(may_map transparent ~f:(fun c -> color c)) () in new pixmap pm ?colormap ~mask class drag_context context = object val context = context method status ?(time=Int32.zero) act = DnD.drag_status context act ~time method suggested_action = DnD.drag_context_suggested_action context method targets = List.map Gdk.Atom.name (DnD.drag_context_targets context) end lablgtk-2.18.8/src/ml_gdk.c0000644000175000017500000007715713460263323014475 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #if defined(_WIN32) || defined(__MINGW32__) #include #else #if defined(HAS_GTKQUARTZ) #else #include #endif #endif #include #include #include #include #include #include "wrappers.h" #include "ml_gpointer.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_pango.h" #include "ml_gdk.h" #include "ml_gdkpixbuf.h" #include "gdk_tags.h" #ifndef HASGTK22 #define GDK_WINDOW_TYPE_HINT_SPLASHSCREEN GDK_WINDOW_TYPE_HINT_NORMAL #define GDK_WINDOW_TYPE_HINT_DESKTOP GDK_WINDOW_TYPE_HINT_NORMAL #define GDK_WINDOW_TYPE_HINT_UTILITY GDK_WINDOW_TYPE_HINT_NORMAL #define GDK_WINDOW_TYPE_HINT_DOCK GDK_WINDOW_TYPE_HINT_NORMAL #endif CAMLprim void ml_raise_gdk (const char *errmsg) { static value * exn = NULL; if (exn == NULL) exn = caml_named_value ("gdkerror"); raise_with_string (*exn, (char*)errmsg); } CAMLprim value ml_gdk_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gdk_color_get_type(); return Val_GType(t); } #include "gdk_tags.c" Make_OptFlags_val (GdkModifier_val) Make_Flags_val (GdkModifier_val) Make_Flags_val (Event_mask_val) #include #define Make_test(conv) \ CAMLprim value ml_test_##conv (value mask, value test) \ { return Val_bool (conv(mask) & Int_val(test)); } Make_test(GdkModifier_val) Make_test(GdkWindowState_val) /* Platform */ value ml_gdk_get_platform() { #ifdef GDK_WINDOWING_WIN32 return MLTAG_WIN32; #elif defined(GDK_WINDOWING_QUARTZ) return MLTAG_QUARTZ; #else return MLTAG_X11; #endif } /* Colormap */ ML_0 (gdk_colormap_get_system, Val_GdkColormap) /* Screen geometry */ ML_0 (gdk_screen_width, Val_int) ML_0 (gdk_screen_height, Val_int) ML_0 (gdk_pango_context_get, Val_PangoContext_new) #ifdef GDK_SCREEN ML_1 (gdk_screen_get_width, GdkScreen_val, Val_int) ML_1 (gdk_screen_get_height, GdkScreen_val, Val_int) ML_0 (gdk_screen_get_default, Val_GdkScreen) ML_1 (gdk_pango_context_get_for_screen, GdkScreen_val, Val_PangoContext_new) #else Unsupported (gdk_screen_get_width) Unsupported (gdk_screen_get_height) Unsupported (gdk_screen_get_default) Unsupported (gdk_pango_context_get_for_screen) #endif /* Visual */ CAMLprim value ml_gdk_visual_get_best (value depth, value type) { GdkVisual *vis; if (type == Val_unit) if (depth == Val_unit) vis = gdk_visual_get_best (); else vis = gdk_visual_get_best_with_depth (Int_val(Field(depth,0))); else if (depth == Val_unit) vis = gdk_visual_get_best_with_type (GdkVisualType_val(Field(type,0))); else vis = gdk_visual_get_best_with_both (Int_val(Field(depth,0)),GdkVisualType_val(Field(type,0))); if (!vis) ml_raise_gdk("Gdk.Visual.get_best"); return Val_GdkVisual(vis); } Make_Extractor (GdkVisual,GdkVisual_val,type,Val_gdkVisualType) Make_Extractor (GdkVisual,GdkVisual_val,depth,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,red_mask,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,red_shift,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,red_prec,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,green_mask,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,green_shift,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,green_prec,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,blue_mask,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,blue_shift,Val_int) Make_Extractor (GdkVisual,GdkVisual_val,blue_prec,Val_int) /* Image */ #ifndef UnsafeImage CAMLexport GdkImage *GdkImage_val(value val) { if (!Field(val,1)) ml_raise_gdk ("attempt to use destroyed GdkImage"); return check_cast(GDK_IMAGE,val); } #endif /* Broken in 2.0 ML_4 (gdk_image_new_bitmap, GdkVisual_val, String_val, Int_val, Int_val, Val_GdkImage) */ ML_4 (gdk_image_new, GdkImageType_val, GdkVisual_val, Int_val, Int_val, Val_GdkImage_new) ML_5 (gdk_drawable_get_image, GdkDrawable_val, Int_val, Int_val, Int_val, Int_val, Val_GdkImage_new) ML_4 (gdk_image_put_pixel, GdkImage_val, Int_val, Int_val, Int_val, Unit) ML_3 (gdk_image_get_pixel, GdkImage_val, Int_val, Int_val, Val_int) Make_Extractor(gdk_image, GdkImage_val, visual, Val_GdkVisual) Make_Extractor(gdk_image, GdkImage_val, width, Val_int) Make_Extractor(gdk_image, GdkImage_val, height, Val_int) Make_Extractor(gdk_image, GdkImage_val, depth, Val_int) /* Make_Extractor(gdk_image, GdkImage_val, bpp, Val_int) Make_Extractor(gdk_image, GdkImage_val, bpl, Val_int) Make_Extractor(gdk_image, GdkImage_val, mem, Val_pointer) */ /* Color */ ML_2 (gdk_colormap_new, GdkVisual_val, Bool_val, Val_GdkColormap) ML_1 (gdk_colormap_get_visual, GdkColormap_val, Val_GdkVisual) CAMLprim value ml_gdk_color_white (value cmap) { GdkColor color; gdk_color_white (GdkColormap_val(cmap), &color); return Val_copy(color); } CAMLprim value ml_gdk_color_black (value cmap) { GdkColor color; gdk_color_black (GdkColormap_val(cmap), &color); return Val_copy(color); } CAMLprim value ml_gdk_color_parse (char *spec) { GdkColor color; if (!gdk_color_parse (spec, &color)) ml_raise_gdk ("color_parse"); return Val_copy(color); } ML_2 (gdk_color_alloc, GdkColormap_val, GdkColor_val, Val_bool) CAMLprim value ml_GdkColor (value red, value green, value blue) { GdkColor color; color.red = Int_val(red); color.green = Int_val(green); color.blue = Int_val(blue); color.pixel = 0; return Val_copy(color); } Make_Extractor (GdkColor, GdkColor_val, red, Val_int) Make_Extractor (GdkColor, GdkColor_val, green, Val_int) Make_Extractor (GdkColor, GdkColor_val, blue, Val_int) Make_Extractor (GdkColor, GdkColor_val, pixel, Val_int) /* Rectangle */ CAMLprim value ml_GdkRectangle (value x, value y, value width, value height) { GdkRectangle rectangle; rectangle.x = Int_val(x); rectangle.y = Int_val(y); rectangle.width = Int_val(width); rectangle.height = Int_val(height); return Val_copy(rectangle); } Make_Extractor (GdkRectangle, GdkRectangle_val, x, Val_int) Make_Extractor (GdkRectangle, GdkRectangle_val, y, Val_int) Make_Extractor (GdkRectangle, GdkRectangle_val, width, Val_int) Make_Extractor (GdkRectangle, GdkRectangle_val, height, Val_int) /* Drawable */ ML_1 (gdk_drawable_get_visual, GdkDrawable_val, Val_GdkVisual) ML_1 (gdk_drawable_get_colormap, GdkDrawable_val, Val_GdkColormap) ML_1 (gdk_drawable_get_depth, GdkDrawable_val, Val_int) CAMLprim value ml_gdk_drawable_get_size (value drawable) { int x, y; value ret; gdk_drawable_get_size (GdkDrawable_val(drawable), &x, &y); ret = alloc_small (2,0); Field(ret,0) = Val_int(x); Field(ret,1) = Val_int(y); return ret; } /* Window */ ML_3 (gdk_window_set_back_pixmap, GdkWindow_val, GdkPixmap_val, Int_val, Unit) ML_2 (gdk_window_set_cursor, GdkWindow_val, GdkCursor_val, Unit) ML_1 (gdk_window_clear, GdkWindow_val, Unit) ML_5 (gdk_window_clear_area, GdkWindow_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_0 (GDK_ROOT_PARENT, Val_GdkWindow) ML_1 (gdk_window_get_parent, GdkWindow_val, Val_GdkWindow) ML_2 (gdk_window_set_transient_for, GdkWindow_val, GdkWindow_val, Unit) ML_1 (gdk_window_foreign_new, GdkNativeWindow_val, Val_GdkWindow) #if defined(_WIN32) || defined(__CYGWIN__) || defined(HAS_GTKQUARTZ) CAMLprim value ml_GDK_WINDOW_XWINDOW(value v) { ml_raise_gdk ("ml_GDK_WINDOW_XWINDOW: only for X11"); return Val_unit; } #else ML_1 (GDK_WINDOW_XWINDOW, GdkDrawable_val, Val_XID) #endif CAMLprim value ml_gdk_window_get_position (value window) { int x, y; value ret; gdk_window_get_position (GdkWindow_val(window), &x, &y); ret = alloc_small (2,0); Field(ret,0) = Val_int(x); Field(ret,1) = Val_int(y); return ret; } CAMLprim value ml_gdk_window_get_pointer_location (value window) { int x = 0; int y = 0; value ret; gdk_window_get_pointer (GdkWindow_val(window), &x, &y, NULL); ret = alloc_small (2, 0); Field(ret, 0) = Val_int(x); Field(ret, 1) = Val_int(y); return ret; } /* Cursor */ Make_Val_final_pointer_ext (GdkCursor, _new, Ignore, gdk_cursor_unref, 20) ML_1 (gdk_cursor_new, GdkCursorType_val, Val_GdkCursor_new) ML_6 (gdk_cursor_new_from_pixmap, GdkPixmap_val, GdkPixmap_val, GdkColor_val, GdkColor_val, Int_val, Int_val, Val_GdkCursor_new) ML_bc6 (ml_gdk_cursor_new_from_pixmap) #ifdef HASGTK24 ML_3 (gdk_cursor_new_from_pixbuf, Insert(gdk_display_get_default ()) GdkPixbuf_val, Int_val, Int_val, Val_GdkCursor_new) #else Unsupported_24(gdk_cursor_new_from_pixbuf) #endif #ifdef HASGTK28 ML_1 (gdk_cursor_get_image, GdkCursor_val, Val_GdkPixbuf_new) #else Unsupported_28(gdk_cursor_get_image) #endif /* Display */ #ifdef HASGTK22 ML_0 (gdk_display_get_default, Val_GdkDisplay) CAMLprim value ml_gdk_display_get_window_at_pointer (value display) { gint x; gint y; GdkWindow *gwin; if ((gwin = gdk_display_get_window_at_pointer (GdkDisplay_val (display), &x, &y))) { /* return Some */ CAMLparam0 (); CAMLlocal1(tup); tup = alloc_tuple(3); Store_field(tup,0,Val_GdkWindow(gwin)); Store_field(tup,1,Val_int(x)); Store_field(tup,2,Val_int(y)); CAMLreturn(ml_some (tup)); } return Val_unit; } #else Unsupported_22(gdk_display_get_default) Unsupported_22(gdk_display_get_window_at_pointer) #endif /* Pixmap */ CAMLexport GdkPixmap *GdkPixmap_val(value val) { if (!Field(val,1)) ml_raise_gdk ("attempt to use destroyed GdkPixmap"); return check_cast(GDK_PIXMAP,val); } ML_4 (gdk_pixmap_new, GdkWindow_val, Int_val, Int_val, Int_val, Val_GdkPixmap_no_ref) ML_4 (gdk_bitmap_create_from_data, GdkWindow_val, String_val, Int_val, Int_val, Val_GdkBitmap_no_ref) ML_7 (gdk_pixmap_create_from_data, GdkWindow_val, String_val, Int_val, Int_val, Int_val, GdkColor_val, GdkColor_val, Val_GdkPixmap_no_ref) ML_bc7 (ml_gdk_pixmap_create_from_data) CAMLprim value ml_gdk_pixmap_colormap_create_from_xpm (value window, value colormap, value transparent, char *filename) { CAMLparam0(); GdkPixmap *pixmap; GdkBitmap *mask = NULL; CAMLlocal2(vpixmap, vmask); value ret; pixmap = gdk_pixmap_colormap_create_from_xpm (Option_val(window,GdkWindow_val,NULL), Option_val(colormap,GdkColormap_val,NULL), &mask, Option_val(transparent,GdkColor_val,NULL), filename); if (!pixmap) ml_raise_gdk ("Gdk.Pixmap.create_from_xpm_file"); vpixmap = Val_GdkPixmap_no_ref(pixmap); vmask = Val_GdkBitmap_no_ref (mask); ret = alloc_small (2,0); Field(ret,0) = vpixmap; Field(ret,1) = vmask; CAMLreturn(ret); } CAMLprim value ml_gdk_pixmap_colormap_create_from_xpm_d (value window, value colormap, value transparent, char **data) { CAMLparam0(); GdkPixmap *pixmap; GdkBitmap *mask = NULL; CAMLlocal2(vpixmap, vmask); value ret; pixmap = gdk_pixmap_colormap_create_from_xpm_d (Option_val(window,GdkWindow_val,NULL), Option_val(colormap,GdkColormap_val,NULL), &mask, Option_val(transparent,GdkColor_val,NULL), data); if (!pixmap) ml_raise_gdk ("Gdk.Pixmap.create_from_xpm_data"); vpixmap = Val_GdkPixmap_no_ref (pixmap); vmask = Val_GdkBitmap_no_ref (mask); ret = alloc_small (2, 0); Field(ret,0) = vpixmap; Field(ret,1) = vmask; CAMLreturn(ret); } /* Font */ Make_Val_final_pointer (GdkFont, gdk_font_ref, gdk_font_unref, 0) Make_Val_final_pointer_ext (GdkFont, _no_ref, Ignore, gdk_font_unref, 20) ML_1 (gdk_font_load, String_val, Val_GdkFont_no_ref) ML_1 (gdk_fontset_load, String_val, Val_GdkFont_no_ref) ML_2 (gdk_string_width, GdkFont_val, String_val, Val_int) ML_2 (gdk_char_width, GdkFont_val, (gchar)Long_val, Val_int) ML_2 (gdk_string_height, GdkFont_val, String_val, Val_int) ML_2 (gdk_char_height, GdkFont_val, (gchar)Long_val, Val_int) ML_2 (gdk_string_measure, GdkFont_val, String_val, Val_int) ML_2 (gdk_char_measure, GdkFont_val, (char)Long_val, Val_int) Make_Extractor (GdkFont, GdkFont_val, type, Val_font_type) Make_Extractor (GdkFont, GdkFont_val, ascent, Val_int) Make_Extractor (GdkFont, GdkFont_val, descent, Val_int) /* Properties */ ML_2 (gdk_atom_intern, String_val, Int_val, Val_GdkAtom) ML_1 (gdk_atom_name, GdkAtom_val, Val_string) CAMLprim value ml_gdk_property_change (value window, value property, value type, value mode, value xdata) { int format = Xdata_val (Field(xdata,0)); value data = Field(xdata,1); int nelems = (format == 8 ? string_length (data) : Wosize_val(data)); guchar *sdata; int i; switch (format) { case 16: sdata = calloc(nelems, sizeof(short)); for (i=0; i255 ){ stat_free (cdashes); ml_raise_gdk("line dashes must be [0..255]"); } cdashes[i] = d; } gdk_gc_set_dashes( GdkGC_val(gc), Int_val(offset), cdashes, l); /* stat_free (cdashes); ? */ CAMLreturn(Val_unit); } ML_2 (gdk_gc_copy, GdkGC_val, GdkGC_val, Unit) CAMLprim value ml_gdk_gc_get_values (value gc) { CAMLparam0(); GdkGCValues values; CAMLlocal2(ret, tmp); gdk_gc_get_values (GdkGC_val(gc), &values); ret = alloc (18, 0); tmp = Val_copy(values.foreground); Store_field(ret, 0, tmp); tmp = Val_copy(values.background); Store_field(ret, 1, tmp); if (values.font) { tmp = ml_some(Val_GdkFont(values.font)); Store_field(ret, 2, tmp); } else Store_field(ret, 2, Val_int(0)); Field(ret,3) = Val_function_type(values.function); Field(ret,4) = Val_fill(values.fill); if (values.tile) { tmp = ml_some(Val_GdkPixmap(values.tile)); Store_field(ret, 5, tmp); } else Store_field(ret, 5, Val_int(0)); if (values.stipple) { tmp = ml_some(Val_GdkPixmap(values.stipple)); Store_field(ret, 6, tmp); } else Store_field(ret, 6, Val_int(0)); if (values.clip_mask) { tmp = ml_some(Val_GdkPixmap(values.clip_mask)); Store_field(ret, 7, tmp); } else Store_field(ret, 7, Val_int(0)); Field(ret,8) = Val_subwindow_mode(values.subwindow_mode); Field(ret,9) = Val_int(values.ts_x_origin); Field(ret,10) = Val_int(values.ts_y_origin); Field(ret,11) = Val_int(values.clip_x_origin); Field(ret,12) = Val_int(values.clip_y_origin); Field(ret,13) = Val_bool(values.graphics_exposures); Field(ret,14) = Val_int(values.line_width); Field(ret,15) = Val_line_style(values.line_style); Field(ret,16) = Val_cap_style(values.cap_style); Field(ret,17) = Val_join_style(values.join_style); CAMLreturn(ret); } /* Draw */ CAMLprim value ml_point_array_new (value len) { value ret; if(Int_val(len) <= 0) invalid_argument("PointArray.new"); ret = alloc (1 + Wosize_asize(Int_val(len)*sizeof(GdkPoint)), Abstract_tag); Field(ret,0) = len; return ret; } CAMLprim value ml_point_array_set (value arr, value pos, value x, value y) { GdkPoint *pt = PointArray_val(arr) + Int_val(pos); pt->x = Int_val(x); pt->y = Int_val(y); return Val_unit; } #define SegmentArray_val(val) ((GdkSegment*)&Field(val,1)) #define SegmentArrayLen_val(val) Int_val(Field(val,0)) CAMLprim value ml_segment_array_new (value len) { value ret; if(Int_val(len) <= 0) invalid_argument("SegmentArray.new"); ret = alloc (1 + Wosize_asize(Int_val(len)*sizeof(GdkSegment)), Abstract_tag); Field(ret,0) = len; return ret; } CAMLprim value ml_segment_array_set (value arr, value pos, value x1, value y1, value x2, value y2) { GdkSegment *pt = SegmentArray_val(arr) + Int_val(pos); pt->x1 = Int_val(x1); pt->y1 = Int_val(y1); pt->x2 = Int_val(x2); pt->y2 = Int_val(y2); return Val_unit; } ML_bc6 (ml_segment_array_set) ML_4 (gdk_draw_point, GdkDrawable_val, GdkGC_val, Int_val, Int_val, Unit) ML_6 (gdk_draw_line, GdkDrawable_val, GdkGC_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc6 (ml_gdk_draw_line) ML_7 (gdk_draw_rectangle, GdkDrawable_val, GdkGC_val, Bool_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc7 (ml_gdk_draw_rectangle) ML_9 (gdk_draw_arc, GdkDrawable_val, GdkGC_val, Bool_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9 (ml_gdk_draw_arc) ML_4 (gdk_draw_polygon, GdkDrawable_val, GdkGC_val, Bool_val, Insert(PointArray_val(arg4)) PointArrayLen_val, Unit) ML_6 (gdk_draw_string, GdkDrawable_val, GdkFont_val, GdkGC_val, Int_val, Int_val, String_val, Unit) ML_bc6 (ml_gdk_draw_string) ML_7 (gdk_draw_layout_with_colors, GdkDrawable_val, GdkGC_val, Int_val, Int_val, PangoLayout_val, Option_val(arg6,GdkColor_val,NULL) Ignore, Option_val(arg7,GdkColor_val,NULL) Ignore, Unit) ML_bc7 (ml_gdk_draw_layout_with_colors) /* ML_9 (gdk_draw_bitmap, GdkDrawable_val, GdkGC_val, GdkBitmap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9 (ml_gdk_draw_bitmap) */ ML_9 (gdk_draw_pixmap, GdkDrawable_val, GdkGC_val, GdkPixmap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9 (ml_gdk_draw_pixmap) ML_9 (gdk_draw_image, GdkDrawable_val, GdkGC_val, GdkImage_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9 (ml_gdk_draw_image) ML_3 (gdk_draw_points, GdkDrawable_val, GdkGC_val, Insert(PointArray_val(arg3)) PointArrayLen_val, Unit) ML_3 (gdk_draw_segments, GdkDrawable_val, GdkGC_val, Insert(SegmentArray_val(arg3)) SegmentArrayLen_val, Unit) ML_3 (gdk_draw_lines, GdkDrawable_val, GdkGC_val, Insert(PointArray_val(arg3)) PointArrayLen_val, Unit) /* RGB */ ML_0 (gdk_rgb_init, Unit) ML_0 (gdk_rgb_get_visual, Val_GdkVisual) ML_0 (gdk_rgb_get_cmap, Val_GdkColormap) ML_9 (gdk_draw_rgb_image, GdkDrawable_val, GdkGC_val, Int_val, Int_val, Int_val, Int_val, GdkRgbDither_val, ml_gpointer_base, Int_val, Unit) ML_bc9 (ml_gdk_draw_rgb_image) /* Events */ /* Have a major collection every 1000 events */ Make_Val_final_pointer (GdkEvent, Ignore, gdk_event_free, 1) ML_1 (gdk_event_copy, GdkEvent_val, Val_GdkEvent) #ifdef HASGTK22 CAMLprim value ml_gdk_event_new (value event_type) { GdkEvent *event = gdk_event_new(Event_type_val(event_type)); event->any.send_event = TRUE; return Val_GdkEvent(event); } #else CAMLprim value ml_gdk_event_new (value event_type) { GdkEvent event; memset (&event, 0, sizeof(GdkEvent)); event.type = Event_type_val(event_type); event.any.send_event = TRUE; return Val_copy(event); } #endif ML_1 (gdk_event_get_time, GdkEvent_val, copy_int32) #define GdkEvent_arg(type) (GdkEvent##type*)GdkEvent_val Make_Extractor (GdkEventAny, GdkEvent_arg(Any), type, Val_event_type) Make_Extractor (GdkEventAny, GdkEvent_arg(Any), window, Val_GdkWindow) Make_Extractor (GdkEventAny, GdkEvent_arg(Any), send_event, Val_bool) Make_Setter (gdk_event_set, GdkEvent_arg(Any), Event_type_val, type) Make_Setter (gdk_event_set, GdkEvent_arg(Any), GdkWindow_val, window) Make_Extractor (GdkEventExpose, GdkEvent_arg(Expose), area, Val_copy) Make_Extractor (GdkEventExpose, GdkEvent_arg(Expose), region, Val_GdkRegion_copy) Make_Extractor (GdkEventExpose, GdkEvent_arg(Expose), count, Val_int) Make_Extractor (GdkEventVisibility, GdkEvent_arg(Visibility), state, Val_gdkVisibilityState) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), x, copy_double) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), y, copy_double) static value copy_axes(double *axes) { CAMLparam0(); CAMLlocal2(x,y); value ret; if (axes) { x = copy_double(axes[0]); y = copy_double(axes[0]); ret = alloc_small(2, 0); Field(ret,0) = x; Field(ret,1) = y; ret = ml_some(ret); } else ret = Val_unit; CAMLreturn(ret); } Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), axes, copy_axes) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), state, Val_int) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), is_hint, Val_int) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), device, Val_GdkDevice) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), x_root, copy_double) Make_Extractor (GdkEventMotion, GdkEvent_arg(Motion), y_root, copy_double) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), x, copy_double) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), y, copy_double) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), axes, copy_axes) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), state, Val_int) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), button, Val_int) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), device, Val_GdkDevice) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), x_root, copy_double) Make_Extractor (GdkEventButton, GdkEvent_arg(Button), y_root, copy_double) Make_Setter (gdk_event_button_set, GdkEvent_arg(Button), Int_val, button) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), x, copy_double) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), y, copy_double) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), state, Val_int) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), direction, Val_gdkScrollDirection) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), device, Val_GdkDevice) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), x_root, copy_double) Make_Extractor (GdkEventScroll, GdkEvent_arg(Scroll), y_root, copy_double) Make_Extractor (GdkEventKey, GdkEvent_arg(Key), state, Val_int) Make_Extractor (GdkEventKey, GdkEvent_arg(Key), keyval, Val_int) Make_Extractor (GdkEventKey, GdkEvent_arg(Key), string, Val_string) Make_Extractor (GdkEventKey, GdkEvent_arg(Key), hardware_keycode, Val_int) Make_Extractor (GdkEventKey, GdkEvent_arg(Key), group, Val_int) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), subwindow, Val_GdkWindow) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), x, copy_double) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), y, copy_double) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), x_root, copy_double) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), y_root, copy_double) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), mode, Val_gdkCrossingMode) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), detail, Val_gdkNotifyType) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), focus, Val_bool) Make_Extractor (GdkEventCrossing, GdkEvent_arg(Crossing), state, Val_int) Make_Extractor (GdkEventFocus, GdkEvent_arg(Focus), in, Val_int) Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), x, Val_int) Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), y, Val_int) Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), width, Val_int) Make_Extractor (GdkEventConfigure, GdkEvent_arg(Configure), height, Val_int) Make_Extractor (GdkEventProperty, GdkEvent_arg(Property), atom, Val_GdkAtom) Make_Extractor (GdkEventProperty, GdkEvent_arg(Property), state, Val_int) Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), selection, Val_GdkAtom) Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), target, Val_GdkAtom) Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), property, Val_GdkAtom) Make_Extractor (GdkEventSelection, GdkEvent_arg(Selection), requestor, Val_GdkNativeWindow) Make_Extractor (GdkEventProximity, GdkEvent_arg(Proximity), device, Val_GdkDevice) Make_Extractor (GdkEventClient, GdkEvent_arg(Client), window, Val_GdkWindow) Make_Extractor(GdkEventClient, GdkEvent_arg(Client), message_type, Val_GdkAtom) CAMLprim value ml_GdkEventClient_data (GdkEventClient *ev) { int nitems = 0; switch (ev->data_format) { case 8: nitems = 20; break; case 16: nitems = 10; break; case 32: nitems = 5; break; } return copy_xdata (ev->data_format, ev->data.b, nitems); } Make_Extractor (GdkEventSetting, GdkEvent_arg(Setting), action, Val_gdkSettingAction) Make_Extractor (GdkEventSetting, GdkEvent_arg(Setting), name, copy_string) Make_Extractor (GdkEventWindowState, GdkEvent_arg(WindowState), changed_mask, Val_int) Make_Extractor (GdkEventWindowState, GdkEvent_arg(WindowState), new_window_state, Val_int) /* DnD */ Make_Flags_val (GdkDragAction_val) #define GdkDragAction_optval(v) Option_val(v,GdkDragAction_val,0) ML_3 (gdk_drag_status, GdkDragContext_val, GdkDragAction_optval, Int32_val, Unit) Make_Extractor (GdkDragContext, GdkDragContext_val, suggested_action, Val_gdkDragAction) static value val_int(gpointer i) { return Val_int (GPOINTER_TO_INT(i)); } CAMLprim value ml_GdkDragContext_targets (value c) { GList *t; t = (GdkDragContext_val(c))->targets; return Val_GList (t, val_int); } /* Misc */ ML_0 (gdk_flush, Unit) ML_0 (gdk_beep, Unit) lablgtk-2.18.8/src/gMain.mli0000644000175000017500000000754313460263323014622 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** Library initialization, main event loop, and events *) open Gtk (** @gtkdoc gtk gtk-General *) module Main : sig val init : ?setlocale:bool -> unit -> string (** [init] also sets the locale and returns its name. Either set [~setlocale] to [false] or GTK_SETLOCALE to "0" if you don't want to the locale to be set *) val main : unit -> unit (** [main] runs the main loop, until [quit] is called. {e Do not use in multi-threaded programs.} *) val quit : unit -> unit (** quit the main loop *) val version : int * int * int (** [major, minor, micro] *) end (** Direct access to functions of [GMain.Main] *) val init : ?setlocale:bool -> unit -> string val main : unit -> unit val quit : unit -> unit (** Global structures *) val selection : GData.clipboard val clipboard : GData.clipboard module Grab : sig val add : #GObj.widget -> unit val remove : #GObj.widget -> unit val get_current : unit -> GObj.widget end module Event : sig val get_current_time : unit -> int32 (** May return GDK_CURRENT_TIME *) val get_current : unit -> GdkEvent.any (** May raise Gpointer.Null *) val get_widget : 'a Gdk.event -> widget obj (** May raise Gpointer.Null *) val propagate : [> `widget] obj -> 'a Gdk.event -> unit end module Rc : sig val add_default_file : string -> unit end module Timeout : sig type id = Glib.Timeout.id val add : ms:int -> callback:(unit -> bool) -> id val remove : id -> unit end module Idle : sig type id = Glib.Idle.id val add : ?prio:int -> (unit -> bool) -> id val remove : id -> unit end module Io : sig type channel = Glib.Io.channel type condition = [ `IN | `OUT | `PRI | `ERR | `HUP | `NVAL ] type id val channel_of_descr : Unix.file_descr -> channel val add_watch : cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id val remove : id -> unit val read : channel -> buf:bytes -> pos:int -> len:int -> int val read_chars : channel -> buf:bytes -> pos:int -> len:int -> int end module Gc_custom : sig val set_speed : int -> unit (** make the allocation of custom blocks contribute more or less to the GC cycle. 0 means do nothing, 100 is as in lablgtk 2.18.3. The default is 10. *) val get_speed : unit -> int end lablgtk-2.18.8/src/gSourceView2.ml0000644000175000017500000005365313460263323015745 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open Gaux open GtkSourceView2 open SourceView2Enums open Gobject open Gtk open GtkBase open GtkSourceView2_types open OgtkSourceView2Props open GObj let get_bool = function `BOOL x -> x | _ -> assert false let bool x = `BOOL x let get_uint = function `INT x -> x | _ -> assert false let uint x = `INT x let get_int = function `INT x -> x | _ -> assert false let int x = `INT x let get_gobject = function `OBJECT x -> x | _ -> assert false let gobject x = `OBJECT (Some x) let map_opt f = function None -> None | Some x -> Some (f x) (** {2 GtkSourceTag} *) type source_tag_property = [ | `BACKGROUND of Gdk.color | `BOLD of bool | `FOREGROUND of Gdk.color | `ITALIC of bool | `STRIKETHROUGH of bool | `UNDERLINE of bool ] let text_tag_property_of_source_tag_property = function | `BACKGROUND p -> `BACKGROUND_GDK p | `BOLD p -> `WEIGHT (if p then `BOLD else `NORMAL) | `FOREGROUND p -> `FOREGROUND_GDK p | `ITALIC p -> `STYLE (if p then `ITALIC else `NORMAL) | `STRIKETHROUGH p -> `STRIKETHROUGH p | `UNDERLINE p -> `UNDERLINE (if p then `SINGLE else `NONE) let color_of_string s = Gdk.Color.alloc ~colormap: (Gdk.Color.get_system_colormap()) (`NAME s) (** {2 GtkSourceStyleScheme} *) class source_style_scheme (obj: GtkSourceView2_types.source_style_scheme obj) = object(self) method as_source_style_scheme = obj method name = SourceStyleScheme.get_name obj method description = SourceStyleScheme.get_description obj end (** {2 GtkSourceStyleSchemeManager} *) class source_style_scheme_manager (obj: GtkSourceView2_types.source_style_scheme_manager obj) = object(self) val obj = obj inherit source_style_scheme_manager_props method search_path = SourceStyleSchemeManager.get_search_path obj method set_search_path = SourceStyleSchemeManager.set_search_path obj method style_scheme_ids = SourceStyleSchemeManager.get_scheme_ids obj method style_scheme s = may_map (new source_style_scheme) (SourceStyleSchemeManager.get_scheme obj s) end let source_style_scheme_manager ~default = let mgr = if default then SourceStyleSchemeManager.default () else SourceStyleSchemeManager.new_ () in new source_style_scheme_manager mgr (** {2 GtkSourceCompletionInfo} *) class source_completion_info_signals (obj' : GtkSourceView2_types.source_completion_info obj) = object inherit GContainer.container_signals_impl obj' inherit source_completion_info_sigs end class source_completion_info (obj' : ([> GtkSourceView2_types.source_completion_info ] as 'a) obj) = object inherit GWindow.window obj' inherit source_completion_info_props method as_source_completion_info = (obj :> GtkSourceView2_types.source_completion_info obj) method widget = new GObj.widget (SourceCompletionInfo.get_widget obj) method set_widget (w : GObj.widget) = SourceCompletionInfo.set_widget obj w#as_widget end (** {2 GtkSourceCompletionProposal} *) class source_completion_proposal_signals (obj' : GtkSourceView2_types.source_completion_proposal obj) = object inherit ['a] gobject_signals (obj' : [> GtkSourceView2_types.source_completion_proposal ] obj) inherit source_completion_proposal_sigs end class source_completion_proposal (obj : GtkSourceView2_types.source_completion_proposal obj) = object val obj = obj method connect = new source_completion_proposal_signals obj method as_source_completion_proposal = obj inherit source_completion_proposal_props end class source_completion_item (obj : GtkSourceView2_types.source_completion_proposal obj) = object inherit source_completion_proposal obj inherit source_completion_item_props end let source_completion_item ?(label = "") ?(text = "") ?icon ?info () = new source_completion_item (SourceCompletionItem.new_ label text icon info) let source_completion_item_with_markup ?(label = "") ?(text = "") ?icon ?info () = new source_completion_item (SourceCompletionItem.new_with_markup label text icon info) let source_completion_item_from_stock ?(label = "") ?(text = "") ~stock ~info () = let stock = GtkStock.Item.lookup stock in let id = stock.GtkStock.stock_id in new source_completion_item (SourceCompletionItem.new_from_stock label text id info) (** {2 GtkSourceCompletionProvider} *) class source_completion_provider (obj' : GtkSourceView2_types.source_completion_provider obj) = object val obj = obj' method as_source_completion_provider = obj method icon = SourceCompletionProvider.get_icon obj method name = SourceCompletionProvider.get_name obj method populate (context : source_completion_context) = SourceCompletionProvider.populate obj context#as_source_completion_context method activation = SourceCompletionProvider.get_activation obj method matched (context : source_completion_context) = SourceCompletionProvider.match_ obj context#as_source_completion_context method info_widget (proposal : source_completion_proposal) = let widget = SourceCompletionProvider.get_info_widget obj proposal#as_source_completion_proposal in match widget with | None -> None | Some widget -> Some (new GObj.widget widget) method update_info (proposal : source_completion_proposal) (info : source_completion_info) = SourceCompletionProvider.update_info obj proposal#as_source_completion_proposal info#as_source_completion_info method start_iter (context : source_completion_context) (proposal : source_completion_proposal) = let iter = SourceCompletionProvider.get_start_iter obj context#as_source_completion_context proposal#as_source_completion_proposal in new GText.iter iter method activate_proposal (proposal : source_completion_proposal) (iter : GText.iter) = SourceCompletionProvider.activate_proposal obj proposal#as_source_completion_proposal iter#as_iter method interactive_delay = SourceCompletionProvider.get_interactive_delay obj method priority = SourceCompletionProvider.get_priority obj end (** {2 GtkSourceCompletionContext} *) and source_completion_context_signals (obj' : GtkSourceView2_types.source_completion_context obj) = object inherit ['a] gobject_signals (obj' : [> GtkSourceView2_types.source_completion_context ] obj) inherit source_completion_context_sigs end and source_completion_context (obj' : GtkSourceView2_types.source_completion_context obj) = object val obj = obj' val iter_prop = { Gobject.name = "iter"; conv = Gobject.Data.unsafe_pointer } inherit source_completion_context_props method as_source_completion_context = obj method activation = SourceCompletionContext.get_activation obj method add_proposals (provider : source_completion_provider) (proposals : source_completion_proposal list) b = let proposals = List.map (fun obj -> obj#as_source_completion_proposal) proposals in SourceCompletionContext.add_proposals obj provider#as_source_completion_provider proposals b method connect = new source_completion_context_signals obj' method iter = new GText.iter (Gobject.get iter_prop obj) method set_iter (iter : GText.iter) = Gobject.set iter_prop obj (iter#as_iter) end class type custom_completion_provider = object method name : string method icon : GdkPixbuf.pixbuf option method populate : source_completion_context -> unit method matched : source_completion_context -> bool method activation : source_completion_activation_flags list method info_widget : source_completion_proposal -> GObj.widget option method update_info : source_completion_proposal -> source_completion_info -> unit method start_iter : source_completion_context -> source_completion_proposal -> GText.iter -> bool method activate_proposal : source_completion_proposal -> GText.iter -> bool method interactive_delay : int method priority : int end let source_completion_provider (p : custom_completion_provider) : source_completion_provider = let of_context ctx = new source_completion_context ctx in let of_proposal prop = new source_completion_proposal prop in let of_info info = new source_completion_info info in let of_iter iter = new GText.iter iter in let as_opt_widget = function | None -> None | Some obj -> Some obj#as_widget in let completion_provider = { SourceCompletionProvider.provider_name = (fun () -> p#name); provider_icon = (fun () -> p#icon); provider_populate = (fun ctx -> p#populate (of_context ctx)); provider_match = (fun ctx -> p#matched (of_context ctx)); provider_activation = (fun () -> p#activation); provider_info_widget = (fun prop -> as_opt_widget (p#info_widget (of_proposal prop))); provider_update_info = (fun prop info -> p#update_info (of_proposal prop) (of_info info)); provider_start_iter = (fun ctx prop iter -> p#start_iter (of_context ctx) (of_proposal prop) (of_iter iter)); provider_activate_proposal = (fun prop iter -> p#activate_proposal (of_proposal prop) (of_iter iter)); provider_interactive_delay = (fun () -> p#interactive_delay); provider_priority = (fun () -> p#priority); } in let obj = SourceCompletionProvider.new_ completion_provider in new source_completion_provider obj (** {2 GtkSourceCompletion} *) class source_completion_signals obj' = object (self) inherit ['a] gobject_signals (obj' : [> GtkSourceView2_types.source_completion] obj) inherit source_completion_sigs method populate_context ~callback = let callback obj = callback (new source_completion_context obj) in self#connect SourceCompletion.S.populate_context ~callback end class source_completion (obj : GtkSourceView2_types.source_completion obj) = object val obj = obj inherit source_completion_props as super method as_source_completion = obj method connect = new source_completion_signals obj method create_context (iter : GText.iter) = let obj = SourceCompletion.create_context obj (iter#as_iter) in new source_completion_context obj method move_window (iter : GText.iter) = SourceCompletion.move_window obj (iter#as_iter) method show (prs : source_completion_provider list) (ctx : source_completion_context) = let prs = List.map (fun pr -> pr#as_source_completion_provider) prs in SourceCompletion.show obj prs ctx#as_source_completion_context method providers = let prs = SourceCompletion.get_providers obj in List.map (fun pr -> new source_completion_provider pr) prs method add_provider (pr : source_completion_provider) = SourceCompletion.add_provider obj (pr#as_source_completion_provider) method remove_provider (pr : source_completion_provider) = SourceCompletion.remove_provider obj (pr#as_source_completion_provider) end (** {2 GtkSourceLanguage} *) class source_language (obj: GtkSourceView2_types.source_language obj) = object (self) method as_source_language = obj val obj = obj method misc = new gobject_ops obj method id = SourceLanguage.get_id obj method name = SourceLanguage.get_name obj method section = SourceLanguage.get_section obj method hidden = SourceLanguage.get_hidden obj method metadata s = SourceLanguage.metadata obj s method mime_types = SourceLanguage.mime_types obj method globs = SourceLanguage.globs obj method style_name s = SourceLanguage.style_name obj s method style_ids = SourceLanguage.style_ids obj end (** {2 GtkSourceLanguageManager} *) class source_language_manager (obj: GtkSourceView2_types.source_language_manager obj) = object (self) method get_oid = Gobject.get_oid obj method as_source_language_manager = obj method set_search_path p = SourceLanguageManager.set_search_path obj p method search_path = SourceLanguageManager.search_path obj method language_ids = SourceLanguageManager.language_ids obj method language id = may_map (new source_language) (SourceLanguageManager.language obj id ) method guess_language ?filename ?content_type () = may_map (new source_language) (SourceLanguageManager.guess_language obj filename content_type) end let source_language_manager ~default = new source_language_manager (if default then SourceLanguageManager.default () else SourceLanguageManager.create []) (** {2 GtkSourceMark} *) class source_mark (obj: GtkSourceView2_types.source_mark obj) = object (self) method coerce = (`MARK (GtkText.Mark.cast obj):GText.mark) method as_source_mark = obj val obj = obj inherit source_mark_props method next ?category () = may_map (fun m -> new source_mark m) (SourceMark.next obj category) method prev ?category () = may_map (fun m -> new source_mark m) (SourceMark.prev obj category) end let source_mark ?category () = new source_mark (SourceMark.create ?category []) (** {2 GtkSourceUndoManager} *) class source_undo_manager_signals obj' = object (self) inherit ['a] gobject_signals (obj' : [> GtkSourceView2_types.source_undo_manager] obj) inherit source_undo_manager_sigs end class source_undo_manager (obj : GtkSourceView2_types.source_undo_manager obj) = object val obj = obj inherit source_undo_manager_props method as_source_undo_manager = obj method connect = new source_undo_manager_signals obj end class type custom_undo_manager = object method can_undo : bool method can_redo : bool method undo : unit -> unit method redo : unit -> unit method begin_not_undoable_action : unit -> unit method end_not_undoable_action : unit -> unit method can_undo_changed : unit -> unit method can_redo_changed : unit -> unit end let source_undo_manager (manager : custom_undo_manager) : source_undo_manager = let undo_manager = { SourceUndoManager.can_undo = (fun () -> manager#can_undo); can_redo = (fun () -> manager#can_redo); undo = manager#undo; redo = manager#redo; begin_not_undoable_action = manager#begin_not_undoable_action; end_not_undoable_action = manager#end_not_undoable_action; can_undo_changed = manager#can_undo_changed; can_redo_changed = manager#can_redo_changed; } in let obj = SourceUndoManager.new_ undo_manager in new source_undo_manager obj (** {2 GtkSourceBuffer} *) class source_buffer_signals obj' = object inherit ['a] gobject_signals (obj' : [> GtkSourceView2_types.source_buffer] obj) inherit GText.buffer_signals_skel inherit source_buffer_sigs end and source_buffer (_obj: GtkSourceView2_types.source_buffer obj) = object (self) inherit GText.buffer_skel _obj as text_buffer val obj = _obj method private obj = _obj inherit source_buffer_props method as_source_buffer = obj method connect = new source_buffer_signals obj method misc = new gobject_ops obj method language = may_map (new source_language) (get SourceBuffer.P.language obj) method set_language (l:source_language option) = set SourceBuffer.P.language obj (may_map (fun l -> l#as_source_language) l) method style_scheme = may_map (new source_style_scheme) (get SourceBuffer.P.style_scheme obj) method set_style_scheme (s:source_style_scheme option) = match s with None -> () | Some scheme -> set SourceBuffer.P.style_scheme obj (Some scheme#as_source_style_scheme) method undo () = SourceBuffer.undo obj method redo () = SourceBuffer.redo obj method begin_not_undoable_action () = SourceBuffer.begin_not_undoable_action obj method end_not_undoable_action () = SourceBuffer.end_not_undoable_action obj method create_source_mark ?name ?category (iter:GText.iter) = new source_mark(SourceBuffer.create_source_mark obj name category iter#as_iter) method source_marks_at_line ?category line = List.map (fun mark -> new source_mark mark) (SourceBuffer.get_source_marks_at_line obj line category) method source_marks_at_iter ?category (iter:GText.iter) = List.map (fun mark -> new source_mark mark) (SourceBuffer.get_source_marks_at_iter obj iter#as_iter category) method remove_source_marks ?category ~(start:GText.iter) ~(stop:GText.iter) () = SourceBuffer.remove_source_marks obj start#as_iter stop#as_iter category method forward_iter_to_source_mark ?category (iter:GText.iter) = SourceBuffer.forward_iter_to_source_mark obj iter#as_iter category method backward_iter_to_source_mark ?category (iter:GText.iter) = SourceBuffer.backward_iter_to_source_mark obj iter#as_iter category method iter_has_context_class (iter:GText.iter) context_class = SourceBuffer.iter_has_context_class obj iter#as_iter context_class method iter_forward_to_context_class_toggle (iter:GText.iter) context_class = SourceBuffer.iter_forward_to_context_class_toggle obj iter#as_iter context_class method iter_backward_to_context_class_toggle (iter:GText.iter) context_class = SourceBuffer.iter_backward_to_context_class_toggle obj iter#as_iter context_class method ensure_highlight ~(start:GText.iter) ~(stop:GText.iter) = SourceBuffer.ensure_highlight obj start#as_iter stop#as_iter method set_undo_manager (manager : source_undo_manager) = let manager = manager#as_source_undo_manager in Gobject.set SourceBuffer.P.undo_manager obj manager method undo_manager = let manager = Gobject.get SourceBuffer.P.undo_manager obj in new source_undo_manager manager end let source_buffer ?(language:source_language option) ?(style_scheme:source_style_scheme option) ?(tag_table : GText.tag_table option) ?text ?(undo_manager : source_undo_manager option) = let language = match language with | None -> None | Some source_language -> Some (source_language#as_source_language) in let style_scheme = match style_scheme with | None -> None | Some schm -> Some (schm#as_source_style_scheme) in let undo_manager = match undo_manager with | None -> None | Some manager -> Some (manager#as_source_undo_manager) in SourceBuffer.make_params [] ?language ?style_scheme ?undo_manager ~cont:(fun pl () -> let buf = match tag_table with None -> new source_buffer (SourceBuffer.create pl) | Some tt -> let obj = SourceBuffer.new_ tt#as_tag_table in Gobject.set_params (Gobject.try_cast obj "GtkSourceBuffer") pl; new source_buffer obj in (match text with | None -> () | Some text -> buf#set_text text); buf) (** {2 GtkSourceView} *) class source_view_signals obj' = object inherit widget_signals_impl (obj' : [> GtkSourceView2_types.source_view] obj) inherit GText.view_signals obj' inherit source_view_sigs end class source_view (obj': GtkSourceView2_types.source_view obj) = object (self) inherit GText.view_skel obj' inherit source_view_props val source_buf = let buf_obj = Gobject.try_cast (GtkText.View.get_buffer obj') "GtkSourceBuffer" in new source_buffer buf_obj method source_buffer = source_buf method connect = new source_view_signals obj' method set_cursor_color = SourceView.set_cursor_color obj method set_cursor_color_by_name s = SourceView.set_cursor_color obj (color_of_string s) method draw_spaces = SourceView.get_draw_spaces obj method set_draw_spaces flags = SourceView.set_draw_spaces obj flags method completion = new source_completion (SourceView.get_completion obj) end let source_view ?source_buffer ?draw_spaces = SourceView.make_params [] ~cont:( GtkText.View.make_params ~cont:( GContainer.pack_container ~create:(fun pl -> let obj = match source_buffer with | Some buf -> SourceView.new_with_buffer (Gobject.try_cast buf#as_buffer "GtkSourceBuffer") | None -> SourceView.new_ () in Gobject.set_params (Gobject.try_cast obj "GtkSourceView") pl; may (SourceView.set_draw_spaces obj) draw_spaces; new source_view obj))) (** {2 Misc} *) let iter_forward_search (iter:GText.iter) flags ~start ~stop ?limit str = let limit = map_opt (fun x -> x#as_iter) limit in match SourceViewMisc.iter_forward_search iter#as_iter str flags ~start: start#as_iter ~stop: stop#as_iter limit with None -> None | Some (it1,it2) -> Some (new GText.iter it1, new GText.iter it2) let iter_backward_search (iter:GText.iter) flags ~start ~stop ?limit str = let limit = map_opt (fun x -> x#as_iter) limit in match SourceViewMisc.iter_backward_search iter#as_iter str flags ~start: start#as_iter ~stop: stop#as_iter limit with None -> None | Some (it1,it2) -> Some (new GText.iter it1, new GText.iter it2) lablgtk-2.18.8/src/Makefile0000755000175000017500000005177113460263323014531 0ustar stephsteph# Makefile for lablgtk. COMPILER = $(CAMLC) $(MLFLAGS) $(MLBYTEFLAGS) -w s-3+52 -c LINKER = $(CAMLC) $(MLFLAGS) $(MLBYTEFLAGS) COMPOPT = $(CAMLOPT) $(MLFLAGS) -w s -c LINKOPT = $(CAMLOPT) $(MLFLAGS) LIBRARIAN = $(CAMLMKLIB) -verbose -ocamlc "$(CAMLC)" -ocamlopt "$(CAMLOPT)" TOPLEVEL = $(CAMLMKTOP) $(MLFLAGS) CAMLP4 = $(CAMLP4O) pr_o.cmo CONFIG = ../config.make # protect against missing definitions BINDIR = "" LIBDIR = "" INSTALLDIR = $(LIBDIR)/lablgtk2 DLLDIR = $(LIBDIR)/stublibs include $(CONFIG) #GTKCFLAGS += -Werror -Wno-error=deprecated-declarations TARGETS = varcc$(XE) lablgtktop$(XE) lablgtk2$(XB) gdk_pixbuf_mlsource$(XE) \ $(THINITOBJS) build.ml all: dist byte world: dist byte $(CAMLBEST) install: findlib-install uninstall: findlib-uninstall MLLIBS = lablgtk.cma CLIBS = liblablgtk2$(XA) #MLLINK = unix.cma str.cma # For -DG_LOG_DOMAIN=\"LablGTK\" ifneq ($(TOOLCHAIN),msvc) GTKCFLAGS += -imacros ml_domain.h else GTKCFLAGS += /FI ml_domain.h endif # compile using a custom version of mlvalues.h, where value is abstract ifdef ABSVALUE GTKCFLAGS += -Iabsvalue -DABSVALUE endif ifdef DEBUG COMPILER += -warn-error A-52 CFLAGS = -g $(GTKCFLAGS) CUSTOM = -custom #MLLINK += -cclib -lcamlrund MLBYTEFLAGS = -g -dtypes else CFLAGS = -DG_DISABLE_ASSERT -DG_DISABLE_CAST_CHECKS $(GTKCFLAGS) ifneq ($(TOOLCHAIN),msvc) CFLAGS += -O endif endif ifeq ($(THREADS_LIB),system) THFLAGS = -thread else THFLAGS = -vmthread CUSTOM = -custom endif THLINK = unix.cma threads.cma ifdef USE_CC CCOMPILER = $(CC) -c -I"$(LIBDIR)" $(CFLAGS) else CCOMPILER = $(CAMLC) -c -ccopt '$(CFLAGS)' -verbose endif ifdef USE_GL ifdef LABLGLDIR MLFLAGS += -I $(LABLGLDIR) endif MLLINK += lablgl.cma MLLIBS += lablgtkgl.cma CLIBS += liblablgtkgl2$(XA) GLMLOBJS = glGtk.cmo GLCOBJS = ml_gtkgl$(XO) endif #ifdef USE_GNOME #MLLIBS += lablgnome.cma #CLIBS += liblablgnome$(XA) #GNOMEMLOBJS = gtkXmHTML.cmo gHtml.cmo #GNOMECOBJS = ml_gtkxmhtml$(XO) #endif ifdef USE_GLADE MLLIBS += lablglade.cma CLIBS += liblablglade2$(XA) GLADEMLOBJS = glade.cmo GLADECOBJS = ml_glade$(XO) TARGETS += lablgladecc$(XE) endif ifdef USE_GNOMECANVAS MLLIBS += lablgnomecanvas.cma CLIBS += liblablgnomecanvas$(XA) GNOMECANVASMLOBJS = gnomeCanvas.cmo gnoCanvas.cmo GNOMECANVASCOBJS = ml_gnomecanvas$(XO) endif ifdef USE_GNOMEUI MLLIBS += lablgnomeui.cma CLIBS += liblablgnomeui$(XA) GNOMEUIMLOBJS = gnomeDruid.cmo gnoDruid.cmo GNOMEUICOBJS = ml_gnomedruid$(XO) ifdef USE_PANEL MLLIBS += lablpanel.cma CLIBS += liblablpanel$(XA) PANELMLOBJS = panel.cmo PANELCOBJS = ml_panel$(XO) endif endif ifdef USE_RSVG MLLIBS += lablrsvg.cma CLIBS += liblablrsvg$(XA) RSVGMLOBJS = rsvg.cmo RSVGCOBJS = ml_rsvg$(XO) $(RSVGCOBJS) : CFLAGS+=$(HAVE_SVGZ) endif ifdef USE_GTKSPELL MLLIBS += lablgtkspell.cma CLIBS += liblablgtkspell$(XA) GTKSPELLMLOBJS = gtkSpell.cmo GTKSPELLCOBJS = ml_gtkspell$(XO) endif ifdef USE_GTKSOURCEVIEW byte:: lablgtksourceview.cma liblablgtksourceview$(XA) opt:: lablgtksourceview.cmxa liblablgtksourceview$(XA) ifeq ($(HAS_NATIVE_DYNLINK),yes) opt:: lablgtksourceview.cmxs endif ml_gtksourceview.o: CFLAGS=$(GTKSOURCEVIEWCFLAGS) GTKSOURCEVIEWMLOBJS = gtkSourceView.cmo gSourceView.cmo GTKSOURCEVIEWCOBJS = ml_gtksourceview$(XO) ml_gtksourceview.c: pango_tags.h GTKSOURCEVIEWMLOBJSENUM = sourceViewEnums.cmo GTKSOURCEVIEWPROPS = gtkSourceView.props CLIBS += liblablgtksourceview$(XA) EXTRA_MLLIBS += lablgtksourceview.cma EXTRA_OBJS += $(GTKSOURCEVIEWMLOBJS) $(GTKSOURCEVIEWMLOBJSENUM) BEFORE_DEPEND += $(GTKSOURCEVIEWMLOBJS:%.cmo=%.ml) $(GTKSOURCEVIEWPROPS:%.props=%Props.ml) $(GTKSOURCEVIEWPROPS:%.props= o%Props.ml) $(GTKSOURCEVIEWMLOBJSENUM:%.cmo=%.ml) lablgtksourceview.cma liblablgtksourceview$(XA): \ $(GTKSOURCEVIEWCOBJS) $(GTKSOURCEVIEWMLOBJSENUM) $(GTKSOURCEVIEWPROPS:%.props=%Props.cmo) $(GTKSOURCEVIEWPROPS:%.props=o%Props.cmo) $(GTKSOURCEVIEWMLOBJS) $(LIBRARIAN) -o lablgtksourceview $^ $(GTKSOURCEVIEWLIBS) lablgtksourceview.cmxa: $(GTKSOURCEVIEWCOBJS) $(GTKSOURCEVIEWMLOBJSENUM:.cmo=.cmx) $(GTKSOURCEVIEWPROPS:%.props=%Props.cmx) $(GTKSOURCEVIEWPROPS:%.props=o%Props.cmx) $(GTKSOURCEVIEWMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgtksourceview $^ $(GTKSOURCEVIEWLIBS) endif ifdef USE_GTKSOURCEVIEW2 MLLIBS += lablgtksourceview2.cma CLIBS += liblablgtksourceview2$(XA) GTKSOURCEVIEW2MLOBJS = gtkSourceView2.cmo gSourceView2.cmo GTKSOURCEVIEW2COBJS = ml_gtksourceview2$(XO) GTKSOURCEVIEW2MLOBJSENUM = sourceView2Enums.cmo GTKSOURCEVIEW2PROPS = gtkSourceView2.props BEFORE_DEPEND += $(GTKSOURCEVIEW2PROPS:%.props=%Props.ml) $(GTKSOURCEVIEW2PROPS:%.props= o%Props.ml) $(GTKSOURCEVIEWMLOBJSENUM:%.cmo=%.ml) EXTRA_OBJS += $(GTKSOURCEVIEW2MLOBJSENUM) GTKSOURCEVIEW2ALLMLOBJS = $(GTKSOURCEVIEW2MLOBJSENUM) \ $(GTKSOURCEVIEW2PROPS:%.props=%Props.cmo) \ $(GTKSOURCEVIEW2PROPS:%.props=o%Props.cmo) $(GTKSOURCEVIEW2MLOBJS) lablgtksourceview2.cma liblablgtksourceview2$(XA): \ $(GTKSOURCEVIEW2COBJS) $(GTKSOURCEVIEW2ALLMLOBJS) $(LIBRARIAN) -o lablgtksourceview2 $^ $(GTKSOURCEVIEW2LIBS) lablgtksourceview2.cmxa: \ $(GTKSOURCEVIEW2COBJS) $(GTKSOURCEVIEW2ALLMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgtksourceview2 $^ $(GTKSOURCEVIEW2LIBS) lablgtksourceview2.cmxs: DYNLINKLIBS=$(GTKSOURCEVIEW2_LIBS) endif ifdef USE_GTKQUARTZ CFLAGS += -DHAS_GTKQUARTZ endif # Rules .SUFFIXES: .ml .mli .cmo .cmi .cmx .cmxs .cmxa .c $(XO) .d$(XO) .var .h .opt .def .ml4 .c$(XO): $(CCOMPILER) $< .cpp$(XO): $(CCOMPILER) $< .c.d$(XO): $(CAMLC) -c -ccopt '-MT -DCAML_DLL -Fo$@ $(CFLAGS)' $< .ml.cmo: $(COMPILER) $(PRINCIPAL) $< .mli.cmi: $(COMPILER) $< .ml.cmx: $(COMPOPT) $< ifneq ($(CAMLP4O),no) .ml4.ml: $(CAMLP4O) -impl $< -o $@ endif #.ml4.cmo: # $(CAMLC) -c -pp "$(CAMLP4O) -impl" -impl $< .cmxa.cmxs: $(CAMLOPT) -verbose -o $@ -shared -linkall -I . \ -ccopt '$(filter -L%, $(DYNLINKLIBS))' $< %_tags.h %_tags.c %Enums.ml: %_tags.var varcc$(XE) ./varcc $< %Props.ml o%Props.ml: %.props propcc$(XE) ./propcc $< # Files GTKOBJS = ml_gtk$(XO) ml_pango$(XO) ml_gtkaction$(XO) \ ml_gtkbin$(XO) ml_gtkbroken$(XO) ml_gtkbutton$(XO) \ ml_gtkassistant$(XO) \ ml_gtkedit$(XO) ml_gtkfile$(XO) ml_gtklist$(XO) \ ml_gtkmenu$(XO) ml_gtkmisc$(XO) \ ml_gtkpack$(XO) ml_gtkrange$(XO) ml_gtkstock$(XO) \ ml_gtktext$(XO) ml_gtktree$(XO) COBJS = ml_gdkpixbuf$(XO) ml_gdk$(XO) ml_glib$(XO) ml_gobject$(XO) \ ml_gpointer$(XO) ml_gvaluecaml$(XO) wrappers$(XO) $(GTKOBJS) GTKPROPS += gtkBase.props gtkBin.props gtkButton.props gtkEdit.props \ gtkList.props gtkMenu.props gtkMisc.props gtkPack.props \ gtkRange.props gtkText.props gtkTree.props gtkFile.props \ gtkAction.props gtkBroken.props gtkAssistant.props MLOBJS1 = gaux.cmo gpointer.cmo gutf8.cmo glib.cmo gobject.cmo ENUMOBJS += gdkEnums.cmo pangoEnums.cmo gtkEnums.cmo MLOBJS2 = pango.cmo gdk.cmo gdkEvent.cmo gdkKeysyms.cmo gdkPixbuf.cmo \ gtk.cmo gtkSignal.cmo gtkStock.cmo gtkObject.cmo MLOBJS3 = gtkData.cmo gtkBase.cmo gtkPack.cmo gtkButton.cmo \ gtkAssistant.cmo \ gtkMenu.cmo gtkMisc.cmo gtkWindow.cmo gtkList.cmo \ gtkBin.cmo gtkEdit.cmo gtkRange.cmo gtkText.cmo gtkTree.cmo \ gtkFile.cmo gtkMain.cmo gtkBroken.cmo \ gPango.cmo gDraw.cmo gObj.cmo ogtkBaseProps.cmo gData.cmo MLOBJS4 = gMain.cmo gContainer.cmo gPack.cmo gButton.cmo gText.cmo \ gMenu.cmo gMisc.cmo gTree.cmo gList.cmo gFile.cmo gWindow.cmo \ gAssistant.cmo \ gBin.cmo gEdit.cmo gRange.cmo gAction.cmo gBroken.cmo \ gUtil.cmo gToolbox.cmo MLOBJS = $(MLOBJS1) $(ENUMOBJS) $(MLOBJS2) $(GTKPROPS:.props=Props.cmo) \ $(MLOBJS3) $(GTKPROPS:%.props=o%Props.cmo) $(MLOBJS4) THOBJS = gtkThread.cmo INITOBJS = gtkInit.cmo ifdef USE_GTKQUARTZ THINITOBJS = gtkThTop.cmo else THINITOBJS = gtkThInit.cmo endif EXTRAOBJS = $(INITOBJS) $(THOBJS) $(THINITOBJS) ALLOBJS = $(MLOBJS) $(GLMLOBJS) $(GNOMEMLOBJS) $(GLADEMLOBJS) \ $(RSVGMLOBJS) $(GNOMECANVASMLOBJS) $(GNOMEUIMLOBJS) $(PANELMLOBJS) \ $(GTKSPELLMLOBJS) $(GTKSOURCEVIEW2MLOBJS) \ $(INITOBJS) ALLTHOBJS = $(THOBJS) $(THINITOBJS) PROPOBJS = $(GTKPROPS:%.props=%Props.cmo) $(GTKPROPS:%.props=o%Props.cmo) ML4SRC = check_externals.ml propcc.ml varcc.ml # Targets byte:: $(TARGETS) $(INITOBJS) opt:: $(TARGETS) lablgtkopt depend: $(MAKE) real-depend USE_GL=1 USE_GLADE=1 USE_RSVG=1 \ USE_GNOMECANVAS=1 USE_GNOMEUI=1 USE_PANEL=1 USE_GTKSPELL=1 \ USE_GTKSOURCEVIEW=1 USE_GTKSOURCEVIEW2=1 real-depend: $(ENUMOBJS:.cmo=.ml) $(PROPOBJS:.cmo=.ml) $(BEFORE_DEPEND) ocamldep $(ALLOBJS:.cmo=.ml) $(PROPOBJS:.cmo=.ml) \ $(ALLTHOBJS:.cmo=.ml) $(BEFORE_DEPEND) *.mli > .depend ifeq ($(THREADS_LIB),no) lablgtktop$(XE): $(MLLIBS) $(CONFIG) $(TOPLEVEL) $(CUSTOM) -o $@ $(MLLINK) -I . $(MLLIBS) else lablgtktop$(XE): $(MLLIBS) $(THOBJS) $(CONFIG) $(TOPLEVEL) $(THFLAGS) $(CUSTOM) -o $@ $(THLINK) $(MLLINK) \ -I . $(MLLIBS) $(THOBJS) endif lablgtk2: Makefile $(CONFIG) lablgtk2.in sed -e "s|@INSTALLDIR@|$(LABLGTKDIR)|g" \ -e "s|@LABLGLDIR@|$(LABLGLDIR)|g" \ -e "s|@MLLIBS@|$(MLLINK) $(MLLIBS)|g" \ -e "s|@INITOBJS@|$(INITOBJS)|g" \ -e "s|@THOBJS@|$(THOBJS)|g" \ -e "s|@THINITOBJS@|$(THINITOBJS)|g" \ -e "s|@USEDLL@|$(HAS_DLL_SUPPORT)|g" \ -e "s|@THREADS_LIB@|$(THREADS_LIB)|g" \ < lablgtk2.in > $@ chmod 755 $@ lablgtk2.bat: lablgtk2.bat.in cp lablgtk2.bat.in lablgtk2.bat build.ml: Makefile $(CONFIG) build.ml.in sed -e "s|@LABLGTK_MLS@|$(MLOBJS:.cmo=)|" \ -e "s|@EXTRA_MLS@|$(EXTRAOBJS:.cmo=)|" \ -e "s|@PROP_MLS@|$(PROPOBJS:.cmo=)|" \ -e "s|@GTKLIBS@|$(GTKLIBS)|" \ -e "s|@GLADE_MLS@|$(GLADEMLOBJS:.cmo=)|" \ -e "s|@GLADE_LIBS@|$(GLADELIBS)|" \ -e "s|@RSVG_MLS@|$(RSVGMLOBJS:.cmo=)|" \ -e "s|@RSVG_LIBS@|$(RSVGLIBS)|" \ -e "s|@CANVAS_MLS@|$(GNOMECANVASMLOBJS:.cmo=)|" \ -e "s|@CANVAS_LIBS@|$(GNOMECANVASLIBS)|" \ -e "s|@SOURCEVIEW2_MLS@|$(GTKSOURCEVIEW2ALLMLOBJS:.cmo=)|" \ -e "s|@SOURCEVIEW2_LIBS@|$(GTKSOURCEVIEW2LIBS)|" \ -e "s|@TOOLCHAIN@|$(TOOLCHAIN)|" \ < build.ml.in > $@ gdk_pixbuf_mlsource$(XE) : lablgtk.cma gdk_pixbuf_mlsource.ml $(CAMLC) -o $@ -I . $^ lablgtkopt:: $(MLLIBS:.cma=.cmxa) $(INITOBJS:.cmo=.cmx) ifeq ($(THREADS_LIB),system) lablgtkopt:: $(THOBJS:.cmo=.cmx) endif ifeq ($(HAS_NATIVE_DYNLINK),yes) lablgtkopt:: $(MLLIBS:.cma=.cmxs) endif LABLGLADECCOBJS = gutf8.cmo xml_lexer.cmo lablgladecc.cmo lablgladecc$(XE): $(LABLGLADECCOBJS) $(LINKER) -o $@ $(LABLGLADECCOBJS) testcc$(XE): lablgladecc$(XE) lablgtktop ./lablgladecc -test > testcc.ml ./lablgtktop testcc.ml rm -f testcc.ml PREOBJS= $(MLOBJS) $(EXTRAOBJS) $(GLADEMLOBJS) $(RSVGMLOBJS) \ $(GNOMECANVASMLOBJS) $(GTKSOURCEVIEW2ALLMLOBJS) # Install ml sources and C binaries, can then rebuild using build.ml preinstall: mkdir -p "$(INSTALLDIR)" "$(BINDIR)" "$(DLLDIR)" cp $(PREOBJS:.cmo=.ml) gtkSourceView2_types.mli "$(INSTALLDIR)" for f in $(PREOBJS:.cmo=.mli); do \ if test -f $$f; then cp $$f "$(INSTALLDIR)"; fi; done cp build.ml "$(INSTALLDIR)" cp lablgtk2$(XB) gdk_pixbuf_mlsource$(XE) "$(BINDIR)" cp lablgladecc$(XE) "$(BINDIR)/lablgladecc2$(XE)" cp $(CLIBS) "$(INSTALLDIR)" cp $(CLIBS:lib%$(XA)=dll%$(XS)) "$(DLLDIR)" # Install directly to $(INSTALLDIR), without using ocamlfind old-install: mkdir -p "$(INSTALLDIR)" "$(BINDIR)" "$(DLLDIR)" cp $(ALLOBJS:.cmo=.cmi) $(EXTRA_OBJS:.cmo=.cmi) "$(INSTALLDIR)" cp -p ../META *.mli "$(INSTALLDIR)" cp -p $(ALLOBJS:.cmo=.ml) $(ALLTHOBJS:.cmo=.ml) \ $(EXTRA_OBJS:.cmo=.ml) build.ml "$(INSTALLDIR)" cp $(EXTRA_MLLIBS) $(MLLIBS) $(INITOBJS) "$(INSTALLDIR)" cp $(CLIBS) "$(INSTALLDIR)" cd "$(INSTALLDIR)" && $(RANLIB) $(CLIBS) cp varcc$(XE) propcc$(XE) "$(INSTALLDIR)" if test $(THREADS_LIB) != no; \ then cp $(ALLTHOBJS) $(ALLTHOBJS:.cmo=.cmi) "$(INSTALLDIR)"; \ fi if test $(THREADS_LIB) = vm || test $(HAS_DLL_SUPPORT) != yes; \ then cp lablgtktop$(XE) "$(INSTALLDIR)"; \ fi cp -p *.h "$(INSTALLDIR)" @if test -f lablgtk.cmxa; then $(MAKE) old-installopt; fi @if test -f dlllablgtk2$(XS); then $(MAKE) old-installdll; fi cp lablgtk2$(XB) "$(BINDIR)" if test -f lablgladecc$(XE); then \ cp lablgladecc$(XE) "$(BINDIR)/lablgladecc2$(XE)"; fi cp gdk_pixbuf_mlsource$(XE) "$(BINDIR)" old-installdll: cp $(CLIBS:lib%$(XA)=dll%$(XS)) "$(DLLDIR)" || \ echo "Couldn't install dlls in default location: $(DLLDIR)" if test -f dlllablgtk2$(XA); then \ cp $(CLIBS:lib%$(XA)=dll%$(XA)) "$(INSTALLDIR)"; fi old-installopt: cp $(MLLIBS:.cma=.cmxa) $(MLLIBS:.cma=$(XA)) $(EXTRA_MLLIBS:.cma=.cmxa) $(EXTRA_MLLIBS:.cma=$(XA)) "$(INSTALLDIR)" ifeq ($(HAS_NATIVE_DYNLINK),yes) cp $(MLLIBS:.cma=.cmxs) $(EXTRA_MLLIBS:.cma=.cmxs) "$(INSTALLDIR)" endif cd "$(INSTALLDIR)" && $(RANLIB) $(MLLIBS:.cma=$(XA)) $(EXTRA_MLLIBS:.cma=$(XA)) cp $(ALLOBJS:.cmo=.cmx) $(EXTRA_OBJS:.cmo=.cmx) "$(INSTALLDIR)" cp $(INITOBJS:.cmo=$(XO)) "$(INSTALLDIR)" if test -f gtkThread.cmx; then \ cp $(THOBJS:.cmo=.cmx) $(THOBJS:.cmo=$(XO)) "$(INSTALLDIR)"; fi old-uninstall: rm -r "$(INSTALLDIR)" for f in $(CLIBS:lib%$(XA)=dll%$(XS)); \ do rm "$(DLLDIR)"/$$f; done for f in lablgladecc2$(XE) lablgtk2$(XB) gdk_pixbuf_mlsource$(XE); \ do rm -f "$(BINDIR)"/$$f; done # Install using ocamlfind findlib-install: @if test "$(OCAMLFIND)" = no; then \ echo "Cannot use ocamlfind, use old-install."; \ exit 2; fi mkdir -p "$(BINDIR)" mkdir -p "$(DESTDIR)$(FINDLIBDIR)" @if test -f "$(DESTDIR)$(OCAMLLDCONF)"; then :; else \ mkdir -p "`dirname $(DESTDIR)$(OCAMLLDCONF)`"; \ touch "$(DESTDIR)$(OCAMLLDCONF)"; fi $(OCAMLFIND) install -destdir "$(DESTDIR)$(FINDLIBDIR)" \ -ldconf "$(DESTDIR)$(OCAMLLDCONF)" \ lablgtk2 ../META \ build.ml \ $(CLIBS) \ $(ALLOBJS:.cmo=.cmi) $(EXTRA_OBJS:.cmo=.cmi) \ *.mli \ $(ALLOBJS:.cmo=.ml) $(ALLTHOBJS:.cmo=.ml) $(EXTRA_OBJS:.cmo=.ml) \ $(EXTRA_MLLIBS) $(MLLIBS) $(INITOBJS) \ varcc$(XE) propcc$(XE) \ `if test $(THREADS_LIB) != no; \ then echo $(ALLTHOBJS) $(ALLTHOBJS:.cmo=.cmi) ; \ fi` \ `if test $(THREADS_LIB) = vm || test $(HAS_DLL_SUPPORT) != yes; \ then echo lablgtktop$(XE) ; \ fi` \ *.h \ `if test -f lablgtk.cmxa; \ then \ echo $(MLLIBS:.cma=.cmxa) $(MLLIBS:.cma=$(XA)) \ $(EXTRA_MLLIBS:.cma=.cmxa) $(EXTRA_MLLIBS:.cma=$(XA)) ; \ if test "$(HAS_NATIVE_DYNLINK)" = "yes" ; \ then echo $(MLLIBS:.cma=.cmxs) $(EXTRA_MLLIBS:.cma=.cmxs) ; \ fi; \ echo $(ALLOBJS:.cmo=.cmx) $(EXTRA_OBJS:.cmo=.cmx) ; \ echo $(INITOBJS:.cmo=$(XO)) ; \ if test -f gtkThread.cmx; then \ echo $(THOBJS:.cmo=.cmx) $(THOBJS:.cmo=$(XO)) ; \ fi ; \ fi` \ `if test -f dlllablgtk2$(XS); \ then \ echo "-dll $(CLIBS:lib%$(XA)=dll%$(XS)) -nodll" ; \ fi` \ `if test -f dlllablgtk2$(XA); \ then \ echo $(CLIBS:lib%$(XA)=dll%$(XA)) ; \ fi` rm -f lablgtk2 $(MAKE) lablgtk2 LABLGTKDIR="$(FINDLIBDIR)/lablgtk2" cp lablgtk2$(XB) "$(BINDIR)" if test -f lablgladecc$(XE); then \ cp lablgladecc$(XE) "$(BINDIR)/lablgladecc2$(XE)"; \ fi cp gdk_pixbuf_mlsource$(XE) "$(BINDIR)" $(RANLIB) $(CLIBS:%="$(FLINSTALLDIR)"/%) @if test -f lablgtk.cmxa; then \ echo "Execute $(RANLIB) in $(FLINSTALLDIR)"; \ $(RANLIB) $(MLLIBS:%.cma="$(FLINSTALLDIR)"/%$(XA)) \ $(EXTRA_MLLIBS:%.cma="$(FLINSTALLDIR)"/%$(XA)) ; \ fi findlib-uninstall: $(OCAMLFIND) remove lablgtk2 for f in lablgladecc2$(XE) lablgtk2$(XB) gdk_pixbuf_mlsource$(XE); \ do rm -f "$(BINDIR)"/$$f; done lablgtk.cma liblablgtk2$(XA): $(COBJS) $(MLOBJS) $(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS) lablgtk.cmxa: $(COBJS) $(MLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgtk -oc lablgtk2 $^ $(GTKLIBS) lablgtk.cmxs: DYNLINKLIBS=$(GTK_LIBS) lablgtkgl.cma liblablgtkgl2$(XA): $(GLCOBJS) $(GLMLOBJS) $(LIBRARIAN) -o lablgtkgl -oc lablgtkgl2 $^ $(GTKGLLIBS) lablgtkgl.cmxa: $(GLCOBJS) $(GLMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgtkgl -oc lablgtkgl2 $^ $(GTKGLLIBS) lablgtkgl.cmxs: DYNLINKLIBS=$(GTKGL_LIBS) lablglade.cma liblablglade2$(XA): $(GLADECOBJS) $(GLADEMLOBJS) $(LIBRARIAN) -o lablglade -oc lablglade2 $^ $(GLADELIBS) lablglade.cmxa: $(GLADECOBJS) $(GLADEMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablglade -oc lablglade2 $^ $(GLADELIBS) lablglade.cmxs: DYNLINKLIBS=$(GLADE_LIBS) lablrsvg.cma liblablrsvg$(XA): $(RSVGCOBJS) $(RSVGMLOBJS) $(LIBRARIAN) -o lablrsvg $^ $(RSVGLIBS) lablrsvg.cmxa: $(RSVGCOBJS) $(RSVGMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablrsvg $^ $(RSVGLIBS) lablrsvg.cmxs: DYNLINKLIBS=$(RSVG_LIBS) lablgnomecanvas.cma liblablgnomecanvas$(XA): \ $(GNOMECANVASCOBJS) $(GNOMECANVASMLOBJS) $(LIBRARIAN) -o lablgnomecanvas $^ $(GNOMECANVASLIBS) lablgnomecanvas.cmxa: $(GNOMECANVASCOBJS) $(GNOMECANVASMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgnomecanvas $^ $(GNOMECANVASLIBS) # gnoCanvas.cmo: COMPILER+= -i lablgnomecanvas.cmxs: DYNLINKLIBS=$(GNOMECANVAS_LIBS) lablgnomeui.cma liblablgnomeui$(XA): $(GNOMEUICOBJS) $(GNOMEUIMLOBJS) $(LIBRARIAN) -o lablgnomeui $^ $(GNOMEUILIBS) lablgnomeui.cmxa: $(GNOMEUICOBJS) $(GNOMEUIMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgnomeui $^ $(GNOMEUILIBS) # gnoDruid.cmo: COMPILER+= -i lablgnomeui.cmxs: DYNLINKLIBS=$(GNOMEUI_LIBS) lablpanel.cma liblablpanel$(XA): $(PANELCOBJS) $(PANELMLOBJS) $(LIBRARIAN) -o lablpanel $^ $(PANELLIBS) lablpanel.cmxa: $(PANELCOBJS) $(PANELMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablpanel $^ $(PANELLIBS) lablpanel.cmxs: DYNLINKLIBS=$(PANEL_LIBS) lablgtkspell.cma liblablgtkspell$(XA): $(GTKSPELLCOBJS) $(GTKSPELLMLOBJS) $(LIBRARIAN) -o lablgtkspell $^ $(GTKSPELLLIBS) lablgtkspell.cmxa: $(GTKSPELLCOBJS) $(GTKSPELLMLOBJS:.cmo=.cmx) $(LIBRARIAN) -o lablgtkspell $^ $(GTKSPELLLIBS) lablgtkspell.cmxs: DYNLINKLIBS=$(GTKSPELL_LIBS) #gtkSignal.ml: gtkSignal.ml4 # $(CAMLP4O) pa_macro.cmo $(HAS_PRINTEXC_BACKTRACE) -impl $< -o $@ gtkThread.cmo: gtkThread.ml $(CONFIG) $(COMPILER) $(THFLAGS) $< gtkThread.cmi: gtkThread.mli $(CONFIG) $(COMPILER) $(THFLAGS) $< gtkThread.cmx: gtkThread.ml $(CONFIG) $(COMPOPT) $(THFLAGS) $< gtkThTop.cmo: gtkThTop.ml $(CONFIG) $(COMPILER) $(THFLAGS) -I +compiler-libs $< xml_lexer.ml: xml_lexer.mll $(CAMLLEX) xml_lexer.mll xml_lexer.cmo xml_lexer.cmx : xml_lexer.cmi varcc$(XE): varcc.cmo $(LINKER) -o $@ $< rm -f *_tags.h *_tags.c propcc$(XE): propcc.cmo $(LINKER) -o $@ $< check_externals$(XE): check_externals.cmo $(LINKER) -o $@ $< clean: rm -f *.cm* *.o *.a *.so *.exe *.obj *.lib *.dll *_tags.[ch] *.gch \ $(TARGETS) xml_lexer.ml propcc$(XE) check_externals$(XE) \ *Enums.ml *Props.ml rm -f \#*\# *~ dist: $(ML4SRC) dist-clean: rm -f $(ML4SRC) DOCFILES = gPango.ml gDraw.mli gObj.mli gMain.mli gData.mli \ gContainer.mli gBin.mli gPack.mli gButton.mli gText.mli \ gMenu.mli gMisc.mli gTree.mli gFile.mli gList.mli gWindow.mli \ gEdit.mli gRange.mli gAction.mli gUtil.mli gToolbox.mli gBroken.mli \ gaux.ml gpointer.mli glib.mli gobject.mli \ gdkEnums.ml pangoEnums.ml gtkEnums.ml \ gdk.mli gdkEvent.ml gdkPixbuf.mli \ gtk.ml pango.ml gtkSignal.mli gtkObject.ml \ gtkStock.ml gtkData.ml gtkBase.ml gtkPack.ml gtkButton.ml \ gtkMenu.ml gtkMisc.ml gtkWindow.ml gtkList.ml \ gtkEdit.ml gtkRange.ml gtkText.ml gtkTree.ml \ gtkFile.ml gtkMain.ml \ $(GTKPROPS:%.props=%Props.ml) ifdef USE_GLADE DOCFILES += glade.mli xml_lexer.mli endif ifdef USE_GL DOCFILES += glGtk.mli endif ifdef USE_RSVG DOCFILES += rsvg.mli endif ifdef USE_GNOMECANVAS DOCFILES += gnomeCanvas.ml gnoCanvas.mli endif ifdef USE_GNOMEUI DOCFILES += gnomeDruid.ml gnoDruid.mli endif ifdef USE_PANEL DOCFILES += panel.mli endif ifdef USE_GTKSPELL DOCFILES += gtkSpell.mli endif ifdef USE_GTKSOURCEVIEW DOCFILES += gSourceView.mli endif ifdef USE_GTKSOURCEVIEW2 DOCFILES += gSourceView2.mli endif OCAMLDOC = ocamldoc lablgtk.odoc : $(DOCFILES) $(ALLOBJS) $(OCAMLDOC) -dump $@ $(if $(LABLGLDIR),-I $(LABLGLDIR)) $(DOCFILES) gtkdoc.cmo : gtkdoc.ml $(CAMLC) -I +ocamldoc -pp "$(CAMLP4O) pa_macro.cmo $(ODOC_DEF)" -c $< DOCDIR=../doc #DOC_URI=file:///usr/share/gtk-doc/html DOC_BASE_URI=$(if $(DOC_URI),-base-uri $(DOC_URI)) doc : lablgtk.odoc gtkdoc.cmo mkdir -p $(DOCDIR)/html $(OCAMLDOC) -sort -g ./gtkdoc.cmo $(DOC_BASE_URI) -t LablGTK -d $(DOCDIR)/html -load $< doc_texi : lablgtk.odoc $(OCAMLDOC) -texi -t LablGTK -o $(DOCDIR)/lablgtk2.texi -load $< $(GTKOBJS): pango_tags.h gtk_tags.h ml_gtk.h gdk_tags.h ml_gdk.h \ ml_gobject.h ml_glib.h wrappers.h $(GNOMEUICOBJS) : gnomeui_tags.h $(PANELCOBJS) : panel_tags.h $(GTKSOURCEVIEWCOBJS): ml_glib.h ml_gdk.h ml_gtk.h ml_gobject.h ml_gdkpixbuf.h ml_pango.h \ gtk_tags.h gdk_tags.h ml_gtktext.h sourceView_tags.h wrappers.h $(GTKSOURCEVIEW2COBJS): ml_glib.h ml_gdk.h ml_gtk.h ml_gobject.h ml_gdkpixbuf.h ml_pango.h \ gtk_tags.h gdk_tags.h ml_gtktext.h sourceView2_tags.h wrappers.h ml_glib$(XO): glib_tags.h ml_glib.h wrappers.h ml_gobject$(XO): gobject_tags.h ml_gvaluecaml.h wrappers.h ml_gvaluecaml$(XO): ml_gobject.h wrappers.h ml_gdk$(XO): gdk_tags.h ml_gdk.h ml_gpointer.h \ pango_tags.h ml_pango.h wrappers.h ml_gtk$(XO) ml_gtktext$(XO): ml_pango.h ml_gtkgl$(XO): gtkgl_tags.h ml_gtk.h ml_gdk.h wrappers.h ml_gtkxmhtml$(XO): gtkxmhtml_tags.h ml_gtk.h ml_gdk.h wrappers.h ml_gpointer$(XO): ml_gpointer.h ml_gdkpixbuf$(XO): ml_gdkpixbuf.h gdkpixbuf_tags.h ml_gdk.h gdk_tags.h \ wrappers.h ml_gpointer.h ml_pango$(XO): pango_tags.h ml_pango.h ml_rsvg$(XO): ml_gobject.h ml_gdkpixbuf.h wrappers.h ml_gnomecanvas$(XO): ml_gtk.h ml_gobject.h wrappers.h ml_gnomedruid$(XO): ml_gtk.h ml_gobject.h wrappers.h ml_panel$(XO): ml_gtk.h ml_gobject.h wrappers.h include .depend lablgtk-2.18.8/src/TODO.gtktext0000644000175000017500000000174713460263323015245 0ustar stephsteph=============================================================================== GtkTextIter: Il manque : gtk_text_iter_get_attributes =============================================================================== GtkTextMark : FINI =============================================================================== GtkTextBuffer: FINI =============================================================================== GtkTextTag: Il manque les PangoTabs. =============================================================================== GtkTextTagTable: FINI =============================================================================== GtkTextView: Manquent les fonctions concernant les PangoTabArray : void gtk_text_view_set_tabs(GtkTextView *text_view,PangoTabArray *tabs); PangoTabArray* gtk_text_view_get_tabs(GtkTextView *text_view); GtkTextAttributes* gtk_text_view_get_default_attributes(GtkTextView *text_view); =============================================================================== lablgtk-2.18.8/src/gtkButton.props0000644000175000017500000001131713460263323016124 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } oheader{ open GtkButtonProps } class Button set wrap wrapsig : Bin { "focus-on-click" gboolean : Read / Write / NoSet "image" GtkWidget : Read / Write / NoSet "image-position" GtkPositionType : Read / Write / NoSet "label" gchararray : Read / Write / Construct "use-stock" gboolean : Read / Write / Construct "use-underline" gboolean : Read / Write / Construct "relief" GtkReliefStyle : Read / Write "xalign" gfloat : Read / Write / NoSet "yalign" gfloat : Read / Write / NoSet signal activate / NoWrap signal clicked signal enter signal leave signal pressed signal released } class ToggleButton set : Button { "active" gboolean : Read / Write "draw-indicator" gboolean : Read / Write "inconsistent" gboolean : Read / Write / NoSet signal toggled } class CheckButton notype : ToggleButton {} class RadioButton : ToggleButton { "group" GtkRadioButton_opt : Write } class ColorButton wrap : Button { "alpha" guint : Read / Write "color" GdkColor : Read / Write / Set "title" gchararray : Read / Write / Set "use-alpha" gboolean : Read / Write signal color_set } class FontButton wrap : Button { "font-name" gchararray : Read / Write / Set "show-size" gboolean : Read / Write "show-style" gboolean : Read / Write "title" gchararray : Read / Write / Set "use-font" gboolean : Read / Write "use-size" gboolean : Read / Write signal font_set } class ToolItem wrap : Bin { "is-important" gboolean : Read / Write "visible-horizontal" gboolean : Read / Write "visible-vertical" gboolean : Read / Write method set_homogeneous : "bool -> unit" method get_homogeneous : "bool" method set_expand : "bool -> unit" method get_expand : "bool" method set_tooltip : "[>`tooltips] obj -> string -> string -> unit" method set_use_drag_window : "bool -> unit" method get_use_drag_window : "bool" (* probably only useful when subclassing ToolItem signal create_menu_proxy : -> bool signal set_tooltip : GtkTooltips string string -> bool signal toolbar_reconfigured get_icon_size get_orientation get_toolbar_style get_relief_style retrieve_proxy_menu_item get_proxy_menu_item set_proxy_menu_item *) } class SeparatorToolItem : ToolItem { "draw" gboolean : Read / Write } conversions { GtkStockId "GtkStock.conv" } class ToolButton wrap : ToolItem { "icon-widget" GtkWidget : Read / Write "label" gchararray : Read / Write "label-widget" GtkWidget : Read / Write "stock-id" GtkStockId : Read / Write "use-underline" gboolean : Read / Write signal clicked } class ToggleToolButton : ToolButton { signal toggled method set_active : "bool -> unit" method get_active : "bool" } class RadioToolButton : ToggleToolButton { "group" GtkRadioToolButton_opt : Write } classes { GtkMenu "menu obj" } class MenuToolButton : ToolButton { "menu" GtkMenu : Read / Write (* signal show-menu *) method set_arrow_tooltip : "[>`tooltips] obj -> string -> string -> unit" } class Toolbar set wrapsig : Container { "orientation" GtkOrientation : Read / Write "toolbar-style" GtkToolbarStyle : Read / Write signal orientation_changed : GtkOrientation signal style_changed : GtkToolbarStyle (* API extended in GTK 2.4 *) "show-arrow" gboolean : Read / Write signal focus_home_or_end : bool -> bool signal move_focus : GtkDirectionType -> bool signal popup_context_menu : int int int -> bool } class LinkButton wrap : LinkButton { "uri" gchararray : Read / Write } (* Not tested yet. For Gtk 2.12. class ScaleButton wrap : ScaleButton { "adjustement" GtkAdjustment : Read / Write "icons" GStrv : Read / Write "size" GtkIconSize : Read / Write "value" gdouble : Read / Write signal popdown signal popup signal value_changed : float -> unit } *)lablgtk-2.18.8/src/gtkAssistant.props0000644000175000017500000000244513460263323016624 0ustar stephsteph(* $Id: gtkButton.props 1341 2007-06-07 22:19:31Z monate $ *) prefix "Gtk" header { open Gtk } classes { GdkPixbuf "GdkPixbuf.pixbuf" } conversions { GtkAssistantPageType "GtkEnums.assistant_page_type_conv" } class Assistant wrapsig wrap : Window { signal apply signal cancel signal close signal leave signal prepare method get_current_page : "int" method set_current_page : "int->unit" method get_n_pages : "int" method get_nth_page : "int -> widget obj" method insert_page : "widget obj -> int -> int" method set_page_type : "widget obj -> GtkEnums.assistant_page_type -> unit" method get_page_type : "widget obj -> GtkEnums.assistant_page_type" method set_page_title : "widget obj -> string -> unit" method get_page_title : "widget obj -> string" method set_page_header_image : "widget obj -> GdkPixbuf.pixbuf -> unit" method get_page_header_image : "widget obj -> GdkPixbuf.pixbuf" method set_page_side_image :"widget obj -> GdkPixbuf.pixbuf -> unit" method get_page_side_image : "widget obj -> GdkPixbuf.pixbuf" method set_page_complete : "widget obj -> bool -> unit" method get_page_complete : "widget obj -> bool" method add_action_widget : "widget obj -> unit" method remove_action_widget : "widget obj -> unit" method update_buttons_state : "unit" } lablgtk-2.18.8/src/gTree.ml0000644000175000017500000007427713460263323014474 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject open Gtk open GtkBase open GtkTree open OgtkBaseProps open OgtkTreeProps open GObj open GContainer (* New GtkTreeView/Model framework *) type 'a column = {index: int; conv: 'a data_conv; creator: int} class column_list = object (self) val mutable index = 0 val mutable types = [] val mutable locked = false method types = List.rev types method add : 'a. 'a data_conv -> 'a column = fun conv -> if locked then failwith "GTree.column_list#add"; let n = index in types <- Data.get_type conv :: types; index <- index + 1; {index = n; conv = conv; creator = Oo.id self} method id = Oo.id self method lock () = locked <- true end class row_reference rr ~model = object (self) method as_ref = rr method path = RowReference.get_path rr method valid = RowReference.valid rr method iter = TreeModel.get_iter model self#path end class model_signals obj = object inherit ['a] gobject_signals obj inherit tree_model_sigs end let model_ids = Hashtbl.create 7 let custom_model_ids = Hashtbl.create 7 class model obj = object (self) val id = try Hashtbl.find model_ids (Gobject.get_oid obj) with Not_found -> 0 val obj = obj method as_model = (obj :> tree_model) method coerce = (self :> model) method misc = new gobject_ops obj method flags = TreeModel.get_flags obj method n_columns = TreeModel.get_n_columns obj method get_column_type = TreeModel.get_column_type obj method get_iter = TreeModel.get_iter obj method get_path = TreeModel.get_path obj method get_row_reference path = new row_reference (RowReference.create obj path) obj method get : 'a. row:tree_iter -> column:'a column -> 'a = fun ~row ~column -> if column.creator <> id then invalid_arg "GTree.model#get: bad column"; (* Prevent a class derived from an ancestor of a custom model from calling get: this would be unsound. *) if not (Gobject.is_a obj "Custom_model") && Hashtbl.mem custom_model_ids id then invalid_arg "GTree.model#get: embedded custom model for iterator. Please use model#get_path then custom_model#custom_get_iter."; let v = Value.create_empty () in TreeModel.get_value obj ~row ~column:column.index v; Data.of_value column.conv v method get_iter_first = TreeModel.get_iter_first obj method iter_next = TreeModel.iter_next obj method iter_has_child = TreeModel.iter_has_child obj method iter_n_children = TreeModel.iter_n_children obj method iter_children = TreeModel.iter_children obj method iter_parent = TreeModel.iter_parent obj method foreach = TreeModel.foreach obj method row_changed = TreeModel.row_changed obj end class tree_sortable_signals obj = object inherit model_signals obj inherit tree_sortable_sigs end class tree_sortable obj = object inherit model obj method connect = new tree_sortable_signals obj method sort_column_changed () = GtkTree.TreeSortable.sort_column_changed obj method get_sort_column_id = GtkTree.TreeSortable.get_sort_column_id obj method set_sort_column_id = GtkTree.TreeSortable.set_sort_column_id obj method set_sort_func id cmp = GtkTree.TreeSortable.set_sort_func obj id (fun m it_a it_b -> cmp (new model m) it_a it_b) method set_default_sort_func cmp = GtkTree.TreeSortable.set_default_sort_func obj (fun m it_a it_b -> cmp (new model m) it_a it_b) method has_default_sort_func = GtkTree.TreeSortable.has_default_sort_func obj end let default_sort_column_id = -1 let unsorted_sort_column_id = -2 class tree_store obj = object inherit tree_sortable obj method set : 'a. row:tree_iter -> column:'a column -> 'a -> unit = fun ~row ~column data -> if column.creator <> id then invalid_arg "GTree.tree_store#set: bad column"; TreeStore.set_value obj ~row ~column:column.index (Data.to_value column.conv data) method remove = TreeStore.remove obj method insert = TreeStore.insert obj method insert_before = TreeStore.insert_before obj method insert_after = TreeStore.insert_after obj method append = TreeStore.append obj method prepend = TreeStore.prepend obj method is_ancestor = TreeStore.is_ancestor obj method iter_depth = TreeStore.iter_depth obj method clear () = TreeStore.clear obj method iter_is_valid = TreeStore.iter_is_valid obj method swap = TreeStore.swap obj method move_before = TreeStore.move_before obj method move_after = TreeStore.move_after obj end let tree_store (cols : column_list) = cols#lock (); let store = TreeStore.create (Array.of_list cols#types) in Hashtbl.add model_ids(Gobject.get_oid store) cols#id; new tree_store store class list_store obj = object inherit tree_sortable obj method set : 'a. row:tree_iter -> column:'a column -> 'a -> unit = fun ~row ~column data -> if column.creator <> id then invalid_arg "GTree.list_store#set: bad column"; ListStore.set_value obj ~row ~column:column.index (Data.to_value column.conv data) method remove = ListStore.remove obj method insert = ListStore.insert obj method insert_before = ListStore.insert_before obj method insert_after = ListStore.insert_after obj method append = ListStore.append obj method prepend = ListStore.prepend obj method clear () = ListStore.clear obj method iter_is_valid = ListStore.iter_is_valid obj method swap = ListStore.swap obj method move_before = ListStore.move_before obj method move_after = ListStore.move_after obj end let list_store (cols : column_list) = cols#lock (); let store = ListStore.create (Array.of_list cols#types) in Hashtbl.add model_ids (Gobject.get_oid store) cols#id; new list_store store let store_of_list conv data = let cols = new column_list in let column = cols#add conv in let store = list_store cols in List.iter (fun d -> let row = store#append () in store#set ~row ~column d) data ; store, column class model_sort (obj : Gtk.tree_model_sort) = object inherit tree_sortable obj method model = new model (Gobject.get GtkTree.TreeModelSort.P.model obj) method convert_child_path_to_path = GtkTree.TreeModelSort.convert_child_path_to_path obj method convert_child_iter_to_iter = GtkTree.TreeModelSort.convert_child_iter_to_iter obj method convert_path_to_child_path = GtkTree.TreeModelSort.convert_path_to_child_path obj method convert_iter_to_child_iter = GtkTree.TreeModelSort.convert_iter_to_child_iter obj method reset_default_sort_func () = GtkTree.TreeModelSort.reset_default_sort_func obj method iter_is_valid = GtkTree.TreeModelSort.iter_is_valid obj end let model_sort model = let child_model = model#as_model in let child_oid = Gobject.get_oid child_model in let o = GtkTree.TreeModelSort.create ~model:child_model [] in begin try let child_id = Hashtbl.find model_ids child_oid in Hashtbl.add model_ids (Gobject.get_oid o) child_id with Not_found -> () end ; new model_sort o class model_filter (obj : Gtk.tree_model_filter) = object inherit model obj method connect = new model_signals obj method child_model = new model (Gobject.get GtkTree.TreeModelFilter.P.child_model obj) method virtual_root = Gobject.get GtkTree.TreeModelFilter.P.virtual_root obj method set_visible_func f = GtkTree.TreeModelFilter.set_visible_func obj (fun o it -> f (new model o) it) method set_visible_column (c : bool column) = GtkTree.TreeModelFilter.set_visible_column obj c.index method convert_child_path_to_path = GtkTree.TreeModelFilter.convert_child_path_to_path obj method convert_child_iter_to_iter = GtkTree.TreeModelFilter.convert_child_iter_to_iter obj method convert_path_to_child_path = GtkTree.TreeModelFilter.convert_path_to_child_path obj method convert_iter_to_child_iter = GtkTree.TreeModelFilter.convert_iter_to_child_iter obj method refilter () = GtkTree.TreeModelFilter.refilter obj end let model_filter ?virtual_root model = let child_model = model#as_model in let child_oid = Gobject.get_oid child_model in let o = GtkTree.TreeModelFilter.create ~child_model ?virtual_root [] in begin try let child_id = Hashtbl.find model_ids child_oid in Hashtbl.add model_ids (Gobject.get_oid o) child_id; with Not_found -> () end ; new model_filter o module Path = TreePath (* open GTree.Data;; let cols = new GTree.column_list ;; let title = cols#add string;; let author = cols#add string;; let checked = cols#add boolean;; let store = new GTree.tree_store cols;; *) class type cell_renderer = object method as_renderer : Gtk.cell_renderer obj end class cell_layout obj = object method pack : 'a. ?expand:bool -> ?from:Tags.pack_type -> (#cell_renderer as 'a) -> unit = fun ?expand ?from crr -> GtkTree.CellLayout.pack obj ?expand ?from crr#as_renderer method reorder : 'a. (#cell_renderer as 'a) -> int -> unit = fun crr pos -> GtkTree.CellLayout.reorder obj crr#as_renderer pos method clear () = GtkTree.CellLayout.clear obj method add_attribute : 'a 'b. (#cell_renderer as 'a) -> string -> 'b column -> unit = fun crr attr col -> GtkTree.CellLayout.add_attribute obj crr#as_renderer attr col.index method set_cell_data_func : 'a. (#cell_renderer as 'a) -> (model -> Gtk.tree_iter -> unit) -> unit = fun crr cb -> GtkTree.CellLayout.set_cell_data_func obj crr#as_renderer (Some (fun m i -> cb (new model m) i)) method unset_cell_data_func : 'a. (#cell_renderer as 'a) -> unit = fun crr -> GtkTree.CellLayout.set_cell_data_func obj crr#as_renderer None method clear_attributes : 'a. (#cell_renderer as 'a) -> unit = fun crr -> GtkTree.CellLayout.clear_attributes obj crr#as_renderer end class view_column_signals obj = object (self) inherit gtkobj_signals_impl obj method clicked = self#connect TreeViewColumn.S.clicked end module P = TreeViewColumn.P class view_column (_obj : tree_view_column obj) = object inherit GObj.gtkobj _obj method private obj = _obj inherit tree_view_column_props method as_column = obj method misc = new gobject_ops obj method connect = new view_column_signals obj (* in GTK 2.4 this will be in GtkCellLayout interface *) (* inherit cell_layout _obj *) method clear () = TreeViewColumn.clear obj method reorder : 'a. (#cell_renderer as 'a) -> int -> unit = fun crr pos -> GtkTree.CellLayout.reorder obj crr#as_renderer pos method pack : 'a. ?expand:_ -> ?from:_ -> (#cell_renderer as 'a)-> _ = fun ?expand ?from r -> TreeViewColumn.pack obj ?expand ?from r#as_renderer method add_attribute : 'a 'b. (#cell_renderer as 'a) -> string -> 'b column -> unit = fun crr attr col -> TreeViewColumn.add_attribute obj crr#as_renderer attr col.index method clear_attributes : 'a. (#cell_renderer as 'a) -> unit = fun crr -> TreeViewColumn.clear_attributes obj crr#as_renderer method set_sort_column_id = TreeViewColumn.set_sort_column_id obj method get_sort_column_id = TreeViewColumn.get_sort_column_id obj method set_cell_data_func : 'a. (#cell_renderer as 'a) -> (model -> Gtk.tree_iter -> unit) -> unit = fun crr cb -> TreeViewColumn.set_cell_data_func obj crr#as_renderer (Some (fun m i -> cb (new model m) i)) method unset_cell_data_func : 'a. (#cell_renderer as 'a) -> unit = fun crr -> TreeViewColumn.set_cell_data_func obj crr#as_renderer None end let view_column ?title ?renderer () = let w = new view_column (TreeViewColumn.create []) in may title ~f:w#set_title; may renderer ~f: begin fun (crr, l) -> w#pack crr; List.iter l ~f: (fun (attr,col) -> w#add_attribute crr attr col) end; w let as_column (col : view_column) = col#as_column class selection_signals (obj : tree_selection) = object (self) inherit ['a] gobject_signals obj method changed = self#connect TreeSelection.S.changed end class selection obj = object val obj = obj method connect = new selection_signals obj method misc = new gobject_ops obj method set_mode = TreeSelection.set_mode obj method get_mode = TreeSelection.get_mode obj method set_select_function = TreeSelection.set_select_function obj method get_selected_rows = TreeSelection.get_selected_rows obj method count_selected_rows = TreeSelection.count_selected_rows obj method select_path = TreeSelection.select_path obj method unselect_path = TreeSelection.unselect_path obj method path_is_selected = TreeSelection.path_is_selected obj method select_iter = TreeSelection.select_iter obj method unselect_iter = TreeSelection.unselect_iter obj method iter_is_selected = TreeSelection.iter_is_selected obj method select_all () = TreeSelection.select_all obj method unselect_all () = TreeSelection.unselect_all obj method select_range = TreeSelection.select_range obj method unselect_range = TreeSelection.unselect_range obj end class view_signals obj = object (self) inherit container_signals_impl obj inherit tree_view_sigs method row_activated ~callback = self#connect TreeView.S.row_activated ~callback:(fun it vc -> callback it (new view_column vc)) end open TreeView.P class view obj = object inherit [Gtk.tree_view] GContainer.container_impl obj inherit tree_view_props method as_tree_view = (obj :> Gtk.tree_view Gtk.obj) method connect = new view_signals obj method event = new GObj.event_ops obj method selection = new selection (TreeView.get_selection obj) method expander_column = may_map (new view_column) (get expander_column obj) method set_expander_column c = set expander_column obj (may_map as_column c) method model = new model (Property.get_some obj model) method set_model m = set model obj (may_map (fun (m:model) -> m#as_model) m) method append_column col = TreeView.append_column obj (as_column col) method remove_column col = TreeView.remove_column obj (as_column col) method insert_column col = TreeView.insert_column obj (as_column col) method get_column n = new view_column (TreeView.get_column obj n) method move_column col ~after = TreeView.move_column_after obj (as_column col) (as_column after) method scroll_to_point = TreeView.scroll_to_point obj method scroll_to_cell ?align path col = TreeView.scroll_to_cell obj ?align path (as_column col) method row_activated path col = TreeView.row_activated obj path (as_column col) method expand_all () = TreeView.expand_all obj method collapse_all () = TreeView.collapse_all obj method expand_row ?(all=false) = TreeView.expand_row obj ~all method expand_to_path = TreeView.expand_to_path obj method collapse_row = TreeView.collapse_row obj method row_expanded = TreeView.row_expanded obj method set_cursor : 'a. ?cell:(#cell_renderer as 'a) -> _ = fun ?cell ?(edit=false) row col -> match cell with None -> TreeView.set_cursor obj ~edit row (as_column col) | Some cell -> TreeView.set_cursor_on_cell obj ~edit row (as_column col) cell#as_renderer method get_cursor () = match TreeView.get_cursor obj with path, Some vc -> path, Some (new view_column vc) | _, None as pair -> pair method get_path_at_pos ~x ~y = match TreeView.get_path_at_pos obj ~x ~y with Some (p, c, x, y) -> Some (p, new view_column c, x, y) | None -> None method get_cell_area ?path ?col () = TreeView.get_cell_area obj ?path ?col:(Gaux.may_map as_column col) () method get_visible_range () = TreeView.get_visible_range obj method set_row_separator_func fo = TreeView.set_row_separator_func obj (Gaux.may_map (fun f m -> f (new model m)) fo) end let view ?model ?hadjustment ?vadjustment = let model = may_map (fun m -> m#as_model) model in let hadjustment = may_map GData.as_adjustment hadjustment in let vadjustment = may_map GData.as_adjustment vadjustment in TreeView.make_params [] ?model ?hadjustment ?vadjustment ~cont:( GContainer.pack_container ~create:(fun p -> new view (TreeView.create p))) type cell_properties = [ `CELL_BACKGROUND of string | `CELL_BACKGROUND_GDK of Gdk.color | `CELL_BACKGROUND_SET of bool | `HEIGHT of int | `IS_EXPANDED of bool | `IS_EXPANDER of bool | `MODE of Tags.cell_renderer_mode | `VISIBLE of bool | `WIDTH of int | `XALIGN of float | `XPAD of int | `YALIGN of float | `YPAD of int ] type cell_properties_pixbuf_only = [ `PIXBUF of GdkPixbuf.pixbuf | `PIXBUF_EXPANDER_CLOSED of GdkPixbuf.pixbuf | `PIXBUF_EXPANDER_OPEN of GdkPixbuf.pixbuf | `STOCK_DETAIL of string | `STOCK_ID of string | `STOCK_SIZE of Gtk.Tags.icon_size ] type cell_properties_pixbuf = [ cell_properties | cell_properties_pixbuf_only ] type cell_properties_text_only = [ `BACKGROUND of string | `BACKGROUND_GDK of Gdk.color | `BACKGROUND_SET of bool | `EDITABLE of bool | `FAMILY of string | `FONT of string | `FONT_DESC of Pango.font_description | `FOREGROUND of string | `FOREGROUND_GDK of Gdk.color | `FOREGROUND_SET of bool | `MARKUP of string | `RISE of int | `SINGLE_PARAGRAPH_MODE of bool | `SIZE of int | `SIZE_POINTS of float | `STRETCH of Pango.Tags.stretch | `STRIKETHROUGH of bool | `STYLE of Pango.Tags.style | `TEXT of string | `UNDERLINE of Pango.Tags.underline | `VARIANT of Pango.Tags.variant ] type cell_properties_text = [ cell_properties | cell_properties_text_only | `SCALE of Pango.Tags.scale | `WEIGHT of Pango.Tags.weight ] type cell_properties_toggle_only = [ `ACTIVATABLE of bool | `ACTIVE of bool | `INCONSISTENT of bool | `RADIO of bool ] type cell_properties_toggle = [ cell_properties | cell_properties_toggle_only ] type cell_properties_progress_only = [ `VALUE of int | `TEXT of string option ] type cell_properties_progress = [ cell_properties | cell_properties_progress_only ] type cell_properties_combo_only = [ `MODEL of model option | `TEXT_COLUMN of string column | `HAS_ENTRY of bool ] type cell_properties_combo = [ cell_properties_text | cell_properties_combo_only ] type cell_properties_accel_only = [ `KEY of int | `ACCEL_MODE of GtkEnums.cell_renderer_accel_mode | `MODS of GdkEnums.modifier list | `KEYCODE of int ] type cell_properties_accel = [ cell_properties_text | cell_properties_accel_only ] let cell_renderer_pixbuf_param' = function | #cell_properties_pixbuf_only as x -> cell_renderer_pixbuf_param x | #cell_properties as x -> cell_renderer_param x let cell_renderer_text_param' = function | `SCALE s -> cell_renderer_text_param (`SCALE (Pango.Tags.scale_to_float s)) | `WEIGHT w -> cell_renderer_text_param(`WEIGHT (Pango.Tags.weight_to_int w)) | #cell_properties as x -> cell_renderer_param x | #cell_properties_text_only as x -> cell_renderer_text_param x let cell_renderer_toggle_param' = function | #cell_properties_toggle_only as x -> cell_renderer_toggle_param x | #cell_properties as x -> cell_renderer_param x let cell_renderer_progress_param' = function | #cell_properties_progress_only as x -> cell_renderer_progress_param x | #cell_properties as x -> cell_renderer_param x let cell_renderer_combo_param' = function | `MODEL None -> Gobject.param CellRendererCombo.P.model None | `MODEL (Some m : model option) -> Gobject.param CellRendererCombo.P.model (Some m#as_model) | `TEXT_COLUMN c -> Gobject.param CellRendererCombo.P.text_column c.index | `HAS_ENTRY b -> Gobject.param CellRendererCombo.P.has_entry b | #cell_properties_text as x -> cell_renderer_text_param' x let cell_renderer_accel_param' = function | `KEYCODE i -> Gobject.param CellRendererAccel.P.keycode i | `KEY i -> Gobject.param CellRendererAccel.P.accel_key i | `ACCEL_MODE m -> Gobject.param CellRendererAccel.P.accel_mode m | `MODS m -> Gobject.param CellRendererAccel.P.accel_mods (Gpointer.encode_flags GdkEnums.modifier m); | #cell_properties_text as x -> cell_renderer_text_param' x class type ['a, 'b] cell_renderer_skel = object inherit gtkobj val obj : 'a obj method as_renderer : Gtk.cell_renderer obj method get_property : ('a, 'c) property -> 'c method set_properties : 'b list -> unit end class virtual ['a,'b] cell_renderer_impl obj = object (self) inherit gtkobj obj method as_renderer = (obj :> Gtk.cell_renderer obj) method private virtual param : 'b -> 'a param method set_properties l = set_params obj (List.map ~f:self#param l) method get_property : 'c. ('a,'c) property -> 'c = Gobject.Property.get obj end class cell_renderer_pixbuf obj = object inherit [Gtk.cell_renderer_pixbuf,cell_properties_pixbuf] cell_renderer_impl obj method private param = cell_renderer_pixbuf_param' method connect = new gtkobj_signals_impl obj end class cell_renderer_text_signals obj = object (self) inherit gtkobj_signals_impl (obj : [>Gtk.cell_renderer_text] obj) method edited = self#connect CellRendererText.S.edited end class cell_renderer_text obj = object inherit [Gtk.cell_renderer_text,cell_properties_text] cell_renderer_impl obj method private param = cell_renderer_text_param' method set_fixed_height_from_font = CellRendererText.set_fixed_height_from_font obj method connect = new cell_renderer_text_signals obj end class cell_renderer_toggle_signals obj = object (self) inherit gtkobj_signals_impl (obj : Gtk.cell_renderer_toggle obj) method toggled = self#connect CellRendererToggle.S.toggled end class cell_renderer_toggle obj = object inherit [Gtk.cell_renderer_toggle,cell_properties_toggle] cell_renderer_impl obj method private param = cell_renderer_toggle_param' method connect = new cell_renderer_toggle_signals obj end class cell_renderer_progress obj = object inherit [Gtk.cell_renderer_progress,cell_properties_progress] cell_renderer_impl obj method private param = cell_renderer_progress_param' method connect = new gtkobj_signals_impl obj end class cell_renderer_combo_signals obj = object (self) inherit cell_renderer_text_signals obj method changed = self#connect CellRendererCombo.S.changed end class cell_renderer_combo obj = object inherit [Gtk.cell_renderer_combo,cell_properties_combo] cell_renderer_impl obj method private param = cell_renderer_combo_param' method set_fixed_height_from_font = CellRendererText.set_fixed_height_from_font obj method connect = new cell_renderer_combo_signals (obj :> Gtk.cell_renderer_combo Gtk.obj) end class cell_renderer_accel_signals (obj:Gtk.cell_renderer_accel Gtk.obj) = object(self) inherit gtkobj_signals_impl obj method edited = self#connect CellRendererText.S.edited method accel_edited = self#connect CellRendererAccel.S.accel_edited method accel_cleared = self#connect CellRendererAccel.S.accel_cleared end class cell_renderer_accel obj = object inherit [Gtk.cell_renderer_accel,cell_properties_accel] cell_renderer_impl obj method private param = cell_renderer_accel_param' method connect = new cell_renderer_accel_signals obj end let cell_renderer_pixbuf l = new cell_renderer_pixbuf (CellRendererPixbuf.create (List.map cell_renderer_pixbuf_param' l)) let cell_renderer_text l = new cell_renderer_text (CellRendererText.create (List.map cell_renderer_text_param' l)) let cell_renderer_toggle l = new cell_renderer_toggle (CellRendererToggle.create (List.map cell_renderer_toggle_param' l)) let cell_renderer_progress l = new cell_renderer_progress (CellRendererProgress.create (List.map cell_renderer_progress_param' l)) let cell_renderer_combo l = new cell_renderer_combo (CellRendererCombo.create (List.map cell_renderer_combo_param' l)) let cell_renderer_accel (l:cell_properties_accel list) = new cell_renderer_accel (CellRendererAccel.create (List.map cell_renderer_accel_param' l)) class icon_view_signals obj = object (self) inherit container_signals_impl obj inherit OgtkTreeProps.icon_view_sigs end class icon_view obj = object inherit [[> Gtk.icon_view]] GContainer.container_impl obj inherit OgtkTreeProps.icon_view_props method connect = new icon_view_signals obj method event = new GObj.event_ops obj method model = new model (Gobject.Property.get_some obj IconView.P.model) method set_model (m : model option) = Gobject.set IconView.P.model obj (Gaux.may_map (fun m -> m#as_model) m) method set_markup_column (c : string column) = Gobject.set IconView.P.markup_column obj c.index method set_text_column (c : string column) = Gobject.set IconView.P.text_column obj c.index method set_pixbuf_column (c : GdkPixbuf.pixbuf column) = Gobject.set IconView.P.pixbuf_column obj c.index method get_path_at_pos = IconView.get_path_at_pos obj method selected_foreach = IconView.selected_foreach obj method select_path = IconView.select_path obj method unselect_path = IconView.unselect_path obj method path_is_selected = IconView.path_is_selected obj method get_selected_items = IconView.get_selected_items obj method select_all () = IconView.select_all obj method unselect_all () = IconView.unselect_all obj method item_activated = IconView.item_activated obj end let icon_view ?model = let model = Gaux.may_map (fun m -> m#as_model) model in IconView.make_params ?model [] ~cont:( GContainer.pack_container ~create:(fun p -> new icon_view (IconView.create p))) (* Custom models *) class type virtual ['obj,'row,'a,'b,'c] custom_tree_model_type = object inherit model val obj : 'obj val n_columns : int val columns : Gobject.g_type array method custom_n_columns : int method custom_get_column_type : int -> Gobject.g_type method connect : model_signals (** Signal emitters *) method custom_row_changed : Gtk.tree_path -> 'row -> unit method custom_row_deleted : Gtk.tree_path -> unit method custom_row_has_child_toggled : Gtk.tree_path -> 'row -> unit method custom_row_inserted : Gtk.tree_path -> 'row -> unit method custom_rows_reordered : Gtk.tree_path -> 'row option -> int array -> unit method custom_unref_node : 'row -> unit method custom_ref_node : 'row -> unit method custom_flags : GtkEnums.tree_model_flags list method virtual custom_get_iter : Gtk.tree_path -> 'row option method virtual custom_get_path : 'row -> Gtk.tree_path method custom_get_value : 'row -> int -> Gobject.g_value -> unit method virtual custom_value : 'a. Gobject.g_type -> 'row -> column:int -> Gobject.basic method virtual custom_iter_children : 'row option -> 'row option method virtual custom_iter_has_child : 'row -> bool method virtual custom_iter_n_children : 'row option -> int method virtual custom_iter_next : 'row -> 'row option method virtual custom_iter_nth_child : 'row option -> int -> 'row option method virtual custom_iter_parent : 'row -> 'row option method virtual custom_decode_iter : 'a -> 'b -> 'c -> 'row method virtual custom_encode_iter : 'row -> 'a * 'b * 'c end class virtual ['row,'a,'b,'c] custom_tree_model (column_list:column_list) = let obj = (GtkTree.CustomModel.create ()) in object (self) inherit model obj method connect = new model_signals obj inherit ['row,'a,'b,'c] GtkTree.CustomModel.callback val n_columns = List.length column_list#types val columns = Array.of_list column_list#types method get ~row:_ ~column:_ = failwith "get not allowed on a custom model." method custom_n_columns = n_columns method custom_get_value (row:'row) (column:int) (value:Gobject.g_value) = Gobject.Value.init value (columns.(column)); if column >=0 && column failwith ("custom_value returned a value of incompatible type for column "^string_of_int column ^" of type "^ (Gobject.Type.name (Gobject.Value.get_type value))) else invalid_arg ("custom_get_value: invalid column id "^string_of_int column) method virtual custom_value : 'a. Gobject.g_type -> 'row -> column:int -> Gobject.basic method custom_get_column_type n : Gobject.g_type = if 0 <= n && n < n_columns then columns.(n) else Gobject.Type.of_fundamental `INVALID method custom_row_inserted path (iter:'row) = CustomModel.custom_row_inserted obj path iter method custom_row_changed path (iter:'row) = CustomModel.custom_row_changed obj path iter method custom_row_has_child_toggled path (iter:'row) = CustomModel.custom_row_has_child_toggled obj path iter method custom_row_deleted (path:Gtk.tree_path) = CustomModel.custom_row_deleted obj path method custom_rows_reordered path (iter_opt:'row option) new_order = CustomModel.custom_rows_reordered obj path iter_opt new_order method custom_flags : GtkEnums.tree_model_flags list = [] initializer GtkTree.CustomModel.register_callback obj self; column_list#lock (); let id = Gobject.get_oid obj in Hashtbl.add model_ids id column_list#id; Hashtbl.add custom_model_ids column_list#id (); (* Invalidate all iterators before dying...*) Gc.finalise (fun m -> m#foreach (fun p _ -> m#custom_row_deleted p; false)) self end lablgtk-2.18.8/src/gAction.ml0000644000175000017500000002341613460263323014777 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) external init : unit -> unit = "ml_gtkaction_init" let () = init () module GtkAction = GtkActionProps open GtkAction class action_signals obj = object inherit [[> Gtk.action]] GObj.gobject_signals obj inherit OgtkActionProps.action_sigs end class action_skel obj = object val obj = obj method private obj = obj inherit OgtkActionProps.action_props method as_action = (obj :> Gtk.action Gobject.obj) method activate () = Action.activate obj method is_sensitive = Action.is_sensitive obj method is_visible = Action.is_visible obj method connect_proxy w = Action.connect_proxy obj (GObj.as_widget w) method disconnect_proxy w = Action.disconnect_proxy obj (GObj.as_widget w) method get_proxies = List.map (new GObj.widget) (Action.get_proxies obj) method connect_accelerator () = Action.connect_accelerator obj method disconnect_accelerator () = Action.disconnect_accelerator obj method set_accel_path = Action.set_accel_path obj method set_accel_group = Action.set_accel_group obj method block_activate_from (w : GObj.widget) = Action.block_activate_from obj w#as_widget method unblock_activate_from (w : GObj.widget) = Action.unblock_activate_from obj w#as_widget end class action obj = object inherit action_skel obj method connect = new action_signals obj end let action ~name () = new action (Action.create ~name []) class toggle_action_signals obj = object inherit action_signals obj inherit OgtkActionProps.toggle_action_sigs end class toggle_action_skel obj = object inherit action_skel obj inherit OgtkActionProps.toggle_action_props method toggled () = ToggleAction.toggled obj method set_active = ToggleAction.set_active obj method get_active = ToggleAction.get_active obj end class toggle_action obj = object inherit toggle_action_skel obj method connect = new toggle_action_signals obj end let toggle_action ~name () = new toggle_action (ToggleAction.create [ Gobject.param Action.P.name name ]) class radio_action_signals obj = object inherit toggle_action_signals obj method changed ~callback = GtkSignal.connect ~sgn:RadioAction.S.changed ~callback:(fun o -> callback (RadioAction.get_current_value o)) ~after obj end class radio_action obj = object inherit toggle_action_skel obj inherit OgtkActionProps.radio_action_props method connect = new radio_action_signals obj method as_radio_action = (obj :> Gtk.radio_action Gobject.obj) method get_current_value = RadioAction.get_current_value obj end let radio_action ?group ~name ~value () = new radio_action (RadioAction.create (Gobject.Property.may_cons RadioAction.P.group (Gaux.may_map (fun g -> Some (g#as_radio_action)) group) [ Gobject.param Action.P.name name ; Gobject.param RadioAction.P.value value ])) class action_group_signals obj = object (self) inherit [[> Gtk.action_group]] GObj.gobject_signals obj method private virtual connect : 'b. ('a,'b) GtkSignal.t -> callback:'b -> GtkSignal.id method connect_proxy ~callback = self#connect {ActionGroup.S.connect_proxy with GtkSignal.marshaller = fun f -> GtkSignal.marshal2 (Gobject.Data.gobject : Gtk.action Gtk.obj Gobject.data_conv) GObj.conv_widget "GtkActionGroup::connect_proxy" f} (fun o -> callback (new action o)) method disconnect_proxy ~callback = self#connect {ActionGroup.S.disconnect_proxy with GtkSignal.marshaller = fun f -> GtkSignal.marshal2 (Gobject.Data.gobject : Gtk.action Gtk.obj Gobject.data_conv) GObj.conv_widget "GtkActionGroup::disconnect_proxy" f} (fun o -> callback (new action o)) method post_activate ~callback = self#connect ActionGroup.S.post_activate (fun o -> callback (new action o)) method pre_activate ~callback = self#connect ActionGroup.S.pre_activate (fun o -> callback (new action o)) end class action_group obj = object val obj = obj method private obj = obj inherit OgtkActionProps.action_group_props method as_group = (obj :> Gtk.action_group Gobject.obj) method connect = new action_group_signals obj method get_action n = new action (ActionGroup.get_action obj n) method list_actions = List.map (new action) (ActionGroup.list_actions obj) method add_action : 'a. (#action_skel as 'a) -> unit = fun a -> ActionGroup.add_action obj a#as_action method add_action_with_accel : 'a. ?accel:string -> (#action_skel as 'a) -> unit = fun ?accel a -> ActionGroup.add_action_with_accel obj a#as_action accel method remove_action : 'a. (#action_skel as 'a) -> unit = fun a -> ActionGroup.remove_action obj a#as_action end let action_group ~name () = new action_group (ActionGroup.create ~name []) type 'a entry = action_group -> 'a let add_single_action ret a ?stock ?label ?accel ?tooltip (group : #action_group) = Gaux.may a#set_label label ; Gaux.may a#set_tooltip tooltip ; Gaux.may a#set_stock_id stock ; group#add_action_with_accel ?accel a ; ret a let add_action name ?callback = let a = action ~name () in Gaux.may callback ~f:(fun cb -> a#connect#activate ~callback:(fun () -> cb a)) ; add_single_action ignore a let add_toggle_action name ?active ?callback = let a = toggle_action ~name () in Gaux.may a#set_active active ; Gaux.may callback ~f:(fun cb -> a#connect#activate ~callback:(fun () -> cb a)) ; add_single_action ignore a let add_radio_action name value = let a = radio_action ~name ~value () in add_single_action (fun a -> a) a let add_actions ac_group = List.iter (fun f -> let () = f ac_group in ()) let group_radio_actions ?init_value ?callback radio_action_entries ac_group = let last_radio_ac = List.fold_left (fun radio_grp f -> let radio_ac = f ac_group in radio_ac#set_group radio_grp ; Gaux.may (fun init_v -> radio_ac#set_active (radio_ac#value = init_v)) init_value ; Some radio_ac#as_radio_action) None radio_action_entries in Gaux.may (fun cb -> Gaux.may (fun o -> GtkSignal.connect ~sgn:RadioAction.S.changed ~callback:(fun curr -> cb (RadioAction.get_current_value curr)) o) last_radio_ac) callback ; () class ui_manager_signals obj = object (self) inherit [[> Gtk.ui_manager]] GObj.gobject_signals obj inherit OgtkActionProps.ui_manager_sigs method connect_proxy ~callback = self#connect {UIManager.S.connect_proxy with GtkSignal.marshaller = fun f -> GtkSignal.marshal2 (Gobject.Data.gobject : Gtk.action Gtk.obj Gobject.data_conv) GObj.conv_widget "GtkUIManager::connect_proxy" f} (fun o -> callback (new action o)) method disconnect_proxy ~callback = self#connect {UIManager.S.disconnect_proxy with GtkSignal.marshaller = fun f -> GtkSignal.marshal2 (Gobject.Data.gobject : Gtk.action Gtk.obj Gobject.data_conv) GObj.conv_widget "GtkUIManager::disconnect_proxy" f} (fun o -> callback (new action o)) method post_activate ~callback = self#connect UIManager.S.post_activate (fun o -> callback (new action o)) method pre_activate ~callback = self#connect UIManager.S.pre_activate (fun o -> callback (new action o)) end type ui_id = int let invalid_id = 0 class ui_manager obj = object val obj = obj method private obj = obj inherit OgtkActionProps.ui_manager_props method connect = new ui_manager_signals obj method as_ui_manager = (obj:> Gtk.ui_manager Gtk.obj) method insert_action_group (g : action_group) = UIManager.insert_action_group obj g#as_group method remove_action_group (g : action_group) = UIManager.remove_action_group obj g#as_group method get_action_groups = List.map (new action_group) (UIManager.get_action_groups obj) method get_accel_group = UIManager.get_accel_group obj method get_widget s = new GObj.widget (UIManager.get_widget obj s) method get_toplevels kind = List.map (new GObj.widget) (UIManager.get_toplevels obj kind) method get_action s = new action (UIManager.get_action obj s) method add_ui_from_string = UIManager.add_ui_from_string obj method add_ui_from_file = UIManager.add_ui_from_file obj method new_merge_id () = UIManager.new_merge_id obj method add_ui = UIManager.add_ui obj method remove_ui = UIManager.remove_ui obj method ensure_update () = UIManager.ensure_update obj end let ui_manager () = new ui_manager (UIManager.create []) lablgtk-2.18.8/src/gSourceView.mli0000644000175000017500000002752413460263323016032 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (** {2 GtkSourceView interface} *) open Gtk open GText (** {2 GtkSourceTag} *) type source_tag_property = [ | `BACKGROUND of Gdk.color | `BOLD of bool | `FOREGROUND of Gdk.color | `ITALIC of bool | `STRIKETHROUGH of bool | `UNDERLINE of bool ] class source_tag_style : GtkSourceView_types.source_tag_style obj -> object method as_source_tag_style : GtkSourceView_types.source_tag_style Gtk.obj method copy : source_tag_style method background : Gdk.color method bold : bool method foreground : Gdk.color method italic : bool method strikethrough : bool method underline : bool method use_background : bool method use_foreground : bool method set_background : Gdk.color -> unit method set_background_by_name : string -> unit method set_bold : bool -> unit method set_foreground : Gdk.color -> unit method set_foreground_by_name : string -> unit method set_italic : bool -> unit method set_strikethrough : bool -> unit method set_underline : bool -> unit method set_use_background : bool -> unit method set_use_foreground : bool -> unit end val source_tag_style : ?background:Gdk.color -> ?background_by_name:string -> ?bold:bool -> ?foreground:Gdk.color -> ?foreground_by_name:string -> ?italic:bool -> ?strikethrough:bool -> ?underline:bool -> unit -> source_tag_style type source_tag_id = string class source_tag : GtkSourceView_types.source_tag obj -> object inherit GText.tag method as_source_tag : GtkSourceView_types.source_tag obj method id : source_tag_id method style : source_tag_style method set_style : source_tag_style -> unit method set_source_properties : source_tag_property list -> unit method set_source_property : source_tag_property -> unit end val syntax_tag : id:string -> name:string -> pat_start:string -> pat_end:string -> source_tag val pattern_tag : id:string -> name:string -> pat:string -> source_tag val keyword_list_tag : id:string -> name:string -> keywords:string list -> ?case_sensitive:bool -> ?match_empty_string_at_beginning:bool -> ?match_empty_string_at_end:bool -> ?beginning_regex:string -> ?end_regex:string -> unit -> source_tag val block_comment_tag : id:string -> name:string -> pat_start:string -> pat_end:string -> source_tag val line_comment_tag : id:string -> name:string -> pat_start:string -> source_tag val string_tag : id:string -> name:string -> pat_start:string -> pat_end:string -> end_at_line_end:bool -> source_tag (** {2 GtkSourceTagTable} *) class source_tag_table_signals: ([> GtkSourceView_types.source_tag_table] as 'b) obj -> object('a) inherit GText.tag_table_signals method changed : callback:(unit -> unit) -> GtkSignal.id end class source_tag_table: GtkSourceView_types.source_tag_table obj -> object inherit GText.tag_table_skel method as_source_tag_table : [`sourcetagtable] obj method connect: source_tag_table_signals method misc: GObj.gobject_ops method remove_source_tags : unit -> unit method add_tags : source_tag list -> unit end val source_tag_table : unit -> source_tag_table (** {2 GtkSourceStyleScheme} *) class source_style_scheme : GtkSourceView_types.source_style_scheme obj -> object method as_source_style_scheme : GtkSourceView_types.source_style_scheme obj method get_name : string (** @raise Not_found if the specified tag does not exist. *) method get_tag_style : string -> source_tag_style end val default_style_scheme : unit -> source_style_scheme (** {2 GtkSourceLanguage} *) class source_language_signals: ([> GtkSourceView_types.source_language ] as 'b) obj -> object ('a) inherit ['b] GObj.gobject_signals method tag_style_changed: callback:(string -> unit) -> GtkSignal.id end class source_language: GtkSourceView_types.source_language obj -> object method as_source_language: GtkSourceView_types.source_language obj method connect: source_language_signals method get_escape_char: Glib.unichar method get_name: string method get_section: string method get_style_scheme: source_style_scheme method set_style_scheme: source_style_scheme -> unit method get_tags: source_tag list method get_tag_default_style: source_tag_id -> source_tag_style method get_tag_style: source_tag_id -> source_tag_style method set_tag_style: source_tag_id -> source_tag_style -> unit method misc: GObj.gobject_ops end (** {2 GtkSourceLanguagesManager} *) class source_languages_manager: GtkSourceView_types.source_languages_manager obj -> object method get_oid: int method get_available_languages: source_language list method as_source_languages_manager: GtkSourceView_types.source_languages_manager obj method get_language_from_mime_type: string -> source_language option method lang_files_dirs: string list end val source_languages_manager: (* ?lang_files_dirs:string list -> *) unit -> source_languages_manager val source_language_from_file: ?languages_manager:source_languages_manager -> string -> source_language option (** {2 GtkSourceMarker} *) class source_marker : GtkSourceView_types.source_marker Gtk.obj -> object method as_source_marker : GtkSourceView_types.source_marker Gtk.obj method get_buffer : source_buffer method get_line : int method get_name : string method get_type : string method next : source_marker method prev : source_marker method set_type : string -> unit end (** {2 GtkSourceBuffer} *) and source_buffer_signals: (GtkSourceView_types.source_buffer as 'b) obj -> object ('a) inherit ['b] GText.buffer_signals_type method changed : callback:(unit -> unit) -> GtkSignal.id method can_redo: callback:(bool -> unit) -> GtkSignal.id method can_undo: callback:(bool -> unit) -> GtkSignal.id method highlight_updated: callback:(Gtk.text_iter -> Gtk.text_iter -> unit) -> GtkSignal.id method marker_updated: callback:(Gtk.text_iter -> unit) -> GtkSignal.id end and source_buffer: GtkSourceView_types.source_buffer obj -> object inherit GText.buffer_skel method as_source_buffer: GtkSourceView_types.source_buffer obj method connect: source_buffer_signals method misc: GObj.gobject_ops method check_brackets: bool method set_check_brackets: bool -> unit method set_bracket_match_style: source_tag_style -> unit method highlight: bool method set_highlight: bool -> unit method max_undo_levels: int method set_max_undo_levels: int -> unit method language: source_language option method set_language: source_language -> unit method escape_char: Glib.unichar method set_escape_char: Glib.unichar -> unit method can_undo: bool method can_redo: bool method undo: unit -> unit method redo: unit -> unit method begin_not_undoable_action: unit -> unit method end_not_undoable_action: unit -> unit method create_marker: ?name:string -> ?typ:string -> GText.iter -> source_marker method move_marker: source_marker -> GText.iter -> unit method delete_marker: source_marker -> unit (** @raise Not_found if the marker does not exist. *) method get_marker: string -> source_marker method get_markers_in_region: start:GText.iter -> stop:GText.iter -> source_marker list method get_first_marker: source_marker option method get_last_marker: source_marker option method get_iter_at_marker: source_marker -> GText.iter method get_next_marker: GText.iter -> source_marker option method get_prev_marker: GText.iter -> source_marker option method source_tag_table : source_tag_table end val source_buffer: ?language:source_language -> ?tag_table:source_tag_table -> ?text:string -> ?check_brackets:bool -> ?escape_char:int -> ?highlight:bool -> ?max_undo_levels:int -> unit -> source_buffer (** {2 GtkSourceView} *) class source_view_signals: ([> GtkSourceView_types.source_view ] as 'b) obj -> object ('a) inherit GText.view_signals method redo: callback:(unit -> unit) -> GtkSignal.id method undo: callback:(unit -> unit) -> GtkSignal.id end class source_view: GtkSourceView_types.source_view obj -> object inherit GText.view_skel val obj: GtkSourceView_types.source_view obj method connect: source_view_signals method source_buffer: source_buffer method set_show_line_numbers: bool -> unit method show_line_numbers: bool method set_show_line_markers: bool -> unit method show_line_markers: bool method set_highlight_current_line: bool -> unit method highlight_current_line: bool method set_tabs_width: int -> unit method tabs_width: int method set_auto_indent: bool -> unit method auto_indent: bool method set_insert_spaces_instead_of_tabs: bool -> unit method insert_spaces_instead_of_tabs: bool method set_show_margin: bool -> unit method show_margin: bool method set_margin: int -> unit method margin: int method set_marker_pixbuf: string -> GdkPixbuf.pixbuf -> unit method marker_pixbuf: string -> GdkPixbuf.pixbuf method set_smart_home_end: bool -> unit method smart_home_end: bool method set_cursor_color: Gdk.color -> unit method set_cursor_color_by_name: string -> unit end val source_view: ?source_buffer:source_buffer -> ?auto_indent:bool -> ?highlight_current_line:bool -> ?insert_spaces_instead_of_tabs:bool -> ?margin:int -> ?show_line_markers:bool -> ?show_line_numbers:bool -> ?show_margin:bool -> ?smart_home_end:bool -> ?tabs_width:int -> ?editable:bool -> ?cursor_visible:bool -> ?justification:GtkEnums.justification -> ?wrap_mode:GtkEnums.wrap_mode -> ?accepts_tab:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> source_view (** {2 Misc} *) val find_matching_bracket: GText.iter -> GText.iter option val iter_forward_search : GText.iter -> SourceViewEnums.source_search_flag list -> start:< as_iter : Gtk.text_iter; .. > -> stop:< as_iter : Gtk.text_iter; .. > -> ?limit:< as_iter : Gtk.text_iter; .. > -> string -> (GText.iter * GText.iter) option val iter_backward_search : GText.iter -> SourceViewEnums.source_search_flag list -> start:< as_iter : Gtk.text_iter; .. > -> stop:< as_iter : Gtk.text_iter; .. > -> ?limit:< as_iter : Gtk.text_iter; .. > -> string -> (GText.iter * GText.iter) option lablgtk-2.18.8/src/gtkgl_tags.var0000644000175000017500000000046313460263323015716 0ustar stephsteph(* $Id$ *) (* package "glGtk" *) type visual_options = "GDK_GL_" [ | `USE_GL | `BUFFER_SIZE | `LEVEL | `RGBA | `DOUBLEBUFFER | `STEREO | `AUX_BUFFERS | `RED_SIZE | `GREEN_SIZE | `BLUE_SIZE | `ALPHA_SIZE | `DEPTH_SIZE | `STENCIL_SIZE | `ACCUM_GREEN_SIZE | `ACCUM_ALPHA_SIZE ] lablgtk-2.18.8/src/ml_pango.h0000644000175000017500000000507413460263323015026 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include "pango_tags.h" #define PangoFontDescription_val(val) ((PangoFontDescription*)Pointer_val(val)) CAMLexport value Val_PangoFontDescription_new(PangoFontDescription* it); #define Val_PangoFontDescription(desc) \ (Val_PangoFontDescription_new(pango_font_description_copy(desc))) CAMLexport value ml_PangoStyle_Val (value val); #define Val_PangoLanguage Val_pointer #define PangoLanguage_val Pointer_val #define PangoContext_val(val) check_cast(PANGO_CONTEXT,val) #define Val_PangoContext Val_GAnyObject #define Val_PangoContext_new Val_GAnyObject_new #define PangoFont_val(val) check_cast(PANGO_FONT, val) #define Val_PangoFont Val_GAnyObject #define PangoFontMetrics_val(val) ((PangoFontMetrics*)Pointer_val(val)) #define PangoLayout_val(val) check_cast(PANGO_LAYOUT, val) #define Val_PangoLayout Val_GAnyObject #define PangoFontMap_val(val) check_cast(PANGO_FONT_MAP, val) #define Val_PangoFontMap Val_GAnyObject CAMLexport value Val_PangoRectangle(PangoRectangle *rect); lablgtk-2.18.8/src/rsvg.mli0000644000175000017500000000455213460263323014545 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** librsvg bindings *) type size_fun = int -> int -> int * int val at_size : int -> int -> size_fun val at_zoom : float -> float -> size_fun val at_max_size : int -> int -> size_fun val at_zoom_with_max : float -> float -> int -> int -> size_fun val set_default_dpi : float -> unit (** @raise Error if an error occurs loading data *) (** @raise Sys_error if an error occurs while reading from the channel *) val render_from_string : ?gz:bool -> ?dpi:float -> ?size_cb:size_fun -> ?pos:int -> ?len:int -> string -> GdkPixbuf.pixbuf (** @raise Error if an error occurs loading data *) (** @raise Sys_error if an error occurs while reading from the file *) val render_from_file : ?gz:bool -> ?dpi:float -> ?size_cb:size_fun -> string -> GdkPixbuf.pixbuf lablgtk-2.18.8/src/gToolbox.ml0000644000175000017500000003044513460263323015210 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (** Menus *) type menu_entry = [ `I of string * (unit -> unit) | `C of string * bool * (bool -> unit) | `R of (string * bool * (bool -> unit)) list | `M of string * menu_entry list | `S ] let rec build_menu menu ~(entries : menu_entry list) = let f = new GMenu.factory menu in List.iter entries ~f: begin function | `I (label, callback) -> ignore (f#add_item label ~callback) | `C (label, active, callback) -> ignore (f#add_check_item label ~callback ~active) | `R ((label, active, callback) :: l) -> let r = f#add_radio_item label ~active ~callback in let group = r#group in List.iter l ~f: (fun (label, active, callback) -> ignore (f#add_radio_item label ~active ~callback ~group)) | `R [] -> () | `M (label, entries) -> let m = f#add_submenu label in build_menu m ~entries | `S -> ignore (f#add_separator ()) end let popup_menu ~entries = let menu = GMenu.menu () in build_menu menu ~entries; fun ~button ~time -> if entries = [] then () else menu#popup ~button ~time (** Dialogs *) let mOk = "Ok" let mCancel = "Cancel" let question_box ?parent ~title ~buttons ?(default=1) ?icon message = let button_nb = ref 0 in let destroy_with_parent = Gaux.may_map ~f:(fun _ -> true) parent in let window = GWindow.dialog ?parent ?destroy_with_parent ~modal:true ~title () in let hbox = GPack.hbox ~border_width:10 ~packing:window#vbox#add () in let bbox = window#action_area in begin match icon with None -> () | Some i -> hbox#pack i#coerce ~padding:4 end; ignore (GMisc.label ~text: message ~packing: hbox#add ()); (* the function called to create each button by iterating *) let rec iter_buttons n = function [] -> () | button_label :: q -> let b = GButton.button ~label: button_label ~packing:(bbox#pack ~expand:true ~padding:4) () in b#connect#clicked ~callback: (fun () -> button_nb := n; window#destroy ()); (* If it's the first button then give it the focus *) if n = default then b#grab_default () else (); iter_buttons (n+1) q in iter_buttons 1 buttons; window#connect#destroy ~callback: GMain.Main.quit; window#set_position `CENTER; window#show (); GMain.Main.main (); !button_nb let message_box ?parent ~title ?icon ?(ok=mOk) message = ignore (question_box ?parent ?icon ~title message ~buttons:[ ok ]) let input_widget ?parent ~widget ~event ~get_text ~bind_ok ~expand ~title ?(ok=mOk) ?(cancel=mCancel) message = let retour = ref None in let destroy_with_parent = Gaux.may_map ~f:(fun _ -> true) parent in let window = GWindow.dialog ?parent ?destroy_with_parent ~title ~modal:true () in window#connect#destroy ~callback: GMain.Main.quit; let main_box = window#vbox in let hbox_boutons = window#action_area in let vbox_saisie = GPack.vbox ~packing: (main_box#pack ~expand: true) () in ignore (GMisc.label ~text:message ~packing:(vbox_saisie#pack ~padding:3) ()); vbox_saisie#pack widget ~expand ~padding: 3; let wb_ok = GButton.button ~label: ok ~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in wb_ok#grab_default (); let wb_cancel = GButton.button ~label: cancel ~packing: (hbox_boutons#pack ~expand: true ~padding: 3) () in let f_ok () = retour := Some (get_text ()) ; window#destroy () in let f_cancel () = retour := None; window#destroy () in wb_ok#connect#clicked f_ok; wb_cancel#connect#clicked f_cancel; (* the enter key is linked to the ok action *) (* the escape key is linked to the cancel action *) event#connect#key_press ~callback: begin fun ev -> if GdkEvent.Key.keyval ev = GdkKeysyms._Return && bind_ok then f_ok (); if GdkEvent.Key.keyval ev = GdkKeysyms._Escape then f_cancel (); false end; widget#misc#grab_focus (); window#show (); GMain.Main.main (); !retour let input_string ?parent ~title ?ok ?cancel ?(text="") message = let we_chaine = GEdit.entry ~text () in if text <> "" then we_chaine#select_region 0 (we_chaine#text_length); input_widget ?parent ~widget:we_chaine#coerce ~event:we_chaine#event ~get_text:(fun () -> we_chaine#text) ~bind_ok:true ~expand: false ~title ?ok ?cancel message let input_text ?parent ~title ?ok ?cancel ?(text="") message = let wscroll = GBin.scrolled_window ~vpolicy: `AUTOMATIC ~hpolicy: `AUTOMATIC () in let wview_chaine = GText.view ~editable: true ~packing: wscroll#add () in if text <> "" then begin wview_chaine#buffer#insert text; wview_chaine#buffer#move_mark `SEL_BOUND ~where:wview_chaine#buffer#start_iter; end; input_widget ?parent ~widget:wscroll#coerce ~event:wview_chaine#event ~get_text: wview_chaine#buffer#get_text ~bind_ok:false ~expand: true ~title ?ok ?cancel message (**This variable contains the last directory where the user selected a file.*) let last_dir = ref "" let select_file ~title ?(dir = last_dir) ?(filename="") () = let fs = if Filename.is_relative filename then begin if !dir <> "" then let filename = Filename.concat !dir filename in GWindow.file_selection ~modal:true ~title ~filename () else GWindow.file_selection ~modal:true ~title () end else begin dir := Filename.dirname filename; GWindow.file_selection ~modal:true ~title ~filename () end in fs#connect#destroy ~callback: GMain.Main.quit; let file = ref None in fs#ok_button#connect#clicked ~callback: begin fun () -> file := Some fs#filename; dir := Filename.dirname fs#filename; fs#destroy () end; fs # cancel_button # connect#clicked ~callback:fs#destroy; fs # show (); GMain.Main.main (); !file type 'a tree = [`L of 'a | `N of 'a * 'a tree list] class ['a] tree_selection ~tree ~label ~info ?packing ?show () = let main_box = GPack.vbox ?packing ?show () in (* The scroll window used for the tree of the versions *) let wscroll_tree = GBin.scrolled_window ~packing: main_box#add () in (* The tree containing the versions *) let wtree = GBroken.tree ~packing:wscroll_tree#add_with_viewport () in (* the text widget used to display information on the selected node. *) let wview = GText.view ~editable: false ~packing: main_box#pack () in (* build the tree *) object inherit GObj.widget main_box#as_widget val mutable selection = None method selection = selection method clear_selection () = selection <- None method wtree = wtree method wview = wview initializer let rec insert_node wt (t : 'a tree) = let data, children = match t with `L d -> d, [] | `N(d,c) -> d, c in let item = GBroken.tree_item ~label: (label data) () in wt#insert item ~pos: 0; item#connect#select ~callback: begin fun () -> selection <- Some data; wview#buffer#delete ~start: wview#buffer#start_iter ~stop:wview#buffer#end_iter ; wview#buffer#insert ~iter: wview#buffer#start_iter (info data); () end; item#connect#deselect ~callback: begin fun () -> selection <- None; wview#buffer#set_text ""; end; match children with [] -> (* nothing more to do *) () | l -> (* create a subtree and expand it *) let newtree = GBroken.tree () in item#set_subtree newtree; item#expand (); (* insert the children *) List.iter (insert_node newtree) (List.rev children) in insert_node wtree tree end let tree_selection_dialog ?parent ~tree ~label ~info ~title ?(ok=mOk) ?(cancel=mCancel) ?(width=300) ?(height=400) ?show () = let destroy_with_parent = Gaux.may_map ~f:(fun _ -> true) parent in let window = GWindow.dialog ?parent ?destroy_with_parent ~modal:true ~title ~width ~height ?show () in (* the tree selection box *) let ts = new tree_selection ~tree ~label ~info ~packing:window#vbox#add () in (* the box containing the ok and cancel buttons *) let hbox = window#action_area in let bOk = GButton.button ~label: ok ~packing:(hbox#pack ~padding:4 ~expand: true) () in let bCancel = GButton.button ~label: cancel ~packing:(hbox#pack ~padding:4 ~expand: true) () in bOk#connect#clicked ~callback:window#destroy; bCancel#connect#clicked ~callback:(fun _ -> ts#clear_selection () ; window#destroy ()); window#connect#destroy ~callback: GMain.Main.quit; window#show (); GMain.Main.main () ; ts#selection (** Misc *) let autosize_clist wlist = (* get the number of columns *) let nb_columns = wlist#columns in (* get the columns titles *) let rec iter lacc i = if i >= nb_columns then lacc else let title = wlist#column_title i in iter (lacc@[(" "^title^" ")]) (i+1) in let titles = iter [] 0 in (* insert a row with the titles *) wlist#insert ~row:0 titles; (* use to clist columns_autosize method *) wlist#columns_autosize (); (* remove the inserted row *) ignore (wlist#remove ~row: 0) (** Shortcuts *) type key_combination = [ `A | `C | `S ] list * char type 'a shortcut_specification = { name : string; keys : key_combination list; message : 'a; } (* mk_keys turns keys from a key_combination into a format which can be used in * a GTK+ RC file. *) let mk_keys (mods, c) = let mods = List.map (function `A -> "" | `C -> "" | `S -> "") mods in (String.concat "" mods) ^ (String.make 1 (Char.uppercase_ascii c)) (* Signal creation for shortcuts unfortunately requires us to create an * in-memory gtkrc file which this function do. *) let make_gtkrc_string g_type shortcuts = let sp = Printf.sprintf in let b = Buffer.create 4000 in Buffer.add_string b "binding \"Shortcuts\" {"; StdLabels.List.iter shortcuts ~f:(fun t -> ListLabels.iter t.keys ~f:(fun keys -> let keys = mk_keys keys in Buffer.add_string b (sp "bind \"%s\" { \"%s\" () }" keys t.name) ) ); Buffer.add_string b "}"; let classname = Gobject.Type.name g_type in Buffer.add_string b (sp "class \"%s\" binding \"Shortcuts\"" classname); Buffer.contents b let create_shortcuts ~window:(win : #GWindow.window_skel) ~shortcuts ~callback = let win = win#as_window in let g_type = Gobject.get_type win in GtkMain.Rc.parse_string (make_gtkrc_string g_type shortcuts); ListLabels.iter shortcuts ~f:(fun t -> let sgn = { GtkSignal.name = t.name; classe = `window; marshaller = GtkSignal.marshal_unit } in GtkSignal.signal_new t.name g_type [ `ACTION; `RUN_FIRST ]; ignore (GtkSignal.connect ~sgn ~callback:(fun () -> callback t.message) win) ) lablgtk-2.18.8/src/gtk.ml0000644000175000017500000003030313460263323014171 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject exception Error of string type 'a optobj = 'a obj Gpointer.optboxed type clampf = float module Tags = struct type anchor_type = [ `CENTER|`NORTH|`NW|`NE|`SOUTH|`SW|`SE|`WEST|`EAST ] type arrow_type = [ `UP|`DOWN|`LEFT|`RIGHT ] type attach_options = [ `EXPAND|`SHRINK|`FILL ] type button_box_style = [ `DEFAULT_STYLE|`SPREAD|`EDGE|`START|`END ] type curve_type = [ `LINEAR|`SPLINE|`FREE ] type delete_type = [ `CHARS|`WORD_ENDS|`WORDS|`DISPLAY_LINES|`DISPLAY_LINE_ENDS | `PARAGRAPH_ENDS|`PARAGRAPHS|`WHITESPACE ] type direction_type = [ `TAB_FORWARD|`TAB_BACKWARD|`UP|`DOWN|`LEFT|`RIGHT ] type expander_style = [ `COLLAPSED|`SEMI_COLLAPSED|`SEMI_EXPANDED|`EXPANDED ] type icon_size = [ `INVALID|`MENU|`SMALL_TOOLBAR|`LARGE_TOOLBAR|`BUTTON|`DND|`DIALOG ] type side_type = [ `TOP|`BOTTOM|`LEFT|`RIGHT ] type text_direction = [ `NONE|`LTR|`RTL ] type justification = [ `LEFT|`RIGHT|`CENTER|`FILL ] type match_type = [ `ALL|`ALL_TAIL|`HEAD|`TAIL|`EXACT|`LAST ] type menu_direction = [ `PARENT|`CHILD|`NEXT|`PREV ] type message_type = [ `INFO | `WARNING | `QUESTION | `ERROR | `OTHER ] type metric_type = [ `PIXELS|`INCHES|`CENTIMETERS ] type movement_step = [ `LOGICAL_POSITIONS|`VISUAL_POSITIONS|`WORDS|`DISPLAY_LINES | `DISPLAY_LINE_ENDS|`PARAGRAPH_ENDS|`PARAGRAPHS|`PAGES|`BUFFER_ENDS | `HORIZONTAL_PAGES ] type orientation = [ `HORIZONTAL|`VERTICAL ] type corner_type = [ `TOP_LEFT|`BOTTOM_LEFT|`TOP_RIGHT|`BOTTOM_RIGHT ] type pack_type = [ `START|`END ] type path_priority = [ `LOWEST|`GTK|`APPLICATION|`THEME|`RC|`HIGHEST ] type path_type = [ `WIDGET|`WIDGET_CLASS|`CLASS ] type policy_type = [ `ALWAYS|`AUTOMATIC|`NEVER ] type position = [ `LEFT|`RIGHT|`TOP|`BOTTOM ] type relief_style = [ `NORMAL|`HALF|`NONE ] type resize_mode = [ `PARENT|`QUEUE|`IMMEDIATE ] type signal_run_type = [ `FIRST|`LAST|`BOTH|`NO_RECURSE|`ACTION|`NO_HOOKS ] type scroll_type = [ `NONE|`JUMP|`STEP_FORWARD|`STEP_BACKWARD|`PAGE_BACKWARD|`PAGE_FORWARD | `STEP_UP|`STEP_DOWN|`PAGE_UP|`PAGE_DOWN|`STEP_LEFT|`STEP_RIGHT | `PAGE_LEFT|`PAGE_RIGHT|`START|`END ] type selection_mode = [ `NONE|`SINGLE|`BROWSE|`MULTIPLE ] type shadow_type = [ `NONE|`IN|`OUT|`ETCHED_IN|`ETCHED_OUT ] type state_type = [ `NORMAL|`ACTIVE|`PRELIGHT|`SELECTED|`INSENSITIVE ] type submenu_direction = [ `LEFT|`RIGHT ] type submenu_placement = [ `TOP_BOTTOM|`LEFT_RIGHT ] type toolbar_style = [ `ICONS|`TEXT|`BOTH|`BOTH_HORIZ ] type update_type = [ `CONTINUOUS|`DISCONTINUOUS|`DELAYED ] type visibility = [ `NONE|`PARTIAL|`FULL ] type window_position = [ `NONE|`CENTER|`MOUSE|`CENTER_ALWAYS|`CENTER_ON_PARENT ] type window_type = [ `TOPLEVEL|`POPUP ] type wrap_mode = [ `NONE|`CHAR|`WORD|`WORD_CHAR ] type sort_type = [ `ASCENDING|`DESCENDING ] type pack_direction = [ `LTR | `RTL | `TTB | `BTT ] type expand_type = [ `X|`Y|`BOTH|`NONE ] type update_policy = [ `ALWAYS|`IF_VALID|`SNAP_TO_TICKS ] type cell_type = [ `EMPTY|`TEXT|`PIXMAP|`PIXTEXT|`WIDGET ] type toolbar_child = [ `SPACE | `BUTTON | `TOGGLEBUTTON | `RADIOBUTTON | `WIDGET ] type toolbar_space_style = [ `EMPTY | `LINE ] type spin_type = [ `STEP_FORWARD | `STEP_BACKWARD | `PAGE_FORWARD | `PAGE_BACKWARD | `HOME | `END | `USER_DEFINED of float ] type accel_flag = [ `VISIBLE|`LOCKED ] type button_action = [ `SELECTS|`DRAGS|`EXPANDS ] type calendar_display_options = [ `SHOW_HEADING|`SHOW_DAY_NAMES|`NO_MONTH_CHANGE|`SHOW_WEEK_NUMBERS | `WEEK_START_MONDAY ] type spin_button_update_policy = [ `ALWAYS|`IF_VALID ] type progress_bar_style = [ `CONTINUOUS|`DISCRETE ] type progress_bar_orientation = [ `LEFT_TO_RIGHT|`RIGHT_TO_LEFT|`BOTTOM_TO_TOP|`TOP_TO_BOTTOM ] type dest_defaults = [ `MOTION|`HIGHLIGHT|`DROP|`ALL ] type target_flags = [ `SAME_APP|`SAME_WIDGET ] type text_window_type = [ `PRIVATE | `WIDGET | `TEXT | `LEFT | `RIGHT | `TOP | `BOTTOM] type text_search_flag = [ `VISIBLE_ONLY | `TEXT_ONLY ] type tree_view_column_sizing = [ `GROW_ONLY | `AUTOSIZE | `FIXED ] type cell_renderer_mode = [ `INERT | `ACTIVATABLE | `EDITABLE ] type buttons = [ `NONE | `OK | `CLOSE | `CANCEL | `YES_NO | `OK_CANCEL ] type response = [ `NONE | `REJECT | `ACCEPT | `DELETE_EVENT | `OK | `CANCEL | `CLOSE | `YES | `NO | `APPLY | `HELP ] type gtkobj_flags = [ `IN_DESTRUCTION | `FLOATING ] type widget_flags = [ gtkobj_flags | `TOPLEVEL | `NO_WINDOW | `REALIZED | `MAPPED | `VISIBLE | `SENSITIVE | `PARENT_SENSITIVE | `CAN_FOCUS | `HAS_FOCUS | `CAN_DEFAULT | `HAS_DEFAULT | `HAS_GRAB | `RC_STYLE | `COMPOSITE_CHILD | `NO_REPARENT | `APP_PAINTABLE | `RECEIVES_DEFAULT | `DOUBLE_BUFFERED ] type size_group_mode = [ `NONE | `HORIZONTAL | `VERTICAL | `BOTH ] end open Tags type gtk_class type accel_group type clipboard type style = [`style] obj type 'a group = 'a obj option type statusbar_message type statusbar_context type selection_data type rectangle = { x: int; y: int; width: int; height: int } type target_entry = { target: string; flags: target_flags list; info: int } type box_packing = { expand: bool; fill: bool; padding: int; pack_type: pack_type } type adjustment = [`gtk|`adjustment] type tooltips = [`gtk|`tooltips] type widget = [`gtk|`widget] type container = [widget|`container] type bin = [container|`bin] type alignment = [bin|`alignment] type button = [bin|`button] type toggle_button = [button|`togglebutton] type radio_button = [button|`togglebutton|`radiobutton] type color_button = [button|`colorbutton] type font_button = [button|`fontbutton] type link_button = [button|`linkbutton] type scale_button = [button|`scalebutton] type option_menu = [button|`optionmenu] type event_box = [bin|`eventbox] type frame = [bin|`frame] type aspect_frame = [bin|`frame|`aspectframe] type handle_box = [bin|`handlebox] type invisible = [bin|`invisible] type item = [bin|`item] type list_item = [item|`listitem] type menu_item = [item|`menuitem] type image_menu_item = [menu_item| `imagemenuitem] type check_menu_item = [item|`menuitem|`checkmenuitem] type radio_menu_item = [item|`menuitem|`checkmenuitem|`radiomenuitem] type tree_item = [item|`treeitem] type scrolled_window = [bin|`scrolledwindow] type viewport = [bin|`viewport] type window = [bin|`window] type assistant = [window|`assistant] type dialog = [window|`dialog] type message_dialog = [dialog|`messagedialog] type color_selection_dialog = [dialog|`colorselectiondialog] type input_dialog = [dialog|`inputdialog] type file_selection = [dialog|`fileselection] type font_selection_dialog = [dialog|`fontselectiondialog] type plug = [window|`plug] type box = [container|`box] type button_box = [container|`box|`buttonbox] type gamma_curve = [container|`buttonbox|`gamma] type color_selection = [container|`box|`colorselection] type font_selection = [container|`box|`fontselection] type combo = [container|`box|`combo] type statusbar = [container|`box|`statusbar] type status_icon = [`gtkstatusicon] type gtk_status_icon = status_icon obj type clist = [container|`clist] type fixed = [container|`fixed] type layout = [container|`layout] type liste = [container|`list] type menu_shell = [container|`menushell] type menu = [container|`menushell|`menu] type menu_bar = [container|`menushell|`menubar] type notebook = [container|`notebook] type packer = [container|`packer] type paned = [container|`paned] type socket = [container|`socket] type table = [container|`table] type toolbar = [container|`toolbar] type tool_item = [bin|`toolitem] type separator_tool_item = [tool_item|`separatortoolitem] type tool_button = [tool_item|`toolbutton] type toggle_tool_button = [tool_button|`toggletoolbutton] type radio_tool_button = [toggle_tool_button|`radiotoolbutton] type menu_tool_button = [tool_button|`menutoolbutton] type tree = [container|`tree] type calendar = [widget|`calendar] type drawing_area = [widget|`drawingarea] type curve = [drawing_area|`curve] type editable = [widget|`editable] type entry = [editable|`entry] type spin_button = [editable|`entry|`spinbutton] type old_editable = [editable|`oldeditable] type text = [old_editable|`text] type misc = [widget|`misc] type arrow = [misc|`arrow] type image = [misc|`image] type label = [misc|`label] type tips_query = [misc|`label|`tipsquery] type pixmap = [misc|`pixmap] type progress = [widget|`progress] type progress_bar = [widget|`progress|`progressbar] type range = [widget|`range] type scale = [widget|`range|`scale] type scrollbar = [widget|`range|`scrollbar] type ruler = [widget|`ruler] type separator = [widget|`separator] type text_view = [container|`textview] type text_buffer = [`textbuffer] obj type text_tag_table = [`texttagtable] obj type text_tag = [`texttag] obj type text_mark = [`textmark] obj type text_child_anchor = [`textchildanchor] obj type text_iter type tree_view = [container|`treeview] type tree_view_column = [`gtk|`celllayout|`treeviewcolumn] type tree_selection = [`treeselection] obj type tree_model = [`treemodel] obj type tree_model_custom = [`custommodel|`treemodel] obj type tree_sortable = [`treemodel|`tree_sortable] obj type tree_model_sort = [`treemodelsort|`treesortable|`treemodel] obj type tree_model_filter = [`treemodelfilter|`treemodel] obj type tree_store = [`treestore|`treesortable|`treemodel] obj type list_store = [`liststore|`treesortable|`treemodel] obj type tree_iter type tree_path type row_reference type cell_renderer = [`gtk|`cellrenderer] type cell_renderer_pixbuf = [cell_renderer|`cellrendererpixbuf] type cell_renderer_text = [cell_renderer|`cellrenderertext] type cell_renderer_toggle = [cell_renderer|`cellrenderertoggle] type cell_renderer_progress = [cell_renderer|`cellrendererprogress] type cell_renderer_combo = [cell_renderer_text|`cellrenderercombo] type cell_renderer_accel = [cell_renderer_text|`cellrendereraccel] type icon_source type icon_set type icon_factory = [`iconfactory] obj type size_group = [`sizegroup] obj (* New widgets in 2.4 *) type cell_layout = [`celllayout] type combo_box = [bin|`combobox|cell_layout] type combo_box_entry = [combo_box|`comboboxentry] type expander = [bin|`expander] type file_filter = [`gtk|`filefilter] type file_chooser = [widget|`filechooser] type entry_completion = [`entrycompletion|cell_layout] obj type action = [`action] type toggle_action = [action|`toggleaction] type radio_action = [toggle_action|`radioaction] type action_group = [`actiongroup] type ui_manager = [`uimanager] (* New widgets in 2.6 *) type icon_view = [container|`iconview] type about_dialog = [dialog|`aboutdialog] type file_chooser_button = [box|`filechooserbutton|`filechooser] (* New widgets in 2.12 *) type tooltip = [`tooltip] obj (* re-export Gobject.obj *) type 'a obj = 'a Gobject.obj (* constraint 'a = [> `gtk] *) (* *Props modules break this *) lablgtk-2.18.8/src/gMenu.mli0000644000175000017500000002155513460263323014641 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** Menus *) (** @gtkdoc gtk GtkMenuShell *) class menu_shell_signals : [> menu_shell] obj -> object inherit GContainer.container_signals method deactivate : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkMenuItem *) class menu_item_signals : [> menu_item] obj -> object inherit GContainer.item_signals method activate : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkMenuItem *) class menu_item_skel : 'a obj -> object inherit GContainer.container constraint 'a = [> Gtk.menu_item] val obj : 'a obj method activate : unit -> unit method add_accelerator : group:accel_group -> ?modi:Gdk.Tags.modifier list -> ?flags:Tags.accel_flag list -> Gdk.keysym -> unit method as_item : Gtk.menu_item obj method remove_submenu : unit -> unit method set_right_justified : bool -> unit method select : unit -> unit method deselect : unit -> unit method right_justified : bool method set_submenu : menu -> unit method get_submenu : GObj.widget option end (** The widget used for item in menus @gtkdoc gtk GtkMenuItem *) and menu_item : 'a obj -> object inherit menu_item_skel constraint 'a = [> Gtk.menu_item] val obj : 'a obj method event : event_ops method connect : menu_item_signals end (** A drop down menu widget @gtkdoc gtk GtkMenu *) and menu : Gtk.menu obj -> object inherit [menu_item] GContainer.item_container val obj : Gtk.menu obj method add : menu_item -> unit method event : event_ops method append : menu_item -> unit method as_menu : Gtk.menu obj method children : menu_item list method connect : menu_shell_signals method deactivate : unit -> unit method insert : menu_item -> pos:int -> unit method popdown : unit -> unit method popup : button:int -> time:int32 -> unit method prepend : menu_item -> unit method remove : menu_item -> unit method set_accel_group : accel_group -> unit method set_accel_path : string -> unit method set_border_width : int -> unit method private wrap : Gtk.widget obj -> menu_item end (** @gtkdoc gtk GtkMenu *) val menu : ?accel_path:string -> ?border_width:int -> ?packing:(menu -> unit) -> ?show:bool -> unit -> menu (** @gtkdoc gtk GtkMenuItem *) val menu_item : ?use_mnemonic:bool -> ?label:string -> ?right_justified:bool -> ?packing:(menu_item -> unit) -> ?show:bool -> unit -> menu_item (** @gtkdoc gtk GtkTearoffMenuItem *) val tearoff_item : ?packing:(menu_item -> unit) -> ?show:bool -> unit -> menu_item (** @gtkdoc gtk GtkSeparatorMenuItem *) val separator_item : ?packing:(menu_item -> unit) -> ?show:bool -> unit -> menu_item (** A menu item with an icon @gtkdoc gtk GtkImageMenuItem *) class image_menu_item : 'a obj -> object inherit menu_item_skel constraint 'a = Gtk.image_menu_item val obj : 'a obj method event : event_ops method connect : menu_item_signals method image : widget method set_image : widget -> unit end (** @gtkdoc gtk GtkImageMenuItem *) val image_menu_item : ?image:#widget -> ?label:string -> ?use_mnemonic:bool -> ?stock:GtkStock.id -> ?right_justified:bool -> ?packing:(menu_item -> unit) -> ?show:bool -> unit -> image_menu_item (** @gtkdoc gtk GtkCheckMenuItem *) class check_menu_item_signals : [> check_menu_item] obj -> object inherit menu_item_signals method toggled : callback:(unit -> unit) -> GtkSignal.id end (** A menu item with a check box @gtkdoc gtk GtkCheckMenuItem *) class check_menu_item : 'a obj -> object inherit menu_item_skel constraint 'a = [> Gtk.check_menu_item] val obj : 'a obj method active : bool method event : event_ops method connect : check_menu_item_signals method set_active : bool -> unit method set_inconsistent : bool -> unit method inconsistent : bool method set_show_toggle : bool -> unit method toggled : unit -> unit end (** @gtkdoc gtk GtkCheckMenuItem *) val check_menu_item : ?label:string -> ?use_mnemonic:bool -> ?active:bool -> ?show_toggle:bool -> ?right_justified:bool -> ?packing:(menu_item -> unit) -> ?show:bool -> unit -> check_menu_item (** A choice from multiple check menu items @gtkdoc gtk GtkRadioMenuItem *) class radio_menu_item : Gtk.radio_menu_item obj -> object inherit check_menu_item val obj : Gtk.radio_menu_item obj method group : Gtk.radio_menu_item group method set_group : Gtk.radio_menu_item group -> unit end (** @gtkdoc gtk GtkRadioMenuItem *) val radio_menu_item : ?group:Gtk.radio_menu_item group -> ?label:string -> ?use_mnemonic:bool -> ?active:bool -> ?show_toggle:bool -> ?right_justified:bool -> ?packing:(menu_item -> unit) -> ?show:bool -> unit -> radio_menu_item (** @gtkdoc gtk GtkMenuShell *) class menu_shell : 'a obj -> object inherit [menu_item] GContainer.item_container constraint 'a = [> Gtk.menu_shell] val obj : 'a obj method event : event_ops method deactivate : unit -> unit method connect : menu_shell_signals method insert : menu_item -> pos:int -> unit method private wrap : Gtk.widget obj -> menu_item end (** @gtkdoc gtk GtkMenuBar *) val menu_bar : ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> menu_shell (** A widget used to choose from a list of valid choices @gtkdoc gtk GtkOptionMenu *) class option_menu : 'a obj -> object inherit GButton.button_skel constraint 'a = [> Gtk.option_menu] val obj : 'a obj method event : event_ops method connect : GButton.button_signals method get_menu : menu method remove_menu : unit -> unit method set_history : int -> unit method set_menu : menu -> unit end (** @gtkdoc gtk GtkOptionMenu *) val option_menu : ?menu:#menu -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> option_menu (** A factory for menus @gtkdoc gtk GtkItemFactory *) class ['a] factory : ?accel_group:accel_group -> ?accel_path:string -> ?accel_modi:Gdk.Tags.modifier list -> ?accel_flags:Tags.accel_flag list -> 'a -> object constraint 'a = #menu_shell val flags : Tags.accel_flag list val group : accel_group val m : Gdk.Tags.modifier list val menu_shell : 'a method accel_group : accel_group method add_check_item : ?active:bool -> ?key:Gdk.keysym -> ?callback:(bool -> unit) -> string -> check_menu_item method add_item : ?key:Gdk.keysym -> ?callback:(unit -> unit) -> ?submenu:menu -> string -> menu_item method add_image_item : ?image:widget -> ?key:Gdk.keysym -> ?callback:(unit -> unit) -> ?stock:GtkStock.id -> ?label:string -> unit -> image_menu_item method add_radio_item : ?group:Gtk.radio_menu_item group -> ?active:bool -> ?key:Gdk.keysym -> ?callback:(bool -> unit) -> string -> radio_menu_item method add_separator : unit -> menu_item method add_submenu : ?key:Gdk.keysym -> string -> menu method add_tearoff : unit -> menu_item method private bind : ?modi:Gdk.Tags.modifier list -> ?key:Gdk.keysym -> ?callback:(unit -> unit) -> menu_item -> string -> unit method menu : 'a end lablgtk-2.18.8/src/gtkMenu.props0000644000175000017500000000514613460263323015560 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } conversions { GtkPackDirection "GtkEnums.pack_direction_conv" } class OptionMenu : Button { "menu" GtkMenu : Read / Write method remove_menu method set_history : "int -> unit" signal changed } class MenuItem : Item { method set_submenu : "[>`menu] obj -> unit" method get_submenu : "widget obj option" method remove_submenu method activate method select method deselect method set_right_justified : "bool -> unit" method get_right_justified : "bool" method set_accel_path : "string -> unit" method toggle_size_request : "int -> unit" method toggle_size_allocate : "int -> unit" signal activate signal activate_item (*signal toggle_size_allocate : gint signal toggle_size_request : gintref*) } class CheckMenuItem : MenuItem { "active" gboolean : Read / Write "inconsistent" gboolean : Read / Write method set_show_toggle : "bool -> unit" method toggled signal toggled } class RadioMenuItem abstract : CheckMenuItem { method set_group : "radio_menu_item group -> unit" } class ImageMenuItem : MenuItem { "image" GtkWidget : Read / Write } (* class SeparatorMenuItem {} class TearoffMenuItem {} *) class MenuShell abstract : Container { method append : "[>`widget] obj -> unit" method prepend : "[>`widget] obj -> unit" method insert : "[>`widget] obj -> pos:int -> unit" method deactivate signal activate_current : gboolean signal cancel signal cycle_focus : GtkDirectionType signal deactivate signal move_current : GtkMenuDirectionType signal selection_done } class MenuBar : MenuShell { "child-pack-direction" GtkPackDirection : Read / Write "pack-direction" GtkPackDirection : Read / Write "internal-padding" gint : Read "shadow-type" GtkShadowType : Read } class Menu : MenuShell { "tearoff-title" gchararray : Read / Write method popup : "[>`menushell] optobj -> [>`menuitem] optobj -> button:int -> time:int32 -> unit" method popup_at : "?button:int -> ?time:int32 -> (x:int -> y:int -> pushed_in:bool -> int * int * bool) -> unit" method popdown method get_active : "widget obj" method set_active : "int -> unit" method set_accel_group : "accel_group -> unit" method get_accel_group : "accel_group" method set_accel_path : "string -> unit" method attach_to_widget : "[>`widget] obj -> unit" method get_attach_widget : "widget obj" method detach signal move_scroll : GtkScrollType } lablgtk-2.18.8/src/gList.ml0000644000175000017500000001745113460263323014477 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gtk open GtkBase open GtkList open OgtkListProps open GObj open GContainer class list_item obj = object inherit container (obj : Gtk.list_item obj) method event = new GObj.event_ops obj method as_item = obj method select () = Item.select obj method deselect () = Item.deselect obj method toggle () = Item.toggle obj method connect = new item_signals obj end let list_item ?label ?packing ?(show=true) () = let w = ListItem.create ?label () in let item = new list_item w in may packing ~f:(fun f -> (f item : unit)); if show then item#misc#show (); item class liste_signals obj = object (self) inherit container_signals_impl (obj : Gtk.liste obj) method selection_changed = self#connect Liste.S.selection_changed method select_child ~callback = self#connect Liste.S.select_child ~callback:(fun w -> callback (new list_item (ListItem.cast w))) method unselect_child ~callback = self#connect Liste.S.unselect_child ~callback:(fun w -> callback (new list_item (ListItem.cast w))) end class liste obj = object inherit [list_item] item_container (obj : Gtk.liste obj) method private obj = obj inherit liste_props method private wrap w = new list_item (ListItem.cast w) method connect = new liste_signals obj method insert w = Liste.insert_item obj w#as_item method clear_items = Liste.clear_items obj method select_item = Liste.select_item obj method unselect_item = Liste.unselect_item obj method child_position (w : list_item) = Liste.child_position obj w#as_item end let liste = Liste.make_params [] ~cont:( GContainer.pack_container ~create:(fun p -> new liste (Liste.create p))) (* Cell lists *) class clist_signals obj = object inherit container_signals_impl (obj : [> Gtk.clist] obj) inherit clist_sigs end class ['a] clist obj = object (self) inherit widget (obj : Gtk.clist obj) method set_border_width = Gobject.set Container.P.border_width obj method event = new GObj.event_ops obj method connect = new clist_signals obj method rows = CList.get_rows obj method columns = CList.get_columns obj method focus_row = CList.get_focus_row obj method hadjustment = new GData.adjustment (CList.get_hadjustment obj) method vadjustment = new GData.adjustment (CList.get_vadjustment obj) method freeze () = CList.freeze obj method thaw () = CList.thaw obj method column_title = CList.get_column_title obj method column_widget col = new widget (CList.get_column_widget obj col) method columns_autosize () = CList.columns_autosize obj method optimal_column_width = CList.optimal_column_width obj method moveto ?(row_align=0.) ?(col_align=0.) row col = CList.moveto obj row col ~row_align ~col_align method row_is_visible = CList.row_is_visible obj method cell_type = CList.get_cell_type obj method cell_text = CList.get_text obj method cell_pixmap row col = let pm, mask = CList.get_pixmap obj row col in may_map pm ~f:(fun x -> new GDraw.pixmap ?mask x) method cell_style row col = try Some (new style (CList.get_cell_style obj row col)) with Gpointer.Null -> None method row_selectable row = CList.get_selectable obj ~row method row_style row = try Some (new style (CList.get_row_style obj ~row)) with Gpointer.Null -> None method set_shift = CList.set_shift obj method insert ~row texts = let texts = List.map texts ~f:(fun x -> Some x) in CList.insert obj ~row texts method append = self#insert ~row:self#rows method prepend = self#insert ~row:0 method remove = CList.remove obj method select = CList.select obj method unselect = CList.unselect obj method clear () = CList.clear obj method get_row_column = CList.get_row_column obj method select_all () = CList.select_all obj method unselect_all () = CList.unselect_all obj method swap_rows = CList.swap_rows obj method row_move = CList.row_move obj method sort () = CList.sort obj method set_hadjustment adj = CList.set_hadjustment obj (GData.as_adjustment adj) method set_vadjustment adj = CList.set_vadjustment obj (GData.as_adjustment adj) method set_shadow_type = CList.set_shadow_type obj method set_button_actions = CList.set_button_actions obj method set_selection_mode = CList.set_selection_mode obj method set_reorderable = CList.set_reorderable obj method set_use_drag_icons = CList.set_use_drag_icons obj method set_row_height = CList.set_row_height obj method set_titles_show = CList.set_titles_show obj method set_titles_active = CList.set_titles_active obj method set_sort = CList.set_sort obj method set_column ?widget = CList.set_column obj ?widget:(may_map widget ~f:as_widget) method set_row ?foreground ?background ?selectable ?style = let color = may_map ~f:(fun c -> Gpointer.optboxed (GDraw.optcolor c)) and style = may_map ~f:(fun (st : style) -> st#as_style) style in CList.set_row obj ?foreground:(color foreground) ?background:(color background) ?selectable ?style method set_cell ?text ?pixmap ?spacing ?style = let pixmap, mask = match pixmap with None -> None, None | Some (pm : GDraw.pixmap) -> Some pm#pixmap, pm#mask and style = may_map ~f:(fun (st : style) -> st#as_style) style in CList.set_cell obj ?text ?pixmap ?mask ?spacing ?style method set_row_data n ~data = CList.set_row_data obj ~row:n (Obj.repr (data : 'a)) method get_row_data n : 'a = Obj.obj (CList.get_row_data obj ~row:n) method scroll_vertical = CList.emit_scroll obj ~sgn:CList.S.scroll_vertical method scroll_horizontal = CList.emit_scroll obj ~sgn:CList.S.scroll_horizontal method get_row_state row = CList.get_row_state obj row end let clist_poly ?(columns=1) ?hadjustment ?vadjustment ?titles = CList.setter ?hadjustment:(may_map GData.as_adjustment hadjustment) ?vadjustment:(may_map GData.as_adjustment vadjustment) ~cont:( fun f ?auto_sort ?sort_column -> CList.make_params [] ~cont:( GContainer.pack_container ~create:(fun p -> let w = match titles with None -> CList.create ~cols:columns | Some titles -> CList.create_with_titles (Array.of_list titles) in Gobject.set_params w p; f w; CList.set_sort w ?auto:auto_sort ?column:sort_column (); new clist w))) let clist = clist_poly lablgtk-2.18.8/src/gtkFile.props0000644000175000017500000000246013460263323015527 0ustar stephsteph prefix "Gtk" conversions { GtkFileChooserAction "GtkEnums.file_chooser_action_conv" GtkFileFilter "(gobject : Gtk.file_filter Gtk.obj data_conv)" GtkFileChooserDialog "(gobject : [>`filechooser|`dialog] Gtk.obj data_conv)" GtkFileChooserConfirmation "GtkEnums.file_chooser_confirmation_conv" } class FileChooser abstract wrap wrapsig { "action" GtkFileChooserAction : Read / Write "extra-widget" GtkWidget : Read / Write "file-system-backend" gchararray : Write / Construct Only "filter" GtkFileFilter : Read / Write / NoWrap "local-only" gboolean : Read / Write "preview-widget" GtkWidget : Read / Write "preview-widget-active" gboolean : Read / Write "select-multiple" gboolean : Read / Write "show-hidden" gboolean : Read / Write "use-preview-label" gboolean : Read / Write "do-overwrite-confirmation" gboolean : Read / Write signal current_folder_changed signal file_activated signal selection_changed signal update_preview signal confirm_overwrite : -> GtkFileChooserConfirmation } class FileChooserButton wrap : HBox { (* "dialog" GtkFileChooserDialog : Write / Construct Only *) "title" gchararray : Read / Write "width-chars" gint : Read / Write } lablgtk-2.18.8/src/lablgtk2.bat.in0000755000175000017500000000051613460263323015657 0ustar stephsteph@echo off rem launcher for lablgtk2 set gtklibs=lablgtk.cma if "%1" == "-thread" goto thread set initobjs=gtkInit.cmo goto next :thread shift set initobjs=-I +threads unix.cma threads.cma gtkThread.cmo gtkInit.cmo gtkThInit.cmo :next ocaml -w s -I +site-lib/lablgtk2 %gtklibs% %initobjs% %1 %2 %3 %4 %5 %6 %7 %8 %9 lablgtk-2.18.8/src/gSourceView.ml0000644000175000017500000004507513460263323015662 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open Gaux open GtkSourceView open Gobject open Gtk open GtkBase open GtkSourceView_types open OgtkSourceViewProps open GObj let get_bool = function `BOOL x -> x | _ -> assert false let bool x = `BOOL x let get_uint = function `INT x -> x | _ -> assert false let uint x = `INT x let get_int = function `INT x -> x | _ -> assert false let int x = `INT x let get_gobject = function `OBJECT x -> x | _ -> assert false let gobject x = `OBJECT (Some x) let map_opt f = function None -> None | Some x -> Some (f x) (** {2 GtkSourceTag} *) type source_tag_property = [ | `BACKGROUND of Gdk.color | `BOLD of bool | `FOREGROUND of Gdk.color | `ITALIC of bool | `STRIKETHROUGH of bool | `UNDERLINE of bool ] let text_tag_property_of_source_tag_property = function | `BACKGROUND p -> `BACKGROUND_GDK p | `BOLD p -> `WEIGHT (if p then `BOLD else `NORMAL) | `FOREGROUND p -> `FOREGROUND_GDK p | `ITALIC p -> `STYLE (if p then `ITALIC else `NORMAL) | `STRIKETHROUGH p -> `STRIKETHROUGH p | `UNDERLINE p -> `UNDERLINE (if p then `SINGLE else `NONE) let color_of_string s = Gdk.Color.alloc ~colormap: (Gdk.Color.get_system_colormap()) (`NAME s) class source_tag_style (obj: GtkSourceView_types.source_tag_style obj) = object (self) method as_source_tag_style = obj method copy = new source_tag_style (SourceTagStyle.copy obj) method background = SourceTagStyle.get_background obj method bold = SourceTagStyle.get_bold obj method foreground = SourceTagStyle.get_foreground obj method italic = SourceTagStyle.get_italic obj method strikethrough = SourceTagStyle.get_strikethrough obj method underline = SourceTagStyle.get_underline obj method use_background = SourceTagStyle.get_use_background obj method use_foreground = SourceTagStyle.get_use_foreground obj method set_background = SourceTagStyle.set_background obj method set_background_by_name s = self#set_background (color_of_string s) method set_bold = SourceTagStyle.set_bold obj method set_foreground = SourceTagStyle.set_foreground obj method set_foreground_by_name s = self#set_foreground (color_of_string s) method set_italic = SourceTagStyle.set_italic obj method set_strikethrough = SourceTagStyle.set_strikethrough obj method set_underline = SourceTagStyle.set_underline obj method set_use_background = SourceTagStyle.set_use_background obj method set_use_foreground = SourceTagStyle.set_use_foreground obj end let source_tag_style ?background ?background_by_name ?bold ?foreground ?foreground_by_name ?italic ?strikethrough ?underline () = let st = new source_tag_style (SourceTagStyle.new_ ()) in (match background with None -> () | Some p -> st#set_background p); (match background_by_name with None -> () | Some p -> st#set_background_by_name p); (match bold with None -> () | Some p -> st#set_bold p); (match foreground with None -> () | Some p -> st#set_foreground p); (match foreground_by_name with None -> () | Some p -> st#set_foreground_by_name p); (match italic with None -> () | Some p -> st#set_italic p); (match strikethrough with None -> () | Some p -> st#set_strikethrough p); (match underline with None -> () | Some p -> st#set_underline p); (match background, background_by_name with None, None -> () | _ -> st#set_use_background true); (match foreground, foreground_by_name with None, None -> () | _ -> st#set_use_foreground true); st type source_tag_id = string class source_tag (obj: GtkSourceView_types.source_tag obj) = object (self) inherit GText.tag (obj :> [`texttag] obj) method as_source_tag = obj method id = Gobject.Property.get obj SourceTag.P.id method style : source_tag_style = let st = match SourceTag.get_style obj with None -> let st = SourceTagStyle.new_ () in SourceTag.set_style obj st; st | Some st -> st in new source_tag_style st method set_style (s:source_tag_style) = SourceTag.set_style obj s#as_source_tag_style method set_source_property (p:source_tag_property) = self#set_property (text_tag_property_of_source_tag_property p) method set_source_properties (l:source_tag_property list) = self#set_properties (List.map text_tag_property_of_source_tag_property l) end let syntax_tag ~id ~name ~pat_start ~pat_end = new source_tag (SourceTag.syntax_tag ~id ~name ~pat_start ~pat_end) let pattern_tag ~id ~name ~pat = new source_tag (SourceTag.pattern_tag ~id ~name ~pat) let keyword_list_tag ~id ~name ~keywords ?(case_sensitive=true) ?(match_empty_string_at_beginning=false) ?(match_empty_string_at_end=false) ?beginning_regex ?end_regex () = new source_tag (SourceTag.keyword_list_tag ~id ~name ~keywords ~case_sensitive ~match_empty_string_at_beginning ~match_empty_string_at_end ~beginning_regex ~end_regex) let block_comment_tag = syntax_tag let line_comment_tag ~id ~name ~pat_start = new source_tag (SourceTag.line_comment_tag ~id ~name ~pat_start) let string_tag ~id ~name ~pat_start ~pat_end ~end_at_line_end = new source_tag (SourceTag.string_tag ~id ~name ~pat_start ~pat_end ~end_at_line_end) (** {2 GtkSourceTagTable} *) class source_tag_table_signals obj' = object inherit (['a] gobject_signals (obj' : [> GtkSourceView_types.source_tag_table] obj)) inherit OgtkTextProps.text_tag_table_sigs inherit source_tag_table_sigs end class source_tag_table (obj: GtkSourceView_types.source_tag_table obj) = object (self) inherit GText.tag_table_skel (obj :> [`texttagtable] obj) method as_source_tag_table = (Gobject.try_cast obj "GtkSourceTagTable" :> [`sourcetagtable] obj) method connect = new source_tag_table_signals obj method misc = new gobject_ops obj method remove_source_tags () = SourceTagTable.remove_source_tags obj method add_tags (l:source_tag list) = SourceTagTable.add_tags obj (List.map (fun t -> t#as_source_tag) l) end let source_tag_table () = new source_tag_table (SourceTagTable.new_()) (** {2 GtkSourceStyleScheme} *) class source_style_scheme (obj: GtkSourceView_types.source_style_scheme obj) = object(self) method as_source_style_scheme = obj method get_name = SourceStyleScheme.get_name obj method get_tag_style s = match SourceStyleScheme.get_tag_style obj s with None -> raise Not_found | Some o -> new source_tag_style o end let default_style_scheme () = new source_style_scheme (SourceStyleScheme.get_default ()) (** {2 GtkSourceLanguage} *) class source_language_signals obj' = object (self) inherit ['a] gobject_signals (obj' : [> GtkSourceView_types.source_language] obj) inherit source_language_sigs end class source_language (obj: GtkSourceView_types.source_language obj) = object (self) method as_source_language = obj method connect = new source_language_signals obj method misc = new gobject_ops obj method get_name = SourceLanguage.get_name obj method get_section = SourceLanguage.get_section obj method get_escape_char = SourceLanguage.get_escape_char obj method get_style_scheme = new source_style_scheme (SourceLanguage.get_style_scheme obj) method set_style_scheme (s:source_style_scheme) = SourceLanguage.set_style_scheme obj s#as_source_style_scheme method get_tags = List.map (fun o -> new source_tag o) (SourceLanguage.get_tags obj) method get_tag_style id = new source_tag_style (SourceLanguage.get_tag_style obj id) method set_tag_style id (s:source_tag_style) = SourceLanguage.set_tag_style obj id s#as_source_tag_style method get_tag_default_style id = new source_tag_style (SourceLanguage.get_tag_default_style obj id) end (** {2 GtkSourceLanguagesManager} *) class source_languages_manager (obj: GtkSourceView_types.source_languages_manager obj) = object (self) method get_oid = Gobject.get_oid obj method as_source_languages_manager = obj method get_available_languages = List.map (fun o -> new source_language o) (SourceLanguagesManager.get_available_languages obj) method get_language_from_mime_type s = match SourceLanguagesManager.get_language_from_mime_type obj s with | None -> None | Some obj -> Some (new source_language obj) method lang_files_dirs = SourceLanguagesManager.get_lang_files_dirs obj end (* let source_languages_manager ?lang_files_dirs () = let properties = match lang_files_dirs with | None -> [] | Some dirs -> let list_obj = gslist_of_string_list dirs in [Gobject.param "lang-files-dirs" (`OBJECT (Some list_obj))] in new source_languages_manager (SourceLanguagesManager.create properties) *) let source_languages_manager () = new source_languages_manager (SourceLanguagesManager.create []) let source_language_from_file ?languages_manager fname = let languages_manager = match languages_manager with | None -> source_languages_manager () | Some lm -> lm in let manager_obj = languages_manager#as_source_languages_manager in match SourceLanguage.new_from_file fname manager_obj with | None -> None | Some lang_obj -> Some (new source_language lang_obj) (** {2 GtkSourceMarker} *) class source_marker (obj: GtkSourceView_types.source_marker obj) = object (self) method as_source_marker = obj method set_type = SourceMarker.set_type obj method get_type = SourceMarker.get_type obj method get_line = SourceMarker.get_line obj method get_name = SourceMarker.get_name obj method get_buffer = new source_buffer (SourceMarker.get_buffer obj) method next = new source_marker (SourceMarker.next obj) method prev = new source_marker (SourceMarker.prev obj) end (** {2 GtkSourceBuffer} *) and source_buffer_signals obj' = object inherit ['a] gobject_signals (obj' : [> GtkSourceView_types.source_buffer] obj) inherit GText.buffer_signals_skel inherit source_buffer_sigs end and source_buffer (obj: GtkSourceView_types.source_buffer obj) = object (self) inherit GText.buffer_skel obj as text_buffer method as_source_buffer = obj method connect = new source_buffer_signals obj method misc = new gobject_ops obj method check_brackets = get_bool (self#misc#get_property "check-brackets") method set_check_brackets x = self#misc#set_property "check-brackets" (bool x) method set_bracket_match_style (st:source_tag_style) = SourceBuffer.set_bracket_match_style obj st#as_source_tag_style method highlight = get_bool (self#misc#get_property "highlight") method set_highlight x = self#misc#set_property "highlight" (bool x) method max_undo_levels = get_int (self#misc#get_property "max-undo-levels") method set_max_undo_levels x = self#misc#set_property "max-undo-levels" (int x) method language = match get_gobject (self#misc#get_property "language") with | None -> None | Some obj -> Some (new source_language (Gobject.try_cast obj "GtkSourceLanguage")) method set_language (x: source_language) = self#misc#set_property "language" (gobject x#as_source_language) method escape_char = get_uint (self#misc#get_property "escape-char") method set_escape_char x = self#misc#set_property "escape-char" (uint x) method can_undo = SourceBuffer.can_undo obj method can_redo = SourceBuffer.can_redo obj method undo () = SourceBuffer.undo obj method redo () = SourceBuffer.redo obj method begin_not_undoable_action () = SourceBuffer.begin_not_undoable_action obj method end_not_undoable_action () = SourceBuffer.end_not_undoable_action obj method source_tag_table = new source_tag_table (Gobject.try_cast self#tag_table "GtkSourceTagTable") method create_marker ?name ?typ (iter:GText.iter) = new source_marker(SourceBuffer.create_marker obj name typ iter#as_iter) method move_marker (m:source_marker) (iter:GText.iter) = SourceBuffer.move_marker obj m#as_source_marker iter#as_iter method delete_marker (m:source_marker) = SourceBuffer.delete_marker obj m#as_source_marker method get_marker s = match SourceBuffer.get_marker obj s with Some m -> new source_marker m | None -> raise Not_found method get_markers_in_region ~(start:GText.iter) ~(stop:GText.iter) = List.map (fun m -> new source_marker m) (SourceBuffer.get_markers_in_region obj start#as_iter stop#as_iter) method get_iter_at_marker (m:source_marker) = new GText.iter (SourceBuffer.get_iter_at_marker obj m#as_source_marker) method get_first_marker = map_opt (new source_marker) (SourceBuffer.get_first_marker obj) method get_last_marker = map_opt (new source_marker) (SourceBuffer.get_last_marker obj) method get_next_marker (it:GText.iter) = map_opt (new source_marker) (SourceBuffer.get_next_marker obj it#as_iter) method get_prev_marker (it:GText.iter) = map_opt (new source_marker) (SourceBuffer.get_prev_marker obj it#as_iter) end let source_buffer ?language ?(tag_table : source_tag_table option) ?text = let language = match language with | None -> None | Some source_language -> Some (source_language#as_source_language) in SourceBuffer.make_params [] ?language ~cont:(fun pl () -> let buf = match tag_table with None -> new source_buffer (SourceBuffer.create pl) | Some tt -> let obj = SourceBuffer.new_ tt#as_source_tag_table in Gobject.set_params (Gobject.try_cast obj "GtkSourceBuffer") pl; new source_buffer obj in (match text with | None -> () | Some text -> buf#set_text text); buf) (* alias used below, needed because "source_buffer" is a name in scope *) let source_buffer' = source_buffer (** {2 GtkSourceView} *) class source_view_signals obj' = object inherit widget_signals_impl (obj' : [> GtkSourceView_types.source_view] obj) inherit GText.view_signals obj' inherit source_view_sigs end class source_view (obj': GtkSourceView_types.source_view obj) = object (self) inherit GText.view_skel obj' val source_buf = let buf_obj = Gobject.try_cast (GtkText.View.get_buffer obj') "GtkSourceBuffer" in new source_buffer buf_obj method source_buffer = source_buf method connect = new source_view_signals obj' method set_show_line_numbers x = self#misc#set_property "show_line_numbers" (bool x) method show_line_numbers = get_bool (self#misc#get_property "show_line_numbers") method set_show_line_markers x = self#misc#set_property "show_line_markers" (bool x) method show_line_markers = get_bool (self#misc#get_property "show_line_markers") method set_tabs_width x = self#misc#set_property "tabs_width" (uint x) method tabs_width = get_uint (self#misc#get_property "tabs_width") method set_auto_indent x = self#misc#set_property "auto_indent" (bool x) method auto_indent = get_bool (self#misc#get_property "auto_indent") method set_insert_spaces_instead_of_tabs x = self#misc#set_property "insert_spaces_instead_of_tabs" (bool x) method insert_spaces_instead_of_tabs = get_bool (self#misc#get_property "insert_spaces_instead_of_tabs") method set_highlight_current_line x = self#misc#set_property "highlight_current_line" (bool x) method highlight_current_line = get_bool (self#misc#get_property "highlight_current_line") method set_show_margin x = self#misc#set_property "show_margin" (bool x) method show_margin = get_bool (self#misc#get_property "show_margin") method set_margin x = self#misc#set_property "margin" (uint x) method margin = get_uint (self#misc#get_property "margin") method set_smart_home_end x = self#misc#set_property "smart_home_end" (bool x) method smart_home_end = get_bool (self#misc#get_property "smart_home_end") method set_marker_pixbuf = SourceView.set_marker_pixbuf obj method marker_pixbuf = SourceView.get_marker_pixbuf obj method set_cursor_color = SourceView.set_cursor_color obj method set_cursor_color_by_name s = SourceView.set_cursor_color obj (color_of_string s) end let source_view ?source_buffer = SourceView.make_params [] ~cont:( GtkText.View.make_params ~cont:( GContainer.pack_container ~create:(fun pl -> let obj = match source_buffer with | Some buf -> SourceView.new_with_buffer (Gobject.try_cast buf#as_buffer "GtkSourceBuffer") | None -> SourceView.new_ () in Gobject.set_params (Gobject.try_cast obj "GtkSourceView") pl; new source_view obj))) (** {2 Misc} *) let find_matching_bracket iter = let iter = iter#copy in if SourceViewMisc.find_matching_bracket iter#as_iter then Some iter else None let iter_forward_search (iter:GText.iter) flags ~start ~stop ?limit str = let limit = map_opt (fun x -> x#as_iter) limit in match SourceViewMisc.iter_forward_search iter#as_iter str flags ~start: start#as_iter ~stop: stop#as_iter limit with None -> None | Some (it1,it2) -> Some (new GText.iter it1, new GText.iter it2) let iter_backward_search (iter:GText.iter) flags ~start ~stop ?limit str = let limit = map_opt (fun x -> x#as_iter) limit in match SourceViewMisc.iter_backward_search iter#as_iter str flags ~start: start#as_iter ~stop: stop#as_iter limit with None -> None | Some (it1,it2) -> Some (new GText.iter it1, new GText.iter it2) lablgtk-2.18.8/src/gBroken.ml0000644000175000017500000001304113460263323014773 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject open Gtk open GtkBase open GtkBroken open OgtkBaseProps open OgtkBrokenProps open GObj open GContainer (* Obsolete GtkTree/GtkTreeItem framework *) class tree_item_signals obj = object inherit container_signals_impl (obj : tree_item obj) inherit item_sigs inherit tree_item_sigs end class tree_item obj = object inherit container obj method event = new GObj.event_ops obj method as_item : Gtk.tree_item obj = obj method connect = new tree_item_signals obj method set_subtree (w : tree) = TreeItem.set_subtree obj w#as_tree method remove_subtree () = TreeItem.remove_subtree obj method expand () = TreeItem.expand obj method collapse () = TreeItem.collapse obj method subtree = try Some(new tree (TreeItem.subtree obj)) with Gpointer.Null -> None end and tree_signals obj = object (self) inherit container_signals_impl obj method selection_changed = self#connect Tree.S.selection_changed method select_child ~callback = self#connect Tree.S.select_child ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) method unselect_child ~callback = self#connect Tree.S.unselect_child ~callback:(fun w -> callback (new tree_item (TreeItem.cast w))) end and tree obj = object (self) inherit [tree_item] item_container obj method event = new GObj.event_ops obj method as_tree = (obj :> Gtk.tree obj) method insert w ~pos = Tree.insert obj w#as_item ~pos method connect = new tree_signals obj method clear_items = Tree.clear_items obj method select_item = Tree.select_item obj method unselect_item = Tree.unselect_item obj method child_position (w : tree_item) = Tree.child_position obj w#as_item method remove_items items = Tree.remove_items obj (List.map ~f:(fun (t : tree_item) -> t#as_item) items) method set_selection_mode = Tree.set_selection_mode obj method set_view_mode = Tree.set_view_mode obj method set_view_lines = Tree.set_view_lines obj method selection = List.map ~f:(fun w -> self#wrap (w :> Gtk.widget obj)) (Tree.selection obj) method private wrap w = new tree_item (TreeItem.cast w) end let tree_item ?label ?packing ?show () = let w = TreeItem.create ?label () in let self = new tree_item w in may packing ~f:(fun f -> (f self : unit)); if show <> Some false then self#misc#show (); self let tree ?selection_mode ?view_mode ?view_lines = GContainer.pack_container [] ~create:(fun p -> let w = Tree.create p in Tree.set w ?selection_mode ?view_mode ?view_lines; new tree w) (* Obsolete OldEditable / Text widget *) class old_editable_signals obj = object inherit widget_signals_impl (obj : [>old_editable] obj) inherit OgtkEditProps.editable_sigs inherit old_editable_sigs end class text obj = object (self) inherit GEdit.editable (obj : Gtk.text obj) as super inherit text_props method connect = new old_editable_signals obj method event = new GObj.event_ops obj method get_chars ~start ~stop:e = if start < 0 || e > Text.get_length obj || e < start then invalid_arg "GBroken.text#get_chars"; super#get_chars ~start ~stop:e method set_point = Text.set_point obj method point = Text.get_point obj method length = Text.get_length obj method freeze () = Text.freeze obj method thaw () = Text.thaw obj method insert ?font ?foreground ?background text = let colormap = try Some self#misc#colormap with _ -> None in Text.insert obj text ?font ?foreground:(may_map foreground ~f:(GDraw.color ?colormap)) ?background:(may_map background ~f:(GDraw.color ?colormap)) method forward_delete = Text.forward_delete obj method backward_delete = Text.backward_delete obj end let text ?hadjustment ?vadjustment = let hadjustment = may_map GData.as_adjustment hadjustment in let vadjustment = may_map GData.as_adjustment vadjustment in Text.make_params [] ?hadjustment ?vadjustment ~cont: (fun p ?packing ?show () -> pack_return (new text (Text.create p)) ~packing ~show) lablgtk-2.18.8/src/gutf8.mli0000644000175000017500000000703513460263323014620 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** Pure ocaml module for conversion between UCS and UTF8 *) type unichar = int type unistring = unichar array (** [from_unichar 0xiii] converts a code point [iii] (usually in hexadecimal form) into a string containing the UTF-8 encoded character [0xiii]. See {{:http://www.unicode.org/}unicode.org} for charmaps. Does not check that the given code point is a valid unicode point. *) val from_unichar : unichar -> string val from_unistring : unistring -> string (** [to_unichar_validated] decodes an UTF-8 encoded code point and checks for incomplete characters, invalid characters and overlong encodings. @raise Convert.Error if invalid *) val to_unichar_validated : string -> pos:int ref -> unichar (** [to_unichar] decodes an UTF-8 encoded code point. Result is undefined if [pos] does not point to a valid UTF-8 encoded character. *) val to_unichar : string -> pos:int ref -> unichar (** [to_unistring] decodes an UTF-8 encoded string into an array of [unichar]. The string {e must} be valid. *) val to_unistring : string -> unistring (** [first_char] returns the first UTF-8 encoded code point. *) val first_char : string -> unichar (** [next] returns the position of the code point following the one at [pos]. *) val next : string -> pos:int -> int (** [length] returns the number of code-points in the UTF-8 encode string *) val length : string -> int (** [to_unichar_validated] may raise [PARTIAL_INPUT] or [ILLEGAL_SEQUENCE] *) module Error : sig type error = | NO_CONVERSION (** Conversion between the requested character sets is not supported *) | ILLEGAL_SEQUENCE (** Invalid byte sequence in conversion input *) | FAILED (** Conversion failed for some reason *) | PARTIAL_INPUT (** Partial character sequence at end of input *) | BAD_URI (** URI is invalid *) | NOT_ABSOLUTE_PATH (** Pathname is not an absolute path *) exception Error of error * string val raise_bad_utf8 : unit -> 'a end lablgtk-2.18.8/src/gtkSourceView.ml0000644000175000017500000003243713460263323016217 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open GtkSourceView_types open Gaux open Gobject open Gtk open Tags open GtkSourceViewProps open GtkBase (* external gslist_of_string_list: string list -> 'a obj = "ml_gslist_of_string_list" *) external _gtk_source_tag_style_init: unit -> unit = "ml_gtk_source_tag_style_init" external _gtk_source_tag_init: unit -> unit = "ml_gtk_source_tag_init" external _gtk_source_tag_table_init: unit -> unit = "ml_gtk_source_tag_table_init" external _gtk_source_style_scheme_init: unit -> unit = "ml_gtk_source_style_scheme_init" external _gtk_source_language_init: unit -> unit = "ml_gtk_source_language_init" external _gtk_source_languages_manager_init: unit -> unit = "ml_gtk_source_languages_manager_init" external _gtk_source_marker_init: unit -> unit = "ml_gtk_source_marker_init" external _gtk_source_buffer_init: unit -> unit = "ml_gtk_source_buffer_init" external _gtk_source_view_init: unit -> unit = "ml_gtk_source_view_init" let () = _gtk_source_style_scheme_init (); _gtk_source_language_init (); _gtk_source_languages_manager_init (); _gtk_source_tag_style_init (); _gtk_source_tag_init (); _gtk_source_tag_table_init (); _gtk_source_marker_init (); _gtk_source_buffer_init (); _gtk_source_view_init () module SourceStyleScheme = struct include SourceStyleScheme external get_default: unit -> [>`sourcestylescheme] obj = "ml_gtk_source_style_scheme_get_default" external get_tag_style: source_style_scheme obj -> string -> source_tag_style obj option = "ml_gtk_source_style_scheme_get_tag_style" external get_name: source_style_scheme obj -> string = "ml_gtk_source_style_scheme_get_name" end module SourceLanguage = struct include SourceLanguage external new_from_file: string -> [>`sourcelanguagesmanager] obj -> source_language obj option = "ml__gtk_source_language_new_from_file" external get_name: [>`sourcelanguage] obj -> string = "ml_gtk_source_language_get_name" external get_section: [>`sourcelanguage] obj -> string = "ml_gtk_source_language_get_section" external get_tags: [>`sourcelanguage] obj -> source_tag obj list = "ml_gtk_source_language_get_tags" external get_escape_char: [>`sourcelanguage] obj -> Glib.unichar = "ml_gtk_source_language_get_escape_char" (* external get_mime_types: [>`sourcelanguage] obj -> string list *) (* external set_mime_types: [>`sourcelanguage] obj -> string list -> unit *) external get_style_scheme: [>`sourcelanguage] obj -> source_style_scheme obj = "ml_gtk_source_language_get_style_scheme" external set_style_scheme: [>`sourcelanguage] obj -> source_style_scheme obj -> unit = "ml_gtk_source_language_set_style_scheme" external get_tag_style: [>`sourcelanguage] obj -> string -> source_tag_style obj = "ml_gtk_source_language_get_tag_style" external set_tag_style: [>`sourcelanguage] obj -> string -> source_tag_style obj -> unit = "ml_gtk_source_language_set_tag_style" external get_tag_default_style: [>`sourcelanguage] obj -> string -> source_tag_style obj = "ml_gtk_source_language_get_tag_default_style" end module SourceLanguagesManager = struct include SourceLanguagesManager external new_: unit -> source_languages_manager obj = "ml_gtk_source_languages_manager_new" external get_available_languages: [>`sourcelanguagesmanager] obj -> source_language obj list = "ml_gtk_source_languages_manager_get_available_languages" external get_language_from_mime_type: [>`sourcelanguagesmanager] obj -> string -> source_language obj option = "ml_gtk_source_languages_manager_get_language_from_mime_type" external get_lang_files_dirs: [>`sourcelanguagesmanager] obj -> string list = "ml_gtk_source_languages_manager_get_lang_files_dirs" (* external set_lang_files_dirs: [>`sourcelanguagesmanager] obj -> string list -> unit = "ml_gtk_source_languages_manager_set_lang_files_dirs" *) end module SourceTagStyle = struct include SourceTagStyle external new_ : unit -> source_tag_style obj = "ml_gtk_source_tag_style_new" external copy : source_tag_style obj -> source_tag_style obj = "ml_gtk_source_tag_style_copy" external get_background : source_tag_style obj -> Gdk.color = "ml_gtk_source_tag_style_get_background" external get_bold : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_bold" external get_foreground : source_tag_style obj -> Gdk.color = "ml_gtk_source_tag_style_get_foreground" external get_italic : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_italic" external get_strikethrough : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_strikethrough" external get_underline : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_underline" external get_use_background : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_use_background" external get_use_foreground : source_tag_style obj -> bool = "ml_gtk_source_tag_style_get_use_foreground" external set_background : source_tag_style obj -> Gdk.color -> unit = "ml_gtk_source_tag_style_set_background" external set_bold : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_bold" external set_foreground : source_tag_style obj -> Gdk.color -> unit = "ml_gtk_source_tag_style_set_foreground" external set_italic : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_italic" external set_strikethrough : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_strikethrough" external set_underline : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_underline" external set_use_background : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_use_background" external set_use_foreground : source_tag_style obj -> bool -> unit = "ml_gtk_source_tag_style_set_use_foreground"end module SourceTag = struct include SourceTag external syntax_tag : id: string -> name: string -> pat_start: string -> pat_end: string -> source_tag obj = "ml_gtk_syntax_tag_new" external pattern_tag : id: string -> name: string -> pat: string -> source_tag obj = "ml_gtk_pattern_tag_new" external keyword_list_tag : id: string -> name: string -> keywords: string list -> case_sensitive: bool -> match_empty_string_at_beginning: bool -> match_empty_string_at_end: bool -> beginning_regex: string option -> end_regex: string option -> source_tag obj = "ml_gtk_keyword_list_tag_new_bc" "ml_gtk_keyword_list_tag_new" let block_comment_tag = syntax_tag external line_comment_tag : id: string -> name: string -> pat_start: string -> source_tag obj = "ml_gtk_line_comment_tag_new" external string_tag : id: string -> name: string -> pat_start: string -> pat_end: string -> end_at_line_end: bool -> source_tag obj = "ml_gtk_string_tag_new" external get_style : [> `sourcetag] obj -> [`sourcetagstyle] obj option = "ml_gtk_source_tag_get_style" external set_style : [> `sourcetag] obj -> [`sourcetagstyle] obj -> unit = "ml_gtk_source_tag_set_style" end module SourceTagTable = struct include SourceTagTable external new_ : unit -> source_tag_table obj = "ml_gtk_source_tag_table_new" external add_tags : [> `sourcetagtable] obj -> [> `sourcetag] obj list -> unit = "ml_gtk_source_tag_table_add_tags" external remove_source_tags : [> `sourcetagtable] obj -> unit = "ml_gtk_source_tag_table_remove_source_tags" end module SourceMarker = struct include SourceMarker external set_type : source_marker obj -> string -> unit = "ml_gtk_source_marker_set_marker_type" external get_type : source_marker obj -> string = "ml_gtk_source_marker_get_marker_type" external get_line : source_marker obj -> int = "ml_gtk_source_marker_get_line" external get_name : source_marker obj -> string = "ml_gtk_source_marker_get_name" external get_buffer : source_marker obj -> source_buffer obj = "ml_gtk_source_marker_get_buffer" external next : source_marker obj -> source_marker obj = "ml_gtk_source_marker_next" external prev : source_marker obj -> source_marker obj = "ml_gtk_source_marker_prev" end module SourceBuffer = struct include SourceBuffer external new_: [`sourcetagtable] obj -> source_buffer obj = "ml_gtk_source_buffer_new" external new_with_langage: [>`sourcelanguage] obj -> source_buffer obj = "ml_gtk_source_buffer_new_with_language" external can_undo: [>`sourcebuffer] obj -> bool = "ml_gtk_source_buffer_can_undo" external can_redo: [>`sourcebuffer] obj -> bool = "ml_gtk_source_buffer_can_redo" external undo: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_undo" external redo: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_redo" external begin_not_undoable_action: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_begin_not_undoable_action" external end_not_undoable_action: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_end_not_undoable_action" external set_bracket_match_style: [>`sourcebuffer] obj -> source_tag_style obj -> unit = "ml_gtk_source_buffer_set_bracket_match_style" external create_marker: [>`sourcebuffer] obj -> string option -> string option -> Gtk.text_iter -> source_marker obj = "ml_gtk_source_buffer_create_marker" external move_marker: [>`sourcebuffer] obj -> source_marker obj -> Gtk.text_iter -> unit = "ml_gtk_source_buffer_move_marker" external delete_marker: [>`sourcebuffer] obj -> source_marker obj -> unit = "ml_gtk_source_buffer_delete_marker" external get_marker: [>`sourcebuffer] obj -> string -> source_marker obj option = "ml_gtk_source_buffer_get_marker" external get_markers_in_region: [>`sourcebuffer] obj -> Gtk.text_iter -> Gtk.text_iter -> source_marker obj list = "ml_gtk_source_buffer_get_markers_in_region" external get_iter_at_marker: [>`sourcebuffer] obj -> source_marker obj -> Gtk.text_iter = "ml_gtk_source_buffer_get_iter_at_marker" external get_first_marker: [>`sourcebuffer] obj -> source_marker obj option = "ml_gtk_source_buffer_get_first_marker" external get_last_marker: [>`sourcebuffer] obj -> source_marker obj option = "ml_gtk_source_buffer_get_last_marker" external get_next_marker: [>`sourcebuffer] obj -> Gtk.text_iter -> source_marker obj option = "ml_gtk_source_buffer_get_next_marker" external get_prev_marker: [>`sourcebuffer] obj -> Gtk.text_iter -> source_marker obj option = "ml_gtk_source_buffer_get_prev_marker" end module SourceView = struct include SourceView external new_: unit -> source_view obj = "ml_gtk_source_view_new" external new_with_buffer: [>`sourcebuffer] obj -> source_view obj = "ml_gtk_source_view_new_with_buffer" external set_marker_pixbuf: [>`sourceview] obj -> string -> GdkPixbuf.pixbuf -> unit = "ml_gtk_source_view_set_marker_pixbuf" external get_marker_pixbuf: [>`sourceview] obj -> string -> GdkPixbuf.pixbuf = "ml_gtk_source_view_get_marker_pixbuf" external set_cursor_color: [>`sourceview] obj -> Gdk.color -> unit = "ml_gtk_modify_cursor_color" end module SourceViewMisc = struct external find_matching_bracket: text_iter -> bool = "ml_gtk_source_iter_find_matching_bracket" external iter_backward_search: Gtk.text_iter -> string -> SourceViewEnums.source_search_flag list -> start: Gtk.text_iter -> stop: Gtk.text_iter -> Gtk.text_iter option -> (Gtk.text_iter * Gtk.text_iter) option = "ml_gtk_source_iter_backward_search_bc" "ml_gtk_source_iter_backward_search" external iter_forward_search: Gtk.text_iter -> string -> SourceViewEnums.source_search_flag list -> start: Gtk.text_iter -> stop: Gtk.text_iter -> Gtk.text_iter option -> (Gtk.text_iter * Gtk.text_iter) option = "ml_gtk_source_iter_forward_search_bc" "ml_gtk_source_iter_forward_search" end lablgtk-2.18.8/src/gtkAction.props0000644000175000017500000000757013460263323016074 0ustar stephsteph prefix "Gtk" conversions { GtkStockId "GtkStock.conv" } class Action type "Gtk.action obj" wrap wrapsig gobject { "hide-if-empty" gboolean : Read / Write "is-important" gboolean : Read / Write "label" gchararray : Read / Write "icon-name" gchararray : Read / Write "name" gchararray : Read / Write / Construct Only "sensitive" gboolean : Read / Write "short-label" gchararray : Read / Write "stock-id" GtkStockId : Read / Write "tooltip" gchararray : Read / Write "visible" gboolean : Read / Write "visible-horizontal" gboolean : Read / Write "visible-vertical" gboolean : Read / Write signal activate method is_sensitive : "bool" method is_visible : "bool" method activate method connect_proxy : "Gtk.widget Gtk.obj -> unit" method disconnect_proxy : "Gtk.widget Gtk.obj -> unit" method get_proxies : "Gtk.widget Gtk.obj list" method connect_accelerator method disconnect_accelerator method set_accel_path : "string -> unit" method set_accel_group : "Gtk.accel_group -> unit" method block_activate_from : "Gtk.widget Gtk.obj -> unit" method unblock_activate_from : "Gtk.widget Gtk.obj -> unit" } class ToggleAction type "Gtk.toggle_action obj" wrap wrapsig gobject : Action { "draw-as-radio" gboolean : Read / Write signal toggled method toggled method set_active : "bool -> unit" method get_active : "bool" } class RadioAction type "Gtk.radio_action obj" wrap gobject : ToggleAction { "group" GtkRadioAction_opt : Write "value" gint : Read / Write signal changed : GtkRadioAction method get_current_value : "int" method set_group : "Gtk.radio_action Gtk.group -> unit" } class UIManager type "Gtk.ui_manager obj" wrap wrapsig gobject { "add-tearoffs" gboolean : Read / Write "ui" gchararray : Read signal actions_changed signal add_widget : GtkWidget signal connect_proxy : GtkAction GtkWidget / NoWrap signal disconnect_proxy : GtkAction GtkWidget / NoWrap signal post_activate : GtkAction / NoWrap signal pre_activate : GtkAction / NoWrap method insert_action_group : "Gtk.action_group obj -> int -> unit" method remove_action_group : "Gtk.action_group obj -> unit" method get_action_groups : "Gtk.action_group obj list" method get_accel_group : "Gtk.accel_group" method get_widget : "string -> Gtk.widget Gtk.obj" method get_toplevels : "GtkEnums.ui_manager_item_type list -> Gtk.widget Gtk.obj list" method get_action : "string -> Gtk.action obj" method add_ui_from_string : "string -> int" method add_ui_from_file: "string -> int" method new_merge_id : "int" method add_ui : "int -> path:string -> name:string -> action:string option -> GtkEnums.ui_manager_item_type -> top:bool -> unit" method remove_ui : "int -> unit" method ensure_update } class ActionGroup type "Gtk.action_group obj" wrap wrapsig gobject { "name" gchararray : Read / Write / Construct Only "sensitive" gboolean : Read / Write "visible" gboolean : Read / Write signal connect_proxy : GtkAction GtkWidget / NoWrap signal disconnect_proxy : GtkAction GtkWidget / NoWrap signal post_activate : GtkAction / NoWrap signal pre_activate : GtkAction / NoWrap method get_action : "string -> Gtk.action obj" method list_actions : "Gtk.action obj list" method add_action : "Gtk.action obj -> unit" method add_action_with_accel : "Gtk.action obj -> string option -> unit" method remove_action : "Gtk.action obj -> unit" } lablgtk-2.18.8/src/ml_gtk.h0000644000175000017500000000525513460263323014510 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* GObjects */ #define Val_GtkAccelGroup(val) (Val_GObject(&val->parent)) #define Val_GtkStyle(val) (Val_GObject(&val->parent_instance)) #define GtkAccelGroup_val(val) check_cast(GTK_ACCEL_GROUP,val) #define GtkStyle_val(val) check_cast(GTK_STYLE,val) /* GtkObjects */ CAMLexport value Val_GtkObject_sink (GtkObject *w); #define Val_GtkAny(w) (Val_GObject((GObject*)w)) #define Val_GtkAny_sink(w) (Val_GtkObject_sink(GTK_OBJECT(w))) #define Val_GtkWidget Val_GtkAny #define Val_GtkWidget_sink Val_GtkAny_sink /* For GList containing widgets */ CAMLexport value Val_GtkWidget_func(gpointer w); #define GtkObject_val(val) check_cast(GTK_OBJECT,val) #define GtkWidget_val(val) check_cast(GTK_WIDGET,val) #define GtkAdjustment_val(val) check_cast(GTK_ADJUSTMENT,val) #define GtkItem_val(val) check_cast(GTK_ITEM,val) #define GtkTooltips_val(val) check_cast(GTK_TOOLTIPS,val) #define GtkClipboard_val(val) ((GtkClipboard*)Pointer_val(val)) #define GtkWindow_val(val) check_cast(GTK_WINDOW,val) #define GtkTooltip_val(val) check_cast(GTK_TOOLTIP,val) CAMLprim int Flags_Target_flags_val (value list); lablgtk-2.18.8/src/ml_gtklist.c0000644000175000017500000002305313460263323015373 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" Make_Flags_val (Button_action_val) /* Init all */ CAMLprim value ml_gtklist_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_list_item_get_type() + gtk_list_get_type() + gtk_clist_get_type(); return Val_GType(t); } /* gtklistitem.h */ ML_0 (gtk_list_item_new, Val_GtkWidget_sink) ML_1 (gtk_list_item_new_with_label, String_val, Val_GtkWidget_sink) /* gtklist.h */ #define GtkList_val(val) check_cast(GTK_LIST,val) ML_0 (gtk_list_new, Val_GtkWidget_sink) CAMLprim value ml_gtk_list_insert_item (value list, value item, value pos) { GList *tmp_list = g_list_alloc (); tmp_list->data = GtkWidget_val(item); tmp_list->next = NULL; tmp_list->prev = NULL; gtk_list_insert_items (GtkList_val(list), tmp_list, Int_val(pos)); return Val_unit; } ML_3 (gtk_list_clear_items, GtkList_val, Int_val, Int_val, Unit) ML_2 (gtk_list_select_item, GtkList_val, Int_val, Unit) ML_2 (gtk_list_unselect_item, GtkList_val, Int_val, Unit) ML_2 (gtk_list_select_child, GtkList_val, GtkWidget_val, Unit) ML_2 (gtk_list_unselect_child, GtkList_val, GtkWidget_val, Unit) ML_2 (gtk_list_child_position, GtkList_val, GtkWidget_val, Val_int) /* gtkclist.h */ #define GtkCList_val(val) check_cast(GTK_CLIST,val) ML_1 (gtk_clist_new, Int_val, Val_GtkWidget_sink) ML_1 (gtk_clist_new_with_titles, Insert(Wosize_val(arg1)) (char **), Val_GtkWidget_sink) Make_Extractor (gtk_clist_get, GtkCList_val, rows, Val_int) Make_Extractor (gtk_clist_get, GtkCList_val, columns, Val_int) Make_Extractor (gtk_clist_get, GtkCList_val, focus_row, Val_int) ML_2 (gtk_clist_set_hadjustment, GtkCList_val, GtkAdjustment_val, Unit) ML_2 (gtk_clist_set_vadjustment, GtkCList_val, GtkAdjustment_val, Unit) ML_1 (gtk_clist_get_hadjustment, GtkCList_val, Val_GtkAny) ML_1 (gtk_clist_get_vadjustment, GtkCList_val, Val_GtkAny) ML_2 (gtk_clist_set_shadow_type, GtkCList_val, Shadow_type_val, Unit) ML_2 (gtk_clist_set_selection_mode, GtkCList_val, Selection_mode_val, Unit) ML_2 (gtk_clist_set_reorderable, GtkCList_val, Bool_val, Unit) ML_2 (gtk_clist_set_use_drag_icons, GtkCList_val, Bool_val, Unit) ML_3 (gtk_clist_set_button_actions, GtkCList_val, Int_val, (guint8)Flags_Button_action_val, Unit) ML_1 (gtk_clist_freeze, GtkCList_val, Unit) ML_1 (gtk_clist_thaw, GtkCList_val, Unit) ML_1 (gtk_clist_column_titles_show, GtkCList_val, Unit) ML_1 (gtk_clist_column_titles_hide, GtkCList_val, Unit) ML_2 (gtk_clist_column_title_active, GtkCList_val, Int_val, Unit) ML_2 (gtk_clist_column_title_passive, GtkCList_val, Int_val, Unit) ML_1 (gtk_clist_column_titles_active, GtkCList_val, Unit) ML_1 (gtk_clist_column_titles_passive, GtkCList_val, Unit) ML_3 (gtk_clist_set_column_title, GtkCList_val, Int_val, String_val, Unit) ML_2 (gtk_clist_get_column_title, GtkCList_val, Int_val, Val_string) ML_3 (gtk_clist_set_column_widget, GtkCList_val, Int_val, GtkWidget_val, Unit) ML_2 (gtk_clist_get_column_widget, GtkCList_val, Int_val, Val_GtkWidget) ML_3 (gtk_clist_set_column_justification, GtkCList_val, Int_val, Justification_val, Unit) ML_3 (gtk_clist_set_column_visibility, GtkCList_val, Int_val, Bool_val, Unit) ML_3 (gtk_clist_set_column_resizeable, GtkCList_val, Int_val, Bool_val, Unit) ML_3 (gtk_clist_set_column_auto_resize, GtkCList_val, Int_val, Bool_val, Unit) ML_1 (gtk_clist_columns_autosize, GtkCList_val, Unit) ML_2 (gtk_clist_optimal_column_width, GtkCList_val, Int_val, Val_int) ML_3 (gtk_clist_set_column_width, GtkCList_val, Int_val, Int_val, Unit) ML_3 (gtk_clist_set_column_min_width, GtkCList_val, Int_val, Int_val, Unit) ML_3 (gtk_clist_set_column_max_width, GtkCList_val, Int_val, Int_val, Unit) ML_2 (gtk_clist_set_row_height, GtkCList_val, Int_val, Unit) ML_5 (gtk_clist_moveto, GtkCList_val, Int_val, Int_val, Double_val, Double_val, Unit) ML_2 (gtk_clist_row_is_visible, GtkCList_val, Int_val, Val_visibility) ML_3 (gtk_clist_get_cell_type, GtkCList_val, Int_val, Int_val, Val_cell_type) ML_4 (gtk_clist_set_text, GtkCList_val, Int_val, Int_val, Optstring_val, Unit) CAMLprim value ml_gtk_clist_get_text (value clist, value row, value column) { char *text; if (!gtk_clist_get_text (GtkCList_val(clist), Int_val(row), Int_val(column), &text)) invalid_argument ("Gtk.Clist.get_text"); return Val_optstring(text); } ML_5 (gtk_clist_set_pixmap, GtkCList_val, Int_val, Int_val, GdkPixmap_val, (GdkBitmap*)Pointer_val, Unit) CAMLprim value ml_gtk_clist_get_pixmap (value clist, value row, value column) { CAMLparam0 (); GdkPixmap *pixmap; GdkBitmap *bitmap; CAMLlocal2 (vpixmap,vbitmap); value ret; if (!gtk_clist_get_pixmap (GtkCList_val(clist), Int_val(row), Int_val(column), &pixmap, &bitmap)) invalid_argument ("Gtk.Clist.get_pixmap"); vpixmap = Val_option (pixmap, Val_GdkPixmap); vbitmap = Val_option (bitmap, Val_GdkBitmap); ret = alloc_small (2,0); Field(ret,0) = vpixmap; Field(ret,1) = vbitmap; CAMLreturn(ret); } ML_7 (gtk_clist_set_pixtext, GtkCList_val, Int_val, Int_val, String_val, (guint8)Long_val, GdkPixmap_val, (GdkBitmap*)Pointer_val, Unit) ML_bc7 (ml_gtk_clist_set_pixtext) ML_3 (gtk_clist_set_foreground, GtkCList_val, Int_val, GdkColor_val, Unit) ML_3 (gtk_clist_set_background, GtkCList_val, Int_val, GdkColor_val, Unit) ML_3 (gtk_clist_get_cell_style, GtkCList_val, Int_val, Int_val, Val_GtkStyle) ML_4 (gtk_clist_set_cell_style, GtkCList_val, Int_val, Int_val, GtkStyle_val, Unit) ML_2 (gtk_clist_get_row_style, GtkCList_val, Int_val, Val_GtkStyle) ML_3 (gtk_clist_set_row_style, GtkCList_val, Int_val, GtkStyle_val, Unit) ML_3 (gtk_clist_set_selectable, GtkCList_val, Int_val, Bool_val, Unit) ML_2 (gtk_clist_get_selectable, GtkCList_val, Int_val, Val_bool) ML_5 (gtk_clist_set_shift, GtkCList_val, Int_val, Int_val, Int_val, Int_val, Unit) /* ML_2 (gtk_clist_append, GtkCList_val, (char **), Val_int) */ ML_3 (gtk_clist_insert, GtkCList_val, Int_val, (char **), Val_int) ML_2 (gtk_clist_remove, GtkCList_val, Int_val, Unit) CAMLprim value ml_gtk_clist_set_row_data (value w, value row, value data) { value *data_p = ml_global_root_new (data); gtk_clist_set_row_data_full (GtkCList_val(w), Int_val(row), data_p, ml_global_root_destroy); return Val_unit; } ML_2 (gtk_clist_get_row_data, GtkCList_val, Int_val, *(value*)Check_null) ML_3 (gtk_clist_select_row, GtkCList_val, Int_val, Int_val, Unit) ML_3 (gtk_clist_unselect_row, GtkCList_val, Int_val, Int_val, Unit) ML_1 (gtk_clist_clear, GtkCList_val, Unit) CAMLprim value ml_gtk_clist_get_selection_info (value clist, value x, value y) { int row, column; value ret; if (!gtk_clist_get_selection_info (GtkCList_val(clist), Int_val(x), Int_val(y), &row, &column)) invalid_argument ("Gtk.Clist.get_row_column"); ret = alloc_small (2,0); Field(ret,0) = Val_int(row); Field(ret,1) = Val_int(column); return ret; } ML_1 (gtk_clist_select_all, GtkCList_val, Unit) ML_1 (gtk_clist_unselect_all, GtkCList_val, Unit) ML_3 (gtk_clist_swap_rows, GtkCList_val, Int_val, Int_val, Unit) ML_3 (gtk_clist_row_move, GtkCList_val, Int_val, Int_val, Unit) ML_2 (gtk_clist_set_sort_column, GtkCList_val, Int_val, Unit) ML_2 (gtk_clist_set_sort_type, GtkCList_val, Sort_type_val, Unit) ML_1 (gtk_clist_sort, GtkCList_val, Unit) ML_2 (gtk_clist_set_auto_sort, GtkCList_val, Bool_val, Unit) ML_1 (Scroll_type_val, ID, Val_long) CAMLprim value ml_gtk_clist_get_row_state (value clist, value y) { GtkCListRow *row; GList *list; gint row_num; list = GtkCList_val(clist)->row_list; for (row_num=0; row_num < Int_val(y) ; row_num++) { if (list == NULL) invalid_argument ("Gtk.Clist.get_row_state"); list = list->next; } row = list->data; return (Val_state_type (row->state)); } lablgtk-2.18.8/src/gtkText.ml0000644000175000017500000004524013460263323015044 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open Tags open GtkTextProps open GtkBase external _gtktext_init : unit -> unit = "ml_gtktext_init" let () = _gtktext_init () exception No_such_mark of string module Mark = TextMark module Tag = TextTag module TagTable = TextTagTable module Buffer = struct open Gpointer include TextBuffer external get_line_count : text_buffer -> int = "ml_gtk_text_buffer_get_line_count" external get_char_count : text_buffer -> int = "ml_gtk_text_buffer_get_char_count" (* external get_tag_table : text_buffer -> text_tag_table = "ml_gtk_text_buffer_get_tag_table" *) external insert : text_buffer -> text_iter -> string stable -> unit = "ml_gtk_text_buffer_insert" let insert a b c = insert a b (stable_copy c) external insert_at_cursor : text_buffer -> string stable -> unit = "ml_gtk_text_buffer_insert_at_cursor" let insert_at_cursor a b = insert_at_cursor a (stable_copy b) external insert_interactive : text_buffer -> text_iter -> string stable -> bool -> bool = "ml_gtk_text_buffer_insert_interactive" let insert_interactive a b c = insert_interactive a b (stable_copy c) external insert_interactive_at_cursor : text_buffer -> string stable -> bool -> bool = "ml_gtk_text_buffer_insert_interactive_at_cursor" let insert_interactive_at_cursor a b = insert_interactive_at_cursor a (stable_copy b) external insert_range : text_buffer -> text_iter -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_insert_range" external insert_range_interactive : text_buffer -> text_iter -> text_iter -> text_iter -> bool -> bool = "ml_gtk_text_buffer_insert_range_interactive" external delete : text_buffer -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_delete" external delete_interactive : text_buffer -> text_iter -> text_iter -> bool -> bool = "ml_gtk_text_buffer_delete_interactive" external set_text : text_buffer -> string stable -> unit = "ml_gtk_text_buffer_set_text" let set_text b s = set_text b (stable_copy s) external get_text : text_buffer -> text_iter -> text_iter -> bool -> string = "ml_gtk_text_buffer_get_text" external get_slice : text_buffer -> text_iter -> text_iter -> bool -> string = "ml_gtk_text_buffer_get_slice" external insert_pixbuf : text_buffer -> text_iter -> GdkPixbuf.pixbuf -> unit = "ml_gtk_text_buffer_insert_pixbuf" external create_mark : text_buffer -> string option -> text_iter -> bool -> text_mark = "ml_gtk_text_buffer_create_mark" external move_mark : text_buffer -> text_mark -> text_iter -> unit = "ml_gtk_text_buffer_move_mark" external move_mark_by_name : text_buffer -> string -> text_iter -> unit = "ml_gtk_text_buffer_move_mark_by_name" external delete_mark : text_buffer -> text_mark -> unit = "ml_gtk_text_buffer_delete_mark" external delete_mark_by_name : text_buffer -> string -> unit = "ml_gtk_text_buffer_delete_mark_by_name" external get_mark : text_buffer -> string -> text_mark option = "ml_gtk_text_buffer_get_mark" external get_insert : text_buffer -> text_mark = "ml_gtk_text_buffer_get_insert" external get_selection_bound : text_buffer -> text_mark = "ml_gtk_text_buffer_get_selection_bound" external place_cursor : text_buffer -> text_iter -> unit = "ml_gtk_text_buffer_place_cursor" external select_range : text_buffer -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_select_range" external apply_tag : text_buffer -> text_tag -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_apply_tag" external remove_tag : text_buffer -> text_tag -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_remove_tag" external apply_tag_by_name : text_buffer -> string -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_apply_tag_by_name" external remove_tag_by_name : text_buffer -> string -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_remove_tag_by_name" external remove_all_tags : text_buffer -> text_iter -> text_iter -> unit = "ml_gtk_text_buffer_remove_all_tags" external create_tag_0 : text_buffer -> string option -> text_tag = "ml_gtk_text_buffer_create_tag_0" external create_tag_2 : text_buffer -> string option -> string -> string -> text_tag = "ml_gtk_text_buffer_create_tag_2" external get_iter_at_line_offset : text_buffer -> int -> int -> text_iter = "ml_gtk_text_buffer_get_iter_at_line_offset" external get_iter_at_offset : text_buffer -> int -> text_iter = "ml_gtk_text_buffer_get_iter_at_offset" external get_iter_at_line : text_buffer -> int -> text_iter = "ml_gtk_text_buffer_get_iter_at_line" external get_iter_at_line_index : text_buffer -> int -> int -> text_iter = "ml_gtk_text_buffer_get_iter_at_line_index" external get_iter_at_mark : text_buffer -> text_mark -> text_iter = "ml_gtk_text_buffer_get_iter_at_mark" external get_start_iter : text_buffer -> text_iter = "ml_gtk_text_buffer_get_start_iter" external get_end_iter : text_buffer -> text_iter = "ml_gtk_text_buffer_get_end_iter" external get_bounds : text_buffer -> text_iter * text_iter = "ml_gtk_text_buffer_get_bounds" external get_modified : text_buffer -> bool = "ml_gtk_text_buffer_get_modified" external set_modified : text_buffer -> bool -> unit = "ml_gtk_text_buffer_set_modified" external delete_selection : text_buffer -> bool -> bool -> bool = "ml_gtk_text_buffer_delete_selection" external get_selection_bounds : text_buffer -> text_iter * text_iter = "ml_gtk_text_buffer_get_selection_bounds" external begin_user_action : text_buffer -> unit = "ml_gtk_text_buffer_begin_user_action" external end_user_action : text_buffer -> unit = "ml_gtk_text_buffer_end_user_action" external create_child_anchor : text_buffer -> text_iter -> text_child_anchor = "ml_gtk_text_buffer_create_child_anchor" external insert_child_anchor : text_buffer -> text_iter -> text_child_anchor -> unit = "ml_gtk_text_buffer_insert_child_anchor" external paste_clipboard : text_buffer -> clipboard -> text_iter option -> bool -> unit = "ml_gtk_text_buffer_paste_clipboard" external copy_clipboard : text_buffer -> clipboard -> unit = "ml_gtk_text_buffer_copy_clipboard" external cut_clipboard : text_buffer -> clipboard -> bool -> unit = "ml_gtk_text_buffer_cut_clipboard" external add_selection_clipboard : text_buffer -> clipboard -> unit = "ml_gtk_text_buffer_add_selection_clipboard" external remove_selection_clipboard : text_buffer -> clipboard -> unit = "ml_gtk_text_buffer_remove_selection_clipboard" end module ChildAnchor = TextChildAnchor module View = struct include TextView external create_with_buffer : text_buffer -> text_view obj = "ml_gtk_text_view_new_with_buffer" external set_buffer : [>`textview] obj -> text_buffer -> unit = "ml_gtk_text_view_set_buffer" external get_buffer : [>`textview] obj -> text_buffer = "ml_gtk_text_view_get_buffer" external scroll_to_mark : [>`textview] obj -> text_mark -> float -> bool -> float -> float -> unit = "ml_gtk_text_view_scroll_to_mark_bc" "ml_gtk_text_view_scroll_to_mark" external scroll_to_iter : [>`textview] obj -> text_iter -> float -> bool -> float -> float -> bool = "ml_gtk_text_view_scroll_to_iter_bc" "ml_gtk_text_view_scroll_to_iter" external scroll_mark_onscreen : [>`textview] obj -> text_mark -> unit = "ml_gtk_text_view_scroll_mark_onscreen" external move_mark_onscreen : [>`textview] obj -> text_mark -> bool = "ml_gtk_text_view_move_mark_onscreen" external place_cursor_onscreen : [>`textview] obj -> bool = "ml_gtk_text_view_place_cursor_onscreen" external get_visible_rect : [>`textview] obj -> Gdk.Rectangle.t = "ml_gtk_text_view_get_visible_rect" external get_iter_location : [>`textview] obj -> text_iter -> Gdk.Rectangle.t = "ml_gtk_text_view_get_iter_location" external get_line_at_y : [>`textview] obj -> int -> text_iter*int = "ml_gtk_text_view_get_line_at_y" external get_line_yrange : [>`textview] obj -> text_iter -> int*int = "ml_gtk_text_view_get_line_yrange" external get_iter_at_location : [>`textview] obj -> int -> int -> text_iter = "ml_gtk_text_view_get_iter_at_location" external buffer_to_window_coords : [>`textview] obj -> Gtk.Tags.text_window_type -> int -> int -> int*int = "ml_gtk_text_view_buffer_to_window_coords" external window_to_buffer_coords : [>`textview] obj -> Gtk.Tags.text_window_type -> int -> int -> int*int = "ml_gtk_text_view_window_to_buffer_coords" external get_window : [>`textview] obj -> Gtk.Tags.text_window_type -> Gdk.window option = "ml_gtk_text_view_get_window" external get_window_type : [>`textview] obj -> Gdk.window -> Gtk.Tags.text_window_type = "ml_gtk_text_view_get_window_type" external set_border_window_size : [>`textview] obj -> Gtk.Tags.side_type -> int -> unit = "ml_gtk_text_view_set_border_window_size" external get_border_window_size : [>`textview] obj -> Gtk.Tags.side_type -> int = "ml_gtk_text_view_get_border_window_size" external forward_display_line : [>`textview] obj -> text_iter -> bool = "ml_gtk_text_view_forward_display_line" external backward_display_line : [>`textview] obj -> text_iter -> bool = "ml_gtk_text_view_backward_display_line" external forward_display_line_end : [>`textview] obj -> text_iter -> bool = "ml_gtk_text_view_forward_display_line_end" external backward_display_line_start : [>`textview] obj -> text_iter -> bool = "ml_gtk_text_view_backward_display_line_start" external starts_display_line : [>`textview] obj -> text_iter -> bool = "ml_gtk_text_view_starts_display_line" external move_visually : [>`textview] obj -> text_iter -> int -> bool = "ml_gtk_text_view_move_visually" external add_child_at_anchor : [>`textview] obj -> [>`widget] obj -> text_child_anchor -> unit = "ml_gtk_text_view_add_child_at_anchor" external add_child_in_window : [>`textview] obj -> [>`widget] obj -> text_window_type -> int -> int -> unit = "ml_gtk_text_view_add_child_in_window" external move_child : [>`textview] obj -> [>`widget] obj -> int -> int -> unit = "ml_gtk_text_view_move_child" end module Iter = struct external copy : text_iter -> text_iter = "ml_gtk_text_iter_copy" external assign : text_iter -> text_iter -> unit = "ml_gtk_text_iter_assign" external get_buffer : text_iter -> text_buffer = "ml_gtk_text_iter_get_buffer" external get_offset : text_iter -> int = "ml_gtk_text_iter_get_offset" external get_line : text_iter -> int = "ml_gtk_text_iter_get_line" external get_line_offset : text_iter -> int = "ml_gtk_text_iter_get_line_offset" external get_line_index : text_iter -> int = "ml_gtk_text_iter_get_line_index" external get_visible_line_index : text_iter -> int = "ml_gtk_text_iter_get_visible_line_index" external get_visible_line_offset : text_iter -> int = "ml_gtk_text_iter_get_visible_line_offset" external get_char : text_iter -> Glib.unichar = "ml_gtk_text_iter_get_char" external get_slice : text_iter -> text_iter -> string = "ml_gtk_text_iter_get_slice" external get_text : text_iter -> text_iter -> string = "ml_gtk_text_iter_get_text" external get_visible_slice : text_iter -> text_iter -> string = "ml_gtk_text_iter_get_visible_slice" external get_visible_text : text_iter -> text_iter -> string = "ml_gtk_text_iter_get_visible_text" external get_pixbuf : text_iter -> GdkPixbuf.pixbuf option = "ml_gtk_text_iter_get_pixbuf" external get_marks : text_iter -> text_mark list = "ml_gtk_text_iter_get_marks" external get_toggled_tags : text_iter -> bool -> text_tag list = "ml_gtk_text_iter_get_toggled_tags" external get_child_anchor : text_iter -> text_child_anchor option ="ml_gtk_text_iter_get_child_anchor" external begins_tag : text_iter -> text_tag option -> bool = "ml_gtk_text_iter_begins_tag" external ends_tag : text_iter -> text_tag option -> bool = "ml_gtk_text_iter_ends_tag" external toggles_tag : text_iter -> text_tag option -> bool = "ml_gtk_text_iter_toggles_tag" external has_tag : text_iter -> text_tag -> bool = "ml_gtk_text_iter_has_tag" external get_tags : text_iter -> text_tag list = "ml_gtk_text_iter_get_tags" external editable : text_iter -> default:bool -> bool = "ml_gtk_text_iter_editable" external can_insert : text_iter -> default:bool -> bool = "ml_gtk_text_iter_can_insert" external starts_word : text_iter -> bool = "ml_gtk_text_iter_starts_word" external ends_word : text_iter -> bool = "ml_gtk_text_iter_ends_word" external inside_word : text_iter -> bool = "ml_gtk_text_iter_inside_word" external starts_line : text_iter -> bool = "ml_gtk_text_iter_starts_line" external ends_line : text_iter -> bool = "ml_gtk_text_iter_ends_line" external starts_sentence : text_iter -> bool = "ml_gtk_text_iter_starts_sentence" external ends_sentence : text_iter -> bool = "ml_gtk_text_iter_ends_sentence" external inside_sentence : text_iter -> bool = "ml_gtk_text_iter_inside_sentence" external is_cursor_position : text_iter -> bool = "ml_gtk_text_iter_is_cursor_position" external get_chars_in_line : text_iter -> int = "ml_gtk_text_iter_get_chars_in_line" external get_bytes_in_line : text_iter -> int = "ml_gtk_text_iter_get_bytes_in_line" external get_language : text_iter -> Pango.language = "ml_gtk_text_iter_get_language" external is_end : text_iter -> bool = "ml_gtk_text_iter_is_end" external is_start : text_iter -> bool = "ml_gtk_text_iter_is_start" external forward_char : text_iter -> bool = "ml_gtk_text_iter_forward_char" external backward_char : text_iter -> bool = "ml_gtk_text_iter_backward_char" external forward_chars : text_iter -> int -> bool = "ml_gtk_text_iter_forward_chars" external backward_chars : text_iter -> int -> bool = "ml_gtk_text_iter_backward_chars" external forward_line : text_iter -> bool = "ml_gtk_text_iter_forward_line" external backward_line : text_iter -> bool = "ml_gtk_text_iter_backward_line" external forward_lines : text_iter -> int -> bool = "ml_gtk_text_iter_forward_lines" external backward_lines : text_iter -> int -> bool = "ml_gtk_text_iter_backward_lines" external forward_word_end : text_iter -> bool = "ml_gtk_text_iter_forward_word_end" external forward_word_ends : text_iter -> int -> bool = "ml_gtk_text_iter_forward_word_ends" external backward_word_start : text_iter -> bool = "ml_gtk_text_iter_backward_word_start" external backward_word_starts : text_iter -> int -> bool = "ml_gtk_text_iter_backward_word_starts" external forward_cursor_position : text_iter -> bool = "ml_gtk_text_iter_forward_cursor_position" external backward_cursor_position : text_iter -> bool = "ml_gtk_text_iter_backward_cursor_position" external forward_cursor_positions : text_iter -> int -> bool = "ml_gtk_text_iter_forward_cursor_positions" external backward_cursor_positions : text_iter -> int -> bool = "ml_gtk_text_iter_backward_cursor_positions" external forward_sentence_end : text_iter -> bool = "ml_gtk_text_iter_forward_sentence_end" external backward_sentence_start : text_iter -> bool = "ml_gtk_text_iter_backward_sentence_start" external forward_sentence_ends : text_iter -> int -> bool = "ml_gtk_text_iter_forward_sentence_ends" external backward_sentence_starts : text_iter -> int -> bool = "ml_gtk_text_iter_backward_sentence_starts" external set_offset : text_iter -> int -> unit = "ml_gtk_text_iter_set_offset" external set_line : text_iter -> int -> unit = "ml_gtk_text_iter_set_line" external set_line_offset : text_iter -> int -> unit = "ml_gtk_text_iter_set_line_offset" external set_line_index : text_iter -> int -> unit = "ml_gtk_text_iter_set_line_index" external set_visible_line_index : text_iter -> int -> unit = "ml_gtk_text_iter_set_visible_line_index" external set_visible_line_offset : text_iter -> int -> unit = "ml_gtk_text_iter_set_visible_line_offset" external forward_to_end : text_iter -> unit = "ml_gtk_text_iter_forward_to_end" external forward_to_line_end : text_iter -> bool = "ml_gtk_text_iter_forward_to_line_end" external forward_to_tag_toggle : text_iter -> text_tag option -> bool = "ml_gtk_text_iter_forward_to_tag_toggle" external backward_to_tag_toggle : text_iter -> text_tag option -> bool = "ml_gtk_text_iter_backward_to_tag_toggle" external equal : text_iter -> text_iter -> bool = "ml_gtk_text_iter_equal" external compare : text_iter -> text_iter -> int = "ml_gtk_text_iter_compare" external in_range : text_iter -> text_iter -> text_iter -> bool = "ml_gtk_text_iter_in_range" external order : text_iter -> text_iter -> unit = "ml_gtk_text_iter_order" external forward_search : text_iter -> string -> ?flags:text_search_flag list -> text_iter option -> (text_iter * text_iter) option = "ml_gtk_text_iter_forward_search" external backward_search : text_iter -> string -> ?flags:text_search_flag list -> text_iter option -> (text_iter * text_iter) option = "ml_gtk_text_iter_backward_search" external forward_find_char : text_iter -> (Glib.unichar -> bool) -> text_iter option -> bool = "ml_gtk_text_iter_forward_find_char" external backward_find_char : text_iter -> (Glib.unichar -> bool) -> text_iter option -> bool = "ml_gtk_text_iter_backward_find_char" end lablgtk-2.18.8/src/gtk_tags.var0000644000175000017500000001736213460263323015401 0ustar stephsteph(* Tags for GTK *) package "gtk" (* gtkenums.h *) type anchor_type = "GTK_ANCHOR_" [ `CENTER | `NORTH | `NW | `NE | `SOUTH | `SW | `SE | `WEST | `EAST ] type arrow_type = "GTK_ARROW_" [ `UP | `DOWN | `LEFT | `RIGHT ] type attach_options = "GTK_" [ `EXPAND | `SHRINK | `FILL ] type button_box_style = "GTK_BUTTONBOX_" [ `DEFAULT_STYLE | `SPREAD | `EDGE | `START | `END ] type curve_type = "GTK_CURVE_TYPE_" [ `LINEAR | `SPLINE | `FREE ] type delete_type = "GTK_DELETE_" [ `CHARS | `WORD_ENDS | `WORDS | `DISPLAY_LINES | `DISPLAY_LINE_ENDS | `PARAGRAPH_ENDS | `PARAGRAPHS | `WHITESPACE ] type direction_type = "GTK_DIR_" [ `TAB_FORWARD | `TAB_BACKWARD | `UP | `DOWN | `LEFT | `RIGHT ] type expander_style = "GTK_EXPANDER_" [ `COLLAPSED | `SEMI_COLLAPSED | `SEMI_EXPANDED | `EXPANDED ] type icon_size = "GTK_ICON_SIZE_" [ `INVALID | `MENU | `SMALL_TOOLBAR | `LARGE_TOOLBAR | `BUTTON | `DND | `DIALOG ] type side_type = "GTK_SIDE_" [ `TOP | `BOTTOM | `LEFT | `RIGHT ] type text_direction = "GTK_TEXT_DIR_" [ `NONE | `LTR | `RTL ] type justification = "GTK_JUSTIFY_" [ `LEFT | `RIGHT | `CENTER | `FILL ] type match_type = "GTK_MATCH_" [ `ALL | `ALL_TAIL | `HEAD | `TAIL | `EXACT | `LAST ] type menu_direction_type = "GTK_MENU_DIR_" [ `PARENT | `CHILD | `NEXT | `PREV ] type message_type = "GTK_MESSAGE_" [ `INFO | `WARNING | `QUESTION | `ERROR | `OTHER ] type metric_type = "GTK_" [ `PIXELS | `INCHES | `CENTIMETERS ] type movement_step = "GTK_MOVEMENT_" [ `LOGICAL_POSITIONS | `VISUAL_POSITIONS | `WORDS | `DISPLAY_LINES | `DISPLAY_LINE_ENDS | `PARAGRAPH_ENDS | `PARAGRAPHS | `PAGES | `BUFFER_ENDS | `HORIZONTAL_PAGES ] type orientation = "GTK_ORIENTATION_" [ `HORIZONTAL | `VERTICAL ] type corner_type = "GTK_CORNER_" [ `TOP_LEFT | `BOTTOM_LEFT | `TOP_RIGHT | `BOTTOM_RIGHT ] type pack_type = "GTK_PACK_" [ `START | `END ] type path_priority = "GTK_PATH_PRIO_" [ `LOWEST | `GTK | `APPLICATION | `THEME | `RC | `HIGHEST ] type path_type = "GTK_PATH_" [ `WIDGET | `WIDGET_CLASS | `CLASS ] type policy_type = "GTK_POLICY_" [ `ALWAYS | `AUTOMATIC | `NEVER ] type position_type = "GTK_POS_" [ `LEFT | `RIGHT | `TOP | `BOTTOM ] type preview_type = "GTK_PREVIEW_" [ `COLOR | `GRAYSCALE ] type relief_style = "GTK_RELIEF_" [ `NORMAL | `HALF | `NONE ] type resize_mode = "GTK_RESIZE_" [ `PARENT | `QUEUE | `IMMEDIATE ] type signal_run_type = "GTK_RUN_" [ `FIRST | `LAST | `BOTH | `NO_RECURSE | `ACTION | `NO_HOOKS ] type scroll_step = "GTK_SCROLL_" [ `STEPS | `PAGES | `END | `HORIZONTAL_STEPS | `HORIZONTAL_PAGES | `HORIZONTAL_ENDS ] type scroll_type = "GTK_SCROLL_" [ `NONE | `JUMP | `STEP_FORWARD | `STEP_BACKWARD | `PAGE_BACKWARD | `PAGE_FORWARD | `STEP_UP | `STEP_DOWN | `PAGE_UP | `PAGE_DOWN | `STEP_LEFT | `STEP_RIGHT | `PAGE_LEFT | `PAGE_RIGHT | `START | `END ] type selection_mode = "GTK_SELECTION_" [ `NONE | `SINGLE | `BROWSE | `MULTIPLE ] type shadow_type = "GTK_SHADOW_" [ `NONE | `IN | `OUT | `ETCHED_IN | `ETCHED_OUT ] type state_type = "GTK_STATE_" [ `NORMAL | `ACTIVE | `PRELIGHT | `SELECTED | `INSENSITIVE ] type submenu_direction = "GTK_DIRECTION_" [ `LEFT | `RIGHT ] type submenu_placement = "GTK_" [ `TOP_BOTTOM | `LEFT_RIGHT ] type toolbar_style = "GTK_TOOLBAR_" [ `ICONS | `TEXT | `BOTH | `BOTH_HORIZ ] type update_type = "GTK_UPDATE_" [ `CONTINUOUS | `DISCONTINUOUS | `DELAYED ] type visibility = "GTK_VISIBILITY_" [ `NONE | `PARTIAL | `FULL ] type window_position = "GTK_WIN_POS_" [ `NONE | `CENTER | `MOUSE | `CENTER_ALWAYS | `CENTER_ON_PARENT ] type window_type = "GTK_WINDOW_" [ `TOPLEVEL | `POPUP ] type wrap_mode = "GTK_WRAP_" [ `NONE | `CHAR | `WORD | `WORD_CHAR ] type sort_type = "GTK_SORT_" [ `ASCENDING | `DESCENDING ] type pack_direction = "GTK_PACK_DIRECTION_" [ `LTR | `RTL | `TTB | `BTT ] type protect HASGTK210 tree_view_grid_lines = "GTK_TREE_VIEW_GRID_LINES_" [ `NONE | `HORIZONTAL | `VERTICAL | `BOTH ] (* gtkclist.h *) type cell_type = "GTK_CELL_" [ `EMPTY | `TEXT | `PIXMAP | `PIXTEXT | `WIDGET ] (* gtktextview.h *) type text_window_type = "GTK_TEXT_WINDOW_" [ `PRIVATE | `WIDGET | `TEXT | `LEFT | `RIGHT | `TOP | `BOTTOM ] (* gtktextiter.h *) type text_search_flag = "GTK_TEXT_SEARCH_" [ `VISIBLE_ONLY | `TEXT_ONLY ] type button_action = "GTK_BUTTON_" [ `SELECTS | `DRAGS | `EXPANDS ] (* gtktoolbar.h *) type toolbar_child = "GTK_TOOLBAR_CHILD_" [ `SPACE | `BUTTON | `TOGGLEBUTTON | `RADIOBUTTON | `WIDGET ] type toolbar_space_style = "GTK_TOOLBAR_SPACE_" [ `EMPTY | `LINE ] (* gtkspinbutton.h *) type spin_button_update_policy = "GTK_UPDATE_" [ `ALWAYS | `IF_VALID ] type spin_type = "GTK_SPIN_" [ `STEP_FORWARD | `STEP_BACKWARD | `PAGE_FORWARD | `PAGE_BACKWARD | `HOME | `END | `USER_DEFINED ] (* gtkaccelgroup.h *) type accel_flag = "GTK_ACCEL_" [ `VISIBLE | `LOCKED ] (* gtkcalendar.h *) type calendar_display_options = "GTK_CALENDAR_" [ `SHOW_HEADING | `SHOW_DAY_NAMES | `NO_MONTH_CHANGE | `SHOW_WEEK_NUMBERS | `WEEK_START_MONDAY ] (* gtkprogressbar.h *) type progress_bar_style = "GTK_PROGRESS_" [ `CONTINUOUS | `DISCRETE ] type progress_bar_orientation = "GTK_PROGRESS_" [ `LEFT_TO_RIGHT | `RIGHT_TO_LEFT | `BOTTOM_TO_TOP | `TOP_TO_BOTTOM ] (* gtkdnd.h *) type dest_defaults = "GTK_DEST_DEFAULT_" [ `MOTION | `HIGHLIGHT | `DROP | `ALL ] type target_flags = "GTK_TARGET_" [ `SAME_APP | `SAME_WIDGET ] (* gtktree.h *) type noconv tree_view_mode = "GTK_TREE_VIEW_" [ `LINE | `ITEM ] (* gtktreemodel.h *) type tree_model_flags = "GTK_TREE_MODEL_" [ `ITERS_PERSIST | `LIST_ONLY ] (* gtktreeview.h *) type tree_view_drop_position = "GTK_TREE_VIEW_DROP_" [ `BEFORE | `AFTER | `INTO_OR_BEFORE | `INTO_OR_AFTER ] (* gtktreeviewcolumn.h *) type tree_view_column_sizing = "GTK_TREE_VIEW_COLUMN_" [ `GROW_ONLY | `AUTOSIZE | `FIXED ] (* gtkcellrenderer.h *) type cell_renderer_mode = "GTK_CELL_RENDERER_MODE_" [ `INERT | `ACTIVATABLE | `EDITABLE ] (* gtkcellrendereraccel.h *) type protect HASGTK210 cell_renderer_accel_mode = "GTK_CELL_RENDERER_ACCEL_MODE_" [ `GTK | `OTHER ] (* gtkmessagedialog.h *) type buttons_type = "GTK_BUTTONS_" [ `NONE | `OK | `CLOSE | `CANCEL | `YES_NO | `OK_CANCEL ] (* gtkdialog.h *) type response = "GTK_RESPONSE_" [ `NONE | `REJECT | `ACCEPT | `DELETE_EVENT | `OK | `CANCEL | `CLOSE | `YES | `NO | `APPLY | `HELP ] (* gtkwidget.h *) type widget_flags = "GTK_" [ `IN_DESTRUCTION | `FLOATING | `TOPLEVEL | `NO_WINDOW | `REALIZED | `MAPPED | `VISIBLE | `SENSITIVE | `PARENT_SENSITIVE | `CAN_FOCUS | `HAS_FOCUS | `CAN_DEFAULT | `HAS_DEFAULT | `HAS_GRAB | `RC_STYLE | `COMPOSITE_CHILD | `NO_REPARENT | `APP_PAINTABLE | `RECEIVES_DEFAULT | `DOUBLE_BUFFERED ] (* gtkimage.h *) type image_type = "GTK_IMAGE_" [ `EMPTY | `PIXMAP | `IMAGE | `PIXBUF | `STOCK | `ICON_SET | `ANIMATION | `ICON_NAME | `GICON ] (* gtksizegroup.h *) type size_group_mode = "GTK_SIZE_GROUP_" [ `NONE | `HORIZONTAL | `VERTICAL | `BOTH ] (* gtkfilechooser.h *) type protect HASGTK24 file_chooser_action = "GTK_FILE_CHOOSER_ACTION_" [ `OPEN | `SAVE | `SELECT_FOLDER | `CREATE_FOLDER ] type protect HASGTK28 file_chooser_confirmation = "GTK_FILE_CHOOSER_CONFIRMATION_" [ `CONFIRM | `ACCEPT_FILENAME | `SELECT_AGAIN ] (* gtkfilefilter.h *) type protect HASGTK24 file_filter_flags = "GTK_FILE_FILTER_" [ `FILENAME | `URI | `DISPLAY_NAME | `MIME_TYPE ] (* gtkuimanager.h *) type protect HASGTK24 ui_manager_item_type = "GTK_UI_MANAGER_" [ `AUTO | `MENUBAR | `MENU | `TOOLBAR | `PLACEHOLDER | `POPUP | `MENUITEM | `TOOLITEM | `SEPARATOR | `ACCELERATOR | `POPUP_WITH_ACCELS ] (* gtkassistant.h *) type protect HASGTK210 assistant_page_type = "GTK_ASSISTANT_PAGE_" [ `CONTENT | `INTRO | `CONFIRM | `SUMMARY | `PROGRESS ] (* gtkentry.h *) type protect HASGTK216 entry_icon_position = "GTK_ENTRY_ICON_" [ `PRIMARY | `SECONDARY ] lablgtk-2.18.8/src/gnomeDruid.ml0000644000175000017500000001567213460263323015515 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) type druid = [Gtk.container|`druid] type druidpage = [Gtk.bin|`druidpage] type page_edge = [druidpage|`page_edge] type page_standard = [druidpage|`page_standard] module Druid = struct external new_druid : unit -> druid Gtk.obj = "ml_gnome_druid_new" external set_buttons_sensitive : druid Gtk.obj -> back:bool -> next:bool -> cancel:bool -> help:bool -> unit = "ml_gnome_druid_set_buttons_sensitive" external prepend_page : druid Gtk.obj -> druidpage Gtk.obj -> unit = "ml_gnome_druid_prepend_page" external insert_page : druid Gtk.obj -> druidpage Gtk.obj -> druidpage Gtk.obj -> unit = "ml_gnome_druid_insert_page" external append_page : druid Gtk.obj -> druidpage Gtk.obj -> unit = "ml_gnome_druid_append_page" external set_page : druid Gtk.obj -> druidpage Gtk.obj -> unit = "ml_gnome_druid_set_page" module Signals = struct let cancel = { GtkSignal.name = "cancel" ; GtkSignal.classe = `druid ; GtkSignal.marshaller = GtkSignal.marshal_unit } let help = { GtkSignal.name = "help" ; GtkSignal.classe = `druid ; GtkSignal.marshaller = GtkSignal.marshal_unit } end module Prop = struct let show_finish : (druid, bool) Gobject.property = { Gobject.name = "show-finish" ; Gobject.conv = Gobject.Data.boolean } let show_help : (druid, bool) Gobject.property = { Gobject.name = "show-help" ; Gobject.conv = Gobject.Data.boolean } end end module Druid_page = struct module Signals = struct let back : (druidpage, druid Gtk.obj -> bool) GtkSignal.t = { GtkSignal.name = "back" ; GtkSignal.classe = `druidpage ; GtkSignal.marshaller = GtkSignal.marshal1_ret ~ret:Gobject.Data.boolean Gobject.Data.gobject "GnomeDruidPage::back" } let cancel : (druidpage, druid Gtk.obj -> bool) GtkSignal.t = { GtkSignal.name = "cancel" ; GtkSignal.classe = `druidpage ; GtkSignal.marshaller = GtkSignal.marshal1_ret ~ret:Gobject.Data.boolean Gobject.Data.gobject "GnomeDruidPage::cancel" } let finish : (druidpage, druid Gtk.obj -> unit) GtkSignal.t = { GtkSignal.name = "finish" ; GtkSignal.classe = `druidpage ; GtkSignal.marshaller = GtkSignal.marshal1 Gobject.Data.gobject "GnomeDruidPage::finish" } let next : (druidpage, druid Gtk.obj -> bool) GtkSignal.t = { GtkSignal.name = "next" ; GtkSignal.classe = `druidpage ; GtkSignal.marshaller = GtkSignal.marshal1_ret ~ret:Gobject.Data.boolean Gobject.Data.gobject "GnomeDruidPage::next" } let prepare : (druidpage, druid Gtk.obj -> unit) GtkSignal.t = { GtkSignal.name = "prepare" ; GtkSignal.classe = `druidpage ; GtkSignal.marshaller = GtkSignal.marshal1 Gobject.Data.gobject "GnomeDruidPage::prepare" } end end module Page_Edge = struct type edge_position = [ `START | `FINISH | `OTHER ] external new_with_vals : edge_position -> aa:bool -> ?title:string -> ?text:string -> ?logo:GdkPixbuf.pixbuf -> ?watermark:GdkPixbuf.pixbuf -> ?top_watermark:GdkPixbuf.pixbuf -> page_edge Gtk.obj = "ml_gnome_druid_page_edge_new_with_vals_bc" "ml_gnome_druid_page_edge_new_with_vals" external set_bg_color : page_edge Gtk.obj -> Gdk.color -> unit = "ml_gnome_druid_page_edge_set_bg_color" external set_textbox_color : page_edge Gtk.obj -> Gdk.color -> unit = "ml_gnome_druid_page_edge_set_textbox_color" external set_logo_bg_color : page_edge Gtk.obj -> Gdk.color -> unit = "ml_gnome_druid_page_edge_set_logo_bg_color" external set_title_color : page_edge Gtk.obj -> Gdk.color -> unit = "ml_gnome_druid_page_edge_set_title_color" external set_text_color : page_edge Gtk.obj -> Gdk.color -> unit = "ml_gnome_druid_page_edge_set_text_color" external set_text : page_edge Gtk.obj -> string -> unit = "ml_gnome_druid_page_edge_set_text" external set_title : page_edge Gtk.obj -> string -> unit = "ml_gnome_druid_page_edge_set_title" external set_logo : page_edge Gtk.obj -> GdkPixbuf.pixbuf -> unit = "ml_gnome_druid_page_edge_set_logo" external set_watermark : page_edge Gtk.obj -> GdkPixbuf.pixbuf -> unit = "ml_gnome_druid_page_edge_set_watermark" external set_top_watermark : page_edge Gtk.obj -> GdkPixbuf.pixbuf -> unit = "ml_gnome_druid_page_edge_set_top_watermark" end module Page_Standard = struct external vbox : page_standard Gtk.obj -> Gtk.box Gtk.obj = "ml_gnome_druid_page_standard_vbox" external new_page_standard : unit -> page_standard Gtk.obj = "ml_gnome_druid_page_standard_new" external append_item : page_standard Gtk.obj -> ?question:string -> Gtk.widget Gtk.obj -> ?additional_info:string -> unit = "ml_gnome_druid_page_standard_append_item" module Prop = struct let background : (page_standard, string) Gobject.property = { Gobject.name = "background" ; Gobject.conv = Gobject.Data.string } let logo : (page_standard, GdkPixbuf.pixbuf) Gobject.property = { Gobject.name = "logo" ; Gobject.conv = Gobject.Data.gobject } let logo_background : (page_standard, string) Gobject.property = { Gobject.name = "logo-background" ; Gobject.conv = Gobject.Data.string } let title : (page_standard, string) Gobject.property = { Gobject.name = "title" ; Gobject.conv = Gobject.Data.string } let title_foreground : (page_standard, string) Gobject.property = { Gobject.name = "title-foreground" ; Gobject.conv = Gobject.Data.string } end end lablgtk-2.18.8/src/gWindow.ml0000644000175000017500000003413713460263323015033 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open GtkBase open GtkWindow open GtkMisc open GObj open OgtkBaseProps open GContainer let set = Gobject.Property.set let get = Gobject.Property.get (** Window **) module P = Window.P class window_skel obj = object (self) inherit ['b] bin_impl obj inherit window_props method event = new GObj.event_ops obj method as_window = (obj :> Gtk.window obj) method activate_focus () = Window.activate_focus obj method activate_default () = Window.activate_default obj method add_accel_group = Window.add_accel_group obj method set_default_size ~width ~height = set obj P.default_width width; set obj P.default_height height method move = Window.move obj method parse_geometry = Window.parse_geometry obj method resize = Window.resize obj method set_geometry_hints ?min_size ?max_size ?base_size ?aspect ?resize_inc ?win_gravity ?pos ?user_pos ?user_size w = Window.set_geometry_hints obj ?min_size ?max_size ?base_size ?aspect ?resize_inc ?win_gravity ?pos ?user_pos ?user_size (as_widget w) method set_transient_for w = set obj P.transient_for (Some w) method set_wm_name name = Window.set_wmclass obj ~name method set_wm_class cls = Window.set_wmclass obj ~clas:cls method show () = Widget.show obj method present () = Window.present obj method iconify () = Window.iconify obj method deiconify () = Window.deiconify obj end class window obj = object inherit window_skel (obj : [> Gtk.window] obj) method connect = new container_signals_impl obj method maximize () = Window.maximize obj method unmaximize () = Window.unmaximize obj method fullscreen () = Window.fullscreen obj method unfullscreen () = Window.unfullscreen obj method stick () = Window.stick obj method unstick () = Window.unstick obj end let make_window ~create = Window.make_params ~cont:(fun pl ?wm_name ?wm_class -> Container.make_params pl ~cont:(fun pl ?(show=false) () -> let (w : #window_skel) = create pl in may w#set_wm_name wm_name; may w#set_wm_class wm_class; if show then w#show (); w)) let window ?kind = make_window [] ~create:(fun pl -> new window (Window.create ?kind pl)) let cast_window (w : #widget) = new window (Window.cast w#as_widget) let toplevel (w : #widget) = try Some (cast_window w#misc#toplevel) with Gobject.Cannot_cast _ -> None (** Dialog **) class ['a] dialog_signals (obj : [>Gtk.dialog] obj) ~decode = object (self) inherit container_signals_impl obj method response ~(callback : 'a -> unit) = self#connect Dialog.S.response ~callback:(fun i -> callback (decode i)) method close = self#connect Dialog.S.close end let rec list_rassoc k = function | (a, b) :: _ when b = k -> a | _ :: l -> list_rassoc k l | [] -> raise Not_found let resp = Dialog.std_response let rnone = resp `NONE and rreject = resp `REJECT and raccept = resp `ACCEPT and rdelete = resp `DELETE_EVENT and rok = resp `OK and rcancel = resp `CANCEL and rclose = resp `CLOSE and ryes = resp `YES and rno = resp `NO and rapply = resp `APPLY and rhelp = resp `HELP class virtual ['a] dialog_base obj = object (self) inherit window_skel obj inherit dialog_props method action_area = new GPack.button_box (Dialog.action_area obj) method vbox = new GPack.box (Dialog.vbox obj) method private virtual encode : 'a -> int method private virtual decode : int -> 'a method response v = Dialog.response obj (self#encode v) method set_response_sensitive v s = Dialog.set_response_sensitive obj (self#encode v) s method set_default_response v = Dialog.set_default_response obj (self#encode v) method run () = let resp = Dialog.run obj in if resp = rnone then failwith "dialog destroyed" else self#decode resp end class ['a] dialog_skel obj = object inherit ['a] dialog_base obj val mutable tbl = [rdelete, `DELETE_EVENT] val mutable id = 0 method private encode (v : 'a) = list_rassoc v tbl method private decode r = try List.assoc r tbl with Not_found -> Format.eprintf "Warning: unknown response id:%d in dialog. \ Please report to lablgtk dev team.@." r; `DELETE_EVENT end class ['a] dialog_ext obj = object (self) inherit ['a] dialog_skel obj method add_button text (v : 'a) = tbl <- (id, v) :: tbl ; Dialog.add_button obj text id ; id <- succ id method add_button_stock s_id v = self#add_button (GtkStock.convert_id s_id) v end class ['a] dialog obj = object (self) inherit ['a] dialog_ext (obj :> Gtk.dialog obj) method connect : 'a dialog_signals = new dialog_signals obj (self#decode) end let make_dialog pl ?parent ?destroy_with_parent ~create = make_window ~create:(fun pl -> let d = create pl in may (fun p -> d#set_transient_for p#as_window) parent ; may d#set_destroy_with_parent destroy_with_parent ; d) pl let dialog ?(no_separator=false) = make_dialog [] ~create:(fun pl -> let pl = if no_separator then (Gobject.param Dialog.P.has_separator false) :: pl else pl in new dialog (Dialog.create pl)) type any_response = [GtkEnums.response | `OTHER of int] class dialog_any obj = object (self) inherit [any_response] dialog_base (obj :> Gtk.dialog obj) method private encode = function `OTHER n -> n | #GtkEnums.response as v -> Dialog.std_response v method private decode r = try (Dialog.decode_response r : GtkEnums.response :> [>GtkEnums.response]) with Invalid_argument _ -> `OTHER r method connect : any_response dialog_signals = new dialog_signals obj self#decode method add_button text v = Dialog.add_button obj text (self#encode v) method add_button_stock s_id v = self#add_button (GtkStock.convert_id s_id) v end (** MessageDialog **) type 'a buttons = Gtk.Tags.buttons * (int * 'a) list module Buttons = struct let ok = `OK, [ rok, `OK ] let close = `CLOSE, [ rclose, `CLOSE ] let yes_no = `YES_NO, [ ryes, `YES ; rno, `NO ] let ok_cancel = `OK_CANCEL, [ rok, `OK; rcancel, `CANCEL ] type color_selection = [`OK | `CANCEL | `HELP | `DELETE_EVENT] type file_selection = [`OK | `CANCEL | `HELP | `DELETE_EVENT] type font_selection = [`OK | `CANCEL | `APPLY | `DELETE_EVENT] type about = [`CANCEL | `CLOSE | `DELETE_EVENT] end class ['a] message_dialog obj ~(buttons : 'a buttons) = object (self) inherit ['a] dialog_skel obj inherit message_dialog_props method connect : 'a dialog_signals = new dialog_signals obj self#decode method set_markup = MessageDialog.set_markup obj initializer tbl <- snd buttons @ tbl end let message_dialog ?(message="") ?(use_markup=false) ~message_type ~buttons = make_dialog [] ~create:(fun pl -> let w = let message = if use_markup then "" else message in MessageDialog.create ~message_type ~buttons:(fst buttons) ~message () in Gobject.set_params w pl; if use_markup then MessageDialog.set_markup w message ; new message_dialog ~buttons w) (** AboutDialog *) let namep = if GtkMain.Main.version >= (2,12,0) then GtkBaseProps.AboutDialog.P.program_name else GtkBaseProps.Widget.P.name class about_dialog obj = object (self) inherit [Buttons.about] dialog_skel obj inherit about_dialog_props as props method name = Gobject.get namep obj method set_name = Gobject.set namep obj method connect : Buttons.about dialog_signals = new dialog_signals obj self#decode method set_artists = AboutDialog.set_artists obj method artists = AboutDialog.get_artists obj method set_authors = AboutDialog.set_authors obj method authors = AboutDialog.get_authors obj method set_documenters = AboutDialog.set_documenters obj method documenters = AboutDialog.get_documenters obj initializer tbl <- [ rcancel, `CANCEL ; rclose, `CLOSE ] @ tbl end let about_dialog ?name ?authors = let pl = Gobject.Property.may_cons namep name [] in AboutDialog.make_params pl ~cont:(fun pl -> make_dialog pl ~create:(fun pl -> let d = AboutDialog.create () in Gobject.set_params d pl ; may (AboutDialog.set_authors d) authors ; new about_dialog d)) (** ColorSelectionDialog **) class color_selection_dialog obj = object (self) inherit [Buttons.color_selection] dialog_skel (obj : Gtk.color_selection_dialog obj) method connect : 'a dialog_signals = new dialog_signals obj self#decode method ok_button = new GButton.button (ColorSelectionDialog.ok_button obj) method cancel_button = new GButton.button (ColorSelectionDialog.cancel_button obj) method help_button = new GButton.button (ColorSelectionDialog.help_button obj) method colorsel = new GMisc.color_selection (ColorSelectionDialog.colorsel obj) initializer tbl <- [ rok, `OK ; rcancel, `CANCEL ; rhelp, `HELP ] @ tbl end let color_selection_dialog ?(title="Pick a color") = make_dialog [] ~title ~resizable:false ~create:(fun pl -> new color_selection_dialog (ColorSelectionDialog.create pl)) (** FileSelection **) class file_selection obj = object (self) inherit [Buttons.file_selection] dialog_skel (obj : Gtk.file_selection obj) inherit file_selection_props method connect : 'a dialog_signals = new dialog_signals obj self#decode method complete = FileSelection.complete obj method get_selections = FileSelection.get_selections obj method ok_button = new GButton.button (FileSelection.get_ok_button obj) method cancel_button = new GButton.button (FileSelection.get_cancel_button obj) method help_button = new GButton.button (FileSelection.get_help_button obj) method file_list : string GList.clist = new GList.clist (FileSelection.get_file_list obj) method dir_list : string GList.clist = new GList.clist (FileSelection.get_dir_list obj) initializer tbl <- [ rok, `OK ; rcancel, `CANCEL ; rhelp, `HELP ] @ tbl end let file_selection ?(title="Choose a file") ?(show_fileops=false) = FileSelection.make_params [] ~show_fileops ~cont:( make_dialog ?title:None ~create:(fun pl -> let w = FileSelection.create title in Gobject.set_params w pl; new file_selection w)) (** FontSelectionDialog **) class font_selection_dialog obj = object (self) inherit [Buttons.font_selection] dialog_skel (obj : Gtk.font_selection_dialog obj) method connect : 'a dialog_signals = new dialog_signals obj self#decode method selection = new GMisc.font_selection (FontSelectionDialog.font_selection obj) method ok_button = new GButton.button (FontSelectionDialog.ok_button obj) method apply_button = new GButton.button (FontSelectionDialog.apply_button obj) method cancel_button = new GButton.button (FontSelectionDialog.cancel_button obj) initializer tbl <- [ rok, `OK ; rcancel, `CANCEL ; rapply, `APPLY ] @ tbl end let font_selection_dialog ?title = make_dialog [] ?title ~create:(fun pl -> new font_selection_dialog (FontSelectionDialog.create pl)) (** Plug **) class plug_signals obj = object inherit container_signals_impl (obj : [> plug] obj) inherit plug_sigs end class plug (obj : Gtk.plug obj) = object inherit window_skel obj method connect = new plug_signals obj end let plug ~window:xid = Container.make_params [] ~cont:(fun pl ?(show=false) () -> let w = Plug.create xid in Gobject.set_params w pl; if show then Widget.show w; new plug w) (** Socket **) class socket_signals obj = object inherit container_signals_impl (obj : [> socket] obj) inherit socket_sigs end class socket obj = object (self) inherit container (obj : Gtk.socket obj) method connect = new socket_signals obj method steal = Socket.steal obj method xwindow = self#misc#realize (); Gdk.Window.get_xwindow self#misc#window end let socket = pack_container [] ~create:(fun pl -> new socket (Socket.create pl)) (** FileChooser *) class ['a] file_chooser_dialog_signals obj ~decode = object inherit ['a] dialog_signals obj ~decode inherit OgtkFileProps.file_chooser_sigs end class ['a] file_chooser_dialog obj = object (self) inherit ['a] dialog_ext obj inherit GFile.chooser_impl method connect : 'a file_chooser_dialog_signals = new file_chooser_dialog_signals obj self#decode method add_select_button text v = tbl <- (raccept, v) :: tbl ; Dialog.add_button obj text raccept method add_select_button_stock s_id v = self#add_select_button (GtkStock.convert_id s_id) v end let file_chooser_dialog ~action ?backend = make_dialog (Gobject.Property.may_cons GtkFile.FileChooser.P.file_system_backend backend [ Gobject.param GtkFile.FileChooser.P.action action ]) ~create:(fun pl -> let w = GtkFile.FileChooser.dialog_create pl in new file_chooser_dialog w) lablgtk-2.18.8/src/gpointer.ml0000644000175000017500000001224613460263323015241 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (* marked pointers *) type 'a optaddr let optaddr : 'a option -> 'a optaddr = function None -> Obj.magic 0 | Some x -> Obj.magic x (* naked pointers *) type optstring let raw_null = snd (Obj.magic Nativeint.zero) let optstring : string option -> optstring = function None -> raw_null | Some x -> Obj.magic x (* boxed pointers *) type boxed let boxed_null : boxed = Obj.magic Nativeint.zero external peek_string : ?pos:int -> ?len:int -> boxed -> string = "ml_string_at_pointer" external peek_int : boxed -> int = "ml_int_at_pointer" external poke_int : boxed -> int -> unit = "ml_set_int_at_pointer" external peek_nativeint : boxed -> nativeint = "ml_long_at_pointer" external poke_nativeint : boxed -> nativeint -> unit = "ml_set_long_at_pointer" type 'a optboxed let optboxed : 'a option -> 'a optboxed = function None -> Obj.magic boxed_null | Some obj -> Obj.magic obj let may_box ~f obj : 'a optboxed = match obj with None -> Obj.magic boxed_null | Some obj -> Obj.magic (f obj : 'a) (* Variant tables *) type 'a variant_table constraint 'a = [> ] external decode_variant : 'a variant_table -> int -> 'a = "ml_ml_lookup_from_c" external encode_variant : 'a variant_table -> 'a -> int = "ml_ml_lookup_to_c" let encode_flags tbl l = List.fold_left l ~init:0 ~f:(fun acc v -> acc lor (encode_variant tbl v)) let decode_flags tbl c = let l = ref [] in for i = 30 downto 0 do (* only 31-bits in ocaml usual integers *) let d = 1 lsl i in if c land d <> 0 then l := decode_variant tbl d :: !l done; !l (* Exceptions *) exception Null let _ = Callback.register_exception "null_pointer" Null (* Stable pointer *) type 'a stable external stable_copy : 'a -> 'a stable = "ml_stable_copy" (* Region pointers *) type region = { data: Obj.t; path: int array; offset:int; length: int } let length reg = reg.length let unsafe_create_region ~path ~get_length data = { data = Obj.repr data; path = path; offset = 0; length = get_length data } let sub ?(pos=0) ?len reg = let len = match len with Some x -> x | None -> reg.length - pos in if pos < 0 || pos > reg.length || pos + len > reg.length then invalid_arg "Gpointer.sub"; { reg with offset = reg.offset + pos; length = len } external unsafe_get_byte : region -> pos:int -> int = "ml_gpointer_get_char" external unsafe_set_byte : region -> pos:int -> int -> unit = "ml_gpointer_set_char" external unsafe_blit : src:region -> dst:region -> unit ="ml_gpointer_blit" (* handle with care, if allocation not static *) external get_addr : region -> nativeint = "ml_gpointer_get_addr" let get_byte reg ~pos = if pos >= reg.length then invalid_arg "Gpointer.get_char"; unsafe_get_byte reg ~pos let set_byte reg ~pos ch = if pos >= reg.length then invalid_arg "Gpointer.set_char"; unsafe_set_byte reg ~pos ch let blit ~src ~dst = if src.length <> dst.length then invalid_arg "Gpointer.blit"; unsafe_blit ~src ~dst (* Making a region from a string is easy *) let region_of_bytes = unsafe_create_region ~path:[||] ~get_length:Bytes.length let bytes_of_region reg = let s = Bytes.create reg.length in let reg' = region_of_bytes s in unsafe_blit reg reg'; s (* Access bigarrays breaking the abstraction... dirty *) type 'a bigarray = (int, Bigarray.int8_unsigned_elt, 'a) Bigarray.Array1.t let bigarray_size (arr : 'a bigarray) = let size = { data = Obj.repr arr; path = [|1+4|]; offset = 0; length = 0 } in Nativeint.to_int (get_addr size) let region_of_bigarray arr = unsafe_create_region ~path:[|1|] ~get_length:bigarray_size arr lablgtk-2.18.8/src/ml_gtkgl.c0000644000175000017500000000557513460263323015033 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtkgl_tags.h" /* Conversion functions */ #include "gtkgl_tags.c" #define GtkGLArea_val(val) check_cast(GTK_GL_AREA,val) CAMLprim value ml_gtk_gl_area_new (value list, value share) { value cursor, res; int len, i; int *attrs; for (len = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1)) { if (Is_block(Field(cursor,0))) len += 2; else len++; } attrs = (int*) stat_alloc ((len+1)*sizeof(int)); for (i = 0, cursor = list; cursor != Val_unit; cursor = Field(cursor,1)) { value option = Field(cursor,0); if (Is_block(option)) { attrs[i++] = Visual_options_val(Field(option,0)); attrs[i++] = Int_val(Field(option,1)); } else attrs[i++] = Visual_options_val(option); } attrs[i] = GDK_GL_NONE; res = Val_GtkObject_sink ((GtkObject*)gtk_gl_area_share_new(attrs,GtkGLArea_val(share))); stat_free(attrs); return res; } ML_1 (gtk_gl_area_make_current, GtkGLArea_val, Val_bool) ML_1 (gtk_gl_area_swap_buffers, GtkGLArea_val, Unit) lablgtk-2.18.8/src/gtkAssistant.ml0000644000175000017500000000034513460263323016066 0ustar stephstephopen Gaux open Gobject open Gtk open Tags open GtkAssistantProps open GtkBase external _gtkassistant_init : unit -> unit = "ml_gtkassistant_init" let () = _gtkassistant_init () module Assistant = struct include Assistant end lablgtk-2.18.8/src/glib_tags.var0000644000175000017500000000075013460263323015522 0ustar stephsteph(* $Id$ *) (* package "glib" *) type log_level = "G_LOG_LEVEL_" [ `ERROR | `CRITICAL | `WARNING | `MESSAGE | `INFO | `DEBUG | `FLAG_RECURSION "G_LOG_FLAG_RECURSION" | `FLAG_FATAL "G_LOG_FLAG_FATAL" ] type io_condition = "G_IO_" [ `IN | `OUT | `PRI | `ERR | `HUP | `NVAL ] type normalize_mode = "G_NORMALIZE_" [ `DEFAULT | `DEFAULT_COMPOSE | `ALL | `ALL_COMPOSE ] type locale_category = "LC_" [ `ALL | `COLLATE | `CTYPE | `MESSAGES | `MONETARY | `NUMERIC | `TIME ] lablgtk-2.18.8/src/gnomeCanvas.props0000644000175000017500000002773613460263323016420 0ustar stephsteph(* $Id$ *) header { open Gobject open Data open GtkProps type canvas = [Gtk.layout|`canvas] type item = [`gtk|`canvasitem] type group = [item|`canvasgroup] type clipgroup = [group|`canvasclipgroup] type shape = [item|`canvasshape] type r_e = [shape|`canvasre] type rect = [r_e|`canvasrectangle] type ellipse = [r_e|`canvasellipse] type bpath = [shape|`canvasbpath] type polygon = [shape|`canvaspolygon] type text = [item|`canvastext] type line = [item|`canvasline] type pixbuf = [item|`canvaspixbuf] type widget = [item|`canvaswidget] type rich_text = [item|`canvasrichtext] type item_event = [ `BUTTON_PRESS | `TWO_BUTTON_PRESS | `THREE_BUTTON_PRESS | `BUTTON_RELEASE | `MOTION_NOTIFY | `KEY_PRESS | `KEY_RELEASE | `ENTER_NOTIFY | `LEAVE_NOTIFY | `FOCUS_CHANGE ] Gdk.event type path_def module Private = struct external convert_points : float array -> Gpointer.boxed = "ml_gnome_canvas_convert_points" external convert_dash : float -> float array -> Gpointer.boxed = "ml_gnome_canvas_convert_dash" external get_points : Gpointer.boxed -> float array = "ml_gnome_canvas_get_points" external get_dash : Gpointer.boxed -> float * float array = "ml_gnome_canvas_get_dash" external duplicate_path : path_def -> path_def = "ml_gnome_canvas_path_def_duplicate" open Gaux open Gobject let points = { kind = `BOXED; inj = (fun x -> `POINTER (may_map convert_points x)); proj = (fun x -> may_map get_points (Data.boxed.proj x)) } let art_vpath_dash = { kind = `POINTER; inj = (fun x -> `POINTER (may_map (fun (x,y) -> convert_dash x y) x)); proj = (fun x -> may_map get_dash (Data.pointer.proj x)) } let path_def = { kind = `POINTER; inj = Data.unsafe_boxed_option.inj; proj = (fun x -> may_map duplicate_path (Data.unsafe_boxed_option.proj x)) } end } oheader { open Gobject open GnomeCanvas } use "Gtk" tagprefix "canvas" conversions { GtkStock "GtkStock.conv" ArtWindRule "GnomeCanvasEnums.art_wind_rule_conv" ArtVpathDash "Private.art_vpath_dash" } conversions "GnomeCanvas" "Private" { Points PathDef } classes { GdkPixbuf "GdkPixbuf.pixbuf" GdkDrawable "[`drawable] obj" GtkWidget "Gtk.widget obj" } class Item abstract vsetrec : GtkObject { "parent" GnomeCanvasItem : Read / Write method parent : "group obj" method canvas : "canvas obj" method xform : "[`IDENTITY|`TRANSL of float array|`AFFINE of float array]" method affine_relative : "float array -> unit" method affine_absolute : "float array -> unit" method set : "unit" (* Must call [set] after using [Property.set] *) method move : "x:float -> y:float -> unit" method raise : "int -> unit" method lower : "int -> unit" method raise_to_top : "unit" method lower_to_bottom : "unit" method show : "unit" method hide : "unit" method grab : "Gdk.Tags.event_mask list -> Gdk.cursor -> int32 -> unit" method ungrab : "int32 -> unit" method w2i : "x:float -> y:float -> float * float" method i2w : "x:float -> y:float -> float * float" method i2w_affine : "float array" method i2c_affine : "float array" method reparent : "group obj -> unit" method grab_focus : "unit" method get_bounds : "float array" signal event "(GtkBase.Widget.Signals.Event.marshal : (item_event -> bool) -> _)" } class Shape abstract : Item { "cap-style" GdkCapStyle : Read / Write "dash" ArtVpathDash : Read / Write "fill-color" gchararray : Write "fill-color-gdk" GdkColor : Read / Write "fill-color-rgba" guint32 : Read / Write "fill-stipple" GdkDrawable : Read / Write "join-style" GdkJoinStyle : Read / Write "miterlimit" gdouble : Read / Write "outline-color" gchararray : Write "outline-color-gdk" GdkColor : Read / Write "outline-color-rgba" guint32 : Read / Write "outline-stipple" GdkDrawable : Read / Write "width-pixels" guint : Read / Write "width-units" gdouble : Write "wind" ArtWindRule : Read / Write } class Bpath abstract : Shape { "bpath" GnomeCanvasPathDef : Read / Write } class RE abstract : Shape { "x1" gdouble : Read / Write "x2" gdouble : Read / Write "y1" gdouble : Read / Write "y2" gdouble : Read / Write } class Ellipse abstract : RE {} class Rect abstract : RE {} class Polygon abstract : Shape { "points" GnomeCanvasPoints : Read / Write } class Group abstract : Item { "x" gdouble : Read / Write "y" gdouble : Read / Write method get_items : "item obj list" } class Clipgroup abstract : Group { "path" GnomeCanvasPathDef : Read / Write "wind" ArtWindRule : Read / Write } class Line abstract : Item { "arrow-shape-a" gdouble : Read / Write "arrow-shape-b" gdouble : Read / Write "arrow-shape-c" gdouble : Read / Write "cap-style" GdkCapStyle : Read / Write "fill-color" gchararray : Read / Write "fill-color-gdk" GdkColor : Read / Write "fill-color-rgba" guint32 : Read / Write "fill-stipple" GdkDrawable : Read / Write "first-arrowhead" gboolean : Read / Write "join-style" GdkJoinStyle : Read / Write "last-arrowhead" gboolean : Read / Write "line-style" GdkLineStyle : Read / Write "points" GnomeCanvasPoints : Read / Write "smooth" gboolean : Read / Write "spline-steps" guint : Read / Write "width-pixels" guint : Read / Write "width-units" gdouble : Read / Write } class Pixbuf abstract : Item { "anchor" GtkAnchorType : Read / Write "height" gdouble : Read / Write "height-in-pixels" gboolean : Read / Write "height-set" gboolean : Read / Write "pixbuf" GdkPixbuf : Read / Write "width" gdouble : Read / Write "width-in-pixels" gboolean : Read / Write "width-set" gboolean : Read / Write "x" gdouble : Read / Write "x-in-pixels" gboolean : Read / Write "y" gdouble : Read / Write "y-in-pixels" gboolean : Read / Write } class RichText abstract : Item { "anchor" GtkAnchorType : Read / Write "cursor-blink" gboolean : Read / Write "cursor-visible" gboolean : Read / Write "direction" GtkDirectionType : Read / Write "editable" gboolean : Read / Write "grow-height" gboolean : Read / Write "height" gdouble : Read / Write "indent" gint : Read / Write "justification" GtkJustification : Read / Write "left-margin" gint : Read / Write "pixels-above-lines" gint : Read / Write "pixels-below-lines" gint : Read / Write "pixels-inside-wrap" gint : Read / Write "right-margin" gint : Read / Write "text" gchararray : Read / Write "visible" gboolean : Read / Write "width" gdouble : Read / Write "wrap-mode" GtkWrapMode : Read / Write "x" gdouble : Read / Write "y" gdouble : Read / Write method cut_clipboard : "unit" method copy_clipboard : "unit" method paste_clipboard : "unit" method get_buffer : "Gtk.text_buffer" } class Text abstract : Item { "anchor" GtkAnchorType : Read / Write "attributes" PangoAttrList : Read / Write "clip" gboolean : Read / Write "clip-height" gdouble : Read / Write "clip-width" gdouble : Read / Write "family" gchararray : Read / Write "family-set" gboolean : Read / Write "fill-color" gchararray : Read / Write "fill-color-gdk" GdkColor : Read / Write "fill-color-rgba" guint32 : Read / Write "fill-stipple" GdkDrawable : Read / Write "font" gchararray : Read / Write "font-desc" PangoFontDescription : Read / Write "justification" GtkJustification : Read / Write "markup" gchararray : Write "rise" gint : Read / Write "rise-set" gboolean : Read / Write "scale" gdouble : Read / Write "scale-set" gboolean : Read / Write "size" gint : Read / Write "size-points" gdouble : Read / Write "size-set" gboolean : Read / Write "stretch" PangoStretch : Read / Write "stretch-set" gboolean : Read / Write "strikethrough" gboolean : Read / Write "strikethrough-set" gboolean : Read / Write "style" PangoStyle : Read / Write "style-set" gboolean : Read / Write "text" gchararray : Read / Write "text-height" gdouble : Read / Write "text-width" gdouble : Read / Write "underline" PangoUnderline : Read / Write "underline-set" gboolean : Read / Write "variant" PangoVariant : Read / Write "variant-set" gboolean : Read / Write "weight" gint : Read / Write "weight-set" gboolean : Read / Write "x" gdouble : Read / Write "x-offset" gdouble : Read / Write "y" gdouble : Read / Write "y-offset" gdouble : Read / Write } class Widget abstract : Item { "anchor" GtkAnchorType : Read / Write "height" gdouble : Read / Write "size-pixels" gboolean : Read / Write "widget" GtkWidget : Read / Write "width" gdouble : Read / Write "x" gdouble : Read / Write "y" gdouble : Read / Write } class Canvas "GnomeCanvas" tag "canvas" : Layout { "aa" gboolean : Read / Write / Construct Only method root : "group obj" method set_scroll_region : "x1:float -> y1:float -> x2:float -> y2:float -> unit" method get_scroll_region : "float array" method set_center_scroll_region : "bool -> unit" method get_center_scroll_region : "bool" method set_pixels_per_unit : "float -> unit" method scroll_to : "x:int -> y:int -> unit" method get_scroll_offsets : "int * int" method update_now : "unit" method get_item_at : "x:float -> y:float -> item obj" method w2c_affine : "float array" method w2c : "wx:float -> wy:float -> int * int" method w2c_d : "wx:float -> wy:float -> float * float" method c2w : "cx:float -> cy:float -> float * float" method window_to_world : "winx:float -> winy:float -> float * float" method world_to_window : "wox:float -> woy:float -> float * float" }lablgtk-2.18.8/src/pango.ml0000644000175000017500000002356513460263323014524 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject type context = [`pangocontext] obj type font = [`pangofont] obj type font_map = [`pangofontmap] obj type font_description type font_metrics type language type layout = [`pangolayout] obj type units = int type rectangle = {x:int; y:int; width:int; height:int} external _pango_init : unit -> unit = "ml_pango_init" let () = _pango_init () module Tags = struct type style = [ `NORMAL | `OBLIQUE | `ITALIC ] type weight_internal = [ `ULTRALIGHT | `LIGHT | `NORMAL |`BOLD | `ULTRABOLD |`HEAVY ] type weight = [ weight_internal | `CUSTOM of int] type variant = [ `NORMAL | `SMALL_CAPS ] type stretch = [ `ULTRA_CONDENSED | `EXTRA_CONDENSED | `CONDENSED | `SEMI_CONDENSED | `NORMAL | `SEMI_EXPANDED | `EXPANDED | `EXTRA_EXPANDED | `ULTRA_EXPANDED ] type scale = [ `XX_SMALL | `X_SMALL | `SMALL | `MEDIUM | `LARGE | `X_LARGE | `XX_LARGE | `CUSTOM of float ] external scale_to_float : scale -> float = "ml_Pango_scale_val" type underline = [ `NONE | `SINGLE | `DOUBLE | `LOW ] type wrap_mode = [ `WORD | `CHAR | `WORD_CHAR ] type ellipsize_mode = [ `NONE | `START | `MIDDLE | `END ] type alignment = [ `LEFT | `CENTER | `RIGHT ] open Gpointer external _get_tables : unit -> style variant_table * weight_internal variant_table * variant variant_table * stretch variant_table * underline variant_table * wrap_mode variant_table * ellipsize_mode variant_table = "ml_pango_get_tables" let style, weight, variant, stretch, underline, wrap_mode, ellipsize_mode = _get_tables () let weight_to_int (w : weight) = match w with | `CUSTOM b -> b | #weight_internal as w -> encode_variant weight w end module Font = struct open Tags external from_string : string -> font_description = "ml_pango_font_description_from_string" external to_string : font_description -> string = "ml_pango_font_description_to_string" external copy : font_description -> font_description = "ml_pango_font_description_copy" external set_family : font_description -> string -> unit = "ml_pango_font_description_set_family" external get_family : font_description -> string = "ml_pango_font_description_get_family" external set_style : font_description -> style -> unit = "ml_pango_font_description_set_style" external get_style : font_description -> style = "ml_pango_font_description_get_style" external set_variant : font_description -> variant -> unit = "ml_pango_font_description_set_variant" external get_variant : font_description -> variant = "ml_pango_font_description_get_variant" external set_weight : font_description -> int -> unit = "ml_pango_font_description_set_weight" let set_weight fd w = set_weight fd (weight_to_int w) external get_weight : font_description -> int = "ml_pango_font_description_get_weight" external set_stretch : font_description -> stretch -> unit = "ml_pango_font_description_set_stretch" external get_stretch : font_description -> stretch = "ml_pango_font_description_get_stretch" external set_size : font_description -> int -> unit = "ml_pango_font_description_set_size" external get_size : font_description -> int = "ml_pango_font_description_get_size" let modify fd ?family ?style ?variant ?weight ?stretch ?size () = let may_set set_x x = may x ~f:(set_x fd) in may_set set_family family; may_set set_style style; may_set set_stretch stretch; may_set set_variant variant; may_set set_weight weight; may_set set_size size external get_metrics : font -> language -> font_metrics = "ml_pango_font_get_metrics" external get_ascent : font_metrics -> units = "ml_pango_font_metrics_get_ascent" external get_descent : font_metrics -> units = "ml_pango_font_metrics_get_descent" external get_approximate_char_width : font_metrics -> units = "ml_pango_font_metrics_get_approximate_char_width" external get_approximate_digit_width : font_metrics -> units = "ml_pango_font_metrics_get_approximate_digit_width" end module FontMap = struct external load_font : font_map -> context -> font_description -> font = "ml_pango_font_map_load_font" end module Language = struct external from_string : string -> language = "ml_pango_language_from_string" external to_string : language -> string = "ml_pango_language_to_string" external matches : language -> string -> bool = "ml_pango_language_matches" let none : language = Obj.magic Gpointer.boxed_null end module Context = struct let cast w : context = Gobject.try_cast w "PangoContext" external get_font_description : context -> font_description = "ml_pango_context_get_font_description" external set_font_description : context -> font_description -> unit = "ml_pango_context_set_font_description" external get_language : context -> language = "ml_pango_context_get_language" external set_language : context -> language -> unit = "ml_pango_context_set_language" external load_font : context -> font_description -> font = "ml_pango_context_load_font" external load_fontset : context -> font_description -> language -> font = "ml_pango_context_load_fontset" external get_metrics : context -> font_description -> language option -> font_metrics = "ml_pango_context_get_metrics" end external scale : unit -> int = "ml_PANGO_SCALE" let scale = scale () module Layout = struct open Tags let cast w : layout = Gobject.try_cast w "PangoLayout" external create : context -> layout = "ml_pango_layout_new" external copy : layout -> layout = "ml_pango_layout_copy" external get_context : layout -> context = "ml_pango_layout_get_context" external get_text : layout -> string = "ml_pango_layout_get_text" external set_text : layout -> string -> unit = "ml_pango_layout_set_text" external set_markup : layout -> string -> unit = "ml_pango_layout_set_markup" external set_markup_with_accel : layout -> string -> Glib.unichar -> unit = "ml_pango_layout_set_markup_with_accel" external set_font_description : layout -> font_description -> unit = "ml_pango_layout_set_font_description" external get_width : layout -> int = "ml_pango_layout_get_width" external set_width : layout -> int -> unit = "ml_pango_layout_set_width" external get_indent : layout -> int = "ml_pango_layout_get_indent" external set_indent : layout -> int -> unit = "ml_pango_layout_set_indent" external get_spacing : layout -> int = "ml_pango_layout_get_spacing" external set_spacing : layout -> int -> unit = "ml_pango_layout_set_spacing" external get_wrap : layout -> wrap_mode = "ml_pango_layout_get_wrap" external set_wrap : layout -> wrap_mode -> unit = "ml_pango_layout_set_wrap" external get_justify : layout -> bool = "ml_pango_layout_get_justify" external set_justify : layout -> bool -> unit = "ml_pango_layout_set_justify" external get_single_paragraph_mode : layout -> bool = "ml_pango_layout_get_single_paragraph_mode" external set_single_paragraph_mode : layout -> bool -> unit = "ml_pango_layout_set_single_paragraph_mode" external context_changed : layout -> unit = "ml_pango_layout_context_changed" external get_size : layout -> units * units = "ml_pango_layout_get_size" external get_pixel_size : layout -> int * int = "ml_pango_layout_get_pixel_size" external get_extent : layout -> rectangle = "ml_pango_layout_get_extent" external get_pixel_extent : layout -> rectangle = "ml_pango_layout_get_pixel_extent" external index_to_pos : layout -> int -> rectangle = "ml_pango_layout_index_to_pos" external xy_to_index : layout -> x:int -> y:int -> int * int * bool = "ml_pango_layout_xy_to_index" external set_ellipsize : layout -> ellipsize_mode -> unit = "ml_pango_layout_set_ellipsize" external get_ellipsize : layout -> ellipsize_mode = "ml_pango_layout_get_ellipsize" external get_baseline : layout -> int = "ml_pango_layout_get_baseline" external get_line_count : layout -> int = "ml_pango_layout_get_line_count" external is_wrapped : layout -> bool = "ml_pango_layout_is_wrapped" external is_ellipsized : layout -> bool = "ml_pango_layout_is_ellipsized" external get_alignment : layout -> alignment = "ml_pango_layout_get_alignment" external set_alignment : layout -> alignment -> unit = "ml_pango_layout_set_alignment" end lablgtk-2.18.8/src/ml_glib.c0000644000175000017500000004306413460263323014633 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #ifdef _WIN32 #include "win32.h" #include #include #include #endif #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "glib_tags.h" #include "glib_tags.c" CAMLprim value ml_glib_init(value unit) { ml_register_exn_map (G_CONVERT_ERROR, "g_convert_error"); ml_register_exn_map (G_MARKUP_ERROR, "g_markup_error"); return Val_unit; } /* Not from glib! */ ML_2(setlocale, Locale_category_val, String_option_val, Val_optstring) /* Utility functions */ value copy_string_v (const gchar * const *v) { CAMLparam0(); CAMLlocal4(h,p,c,s); h = p = Val_emptylist; while (*v != NULL) { s = copy_string (*v); c = alloc_small (2, 0); Field (c, 0) = s; Field (c, 1) = Val_emptylist; if (p == Val_emptylist) h = c; else Store_field(p, 1, c); p = c; v++; } CAMLreturn(h); } CAMLprim value copy_string_g_free (char *str) { value res = copy_string_check (str); g_free (str); return res; } static void ml_raise_glib (const char *errmsg) { static value * exn = NULL; if (exn == NULL) exn = caml_named_value ("gerror"); raise_with_string (*exn, (char*)errmsg); } CAMLprim value Val_GList (GList *list, value (*func)(gpointer)) { CAMLparam0 (); CAMLlocal4 (new_cell, result, last_cell, cell); last_cell = cell = Val_unit; while (list != NULL) { result = func(list->data); new_cell = alloc_small(2,0); Field(new_cell,0) = result; Field(new_cell,1) = Val_unit; if (last_cell == Val_unit) cell = new_cell; else modify(&Field(last_cell,1), new_cell); last_cell = new_cell; list = list->next; } CAMLreturn (cell); } CAMLprim value Val_GList_free (GList *list, value (*func)(gpointer)) { value res = Val_GList (list, func); g_list_free (list); return res; } CAMLprim GList *GList_val (value list, gpointer (*func)(value)) { GList *res = NULL; for (; Is_block(list); list = Field(list,1)) res = g_list_append (res, func(Field(list,0))); return (res); } /* Error handling */ static GSList *exn_map; struct exn_data { GQuark domain; char *caml_exn_name; value *caml_exn; }; CAMLprim void ml_register_exn_map (GQuark domain, char *caml_name) { struct exn_data *exn_data = stat_alloc (sizeof *exn_data); exn_data->domain = domain; exn_data->caml_exn_name = caml_name; exn_data->caml_exn = NULL; exn_map = g_slist_prepend (exn_map, exn_data); } static value *lookup_exn_map (GQuark domain) { GSList *l = exn_map; struct exn_data *exn_data; for (l = exn_map; l; l=l->next) { exn_data = l->data; if (exn_data->domain == domain) { if (exn_data->caml_exn == NULL) exn_data->caml_exn = caml_named_value (exn_data->caml_exn_name); return exn_data->caml_exn; } } return NULL; } static void ml_raise_gerror_exn(GError *, value *) Noreturn; static void ml_raise_gerror_exn(GError *err, value *exn) { CAMLparam0(); CAMLlocal2(b, msg); g_assert (err && exn); msg = copy_string(err->message); b = alloc_small (3, 0); Field (b, 0) = *exn; Field (b, 1) = Val_int(err->code); Field (b, 2) = msg; g_error_free (err); mlraise(b); } static void ml_raise_generic_gerror (GError *) Noreturn; static void ml_raise_generic_gerror (GError *err) { static value *exn; value msg; if (exn == NULL) { exn = caml_named_value ("gerror"); if (exn == NULL) failwith ("gerror"); } msg = copy_string (err->message); g_error_free (err); raise_with_arg (*exn, msg); } CAMLprim void ml_raise_gerror(GError *err) { value *caml_exn; g_assert (err); caml_exn = lookup_exn_map (err->domain); if (caml_exn) ml_raise_gerror_exn (err, caml_exn); else ml_raise_generic_gerror (err); } /* Logging */ static void ml_g_log_func(const gchar *log_domain, GLogLevelFlags log_level, const gchar *message, gpointer data) { value msg, *clos_p = data; msg = copy_string (message); callback2_exn(*clos_p, Val_int(log_level), msg); } ML_1 (Log_level_val, ID, Val_int) CAMLprim value ml_g_log_set_handler (value domain, value levels, value clos) { value *clos_p = ml_global_root_new (clos); int id = g_log_set_handler (String_option_val(domain), Int_val(levels), ml_g_log_func, clos_p); CAMLparam1(domain); value ret = alloc_small(3,0); Field(ret,0) = domain; Field(ret,1) = Val_int(id); Field(ret,2) = (value)clos_p; CAMLreturn(ret); } CAMLprim value ml_g_log_remove_handler (value hnd) { if (Field(hnd,2) != 0) { g_log_remove_handler (String_option_val(Field(hnd,0)), Int_val(Field(hnd,1))); ml_global_root_destroy ((value*)Field(hnd,2)); Field(hnd,2) = 0; } return Val_unit; } ML_1(g_log_set_always_fatal, Int_val, Unit) ML_2(g_log_set_fatal_mask, String_option_val, Int_val, Unit) CAMLprim value ml_g_log (value domain, value level, value msg) { g_log (String_val(domain), Int_val(level), "%s", String_val(msg)); return Val_unit; } /* Main loop handling */ /* for 1.3 compatibility */ #ifdef g_main_new #undef g_main_new #define g_main_new(is_running) g_main_loop_new (NULL, is_running) #endif #define GMainLoop_val(val) ((GMainLoop*)Addr_val(val)) ML_1 (g_main_new, Bool_val, Val_addr) ML_1 (g_main_iteration, Bool_val, Val_bool) ML_0 (g_main_pending, Val_bool) ML_1 (g_main_is_running, GMainLoop_val, Val_bool) ML_1 (g_main_quit, GMainLoop_val, Unit) ML_1 (g_main_destroy, GMainLoop_val, Unit) static gboolean ml_g_source_func (gpointer data) { value res, *clos = data; res = callback_exn (*clos, Val_unit); if (Is_exception_result(res)) { CAML_EXN_LOG ("GSourceFunc"); return FALSE; } return Bool_val (res); } CAMLprim value ml_g_timeout_add (value o_prio, value interval, value clos) { value *clos_p = ml_global_root_new (clos); return Val_int (g_timeout_add_full (Option_val(o_prio, Int_val, G_PRIORITY_DEFAULT), Long_val(interval), ml_g_source_func, clos_p, ml_global_root_destroy)); } CAMLprim value ml_g_idle_add (value o_prio, value clos) { value *clos_p = ml_global_root_new (clos); return Val_int (g_idle_add_full (Option_val(o_prio, Int_val, G_PRIORITY_DEFAULT_IDLE), ml_g_source_func, clos_p, ml_global_root_destroy)); } ML_1 (g_source_remove, Int_val, Unit) static GPollFunc poll_func = NULL; static gint ml_poll (GPollFD *ufds, guint nfsd, gint timeout) { gint res; caml_enter_blocking_section(); res = poll_func(ufds, nfsd, timeout); caml_leave_blocking_section(); return res; } CAMLprim value ml_g_wrap_poll_func (value unit) { if (!poll_func) { poll_func = g_main_context_get_poll_func(NULL); g_main_context_set_poll_func (NULL, ml_poll); } return Val_unit; } /* GIOChannel */ Make_Val_final_pointer (GIOChannel, g_io_channel_ref, g_io_channel_unref, 0) Make_Val_final_pointer_ext (GIOChannel, _noref, Ignore, g_io_channel_unref, 20) #define GIOChannel_val(val) ((GIOChannel*)Pointer_val(val)) #ifndef _WIN32 ML_1 (g_io_channel_unix_new, Int_val, Val_GIOChannel_noref) #else CAMLprim value ml_g_io_channel_unix_new(value wh) { return Val_GIOChannel_noref (g_io_channel_unix_new (_open_osfhandle((long)*(HANDLE*)Data_custom_val(wh), O_BINARY))); } #endif static gboolean ml_g_io_channel_watch(GIOChannel *s, GIOCondition c, gpointer data) { value res, cond, *clos_p = data; cond = ml_lookup_flags_getter (ml_table_io_condition, c); res = callback_exn (*clos_p, cond); if (Is_exception_result (res)) { CAML_EXN_LOG("GIOChannel watch"); return FALSE; } return Bool_val(res); } Make_Flags_val(Io_condition_val) CAMLprim value ml_g_io_add_watch(value cond, value clos, value prio, value io) { return Val_long ( g_io_add_watch_full(GIOChannel_val(io), Option_val(prio,Int_val,G_PRIORITY_DEFAULT), Flags_Io_condition_val(cond), ml_g_io_channel_watch, ml_global_root_new(clos), ml_global_root_destroy) ); } CAMLprim value ml_g_io_channel_read(value io, value str, value offset, value count) { gsize read; switch (g_io_channel_read(GIOChannel_val(io), String_val(str) + Int_val(offset), Int_val(count), &read)) { case G_IO_ERROR_NONE: return Val_int( read ); case G_IO_ERROR_INVAL: ml_raise_glib("g_io_channel_read: G_IO_ERROR_INVAL"); case G_IO_ERROR_AGAIN: default: ml_raise_glib("g_io_channel_read: G_IO_ERROR_AGAIN"); } /* no one reaches here... */ return Val_unit; } #ifdef HASGTK22 CAMLprim value ml_g_io_channel_read_chars(value io, value str, value offset, value count) { gsize read; GError *err = NULL; GIOStatus result = g_io_channel_read_chars(GIOChannel_val(io), String_val(str) + Int_val(offset), Int_val(count), &read, &err); if (err != NULL) ml_raise_gerror(err); switch (result) { case G_IO_STATUS_NORMAL: return Val_int( read ); case G_IO_STATUS_EOF: ml_raise_glib("g_io_channel_read_chars G_IO_STATUS_EOF"); case G_IO_STATUS_AGAIN: ml_raise_glib("g_io_channel_read_chars: G_IO_STATUS_AGAIN"); case G_IO_STATUS_ERROR: default: ml_raise_glib("g_io_channel_read_chars: G_IO_STATUS_ERROR"); } /* no one reaches here... */ return Val_unit; } #else Unsupported_22(g_io_channel_read_chars) #endif /* single-linked lists */ CAMLprim value Val_GSList (GSList *list, value (*func)(gpointer)) { CAMLparam0(); CAMLlocal4 (new_cell, result, last_cell, cell); last_cell = cell = Val_unit; while (list != NULL) { result = func(list->data); new_cell = alloc_small(2,0); Field(new_cell,0) = result; Field(new_cell,1) = Val_unit; if (last_cell == Val_unit) cell = new_cell; else modify(&Field(last_cell,1), new_cell); last_cell = new_cell; list = list->next; } CAMLreturn(cell); } CAMLprim value Val_GSList_free (GSList *list, value (*func)(gpointer)) { value res = Val_GSList (list, func); g_slist_free (list); return res; } CAMLprim GSList *GSList_val (value list, gpointer (*func)(value)) { GSList *res = NULL; GSList **current = &res; value cell = list; while (Is_block(cell)) { *current = g_slist_alloc (); (*current)->data = func(Field(cell,0)); cell = Field(cell,1); current = &(*current)->next; } return res; } /* Character Set Conversion */ static value caml_copy_string_len_and_free (char *str, size_t len) { value v; g_assert (str != NULL); v = alloc_string (len); memcpy (String_val(v), str, len); g_free (str); return v; } CAMLprim value ml_g_convert(value str, value to, value from) { gsize bw=0; gchar* c_res; GError *error=NULL; c_res = g_convert(String_val(str),string_length(str), String_val(to),String_val(from), NULL,&bw,&error); if (error != NULL) ml_raise_gerror(error); return caml_copy_string_len_and_free (c_res, bw); } CAMLprim value ml_g_convert_with_fallback(value fallback, value to, value from, value str) { gsize bw=0; gchar* c_res; GError *error=NULL; c_res = g_convert_with_fallback(String_val(str),string_length(str), String_val(to),String_val(from), String_option_val(fallback), NULL,&bw,&error); if (error != NULL) ml_raise_gerror(error); return caml_copy_string_len_and_free (c_res, bw); } #define Make_conversion(cname) \ CAMLprim value ml_##cname(value str) { \ gsize bw=0; \ gchar* c_res; \ GError *error=NULL; \ c_res = cname(String_val(str),string_length(str),NULL,&bw,&error); \ if (error != NULL) ml_raise_gerror(error); \ return caml_copy_string_len_and_free (c_res, bw); \ } /* Make_conversion(g_locale_to_utf8) */ Make_conversion(g_filename_to_utf8) /* Make_conversion(g_locale_from_utf8) */ Make_conversion(g_filename_from_utf8) CAMLprim value ml_g_filename_from_uri (value uri) { GError *err = NULL; gchar *hostname, *result; result = g_filename_from_uri (String_val(uri), &hostname, &err); if (err != NULL) ml_raise_gerror(err); { CAMLparam0(); CAMLlocal3(v_h, v_f, v_p); v_h = Val_option(hostname, copy_string_g_free); v_f = copy_string_g_free (result); v_p = alloc_small(2, 0); Field(v_p, 0) = v_h; Field(v_p, 1) = v_f; CAMLreturn(v_p); } } CAMLprim value ml_g_filename_to_uri (value hostname, value uri) { GError *err = NULL; gchar *result; result = g_filename_to_uri (String_val(uri), String_option_val(hostname), &err); if (err != NULL) ml_raise_gerror(err); return copy_string_g_free(result); } CAMLprim value ml_g_get_charset() { CAMLparam0(); CAMLlocal1(couple); gboolean r; G_CONST_RETURN char *c; r = g_get_charset(&c); couple = alloc_tuple(2); Store_field(couple,0,Val_bool(r)); Store_field(couple,1,Val_string(c)); CAMLreturn(couple); } CAMLprim value ml_g_utf8_validate(value s) { return Val_bool(g_utf8_validate(SizedString_val(s),NULL)); } ML_1 (g_unichar_tolower, Int_val, Val_int) ML_1 (g_unichar_toupper, Int_val, Val_int) ML_1 (g_unichar_totitle, Int_val, Val_int) ML_1 (g_unichar_digit_value, Int_val, Val_int) ML_1 (g_unichar_xdigit_value, Int_val, Val_int) ML_1 (g_utf8_strlen, SizedString_val, Val_int) ML_2 (g_utf8_normalize, SizedString_val, Normalize_mode_val, copy_string_g_free) ML_1 (g_utf8_casefold, SizedString_val, copy_string_g_free) ML_2 (g_utf8_collate, String_val, String_val, Val_int) ML_1 (g_utf8_collate_key, SizedString_val, copy_string_g_free) ML_1 (g_utf8_strup, SizedString_val, copy_string_g_free) ML_1 (g_utf8_strdown, SizedString_val, copy_string_g_free) CAMLprim value ml_g_utf8_offset_to_pointer (value s, value pos, value off) { return Val_long (g_utf8_offset_to_pointer (String_val(s) + Long_val(pos), Long_val(off)) - String_val(s)); } #define UNI_BOOL(f) ML_1(g_unichar_##f, Int_val, Val_bool) UNI_BOOL(validate) UNI_BOOL(isalnum) UNI_BOOL(isalpha) UNI_BOOL(iscntrl) UNI_BOOL(isdigit) UNI_BOOL(isgraph) UNI_BOOL(islower) UNI_BOOL(isprint) UNI_BOOL(ispunct) UNI_BOOL(isspace) UNI_BOOL(isupper) UNI_BOOL(isxdigit) UNI_BOOL(istitle) UNI_BOOL(isdefined) UNI_BOOL(iswide) #undef UNI_BOOL ML_1 (g_markup_escape_text, SizedString_val, copy_string_g_free) ML_0 (g_get_prgname, copy_string_or_null) ML_1 (g_set_prgname, String_val, Unit) #ifdef HASGTK22 ML_0 (g_get_application_name, copy_string_or_null) ML_1 (g_set_application_name, String_val, Unit) #else Unsupported(g_get_application_name) Unsupported(g_set_application_name) #endif ML_0 (g_get_user_name, copy_string) ML_0 (g_get_real_name, copy_string) CAMLprim value ml_g_get_home_dir (value unit) { const char *s = g_get_home_dir(); return s ? ml_some (copy_string (s)) : Val_unit; } ML_0 (g_get_tmp_dir, copy_string) CAMLprim value ml_g_find_program_in_path (value p) { value v; char *s = g_find_program_in_path (String_val(p)); if (s == NULL) raise_not_found(); v = copy_string(s); g_free(s); return v; } CAMLprim value ml_g_getenv (value v) { const gchar *s = g_getenv(String_val(v)); if (s == NULL) raise_not_found(); return copy_string(s); } #ifdef HASGTK24 CAMLprim value ml_g_setenv (value v, value s, value o) { if (! g_setenv(String_val(v), String_val(s), Bool_val(o))) failwith("g_setenv"); return Val_unit; } ML_1 (g_unsetenv, String_val, Unit) #else Unsupported_24(g_setenv) Unsupported_24(g_unsetenv) #endif /* HASGTK24 */ #ifdef HASGTK26 ML_0 (g_get_user_cache_dir, copy_string) ML_0 (g_get_user_data_dir, copy_string) ML_0 (g_get_user_config_dir, copy_string) ML_0 (g_get_system_data_dirs, copy_string_v) ML_0 (g_get_system_config_dirs, copy_string_v) #else Unsupported_26(g_get_user_cache_dir) Unsupported_26(g_get_user_data_dir) Unsupported_26(g_get_user_config_dir) Unsupported_26(g_get_system_data_dirs) Unsupported_26(g_get_system_config_dirs) #endif /* HASGTK26 */ ML_1(g_usleep,Long_val,Unit) lablgtk-2.18.8/src/gdkpixbuf_tags.var0000644000175000017500000000033513460263323016567 0ustar stephsteph(* $Id$ *) (* package "gdkPixbuf" *) type colorspace = "GDK_COLORSPACE_" [ `RGB ] type alpha_mode = "GDK_PIXBUF_ALPHA_" [ `BILEVEL | `FULL ] type interpolation = "GDK_INTERP_" [ `NEAREST | `TILES | `BILINEAR | `HYPER ] lablgtk-2.18.8/src/gText.mli0000644000175000017500000005422413460263323014660 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj (** The text widget and associated objects @gtkdoc gtk TextWidget *) type mark = [`INSERT | `SEL_BOUND | `NAME of string | `MARK of text_mark] class child_anchor : text_child_anchor -> object method as_childanchor : text_child_anchor method deleted : bool method get_oid : int method widgets : widget list end val child_anchor : unit -> child_anchor (** {3 GtkTextTag} *) type tag_property = [ | `ACCUMULATIVE_MARGIN of bool | `BACKGROUND of string | `BACKGROUND_FULL_HEIGHT of bool | `BACKGROUND_FULL_HEIGHT_SET of bool | `BACKGROUND_GDK of Gdk.color | `BACKGROUND_SET of bool | `BACKGROUND_STIPPLE of Gdk.bitmap | `BACKGROUND_STIPPLE_SET of bool | `DIRECTION of Tags.text_direction | `EDITABLE of bool | `EDITABLE_SET of bool | `FAMILY of string | `FAMILY_SET of bool | `FONT of string | `FONT_DESC of Pango.font_description | `FOREGROUND of string | `FOREGROUND_GDK of Gdk.color | `FOREGROUND_SET of bool | `FOREGROUND_STIPPLE of Gdk.bitmap | `FOREGROUND_STIPPLE_SET of bool | `INDENT of int | `INDENT_SET of bool | `INVISIBLE of bool | `INVISIBLE_SET of bool | `JUSTIFICATION of Tags.justification | `JUSTIFICATION_SET of bool | `LANGUAGE of string | `LANGUAGE_SET of bool | `LEFT_MARGIN of int | `LEFT_MARGIN_SET of bool | `PARAGRAPH_BACKGROUND of string | `PARAGRAPH_BACKGROUND_GDK of Gdk.color | `PARAGRAPH_BACKGROUND_SET of bool | `PIXELS_ABOVE_LINES of int | `PIXELS_ABOVE_LINES_SET of bool | `PIXELS_BELOW_LINES of int | `PIXELS_BELOW_LINES_SET of bool | `PIXELS_INSIDE_WRAP of int | `PIXELS_INSIDE_WRAP_SET of bool | `RIGHT_MARGIN of int | `RIGHT_MARGIN_SET of bool | `RISE of int | `RISE_SET of bool | `SCALE of Pango.Tags.scale | `SCALE_SET of bool | `SIZE of int | `SIZE_POINTS of float | `SIZE_SET of bool | `STRETCH of Pango.Tags.stretch | `STRETCH_SET of bool | `STRIKETHROUGH of bool | `STRIKETHROUGH_SET of bool | `STYLE of Pango.Tags.style | `STYLE_SET of bool | `TABS_SET of bool | `UNDERLINE of Pango.Tags.underline | `UNDERLINE_SET of bool | `VARIANT of Pango.Tags.variant | `VARIANT_SET of bool | `WEIGHT of Pango.Tags.weight | `WEIGHT_SET of bool | `WRAP_MODE of Tags.wrap_mode | `WRAP_MODE_SET of bool ] (** @gtkdoc gtk GtkTextTag *) class tag_signals : ([> `texttag] as 'b) obj -> object ('a) method after : 'a method event : callback:(origin:unit Gobject.obj -> GdkEvent.any -> text_iter -> bool) -> GtkSignal.id end (** A tag that can be applied to text in a {!GText.buffer} @gtkdoc gtk GtkTextTag *) class tag : text_tag -> object method as_tag : text_tag method connect : tag_signals method event : 'a obj -> GdkEvent.any -> text_iter -> bool method get_oid : int method priority : int method set_priority : int -> unit method set_properties : tag_property list -> unit method set_property : tag_property -> unit method get_property : ([`texttag],'a) Gobject.property -> 'a end (** @gtkdoc gtk GtkTextTag *) val tag : ?name:string -> unit -> tag (** {3 Text buffer iterator} *) type contents = [ `CHAR of Glib.unichar | `PIXBUF of GdkPixbuf.pixbuf | `CHILD of child_anchor | `UNKNOWN ] (** Movement functions returning an iter are truly functional i.e. the returned iter shares nothing with the originale one. If you need to move some iter in an imperative way use [#nocopy#...]. *) (** @gtkdoc gtk gtk-GtkTextIter *) class nocopy_iter : text_iter -> object method as_iter : text_iter method assign : nocopy_iter -> unit method backward_char : bool method backward_chars : int -> bool method backward_cursor_position : bool method backward_cursor_positions : int -> bool method backward_find_char : ?limit:iter -> (Glib.unichar -> bool) -> bool method backward_line : bool method backward_lines : int -> bool method backward_sentence_start : bool method backward_sentence_starts : int -> bool method backward_to_tag_toggle : tag option -> bool method backward_word_start : bool method backward_word_starts : int -> bool method forward_char : bool method forward_chars : int -> bool method forward_cursor_position : bool method forward_cursor_positions : int -> bool method forward_find_char : ?limit:iter -> (Glib.unichar -> bool) -> bool method forward_line : bool method forward_lines : int -> bool method forward_sentence_end : bool method forward_sentence_ends : int -> bool method forward_to_end : unit method forward_to_tag_toggle : tag option -> bool method forward_word_end : bool method forward_word_ends : int -> bool method forward_to_line_end : bool method set_line : int -> unit method set_line_index : int -> unit method set_line_offset : int -> unit method set_offset : int -> unit method set_visible_line_index : int -> unit method set_visible_line_offset : int -> unit end (** @gtkdoc gtk gtk-GtkTextIter *) and iter : text_iter -> object ('self) method as_iter : text_iter method copy : iter method nocopy : nocopy_iter method backward_char : iter method backward_chars : int -> iter method backward_cursor_position : iter method backward_cursor_positions : int -> iter method backward_find_char : ?limit:iter -> (Glib.unichar -> bool) -> iter method backward_line : iter method backward_lines : int -> iter method backward_search : ?flags:Gtk.Tags.text_search_flag list -> ?limit:iter -> string -> (iter * iter) option method backward_sentence_start : iter method backward_sentence_starts : int -> iter method backward_to_tag_toggle : tag option -> iter method backward_word_start : iter method backward_word_starts : int -> iter method begins_tag : tag option -> bool method buffer : text_buffer method bytes_in_line : int method can_insert : default:bool -> bool method char : Glib.unichar method chars_in_line : int method compare : iter -> int method contents : contents method editable : default:bool -> bool method ends_line : bool method ends_sentence : bool method ends_tag : tag option -> bool method ends_word : bool method equal : iter -> bool method forward_char : iter method forward_chars : int -> iter method forward_cursor_position : iter method forward_cursor_positions : int -> iter method forward_find_char : ?limit:iter -> (Glib.unichar -> bool) -> iter method forward_line : iter method forward_lines : int -> iter method forward_search : ?flags:Gtk.Tags.text_search_flag list -> ?limit:iter -> string -> (iter * iter) option method forward_sentence_end : iter method forward_sentence_ends : int -> iter method forward_to_end : iter method forward_to_line_end : iter method forward_to_tag_toggle : tag option -> iter method forward_word_end : iter method forward_word_ends : int -> iter method get_slice : stop:iter -> string method get_text : stop:iter -> string method get_toggled_tags : bool -> tag list method get_visible_slice : stop:iter -> string method get_visible_text : stop:iter -> string method has_tag : tag -> bool method in_range : start:iter -> stop:iter -> bool method inside_sentence : bool method inside_word : bool method is_cursor_position : bool method is_end : bool method is_start : bool method language : string method line : int method line_index : int method line_offset : int method marks : text_mark list method offset : int method set_line : int -> iter method set_line_index : int -> iter method set_line_offset : int -> iter method set_offset : int -> iter method set_visible_line_index : int -> iter method set_visible_line_offset : int -> iter method starts_line : bool method starts_sentence : bool method starts_word : bool method tags : tag list method toggles_tag : tag option -> bool method visible_line_index : int method visible_line_offset : int end (** @gtkdoc gtk gtk-GtkTextIter *) val as_iter : iter -> text_iter (** {3 GtkTextTagTable} *) (** @gtkdoc gtk GtkTextTagTable *) class tag_table_signals : ([> `texttagtable] as 'b) obj -> object ('a) method after : 'a method tag_added : callback:(text_tag -> unit) -> GtkSignal.id method tag_changed : callback:(text_tag -> size:bool -> unit) -> GtkSignal.id method tag_removed : callback:(text_tag -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkTextTagTable *) class tag_table_skel : [> `texttagtable] obj -> object method get_oid : int method as_tag_table : text_tag_table method add : text_tag -> unit method remove : text_tag -> unit method lookup : string -> text_tag option method size : int end (** Collection of tags that can be used together @gtkdoc gtk GtkTextTagTable *) class tag_table : [> `texttagtable] obj -> object inherit tag_table_skel method connect : tag_table_signals end (** @gtkdoc gtk GtkTextTagTable *) val tag_table : unit -> tag_table (** {3 GtkTextBuffer} *) (** @gtkdoc gtk GtkTextBuffer *) (* class buffer_signals : [> `textbuffer] obj -> object ('a) method apply_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method begin_user_action : callback:(unit -> unit) -> GtkSignal.id method changed : callback:(unit -> unit) -> GtkSignal.id method delete_range : callback:(start:iter -> stop:iter -> unit) -> GtkSignal.id method end_user_action : callback:(unit -> unit) -> GtkSignal.id method insert_child_anchor : callback:(iter -> text_child_anchor -> unit) -> GtkSignal.id method insert_pixbuf : callback:(iter -> GdkPixbuf.pixbuf -> unit) -> GtkSignal.id method insert_text : callback:(iter -> string -> unit) -> GtkSignal.id method mark_deleted : callback:(text_mark -> unit) -> GtkSignal.id method mark_set : callback:(iter -> text_mark -> unit) -> GtkSignal.id method modified_changed : callback:(unit -> unit) -> GtkSignal.id method remove_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method after : 'a end *) class type buffer_signals_skel_type = object method apply_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method begin_user_action : callback:(unit -> unit) -> GtkSignal.id method changed : callback:(unit -> unit) -> GtkSignal.id method delete_range : callback:(start:iter -> stop:iter -> unit) -> GtkSignal.id method end_user_action : callback:(unit -> unit) -> GtkSignal.id method insert_child_anchor : callback:(iter -> Gtk.text_child_anchor -> unit) -> GtkSignal.id method insert_pixbuf : callback:(iter -> GdkPixbuf.pixbuf -> unit) -> GtkSignal.id method insert_text : callback:(iter -> string -> unit) -> GtkSignal.id method mark_deleted : callback:(Gtk.text_mark -> unit) -> GtkSignal.id method mark_set : callback:(iter -> Gtk.text_mark -> unit) -> GtkSignal.id method modified_changed : callback:(unit -> unit) -> GtkSignal.id method remove_tag : callback:(tag -> start:iter -> stop:iter -> unit) -> GtkSignal.id method notify_cursor_position : callback:(int -> unit) -> GtkSignal.id method notify_has_selection : callback:(bool -> unit) -> GtkSignal.id method notify_tag_table : callback:(text_tag_table -> unit) -> GtkSignal.id end class type ['b] buffer_signals_type = object ('a) inherit buffer_signals_skel_type method after : 'a method private connect : 'c. ('b, 'c) GtkSignal.t -> callback:'c -> GtkSignal.id method private notify : 'c. ('b, 'c) Gobject.property -> callback:('c -> unit) -> GtkSignal.id end class virtual buffer_signals_skel : object constraint 'c = [> `textbuffer ] inherit buffer_signals_skel_type method private virtual connect : 'a. ('c, 'a) GtkSignal.t -> callback:'a -> GtkSignal.id method private virtual notify : 'b. ('c, 'b) Gobject.property -> callback:('b -> unit) -> GtkSignal.id end class buffer_signals : ([> `textbuffer ] as 'b) Gtk.obj -> ['b] buffer_signals_type exception No_such_mark of string type position = [ `OFFSET of int | `LINE of int | `LINECHAR of int * int | `LINEBYTE of int * int | `START | `END | `ITER of iter | mark ] (** Stores attributed text for display in a {!GText.view} @gtkdoc gtk GtkTextBuffer *) class buffer_skel : [> `textbuffer] obj -> object method as_buffer : text_buffer method add_selection_clipboard : GData.clipboard -> unit method apply_tag : tag -> start:iter -> stop:iter -> unit method apply_tag_by_name : string -> start:iter -> stop:iter -> unit method begin_user_action : unit -> unit method bounds : iter * iter method char_count : int method copy_clipboard : GData.clipboard -> unit method create_child_anchor : iter -> child_anchor method create_mark : ?name:string -> ?left_gravity:bool -> iter -> text_mark (** @param left_gravity default value is [true] *) method create_tag : ?name:string -> tag_property list -> tag method cut_clipboard : ?default_editable:bool -> GData.clipboard -> unit (** @param default_editable default value is [true] *) method delete : start:iter -> stop:iter -> unit method delete_interactive : start:iter -> stop:iter -> ?default_editable:bool -> unit -> bool (** @param default_editable default value is [true] *) method delete_mark : mark -> unit method delete_selection : ?interactive:bool -> ?default_editable:bool -> unit -> bool (** @param interactive default value is [true] @param default_editable default value is [true] *) method end_iter : iter method end_user_action : unit -> unit method get_iter : position -> iter method get_iter_at_char : ?line:int -> int -> iter method get_iter_at_byte : line:int -> int -> iter method get_iter_at_mark : mark -> iter method get_mark : mark -> text_mark method get_oid : int method get_text : ?start:iter -> ?stop:iter -> ?slice:bool -> ?visible:bool -> unit -> string (** @param slice default value is [false] @param visible default value is [false] *) method insert : ?iter:iter -> ?tag_names:string list -> ?tags:tag list -> string -> unit method insert_child_anchor : iter -> child_anchor -> unit method insert_interactive : ?iter:iter -> ?default_editable:bool -> string -> bool (** @param default_editable default value is [true] *) method insert_pixbuf : iter:iter -> pixbuf:GdkPixbuf.pixbuf -> unit method insert_range : iter:iter -> start:iter -> stop:iter -> unit method insert_range_interactive : iter:iter -> start:iter -> stop:iter -> ?default_editable:bool -> unit -> bool (** @param default_editable default value is [true] *) method line_count : int method modified : bool method move_mark : mark -> where:iter -> unit method paste_clipboard : ?iter:iter -> ?default_editable:bool -> GData.clipboard -> unit (** @param default_editable default value is [true] *) method place_cursor : where:iter -> unit method select_range : iter -> iter -> unit (** @since GTK 2.4 *) method remove_all_tags : start:iter -> stop:iter -> unit method remove_selection_clipboard : GData.clipboard -> unit method remove_tag : tag -> start:iter -> stop:iter -> unit method remove_tag_by_name : string -> start:iter -> stop:iter -> unit method selection_bounds : iter * iter method set_modified : bool -> unit method set_text : string -> unit method start_iter : iter method tag_table : text_tag_table method has_selection : bool (** since Gtk 2.10 *) method cursor_position : int (** since Gtk 2.10 *) end class buffer : [> `textbuffer] obj -> object inherit buffer_skel method connect : buffer_signals end (** @gtkdoc gtk GtkTextBuffer *) val buffer : ?tag_table:tag_table -> ?text:string -> unit -> buffer (** {3 GtkTextView} *) (** @gtkdoc gtk GtkTextView *) class view_signals : [> text_view] obj -> object ('a) method after : 'a method copy_clipboard : callback:(unit -> unit) -> GtkSignal.id method cut_clipboard : callback:(unit -> unit) -> GtkSignal.id method delete_from_cursor : callback:(Tags.delete_type -> int -> unit) -> GtkSignal.id method destroy : callback:(unit -> unit) -> GtkSignal.id method insert_at_cursor : callback:(string -> unit) -> GtkSignal.id method move_cursor : callback:(Tags.movement_step -> int -> extend:bool -> unit) -> GtkSignal.id method move_focus : callback:(Tags.direction_type -> unit) -> GtkSignal.id method page_horizontally : callback:(int -> extend:bool -> unit) -> GtkSignal.id method paste_clipboard : callback:(unit -> unit) -> GtkSignal.id method populate_popup : callback:(menu obj -> unit) -> GtkSignal.id method set_anchor : callback:(unit -> unit) -> GtkSignal.id method set_scroll_adjustments : callback:(GData.adjustment option -> GData.adjustment option -> unit) -> GtkSignal.id method toggle_overwrite : callback:(unit -> unit) -> GtkSignal.id method notify_accepts_tab : callback:(bool -> unit) -> GtkSignal.id method notify_cursor_visible : callback:(bool -> unit) -> GtkSignal.id method notify_editable : callback:(bool -> unit) -> GtkSignal.id method notify_indent : callback:(int -> unit) -> GtkSignal.id method notify_justification : callback:(GtkEnums.justification -> unit) -> GtkSignal.id method notify_left_margin : callback:(int -> unit) -> GtkSignal.id method notify_pixels_above_lines : callback:(int -> unit) -> GtkSignal.id method notify_pixels_below_lines : callback:(int -> unit) -> GtkSignal.id method notify_pixels_inside_wrap : callback:(int -> unit) -> GtkSignal.id method notify_right_margin : callback:(int -> unit) -> GtkSignal.id method notify_wrap_mode : callback:(GtkEnums.wrap_mode -> unit) -> GtkSignal.id end (** Widget that displays a {!GText.buffer} @gtkdoc gtk GtkTextView *) class view_skel : ([> text_view] as 'a) obj -> object inherit GObj.widget val obj : 'a obj method as_view : text_view obj method accepts_tab : bool method add_child_at_anchor : GObj.widget -> child_anchor -> unit method add_child_in_window : child:GObj.widget -> which_window:Tags.text_window_type -> x:int -> y:int -> unit method backward_display_line : iter -> bool method backward_display_line_start : iter -> bool method buffer : buffer method buffer_to_window_coords : tag:Tags.text_window_type -> x:int -> y:int -> int * int method cursor_visible : bool method editable : bool method event : GObj.event_ops method forward_display_line : iter -> bool method forward_display_line_end : iter -> bool method get_border_window_size : [ `BOTTOM | `LEFT | `RIGHT | `TOP] -> int method get_iter_at_location : x:int -> y:int -> iter method get_iter_location : iter -> Gdk.Rectangle.t method get_line_at_y : int -> iter * int method get_line_yrange : iter -> int * int method get_window : Tags.text_window_type -> Gdk.window option method get_window_type : Gdk.window -> Tags.text_window_type method indent : int method justification : Tags.justification method left_margin : int method misc : GObj.misc_ops method move_child : child:GObj.widget -> x:int -> y:int -> unit method move_mark_onscreen : mark -> bool method move_visually : iter -> int -> bool method pixels_above_lines : int method pixels_below_lines : int method pixels_inside_wrap : int method place_cursor_onscreen : unit -> bool method right_margin : int method scroll_mark_onscreen : mark -> unit method scroll_to_iter : ?within_margin:float -> ?use_align:bool -> ?xalign:float -> ?yalign:float -> iter -> bool (** @param use_align default value is [false] *) method scroll_to_mark : ?within_margin:float -> ?use_align:bool -> ?xalign:float -> ?yalign:float -> mark -> unit (** @param use_align default value is [false] *) method set_accepts_tab : bool -> unit method set_border_window_size : typ:[ `BOTTOM | `LEFT | `RIGHT | `TOP] -> size:int -> unit method set_buffer : buffer -> unit method set_cursor_visible : bool -> unit method set_editable : bool -> unit method set_indent : int -> unit method set_justification : Tags.justification -> unit method set_left_margin : int -> unit method set_pixels_above_lines : int -> unit method set_pixels_below_lines : int -> unit method set_pixels_inside_wrap : int -> unit method set_right_margin : int -> unit method set_wrap_mode : Tags.wrap_mode -> unit method starts_display_line : iter -> bool method visible_rect : Gdk.Rectangle.t method window_to_buffer_coords : tag:Tags.text_window_type -> x:int -> y:int -> int * int method wrap_mode : Tags.wrap_mode end class view : ([> text_view] as 'a) obj -> object inherit view_skel val obj : 'a obj method connect : view_signals end (** @gtkdoc gtk GtkTextView *) val view : ?buffer:buffer -> ?editable:bool -> ?cursor_visible:bool -> ?justification:Tags.justification -> ?wrap_mode:Tags.wrap_mode -> ?accepts_tab:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> view lablgtk-2.18.8/src/glib.ml0000644000175000017500000002420213460263323014322 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) type unichar = int type unistring = unichar array exception GError of string external _init : unit -> unit = "ml_glib_init" let () = _init () ; Callback.register_exception "gerror" (GError "") module Main = struct type t external create : bool -> t = "ml_g_main_new" external iteration : bool -> bool = "ml_g_main_iteration" external pending : unit -> bool = "ml_g_main_pending" external is_running : t -> bool = "ml_g_main_is_running" external quit : t -> unit = "ml_g_main_quit" external destroy : t -> unit = "ml_g_main_destroy" type locale_category = [ `ALL | `COLLATE | `CTYPE | `MESSAGES | `MONETARY | `NUMERIC | `TIME ] external setlocale : locale_category -> string option -> string = "ml_setlocale" external wrap_poll_func : unit -> unit = "ml_g_wrap_poll_func" end let int_of_priority = function | `HIGH -> -100 | `DEFAULT -> 0 | `HIGH_IDLE -> 100 | `DEFAULT_IDLE -> 200 | `LOW -> 300 module Timeout = struct type id external add : ?prio:int -> ms:int -> callback:(unit -> bool) -> id = "ml_g_timeout_add" let add = add ?prio:None external remove : id -> unit = "ml_g_source_remove" end module Idle = struct type id external add : ?prio:int -> (unit -> bool) -> id = "ml_g_idle_add" external remove : id -> unit = "ml_g_source_remove" end module Io = struct type channel type condition = [ `IN | `OUT | `PRI | `ERR | `HUP | `NVAL ] type id external channel_of_descr : Unix.file_descr -> channel = "ml_g_io_channel_unix_new" external remove : id -> unit = "ml_g_source_remove" external add_watch : cond:condition list -> callback:(condition list -> bool) -> ?prio:int -> channel -> id = "ml_g_io_add_watch" external read : channel -> buf:bytes -> pos:int -> len:int -> int = "ml_g_io_channel_read" external read_chars : channel -> buf:bytes -> pos:int -> len:int -> int = "ml_g_io_channel_read_chars" end module Message = struct type log_level = [ `ERROR | `CRITICAL | `WARNING | `MESSAGE | `INFO | `DEBUG | `FLAG_RECURSION | `FLAG_FATAL ] external _log_level : log_level -> int = "ml_Log_level_val" let log_level = function | `CUSTOM i -> i lsl 8 | #log_level as level -> _log_level level let int_of_log_levels levels = List.fold_left (fun acc lev -> acc lor (log_level lev)) 0 levels type log_handler external _set_log_handler : ?domain:string -> levels:int -> (level:int -> string -> unit) -> log_handler = "ml_g_log_set_handler" let set_log_handler ?domain ~levels f = _set_log_handler ?domain ~levels:(int_of_log_levels levels) f external remove_log_handler : log_handler -> unit = "ml_g_log_remove_handler" external _set_always_fatal : int -> unit = "ml_g_log_set_always_fatal" let set_always_fatal (levels : log_level list) = _set_always_fatal (int_of_log_levels levels) external _set_fatal_mask : ?domain:string -> int -> unit = "ml_g_log_set_fatal_mask" let set_fatal_mask ?domain levels = _set_fatal_mask ?domain (int_of_log_levels levels) external _log : string -> int -> string -> unit = "ml_g_log" let log ?(domain="") level fmt = Printf.kprintf (_log domain (log_level level)) fmt end (* module Thread = struct external init : unit -> unit = "ml_g_thread_init" (* Call only once! *) external enter : unit -> unit = "ml_gdk_threads_enter" external leave : unit -> unit = "ml_gdk_threads_leave" end *) module Convert = struct type error = | NO_CONVERSION | ILLEGAL_SEQUENCE | FAILED | PARTIAL_INPUT | BAD_URI | NOT_ABSOLUTE_PATH exception Error of error * string let () = Callback.register_exception "g_convert_error" (Error (NO_CONVERSION, "")) external convert : string -> to_codeset:string -> from_codeset:string -> string = "ml_g_convert" external convert_with_fallback : ?fallback:string -> to_codeset:string -> from_codeset:string -> string -> string = "ml_g_convert_with_fallback" (* [get_charset ()] returns the pair [u,s] where [u] is true if the current charset is UTF-8 encoded and [s] is the charset name. *) external get_charset : unit -> bool * string = "ml_g_get_charset" external utf8_validate : string -> bool = "ml_g_utf8_validate" let raise_bad_utf8 () = raise (Error (ILLEGAL_SEQUENCE, "Invalid byte sequence for UTF-8 string")) let locale_from_utf8 s = match get_charset () with | (true, _) -> if utf8_validate s then s else raise_bad_utf8 () | (false, to_codeset) -> convert s ~to_codeset ~from_codeset:"UTF-8" let locale_to_utf8 s = match get_charset () with | (true, _) -> if utf8_validate s then s else raise_bad_utf8 () | (false, from_codeset) -> convert s ~to_codeset:"UTF-8" ~from_codeset external filename_from_utf8 : string -> string = "ml_g_filename_from_utf8" external filename_to_utf8 : string -> string = "ml_g_filename_to_utf8" external filename_from_uri : string -> string option * string = "ml_g_filename_from_uri" external filename_to_uri : ?hostname:string -> string -> string = "ml_g_filename_to_uri" end module Unichar = struct external to_lower : unichar -> unichar = "ml_g_unichar_tolower" external to_upper : unichar -> unichar = "ml_g_unichar_toupper" external to_title : unichar -> unichar = "ml_g_unichar_totitle" external digit_value : unichar -> int = "ml_g_unichar_digit_value" external xdigit_value : unichar -> int = "ml_g_unichar_xdigit_value" external validate : unichar -> bool = "ml_g_unichar_validate" [@@noalloc] external isalnum : unichar -> bool = "ml_g_unichar_isalnum" external isalpha : unichar -> bool = "ml_g_unichar_isalpha" external iscntrl : unichar -> bool = "ml_g_unichar_iscntrl" external isdigit : unichar -> bool = "ml_g_unichar_isdigit" external isgraph : unichar -> bool = "ml_g_unichar_isgraph" external islower : unichar -> bool = "ml_g_unichar_islower" external isprint : unichar -> bool = "ml_g_unichar_isprint" external ispunct : unichar -> bool = "ml_g_unichar_ispunct" external isspace : unichar -> bool = "ml_g_unichar_isspace" external isupper : unichar -> bool = "ml_g_unichar_isupper" external isxdigit : unichar -> bool = "ml_g_unichar_isxdigit" external istitle : unichar -> bool = "ml_g_unichar_istitle" external isdefined : unichar -> bool = "ml_g_unichar_isdefined" external iswide : unichar -> bool = "ml_g_unichar_iswide" end module Utf8 = struct include Gutf8 external validate : string -> bool = "ml_g_utf8_validate" external length : string -> int = "ml_g_utf8_strlen" external offset_to_pos : string -> pos:int -> off:int -> int = "ml_g_utf8_offset_to_pointer" [@@noalloc] external uppercase : string -> string = "ml_g_utf8_strup" external lowercase : string -> string = "ml_g_utf8_strdown" type normalize_mode = [ `DEFAULT | `DEFAULT_COMPOSE | `ALL | `ALL_COMPOSE ] external normalize : string -> normalize_mode -> string = "ml_g_utf8_normalize" external casefold : string -> string = "ml_g_utf8_casefold" external collate : string -> string -> int = "ml_g_utf8_collate" external collate_key : string -> string = "ml_g_utf8_collate_key" end module Markup = struct type error = | BAD_UTF8 | EMPTY | PARSE | UNKNOWN_ELEMENT | UNKNOWN_ATTRIBUTE | INVALID_CONTENT exception Error of error * string let () = Callback.register_exception "g_markup_error" (Error (BAD_UTF8, "")) external escape_text : string -> string = "ml_g_markup_escape_text" end external get_prgname : unit -> string = "ml_g_get_prgname" external set_prgname : string -> unit = "ml_g_set_prgname" external get_application_name : unit -> string = "ml_g_get_application_name" external set_application_name : string -> unit = "ml_g_set_application_name" external get_user_name : unit -> string = "ml_g_get_user_name" external get_real_name : unit -> string = "ml_g_get_real_name" external get_home_dir : unit -> string option = "ml_g_get_home_dir" external get_tmp_dir : unit -> string = "ml_g_get_tmp_dir" external find_program_in_path : string -> string = "ml_g_find_program_in_path" external getenv : string -> string = "ml_g_getenv" external setenv : string -> string -> bool -> unit = "ml_g_setenv" external unsetenv : string -> unit = "ml_g_unsetenv" external get_user_cache_dir : unit -> string = "ml_g_get_user_cache_dir" external get_user_data_dir : unit -> string = "ml_g_get_user_data_dir" external get_user_config_dir : unit -> string = "ml_g_get_user_config_dir" external get_system_data_dirs : unit -> string list = "ml_g_get_system_data_dirs" external get_system_config_dirs : unit -> string list = "ml_g_get_system_config_dirs" external usleep : int -> unit = "ml_g_usleep" lablgtk-2.18.8/src/gtkSourceView2.ml0000644000175000017500000002643213460263323016277 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) open GtkSourceView2_types open Gaux open Gobject open Gtk open Tags open SourceView2Enums open GtkSourceView2Props open GtkBase external _gtk_source_completion_init: unit -> unit = "ml_gtk_source_completion_init" external _gtk_source_style_scheme_init: unit -> unit = "ml_gtk_source_style_scheme_init" external _gtk_source_style_scheme_manager_init: unit -> unit = "ml_gtk_source_style_scheme_manager_init" external _gtk_source_language_init: unit -> unit = "ml_gtk_source_language_init" external _gtk_source_language_manager_init: unit -> unit = "ml_gtk_source_language_manager_init" external _gtk_source_buffer_init: unit -> unit = "ml_gtk_source_buffer_init" external _gtk_source_view_init: unit -> unit = "ml_gtk_source_view_init" let () = _gtk_source_completion_init (); _gtk_source_style_scheme_init (); _gtk_source_style_scheme_manager_init (); _gtk_source_language_init (); _gtk_source_language_manager_init (); _gtk_source_buffer_init (); _gtk_source_view_init () module SourceStyleScheme = struct include SourceStyleScheme external get_name: source_style_scheme obj -> string = "ml_gtk_source_style_scheme_get_name" external get_description: source_style_scheme obj -> string = "ml_gtk_source_style_scheme_get_description" end module SourceCompletionItem = struct include SourceCompletionItem external new_: string -> string -> GdkPixbuf.pixbuf option -> string option -> source_completion_proposal obj = "ml_gtk_source_completion_item_new" external new_with_markup: string -> string -> GdkPixbuf.pixbuf option -> string option -> source_completion_proposal obj = "ml_gtk_source_completion_item_new_with_markup" external new_from_stock: string -> string -> string -> string -> source_completion_proposal obj = "ml_gtk_source_completion_item_new_from_stock" end module SourceCompletionProvider = struct include SourceCompletionProvider type provider = { provider_name : unit -> string; provider_icon : unit -> GdkPixbuf.pixbuf option; provider_populate : source_completion_context obj -> unit; provider_activation : unit -> source_completion_activation_flags list; provider_match : source_completion_context obj -> bool; provider_info_widget : source_completion_proposal obj -> widget obj option; provider_update_info : source_completion_proposal obj -> source_completion_info obj -> unit; provider_start_iter : source_completion_context obj -> source_completion_proposal obj -> text_iter -> bool; provider_activate_proposal : source_completion_proposal obj -> text_iter -> bool; provider_interactive_delay : unit -> int; provider_priority : unit -> int; } external match_ : source_completion_provider obj -> source_completion_context obj -> bool = "ml_gtk_source_completion_provider_match" external new_ : provider -> source_completion_provider obj = "ml_custom_completion_provider_new" end module SourceCompletionContext = SourceCompletionContext module SourceCompletionInfo = SourceCompletionInfo module SourceCompletion = SourceCompletion module SourceStyleSchemeManager = struct include SourceStyleSchemeManager external new_ : unit -> source_style_scheme_manager obj = "ml_gtk_source_style_scheme_manager_new" external default : unit -> source_style_scheme_manager obj = "ml_gtk_source_style_scheme_manager_get_default" end module SourceLanguage = struct include SourceLanguage external get_id : [>`sourcelanguage] obj -> string = "ml_gtk_source_language_get_id" external get_name : [>`sourcelanguage] obj -> string = "ml_gtk_source_language_get_name" external get_section : [>`sourcelanguage] obj -> string = "ml_gtk_source_language_get_section" external get_hidden : [>`sourcelanguage] obj -> bool = "ml_gtk_source_language_get_hidden" external metadata: [>`sourcelanguage] obj -> string -> string option= "ml_gtk_source_language_get_metadata" external mime_types: [>`sourcelanguage] obj -> string list = "ml_gtk_source_language_get_mime_types" external globs: [>`sourcelanguage] obj -> string list = "ml_gtk_source_language_get_globs" external style_name: [>`sourcelanguage] obj -> string -> string option = "ml_gtk_source_language_get_style_name" external style_ids: [>`sourcelanguage] obj -> string list = "ml_gtk_source_language_get_style_ids" end module SourceLanguageManager = struct include SourceLanguageManager external new_: unit -> source_language_manager obj = "ml_gtk_source_language_manager_new" external default: unit -> source_language_manager obj = "ml_gtk_source_language_manager_get_default" external set_search_path: [>`sourcelanguagemanager] obj -> string list -> unit = "ml_gtk_source_language_manager_set_search_path" external search_path: [>`sourcelanguagemanager] obj -> string list = "ml_gtk_source_language_manager_get_search_path" external language_ids: [>`sourcelanguagemanager] obj -> string list = "ml_gtk_source_language_manager_get_language_ids" external language: [>`sourcelanguagemanager] obj -> string -> source_language obj option = "ml_gtk_source_language_manager_get_language" external guess_language: [>`sourcelanguagemanager] obj -> string option -> string option -> source_language obj option = "ml_gtk_source_language_manager_guess_language" end module SourceUndoManager = struct include SourceUndoManager type undo_manager = { can_undo : unit -> bool; can_redo : unit -> bool; undo : unit -> unit; redo : unit -> unit; begin_not_undoable_action : unit -> unit; end_not_undoable_action : unit -> unit; can_undo_changed : unit -> unit; can_redo_changed : unit -> unit; } external new_ : undo_manager -> [`sourceundomanager] obj = "ml_custom_undo_manager_new" end module SourceBuffer = struct include SourceBuffer external new_: [`texttagtable] obj -> source_buffer obj = "ml_gtk_source_buffer_new" external new_with_langage: [>`sourcelanguage] obj -> source_buffer obj = "ml_gtk_source_buffer_new_with_language" external undo: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_undo" external redo: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_redo" external begin_not_undoable_action: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_begin_not_undoable_action" external end_not_undoable_action: [>`sourcebuffer] obj -> unit = "ml_gtk_source_buffer_end_not_undoable_action" external set_highlight_matching_brackets: [>`sourcebuffer] obj -> bool -> unit = "ml_gtk_source_buffer_set_highlight_matching_brackets" external create_source_mark: [>`sourcebuffer] obj -> string option -> string option -> Gtk.text_iter -> source_mark obj = "ml_gtk_source_buffer_create_source_mark" external remove_source_marks: [>`sourcebuffer] obj -> Gtk.text_iter -> Gtk.text_iter -> string option -> unit = "ml_gtk_source_buffer_remove_source_marks" external get_source_marks_at_line: [>`sourcebuffer] obj -> int -> string option -> source_mark obj list = "ml_gtk_source_buffer_get_source_marks_at_line" external get_source_marks_at_iter: [>`sourcebuffer] obj -> Gtk.text_iter -> string option -> source_mark obj list = "ml_gtk_source_buffer_get_source_marks_at_iter" external forward_iter_to_source_mark: [>`sourcebuffer] obj -> Gtk.text_iter -> string option -> bool = "ml_gtk_source_buffer_forward_iter_to_source_mark" external backward_iter_to_source_mark: [>`sourcebuffer] obj -> Gtk.text_iter -> string option -> bool = "ml_gtk_source_buffer_backward_iter_to_source_mark" external iter_has_context_class: [>`sourcebuffer] obj -> Gtk.text_iter -> string -> bool = "ml_gtk_source_buffer_iter_has_context_class" external iter_forward_to_context_class_toggle: [>`sourcebuffer] obj -> Gtk.text_iter -> string -> bool = "ml_gtk_source_buffer_iter_forward_to_context_class_toggle" external iter_backward_to_context_class_toggle: [>`sourcebuffer] obj -> Gtk.text_iter -> string -> bool = "ml_gtk_source_buffer_iter_backward_to_context_class_toggle" external ensure_highlight: [>`sourcebuffer] obj -> Gtk.text_iter -> Gtk.text_iter -> unit = "ml_gtk_source_buffer_ensure_highlight" end module SourceView = struct include SourceView external new_: unit -> source_view obj = "ml_gtk_source_view_new" external new_with_buffer: [>`sourcebuffer] obj -> source_view obj = "ml_gtk_source_view_new_with_buffer" external set_mark_category_pixbuf: [>`sourceview] obj -> string -> GdkPixbuf.pixbuf option -> unit = "ml_gtk_source_view_set_mark_category_pixbuf" external get_mark_category_pixbuf: [>`sourceview] obj -> string -> GdkPixbuf.pixbuf option = "ml_gtk_source_view_get_mark_category_pixbuf" (* Should probably not exist *) external set_cursor_color: [>`sourceview] obj -> Gdk.color -> unit = "ml_gtk_modify_cursor_color" end module SourceMark = struct include SourceMark external next: [> `sourcemark] obj -> string option -> source_mark obj option = "ml_gtk_source_mark_next" external prev: [> `sourcemark] obj -> string option -> source_mark obj option = "ml_gtk_source_mark_prev" end module SourceViewMisc = struct external iter_backward_search: Gtk.text_iter -> string -> SourceView2Enums.source_search_flag list -> start: Gtk.text_iter -> stop: Gtk.text_iter -> Gtk.text_iter option -> (Gtk.text_iter * Gtk.text_iter) option = "ml_gtk_source_iter_backward_search_bc" "ml_gtk_source_iter_backward_search" external iter_forward_search: Gtk.text_iter -> string -> SourceView2Enums.source_search_flag list -> start: Gtk.text_iter -> stop: Gtk.text_iter -> Gtk.text_iter option -> (Gtk.text_iter * Gtk.text_iter) option = "ml_gtk_source_iter_forward_search_bc" "ml_gtk_source_iter_forward_search" end lablgtk-2.18.8/src/gRange.mli0000644000175000017500000001452713460263323014772 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj (** Scrollbars, progressbars, etc. *) (** {3 GtkProgressBar} *) (** A widget which indicates progress visually @gtkdoc gtk GtkProgress @gtkdoc gtk GtkProgressBar *) class progress_bar : Gtk.progress_bar obj -> object inherit GObj.widget_full val obj : Gtk.progress_bar Gtk.obj method adjustment : GData.adjustment method event : GObj.event_ops method pulse : unit -> unit method set_adjustment : GData.adjustment -> unit method set_fraction : float -> unit method set_orientation : Tags.progress_bar_orientation -> unit method set_pulse_step : float -> unit method set_text : string -> unit method fraction : float method orientation : Tags.progress_bar_orientation method pulse_step : float method text : string method ellipsize : PangoEnums.ellipsize_mode (** @since GTK 2.6 *) method set_ellipsize : PangoEnums.ellipsize_mode -> unit (** @since GTK 2.6 *) end (** @gtkdoc gtk GtkProgress @gtkdoc gtk GtkProgressBar @param orientation default value is [`LEFT_TO_RIGHT] @param pulse_step default value is [0.1] *) val progress_bar : ?orientation:Tags.progress_bar_orientation -> ?pulse_step:float -> ?packing:(widget -> unit) -> ?show:bool -> unit -> progress_bar (** {3 GtkRange} *) (** @gtkdoc gtk GtkRange *) class range_signals : [> Gtk.range] obj -> object inherit GObj.widget_signals method adjust_bounds : callback:(float -> unit) -> GtkSignal.id method move_slider : callback:(Tags.scroll_type -> unit) -> GtkSignal.id method change_value : callback:(Tags.scroll_type -> float -> unit) -> GtkSignal.id method value_changed : callback:(unit -> unit) -> GtkSignal.id method notify_adjustment : callback:(GData.adjustment -> unit) -> GtkSignal.id method notify_inverted : callback:(bool -> unit) -> GtkSignal.id method notify_update_policy : callback:(GtkEnums.update_type -> unit) -> GtkSignal.id end (** Base class for widgets which visualize an adjustment @gtkdoc gtk GtkRange *) class range : ([> Gtk.range] as 'a) obj -> object inherit GObj.widget val obj : 'a obj method as_range : Gtk.range Gtk.obj method connect : range_signals method event : GObj.event_ops method set_adjustment : GData.adjustment -> unit method set_inverted : bool -> unit method set_update_policy : Tags.update_type -> unit method adjustment : GData.adjustment method inverted : bool method update_policy : Tags.update_type end (** A slider widget for selecting a value from a range @gtkdoc gtk GtkScale @gtkdoc gtk GtkHScale @gtkdoc gtk GtkVScale *) class scale : Gtk.scale obj -> object inherit range val obj : Gtk.scale obj method set_digits : int -> unit method set_draw_value : bool -> unit method set_value_pos : Tags.position -> unit method digits : int method draw_value : bool method value_pos : Tags.position end (** @gtkdoc gtk GtkScale @gtkdoc gtk GtkHScale @gtkdoc gtk GtkVScale @param digits default value is [1] @param draw_value default value is [false] @param value_pos default value is [`LEFT] @param inverted default value is [false] @param update_policy default value is [`CONTINUOUS] *) val scale : Tags.orientation -> ?adjustment:GData.adjustment -> ?digits:int -> ?draw_value:bool -> ?value_pos:Tags.position -> ?inverted:bool -> ?update_policy:Tags.update_type -> ?packing:(widget -> unit) -> ?show:bool -> unit -> scale (** @gtkdoc gtk GtkScrollbar @gtkdoc gtk GtkHScrollbar @gtkdoc gtk GtkVScrollbar @param inverted default value is [false] @param update_policy default value is [`CONTINUOUS] *) val scrollbar : Tags.orientation -> ?adjustment:GData.adjustment -> ?inverted:bool -> ?update_policy:Tags.update_type -> ?packing:(widget -> unit) -> ?show:bool -> unit -> range (** {3 GtkRuler} *) (** @gtkdoc gtk GtkRuler @gtkdoc gtk GtkHRuler @gtkdoc gtk GtkVRuler *) class ruler : ([> Gtk.ruler] as 'a) Gtk.obj -> object inherit GObj.widget_full val obj : 'a Gtk.obj method event : GObj.event_ops method set_metric : Tags.metric_type -> unit method set_lower : float -> unit method set_max_size : float -> unit method set_metric : Gtk.Tags.metric_type -> unit method set_position : float -> unit method set_upper : float -> unit method lower : float method max_size : float method position : float method upper : float end (** @gtkdoc gtk GtkRuler @gtkdoc gtk GtkHRuler @gtkdoc gtk GtkVRuler @param metric default value is [`PIXELS] *) val ruler : Tags.orientation -> ?metric:Tags.metric_type -> ?lower:float -> ?upper:float -> ?max_size:float -> ?position:float -> ?packing:(GObj.widget -> unit) -> ?show:bool -> unit -> ruler lablgtk-2.18.8/src/ml_gpointer.c0000644000175000017500000000764213460263323015547 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include "wrappers.h" #include "ml_gpointer.h" CAMLprim value ml_stable_copy (value v) { if (Is_block(v) && (char*)(v) < young_end && (char*)(v) > young_start) { CAMLparam1(v); mlsize_t i, wosize = Wosize_val(v); int tag = Tag_val(v); value ret; if (tag < No_scan_tag) invalid_argument("ml_stable_copy"); ret = alloc_shr (wosize, tag); for (i=0; i < wosize; i++) Field(ret,i) = Field(v,i); CAMLreturn(ret); } return v; } CAMLprim value ml_string_at_pointer (value ofs, value len, value ptr) { char *start = ((char*)Pointer_val(ptr)) + Option_val(ofs, Int_val, 0); int length = Option_val(len, Int_val, strlen(start)); value ret = alloc_string(length); memcpy ((char*)ret, start, length); return ret; } CAMLprim value ml_int_at_pointer (value ptr) { return Val_int(*(int*)Pointer_val(ptr)); } CAMLprim value ml_set_int_at_pointer (value ptr, value n) { *(int*)Pointer_val(ptr) = Int_val(n); return Val_unit; } CAMLprim value ml_long_at_pointer (value ptr) { return copy_nativeint(*(long*)Pointer_val(ptr)); } CAMLprim value ml_set_long_at_pointer (value ptr, value n) { *(long*)Pointer_val(ptr) = Nativeint_val(n); return Val_unit; } CAMLexport unsigned char* ml_gpointer_base (value region) { unsigned int i; value ptr = RegData_val(region); value path = RegPath_val(region); if (Is_block(path)) for (i = 0; i < Wosize_val(path); i++) ptr = Field(ptr, Int_val(Field(path, i))); return (unsigned char*) ptr+RegOffset_val(region); } CAMLprim value ml_gpointer_get_char (value region, value pos) { return Val_int(*(ml_gpointer_base (region) + Long_val(pos))); } CAMLprim value ml_gpointer_set_char (value region, value pos, value ch) { *(ml_gpointer_base (region) + Long_val(pos)) = Int_val(ch); return Val_unit; } CAMLprim value ml_gpointer_blit (value region1, value region2) { void *base1 = ml_gpointer_base (region1); void *base2 = ml_gpointer_base (region2); memcpy (base2, base1, RegLength_val(region1)); return Val_unit; } CAMLprim value ml_gpointer_get_addr (value region) { return copy_nativeint ((long)ml_gpointer_base (region)); } lablgtk-2.18.8/src/gtkSourceView.props0000644000175000017500000001032513460263323016742 0ustar stephsteph(*********************************************************************************) (* *) (* lablgtksourceview, OCaml binding for the GtkSourceView text widget *) (* *) (* Copyright (C) 2005 Stefano Zacchiroli *) (* Copyright (C) 2006 Stefano Zacchiroli *) (* Maxence Guesdon *) (* *) (* This library is free software; you can redistribute it and/or modify *) (* it under the terms of the GNU Lesser General Public License as *) (* published by the Free Software Foundation; either version 2.1 of the *) (* License, or (at your option) any later version. *) (* *) (* This library is distributed in the hope that it will be useful, but *) (* WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU *) (* Lesser General Public License for more details. *) (* *) (* You should have received a copy of the GNU Lesser General Public *) (* License along with this library; if not, write to the Free Software *) (* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 *) (* USA *) (* *) (*********************************************************************************) prefix "Gtk" header { open GtkSourceView_types } class SourceStyleScheme type "source_style_scheme obj" set wrapsig : GObject { } class SourceLanguage type "source_language obj" set wrapsig : GObject { signal tag_style_changed: string } class SourceLanguagesManager type "source_languages_manager obj" set wrapsig : GObject { (* "lang-files-dirs" gpointer : Read / Write / Construct Only *) } class SourceTagStyle type "source_tag_style obj" set wrapsig : GObject { "foreground" GdkColor : Read / Write "background" GdkColor : Read / Write "italic" gboolean : Read / Write "bold" gboolean : Read / Write "underline" gboolean : Read / Write "strikethrough" gboolean : Read / Write } class SourceTag type "source_tag obj" set wrapsig : GObject { "id" gchararray : Read / Write / Construct Only } class SourceTagTable type "source_tag_table obj" set wrapsig : GObject { signal changed } class SourceMarker type "source_marker obj" set wrapsig : GObject { } class SourceBuffer type "source_buffer obj" set wrapsig : GObject { "check-brackets" gboolean : Read / Write "escape-char" guint : Read / Write "highlight" gboolean : Read / Write "language" GtkSourceLanguage : Read / Write "max-undo-levels" gint : Read / Write "tag-table" GtkSourceTagTable : Read / Write / Construct Only signal can_redo: gboolean signal can_undo: gboolean signal highlight_updated: GtkTextIter GtkTextIter signal marker_updated: GtkTextIter } class SourceView type "source_view obj" set wrapsig : Widget { "auto-indent" gboolean : Read / Write "highlight-current-line" gboolean : Read / Write "insert-spaces-instead-of-tabs" gboolean : Read / Write "margin" guint : Read / Write "show-line-markers" gboolean : Read / Write "show-line-numbers" gboolean : Read / Write "show-margin" gboolean : Read / Write "smart-home-end" gboolean : Read / Write "tabs-width" guint : Read / Write signal redo signal undo } lablgtk-2.18.8/src/pango_tags.var0000644000175000017500000000165013460263323015711 0ustar stephsteph(* $Id$ *) package "pango" prefix "pango_" type style = "PANGO_STYLE_" [ `NORMAL | `OBLIQUE | `ITALIC ] type weight = "PANGO_WEIGHT_" [ `ULTRALIGHT | `LIGHT | `NORMAL |`BOLD | `ULTRABOLD |`HEAVY ] type variant = "PANGO_VARIANT_" [ `NORMAL | `SMALL_CAPS ] type stretch = "PANGO_STRETCH_" [ `ULTRA_CONDENSED | `EXTRA_CONDENSED | `CONDENSED | `SEMI_CONDENSED | `NORMAL | `SEMI_EXPANDED | `EXPANDED | `EXTRA_EXPANDED | `ULTRA_EXPANDED ] type noconv scale = "PANGO_SCALE_" [ `XX_SMALL | `X_SMALL | `SMALL | `MEDIUM | `LARGE | `X_LARGE | `XX_LARGE | `CUSTOM ] type underline = "PANGO_UNDERLINE_" [ `NONE | `SINGLE | `DOUBLE | `LOW ] type wrap_mode = "PANGO_WRAP_" [ `WORD | `CHAR | `WORD_CHAR ] type protect HASGTK26 ellipsize_mode = "PANGO_ELLIPSIZE_" [ `NONE | `START | `MIDDLE | `END ] (* this enum was introduced in Pango 1.6 / GTK+ 2.6 *) type alignment = "PANGO_ALIGN_" [ `LEFT | `CENTER | `RIGHT ] lablgtk-2.18.8/src/ml_gpointer.h0000644000175000017500000000352213460263323015545 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #define RegData_val(val) (Field(val,0)) #define RegPath_val(val) (Field(val,1)) #define RegOffset_val(val) (Long_val(Field(val,2))) #define RegLength_val(val) (Long_val(Field(val,3))) CAMLexport unsigned char* ml_gpointer_base (value region); lablgtk-2.18.8/src/gtkPack.props0000644000175000017500000001161613460263323015531 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk } oheader{ open GtkPackProps } classes { GtkAdjustment "Gtk.adjustment obj" } class Box hv set : Container { "homogeneous" gboolean : Read / Write "spacing" gint : Read / Write method pack_start : "[>`widget] obj -> expand:bool -> fill:bool -> padding:int -> unit" method pack_end : "[>`widget] obj -> expand:bool -> fill:bool -> padding:int -> unit" method reorder_child : "[>`widget] obj -> pos:int -> unit" method query_child_packing : "[>`widget] obj -> box_packing" method set_child_packing : "[>`widget] obj -> ?expand:bool -> ?fill:bool -> ?padding:int -> ?from:Tags.pack_type -> unit" } class ButtonBox hv : Box { "layout-style" GtkButtonBoxStyle : Read / Write method get_child_secondary : "[>`widget] obj -> bool" method set_child_secondary : "[>`widget] obj -> bool -> unit" } class Fixed : Container { method put : "[>`widget] obj -> x:int -> y:int -> unit" method move : "[>`widget] obj -> x:int -> y:int -> unit" method set_has_window : "bool -> unit" method get_has_window : "bool" } class Paned hv wrap : Container { "position" gint : Read / Write "position-set" gboolean : Read / Write / NoWrap "max-position" gint : Read "min-position" gint : Read method add1 : "[>`widget] obj -> unit" method add2 : "[>`widget] obj -> unit" method pack1 : "[>`widget] obj -> resize:bool -> shrink:bool -> unit" method pack2 : "[>`widget] obj -> resize:bool -> shrink:bool -> unit" method child1 : "widget obj" method child2 : "widget obj" (* omit signals *) } class Layout set : Container { "hadjustment" GtkAdjustment : Read / Write "height" guint : Read / Write "vadjustment" GtkAdjustment : Read / Write "width" guint : Read / Write method put : "[>`widget] obj -> x:int -> y:int -> unit" method move : "[>`widget] obj -> x:int -> y:int -> unit" method freeze method thaw method bin_window : "Gdk.window" } conversions { Pointer } class Notebook set wrap wrapsig : Container { "enable-popup" gboolean : Read / Write "homogeneous"(homogeneous_tabs) gboolean : Read / Write "page" gint : Read / Write / NoSet / NoWrap "scrollable" gboolean : Read / Write "show-border" gboolean : Read / Write "show-tabs" gboolean : Read / Write "tab-border" guint : Write "tab-hborder" guint : Read / Write / NoSet "tab-pos" GtkPositionType : Read / Write "tab-vborder" guint : Read / Write / NoSet method insert_page_menu : "[>`widget] obj -> tab_label:[>`widget] optobj -> menu_label:[>`widget] optobj -> ?pos:int -> int" (* default is append to end *) method remove_page : "int -> unit" method get_current_page : "int" method get_nth_page : "int -> widget obj" method page_num : "[>`widget] obj -> int" method next_page method prev_page method get_tab_label : "[>`widget] obj -> widget obj" method set_tab_label : "[>`widget] obj -> [>`widget] obj -> unit" method get_menu_label : "[>`widget] obj -> widget obj" method set_menu_label : "[>`widget] obj -> [>`widget] obj -> unit" method reorder_child : "[>`widget] obj -> int -> unit" method set_tab_reorderable : "[>`widget] obj -> bool -> unit" method get_tab_reorderable : "[>`widget] obj -> bool" signal switch_page : Pointer gint / NoWrap signal select_page : gboolean signal reorder_tab : GtkDirectionType gboolean signal change_current_page : gint signal move_focus_out : GtkDirectionType signal page_added : GtkWidget guint (* GTK+ 2.10 *) signal page_removed : GtkWidget guint (* GTK+ 2.10 *) signal page_reordered : GtkWidget guint (* GTK+ 2.10 *) signal create_window : page:GtkWidget x:gint y:gint (* GTK+ 2.12 *) } class Table set wrap :Container { "n-columns"(columns) guint : Read / Write "n-rows"(rows) guint : Read / Write "homogeneous" gboolean : Read / Write "row-spacing"(row_spacings) guint : Read / Write "column-spacing"(col_spacings) guint : Read / Write method attach : "[>`widget] obj -> left:int -> right:int -> top:int -> bottom:int -> xoptions:Tags.attach_options list -> yoptions:Tags.attach_options list -> xpadding:int -> ypadding:int -> unit" method set_row_spacing : "int -> int -> unit" method set_col_spacing : "int -> int -> unit" } class SizeGroup : GObject { "mode" GtkSizeGroupMode : Read / Write method add_widget : "[>`widget] obj -> unit" method remove_widget : "[>`widget] obj -> unit" } lablgtk-2.18.8/src/gtkMisc.props0000644000175000017500000001504413460263323015545 0ustar stephsteph(* $Id$ *) header { open Gtk } conversions { GtkStock "GtkStock.conv" GtkCurveType "GtkEnums.curve_type_conv" } boxed { GdkEventButton "GdkEvent.Button.t" } classes { GdkPixbuf "GdkPixbuf.pixbuf" GtkMenu "Gtk.menu obj" } prefix "" class GtkStatusIcon set wrap wrapsig : GObject { "screen" GdkScreen : Read / Write "visible" gboolean : Read / Write "blinking" gboolean : Read / Write method set_from_pixbuf : "GdkPixbuf.pixbuf -> unit" method set_from_file : "string -> unit" method set_from_stock : "string -> unit" method set_from_icon_name : "string -> unit" method get_pixbuf : "GdkPixbuf.pixbuf" method get_stock : "string" method get_icon_name : "string" method get_size : "int" method set_screen : "Gdk.screen -> unit" method get_screen : "Gdk.screen" method set_tooltip : "string -> unit" method set_visible : "bool -> unit" method get_visible : "bool" method set_blinking : "bool -> unit" method get_blinking : "bool" method is_embedded : "bool" signal activate signal popup_menu : guint guint signal size_changed : gint } prefix "Gtk" class Misc abstract set wrap : Widget { "xalign" gfloat : Read / Write "yalign" gfloat : Read / Write "xpad" gint : Read / Write "ypad" gint : Read / Write } class Label set wrap : Misc { "label" gchararray : Read / Write "use-markup" gboolean : Read / Write "use-underline" gboolean : Read / Write "mnemonic-keyval" guint : Read "mnemonic-widget" GtkWidget_opt : Read / Write "justify" GtkJustification : Read / Write "wrap"(line_wrap) gboolean : Read / Write "pattern" gchararray : Write "selectable" gboolean : Read / Write "attributes" PangoAttrList : Read / Write "cursor-position" gint : Read "selection-bound" gint : Read (* new properties in GTK 2.6 *) "angle" gdouble : Read / Write / NoSet "ellipsize" PangoEllipsizeMode : Read / Write "max-width-chars" gint : Read / Write / NoSet "single-line-mode" gboolean : Read / Write / NoSet "width-chars" gint : Read / Write / NoSet method get_text : "string" method set_text : "string -> unit" method select_region : "int -> int -> unit" method get_selection_bounds : "(int * int) option" signal copy_clipboard signal move_cursor : GtkMovementStep gint gboolean signal populate_popup : GtkMenu } class TipsQuery set wrap wrapsig : Label { "caller" GtkWidget_opt : Read / Write "emit-always" gboolean : Read / Write "label-inactive" gchararray : Read / Write "label-no-tip" gchararray : Read / Write method start_query method stop_query signal start_query signal stop_query signal widget_entered : GtkWidget_opt text:string privat:string signal widget_selected : GtkWidget_opt text:string privat:string GdkEventButton -> bool } class Arrow set wrap : Misc { "arrow-type"(kind) GtkArrowType : Read / Write "shadow-type"(shadow) GtkShadowType : Read / Write } class Image set wrap : Misc { "file" gchararray : Write "image" GdkImage : Read / Write "pixbuf" GdkPixbuf : Read / Write "pixbuf-animation" GdkPixbufAnimation : Read / Write "pixel-size" gint : Read / Write "pixmap" GdkPixmap : Read / Write / NoWrap "mask" GdkBitmap_opt : Read / Write "stock" GtkStock : Read / Write "icon-set" GtkIconSet : Read / Write "icon-size" GtkIconSize : Read / Write "storage-type" GtkImageType : Read method clear } class ColorSelection set wrap : Box { "current-alpha"(alpha) guint : Read / Write "current-color"(color) GdkColor : Read / Write "has-opacity-control" gboolean : Read / Write "has-palette" gboolean : Read / Write signal color_changed } class FontSelection set wrap : Box { (* bug in Gtk: "font" GdkFont_opt : Read *) "font-name" gchararray : Read / Write "preview-text" gchararray : Read / Write } class GammaCurve : Box { method get_gamma : "float" } class Statusbar set : Box { "has-resize-grip" gboolean : Read / Write (* 2.4 *) method get_has_resize_grip : "bool" method set_has_resize_grip : "bool -> unit" method get_context_id : "string -> statusbar_context" method push : "statusbar_context -> text:string -> statusbar_message" method pop : "statusbar_context -> unit" method remove : "statusbar_context -> statusbar_message -> unit" signal text_popped : guint gchararray signal text_pushed : guint gchararray } class Calendar wrap wrapsig : Widget { "day" gint : Read / Write "month" gint : Read / Write "year" gint : Read / Write method select_month : "month:int -> year:int -> unit" method select_day : "int -> unit" method mark_day : "int -> unit" method unmark_day : "int -> unit" method get_num_marked_dates : "int" method is_day_marked : "int -> bool" method clear_marks method display_options : "Gtk.Tags.calendar_display_options list -> unit" method get_date : "int * int * int" (* year * month * day *) method freeze method thaw signal day_selected signal day_selected_double_click signal month_changed signal next_month signal next_year signal prev_month signal prev_year } class DrawingArea : Widget { method size : "width:int -> height:int -> unit" } class Curve set wrap : DrawingArea { "curve-type" GtkCurveType : Read / Write "max-x" gfloat : Read / Write "max-y" gfloat : Read / Write "min-x" gfloat : Read / Write "min-y" gfloat : Read / Write method reset method set_gamma : "int -> unit" method set_vector : "float array -> unit" method get_vector : "int -> float array" } class Separator hv : Widget {} lablgtk-2.18.8/src/gMisc.ml0000644000175000017500000002331413460263323014452 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkBase open GtkMisc open OgtkMiscProps open GObj let separator dir ?packing ?show () = let w = Separator.create dir [] in pack_return (new widget_full w) ~packing ~show class statusbar_context obj ctx = object (self) val obj : statusbar obj = obj val context : Gtk.statusbar_context = ctx method context = context method push text = Statusbar.push obj context ~text method pop () = Statusbar.pop obj context method remove = Statusbar.remove obj context method flash ?(delay=1000) text = let msg = self#push text in Glib.Timeout.add delay (fun () -> self#remove msg; false); () end class statusbar obj = object inherit GPack.box (obj : Gtk.statusbar obj) method has_resize_grip = Statusbar.get_has_resize_grip obj method set_has_resize_grip v = Statusbar.set_has_resize_grip obj v method new_context ~name = new statusbar_context obj (Statusbar.get_context_id obj name) end let statusbar = Statusbar.make_params [] ~cont: (GContainer.pack_container ~create: (fun p -> new statusbar (Statusbar.create p))) class status_icon_signals (obj : Gtk.status_icon Gobject.obj) = object (* inherit [Gtk.status_icon] gobject_signals obj*) inherit gtk_status_icon_sigs method private connect sgn ~callback = GtkSignal.connect ~sgn ~callback ~after: true obj method private notify prop ~callback = GtkSignal.connect_property obj ~prop ~callback end class status_icon obj = object val obj : Gtk.status_icon Gobject.obj = obj inherit gtk_status_icon_props method connect = new status_icon_signals obj method set_from_pixbuf = StatusIcon.set_from_pixbuf obj method set_from_file = StatusIcon.set_from_file obj method set_from_stock = StatusIcon.set_from_stock obj method set_from_icon_name = StatusIcon.set_from_icon_name obj method get_pixbuf = StatusIcon.get_pixbuf obj method get_stock = StatusIcon.get_stock obj method get_icon_name = StatusIcon.get_icon_name obj method get_size = StatusIcon.get_size obj method set_tooltip = StatusIcon.set_tooltip obj method is_embedded= StatusIcon.is_embedded obj end let status_icon = StatusIcon.make_params [] ~cont: (fun p () -> new status_icon (StatusIcon.create p)) let status_icon_from_pixbuf = StatusIcon.make_params [] ~cont: (fun p pb -> let o = new status_icon (StatusIcon.create p) in o#set_from_pixbuf pb; o ) let status_icon_from_file = StatusIcon.make_params [] ~cont: (fun p file -> let o = new status_icon (StatusIcon.create p) in o#set_from_file file; o ) let status_icon_from_stock = StatusIcon.make_params [] ~cont: (fun p s -> let o = new status_icon (StatusIcon.create p) in o#set_from_stock s; o ) let status_icon_from_icon_name = StatusIcon.make_params [] ~cont: (fun p s -> let o = new status_icon (StatusIcon.create p) in o#set_from_icon_name s; o ) class calendar_signals obj = object inherit widget_signals_impl obj inherit calendar_sigs end class calendar obj = object inherit ['a] widget_impl (obj : Gtk.calendar obj) inherit calendar_props method event = new GObj.event_ops obj method connect = new calendar_signals obj method select_month = Calendar.select_month obj method select_day = Calendar.select_day obj method mark_day = Calendar.mark_day obj method unmark_day = Calendar.unmark_day obj method clear_marks = Calendar.clear_marks obj method display_options = Calendar.display_options obj method date = Calendar.get_date obj method freeze () = Calendar.freeze obj method thaw () = Calendar.thaw obj method num_marked_dates = Calendar.get_num_marked_dates obj method is_day_marked = Calendar.is_day_marked obj end let calendar ?options ?packing ?show () = let w = Calendar.create [] in may options ~f:(Calendar.display_options w); pack_return (new calendar w) ~packing ~show class drawing_area obj = object inherit widget_full (obj : [> Gtk.drawing_area] obj) method event = new GObj.event_ops obj method set_size = DrawingArea.size obj end let may_set_size ?(width=0) ?(height=0) w = if width <> 0 || height <> 0 then DrawingArea.size w ~width ~height let drawing_area ?width ?height ?packing ?show () = let w = DrawingArea.create [] in may_set_size w ?width ?height; pack_return (new drawing_area w) ~packing ~show class curve obj = object inherit drawing_area (obj : Gtk.curve obj) inherit curve_props method reset () = Curve.reset obj method set_gamma = Curve.set_gamma obj method set_vector = Curve.set_vector obj method get_vector = Curve.get_vector obj end let curve ?width ?height = Curve.make_params [] ~cont:(fun pl ?packing ?show () -> let w = Curve.create pl in may_set_size w ?width ?height; pack_return (new curve w) ~packing ~show) class misc obj = object inherit ['a] widget_impl obj inherit misc_props end class arrow obj = object inherit misc obj inherit arrow_props end let arrow = Arrow.make_params [] ~cont:( Misc.all_params ~cont:(fun p ?packing ?show () -> pack_return (new arrow (Arrow.create p)) ~packing ~show)) class image obj = object (self) inherit misc obj inherit image_props method pixmap = new GDraw.pixmap (get Image.P.pixmap obj) ?mask:self#mask method set_pixmap (p : GDraw.pixmap) = set Image.P.pixmap obj p#pixmap; self#set_mask p#mask method clear () = Image.clear obj end type image_type = [ `EMPTY | `PIXMAP | `IMAGE | `PIXBUF | `STOCK | `ICON_SET | `ANIMATION | `ICON_NAME | `GICON ] let image = Image.make_params [] ~cont:( Misc.all_params ~cont:(fun p ?packing ?show () -> pack_return (new image (Image.create p)) ~packing ~show)) let pixmap pm = let pl = [param Image.P.pixmap pm#pixmap; param Image.P.mask pm#mask] in Misc.all_params pl ~cont:(fun pl ?packing ?show () -> pack_return (new image (Image.create pl)) ~packing ~show) class label_skel obj = object(self) inherit misc obj inherit label_props method text = GtkMiscProps.Label.get_text obj method set_text = GtkMiscProps.Label.set_text obj method selection_bounds = GtkMiscProps.Label.get_selection_bounds obj method select_region = GtkMiscProps.Label.select_region obj end class label obj = object inherit label_skel (obj : Gtk.label obj) method connect = new widget_signals_impl obj end let label ?text ?markup ?use_underline ?mnemonic_widget = let label, use_markup = if markup = None then text, None else markup, Some true in let mnemonic_widget = may_map (fun w -> w#as_widget) mnemonic_widget in Label.make_params [] ?label ?use_markup ?use_underline ?mnemonic_widget ~cont:( Misc.all_params ~cont:(fun p ?packing ?show () -> pack_return (new label (Label.create p)) ~packing ~show)) let label_cast w = new label (Label.cast w#as_widget) class tips_query_signals obj = object inherit widget_signals_impl (obj : Gtk.tips_query obj) inherit tips_query_sigs end class tips_query obj = object inherit label_skel obj method start () = TipsQuery.start_query obj method stop () = TipsQuery.stop_query obj inherit tips_query_props method connect = new tips_query_signals obj end let tips_query ?caller = let caller = may_map (fun w -> w#as_widget) caller in TipsQuery.make_params [] ?caller ~cont:( Misc.all_params ~cont:(fun p ?packing ?show () -> pack_return (new tips_query (TipsQuery.create p)) ~packing ~show)) class color_selection obj = object inherit [Gtk.color_selection] GObj.widget_impl obj method connect = new GObj.widget_signals_impl obj method set_border_width = set Container.P.border_width obj inherit color_selection_props end let color_selection = ColorSelection.make_params [] ~cont:( GContainer.pack_container ~create: (fun p -> new color_selection (ColorSelection.create p))) class font_selection obj = object inherit [Gtk.font_selection] widget_impl obj inherit font_selection_props method event = new event_ops obj method connect = new GObj.widget_signals_impl obj method set_border_width = set Container.P.border_width obj end let font_selection = FontSelection.make_params [] ~cont:( GContainer.pack_container ~create: (fun p -> new font_selection (FontSelection.create p))) lablgtk-2.18.8/src/gtkMain.ml0000644000175000017500000001035013460263323014776 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gtk let () = Callback.register_exception "gtkerror" (Error"") let () = Gc.set {(Gc.get()) with Gc.max_overhead = 1000000} module Main = struct external init : string array -> string array = "ml_gtk_init" (* external set_locale : unit -> string = "ml_gtk_set_locale" *) external disable_setlocale : unit -> unit = "ml_gtk_disable_setlocale" (* external main : unit -> unit = "ml_gtk_main" *) let init ?(setlocale=true) () = let setlocale = try Sys.getenv "GTK_SETLOCALE" <> "0" with Not_found -> setlocale in if not setlocale then disable_setlocale (); let argv = try init Sys.argv with Error err -> raise (Error ("GtkMain.init: initialization failed\n" ^ err)) in if setlocale then ignore (Glib.Main.setlocale `NUMERIC (Some "C")); Array.blit ~src:argv ~dst:Sys.argv ~len:(Array.length argv) ~src_pos:0 ~dst_pos:0; Obj.truncate (Obj.repr Sys.argv) (Array.length argv); if setlocale then Glib.Main.setlocale `ALL None else "" open Glib let loops = ref [] let default_main () = let loop = (Main.create true) in loops := loop :: !loops; Glib.Main.wrap_poll_func (); (* mark polling as blocking *) while Main.is_running loop do Main.iteration true done; if !loops <> [] then loops := List.tl !loops let main_func = ref default_main let main () = !main_func () let quit () = if !loops <> [] then Main.quit (List.hd !loops) external get_version : unit -> int * int * int = "ml_gtk_get_version" let version = get_version () external get_current_event_time : unit -> int32 = "ml_gtk_get_current_event_time" end module Grab = struct external add : [>`widget] obj -> unit = "ml_gtk_grab_add" external remove : [>`widget] obj -> unit = "ml_gtk_grab_remove" external get_current : unit -> widget obj= "ml_gtk_grab_get_current" end module Event = struct (* May return GDK_CURRENT_TIME *) external get_current_time : unit -> int32 = "ml_gtk_get_current_event_time" (* May raise Gpointer.Null *) external get_current : unit -> GdkEvent.any = "ml_gtk_get_current_event" (* May raise Gpointer.Null *) external get_widget : 'a Gdk.event -> widget obj = "ml_gtk_get_event_widget" external propagate : [> `widget] obj -> 'a Gdk.event -> unit = "ml_gtk_propagate_event" end module Rc = struct external add_default_file : string -> unit = "ml_gtk_rc_add_default_file" external parse : file:string -> unit = "ml_gtk_rc_parse" external parse_string : string -> unit = "ml_gtk_rc_parse_string" end module Gc_custom = struct external set_speed : int -> unit = "ml_set_gc_speed" external get_speed : unit -> int = "ml_get_gc_speed" end lablgtk-2.18.8/src/gPack.mli0000644000175000017500000002755213460263323014616 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj open GContainer (** Several container widgets *) (** {3 Boxes} *) (** @gtkdoc gtk GtkBox *) class box_skel : ([> box] as 'a) obj -> object inherit GContainer.container val obj : 'a obj method pack : ?from:Tags.pack_type -> ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit (** @param from default value is [`START] @param expand default value is [false] @param fill default value is [true], ignored if [expand] is [false] *) method reorder_child : widget -> pos:int -> unit method set_child_packing : ?from:Tags.pack_type -> ?expand:bool -> ?fill:bool -> ?padding:int -> widget -> unit method set_homogeneous : bool -> unit method homogeneous : bool method set_spacing : int -> unit method spacing : int end (** A base class for box containers @gtkdoc gtk GtkBox *) class box : ([> Gtk.box] as 'a) obj -> object inherit box_skel val obj : 'a obj method connect : GContainer.container_signals end (** @gtkdoc gtk GtkBox @param homogeneous default value is [false] *) val box : Tags.orientation -> ?homogeneous:bool -> ?spacing:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box (** @gtkdoc gtk GtkVBox @param homogeneous default value is [false] *) val vbox : ?homogeneous:bool -> ?spacing:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box (** @gtkdoc gtk GtkHVBox @param homogeneous default value is [false] *) val hbox : ?homogeneous:bool -> ?spacing:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> box (** @gtkdoc gtk GtkButtonBox *) class button_box : ([> Gtk.button_box] as 'a) obj -> object inherit box val obj : 'a obj method set_child_ipadding : ?x:int -> ?y:int -> unit -> unit (** @deprecated . *) method set_child_size : ?width:int -> ?height:int -> unit -> unit (** @deprecated . *) method set_layout : Gtk.Tags.button_box_style -> unit method layout : Gtk.Tags.button_box_style method get_child_secondary : widget -> bool (** @since GTK 2.4 *) method set_child_secondary : widget -> bool -> unit (** @since GTK 2.4 *) end (** @gtkdoc gtk GtkButtonBox *) val button_box : Tags.orientation -> ?spacing:int -> ?child_width:int -> ?child_height:int -> ?child_ipadx:int -> ?child_ipady:int -> ?layout:GtkPack.BBox.bbox_style -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> button_box (** {3 GtkTable} *) (** Pack widgets in regular patterns @gtkdoc gtk GtkTable *) class table : Gtk.table obj -> object inherit GContainer.container_full val obj : Gtk.table obj method attach : left:int -> top:int -> ?right:int -> ?bottom:int -> ?expand:Tags.expand_type -> ?fill:Tags.expand_type -> ?shrink:Tags.expand_type -> ?xpadding:int -> ?ypadding:int -> widget -> unit (** @param left column number to attach the left side of the widget to @param top row number to attach the top of the widget to @param right default value is [left+1] @param bottom default value is [top+1] @param expand default value is [`NONE] @param fill default value is [`BOTH] @param shrink default value is [`NONE] *) method col_spacings : int method columns : int method homogeneous : bool method row_spacings : int method rows : int method set_col_spacing : int -> int -> unit method set_col_spacings : int -> unit method set_columns : int -> unit method set_homogeneous : bool -> unit method set_row_spacing : int -> int -> unit method set_row_spacings : int -> unit method set_rows : int -> unit end (** @gtkdoc gtk GtkTable *) val table : ?columns:int -> ?rows:int -> ?homogeneous:bool -> ?row_spacings:int -> ?col_spacings:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> table (** {3 GtkFixed} *) (** A container which allows you to position widgets at fixed coordinates @gtkdoc gtk GtkFixed *) class fixed : Gtk.fixed obj -> object inherit GContainer.container_full val obj : Gtk.fixed obj method event : event_ops method move : widget -> x:int -> y:int -> unit method put : widget -> x:int -> y:int -> unit method set_has_window : bool -> unit method has_window : bool end (** @gtkdoc gtk GtkFixed *) val fixed : ?has_window: bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> fixed (** {3 GtkLayout} *) (** Infinite scrollable area containing child widgets and/or custom drawing @gtkdoc gtk GtkLayout *) class layout : 'a obj -> object inherit GContainer.container_full constraint 'a = [> Gtk.layout] val obj : 'a obj method event : event_ops method bin_window : Gdk.window method freeze : unit -> unit method hadjustment : GData.adjustment method height : int method move : widget -> x:int -> y:int -> unit method put : widget -> x:int -> y:int -> unit method set_hadjustment : GData.adjustment -> unit method set_height : int -> unit method set_vadjustment : GData.adjustment -> unit method set_width : int -> unit method thaw : unit -> unit method vadjustment : GData.adjustment method width : int end (** @gtkdoc gtk GtkLayout *) val layout : ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?layout_width:int -> ?layout_height:int -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> layout (** {3 GtkNotebook} *) (** @gtkdoc gtk GtkNotebook *) class notebook_signals : [> Gtk.notebook] obj -> object inherit GContainer.container_signals method change_current_page : callback:(int -> unit) -> GtkSignal.id method create_window : callback:(page:GObj.widget -> x:int -> y:int -> unit) -> GtkSignal.id method move_focus_out : callback:(GtkEnums.direction_type -> unit) -> GtkSignal.id method notify_enable_popup : callback:(bool -> unit) -> GtkSignal.id method notify_homogeneous_tabs : callback:(bool -> unit) -> GtkSignal.id method notify_scrollable : callback:(bool -> unit) -> GtkSignal.id method notify_show_border : callback:(bool -> unit) -> GtkSignal.id method notify_show_tabs : callback:(bool -> unit) -> GtkSignal.id method notify_tab_hborder : callback:(int -> unit) -> GtkSignal.id method notify_tab_pos : callback:(GtkEnums.position_type -> unit) -> GtkSignal.id method notify_tab_vborder : callback:(int -> unit) -> GtkSignal.id method page_added : callback:(GObj.widget -> int -> unit) -> GtkSignal.id method page_removed : callback:(GObj.widget -> int -> unit) -> GtkSignal.id method page_reordered : callback:(GObj.widget -> int -> unit) -> GtkSignal.id method reorder_tab : callback:(GtkEnums.direction_type -> bool -> unit) -> GtkSignal.id method select_page : callback:(bool -> unit) -> GtkSignal.id method switch_page : callback:(int -> unit) -> GtkSignal.id end (** A tabbed notebook container @gtkdoc gtk GtkNotebook *) class notebook : Gtk.notebook obj -> object inherit GContainer.container val obj : Gtk.notebook obj method as_notebook : Gtk.notebook Gtk.obj method event : event_ops method append_page : ?tab_label:widget -> ?menu_label:widget -> widget -> int method connect : notebook_signals method current_page : int method get_menu_label : widget -> widget method get_nth_page : int -> widget method get_tab_label : widget -> widget method get_tab_reorderable : widget -> bool method goto_page : int -> unit method insert_page : ?tab_label:widget -> ?menu_label:widget -> ?pos:int -> widget -> int method next_page : unit -> unit method page_num : widget -> int method prepend_page : ?tab_label:widget -> ?menu_label:widget -> widget -> int method previous_page : unit -> unit method remove_page : int -> unit method reorder_child : widget -> int -> unit method set_enable_popup : bool -> unit method set_homogeneous_tabs : bool -> unit method set_page : ?tab_label:widget -> ?menu_label:widget -> widget -> unit method set_scrollable : bool -> unit method set_show_border : bool -> unit method set_show_tabs : bool -> unit method set_tab_border : int -> unit method set_tab_hborder : int -> unit method set_tab_reorderable : widget -> bool -> unit method set_tab_vborder : int -> unit method set_tab_pos : Tags.position -> unit method enable_popup : bool method homogeneous_tabs : bool method scrollable : bool method show_border : bool method show_tabs : bool method tab_hborder : int method tab_pos : GtkEnums.position_type method tab_vborder : int end (** @gtkdoc gtk GtkNotebook *) val notebook : ?enable_popup:bool -> ?homogeneous_tabs:bool -> ?scrollable:bool -> ?show_border:bool -> ?show_tabs:bool -> ?tab_border:int -> ?tab_pos:Tags.position -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> notebook (** {3 GtkPaned} *) (** Base class for widgets with two adjustable panes @gtkdoc gtk GtkPaned *) class paned : Gtk.paned obj -> object inherit GContainer.container_full val obj : Gtk.paned obj method event : event_ops method add1 : widget -> unit method add2 : widget -> unit method pack1 : ?resize:bool -> ?shrink:bool -> widget -> unit (** @param resize default value is [false] @param shrink default value is [false] *) method pack2 : ?resize:bool -> ?shrink:bool -> widget -> unit (** @param resize default value is [false] @param shrink default value is [false] *) method child1 : widget method child2 : widget method set_position : int -> unit method position : int method max_position : int (** @since GTK 2.4 *) method min_position : int (** @since GTK 2.4 *) end (** @gtkdoc gtk GtkPaned *) val paned : Tags.orientation -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> paned lablgtk-2.18.8/src/panel.ml0000644000175000017500000001203413460263323014504 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) type panel_applet = [`panelapplet| Gtk.event_box] type background_type = [ | `NO_BACKGROUND | `COLOR_BACKGROUND of Gdk.color | `PIXMAP_BACKGROUND of Gdk.pixmap ] type flags = [ | `EXPAND_MAJOR | `EXPAND_MINOR | `HAS_HANDLE ] type orient_type = GtkEnums.arrow_type external get_orient : [> panel_applet] Gtk.obj -> orient_type = "ml_panel_applet_get_orient" external get_size : [> panel_applet] Gtk.obj -> int = "ml_panel_applet_get_size" external get_background : [> panel_applet] Gtk.obj -> background_type = "ml_panel_applet_get_background" external get_flags : [> panel_applet] Gtk.obj -> flags list = "ml_panel_applet_get_flags" external set_flags : [> panel_applet] Gtk.obj -> flags list -> unit = "ml_panel_applet_set_flags" type verb = string * (string -> unit) external setup_menu : [> panel_applet] Gtk.obj -> xml:string -> verb list -> unit = "ml_panel_applet_setup_menu" external setup_menu_from_file : [> panel_applet] Gtk.obj -> ?dir:string -> file:string -> ?app_name:string -> verb list -> unit = "ml_panel_applet_setup_menu_from_file" external _factory_main : string array -> iid:string -> ([> panel_applet] Gtk.obj -> iid:string -> bool) -> bool = "ml_panel_applet_factory_main" module S = struct let change_background = { GtkSignal.name = "change-background" ; GtkSignal.classe = `panelapplet ; GtkSignal.marshaller = fun (cb : (background_type -> unit)) argv -> match Gobject.Closure.get_args argv with | _ :: `INT 0 :: _ -> cb `NO_BACKGROUND | _ :: `INT 1 :: `POINTER (Some color) :: _ -> cb (`COLOR_BACKGROUND (Obj.magic color)) | _ :: `INT 2 :: _ :: `OBJECT (Some pixmap) :: _ -> cb (`PIXMAP_BACKGROUND (Gdk.Pixmap.cast pixmap)) | _ -> failwith "marshal: PanelApplet::change-background" } let change_orient : (panel_applet, _) GtkSignal.t = { GtkSignal.name = "change-orient" ; GtkSignal.classe = `panelapplet ; GtkSignal.marshaller = GtkSignal.marshal1 GtkEnums.arrow_type_conv "change-orient" } let change_size : (panel_applet, _) GtkSignal.t = { GtkSignal.name = "change-size" ; GtkSignal.classe = `panelapplet ; GtkSignal.marshaller = GtkSignal.marshal1 Gobject.Data.int "change-size" } let move_focus_out_of_applet : (panel_applet, _) GtkSignal.t = { GtkSignal.name = "move-focus-out-of-applet" ; GtkSignal.classe = `panelapplet ; GtkSignal.marshaller = GtkSignal.marshal1 GtkEnums.direction_type_conv "move-focus-out-of-applet" } end class applet_signals obj = object (self) inherit GContainer.container_signals_impl obj method change_background = self#connect S.change_background method change_orient = self#connect S.change_orient method change_size = self#connect S.change_size method move_focus_out_of_applet = self#connect S.move_focus_out_of_applet end class applet obj = object (self) inherit GContainer.bin obj method connect = new applet_signals (obj :> panel_applet Gtk.obj) method event = new GObj.event_ops obj method get_background = get_background obj method get_orient = get_orient obj method get_size = get_size obj method get_flags = get_flags obj method set_flags = set_flags obj method setup_menu = setup_menu obj method setup_menu_from_file = setup_menu_from_file obj end let factory_main ~iid cb = _factory_main Sys.argv ~iid (fun obj ~iid -> cb (new applet obj) ~iid) lablgtk-2.18.8/src/ml_gvaluecaml.h0000644000175000017500000000332313460263323016035 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ GType g_caml_get_type() G_GNUC_CONST; #define G_TYPE_CAML (g_caml_get_type()) void g_value_store_caml_value (GValue *, value); lablgtk-2.18.8/src/ml_gtktext.h0000644000175000017500000000564313460263323015416 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #define GtkTextMark_val(val) check_cast(GTK_TEXT_MARK,val) #define Val_GtkTextMark(val) (Val_GObject((GObject*)val)) #define Val_GtkTextMark_new(val) (Val_GObject_new((GObject*)val)) #define GtkTextTag_val(val) check_cast(GTK_TEXT_TAG,val) #define Val_GtkTextTag(val) (Val_GObject((GObject*)val)) #define Val_GtkTextTag_new(val) (Val_GObject_new((GObject*)val)) #define GtkTextTagTable_val(val) check_cast(GTK_TEXT_TAG_TABLE,val) #define Val_GtkTextTagTable(val) (Val_GObject((GObject*)val)) #define Val_GtkTextTagTable_new(val) (Val_GObject_new((GObject*)val)) #define GtkTextBuffer_val(val) check_cast(GTK_TEXT_BUFFER,val) #define Val_GtkTextBuffer(val) (Val_GObject((GObject*)val)) #define Val_GtkTextBuffer_new(val) (Val_GObject_new((GObject*)val)) #define GtkTextChildAnchor_val(val) check_cast(GTK_TEXT_CHILD_ANCHOR,val) #define Val_GtkTextChildAnchor(val) (Val_GObject((GObject*)val)) #define Val_GtkTextChildAnchor_new(val) (Val_GObject_new((GObject*)val)) /* "Lighter" version: allocate in the ocaml heap (see ml_gtktext.c for other definitions. */ #define GtkTextIter_val(val) ((GtkTextIter*)MLPointer_val(val)) #define Val_GtkTextIter(it) (copy_memblock_indirected(it,sizeof(GtkTextIter))) #define alloc_GtkTextIter() (alloc_memblock_indirected(sizeof(GtkTextIter)) #define GtkTextView_val(val) check_cast(GTK_TEXT_VIEW,val) lablgtk-2.18.8/src/gButton.ml0000644000175000017500000002631013460263323015031 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gobject open Gtk open GtkBase open GtkButton open OgtkButtonProps open GObj open GContainer class button_skel obj = object (self) inherit bin obj inherit button_props method clicked () = Button.clicked obj method grab_default () = set Widget.P.can_default obj true; set Widget.P.has_default obj true method event = new GObj.event_ops obj method unset_image () = Gobject.Property.set_dyn obj GtkButtonProps.Button.P.image.Gobject.name (`OBJECT None) end class button_signals obj = object inherit container_signals_impl (obj : [> button] obj) inherit button_sigs end class button obj = object inherit button_skel (obj : Gtk.button obj) method connect = new button_signals obj end let pack_return create p ?packing ?show () = pack_return (create p) ~packing ~show let button ?label = Button.make_params [] ?label ~cont:( pack_return (fun p -> new button (Button.create p))) class toggle_button_signals obj = object (self) inherit button_signals obj method toggled = self#connect ToggleButton.S.toggled end class toggle_button obj = object inherit button_skel obj method connect = new toggle_button_signals obj method active = get ToggleButton.P.active obj method set_active = set ToggleButton.P.active obj method set_draw_indicator = set ToggleButton.P.draw_indicator obj end let make_toggle_button create ?label = Button.make_params [] ?label ~cont:( ToggleButton.make_params ~cont:( pack_return (fun p -> new toggle_button (create p)))) let toggle_button = make_toggle_button ToggleButton.create let check_button = make_toggle_button ToggleButton.create_check class radio_button obj = object inherit toggle_button (obj : Gtk.radio_button obj) method set_group = set RadioButton.P.group obj method group = Some obj end let radio_button ?group = Button.make_params [] ~cont:( ToggleButton.make_params ~cont:( pack_return (fun p -> new radio_button (RadioButton.create ?group p)))) class color_button_signals obj = object (self) inherit button_signals obj method color_set = self#connect ColorButton.S.color_set end class color_button obj = object inherit button_skel obj inherit color_button_props method connect = new color_button_signals obj end let color_button = ColorButton.make_params [] ~cont:( pack_return (fun pl -> new color_button (ColorButton.create pl))) class font_button_signals obj = object (self) inherit button_signals obj method font_set = self#connect FontButton.S.font_set end class font_button obj = object inherit button_skel obj inherit font_button_props method connect = new font_button_signals obj end let font_button = FontButton.make_params [] ~cont:( pack_return (fun pl -> new font_button (FontButton.create pl))) (* Toolbar *) class type tool_item_o = object method as_tool_item : Gtk.tool_item obj end class toolbar_signals obj = object inherit GContainer.container_signals_impl obj inherit toolbar_sigs end class toolbar obj = object inherit container (obj : Gtk.toolbar obj) method connect = new toolbar_signals obj method insert_widget ?tooltip ?tooltip_private ?pos w = Toolbar.insert_widget obj (as_widget w) ?tooltip ?tooltip_private ?pos method insert_button ?text ?tooltip ?tooltip_private ?icon ?pos ?callback () = let icon = may_map icon ~f:as_widget in new button (Toolbar.insert_button obj ~kind:`BUTTON ?icon ?text ?tooltip ?tooltip_private ?pos ?callback ()) method insert_toggle_button ?text ?tooltip ?tooltip_private ?icon ?pos ?callback () = let icon = may_map icon ~f:as_widget in new toggle_button (ToggleButton.cast (Toolbar.insert_button obj ~kind:`TOGGLEBUTTON ?icon ?text ?tooltip ?tooltip_private ?pos ?callback ())) method insert_radio_button ?text ?tooltip ?tooltip_private ?icon ?pos ?callback () = let icon = may_map icon ~f:as_widget in new radio_button (RadioButton.cast (Toolbar.insert_button obj ~kind:`RADIOBUTTON ?icon ?text ?tooltip ?tooltip_private ?pos ?callback ())) method insert_space = Toolbar.insert_space obj method orientation = get Toolbar.P.orientation obj method set_orientation = set Toolbar.P.orientation obj method style = get Toolbar.P.toolbar_style obj method set_style = set Toolbar.P.toolbar_style obj method unset_style () = Toolbar.unset_style obj method get_tooltips = Toolbar.get_tooltips obj method set_tooltips = Toolbar.set_tooltips obj method icon_size = Toolbar.get_icon_size obj method set_icon_size = Toolbar.set_icon_size obj method unset_icon_size () = Toolbar.unset_icon_size obj (* extended API in GTK 2.4 *) method show_arrow = get Toolbar.P.show_arrow obj method set_show_arrow = set Toolbar.P.show_arrow obj method insert : 'a. ?pos:int -> (#tool_item_o as 'a) -> unit = fun ?(pos= -1) i -> Toolbar.insert obj i#as_tool_item ~pos method get_item_index : 'a. (#tool_item_o as 'a) -> int = fun i -> Toolbar.get_item_index obj i#as_tool_item method get_n_items = Toolbar.get_n_items obj method get_nth_item = Toolbar.get_nth_item obj method get_drop_index = Toolbar.get_drop_index obj method set_drop_highlight_item : 'a. ((#tool_item_o as 'a) * int) option -> unit = function | None -> Toolbar.set_drop_highlight_item obj None 0 | Some (i, pos) -> Toolbar.set_drop_highlight_item obj (Some i#as_tool_item) pos method relief_style = Toolbar.get_relief_style obj end let toolbar ?orientation ?style ?tooltips = pack_container [] ~create:(fun p -> let w = Toolbar.create p in Toolbar.set w ?orientation ?style ?tooltips; new toolbar w) (* New extended API in GTK 2.4 *) let may_cons = Gobject.Property.may_cons class tool_item_skel obj = object inherit [[> Gtk.tool_item]] GContainer.bin_impl obj inherit OgtkButtonProps.tool_item_props method as_tool_item = (obj :> Gtk.tool_item obj) method set_homogeneous = ToolItem.set_homogeneous obj method get_homogeneous = ToolItem.get_homogeneous obj method set_expand = ToolItem.set_expand obj method get_expand = ToolItem.get_expand obj method set_tooltip (t : GData.tooltips) = ToolItem.set_tooltip obj t#as_tooltips method set_use_drag_window = ToolItem.set_use_drag_window obj method get_use_drag_window = ToolItem.get_use_drag_window obj end class tool_item obj = object inherit tool_item_skel obj method connect = new GContainer.container_signals_impl obj end let tool_item_params create pl ?homogeneous ?expand ?packing ?show () = let item = create pl in Gaux.may item#set_homogeneous homogeneous ; Gaux.may item#set_expand expand ; Gaux.may (fun f -> (f (item :> tool_item_o) : unit)) packing ; if show <> Some false then item#misc#show () ; item let tool_item = tool_item_params (fun pl -> new tool_item (ToolItem.create pl)) [] class separator_tool_item obj = object inherit tool_item obj method draw = get SeparatorToolItem.P.draw obj method set_draw = set SeparatorToolItem.P.draw obj end let separator_tool_item ?draw = let pl = may_cons SeparatorToolItem.P.draw draw [] in tool_item_params (fun pl -> new separator_tool_item (SeparatorToolItem.create pl)) pl class tool_button_signals (obj : [> Gtk.tool_button] obj) = object (self) inherit GContainer.container_signals_impl obj method clicked = self#connect ToolButton.S.clicked end class tool_button_skel obj = object inherit tool_item_skel obj inherit tool_button_props end class tool_button obj = object inherit tool_button_skel obj method connect = new tool_button_signals obj end let tool_button_params create pl ?label ?stock ?use_underline = tool_item_params create (may_cons ToolButton.P.label label ( may_cons ToolButton.P.stock_id stock ( may_cons ToolButton.P.use_underline use_underline pl))) let tool_button = tool_button_params (fun pl -> new tool_button (ToolButton.create pl)) [] class toggle_tool_button_signals obj = object (self) inherit tool_button_signals obj method toggled = self#connect ToggleToolButton.S.toggled end class toggle_tool_button obj = object inherit tool_button_skel obj method connect = new toggle_tool_button_signals obj method set_active = ToggleToolButton.set_active obj method get_active = ToggleToolButton.get_active obj end let toggle_tool_button_params create pl ?active = tool_button_params (fun pl -> let o = create pl in Gaux.may o#set_active active ; o) pl let toggle_tool_button = toggle_tool_button_params (fun pl -> new toggle_tool_button (ToggleToolButton.create pl)) [] class radio_tool_button obj = object inherit toggle_tool_button obj method group = Some (obj :> Gtk.radio_tool_button Gtk.obj) method set_group = set RadioToolButton.P.group obj end let radio_tool_button ?group = toggle_tool_button_params (fun pl -> new radio_tool_button (RadioToolButton.create pl)) (may_cons RadioToolButton.P.group (Gaux.may_map (fun g -> g#group) group) []) class menu_tool_button obj = object inherit tool_button obj method menu = get MenuToolButton.P.menu obj method set_menu = set MenuToolButton.P.menu obj method set_arrow_tooltip (t : GData.tooltips) = MenuToolButton.set_arrow_tooltip obj t#as_tooltips end let menu_tool_button ?menu = tool_button_params (fun pl -> new menu_tool_button (MenuToolButton.create pl)) (may_cons MenuToolButton.P.menu (Gaux.may_map (fun m -> m#as_menu) menu) []) class link_button obj = object inherit button_skel obj inherit link_button_props end let link_button ?label = pack_return (fun uri -> new link_button (match label with | None -> LinkButton.create uri | Some s -> LinkButton.create_with_label uri s)) lablgtk-2.18.8/src/ml_rsvg.c0000644000175000017500000000755513460263323014704 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ /* Author: Olivier Andrieu */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_gdkpixbuf.h" #include "ml_gobject.h" #include "ml_glib.h" static void ml_rsvg_size_callback(gint *w, gint *h, gpointer user_data) { value *cb = user_data; value r; r = callback2_exn(*cb, Val_int(*w), Val_int(*h)); if(Is_exception_result(r)) return; *w = Int_val(Field(r, 0)); *h = Int_val(Field(r, 1)); } ML_0(rsvg_handle_new, Val_pointer) #ifdef HAVE_SVGZ #include ML_0 (rsvg_handle_new_gz, Val_pointer) #else CAMLprim value ml_rsvg_handle_new_gz() { failwith ("Doesn't support GZipped SVG files"); return Val_unit; } #endif /* HAVE_SVGZ */ #define RsvgHandle_val(val) ((RsvgHandle *)Pointer_val(val)) CAMLprim value ml_rsvg_handle_set_size_callback(value vh, value cb) { RsvgHandle *h = RsvgHandle_val(vh); value *u_data = ml_global_root_new(cb); rsvg_handle_set_size_callback(h, ml_rsvg_size_callback, u_data, ml_global_root_destroy); return Val_unit; } ML_1(rsvg_handle_free, RsvgHandle_val, Unit) CAMLprim value ml_rsvg_handle_close(value h) { GError *err = NULL; rsvg_handle_close(RsvgHandle_val(h), &err); if (err != NULL) ml_raise_gerror (err); return Val_unit; } static inline void check_substring(value s, value o, value l) { if(Int_val(o) < 0 || Int_val(l) < 0 || Int_val(o) + Int_val(l) > string_length(s)) invalid_argument("bad substring"); } CAMLprim value ml_rsvg_handle_write(value h, value s, value off, value len) { GError *err = NULL; check_substring(s, off, len); rsvg_handle_write(RsvgHandle_val(h), (guchar *) String_val(s)+Int_val(off), Int_val(len), &err); if (err != NULL) ml_raise_gerror (err); return Val_unit; } ML_1(rsvg_handle_get_pixbuf, RsvgHandle_val, Val_GdkPixbuf_new) #if (LIBRSVG_MAJOR_VERSION == 2) && (LIBRSVG_MINOR_VERSION >= 2) ML_2(rsvg_handle_set_dpi, RsvgHandle_val, Double_val, Unit) ML_1(rsvg_set_default_dpi, Double_val, Unit) #else Unsupported(rsvg_handle_set_dpi) Unsupported(rsvg_set_default_dpi) #endif CAMLprim value ml_rsvg_init (value unit) { ml_register_exn_map(RSVG_ERROR, "ml_rsvg_exn"); return Val_unit; } lablgtk-2.18.8/src/gtkXmHTML.ml0000644000175000017500000001310113460263323015160 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk type string_direction = [ | `R_TO_L | `L_TO_R ] type position = [ | `END | `CENTER | `BEGINNING ] type line_type = [ | `SOLID | `DASHED | `SINGLE | `DOUBLE | `STRIKE | `UNDER | `NONE ] type dither_type = [ | `QUICK | `BEST | `FAST | `SLOW | `DISABLED ] type xmhtml = [widget|`container|`xmhtml] external create : unit -> xmhtml obj = "ml_gtk_xmhtml_new" external freeze : [> `xmhtml] obj -> unit = "ml_gtk_xmhtml_freeze" external thaw : [> `xmhtml] obj -> unit = "ml_gtk_xmhtml_thaw" external source : [> `xmhtml] obj -> string -> unit = "ml_gtk_xmhtml_source" (* external get_source : [> `xmhtml] obj -> string = "ml_gtk_xmhtml_get_source" *) external set_string_direction : [> `xmhtml] obj -> string_direction -> unit = "ml_gtk_xmhtml_set_string_direction" external set_alignment : [> `xmhtml] obj -> position -> unit = "ml_gtk_xmhtml_set_alignment" (* external set_outline : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_outline" *) external set_font_familty : [> `xmhtml] obj -> family:string -> sizes:string -> unit = "ml_gtk_xmhtml_set_font_familty" external set_font_familty_fixed : [> `xmhtml] obj -> family:string -> sizes:string -> unit = "ml_gtk_xmhtml_set_font_familty_fixed" external set_font_charset : [> `xmhtml] obj -> string -> unit = "ml_gtk_xmhtml_set_font_charset" external set_allow_body_colors : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_allow_body_colors" external set_hilight_on_enter : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_hilight_on_enter" external set_anchor_underline_type : [> `xmhtml] obj -> line_type list -> unit = "ml_gtk_xmhtml_set_anchor_underline_type" external set_anchor_visited_underline_type : [> `xmhtml] obj -> line_type list -> unit = "ml_gtk_xmhtml_set_anchor_visited_underline_type" external set_anchor_target_underline_type : [> `xmhtml] obj -> line_type list -> unit = "ml_gtk_xmhtml_set_anchor_target_underline_type" external set_allow_color_switching : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_allow_color_switching" external set_dithering : [> `xmhtml] obj -> dither_type -> unit = "ml_gtk_xmhtml_set_dithering" external set_allow_font_switching : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_allow_font_switching" external set_max_image_colors : [> `xmhtml] obj -> int -> unit = "ml_gtk_xmhtml_set_max_image_colors" external set_allow_images : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_allow_images" external set_plc_intervals : [> `xmhtml] obj -> min:int -> max:int -> default:int -> unit = "ml_gtk_xmhtml_set_plc_intervals" (* external set_def_body_image_url : [> `xmhtml] obj -> string -> unit = "ml_gtk_xmhtml_set_def_body_image_url" *) external set_anchor_buttons : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_anchor_buttons" external set_anchor_cursor : [> `xmhtml] obj -> Gdk.cursor option -> unit = "ml_gtk_xmhtml_set_anchor_cursor" external set_topline : [> `xmhtml] obj -> int -> unit = "ml_gtk_xmhtml_set_topline" external get_topline : [> `xmhtml] obj -> int = "ml_gtk_xmhtml_get_topline" external set_freeze_animations : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_freeze_animations" external set_screen_gamma : [> `xmhtml] obj -> float -> unit = "ml_gtk_xmhtml_set_screen_gamma" external set_perfect_colors : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_perfect_colors" external set_uncompress_command : [> `xmhtml] obj -> string -> unit = "ml_gtk_xmhtml_set_uncompress_command" external set_strict_checking : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_strict_checking" external set_bad_html_warnings : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_bad_html_warnings" external set_allow_form_coloring : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_allow_form_coloring" external set_imagemap_draw : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_imagemap_draw" external set_alpha_processing : [> `xmhtml] obj -> bool -> unit = "ml_gtk_xmhtml_set_alpha_processing" lablgtk-2.18.8/src/gWindow.mli0000644000175000017500000004563313460263323015207 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gtk open GObj (** Windows *) (** {3 GtkWindow} *) (** @gtkdoc gtk GtkWindow *) class window_skel : 'a obj -> object inherit GContainer.bin constraint 'a = [> Gtk.window] val obj : 'a obj method activate_default : unit -> bool method activate_focus : unit -> bool method add_accel_group : accel_group -> unit method as_window : Gtk.window obj method deiconify : unit -> unit method event : event_ops method iconify : unit -> unit method move : x:int -> y:int -> unit method parse_geometry : string -> bool method present : unit -> unit method resize : width:int -> height:int -> unit method show : unit -> unit method set_accept_focus : bool -> unit method set_allow_grow : bool -> unit method set_allow_shrink : bool -> unit method set_decorated : bool -> unit method set_default_height : int -> unit method set_default_size : width:int -> height:int -> unit method set_default_width : int -> unit method set_deletable : bool -> unit method set_destroy_with_parent : bool -> unit method set_focus_on_map : bool -> unit method set_geometry_hints : ?min_size:int * int -> ?max_size:int * int -> ?base_size:int * int -> ?aspect:float * float -> ?resize_inc:int * int -> ?win_gravity:Gdk.Tags.gravity -> ?pos:bool -> ?user_pos:bool -> ?user_size:bool -> GObj.widget -> unit method set_gravity : Gdk.Tags.gravity -> unit method set_icon : GdkPixbuf.pixbuf option -> unit method set_icon_name : string -> unit method set_modal : bool -> unit method set_opacity : float -> unit method set_position : Tags.window_position -> unit method set_resizable : bool -> unit method set_role : string -> unit method set_screen : Gdk.screen -> unit method set_skip_pager_hint : bool -> unit method set_skip_taskbar_hint : bool -> unit method set_title : string -> unit method set_transient_for : Gtk.window obj -> unit method set_type_hint : Gdk.Tags.window_type_hint -> unit method set_wm_class : string -> unit method set_wm_name : string -> unit method accept_focus : bool method allow_grow : bool method allow_shrink : bool method decorated : bool method default_height : int method default_width : int method deletable : bool method destroy_with_parent : bool method focus_on_map : bool method gravity : GdkEnums.gravity method has_toplevel_focus : bool method icon : GdkPixbuf.pixbuf option method icon_name : string method is_active : bool method kind : Tags.window_type method modal : bool method opacity : float method position : Tags.window_position method resizable : bool method role : string method screen : Gdk.screen method skip_pager_hint : bool method skip_taskbar_hint : bool method title : string method type_hint : Gdk.Tags.window_type_hint method set_urgency_hint : bool -> unit (** since Gtk 2.8 *) method urgency_hint : bool (** since Gtk 2.8 *) end (** Toplevel widget which can contain other widgets @gtkdoc gtk GtkWindow *) class window : ([> Gtk.window] as 'a) obj -> object inherit window_skel val obj : 'a obj method connect : GContainer.container_signals method fullscreen : unit -> unit (** @since GTK 2.2 *) method maximize : unit -> unit method stick : unit -> unit method unfullscreen : unit -> unit (** @since GTK 2.2 *) method unmaximize : unit -> unit method unstick : unit -> unit end (** @gtkdoc gtk GtkWindow *) val window : ?kind:Tags.window_type -> ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> window (** @param kind default value is [`TOPLEVEL] @param allow_grow default value is [true] @param allow_shrink default value is [false] @param modal default value is [false] @param resizable default value is [true] @param type_hint default value is [`NORMAL] @param position default value is [`NONE] *) val toplevel : #widget -> window option (** return the toplevel window of this widget, if existing *) (** {3 GtkDialog} *) (** @gtkdoc gtk GtkDialog *) class ['a] dialog_signals : ([> Gtk.dialog] as 'b) obj -> decode:(int -> 'a) -> object inherit GContainer.container_signals val obj : 'b obj method response : callback:('a -> unit) -> GtkSignal.id method close : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkDialog *) class ['a] dialog_skel : ([>Gtk.dialog] as 'b) obj -> object constraint 'a = [> `DELETE_EVENT] inherit window_skel val obj : 'b obj method action_area : GPack.button_box method event : event_ops method vbox : GPack.box method response : 'a -> unit method set_response_sensitive : 'a -> bool -> unit method set_default_response : 'a -> unit method has_separator : bool method set_has_separator : bool -> unit method run : unit -> 'a method private encode : 'a -> int method private decode : int -> 'a end (** Create popup windows @gtkdoc gtk GtkDialog *) class ['a] dialog_ext : ([> Gtk.dialog] as 'b) obj -> object inherit ['a] dialog_skel val obj : 'b obj method add_button : string -> 'a -> unit method add_button_stock : GtkStock.id -> 'a -> unit end (** Create popup windows @gtkdoc gtk GtkDialog *) class ['a] dialog : [> Gtk.dialog] obj -> object inherit ['a] dialog_ext val obj : Gtk.dialog obj method connect : 'a dialog_signals end (** @gtkdoc gtk GtkDialog *) val dialog : ?no_separator:bool -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> 'a dialog (** @param no_separator default value is [false] @param destroy_with_parent default value is [false] *) (** Variation for safe typing *) type any_response = [GtkEnums.response | `OTHER of int] class dialog_any : [> Gtk.dialog] obj -> [any_response] dialog (** {3 GtkMessageDialog} *) type 'a buttons module Buttons : sig val ok : [>`OK] buttons val close : [>`CLOSE] buttons val yes_no : [>`YES|`NO] buttons val ok_cancel : [>`OK|`CANCEL] buttons type color_selection = [`OK | `CANCEL | `HELP | `DELETE_EVENT] type file_selection = [`OK | `CANCEL | `HELP | `DELETE_EVENT] type font_selection = [`OK | `CANCEL | `APPLY | `DELETE_EVENT] type about = [ `CANCEL | `CLOSE | `DELETE_EVENT ] end (** Convenient message window @gtkdoc gtk GtkMessageDialog *) class type ['a] message_dialog = object inherit ['a] dialog_skel val obj : [> Gtk.message_dialog] obj method connect : 'a dialog_signals method set_markup : string -> unit (** @since GTK 2.4 *) method message_type : Tags.message_type method set_message_type : Tags.message_type -> unit end (** @gtkdoc gtk GtkMessageDialog *) val message_dialog : ?message:string -> ?use_markup:bool -> message_type:Tags.message_type -> buttons:'a buttons -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> 'a message_dialog (** {3 GtkAboutDialog} *) (** @gtkdoc gtk GtkAboutDialog @since GTK 2.6 *) class about_dialog : ([> Gtk.about_dialog] as 'a) Gtk.obj -> object inherit [Buttons.about] dialog_skel val obj : 'a Gtk.obj method connect : Buttons.about dialog_signals method artists : string list method authors : string list method comments : string method copyright : string method documenters : string list method license : string method logo : GdkPixbuf.pixbuf method logo_icon_name : string (** The property [name] is left unchanged, but it will access [program-name] if version is higher than 2.12 *) method name : string method translator_credits : string method version : string method website : string method website_label : string method wrap_license : bool method set_artists : string list -> unit method set_authors : string list -> unit method set_comments : string -> unit method set_copyright : string -> unit method set_documenters : string list -> unit method set_license : string -> unit method set_logo : GdkPixbuf.pixbuf -> unit method set_logo_icon_name : string -> unit method set_name : string -> unit method set_translator_credits : string -> unit method set_version : string -> unit method set_website : string -> unit method set_website_label : string -> unit method set_wrap_license : bool -> unit end (** Display information about an application. In GTK+ 2.6.x and 2.8.x, a default handler is already connected to the [response] signal. It simply hides the dialog. This is no longer the case since GTK+ 2.10.x though. You could use it like this: {[let about_dialog = ref (fun () -> raise Not_found) let show_dialog () = try !about_dialog () with Not_found -> let dialog = GWindow.about_dialog ~name:"..." (* etc. *) () in about_dialog := dialog#present ; dialog#show () ]} @gtkdoc gtk GtkAboutDialog @since GTK 2.6 *) val about_dialog : ?name:string -> ?authors:string list -> ?comments:string -> ?copyright:string -> ?license:string -> ?logo:GdkPixbuf.pixbuf -> ?logo_icon_name:string -> ?translator_credits:string -> ?version:string -> ?website:string -> ?website_label:string -> ?wrap_license:bool -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> about_dialog (** {3 File Chooser Dialog} *) (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserDialog *) class ['a] file_chooser_dialog_signals : ([> Gtk.file_chooser|Gtk.dialog] as 'b) Gtk.obj -> decode:(int -> 'a) -> object inherit ['a] dialog_signals inherit GFile.chooser_signals val obj : 'b Gtk.obj end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserDialog *) class ['a] file_chooser_dialog : ([> Gtk.file_chooser|Gtk.dialog] as 'b) Gtk.obj -> object inherit ['a] dialog_ext inherit GFile.chooser val obj : 'b Gtk.obj method connect : 'a file_chooser_dialog_signals (** The following methods should be used to add the [OPEN] or [SAVE] button of a FileChooserDialog *) method add_select_button : string -> 'a -> unit (** ditto with a stock id *) method add_select_button_stock : GtkStock.id -> 'a -> unit end (** @since GTK 2.4 @gtkdoc gtk GtkFileChooserDialog *) val file_chooser_dialog : action:GtkEnums.file_chooser_action -> ?backend:string -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?title:string -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> 'a file_chooser_dialog (** {3 Selection Dialogs} *) (** @gtkdoc gtk GtkColorSelectionDialog *) class color_selection_dialog : Gtk.color_selection_dialog obj -> object inherit [Buttons.color_selection] dialog_skel val obj : Gtk.color_selection_dialog obj method connect : Buttons.color_selection dialog_signals method cancel_button : GButton.button method colorsel : GMisc.color_selection method help_button : GButton.button method ok_button : GButton.button end (** @gtkdoc gtk GtkColorSelectionDialog *) val color_selection_dialog : ?title:string -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> color_selection_dialog (** @gtkdoc gtk GtkFileSelection *) class file_selection : Gtk.file_selection obj -> object inherit [Buttons.file_selection] dialog_skel val obj : Gtk.file_selection obj method connect : Buttons.file_selection dialog_signals method cancel_button : GButton.button method complete : filter:string -> unit method filename : string method get_selections : string list method help_button : GButton.button method ok_button : GButton.button method file_list : string GList.clist method dir_list : string GList.clist method select_multiple : bool method show_fileops : bool method set_filename : string -> unit method set_show_fileops : bool -> unit method set_select_multiple : bool -> unit end (** @gtkdoc gtk GtkFileSelection *) val file_selection : ?title:string -> ?show_fileops:bool -> ?filename:string -> ?select_multiple:bool -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> file_selection (** @gtkdoc gtk GtkFontSelectionDialog*) class font_selection_dialog : Gtk.font_selection_dialog obj -> object inherit [Buttons.font_selection] dialog_skel val obj : Gtk.font_selection_dialog obj method connect : Buttons.font_selection dialog_signals method apply_button : GButton.button method cancel_button : GButton.button method selection : GMisc.font_selection method ok_button : GButton.button end (** @gtkdoc gtk GtkFontSelectionDialog*) val font_selection_dialog : ?title:string -> ?parent:#window_skel -> ?destroy_with_parent:bool -> ?allow_grow:bool -> ?allow_shrink:bool -> ?decorated:bool -> ?deletable:bool -> ?focus_on_map:bool -> ?icon:GdkPixbuf.pixbuf -> ?icon_name:string -> ?modal:bool -> ?position:Tags.window_position -> ?resizable:bool -> ?screen:Gdk.screen -> ?type_hint:Gdk.Tags.window_type_hint -> ?urgency_hint:bool -> ?wm_name:string -> ?wm_class:string -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> font_selection_dialog (** {3 GtkPlug} *) (** @gtkdoc gtk GtkPlug *) class plug_signals : ([> Gtk.plug] as 'a) obj -> object inherit GContainer.container_signals val obj : 'a obj method embedded : callback:(unit -> unit) -> GtkSignal.id end (** Toplevel for embedding into other processes @gtkdoc gtk GtkPlug *) class plug : Gtk.plug obj -> object inherit window_skel val obj : Gtk.plug obj method connect : plug_signals end (** @gtkdoc gtk GtkPlug *) val plug : window:Gdk.native_window -> ?border_width:int -> ?width:int -> ?height:int -> ?show:bool -> unit -> plug (** {3 GtkSocket} *) (** @gtkdoc gtk GtkSocket *) class socket_signals : ([>Gtk.socket] as 'a) obj -> object inherit GContainer.container_signals val obj : 'a obj method plug_added : callback:(unit -> unit) -> GtkSignal.id method plug_removed : callback:(unit -> unit) -> GtkSignal.id end (** Container for widgets from other processes @gtkdoc gtk GtkSocket *) class socket : Gtk.socket obj -> object inherit GContainer.container val obj : Gtk.socket obj method connect : socket_signals method steal : Gdk.native_window -> unit (** @deprecated "inherently unreliable" *) method xwindow : Gdk.xid end (** @gtkdoc gtk GtkSocket *) val socket : ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> socket lablgtk-2.18.8/src/gBroken.mli0000644000175000017500000001370113460263323015147 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gobject open Gtk open GObj open GContainer (** Deprecated widgets @gtkdoc gtk Deprecated *) (** {3 Obsolete GtkTree/GtkTreeItem framework} *) (** @gtkdoc gtk GtkTreeItem @deprecated use {!GTree.view} instead *) class tree_item_signals : tree_item obj -> object inherit GContainer.item_signals method collapse : callback:(unit -> unit) -> GtkSignal.id method expand : callback:(unit -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkTreeItem @deprecated use {!GTree.view} instead *) class tree_item : Gtk.tree_item obj -> object inherit GContainer.container val obj : Gtk.tree_item obj method event : event_ops method as_item : Gtk.tree_item obj method collapse : unit -> unit method connect : tree_item_signals method expand : unit -> unit method remove_subtree : unit -> unit method set_subtree : tree -> unit method subtree : tree option end (** @gtkdoc gtk GtkTree @deprecated use {!GTree.view} instead *) and tree_signals : Gtk.tree obj -> object inherit GContainer.container_signals val obj : Gtk.tree obj method select_child : callback:(tree_item -> unit) -> GtkSignal.id method selection_changed : callback:(unit -> unit) -> GtkSignal.id method unselect_child : callback:(tree_item -> unit) -> GtkSignal.id end (** @gtkdoc gtk GtkTree @deprecated use {!GTree.view} instead *) and tree : Gtk.tree obj -> object inherit [tree_item] GContainer.item_container val obj : Gtk.tree obj method event : event_ops method as_tree : Gtk.tree obj method child_position : tree_item -> int method clear_items : start:int -> stop:int -> unit method connect : tree_signals method insert : tree_item -> pos:int -> unit method remove_items : tree_item list -> unit method select_item : pos:int -> unit method selection : tree_item list method set_selection_mode : Tags.selection_mode -> unit method set_view_lines : bool -> unit method set_view_mode : [`LINE|`ITEM] -> unit method unselect_item : pos:int -> unit method private wrap : Gtk.widget obj -> tree_item end (** @gtkdoc gtk GtkTreeItem @deprecated use {!GTree.view} instead *) val tree_item : ?label:string -> ?packing:(tree_item -> unit) -> ?show:bool -> unit -> tree_item (** @gtkdoc gtk GtkTree @deprecated use {!GTree.view} instead *) val tree : ?selection_mode:Tags.selection_mode -> ?view_mode:[`LINE|`ITEM] -> ?view_lines:bool -> ?border_width:int -> ?width:int -> ?height:int -> ?packing:(widget -> unit) -> ?show:bool -> unit -> tree (** {3 Obsolete GtkOldEditable/GtkText framework} *) class old_editable_signals : ([> Gtk.old_editable ] as 'b) Gtk.obj -> object inherit GEdit.editable_signals val obj : 'b Gtk.obj method activate : callback:(unit -> unit) -> GtkSignal.id method copy_clipboard : callback:(unit -> unit) -> GtkSignal.id method cut_clipboard : callback:(unit -> unit) -> GtkSignal.id method move_cursor : callback:(int -> int -> unit) -> GtkSignal.id method move_page : callback:(int -> unit) -> GtkSignal.id method move_to_column : callback:(int -> unit) -> GtkSignal.id method move_to_row : callback:(int -> unit) -> GtkSignal.id method move_word : callback:(int -> unit) -> GtkSignal.id method paste_clipboard : callback:(unit -> unit) -> GtkSignal.id end class text : Gtk.text Gtk.obj -> object inherit GEdit.editable inherit [Gtk.text] GObj.objvar method connect : old_editable_signals method backward_delete : int -> unit method event : GObj.event_ops method forward_delete : int -> unit method freeze : unit -> unit method hadjustment : GData.adjustment method insert : ?font:Gdk.font -> ?foreground:GDraw.color -> ?background:GDraw.color -> string -> unit method length : int method line_wrap : bool method point : int method set_hadjustment : GData.adjustment -> unit method set_line_wrap : bool -> unit method set_point : int -> unit method set_vadjustment : GData.adjustment -> unit method set_word_wrap : bool -> unit method thaw : unit -> unit method vadjustment : GData.adjustment method word_wrap : bool end val text : ?hadjustment:GData.adjustment -> ?vadjustment:GData.adjustment -> ?editable: bool -> ?line_wrap:bool -> ?word_wrap:bool -> ?packing:(widget -> unit) -> ?show:bool -> unit -> text lablgtk-2.18.8/src/gRange.ml0000644000175000017500000000646213460263323014620 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gaux open Gtk open GtkBase open GtkRange open OgtkRangeProps open GObj class progress_bar obj = object inherit [Gtk.progress_bar] widget_impl obj method connect = new widget_signals_impl obj method event = new GObj.event_ops obj inherit progress_bar_props method pulse () = ProgressBar.pulse obj end let progress_bar = ProgressBar.make_params [] ~cont:(fun pl ?packing ?show () -> pack_return (new progress_bar (ProgressBar.create pl)) ~packing ~show) class range_signals obj = object inherit widget_signals_impl obj inherit range_sigs end class range obj = object inherit ['a] widget_impl obj method as_range = (obj :> Gtk.range Gtk.obj) method connect = new range_signals obj method event = new GObj.event_ops obj inherit range_props end class scale obj = object inherit range (obj : Gtk.scale obj) inherit scale_props end let scale dir ?adjustment = Scale.make_params [] ~cont:( Range.make_params ?adjustment:(may_map GData.as_adjustment adjustment) ~cont:(fun pl ?packing ?show params -> pack_return (new scale (Scale.create dir pl)) ~packing ~show)) let scrollbar dir ?adjustment = Range.make_params [] ?adjustment:(may_map GData.as_adjustment adjustment) ~cont:(fun pl ?packing ?show params -> pack_return (new range (Scrollbar.create dir pl)) ~packing ~show) class ruler obj = object inherit ['a] widget_impl obj method connect = new widget_signals_impl obj method event = new GObj.event_ops obj inherit ruler_props method set_metric = Ruler.set_metric obj end let ruler dir ?metric = Ruler.make_params [] ~cont:(fun pl ?packing ?show params -> let w = new ruler (Ruler.create dir pl) in may w#set_metric metric; pack_return w ~packing ~show) lablgtk-2.18.8/src/ml_gtkassistant.c0000644000175000017500000001267713460263323016443 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id: ml_gtkbutton.c 1347 2007-06-20 07:40:34Z guesdon $ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gdkpixbuf.h" #include "gtk_tags.h" /* Init all */ CAMLprim value ml_gtkassistant_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = #ifdef HASGTK210 gtk_assistant_get_type () + #endif 0; return Val_GType(t); } /* gtkassistant.h */ #ifdef HASGTK210 #define GtkAssistant_val(val) check_cast(GTK_ASSISTANT,val) ML_1(gtk_assistant_update_buttons_state, GtkAssistant_val,Unit) ML_2(gtk_assistant_remove_action_widget, GtkAssistant_val, GtkWidget_val, Unit) ML_2(gtk_assistant_add_action_widget, GtkAssistant_val, GtkWidget_val, Unit) ML_2(gtk_assistant_get_page_complete,GtkAssistant_val, GtkWidget_val, Val_bool) ML_3(gtk_assistant_set_page_complete,GtkAssistant_val, GtkWidget_val, Bool_val, Unit) ML_2(gtk_assistant_get_page_side_image, GtkAssistant_val, GtkWidget_val, Val_GdkPixbuf) ML_3(gtk_assistant_set_page_side_image, GtkAssistant_val, GtkWidget_val, GdkPixbuf_val, Unit) ML_2(gtk_assistant_get_page_header_image, GtkAssistant_val, GtkWidget_val, Val_GdkPixbuf) ML_3(gtk_assistant_set_page_header_image, GtkAssistant_val, GtkWidget_val, GdkPixbuf_val, Unit) ML_2(gtk_assistant_get_page_title, GtkAssistant_val, GtkWidget_val, Val_string) ML_3(gtk_assistant_set_page_title, GtkAssistant_val, GtkWidget_val, String_val, Unit) ML_2(gtk_assistant_get_page_type, GtkAssistant_val, GtkWidget_val, Val_assistant_page_type) ML_3(gtk_assistant_set_page_type, GtkAssistant_val, GtkWidget_val, Assistant_page_type_val, Unit) ML_3(gtk_assistant_insert_page, GtkAssistant_val, GtkWidget_val, Int_val, Val_int) ML_2(gtk_assistant_get_nth_page, GtkAssistant_val, Int_val, Val_GtkWidget) ML_1(gtk_assistant_get_n_pages, GtkAssistant_val, Val_int) ML_1(gtk_assistant_get_current_page, GtkAssistant_val, Val_int) ML_2(gtk_assistant_set_current_page, GtkAssistant_val, Int_val,Unit) // Untested code: static gint ml_g_assistant_page_func(gint current_page, gpointer user_data) { value *clos = user_data; CAMLparam0(); CAMLlocal1(ret); ret = callback_exn(*clos, Val_int(current_page)); if (Is_exception_result(ret)) { CAML_EXN_LOG("gtk_assistant_page_function"); } CAMLreturn(ret); } CAMLprim value ml_gtk_assistant_set_forward_page_func (value assistant, value clos) { value *clos_p = ml_global_root_new (clos); gtk_assistant_set_forward_page_func((GtkAssistant*)Val_GtkAny(assistant), ml_g_assistant_page_func, clos_p, ml_global_root_destroy); return Val_unit; } #else Unsupported_210(gtk_assistant_update_buttons_state) Unsupported_210(gtk_assistant_remove_action_widget) Unsupported_210(gtk_assistant_add_action_widget) Unsupported_210(gtk_assistant_get_page_complete) Unsupported_210(gtk_assistant_set_page_complete) Unsupported_210(gtk_assistant_get_page_side_image) Unsupported_210(gtk_assistant_set_page_side_image) Unsupported_210(gtk_assistant_get_page_header_image) Unsupported_210(gtk_assistant_set_page_header_image) Unsupported_210(gtk_assistant_get_page_title) Unsupported_210(gtk_assistant_set_page_title) Unsupported_210(gtk_assistant_get_page_type) Unsupported_210(gtk_assistant_set_page_type) Unsupported_210(gtk_assistant_insert_page) Unsupported_210(gtk_assistant_get_nth_page) Unsupported_210(gtk_assistant_get_n_pages) Unsupported_210(gtk_assistant_get_current_page) Unsupported_210(gtk_assistant_set_current_page) Unsupported_210(gtk_assistant_set_forward_page_func) #endif lablgtk-2.18.8/src/gtkEdit.props0000644000175000017500000001454213460263323015541 0ustar stephsteph(* $Id$ *) prefix "Gtk" header { open Gtk module Internal = struct let marshal_insert = ref (fun (_ : string -> pos:int ref -> unit) -> failwith "GtkEditProps.Internal.marshal_insert") end } oheader{ open GtkEditProps } conversions { GtkEntryIconPosition "GtkEnums.entry_icon_position_conv" GtkStock "GtkStock.conv" } boxed { GdkEventButton "GdkEvent.Button.t" } classes { GtkAdjustment "Gtk.adjustment obj" GtkMenu "Gtk.menu obj" GdkPixbuf "GdkPixbuf.pixbuf" } class Editable abstract wrapsig : Widget { (* actually an interface *) method select_region : "start:int -> stop:int -> unit" method get_selection_bounds : "(int * int) option" method insert_text : "string -> pos:int -> int" method delete_text : "start:int -> stop:int -> unit" method get_chars : "start:int -> stop:int -> string" method cut_clipboard method copy_clipboard method paste_clipboard method delete_selection method get_position : "int" method set_position : "int -> unit" method get_editable : "bool" method set_editable : "bool -> unit" signal changed signal delete_text : start:int stop:int signal insert_text "(fun f -> !Internal.marshal_insert f)" } class Entry set wrap wrapsig : Editable { "text" gchararray : Read / Write "visibility" gboolean : Read / Write "max-length" gint : Read / Write "activates-default" gboolean : Read / Write "cursor-position" gint : Read / NoWrap "editable" gboolean : Read / Write / NoWrap "has-frame" gboolean : Read / Write "invisible-char" guint : Read / Write / NoSet "scroll-offset" gint : Read "selection-bound" gint : Read / NoWrap "width-chars" gint : Read / Write "xalign" gfloat : Read / Write (* Since 2.14 *) "overwrite-mode" gboolean : Read / Write / NoSet (* Since 2.16 *) "primary-icon-activatable" gboolean : Read / Write / NoSet "primary-icon-name" gchararray_opt : Read / Write / NoSet / NoWrap "primary-icon-pixbuf" GdkPixbuf : Read / Write / NoSet / NoGet "primary-icon-sensitive" gboolean : Read / Write / NoSet "primary-icon-stock" GtkStock : Read / Write / NoSet / NoGet "primary-icon-tooltip-markup" gchararray : Read / Write / NoSet / NoGet "primary-icon-tooltip-text" gchararray : Read / Write / NoSet / NoGet "secondary-icon-activatable" gboolean : Read / Write / NoSet "secondary-icon-name" gchararray_opt : Read / Write / NoSet / NoWrap "secondary-icon-pixbuf" GdkPixbuf : Read / Write / NoSet / NoGet "secondary-icon-sensitive" gboolean : Read / Write / NoSet "secondary-icon-stock" GtkStock : Read / Write / NoSet / NoGet "secondary-icon-tooltip-markup" gchararray : Read / Write / NoSet / NoGet "secondary-icon-tooltip-text" gchararray : Read / Write / NoSet / NoGet method append_text : "string -> unit" method prepend_text : "string -> unit" method text_length : "int" method get_completion : "Gtk.entry_completion option" method set_completion : "Gtk.entry_completion -> unit" signal activate signal copy_clipboard signal cut_clipboard signal delete_from_cursor : GtkDeleteType int signal insert_at_cursor : string signal move_cursor : GtkMovementStep gint extend:gboolean signal paste_clipboard signal populate_popup : GtkMenu / NoWrap signal toggle_overwrite (* Since 2.16 *) signal icon_press : GtkEntryIconPosition GdkEventButton signal icon_released : GtkEntryIconPosition GdkEventButton } class SpinButton set wrap wrapsig : Entry { "adjustment" GtkAdjustment : Read / Write "climb-rate"(rate) gdouble : Read / Write "digits" guint : Read / Write "numeric" gboolean : Read / Write "snap-to-ticks" gboolean : Read / Write "update-policy" GtkSpinButtonUpdatePolicy : Read / Write "value" gdouble : Read / Write "wrap" gboolean : Read / Write method spin : "Tags.spin_type -> unit" method update signal change_value : GtkScrollType signal input : -> int signal output : -> bool signal value_changed signal wrapped (* GTK+ 2.10 *) } class Combo set wrap : Box { "allow-empty" gboolean : Read / Write "case-sensitive" gboolean : Read / Write "enable-arrow-keys" gboolean : Read / Write "enable-arrows-always" gboolean : Read / Write / NoSet / NoWrap "value-in-list" gboolean : Read / Write } class ComboBox set wrap wrapsig : Bin { "model" GtkTreeModel : Read / Write / NoWrap "active" gint : Read / Write "add-tearoffs" gboolean : Read / Write (* GTK+ 2.6 *) "column-span-column" gint : Read / Write / NoSet / NoWrap "focus-on-click" gboolean : Read / Write (* GTK+ 2.6 *) "has-frame" gboolean : Read / Write (* GTK+ 2.6 *) "row-span-column" gint : Read / Write / NoSet / NoWrap "wrap-width" gint : Read / Write signal changed method get_active_iter : "Gtk.tree_iter option" method set_active_iter : "Gtk.tree_iter option -> unit" method set_row_separator_func : "(Gtk.tree_model -> Gtk.tree_iter -> bool) option -> unit" (* GTK+ 2.6 *) } class ComboBoxEntry set : ComboBox { "text-column" gint : Read / Write / NoSet } class EntryCompletion set gobject { "minimum-key-length" gint : Read / Write "model" GtkTreeModel : Read / Write signal action_activated : gint signal match_selected : GtkTreeModelFilter GtkTreeIter -> gboolean method get_entry : "Gtk.entry obj option" method complete method insert_action_text : "int -> string -> unit" method insert_action_markup : "int -> string -> unit" method delete_action : "int -> unit" method set_text_column : "int -> unit" method set_match_func : "(string -> Gtk.tree_iter -> bool) -> unit" } lablgtk-2.18.8/src/ml_gdkpixbuf.h0000644000175000017500000000356313460263323015706 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #define GdkPixbuf_val(val) (check_cast(GDK_PIXBUF, val)) CAMLexport value Val_GdkPixbuf_ (GdkPixbuf *, gboolean); #define Val_GdkPixbuf(p) Val_GdkPixbuf_(p, TRUE) #define Val_GdkPixbuf_new(p) Val_GdkPixbuf_(p, FALSE) value Val_option_GdkPixbuf (GdkPixbuf *); lablgtk-2.18.8/src/ml_gdkpixbuf.c0000644000175000017500000002735213460263323015703 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gpointer.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gdkpixbuf.h" #include "gdk_tags.h" #include "gdkpixbuf_tags.h" #include "gdkpixbuf_tags.c" /* custom block with serialization for GdkPixbufs */ static void ml_final_GdkPixbuf (value val) { ml_g_object_unref_later (GObject_val(val)); } static gboolean pixbuf_marshal_use_rle; CAMLprim value ml_gdk_pixbuf_set_marshal_use_rle (value v) { pixbuf_marshal_use_rle = Bool_val (v); return Val_unit; } static void ml_GdkPixbuf_serialize (value v, unsigned long *wsize_32, unsigned long *wsize_64) { GdkPixbuf *pb = GdkPixbuf_val(v); GdkPixdata pixdata; guint8 *stream, *pixels; guint len; pixels = gdk_pixdata_from_pixbuf (&pixdata, pb, pixbuf_marshal_use_rle); stream = gdk_pixdata_serialize (&pixdata, &len); serialize_int_4 (len); serialize_block_1 (stream, len); g_free (stream); g_free (pixels); *wsize_32 = 4; *wsize_64 = 8; } static unsigned long ml_GdkPixbuf_deserialize (void *dst) { GError *error = NULL; GdkPixdata pixdata; GdkPixbuf *pb; guint8 *stream; guint len; len = deserialize_uint_4(); stream = stat_alloc (len); deserialize_block_1 (stream, len); gdk_pixdata_deserialize (&pixdata, len, stream, &error); if (error) goto out; pb = gdk_pixbuf_from_pixdata (&pixdata, TRUE, &error); if (error) goto out; *(GdkPixbuf **)dst = pb; out: stat_free (stream); if (error != NULL) { char *msg; GEnumClass *class = G_ENUM_CLASS (g_type_class_peek (GDK_TYPE_PIXBUF_ERROR)); GEnumValue *val = g_enum_get_value (class, error->code); msg = val ? (char*)val->value_name : ""; g_error_free (error); deserialize_error (msg); } return sizeof pb; } static struct custom_operations ml_custom_GdkPixbuf = { "GdkPixbuf/2.0/", ml_final_GdkPixbuf, custom_compare_default, custom_hash_default, ml_GdkPixbuf_serialize, ml_GdkPixbuf_deserialize }; value Val_GdkPixbuf_ (GdkPixbuf *pb, gboolean ref) { GdkPixbuf **p; value ret; if (pb == NULL) ml_raise_null_pointer(); ret = ml_alloc_custom (&ml_custom_GdkPixbuf, sizeof pb, 100, 1000); p = Data_custom_val (ret); *p = ref ? g_object_ref (pb) : pb; return ret; } Make_Val_option(GdkPixbuf) CAMLprim value ml_gdkpixbuf_init(value unit) { ml_register_exn_map (GDK_PIXBUF_ERROR, "gdk_pixbuf_error"); register_custom_operations (&ml_custom_GdkPixbuf); return Val_unit; } /* GdkPixbuf accessors */ ML_1(gdk_pixbuf_get_n_channels, GdkPixbuf_val, Val_int) ML_1(gdk_pixbuf_get_has_alpha, GdkPixbuf_val, Val_bool) ML_1(gdk_pixbuf_get_bits_per_sample, GdkPixbuf_val, Val_int) ML_1(gdk_pixbuf_get_width, GdkPixbuf_val, Val_int) ML_1(gdk_pixbuf_get_height, GdkPixbuf_val, Val_int) ML_1(gdk_pixbuf_get_rowstride, GdkPixbuf_val, Val_int) CAMLprim value ml_gdk_pixbuf_get_pixels (value pixbuf) { long pixels = (long)gdk_pixbuf_get_pixels (GdkPixbuf_val(pixbuf)); unsigned int ofs = pixels & (sizeof(value)-1); value ret = alloc_small(2,0); Field(ret,0) = (value)(pixels - ofs); Field(ret,1) = Val_int(ofs); return ret; } /* Creation */ ML_5(gdk_pixbuf_new, GDK_COLORSPACE_RGB Ignore, Int_val, Int_val, Int_val, Int_val, Val_GdkPixbuf_new) ML_1(gdk_pixbuf_copy, GdkPixbuf_val, Val_GdkPixbuf_new) CAMLprim value ml_gdk_pixbuf_new_from_file(value f) { GError *err = NULL; GdkPixbuf *res = gdk_pixbuf_new_from_file(String_val(f), &err); if (err) ml_raise_gerror(err); return Val_GdkPixbuf_new(res); } #ifdef HASGTK24 CAMLprim value ml_gdk_pixbuf_new_from_file_at_size(value f, value w, value h) { GError *err = NULL; GdkPixbuf *res = gdk_pixbuf_new_from_file_at_size(String_val(f), Int_val(w), Int_val(h), &err); if (err) ml_raise_gerror(err); return Val_GdkPixbuf_new(res); } CAMLprim value ml_gdk_pixbuf_get_file_info(value f) { CAMLparam0(); CAMLlocal1(v); gint w, h; GdkPixbufFormat *fmt; fmt = gdk_pixbuf_get_file_info (String_val (f), &w, &h); v = alloc_tuple(3); Store_field(v, 0, copy_string(gdk_pixbuf_format_get_name(fmt))); Store_field(v, 1, Val_int(w)); Store_field(v, 2, Val_int(h)); CAMLreturn(v); } #else Unsupported_24 (gdk_pixbuf_new_from_file_at_size) Unsupported_24 (gdk_pixbuf_get_file_info) #endif ML_1(gdk_pixbuf_new_from_xpm_data, (const char**), Val_GdkPixbuf_new) static void ml_gdk_pixbuf_destroy_notify (guchar *pixels, gpointer data) { ml_global_root_destroy(data); } CAMLprim value ml_gdk_pixbuf_new_from_data(value data, value has_alpha, value bits, value w, value h, value rs) { value *root = ml_global_root_new(data); GdkPixbuf *pixbuf = gdk_pixbuf_new_from_data(ml_gpointer_base(*root), GDK_COLORSPACE_RGB, Int_val(has_alpha), Int_val(bits), Int_val(w), Int_val(h), Int_val(rs), ml_gdk_pixbuf_destroy_notify, root); return Val_GdkPixbuf_new(pixbuf); } ML_bc6(ml_gdk_pixbuf_new_from_data) /* Adding an alpha channel */ ML_5(gdk_pixbuf_add_alpha, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, Val_GdkPixbuf_new) /* Fill a pixbuf */ ML_2(gdk_pixbuf_fill, GdkPixbuf_val, Int32_val, Unit) /* Modifies saturation and optionally pixelates */ ML_4(gdk_pixbuf_saturate_and_pixelate, GdkPixbuf_val, GdkPixbuf_val, Double_val, Bool_val, Unit) /* Copy an area */ ML_8(gdk_pixbuf_copy_area, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, GdkPixbuf_val, Int_val, Int_val, Unit) ML_bc8(ml_gdk_pixbuf_copy_area) /* Create a sub-region */ ML_5(gdk_pixbuf_new_subpixbuf, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, Val_GdkPixbuf_new) /* Rendering to a drawable */ ML_9(gdk_pixbuf_render_threshold_alpha, GdkPixbuf_val, GdkBitmap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9(ml_gdk_pixbuf_render_threshold_alpha) ML_12(gdk_pixbuf_render_to_drawable, GdkPixbuf_val, GdkDrawable_val, GdkGC_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, GdkRgbDither_val, Int_val, Int_val, Unit) ML_bc12(ml_gdk_pixbuf_render_to_drawable) ML_13(gdk_pixbuf_render_to_drawable_alpha, GdkPixbuf_val, GdkDrawable_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Alpha_mode_val, Int_val, GdkRgbDither_val, Int_val, Int_val, Unit) ML_bc13(ml_gdk_pixbuf_render_to_drawable_alpha) /* Not available before 2.2 ML_12(gdk_draw_pixbuf, GdkDrawable_val, GdkGC_val, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, GdkRgbDither_val, Int_val, Int_val, Unit) ML_bc12(ml_gdk_draw_pixbuf) */ CAMLprim value ml_gdk_pixbuf_render_pixmap_and_mask (value pixbuf, value thr) { CAMLparam0(); CAMLlocal2(vpm,vmask); value ret; GdkPixmap *pm; GdkBitmap *mask; gdk_pixbuf_render_pixmap_and_mask(GdkPixbuf_val(pixbuf), &pm, &mask, Int_val(thr)); vpm = Val_GdkPixmap_no_ref(pm); vmask = Val_option(mask,Val_GdkBitmap_no_ref); ret = alloc_small(2,0); Field(ret,0) = vpm; Field(ret,1) = vmask; CAMLreturn(ret); } /* Fetching a region from a drawable */ ML_9(gdk_pixbuf_get_from_drawable, GdkPixbuf_val, GdkDrawable_val, GdkColormap_val, Int_val, Int_val, Int_val, Int_val, Int_val, Int_val, Unit) ML_bc9(ml_gdk_pixbuf_get_from_drawable) /* Scaling */ ML_11(gdk_pixbuf_scale, GdkPixbuf_val, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, Double_val, Double_val, Double_val, Double_val, Interpolation_val, Unit) ML_bc11(ml_gdk_pixbuf_scale) ML_12(gdk_pixbuf_composite, GdkPixbuf_val, GdkPixbuf_val, Int_val, Int_val, Int_val, Int_val, Double_val, Double_val, Double_val, Double_val, Interpolation_val, Int_val, Unit) ML_bc12(ml_gdk_pixbuf_composite) static int list_length(value l) { int i = 0; while(l != Val_emptylist){ l = Field(l, 1); i++; } return i; } static void convert_gdk_pixbuf_options (value options, char ***opt_k, char ***opt_v, gboolean copy) { if (Is_block(options)) { value cell = Field(options, 0); unsigned int i, len = list_length(cell); *opt_k = stat_alloc(sizeof (char *) * (len + 1)); *opt_v = stat_alloc(sizeof (char *) * (len + 1)); for (i=0; i 'a); inj: ('a -> unit data_set) } type fundamental_type = [ `INVALID | `NONE | `INTERFACE | `PARAM | base_data ] type signal_type = [ `RUN_FIRST | `RUN_LAST | `NO_RECURSE | `ACTION | `NO_HOOKS ] external do_unref : unit -> unit = "ml_g_object_do_unref" let unref_alarm = Gc.create_alarm do_unref module Type = struct external init : unit -> unit = "ml_g_type_init" let () = init () external name : g_type -> string = "ml_g_type_name" external _from_name : string -> g_type = "ml_g_type_from_name" external parent : g_type -> g_type = "ml_g_type_parent" external depth : g_type -> int = "ml_g_type_depth" external is_a : g_type -> g_type -> bool = "ml_g_type_is_a" external fundamental : g_type -> fundamental_type = "ml_G_TYPE_FUNDAMENTAL" external of_fundamental : fundamental_type -> g_type = "ml_Fundamental_type_val" external interface_prerequisites : g_type -> g_type list = "ml_g_type_interface_prerequisites" (** @since GTK 2.2 *) external register_static : parent:g_type -> name:string -> g_type = "ml_g_type_register_static" let invalid = of_fundamental `INVALID let from_name s = let t = _from_name s in if t = invalid then failwith ("Gobject.Type.from_name: " ^ s); t external g_caml_get_type : unit -> g_type = "ml_g_caml_get_type" let caml = g_caml_get_type () end module Value = struct external create_empty : unit -> g_value = "ml_g_value_new" (* create a g_value owned by ML *) external init : g_value -> g_type -> unit = "ml_g_value_init" let create ty = let v = create_empty () in init v ty; v (* create and initialize a g_value *) external release : g_value -> unit = "ml_g_value_release" (* invalidate a g_value, releasing resources *) external get_type : g_value -> g_type = "ml_G_VALUE_TYPE" external copy : g_value -> g_value -> unit = "ml_g_value_copy" external reset : g_value -> unit = "ml_g_value_reset" external type_compatible : g_type -> g_type -> bool = "ml_g_value_type_compatible" external type_transformable : g_type -> g_type -> bool = "ml_g_value_type_transformable" external transform : g_value -> g_value -> bool = "ml_g_value_transform" external get : g_value -> data_get = "ml_g_value_get_mlvariant" external set : g_value -> 'a data_set -> unit = "ml_g_value_set_mlvariant" external get_pointer : g_value -> Gpointer.boxed = "ml_g_value_get_pointer" external get_nativeint : g_value -> nativeint = "ml_g_value_get_nativeint" external get_int32 : g_value -> int32 = "ml_g_value_get_int32" let get_conv kind v = try match kind with (* special case to get all 32 bits *) | `INT32 | `UINT32 -> `INT32 (get_int32 v) (* special case to avoid copy of boxed *) | `POINTER -> `POINTER (try Some (get_pointer v) with Gpointer.Null -> None) | _ -> (get v :> data_conv_get) with Failure ("Gobject.get_int32"|"Gobject.get_pointer") -> `NONE end module Closure = struct type args type argv = { result: g_value; nargs: int; args: args } external create : (argv -> unit) -> g_closure = "ml_g_closure_new" external _nth : args -> pos:int -> g_value = "ml_g_value_shift" let nth arg ~pos = if pos < 0 || pos >= arg.nargs then invalid_arg "Gobject.Closure.nth"; _nth arg.args ~pos let result argv = argv.result let get_result_type arg = Value.get_type (result arg) let get_type arg ~pos = Value.get_type (nth arg ~pos) let get arg ~pos = Value.get (nth arg ~pos) let set_result arg = Value.set (result arg) let get_args arg = let rec loop args ~pos = if pos < 0 then args else loop (get arg ~pos :: args) ~pos:(pos-1) in loop [] ~pos:(arg.nargs - 1) let get_pointer arg ~pos = Value.get_pointer (nth arg ~pos) let get_nativeint arg ~pos = Value.get_nativeint (nth arg ~pos) let get_int32 arg ~pos = Value.get_int32 (nth arg ~pos) end let objtype_from_name ~caller name = let t = Type._from_name name in let f = Type.fundamental t in if f = `INVALID then failwith (caller ^ " : type " ^ name ^ " is not yet defined"); if f <> `OBJECT then failwith (caller ^ " : " ^ name ^ " is not an object type"); t external get_type : 'a obj -> g_type = "ml_G_TYPE_FROM_INSTANCE" external get_object_type : 'a obj -> g_type = "ml_G_TYPE_FROM_INSTANCE" let is_a obj name = Type.is_a (get_type obj) (objtype_from_name ~caller:"Gobject.is_a" name) exception Cannot_cast of string * string external unsafe_cast : 'a obj -> 'b obj = "%identity" let try_cast w name = if is_a w name then unsafe_cast w else raise (Cannot_cast(Type.name(get_type w), name)) external coerce : 'a obj -> unit obj = "%identity" external coerce_option : 'a obj option -> unit obj option = "%identity" (* [coerce] is safe *) external unsafe_create : g_type -> (string * 'a data_set) list -> 'b obj = "ml_g_object_new" (* This is dangerous! *) external unsafe_unref : 'a obj -> unit = "ml_g_object_unref" external get_ref_count : 'a obj -> int = "ml_g_object_ref_count" type ('a,'b) property = { name: string; conv: 'b data_conv } type 'a param = string * unit data_set let dyn_param prop v = (prop, (Obj.magic (v : 'a data_set) : unit data_set)) let param (prop : ('a,'b) property) d : 'a param = dyn_param prop.name (prop.conv.inj d) let unsafe_create ~classe l = unsafe_create (objtype_from_name ~caller:"Gobject.unsafe_create" classe) l let get_oid (obj : 'a obj) : int = (snd (Obj.magic obj) lor 0) module Data = struct let boolean = { kind = `BOOLEAN; proj = (function `BOOL b -> b | _ -> failwith "Gobject.get_bool"); inj = (fun b -> `BOOL b) } let char = { kind = `CHAR; proj = (function `CHAR c -> c | _ -> failwith "Gobject.get_char"); inj = (fun c -> `CHAR c) } let uchar = {char with kind = `UCHAR} let int = { kind = `INT; proj = (function `INT c -> c | _ -> failwith "Gobject.get_int"); inj = (fun c -> `INT c) } let uint = {int with kind = `UINT} let long = {int with kind = `LONG} let ulong = {int with kind = `ULONG} let int32 = { kind = `INT32; proj = (function `INT32 c -> c | _ -> failwith "Gobject.get_int32"); inj = (fun c -> `INT32 c) } let uint32 = {int32 with kind = `UINT32} let flags tbl = { kind = `FLAGS; proj = (function `INT c -> Gpointer.decode_flags tbl c | _ -> failwith "Gobject.get_flags"); inj = (fun c -> `INT (Gpointer.encode_flags tbl c)) } let enum tbl = { kind = `ENUM; proj = (function `INT c -> Gpointer.decode_variant tbl c | _ -> failwith "Gobject.get_enum"); inj = (fun c -> `INT (Gpointer.encode_variant tbl c)) } let int64 = { kind = `INT64; proj = (function `INT64 c -> c | _ -> failwith "Gobject.get_int64"); inj = (fun c -> `INT64 c) } let uint64 = {int64 with kind = `UINT64} let float = { kind = `FLOAT; proj = (function `FLOAT c -> c | _ -> failwith "Gobject.get_float"); inj = (fun c -> `FLOAT c) } let double = {float with kind = `DOUBLE} let string = { kind = `STRING; proj = (function `STRING (Some s) -> s | `STRING None -> "" | _ -> failwith "Gobject.get_string"); inj = (fun s -> `STRING (Some s)) } let string_option = { kind = `STRING; proj = (function `STRING s -> s | _ -> failwith "Gobject.get_string_option"); inj = (fun s -> `STRING s) } let pointer = { kind = `POINTER; proj = (function `POINTER c -> c | _ -> failwith "Gobject.get_pointer"); inj = (fun c -> `POINTER c) } let unsafe_pointer = { kind = `POINTER; proj = (function `POINTER (Some c) -> Obj.magic c | _ -> failwith "Gobject.get_pointer"); inj = (fun c -> `POINTER (Some (Obj.magic c))) } let magic : 'a option -> 'b option = Obj.magic let unsafe_pointer_option = { kind = `POINTER; proj = (function `POINTER c -> magic c | _ -> failwith "Gobject.get_pointer"); inj = (fun c -> `POINTER (magic c)) } let boxed_type t = if Type.fundamental t <> `BOXED then failwith "Gobject.Data.boxed_type"; `OTHER t let boxed t = {pointer with kind = boxed_type t} let unsafe_boxed t = {unsafe_pointer with kind = boxed_type t} let unsafe_boxed_option t = {unsafe_pointer_option with kind = boxed_type t} let gobject_option = { kind = `OBJECT; proj = (function `OBJECT c -> may_map ~f:unsafe_cast c | _ -> failwith "Gobject.get_object"); inj = (fun c -> `OBJECT (may_map ~f:unsafe_cast c)) } let gobject = { kind = `OBJECT; proj = (function `OBJECT (Some c) -> unsafe_cast c | `OBJECT None -> raise Gpointer.Null | _ -> failwith "Gobject.get_object"); inj = (fun c -> `OBJECT (Some (unsafe_cast c))) } let gobject_by_name name = { gobject with kind = `OTHER (Type.from_name name) } let caml = { kind = `OTHER Type.caml; proj = (function `CAML v -> Obj.obj v | _ -> failwith "Gobject.get_caml") ; inj = (fun v -> `CAML (Obj.repr v)) } let caml_option = { kind = `OTHER Type.caml; proj = (function `CAML v -> Some (Obj.obj v) | `NONE -> None | _ -> failwith "Gobject.get_caml") ; inj = (function None -> `POINTER None | Some v -> `CAML (Obj.repr v)) } let wrap ~inj ~proj conv = { kind = conv.kind; proj = (fun x -> proj (conv.proj x)); inj = (fun x -> conv.inj (inj x)) } let of_value conv v = conv.proj (Value.get_conv conv.kind v) let type_of_kind = function | `INT32 -> Type.of_fundamental `INT | `UINT32 -> Type.of_fundamental `UINT | `OTHER t -> t | #base_data as x -> Type.of_fundamental x let get_type conv = type_of_kind conv.kind let to_value conv x = let v = Value.create (get_type conv) in Value.set v (conv.inj x); v end module Property = struct external freeze_notify : 'a obj -> unit = "ml_g_object_freeze_notify" external thaw_notify : 'a obj -> unit = "ml_g_object_thaw_notify" external notify : 'a obj -> string -> unit = "ml_g_object_notify" external set_value : 'a obj -> string -> g_value -> unit = "ml_g_object_set_property" external get_value : 'a obj -> string -> g_value -> unit = "ml_g_object_get_property" external get_type : 'a obj -> string -> g_type = "ml_my_g_object_get_property_type" (* [get_property_type o name] may raise [Invalid_argument name] *) (* Converted the following to C to avoid too many calls let set_dyn obj prop data = let t = get_type obj prop in let v = Value.create t in Value.set v data; set_value obj prop v let get_dyn obj prop = let t = get_type obj prop in let v = Value.create t in get_value obj prop v; Value.get v *) external set_dyn : 'a obj -> string -> 'b data_set -> unit = "ml_g_object_set_property_dyn" external get_dyn : 'a obj -> string -> data_get = "ml_g_object_get_property_dyn" let set (obj : 'a obj) (prop : ('a,_) property) x = set_dyn obj prop.name (prop.conv.inj x) let get (obj : 'a obj) (prop : ('a,_) property) = let v = match prop.conv.kind with (* Special cases: need to bypass normal conversion *) | `INT32 | `UINT32 | `POINTER as k -> let t = get_type obj prop.name in let v = Value.create t in get_value obj prop.name v; Value.get_conv k v | _ -> (get_dyn obj prop.name :> data_conv_get) in prop.conv.proj v let get_some obj prop = match get obj prop with Some x -> x | None -> failwith ("Gobject.Property.get_some: " ^ prop.name) let check obj prop = let tp obj = Type.name (get_object_type obj) in let _data = try get_dyn obj prop.name with Invalid_argument _ -> failwith (tp obj ^ " has no property " ^ prop.name) | exn -> prerr_endline ("exception while looking for " ^ tp obj ^ "->" ^ prop.name); raise exn in try ignore (get obj prop) with Failure s -> failwith (s ^ " cannot handle " ^ tp obj ^ "->" ^ prop.name) | exn -> failwith (tp obj ^ "->" ^ prop.name ^ " raised " ^ Printexc.to_string exn) let may_cons prop x l = match x with Some x -> param prop x :: l | None -> l let may_cons_opt prop x l = match x with Some _ -> param prop x :: l | None -> l end let set p o x = Property.set o p x let get p o = Property.get o p let set_params obj params = List.iter params ~f:(fun (prop,arg) -> Property.set_dyn obj prop arg) lablgtk-2.18.8/src/gnoDruid.ml0000644000175000017500000001500113460263323015155 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) class type druid_page = object method as_druidpage : GnomeDruid.druidpage Gtk.obj end class druid_signals obj = object (self) inherit GContainer.container_signals_impl (obj : GnomeDruid.druid Gtk.obj) method cancel = self#connect GnomeDruid.Druid.Signals.cancel method help = self#connect GnomeDruid.Druid.Signals.help end class druid obj = object (self) inherit GContainer.container obj method connect = new druid_signals obj method show_finish = Gobject.get GnomeDruid.Druid.Prop.show_finish obj method show_help = Gobject.get GnomeDruid.Druid.Prop.show_help obj method set_show_finish = Gobject.set GnomeDruid.Druid.Prop.show_finish obj method set_show_help = Gobject.set GnomeDruid.Druid.Prop.show_help obj method set_buttons_sensitive = GnomeDruid.Druid.set_buttons_sensitive obj method prepend_page : 'p. (#druid_page as 'p) -> unit = fun p -> GnomeDruid.Druid.prepend_page obj p#as_druidpage method insert_page : 'p1 'p2. (#druid_page as 'p1) -> (#druid_page as 'p2) -> unit = fun p1 p2 -> GnomeDruid.Druid.insert_page obj p1#as_druidpage p2#as_druidpage method append_page : 'p. (#druid_page as 'p) -> unit = fun p -> GnomeDruid.Druid.append_page obj p#as_druidpage method set_page : 'p. (#druid_page as 'p) -> unit = fun p -> GnomeDruid.Druid.set_page obj p#as_druidpage end let druid ?show_finish ?show_help = GContainer.pack_container ( Gobject.Property.may_cons GnomeDruid.Druid.Prop.show_finish show_finish ( Gobject.Property.may_cons GnomeDruid.Druid.Prop.show_help show_help [])) ~create:(fun pl -> let w = GnomeDruid.Druid.new_druid () in Gobject.set_params w pl ; new druid w) class druid_page_signals obj = object (self) inherit GContainer.container_signals_impl obj method back ~callback = self#connect GnomeDruid.Druid_page.Signals.back (fun w -> callback (new druid w)) method cancel ~callback = self#connect GnomeDruid.Druid_page.Signals.cancel (fun w -> callback (new druid w)) method finish ~callback = self#connect GnomeDruid.Druid_page.Signals.finish (fun w -> callback (new druid w)) method next ~callback = self#connect GnomeDruid.Druid_page.Signals.next (fun w -> callback (new druid w)) method prepare ~callback = self#connect GnomeDruid.Druid_page.Signals.prepare (fun w -> callback (new druid w)) end class druid_page_skel obj = object (self) inherit [[> GnomeDruid.druidpage]] GContainer.container_impl obj method as_druidpage = (obj :> GnomeDruid.druidpage Gtk.obj) method connect = new druid_page_signals (obj :> GnomeDruid.druidpage Gtk.obj) end class druid_page_edge obj = object (self) inherit druid_page_skel obj method set_bg_color = GnomeDruid.Page_Edge.set_bg_color obj method set_textbox_color = GnomeDruid.Page_Edge.set_textbox_color obj method set_logo_bg_color = GnomeDruid.Page_Edge.set_logo_bg_color obj method set_title_color = GnomeDruid.Page_Edge.set_title_color obj method set_text_color = GnomeDruid.Page_Edge.set_text_color obj method set_text = GnomeDruid.Page_Edge.set_text obj method set_title = GnomeDruid.Page_Edge.set_title obj method set_logo = GnomeDruid.Page_Edge.set_logo obj method set_watermark = GnomeDruid.Page_Edge.set_watermark obj method set_top_watermark = GnomeDruid.Page_Edge.set_top_watermark obj end let druid_page_edge ~position ~aa ?title ?text ?logo ?watermark ?top_watermark = GContainer.pack_container [] ~create:(fun pl -> let w = GnomeDruid.Page_Edge.new_with_vals position ~aa ?title ?text ?logo ?watermark ?top_watermark in Gobject.set_params w pl ; new druid_page_edge w) class druid_page_standard obj = object (self) inherit druid_page_skel obj method vbox = new GPack.box (GnomeDruid.Page_Standard.vbox obj) method append_item ?question ?additional_info w = GnomeDruid.Page_Standard.append_item obj ?question (GObj.as_widget w) ?additional_info method set_background = Gobject.set GnomeDruid.Page_Standard.Prop.background obj method set_logo = Gobject.set GnomeDruid.Page_Standard.Prop.logo obj method set_logo_background = Gobject.set GnomeDruid.Page_Standard.Prop.logo_background obj method set_title = Gobject.set GnomeDruid.Page_Standard.Prop.title obj method set_title_foreground = Gobject.set GnomeDruid.Page_Standard.Prop.title_foreground obj end let druid_page_standard ?background ?logo ?logo_background ?title ?title_foreground = GContainer.pack_container ( Gobject.Property.may_cons GnomeDruid.Page_Standard.Prop.background background ( Gobject.Property.may_cons GnomeDruid.Page_Standard.Prop.logo logo ( Gobject.Property.may_cons GnomeDruid.Page_Standard.Prop.logo_background logo_background ( Gobject.Property.may_cons GnomeDruid.Page_Standard.Prop.title title ( Gobject.Property.may_cons GnomeDruid.Page_Standard.Prop.title_foreground title_foreground []))))) ~create:(fun pl -> let w = GnomeDruid.Page_Standard.new_page_standard () in Gobject.set_params w pl ; new druid_page_standard w) lablgtk-2.18.8/src/gAssistant.ml0000644000175000017500000001023013460263323015521 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id: gWindow.ml 1347 2007-06-20 07:40:34Z guesdon $ *) open Gaux open Gtk open GtkBase open GtkAssistant open GtkMisc open GObj open OgtkAssistantProps open GContainer (** Assistants **) class assistant_signals obj = object inherit container_signals_impl (obj : [> assistant] obj) inherit assistant_sigs end class assistant obj = object (self) inherit GWindow.window_skel obj method connect = new assistant_signals obj method current_page = Assistant.get_current_page obj method set_current_page = Assistant.set_current_page obj method n_pages = Assistant.get_n_pages obj method nth_page = Assistant.get_nth_page obj method insert_page ?page_type ?title ?header_image ?side_image ?complete ~position w = let n = Assistant.insert_page obj w position in may (self#set_page_type w) page_type; may (self#set_page_title w) title; may (self#set_page_header_image w) header_image; may (self#set_page_side_image w) side_image; may (self#set_page_complete w) complete; n method append_page ?page_type ?title ?header_image ?side_image ?complete w = self#insert_page ?page_type ?title ?header_image ?side_image ?complete ~position:(-1) w method prepend_page ?page_type ?title ?header_image ?side_image ?complete w = self#insert_page ?page_type ?title ?header_image ?side_image ?complete ~position:0 w method set_page_type = Assistant.set_page_type obj method page_type = Assistant.get_page_type obj method set_page_title = Assistant.set_page_title obj method page_title = Assistant.get_page_title obj method set_page_header_image = Assistant.set_page_header_image obj method page_header_image = Assistant.get_page_header_image obj method set_page_side_image = Assistant.set_page_side_image obj method page_side_image = Assistant.get_page_side_image obj method set_page_complete = Assistant.set_page_complete obj method page_complete = Assistant.get_page_complete obj method add_action_widget = Assistant.add_action_widget obj method remove_action_widget = Assistant.remove_action_widget obj method update_buttons_state = Assistant.update_buttons_state obj end (*let assistant () = new assistant (Assistant.create []) *) let make_assistant ~create = GtkWindow.Window.make_params ~cont:(fun pl ?wm_name ?wm_class -> Container.make_params pl ~cont:(fun pl ?(show=false) () -> let (w : #GWindow.window_skel) = create pl in may w#set_wm_name wm_name; may w#set_wm_class wm_class; if show then w#show (); w)) let assistant = make_assistant [] ~create:(fun pl -> new assistant (Assistant.create [])) lablgtk-2.18.8/src/gDraw.mli0000644000175000017500000001330513460263323014624 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open Gdk (** Offscreen drawables *) (** {3 Colors} *) (** @gtkdoc gdk gdk-Colormaps-and-Colors *) type color = [ `COLOR of Gdk.color | `WHITE | `BLACK | `NAME of string | `RGB of int * int * int] val color : ?colormap:colormap -> color -> Gdk.color type optcolor = [ `COLOR of Gdk.color | `WHITE | `BLACK | `NAME of string | `RGB of int * int * int | `DEFAULT ] val optcolor : ?colormap:colormap -> optcolor -> Gdk.color option (** {3 GdkDrawable} *) (** Functions for drawing points, lines, arcs, and text @gtkdoc gdk gdk-Drawing-Primitives *) class drawable : ?colormap:colormap -> ([>`drawable] Gobject.obj as 'a) -> object val mutable gc : gc val w : 'a method arc : x:int -> y:int -> width:int -> height:int -> ?filled:bool -> ?start:float -> ?angle:float -> unit -> unit method color : color -> Gdk.color method colormap : colormap method depth : int method gc : gc method set_gc : gc -> unit method gc_values : GC.values method get_image : x:int -> y:int -> width:int -> height:int -> image method get_pixbuf : ?dest_x:int -> ?dest_y:int -> ?width:int -> ?height:int -> ?src_x:int -> ?src_y:int -> GdkPixbuf.pixbuf -> unit method line : x:int -> y:int -> x:int -> y:int -> unit method point : x:int -> y:int -> unit method polygon : ?filled:bool -> (int * int) list -> unit method put_layout : x: int -> y: int -> ?fore:color -> ?back:color -> Pango.layout -> unit method put_image : x:int -> y:int -> ?xsrc:int -> ?ysrc:int -> ?width:int -> ?height:int -> image -> unit method put_pixmap : x:int -> y:int -> ?xsrc:int -> ?ysrc:int -> ?width:int -> ?height:int -> pixmap -> unit method put_rgb_data : width:int -> height:int -> ?x:int -> ?y:int -> ?dither:Gdk.Tags.rgb_dither -> ?row_stride:int -> Gpointer.region -> unit method put_pixbuf : x:int -> y:int -> ?width:int -> ?height:int -> ?dither:Gdk.Tags.rgb_dither -> ?x_dither:int -> ?y_dither:int -> ?src_x:int -> ?src_y:int -> GdkPixbuf.pixbuf -> unit method rectangle : x:int -> y:int -> width:int -> height:int -> ?filled:bool -> unit -> unit method set_background : color -> unit method set_foreground : color -> unit method set_clip_region : region -> unit method set_clip_origin : x:int -> y:int -> unit method set_clip_mask : bitmap -> unit method set_clip_rectangle : Rectangle.t -> unit method set_line_attributes : ?width:int -> ?style:GC.gdkLineStyle -> ?cap:GC.gdkCapStyle -> ?join:GC.gdkJoinStyle -> unit -> unit method size : int * int method string : string -> font:font -> x:int -> y:int -> unit method points : (int * int) list -> unit method lines : (int * int) list -> unit method segments : ((int * int) * (int * int)) list -> unit end (** {3 GdkPixmap} *) (** Offscreen drawables @gtkdoc gdk gdk-Bitmaps-and-Pixmaps *) class pixmap : ?colormap:colormap -> ?mask:bitmap -> Gdk.pixmap -> object inherit drawable val w : Gdk.pixmap val bitmap : drawable option val mask : bitmap option method mask : bitmap option method pixmap : Gdk.pixmap end class type misc_ops = object method colormap : colormap method realize : unit -> unit method visual_depth : int method window : window end (** @gtkdoc gdk gdk-Bitmaps-and-Pixmaps *) val pixmap : width:int -> height:int -> ?mask:bool -> ?window:< misc : #misc_ops; .. > -> ?colormap:colormap -> unit -> pixmap val pixmap_from_xpm : file:string -> ?window:< misc : #misc_ops; .. > -> ?colormap:colormap -> ?transparent:color -> unit -> pixmap val pixmap_from_xpm_d : data:string array -> ?window:< misc : #misc_ops; .. > -> ?colormap:colormap -> ?transparent:color -> unit -> pixmap (** {3 GdkDragContext} *) (** @gtkdoc gdk gdk-Drag-and-Drop *) class drag_context : Gdk.drag_context -> object val context : Gdk.drag_context method status : ?time:int32 -> Tags.drag_action option -> unit method suggested_action : Tags.drag_action method targets : string list end lablgtk-2.18.8/src/gnomeui_tags.var0000644000175000017500000000010113460263323016236 0ustar stephstephtype edge_position = "GNOME_EDGE_" [ `START | `FINISH | `OTHER ] lablgtk-2.18.8/src/gContainer.ml0000644000175000017500000000767213460263323015512 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gobject open Gtk open GtkBase open OgtkBaseProps open GObj open GData open Container class focus obj = object val obj = obj (* method circulate = focus obj *) method set (child : widget option) = let child = may_map child ~f:(fun x -> x#as_widget) in set_focus_child obj (Gpointer.optboxed child) method set_hadjustment adj = set_focus_hadjustment obj (Gpointer.optboxed (may_map adj ~f:as_adjustment)) method set_vadjustment adj = set_focus_vadjustment obj (Gpointer.optboxed (may_map adj ~f:as_adjustment)) end class ['a] container_impl obj = object (self) inherit ['a] widget_impl obj inherit container_props method add w = add obj (as_widget w) method remove w = remove obj (as_widget w) method children = List.map ~f:(new widget) (children obj) method all_children = let l = ref [] in forall obj ~f:(fun w -> l := new widget w :: !l); List.rev !l method focus = new focus obj end class container = ['a] container_impl class container_signals_impl obj = object inherit widget_signals_impl obj inherit container_sigs end class type container_signals = container_signals_impl class container_full obj = object inherit container obj method connect = new container_signals_impl obj end let cast_container (w : widget) = new container_full (cast w#as_widget) let pack_container ~create = Container.make_params ~cont: (fun p ?packing ?show () -> pack_return (create p) ~packing ~show) class ['a] bin_impl obj = object inherit ['a] container_impl obj method child = new widget (Bin.get_child obj) end class bin = ['a] bin_impl class virtual ['a] item_container obj = object (self) inherit ['b] widget_impl obj inherit container_props method add (w : 'a) = add obj w#as_item method remove (w : 'a) = remove obj w#as_item method private virtual wrap : Gtk.widget obj -> 'a method children : 'a list = List.map ~f:self#wrap (children obj) method all_children = let l = ref [] in forall obj ~f:(fun w -> l := self#wrap w :: !l); List.rev !l method focus = new focus obj method virtual insert : 'a -> pos:int -> unit method append (w : 'a) = self#insert w ~pos:(-1) method prepend (w : 'a) = self#insert w ~pos:0 end class item_signals obj = object inherit container_signals_impl (obj : [> Gtk.item] obj) inherit item_sigs end lablgtk-2.18.8/src/gpointer.mli0000644000175000017500000000743213460263323015413 0ustar stephsteph(**************************************************************************) (* Lablgtk *) (* *) (* This program is free software; you can redistribute it *) (* and/or modify it under the terms of the GNU Library General *) (* Public License as published by the Free Software Foundation *) (* version 2, with the exception described in file COPYING which *) (* comes with the library. *) (* *) (* This program is distributed in the hope that it will be useful, *) (* but WITHOUT ANY WARRANTY; without even the implied warranty of *) (* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *) (* GNU Library General Public License for more details. *) (* *) (* You should have received a copy of the GNU Library General *) (* Public License along with this program; if not, write to the *) (* Free Software Foundation, Inc., 59 Temple Place, Suite 330, *) (* Boston, MA 02111-1307 USA *) (* *) (* *) (**************************************************************************) (* $Id$ *) (** [Gpointer]: various kinds of pointers to C data *) (** Marked pointers *) type 'a optaddr val optaddr : 'a option -> 'a optaddr (** Naked pointers *) type optstring val raw_null : optstring val optstring : string option -> optstring (** Boxed pointers *) type boxed val boxed_null : boxed val peek_string : ?pos:int -> ?len:int -> boxed -> string val peek_int : boxed -> int val poke_int : boxed -> int -> unit val peek_nativeint : boxed -> nativeint val poke_nativeint : boxed -> nativeint -> unit type 'a optboxed val optboxed : 'a option -> 'a optboxed val may_box : f:('a -> 'b) -> 'a option -> 'b optboxed (** Variant tables *) type 'a variant_table constraint 'a = [> ] val decode_variant : 'a variant_table -> int -> 'a val encode_variant : 'a variant_table -> 'a -> int val decode_flags : 'a variant_table -> int -> 'a list val encode_flags : 'a variant_table -> 'a list -> int (** Null pointer exception *) exception Null (** Ensure a value is copied in the old generation *) type 'a stable val stable_copy : 'a -> 'a stable (** Region handling *) (** The abstract type of heap regions *) type region val length : region -> int (** the length of the region *) val get_addr : region -> nativeint (** the start address of the region *) val sub : ?pos:int -> ?len:int -> region -> region (** subregion of length [len] starting at offset [pos] *) val get_byte : region -> pos:int -> int val set_byte : region -> pos:int -> int -> unit val blit : src:region -> dst:region -> unit val region_of_bytes : bytes -> region (** create a region sharing a string *) val bytes_of_region : region -> bytes (** copy the contents of the region to a string *) type 'a bigarray = (int, Bigarray.int8_unsigned_elt, 'a) Bigarray.Array1.t val region_of_bigarray : 'a bigarray -> region (** create a region sharing a bigarray *) (** Unsafe access *) val unsafe_create_region : path:int array -> get_length:('a -> int) -> 'a -> region (** [unsafe_create_region ~path ~get_length] returns a function to build regions from a specific kind of data abstraction *) external unsafe_get_byte : region -> pos:int -> int = "ml_gpointer_get_char" external unsafe_set_byte : region -> pos:int -> int -> unit = "ml_gpointer_set_char" lablgtk-2.18.8/src/ml_gtkedit.c0000644000175000017500000002540413460263323015347 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ /* $Id$ */ #include #include #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "gtk_tags.h" #include "ml_gtktree.h" /* Init all */ CAMLprim value ml_gtkedit_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_spin_button_get_type() + gtk_combo_get_type() + #ifdef HASGTK24 gtk_combo_box_get_type() + gtk_combo_box_entry_get_type() + gtk_entry_completion_get_type(); #else 0; #endif return Val_GType(t); } /* gtkeditable.h */ #define GtkEditable_val(val) check_cast(GTK_EDITABLE,val) ML_3 (gtk_editable_select_region, GtkEditable_val, Int_val, Int_val, Unit) CAMLprim value ml_gtk_editable_get_selection_bounds(value w) { int start, end; CAMLparam1(w); CAMLlocal1(tmp); value res = Val_unit; if (gtk_editable_get_selection_bounds(GtkEditable_val(w), &start, &end)) { tmp = alloc_small(2,0); Field(tmp,0) = Val_int(start); Field(tmp,1) = Val_int(end); res = alloc_small(1,0); Field(res,0) = tmp; } CAMLreturn(res); } CAMLprim value ml_gtk_editable_insert_text (value w, value s, value pos) { int position = Int_val(pos); gtk_editable_insert_text (GtkEditable_val(w), String_val(s), string_length(s), &position); return Val_int(position); } ML_3 (gtk_editable_delete_text, GtkEditable_val, Int_val, Int_val, Unit) ML_3 (gtk_editable_get_chars, GtkEditable_val, Int_val, Int_val, copy_string_g_free) ML_1 (gtk_editable_cut_clipboard, GtkEditable_val, Unit) ML_1 (gtk_editable_copy_clipboard, GtkEditable_val, Unit) ML_1 (gtk_editable_paste_clipboard, GtkEditable_val, Unit) ML_1 (gtk_editable_delete_selection, GtkEditable_val, Unit) ML_2 (gtk_editable_set_position, GtkEditable_val, Int_val, Unit) ML_1 (gtk_editable_get_position, GtkEditable_val, Val_int) ML_2 (gtk_editable_set_editable, GtkEditable_val, Bool_val, Unit) ML_1 (gtk_editable_get_editable, GtkEditable_val, Val_bool) /* gtkentry.h */ #define GtkEntry_val(val) check_cast(GTK_ENTRY,val) ML_2 (gtk_entry_append_text, GtkEntry_val, String_val, Unit) ML_2 (gtk_entry_prepend_text, GtkEntry_val, String_val, Unit) Make_Extractor (gtk_entry, GtkEntry_val, text_length, Val_int) /* ML_0 (gtk_entry_new, Val_GtkWidget_sink) ML_1 (gtk_entry_new_with_max_length, (gint16)Long_val, Val_GtkWidget_sink) ML_2 (gtk_entry_set_text, GtkEntry_val, String_val, Unit) ML_1 (gtk_entry_get_text, GtkEntry_val, Val_string) ML_3 (gtk_entry_select_region, GtkEntry_val, Int_val, Int_val, Unit) ML_2 (gtk_entry_set_visibility, GtkEntry_val, Bool_val, Unit) ML_2 (gtk_entry_set_max_length, GtkEntry_val, (gint16)Long_val, Unit) */ /* gtkspinbutton.h */ #define GtkSpinButton_val(val) check_cast(GTK_SPIN_BUTTON,val) /* ML_3 (gtk_spin_button_new, GtkAdjustment_val, Float_val, Int_val, Val_GtkWidget_sink) ML_2 (gtk_spin_button_set_adjustment, GtkSpinButton_val, GtkAdjustment_val, Unit) ML_1 (gtk_spin_button_get_adjustment, GtkSpinButton_val, Val_GtkAny) ML_2 (gtk_spin_button_set_digits, GtkSpinButton_val, Int_val, Unit) ML_1 (gtk_spin_button_get_value_as_float, GtkSpinButton_val, copy_double) ML_2 (gtk_spin_button_set_value, GtkSpinButton_val, Float_val, Unit) ML_2 (gtk_spin_button_set_update_policy, GtkSpinButton_val, Spin_button_update_policy_val, Unit) ML_2 (gtk_spin_button_set_numeric, GtkSpinButton_val, Bool_val, Unit) ML_2 (gtk_spin_button_set_wrap, GtkSpinButton_val, Bool_val, Unit) ML_2 (gtk_spin_button_set_snap_to_ticks, GtkSpinButton_val, Bool_val, Unit) ML_4 (gtk_spin_button_configure, GtkSpinButton_val, GtkAdjustment_val, Float_val, Int_val, Unit) */ ML_2 (gtk_spin_button_spin, GtkSpinButton_val, Insert (Is_long(arg2) ? Spin_type_val(arg2) : GTK_SPIN_USER_DEFINED) (Is_long(arg2) ? 0.0 : Float_val(Field(arg2,1))) Ignore, Unit) ML_1 (gtk_spin_button_update, GtkSpinButton_val, Unit) /* gtktext.h */ /* #define GtkText_val(val) check_cast(GTK_TEXT,val) ML_2 (gtk_text_new, GtkAdjustment_val, GtkAdjustment_val, Val_GtkWidget_sink) ML_2 (gtk_text_set_word_wrap, GtkText_val, Bool_val, Unit) ML_2 (gtk_text_set_line_wrap, GtkText_val, Bool_val, Unit) ML_3 (gtk_text_set_adjustments, GtkText_val, Option_val(arg2,GtkAdjustment_val,GtkText_val(arg1)->hadj) Ignore, Option_val(arg3,GtkAdjustment_val,GtkText_val(arg1)->vadj) Ignore, Unit) Make_Extractor (gtk_text_get, GtkText_val, hadj, Val_GtkWidget) Make_Extractor (gtk_text_get, GtkText_val, vadj, Val_GtkWidget) ML_2 (gtk_text_set_point, GtkText_val, Int_val, Unit) ML_1 (gtk_text_get_point, GtkText_val, Val_int) ML_1 (gtk_text_get_length, GtkText_val, Val_int) ML_1 (gtk_text_freeze, GtkText_val, Unit) ML_1 (gtk_text_thaw, GtkText_val, Unit) CAMLprim value ml_gtk_text_insert (value text, value font, value fore, value back, value str) { gtk_text_insert (GtkText_val(text), Option_val(font,GdkFont_val,NULL), Option_val(fore,GdkColor_val,NULL), Option_val(back,GdkColor_val,NULL), String_val(str), string_length(str)); return Val_unit; } ML_2 (gtk_text_forward_delete, GtkText_val, Int_val, Val_int) ML_2 (gtk_text_backward_delete, GtkText_val, Int_val, Val_int) */ /* gtkcombo.h */ #define GtkCombo_val(val) check_cast(GTK_COMBO,val) /* ML_0 (gtk_combo_new, Val_GtkWidget_sink) ML_3 (gtk_combo_set_value_in_list, GtkCombo_val, Option_val(arg2, Bool_val, GtkCombo_val(arg1)->value_in_list) Ignore, Option_val(arg3, Bool_val, GtkCombo_val(arg1)->ok_if_empty) Ignore, Unit) ML_2 (gtk_combo_set_use_arrows, GtkCombo_val, Bool_val, Unit) ML_2 (gtk_combo_set_use_arrows_always, GtkCombo_val, Bool_val, Unit) ML_2 (gtk_combo_set_case_sensitive, GtkCombo_val, Bool_val, Unit) */ ML_3 (gtk_combo_set_item_string, GtkCombo_val, GtkItem_val, String_val, Unit) ML_1 (gtk_combo_disable_activate, GtkCombo_val, Unit) Make_Extractor (gtk_combo, GtkCombo_val, entry, Val_GtkWidget) Make_Extractor (gtk_combo, GtkCombo_val, list, Val_GtkWidget) #ifdef HASGTK24 /* gtkcombobox.h */ #define GtkComboBox_val(val) check_cast(GTK_COMBO_BOX,val) CAMLprim value ml_gtk_combo_box_get_active_iter(value combo) { GtkTreeIter it; if (! gtk_combo_box_get_active_iter(GtkComboBox_val(combo), &it)) return Val_unit; return ml_some(Val_GtkTreeIter(&it)); } ML_2(gtk_combo_box_set_active_iter, GtkComboBox_val, GtkTreeIter_optval, Unit) /* gtkentrycompletion.h */ #define GtkEntryCompletion_val(val) check_cast(GTK_ENTRY_COMPLETION,val) ML_1(gtk_entry_completion_get_entry,GtkEntryCompletion_val,Val_GtkWidget) ML_1(gtk_entry_completion_complete,GtkEntryCompletion_val,Unit) ML_3(gtk_entry_completion_insert_action_text,GtkEntryCompletion_val,Int_val,String_val,Unit) ML_3(gtk_entry_completion_insert_action_markup,GtkEntryCompletion_val,Int_val,String_val,Unit) ML_2(gtk_entry_completion_delete_action,GtkEntryCompletion_val,Int_val,Unit) ML_2(gtk_entry_completion_set_text_column,GtkEntryCompletion_val,Int_val,Unit) static gboolean ml_gtk_entry_completion_match_func (GtkEntryCompletion *completion, const gchar *key, GtkTreeIter *iter, gpointer user_data) { value *closure = user_data; CAMLparam0(); CAMLlocal3(vkey, viter, vret); vkey = copy_string(key); viter = Val_GtkTreeIter(iter); vret = callback2_exn(*closure, vkey, viter); if (Is_exception_result(vret)) CAMLreturn(FALSE); CAMLreturn(Bool_val(vret)); } CAMLprim value ml_gtk_entry_completion_set_match_func(value compl, value cb) { value *closure = ml_global_root_new(cb); gtk_entry_completion_set_match_func(GtkEntryCompletion_val(compl), ml_gtk_entry_completion_match_func, closure, ml_global_root_destroy); return Val_unit; } ML_2 (gtk_entry_set_completion, GtkEntry_val, GtkEntryCompletion_val, Unit) CAMLprim value ml_gtk_entry_get_completion(value entry) { GtkEntryCompletion *c = gtk_entry_get_completion(GtkEntry_val(entry)); return c ? ml_some(Val_GAnyObject(c)) : Val_unit; } #else Unsupported_24(gtk_combo_box_get_active_iter) Unsupported_24(gtk_combo_box_set_active_iter) Unsupported_24(gtk_entry_completion_get_entry) Unsupported_24(gtk_entry_completion_complete) Unsupported_24(gtk_entry_completion_insert_action_text) Unsupported_24(gtk_entry_completion_insert_action_markup) Unsupported_24(gtk_entry_completion_delete_action) Unsupported_24(gtk_entry_completion_set_text_column) Unsupported_24(gtk_entry_completion_set_match_func) Unsupported_24(gtk_entry_get_completion) Unsupported_24(gtk_entry_set_completion) #endif /* HASGTK24 */ #ifdef HASGTK26 CAMLprim value ml_gtk_combo_box_set_row_separator_func (value cb, value fun_o) { gpointer data; GtkDestroyNotify dnotify; GtkTreeViewRowSeparatorFunc func; if (Is_long (fun_o)) { data = NULL; dnotify = NULL; func = NULL; } else { data = ml_global_root_new (Field (fun_o, 0)); dnotify = ml_global_root_destroy; func = ml_gtk_row_separator_func; } gtk_combo_box_set_row_separator_func (GtkComboBox_val (cb), func, data, dnotify); return Val_unit; } #else Unsupported_26 (gtk_combo_box_set_row_separator_func) #endif /* HASGTK26 */ lablgtk-2.18.8/src/ml_gtkstock.c0000644000175000017500000001346013460263323015544 0ustar stephsteph/**************************************************************************/ /* Lablgtk */ /* */ /* This program is free software; you can redistribute it */ /* and/or modify it under the terms of the GNU Library General */ /* Public License as published by the Free Software Foundation */ /* version 2, with the exception described in file COPYING which */ /* comes with the library. */ /* */ /* This program is distributed in the hope that it will be useful, */ /* but WITHOUT ANY WARRANTY; without even the implied warranty of */ /* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the */ /* GNU Library General Public License for more details. */ /* */ /* You should have received a copy of the GNU Library General */ /* Public License along with this program; if not, write to the */ /* Free Software Foundation, Inc., 59 Temple Place, Suite 330, */ /* Boston, MA 02111-1307 USA */ /* */ /* */ /**************************************************************************/ #include #include #include #include #include #include "wrappers.h" #include "ml_glib.h" #include "ml_gobject.h" #include "ml_gdk.h" #include "ml_gtk.h" #include "ml_gdkpixbuf.h" #include "gtk_tags.h" #include "gdk_tags.h" CAMLprim value ml_gtkstock_init(value unit) { /* Since these are declared const, must force gcc to call them! */ GType t = gtk_icon_set_get_type() + gtk_icon_source_get_type() + gtk_icon_factory_get_type(); return Val_GType(t); } /* gtkiconfactory.h */ /* GtkIconSource */ Make_Val_final_pointer_ext(GtkIconSource, _new, Ignore, gtk_icon_source_free, 5) #define GtkIconSource_val(v) ((GtkIconSource*)Pointer_val(v)) ML_0 (gtk_icon_source_new, Val_GtkIconSource_new) ML_2 (gtk_icon_source_set_filename, GtkIconSource_val, String_val, Unit) ML_2 (gtk_icon_source_set_pixbuf, GtkIconSource_val, GdkPixbuf_val, Unit) ML_1 (gtk_icon_source_get_filename, GtkIconSource_val, copy_string) ML_1 (gtk_icon_source_get_pixbuf, GtkIconSource_val, Val_GdkPixbuf) ML_2 (gtk_icon_source_set_direction_wildcarded, GtkIconSource_val, Bool_val, Unit) ML_2 (gtk_icon_source_set_state_wildcarded, GtkIconSource_val, Bool_val, Unit) ML_2 (gtk_icon_source_set_size_wildcarded, GtkIconSource_val, Bool_val, Unit) ML_2 (gtk_icon_source_set_direction, GtkIconSource_val, Text_direction_val, Unit) ML_2 (gtk_icon_source_set_state, GtkIconSource_val, State_type_val, Unit) ML_2 (gtk_icon_source_set_size, GtkIconSource_val, Icon_size_val, Unit) /* GtkIconSet */ Make_Val_final_pointer(GtkIconSet, gtk_icon_set_ref, gtk_icon_set_unref, 0) Make_Val_final_pointer_ext(GtkIconSet, _new, Ignore, gtk_icon_set_unref, 5) #define GtkIconSet_val(v) ((GtkIconSet*)Pointer_val(v)) ML_0 (gtk_icon_set_new, Val_GtkIconSet_new) ML_1 (gtk_icon_set_new_from_pixbuf, GdkPixbuf_val, Val_GtkIconSet_new) ML_2 (gtk_icon_set_add_source, GtkIconSet_val, GtkIconSource_val, Unit) CAMLprim value ml_gtk_icon_set_get_sizes(value s) { CAMLparam0(); CAMLlocal2(p, c); GtkIconSize *arr; gint n; gtk_icon_set_get_sizes(GtkIconSet_val(s), &arr, &n); p = Val_emptylist; for(; n>=0; n--){ c = alloc_small(2, Tag_cons); Field(c, 0) = Val_icon_size(arr[n]); Field(c, 1) = p; p = c; } g_free(arr); CAMLreturn(c); } /* GtkIconFactory */ #define GtkIconFactory_val(val) check_cast(GTK_ICON_FACTORY, val) ML_0 (gtk_icon_factory_new, Val_GAnyObject_new) ML_3 (gtk_icon_factory_add, GtkIconFactory_val, String_val, GtkIconSet_val, Unit) ML_2 (gtk_icon_factory_lookup, GtkIconFactory_val, String_val, Val_GtkIconSet) ML_1 (gtk_icon_factory_add_default, GtkIconFactory_val, Unit) ML_1 (gtk_icon_factory_remove_default, GtkIconFactory_val, Unit) ML_1 (gtk_icon_factory_lookup_default, String_val, Val_GtkIconSet) /* GtkStockItem */ CAMLprim value ml_gtk_stock_add(value item) { GtkStockItem it; it.stock_id = String_val(Field(item, 0)); it.label = String_val(Field(item, 1)); it.modifier = Flags_GdkModifier_val(Field(item, 2)) ; it.keyval = Int_val(Field(item, 3)); it.translation_domain = NULL; gtk_stock_add(&it, 1); return Val_unit; } CAMLprim value ml_gtk_stock_list_ids(value unit) { return Val_GSList_free( gtk_stock_list_ids(), (value_in) copy_string_g_free); } CAMLprim value ml_gtk_stock_lookup(value id) { CAMLparam1(id); CAMLlocal3(stock_result,p,c); GtkStockItem r; gboolean b; b = gtk_stock_lookup(String_val(id),&r); if (!b) raise_not_found(); p = Val_emptylist; #define TESTANDCONS(mod)\ if (r.modifier & GDK_##mod##_MASK) \ { c = alloc_small(2,Tag_cons);\ Field(c,0) = Val_gdkModifier(GDK_##mod##_MASK); Field(c,1) = p; p = c;} TESTANDCONS(SHIFT); TESTANDCONS(LOCK); TESTANDCONS(CONTROL); TESTANDCONS(MOD1); TESTANDCONS(MOD2); TESTANDCONS(MOD3); TESTANDCONS(MOD4); TESTANDCONS(MOD5); TESTANDCONS(BUTTON1); TESTANDCONS(BUTTON2); TESTANDCONS(BUTTON3); TESTANDCONS(BUTTON4); TESTANDCONS(BUTTON5); TESTANDCONS(SUPER); TESTANDCONS(HYPER); TESTANDCONS(META); TESTANDCONS(RELEASE); stock_result = alloc_tuple(4); Store_field(stock_result,0,Val_string(r.stock_id)); Store_field(stock_result,1,Val_string(r.label)); Store_field(stock_result,2,p); Store_field(stock_result,3,Val_int(r.keyval)); CAMLreturn(stock_result); } lablgtk-2.18.8/Makefile.pre0000644000175000017500000000052613460263323014514 0ustar stephstephinclude config.make ROOT=$(DESTDIR)$(prefix) SAMPLES=$(ROOT)/examples/lablgtk2 all: cp README $(ROOT)/Lablgtk.txt cp README.win32 $(ROOT)/Lablgtk-install.txt cp CHANGES $(ROOT)/Lablgtk-changes.txt for i in . glade rsvg text canvas sourceview; do \ mkdir -p $(SAMPLES)/$$i; \ (cd examples/$$i; cp * $(SAMPLES)/$$i); done lablgtk-2.18.8/README0000755000175000017500000004221013460263323013146 0ustar stephsteph LablGTK2 2.18.8 : an interface to the GIMP Tool Kit Needed: ocaml-4.05 or more gtk+-2.x (gtk+-2.16.x for full functionality) findlib 1.2.1 or more (for default install) GNU make (there is no standard for conditionals) Info/upgrades: http://lablgtk.forge.ocamlcore.org/ https://github.com/garrigue/lablgtk Status: LablGtk2 is now pretty stable. An important change in gtk-2 is the use of unicode (utf8) for all strings. If you use non-ascii strings, you must imperatively convert them to unicode. This can be done with the [Glib.Convert.locale_to_utf8] function. If your input is already in utf8, it is still a good idea to validate it with Glib.Utf8.validate, as malformed utf8 strings may cause segmentation faults. Note that setlocale is now always called (except if you set GTK_SETLOCALE to 0 in the environment), but LC_NUMERIC is reverted to "C" to avoid problems with floating point conversion in Caml. Note that some widgets are only supported in newer versions of GTK+. If you use them in older versions, you will get a runtime error: Failure "Gobject.unsafe_create : type GtkActionGroup is not yet defined" For unsupported methods, the error message is a bit clearer: Failure "gdk_pixbuf_get_file_info unsupported in Gtk 2.x < 2.4" How to compile: You should normally not need to modify Makefiles. In case you are using the SVN version you may have to first type "aclocal && autoconf". Type ./configure && make world to compile with all supported options enabled (libgl, libglade, libgnomecanvas, librsvg, native compilation, thread support). You may use "./configure --help" to check for the different configuration options. Lablgtk2 specific options are: --with-libdir=/path: install libs in /path/lablgtk2 and /path/stublibs --with-gl --without-gl: override autodetected GtkGLArea support. Requires LablGL --with-glade --without-glade: override autodetected libglade support --with-rsvg --without-rsvg: override autodetected librsvg support --with-gnomecanvas --without-gnomecanvas: override autodetected libgnomecanvas support --with-gnomeui --without-gnomeui: override autodetected libgnomeui support --with-panel --without-panel: override autodetected libpanelapplet support --with-gtkspell --without-gtkspell: override autodetected gtkspell support --with-gtksourceview --without-gtksourceview: override autodetected gtksourceview support --with-gtksourceview2 --without-gtksourceview2: override autodetected gtksourceview2 support --enable-debug: enable debug mode Type "make install" to install using findlib. The commands lablgtk2, gdk_pixbuf_mlsource, and lablgladecc2, are copied directly to the configured executable directory. The following findlib packages are provided (according to configuration): lablgtk2 lablgtk2.auto-init lablgtk2.gl lablgtk2.glade lablgtk2.gnomecanvas lablgtk2.gnomehtml lablgtk2.gnomeui lablgtk2.gtkspell lablgtk2.panel lablgtk2.rsvg lablgtk2.sourceview lablgtk2.sourceview2 You can alternatively use "make old-install" or "make old-install DESTDIR=/my/prefix" to use the old installation procedure, which does not rely on findlib. By default, the library is installed at +lablgtk2. All installation paths are prefixed by DESTDIR when given. Contents: gdk.ml low-level interface to the General Drawing Kit gtk.ml low-level interface to the GIMP Tool Kit gtkThread.ml main loop for threaded version g[A-Z]*.ml object-oriented interface to GTK gdkObj.ml object-oriented interface to GDK lablgtk2 toplevel examples/*.ml various examples applications/browser an ongoing port of ocamlbrowser applications/camlirc an IRC client (by Nobuaki Yoshida) How to run the examples: In the examples directory just type: lablgtk2 ???.ml If you want to run them before installing lablgtk2 you have to use -localdir: ../src/lablgtk2 -localdir ???.ml How to link them: The lablgtk2 script loads an extra module GtkInit, whose only contents is: let locale = GtkMain.Main.init () You must either add this line, or add this module to your link, before calling any Gtk function. With ocamlfind, use ocamlfind ocamlc -package lablgtk2.auto-init -linkpkg -w s ???.ml -o ??? Otherwise, use something similar to: ocamlc -I +lablgtk2 -w s lablgtk.cma gtkInit.cmo ???.ml -o ??? How to use the threaded toplevel: % lablgtk2 -thread Objective Caml version 3.09 # let w = GWindow.window ~show:true ();; # let b = GButton.button ~packing:w#add ~label:"Hello!" ();; You should at once see a window appear, and then a button. The GTK main loop is running in a separate thread. Any command is immediately reflected by the system. For Windows and OSX/Quartz, there are restrictions on which commands can be used in which thread. See the windows port section lower for how to use them. When using threads in a stand-alone application, you must link with gtkThread.cmo and call GtkThread.main in place of GMain.main. Since 2.16.0, busy waiting is no longer necessary with systems threads. (I.e., CPU usage is 0% if nothing occurs.) If you use VM threads, you have to enable busy waiting by hand, otherwise other threads won't be executed (cf. gtkThread.mli). Beware that with VM threads, you cannot switch threads within a callback. The only thread related command you may use in a callback is Thread.create. Calling blocking operations may cause deadlocks. On the other hand, all newly created threads will be run outside of the callback, so they can use all thread operations. Structure of the (raw) Gtk* modules: These modules are composed of one submodule for each class. Signals specific to a widget are in a Signals inner module. A setter function is defined to give access to set_param functions. Structure of the G[A-Z]* modules: These modules provide classes to wrap the raw function calls. Here are the widget classes contained in each module: GPango Pango font handling GDraw Gdk pixmaps, etc... GObj gtkobj, widget, style GData data, adjustment, tooltips GContainer container, item_container GWindow window, dialog, color_selection_dialog, file_selection, plug GPack box, button_box, table, fixed, layout, packer, paned, notebook GBin scrolled_window, event_box, handle_box, frame, aspect_frame, viewport, socket GButton button, toggle_button, check_button, radio_button, toolbar GMenu menu_item, tearoff_item, check_menu_item, radio_menu_item, menu_shell, menu, option_menu, menu_bar, factory GMisc separator, statusbar, calendar, drawing_area, misc, arrow, image, pixmap, label, tips_query, color_selection, font_selection GTree tree_item, tree, view (also tree/list_store, model) GList list_item, liste, clist GEdit editable, entry, spin_button, combo GRange progress, progress_bar, range, scale, scrollbar GText view (also buffer, iter, mark, tag, tagtable) While subtyping follows the Gtk widget hierarchy, you cannot always use width subtyping (i.e. #super is not unifiable with all the subclasses of super). Still, it works for some classes, like #widget and #container, and allows subtyping without coercion towards these classes (cf. #container in examples/pousse.ml for instance). Practically, each widget class is composed of: * a coerce method, returning the object coerced to the type widget. * an as_widget method, returning the raw Gtk widget used for packing, etc... * a destroy method, sending the destroy signal to the object. * a get_oid method, the equivalent of Oo.id for Gtk objects. * a connect sub-object, allowing one to widget specific signals (this is what prevents width subtyping in subclasses.) * a misc sub-object, giving access to miscellanous functionality of the basic gtkwidget class, and a misc#connect sub-object. * an event sub-object, for Xevent related functions (only if the widget has an Xwindow), and an event#connect sub-object. * a drag sub-object, containing drag and drop functions, and a drag#connect sub-object. * widget specific methods. Here is a diagram of the structure (- for methods, + for sub-objects) - coerce : widget - as_widget : Gtk.widget obj - destroy : unit -> unit - get_oid : int - ... + connect : mywidget_signals | - after | - signal_name : callback:(... -> ...) -> GtkSignal.id + misc : misc_ops | - show, hide, disconnect, ... | + connect : misc_signals + drag : drag_ops | - ... | + connect : drag_signals + event : event_ops | - add, ... | + connect : event_signals You create a widget by [. options ... ()]. Many optional arguments are admitted. The last two of them, packing: and show:, allow you respectively to call a function on your newly created widget, and to decide wether to show it immediately or not. By default all widgets except toplevel windows (GWindow module) are shown immediately. Default arguments: For many constructor or method arguments, default values are provided. Generally, this default value is defined by GTK, and you must refer to GTK's documentation. For ML defined defaults, usually default values are either false, 0, None or `NONE, according to the expected type. Important exceptions are ~show, which default to true in all widgets except those in GWindow, and ~fill, which defaults to true or `BOTH. Note about unit as method argument: O'Caml introduces no distinction between methods having side-effects and methods simply returning a value. In practice, this is confusing, and awkward when used as callbacks. For this reason all methods having noticeable side-effects should take arguments, and unit if they have no argument. ML-side signals: The GUtil module provides two kinds of utilities: a memo table, to be able to dynamically cast widgets to their original class, and more interesting ML-side signals. With ML-side signals, you can combine LablGTK widgets into your own components, and add signals to them. Later you can connect to these signals, just like GTK signals. This proved very efficient to develop complex applications, abstracting the plumbing between various components. Explanations are provided in GUtil.mli. Contributed components: The GToolbox module contains contributed components to help you build your applications. Memory management: Important efforts have been dedicated to cooperate with Gtk's reference counting mechanism. As a result you should generally be able to use Gdk/Gtk data structures without caring about memory management. They will be freed when nobody points to them any more. This also means that you do not need to pay too much attention to whether a data structure is still alive or not. If it is not, you should get an error rather than a core dump. The case of Gtk objects deserves special care. Since they are interactive, we cannot just destroy them when they are no longer referenced. They have to be explicitely destroyed. If a widget was added to a container widget, it will automatically be destroyed when its last container is destroyed. For this reason you need only destroy toplevel widgets. Since too frequent GC can severely degrade performance, since 2.18.4 it is possible to change the contribution of custom blocks to the GC cycle, using the function GMain.Gc.set_speed. The default is 10% of what it was in 2.18.3. If you set it to 0, custom block allocation has no impact, and you should consider running the Gc by hand. IMPORTANT: Some Gtk data structures are allocated in the Caml heap, and their use in signals (Gtk functions internally cally callbacks) relies on their address being stable during a function call. For this reason automatic compation is disabled in GtkMain. If you need it, you may use compaction through Gc.compact where it is safe (timeouts, other threads...), but do not enable automatic compaction. LibGlade support: There is support for Glade generated XML UI description files, using libglade. You can read in a file, access to widgets, and define callbacks. A tool for extracting widget definitions from glade description is provided. It generates a wrapper class, and you can then generate an object corresponding to the intended layout, and access individual widgets through its methods. Example: % lablgladecc2 project1.glade > project1.ml % lablgtk2 -thread # #use "project1.ml" ;; class window1 : ... # let w1 = new window1 () ;; # w1#bind ~name:"on_paste1_activate" ~callback:(fun () -> w1#text1#insert "some text\n");; See lablgladecc2 -help for other features (tracing and source embedding). The executable must be linked with lablglade.cma. GL extension: You can use lablgtk in combination with LablGL * get and install lablGL 1.05 from http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgl.html * get and install gtkglarea-1.99.0.tar.gz from ftp://ftp.gnome.org/pub/gnome/sources/gtkglarea/1.99/ or any other gnome mirror site * reconfigure You can then use the widget GlGtk.gl_area as an OpenGL window. Some examples are in examples/GL, but basically any LablGL example can be easily ported. The executable must be linked with both lablgl.cma and lablgtkgl.cma. SVG support: This binding was contributed by Olivier Andrieu. It requires librsvg-2.x (preferably 2.2.x). See an example in examples/rsvg. The executable must be linked with lablrsvg.cma. GnomeCanvas support: This binding was also contributed by Olivier Andrieu. It requires libgnomecanvas-2.x. See examples in examples/canvas. The executable must be linked with lablgnomecanvas.cma. GtkSourceView 1 support: This binding was contributed by Maxence Guesdon and Stefano Zacchiroli. It requires libgtksourceview-1.x. See examples in examples/sourceview. The executable must be linked with lablgtksourceview.cma. GtkSourceView 2 support: This binding was contributed by Benjamin Monate: it is based on the aforementioned GtksourceView 1 support. It requires libgtksourceview-2.x. See examples in examples/sourceview/*2.ml The executable must be linked with lablgtksourceview2.cma. Windows port See README.win32 for detailed information on installation. If you want to use threads, you must be aware of windows specific restrictions; see for instance: http://article.gmane.org/gmane.comp.video.gimp.windows.devel/314 I.e. all GTK related calls must occur in the same thread, the one that runs the main loop. If you want to call them from other threads you need to do some forwarding. Fortunately, with a functional language this is easy. Two functions, val async : ('a -> unit) -> 'a -> unit val sync : ('a -> 'b) -> 'a -> 'b are available in the GtkThread module to help you. They will forward your call to the main thread (between handling two GUI events). This can be either asynchronous or synchronous. In the synchronous case, beware of deadlocks (the trivial case, when you are calling from the same thread, is properly avoided). Note also that since callbacks are always called from the main loop thread, you can freely use GTK in them. Also, non-graphical operations are thread-safe. Here is an example using the lablgtk toplevel with threads: % lablgtk2.bat -thread Objective Caml version 3.09 # open GtkThread;; # let w = sync (GWindow.window ~show:true) ();; # let b = sync (GButton.button ~packing:w#add ~label:"Hello!") ();; # b#connect#clicked (fun () -> prerr_endline "Hello");; OSX/Quartz port Since Darwin is Unix, this port compiles as usual. Note however that Quartz imposes even stronger restrictions than Windows on threads: only the main thread of the application can do GUI work. Just apply the same techniques as described above, being careful to ensure that your first call to GtkThread.main occurs in the main thread. This is done automatically in the threaded toplvel. Authors: Jacques Garrigue Benjamin Monate Olivier Andrieu Adrien Nader Jun Furuse Maxence Guesdon Stefano Zacchiroli For lablgtk1: Hubert Fauque Koji Kagawa Bug reports: http://forge.ocamlcore.org/tracker/?group_id=220 lablgtk-2.18.8/config.make.in0000644000175000017500000000464413460263323015005 0ustar stephsteph# -*- makefile -*- datarootdir = @datarootdir@ CAMLC=@CAMLC@ CAMLOPT=@CAMLOPT@ CAMLRUN=@OCAMLRUN@ CAMLDEP=@OCAMLDEP@ OCAMLDOC=@OCAMLDOC@ CAMLMKTOP=@CAMLMKTOP@ CAMLMKLIB=@CAMLMKLIB@ CAMLP4O=@CAMLP4O@ OCAMLFIND=@OCAMLFIND@ FINDLIBDIR=@FINDLIBDIR@ OCAMLLDCONF=@OCAMLLDCONF@ CAMLBEST=@OCAMLBEST@ CAMLWIN32=@OCAMLWIN32@ CAMLDEP=@OCAMLDEP@ CAMLLEX=@OCAMLLEX@ CAMLYACC=@OCAMLYACC@ EXE=@EXE@ USE_GL=@USE_GTKGL@ USE_GLADE=@USE_GLADE@ USE_RSVG=@USE_RSVG@ HAVE_SVGZ=@HAVE_SVGZ@ USE_GNOMECANVAS=@USE_GNOMECANVAS@ USE_GNOMEUI=@USE_GNOMEUI@ USE_PANEL=@USE_PANEL@ USE_GTKSPELL=@USE_GTKSPELL@ USE_GTKSOURCEVIEW=@USE_GTKSOURCEVIEW@ USE_GTKSOURCEVIEW2=@USE_GTKSOURCEVIEW2@ USE_GTKQUARTZ=@USE_GTKQUARTZ@ USE_CC=@USE_CC@ DEBUG=@DEBUG@ CC=@CC@ RANLIB=@RANLIB@ XA=.a XB= XE= XO=.o XS=@XS@ TOOLCHAIN=unix LIBDIR=@LIBDIR@ THREADS_LIB=@THREADS_LIB@ HAS_DLL_SUPPORT=@HAS_DLL_SUPPORT@ HAS_NATIVE_DYNLINK=@HAS_NATIVE_DYNLINK@ # if using ocaml >= 3.08, add a -D OCAML_308 (for camlp4) ODOC_DEF=@ODOC_DEF@ # if using ocaml >= 3.11, add a -D HAS_PRINTEXC_BACKTRACE (for camlp4) HAS_PRINTEXC_BACKTRACE=@HAS_PRINTEXC_BACKTRACE@ # where to install the binaries prefix=@prefix@ exec_prefix=@exec_prefix@ BINDIR=$(DESTDIR)@bindir@ # where to install the man page MANDIR=$(DESTDIR)@mandir@ LABLGTKDIR=@LIBDIR@/lablgtk2 INSTALLDIR=$(DESTDIR)@LIBDIR@/lablgtk2 DLLDIR=$(DESTDIR)@LIBDIR@/stublibs LABLGLDIR=@LABLGLDIR@ FLINSTALLDIR=$(DESTDIR)$(FINDLIBDIR)/lablgtk2 FILT = -Wl,--export-dynamic clean_libs = $(subst -pthread,-ldopt -pthread -ccopt -pthread,$(subst --rpath,-rpath,$(filter-out $(FILT),$(1)))) GTKCFLAGS=@OCAML_CC_EXTRA_FLAGS@ @GTKALL_CFLAGS@ GTK_LIBS = @GTK_LIBS@ GTKLIBS:=$(call clean_libs,$(GTK_LIBS)) GTKGL_LIBS = @GTKGL_LIBS@ GTKGLLIBS:=$(call clean_libs,$(GTKGL_LIBS)) GLADE_LIBS = @GLADE_LIBS@ GLADELIBS:=$(call clean_libs,$(GLADE_LIBS)) RSVG_LIBS = @RSVG_LIBS@ RSVGLIBS:=$(call clean_libs,$(RSVG_LIBS)) GNOMECANVAS_LIBS = @GNOMECANVAS_LIBS@ GNOMECANVASLIBS:=$(call clean_libs,$(GNOMECANVAS_LIBS)) GNOMEUI_LIBS = @GNOMEUI_LIBS@ GNOMEUILIBS:=$(call clean_libs,$(GNOMEUI_LIBS)) PANEL_LIBS = @PANEL_LIBS@ PANELLIBS:=$(call clean_libs,$(PANEL_LIBS)) GTKSPELL_LIBS = @GTKSPELL_LIBS@ GTKSPELLLIBS:=$(call clean_libs,$(GTKSPELL_LIBS)) GTKSOURCEVIEW_LIBS = @GTKSOURCEVIEW_LIBS@ GTKSOURCEVIEWLIBS:=$(call clean_libs,$(GTKSOURCEVIEW_LIBS)) GTKSOURCEVIEWCFLAGS= @GTKSOURCEVIEW_CFLAGS@ GTKSOURCEVIEW2_LIBS = @GTKSOURCEVIEW2_LIBS@ GTKSOURCEVIEW2LIBS:=$(call clean_libs,$(GTKSOURCEVIEW2_LIBS)) lablgtk-2.18.8/LGPL0000644000175000017500000006350413460263323012755 0ustar stephsteph GNU LESSER GENERAL PUBLIC LICENSE Version 2.1, February 1999 Copyright (C) 1991, 1999 Free Software Foundation, Inc. 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. [This is the first released version of the Lesser GPL. It also counts as the successor of the GNU Library Public License, version 2, hence the version number 2.1.] Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public Licenses are intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This license, the Lesser General Public License, applies to some specially designated software packages--typically libraries--of the Free Software Foundation and other authors who decide to use it. You can use it too, but we suggest you first think carefully about whether this license or the ordinary General Public License is the better strategy to use in any particular case, based on the explanations below. When we speak of free software, we are referring to freedom of use, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish); that you receive source code or can get it if you want it; that you can change the software and use pieces of it in new free programs; and that you are informed that you can do these things. To protect your rights, we need to make restrictions that forbid distributors to deny you these rights or to ask you to surrender these rights. These restrictions translate to certain responsibilities for you if you distribute copies of the library or if you modify it. For example, if you distribute copies of the library, whether gratis or for a fee, you must give the recipients all the rights that we gave you. You must make sure that they, too, receive or can get the source code. If you link other code with the library, you must provide complete object files to the recipients, so that they can relink them with the library after making changes to the library and recompiling it. And you must show them these terms so they know their rights. We protect your rights with a two-step method: (1) we copyright the library, and (2) we offer you this license, which gives you legal permission to copy, distribute and/or modify the library. To protect each distributor, we want to make it very clear that there is no warranty for the free library. Also, if the library is modified by someone else and passed on, the recipients should know that what they have is not the original version, so that the original author's reputation will not be affected by problems that might be introduced by others. Finally, software patents pose a constant threat to the existence of any free program. We wish to make sure that a company cannot effectively restrict the users of a free program by obtaining a restrictive license from a patent holder. Therefore, we insist that any patent license obtained for a version of the library must be consistent with the full freedom of use specified in this license. Most GNU software, including some libraries, is covered by the ordinary GNU General Public License. This license, the GNU Lesser General Public License, applies to certain designated libraries, and is quite different from the ordinary General Public License. We use this license for certain libraries in order to permit linking those libraries into non-free programs. When a program is linked with a library, whether statically or using a shared library, the combination of the two is legally speaking a combined work, a derivative of the original library. The ordinary General Public License therefore permits such linking only if the entire combination fits its criteria of freedom. The Lesser General Public License permits more lax criteria for linking other code with the library. We call this license the "Lesser" General Public License because it does Less to protect the user's freedom than the ordinary General Public License. It also provides other free software developers Less of an advantage over competing non-free programs. These disadvantages are the reason we use the ordinary General Public License for many libraries. However, the Lesser license provides advantages in certain special circumstances. For example, on rare occasions, there may be a special need to encourage the widest possible use of a certain library, so that it becomes a de-facto standard. To achieve this, non-free programs must be allowed to use the library. A more frequent case is that a free library does the same job as widely used non-free libraries. In this case, there is little to gain by limiting the free library to free software only, so we use the Lesser General Public License. In other cases, permission to use a particular library in non-free programs enables a greater number of people to use a large body of free software. For example, permission to use the GNU C Library in non-free programs enables many more people to use the whole GNU operating system, as well as its variant, the GNU/Linux operating system. Although the Lesser General Public License is Less protective of the users' freedom, it does ensure that the user of a program that is linked with the Library has the freedom and the wherewithal to run that program using a modified version of the Library. The precise terms and conditions for copying, distribution and modification follow. Pay close attention to the difference between a "work based on the library" and a "work that uses the library". The former contains code derived from the library, whereas the latter must be combined with the library in order to run. GNU LESSER GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License Agreement applies to any software library or other program which contains a notice placed by the copyright holder or other authorized party saying it may be distributed under the terms of this Lesser General Public License (also called "this License"). Each licensee is addressed as "you". A "library" means a collection of software functions and/or data prepared so as to be conveniently linked with application programs (which use some of those functions and data) to form executables. The "Library", below, refers to any such software library or work which has been distributed under these terms. A "work based on the Library" means either the Library or any derivative work under copyright law: that is to say, a work containing the Library or a portion of it, either verbatim or with modifications and/or translated straightforwardly into another language. (Hereinafter, translation is included without limitation in the term "modification".) "Source code" for a work means the preferred form of the work for making modifications to it. For a library, complete source code means all the source code for all modules it contains, plus any associated interface definition files, plus the scripts used to control compilation and installation of the library. Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running a program using the Library is not restricted, and output from such a program is covered only if its contents constitute a work based on the Library (independent of the use of the Library in a tool for writing it). Whether that is true depends on what the Library does and what the program that uses the Library does. 1. You may copy and distribute verbatim copies of the Library's complete source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and distribute a copy of this License along with the Library. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Library or any portion of it, thus forming a work based on the Library, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) The modified work must itself be a software library. b) You must cause the files modified to carry prominent notices stating that you changed the files and the date of any change. c) You must cause the whole of the work to be licensed at no charge to all third parties under the terms of this License. d) If a facility in the modified Library refers to a function or a table of data to be supplied by an application program that uses the facility, other than as an argument passed when the facility is invoked, then you must make a good faith effort to ensure that, in the event an application does not supply such function or table, the facility still operates, and performs whatever part of its purpose remains meaningful. (For example, a function in a library to compute square roots has a purpose that is entirely well-defined independent of the application. Therefore, Subsection 2d requires that any application-supplied function or table used by this function must be optional: if the application does not supply it, the square root function must still compute square roots.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Library, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Library, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Library. In addition, mere aggregation of another work not based on the Library with the Library (or with a work based on the Library) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may opt to apply the terms of the ordinary GNU General Public License instead of this License to a given copy of the Library. To do this, you must alter all the notices that refer to this License, so that they refer to the ordinary GNU General Public License, version 2, instead of to this License. (If a newer version than version 2 of the ordinary GNU General Public License has appeared, then you can specify that version instead if you wish.) Do not make any other change in these notices. Once this change is made in a given copy, it is irreversible for that copy, so the ordinary GNU General Public License applies to all subsequent copies and derivative works made from that copy. This option is useful when you wish to copy part of the code of the Library into a program that is not a library. 4. You may copy and distribute the Library (or a portion or derivative of it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange. If distribution of object code is made by offering access to copy from a designated place, then offering equivalent access to copy the source code from the same place satisfies the requirement to distribute the source code, even though third parties are not compelled to copy the source along with the object code. 5. A program that contains no derivative of any portion of the Library, but is designed to work with the Library by being compiled or linked with it, is called a "work that uses the Library". Such a work, in isolation, is not a derivative work of the Library, and therefore falls outside the scope of this License. However, linking a "work that uses the Library" with the Library creates an executable that is a derivative of the Library (because it contains portions of the Library), rather than a "work that uses the library". The executable is therefore covered by this License. Section 6 states terms for distribution of such executables. When a "work that uses the Library" uses material from a header file that is part of the Library, the object code for the work may be a derivative work of the Library even though the source code is not. Whether this is true is especially significant if the work can be linked without the Library, or if the work is itself a library. The threshold for this to be true is not precisely defined by law. If such an object file uses only numerical parameters, data structure layouts and accessors, and small macros and small inline functions (ten lines or less in length), then the use of the object file is unrestricted, regardless of whether it is legally a derivative work. (Executables containing this object code plus portions of the Library will still fall under Section 6.) Otherwise, if the work is a derivative of the Library, you may distribute the object code for the work under the terms of Section 6. Any executables containing that work also fall under Section 6, whether or not they are linked directly with the Library itself. 6. As an exception to the Sections above, you may also combine or link a "work that uses the Library" with the Library to produce a work containing portions of the Library, and distribute that work under terms of your choice, provided that the terms permit modification of the work for the customer's own use and reverse engineering for debugging such modifications. You must give prominent notice with each copy of the work that the Library is used in it and that the Library and its use are covered by this License. You must supply a copy of this License. If the work during execution displays copyright notices, you must include the copyright notice for the Library among them, as well as a reference directing the user to the copy of this License. Also, you must do one of these things: a) Accompany the work with the complete corresponding machine-readable source code for the Library including whatever changes were used in the work (which must be distributed under Sections 1 and 2 above); and, if the work is an executable linked with the Library, with the complete machine-readable "work that uses the Library", as object code and/or source code, so that the user can modify the Library and then relink to produce a modified executable containing the modified Library. (It is understood that the user who changes the contents of definitions files in the Library will not necessarily be able to recompile the application to use the modified definitions.) b) Use a suitable shared library mechanism for linking with the Library. A suitable mechanism is one that (1) uses at run time a copy of the library already present on the user's computer system, rather than copying library functions into the executable, and (2) will operate properly with a modified version of the library, if the user installs one, as long as the modified version is interface-compatible with the version that the work was made with. c) Accompany the work with a written offer, valid for at least three years, to give the same user the materials specified in Subsection 6a, above, for a charge no more than the cost of performing this distribution. d) If distribution of the work is made by offering access to copy from a designated place, offer equivalent access to copy the above specified materials from the same place. e) Verify that the user has already received a copy of these materials or that you have already sent this user a copy. For an executable, the required form of the "work that uses the Library" must include any data and utility programs needed for reproducing the executable from it. However, as a special exception, the materials to be distributed need not include anything that is normally distributed (in either source or binary form) with the major components (compiler, kernel, and so on) of the operating system on which the executable runs, unless that component itself accompanies the executable. It may happen that this requirement contradicts the license restrictions of other proprietary libraries that do not normally accompany the operating system. Such a contradiction means you cannot use both them and the Library together in an executable that you distribute. 7. You may place library facilities that are a work based on the Library side-by-side in a single library together with other library facilities not covered by this License, and distribute such a combined library, provided that the separate distribution of the work based on the Library and of the other library facilities is otherwise permitted, and provided that you do these two things: a) Accompany the combined library with a copy of the same work based on the Library, uncombined with any other library facilities. This must be distributed under the terms of the Sections above. b) Give prominent notice with the combined library of the fact that part of it is a work based on the Library, and explaining where to find the accompanying uncombined form of the same work. 8. You may not copy, modify, sublicense, link with, or distribute the Library except as expressly provided under this License. Any attempt otherwise to copy, modify, sublicense, link with, or distribute the Library is void, and will automatically terminate your rights under this License. However, parties who have received copies, or rights, from you under this License will not have their licenses terminated so long as such parties remain in full compliance. 9. You are not required to accept this License, since you have not signed it. However, nothing else grants you permission to modify or distribute the Library or its derivative works. These actions are prohibited by law if you do not accept this License. Therefore, by modifying or distributing the Library (or any work based on the Library), you indicate your acceptance of this License to do so, and all its terms and conditions for copying, distributing or modifying the Library or works based on it. 10. Each time you redistribute the Library (or any work based on the Library), the recipient automatically receives a license from the original licensor to copy, distribute, link with or modify the Library subject to these terms and conditions. You may not impose any further restrictions on the recipients' exercise of the rights granted herein. You are not responsible for enforcing compliance by third parties with this License. 11. If, as a consequence of a court judgment or allegation of patent infringement or for any other reason (not limited to patent issues), conditions are imposed on you (whether by court order, agreement or otherwise) that contradict the conditions of this License, they do not excuse you from the conditions of this License. If you cannot distribute so as to satisfy simultaneously your obligations under this License and any other pertinent obligations, then as a consequence you may not distribute the Library at all. For example, if a patent license would not permit royalty-free redistribution of the Library by all those who receive copies directly or indirectly through you, then the only way you could satisfy both it and this License would be to refrain entirely from distribution of the Library. If any portion of this section is held invalid or unenforceable under any particular circumstance, the balance of the section is intended to apply, and the section as a whole is intended to apply in other circumstances. It is not the purpose of this section to induce you to infringe any patents or other property right claims or to contest validity of any such claims; this section has the sole purpose of protecting the integrity of the free software distribution system which is implemented by public license practices. Many people have made generous contributions to the wide range of software distributed through that system in reliance on consistent application of that system; it is up to the author/donor to decide if he or she is willing to distribute software through any other system and a licensee cannot impose that choice. This section is intended to make thoroughly clear what is believed to be a consequence of the rest of this License. 12. If the distribution and/or use of the Library is restricted in certain countries either by patents or by copyrighted interfaces, the original copyright holder who places the Library under this License may add an explicit geographical distribution limitation excluding those countries, so that distribution is permitted only in or among countries not thus excluded. In such case, this License incorporates the limitation as if written in the body of this License. 13. The Free Software Foundation may publish revised and/or new versions of the Lesser General Public License from time to time. Such new versions will be similar in spirit to the present version, but may differ in detail to address new problems or concerns. Each version is given a distinguishing version number. If the Library specifies a version number of this License which applies to it and "any later version", you have the option of following the terms and conditions either of that version or of any later version published by the Free Software Foundation. If the Library does not specify a license version number, you may choose any version ever published by the Free Software Foundation. 14. If you wish to incorporate parts of the Library into other free programs whose distribution conditions are incompatible with these, write to the author to ask for permission. For software which is copyrighted by the Free Software Foundation, write to the Free Software Foundation; we sometimes make exceptions for this. Our decision will be guided by the two goals of preserving the free status of all derivatives of our free software and of promoting the sharing and reuse of software generally. NO WARRANTY 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE LIBRARY "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE LIBRARY AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE LIBRARY (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES. END OF TERMS AND CONDITIONS How to Apply These Terms to Your New Libraries If you develop a new library, and you want it to be of the greatest possible use to the public, we recommend making it free software that everyone can redistribute and change. You can do so by permitting redistribution under these terms (or, alternatively, under the terms of the ordinary General Public License). To apply these terms, attach the following notices to the library. It is safest to attach them to the start of each source file to most effectively convey the exclusion of warranty; and each file should have at least the "copyright" line and a pointer to where the full notice is found. Copyright (C) This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License as published by the Free Software Foundation; either version 2.1 of the License, or (at your option) any later version. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Also add information on how to contact you by electronic and paper mail. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the library, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the library `Frob' (a library for tweaking knobs) written by James Random Hacker. , 1 April 1990 Ty Coon, President of Vice That's all there is to it! lablgtk-2.18.8/CHANGES.API0000644000175000017500000000372613460263323013677 0ustar stephstephAPI CHANGES ----------- GPack.notebook#append_page and GPack.notebook#insert_page : return int instead of unit GAction.action_group#add_action : removed `accel' optional parameter GBin.alignment : add `padding' optional parameter GEdit.combo_box, combo_box_entry, combo_box_text, combo_box_entry_text : add `active' optional parameter GMain.Idle.add, Glib.Idle.add : add a `prio' optional argument GMain.Io.add_watch, Glib.Io.add_watch : use a list of `conditions' insted of a single one GTree.column_list : replace method `kinds' by `types' GWindow.message_dialog : add `use_markup' optional argument Glib : remove exception `Critical' and Glib.Message.handle_criticals remove Glib.Message.set_print_handler changed type of Glib.Message.set_log_handler Gobject.Data : boxed, unsafe_boxed, unsafe_boxed_option : take an additional `g_type' parameter replace `get_fundamental' by `get_type' GnoDruid : replace druid_page by druid_page_skel API ADDITIONS ------------- Glib.usleep GAssistant.* GWindow.about_dialog (set_)?wrap_licence GSourceView GButton.link_button GAction.action_skel#set_accel_group GAction.action_group#add_action_with_accel GAction.ui_manager#new_merge_id GAction.ui_manager#add_ui GBin.alignment#{set_,}{top,bottom,left,right}_padding GMisc.calendar#{set_,}{day,month,year} GMisc.calendar#is_day_marked GMisc.calendar#num_marked_dates GMisc.label_skel#selection_bounds GMisc.label_skel#select_region GPack.paned#{max_,min_,}position GText.buffer#select_range GTree.cell_layout#reorder GTree.cell_layout#{unset,set}_cell_data_func GWindow.message_dialog#set_markup GdkPixbuf.from_file_at_size GdkPixbuf.save_to_callback GdkPixbuf.save_to_buffer Glib.int_of_priority Glib.Message.log Glib.Utf8 : a bunch of unicode-related functions Glib.Markup.Error (exception) Glib : a couple of misc. utility functions (get_home_dir, find_program_in_path, etc.) GtkSignal.override_class_closure GtkSignal.chain_from_overridden GtkSpell lablgtk-2.18.8/CHANGES0000644000175000017500000014160713460263323013270 0ustar stephstephLablGTK changes log In Lablgtk-2.18.8: 2019.4.25 [Jacques] * release new version, as 2.18.7 fails on 4.08 (boxing problem) 2019.4.12 [Jacques] * remove -warn-error to allow compilation on future versions of ocaml 2019.2.15 [Jacques] * mark Gdk.PointArray.t and Gdk.SegmentArray.t as [@@ boxed] (report by Andre Maroneze) In Lablgtk-2.18.7: 2018.12.9 [Guillaume Melquiond] * Support property "expand" of GtkTreeViewColumn (available since 2.4) 2018.11.30 [Jacques] * ensure we compile on ocaml 4.05 (report by Ralf Treinen) * put examples explicitly in the public domain (report by Ralf Treinen) 2018.11.19 [Hugo Herbelin] * In GToolbox, add support for declaring dialogs transient for a parent. 2018.11.12 [Maxence] * Add some properties to GText.tag 2018.08.25 [Francois Bobot] * Add require for threads in META In Lablgtk-2.18.6: 2017.10.30 [Jacques] * prepare release * finish transition for applications subdirectory 2017.09.19 [Jacques] * prepare for 4.06: -safe-string transition and warnings In Lablgtk-2.18.5: 2016.08.10 [Jacques] * update applications/browser for 4.04 2016.08.02 [Jacques] * add CAMLparam before CAMLlocal (report by Francois Bobot) * add -fno-unwind-tables to GTKCFLAGS if the compiler allows it (suggested by Bart Jacobs) In Lablgtk-2.18.4: 2016.04.27 [Jacques] * disable camlp4 make rule when no camlp4o available * update applications * rename GC module to GMain.Gc_custom 2016.04.11 [Jacques] * Fix ml_gnome_canvas_c2w (Didier Le Botlan) 2016.03.06 [Jacques] * remove build dependency on camlp4 (still needed for tree version) * allow to change the GC speed (i.e. the impact of custom blocks) see GMain.GC.set_speed. 2016.03.04 [Jacques] * use own definition of alloc_custom, to be sure to allocate in the heap 2015.04.16 [Jacques] * fix GtkTree.TreeModel.cast 2015.02.06 [Jacques] * add get_image and get_pixbuf to GDraw.drawable. In Lablgtk-2.18.3: 2014.10.06 [Jacques] * add Gdk.Window.create_foreign and set_transient_for functions (Tim Cuthbertson) 2014.09.20 [Jacques] * CAMLparam initializes with Val_unit rather than 0 since ocaml 4.02. Fix a related problem in ml_gobject. This caused random crashes with unison (Christopher Zimmermann, PR#1425) * Also factorize some code to use Val_option_* * Replace XID by GdkNativeWindow where required. You may need to insert calls to Gdk.Window.native_of_xid in some places. In Lablgtk-2.18.2: 2014.09.17 [Jacques] * Revert old commit which broke notify signals * Quote $(FLINSTALLDIR) in Makefile (cf PR#1342) * Update applications/browser for 4.02 2014.08.22 [Jacques] * Make Float_val an alias for Double_val, since it was used wrongly anyway (Felix Ruess) * Make GObj.misc_ops#add_accelerator polymorphic in the widget of the signal (Erkki Seppala) * Use properties in GtkAdjustment, rather than direct accessors 2013.12.31 [Jacques] * fix GtkTree.IconView.get_path_at_pos (Thomas Leonard) In Lablgtk-2.18.1: 2013.12.6 [Jacques] * add gtksourceview2 to windows binaries In Lablgtk-2.18.0: 2013.10.01 [Jacques] * prepare release * update applications for 4.01 * various fixes in windows port 2013.9.17 [Jacques] * add some GTK enumerations and update stock icon list * add properties GtkTreeView.enable_{tree,grid}_lines * add properties GtkEntry.{primary,secondary}_icon_{stock,name,pixbuf}, see examples/entry2.ml for usage 2013.7.29 [Pierre-Marie] * add tags in GtkMovementStep 2013.2.19 [Jacques] * fix compatibility with ocaml 4.01 (?lab for non-optional arguments) 2012.08.26 [Pierre-Marie] * add handling of new modifiers 2012.08.26 [Jacques] * detect findlib during configuration * support DESTDIR with findlib-install 2012.08.26 [Jacques] * indicate that only old-install supports DESTDIR * have old-install copy the META file too * cleanup the two phases of findlib-install In Lablgtk-2.16.0: 2012.08.23 [Jacques] * update Windows port, compiles fine on mingw with ./configure --disable-gtktest * lablgtk2 script does not load extra libraries by default (use flag -all to load all extensions) 2012.08.17 [Jacques] * generate correct lablgtk2 script for findlib. * add old-uninstall target. * support threaded toplevel with Quartz backend, using gtkThTop.ml (runs the toplevel loop in another thread) * remove GtkThInit from META (not portable) * avoid busy waiting by using g_main_context_set_poll_func to make polling non-blocking. busy waiting is still needed for VM threads, and can be activated by setting the environment variable LABLGTK_BUSY_WAIT. 2012.08.16 [Jacques] * update applications/browser for OCaml 4.00 * update applications/camlirc to use GText instead of GBroken.text 2012.07.26 [Pierre-Marie] * improvements to GtkSourceView2. * add cast and assignation functions to GText.nocopy_iter. * add Gtk 2.10 missing key modifiers. 2012.07.24 [Jacques] * can still install using old-install. 2012.06.19 [Adrien] * add a high-level API to create keyboard shortcuts. 2012.06.12 [Adrien] * add several #as_foo methods: entry, notebook, range * new signals for notebook: select_page, reorder_tab, change_current_page, move_focus_out, page_{added,removed,reordered} * add gtk_container_child_{set,get}_property * add gtk_notebook_{set,get}_tab_reorderable * add gtk_signal_new which can be used to create custom keyboard shortcuts * add g_signal_list and g_signal_query * add functions to connect to notify::foo signals which indicate when an object property changes * add foo#connect#notify_bar methods to add callbacks on changes of the "bar" property of the object "foo". 2012.04.11 [Maxence] * use findlib to install (see README for the list of installed packages) 2012.06.05 [Jacques] * merge GtkSourceView2 additions by Pierre-Marie Pedrot 2012.03.07 [Jacques] * add Make_Val_option to wrappers.h 2011.07.20 [Jacques] * add gtk_accelerator_name/get_label (for Pierre Boutillier) * add gtk_accel_map_foreach/change_entry (ibid) * add gdk_window_clear_area (for DDR) * make gtk_tree_view_get_visible_range version dependent (Thomas Ripoche) In Lablgtk-2.14.2: 2010.09.09 [Jacques] * add GtkCurve (but it is deprecated since 2.20) 2010.08.16 [Jacques] * rename g_value_{get,set}_variant, as the name is used by recent versions of glib (reported by Florent Monnier) 2010.07.25 [Jacques] * add changed signal to cell_renderer_combo (reported by Dmitry Bely) 2010.07.23 [Jacques] * copy GtkTreePath arguments in callbacks, as reported by Benjamin. 2010.06.25 [Jacques] * remove gtkInit.cmo from gdk_pixbuf_mlsource, no need to initialize Gtk as Gobject is sufficient * protect GtkThread callbacks against exceptions, and provide a function to process messages inside a different main loop. * add -nothinit option to lablgtk2, since Quartz cannot run the main loop in a different thread (one should just call GtkThread.main). See dialog-thread.ml for an example. 2010.06.08 [Jacques] * correct interfaces due to the fixing of an unsoundness bug in ocaml 3.12 (cf. http://caml.inria.fr/mantis/view.php?id=4824) In Lablgtk-2.14.1: 2010.05.20 [Jacques] * update unison patch to 2.40.16 (for Quartz users) 2010.05.18 [Jacques] * rename gtkSignal.ml to gtkSignal.ml4 and fix depend target * move Glib.Utf8 code to gutf8.ml, so that it can be used in xml_lexer to fix a bug report by Pascal Brisset (multibyte entities of the form ● in glade files). 2010.04.08 [Jacques] * remove useless methods (discovered by ocaml 3.12) 2010.01.14 [Benjamin] * Apply patch from Mike Spivey to support get_visible range in Gtree * Fixed incorrect target labgtkspell.cmxs in Makefile 2009.10.01 [Jacques] * Correct wrong module name SourceViewEnums -> SourceView2Enums In Lablgtk-2.14.0: 2009.09.25 [Jacques] * Ensure compilation under windows 2009.09.22 [Benjamin] * Restore compatibility with pre-3.11 OCaml versions 2009.09.01 [Benjamin] * Apply patch from Mike Spivey: * Access to StyleSchemeManager objects * Some attributes are strings and not string options. This seems sensible. * Languages and style schemes are treated alike in creating buffers: both arguments are wrapped. * draw_spaces deals with a list of flags, not a single flag. * Mark categories can have priorities, icons and backgrounds * Some attributes of languages are accessed by methods instead of properties to work around a GTK bug. 2009.09.01 [Benjamin] * Support for GtkSourceView 2.6 in library "lablgtksourceview2" * Support for GtkSourceView 1.x is still available in library "lablgtksourceview" but it is no longer linked into the lablgtk2 default toplevel as it is not linkable with "lablgtksourceview2". 2009.05.21 [Jacques] * Apply Anil Madhavapeddy patch for lablgladecc2 -hide-default 2009.05.18 [Benjamin] * Make and install dynamic cmxs objects when available. * Fix compilation bug for ml_panel.c (Richard Jones message of 2009-02-06) 2009.05.12 [Jacques] * Merge new tooltip support from Moutinho's branch r1365 (sorry for 1.5y delay...) * Merge tree DND from Moutinho's branch r1387 (1y delay...) 2009.05.08 [Jacques] * Add Gdk.Windowing.platform for platform dependent applications * Fix bug in Clist.set_pixmap when no mask given 2009.04.20 [Jacques] * Print backtrace if available when exception raised in signal callback. Requires ocaml 3.11. (suggested by Bart Jacobs) * Use "val virtual obj" in generated code. Requires ocaml 3.10. 2009.03.19 [Jacques] * In GtkAboutDialog, change internal property from "name" to "program-name" if version >= 2.12. The OO interface is left unchanged, since there is no conflict with #misc#name anyway. 2009.02.09 [Benjamin] * fix linking bug for older than 2.2 Gtk with g_io_channel_read_chars 2009.01.20 [Benjamin] * change handling of non existent properties. [Not_found] is no longer raised and [Invalid_argument prop_name] is used instead. No exception is raised by unknown dynamic property setters and a GLib warning is emitted. See the comments in src/gobject.mli in the local Property module. 2009.01.13 [Benjamin] * fix compilation issues with Gtk 2.4 In Lablgtk-2.12.0: 2008.12.20 [Jacques] * fix build process for ocaml 3.11 on MSVC and mingw. 2008.12.09 [Jacques] * fix ml_gtk_source_buffer_create_marker 2008.10.30 [Benjamin] * Support Gtk Quartz backend compilation (thanks to Pascal Cuoq) 2008.10.07 [Benjamin] * Revert last change on GEdit.entry_completion according to M. Clasen. Keeping the new type for the callback match_selected. 2008.10.05 [Benjamin] * Change type of model contained in GEdit.entry_completion from model to model_filter see http://bugzilla.gnome.org/show_bug.cgi?id=555087. 2008.09.10 [Benjamin] * Many custom tree model bugs fixed. 2008.09.04 [Benjamin] * First attempt to support custom_tree_models in GTree. I need some feedback on ways to improve the safety. An example of usage is given in examples/custom_tree.ml Part of the code comes from Robert Schneck: he agreed by private mail on relicensing it for lablgtk2. 2008.08.20 [Jacques] * Move model to head of properties in ComboBox (bug reported by Pierre-Marie Pedrot) 2008.08.03 [Benjamin] * Support for wrapped signal of GEdit.spin_button (Gtk 2.10) 2008.08.01 [Benjamin] * Support for GtkRendererAccel of Gtk 2.10 2008.07.26 [Benjamin] * Add a few 2.10 properties GAction.icon_name, GButton.image_position, 2008.07.25 [Olivier] * don't use G_QUEUE_INIT (dependency on glib 2.14) 2008.07.25 [Jacques] * Add [widget] to Gtk.file_chooser * configure did not work on FreeBSD 2008.05.09 [Benjamin] * Add Glib.Io.read_chars. Other g_io_* function could be added... 2008.04.14 [Olivier] * use Gc.create_alarm to delay GObject finalization instead of an idle function 2008.03.31 [Benjamin] * Support mingw compilation with OCaml 3.11. Still tricky... 2008.03.25 [Jacques] * add GtkWindow properties * add GMain.Event * add GtkMenu.Menu.popup_at 2008.03.22 [Benjamin] * prepare gtksourceview 2.1 support In lablgtk-2.10.1: 2008.02.26 [Jacques] * fix wrong type in GContainer.mli (could not compile with 3.10.2) 2007.12.01 [Jacques] * revert to setting LC_NUMERIC to C (ocaml still uses strtod) 2007.11.28 [Jacques] * Fix Val_GType/GType_val (use Val_addr/Addr_val) 2007.10.09 [Benjamin] * add ui_manager#as_ui_manager 2007.09.27 [Jacques] * Fix examples. In lablgtk-2.10.0: 2007.09.25 [Jacques] * Various preparations for release. * Use the "Glade for Windows" distribution for win32, supporting glade and rsvg. 2007.08.17 [Jacques] * some more patch by Julien Moutinho (style and Rc). * do not set LC_NUMERIC to C (ocaml is now ok) (Volker Grabsch). * avoid some warnings in ml_gdkpixbuf and ml_glib. 2007.08.09 [Benjamin] * GtkImage : clear support 2007.08.08 [Benjamin] * Fix typo in property "wrap-license" (was "wrap-licence") of GtkAboutDialog * Add GtkFileChooser "do-confirm-overwrite" property support and "confirm-overwrite" signal * GWindow "urgency-hint" property support 2007.08.07 [Benjamin] * Add Glib.usleep * Add Stock icons for Gtk 2.10 and 2.8 * Add has_selection and cursor_position properties in GText.buffer 2007.08.06 [Benjamin] * Add support for GtkAssistant of Gtk 2.10 2007.06.18 [Jacques] * merge patches by Julien Moutinho for GdkDisplay and gtk_tree_view_get_cell_area. 2007.06.08 [Benjamin] * Add support for gtk_link_button 2007.06.07 [Benjamin] * gtksourceview support 2007.05.27 [Benjamin] * fixed bug in GWindow.about_dialog whose callbacks raised an uncaught Not_found. The default Close button now responds `CANCEL and not `CLOSE. 2006.11.19 [Olivier] * add some missing properties in GtkIconView (in module GTree) (2.6) * add some missing properties in GtkButton (2.4, 2.6) 2006.11.03 [Olivier] * move GtkSocket code from ml_gtkbin.c to ml_gtk.c since it is wrapped in GWindow. 2006.10.27 [Jacques] * add Gdk.Cursor.get_image * remove Gdk.Cursor.destroy (could be dangerous) * add new methods to GData.clipboard (partly from SooHyoung Oh) 2006.10.13 [Jacques] * add GDraw.drawable#colormap,gc,set_gc 2006.09.15 [Olivier] * wrap GtkMenuToolButton (2.6) In lablgtk2-20060908: 2006.08.08 [RobertR] * export copy_memblock_indirected and ml_lookup_flags_getter for Windows 2006.07.06 [Jacques] * make ABSVALUE=1 to use a custom mlvalues.h where value is abstract 2006.05.13 [Jacques] * delay finalization functions when they may trigger a callback 2006.02.03 [Jacques] * add GLayout#bin_window 2005.12.19 [Jacques] * lablgladecc : apply Keita Yamaguchi's patch 2005.12.02 [Benjalin] * lablgladecc : support for GtkAboutDialog 2005.11.10 [Olivier] * wrap gtk_tree_view_expand_to_path (2.2) 2005.11.03 [Benjamin] * lablgladecc : emit w#toplevel#misc#show_all instead of w#toplevel#show in check_all, because some toplevel widgets (gMenu for example) do not have a show method 2005.10.28 [Jacques] * add windows support for rsvg In lablgtk2-20051027 (2.6.0): 2005.10.25 [Jacques] * fix GtkThread.sync (Robert Schneck-McConnell) 2005.10.17 [Jacques] * new recompilation approach for Windows 2005.10.03 [Olivier] * fix refcounting of pixbufs in GdkPixbuf 2005.09.24 [Olivier] * wrap gdk_cursor_new_from_pixbuf 2005.08.25 [Olivier] * gtk_about_dialog_set_{url,email}_hook are not methods : fix the external type declaration and remove from the GWindow.about_dialog class. 2005.08.18 [Olivier] * add special sort_column_id values in GTree to select default sort function or disable sorting * add a couple of utility functions in Glib : - getenv, setenv, unsetenv (2.4) - get_user_data_dir, etc. (2.6) * change the generated code of gdk-pixbuf-mlsource a bit. In lablgtk2-20050701: 2005.06.30 [Jacques] * export same symbols under unix and windows In lablgtk2-20050613: 2005.06.13 [Jacques] * define GText.buffer_skel and GText.view_skel 2005.06.02 [Jacques] * export all macro-generated functions (robertr) * change --rpath to -rpath (better done in ocamlmklib?) 2005.05.03 [Olivier] * wrap GdkPixbuf.get_file_info (2.4) * support serialization and deserialization of GdkPixbuf.pixbuf values * add a gdk-pixbuf-mlsource tool to help compiling images into programs. 2005.03.20 [Jacques] * add Gobject.Data.wrap to create new conversions 2005.03.07 [Olivier] * add GEdit.entry#xalign property (2.4) * make configure fail if GTK+ cannot be found In lablgtk2-20050218: 2005.02.18 [Jacques] * add GObj.event_signals#scroll and other missing wevents (Hendrik Tews) 2005.02.17 [Jacques] * allow using vmthreads 2005.02.07 [Olivier] * GTree.Path.is_prev now returns bool (T. Kurt Bond) 2005.01.08 [Olivier] * add a use_markup optional argument to GEdit.combo_box_text. 2005.01.04 [Olivier] (2.6) * new stock items * add PangoEllipsizeMode for PangoLayout * new GtkLabel properties * new GtkProgressbar::ellipsize property * new GtkTreeView properties and separator rows 2005.01.02 [Olivier] * 2.6 improvements to GtkComboBox (separators and a couple of new properties) 2004.12.05 [Olivier] * add GtkFileChooserButton (2.6) 2004.12.04 [Jacques] * fix constraint in GUtil.memo 2004.12.02 [Olivier] * add GtkAboutDialog (2.6) 2004.12.02 [Jacques] * fix Michael Furr's bug reports 2004.11.24 [Olivier] * add GMisc.statusbar#has_resize_grip and #set_has_resize_grip GMisc.statusbar now inherits from GPack.box * add GtkIconView (2.6) 2004.11.22 [Olivier] * add GtkCellRendererCombo (2.6) * add GtkCellRendererProgress (2.6) In lablgtk2-20041119: 2004.11.17 [Jacques] * fix make depend * cleanup lablgtk2.in 2004.11.15 [Olivier] * add max-position and min-position in GPack.paned (2.4) * add GtkSpell interface (http://gtkspell.sf.net/) 2004.11.10 [Olivier] * add GPack.paned#position * allow multiple conditions per watch in Glib.Io.add_watch 2004.10.24 [Olivier] * add a .mli for GnoDruid, reorganize gnoDruid.ml a bit * add the single-paragraph-mode property in GtkCellRendererText 2004.10.05 [Jacques] * revise Timeout.add and Idle.add for compatibility (optional arguments must be followed by a non-labeled argument) 2004.10.02 [Jacques] * 2.2 compatibility fixes (G_STRFUNC only defined in 2.4) 2004.09.21 [Olivier] * add optional priority argument for timeouts and idle callbacks in Glib * get rid of the print handler in Glib.Message (it's not used by libraries) * get rid of the Glib.Critical exception (callbacks should never raise exceptions) * add Glib.Message.log and a couple other functions related to logging * generally prevent exceptions from escaping callbacks 2004.09.18 [Jacques] * revert to using `OTHER in Gobject.data_kind 2004.09.17 [Olivier] * more unicode fixes, add a Utf8.to_unichar_validated function 2004.09.17 [Jacques] * Gobject.Data.boxed parameterized by the real type, to be able to create tree store columns from it. Gobject.fundamental_type modified accordingly. 2004.09.15 [Olivier] * add GText.buffer#select_range 2004.09.14 [Olivier] * add a few unicode-related functions 2004.09.08 [Olivier] * add GAction.ui_manager#add_ui * have #get_widget and #get_action raise Not_found instead of Null_pointer. 2004.09.03 [Olivier] * in GAction.action_group, do not merge #add_action and #add_action_with_accel in a single method because they have different behaviour. Fixes a bug where stock items accelerators were not connected. * add the padding properties of GBin.alignment (2.4) 2004.08.27 [Olivier] * add GTree.cell_layout#reorder and GTree.cell_layout#set_cell_data_func * add a couple of utility functions in Glib * decimate ml_gtkmisc.c, add a couple of things to GtkCalendar and GtkLabel 2004.08.24 [Olivier] * add GWindow.message_dialog#set_markup (2.4) * add override of default signal handlers (GtkSignal.override_class_closure, GtkSignal.chain_from_overridden) 2004.08.23 [Olivier] * wrap some 2.4 additions in GdkPixbuf (from_file_at_size, save_to_buffer). Add some Ocamldoc comments. * add 2.4 stock items in GtkStock 2004.08.20 [Jacques] * fix GdkPixbuf.render_to_drawable * support gtk-2.0.1 * add examples/GL/texturesurf.ml with texture from pixbuf 2004.08.19 [Olivier] * add 'active' property of ComboBox as a constructor parameter. * qualify conversion tables as 'const' (so they end up in read-only pages) * add some ocamldoc comments 2004.08.11 [Olivier] * have GAction.ui_manager#add_ui_from_string raise an exception in case of error. * add Glib.Markup.Error exception. * avoid memory leaks in Glib.Convert. * remove some dead code (GtkPreview). In lablgtk2-20040716 (2.4.0): 2004.07.16 [Jacques] * add GLib.Io.remove and Glib.Io.read, works under windows too 2004.07.09 [Olivier] * Rewrite Xml_lexer so that it is more conformant. 2004.07.08 [Olivier] * fix the support of SVGZ files for older versions of librsvg where the header is not always present. 2004.07.05 [Olivier] * add ocamldoc comments for some optional parameters. * add some optional parameters to the GtkFileFilter constructor. 2004.06.28 [Olivier] * support SVGZ files in Rsvg, fix for render_from_file on Win32, fix memory leak. 2004.06.22 [Olivier] * extend GtkComboBox convenience API to GtkComboBoxEntry. 2004.06.15 [Olivier] * fix the ocamldoc generator for ocaml 3.08 * silence some GCC 3.4 warnings 2004.06.10 [Olivier] * add #event method for GtkComboBox (and descendants), and GtkFileChooserWidget 2004.06.06 [Olivier] * changed methods returning a char* or NULL in GFile: now they return string option instead of converting NULL into "". 2004.06.02 [Olivier] * add some properties for the GnomeCanvasText item, introduce a GnoCanvas.text class with getters for text height and width * relax type constraint in GUtil.memo so that it can work for non-widget gobjects * add Glib.Markup.escape_text (useful for dealing with pango markup) 2004.06.01 [Olivier] * export a couple of properties in GButton.button_skel 2004.05.09 [Olivier] * extended toolbar API (2.4) * update GtkAction* widgets to the final API 2004.04.04 [Olivier] * re-implement Gobject.Data.caml (correctly this time) 2004.03.26 [Olivier] * Add a common supertype for canvas items: GnoCanvas.base_item. * Improve the signatures of canvas, group and item classes in GnoCanvas (no more low-level Gtk.obj) 2004.03.23 [Olivier] * generic handling of GError on the C side * added exception Glib.Convert.Error In lablgtk2-20040319: 2004.03.18 [Jacques] * move GTree.tree to GBroken.tree (really broken in 2.4?) * add GBroken.text * add GContainer#all_children * add GUtil.print_widget 2004.03.17 [Olivier] * add GFile.filter#add_custom * add special methods for adding open/save button in GWindow.file_chooser_dialog 2004.03.15 [Jacques] * allow destroying pixmaps manually * update GdkPixbuf support * PangoLayout corrections (incompatible with previous snapshot) 2004.03.10 [Olivier] * update several 2.4 widgets to the latest API (ComboBox, TreeView, FileChooser). * add a convenience function GTree.store_of_list * change the type of #iter_n_children and #iter_children in GTree.model 2004.03.05 [Olivier] * gtk_dialog->action_area is a GtkHButtonBox * add gtk_button_box_{set,get}_child_secondary (2.4) * misc. additions and cleanups in GPack.box and GPack.button_box In lablgtk2-20040304: 2004.03.04 [Jacques] * fix dependencies in src/Makefile * fix #layout in GDraw.{drawable,pixmap} * fix typing problems in 3.06 and 3.07+14 2004.03.01 [Jacques] * add Pango.Layout and GDraw.drawable#layout 2004.02.29 [Olivier] * add Gobject.Data.caml to store caml values in GtkTreeModels. * add signal emitting gtk_tree_model_row_changed 2004.02.15 [Olivier] * change type of gdk_drag_status: argument is drag_action option instead of drag_action list 2004.01.27 [Jacques] * add GWindow.dialog_any (for glade) * restructure dialog code 2004.01.21 [Olivier] * GtkColorButton and GtkFontButton (2.4) 2004.01.15 [Olivier] * add gtk_tree_view_column_set_cell_data_func * log error messages if ml_gtktree callbacks raise exceptions * fix the types of some callbacks in GtkTreeSortable and GtkTreeModelFilter In lablgtk2-20040113: 2004.01.13 [Jacques] * revert to GWindow.window_skel/window * prepare snapshot 2004.01.08 [Olivier] * GtkTreeModel{Sort,Filter} fixes * added some missing GtkTreeModel methods (get_iter_first, iter_has_child, iter_n_children, flags, foreach) * in wrappers, added a function for converting a C flags value into a variant list (the reverse of the Make_Flags_val macro) 2004.01.04 [Olivier] * support for GtkEntryCompletion (2.4) 2003.12.21 [Olivier] * add event-after signal for widgets 2003.12.20 [Olivier] * make the comparison function use gtk_tree_path_compare for Gtk.tree_path values. 2003.12.19 [Olivier] * added support for GtkTreeSortable, GtkTreeModelSort and GtkTreeModelFilter (2.4) * fixes for GtkComboBox * GTree.view_column inherit from GTree.cell_layout, add a few methods to GTree.view_column 2003.12.17 [Jacques] * some additions/improvements to lablgladecc 2003.12.13 [Olivier] * More GTK 2.4 support: Action-based menus and toolbars * added GtkData.AccelGroup.parse 2003.12.10 [Olivier] * support for GTK 2.4 widgets: GtkComboBox, GtkExpander, GtkFileChooser 2003.11.30 [Olivier] * move event method of GRange.scrollbar in GRange.range (GtkScale widgets also receive events), removed GRange.scrollbar class * added event method in GTree.view, GRange.ruler 2003.10.30 [Jacques] * add GWindow.file_selection#dir_list (Francois Pessaux) * move GBin.socket to GWindow.socket (this wasn't a bin) * add GWindow.plug_signals 2003.10.28 [Olivier] * make Panel.applet inherit GContainer.bin; remove the unit arg for getters 2003.10.20 [Jacques] * add bin class for #child 2003.10.13 [Olivier] * autoconf support for lablGL location 2003.10.09 [Olivier] * wrap GtkButton label property in button_skel In lablgtk-2.2.0: 2003.10.10 [Jacques] * merge Makefile.nt into Makefile, check for msvc 2003.10.09 [Benjamin] * doc: correct GtkAjustement link to the right Gtk doc * doc: fix Makefile for doc (use of OCAML instead of CAMLC and mkdir ../doc/html) 2003.10.07 [Jacques] * add Gpointer.{peek,poke}_nativeint 2003.09.27 [Olivier] * remove `NONE response in dialogs * improved ocamldoc documentation (custom generator with links to GTK+ API reference) 2003.09.22 [Jacques] (request F.Pottier) * add window#maximize/fulscreen/stick * add GTree.row_reference and GTree.Path 2003.09.17 [Olivier] * GNOME libpanelapplet support. Now we can write panel applets in caml. 2003.09.11 [Olivier] * configure script prints a summary of the libraries that will be built. * in the output of pkg-config, filter out the options that ocamlmklib doesn't like. 2003.08.28 [Benjamin] * mnemonic support for all kind of menus. Defaults to true in factory. 2003.08.18 [Olivier] * wrap GtkNotebook::switch_page instead of change_current_page 2003.08.15 [Jacques] * split gtk.props in small pieces, to allow more generation 2003.08.06 [Olivier] * in GWindow: color_selection_dialog, file_selection and font_selection_dialog now inherit from GWindow.dialog 2003.08.05 [Olivier] * Added some libgnomeui bindings (Druids) * some new things in Gdkpixbuf : save, fill, subpixbuf, saturate_and_pixelate gdkpixbuf-specific errors 2003.07.18 [Benjamin] * New Glib.Unichar module 2003.07.17 [Benjamin] * Fix Win32 compilation 2003.07.09 [Jun Furuse] Improvements of lablgladecc: * Internal widgets are now also accessible by instance variables. The user can use simply widget names inside sub-class definitions, instead writing self#widget_name. * A flag -hide-default hides all the widget with default names come from glade, like label123. * Added check_all function to the output so that one can check all the widgets really exist. * reparent method is added to facilitate to embed one glade toplevel widget into a container. 2003.07.09 [Jacques] * ?width and ?height in GWindow back to setting size_request (default size did not work properly) * backward compatibility: GMisc.label has two exclusive parameters, ?text and ?markup (and no ?use_markup). 2003.07.07 [Benjamin] * Fixed confusion between text/label in a Label. Now GMisc.label expects ~label instead of ~text. This is consistant with the semantic of text and label properties (label may contain pango makups/text never do) In lablgtk2-20030707: 2003.07.05 [Jacques] * #misc#set_geometry renamed in #misc#set_size_request * ?width and ?height in GWindow set default size rather than size request 2003.07.02 [Jacques] * fix configure (split PKG_CHECK_MODULES for GTK and GTKALL) * fix name of gtk_gl_area_swap_buffers 2003.06.24 [Benjamin] * Fix deps in Makefile * Fix generation of an incorrect lablgtk2 when debug is enabled * Fix Gtk 2.0 compatibility 2003.06.24 [Jacques] * finish going to generation, add missing signals * wrap clipboard and cell renderers * add GMain.init to avoid "open GMain" 2003.06.23 [Jacques] * Lots of changes: generate signals and externals too. 2003.06.19 [Jacques] * Add GData.clipboard. * Properties for GtkCellRenderer. * Towards canvas properties. 2003.06.18 [Jacques] * Massive change: generate properties automatically. Probable incompatibilities: inform immediately. 2003.06.17 [Benjamin] * Fix Gtk 2.0 compatibility 2003.06.16 [Benjamin] * Fix dependencies in Makefile. Now make -j works. * Add "world" target in Makefile. 2003.06.15 [Jacques] * Starting automatic generation of code. Should reduce need to write wrappers and externals manually. 2003.06.13 [Benjamin] * Experimental g_type_register_static: not to be used at this time 2003.06.11 [Jacques] * changes in object properties (GtkBase.Tables, ...) * add check_externals utility, fix some bugs * additions in GtkWindow.ml 2003.06.10 [Jacques] * changes in object properties (gobject.ml, gtkTree.ml) 2003.06.06 [Jacques] * new #misc#get_flag to get misc widget info * font_desc handling in Pango 2003.06.04 [Jacques] * GtkDialog cleanup * add applications/osiris (just started) 2003.05.29 [Jacques] * fixed GtkTree.TreeView.Properties.model * fixed ml_gobject.{get,set}_value to assume interfaces are objects 2003.05.26 [Jun Furuse] * msvc port is done! 2003.05.24 [Jun Furuse] * added Window.get_visual 2003.05.23 [Benjamin] * fixed incorrect type of trreview#connect#row_activated 2003.05.21 [Jun Furuse] * fixed a problem of SpinButton.get_value_as_int for the case of the value is minus' src/gtkEdit.ml 2003.05.14 [Benjamin] * Glib.Convert convert_with_fallback support 2003.05.12 [Benjamin] * GtkData.AccelMap support * GtkImageMenuItem support * MenuFactory accel_map support by default * GtkStock.Item.lookup support 2003.05.01 [Maxence] * srcdoc target added to generate HTML doc in src/doc/index.html (I did not test on Windows) In lablgtk2-20030423: 2003.04.22 [Jacques] * GtkThread.thread_main automatically switches to gui thread. 2003.04.21 [Benjamin] * GRange.progress_bar updated. Old functions deprecated. 2003.04.12 [Olivier] * add GWindow.message_dialog, add methods in GWindow.dialog 2003.04.11 [Jun] * add GtkWindow.Window.resize and its C interface 2003.04.08 [Jacques] * lots of change in GtkTree*, add examples/tree_store.ml 2003.04.02 [Jacques] * finish? GtkTreeView In lablgtk2-20030326: 2003.03.20 [Olivier] * add stocks and mnemonics for buttons * add icon factories 2003.03.19 [Jacques] * more property support (phantom type like for signals) 2003.03.18 [Jacques] * lots of GtkTree* additions * small changes in ml_glibc, gObj.ml 2003.03.17 [Benjamin] * Restore Variant and stretch properties in GtkText * GTK 2.0 fixes in GtkTree 2003.03.16 [Olivier] * GnomeCanvas: avoid duplicate properties type declaration 2003.03.15 * changes in Gobject.Property and Gobject.Value.set (use set_boxed in ml_gobject.c for automatic copying) * adapt text and gnome-canvas (no need to build g_values) In lablgtk2-beta: 2003.03.14 * libgnomecanvas support [Olivier] * prepare for release, and fix makefiles [Jacques] 2003.03.13 * Add Idle support 2003.02.26 [Benjamin] * Use mnemonics by default in factories 2003.02.25 [Benjamin] * GMenu new methods * Support for mnemonic in labels. * First patch to correct alloca problem in insert_text* 2003.02.25 * copy_block_indirected allocates in old generation * disable compaction in gtkMain.ml * copy young strings to the stack when needed * free lists obtained from Gtk 2003.02.24 * replace alloc_final by alloc_custom (wrapper.h) * better gtk-2.0 support (ml_gdk.c) 2003.02.21 * Support for GTK 2.0 and librsvg 2.0 compilation (O. Andrieu) [Benjamin] In lablgtk2-20030221: 2003.02.21 * add GObj.misc_ops#set_size_chars * applications/browser only works with CVS version of ocaml * bug fixes 2003.02.20 * additions to Pango [Jacques] [Benjamin]: * added set_stock to GMisc.image * In GMisc.label_skel : added : #set_markup #set_markup_with_mnemonic #label changed : semantic of #text (returns text with markups and mnemonics) old semantic available with #label. * In GText.iter : add #language 2003.02.19 * GdkDrawable is also a GObject * split GText.iter/nocopy_iter (Benjamin) * finish split (Jacques) 2003.02.14 * Added librsvg support (contributed by Olivier Andrieu) * Ported applications/browser * GText.iter#forward/backward return self 2003.02.13 * Starting to add GtkTreeView. See tree2.ml. 2003.02.12 * API changes and bug fixes in GText (Jacques) 2003.02.11 * API changes in GText (Jacques) * Many bug fix in GText (Benjamin) In lablgtk2-20030210: 2003.02.10 * merge trunk * Add gtkgl-2.0 and libglade-2.0 support 2003.01.22 * Support for interaction between GtkTextBuffer and GtkClipboard. (Benjamin) * Support for search functions in GtkTextIter. (Benjamin) 2002.01.16 * fix memory management in ml_gdk.h * GObject and GtkObject are different! fix gtk.ml 2002.01.15 * added GtkAccelGroup and GtkClipboard support (Jacques) * suppress Gdk.Tags.selection (use Gdk.Atom.primary/secondary/clipboard) * time is 32-bit! (Benjamin) In lablgtk2-alpha: 2002.12.26 * lots of changes to adapt to gtk2 * callback handling and property support completely rewritten * many API changes * new text widget interfaced by Benjamin Monate * Gtk2 automatically calls setlocale in gtk_init, but we revert LC_NUMERIC to C immediately after In trunk: 2003.04.14 * fix Glib.IO (Henri Dubois-Ferriere) 2003.01.22 * GtkThread.main switches GtkMain.Main.main to call GtkThread.thread_main 2003.01.10 * added GList.clist#get_row_state and GWindow.file_selection#file_list (by Francois Pessaux) 2002.11.18 * added META (by Stefano Zacchiroli) * fixed applications/camlirc (Tim Freeman) 2002.10.31 * add gdk_property_* 2002.10.26 * fix GdkPixbuf.create_pixmap * add GdkEventClient (requested by Didier le Botlan) 2002.08.26 * add Gdk.Window.get_pointer_location (Tim Freeman) In lablgtk-1.2.5: 2002.08.19 * add GWindow.toplevel (Tim Freeman report) 2002.08.09 * Makefile and tictactoe patches (Tim Freeman) 2002.08.07 * add GtkThread.sync and GtkThread.async to post calls to GTK from different threads on windows (GTK/win32 is not reentrant) In lablgtk-1.2.4: 2002.07.15 * add dll support to windows port 2002.07.13 * install dlls to stublibs directory 2002.07.06 * add g_io_add_watch support in GMain.Io (requested by Maxence) 2002.07.04 * add rpm spec (Ben Martin) 2002.07.01 * add GdkPixbuf support 2002.06.20 * add all color settings in GtkData.Style/GObj.style (requested by N. Raynaud) * add GMain.Rc 2002.06.19 * add Gpointer.region, to handle bigarray/string/Raw.t in an uniform way 2002.06.18 * add Gdk.Rgb.draw_image (requested by F. Dellaert) 2002.05.30 * change typing of GtkSignal.t 2002.05.28 * move GtkData.Selection to GtkBase.Selection * add actual selection handling * add Gdk.Atom 2002.04.30 * added button#set_relief, paned#pack1/pack2/set_position, Gdk.Window.set_cursor (requested by malc) 2002.02.25 * add GtkPreview support (by Lauri Alanko) * add applications/camlirc (by Noabuaki Yoshida) 2002.01.25 * correct ml_gtk_spin_button_set_update_policy * update Makefile for gtkxmhtml In lablgtk-1.2.3: 2001.12.12 * add GToolbox utility module (contributed by Maxence Guesdon) 2001.12.10 * add Adjustment.set_bounds (Alan Schmitt) 2001.11.22 * add parameters to handle_box and color_selection (Maxence Guesdon) 2001.11.01 * adapt to ocaml 3.03a+2 dlls. In lablgtk-1.2.2: 2001.10.09 * GList.clist returns a monomorphic "string clist", use GList.clist_poly for a polymorphic clist. 2001.10.04 * add Gdk.Window.get_colormap * change APIs in Gdk.Pixmap/Bitmap and GDraw.create_pixmap* (window parameter is not strictly necessary) 2001.09.13 * improve dll-ization * add patch for unison-2.7.1 2001.09.06 * merge strict labels * attempt dll-ization In lablgtk-1.2.1: 2001.08.10 * change ?nolocale to ?setlocale, defaulting to false. Setting the locale must be required explicitly, by setting the environment variable GTK_SETLOCALE for instance * release version 1.2.1 2001.07.04 * add signals to GList.liste 2001.05.22 * add ?nolocale parameter to Main.init (cf. ocaml PR#275) * remove Main.flush (enough to have it as Gdk.X.flush) * include [main] and [quit] in GMain, so you can now write GMain.main rather than GMain.Main.main * move glade examples to examples/glade 2001.05.18 * add -trace flag to lablgladecc, to trace handler calls 2001.05.17 * add GRange.ruler * improve lablgladecc, support all widgets * add -root and -embed flags to lablgladecc 2001.05.16 * add lablgladecc, a libglade wrapper compiler 2001.04.16 * clipping patch by Michael Welsh 2001.03.13 * support GTK 1.2.3 2001.03.12 * released 1.2.0 * merged in variance annotations * added gears example by Eric Cooper In lablgtk-1.2.0: 2001.02.27 * add extractors to Gdk.Image * slight API change in GDraw.drawing#put_{image,pixmap} 2001.02.21 * add size-allocate signal 2001.02.15 * changed directory structure: sources moved to src/ * updated Makefile.nt, made Win32 port work with gtk-1.3 of 2000-12-26 * remove gutter_size in GtkPack.Paned, since it disappeared in 1.3 2001.02.13 * relax some types in Gdk.Window, to allow all drawables * support for (dangerous?) callbacks in libglade 2001.02.10 * added preliminary support for libglade 2000.12.20 * add Filesection.complete (Sven Luther's patch) 2000.12.07 * merge wakita's patch for gdk_draw_pixmap rename GDraw.drawable#image/pixmap to #put_image/put_pixma 2000.11.29 * remove unison port, since unison already works with this snapshot 2000.11.16 * internal change: switch from var2def/var2conv to varcc, and split ml_gtk.c in smaller files 2000.8.29 * bugs in color selection reported by Nicolas George * changed the license 2000.8.21 * correct GtkStyle.set_font bug reported by Patrick Doane 2000.7.27 * changed GUtil.signal and GUtil.variable for better usability * suppressed obsolete color settings in tooltips 2000.6.19 * patch by Michael Welsh for Gdk regions 2000.6.15 * add CList.set_cell_style/set_row_style * change set_usize/set_uposition into set_geometry * return an option rather than raise an exception for null pointers * map empty strings to NULL when meaningful * Gdk.Font.get_type/ascent/descent 2000.6.14 * add GDraw.optcolor for functions with a default (Jerome suggested) 2000.6.8 * apply Jerome Vouillon's patch * changes in GtkSignal and GtkArgv.ml 2000.6.7 * create #misc#connect for widget generic signals 2000.6.6 * move notebook from GMisc to GPack * #connect#event, #add_event, #misc#event, #misc#set_events_extension transferred to #event su-bobject. * #connect#drag -> #drag#connect. * #get_type, #connect#disconnect, #connect#stop_emit transferred to #misc. 2000.5.25 * split misc.ml into gaux.ml and gpointer.ml 2000.5.23 * add GMisc.notebook#get_{tab,menu}_label. Rename nth_page to get_nth_page. * modified ML signals in GUtil, to allow signals without widget. 2000.5.22 * Incompatible!: Change default for ~expand in Box.pack, Pack.build_options, Table.build_options. Now defaults to false/`NONE. This means that all options default to false/`NONE, except ~show (true for all widgets except windows) and ~fill (always true but effect controlled by ~expand). * add GtkArgv.get_nativeint and GtkArgv.set_nativeint. * make offset and length optional in GtkArgv.string_at_pointer. 2000.5.10 * rename GtkFrame to GtkBin and GFrame to GBin * move socket to GBin 2000.5.9 * add arrow and image classes to GMisc * add list and set_item_string methods to GEdit.combo * add socket and plug classes to GContainer and GWindow * two new examples: combo.ml and socket.ml 2000.4.28 * add GUtil.variable 2000.4.27 * add GtkXmHTML widget In lablgtk-1.00: 2000.4.24 * merge in changes for ocaml 3.00: label and syntax changes, autolink * added better visual and colormap handling to Gdk * GdkObj renamed to GDraw, GtkPixmap moved to GMisc * Initialize Gtk in gtkInit.cmo/cmx, start a thread in gtkInitThread.cmo. These are only included in toplevels, link them explicitely or call GMain.Main.init and GtkThread.start otherwise. * install to caml standard library * many other forgotten changes... 2000.3.02 * move locale setting inside GtkMain.init, since it requires an X display 2000.2.24 * add checks in add methods, to avoid critical errors 2000.2.23 * add dcalendar.ml (submitted by Ken Wakita) and csview.ml * correct bug in GdkObj.pixmap#line 1999.12.19 * release lablGTK beta2 1999.12.16 * upgraded unison to version 1.169 * radio groups are of type {radio_menu_item,radio_button} obj option, otherwise you could not use them several times 1999.12.13 * added GtkEdit::{insert_text,delete_text} signals * better syntax highlighting and ergonomy in the browser's shell 1999.11... * switched to Objective Caml 3 * constructors are no longer classes, but simple functions 1999.10.29 * changed GtkArgv.get_{string,pointer,object} to return option types 1999.10.27 * added radtest/CHANGES for cooperative editing on radtest 1999.10.21 * added a UI for unison (ask bcpierce@saul.cis.upenn.edu about how to get unison) 1999.10.20 * corrected CList signals * moved initialization out of the library, in gtkInit.cmo 1999.10.15 * release lablGTK beta1 1999.10.13 * improved gtkThread.ml (no timer) * modify Sys.argv in place (gtkMain.ml) * add set_row_data and get_row_data for GtkCList 1999.10.11 * bugfixes in Makefile, radtest and lv 1999.10.6 * added Gdk.X.flush and Gdk.X.beep * Gdk.X.flush is exported in GtkMain.Main 1999.9.9 * added font selection dialog 1999.8.25 * re-added connect#draw 1999.8.10 * reduced the number of methods in widget * moved disconnect and stop_emit to object_signals * moved ?:after to each signal * more functions in applications/browser 1999.8.9 * Major change: created one set_param method by parameter, rather than grouping them and using options. You can get previous versions with tag "changing_set" * corrected examples, radtest and browser for these changes * a bit of clean-up in radtest (treew.ml and Makefile) 1999.8.5 * corrected a bad bug with indirected pointers in caml heap 1999.7.15 * add GdkKeysyms for exotic keysyms 1999.7.14 * moved Truecolor inside Gdk * added COPYING * prepared for release 1999.7.12 * clean up drag-and-drop 1999.7.9 * corrected bug in Container.children * added ML signal support in GUtil 1999.7.6 * added DnD, improved radtest (Hubert) * small corrections (Jacques) 1999.7.1 * added some gdk functions related window and ximage * also added applications/lv, "labl image viewer" with the camlimage library. (JPF) 1999.7.1 * added applications/lablglade (Koji) 1999.6.28 * added applications/radtest (Hubert) 1999.6.23 * improved variant conversions for space. 1999.6.22 * updated olabl.patch. With this new version you can access fields of records without opening modules. You can also use several times the same label in one module. * examples/GL/morph3d.ml uses it. 1999.6.21 * moved event functions to GdkEvent 1999.6.20 * new example: radtest.ml (Hubert) 1999.6.18 * added GL extension 1999.6.15 * grouped set methods into set_ * added width and height option to all classes * windows not shown are automatically destroyed by the GC 1999.6.14 * added GPack.layout, GPack.packer, GPack.paned, GMisc.notebook, GRange.scale, GMisc.calendar * added 3 examples * #add_events only available on windowed widgets 1999.6.11 * added CList widget in GList module, and examples/clist.ml * improved pixmap abstraction in GdkObj / GPix 1999.6.10 * suppressed almost all raw pointers from the code. Pointers are now either boxed (second field of an abstract block) or marked (lowest bit set to 1). 1999.6.9 * added GtkBase.Object.get_id and GObj.gtkobj#get_id to get an unique identifier to gtk objects. Nice for hash-tables, etc... * GUtil.memo is such an hash-table, allowing you to recover an object's wrapper. * added a show option to all classes, commanding whether the widget should be shown immediately. It is by default true on all widgets except in module GWindow. * moved non-OO examples to examples/old. Do "cvs update -d old" to get them. * changes in Gdk/GtkData/GObj about styles. 1999.6.8 * updated olabl.patch 1999.6.7 * split gtk.ml into gtk*.ml 1999.6.5 * grouped Container focus operations in a "focus" subwidget 1999.6.4 * slightly reorganized widget grouping 1999.6.3 * disabled gtk_caller * subtle hack to have GTree get the right interface * switched completely to the new widget scheme (including examples) * added olabl.patch to apply to olabl-2.02 to compile new sources 1999.6.2 * integrated changes from Hubert in Gtk, GtkObj and testgtk.ml * added G* modules to replace GtkObj. "make lablgtk2" for it 1999.6.1 * added experimental GtkMenu for a cleaner approach to OO (Jacques) 1999.5.31 * GtkObj: list, tree and menu_shell inherit from item_container (Jacques) * Argv.get_{string,pointer,object} may raise Null_pointer (Jacques) * Support for creating new widgets (Hubert) 1999.5.28 * a few stylistic corrections * added Packer in gtk.ml 1999.5.27 * new Gtk.Main.main Gtk.Main.quit and GtkThread.main (for modal windows) * added x: and y: to Window.setter * new methods: object#get_type widget#misc#lock_accelerators widget#misc#visible widget#misc#parent container#set_focus#vadjustment container#set_focus#hadjustment (could be container#set_focus#adjustment with a dir param) window#set_modal window#set_position window#set_default_size window#set_transient_for menu#set_accel_group * new classes: handle_box_skel handle_box_signals handle_box bbox color_selection color_selection_dialog toolbar and the corresponding modules in gtk.ml new class type: is_window and method as_window * new param tearoff: in new_menu_item new param x: and y: modal: in Window.setter * Widget.event and Widget.activate return bool * new example: examples/testgtk.ml and test.xpm (Hubert) 1999.5.25 * upgraded to gtk+-1.2.3 (all examples work) * suppressed deprecated function calls and corrected examples * added a patch to use toplevel threads in olabl-2.02 1998.12.13 * upgraded to olabl-2.01 1998.12.9 * replicated Main, Timeout and Grab to GtkObj (no need to open Gtk anymore) * moved some non standard classes to GtkExt 1998.12.8 * added the first application, xxaplay, Playstation audio track player for linux. (How architecture specific!) (Furuse) 1998.12.8 * more widgets in GtkObj * refined memory management * all variants in upper case 1998.12.7 * after deeper thought, re-introduced the connect sub-object * simplified GtkObj: use simple inheritance and allow easy subtyping * updated olabl.diffs for bugs in class functions parsing and printing * add ThreadObj for concurrent object programming (Jacques) 1998.12.3 * pousse.ml is now a reversi game (idea for strategy ?) * solved startup bug (a value checker for ocaml is now available) (Jacques) 1998.12.2 * added GdkObj for high level drawing primitives (Jacques) 1998.11.30 * removed cast checking for NULL valued widgets (ml_gtk.[ch]) * module Arg is renamed as GtkArg because of the name corrision with the module Arg in the standard library * Makefile : native code compilation added (Furuse) 1998.11.29 * renamed widget_ops sub-object to misc * various improvements of set functions (Jacques) 1998.11.28 * switched to object-oriented model. GtkObj is now the standard way to access the library, but not all objects are ready (see README) * removed inheritance in gtk.ml (Jacques) 1998.11.24 * added inheritance in gtk.ml 1998.11.22 * added gtkObj.ml and examples/*_obj.ml * various modifications in gtk.ml lablgtk-2.18.8/doc/0000755000175000017500000000000013523300020013013 5ustar stephstephlablgtk-2.18.8/doc/header_apps0000644000175000017500000000244313460263323015232 0ustar stephsteph Lablgtk - Applications * You are free to do anything you want with this code as long as it is for personal use. * Redistribution can only be "as is". Binary distribution and bug fixes are allowed, but you cannot extensively modify the code without asking the authors. The authors may choose to remove any of the above restrictions on a per request basis. Authors: Jacques Garrigue Benjamin Monate Olivier Andrieu Jun Furuse Hubert Fauque Koji Kagawa lablgtk-2.18.8/doc/README0000644000175000017500000000051113460263323013706 0ustar stephsteph LablGTK documents Currently, there is no real documentation for LablGTK. For information on how to use it, please have a look at README in the main directory. Documents with extension .mgp are MagicPoint presentations. They give some ideas about how lablgtk was made. You may read them directly. $Id$lablgtk-2.18.8/doc/layers.mgp0000644000175000017500000000775313460263323015051 0ustar stephsteph%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %deffont "code" xfont "itc avant garde gothic-demi-r", tfont "verdana.ttf" %deffont "code-bold" xfont "terminal-bold-r", tfont "verdanab.ttf" %deffont "sans" xfont "helvetica-medium-r", tfont "comic.ttf" %deffont "sans-bold" xfont "helvetica-bold-r", tfont "comicbd.ttf" %deffont "sansit" xfont "helvetica-medium-i", tfont "marlett.ttf" %deffont "title" xfont "times-medium-r", tfont "times.ttf" %deffont "title-bold" xfont "times-bold-r", tfont "timesbd.ttf" %default 1 right, size 2, fore "white", bgrad %default 1 vfont "goth", font "sans-bold", vgap 100 %default 2 leftfill, size 8, vgap 60, prefix " ", font "sans" %default 3 size 4, bar "beige", vgap 10 %default 4 size 5, fore "white", vgap 20, prefix " " %tab 1 size 5, vgap 40, prefix " ", icon box "green" 50 %tab 2 size 5, vgap 40, prefix " ", icon arc "yellow" 50 %tab 3 size 5, vgap 40, prefix " ", icon arc "white" 40 %tab com1 size 4, prefix " " %tab com2 size 4, prefix " " %tab com3 size 4, prefix " " %tab txt font "sans", size 5, fore "white", prefix " " %tab vspace size 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page %nodefault %size 9, font "title-bold" %fore "beige", back "navyblue", vgap 20 %center The 3 layers of LablGTK %size 7, font "title" Jacques Garrigue Kyoto University %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 2 LablGTK An High-Level interface to the GTK+ toolkit for Objective Caml 1st layer: C stubs and support functions most the work is done at this level very careful about memory management 2nd layer: ML low level interface very little actual code provides a well-typed layer 3rd layer: ML object-oriented interface easy to use %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 3 1st layer Do all the dirty work on the C side Good support for C stubs in Caml No assumptions about C data representation Heavy use of CPP for generating stubs one line per function (about 700) Extractor functions to access structure members Variant conversion (about 80 enumerations) Signal (callback) basic support GC support: ref/deref and finalization %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 4 2nd layer Well typed interface to GTK Types and variants External declarations (about 950) Error prone: no consistency check with C Very few type errors, but some wrong function names Wrappers when needed Things hard to do on the C side Signal stubs Uses dynamic typing Thread safe Allows for interactive programming %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 5 3rd layer Stateful object-oriented layer Each GTK class mapped to a Caml class Methods restricted to useful ones The GTK class hierarchy is sometimes strange Object constructors defined as functions Heavy use of optional parameters Take full advantage of higher-order functions signal/callback, functional parameters Lack of polymorphic method (present in OLabl) There is a #coerce method to convert to the basic widget \ type %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 6 Programming example Hello World %size 2 %font "code", size 4, prefix " ", fore "yellow" open GMain let window = GWindow.window ~border_width: 10 () let button = GButton.button ~label: "Hello World" ~packing: window#add () let _ = window#connect#destroy ~callback: Main.quit; button#connect#clicked ~callback: window#destroy; window#show (); Main.main () %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 7 Status Complete implementation of GTK functions - GtkCTree + GtkGLArea, GtkXmHtml, Mozilla A large number of GDK functions Lots of examples 20+ applets experimental GUI builder Unison file synchronizer (Pierce & others) Version 1.00 available for Objective Caml see LablGTK at http://www.gtk.org/lablgtk-2.18.8/doc/header0000644000175000017500000000224513460263323014207 0ustar stephsteph Lablgtk This program is free software; you can redistribute it and/or modify it under the terms of the GNU Library General Public License as published by the Free Software Foundation version 2, with the exception described in file COPYING which comes with the library. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License for more details. You should have received a copy of the GNU Library General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA lablgtk-2.18.8/doc/header_examples0000644000175000017500000000061313460263323016102 0ustar stephsteph Lablgtk - Examples There is no specific licensing policy, but you may freely take inspiration from the code, and copy parts of it in your application. lablgtk-2.18.8/doc/formula.eps0000644000175000017500000005202513460263323015213 0ustar stephsteph%!PS-Adobe-2.0 EPSF-2.0 %%Creator: dvipsk 5.78 p1.4c Copyright 1996-99 ASCII Corp.(www-ptex@ascii.co.jp) %%dvipsk 5.78 Copyright 1998 Radical Eye Software (www.radicaleye.com) %%Title: formula.dvi %%BoundingBox: 71 318 395 524 %%DocumentFonts: Symbol Times-Italic Times-Roman Helvetica %%EndComments %DVIPSCommandLine: dvips -E -o formula.eps formula %DVIPSParameters: dpi=300, compressed %DVIPSSource: TeX output 1999.08.19:0906 %%BeginProcSet: texc.pro %! /TeXDict 300 dict def TeXDict begin /N{def}def /B{bind def}N /S{exch}N /X{S N}B /TR{translate}N /isls false N /vsize 11 72 mul N /hsize 8.5 72 mul N /landplus90{false}def /@rigin{isls{[0 landplus90{1 -1}{-1 1} ifelse 0 0 0]concat}if 72 Resolution div 72 VResolution div neg scale isls{landplus90{VResolution 72 div vsize mul 0 exch}{Resolution -72 div hsize mul 0}ifelse TR}if Resolution VResolution vsize -72 div 1 add mul TR[matrix currentmatrix{dup dup round sub abs 0.00001 lt{round}if} forall round exch round exch]setmatrix}N /@landscape{/isls true N}B /@manualfeed{statusdict /manualfeed true put}B /@copies{/#copies X}B /FMat[1 0 0 -1 0 0]N /FBB[0 0 0 0]N /nn 0 N /IE 0 N /ctr 0 N /df-tail{ /nn 8 dict N nn begin /FontType 3 N /FontMatrix fntrx N /FontBBox FBB N string /base X array /BitMaps X /BuildChar{CharBuilder}N /Encoding IE N end dup{/foo setfont}2 array copy cvx N load 0 nn put /ctr 0 N[}B /df{ /sf 1 N /fntrx FMat N df-tail}B /dfs{div /sf X /fntrx[sf 0 0 sf neg 0 0] N df-tail}B /E{pop nn dup definefont setfont}B /ch-width{ch-data dup length 5 sub get}B /ch-height{ch-data dup length 4 sub get}B /ch-xoff{ 128 ch-data dup length 3 sub get sub}B /ch-yoff{ch-data dup length 2 sub get 127 sub}B /ch-dx{ch-data dup length 1 sub get}B /ch-image{ch-data dup type /stringtype ne{ctr get /ctr ctr 1 add N}if}B /id 0 N /rw 0 N /rc 0 N /gp 0 N /cp 0 N /G 0 N /sf 0 N /CharBuilder{save 3 1 roll S dup /base get 2 index get S /BitMaps get S get /ch-data X pop /ctr 0 N ch-dx 0 ch-xoff ch-yoff ch-height sub ch-xoff ch-width add ch-yoff setcachedevice ch-width ch-height true[1 0 0 -1 -.1 ch-xoff sub ch-yoff .1 sub]/id ch-image N /rw ch-width 7 add 8 idiv string N /rc 0 N /gp 0 N /cp 0 N{rc 0 ne{rc 1 sub /rc X rw}{G}ifelse}imagemask restore}B /G{{id gp get /gp gp 1 add N dup 18 mod S 18 idiv pl S get exec}loop}B /adv{cp add /cp X}B /chg{rw cp id gp 4 index getinterval putinterval dup gp add /gp X adv}B /nd{/cp 0 N rw exit}B /lsh{rw cp 2 copy get dup 0 eq{pop 1}{ dup 255 eq{pop 254}{dup dup add 255 and S 1 and or}ifelse}ifelse put 1 adv}B /rsh{rw cp 2 copy get dup 0 eq{pop 128}{dup 255 eq{pop 127}{dup 2 idiv S 128 and or}ifelse}ifelse put 1 adv}B /clr{rw cp 2 index string putinterval adv}B /set{rw cp fillstr 0 4 index getinterval putinterval adv}B /fillstr 18 string 0 1 17{2 copy 255 put pop}for N /pl[{adv 1 chg} {adv 1 chg nd}{1 add chg}{1 add chg nd}{adv lsh}{adv lsh nd}{adv rsh}{ adv rsh nd}{1 add adv}{/rc X nd}{1 add set}{1 add clr}{adv 2 chg}{adv 2 chg nd}{pop nd}]dup{bind pop}forall N /D{/cc X dup type /stringtype ne{] }if nn /base get cc ctr put nn /BitMaps get S ctr S sf 1 ne{dup dup length 1 sub dup 2 index S get sf div put}if put /ctr ctr 1 add N}B /I{ cc 1 add D}B /bop{userdict /bop-hook known{bop-hook}if /SI save N @rigin 0 0 moveto /V matrix currentmatrix dup 1 get dup mul exch 0 get dup mul add .99 lt{/QV}{/RV}ifelse load def pop pop}N /eop{SI restore userdict /eop-hook known{eop-hook}if showpage}N /@start{userdict /start-hook known{start-hook}if pop /VResolution X /Resolution X 1000 div /DVImag X /IE 256 array N 2 string 0 1 255{IE S dup 360 add 36 4 index cvrs cvn put}for pop 65781.76 div /vsize X 65781.76 div /hsize X}N /dir 0 def /dyy{/dir 0 def}B /dyt{/dir 1 def}B /dty{/dir 2 def}B /dtt{/dir 3 def}B /p{dir 2 eq{-90 rotate show 90 rotate}{dir 3 eq{-90 rotate show 90 rotate}{show}ifelse}ifelse}B /RMat[1 0 0 -1 0 0]N /BDot 260 string N /rulex 0 N /ruley 0 N /v{/ruley X /rulex X V}B /V{}B /RV statusdict begin /product where{pop false[(Display)(NeXT)(LaserWriter 16/600)]{dup length product length le{dup length product exch 0 exch getinterval eq{ pop true exit}if}{pop}ifelse}forall}{false}ifelse end{{gsave TR -.1 .1 TR 1 1 scale rulex ruley false RMat{BDot}imagemask grestore}}{{gsave TR -.1 .1 TR rulex ruley scale 1 1 false RMat{BDot}imagemask grestore}} ifelse B /QV{gsave newpath transform round exch round exch itransform moveto rulex 0 rlineto 0 ruley neg rlineto rulex neg 0 rlineto fill grestore}B /a{moveto}B /delta 0 N /tail{dup /delta X 0 rmoveto}B /M{S p delta add tail}B /b{S p tail}B /c{-4 M}B /d{-3 M}B /e{-2 M}B /f{-1 M}B /g{0 M}B /h{1 M}B /i{2 M}B /j{3 M}B /k{4 M}B /w{0 rmoveto}B /l{p -4 w}B /m{p -3 w}B /n{p -2 w}B /o{p -1 w}B /q{p 1 w}B /r{p 2 w}B /s{p 3 w}B /t{ p 4 w}B /x{0 S rmoveto}B /y{3 2 roll p a}B /bos{/SS save N}B /eos{SS restore}B end %%EndProcSet %%BeginProcSet: 8r.enc % @@psencodingfile@{ % author = "S. Rahtz, P. MacKay, Alan Jeffrey, B. Horn, K. Berry", % version = "0.6", % date = "22 June 1996", % filename = "8r.enc", % email = "kb@@mail.tug.org", % address = "135 Center Hill Rd. // Plymouth, MA 02360", % codetable = "ISO/ASCII", % checksum = "119 662 4424", % docstring = "Encoding for TrueType or Type 1 fonts to be used with TeX." % @} % % Idea is to have all the characters normally included in Type 1 fonts % available for typesetting. This is effectively the characters in Adobe % Standard Encoding + ISO Latin 1 + extra characters from Lucida. % % Character code assignments were made as follows: % % (1) the Windows ANSI characters are almost all in their Windows ANSI % positions, because some Windows users cannot easily reencode the % fonts, and it makes no difference on other systems. The only Windows % ANSI characters not available are those that make no sense for % typesetting -- rubout (127 decimal), nobreakspace (160), softhyphen % (173). quotesingle and grave are moved just because it's such an % irritation not having them in TeX positions. % % (2) Remaining characters are assigned arbitrarily to the lower part % of the range, avoiding 0, 10 and 13 in case we meet dumb software. % % (3) Y&Y Lucida Bright includes some extra text characters; in the % hopes that other PostScript fonts, perhaps created for public % consumption, will include them, they are included starting at 0x12. % % (4) Remaining positions left undefined are for use in (hopefully) % upward-compatible revisions, if someday more characters are generally % available. % % (5) hyphen appears twice for compatibility with both ASCII and Windows. % /TeXBase1Encoding [ % 0x00 (encoded characters from Adobe Standard not in Windows 3.1) /.notdef /dotaccent /fi /fl /fraction /hungarumlaut /Lslash /lslash /ogonek /ring /.notdef /breve /minus /.notdef % These are the only two remaining unencoded characters, so may as % well include them. /Zcaron /zcaron % 0x10 /caron /dotlessi % (unusual TeX characters available in, e.g., Lucida Bright) /dotlessj /ff /ffi /ffl /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef % very contentious; it's so painful not having quoteleft and quoteright % at 96 and 145 that we move the things normally found there down to here. /grave /quotesingle % 0x20 (ASCII begins) /space /exclam /quotedbl /numbersign /dollar /percent /ampersand /quoteright /parenleft /parenright /asterisk /plus /comma /hyphen /period /slash % 0x30 /zero /one /two /three /four /five /six /seven /eight /nine /colon /semicolon /less /equal /greater /question % 0x40 /at /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O % 0x50 /P /Q /R /S /T /U /V /W /X /Y /Z /bracketleft /backslash /bracketright /asciicircum /underscore % 0x60 /quoteleft /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o % 0x70 /p /q /r /s /t /u /v /w /x /y /z /braceleft /bar /braceright /asciitilde /.notdef % rubout; ASCII ends % 0x80 /.notdef /.notdef /quotesinglbase /florin /quotedblbase /ellipsis /dagger /daggerdbl /circumflex /perthousand /Scaron /guilsinglleft /OE /.notdef /.notdef /.notdef % 0x90 /.notdef /.notdef /.notdef /quotedblleft /quotedblright /bullet /endash /emdash /tilde /trademark /scaron /guilsinglright /oe /.notdef /.notdef /Ydieresis % 0xA0 /.notdef % nobreakspace /exclamdown /cent /sterling /currency /yen /brokenbar /section /dieresis /copyright /ordfeminine /guillemotleft /logicalnot /hyphen % Y&Y (also at 45); Windows' softhyphen /registered /macron % 0xD0 /degree /plusminus /twosuperior /threesuperior /acute /mu /paragraph /periodcentered /cedilla /onesuperior /ordmasculine /guillemotright /onequarter /onehalf /threequarters /questiondown % 0xC0 /Agrave /Aacute /Acircumflex /Atilde /Adieresis /Aring /AE /Ccedilla /Egrave /Eacute /Ecircumflex /Edieresis /Igrave /Iacute /Icircumflex /Idieresis % 0xD0 /Eth /Ntilde /Ograve /Oacute /Ocircumflex /Otilde /Odieresis /multiply /Oslash /Ugrave /Uacute /Ucircumflex /Udieresis /Yacute /Thorn /germandbls % 0xE0 /agrave /aacute /acircumflex /atilde /adieresis /aring /ae /ccedilla /egrave /eacute /ecircumflex /edieresis /igrave /iacute /icircumflex /idieresis % 0xF0 /eth /ntilde /ograve /oacute /ocircumflex /otilde /odieresis /divide /oslash /ugrave /uacute /ucircumflex /udieresis /yacute /thorn /ydieresis ] def %%EndProcSet %%BeginProcSet: texps.pro %! TeXDict begin /rf{findfont dup length 1 add dict begin{1 index /FID ne 2 index /UniqueID ne and{def}{pop pop}ifelse}forall[1 index 0 6 -1 roll exec 0 exch 5 -1 roll VResolution Resolution div mul neg 0 0]/Metrics exch def dict begin 0 1 255{exch dup type /integertype ne{pop pop 1 sub dup 0 le{pop}{[}ifelse}{FontMatrix 0 get div Metrics 0 get div def} ifelse}for Metrics /Metrics currentdict end def[2 index currentdict end definefont 3 -1 roll makefont /setfont cvx]cvx def}def /ObliqueSlant{ dup sin S cos div neg}B /SlantFont{4 index mul add}def /ExtendFont{3 -1 roll mul exch}def /ReEncodeFont{/Encoding exch def}def end %%EndProcSet %%BeginProcSet: special.pro %! TeXDict begin /SDict 200 dict N SDict begin /@SpecialDefaults{/hs 612 N /vs 792 N /ho 0 N /vo 0 N /hsc 1 N /vsc 1 N /ang 0 N /CLIP 0 N /rwiSeen false N /rhiSeen false N /letter{}N /note{}N /a4{}N /legal{}N}B /@scaleunit 100 N /@hscale{@scaleunit div /hsc X}B /@vscale{@scaleunit div /vsc X}B /@hsize{/hs X /CLIP 1 N}B /@vsize{/vs X /CLIP 1 N}B /@clip{ /CLIP 2 N}B /@hoffset{/ho X}B /@voffset{/vo X}B /@angle{/ang X}B /@rwi{ 10 div /rwi X /rwiSeen true N}B /@rhi{10 div /rhi X /rhiSeen true N}B /@llx{/llx X}B /@lly{/lly X}B /@urx{/urx X}B /@ury{/ury X}B /magscale true def end /@MacSetUp{userdict /md known{userdict /md get type /dicttype eq{userdict begin md length 10 add md maxlength ge{/md md dup length 20 add dict copy def}if end md begin /letter{}N /note{}N /legal{} N /od{txpose 1 0 mtx defaultmatrix dtransform S atan/pa X newpath clippath mark{transform{itransform moveto}}{transform{itransform lineto} }{6 -2 roll transform 6 -2 roll transform 6 -2 roll transform{ itransform 6 2 roll itransform 6 2 roll itransform 6 2 roll curveto}}{{ closepath}}pathforall newpath counttomark array astore /gc xdf pop ct 39 0 put 10 fz 0 fs 2 F/|______Courier fnt invertflag{PaintBlack}if}N /txpose{pxs pys scale ppr aload pop por{noflips{pop S neg S TR pop 1 -1 scale}if xflip yflip and{pop S neg S TR 180 rotate 1 -1 scale ppr 3 get ppr 1 get neg sub neg ppr 2 get ppr 0 get neg sub neg TR}if xflip yflip not and{pop S neg S TR pop 180 rotate ppr 3 get ppr 1 get neg sub neg 0 TR}if yflip xflip not and{ppr 1 get neg ppr 0 get neg TR}if}{noflips{TR pop pop 270 rotate 1 -1 scale}if xflip yflip and{TR pop pop 90 rotate 1 -1 scale ppr 3 get ppr 1 get neg sub neg ppr 2 get ppr 0 get neg sub neg TR}if xflip yflip not and{TR pop pop 90 rotate ppr 3 get ppr 1 get neg sub neg 0 TR}if yflip xflip not and{TR pop pop 270 rotate ppr 2 get ppr 0 get neg sub neg 0 S TR}if}ifelse scaleby96{ppr aload pop 4 -1 roll add 2 div 3 1 roll add 2 div 2 copy TR .96 dup scale neg S neg S TR}if}N /cp {pop pop showpage pm restore}N end}if}if}N /normalscale{Resolution 72 div VResolution 72 div neg scale magscale{DVImag dup scale}if 0 setgray} N /psfts{S 65781.76 div N}N /startTexFig{/psf$SavedState save N userdict maxlength dict begin /magscale true def normalscale currentpoint TR /psf$ury psfts /psf$urx psfts /psf$lly psfts /psf$llx psfts /psf$y psfts /psf$x psfts currentpoint /psf$cy X /psf$cx X /psf$sx psf$x psf$urx psf$llx sub div N /psf$sy psf$y psf$ury psf$lly sub div N psf$sx psf$sy scale psf$cx psf$sx div psf$llx sub psf$cy psf$sy div psf$ury sub TR /showpage{}N /erasepage{}N /copypage{}N /p 3 def @MacSetUp}N /doclip{ psf$llx psf$lly psf$urx psf$ury currentpoint 6 2 roll newpath 4 copy 4 2 roll moveto 6 -1 roll S lineto S lineto S lineto closepath clip newpath moveto}N /endTexFig{end psf$SavedState restore}N /@beginspecial{SDict begin /SpecialSave save N gsave normalscale currentpoint TR @SpecialDefaults count /ocount X /dcount countdictstack N}N /@setspecial {CLIP 1 eq{newpath 0 0 moveto hs 0 rlineto 0 vs rlineto hs neg 0 rlineto closepath clip}if ho vo TR hsc vsc scale ang rotate rwiSeen{rwi urx llx sub div rhiSeen{rhi ury lly sub div}{dup}ifelse scale llx neg lly neg TR }{rhiSeen{rhi ury lly sub div dup scale llx neg lly neg TR}if}ifelse CLIP 2 eq{newpath llx lly moveto urx lly lineto urx ury lineto llx ury lineto closepath clip}if /showpage{}N /erasepage{}N /copypage{}N newpath }N /@endspecial{count ocount sub{pop}repeat countdictstack dcount sub{ end}repeat grestore SpecialSave restore end}N /@defspecial{SDict begin} N /@fedspecial{end}B /li{lineto}B /rl{rlineto}B /rc{rcurveto}B /np{ /SaveX currentpoint /SaveY X N 1 setlinecap newpath}N /st{stroke SaveX SaveY moveto}N /fil{fill SaveX SaveY moveto}N /ellipse{/endangle X /startangle X /yrad X /xrad X /savematrix matrix currentmatrix N TR xrad yrad scale 0 0 1 startangle endangle arc savematrix setmatrix}N end %%EndProcSet %%BeginProcSet: color.pro %! TeXDict begin /setcmykcolor where{pop}{/setcmykcolor{dup 10 eq{pop setrgbcolor}{1 sub 4 1 roll 3{3 index add neg dup 0 lt{pop 0}if 3 1 roll }repeat setrgbcolor pop}ifelse}B}ifelse /TeXcolorcmyk{setcmykcolor}def /TeXcolorrgb{setrgbcolor}def /TeXcolorgrey{setgray}def /TeXcolorgray{ setgray}def /TeXcolorhsb{sethsbcolor}def /currentcmykcolor where{pop}{ /currentcmykcolor{currentrgbcolor 10}B}ifelse /DC{exch dup userdict exch known{pop pop}{X}ifelse}B /GreenYellow{0.15 0 0.69 0 setcmykcolor}DC /Yellow{0 0 1 0 setcmykcolor}DC /Goldenrod{0 0.10 0.84 0 setcmykcolor} DC /Dandelion{0 0.29 0.84 0 setcmykcolor}DC /Apricot{0 0.32 0.52 0 setcmykcolor}DC /Peach{0 0.50 0.70 0 setcmykcolor}DC /Melon{0 0.46 0.50 0 setcmykcolor}DC /YellowOrange{0 0.42 1 0 setcmykcolor}DC /Orange{0 0.61 0.87 0 setcmykcolor}DC /BurntOrange{0 0.51 1 0 setcmykcolor}DC /Bittersweet{0 0.75 1 0.24 setcmykcolor}DC /RedOrange{0 0.77 0.87 0 setcmykcolor}DC /Mahogany{0 0.85 0.87 0.35 setcmykcolor}DC /Maroon{0 0.87 0.68 0.32 setcmykcolor}DC /BrickRed{0 0.89 0.94 0.28 setcmykcolor} DC /Red{0 1 1 0 setcmykcolor}DC /OrangeRed{0 1 0.50 0 setcmykcolor}DC /RubineRed{0 1 0.13 0 setcmykcolor}DC /WildStrawberry{0 0.96 0.39 0 setcmykcolor}DC /Salmon{0 0.53 0.38 0 setcmykcolor}DC /CarnationPink{0 0.63 0 0 setcmykcolor}DC /Magenta{0 1 0 0 setcmykcolor}DC /VioletRed{0 0.81 0 0 setcmykcolor}DC /Rhodamine{0 0.82 0 0 setcmykcolor}DC /Mulberry {0.34 0.90 0 0.02 setcmykcolor}DC /RedViolet{0.07 0.90 0 0.34 setcmykcolor}DC /Fuchsia{0.47 0.91 0 0.08 setcmykcolor}DC /Lavender{0 0.48 0 0 setcmykcolor}DC /Thistle{0.12 0.59 0 0 setcmykcolor}DC /Orchid{ 0.32 0.64 0 0 setcmykcolor}DC /DarkOrchid{0.40 0.80 0.20 0 setcmykcolor} DC /Purple{0.45 0.86 0 0 setcmykcolor}DC /Plum{0.50 1 0 0 setcmykcolor} DC /Violet{0.79 0.88 0 0 setcmykcolor}DC /RoyalPurple{0.75 0.90 0 0 setcmykcolor}DC /BlueViolet{0.86 0.91 0 0.04 setcmykcolor}DC /Periwinkle {0.57 0.55 0 0 setcmykcolor}DC /CadetBlue{0.62 0.57 0.23 0 setcmykcolor} DC /CornflowerBlue{0.65 0.13 0 0 setcmykcolor}DC /MidnightBlue{0.98 0.13 0 0.43 setcmykcolor}DC /NavyBlue{0.94 0.54 0 0 setcmykcolor}DC /RoyalBlue{1 0.50 0 0 setcmykcolor}DC /Blue{1 1 0 0 setcmykcolor}DC /Cerulean{0.94 0.11 0 0 setcmykcolor}DC /Cyan{1 0 0 0 setcmykcolor}DC /ProcessBlue{0.96 0 0 0 setcmykcolor}DC /SkyBlue{0.62 0 0.12 0 setcmykcolor}DC /Turquoise{0.85 0 0.20 0 setcmykcolor}DC /TealBlue{0.86 0 0.34 0.02 setcmykcolor}DC /Aquamarine{0.82 0 0.30 0 setcmykcolor}DC /BlueGreen{0.85 0 0.33 0 setcmykcolor}DC /Emerald{1 0 0.50 0 setcmykcolor}DC /JungleGreen{0.99 0 0.52 0 setcmykcolor}DC /SeaGreen{ 0.69 0 0.50 0 setcmykcolor}DC /Green{1 0 1 0 setcmykcolor}DC /ForestGreen{0.91 0 0.88 0.12 setcmykcolor}DC /PineGreen{0.92 0 0.59 0.25 setcmykcolor}DC /LimeGreen{0.50 0 1 0 setcmykcolor}DC /YellowGreen{ 0.44 0 0.74 0 setcmykcolor}DC /SpringGreen{0.26 0 0.76 0 setcmykcolor} DC /OliveGreen{0.64 0 0.95 0.40 setcmykcolor}DC /RawSienna{0 0.72 1 0.45 setcmykcolor}DC /Sepia{0 0.83 1 0.70 setcmykcolor}DC /Brown{0 0.81 1 0.60 setcmykcolor}DC /Tan{0.14 0.42 0.56 0 setcmykcolor}DC /Gray{0 0 0 0.50 setcmykcolor}DC /Black{0 0 0 1 setcmykcolor}DC /White{0 0 0 0 setcmykcolor}DC end %%EndProcSet TeXDict begin 40258437 52099154 1000 300 300 (formula.dvi) @start /Fa 134[ 41 5[ 41 3[ 46 46 1[ 18 6[ 46 15[ 60 4[ 55 14[ 55 23[ 28 28 40[{ TeXBase1Encoding ReEncodeFont } 11 82.6359 /Helvetica rf /Fb 205[ 34 34 49[{ TeXBase1Encoding ReEncodeFont } 2 68.8667 /Times-Roman rf /Fc 154[ 30 101[{ } 1 68.8667 /Symbol rf %DVIPSBitmapFont: Fd cmr10 19.907 4 /Fd 4 94 df<146014E0EB01C0EB0380EB0700130E5B133C13385B13F05B1201485AA248 5AA348C7FCA25A121EA2123EA2123CA2127CA5127812F8B01278127CA5123CA2123EA212 1EA2121F7EA26C7EA36C7EA26C7E12007F13707F133C131C7F7FEB0380EB01C0EB00E014 60135278BD20> 40 D<7E7E7E12707E7E7E120F7E6C7E7F12017F6C7EA21378A37FA213 3E131EA2131FA27FA21480A5130714C0B01480130FA51400A25BA2131EA2133E133CA25B A35BA2485A5B12035B48C7FC5A120E5A5A5A5A5A5A12527BBD20> I 91 D 93 D E %EndDVIPSBitmapFont /Fe 197[ 23 58[{ TeXBase1Encoding ReEncodeFont } 1 82.6359 /Times-Roman rf %DVIPSBitmapFont: Ff cmsy10 19.907 4 /Ff 4 106 df<0060161800F0163CA26C167C00781678007C16F8003C16F0A2003E1501 001E16E0A2001F15036C16C06D140700071680A26D140F000316006D5C6CB612FEA36C5D 01F8C7127C01781478A2017C14F8013C5CA2013E1301011E5C011F13036D5CA2EC800701 075CECC00F010391C7FCA26E5A0101131EECF03E0100133CA2ECF87CEC7878A2EC7CF8EC 3CF0143F6E5AA36E5AA26E5AA26EC8FC2E3A80B82F> 56 D<126012F0B3A7B8FC1780A3 00F0CAFCB3A8126029397CB832> 96 D<14C0EB01E0A2130314C013071480A2130F1400 A25B131E133E133CA2137C137813F85BA212015BA212035B12075BA2120F90C7FC5A121E A2123E123CA2127C127812F85AA27E1278127C123CA2123E121EA2121F7E7F1207A27F12 037F1201A27F1200A27F1378137C133CA2133E131E131F7FA214801307A214C0130314E0 1301A2EB00C0135278BD20> 104 D<126012F0A27E1278127C123CA2123E121EA2121F7E 7F1207A27F12037F1201A27F1200A27F1378137C133CA2133E131E131F7FA214801307A2 14C0130314E01301A2130314C013071480A2130F1400A25B131E133E133CA2137C137813 F85BA212015BA212035B12075BA2120F90C7FC5A121EA2123E123CA2127C127812F85AA2 126013527CBD20> I E %EndDVIPSBitmapFont %DVIPSBitmapFont: Fg cmmi10 19.907 1 /Fg 1 59 df<121C123E127FEAFF80A3EA7F00123E121C0909798817> 58 D E %EndDVIPSBitmapFont /Fh 158[ 41 31[ 50 65[{ TeXBase1Encoding ReEncodeFont } 2 82.6359 /Times-Italic rf /Fi 139[ 36 50 13[ 36 101[{ } 3 82.6359 /Symbol rf end %%EndProlog %%BeginSetup %%Feature: *Resolution 300dpi TeXDict begin %%EndSetup 0 0 bop Black Black 0 0.7 0 TeXcolorrgb Fh 567 883 a(A) p Ff 636 883 a(`) p Fh 705 883 a(a) p Fe 765 883 a(:) p 0 0 1 TeXcolorrgb Fi 806 883 a(t) p Fb 842 900 a(1) p 0 0.7 0 TeXcolorrgb Fd 948 883 a(\() p 0 0 1 TeXcolorrgb Fi(t) p Fb 1016 900 a(1) p 0 0.7 0 TeXcolorrgb Fe 1071 883 a(:) p 0 0 1 TeXcolorrgb Fi 1112 883 a(t) p 0 0.7 0 TeXcolorrgb Fe 1167 883 a(:) p 0 0 1 TeXcolorrgb Fi 1208 883 a(t) p Fb 1244 900 a(2) p 0 0.7 0 TeXcolorrgb Fd 1281 883 a(\)) p 567 920 746 4 v Fh 704 995 a(A) p Ff 773 995 a(`) p Fd 842 995 a(\() p Fh(a) p Fe 934 995 a(:) p 0 0 1 TeXcolorrgb Fi 975 995 a(t) p 0 0.7 0 TeXcolorrgb Fd(\)) p Fe 1062 995 a(:) p 0 0 1 TeXcolorrgb Fi 1103 995 a(t) p Fb 1139 1012 a(2) p 0 0.7 0 TeXcolorrgb Black Fa 2 939 a(\(Ann\)) p 0 0.7 0 TeXcolorrgb Black 0 0.7 0 TeXcolorrgb Fh 540 1208 a(A) p Ff 609 1208 a(`) p Fh 678 1208 a(a) p Fe 738 1208 a(:) p 0 0 1 TeXcolorrgb Fi 779 1208 a(s) p Fb 829 1225 a(1) p 0 0.7 0 TeXcolorrgb Fd 934 1208 a(\() p 0 0 1 TeXcolorrgb Fi(s) p Fb 1016 1225 a(1) p 0 0.7 0 TeXcolorrgb Fe 1071 1208 a(:) p 0 0 1 TeXcolorrgb Fi 1112 1208 a(s) p 0 0.7 0 TeXcolorrgb Fe 1180 1208 a(:) p 0 0 1 TeXcolorrgb Fi 1222 1208 a(s) p Fb 1272 1225 a(2) p 0 0.7 0 TeXcolorrgb Fd 1308 1208 a(\)) p 540 1245 801 4 v Fh 661 1321 a(A) p Ff 730 1321 a(`) p Fd 799 1321 a([) p Fh(a) p Fe 881 1321 a(:) p 0 0 1 TeXcolorrgb Fi 923 1321 a(s) p 0 0.7 0 TeXcolorrgb Fd 972 1321 a(]) p Fe 1014 1321 a(:) p 0 0 1 TeXcolorrgb Fd 1055 1321 a([) p Fi(s) p Fb 1128 1338 a(2) p Fd 1164 1321 a(]) p Fc 1187 1297 a(e) p 0 0.7 0 TeXcolorrgb Black Fa 2 1264 a(\(P) l(oly\)) p 0 0.7 0 TeXcolorrgb Black 0 0.7 0 TeXcolorrgb Fh 704 1537 a(A) p Ff 773 1537 a(`) p Fh 842 1537 a(a) p Fe 902 1537 a(:) p 0 0 1 TeXcolorrgb Ff 943 1537 a(8) p Fi(e) p Fg(:) p Fd([) p Fi(s) p Fd(]) p Fc 1145 1507 a(e) p 0 0.7 0 TeXcolorrgb 704 1573 472 4 v Fh 764 1649 a(A) p Ff 833 1649 a(`) p 902 1649 a(h) p Fh(a) p Ff(i) p Fe 1025 1649 a(:) p 0 0 1 TeXcolorrgb Fi 1067 1649 a(s) p 0 0.7 0 TeXcolorrgb Black Fa 2 1592 a(\(Use\)) p 0 0.7 0 TeXcolorrgb Black Black Black 90 rotate dyy eop %%Trailer end userdict /end-hook known{end-hook}if %%EOF lablgtk-2.18.8/doc/lablgtk.mgp0000644000175000017500000003061313460263323015161 0ustar stephsteph%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %deffont "code" xfont "itc avant garde gothic-demi-r", tfont "verdana.ttf" %deffont "code-bold" xfont "terminal-bold-r", tfont "verdanab.ttf" %deffont "sans" xfont "helvetica-medium-r", tfont "comic.ttf" %deffont "sans-bold" xfont "helvetica-bold-r", tfont "comicbd.ttf" %deffont "sansit" xfont "helvetica-medium-i", tfont "marlett.ttf" %deffont "title" xfont "times-medium-r", tfont "times.ttf" %deffont "title-bold" xfont "times-bold-r", tfont "timesbd.ttf" %default 1 right, size 2, fore "white", bgrad %default 1 vfont "goth", font "sans-bold", vgap 100 %default 2 leftfill, size 8, vgap 60, prefix " ", font "sans" %default 3 size 4, bar "beige", vgap 10 %default 4 size 5, fore "white", vgap 20, prefix " " %tab 1 size 5, vgap 40, prefix " ", icon box "green" 50 %tab 2 size 5, vgap 40, prefix " ", icon arc "yellow" 50 %tab 3 size 5, vgap 40, prefix " ", icon arc "white" 40 %tab com1 size 4, prefix " " %tab com2 size 4, prefix " " %tab com3 size 4, prefix " " %tab txt font "sans", size 5, fore "white", prefix " " %tab vspace size 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page %nodefault %size 9, font "title-bold" %fore "beige", back "navyblue", vgap 20 %center A Type System in Action: the LablGTK Interface %size 7, font "title" Jacques Garrigue Kyoto University %size 6, font "code" garrigue@kurims.kyoto-u.ac.jp %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 2 Synopsis Objective Label introduction %size 2 Why GTK+? GTK+/LablGTK structure %size 2 Low Level Type encoding with variants Labeled parameters %size 2 High Level Object-orientation Optional arguments Polymorphic methods %size 2 Conclusion %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 3 Objective Label Based on Objective Caml ML syntax and type inference Class-based object system Several extensions Labeled and optional parameters Polymorphic variants Polymorphic methods Tools Type-based browser GUI and 3D graphics %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 4 Labels and optionals %font "code", size 4, prefix " ", fore "yellow" let rec map fun:f = function [] -> [] | x :: l -> f x :: map fun:f l %fore "lightpink" val map : fun:('a -> 'b) -> 'a list -> 'b list %pause, fore "yellow", font "code" let f = map [1;2;3] %fore "lightpink" val f : fun:(int -> 'a) -> 'a list %fore "yellow" f fun:(fun x -> 2*x) %fore "lightpink" - : int list = [2; 3; 4] %pause, fore "yellow", font "code" let f x ?incr:y [< 1 >] = x + y %fore "lightpink" val f : int -> ?incr:int -> int %fore "yellow" f 1 %fore "lightpink" - : int = 2 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 5 Polymorphic variants %font "code", size 4, prefix " ", fore "yellow" [`on; `off] %fore "lightpink" - : [> off on] list = [`on; `off] %pause, fore "yellow", font "code" `number 1;; %fore "lightpink" - : [> number(int)] = `number 1 %pause, fore "yellow", font "code" let f = function `on -> 1 | `off -> 0 | `number n -> n %fore "lightpink" val f : [< number(int) off on] -> int %pause, fore "yellow", font "code" type t = [on off number(int)] %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 6 Polymorphic methods Not allowed in Objective Caml %size 2 %font "code", size 4, prefix " ", fore "yellow" class c = object method m x = x end %fore "red" Some type variables are unbound in this type: class c : object method m : 'a -> 'a end The method m has type 'a -> 'a where 'a is unbound %pause, font "sans", size 5, prefix " ", fore "white" Need explicit annotation in O'Labl %size 2 %font "code", size 4, prefix " ", fore "yellow" class c = object method m : 'a. 'a -> 'a = fun x -> x end %fore "lightpink" class c : object method m : 'a -> 'a end %fore "yellow" let o = new c %fore "lightpink" val o : c = %fore "yellow" o#m 1, o#m true %fore "lightpink" - : int * bool = 1, true %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 7 Why GTK+ ? Why use the GIMP Tool Kit? %size 3 Widely used in free software Easy to interface Written in C (QT uses C++) Memory management Drawbacks %size 3 Design lacks uniformity Extensive use of dynamic typing %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 8 GTK+ Structure Class hierarchy based on GtkObject %size 2 Single inheritance &com1 New widgets may redefine methods %size 2 Dynamically checked &com1 Casting necessay both up and down %size 2 Developper-side hierarchy &com1 Inheritance is not always meaningful to the user %size 2 %size 5 Signal-based callback mechanism %size 2 May use multiple callbacks %size 2 Signals are polymorphic %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 9 LablGTK structure Typed at all levels Low-level interface %size 2 C stub functions -- typechecked by C ML type declarations -- ML abstract types High-level interface %size 2 ML class wrappers -- ML concrete types %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 10 Low Level Interface Goals Strongly typed interface &com1 heavy use of advanced typing techniques Very little ML code &com1 C-stubs and external declarations Safe memory management &com1 have the library cooperate with the GC %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 11 Low level encoding (I) How to represent widget subtyping in ML? Example: buttons' hierarchy %size 2 %font "code", size 5, prefix " ", fore "yellow" GtkObject GtkWidget GtkContainer GtkButton GtkToggleButton GtkRadioButton %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 12 Variants as set constraints Variants can be seen as sets of possible values: [tag1 ... tagn] = {tag1,...,tagn} Polymorphic variants introduce constraints $B&A(B[> tag1 ... tagn] $B"N(B $B&A(B $B"?(B {tag1,...,tagn} $B&A(B[< tag1 ... tagn] $B"N(B $B&A(B $B">(B {tag1,...,tagn} %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 13 Encoding hierarchies Define an abstract type &vspace %font "code", fore "yellow", size 5 type 'a obj &txt Use tags to represent properties &vspace %font "code", fore "yellow", size 5 type t = [class1 ... classn] obj &txt Functions check properties &vspace %font "code", fore "yellow", size 5 val f : [> class1 ... classn] obj -> ... &txt Subsumes Haskell type classes &vspace Allows multiple inheritance %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 14 Low level encoding (II) Example: buttons' hierarchy %size 2 %font "code", size 4, prefix " ", fore "yellow" type 'a obj type widget = [widget] obj type container = [widget container] obj type button = [widget container button] obj type toggle_button = [widget ... togglebutton] obj type radio_button = [widget ... radiobutton] obj type state_type = [ NORMAL ACTIVE PRELIGHT SELECTED INSENSITIVE ] val set_state : [> widget] obj -> state_type -> unit val children : [> container] obj -> [widget] obj list val clicked : [> button] obj -> unit val set_group : [> radiobutton] obj -> group -> unit %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 15 Alternate encoding Use only standard ML features %size 2 %font "code", size 4, prefix " ", fore "yellow", vgap 50 type 'a obj type 'a widget ... type 'a radio type state_type = NORMAL | ACTIVE | ... | INSENSITIVE val set_state : 'a widget obj -> state_type -> unit val children : 'a container widget obj -> unit widget obj list val clicked : 'a button container widget obj -> unit &txt Weaknesses No multiple inheritance Not very intuitive for the user %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 16 Low level encoding (III) Use of labeled parameters %size 2 %font "code", size 4, prefix " ", fore "yellow", vgap 50 val adjustment_new : value:float -> lower:float -> upper:float -> step_incr:float -> page_incr:float -> page_size:float -> adjustment obj &txt Signals %size 2 %font "code", size 4, prefix " ", fore "yellow", vgap 50 type ('a,'b) signal = { name: string; marshaller: 'b -> GtkArgv.t -> unit } val connect : 'a obj -> sig:('a,'b) signal -> callback:'b -> ?after:bool -> id val button_clicked : ([> button], unit -> unit) signal %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 17 High-Level Interface Problems with GTK+ %size 2 Name space is scattered &com1 One has to know in which superclass a function is defined Developper oriented design &com1 There is no clear distinction between public and private definitions &txt LablGTK design %size 2 OCaml classes to reunify name space Omit developper-oriented methods %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 18 High-level classes %font "code", size 4, prefix " ", fore "yellow" class button : %fore "lightgreen" ?label:string -> %fore "lightpink" ?border_width:int -> ?width:int -> ?height:int -> %fore "lightgray" ?packing:(GButton.button -> unit) -> ?show:bool -> %fore "yellow" object %fore "lightgray" method destroy : unit -> unit method as_widget : Gtk.widget obj method misc : GObj.widget_misc %fore "lightpink" method add : #is_widget -> unit method set_border_width : int -> unit %fore "lightgreen" method clicked : unit -> unit method connect : GButton.button_signals method grab_default : unit -> unit %fore "yellow" end %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 19 High-level features Objective Caml classes &com1 allow collecting methods from different modules Use optionals in class constructors &com1 makes widget creation much easier Polymorphic methods &com1 needed for container widgets %size 2 %font "code", size 4, fore "yellow", vgap 50 method add : 'a. (#is_widget as 'a) -> unit %fore "white", font "sans" Polymorphic variants &com1 for C-style enumeration types, avoid name-space dependancies %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 20 Polymorphic methods (I) Instance of first-class polymorphism %size 2 first-class polytypes cannot be inferred they are propagated by the definition flow Technically %size 2 use polymorphism to track available information type system excludes derivations based on "guessed" information %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 21 First class polymorphism %prefix " " %image "formula.eps" 512x384 %size 2 %prefix " ", size 5, fore "lightblue" ($B&R(B1 : $B&R(B : $B&R(B2) $B"N(B $B&R(B1 = $B&H(B($B&Q(B1($B&R(B)) $B"J(B $B&R(B2 = $B&H(B($B&Q(B2($B&R(B)) %fore "white" where $B&H(B instantiates free variables, and $B&Q(B1,$B&Q(B2 rename free labels of $B&R(B. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 22 Polymorphic methods (II) Definitions %size 2 %font "code", size 4, prefix " ", fore "yellow", vgap 50 type is_widget = < as_widget : widget obj > type #is_widget = < as_widget : widget obj; .. > type container = < ... ; add : 'a. (#as_widget as 'a) -> unit; ... > %pause &txt Propagation %size 2 %font "code", size 4, prefix " ", fore "lightgreen", vgap 50 fun (cont : container) -> cont#add widget %pause let button = new button in button#add widget %pause, fore "red" fun cont -> cont#add widget %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 23 Programming example Hello World %size 2 %font "code", size 4, prefix " ", fore "yellow" open GMain let window = new GWindow.window border_width: 10 let button = new GButton.button label: "Hello World" packing: window#add let _ = window#connect#destroy callback: Main.quit; button#connect#clicked callback: window#destroy; window#show (); Main.main () %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% %page 24 Conclusion Results %size 2 Could build a strongly typed interface It is easier to use than the C API Makes effective use of extensions to the type system Comments %size 2 Still difficulties with the Caml object system &com2 class recursion, method type refinement, etc... lablgtk-2.18.8/doc/.cvsignore0000644000175000017500000000004213460263323015025 0ustar stephstephhtml lablgtk2.texi lablgtk2.info* lablgtk-2.18.8/doc/FAQ.text0000644000175000017500000000000013460263323014334 0ustar stephstephlablgtk-2.18.8/Makefile0000644000175000017500000000202313460263323013721 0ustar stephsteph# Toplevel makefile for LablGtk2 all opt doc install uninstall byte world old-install old-uninstall: config.make all opt doc install uninstall byte clean depend world old-install old-uninstall: $(MAKE) -C src $@ preinstall: $(MAKE) -C src $@ $(MAKE) -f Makefile.pre arch-clean: @rm -f config.status config.make config.cache config.log @rm -f \#*\# *~ aclocal.m4 @rm -rf autom4te*.cache configure: configure.in aclocal autoconf config.make: config.make.in @echo config.make is not up to date. Execute ./configure first. @exit 2 .PHONY: all opt doc install byte world clean depend arch-clean headers headers: find examples -name "*.ml" -exec headache -h header_examples {} \; find applications -name "*.ml" -exec headache -h header_apps {} \; find applications -name "*.mli" -exec headache -h header_apps {} \; find src -name "*.ml" -exec headache -h header {} \; find src -name "*.mli" -exec headache -h header {} \; find src -name "*.c" -exec headache -h header {} \; find src -name "*.h" -exec headache -h header {} \;lablgtk-2.18.8/configure0000755000175000017500000056631313460263323014211 0ustar stephsteph#! /bin/sh # Guess values for system-dependent variables and create Makefiles. # Generated by GNU Autoconf 2.69. # # # Copyright (C) 1992-1996, 1998-2012 Free Software Foundation, Inc. # # # This configure script is free software; the Free Software Foundation # gives unlimited permission to copy, distribute and modify it. ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # Use a proper internal environment variable to ensure we don't fall # into an infinite loop, continuously re-executing ourselves. if test x"${_as_can_reexec}" != xno && test "x$CONFIG_SHELL" != x; then _as_can_reexec=no; export _as_can_reexec; # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. $as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 as_fn_exit 255 fi # We don't want this to propagate to other subprocesses. { _as_can_reexec=; unset _as_can_reexec;} if test "x$CONFIG_SHELL" = x; then as_bourne_compatible="if test -n \"\${ZSH_VERSION+set}\" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on \${1+\"\$@\"}, which # is contrary to our usage. Disable this feature. alias -g '\${1+\"\$@\"}'='\"\$@\"' setopt NO_GLOB_SUBST else case \`(set -o) 2>/dev/null\` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi " as_required="as_fn_return () { (exit \$1); } as_fn_success () { as_fn_return 0; } as_fn_failure () { as_fn_return 1; } as_fn_ret_success () { return 0; } as_fn_ret_failure () { return 1; } exitcode=0 as_fn_success || { exitcode=1; echo as_fn_success failed.; } as_fn_failure && { exitcode=1; echo as_fn_failure succeeded.; } as_fn_ret_success || { exitcode=1; echo as_fn_ret_success failed.; } as_fn_ret_failure && { exitcode=1; echo as_fn_ret_failure succeeded.; } if ( set x; as_fn_ret_success y && test x = \"\$1\" ); then : else exitcode=1; echo positional parameters were not saved. fi test x\$exitcode = x0 || exit 1 test -x / || exit 1" as_suggested=" as_lineno_1=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_1a=\$LINENO as_lineno_2=";as_suggested=$as_suggested$LINENO;as_suggested=$as_suggested" as_lineno_2a=\$LINENO eval 'test \"x\$as_lineno_1'\$as_run'\" != \"x\$as_lineno_2'\$as_run'\" && test \"x\`expr \$as_lineno_1'\$as_run' + 1\`\" = \"x\$as_lineno_2'\$as_run'\"' || exit 1" if (eval "$as_required") 2>/dev/null; then : as_have_required=yes else as_have_required=no fi if test x$as_have_required = xyes && (eval "$as_suggested") 2>/dev/null; then : else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR as_found=false for as_dir in /bin$PATH_SEPARATOR/usr/bin$PATH_SEPARATOR$PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. as_found=: case $as_dir in #( /*) for as_base in sh bash ksh sh5; do # Try only shells that exist, to save several forks. as_shell=$as_dir/$as_base if { test -f "$as_shell" || test -f "$as_shell.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$as_shell"; } 2>/dev/null; then : CONFIG_SHELL=$as_shell as_have_required=yes if { $as_echo "$as_bourne_compatible""$as_suggested" | as_run=a "$as_shell"; } 2>/dev/null; then : break 2 fi fi done;; esac as_found=false done $as_found || { if { test -f "$SHELL" || test -f "$SHELL.exe"; } && { $as_echo "$as_bourne_compatible""$as_required" | as_run=a "$SHELL"; } 2>/dev/null; then : CONFIG_SHELL=$SHELL as_have_required=yes fi; } IFS=$as_save_IFS if test "x$CONFIG_SHELL" != x; then : export CONFIG_SHELL # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV case $- in # (((( *v*x* | *x*v* ) as_opts=-vx ;; *v* ) as_opts=-v ;; *x* ) as_opts=-x ;; * ) as_opts= ;; esac exec $CONFIG_SHELL $as_opts "$as_myself" ${1+"$@"} # Admittedly, this is quite paranoid, since all the known shells bail # out after a failed `exec'. $as_echo "$0: could not re-execute with $CONFIG_SHELL" >&2 exit 255 fi if test x$as_have_required = xno; then : $as_echo "$0: This script requires a shell more modern than all" $as_echo "$0: the shells that I found on your system." if test x${ZSH_VERSION+set} = xset ; then $as_echo "$0: In particular, zsh $ZSH_VERSION has bugs and should" $as_echo "$0: be upgraded to zsh 4.3.4 or later." else $as_echo "$0: Please tell bug-autoconf@gnu.org about your system, $0: including any error possibly output before this $0: message. Then install a modern shell, or manually run $0: the script under such a shell if you do have one." fi exit 1 fi fi fi SHELL=${CONFIG_SHELL-/bin/sh} export SHELL # Unset more variables known to interfere with behavior of common tools. CLICOLOR_FORCE= GREP_OPTIONS= unset CLICOLOR_FORCE GREP_OPTIONS ## --------------------- ## ## M4sh Shell Functions. ## ## --------------------- ## # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits as_lineno_1=$LINENO as_lineno_1a=$LINENO as_lineno_2=$LINENO as_lineno_2a=$LINENO eval 'test "x$as_lineno_1'$as_run'" != "x$as_lineno_2'$as_run'" && test "x`expr $as_lineno_1'$as_run' + 1`" = "x$as_lineno_2'$as_run'"' || { # Blame Lee E. McMahon (1931-1989) for sed's syntax. :-) sed -n ' p /[$]LINENO/= ' <$as_myself | sed ' s/[$]LINENO.*/&-/ t lineno b :lineno N :loop s/[$]LINENO\([^'$as_cr_alnum'_].*\n\)\(.*\)/\2\1\2/ t loop s/-\n.*// ' >$as_me.lineno && chmod +x "$as_me.lineno" || { $as_echo "$as_me: error: cannot create $as_me.lineno; rerun with a POSIX shell" >&2; as_fn_exit 1; } # If we had to re-execute with $CONFIG_SHELL, we're ensured to have # already done that, so ensure we don't try to do so again and fall # in an infinite loop. This has already happened in practice. _as_can_reexec=no; export _as_can_reexec # Don't try to exec as it changes $[0], causing all sort of problems # (the dirname of $[0] is not the place where we might find the # original and so on. Autoconf is especially sensitive to this). . "./$as_me.lineno" # Exit status is that of the last command. exit } ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" test -n "$DJDIR" || exec 7<&0 &1 # Name of the host. # hostname on some systems (SVR3.2, old GNU/Linux) returns a bogus exit status, # so uname gets run too. ac_hostname=`(hostname || uname -n) 2>/dev/null | sed 1q` # # Initializations. # ac_default_prefix=/usr/local ac_clean_files= ac_config_libobj_dir=. LIBOBJS= cross_compiling=no subdirs= MFLAGS= MAKEFLAGS= # Identity of this package. PACKAGE_NAME= PACKAGE_TARNAME= PACKAGE_VERSION= PACKAGE_STRING= PACKAGE_BUGREPORT= PACKAGE_URL= ac_unique_file="src/gtk.ml" ac_subst_vars='LTLIBOBJS LIBOBJS DEBUG USE_CC HAVE_SVGZ LABLGLDIR OCAMLLDCONF FINDLIBDIR OCAML_CC_EXTRA_FLAGS HAS_NATIVE_DYNLINK HAS_DLL_SUPPORT THREADS_LIB OCAMLWIN32 OCAMLBEST LIBDIR XS EXE GTKALL_LIBS GTKALL_CFLAGS USE_GTKQUARTZ GTKQUARTZ_LIBS GTKQUARTZ_CFLAGS USE_GTKSOURCEVIEW2 GTKSOURCEVIEW2_LIBS GTKSOURCEVIEW2_CFLAGS USE_GTKSOURCEVIEW GTKSOURCEVIEW_LIBS GTKSOURCEVIEW_CFLAGS USE_GTKSPELL GTKSPELL_LIBS GTKSPELL_CFLAGS USE_PANEL PANEL_LIBS PANEL_CFLAGS USE_GNOMEUI GNOMEUI_LIBS GNOMEUI_CFLAGS USE_GNOMECANVAS GNOMECANVAS_LIBS GNOMECANVAS_CFLAGS USE_RSVG RSVG_LIBS RSVG_CFLAGS USE_GLADE GLADE_LIBS GLADE_CFLAGS USE_GTKGL GTKGL_LIBS GTKGL_CFLAGS PKG_CONFIG_LIBDIR PKG_CONFIG_PATH GTK_LIBS GTK_CFLAGS PKG_CONFIG OBJEXT EXEEXT ac_ct_CC CPPFLAGS LDFLAGS CFLAGS CC RANLIB HAS_PRINTEXC_BACKTRACE ODOC_DEF OCAMLFIND CAMLP4O CAMLMKLIB CAMLMKTOP OCAMLYACC OCAMLLEX OCAMLDOC OCAMLDEP OCAMLRUN OCAMLOPTDOTOPT OCAMLCDOTOPT CAMLOPT CAMLC target_alias host_alias build_alias LIBS ECHO_T ECHO_N ECHO_C DEFS mandir localedir libdir psdir pdfdir dvidir htmldir infodir docdir oldincludedir includedir localstatedir sharedstatedir sysconfdir datadir datarootdir libexecdir sbindir bindir program_transform_name prefix exec_prefix PACKAGE_URL PACKAGE_BUGREPORT PACKAGE_STRING PACKAGE_VERSION PACKAGE_TARNAME PACKAGE_NAME PATH_SEPARATOR SHELL' ac_subst_files='' ac_user_opts=' enable_option_checking with_libdir with_threads enable_gtktest with_gl with_glade with_rsvg with_gnomecanvas with_gnomeui with_panel with_gtkspell with_gtksourceview with_gtksourceview2 with_quartz enable_debug ' ac_precious_vars='build_alias host_alias target_alias CC CFLAGS LDFLAGS LIBS CPPFLAGS PKG_CONFIG PKG_CONFIG_PATH PKG_CONFIG_LIBDIR GTKGL_CFLAGS GTKGL_LIBS GLADE_CFLAGS GLADE_LIBS RSVG_CFLAGS RSVG_LIBS GNOMECANVAS_CFLAGS GNOMECANVAS_LIBS GNOMEUI_CFLAGS GNOMEUI_LIBS PANEL_CFLAGS PANEL_LIBS GTKSPELL_CFLAGS GTKSPELL_LIBS GTKSOURCEVIEW_CFLAGS GTKSOURCEVIEW_LIBS GTKSOURCEVIEW2_CFLAGS GTKSOURCEVIEW2_LIBS GTKQUARTZ_CFLAGS GTKQUARTZ_LIBS GTKALL_CFLAGS GTKALL_LIBS' # Initialize some variables set by options. ac_init_help= ac_init_version=false ac_unrecognized_opts= ac_unrecognized_sep= # The variables have the same names as the options, with # dashes changed to underlines. cache_file=/dev/null exec_prefix=NONE no_create= no_recursion= prefix=NONE program_prefix=NONE program_suffix=NONE program_transform_name=s,x,x, silent= site= srcdir= verbose= x_includes=NONE x_libraries=NONE # Installation directory options. # These are left unexpanded so users can "make install exec_prefix=/foo" # and all the variables that are supposed to be based on exec_prefix # by default will actually change. # Use braces instead of parens because sh, perl, etc. also accept them. # (The list follows the same order as the GNU Coding Standards.) bindir='${exec_prefix}/bin' sbindir='${exec_prefix}/sbin' libexecdir='${exec_prefix}/libexec' datarootdir='${prefix}/share' datadir='${datarootdir}' sysconfdir='${prefix}/etc' sharedstatedir='${prefix}/com' localstatedir='${prefix}/var' includedir='${prefix}/include' oldincludedir='/usr/include' docdir='${datarootdir}/doc/${PACKAGE}' infodir='${datarootdir}/info' htmldir='${docdir}' dvidir='${docdir}' pdfdir='${docdir}' psdir='${docdir}' libdir='${exec_prefix}/lib' localedir='${datarootdir}/locale' mandir='${datarootdir}/man' ac_prev= ac_dashdash= for ac_option do # If the previous option needs an argument, assign it. if test -n "$ac_prev"; then eval $ac_prev=\$ac_option ac_prev= continue fi case $ac_option in *=?*) ac_optarg=`expr "X$ac_option" : '[^=]*=\(.*\)'` ;; *=) ac_optarg= ;; *) ac_optarg=yes ;; esac # Accept the important Cygnus configure options, so we can diagnose typos. case $ac_dashdash$ac_option in --) ac_dashdash=yes ;; -bindir | --bindir | --bindi | --bind | --bin | --bi) ac_prev=bindir ;; -bindir=* | --bindir=* | --bindi=* | --bind=* | --bin=* | --bi=*) bindir=$ac_optarg ;; -build | --build | --buil | --bui | --bu) ac_prev=build_alias ;; -build=* | --build=* | --buil=* | --bui=* | --bu=*) build_alias=$ac_optarg ;; -cache-file | --cache-file | --cache-fil | --cache-fi \ | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c) ac_prev=cache_file ;; -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \ | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*) cache_file=$ac_optarg ;; --config-cache | -C) cache_file=config.cache ;; -datadir | --datadir | --datadi | --datad) ac_prev=datadir ;; -datadir=* | --datadir=* | --datadi=* | --datad=*) datadir=$ac_optarg ;; -datarootdir | --datarootdir | --datarootdi | --datarootd | --dataroot \ | --dataroo | --dataro | --datar) ac_prev=datarootdir ;; -datarootdir=* | --datarootdir=* | --datarootdi=* | --datarootd=* \ | --dataroot=* | --dataroo=* | --dataro=* | --datar=*) datarootdir=$ac_optarg ;; -disable-* | --disable-*) ac_useropt=`expr "x$ac_option" : 'x-*disable-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--disable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=no ;; -docdir | --docdir | --docdi | --doc | --do) ac_prev=docdir ;; -docdir=* | --docdir=* | --docdi=* | --doc=* | --do=*) docdir=$ac_optarg ;; -dvidir | --dvidir | --dvidi | --dvid | --dvi | --dv) ac_prev=dvidir ;; -dvidir=* | --dvidir=* | --dvidi=* | --dvid=* | --dvi=* | --dv=*) dvidir=$ac_optarg ;; -enable-* | --enable-*) ac_useropt=`expr "x$ac_option" : 'x-*enable-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid feature name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "enable_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--enable-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval enable_$ac_useropt=\$ac_optarg ;; -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \ | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \ | --exec | --exe | --ex) ac_prev=exec_prefix ;; -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \ | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \ | --exec=* | --exe=* | --ex=*) exec_prefix=$ac_optarg ;; -gas | --gas | --ga | --g) # Obsolete; use --with-gas. with_gas=yes ;; -help | --help | --hel | --he | -h) ac_init_help=long ;; -help=r* | --help=r* | --hel=r* | --he=r* | -hr*) ac_init_help=recursive ;; -help=s* | --help=s* | --hel=s* | --he=s* | -hs*) ac_init_help=short ;; -host | --host | --hos | --ho) ac_prev=host_alias ;; -host=* | --host=* | --hos=* | --ho=*) host_alias=$ac_optarg ;; -htmldir | --htmldir | --htmldi | --htmld | --html | --htm | --ht) ac_prev=htmldir ;; -htmldir=* | --htmldir=* | --htmldi=* | --htmld=* | --html=* | --htm=* \ | --ht=*) htmldir=$ac_optarg ;; -includedir | --includedir | --includedi | --included | --include \ | --includ | --inclu | --incl | --inc) ac_prev=includedir ;; -includedir=* | --includedir=* | --includedi=* | --included=* | --include=* \ | --includ=* | --inclu=* | --incl=* | --inc=*) includedir=$ac_optarg ;; -infodir | --infodir | --infodi | --infod | --info | --inf) ac_prev=infodir ;; -infodir=* | --infodir=* | --infodi=* | --infod=* | --info=* | --inf=*) infodir=$ac_optarg ;; -libdir | --libdir | --libdi | --libd) ac_prev=libdir ;; -libdir=* | --libdir=* | --libdi=* | --libd=*) libdir=$ac_optarg ;; -libexecdir | --libexecdir | --libexecdi | --libexecd | --libexec \ | --libexe | --libex | --libe) ac_prev=libexecdir ;; -libexecdir=* | --libexecdir=* | --libexecdi=* | --libexecd=* | --libexec=* \ | --libexe=* | --libex=* | --libe=*) libexecdir=$ac_optarg ;; -localedir | --localedir | --localedi | --localed | --locale) ac_prev=localedir ;; -localedir=* | --localedir=* | --localedi=* | --localed=* | --locale=*) localedir=$ac_optarg ;; -localstatedir | --localstatedir | --localstatedi | --localstated \ | --localstate | --localstat | --localsta | --localst | --locals) ac_prev=localstatedir ;; -localstatedir=* | --localstatedir=* | --localstatedi=* | --localstated=* \ | --localstate=* | --localstat=* | --localsta=* | --localst=* | --locals=*) localstatedir=$ac_optarg ;; -mandir | --mandir | --mandi | --mand | --man | --ma | --m) ac_prev=mandir ;; -mandir=* | --mandir=* | --mandi=* | --mand=* | --man=* | --ma=* | --m=*) mandir=$ac_optarg ;; -nfp | --nfp | --nf) # Obsolete; use --without-fp. with_fp=no ;; -no-create | --no-create | --no-creat | --no-crea | --no-cre \ | --no-cr | --no-c | -n) no_create=yes ;; -no-recursion | --no-recursion | --no-recursio | --no-recursi \ | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) no_recursion=yes ;; -oldincludedir | --oldincludedir | --oldincludedi | --oldincluded \ | --oldinclude | --oldinclud | --oldinclu | --oldincl | --oldinc \ | --oldin | --oldi | --old | --ol | --o) ac_prev=oldincludedir ;; -oldincludedir=* | --oldincludedir=* | --oldincludedi=* | --oldincluded=* \ | --oldinclude=* | --oldinclud=* | --oldinclu=* | --oldincl=* | --oldinc=* \ | --oldin=* | --oldi=* | --old=* | --ol=* | --o=*) oldincludedir=$ac_optarg ;; -prefix | --prefix | --prefi | --pref | --pre | --pr | --p) ac_prev=prefix ;; -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*) prefix=$ac_optarg ;; -program-prefix | --program-prefix | --program-prefi | --program-pref \ | --program-pre | --program-pr | --program-p) ac_prev=program_prefix ;; -program-prefix=* | --program-prefix=* | --program-prefi=* \ | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*) program_prefix=$ac_optarg ;; -program-suffix | --program-suffix | --program-suffi | --program-suff \ | --program-suf | --program-su | --program-s) ac_prev=program_suffix ;; -program-suffix=* | --program-suffix=* | --program-suffi=* \ | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*) program_suffix=$ac_optarg ;; -program-transform-name | --program-transform-name \ | --program-transform-nam | --program-transform-na \ | --program-transform-n | --program-transform- \ | --program-transform | --program-transfor \ | --program-transfo | --program-transf \ | --program-trans | --program-tran \ | --progr-tra | --program-tr | --program-t) ac_prev=program_transform_name ;; -program-transform-name=* | --program-transform-name=* \ | --program-transform-nam=* | --program-transform-na=* \ | --program-transform-n=* | --program-transform-=* \ | --program-transform=* | --program-transfor=* \ | --program-transfo=* | --program-transf=* \ | --program-trans=* | --program-tran=* \ | --progr-tra=* | --program-tr=* | --program-t=*) program_transform_name=$ac_optarg ;; -pdfdir | --pdfdir | --pdfdi | --pdfd | --pdf | --pd) ac_prev=pdfdir ;; -pdfdir=* | --pdfdir=* | --pdfdi=* | --pdfd=* | --pdf=* | --pd=*) pdfdir=$ac_optarg ;; -psdir | --psdir | --psdi | --psd | --ps) ac_prev=psdir ;; -psdir=* | --psdir=* | --psdi=* | --psd=* | --ps=*) psdir=$ac_optarg ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) silent=yes ;; -sbindir | --sbindir | --sbindi | --sbind | --sbin | --sbi | --sb) ac_prev=sbindir ;; -sbindir=* | --sbindir=* | --sbindi=* | --sbind=* | --sbin=* \ | --sbi=* | --sb=*) sbindir=$ac_optarg ;; -sharedstatedir | --sharedstatedir | --sharedstatedi \ | --sharedstated | --sharedstate | --sharedstat | --sharedsta \ | --sharedst | --shareds | --shared | --share | --shar \ | --sha | --sh) ac_prev=sharedstatedir ;; -sharedstatedir=* | --sharedstatedir=* | --sharedstatedi=* \ | --sharedstated=* | --sharedstate=* | --sharedstat=* | --sharedsta=* \ | --sharedst=* | --shareds=* | --shared=* | --share=* | --shar=* \ | --sha=* | --sh=*) sharedstatedir=$ac_optarg ;; -site | --site | --sit) ac_prev=site ;; -site=* | --site=* | --sit=*) site=$ac_optarg ;; -srcdir | --srcdir | --srcdi | --srcd | --src | --sr) ac_prev=srcdir ;; -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*) srcdir=$ac_optarg ;; -sysconfdir | --sysconfdir | --sysconfdi | --sysconfd | --sysconf \ | --syscon | --sysco | --sysc | --sys | --sy) ac_prev=sysconfdir ;; -sysconfdir=* | --sysconfdir=* | --sysconfdi=* | --sysconfd=* | --sysconf=* \ | --syscon=* | --sysco=* | --sysc=* | --sys=* | --sy=*) sysconfdir=$ac_optarg ;; -target | --target | --targe | --targ | --tar | --ta | --t) ac_prev=target_alias ;; -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*) target_alias=$ac_optarg ;; -v | -verbose | --verbose | --verbos | --verbo | --verb) verbose=yes ;; -version | --version | --versio | --versi | --vers | -V) ac_init_version=: ;; -with-* | --with-*) ac_useropt=`expr "x$ac_option" : 'x-*with-\([^=]*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--with-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=\$ac_optarg ;; -without-* | --without-*) ac_useropt=`expr "x$ac_option" : 'x-*without-\(.*\)'` # Reject names that are not valid shell variable names. expr "x$ac_useropt" : ".*[^-+._$as_cr_alnum]" >/dev/null && as_fn_error $? "invalid package name: $ac_useropt" ac_useropt_orig=$ac_useropt ac_useropt=`$as_echo "$ac_useropt" | sed 's/[-+.]/_/g'` case $ac_user_opts in *" "with_$ac_useropt" "*) ;; *) ac_unrecognized_opts="$ac_unrecognized_opts$ac_unrecognized_sep--without-$ac_useropt_orig" ac_unrecognized_sep=', ';; esac eval with_$ac_useropt=no ;; --x) # Obsolete; use --with-x. with_x=yes ;; -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \ | --x-incl | --x-inc | --x-in | --x-i) ac_prev=x_includes ;; -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \ | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*) x_includes=$ac_optarg ;; -x-libraries | --x-libraries | --x-librarie | --x-librari \ | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l) ac_prev=x_libraries ;; -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \ | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*) x_libraries=$ac_optarg ;; -*) as_fn_error $? "unrecognized option: \`$ac_option' Try \`$0 --help' for more information" ;; *=*) ac_envvar=`expr "x$ac_option" : 'x\([^=]*\)='` # Reject names that are not valid shell variable names. case $ac_envvar in #( '' | [0-9]* | *[!_$as_cr_alnum]* ) as_fn_error $? "invalid variable name: \`$ac_envvar'" ;; esac eval $ac_envvar=\$ac_optarg export $ac_envvar ;; *) # FIXME: should be removed in autoconf 3.0. $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac done if test -n "$ac_prev"; then ac_option=--`echo $ac_prev | sed 's/_/-/g'` as_fn_error $? "missing argument to $ac_option" fi if test -n "$ac_unrecognized_opts"; then case $enable_option_checking in no) ;; fatal) as_fn_error $? "unrecognized options: $ac_unrecognized_opts" ;; *) $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2 ;; esac fi # Check all directory arguments for consistency. for ac_var in exec_prefix prefix bindir sbindir libexecdir datarootdir \ datadir sysconfdir sharedstatedir localstatedir includedir \ oldincludedir docdir infodir htmldir dvidir pdfdir psdir \ libdir localedir mandir do eval ac_val=\$$ac_var # Remove trailing slashes. case $ac_val in */ ) ac_val=`expr "X$ac_val" : 'X\(.*[^/]\)' \| "X$ac_val" : 'X\(.*\)'` eval $ac_var=\$ac_val;; esac # Be sure to have absolute directory names. case $ac_val in [\\/$]* | ?:[\\/]* ) continue;; NONE | '' ) case $ac_var in *prefix ) continue;; esac;; esac as_fn_error $? "expected an absolute directory name for --$ac_var: $ac_val" done # There might be people who depend on the old broken behavior: `$host' # used to hold the argument of --host etc. # FIXME: To remove some day. build=$build_alias host=$host_alias target=$target_alias # FIXME: To remove some day. if test "x$host_alias" != x; then if test "x$build_alias" = x; then cross_compiling=maybe elif test "x$build_alias" != "x$host_alias"; then cross_compiling=yes fi fi ac_tool_prefix= test -n "$host_alias" && ac_tool_prefix=$host_alias- test "$silent" = yes && exec 6>/dev/null ac_pwd=`pwd` && test -n "$ac_pwd" && ac_ls_di=`ls -di .` && ac_pwd_ls_di=`cd "$ac_pwd" && ls -di .` || as_fn_error $? "working directory cannot be determined" test "X$ac_ls_di" = "X$ac_pwd_ls_di" || as_fn_error $? "pwd does not report name of working directory" # Find the source files, if location was not specified. if test -z "$srcdir"; then ac_srcdir_defaulted=yes # Try the directory containing this script, then the parent directory. ac_confdir=`$as_dirname -- "$as_myself" || $as_expr X"$as_myself" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_myself" : 'X\(//\)[^/]' \| \ X"$as_myself" : 'X\(//\)$' \| \ X"$as_myself" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_myself" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` srcdir=$ac_confdir if test ! -r "$srcdir/$ac_unique_file"; then srcdir=.. fi else ac_srcdir_defaulted=no fi if test ! -r "$srcdir/$ac_unique_file"; then test "$ac_srcdir_defaulted" = yes && srcdir="$ac_confdir or .." as_fn_error $? "cannot find sources ($ac_unique_file) in $srcdir" fi ac_msg="sources are in $srcdir, but \`cd $srcdir' does not work" ac_abs_confdir=`( cd "$srcdir" && test -r "./$ac_unique_file" || as_fn_error $? "$ac_msg" pwd)` # When building in place, set srcdir=. if test "$ac_abs_confdir" = "$ac_pwd"; then srcdir=. fi # Remove unnecessary trailing slashes from srcdir. # Double slashes in file names in object file debugging info # mess up M-x gdb in Emacs. case $srcdir in */) srcdir=`expr "X$srcdir" : 'X\(.*[^/]\)' \| "X$srcdir" : 'X\(.*\)'`;; esac for ac_var in $ac_precious_vars; do eval ac_env_${ac_var}_set=\${${ac_var}+set} eval ac_env_${ac_var}_value=\$${ac_var} eval ac_cv_env_${ac_var}_set=\${${ac_var}+set} eval ac_cv_env_${ac_var}_value=\$${ac_var} done # # Report the --help message. # if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF \`configure' configures this package to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... To assign environment variables (e.g., CC, CFLAGS...), specify them as VAR=VALUE. See below for descriptions of some of the useful variables. Defaults for the options are specified in brackets. Configuration: -h, --help display this help and exit --help=short display options specific to this package --help=recursive display the short help of all the included packages -V, --version display version information and exit -q, --quiet, --silent do not print \`checking ...' messages --cache-file=FILE cache test results in FILE [disabled] -C, --config-cache alias for \`--cache-file=config.cache' -n, --no-create do not create output files --srcdir=DIR find the sources in DIR [configure dir or \`..'] Installation directories: --prefix=PREFIX install architecture-independent files in PREFIX [$ac_default_prefix] --exec-prefix=EPREFIX install architecture-dependent files in EPREFIX [PREFIX] By default, \`make install' will install all the files in \`$ac_default_prefix/bin', \`$ac_default_prefix/lib' etc. You can specify an installation prefix other than \`$ac_default_prefix' using \`--prefix', for instance \`--prefix=\$HOME'. For better control, use the options below. Fine tuning of the installation directories: --bindir=DIR user executables [EPREFIX/bin] --sbindir=DIR system admin executables [EPREFIX/sbin] --libexecdir=DIR program executables [EPREFIX/libexec] --sysconfdir=DIR read-only single-machine data [PREFIX/etc] --sharedstatedir=DIR modifiable architecture-independent data [PREFIX/com] --localstatedir=DIR modifiable single-machine data [PREFIX/var] --libdir=DIR object code libraries [EPREFIX/lib] --includedir=DIR C header files [PREFIX/include] --oldincludedir=DIR C header files for non-gcc [/usr/include] --datarootdir=DIR read-only arch.-independent data root [PREFIX/share] --datadir=DIR read-only architecture-independent data [DATAROOTDIR] --infodir=DIR info documentation [DATAROOTDIR/info] --localedir=DIR locale-dependent data [DATAROOTDIR/locale] --mandir=DIR man documentation [DATAROOTDIR/man] --docdir=DIR documentation root [DATAROOTDIR/doc/PACKAGE] --htmldir=DIR html documentation [DOCDIR] --dvidir=DIR dvi documentation [DOCDIR] --pdfdir=DIR pdf documentation [DOCDIR] --psdir=DIR ps documentation [DOCDIR] _ACEOF cat <<\_ACEOF _ACEOF fi if test -n "$ac_init_help"; then cat <<\_ACEOF Optional Features: --disable-option-checking ignore unrecognized --enable/--with options --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no) --enable-FEATURE[=ARG] include FEATURE [ARG=yes] --disable-gtktest do not try to compile and run a test GTK+ program --enable-debug enable debug mode Optional Packages: --with-PACKAGE[=ARG] use PACKAGE [ARG=yes] --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no) --with-libdir=/path install libs in /path/lablgtk2 and /path/stublibs --with-threads=(yes|system|vm|no) which threads to use --without-gl override autodetected GtkGLArea support. Requires LablGL --without-glade override autodetected libglade support --without-rsvg override autodetected librsvg support --without-gnomecanvas override autodetected libgnomecanvas support --without-gnomeui override autodetected libgnomeui support --without-panel override autodetected libpanelapplet support --without-gtkspell override autodetected gtkspell support --without-gtksourceview override autodetected gtksourceview support --without-gtksourceview2 override autodetected gtksourceview 2 support --without-quartz override autodetected quartz support Some influential environment variables: CC C compiler command CFLAGS C compiler flags LDFLAGS linker flags, e.g. -L if you have libraries in a nonstandard directory LIBS libraries to pass to the linker, e.g. -l CPPFLAGS (Objective) C/C++ preprocessor flags, e.g. -I if you have headers in a nonstandard directory PKG_CONFIG path to pkg-config utility PKG_CONFIG_PATH directories to add to pkg-config's search path PKG_CONFIG_LIBDIR path overriding pkg-config's built-in search path GTKGL_CFLAGS C compiler flags for GTKGL, overriding pkg-config GTKGL_LIBS linker flags for GTKGL, overriding pkg-config GLADE_CFLAGS C compiler flags for GLADE, overriding pkg-config GLADE_LIBS linker flags for GLADE, overriding pkg-config RSVG_CFLAGS C compiler flags for RSVG, overriding pkg-config RSVG_LIBS linker flags for RSVG, overriding pkg-config GNOMECANVAS_CFLAGS C compiler flags for GNOMECANVAS, overriding pkg-config GNOMECANVAS_LIBS linker flags for GNOMECANVAS, overriding pkg-config GNOMEUI_CFLAGS C compiler flags for GNOMEUI, overriding pkg-config GNOMEUI_LIBS linker flags for GNOMEUI, overriding pkg-config PANEL_CFLAGS C compiler flags for PANEL, overriding pkg-config PANEL_LIBS linker flags for PANEL, overriding pkg-config GTKSPELL_CFLAGS C compiler flags for GTKSPELL, overriding pkg-config GTKSPELL_LIBS linker flags for GTKSPELL, overriding pkg-config GTKSOURCEVIEW_CFLAGS C compiler flags for GTKSOURCEVIEW, overriding pkg-config GTKSOURCEVIEW_LIBS linker flags for GTKSOURCEVIEW, overriding pkg-config GTKSOURCEVIEW2_CFLAGS C compiler flags for GTKSOURCEVIEW2, overriding pkg-config GTKSOURCEVIEW2_LIBS linker flags for GTKSOURCEVIEW2, overriding pkg-config GTKQUARTZ_CFLAGS C compiler flags for GTKQUARTZ, overriding pkg-config GTKQUARTZ_LIBS linker flags for GTKQUARTZ, overriding pkg-config GTKALL_CFLAGS C compiler flags for GTKALL, overriding pkg-config GTKALL_LIBS linker flags for GTKALL, overriding pkg-config Use these variables to override the choices made by `configure' or to help it to find libraries and programs with nonstandard names/locations. Report bugs to the package provider. _ACEOF ac_status=$? fi if test "$ac_init_help" = "recursive"; then # If there are subdirs, report their specific --help. for ac_dir in : $ac_subdirs_all; do test "x$ac_dir" = x: && continue test -d "$ac_dir" || { cd "$srcdir" && ac_pwd=`pwd` && srcdir=. && test -d "$ac_dir"; } || continue ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix cd "$ac_dir" || { ac_status=$?; continue; } # Check for guested configure. if test -f "$ac_srcdir/configure.gnu"; then echo && $SHELL "$ac_srcdir/configure.gnu" --help=recursive elif test -f "$ac_srcdir/configure"; then echo && $SHELL "$ac_srcdir/configure" --help=recursive else $as_echo "$as_me: WARNING: no configuration information is in $ac_dir" >&2 fi || ac_status=$? cd "$ac_pwd" || { ac_status=$?; break; } done fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF configure generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it. _ACEOF exit fi ## ------------------------ ## ## Autoconf initialization. ## ## ------------------------ ## # ac_fn_c_try_compile LINENO # -------------------------- # Try to compile conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_compile () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest.$ac_objext; then : ac_retval=0 else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile # ac_fn_c_try_run LINENO # ---------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. Assumes # that executables *can* be run. ac_fn_c_try_run () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { ac_try='./conftest$ac_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then : ac_retval=0 else $as_echo "$as_me: program exited with status $ac_status" >&5 $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run # ac_fn_c_try_link LINENO # ----------------------- # Try to link conftest.$ac_ext, and return whether this succeeded. ac_fn_c_try_link () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack rm -f conftest.$ac_objext conftest$ac_exeext if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>conftest.err ac_status=$? if test -s conftest.err; then grep -v '^ *+' conftest.err >conftest.er1 cat conftest.er1 >&5 mv -f conftest.er1 conftest.err fi $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } && { test -z "$ac_c_werror_flag" || test ! -s conftest.err } && test -s conftest$ac_exeext && { test "$cross_compiling" = yes || test -x conftest$ac_exeext }; then : ac_retval=0 else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi # Delete the IPA/IPO (Inter Procedural Analysis/Optimization) information # created by the PGI compiler (conftest_ipa8_conftest.oo), as it would # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link # ac_fn_c_check_func LINENO FUNC VAR # ---------------------------------- # Tests whether FUNC exists, setting the cache variable VAR accordingly ac_fn_c_check_func () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ /* Define $2 to an innocuous variant, in case declares $2. For example, HP-UX 11i declares gettimeofday. */ #define $2 innocuous_$2 /* System header to define __stub macros and hopefully few prototypes, which can conflict with char $2 (); below. Prefer to if __STDC__ is defined, since exists even on freestanding compilers. */ #ifdef __STDC__ # include #else # include #endif #undef $2 /* Override any GCC internal prototype to avoid an error. Use char because int might match the return type of a GCC builtin and then its argument prototype would still apply. */ #ifdef __cplusplus extern "C" #endif char $2 (); /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined __stub_$2 || defined __stub___$2 choke me #endif int main () { return $2 (); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : eval "$3=yes" else eval "$3=no" fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by $as_me, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ _ACEOF exec 5>>config.log { cat <<_ASUNAME ## --------- ## ## Platform. ## ## --------- ## hostname = `(hostname || uname -n) 2>/dev/null | sed 1q` uname -m = `(uname -m) 2>/dev/null || echo unknown` uname -r = `(uname -r) 2>/dev/null || echo unknown` uname -s = `(uname -s) 2>/dev/null || echo unknown` uname -v = `(uname -v) 2>/dev/null || echo unknown` /usr/bin/uname -p = `(/usr/bin/uname -p) 2>/dev/null || echo unknown` /bin/uname -X = `(/bin/uname -X) 2>/dev/null || echo unknown` /bin/arch = `(/bin/arch) 2>/dev/null || echo unknown` /usr/bin/arch -k = `(/usr/bin/arch -k) 2>/dev/null || echo unknown` /usr/convex/getsysinfo = `(/usr/convex/getsysinfo) 2>/dev/null || echo unknown` /usr/bin/hostinfo = `(/usr/bin/hostinfo) 2>/dev/null || echo unknown` /bin/machine = `(/bin/machine) 2>/dev/null || echo unknown` /usr/bin/oslevel = `(/usr/bin/oslevel) 2>/dev/null || echo unknown` /bin/universe = `(/bin/universe) 2>/dev/null || echo unknown` _ASUNAME as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. $as_echo "PATH: $as_dir" done IFS=$as_save_IFS } >&5 cat >&5 <<_ACEOF ## ----------- ## ## Core tests. ## ## ----------- ## _ACEOF # Keep a trace of the command line. # Strip out --no-create and --no-recursion so they do not pile up. # Strip out --silent because we don't want to record it for future runs. # Also quote any args containing shell meta-characters. # Make two passes to allow for proper duplicate-argument suppression. ac_configure_args= ac_configure_args0= ac_configure_args1= ac_must_keep_next=false for ac_pass in 1 2 do for ac_arg do case $ac_arg in -no-create | --no-c* | -n | -no-recursion | --no-r*) continue ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil) continue ;; *\'*) ac_arg=`$as_echo "$ac_arg" | sed "s/'/'\\\\\\\\''/g"` ;; esac case $ac_pass in 1) as_fn_append ac_configure_args0 " '$ac_arg'" ;; 2) as_fn_append ac_configure_args1 " '$ac_arg'" if test $ac_must_keep_next = true; then ac_must_keep_next=false # Got value, back to normal. else case $ac_arg in *=* | --config-cache | -C | -disable-* | --disable-* \ | -enable-* | --enable-* | -gas | --g* | -nfp | --nf* \ | -q | -quiet | --q* | -silent | --sil* | -v | -verb* \ | -with-* | --with-* | -without-* | --without-* | --x) case "$ac_configure_args0 " in "$ac_configure_args1"*" '$ac_arg' "* ) continue ;; esac ;; -* ) ac_must_keep_next=true ;; esac fi as_fn_append ac_configure_args " '$ac_arg'" ;; esac done done { ac_configure_args0=; unset ac_configure_args0;} { ac_configure_args1=; unset ac_configure_args1;} # When interrupted or exit'd, cleanup temporary files, and complete # config.log. We remove comments because anyway the quotes in there # would cause problems or look ugly. # WARNING: Use '\'' to represent an apostrophe within the trap. # WARNING: Do not start the trap code with a newline, due to a FreeBSD 4.0 bug. trap 'exit_status=$? # Save into config.log some information that might help in debugging. { echo $as_echo "## ---------------- ## ## Cache variables. ## ## ---------------- ##" echo # The following way of writing the cache mishandles newlines in values, ( for ac_var in `(set) 2>&1 | sed -n '\''s/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'\''`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space='\'' '\''; set) 2>&1` in #( *${as_nl}ac_space=\ *) sed -n \ "s/'\''/'\''\\\\'\'''\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\''\\2'\''/p" ;; #( *) sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) echo $as_echo "## ----------------- ## ## Output variables. ## ## ----------------- ##" echo for ac_var in $ac_subst_vars do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo if test -n "$ac_subst_files"; then $as_echo "## ------------------- ## ## File substitutions. ## ## ------------------- ##" echo for ac_var in $ac_subst_files do eval ac_val=\$$ac_var case $ac_val in *\'\''*) ac_val=`$as_echo "$ac_val" | sed "s/'\''/'\''\\\\\\\\'\'''\''/g"`;; esac $as_echo "$ac_var='\''$ac_val'\''" done | sort echo fi if test -s confdefs.h; then $as_echo "## ----------- ## ## confdefs.h. ## ## ----------- ##" echo cat confdefs.h echo fi test "$ac_signal" != 0 && $as_echo "$as_me: caught signal $ac_signal" $as_echo "$as_me: exit $exit_status" } >&5 rm -f core *.core core.conftest.* && rm -f -r conftest* confdefs* conf$$* $ac_clean_files && exit $exit_status ' 0 for ac_signal in 1 2 13 15; do trap 'ac_signal='$ac_signal'; as_fn_exit 1' $ac_signal done ac_signal=0 # confdefs.h avoids OS command line length limits that DEFS can exceed. rm -f -r conftest* confdefs.h $as_echo "/* confdefs.h */" > confdefs.h # Predefined preprocessor variables. cat >>confdefs.h <<_ACEOF #define PACKAGE_NAME "$PACKAGE_NAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_TARNAME "$PACKAGE_TARNAME" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_VERSION "$PACKAGE_VERSION" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_STRING "$PACKAGE_STRING" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_BUGREPORT "$PACKAGE_BUGREPORT" _ACEOF cat >>confdefs.h <<_ACEOF #define PACKAGE_URL "$PACKAGE_URL" _ACEOF # Let the site file select an alternate cache file if it wants to. # Prefer an explicitly selected file to automatically selected ones. ac_site_file1=NONE ac_site_file2=NONE if test -n "$CONFIG_SITE"; then # We do not want a PATH search for config.site. case $CONFIG_SITE in #(( -*) ac_site_file1=./$CONFIG_SITE;; */*) ac_site_file1=$CONFIG_SITE;; *) ac_site_file1=./$CONFIG_SITE;; esac elif test "x$prefix" != xNONE; then ac_site_file1=$prefix/share/config.site ac_site_file2=$prefix/etc/config.site else ac_site_file1=$ac_default_prefix/share/config.site ac_site_file2=$ac_default_prefix/etc/config.site fi for ac_site_file in "$ac_site_file1" "$ac_site_file2" do test "x$ac_site_file" = xNONE && continue if test /dev/null != "$ac_site_file" && test -r "$ac_site_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading site script $ac_site_file" >&5 $as_echo "$as_me: loading site script $ac_site_file" >&6;} sed 's/^/| /' "$ac_site_file" >&5 . "$ac_site_file" \ || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file See \`config.log' for more details" "$LINENO" 5; } fi done if test -r "$cache_file"; then # Some versions of bash will fail to source /dev/null (special files # actually), so we avoid doing that. DJGPP emulates it as a regular file. if test /dev/null != "$cache_file" && test -f "$cache_file"; then { $as_echo "$as_me:${as_lineno-$LINENO}: loading cache $cache_file" >&5 $as_echo "$as_me: loading cache $cache_file" >&6;} case $cache_file in [\\/]* | ?:[\\/]* ) . "$cache_file";; *) . "./$cache_file";; esac fi else { $as_echo "$as_me:${as_lineno-$LINENO}: creating cache $cache_file" >&5 $as_echo "$as_me: creating cache $cache_file" >&6;} >$cache_file fi # Check that the precious variables saved in the cache have kept the same # value. ac_cache_corrupted=false for ac_var in $ac_precious_vars; do eval ac_old_set=\$ac_cv_env_${ac_var}_set eval ac_new_set=\$ac_env_${ac_var}_set eval ac_old_val=\$ac_cv_env_${ac_var}_value eval ac_new_val=\$ac_env_${ac_var}_value case $ac_old_set,$ac_new_set in set,) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was set to \`$ac_old_val' in the previous run" >&2;} ac_cache_corrupted=: ;; ,set) { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' was not set in the previous run" >&5 $as_echo "$as_me: error: \`$ac_var' was not set in the previous run" >&2;} ac_cache_corrupted=: ;; ,);; *) if test "x$ac_old_val" != "x$ac_new_val"; then # differences in whitespace do not lead to failure. ac_old_val_w=`echo x $ac_old_val` ac_new_val_w=`echo x $ac_new_val` if test "$ac_old_val_w" != "$ac_new_val_w"; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: \`$ac_var' has changed since the previous run:" >&5 $as_echo "$as_me: error: \`$ac_var' has changed since the previous run:" >&2;} ac_cache_corrupted=: else { $as_echo "$as_me:${as_lineno-$LINENO}: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&5 $as_echo "$as_me: warning: ignoring whitespace changes in \`$ac_var' since the previous run:" >&2;} eval $ac_var=\$ac_old_val fi { $as_echo "$as_me:${as_lineno-$LINENO}: former value: \`$ac_old_val'" >&5 $as_echo "$as_me: former value: \`$ac_old_val'" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: current value: \`$ac_new_val'" >&5 $as_echo "$as_me: current value: \`$ac_new_val'" >&2;} fi;; esac # Pass precious variables to config.status. if test "$ac_new_set" = set; then case $ac_new_val in *\'*) ac_arg=$ac_var=`$as_echo "$ac_new_val" | sed "s/'/'\\\\\\\\''/g"` ;; *) ac_arg=$ac_var=$ac_new_val ;; esac case " $ac_configure_args " in *" '$ac_arg' "*) ;; # Avoid dups. Use of quotes ensures accuracy. *) as_fn_append ac_configure_args " '$ac_arg'" ;; esac fi done if $ac_cache_corrupted; then { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} { $as_echo "$as_me:${as_lineno-$LINENO}: error: changes in the environment can compromise the build" >&5 $as_echo "$as_me: error: changes in the environment can compromise the build" >&2;} as_fn_error $? "run \`make distclean' and/or \`rm $cache_file' and start over" "$LINENO" 5 fi ## -------------------- ## ## Main body of script. ## ## -------------------- ## ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu # Check for Ocaml compilers # we first look for ocamlc in the path; if not present, we fail # Extract the first word of "ocamlc", so it can be a program name with args. set dummy ocamlc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CAMLC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CAMLC"; then ac_cv_prog_CAMLC="$CAMLC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CAMLC="ocamlc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CAMLC" && ac_cv_prog_CAMLC="no" fi fi CAMLC=$ac_cv_prog_CAMLC if test -n "$CAMLC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLC" >&5 $as_echo "$CAMLC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$CAMLC" = no ; then as_fn_error $? "Cannot find ocamlc." "$LINENO" 5 fi # we extract Ocaml version number and library path OCAMLVERSION=`$CAMLC -version` echo "ocaml version is $OCAMLVERSION" OCAMLLIB=`$CAMLC -where | tr -d '\\r'` echo "ocaml library path is $OCAMLLIB" LIBDIR=$OCAMLLIB # Check whether --with-libdir was given. if test "${with_libdir+set}" = set; then : withval=$with_libdir; LIBDIR=$withval echo "Install dirs are : $LIBDIR/lablgtk2 and $LIBDIR/stublibs" echo " Compile with ocamlc -I $LIBDIR/lablgtk2 and add $LIBDIR/stublibs either to OCAMLLIB/ld.conf or to CAML_LD_LIBRARY_PATH" else echo "Default install dirs are : $LIBDIR/lablgtk2 and $LIBDIR/stublibs" echo "Compile with ocamlc -I +lablgtk2" fi # then we look for ocamlopt; if not present, we issue a warning # if the version is not the same, we also discard it # we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not # Extract the first word of "ocamlopt", so it can be a program name with args. set dummy ocamlopt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CAMLOPT+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CAMLOPT"; then ac_cv_prog_CAMLOPT="$CAMLOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CAMLOPT="ocamlopt" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CAMLOPT" && ac_cv_prog_CAMLOPT="no" fi fi CAMLOPT=$ac_cv_prog_CAMLOPT if test -n "$CAMLOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLOPT" >&5 $as_echo "$CAMLOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi OCAMLBEST=byte if test "$CAMLOPT" = no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find ocamlopt; bytecode compilation only." >&5 $as_echo "$as_me: WARNING: Cannot find ocamlopt; bytecode compilation only." >&2;} else { $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlopt version" >&5 $as_echo_n "checking ocamlopt version... " >&6; } TMPVERSION=`$CAMLOPT -version` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlopt discarded." >&5 $as_echo "differs from ocamlc; ocamlopt discarded." >&6; } CAMLOPT=no else { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 $as_echo "ok" >&6; } OCAMLBEST=opt fi fi # checking for ocamlc.opt # Extract the first word of "ocamlc.opt", so it can be a program name with args. set dummy ocamlc.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLCDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLCDOTOPT"; then ac_cv_prog_OCAMLCDOTOPT="$OCAMLCDOTOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLCDOTOPT="ocamlc.opt" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLCDOTOPT" && ac_cv_prog_OCAMLCDOTOPT="no" fi fi OCAMLCDOTOPT=$ac_cv_prog_OCAMLCDOTOPT if test -n "$OCAMLCDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLCDOTOPT" >&5 $as_echo "$OCAMLCDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLCDOTOPT" != no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlc.opt version" >&5 $as_echo_n "checking ocamlc.opt version... " >&6; } TMPVERSION=`$OCAMLCDOTOPT -version` if test "$TMPVERSION" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlc.opt discarded." >&5 $as_echo "differs from ocamlc; ocamlc.opt discarded." >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 $as_echo "ok" >&6; } CAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$CAMLOPT" != no ; then # Extract the first word of "ocamlopt.opt", so it can be a program name with args. set dummy ocamlopt.opt; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLOPTDOTOPT+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLOPTDOTOPT"; then ac_cv_prog_OCAMLOPTDOTOPT="$OCAMLOPTDOTOPT" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLOPTDOTOPT="ocamlopt.opt" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLOPTDOTOPT" && ac_cv_prog_OCAMLOPTDOTOPT="no" fi fi OCAMLOPTDOTOPT=$ac_cv_prog_OCAMLOPTDOTOPT if test -n "$OCAMLOPTDOTOPT"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLOPTDOTOPT" >&5 $as_echo "$OCAMLOPTDOTOPT" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLOPTDOTOPT" != no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking ocamlc.opt version" >&5 $as_echo_n "checking ocamlc.opt version... " >&6; } TMPVER=`$OCAMLOPTDOTOPT -version` if test "$TMPVER" != "$OCAMLVERSION" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: differs from ocamlc; ocamlopt.opt discarded." >&5 $as_echo "differs from ocamlc; ocamlopt.opt discarded." >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: ok" >&5 $as_echo "ok" >&6; } CAMLOPT=$OCAMLOPTDOTOPT fi fi fi # ocamlrun, ocamldep, ocamllex and ocamlyacc should also be present in the path # Extract the first word of "ocamlrun", so it can be a program name with args. set dummy ocamlrun; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLRUN+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLRUN"; then ac_cv_prog_OCAMLRUN="$OCAMLRUN" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLRUN="ocamlrun" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLRUN" && ac_cv_prog_OCAMLRUN="no" fi fi OCAMLRUN=$ac_cv_prog_OCAMLRUN if test -n "$OCAMLRUN"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLRUN" >&5 $as_echo "$OCAMLRUN" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLRUN" = no ; then as_fn_error $? "Cannot find ocamlrun." "$LINENO" 5 fi # Extract the first word of "ocamldep", so it can be a program name with args. set dummy ocamldep; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLDEP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLDEP"; then ac_cv_prog_OCAMLDEP="$OCAMLDEP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLDEP="ocamldep" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLDEP" && ac_cv_prog_OCAMLDEP="no" fi fi OCAMLDEP=$ac_cv_prog_OCAMLDEP if test -n "$OCAMLDEP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDEP" >&5 $as_echo "$OCAMLDEP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLDEP" = no ; then as_fn_error $? "Cannot find ocamldep." "$LINENO" 5 fi # Extract the first word of "ocamldoc", so it can be a program name with args. set dummy ocamldoc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLDOC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLDOC"; then ac_cv_prog_OCAMLDOC="$OCAMLDOC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLDOC="ocamldoc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLDOC" && ac_cv_prog_OCAMLDOC="no" fi fi OCAMLDOC=$ac_cv_prog_OCAMLDOC if test -n "$OCAMLDOC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLDOC" >&5 $as_echo "$OCAMLDOC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLDOC" = no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: Cannot find ocamldoc." >&5 $as_echo "Cannot find ocamldoc." >&6; } fi # Extract the first word of "ocamllex", so it can be a program name with args. set dummy ocamllex; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLLEX+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLLEX"; then ac_cv_prog_OCAMLLEX="$OCAMLLEX" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLLEX="ocamllex" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLLEX" && ac_cv_prog_OCAMLLEX="no" fi fi OCAMLLEX=$ac_cv_prog_OCAMLLEX if test -n "$OCAMLLEX"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLLEX" >&5 $as_echo "$OCAMLLEX" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLLEX" = no ; then as_fn_error $? "Cannot find ocamllex." "$LINENO" 5 #else # AC_CHECK_PROG(OCAMLLEXDOTOPT,ocamllex.opt,ocamllex.opt,no) # if test "$OCAMLLEXDOTOPT" != no ; then # OCAMLLEX=$OCAMLLEXDOTOPT # fi fi # Extract the first word of "ocamlyacc", so it can be a program name with args. set dummy ocamlyacc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLYACC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLYACC"; then ac_cv_prog_OCAMLYACC="$OCAMLYACC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLYACC="ocamlyacc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLYACC" && ac_cv_prog_OCAMLYACC="no" fi fi OCAMLYACC=$ac_cv_prog_OCAMLYACC if test -n "$OCAMLYACC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLYACC" >&5 $as_echo "$OCAMLYACC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$OCAMLYACC" = no ; then as_fn_error $? "Cannot find ocamlyacc." "$LINENO" 5 fi # Extract the first word of "ocamlmktop", so it can be a program name with args. set dummy ocamlmktop; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CAMLMKTOP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CAMLMKTOP"; then ac_cv_prog_CAMLMKTOP="$CAMLMKTOP" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CAMLMKTOP="ocamlmktop" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CAMLMKTOP" && ac_cv_prog_CAMLMKTOP="no" fi fi CAMLMKTOP=$ac_cv_prog_CAMLMKTOP if test -n "$CAMLMKTOP"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLMKTOP" >&5 $as_echo "$CAMLMKTOP" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$CAMLMKTOP" = no ; then as_fn_error $? "Cannot find ocamlmktop." "$LINENO" 5 fi # Extract the first word of "ocamlmklib", so it can be a program name with args. set dummy ocamlmklib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CAMLMKLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CAMLMKLIB"; then ac_cv_prog_CAMLMKLIB="$CAMLMKLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CAMLMKLIB="ocamlmklib" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CAMLMKLIB" && ac_cv_prog_CAMLMKLIB="no" fi fi CAMLMKLIB=$ac_cv_prog_CAMLMKLIB if test -n "$CAMLMKLIB"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLMKLIB" >&5 $as_echo "$CAMLMKLIB" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$CAMLMKLIB" = no ; then as_fn_error $? "Cannot find ocamlmklib." "$LINENO" 5 fi # Extract the first word of "camlp4o", so it can be a program name with args. set dummy camlp4o; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CAMLP4O+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CAMLP4O"; then ac_cv_prog_CAMLP4O="$CAMLP4O" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CAMLP4O="camlp4o" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_CAMLP4O" && ac_cv_prog_CAMLP4O="no" fi fi CAMLP4O=$ac_cv_prog_CAMLP4O if test -n "$CAMLP4O"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CAMLP4O" >&5 $as_echo "$CAMLP4O" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "$CAMLP4O" = no ; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Cannot find camlp4o; please do not modify .ml4 files." >&5 $as_echo "$as_me: WARNING: Cannot find camlp4o; please do not modify .ml4 files." >&2;} fi # Extract the first word of "ocamlfind", so it can be a program name with args. set dummy ocamlfind; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_OCAMLFIND+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$OCAMLFIND"; then ac_cv_prog_OCAMLFIND="$OCAMLFIND" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_OCAMLFIND="ocamlfind" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_prog_OCAMLFIND" && ac_cv_prog_OCAMLFIND="no" fi fi OCAMLFIND=$ac_cv_prog_OCAMLFIND if test -n "$OCAMLFIND"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $OCAMLFIND" >&5 $as_echo "$OCAMLFIND" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "`$OCAMLFIND printconf stdlib`" != "`$CAMLC -where`"; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: Ignoring ocamlfind" >&5 $as_echo "$as_me: WARNING: Ignoring ocamlfind" >&2;} OCAMLFIND=no fi if test "$OCAMLFIND" = no; then FINDLIBDIR="" OCAMLLDCONF="" else FINDLIBDIR="`ocamlfind printconf destdir | tr -d '\\r'`" echo "$OCAMLFIND library path is $FINDLIBDIR" OCAMLLDCONF="`ocamlfind printconf ldconf | tr -d '\\r'`" echo "$OCAMLFIND ldconf path is $OCAMLLDCONF" fi if expr "$OCAMLVERSION" '>=' '4' > /dev/null ; then ODOC_DEF="-D OCAML_400" fi if expr "$OCAMLVERSION" '>=' '3.11' > /dev/null ; then HAS_PRINTEXC_BACKTRACE="-D HAS_PRINTEXC_BACKTRACE" fi # Check for which kind of threads is used { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ocaml threads" >&5 $as_echo_n "checking for ocaml threads... " >&6; } # Check whether --with-threads was given. if test "${with_threads+set}" = set; then : withval=$with_threads; THREADS_LIB="$withval" else THREADS_LIB="yes" fi if (test "$THREADS_LIB" = yes || test "$THREADS_LIB" = system) && \ test -r "$OCAMLLIB/threads/threads.cma"; then THREADS_LIB="system" elif (test "$THREADS_LIB" = yes || test "$THREADS_LIB" = vm) && \ test -r "$OCAMLLIB/vmthreads/stdlib.cma"; then THREADS_LIB="vm" elif test "$THREADS_LIB" = yes || test "$THREADS_LIB" = no; then THREADS_LIB="no" else echo; as_fn_error $? "Cannot use $THREADS_LIB threads" "$LINENO" 5 fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: use $THREADS_LIB threads" >&5 $as_echo "use $THREADS_LIB threads" >&6; } # Check for dll support HAS_DLL_SUPPORT="no" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ocaml dll support" >&5 $as_echo_n "checking for ocaml dll support... " >&6; } if test -r "$OCAMLLIB/stublibs/dllunix.so" || test -r "$OCAMLLIB/stublibs/dllunix.dll" then HAS_DLL_SUPPORT="yes" fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $HAS_DLL_SUPPORT" >&5 $as_echo "$HAS_DLL_SUPPORT" >&6; } RANLIB=`$CAMLC -config | grep ranlib | sed -e "s/ranlib: \(.*\)/\1/" ` if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}ranlib", so it can be a program name with args. set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then ac_cv_prog_RANLIB="$RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_RANLIB="${ac_tool_prefix}ranlib" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi RANLIB=$ac_cv_prog_RANLIB if test -n "$RANLIB"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $RANLIB" >&5 $as_echo "$RANLIB" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_prog_RANLIB"; then ac_ct_RANLIB=$RANLIB # Extract the first word of "ranlib", so it can be a program name with args. set dummy ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then ac_cv_prog_ac_ct_RANLIB="$ac_ct_RANLIB" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_RANLIB="ranlib" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_RANLIB=$ac_cv_prog_ac_ct_RANLIB if test -n "$ac_ct_RANLIB"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_RANLIB" >&5 $as_echo "$ac_ct_RANLIB" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_ct_RANLIB" = x; then RANLIB=":" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac RANLIB=$ac_ct_RANLIB fi else RANLIB="$ac_cv_prog_RANLIB" fi # get the C compiler used by ocamlc if test -z "$CC" ; then touch conftest.c CC=$($CAMLC -verbose -c conftest.c 2>&1 | head -1 | sed 's/^+ \([^ ]*\) .*$/\1/') echo OCaml uses $CC to compile C files fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}gcc", so it can be a program name with args. set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_prog_CC"; then ac_ct_CC=$CC # Extract the first word of "gcc", so it can be a program name with args. set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="gcc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 $as_echo "$ac_ct_CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi else CC="$ac_cv_prog_CC" fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}cc", so it can be a program name with args. set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="${ac_tool_prefix}cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi fi if test -z "$CC"; then # Extract the first word of "cc", so it can be a program name with args. set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else ac_prog_rejected=no as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then if test "$as_dir/$ac_word$ac_exec_ext" = "/usr/ucb/cc"; then ac_prog_rejected=yes continue fi ac_cv_prog_CC="cc" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS if test $ac_prog_rejected = yes; then # We found a bogon in the path, so make sure we never use it. set dummy $ac_cv_prog_CC shift if test $# != 0; then # We chose a different compiler from the bogus one. # However, it has the same basename, so the bogon will be chosen # first if we set CC to just the basename; use the full file name. shift ac_cv_prog_CC="$as_dir/$ac_word${1+' '}$@" fi fi fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$CC"; then if test -n "$ac_tool_prefix"; then for ac_prog in cl.exe do # Extract the first word of "$ac_tool_prefix$ac_prog", so it can be a program name with args. set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then ac_cv_prog_CC="$CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_CC="$ac_tool_prefix$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi CC=$ac_cv_prog_CC if test -n "$CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $CC" >&5 $as_echo "$CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$CC" && break done fi if test -z "$CC"; then ac_ct_CC=$CC for ac_prog in cl.exe do # Extract the first word of "$ac_prog", so it can be a program name with args. set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then ac_cv_prog_ac_ct_CC="$ac_ct_CC" # Let the user override the test. else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_prog_ac_ct_CC="$ac_prog" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS fi fi ac_ct_CC=$ac_cv_prog_ac_ct_CC if test -n "$ac_ct_CC"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ct_CC" >&5 $as_echo "$ac_ct_CC" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi test -n "$ac_ct_CC" && break done if test "x$ac_ct_CC" = x; then CC="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac CC=$ac_ct_CC fi fi fi test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 set X $ac_compile ac_compiler=$2 for ac_option in --version -v -V -qversion; do { { ac_try="$ac_compiler $ac_option >&5" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compiler $ac_option >&5") 2>conftest.err ac_status=$? if test -s conftest.err; then sed '10a\ ... rest of stderr output deleted ... 10q' conftest.err >conftest.er1 cat conftest.er1 >&5 fi rm -f conftest.er1 conftest.err $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } done cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files a.out a.out.dSYM a.exe b.out" # Try to create an executable without -o first, disregard a.out. # It will help us diagnose broken compilers, and finding out an intuition # of exeext. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the C compiler works" >&5 $as_echo_n "checking whether the C compiler works... " >&6; } ac_link_default=`$as_echo "$ac_link" | sed 's/ -o *conftest[^ ]*//'` # The possible output files: ac_files="a.out conftest.exe conftest a.exe a_out.exe b.out conftest.*" ac_rmfiles= for ac_file in $ac_files do case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; * ) ac_rmfiles="$ac_rmfiles $ac_file";; esac done rm -f $ac_rmfiles if { { ac_try="$ac_link_default" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link_default") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : # Autoconf-2.13 could set the ac_cv_exeext variable to `no'. # So ignore a value of `no', otherwise this would lead to `EXEEXT = no' # in a Makefile. We should not override ac_cv_exeext if it was cached, # so that the user can short-circuit this test for compilers unknown to # Autoconf. for ac_file in $ac_files '' do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; [ab].out ) # We found the default executable, but exeext='' is most # certainly right. break;; *.* ) if test "${ac_cv_exeext+set}" = set && test "$ac_cv_exeext" != no; then :; else ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` fi # We set ac_cv_exeext here because the later test for it is not # safe: cross compilers may not add the suffix if given an `-o' # argument, so we may need to know it at that point already. # Even if this section looks crufty: it has the advantage of # actually working. break;; * ) break;; esac done test "$ac_cv_exeext" = no && ac_cv_exeext= else ac_file='' fi if test -z "$ac_file"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler default output file name" >&5 $as_echo_n "checking for C compiler default output file name... " >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_file" >&5 $as_echo "$ac_file" >&6; } ac_exeext=$ac_cv_exeext rm -f -r a.out a.out.dSYM a.exe conftest$ac_cv_exeext b.out ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of executables" >&5 $as_echo_n "checking for suffix of executables... " >&6; } if { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : # If both `conftest.exe' and `conftest' are `present' (well, observable) # catch `conftest.exe'. For instance with Cygwin, `ls conftest' will # work properly (i.e., refer to `conftest.exe'), while it won't with # `rm'. for ac_file in conftest.exe conftest conftest.*; do test -f "$ac_file" || continue case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM | *.o | *.obj ) ;; *.* ) ac_cv_exeext=`expr "$ac_file" : '[^.]*\(\..*\)'` break;; * ) break;; esac done else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 $as_echo "$ac_cv_exeext" >&6; } rm -f conftest.$ac_ext EXEEXT=$ac_cv_exeext ac_exeext=$EXEEXT cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include int main () { FILE *f = fopen ("conftest.out", "w"); return ferror (f) || fclose (f) != 0; ; return 0; } _ACEOF ac_clean_files="$ac_clean_files conftest.out" # Check that the compiler produces executables we can run. If not, either # the compiler is broken, or we cross compile. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are cross compiling" >&5 $as_echo_n "checking whether we are cross compiling... " >&6; } if test "$cross_compiling" != yes; then { { ac_try="$ac_link" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_link") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; } if { ac_try='./conftest$ac_cv_exeext' { { case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_try") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; }; then cross_compiling=no else if test "$cross_compiling" = maybe; then cross_compiling=yes else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. See \`config.log' for more details" "$LINENO" 5; } fi fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $cross_compiling" >&5 $as_echo "$cross_compiling" >&6; } rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; } if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF rm -f conftest.o conftest.obj if { { ac_try="$ac_compile" case "(($ac_try" in *\"* | *\`* | *\\*) ac_try_echo=\$ac_try;; *) ac_try_echo=$ac_try;; esac eval ac_try_echo="\"\$as_me:${as_lineno-$LINENO}: $ac_try_echo\"" $as_echo "$ac_try_echo"; } >&5 (eval "$ac_compile") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then : for ac_file in conftest.o conftest.obj conftest.*; do test -f "$ac_file" || continue; case $ac_file in *.$ac_ext | *.xcoff | *.tds | *.d | *.pdb | *.xSYM | *.bb | *.bbg | *.map | *.inf | *.dSYM ) ;; *) ac_cv_objext=`expr "$ac_file" : '.*\.\(.*\)'` break;; esac done else $as_echo "$as_me: failed program was:" >&5 sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_objext" >&5 $as_echo "$ac_cv_objext" >&6; } OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { #ifndef __GNUC__ choke me #endif ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_compiler_gnu=yes else ac_compiler_gnu=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_cv_c_compiler_gnu=$ac_compiler_gnu fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_c_compiler_gnu" >&5 $as_echo "$ac_cv_c_compiler_gnu" >&6; } if test $ac_compiler_gnu = yes; then GCC=yes else GCC= fi ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag ac_c_werror_flag=yes ac_cv_prog_cc_g=no CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes else CFLAGS="" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : else ac_c_werror_flag=$ac_save_c_werror_flag CFLAGS="-g" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_g=yes fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext ac_c_werror_flag=$ac_save_c_werror_flag fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_g" >&5 $as_echo "$ac_cv_prog_cc_g" >&6; } if test "$ac_test_CFLAGS" = set; then CFLAGS=$ac_save_CFLAGS elif test $ac_cv_prog_cc_g = yes; then if test "$GCC" = yes; then CFLAGS="-g -O2" else CFLAGS="-g" fi else if test "$GCC" = yes; then CFLAGS="-O2" else CFLAGS= fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no ac_save_CC=$CC cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include struct stat; /* Most of the following tests are stolen from RCS 5.7's src/conf.sh. */ struct buf { int x; }; FILE * (*rcsopen) (struct buf *, struct stat *, int); static char *e (p, i) char **p; int i; { return p[i]; } static char *f (char * (*g) (char **, int), char **p, ...) { char *s; va_list v; va_start (v,p); s = g (p, va_arg (v,int)); va_end (v); return s; } /* OSF 4.0 Compaq cc is some sort of almost-ANSI by default. It has function prototypes and stuff, but not '\xHH' hex character constants. These don't provoke an error unfortunately, instead are silently treated as 'x'. The following induces an error, until -std is added to get proper ANSI mode. Curiously '\x00'!='x' always comes out true, for an array size at least. It's necessary to write '\x00'==0 to get something that's true only with -std. */ int osf4_cc_array ['\x00' == 0 ? 1 : -1]; /* IBM C 6 for AIX is almost-ANSI by default, but it replaces macro parameters inside strings and character constants. */ #define FOO(x) 'x' int xlc6_cc_array[FOO(a) == 'x' ? 1 : -1]; int test (int i, double x); struct s1 {int (*f) (int a);}; struct s2 {int (*f) (double a);}; int pairnames (int, char **, FILE *(*)(struct buf *, struct stat *, int), int, int); int argc; char **argv; int main () { return f (e, argv, 0) != argv[0] || f (e, argv, 1) != argv[1]; ; return 0; } _ACEOF for ac_arg in '' -qlanglvl=extc89 -qlanglvl=ansi -std \ -Ae "-Aa -D_HPUX_SOURCE" "-Xc -D__EXTENSIONS__" do CC="$ac_save_CC $ac_arg" if ac_fn_c_try_compile "$LINENO"; then : ac_cv_prog_cc_c89=$ac_arg fi rm -f core conftest.err conftest.$ac_objext test "x$ac_cv_prog_cc_c89" != "xno" && break done rm -f conftest.$ac_ext CC=$ac_save_CC fi # AC_CACHE_VAL case "x$ac_cv_prog_cc_c89" in x) { $as_echo "$as_me:${as_lineno-$LINENO}: result: none needed" >&5 $as_echo "none needed" >&6; } ;; xno) { $as_echo "$as_me:${as_lineno-$LINENO}: result: unsupported" >&5 $as_echo "unsupported" >&6; } ;; *) CC="$CC $ac_cv_prog_cc_c89" { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_prog_cc_c89" >&5 $as_echo "$ac_cv_prog_cc_c89" >&6; } ;; esac if test "x$ac_cv_prog_cc_c89" != xno; then : fi ac_ext=c ac_cpp='$CPP $CPPFLAGS' ac_compile='$CC -c $CFLAGS $CPPFLAGS conftest.$ac_ext >&5' ac_link='$CC -o conftest$ac_exeext $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext $LIBS >&5' ac_compiler_gnu=$ac_cv_c_compiler_gnu OCAML_CC_EXTRA_FLAGS= { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether C compiler accepts -fno-unwind-tables" >&5 $as_echo_n "checking whether C compiler accepts -fno-unwind-tables... " >&6; } if ${ax_cv_check_cflags___fno_unwind_tables+:} false; then : $as_echo_n "(cached) " >&6 else ax_check_save_flags=$CFLAGS CFLAGS="$CFLAGS -fno-unwind-tables" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ int main () { ; return 0; } _ACEOF if ac_fn_c_try_compile "$LINENO"; then : ax_cv_check_cflags___fno_unwind_tables=yes else ax_cv_check_cflags___fno_unwind_tables=no fi rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext CFLAGS=$ax_check_save_flags fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ax_cv_check_cflags___fno_unwind_tables" >&5 $as_echo "$ax_cv_check_cflags___fno_unwind_tables" >&6; } if test "x$ax_cv_check_cflags___fno_unwind_tables" = xyes; then : OCAML_CC_EXTRA_FLAGS=-fno-unwind-tables else : fi # platform { $as_echo "$as_me:${as_lineno-$LINENO}: checking platform" >&5 $as_echo_n "checking platform... " >&6; } echo "print_endline Sys.os_type ;;" > conftest.ml ac_ocaml_platform=$(ocaml conftest.ml | tr -d '\r') { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_ocaml_platform" >&5 $as_echo "$ac_ocaml_platform" >&6; } if test $ac_ocaml_platform = Win32 ; then OCAMLWIN32=yes EXE=.exe XS=.dll else OCAMLWIN32=no EXE= XS=.so fi # Working native Dynlink { $as_echo "$as_me:${as_lineno-$LINENO}: checking native dynlink" >&5 $as_echo_n "checking native dynlink... " >&6; } echo "Dynlink.loadfile \"foo\";;" > test_dynlink.ml if ($CAMLOPT -shared -o test_dynlink.cmxs test_dynlink.ml) 2> /dev/null ; then HAS_NATIVE_DYNLINK=yes else HAS_NATIVE_DYNLINK=no fi rm test_dynlink.* # GTK 2 auto configuration GTKPKG=gtk+-2.0 # Check whether --enable-gtktest was given. if test "${enable_gtktest+set}" = set; then : enableval=$enable_gtktest; else enable_gtktest=yes fi pkg_config_args=gtk+-2.0 for module in . do case "$module" in gthread) pkg_config_args="$pkg_config_args gthread-2.0" ;; esac done no_gtk="" # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS test -z "$ac_cv_path_PKG_CONFIG" && ac_cv_path_PKG_CONFIG="no" ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test x$PKG_CONFIG != xno ; then if pkg-config --atleast-pkgconfig-version 0.7 ; then : else echo "*** pkg-config too old; version 0.7 or better required." no_gtk=yes PKG_CONFIG=no fi else no_gtk=yes fi min_gtk_version=2.0.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTK+ - version >= $min_gtk_version" >&5 $as_echo_n "checking for GTK+ - version >= $min_gtk_version... " >&6; } if test x$PKG_CONFIG != xno ; then ## don't try to run the test against uninstalled libtool libs if $PKG_CONFIG --uninstalled $pkg_config_args; then echo "Will use uninstalled version of GTK+ found in PKG_CONFIG_PATH" enable_gtktest=no fi if $PKG_CONFIG --atleast-version $min_gtk_version $pkg_config_args; then : else no_gtk=yes fi fi if test x"$no_gtk" = x ; then GTK_CFLAGS=`$PKG_CONFIG $pkg_config_args --cflags` GTK_LIBS=`$PKG_CONFIG $pkg_config_args --libs` gtk_config_major_version=`$PKG_CONFIG --modversion gtk+-2.0 | \ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\1/'` gtk_config_minor_version=`$PKG_CONFIG --modversion gtk+-2.0 | \ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\2/'` gtk_config_micro_version=`$PKG_CONFIG --modversion gtk+-2.0 | \ sed 's/\([0-9]*\).\([0-9]*\).\([0-9]*\)/\3/'` if test "x$enable_gtktest" = "xyes" ; then ac_save_CFLAGS="$CFLAGS" ac_save_LIBS="$LIBS" CFLAGS="$CFLAGS $GTK_CFLAGS" LIBS="$GTK_LIBS $LIBS" rm -f conf.gtktest if test "$cross_compiling" = yes; then : echo $ac_n "cross compiling; assumed OK... $ac_c" else cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include #include int main () { int major, minor, micro; char *tmp_version; fclose (fopen ("conf.gtktest", "w")); /* HP/UX 9 (%@#!) writes to sscanf strings */ tmp_version = g_strdup("$min_gtk_version"); if (sscanf(tmp_version, "%d.%d.%d", &major, &minor, µ) != 3) { printf("%s, bad version string\n", "$min_gtk_version"); exit(1); } if ((gtk_major_version != $gtk_config_major_version) || (gtk_minor_version != $gtk_config_minor_version) || (gtk_micro_version != $gtk_config_micro_version)) { printf("\n*** 'pkg-config --modversion gtk+-2.0' returned %d.%d.%d, but GTK+ (%d.%d.%d)\n", $gtk_config_major_version, $gtk_config_minor_version, $gtk_config_micro_version, gtk_major_version, gtk_minor_version, gtk_micro_version); printf ("*** was found! If pkg-config was correct, then it is best\n"); printf ("*** to remove the old version of GTK+. You may also be able to fix the error\n"); printf("*** by modifying your LD_LIBRARY_PATH enviroment variable, or by editing\n"); printf("*** /etc/ld.so.conf. Make sure you have run ldconfig if that is\n"); printf("*** required on your system.\n"); printf("*** If pkg-config was wrong, set the environment variable PKG_CONFIG_PATH\n"); printf("*** to point to the correct configuration files\n"); } else if ((gtk_major_version != GTK_MAJOR_VERSION) || (gtk_minor_version != GTK_MINOR_VERSION) || (gtk_micro_version != GTK_MICRO_VERSION)) { printf("*** GTK+ header files (version %d.%d.%d) do not match\n", GTK_MAJOR_VERSION, GTK_MINOR_VERSION, GTK_MICRO_VERSION); printf("*** library (version %d.%d.%d)\n", gtk_major_version, gtk_minor_version, gtk_micro_version); } else { if ((gtk_major_version > major) || ((gtk_major_version == major) && (gtk_minor_version > minor)) || ((gtk_major_version == major) && (gtk_minor_version == minor) && (gtk_micro_version >= micro))) { return 0; } else { printf("\n*** An old version of GTK+ (%d.%d.%d) was found.\n", gtk_major_version, gtk_minor_version, gtk_micro_version); printf("*** You need a version of GTK+ newer than %d.%d.%d. The latest version of\n", major, minor, micro); printf("*** GTK+ is always available from ftp://ftp.gtk.org.\n"); printf("***\n"); printf("*** If you have already installed a sufficiently new version, this error\n"); printf("*** probably means that the wrong copy of the pkg-config shell script is\n"); printf("*** being found. The easiest way to fix this is to remove the old version\n"); printf("*** of GTK+, but you can also set the PKG_CONFIG environment to point to the\n"); printf("*** correct copy of pkg-config. (In this case, you will have to\n"); printf("*** modify your LD_LIBRARY_PATH enviroment variable, or edit /etc/ld.so.conf\n"); printf("*** so that the correct libraries are found at run-time))\n"); } } return 1; } _ACEOF if ac_fn_c_try_run "$LINENO"; then : else no_gtk=yes fi rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ conftest.$ac_objext conftest.beam conftest.$ac_ext fi CFLAGS="$ac_save_CFLAGS" LIBS="$ac_save_LIBS" fi fi if test "x$no_gtk" = x ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes (version $gtk_config_major_version.$gtk_config_minor_version.$gtk_config_micro_version)" >&5 $as_echo "yes (version $gtk_config_major_version.$gtk_config_minor_version.$gtk_config_micro_version)" >&6; } : else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test "$PKG_CONFIG" = "no" ; then echo "*** A new enough version of pkg-config was not found." echo "*** See http://pkgconfig.sourceforge.net" else if test -f conf.gtktest ; then : else echo "*** Could not run GTK+ test program, checking why..." ac_save_CFLAGS="$CFLAGS" ac_save_LIBS="$LIBS" CFLAGS="$CFLAGS $GTK_CFLAGS" LIBS="$LIBS $GTK_LIBS" cat confdefs.h - <<_ACEOF >conftest.$ac_ext /* end confdefs.h. */ #include #include int main () { return ((gtk_major_version) || (gtk_minor_version) || (gtk_micro_version)); ; return 0; } _ACEOF if ac_fn_c_try_link "$LINENO"; then : echo "*** The test program compiled, but did not run. This usually means" echo "*** that the run-time linker is not finding GTK+ or finding the wrong" echo "*** version of GTK+. If it is not finding GTK+, you'll need to set your" echo "*** LD_LIBRARY_PATH environment variable, or edit /etc/ld.so.conf to point" echo "*** to the installed location Also, make sure you have run ldconfig if that" echo "*** is required on your system" echo "***" echo "*** If you have an old version installed, it is best to remove it, although" echo "*** you may also be able to get things to work by modifying LD_LIBRARY_PATH" else echo "*** The test program failed to compile or link. See the file config.log for the" echo "*** exact error that occured. This usually means GTK+ is incorrectly installed." fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext conftest.$ac_ext CFLAGS="$ac_save_CFLAGS" LIBS="$ac_save_LIBS" fi fi GTK_CFLAGS="" GTK_LIBS="" as_fn_error $? "GTK+ is required" "$LINENO" 5 fi rm -f conf.gtktest if test "x$ac_cv_env_PKG_CONFIG_set" != "xset"; then if test -n "$ac_tool_prefix"; then # Extract the first word of "${ac_tool_prefix}pkg-config", so it can be a program name with args. set dummy ${ac_tool_prefix}pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_PKG_CONFIG="$PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi PKG_CONFIG=$ac_cv_path_PKG_CONFIG if test -n "$PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $PKG_CONFIG" >&5 $as_echo "$PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi fi if test -z "$ac_cv_path_PKG_CONFIG"; then ac_pt_PKG_CONFIG=$PKG_CONFIG # Extract the first word of "pkg-config", so it can be a program name with args. set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } if ${ac_cv_path_ac_pt_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $ac_pt_PKG_CONFIG in [\\/]* | ?:[\\/]*) ac_cv_path_ac_pt_PKG_CONFIG="$ac_pt_PKG_CONFIG" # Let the user override the test with a path. ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. for ac_exec_ext in '' $ac_executable_extensions; do if as_fn_executable_p "$as_dir/$ac_word$ac_exec_ext"; then ac_cv_path_ac_pt_PKG_CONFIG="$as_dir/$ac_word$ac_exec_ext" $as_echo "$as_me:${as_lineno-$LINENO}: found $as_dir/$ac_word$ac_exec_ext" >&5 break 2 fi done done IFS=$as_save_IFS ;; esac fi ac_pt_PKG_CONFIG=$ac_cv_path_ac_pt_PKG_CONFIG if test -n "$ac_pt_PKG_CONFIG"; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_pt_PKG_CONFIG" >&5 $as_echo "$ac_pt_PKG_CONFIG" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } fi if test "x$ac_pt_PKG_CONFIG" = x; then PKG_CONFIG="" else case $cross_compiling:$ac_tool_warned in yes:) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: using cross tools not prefixed with host triplet" >&5 $as_echo "$as_me: WARNING: using cross tools not prefixed with host triplet" >&2;} ac_tool_warned=yes ;; esac PKG_CONFIG=$ac_pt_PKG_CONFIG fi else PKG_CONFIG="$ac_cv_path_PKG_CONFIG" fi fi if test -n "$PKG_CONFIG"; then _pkg_min_version=0.9.0 { $as_echo "$as_me:${as_lineno-$LINENO}: checking pkg-config is at least version $_pkg_min_version" >&5 $as_echo_n "checking pkg-config is at least version $_pkg_min_version... " >&6; } if $PKG_CONFIG --atleast-pkgconfig-version $_pkg_min_version; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } PKG_CONFIG="" fi fi # Check whether --with-gl was given. if test "${with_gl+set}" = set; then : withval=$with_gl; USE_GTKGL=$withval; FORCE_GTKGL=yes else USE_GTKGL=yes; FORCE_GTKGL=no fi if test $USE_GTKGL = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKGL" >&5 $as_echo_n "checking for GTKGL... " >&6; } if test -n "$GTKGL_CFLAGS"; then pkg_cv_GTKGL_CFLAGS="$GTKGL_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtkgl-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtkgl-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKGL_CFLAGS=`$PKG_CONFIG --cflags "gtkgl-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKGL_LIBS"; then pkg_cv_GTKGL_LIBS="$GTKGL_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtkgl-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtkgl-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKGL_LIBS=`$PKG_CONFIG --libs "gtkgl-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKGL_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "gtkgl-2.0" 2>&1` else GTKGL_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "gtkgl-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKGL_PKG_ERRORS" >&5 if test $FORCE_GTKGL = yes ; then as_fn_error $? "gl enforced but no support found" "$LINENO" 5 else USE_GTKGL=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GTKGL = yes ; then as_fn_error $? "gl enforced but no support found" "$LINENO" 5 else USE_GTKGL=no fi else GTKGL_CFLAGS=$pkg_cv_GTKGL_CFLAGS GTKGL_LIBS=$pkg_cv_GTKGL_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GTKGL = yes ; then USE_GTKGL=1 GTKGLPKG=gtkgl-2.0 else unset USE_GTKGL fi # Check for LablGL if test -n "$USE_GTKGL" ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking lablGL directory" >&5 $as_echo_n "checking lablGL directory... " >&6; } cat > conftest.ml << EOF open Raw EOF if $CAMLC -c -I "${LABLGLDIR:=+lablGL}" conftest.ml > /dev/null 2>&1 ; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: $LABLGLDIR" >&5 $as_echo "$LABLGLDIR" >&6; } else if test $FORCE_GTKGL = yes ; then as_fn_error $? "gtkgl enforced but lablGL not found" "$LINENO" 5 else { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } unset USE_GTKGL unset GTKGLPKG unset LABLGLDIR fi fi fi # Check whether --with-glade was given. if test "${with_glade+set}" = set; then : withval=$with_glade; USE_GLADE=$withval; FORCE_GLADE=yes else USE_GLADE=yes; FORCE_GLADE=no fi if test $USE_GLADE = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GLADE" >&5 $as_echo_n "checking for GLADE... " >&6; } if test -n "$GLADE_CFLAGS"; then pkg_cv_GLADE_CFLAGS="$GLADE_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libglade-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libglade-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GLADE_CFLAGS=`$PKG_CONFIG --cflags "libglade-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GLADE_LIBS"; then pkg_cv_GLADE_LIBS="$GLADE_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libglade-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libglade-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GLADE_LIBS=`$PKG_CONFIG --libs "libglade-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GLADE_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libglade-2.0" 2>&1` else GLADE_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libglade-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GLADE_PKG_ERRORS" >&5 if test $FORCE_GLADE = yes ; then as_fn_error $? "glade enforced but no support found" "$LINENO" 5 else USE_GLADE=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GLADE = yes ; then as_fn_error $? "glade enforced but no support found" "$LINENO" 5 else USE_GLADE=no fi else GLADE_CFLAGS=$pkg_cv_GLADE_CFLAGS GLADE_LIBS=$pkg_cv_GLADE_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GLADE = yes ; then USE_GLADE=1 GLADEPKG=libglade-2.0 else unset USE_GLADE fi # Check whether --with-rsvg was given. if test "${with_rsvg+set}" = set; then : withval=$with_rsvg; USE_RSVG=$withval; FORCE_RSVG=yes else USE_RSVG=yes; FORCE_RSVG=no fi if test $USE_RSVG = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for RSVG" >&5 $as_echo_n "checking for RSVG... " >&6; } if test -n "$RSVG_CFLAGS"; then pkg_cv_RSVG_CFLAGS="$RSVG_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"librsvg-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "librsvg-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_RSVG_CFLAGS=`$PKG_CONFIG --cflags "librsvg-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$RSVG_LIBS"; then pkg_cv_RSVG_LIBS="$RSVG_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"librsvg-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "librsvg-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_RSVG_LIBS=`$PKG_CONFIG --libs "librsvg-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then RSVG_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "librsvg-2.0" 2>&1` else RSVG_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "librsvg-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$RSVG_PKG_ERRORS" >&5 if test $FORCE_RSVG = yes ; then as_fn_error $? "rsvg enforced but no support found" "$LINENO" 5 else USE_RSVG=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_RSVG = yes ; then as_fn_error $? "rsvg enforced but no support found" "$LINENO" 5 else USE_RSVG=no fi else RSVG_CFLAGS=$pkg_cv_RSVG_CFLAGS RSVG_LIBS=$pkg_cv_RSVG_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_RSVG = yes ; then USE_RSVG=1 RSVGPKG=librsvg-2.0 else unset USE_RSVG fi # Check for SVGZ support if test -n "$USE_RSVG" ; then ac_ocaml_libs="$LIBS" LIBS="$LIBS $RSVG_LIBS" ac_fn_c_check_func "$LINENO" "rsvg_handle_new_gz" "ac_cv_func_rsvg_handle_new_gz" if test "x$ac_cv_func_rsvg_handle_new_gz" = xyes; then : HAVE_SVGZ=-DHAVE_SVGZ else unset HAVE_SVGZ fi # this tests seems broken on my ubuntu FF unset HAVE_SVGZ LIBS="$ac_ocaml_libs" else unset HAVE_SVGZ fi # Check whether --with-gnomecanvas was given. if test "${with_gnomecanvas+set}" = set; then : withval=$with_gnomecanvas; USE_GNOMECANVAS=$withval; FORCE_GNOMECANVAS=yes else USE_GNOMECANVAS=yes; FORCE_GNOMECANVAS=no fi if test $USE_GNOMECANVAS = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNOMECANVAS" >&5 $as_echo_n "checking for GNOMECANVAS... " >&6; } if test -n "$GNOMECANVAS_CFLAGS"; then pkg_cv_GNOMECANVAS_CFLAGS="$GNOMECANVAS_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libgnomecanvas-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libgnomecanvas-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GNOMECANVAS_CFLAGS=`$PKG_CONFIG --cflags "libgnomecanvas-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GNOMECANVAS_LIBS"; then pkg_cv_GNOMECANVAS_LIBS="$GNOMECANVAS_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libgnomecanvas-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libgnomecanvas-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GNOMECANVAS_LIBS=`$PKG_CONFIG --libs "libgnomecanvas-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GNOMECANVAS_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libgnomecanvas-2.0" 2>&1` else GNOMECANVAS_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libgnomecanvas-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GNOMECANVAS_PKG_ERRORS" >&5 if test $FORCE_GNOMECANVAS = yes ; then as_fn_error $? "gnomecanvas enforced but no support found" "$LINENO" 5 else USE_GNOMECANVAS=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GNOMECANVAS = yes ; then as_fn_error $? "gnomecanvas enforced but no support found" "$LINENO" 5 else USE_GNOMECANVAS=no fi else GNOMECANVAS_CFLAGS=$pkg_cv_GNOMECANVAS_CFLAGS GNOMECANVAS_LIBS=$pkg_cv_GNOMECANVAS_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GNOMECANVAS = yes ; then USE_GNOMECANVAS=1 GNOMECANVASPKG=libgnomecanvas-2.0 else unset USE_GNOMECANVAS fi # Check whether --with-gnomeui was given. if test "${with_gnomeui+set}" = set; then : withval=$with_gnomeui; USE_GNOMEUI=$withval; FORCE_GNOMEUI=yes else USE_GNOMEUI=yes; FORCE_GNOMEUI=no fi if test $USE_GNOMEUI = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GNOMEUI" >&5 $as_echo_n "checking for GNOMEUI... " >&6; } if test -n "$GNOMEUI_CFLAGS"; then pkg_cv_GNOMEUI_CFLAGS="$GNOMEUI_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libgnomeui-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libgnomeui-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GNOMEUI_CFLAGS=`$PKG_CONFIG --cflags "libgnomeui-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GNOMEUI_LIBS"; then pkg_cv_GNOMEUI_LIBS="$GNOMEUI_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libgnomeui-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libgnomeui-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GNOMEUI_LIBS=`$PKG_CONFIG --libs "libgnomeui-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GNOMEUI_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libgnomeui-2.0" 2>&1` else GNOMEUI_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libgnomeui-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GNOMEUI_PKG_ERRORS" >&5 if test $FORCE_GNOMEUI = yes ; then as_fn_error $? "gnomeui enforced but no support found" "$LINENO" 5 else USE_GNOMEUI=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GNOMEUI = yes ; then as_fn_error $? "gnomeui enforced but no support found" "$LINENO" 5 else USE_GNOMEUI=no fi else GNOMEUI_CFLAGS=$pkg_cv_GNOMEUI_CFLAGS GNOMEUI_LIBS=$pkg_cv_GNOMEUI_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GNOMEUI = yes ; then USE_GNOMEUI=1 GNOMEUIPKG=libgnomeui-2.0 else unset USE_GNOMEUI fi # Check whether --with-panel was given. if test "${with_panel+set}" = set; then : withval=$with_panel; USE_PANEL=$withval; FORCE_PANEL=yes else USE_PANEL=yes; FORCE_PANEL=no fi if test $USE_PANEL = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for PANEL" >&5 $as_echo_n "checking for PANEL... " >&6; } if test -n "$PANEL_CFLAGS"; then pkg_cv_PANEL_CFLAGS="$PANEL_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libpanelapplet-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libpanelapplet-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PANEL_CFLAGS=`$PKG_CONFIG --cflags "libpanelapplet-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$PANEL_LIBS"; then pkg_cv_PANEL_LIBS="$PANEL_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"libpanelapplet-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "libpanelapplet-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_PANEL_LIBS=`$PKG_CONFIG --libs "libpanelapplet-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then PANEL_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "libpanelapplet-2.0" 2>&1` else PANEL_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "libpanelapplet-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$PANEL_PKG_ERRORS" >&5 if test $FORCE_PANEL = yes ; then as_fn_error $? "panel enforced but no support found" "$LINENO" 5 else USE_PANEL=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_PANEL = yes ; then as_fn_error $? "panel enforced but no support found" "$LINENO" 5 else USE_PANEL=no fi else PANEL_CFLAGS=$pkg_cv_PANEL_CFLAGS PANEL_LIBS=$pkg_cv_PANEL_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_PANEL = yes ; then USE_PANEL=1 PANELPKG=libpanelapplet-2.0 else unset USE_PANEL fi # Check whether --with-gtkspell was given. if test "${with_gtkspell+set}" = set; then : withval=$with_gtkspell; USE_GTKSPELL=$withval; FORCE_GTKSPELL=yes else USE_GTKSPELL=yes; FORCE_GTKSPELL=no fi if test $USE_GTKSPELL = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKSPELL" >&5 $as_echo_n "checking for GTKSPELL... " >&6; } if test -n "$GTKSPELL_CFLAGS"; then pkg_cv_GTKSPELL_CFLAGS="$GTKSPELL_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtkspell-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtkspell-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSPELL_CFLAGS=`$PKG_CONFIG --cflags "gtkspell-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKSPELL_LIBS"; then pkg_cv_GTKSPELL_LIBS="$GTKSPELL_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtkspell-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtkspell-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSPELL_LIBS=`$PKG_CONFIG --libs "gtkspell-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKSPELL_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "gtkspell-2.0" 2>&1` else GTKSPELL_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "gtkspell-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKSPELL_PKG_ERRORS" >&5 if test $FORCE_GTKSPELL = yes ; then as_fn_error $? "gtkspell enforced but no support found" "$LINENO" 5 else USE_GTKSPELL=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GTKSPELL = yes ; then as_fn_error $? "gtkspell enforced but no support found" "$LINENO" 5 else USE_GTKSPELL=no fi else GTKSPELL_CFLAGS=$pkg_cv_GTKSPELL_CFLAGS GTKSPELL_LIBS=$pkg_cv_GTKSPELL_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GTKSPELL = yes ; then USE_GTKSPELL=1 GTKSPELLPKG=gtkspell-2.0 else unset USE_GTKSPELL fi # Check whether --with-gtksourceview was given. if test "${with_gtksourceview+set}" = set; then : withval=$with_gtksourceview; USE_GTKSOURCEVIEW=$withval; FORCE_GTKSOURCEVIEW=yes else USE_GTKSOURCEVIEW=yes; FORCE_GTKSOURCEVIEW=no fi if test $USE_GTKSOURCEVIEW = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKSOURCEVIEW" >&5 $as_echo_n "checking for GTKSOURCEVIEW... " >&6; } if test -n "$GTKSOURCEVIEW_CFLAGS"; then pkg_cv_GTKSOURCEVIEW_CFLAGS="$GTKSOURCEVIEW_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtksourceview-1.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtksourceview-1.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSOURCEVIEW_CFLAGS=`$PKG_CONFIG --cflags "gtksourceview-1.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKSOURCEVIEW_LIBS"; then pkg_cv_GTKSOURCEVIEW_LIBS="$GTKSOURCEVIEW_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtksourceview-1.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtksourceview-1.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSOURCEVIEW_LIBS=`$PKG_CONFIG --libs "gtksourceview-1.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKSOURCEVIEW_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "gtksourceview-1.0" 2>&1` else GTKSOURCEVIEW_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "gtksourceview-1.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKSOURCEVIEW_PKG_ERRORS" >&5 if test $FORCE_GTKSOURCEVIEW = yes ; then as_fn_error $? "gtksourceview enforced but no support found" "$LINENO" 5 else USE_GTKSOURCEVIEW=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GTKSOURCEVIEW = yes ; then as_fn_error $? "gtksourceview enforced but no support found" "$LINENO" 5 else USE_GTKSOURCEVIEW=no fi else GTKSOURCEVIEW_CFLAGS=$pkg_cv_GTKSOURCEVIEW_CFLAGS GTKSOURCEVIEW_LIBS=$pkg_cv_GTKSOURCEVIEW_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GTKSOURCEVIEW = yes ; then USE_GTKSOURCEVIEW=1 GTKSOURCEVIEWPKG=gtksourceview-1.0 else unset USE_GTKSOURCEVIEW fi # Check whether --with-gtksourceview2 was given. if test "${with_gtksourceview2+set}" = set; then : withval=$with_gtksourceview2; USE_GTKSOURCEVIEW2=$withval; FORCE_GTKSOURCEVIEW2=yes else USE_GTKSOURCEVIEW2=yes; FORCE_GTKSOURCEVIEW2=no fi if test $USE_GTKSOURCEVIEW2 = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKSOURCEVIEW2" >&5 $as_echo_n "checking for GTKSOURCEVIEW2... " >&6; } if test -n "$GTKSOURCEVIEW2_CFLAGS"; then pkg_cv_GTKSOURCEVIEW2_CFLAGS="$GTKSOURCEVIEW2_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtksourceview-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtksourceview-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSOURCEVIEW2_CFLAGS=`$PKG_CONFIG --cflags "gtksourceview-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKSOURCEVIEW2_LIBS"; then pkg_cv_GTKSOURCEVIEW2_LIBS="$GTKSOURCEVIEW2_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtksourceview-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtksourceview-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKSOURCEVIEW2_LIBS=`$PKG_CONFIG --libs "gtksourceview-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKSOURCEVIEW2_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "gtksourceview-2.0" 2>&1` else GTKSOURCEVIEW2_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "gtksourceview-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKSOURCEVIEW2_PKG_ERRORS" >&5 if test $FORCE_GTKSOURCEVIEW2 = yes ; then as_fn_error $? "gtksourceview2 enforced but no support found" "$LINENO" 5 else USE_GTKSOURCEVIEW2=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GTKSOURCEVIEW2 = yes ; then as_fn_error $? "gtksourceview2 enforced but no support found" "$LINENO" 5 else USE_GTKSOURCEVIEW2=no fi else GTKSOURCEVIEW2_CFLAGS=$pkg_cv_GTKSOURCEVIEW2_CFLAGS GTKSOURCEVIEW2_LIBS=$pkg_cv_GTKSOURCEVIEW2_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GTKSOURCEVIEW2 = yes ; then USE_GTKSOURCEVIEW2=1 GTKSOURCEVIEW2PKG=gtksourceview-2.0 else unset USE_GTKSOURCEVIEW2 fi # Check whether --with-quartz was given. if test "${with_quartz+set}" = set; then : withval=$with_quartz; USE_GTKQUARTZ=$withval; FORCE_GTKQUARTZ=yes else USE_GTKQUARTZ=yes; FORCE_GTKQUARTZ=no fi if test $USE_GTKQUARTZ = yes ; then pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKQUARTZ" >&5 $as_echo_n "checking for GTKQUARTZ... " >&6; } if test -n "$GTKQUARTZ_CFLAGS"; then pkg_cv_GTKQUARTZ_CFLAGS="$GTKQUARTZ_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtk+-quartz-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtk+-quartz-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKQUARTZ_CFLAGS=`$PKG_CONFIG --cflags "gtk+-quartz-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKQUARTZ_LIBS"; then pkg_cv_GTKQUARTZ_LIBS="$GTKQUARTZ_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"gtk+-quartz-2.0\""; } >&5 ($PKG_CONFIG --exists --print-errors "gtk+-quartz-2.0") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKQUARTZ_LIBS=`$PKG_CONFIG --libs "gtk+-quartz-2.0" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKQUARTZ_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "gtk+-quartz-2.0" 2>&1` else GTKQUARTZ_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "gtk+-quartz-2.0" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKQUARTZ_PKG_ERRORS" >&5 if test $FORCE_GTKQUARTZ = yes ; then as_fn_error $? "quartz enforced but no support found" "$LINENO" 5 else USE_GTKQUARTZ=no fi elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if test $FORCE_GTKQUARTZ = yes ; then as_fn_error $? "quartz enforced but no support found" "$LINENO" 5 else USE_GTKQUARTZ=no fi else GTKQUARTZ_CFLAGS=$pkg_cv_GTKQUARTZ_CFLAGS GTKQUARTZ_LIBS=$pkg_cv_GTKQUARTZ_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi fi if test $USE_GTKQUARTZ = yes ; then USE_GTKQUARTZ=1 GTKQUARTZPKG=gtk+-quartz-2.0 else unset USE_GTKQUARTZ fi pkg_failed=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for GTKALL" >&5 $as_echo_n "checking for GTKALL... " >&6; } if test -n "$GTKALL_CFLAGS"; then pkg_cv_GTKALL_CFLAGS="$GTKALL_CFLAGS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"\$GTKPKG \$GTKGLPKG \$GLADEPKG \$RSVGPKG \$GNOMECANVASPKG \$GNOMEUIPKG \$PANELPKG \$GTKSPELLPKG \$GTKSOURCEVIEW2PKG \$GTKQUARTZPKG\""; } >&5 ($PKG_CONFIG --exists --print-errors "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKALL_CFLAGS=`$PKG_CONFIG --cflags "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test -n "$GTKALL_LIBS"; then pkg_cv_GTKALL_LIBS="$GTKALL_LIBS" elif test -n "$PKG_CONFIG"; then if test -n "$PKG_CONFIG" && \ { { $as_echo "$as_me:${as_lineno-$LINENO}: \$PKG_CONFIG --exists --print-errors \"\$GTKPKG \$GTKGLPKG \$GLADEPKG \$RSVGPKG \$GNOMECANVASPKG \$GNOMEUIPKG \$PANELPKG \$GTKSPELLPKG \$GTKSOURCEVIEW2PKG \$GTKQUARTZPKG\""; } >&5 ($PKG_CONFIG --exists --print-errors "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG") 2>&5 ac_status=$? $as_echo "$as_me:${as_lineno-$LINENO}: \$? = $ac_status" >&5 test $ac_status = 0; }; then pkg_cv_GTKALL_LIBS=`$PKG_CONFIG --libs "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG" 2>/dev/null` test "x$?" != "x0" && pkg_failed=yes else pkg_failed=yes fi else pkg_failed=untried fi if test $pkg_failed = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } if $PKG_CONFIG --atleast-pkgconfig-version 0.20; then _pkg_short_errors_supported=yes else _pkg_short_errors_supported=no fi if test $_pkg_short_errors_supported = yes; then GTKALL_PKG_ERRORS=`$PKG_CONFIG --short-errors --print-errors --cflags --libs "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG" 2>&1` else GTKALL_PKG_ERRORS=`$PKG_CONFIG --print-errors --cflags --libs "$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG" 2>&1` fi # Put the nasty error message in config.log where it belongs echo "$GTKALL_PKG_ERRORS" >&5 as_fn_error $? "Package requirements ($GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG) were not met: $GTKALL_PKG_ERRORS Consider adjusting the PKG_CONFIG_PATH environment variable if you installed software in a non-standard prefix. Alternatively, you may set the environment variables GTKALL_CFLAGS and GTKALL_LIBS to avoid the need to call pkg-config. See the pkg-config man page for more details." "$LINENO" 5 elif test $pkg_failed = untried; then { $as_echo "$as_me:${as_lineno-$LINENO}: result: no" >&5 $as_echo "no" >&6; } { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "The pkg-config script could not be found or is too old. Make sure it is in your PATH or set the PKG_CONFIG environment variable to the full path to pkg-config. Alternatively, you may set the environment variables GTKALL_CFLAGS and GTKALL_LIBS to avoid the need to call pkg-config. See the pkg-config man page for more details. To get pkg-config, see . See \`config.log' for more details" "$LINENO" 5; } else GTKALL_CFLAGS=$pkg_cv_GTKALL_CFLAGS GTKALL_LIBS=$pkg_cv_GTKALL_LIBS { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } fi # Check whether --enable-debug was given. if test "${enable_debug+set}" = set; then : enableval=$enable_debug; { $as_echo "$as_me:${as_lineno-$LINENO}: result: Debug mode enabled" >&5 $as_echo "Debug mode enabled" >&6; } ; DEBUG=1 else DEBUG= fi # substitutions to perform # Finally create the config.make from config.make.in ac_config_files="$ac_config_files config.make" cat >confcache <<\_ACEOF # This file is a shell script that caches the results of configure # tests run on this system so they can be shared between configure # scripts and configure runs, see configure's option --config-cache. # It is not useful on other systems. If it contains results you don't # want to keep, you may remove or edit it. # # config.status only pays attention to the cache file if you give it # the --recheck option to rerun configure. # # `ac_cv_env_foo' variables (set or unset) will be overridden when # loading this file, other *unset* `ac_cv_foo' will be assigned the # following values. _ACEOF # The following way of writing the cache mishandles newlines in values, # but we know of no workaround that is simple, portable, and efficient. # So, we kill variables containing newlines. # Ultrix sh set writes to stderr and can't be redirected directly, # and sets the high bit in the cache file unless we assign to the vars. ( for ac_var in `(set) 2>&1 | sed -n 's/^\([a-zA-Z_][a-zA-Z0-9_]*\)=.*/\1/p'`; do eval ac_val=\$$ac_var case $ac_val in #( *${as_nl}*) case $ac_var in #( *_cv_*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: cache variable $ac_var contains a newline" >&5 $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; esac case $ac_var in #( _ | IFS | as_nl) ;; #( BASH_ARGV | BASH_SOURCE) eval $ac_var= ;; #( *) { eval $ac_var=; unset $ac_var;} ;; esac ;; esac done (set) 2>&1 | case $as_nl`(ac_space=' '; set) 2>&1` in #( *${as_nl}ac_space=\ *) # `set' does not quote correctly, so add quotes: double-quote # substitution turns \\\\ into \\, and sed turns \\ into \. sed -n \ "s/'/'\\\\''/g; s/^\\([_$as_cr_alnum]*_cv_[_$as_cr_alnum]*\\)=\\(.*\\)/\\1='\\2'/p" ;; #( *) # `set' quotes correctly as required by POSIX, so do not add quotes. sed -n "/^[_$as_cr_alnum]*_cv_[_$as_cr_alnum]*=/p" ;; esac | sort ) | sed ' /^ac_cv_env_/b end t clear :clear s/^\([^=]*\)=\(.*[{}].*\)$/test "${\1+set}" = set || &/ t end s/^\([^=]*\)=\(.*\)$/\1=${\1=\2}/ :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} if test ! -f "$cache_file" || test -h "$cache_file"; then cat confcache >"$cache_file" else case $cache_file in #( */* | ?:*) mv -f confcache "$cache_file"$$ && mv -f "$cache_file"$$ "$cache_file" ;; #( *) mv -f confcache "$cache_file" ;; esac fi fi else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} fi fi rm -f confcache test "x$prefix" = xNONE && prefix=$ac_default_prefix # Let make expand exec_prefix. test "x$exec_prefix" = xNONE && exec_prefix='${prefix}' # Transform confdefs.h into DEFS. # Protect against shell expansion while executing Makefile rules. # Protect against Makefile macro expansion. # # If the first sed substitution is executed (which looks for macros that # take arguments), then branch to the quote section. Otherwise, # look for a macro that doesn't take arguments. ac_script=' :mline /\\$/{ N s,\\\n,, b mline } t clear :clear s/^[ ]*#[ ]*define[ ][ ]*\([^ (][^ (]*([^)]*)\)[ ]*\(.*\)/-D\1=\2/g t quote s/^[ ]*#[ ]*define[ ][ ]*\([^ ][^ ]*\)[ ]*\(.*\)/-D\1=\2/g t quote b any :quote s/[ `~#$^&*(){}\\|;'\''"<>?]/\\&/g s/\[/\\&/g s/\]/\\&/g s/\$/$$/g H :any ${ g s/^\n// s/\n/ /g p } ' DEFS=`sed -n "$ac_script" confdefs.h` ac_libobjs= ac_ltlibobjs= U= for ac_i in : $LIBOBJS; do test "x$ac_i" = x: && continue # 1. Remove the extension, and $U if already installed. ac_script='s/\$U\././;s/\.o$//;s/\.obj$//' ac_i=`$as_echo "$ac_i" | sed "$ac_script"` # 2. Prepend LIBOBJDIR. When used with automake>=1.10 LIBOBJDIR # will be set to the directory where LIBOBJS objects are built. as_fn_append ac_libobjs " \${LIBOBJDIR}$ac_i\$U.$ac_objext" as_fn_append ac_ltlibobjs " \${LIBOBJDIR}$ac_i"'$U.lo' done LIBOBJS=$ac_libobjs LTLIBOBJS=$ac_ltlibobjs : "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $CONFIG_STATUS" >&5 $as_echo "$as_me: creating $CONFIG_STATUS" >&6;} as_write_fail=0 cat >$CONFIG_STATUS <<_ASEOF || as_write_fail=1 #! $SHELL # Generated by $as_me. # Run this file to recreate the current configuration. # Compiler output produced by configure, useful for debugging # configure, is in config.log if it exists. debug=false ac_cs_recheck=false ac_cs_silent=false SHELL=\${CONFIG_SHELL-$SHELL} export SHELL _ASEOF cat >>$CONFIG_STATUS <<\_ASEOF || as_write_fail=1 ## -------------------- ## ## M4sh Initialization. ## ## -------------------- ## # Be more Bourne compatible DUALCASE=1; export DUALCASE # for MKS sh if test -n "${ZSH_VERSION+set}" && (emulate sh) >/dev/null 2>&1; then : emulate sh NULLCMD=: # Pre-4.2 versions of Zsh do word splitting on ${1+"$@"}, which # is contrary to our usage. Disable this feature. alias -g '${1+"$@"}'='"$@"' setopt NO_GLOB_SUBST else case `(set -o) 2>/dev/null` in #( *posix*) : set -o posix ;; #( *) : ;; esac fi as_nl=' ' export as_nl # Printing a long string crashes Solaris 7 /usr/bin/printf. as_echo='\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\' as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo as_echo=$as_echo$as_echo$as_echo$as_echo$as_echo$as_echo # Prefer a ksh shell builtin over an external printf program on Solaris, # but without wasting forks for bash or zsh. if test -z "$BASH_VERSION$ZSH_VERSION" \ && (test "X`print -r -- $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='print -r --' as_echo_n='print -rn --' elif (test "X`printf %s $as_echo`" = "X$as_echo") 2>/dev/null; then as_echo='printf %s\n' as_echo_n='printf %s' else if test "X`(/usr/ucb/echo -n -n $as_echo) 2>/dev/null`" = "X-n $as_echo"; then as_echo_body='eval /usr/ucb/echo -n "$1$as_nl"' as_echo_n='/usr/ucb/echo -n' else as_echo_body='eval expr "X$1" : "X\\(.*\\)"' as_echo_n_body='eval arg=$1; case $arg in #( *"$as_nl"*) expr "X$arg" : "X\\(.*\\)$as_nl"; arg=`expr "X$arg" : ".*$as_nl\\(.*\\)"`;; esac; expr "X$arg" : "X\\(.*\\)" | tr -d "$as_nl" ' export as_echo_n_body as_echo_n='sh -c $as_echo_n_body as_echo' fi export as_echo_body as_echo='sh -c $as_echo_body as_echo' fi # The user is always right. if test "${PATH_SEPARATOR+set}" != set; then PATH_SEPARATOR=: (PATH='/bin;/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 && { (PATH='/bin:/bin'; FPATH=$PATH; sh -c :) >/dev/null 2>&1 || PATH_SEPARATOR=';' } fi # IFS # We need space, tab and new line, in precisely that order. Quoting is # there to prevent editors from complaining about space-tab. # (If _AS_PATH_WALK were called with IFS unset, it would disable word # splitting by setting IFS to empty value.) IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR for as_dir in $PATH do IFS=$as_save_IFS test -z "$as_dir" && as_dir=. test -r "$as_dir/$0" && as_myself=$as_dir/$0 && break done IFS=$as_save_IFS ;; esac # We did not find ourselves, most probably we were run as `sh COMMAND' # in which case we are not to be found in the path. if test "x$as_myself" = x; then as_myself=$0 fi if test ! -f "$as_myself"; then $as_echo "$as_myself: error: cannot find myself; rerun with an absolute file name" >&2 exit 1 fi # Unset variables that we do not need and which cause bugs (e.g. in # pre-3.0 UWIN ksh). But do not cause bugs in bash 2.01; the "|| exit 1" # suppresses any "Segmentation fault" message there. '((' could # trigger a bug in pdksh 5.2.14. for as_var in BASH_ENV ENV MAIL MAILPATH do eval test x\${$as_var+set} = xset \ && ( (unset $as_var) || exit 1) >/dev/null 2>&1 && unset $as_var || : done PS1='$ ' PS2='> ' PS4='+ ' # NLS nuisances. LC_ALL=C export LC_ALL LANGUAGE=C export LANGUAGE # CDPATH. (unset CDPATH) >/dev/null 2>&1 && unset CDPATH # as_fn_error STATUS ERROR [LINENO LOG_FD] # ---------------------------------------- # Output "`basename $0`: error: ERROR" to stderr. If LINENO and LOG_FD are # provided, also output the error to LOG_FD, referencing LINENO. Then exit the # script with STATUS, using 1 if that was 0. as_fn_error () { as_status=$1; test $as_status -eq 0 && as_status=1 if test "$4"; then as_lineno=${as_lineno-"$3"} as_lineno_stack=as_lineno_stack=$as_lineno_stack $as_echo "$as_me:${as_lineno-$LINENO}: error: $2" >&$4 fi $as_echo "$as_me: error: $2" >&2 as_fn_exit $as_status } # as_fn_error # as_fn_set_status STATUS # ----------------------- # Set $? to STATUS, without forking. as_fn_set_status () { return $1 } # as_fn_set_status # as_fn_exit STATUS # ----------------- # Exit the shell with STATUS, even in a "trap 0" or "set -e" context. as_fn_exit () { set +e as_fn_set_status $1 exit $1 } # as_fn_exit # as_fn_unset VAR # --------------- # Portably unset VAR. as_fn_unset () { { eval $1=; unset $1;} } as_unset=as_fn_unset # as_fn_append VAR VALUE # ---------------------- # Append the text in VALUE to the end of the definition contained in VAR. Take # advantage of any shell optimizations that allow amortized linear growth over # repeated appends, instead of the typical quadratic growth present in naive # implementations. if (eval "as_var=1; as_var+=2; test x\$as_var = x12") 2>/dev/null; then : eval 'as_fn_append () { eval $1+=\$2 }' else as_fn_append () { eval $1=\$$1\$2 } fi # as_fn_append # as_fn_arith ARG... # ------------------ # Perform arithmetic evaluation on the ARGs, and store the result in the # global $as_val. Take advantage of shells that can avoid forks. The arguments # must be portable across $(()) and expr. if (eval "test \$(( 1 + 1 )) = 2") 2>/dev/null; then : eval 'as_fn_arith () { as_val=$(( $* )) }' else as_fn_arith () { as_val=`expr "$@" || test $? -eq 1` } fi # as_fn_arith if expr a : '\(a\)' >/dev/null 2>&1 && test "X`expr 00001 : '.*\(...\)'`" = X001; then as_expr=expr else as_expr=false fi if (basename -- /) >/dev/null 2>&1 && test "X`basename -- / 2>&1`" = "X/"; then as_basename=basename else as_basename=false fi if (as_dir=`dirname -- /` && test "X$as_dir" = X/) >/dev/null 2>&1; then as_dirname=dirname else as_dirname=false fi as_me=`$as_basename -- "$0" || $as_expr X/"$0" : '.*/\([^/][^/]*\)/*$' \| \ X"$0" : 'X\(//\)$' \| \ X"$0" : 'X\(/\)' \| . 2>/dev/null || $as_echo X/"$0" | sed '/^.*\/\([^/][^/]*\)\/*$/{ s//\1/ q } /^X\/\(\/\/\)$/{ s//\1/ q } /^X\/\(\/\).*/{ s//\1/ q } s/.*/./; q'` # Avoid depending upon Character Ranges. as_cr_letters='abcdefghijklmnopqrstuvwxyz' as_cr_LETTERS='ABCDEFGHIJKLMNOPQRSTUVWXYZ' as_cr_Letters=$as_cr_letters$as_cr_LETTERS as_cr_digits='0123456789' as_cr_alnum=$as_cr_Letters$as_cr_digits ECHO_C= ECHO_N= ECHO_T= case `echo -n x` in #((((( -n*) case `echo 'xy\c'` in *c*) ECHO_T=' ';; # ECHO_T is single tab character. xy) ECHO_C='\c';; *) echo `echo ksh88 bug on AIX 6.1` > /dev/null ECHO_T=' ';; esac;; *) ECHO_N='-n';; esac rm -f conf$$ conf$$.exe conf$$.file if test -d conf$$.dir; then rm -f conf$$.dir/conf$$.file else rm -f conf$$.dir mkdir conf$$.dir 2>/dev/null fi if (echo >conf$$.file) 2>/dev/null; then if ln -s conf$$.file conf$$ 2>/dev/null; then as_ln_s='ln -s' # ... but there are two gotchas: # 1) On MSYS, both `ln -s file dir' and `ln file dir' fail. # 2) DJGPP < 2.04 has no symlinks; `ln -s' creates a wrapper executable. # In both cases, we have to default to `cp -pR'. ln -s conf$$.file conf$$.dir 2>/dev/null && test ! -f conf$$.exe || as_ln_s='cp -pR' elif ln conf$$.file conf$$ 2>/dev/null; then as_ln_s=ln else as_ln_s='cp -pR' fi else as_ln_s='cp -pR' fi rm -f conf$$ conf$$.exe conf$$.dir/conf$$.file conf$$.file rmdir conf$$.dir 2>/dev/null # as_fn_mkdir_p # ------------- # Create "$as_dir" as a directory, including parents if necessary. as_fn_mkdir_p () { case $as_dir in #( -*) as_dir=./$as_dir;; esac test -d "$as_dir" || eval $as_mkdir_p || { as_dirs= while :; do case $as_dir in #( *\'*) as_qdir=`$as_echo "$as_dir" | sed "s/'/'\\\\\\\\''/g"`;; #'( *) as_qdir=$as_dir;; esac as_dirs="'$as_qdir' $as_dirs" as_dir=`$as_dirname -- "$as_dir" || $as_expr X"$as_dir" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$as_dir" : 'X\(//\)[^/]' \| \ X"$as_dir" : 'X\(//\)$' \| \ X"$as_dir" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$as_dir" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` test -d "$as_dir" && break done test -z "$as_dirs" || eval "mkdir $as_dirs" } || test -d "$as_dir" || as_fn_error $? "cannot create directory $as_dir" } # as_fn_mkdir_p if mkdir -p . 2>/dev/null; then as_mkdir_p='mkdir -p "$as_dir"' else test -d ./-p && rmdir ./-p as_mkdir_p=false fi # as_fn_executable_p FILE # ----------------------- # Test if FILE is an executable regular file. as_fn_executable_p () { test -f "$1" && test -x "$1" } # as_fn_executable_p as_test_x='test -x' as_executable_p=as_fn_executable_p # Sed expression to map a string onto a valid CPP name. as_tr_cpp="eval sed 'y%*$as_cr_letters%P$as_cr_LETTERS%;s%[^_$as_cr_alnum]%_%g'" # Sed expression to map a string onto a valid variable name. as_tr_sh="eval sed 'y%*+%pp%;s%[^_$as_cr_alnum]%_%g'" exec 6>&1 ## ----------------------------------- ## ## Main body of $CONFIG_STATUS script. ## ## ----------------------------------- ## _ASEOF test $as_write_fail = 0 && chmod +x $CONFIG_STATUS || ac_write_fail=1 cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Save the log message, to keep $0 and so on meaningful, and to # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" This file was extended by $as_me, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS CONFIG_LINKS = $CONFIG_LINKS CONFIG_COMMANDS = $CONFIG_COMMANDS $ $0 $@ on `(hostname || uname -n) 2>/dev/null | sed 1q` " _ACEOF case $ac_config_files in *" "*) set x $ac_config_files; shift; ac_config_files=$*;; esac cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 # Files that config.status was made for. config_files="$ac_config_files" _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 ac_cs_usage="\ \`$as_me' instantiates files and other configuration actions from templates according to the current configuration. Unless the files and actions are specified as TAGs, all are instantiated by default. Usage: $0 [OPTION]... [TAG]... -h, --help print this help, then exit -V, --version print version number and configuration settings, then exit --config print configuration, then exit -q, --quiet, --silent do not print progress messages -d, --debug don't remove temporary files --recheck update $as_me by reconfiguring in the same conditions --file=FILE[:TEMPLATE] instantiate the configuration file FILE Configuration files: $config_files Report bugs to the package provider." _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ config.status configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" Copyright (C) 2012 Free Software Foundation, Inc. This config.status script is free software; the Free Software Foundation gives unlimited permission to copy, distribute and modify it." ac_pwd='$ac_pwd' srcdir='$srcdir' test -n "\$AWK" || AWK=awk _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # The default lists apply if the user does not specify any file. ac_need_defaults=: while test $# != 0 do case $1 in --*=?*) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg=`expr "X$1" : 'X[^=]*=\(.*\)'` ac_shift=: ;; --*=) ac_option=`expr "X$1" : 'X\([^=]*\)='` ac_optarg= ac_shift=: ;; *) ac_option=$1 ac_optarg=$2 ac_shift=shift ;; esac case $ac_option in # Handling of the options. -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r) ac_cs_recheck=: ;; --version | --versio | --versi | --vers | --ver | --ve | --v | -V ) $as_echo "$ac_cs_version"; exit ;; --config | --confi | --conf | --con | --co | --c ) $as_echo "$ac_cs_config"; exit ;; --debug | --debu | --deb | --de | --d | -d ) debug=: ;; --file | --fil | --fi | --f ) $ac_shift case $ac_optarg in *\'*) ac_optarg=`$as_echo "$ac_optarg" | sed "s/'/'\\\\\\\\''/g"` ;; '') as_fn_error $? "missing file argument" ;; esac as_fn_append CONFIG_FILES " '$ac_optarg'" ac_need_defaults=false;; --he | --h | --help | --hel | -h ) $as_echo "$ac_cs_usage"; exit ;; -q | -quiet | --quiet | --quie | --qui | --qu | --q \ | -silent | --silent | --silen | --sile | --sil | --si | --s) ac_cs_silent=: ;; # This is an error. -*) as_fn_error $? "unrecognized option: \`$1' Try \`$0 --help' for more information." ;; *) as_fn_append ac_config_targets " $1" ac_need_defaults=false ;; esac shift done ac_configure_extra_args= if $ac_cs_silent; then exec 6>/dev/null ac_configure_extra_args="$ac_configure_extra_args --silent" fi _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 if \$ac_cs_recheck; then set X $SHELL '$0' $ac_configure_args \$ac_configure_extra_args --no-create --no-recursion shift \$as_echo "running CONFIG_SHELL=$SHELL \$*" >&6 CONFIG_SHELL='$SHELL' export CONFIG_SHELL exec "\$@" fi _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 exec 5>>config.log { echo sed 'h;s/./-/g;s/^.../## /;s/...$/ ##/;p;x;p;x' <<_ASBOX ## Running $as_me. ## _ASBOX $as_echo "$ac_log" } >&5 _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # Handling of arguments. for ac_config_target in $ac_config_targets do case $ac_config_target in "config.make") CONFIG_FILES="$CONFIG_FILES config.make" ;; *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done # If the user did not use the arguments to specify the items to instantiate, # then the envvar interface is used. Set only those that are not. # We use the long form for the default assignment because of an extremely # bizarre bug on SunOS 4.1.3. if $ac_need_defaults; then test "${CONFIG_FILES+set}" = set || CONFIG_FILES=$config_files fi # Have a temporary directory for convenience. Make it in the build tree # simply because there is no reason against having it here, and in addition, # creating and moving files from /tmp can sometimes cause problems. # Hook for its removal unless debugging. # Note that there is a small window in which the directory will not be cleaned: # after its creation but before its name has been assigned to `$tmp'. $debug || { tmp= ac_tmp= trap 'exit_status=$? : "${ac_tmp:=$tmp}" { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } # Create a (secure) tmp directory for tmp files. { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. # This happens for instance with `./config.status config.h'. if test -n "$CONFIG_FILES"; then ac_cr=`echo X | tr X '\015'` # On cygwin, bash can eat \r inside `` if the user requested igncr. # But we know of no other shell where ac_cr would be empty at this # point, so we can use a bashism as a fallback. if test "x$ac_cr" = x; then eval ac_cr=\$\'\\r\' fi ac_cs_awk_cr=`$AWK 'BEGIN { print "a\rb" }' /dev/null` if test "$ac_cs_awk_cr" = "a${ac_cr}b"; then ac_cs_awk_cr='\\r' else ac_cs_awk_cr=$ac_cr fi echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF { echo "cat >conf$$subs.awk <<_ACEOF" && echo "$ac_subst_vars" | sed 's/.*/&!$&$ac_delim/' && echo "_ACEOF" } >conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_num=`echo "$ac_subst_vars" | grep -c '^'` ac_delim='%!_!# ' for ac_last_try in false false false false false :; do . ./conf$$subs.sh || as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 ac_delim_n=`sed -n "s/.*$ac_delim\$/X/p" conf$$subs.awk | grep -c X` if test $ac_delim_n = $ac_delim_num; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_STATUS" "$LINENO" 5 else ac_delim="$ac_delim!$ac_delim _$ac_delim!! " fi done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h s/^/S["/; s/!.*/"]=/ p g s/^[^!]*!// :repl t repl s/'"$ac_delim"'$// t delim :nl h s/\(.\{148\}\)..*/\1/ t more1 s/["\\]/\\&/g; s/^/"/; s/$/\\n"\\/ p n b repl :more1 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t nl :delim h s/\(.\{148\}\)..*/\1/ t more2 s/["\\]/\\&/g; s/^/"/; s/$/"/ p b :more2 s/["\\]/\\&/g; s/^/"/; s/$/"\\/ p g s/.\{148\}// t delim ' >$CONFIG_STATUS || ac_write_fail=1 rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" } { line = $ 0 nfields = split(line, field, "@") substed = 0 len = length(field[1]) for (i = 2; i < nfields; i++) { key = field[i] keylen = length(key) if (S_is_set[key]) { value = S[key] line = substr(line, 1, len) "" value "" substr(line, len + keylen + 3) len += length(value) + length(field[++i]) substed = 1 } else len += 1 + keylen } print line } _ACAWK _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF # VPATH may cause trouble with some makes, so we remove sole $(srcdir), # ${srcdir} and @srcdir@ entries from VPATH if srcdir is ".", strip leading and # trailing colons and then remove the whole line if VPATH becomes empty # (actually we leave an empty line to preserve line numbers). if test "x$srcdir" = x.; then ac_vpsub='/^[ ]*VPATH[ ]*=[ ]*/{ h s/// s/^/:/ s/[ ]*$/:/ s/:\$(srcdir):/:/g s/:\${srcdir}:/:/g s/:@srcdir@:/:/g s/^:*// s/:*$// x s/\(=[ ]*\).*/\1/ G s/\n// s/^[^=]*=[ ]*$// }' fi cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 fi # test -n "$CONFIG_FILES" eval set X " :F $CONFIG_FILES " shift for ac_tag do case $ac_tag in :[FHLC]) ac_mode=$ac_tag; continue;; esac case $ac_mode$ac_tag in :[FHL]*:*);; :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac ac_save_IFS=$IFS IFS=: set x $ac_tag IFS=$ac_save_IFS shift ac_file=$1 shift case $ac_mode in :L) ac_source=$1;; :[FH]) ac_file_inputs= for ac_f do case $ac_f in -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. test -f "$ac_f" || case $ac_f in [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" done # Let's still pretend it is `configure' which instantiates (i.e., don't # use $as_me), people would be surprised to read: # /* config.h. Generated by config.status. */ configure_input='Generated from '` $as_echo "$*" | sed 's|^[^:]*/||;s|:[^:]*/|, |g' `' by configure.' if test x"$ac_file" != x-; then configure_input="$ac_file. $configure_input" { $as_echo "$as_me:${as_lineno-$LINENO}: creating $ac_file" >&5 $as_echo "$as_me: creating $ac_file" >&6;} fi # Neutralize special characters interpreted by sed in replacement strings. case $configure_input in #( *\&* | *\|* | *\\* ) ac_sed_conf_input=`$as_echo "$configure_input" | sed 's/[\\\\&|]/\\\\&/g'`;; #( *) ac_sed_conf_input=$configure_input;; esac case $ac_tag in *:-:* | *:-) cat >"$ac_tmp/stdin" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac ac_dir=`$as_dirname -- "$ac_file" || $as_expr X"$ac_file" : 'X\(.*[^/]\)//*[^/][^/]*/*$' \| \ X"$ac_file" : 'X\(//\)[^/]' \| \ X"$ac_file" : 'X\(//\)$' \| \ X"$ac_file" : 'X\(/\)' \| . 2>/dev/null || $as_echo X"$ac_file" | sed '/^X\(.*[^/]\)\/\/*[^/][^/]*\/*$/{ s//\1/ q } /^X\(\/\/\)[^/].*/{ s//\1/ q } /^X\(\/\/\)$/{ s//\1/ q } /^X\(\/\).*/{ s//\1/ q } s/.*/./; q'` as_dir="$ac_dir"; as_fn_mkdir_p ac_builddir=. case "$ac_dir" in .) ac_dir_suffix= ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_dir_suffix=/`$as_echo "$ac_dir" | sed 's|^\.[\\/]||'` # A ".." for each directory in $ac_dir_suffix. ac_top_builddir_sub=`$as_echo "$ac_dir_suffix" | sed 's|/[^\\/]*|/..|g;s|/||'` case $ac_top_builddir_sub in "") ac_top_builddir_sub=. ac_top_build_prefix= ;; *) ac_top_build_prefix=$ac_top_builddir_sub/ ;; esac ;; esac ac_abs_top_builddir=$ac_pwd ac_abs_builddir=$ac_pwd$ac_dir_suffix # for backward compatibility: ac_top_builddir=$ac_top_build_prefix case $srcdir in .) # We are building in place. ac_srcdir=. ac_top_srcdir=$ac_top_builddir_sub ac_abs_top_srcdir=$ac_pwd ;; [\\/]* | ?:[\\/]* ) # Absolute name. ac_srcdir=$srcdir$ac_dir_suffix; ac_top_srcdir=$srcdir ac_abs_top_srcdir=$srcdir ;; *) # Relative name. ac_srcdir=$ac_top_build_prefix$srcdir$ac_dir_suffix ac_top_srcdir=$ac_top_build_prefix$srcdir ac_abs_top_srcdir=$ac_pwd/$srcdir ;; esac ac_abs_srcdir=$ac_abs_top_srcdir$ac_dir_suffix case $ac_mode in :F) # # CONFIG_FILE # _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # If the template does not know about datarootdir, expand it. # FIXME: This hack should be removed a few years after 2.60. ac_datarootdir_hack=; ac_datarootdir_seen= ac_sed_dataroot=' /datarootdir/ { p q } /@datadir@/p /@docdir@/p /@infodir@/p /@localedir@/p /@mandir@/p' case `eval "sed -n \"\$ac_sed_dataroot\" $ac_file_inputs"` in *datarootdir*) ac_datarootdir_seen=yes;; *@datadir@*|*@docdir@*|*@infodir@*|*@localedir@*|*@mandir@*) { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&5 $as_echo "$as_me: WARNING: $ac_file_inputs seems to ignore the --datarootdir setting" >&2;} _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_datarootdir_hack=' s&@datadir@&$datadir&g s&@docdir@&$docdir&g s&@infodir@&$infodir&g s&@localedir@&$localedir&g s&@mandir@&$mandir&g s&\\\${datarootdir}&$datarootdir&g' ;; esac _ACEOF # Neutralize VPATH when `$srcdir' = `.'. # Shell code in configure.ac might set extrasub. # FIXME: do we really want to maintain this feature? cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_sed_extra="$ac_vpsub $extrasub _ACEOF cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 :t /@[a-zA-Z_][a-zA-Z_0-9]*@/!b s|@configure_input@|$ac_sed_conf_input|;t t s&@top_builddir@&$ac_top_builddir_sub&;t t s&@top_build_prefix@&$ac_top_build_prefix&;t t s&@srcdir@&$ac_srcdir&;t t s&@abs_srcdir@&$ac_abs_srcdir&;t t s&@top_srcdir@&$ac_top_srcdir&;t t s&@abs_top_srcdir@&$ac_abs_top_srcdir&;t t s&@builddir@&$ac_builddir&;t t s&@abs_builddir@&$ac_abs_builddir&;t t s&@abs_top_builddir@&$ac_abs_top_builddir&;t t $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | $AWK -f "$ac_tmp/subs.awk" \ >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ "$ac_tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} rm -f "$ac_tmp/stdin" case $ac_file in -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac done # for ac_tag as_fn_exit 0 _ACEOF ac_clean_files=$ac_clean_files_save test $ac_write_fail = 0 || as_fn_error $? "write failure creating $CONFIG_STATUS" "$LINENO" 5 # configure is writing to config.log, and then calls config.status. # config.status does its own redirection, appending to config.log. # Unfortunately, on DOS this fails, as config.log is still kept open # by configure, so config.status won't be able to write to it; its # output is simply discarded. So we exec the FD to /dev/null, # effectively closing config.log, so it can be properly (re)opened and # appended to by config.status. When coming back to configure, we # need to make the FD available again. if test "$no_create" != yes; then ac_cs_success=: ac_config_status_args= test "$silent" = yes && ac_config_status_args="$ac_config_status_args --quiet" exec 5>/dev/null $SHELL $CONFIG_STATUS $ac_config_status_args || ac_cs_success=false exec 5>>config.log # Use ||, not &&, to avoid exiting from the if with $? = 1, which # would make configure fail if this is the last instruction. $ac_cs_success || as_fn_exit 1 fi if test -n "$ac_unrecognized_opts" && test "$enable_option_checking" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: unrecognized options: $ac_unrecognized_opts" >&5 $as_echo "$as_me: WARNING: unrecognized options: $ac_unrecognized_opts" >&2;} fi chmod a-w config.make echo ; echo "LablGTK configuration:" echo " threads $THREADS_LIB" echo " native dynlink $HAS_NATIVE_DYNLINK" echo $ECHO_N " GtkGLArea $ECHO_C" if test -n "$USE_GTKGL" then echo " yes" else if test "$FORCE_GTKGL" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " libglade $ECHO_C" if test -n "$USE_GLADE" then echo " yes" else if test "$FORCE_GLADE" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " librsvg $ECHO_C" if test -n "$USE_RSVG" then echo " yes" else if test "$FORCE_RSVG" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " libgnomecanvas $ECHO_C" if test -n "$USE_GNOMECANVAS" then echo " yes" else if test "$FORCE_GNOMECANVAS" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " libgnomeui $ECHO_C" if test -n "$USE_GNOMEUI" then echo " yes" else if test "$FORCE_GNOMEUI" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " libpanelapplet $ECHO_C" if test -n "$USE_PANEL" then echo " yes" else if test "$FORCE_PANEL" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " gtkspell $ECHO_C" if test -n "$USE_GTKSPELL" then echo " yes" else if test "$FORCE_GTKSPELL" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " gtksourceview 1 $ECHO_C" if test -n "$USE_GTKSOURCEVIEW" then echo " yes" else if test "$FORCE_GTKSOURCEVIEW" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " gtksourceview 2 $ECHO_C" if test -n "$USE_GTKSOURCEVIEW2" then echo " yes" else if test "$FORCE_GTKSOURCEVIEW2" = "yes" then echo " disabled" else echo " not found" fi fi echo $ECHO_N " quartz $ECHO_C" if test -n "$USE_GTKQUARTZ" then echo " yes" else if test "$FORCE_GTKQUARTZ" = "yes" then echo " disabled" else echo " not found" fi fi echo echo $ECHO_N " debug $ECHO_C" if test -n "$DEBUG" ; then echo " yes" ; else echo " no" ; fi echo " C compiler $CC" echo " Camlp4 $CAMLP4O" lablgtk-2.18.8/META0000644000175000017500000000527213460263323012743 0ustar stephstephdescription = "Bindings for gtk2" requires = "" version = "2.18.8" archive(byte) = "lablgtk.cma" archive(native) = "lablgtk.cmxa" archive(byte,mt) += "gtkThread.cmo" archive(native,mt) += "gtkThread.cmx" requires(mt) += "threads" package "auto-init" ( exists_if = "gtkInit.cmo,gtkInit.cmx" description = "Auto-initialization of GTK" requires = "lablgtk2" archive(byte) = "gtkInit.cmo" archive(native) = "gtkInit.cmx" ) package "gl" ( exists_if = "lablgtkgl.cma,lablgtkgl.cmxa,lablgtkgl.cmxs" description = "Bindings for gtkGL" requires = "lablgtk2" archive(byte) = "lablgtkgl.cma" archive(native) = "lablgtkgl.cmxa" ) package "glade" ( exists_if = "lablglade.cma,lablglade.cmxa,lablglade.cmxs" description = "Bindings for glade" requires = "lablgtk2" archive(byte) = "lablglade.cma" archive(native) = "lablglade.cmxa" ) package "gnomecanvas" ( exists_if = "lablgnomecanvas.cma,lablgnomecanvas.cmxa,lablgnomecanvas.cmxs" description = "Bindings for gnomecanvas" requires = "lablgtk2" archive(byte) = "lablgnomecanvas.cma" archive(native) = "lablgnomecanvas.cmxa" ) package "gnomehtml" ( exists_if = "lablgnome.cma,lablgnome.cmxa,lablgnome.cmxs" description = "Bindings for gnome html" requires = "lablgtk2" archive(byte) = "lablgnome.cma" archive(native) = "lablgnome.cmxa" ) package "gnomeui" ( exists_if = "lablgnomeui.cma,lablgnomeui.cmxa,lablgnomeui.cmxs" description = "Bindings for gnomeui" requires = "lablgtk2" archive(byte) = "lablgnomeui.cma" archive(native) = "lablgnomeui.cmxa" ) package "gtkspell" ( exists_if = "lablgtkspell.cma,lablgtkspell.cmxa,lablgtkspell.cmxs" description = "Bindings for gtkspell" requires = "lablgtk2" archive(byte) = "lablgtkspell.cma" archive(native) = "lablgtkspell.cmxa" ) package "panel" ( exists_if = "lablpanel.cma,lablpanel.cmxa,lablpanel.cmxs" description = "Bindings for panelapplet" requires = "lablgtk2" archive(byte) = "lablpanel.cma" archive(native) = "lablpanel.cmxa" ) package "rsvg" ( exists_if = "lablrsvg.cma,lablrsvg.cmxa,lablrsvg.cmxs" description = "Bindings for rsvg" requires = "lablgtk2" archive(byte) = "lablrsvg.cma" archive(native) = "lablrsvg.cmxa" ) package "sourceview" ( exists_if = "lablgtksourceview.cma,lablgtksourceview.cmxa,lablgtksourceview.cmxs" description = "Bindings for gtksourceview" requires = "lablgtk2" archive(byte) = "lablgtksourceview.cma" archive(native) = "lablgtksourceview.cmxa" ) package "sourceview2" ( exists_if = "lablgtksourceview2.cma,lablgtksourceview2.cmxa,lablgtksourceview2.cmxs" description = "Bindings for gtksourceview2" requires = "lablgtk2" archive(byte) = "lablgtksourceview2.cma" archive(native) = "lablgtksourceview2.cmxa" ) lablgtk-2.18.8/config.make.msvc0000644000175000017500000000252313460263323015341 0ustar stephstephCAMLC=ocamlc.opt CAMLOPT=ocamlopt.opt OCAMLDOC=ocamldoc CAMLMKTOP=ocamlmktop CAMLMKLIB=ocamlmklib -ocamlc ocamlc -ocamlopt ocamlopt CAMLLEX=ocamllex CAMLP4O=camlp4o XO= USE_GL= USE_GNOME= USE_GLADE=1 USE_RSVG=1 HAVE_SVGZ= USE_GNOMECANVAS= USE_CC= DEBUG= CC= RANLIB=: XA=.lib XB=.bat XE=.exe XO=.obj XS=.dll TOOLCHAIN=msvc LIBDIR=`$(CAMLC) -where | sed "s/ *$$//"` THREADS_LIB=system HAS_DLL_SUPPORT=yes # where to install the binaries BINDIR=$(LIBDIR)\..\bin # where to install the man page MANDIR=$(LIBDIR)\..\man INSTALLDIR=$(LIBDIR)\lablgtk2 DLLDIR=$(LIBDIR)\stublibs # if using ocaml >= 3.08, add a -D OCAML_308 (for camlp4) ODOC_DEF=-D OCAML_308 GTKROOT=c:/GTK #GTKROOT=c:/Home/garrigue/gtk-2.6.8 GTKINC=$(GTKROOT)/include GTKCFLAGS=-I$(GTKINC)/glib-2.0 -I$(GTKROOT)/lib/glib-2.0/include -I$(GTKINC)/gtk-2.0/ -I$(GTKROOT)/lib/gtk-2.0/include -I$(GTKINC)/pango-1.0 -I$(GTKINC)/atk-1.0 -I $(GTKINC)/cairo -I$(GTKINC)/librsvg-2 -I$(GTKINC)/libglade-2.0 -I$(GTKINC) GTKLIBS0=gtk-win32-2.0.lib gdk_pixbuf-2.0.lib gdk-win32-2.0.lib pango-1.0.lib atk-1.0.lib glib-2.0.lib gobject-2.0.lib RSVGLIBS0=rsvg-2.lib GLADELIBS0=glade-2.0.lib GTKLIBS=-L$(GTKROOT)/lib -ldopt "-show-imports $(GTKLIBS0)" -cclib "$(GTKLIBS0)" RSVGLIBS=-L$(GTKROOT)/lib -ldopt "$(RSVGLIBS0)" -cclib "$(RSVGLIBS0)" GLADELIBS=-L$(GTKROOT)/lib -ldopt "$(GLADELIBS0)" -cclib "$(GLADELIBS0)" lablgtk-2.18.8/examples/0000755000175000017500000000000013523300020014064 5ustar stephstephlablgtk-2.18.8/examples/csview.ml0000644000175000017500000001607613460263323015746 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* Compile with ocamlc -pp camlp4o -I ../src lablgtk.cma csview.ml -o csview or run with lablgtk2 camlp4o.cma csview.ml *) open StdLabels (* A simple CSV data viewer *) type data = { fields : string list; titles : string list; data : string list list } let mem_string ~char s = try for i = 0 to String.length s - 1 do if s.[i] = char then raise Exit done; false with Exit -> true let rec until ~chars ?(escapes="") ?(buf = Buffer.create 80) s = match Stream.peek s with Some c -> if mem_string ~char:c escapes then begin Stream.junk s; Buffer.add_char buf (Stream.next s); until ~chars ~escapes ~buf s end else if mem_string ~char:c chars then Glib.Convert.locale_to_utf8 (Buffer.contents buf) else begin Buffer.add_char buf c; Stream.junk s; until ~chars ~escapes ~buf s end | None -> if Buffer.length buf > 0 then raise (Stream.Error "until") else raise Stream.Failure let rec ignores ?(chars = " \t") s = match Stream.peek s with Some c when mem_string ~char:c chars -> Stream.junk s; ignores ~chars s | _ -> () let parse_field = parser [< ''"'; f = until ~chars:"\"" ~escapes:"\\"; ''"'; _ = ignores >] -> for i = 0 to String.length f - 1 do if f.[i] = '\031' then f.[i] <- '\n' done; f | [< f = until ~chars:",\n\r" >] -> f | [< >] -> "" let comma = parser [< '','; _ = ignores >] -> () let rec parse_list ~item ~sep = parser [< i = item; s >] -> begin match s with parser [< _ = sep; l = parse_list ~item ~sep >] -> i :: l | [< >] -> [i] end | [< >] -> [] let parse_one = parse_list ~item:parse_field ~sep:comma let lf = parser [< ''\n'|'\r'; _ = ignores ~chars:"\n\r"; _ = ignores >] -> () let parse_all = parse_list ~item:parse_one ~sep:lf let read_file ic = let s = Stream.of_channel ic in let data = parse_all s in match data with ("i"::fields) :: ("T"::titles) :: data -> {fields=fields; titles=titles; data=List.map ~f:List.tl data} | titles :: data -> {fields=titles; titles=titles; data=data} | _ -> failwith "Insufficient data" let print_string s = Format.print_char '"'; for i = 0 to String.length s - 1 do match s.[i] with '\'' -> Format.print_char '\'' | '"' -> Format.print_string "\\\"" | '\160'..'\255' as c -> Format.print_char c | c -> Format.print_string (Char.escaped c) done; Format.print_char '"' (* #install_printer print_string;; *) open GMain let field_widths = [ "i", 0; "ATTR", 0; "NAME", 17; "NAPR", 8; "TEL1", 14; "ZIPC", 12; "ADR1", 40; "BRTH", 10; "RMRK", 20; "CHK1", 0; "CHK2", 0; "CHK3", 0; "CHK4", 0; "TIM1", 16; "TIM2", 16; "ALRM", 0; "ATTM", 0; ] let rec genlist ~start ~stop = if start >= stop then [] else (start,-1) :: genlist ~start:(start+1) ~stop let rec star p = parser [< l = plus p >] -> l | [< >] -> [] and plus p = parser [< e = p; l = star p >] -> e :: l let parse_int s = let l = plus (parser [< ''0'..'9' as n >] -> Char.code n - Char.code '0') s in List.fold_left l ~init:0 ~f:(fun acc n -> acc * 10 + n) let parse_range ~start = parser | [< ''-'; stop = parse_int >] -> genlist ~start ~stop | [< '':'; width = parse_int >] -> [start,width] | [< >] -> [start,-1] let rec parse_fields = parser [< n = parse_int; s >] -> let l = parse_range ~start:(n-1) s in l @ parse_fields s | [< '','|' '; s >] -> parse_fields s | [< >] -> [] let select_columns ~items ~titles = let w = GWindow.dialog ~modal:true () in let vbox = w#vbox in List.iter2 titles (Array.to_list items) ~f: begin fun title item -> match item with None -> () | Some it -> let b = GButton.check_button ~label:title ~active:it#active ~packing:vbox#add () in ignore (b#connect#toggled ~callback:(fun () -> it#set_active b#active)) end; let close = GButton.button ~label:"Close" ~packing:w#action_area#add () in close#connect#clicked ~callback:w#destroy; w#show () let main () = let file = ref "" and fields = ref "" in Arg.parse ["-fields", Arg.Set_string fields, "fields to display"] ((:=) file) "Usage: csview "; let fields = parse_fields (Stream.of_string !fields) in let locale = Main.init ~setlocale:true () in let ic = if !file = "" then stdin else open_in !file in let data = read_file ic in if !file <> "" then close_in ic; let w = GWindow.window () in w#connect#destroy ~callback:Main.quit; let vbox = GPack.vbox ~packing:w#add () in let mbar = new GMenu.factory (GMenu.menu_bar ~packing:vbox#pack ()) in let columns = new GMenu.factory (mbar#add_submenu "Columns") in let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~width:600 ~height:300 ~packing:vbox#add () in let cl = GList.clist ~titles:data.titles ~packing:sw#add () in let metrics = cl#misc#pango_context#get_metrics () in let w0 = GPango.to_pixels metrics#approx_digit_width in let items = Array.create (List.length data.titles) None in columns#add_item "Select" ~callback:(fun () -> select_columns ~items ~titles:data.titles); let sort_col = ref (-1) in cl#connect#click_column ~callback: begin fun n -> cl#set_sort ~column:n (); cl#sort (); (* match items.(n) with None -> () | Some it -> it#set_active false *) end; let width ~col ~f = let w = try List.assoc col fields with Not_found -> -1 in if w <> -1 then w else try List.assoc f field_widths with Not_found -> -1 in List.fold_left2 data.titles data.fields ~init:0 ~f: begin fun col title f -> let width = width ~col ~f in let active = (fields = [] && width <> 0) || List.mem_assoc col fields in items.(col) <- Some (columns#add_check_item title ~active ~callback:(fun b -> cl#set_column col ~visibility:b)); if not active then cl#set_column ~visibility:false col else if f = "NAPR" || f = "TIM1" || f = "CLAS" then cl#set_sort ~auto:true ~column:col (); succ col end; List.iter data.data ~f:(fun l -> if List.length l > 1 then ignore (cl#append l)); cl#columns_autosize (); List.fold_left data.fields ~init:0 ~f: begin fun col f -> let width = width ~col ~f in if width > 0 then cl#set_column ~width:(width * w0) col; succ col end; w#show (); Main.main () let () = if not !Sys.interactive then main () lablgtk-2.18.8/examples/events2.ml0000644000175000017500000000245313460263323016026 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* See comments in events.ml *) open GMain let _ = let window = GWindow.window () in window#connect#destroy ~callback:Main.quit; let text = GText.view ~width:200 ~height:100 ~packing:window#add () in text#event#connect#button_press ~callback: begin fun ev -> GdkEvent.Button.button ev = 3 && GdkEvent.get_type ev = `BUTTON_PRESS && begin let win = match text#get_window `WIDGET with | None -> assert false | Some w -> w in let x,y = Gdk.Window.get_pointer_location win in let b_x,b_y = text#window_to_buffer_coords ~tag:`WIDGET ~x ~y in let clicked_pos = text#get_iter_at_location ~x:b_x ~y:b_y in Printf.printf "Position is %d.\n" clicked_pos#offset; flush stdout; true; end end; window#show (); Main.main () lablgtk-2.18.8/examples/link_button.ml0000644000175000017500000000210313460263323016760 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let window = GWindow.window ~title: "Link button" ~border_width: 0 () in let box = GPack.vbox ~packing: window#add () in let button = GButton.link_button "http://HELLO.ORG" ~label:"BYE" ~packing:box#add () in button#set_uri "GHHHHH"; Format.printf "Got:%a@." GUtil.print_widget button; GtkButton.LinkButton.set_uri_hook (fun _ s -> Format.printf "Got url '%s'@." s; button#set_uri "AGAIN"); window#connect#destroy GMain.quit; window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/nihongo.ml0000644000175000017500000000241213460263323016074 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* ć“ć‚Œć‚’å®Ÿč”Œć™ć‚‹å‰ć«LC_ALL=ja_JP.EUCćŖ恩ćØęŒ‡å®šć—ćŖ恑悌恰ćŖ悉ćŖ恄 *) open GMain let window = GWindow.window () let box = GPack.vbox ~packing: window#add () let text = GText.view ~packing: box#add () let button = GButton.button ~label: "ēµ‚äŗ†" ~packing: box#add () let label = GMisc.label ~text:"ć“ć‚Œć«ćÆå½±éŸæ恗ćŖ恄" ~packing: box#add () let _ = window#connect#destroy ~callback:Main.quit; text#buffer#insert "恓悓恫恔ćÆ"; text#misc#set_size_chars ~width:20 ~height:5 (); let style = button#misc#style#copy in button#misc#set_style style; style#set_bg [`NORMAL,`NAME "green"; `PRELIGHT,`NAME "red"]; button#connect#clicked ~callback:Main.quit let _ = window#show (); Main.main () lablgtk-2.18.8/examples/testdnd.ml0000644000175000017500000005211313460263323016103 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* this is a translation in Caml of the gtk+ example testdnd.c *) open Gaux open Gtk open GObj open GMain (* GtkThread.start() *) let drag_icon_xpm = [| "36 48 9 1"; " c None"; ". c #020204"; "+ c #8F8F90"; "@ c #D3D3D2"; "# c #AEAEAC"; "$ c #ECECEC"; "% c #A2A2A4"; "& c #FEFEFC"; "* c #BEBEBC"; " ....................."; " ..&&&&&&&&&&&&&&&&&&&."; " ...&&&&&&&&&&&&&&&&&&&."; " ..&.&&&&&&&&&&&&&&&&&&&."; " ..&&.&&&&&&&&&&&&&&&&&&&."; " ..&&&.&&&&&&&&&&&&&&&&&&&."; " ..&&&&.&&&&&&&&&&&&&&&&&&&."; " ..&&&&&.&&&@&&&&&&&&&&&&&&&."; " ..&&&&&&.*$%$+$&&&&&&&&&&&&&."; " ..&&&&&&&.%$%$+&&&&&&&&&&&&&&."; " ..&&&&&&&&.#&#@$&&&&&&&&&&&&&&."; " ..&&&&&&&&&.#$**#$&&&&&&&&&&&&&."; " ..&&&&&&&&&&.&@%&%$&&&&&&&&&&&&&."; " ..&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&."; " ..&&&&&&&&&&&&.&&&&&&&&&&&&&&&&&&&."; "................&$@&&&@&&&&&&&&&&&&."; ".&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&&&&&."; ".&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&&&."; ".&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&&&."; ".&&&&&&@#@@$&*@&@#@#$**#$&&&&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&@%&%$&&&&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&&+&$+&$&@&$@&&$@&&&&&&&&&&."; ".&&&&&&&&&+&&#@%#+@#@*$%&+$&&&&&&&&."; ".&&&&&&&&&+&&#@#@&&@*%$%$+&&&&&&&&&."; ".&&&&&&&&&+&$%&#@&#@@#&#@$&&&&&&&&&."; ".&&&&&&&&@#@@$&*@&@#@#$#*#$&&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&&&."; ".&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&&&&&."; ".&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&&&&&."; ".&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&&&&&."; ".&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&&&&&."; ".&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&&&&&&&$#@@$&&&&&&&&&&&&&&&."; ".&&&&&&&&&&&&&&&+&$%&$$@&$@&&$@&&&&."; ".&&&&&&&&&&&&&&&+&&#@%#+@#@*$%$+$&&."; ".&&&&&&&&&&&&&&&+&&#@#@&&@*#$%$+&&&."; ".&&&&&&&&&&&&&&&+&$+&*@&#@@#&#@$&&&."; ".&&&&&&&&&&&&&&$%@@&&*@&@#@#$#*#&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&$%&%$&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."; ".&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&."; "...................................." |] let trashcan_closed_xpm = [| "64 80 17 1"; " c None"; ". c #030304"; "+ c #5A5A5C"; "@ c #323231"; "# c #888888"; "$ c #1E1E1F"; "% c #767677"; "& c #494949"; "* c #9E9E9C"; "= c #111111"; "- c #3C3C3D"; "; c #6B6B6B"; "> c #949494"; ", c #282828"; "' c #808080"; ") c #545454"; "! c #AEAEAC"; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " "; " ==......=$$...=== "; " ..$------)+++++++++++++@$$... "; " ..=@@-------&+++++++++++++++++++-.... "; " =.$$@@@-&&)++++)-,$$$$=@@&+++++++++++++,..$ "; " .$$$$@@&+++++++&$$$@@@@-&,$,-++++++++++;;;&.. "; " $$$$,@--&++++++&$$)++++++++-,$&++++++;%%'%%;;$@ "; " .-@@-@-&++++++++-@++++++++++++,-++++++;''%;;;%*-$ "; " +------++++++++++++++++++++++++++++++;;%%%;;##*!. "; " =+----+++++++++++++++++++++++;;;;;;;;;;;;%'>>). "; " .=)&+++++++++++++++++;;;;;;;;;;;;;;%''>>#>#@. "; " =..=&++++++++++++;;;;;;;;;;;;;%###>>###+%== "; " .&....=-+++++%;;####''''''''''##'%%%)..#. "; " .+-++@....=,+%#####'%%%%%%%%%;@$-@-@*++!. "; " .+-++-+++-&-@$$=$=......$,,,@;&)+!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " =+-++-+++-+++++++++!++++!++++!+++!++!+++= "; " $.++-+++-+++++++++!++++!++++!+++!++!+.$ "; " =.++++++++++++++!++++!++++!+++!++.= "; " $..+++++++++++++++!++++++...$ "; " $$=.............=$$ "; " "; " "; " "; " "; " "; " "; " "; " "; " " |] let trashcan_open_xpm = [| "64 80 17 1"; " c None"; ". c #030304"; "+ c #5A5A5C"; "@ c #323231"; "# c #888888"; "$ c #1E1E1F"; "% c #767677"; "& c #494949"; "* c #9E9E9C"; "= c #111111"; "- c #3C3C3D"; "; c #6B6B6B"; "> c #949494"; ", c #282828"; "' c #808080"; ") c #545454"; "! c #AEAEAC"; " "; " "; " "; " "; " "; " "; " .=.==.,@ "; " ==.,@-&&&)-= "; " .$@,&++;;;%>*- "; " $,-+)+++%%;;'#+. "; " =---+++++;%%%;%##@. "; " @)++++++++;%%%%'#%$ "; " $&++++++++++;%%;%##@= "; " ,-++++)+++++++;;;'#%) "; " @+++&&--&)++++;;%'#'-. "; " ,&++-@@,,,,-)++;;;'>'+, "; " =-++&@$@&&&&-&+;;;%##%+@ "; " =,)+)-,@@&+++++;;;;%##%&@ "; " @--&&,,@&)++++++;;;;'#)@ "; " ---&)-,@)+++++++;;;%''+, "; " $--&)+&$-+++++++;;;%%'';- "; " .,-&+++-$&++++++;;;%''%&= "; " $,-&)++)-@++++++;;%''%), "; " =,@&)++++&&+++++;%'''+$@&++++++ "; " .$@-++++++++++++;'#';,........=$@&++++ "; " =$@@&)+++++++++++'##-.................=&++ "; " .$$@-&)+++++++++;%#+$.....................=)+ "; " $$,@-)+++++++++;%;@=........................,+ "; " .$$@@-++++++++)-)@=............................ "; " $,@---)++++&)@===............................,. "; " $-@---&)))-$$=..............................=)!. "; " --&-&&,,$=,==...........................=&+++!. "; " =,=$..=$+)+++++&@$=.............=$@&+++++!++!. "; " .)-++-+++++++++++++++++++++++++++!++!++!. "; " .+-++-+++++++++++++++++++++++!+++!++!++!. "; " .+-++-+++-+++++++++!+++!!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " .+-++-+++-+++++++++!++++!++++!+++!++!++!. "; " =+-++-+++-+++++++++!++++!++++!+++!++!+++= "; " $.++-+++-+++++++++!++++!++++!+++!++!+.$ "; " =.++++++++++++++!++++!++++!+++!++.= "; " $..+++++++++++++++!++++++...$ "; " $$==...........==$$ "; " "; " "; " "; " "; " "; " "; " "; " "; " " |] let window = GWindow.window ~title:"DnD Test" () let _ = window#misc#realize () let drag_icon = GDraw.pixmap_from_xpm_d ~data:drag_icon_xpm ~window () let trashcan_open = GDraw.pixmap_from_xpm_d ~data:trashcan_open_xpm ~window () let trashcan_closed = GDraw.pixmap_from_xpm_d ~data:trashcan_closed_xpm ~window () let targets = [ { target = "STRING"; flags = []; info = 0}; { target = "text/plain"; flags = []; info = 0}; { target = "text/uri-list"; flags = []; info = 2}; { target = "application/x-rootwin-drop"; flags = []; info = 1} ] class drag_handler = object method private beginning (_ : drag_context) = () method private data_delete (_ : drag_context) = () method private data_get (_ : drag_context) (_ : selection_context) ~(info : int) ~(time : int32) = () method private data_received (_ : drag_context) ~(x : int) ~(y : int) (_ : selection_data) ~(info : int) ~(time : int32) = () method private drop (_ : drag_context) ~(x : int) ~(y : int) ~(time : int32) = false method private ending (_ : drag_context) = () method private leave (_ : drag_context) ~(time : int32) = () method private motion (_ : drag_context) ~(x : int) ~(y : int) ~(time : int32) = false end class target_drag ?packing ?show () = let pixmap = GMisc.pixmap trashcan_closed ?packing ?show () in object (self) inherit widget pixmap#as_widget inherit drag_handler val mutable have_drag = false method leave _ ~time = print_endline "leave"; flush stdout; have_drag <- false; pixmap#set_pixmap trashcan_closed method motion context ~x ~y ~time = if not have_drag then begin have_drag <- true; pixmap#set_pixmap trashcan_open end; let source_typename = try context#source_widget#misc#get_type with Gpointer.Null -> "unknown" in Printf.printf "motion, source %s\n" source_typename; flush stdout; context#status (Some context#suggested_action) ~time; true method drop context ~x ~y ~time = prerr_endline "drop"; flush stdout; have_drag <- false; pixmap#set_pixmap trashcan_closed; match context#targets with | [] -> false | d :: _ -> pixmap#drag#get_data ~target:d ~time context; true method data_received context ~x ~y data ~info ~time = if data#format = 8 then begin Printf.printf "Received \"%s\" in trashcan\n" data#data; flush stdout; context#finish ~success:true ~del:false ~time end else context#finish ~success:false ~del:false ~time initializer pixmap#drag#dest_set targets ~actions:[`COPY;`MOVE]; pixmap#drag#connect#leave ~callback:self#leave; pixmap#drag#connect#motion ~callback:self#motion; pixmap#drag#connect#drop ~callback:self#drop; pixmap#drag#connect#data_received ~callback:self#data_received; () end class label_drag ?packing ?show () = let label = GMisc.label ~text:"Drop Here\n" ?packing ?show () in object (self) inherit widget label#as_widget inherit drag_handler method data_received context ~x ~y data ~info ~time = if data#format = 8 then begin Printf.printf "Received \"%s\" in label\n" data#data; flush stdout; context#finish ~success:true ~del:false ~time end else context#finish ~success:false ~del:false ~time initializer label#drag#dest_set targets ~actions:[`COPY; `MOVE ]; label#drag#connect#data_received ~callback:self#data_received; () end class source_drag ?packing ?show () = let button = GButton.button ~label:"Drag Here\n" ?packing ?show () in object (self) inherit widget button#as_widget inherit drag_handler method data_get _ sel ~info ~time = if info = 1 then begin print_endline "I was dropped on the rootwin"; flush stdout end else if info = 2 then sel#return "file:///home/otaylor/images/weave.png" else sel#return "I'm Data!" method data_delete _ = print_endline "Delete the data!"; flush stdout initializer button#drag#source_set targets ~modi:[`BUTTON1; `BUTTON3 ] ~actions:[`COPY; `MOVE ]; button#drag#source_set_icon drag_icon; button#drag#connect#data_get ~callback:self#data_get; button#drag#connect#data_delete ~callback:self#data_delete; () end class popup () = object (self) inherit drag_handler val mutable popup_window = (None : #GWindow.window option) val mutable popped_up = false val mutable in_popup = false val mutable popdown_timer = None val mutable popup_timer = None method timer = popup_timer method remove_timer () = may popup_timer ~f:(fun pdt -> Timeout.remove pdt; popup_timer <- None) method add_timer time ~callback = popup_timer <- Some (Timeout.add ~ms:time ~callback) method popdown () = popdown_timer <- None; may popup_window ~f:(fun w -> w#misc#hide ()); popped_up <- false; false method motion (_ : drag_context) ~x ~y ~time = if not in_popup then begin in_popup <- true; may popdown_timer ~f: begin fun pdt -> print_endline "removed popdown"; flush stdout; Timeout.remove pdt; popdown_timer <- None end end; true method leave (_ : drag_context) ~time = if in_popup then begin in_popup <- false; if popdown_timer = None then begin print_endline "added popdown"; flush stdout; popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown) end end method popup () = if not popped_up then begin if popup_window = None then begin let w = GWindow.window ~kind:`POPUP ~position:`MOUSE () in popup_window <- Some w; let table = GPack.table ~rows:3 ~columns:3 ~packing:w#add () in for i = 0 to 2 do for j = 0 to 2 do let button = GButton.button ~label:(string_of_int i ^ "," ^ string_of_int j) ~packing:(table#attach ~left:i ~top:j ~expand:`BOTH) () in button#drag#dest_set targets ~actions:[`COPY; `MOVE ]; button#drag#connect#motion ~callback:self#motion; button#drag#connect#leave ~callback:self#leave; done done end; may popup_window ~f:(fun w -> w#show ()); popped_up <- true end; popdown_timer <- Some (Timeout.add ~ms:500 ~callback:self#popdown); print_endline "added popdown"; flush stdout; self#remove_timer (); false end class popsite ?packing ?show () = let label = GMisc.label ~text:"Popup\n" ?packing ?show () and popup = new popup () in object (self) inherit widget label#as_widget inherit drag_handler method motion _ ~x ~y ~time = if popup#timer = None then begin print_endline "added popdown"; flush stdout; popup#add_timer 500 ~callback:popup#popup end; true method leave _ ~time = popup#remove_timer () initializer label#drag#dest_set targets ~actions:[`COPY; `MOVE ]; label#drag#connect#motion ~callback:self#motion; label#drag#connect#leave ~callback:self#leave; () end let main () = window#connect#destroy ~callback: Main.quit; let table = GPack.table ~rows:2 ~columns:2 ~packing:window#add () in let attach = table#attach ~expand:`BOTH in new label_drag ~packing:(attach ~left:0 ~top:0) (); new target_drag ~packing:(attach ~left:1 ~top:0) (); new source_drag ~packing:(attach ~left:0 ~top:1) (); new popsite ~packing:(attach ~left:1 ~top:1) (); window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/druid.ml0000644000175000017500000000661613460263323015554 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) type color = | RED | BLUE | YELLOW type food = | DONUTS | YOGHURTS | PIZZA class answer = object val mutable color = RED val mutable food = DONUTS method answer_color c () = color <- c method answer_food f () = food <- f method get_answer = "42" end let radio_color poll packing = let f = GBin.frame ~label:"Color" ~packing () in let vb = GPack.vbox ~packing:f#add () in let rb = GButton.radio_button ~label:"Red" ~packing:(vb#pack) () in rb#connect#clicked (poll#answer_color RED) ; let rb2 = GButton.radio_button ~group:rb#group ~label:"Blue" ~packing:(vb#pack) () in rb2#connect#clicked (poll#answer_color BLUE) ; let rb3 = GButton.radio_button ~group:rb#group ~label:"Yellow" ~packing:(vb#pack) () in rb3#connect#clicked (poll#answer_color YELLOW) let radio_food poll = let vb = GPack.vbox () in let rb = GButton.radio_button ~label:"Donuts" ~packing:(vb#pack) () in rb#connect#clicked (poll#answer_food DONUTS) ; let rb2 = GButton.radio_button ~group:rb#group ~label:"Pizza" ~packing:(vb#pack) () in rb2#connect#clicked (poll#answer_food PIZZA) ; let rb3 = GButton.radio_button ~group:rb#group ~label:"Yoghurt" ~packing:(vb#pack) () in rb3#connect#clicked (poll#answer_food YOGHURTS) ; vb let are_you_sure quit = let md = GWindow.message_dialog ~message:"Are you sure ?" ~message_type:`QUESTION ~buttons:GWindow.Buttons.yes_no ~modal:true () in let res = md#run () = `YES in md#destroy () ; if res then quit () let make_druid poll quit = let d = GnoDruid.druid () in d#connect#cancel (fun () -> are_you_sure quit) ; begin let fp = GnoDruid.druid_page_edge ~position:`START ~aa:true ~title:"Poll !!" () in fp#set_text "Here is our great new poll.\nPlease answer all the questions !" ; d#append_page fp end ; begin let cp = GnoDruid.druid_page_standard ~title:"Color" () in radio_color poll cp#vbox#pack ; d#append_page cp end ; begin let mp = GnoDruid.druid_page_standard ~title:"Food" () in mp#append_item ~question:"Favorite food ?" ~additional_info:"" (radio_food poll)#coerce ; d#append_page mp end ; begin let ep = GnoDruid.druid_page_edge ~position:`FINISH ~aa:true ~title:"The end" () in ep#set_text "Thank you for your co-operation." ; d#append_page ep ; ep#connect#finish (fun _ -> let res = GWindow.message_dialog ~message:(Printf.sprintf "The answer is %s!" poll#get_answer) ~message_type:`INFO ~buttons:GWindow.Buttons.close ~modal:true () in res#run () ; res#destroy () ; quit ()) end ; d let window_and_druid () = let w = GWindow.window ~title:"Druid test" () in let poll = new answer in w#add (make_druid poll GMain.quit)#coerce ; w#event#connect#delete (fun _ -> are_you_sure GMain.quit ; true) ; w let _ = let w = window_and_druid () in w#show () ; GMain.main () lablgtk-2.18.8/examples/entry.ml0000644000175000017500000000353513460263323015603 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open Printf open GMain let enter_callback entry = printf "Entry contents: %s\n" entry#text; flush stdout let entry_toggle_editable button entry = entry#set_editable button#active let entry_toggle_visibility button entry = entry#set_visibility button#active let main () = let window = GWindow.window ~title: "GTK Entry" ~width: 200 ~height: 100 () in window#connect#destroy ~callback:Main.quit; let vbox = GPack.vbox ~packing: window#add () in let entry = GEdit.entry ~max_length: 50 ~packing: vbox#add () in entry#connect#activate ~callback:(fun () -> enter_callback entry); entry#set_text "Hello"; entry#append_text " world"; entry#select_region ~start:0 ~stop:entry#text_length; let hbox = GPack.hbox ~packing: vbox#add () in let check = GButton.check_button ~label: "Editable" ~active: true ~packing: hbox#add () in check#connect#toggled ~callback:(fun () -> entry_toggle_editable check entry); let check = GButton.check_button ~label:"Visible" ~active:true ~packing:hbox#add () in check#connect#toggled ~callback:(fun () -> entry_toggle_visibility check entry); let button = GButton.button ~label: "Close" ~packing: vbox#add () in button#connect#clicked ~callback:window#destroy; button#grab_default (); window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/radiobuttons.ml0000644000175000017500000000327113460263323017154 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let window = GWindow.window ~title: "radio buttons" ~border_width: 0 () in window#connect#destroy ~callback:Main.quit; let box1 = GPack.vbox ~packing: window#add () in let box2 = GPack.vbox ~spacing:10 ~border_width: 10 ~packing: box1#add () in let button1 = GButton.radio_button ~label:"button1" ~packing: box2#add () in button1#connect#clicked ~callback:(fun () -> prerr_endline "button1"); let button2 = GButton.radio_button ~group:button1#group ~label:"button2" ~active:true ~packing: box2#add () in button2#connect#clicked ~callback:(fun () -> prerr_endline "button2"); let button3 = GButton.radio_button ~group:button1#group ~label:"button3" ~packing: box2#add () in button3#connect#clicked ~callback:(fun () -> prerr_endline "button3"); let separator = GMisc.separator `HORIZONTAL ~packing: box1#pack () in let box3 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box3#add () in button#connect#clicked ~callback:Main.quit; button#grab_default (); window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/editor2.ml0000644000175000017500000001115513460263323016007 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels let file_dialog ~title ~callback ?filename () = let sel = GWindow.file_selection ~title ~modal:true ?filename () in sel#cancel_button#connect#clicked ~callback:sel#destroy; sel#ok_button#connect#clicked ~callback: begin fun () -> let name = sel#filename in sel#destroy (); callback name end; sel#show () let input_channel b ic = let buf = Bytes.create 1024 and len = ref 0 in while len := input ic buf 0 1024; !len > 0 do Buffer.add_subbytes b buf 0 !len done let with_file name ~f = let ic = open_in name in try f ic; close_in ic with exn -> close_in ic; raise exn class editor ?packing ?show () = object (self) val text = GText.view ?packing ?show () val mutable filename = None method text = text method load_file name = try let b = Buffer.create 1024 in with_file name ~f:(input_channel b); let s = Glib.Convert.locale_to_utf8 (Buffer.contents b) in let n_buff = GText.buffer ~text:s () in text#set_buffer n_buff; filename <- Some name; n_buff#place_cursor n_buff#start_iter with _ -> prerr_endline "Load failed" method open_file () = file_dialog ~title:"Open" ~callback:self#load_file () method save_dialog () = file_dialog ~title:"Save" ?filename ~callback:(fun file -> self#output ~file) () method save_file () = match filename with Some file -> self#output ~file | None -> self#save_dialog () method output ~file = try if Sys.file_exists file then Sys.rename file (file ^ "~"); let s = text#buffer#get_text () in let oc = open_out file in output_string oc (Glib.Convert.locale_from_utf8 s); close_out oc; filename <- Some file with _ -> prerr_endline "Save failed" end let window = GWindow.window ~width:500 ~height:300 ~title:"editor" () let vbox = GPack.vbox ~packing:window#add () let menubar = GMenu.menu_bar ~packing:vbox#pack () let factory = new GMenu.factory ~accel_path:"/" menubar let accel_group = factory#accel_group let file_menu = factory#add_submenu "File" let edit_menu = factory#add_submenu "Edit" let scrollwin = GBin.scrolled_window ~packing:vbox#add () let editor = new editor ~packing:scrollwin#add () open GdkKeysyms let _ = window#connect#destroy ~callback:GMain.quit; let factory = new GMenu.factory ~accel_path:"/////" file_menu ~accel_group in factory#add_item "Open" ~key:_O ~callback:editor#open_file; factory#add_item "Save" ~key:_S ~callback:editor#save_file; factory#add_item "Save as..." ~callback:editor#save_dialog; factory#add_separator (); factory#add_item "Quit" ~key:_Q ~callback:window#destroy; let factory = new GMenu.factory ~accel_path:"///" edit_menu ~accel_group in factory#add_item "Copy" ~key:_C ~callback: (fun () -> editor#text#buffer#copy_clipboard GMain.clipboard); factory#add_item "Cut" ~key:_X ~callback: (fun () -> GtkSignal.emit_unit editor#text#as_view GtkText.View.S.cut_clipboard); factory#add_item "Paste" ~key:_V ~callback: (fun () -> GtkSignal.emit_unit editor#text#as_view GtkText.View.S.paste_clipboard); factory#add_separator (); factory#add_check_item "Word wrap" ~active:false ~callback: (fun b -> editor#text#set_wrap_mode (if b then `WORD else `NONE)); factory#add_check_item "Read only" ~active:false ~callback:(fun b -> editor#text#set_editable (not b)); factory#add_item "Save accels" ~callback:(fun () -> GtkData.AccelMap.save "test.accel"); window#add_accel_group accel_group; editor#text#event#connect#button_press ~callback:(fun ev -> let button = GdkEvent.Button.button ev in if button = 3 then begin file_menu#popup ~button ~time:(GdkEvent.Button.time ev); true end else false); window#show (); let () = GtkData.AccelMap.load "test.accel" in GtkData.AccelMap.foreach (fun ~path ~key ~modi ~changed -> if modi = [`CONTROL] then if GtkData.AccelMap.change_entry path ~key ~modi:[`MOD1] then prerr_endline ("Changed " ^ path) else prerr_endline ("Could not change "^path)); GMain.main () lablgtk-2.18.8/examples/fixed_editor.ml0000644000175000017500000002224713460263323017110 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open Gdk open Gtk open GObj open GMain let dnd_source_window () = let window = GWindow.window ~position:`MOUSE () in let vbx = GPack.vbox ~border_width:10 ~packing:window#add () in let evb = GBin.event_box ~border_width:0 ~packing:vbx#add () in let frm = GBin.frame ~shadow_type:`OUT ~packing:evb#add () in let lbl = GMisc.label ~text:"hello" ~packing:frm#add () in let lbl2 = GMisc.label ~text:"drag from here!" ~packing:vbx#add () in let targets = [ { target = "STRING"; flags = []; info = 0} ] in begin window#show (); evb#drag#source_set targets ~modi:[`BUTTON1] ~actions:[`COPY]; evb#drag#connect#data_get ~callback: begin fun _ sel ~info ~time -> sel#return "hello! " end end let corner_width = 7 let corner_height = 7 type drag_action_type = GB_DRAG_NONE | GB_MIDDLE | GB_TOP | GB_BOTTOM | GB_LEFT | GB_RIGHT | GB_TOP_LEFT | GB_TOP_RIGHT | GB_BOTTOM_LEFT | GB_BOTTOM_RIGHT let get_position_in_widget w ~x ~y ~width ~height = if (x <= corner_width) then if (y <= corner_height) then GB_TOP_LEFT else if (y >= height-corner_width) then GB_BOTTOM_LEFT else GB_LEFT else if (x >= width-corner_width) then if (y <= corner_height) then GB_TOP_RIGHT else if (y >= height-corner_width) then GB_BOTTOM_RIGHT else GB_RIGHT else if (y <= corner_height) then GB_TOP else if (y >= height-corner_width) then GB_BOTTOM else GB_MIDDLE class drag_info = object val mutable drag_action = GB_DRAG_NONE val mutable drag_offset = (0, 0) val mutable toimen = (0, 0) val mutable drag_widget = None method drag_action = drag_action method drag_offset = drag_offset method toimen = toimen (* coord. of opposite corner *) method set_drag_widget (w : GObj.widget) = begin match drag_widget with None -> begin GMain.Grab.add w; drag_widget <- Some w; () end | Some w -> () end method unset_drag_widget () = begin match drag_widget with Some w -> begin GMain.Grab.remove w; drag_widget <- None; () end | None -> () end method set_drag_offset ~x ~y = drag_offset <- (x, y) method set_drag_action (w : Gdk.window) ~x ~y = begin let (x0, y0) = Window.get_position w in let (width, height) = Drawable.get_size w in drag_action <- get_position_in_widget w ~x ~y ~width ~height; let (x1, y1) = (x0+width, y0+height) in toimen <- match drag_action with GB_TOP_LEFT -> (x1, y1) | GB_BOTTOM_LEFT -> (x1, y0) | GB_TOP_RIGHT -> (x0, y1) | GB_BOTTOM_RIGHT -> (x0, y0) | GB_TOP -> (x0, y1) | GB_BOTTOM -> (x0, y0) | GB_LEFT -> (x1, y0) | GB_RIGHT -> (x0, y0) | _ -> (-1, -1) end method unset_drag_action () = drag_action <- GB_DRAG_NONE end let to_grid g x = x - (x mod g) let to_grid2 g (x, y) = (to_grid g x, to_grid g y) class fix_editor ~width ~height ~packing = let info = new drag_info in let fix = GPack.fixed ~has_window:true ~width ~height ~packing () in let _ = fix#misc#realize () in let fix_window = fix#misc#window in let fix_drawing = new GDraw.drawable fix_window in object (self) inherit GObj.widget fix#as_widget val mutable grid = 1 method set_grid g = if (grid != g) then begin let pix = GDraw.pixmap ~window:fix ~width:g ~height:g ~mask:true () in let c = fix#misc#style#bg `NORMAL in pix#set_foreground (`COLOR c); pix#rectangle ~filled:true ~x:0 ~y:0 ~width:g ~height:g (); pix#set_foreground `BLACK; pix#point ~x:0 ~y:0; Gdk.Window.set_back_pixmap fix_window (`PIXMAP pix#pixmap) end; grid <- g method new_child ~name ~x ~y ~width ~height ~callback = let evb = GBin.event_box ~border_width:0 ~packing:fix#add () in let lbl = GMisc.label ~text:name ~width ~height ~packing:evb#add () in evb#misc#realize (); fix#move evb#coerce ~x ~y; self#connect_signals ~ebox:evb ~widget:lbl#coerce ~callback; () method private connect_signals ~ebox:(ebox : GBin.event_box) ~widget:(widget : widget) ~callback:cbfun = let drawing = new GDraw.drawable (ebox#misc#window) in let draw_id = ref None in let exps_id = ref None in let on_paint _ = let (width, height) = Drawable.get_size (ebox#misc#window) in begin drawing#set_foreground `BLACK; drawing#rectangle ~filled:true ~x:0 ~y:0 ~width:corner_width ~height:corner_height (); drawing#rectangle ~filled:true ~x:(width-corner_width) ~y:0 ~width:corner_width ~height:corner_height (); drawing#rectangle ~filled:true ~x:(width-corner_width) ~y:(height-corner_height) ~width:corner_width ~height:corner_height (); drawing#rectangle ~filled:true ~x:0 ~y:(height-corner_height) ~width:corner_width ~height:corner_height (); drawing#rectangle ~filled:false ~x:0 ~y:0 ~width:(width-1) ~height:(height-1) (); end in ebox#event#connect#button_press ~callback: begin fun ev -> let bx = int_of_float (GdkEvent.Button.x ev) in let by = int_of_float (GdkEvent.Button.y ev) in info#set_drag_action (ebox#misc#window) ~x:bx ~y:by; info#set_drag_offset ~x:bx ~y:by; true end; ebox#event#connect#motion_notify ~callback: begin fun ev -> info#set_drag_widget ebox#coerce; let action = info#drag_action in let (mx, my) = fix#misc#pointer in let (ox, oy) = info#drag_offset in begin match action with GB_MIDDLE -> let (nx, ny) = to_grid2 grid (mx-ox, my-oy) in fix#move ebox#coerce ~x:nx ~y:ny; if cbfun ~x:nx ~y:ny ~width:(-2) ~height:(-2) then () else (* should we undo ? *) () | GB_DRAG_NONE -> () (* do nothing *) | GB_TOP_LEFT | GB_BOTTOM_LEFT | GB_TOP_RIGHT | GB_BOTTOM_RIGHT -> let (toi_x, toi_y) = info#toimen in let (mx, my) = to_grid2 grid (mx, my) in let (lx, rx) = if mx let (lx, toi_y) = info#toimen in let my = to_grid grid my in let (ty, by) = if my let (toi_x, ty) = info#toimen in let mx = to_grid grid mx in let (lx, rx) = if mx info#unset_drag_action (); info#unset_drag_widget (); true end; exps_id := Some (ebox#event#connect#after#expose ~callback:(fun _ -> on_paint(); false)); (* draw_id := Some (ebox#misc#connect#draw ~callback:on_paint); *) () initializer fix#drag#dest_set ~actions:[`COPY] [ { target = "STRING"; flags = []; info = 0} ]; fix#drag#connect#data_received ~callback: begin fun context ~x ~y data ~info ~time -> let name = data#data in let _ = self#new_child ~name ~x ~y ~width:32 ~height:32 ~callback:(fun ~x ~y ~width ~height -> true) in (* Printf.printf "%s %d %d\n" (data#data) x y; flush stdout; *) context#finish ~success:true ~del:false ~time; end; () end (* the following is for test only *) let window1 () = let window = GWindow.window () in let _ = window#connect#destroy ~callback: Main.quit in let fix = new fix_editor ~width:640 ~height:480 ~packing:window#add in fix#set_grid 5; let setter = fix#new_child ~name:"hello" ~x:100 ~y:200 ~width:32 ~height:32 ~callback:begin fun ~x ~y ~width ~height -> (* Printf.printf "name=%s, x=%d, y=%d, width=%d, height=%d\n" "hello" x y width height; flush stdout; *) true end in window#show (); () let main () = window1 (); dnd_source_window (); Main.main () let _ = main () (* Todo change mouse cursor resize fixed itself remove_child (drag and) drop *) lablgtk-2.18.8/examples/rpn.ml0000644000175000017500000001023713460263323015236 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* reverse polish calculator *) open StdLabels open GMain let wow _ = prerr_endline "Wow!"; () let main () = let stack = Stack.create () in (* toplevel window *) let window = GWindow.window ~border_width: 10 ~title:"Reverse Polish Calculator" () in window#connect#destroy ~callback:Main.quit; (* vbox *) let vbx = GPack.vbox ~packing:window#add () in (* entry *) let entry = GEdit.entry ~text:"0" ~editable:false ~max_length: 20 ~packing: vbx#add () in (* BackSpace, Clear, All Clear, Quit *) let table0 = GPack.table ~rows:1 ~columns:4 ~packing:vbx#add () in let bs_clicked _ = begin let txt = entry#text in let len = String.length txt in if len <= 1 then entry#set_text "0" else entry#set_text (String.sub txt ~pos:0 ~len:(len-1)) end in let c_clicked _ = entry#set_text("0") in let ac_clicked _ = Stack.clear stack; entry#set_text("0") in let labels0 = [("BS", bs_clicked) ; ("C", c_clicked); ("AC", ac_clicked); ("Quit", window#destroy)] in let rec loop0 labels n = match labels with [] -> () | (lbl, cb) :: t -> let button = GButton.button ~label:lbl ~packing:(table0#attach ~left:n ~top:1 ~expand:`BOTH) () in button#connect#clicked ~callback:cb; loop0 t (n+1) in loop0 labels0 1; (* Numerals *) let table1 = GPack.table ~rows:4 ~columns:5 ~packing:vbx#add () in let labels1 = ["7"; "8"; "9"; "4"; "5"; "6"; "1"; "2"; "3"; "0"] in let numClicked n _ = let txt = entry#text in if (txt = "0") then entry#set_text n else begin entry#append_text n end in let rec loop1 labels n = match labels with [] -> () | lbl :: lbls -> let button = GButton.button ~label:(" "^lbl^" ") ~packing:(table1#attach ~left:(n mod 3) ~top:(n/3) ~expand:`BOTH) () in button#connect#clicked ~callback:(numClicked lbl); loop1 lbls (n+1) in loop1 labels1 0; (* Period *) let periodClicked _ = let txt = entry#text in if not (String.contains txt '.') then entry#append_text "." in (GButton.button ~label:" . " ~packing:(table1#attach ~left:1 ~top:3 ~expand:`BOTH) ()) #connect#clicked ~callback:periodClicked; (* Enter (Push) *) let enterClicked _ = let txt = entry#text in let n = float_of_string txt in begin Stack.push n stack; entry#set_text "0" end in (GButton.button ~label:"Ent" ~packing:(table1#attach ~left:2 ~top:3 ~expand:`BOTH) ()) #connect#clicked ~callback:enterClicked; (* Operators *) let op2Clicked op _ = let n1 = float_of_string (entry#text) in let n2 = Stack.pop stack in entry#set_text (string_of_float (op n2 n1)) in let op1Clicked op _ = let n1 = float_of_string (entry#text) in entry#set_text (string_of_float (op n1)) in let modClicked _ = let n1 = int_of_string (entry#text) in let n2 = truncate (Stack.pop stack) in entry#set_text (string_of_int (n2 mod n1)) in let labels2 = [(" / ", op2Clicked (/.)); (" * ", op2Clicked ( *. )); (" - ", op2Clicked (-.)); (" + ", op2Clicked (+.)); ("mod", modClicked); (" ^ ", op2Clicked ( ** )); ("+/-", op1Clicked (~-.)); ("1/x", op1Clicked (fun x -> 1.0/.x))] in let rec loop2 labels n = match labels with [] -> () | (lbl, cb) :: t -> let button = GButton.button ~label:lbl ~packing:(table1#attach ~left:(3 + n/4) ~top: (n mod 4) ~expand:`BOTH) () in button#connect#clicked ~callback:cb; loop2 t (n+1) in loop2 labels2 0; (* show all and enter event loop *) window#show (); Main.main () let _ = Printexc.print main() lablgtk-2.18.8/examples/accel_tree.ml0000644000175000017500000001465313460263323016533 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) type accel = { action : string; mask : Gdk.Tags.modifier list; value : Gdk.keysym; } open GdkKeysyms let list = [{action="Cut"; mask=[`CONTROL]; value= _X }; {action="Copy"; mask=[`CONTROL]; value= _C }; {action="Paste"; mask=[`CONTROL]; value= _V }; {action="Print"; mask=[`CONTROL]; value= _P }; {action="New"; mask=[`CONTROL]; value= _N }; {action="Open"; mask=[`CONTROL]; value= _O }; {action="Print"; mask=[`CONTROL]; value= _P }; ] let cols = new GTree.column_list let action = cols#add Gobject.Data.string let mask = cols#add Gobject.Data.int let value = cols#add Gobject.Data.uint let accel_edited (store:GTree.list_store) model path ~accel_key ~accel_mods ~hardware_keycode = let iter = model#get_iter path in ignore (store#set ~row:iter ~column:mask accel_mods); ignore (store#set ~row:iter ~column:value accel_key) let setup_tree_view (store:GTree.list_store) (treeview:GTree.view) = let renderer = GTree.cell_renderer_text [] in let column = GTree.view_column ~title:"Buy" ~renderer:(renderer,["text",action]) () in ignore (treeview#append_column column); let renderer = GTree.cell_renderer_accel [`ACCEL_MODE `GTK; `EDITABLE true] in let column = GTree.view_column ~title:"Buy" ~renderer:(renderer,[]) () in column#add_attribute renderer "accel-mods" mask; column#add_attribute renderer "accel-key" value; ignore (treeview#append_column column); renderer#connect#accel_edited ~callback:(accel_edited store treeview#model) let () = let window = GWindow.window ~kind:`TOPLEVEL ~title:"Accelerator Keys" ~border_width:10 ~width:250 ~height:250 () in let store = GTree.list_store cols in List.iter (fun {action=a; mask=m; value=v} -> let row = store#append () in store#set ~row ~column:action a; store#set ~row ~column:mask (Gpointer.encode_flags GdkEnums.modifier m); store#set ~row ~column:value v; ) list; let scrolled_win = GBin.scrolled_window ~packing:window#add ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in let treeview = GTree.view ~model:store ~packing:scrolled_win#add () in setup_tree_view store treeview; window#show (); window#connect#destroy GMain.quit; GMain.main () (* This code is an OCaml adaptation of the following C code from http://www.linuxquestions.org/linux/articles/Technical/New_GTK_Widgets_GtkCellRendererAccel #include #include enum { ACTION = 0, MASK, VALUE, COLUMNS }; typedef struct { gchar *action; GdkModifierType mask; guint value; } Accelerator; const Accelerator list[] = { {"Cut", GDK_CONTROL_MASK, GDK_X }, { "Copy", GDK_CONTROL_MASK, GDK_C }, { "Paste", GDK_CONTROL_MASK, GDK_V }, { "New", GDK_CONTROL_MASK, GDK_N }, { "Open", GDK_CONTROL_MASK, GDK_O }, { "Print", GDK_CONTROL_MASK, GDK_P }, { NULL, NULL, NULL } }; static void setup_tree_view (GtkWidget* ); static void accel_edited (GtkCellRendererAccel*, gchar*, guint, GdkModifierType, guint, GtkTreeView* ); int main (int argc, char *argv[]) { GtkWidget *window, *treeview, *scrolled_win; GtkListStore *store; GtkTreeIter iter; guint i = 0; gtk_init (&argc, &argv); window = gtk_window_new (GTK_WINDOW_TOPLEVEL); gtk_window_set_title (GTK_WINDOW (window), "Accelerator Keys"); gtk_container_set_border_width (GTK_CONTAINER (window), 10); gtk_widget_set_size_request (window, 250, 250); treeview = gtk_tree_view_new (); setup_tree_view (treeview); store = gtk_list_store_new (COLUMNS, G_TYPE_STRING, G_TYPE_INT, G_TYPE_UINT); /* Add all of the keyboard accelerators to the GtkListStore. */ while (list[i].action != NULL) { gtk_list_store_append (store, &iter); gtk_list_store_set (store, &iter, ACTION, list[i].action, MASK, (gint) list[i].mask, VALUE, list[i].value, -1); i++; } gtk_tree_view_set_model (GTK_TREE_VIEW (treeview), GTK_TREE_MODEL (store)); g_object_unref (store); scrolled_win = gtk_scrolled_window_new (NULL, NULL); gtk_scrolled_window_set_policy (GTK_SCROLLED_WINDOW (scrolled_win), GTK_POLICY_AUTOMATIC, GTK_POLICY_AUTOMATIC); gtk_container_add (GTK_CONTAINER (scrolled_win), treeview); gtk_container_add (GTK_CONTAINER (window), scrolled_win); gtk_widget_show_all (window); gtk_main (); return 0; } /* Create a tree view with two columns. The first is an action and the * second is a keyboard accelerator. */ static void setup_tree_view (GtkWidget *treeview) { GtkCellRenderer *renderer; GtkTreeViewColumn *column; renderer = gtk_cell_renderer_text_new (); column = gtk_tree_view_column_new_with_attributes ("Buy", renderer, "text", ACTION, NULL); gtk_tree_view_append_column (GTK_TREE_VIEW (treeview), column); renderer = gtk_cell_renderer_accel_new (); g_object_set (renderer, "accel-mode", GTK_CELL_RENDERER_ACCEL_MODE_GTK, "editable", TRUE, NULL); column = gtk_tree_view_column_new_with_attributes ("Buy", renderer, "accel-mods", MASK, "accel-key", VALUE, NULL); gtk_tree_view_append_column (GTK_TREE_VIEW (treeview), column); g_signal_connect (G_OBJECT (renderer), "accel_edited", G_CALLBACK (accel_edited), (gpointer) treeview); } /* Apply the new keyboard accelerator key and mask to the cell. */ static void accel_edited (GtkCellRendererAccel *renderer, gchar *path, guint accel_key, GdkModifierType mask, guint hardware_keycode, GtkTreeView *treeview) { GtkTreeModel *model; GtkTreeIter iter; model = gtk_tree_view_get_model (treeview); if (gtk_tree_model_get_iter_from_string (model, &iter, path)) gtk_list_store_set (GTK_LIST_STORE (model), &iter, MASK, (gint) mask, VALUE, accel_key, -1); } *) lablgtk-2.18.8/examples/gioredirect.ml0000644000175000017500000000500713460263323016736 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open StdLabels open GMain (* On Windows, the channel will be set to non blocking mode. The argument given to [callback] may no be UTF-8 encoded. The redirection stops as soon as [callbacks] return [false] or an error occured *) let channel_redirector channel callback = let cout,cin = Unix.pipe () in Unix.dup2 cin channel ; let channel = Io.channel_of_descr cout in let len = 80 in let buf = Bytes.create len in Io.add_watch channel ~prio:0 ~cond:[`IN; `HUP; `ERR] ~callback: begin fun cond -> try if List.mem `IN cond then begin (* On Windows, you must use Io.read *) let len = Io.read channel ~buf ~pos:0 ~len in len >= 1 && (callback (Bytes.sub_string buf ~pos:0 ~len)) end else false with e -> callback ("Channel redirector got an exception: " ^ (Printexc.to_string e)); false end let () = let _l = Main.init () in let w = GWindow.window ~width:300 ~height:200 () in let notebook = GPack.notebook ~packing:w#add () in let redirect channel name = let buffer = GText.buffer () in let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in let label = GMisc.label ~markup:name () in let _ = notebook#prepend_page ~tab_label:label#coerce sw#coerce in let _text = GText.view ~buffer ~editable:false ~packing:sw#add () in channel_redirector channel (fun c -> buffer#insert c; true ) in redirect Unix.stdout "Std Out"; redirect Unix.stderr "Std Error"; let _ = Timeout.add 500 (fun () -> try Pervasives.print_endline "Hello print_endline"; true with e -> prerr_endline (Printexc.to_string e); false) ,Timeout.add 500 (fun () -> Printf.printf "Hello printf\n%!"; true) ,Timeout.add 500 (fun () -> Format.printf "Hello format@."; true), Timeout.add 5000 (fun () -> Pervasives.prerr_endline "Hello prerr_endline"; true) in let _ = w#connect#destroy quit in w#show (); main () lablgtk-2.18.8/examples/GL/0000755000175000017500000000000013523300020014366 5ustar stephstephlablgtk-2.18.8/examples/GL/tutorial-4.ml0000644000175000017500000000641413460263323016747 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Copyright 2001 David MENTRE *) (* This program is under GNU GPL license *) (* general structure taken in lablgtk planet.ml from Jacques Garrigues *) (* OLablgtk/Olabgl adaptation of NeHe's OpenGL tutorial #4: http://nehe.gamedev.net/tutorials/lesson04.asp *) let rtri = ref 0.0 let rquad = ref 0.0 let resizeGLScene ~width ~height = let ok_height = if height = 0 then 1 else height in GlDraw.viewport 0 0 width ok_height; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:45.0 ~aspect:((float_of_int width)/.(float_of_int ok_height)) ~z:(0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () let initGL () = GlDraw.shade_model `smooth; GlClear.color ~alpha:0.0 (0.0, 0.0, 0.0); GlClear.depth 1.0; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let drawGLScene area () = GlClear.clear [`color; `depth]; GlMat.load_identity (); GlMat.translate ~x:(-1.5) ~y:0.0 ~z:(-6.0) (); GlMat.rotate ~angle:!rtri ~x:0.0 ~y:1.0 ~z:0.0 (); GlDraw.begins `triangles; GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.ends (); GlMat.load_identity (); GlMat.translate ~x:1.5 ~y:0.0 ~z:(-6.0) (); GlMat.rotate ~angle:!rquad ~x:1.0 ~y:0.0 ~z:0.0 (); GlDraw.color (0.5, 0.5, 1.0); GlDraw.begins `quads; GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); rtri := !rtri +. 0.2; rquad := !rquad -. 0.15; area#swap_buffers () let killGLWindow () = () (* do nothing *) let createGLWindow title width height bits fullscreen = let w = GWindow.window ~title:title () in w#connect#destroy ~callback:(fun () -> GMain.Main.quit (); exit 0); w#set_resize_mode `IMMEDIATE; let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 16;`BUFFER_SIZE bits] ~width:width ~height:height~packing:w#add () in area#event#add [`KEY_PRESS]; w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = GdkKeysyms._Escape then w#destroy (); true end; GMain.Timeout.add ~ms:20 ~callback: begin fun () -> drawGLScene area (); true end; area#connect#display ~callback:(drawGLScene area); area#connect#reshape ~callback:resizeGLScene; area#connect#realize ~callback: begin fun () -> initGL (); resizeGLScene ~width ~height end; w#show (); w let main () = let w = createGLWindow "Tutorial $" 640 480 16 false in GMain.Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/planet.ml0000644000175000017500000001051713460263323016225 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels class planet area = object (self) val area : GlGtk.area = area val mutable year = 0.0 val mutable day = 0.0 val mutable eye = 0.0 val mutable time = 0.0 method tick new_time = if time = 0. then time <- new_time else let diff = new_time -. time in time <- new_time; day <- mod_float (day +. diff *. 200.) 360.0; year <- mod_float (year +. diff *. 20.) 360.0 method day_add () = day <- mod_float (day +. 10.0) 360.0 method day_subtract () = day <- mod_float (day -. 10.0) 360.0 method year_add () = year <- mod_float (year +. 5.0) 360.0 method year_subtract () = year <- mod_float (year -. 5.0) 360.0 method eye x = eye <- x; self#display () method display () = GlClear.clear [`color;`depth]; GlDraw.color (1.0, 1.0, 1.0); GlMat.push(); GlMat.rotate ~angle:eye ~x:1. (); (* draw sun *) GlLight.material ~face:`front (`specular (1.0,1.0,0.0,1.0)); GlLight.material ~face:`front (`shininess 5.0); GluQuadric.sphere ~radius:1.0 ~slices:32 ~stacks:32 (); (* draw smaller planet *) GlMat.rotate ~angle:year ~y:1.0 (); GlMat.translate ~x:3.0 (); GlMat.rotate ~angle:day ~y:1.0 (); GlDraw.color (0.0, 1.0, 1.0); GlDraw.shade_model `flat; GlLight.material ~face:`front(`shininess 128.0); GluQuadric.sphere ~radius:0.2 ~slices:10 ~stacks:10 (); GlDraw.shade_model `smooth; GlMat.pop (); Gl.flush (); area#swap_buffers () end let myinit () = let light_ambient = 0.5, 0.5, 0.5, 1.0 and light_diffuse = 1.0, 0.8, 0.2, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in List.iter ~f:(GlLight.light ~num:0) [ `ambient light_ambient; `diffuse light_diffuse; `specular light_specular; `position light_position ]; GlFunc.depth_func `less; List.iter ~f:Gl.enable [`lighting; `light0; `depth_test]; GlDraw.shade_model `smooth let my_reshape ~width:w ~height:h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity(); GluMat.perspective ~fovy:60.0 ~aspect:(float w /. float h) ~z:(1.0,20.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate ~z:(-5.0) () (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) open GMain open GdkKeysyms let main () = let w = GWindow.window ~title:"Planet" () in w#connect#destroy ~callback:(fun () -> Main.quit (); exit 0); w#set_resize_mode `IMMEDIATE; let hb = GPack.hbox ~packing:w#add () in let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 1] ~width:700 ~height:500 ~packing:hb#add () in area#event#add [`KEY_PRESS]; let planet = new planet area in let adjustment = GData.adjustment ~value:0. ~lower:(-90.) ~upper:90. ~step_incr:1. ~page_incr:5. ~page_size:5. () in let scale = GRange.scale `VERTICAL ~adjustment ~draw_value:false ~packing:hb#pack () in adjustment#connect#value_changed ~callback:(fun () -> planet#eye adjustment#value); w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = _Left then planet#year_subtract () else if key = _Right then planet#year_add () else if key = _Up then planet#day_add () else if key = _Down then planet#day_subtract () else if key = _Escape then w#destroy (); planet#display (); true end; Timeout.add ~ms:20 ~callback: begin fun () -> planet#tick (Sys.time ()); planet#display (); true end; area#connect#display ~callback:planet#display; area#connect#reshape ~callback:my_reshape; area#connect#realize ~callback: begin fun () -> myinit (); my_reshape ~width:700 ~height:500 end; w#show (); Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/aargb.ml0000644000175000017500000000444213460263323016016 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) let init () = List.iter Gl.enable [`line_smooth; `blend]; GlFunc.blend_func ~src:`src_alpha ~dst:`one_minus_src_alpha; GlMisc.hint `line_smooth `dont_care; GlDraw.line_width 4.; GlClear.color (0., 0., 0.) let rot_angle = ref 0. let display ~area () = GlClear.clear [`color]; GlDraw.color (0., 1., 0.); GlMat.push (); GlMat.rotate ~angle:(-. !rot_angle) ~z:0.1 (); GlDraw.begins `lines; GlDraw.vertex2 (-0.5, 0.5); GlDraw.vertex2 (0.5, -0.5); GlDraw.ends (); GlMat.pop (); GlDraw.color (0., 0., 1.); GlMat.push (); GlMat.rotate ~angle:(!rot_angle) ~z:0.1 (); GlDraw.begins `lines; GlDraw.vertex2 (0.5, 0.5); GlDraw.vertex2 (-0.5, -0.5); GlDraw.ends (); GlMat.pop (); Gl.flush (); area#swap_buffers () let reshape ~width:w ~height:h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity(); if w < h then GluMat.ortho2d ~x:(-1., 1.) ~y:(-.float w /. float h, float w /. float h) else GluMat.ortho2d ~y:(-1., 1.) ~x:(-.float w /. float h, float w /. float h); GlMat.mode `modelview; GlMat.load_identity() open GdkKeysyms let main () = let w = GWindow.window ~title:"Antialiasing/Gtk" () in w#connect#destroy ~callback:GMain.quit; let area = GlGtk.area [`RGBA;`DOUBLEBUFFER] ~width:500 ~height:500 ~packing:w#add () in area#connect#realize ~callback:init; area#connect#reshape ~callback:reshape; area#connect#display ~callback:(display ~area); w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = _r || key = _R then begin rot_angle := !rot_angle +. 20.; if !rot_angle > 360. then rot_angle := 0.; display ~area () end; true end; w#show (); GMain.main () let _ = main () lablgtk-2.18.8/examples/GL/tutorial-2.ml0000644000175000017500000000547713460263323016755 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Copyright 2001 David MENTRE *) (* This program is under GNU GPL license *) (* general structure taken in lablgtk planet.ml from Jacques Garrigues *) (* OLablgtk/Olabgl adaptation of NeHe's OpenGL tutorial #2: http://nehe.gamedev.net/tutorials/lesson02.asp *) let resizeGLScene ~width ~height = let ok_height = if height = 0 then 1 else height in GlDraw.viewport 0 0 width ok_height; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:45.0 ~aspect:((float_of_int width)/.(float_of_int ok_height)) ~z:(0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () let initGL () = GlDraw.shade_model `smooth; GlClear.color ~alpha:0.0 (0.0, 0.0, 0.0); GlClear.depth 1.0; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let drawGLScene area () = GlClear.clear [`color; `depth]; GlMat.load_identity (); GlMat.translate ~x:(-1.5) ~y:0.0 ~z:(-6.0) (); GlDraw.begins `triangles; GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.ends (); GlMat.translate ~x:3.0 ~y:0.0 ~z:0.0 (); GlDraw.begins `quads; GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); area#swap_buffers () let killGLWindow () = () (* do nothing *) let createGLWindow title width height bits fullscreen = let w = GWindow.window ~title:title () in w#connect#destroy ~callback:(fun () -> GMain.Main.quit (); exit 0); w#set_resize_mode `IMMEDIATE; let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 16;`BUFFER_SIZE bits] ~width:width ~height:height~packing:w#add () in area#event#add [`KEY_PRESS]; w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = GdkKeysyms._Escape then w#destroy (); true end; area#connect#display ~callback:(drawGLScene area); area#connect#reshape ~callback:resizeGLScene; area#connect#realize ~callback: begin fun () -> initGL (); resizeGLScene ~width ~height end; w#show (); w let main () = let w = createGLWindow "Tutorial 2" 640 480 16 false in GMain.Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/gears.ml0000644000175000017500000001732113460263323016043 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* * 3-D gear wheels. This program is in the public domain. * * Brian Paul * LablGL version by Jacques Garrigue * Lablgtk version by Eric Cooper *) open StdLabels let pi = acos (-1.) (* * Draw a gear wheel. You'll probably want to call this function when * building a display list since we do a lot of trig here. * * Input: inner_radius - radius of hole at center * outer_radius - radius at center of teeth * width - width of gear * teeth - number of teeth * tooth_depth - depth of tooth *) let gear ~inner ~outer ~width ~teeth ~tooth_depth = let r0 = inner and r1 = outer -. tooth_depth /. 2.0 and r2 = outer +. tooth_depth /. 2.0 in let ta = 2.0 *. pi /. float teeth in let da = ta /. 4.0 in GlDraw.shade_model `flat; GlDraw.normal ~z:1.0 (); let vertex ~r ~z ?(s=0) i = let angle = float i *. ta +. float s *. da in GlDraw.vertex ~x:(r *. cos angle) ~y:(r *. sin angle) ~z () in (* draw front face *) let z = width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r0 ~z; vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~z ~s:3; done; GlDraw.ends (); (* draw front sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r1 ~s:3 ~z; done; GlDraw.ends (); GlDraw.normal ~z:(-1.0) (); (* draw back face *) let z = -. width *. 0.5 in GlDraw.begins `quad_strip; for i=0 to teeth do vertex i ~r:r1 ~z; vertex i ~r:r0 ~z; vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r0 ~z; done; GlDraw.ends (); (* draw back sides of teeth *) GlDraw.begins `quads; for i=0 to teeth - 1 do vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r1 ~z; done; GlDraw.ends (); (* draw outward faces of teeth *) let z = width *. 0.5 and z' = width *. (-0.5) in GlDraw.begins `quad_strip; for i=0 to teeth - 1 do let angle = float i *. ta in vertex i ~r:r1 ~z; vertex i ~r:r1 ~z:z'; let u = r2 *. cos(angle+.da) -. r1 *. cos(angle) and v = r2 *. sin(angle+.da) -. r1 *. sin(angle) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r2 ~s:1 ~z; vertex i ~r:r2 ~s:1 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); vertex i ~r:r2 ~s:2 ~z; vertex i ~r:r2 ~s:2 ~z:z'; let u = r1 *. cos(angle +. 3. *. da) -. r2 *. cos(angle +. 2. *. da) and v = r1 *. sin(angle +. 3. *. da) -. r2 *. sin(angle +. 2. *. da) in GlDraw.normal ~x:v ~y:(-.u) (); vertex i ~r:r1 ~s:3 ~z; vertex i ~r:r1 ~s:3 ~z:z'; GlDraw.normal ~x:(cos angle) ~y:(sin angle) (); done; vertex 0 ~r:r1 ~z; vertex 0 ~r:r1 ~z:z'; GlDraw.ends (); GlDraw.shade_model `smooth; (* draw inside radius cylinder *) GlDraw.begins `quad_strip; for i=0 to teeth do let angle = float i *. ta in GlDraw.normal ~x:(-. cos angle) ~y:(-. sin angle) (); vertex i ~r:r0 ~z:z'; vertex i ~r:r0 ~z; done; GlDraw.ends () class view area = object (self) val mutable gears = None val mutable view_rotx = 0.0 val mutable view_roty = 0.0 val mutable view_rotz = 0.0 val mutable angle = 0.0 method rotx a = view_rotx <- a method roty a = view_roty <- a method rotz a = view_rotz <- a method draw () = let (gear1, gear2, gear3) = match gears with Some x -> x | None -> failwith "draw : not yet initialized" in GlClear.clear [`color;`depth]; GlMat.push (); GlMat.rotate ~angle:view_rotx ~x:1.0 (); GlMat.rotate ~angle:view_roty ~y:1.0 (); GlMat.rotate ~angle:view_rotz ~z:1.0 (); GlMat.push (); GlMat.translate ~x:(-3.0) ~y:(-2.0) (); GlMat.rotate ~angle:angle ~z:1.0 (); (* gear inner:1.0 outer:4.0 width:1.0 teeth:20 tooth_depth:0.7; *) GlList.call gear1; GlMat.pop (); GlMat.push (); GlMat.translate ~x:3.1 ~y:(-2.0) (); GlMat.rotate ~angle:(-2.0 *. angle -. 9.0) ~z:1.0 (); (* gear inner:0.5 outer:2.0 width:2.0 teeth:10 tooth_depth:0.7; *) GlList.call gear2; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-3.1) ~y:4.2 (); GlMat.rotate ~angle:(-2.0 *. angle -. 25.0) ~z:1.0 (); (* gear inner:1.3 outer:2.0 width:0.5 teeth:10 tooth_depth:0.7; *) GlList.call gear3; GlMat.pop (); GlMat.pop (); Gl.flush (); area#swap_buffers () method idle () = angle <- angle +. 2.0; if area#misc#visible then self#draw (); true method reshape ~width:w ~height:h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); let r = float w /. float h in let r' = 1. /. r in if (w>h) then GlMat.frustum ~x:(-. r,r) ~y:(-1.0,1.0) ~z:(5.0,60.0) else GlMat.frustum ~x:(-1.0,1.0) ~y:(-.r',r') ~z:(5.0,60.0); GlMat.mode `modelview; GlMat.load_identity(); GlMat.translate ~z:(-40.0) (); GlClear.clear[`color;`depth] method init () = let pos = 5.0, 5.0, 10.0, 0.0 and red = 0.8, 0.1, 0.0, 1.0 and green = 0.0, 0.8, 0.2, 1.0 and blue = 0.2, 0.2, 1.0, 1.0 in GlLight.light ~num:0 (`position pos); List.iter ~f:Gl.enable [`cull_face;`lighting;`light0;`depth_test;`normalize]; (* make the gears *) let make_gear ~inner ~outer ~width ~teeth ~color = let list = GlList.create `compile in GlLight.material ~face:`front (`ambient_and_diffuse color); gear ~inner ~outer ~width ~teeth ~tooth_depth:0.7; GlList.ends (); list in let gear1 = make_gear ~inner:1.0 ~outer:4.0 ~width:1.0 ~teeth:20 ~color:red and gear2 = make_gear ~inner:0.5 ~outer:2.0 ~width:2.0 ~teeth:10 ~color:green and gear3 = make_gear ~inner:1.3 ~outer:2.0 ~width:0.5 ~teeth:10 ~color:blue in gears <- Some (gear1, gear2, gear3) initializer area#connect#realize ~callback: self#init; area#connect#display ~callback: self#draw; area#connect#reshape ~callback: self#reshape; () end open GMain let main () = let window = GWindow.window ~title: "ML Gears" () in window#connect#destroy ~callback:Main.quit; window#set_resize_mode `IMMEDIATE; let table = GPack.table ~rows: 2 ~columns: 3 ~packing: window#add () in let area = GlGtk.area [`DEPTH_SIZE 1; `RGBA; `DOUBLEBUFFER] ~width: 300 ~height: 300 ~packing: (table#attach ~left: 1 ~top: 0 ~expand: `BOTH) () in let view = new view area in let scale ~orientation ~callback ~value ?packing () = let adjustment = GData.adjustment ~lower: 0.0 ~upper: 360.0 () in adjustment#connect#value_changed ~callback: (fun () -> callback adjustment#value); adjustment#set_value value; GRange.scale orientation ~adjustment ~draw_value: false ?packing () in let sx = scale ~orientation: `VERTICAL ~callback: view#rotx ~value: 40.0 ~packing: (table#attach ~left: 2 ~top: 0 ~expand: `Y) () in let sy = scale ~orientation: `HORIZONTAL ~callback: view#roty ~value: 20.0 ~packing: (table#attach ~left: 1 ~top: 1 ~expand: `X) () in let sz = scale ~orientation: `VERTICAL ~callback: view#rotz ~value: 10.0 ~packing: (table#attach ~left: 0 ~top: 0 ~expand: `Y) () in Timeout.add ~ms: 20 ~callback: view#idle; window#show (); Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/scene.ml0000644000175000017500000000760413460263323016042 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (* Initialize material property and light source. *) let myinit () = let light_ambient = 0.0, 0.0, 0.0, 1.0 and light_diffuse = 1.0, 1.0, 1.0, 1.0 and light_specular = 1.0, 1.0, 1.0, 1.0 (* light_position is NOT default value *) and light_position = 1.0, 1.0, 1.0, 0.0 in GlLight.light ~num:0 (`ambient light_ambient); GlLight.light ~num:0 (`diffuse light_diffuse); GlLight.light ~num:0 (`specular light_specular); GlLight.light ~num:0 (`position light_position); GlFunc.depth_func `less; List.iter ~f:Gl.enable [`lighting; `light0; `depth_test] let pi = acos (-1.) let solid_torus ~inner ~outer = let slices = 32 and faces = 16 in let slice_angle = 2.0 *. pi /. float slices and face_angle = 2.0 *. pi /. float faces in let vertex ~i ~j = let angle1 = slice_angle *. float i and angle2 = face_angle *. float j in GlDraw.normal3 (cos angle1 *. cos angle2, -. sin angle1 *. cos angle2, sin angle2); GlDraw.vertex3 ((outer +. inner *. cos angle2) *. cos angle1, -. (outer +. inner *. cos angle2) *. sin angle1, inner *. sin angle2) in GlDraw.begins `quads; for i = 0 to slices - 1 do for j = 0 to faces - 1 do vertex ~i ~j; vertex ~i:(i+1) ~j; vertex ~i:(i+1) ~j:(j+1); vertex ~i ~j:(j+1); done done; GlDraw.ends () let solid_cone ~radius ~height = GluQuadric.cylinder ~base:radius ~top:0. ~height ~slices:15 ~stacks:10 () let solid_sphere ~radius = GluQuadric.sphere ~radius ~slices:32 ~stacks:32 () let display area = GlClear.clear [`color; `depth]; GlMat.push (); GlMat.rotate ~angle:20.0 ~x:1.0 (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:0.5 (); GlMat.rotate ~angle:90.0 ~x:1.0 (); solid_torus ~inner:0.275 ~outer:0.85; GlMat.pop (); GlMat.push (); GlMat.translate ~x:(-0.75) ~y:(-0.5) (); GlMat.rotate ~angle:270.0 ~x:1.0 (); solid_cone ~radius:1.0 ~height:2.0; GlMat.pop (); GlMat.push (); GlMat.translate ~x:0.75 ~z:(-1.0) (); solid_sphere ~radius:1.0; GlMat.pop (); GlMat.pop (); Gl.flush (); area#swap_buffers () let my_reshape ~width:w ~height:h = GlDraw.viewport ~x:0 ~y:0 ~w ~h; GlMat.mode `projection; GlMat.load_identity (); if w <= h then GlMat.ortho ~x:(-2.5,2.5) ~z:(-10.0,10.0) ~y:(-2.5 *. float h /. float w, 2.5 *. float h /. float w) else GlMat.ortho ~y:(-2.5,2.5) ~z:(-10.0,10.0) ~x:(-2.5 *. float w /. float h, 2.5 *. float w /. float h); GlMat.mode `modelview (* Main Loop * Open window with initial window size, title bar, * RGBA display mode, and handle input events. *) open GMain let main () = let w = GWindow.window ~title:"Scene" () in w#connect#destroy ~callback:(fun () -> Main.quit (); exit 0); let area = GlGtk.area [`RGBA;`DEPTH_SIZE 1;`DOUBLEBUFFER] ~width:500 ~height:500 ~packing:w#add () in area#connect#realize ~callback:myinit; area#connect#reshape ~callback:my_reshape; area#connect#display ~callback:(fun () -> display area); area#event#add [`BUTTON_PRESS]; area#event#connect#button_press ~callback: begin fun ev -> let p = (GdkEvent.Button.x ev, GdkEvent.Button.y ev, 0.) in area#make_current (); let (x, y, z) = GluMat.unproject p in Printf.printf "x=%f, y=%f, z=%f\n" x y z; flush stdout; true end; w#show (); Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/tutorial-5.ml0000644000175000017500000001133713460263323016750 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Copyright 2001 David MENTRE *) (* This program is under GNU GPL license *) (* general structure taken in lablgtk planet.ml from Jacques Garrigues *) (* OLablgtk/Olabgl adaptation of NeHe's OpenGL tutorial #5: http://nehe.gamedev.net/tutorials/lesson05.asp *) let rtri = ref 0.0 let rquad = ref 0.0 let resizeGLScene ~width ~height = let ok_height = if height = 0 then 1 else height in GlDraw.viewport 0 0 width ok_height; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:45.0 ~aspect:((float_of_int width)/.(float_of_int ok_height)) ~z:(0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () let initGL () = GlDraw.shade_model `smooth; GlClear.color ~alpha:0.0 (0.0, 0.0, 0.0); GlClear.depth 1.0; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let drawGLScene area () = GlClear.clear [`color; `depth]; GlMat.load_identity (); GlMat.translate ~x:(-1.5) ~y:0.0 ~z:(-6.0) (); GlMat.rotate ~angle:!rtri ~x:0.0 ~y:1.0 ~z:0.0 (); GlDraw.begins `triangles; GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 1.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 1.0); GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 1.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (-1.0, -1.0, -1.0); GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (-1.0, -1.0, -1.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 1.0); GlDraw.ends (); GlMat.load_identity (); GlMat.translate ~x:1.5 ~y:0.0 ~z:(-7.0) (); GlMat.rotate ~angle:!rquad ~x:1.0 ~y:1.0 ~z:1.0 (); GlDraw.begins `quads; GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.vertex3 (-1.0, 1.0, -1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 (1.0, 1.0, 1.0); GlDraw.color (1.0, 0.5, 0.0); GlDraw.vertex3 (1.0, -1.0, 1.0); GlDraw.vertex3 (-1.0, -1.0, 1.0); GlDraw.vertex3 (-1.0, -1.0, -1.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0, -1.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 1.0); GlDraw.color (1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.vertex3 (-1.0, -1.0, -1.0); GlDraw.vertex3 (-1.0, 1.0, -1.0); GlDraw.vertex3 (1.0, 1.0, -1.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (-1.0, 1.0, 1.0); GlDraw.vertex3 (-1.0, 1.0, -1.0); GlDraw.vertex3 (-1.0, -1.0, -1.0); GlDraw.vertex3 (-1.0, -1.0, 1.0); GlDraw.color (1.0, 0.0, 1.0); GlDraw.vertex3 (1.0, 1.0, -1.0); GlDraw.vertex3 (1.0, 1.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 1.0); GlDraw.vertex3 (1.0, -1.0, -1.0); GlDraw.ends (); rtri := !rtri +. 0.2; rquad := !rquad -. 0.15; area#swap_buffers () let killGLWindow () = () (* do nothing *) let createGLWindow title width height bits fullscreen = let w = GWindow.window ~title:title () in w#connect#destroy ~callback:(fun () -> GMain.Main.quit (); exit 0); w#set_resize_mode `IMMEDIATE; let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 16;`BUFFER_SIZE bits] ~width:width ~height:height~packing:w#add () in area#event#add [`KEY_PRESS]; w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = GdkKeysyms._Escape then w#destroy (); true end; GMain.Timeout.add ~ms:20 ~callback: begin fun () -> drawGLScene area (); true end; area#connect#display ~callback:(drawGLScene area); area#connect#reshape ~callback:resizeGLScene; area#connect#realize ~callback: begin fun () -> initGL (); resizeGLScene ~width ~height end; w#show (); w let main () = let w = createGLWindow "Tutorial 5" 640 480 16 false in GMain.Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/tutorial-3.ml0000644000175000017500000000570313460263323016746 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Copyright 2001 David MENTRE *) (* This program is under GNU GPL license *) (* general structure taken in lablgtk planet.ml from Jacques Garrigues *) (* OLablgtk/Olabgl adaptation of NeHe's OpenGL tutorial #3: http://nehe.gamedev.net/tutorials/lesson03.asp *) let resizeGLScene ~width ~height = let ok_height = if height = 0 then 1 else height in GlDraw.viewport 0 0 width ok_height; GlMat.mode `projection; GlMat.load_identity (); GluMat.perspective ~fovy:45.0 ~aspect:((float_of_int width)/.(float_of_int ok_height)) ~z:(0.1, 100.0); GlMat.mode `modelview; GlMat.load_identity () let initGL () = GlDraw.shade_model `smooth; GlClear.color ~alpha:0.0 (0.0, 0.0, 0.0); GlClear.depth 1.0; Gl.enable `depth_test; GlFunc.depth_func `lequal; GlMisc.hint `perspective_correction `nicest let drawGLScene area () = GlClear.clear [`color; `depth]; GlMat.load_identity (); GlMat.translate ~x:(-1.5) ~y:0.0 ~z:(-6.0) (); GlDraw.begins `triangles; GlDraw.color (1.0, 0.0, 0.0); GlDraw.vertex3 (0.0, 1.0, 0.0); GlDraw.color (0.0, 1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.color (0.0, 0.0, 1.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.ends (); GlMat.translate ~x:3.0 ~y:0.0 ~z:0.0 (); GlDraw.color (0.5, 0.5, 1.0); GlDraw.begins `quads; GlDraw.vertex3 (-1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, 1.0, 0.0); GlDraw.vertex3 (1.0, -1.0, 0.0); GlDraw.vertex3 (-1.0, -1.0, 0.0); GlDraw.ends (); area#swap_buffers () let killGLWindow () = () (* do nothing *) let createGLWindow title width height bits fullscreen = let w = GWindow.window ~title:title () in w#connect#destroy ~callback:(fun () -> GMain.Main.quit (); exit 0); w#set_resize_mode `IMMEDIATE; let area = GlGtk.area [`DOUBLEBUFFER;`RGBA;`DEPTH_SIZE 16;`BUFFER_SIZE bits] ~width:width ~height:height~packing:w#add () in area#event#add [`KEY_PRESS]; w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev in if key = GdkKeysyms._Escape then w#destroy (); true end; area#connect#display ~callback:(drawGLScene area); area#connect#reshape ~callback:resizeGLScene; area#connect#realize ~callback: begin fun () -> initGL (); resizeGLScene ~width ~height end; w#show (); w let main () = let w = createGLWindow "Tutorial 3" 640 480 16 false in GMain.Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/GL/simple_th.ml0000644000175000017500000000323713460263323016727 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id: simple.ml 1347 2007-06-20 07:40:34Z guesdon $ *) (* A version of simple that works asynchronously *) (* Run it with: lablgt2 -thread simple_th.ml *) open GMain let main () = let w = GWindow.window ~title:"LablGL/Gtk" () in w#connect#destroy ~callback:Main.quit; let area = GlGtk.area [`RGBA;`DEPTH_SIZE 1;`DOUBLEBUFFER] ~width:500 ~height:500 ~packing:w#add () in area#connect#realize ~callback: begin fun () -> GlMat.mode `projection; GlMat.load_identity (); GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0); end; area#connect#display ~callback: begin fun () -> GlClear.color (0.0, 0.0, 0.0); GlClear.clear [`color]; GlDraw.color (1.0, 1.0, 1.0); GlDraw.begins `polygon; GlDraw.vertex ~x:(-0.5) ~y:(-0.5) (); GlDraw.vertex ~x:(-0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(-0.5) (); GlDraw.ends (); Gl.flush (); area#swap_buffers () end; Timeout.add ~ms:10000 ~callback:(fun () -> w#destroy ();false); GtkThread.async w#show (); Thread.join GtkThInit.thread let _ = main () lablgtk-2.18.8/examples/GL/texturesurf.ml0000644000175000017500000001053713460263323017344 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels let texpts = [|[|0.0; 0.0; 0.0; 1.0|]; [|1.0; 0.0; 1.0; 1.0|]|] let ctrlpoints = [|[|-1.5; -1.5; 4.9; -0.5; -1.5; 2.0; 0.5; -1.5; -1.0; 1.5; -1.5; 2.0|]; [|-1.5; -0.5; 1.0; -0.5; -0.5; 3.0; 0.5; -0.5; 0.0; 1.5; -0.5; -1.0|]; [|-1.5; 0.5; 4.0; -0.5; 0.5; 0.0; 0.5; 0.5; 3.0; 1.5; 0.5; 4.0|]; [|-1.5; 1.5; -2.0; -0.5; 1.5; -2.0; 0.5; 1.5; 0.0; 1.5; 1.5; -1.0|]|] let image_width = 64 and image_height = 64 let pi = acos (-1.0) let display togl = GlClear.clear [`color;`depth]; GlDraw.color (1.0,1.0,1.0); GlMap.eval_mesh2 ~mode:`fill ~range1:(0,20) ~range2:(0,20); Gl.flush (); togl#swap_buffers () let make_image () = let image = GlPix.create `ubyte ~height:image_height ~width:image_width ~format:`rgb in let raw = GlPix.to_raw image and pos = GlPix.raw_pos image in for i = 0 to image_width - 1 do let ti = 2.0 *. pi *. float i /. float image_width in for j = 0 to image_height - 1 do let tj = 2.0 *. pi *. float j /. float image_height in Raw.sets raw ~pos:(pos ~x:j ~y:i) (Array.map ~f:(fun x -> truncate (127.0 *. (1.0 +. x))) [|sin ti; cos (2.0 *. ti); cos (ti +. tj)|]); done; done; image let read_to_glpix myfile = let pix = GdkPixbuf.from_file myfile in let pix = if GdkPixbuf.get_has_alpha pix then pix else GdkPixbuf.add_alpha pix in let src = GdkPixbuf.get_pixels pix in let raw = Raw.create `ubyte ~len:(Gpointer.length src) in Gpointer.blit ~src ~dst:(GlGtk.region_of_raw raw); GlPix.of_raw raw ~format:`rgba ~width:(GdkPixbuf.get_width pix) ~height:(GdkPixbuf.get_height pix) (* You may use your own texture, but its size must be 2**m x 2**n *) (* let make_image () = read_to_glpix "sa15-crop.jpg" *) let myinit () = let ctrlpoints = Raw.of_matrix ~kind:`double ctrlpoints and texpts = Raw.of_matrix ~kind:`double texpts in GlMap.map2 ~target:`vertex_3 (0.0, 1.0) ~order:4 (0.0, 1.0) ~order:4 ctrlpoints; GlMap.map2 ~target:`texture_coord_2 (0.0,1.0) ~order:2 (0.0,1.0) ~order:2 texpts; Gl.enable `map2_texture_coord_2; Gl.enable `map2_vertex_3; GlMap.grid2 ~n1:20 ~range1:(0.0,1.0) ~n2:20 ~range2:(0.0,1.0); let image = make_image () in GlTex.env (`mode `decal); List.iter ~f:(GlTex.parameter ~target:`texture_2d) [ `wrap_s `repeat; `wrap_t `repeat; `mag_filter `nearest; `min_filter `nearest ]; GlTex.image2d image; List.iter ~f:Gl.enable [`texture_2d;`depth_test;`normalize]; GlDraw.shade_model `flat let my_reshape ~width ~height = GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height; GlMat.mode `projection; GlMat.load_identity (); let r = float height /. float width in if width <= height then GlMat.ortho ~x:(-4.0, 4.0) ~y:(-4.0 *. r, 4.0 *. r) ~z:(-4.0, 4.0) else GlMat.ortho ~x:(-4.0 /. r, 4.0 /. r) ~y:(-4.0, 4.0) ~z:(-4.0, 4.0); GlMat.mode `modelview; GlMat.load_identity (); GlMat.rotate ~angle:85. ~x:1. ~y:1. ~z:1. () open GdkKeysyms let main () = let w = GWindow.window ~title:"Texture Surf" () in let togl = GlGtk.area [`RGBA;`DOUBLEBUFFER;`DEPTH_SIZE 1] ~width:300 ~height:300 ~packing:w#add () in togl#misc#connect#realize myinit; togl#connect#reshape my_reshape; togl#connect#display (fun () -> display togl); w#event#connect#key_press ~callback: begin fun ev -> let k = GdkEvent.Key.keyval ev in if k = _Up then (GlMat.rotate ~angle:(-5.) ~z:1.0 (); display togl) else if k = _Down then (GlMat.rotate ~angle:(5.) ~z:1.0 (); display togl) else if k = _Left then (GlMat.rotate ~angle:(5.) ~x:1.0 (); display togl) else if k = _Right then (GlMat.rotate ~angle:(-5.) ~x:1.0 (); display togl) else if k = _Escape then w#destroy (); true end; w#connect#destroy ~callback:GMain.quit; w#show (); GMain.main () let _ = main () lablgtk-2.18.8/examples/GL/morph3d.ml0000644000175000017500000005121213460263323016313 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (*- * morph3d.c - Shows 3D morphing objects (TK Version) * * This program was inspired on a WindowsNT(R)'s screen saver. It was written * from scratch and it was not based on any other source code. * * Porting it to xlock (the final objective of this code since the moment I * decided to create it) was possible by comparing the original Mesa's gear * demo with it's ported version, so thanks for Danny Sung for his indirect * help (look at gear.c in xlock source tree). NOTE: At the moment this code * was sent to Brian Paul for package inclusion, the XLock Version was not * available. In fact, I'll wait it to appear on the next Mesa release (If you * are reading this, it means THIS release) to send it for xlock package * inclusion). It will probably there be a GLUT version too. * * Thanks goes also to Brian Paul for making it possible and inexpensive * to use OpenGL at home. * * Since I'm not a native english speaker, my apologies for any gramatical * mistake. * * My e-mail addresses are * * vianna@cat.cbpf.br * and * marcelo@venus.rdc.puc-rio.br * * Marcelo F. Vianna (Feb-13-1997) *) (* This document is VERY incomplete, but tries to describe the mathematics used in the program. At this moment it just describes how the polyhedra are generated. On futhurer versions, this document will be probabbly improved. Since I'm not a native english speaker, my apologies for any gramatical mistake. Marcelo Fernandes Vianna - Undergraduate in Computer Engeneering at Catholic Pontifical University - of Rio de Janeiro (PUC-Rio) Brasil. - e-mail: vianna@cat.cbpf.br or marcelo@venus.rdc.puc-rio.br - Feb-13-1997 POLYHEDRA GENERATION For the purpose of this program it's not sufficient to know the polyhedra vertexes coordinates. Since the morphing algorithm applies a nonlinear transformation over the surfaces (faces) of the polyhedron, each face has to be divided into smaller ones. The morphing algorithm needs to transform each vertex of these smaller faces individually. It's a very time consoming task. In order to reduce calculation overload, and since all the macro faces of the polyhedron are transformed by the same way, the generation is made by creating only one face of the polyhedron, morphing it and then rotating it around the polyhedron center. What we need to know is the face radius of the polyhedron (the radius of the inscribed sphere) and the angle between the center of two adjacent faces using the center of the sphere as the angle's vertex. The face radius of the regular polyhedra are known values which I decided to not waste my time calculating. Following is a table of face radius for the regular polyhedra with edge length = 1: TETRAHEDRON : 1/(2*sqrt(2))/sqrt(3) CUBE : 1/2 OCTAHEDRON : 1/sqrt(6) DODECAHEDRON : T^2 * sqrt((T+2)/5) / 2 -> where T=(sqrt(5)+1)/2 ICOSAHEDRON : (3*sqrt(3)+sqrt(15))/12 I've not found any reference about the mentioned angles, so I needed to calculate them, not a trivial task until I figured out how :) Curiously these angles are the same for the tetrahedron and octahedron. A way to obtain this value is inscribing the tetrahedron inside the cube by matching their vertexes. So you'll notice that the remaining unmatched vertexes are in the same straight line starting in the cube/tetrahedron center and crossing the center of each tetrahedron's face. At this point it's easy to obtain the bigger angle of the isosceles triangle formed by the center of the cube and two opposite vertexes on the same cube face. The edges of this triangle have the following lenghts: sqrt(2) for the base and sqrt(3)/2 for the other two other edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the cube this angle is obvious, but just for formality it can be easily obtained because we also know it's isosceles edge lenghts: sqrt(2)/2 for the base and 1/2 for the other two edges. So the angle we want is: +-----------------------------------------------------------+ | 2*ARCSIN((sqrt(2)/2)/1) = 90.000000000000000000 degrees | +-----------------------------------------------------------+ For the octahedron we use the same idea used for the tetrahedron, but now we inscribe the cube inside the octahedron so that all cubes's vertexes matches excatly the center of each octahedron's face. It's now clear that this angle is the same of the thetrahedron one: +-----------------------------------------------------------+ | 2*ARCSIN(sqrt(2)/sqrt(3)) = 109.47122063449069174 degrees | +-----------------------------------------------------------+ For the dodecahedron it's a little bit harder because it's only relationship with the cube is useless to us. So we need to solve the problem by another way. The concept of Face radius also exists on 2D polygons with the name Edge radius: Edge Radius For Pentagon (ERp) ERp = (1/2)/TAN(36 degrees) * VRp = 0.6881909602355867905 (VRp is the pentagon's vertex radio). Face Radius For Dodecahedron FRd = T^2 * sqrt((T+2)/5) / 2 = 1.1135163644116068404 Why we need ERp? Well, ERp and FRd segments forms a 90 degrees angle, completing this triangle, the lesser angle is a half of the angle we are looking for, so this angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERp/FRd) = 63.434948822922009981 degrees | +-----------------------------------------------------------+ For the icosahedron we can use the same method used for dodecahedron (well the method used for dodecahedron may be used for all regular polyhedra) Edge Radius For Triangle (this one is well known: 1/3 of the triangle height) ERt = sin(60)/3 = sqrt(3)/6 = 0.2886751345948128655 Face Radius For Icosahedron FRi= (3*sqrt(3)+sqrt(15))/12 = 0.7557613140761707538 So the angle is: +-----------------------------------------------------------+ | 2*ARCTAN(ERt/FRi) = 41.810314895778596167 degrees | +-----------------------------------------------------------+ *) let scale = 0.3 let vect_mul (x1,y1,z1) (x2,y2,z2) = (y1 *. z2 -. z1 *. y2, z1 *. x2 -. x1 *. z2, x1 *. y2 -. y1 *. x2) let sqr a = a *. a (* Increasing this values produces better image quality, the price is speed. *) (* Very low values produces erroneous/incorrect plotting *) let tetradivisions = 23 let cubedivisions = 20 let octadivisions = 21 let dodecadivisions = 10 let icodivisions = 15 let tetraangle = 109.47122063449069174 let cubeangle = 90.000000000000000000 let octaangle = 109.47122063449069174 let dodecaangle = 63.434948822922009981 let icoangle = 41.810314895778596167 let pi = acos (-1.) let sqrt2 = sqrt 2. let sqrt3 = sqrt 3. let sqrt5 = sqrt 5. let sqrt6 = sqrt 6. let sqrt15 = sqrt 15. let cossec36_2 = 0.8506508083520399322 let cosd x = cos (float x /. 180. *. pi) let sind x = sin (float x /. 180. *. pi) let cos72 = cosd 72 let sin72 = sind 72 let cos36 = cosd 36 let sin36 = sind 36 (*************************************************************************) let front_shininess = 60.0 let front_specular = 0.7, 0.7, 0.7, 1.0 let ambient = 0.0, 0.0, 0.0, 1.0 let diffuse = 1.0, 1.0, 1.0, 1.0 let position0 = 1.0, 1.0, 1.0, 0.0 let position1 = -1.0,-1.0, 1.0, 0.0 let lmodel_ambient = 0.5, 0.5, 0.5, 1.0 let lmodel_twoside = true let materialRed = 0.7, 0.0, 0.0, 1.0 let materialGreen = 0.1, 0.5, 0.2, 1.0 let materialBlue = 0.0, 0.0, 0.7, 1.0 let materialCyan = 0.2, 0.5, 0.7, 1.0 let materialYellow = 0.7, 0.7, 0.0, 1.0 let materialMagenta = 0.6, 0.2, 0.5, 1.0 let materialWhite = 0.7, 0.7, 0.7, 1.0 let materialGray = 0.2, 0.2, 0.2, 1.0 let all_gray = Array.create 20 materialGray let vertex ~xf ~yf ~zf ~ampvr2 = let xa = xf +. 0.01 and yb = yf +. 0.01 in let xf2 = sqr xf and yf2 = sqr yf in let factor = 1. -. (xf2 +. yf2) *. ampvr2 and factor1 = 1. -. (sqr xa +. yf2) *. ampvr2 and factor2 = 1. -. (xf2 +. sqr yb) *. ampvr2 in let vertx = factor *. xf and verty = factor *. yf and vertz = factor *. zf in let neiax = factor1 *. xa -. vertx and neiay = factor1 *. yf -. verty and neiaz = factor1 *. zf -. vertz and neibx = factor2 *. xf -. vertx and neiby = factor2 *. yb -. verty and neibz = factor2 *. zf -. vertz in GlDraw.normal3 (vect_mul (neiax, neiay, neiaz) (neibx, neiby, neibz)); GlDraw.vertex3 (vertx, verty, vertz) let triangle ~edge ~amp ~divisions ~z = let divi = float divisions in let vr = edge *. sqrt3 /. 3. in let ampvr2 = amp /. sqr vr and zf = edge *. z in let ax = edge *. (0.5 /. divi) and ay = edge *. (-0.5 *. sqrt3 /. divi) and bx = edge *. (-0.5 /. divi) in for ri = 1 to divisions do GlDraw.begins `triangle_strip; for ti = 0 to ri - 1 do vertex ~zf ~ampvr2 ~xf:(float (ri-ti) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti) *. ay +. float ti *. ay); vertex ~zf ~ampvr2 ~xf:(float (ri-ti-1) *. ax +. float ti *. bx) ~yf:(vr +. float (ri-ti-1) *. ay +. float ti *. ay) done; vertex ~xf:(float ri *. bx) ~yf:(vr +. float ri *. ay) ~zf ~ampvr2; GlDraw.ends () done let square ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr (edge *. sqrt2 /. 2.) in for yi = 0 to divisions - 1 do let yf = edge *. (-0.5 +. float yi /. divi) in let yf2 = sqr yf in let y = yf +. 1.0 /. divi *. edge in let y2 = sqr y in GlDraw.begins `quad_strip; for xi = 0 to divisions do let xf = edge *. (-0.5 +. float xi /. divi) in vertex ~xf ~yf:y ~zf ~ampvr2; vertex ~xf ~yf ~zf ~ampvr2 done; GlDraw.ends () done let pentagon ~edge ~amp ~divisions ~z = let divi = float divisions in let zf = edge *. z and ampvr2 = amp /. sqr(edge *. cossec36_2) in let x = Array.init 6 ~f:(fun fi -> -. cos (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) and y = Array.init 6 ~f:(fun fi -> sin (float fi *. 2. *. pi /. 5. +. pi /. 10.) /. divi *. cossec36_2 *. edge) in for ri = 1 to divisions do for fi = 0 to 4 do GlDraw.begins `triangle_strip; for ti = 0 to ri-1 do vertex ~zf ~ampvr2 ~xf:(float(ri-ti) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti) *. y.(fi) +. float ti *. y.(fi+1)); vertex ~zf ~ampvr2 ~xf:(float(ri-ti-1) *. x.(fi) +. float ti *. x.(fi+1)) ~yf:(float(ri-ti-1) *. y.(fi) +. float ti *. y.(fi+1)) done; vertex ~xf:(float ri *. x.(fi+1)) ~yf:(float ri *. y.(fi+1)) ~zf ~ampvr2; GlDraw.ends () done done let call_list list color = GlLight.material ~face:`both (`diffuse color); GlList.call list let draw_tetra ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(0.5 /. sqrt6); GlList.ends(); call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.tetraangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(sqrt3 /. 2.) (); call_list list color.(2); GlMat.pop(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. tetraangle) ~x:0.5 ~y:(-.sqrt3 /. 2.) (); call_list list color.(3); GlList.delete list let draw_cube ~amp ~divisions ~color = let list = GlList.create `compile in square ~edge:2.0 ~amp ~divisions ~z:0.5; GlList.ends (); call_list list color.(0); for i = 1 to 3 do GlMat.rotate ~angle:cubeangle ~x:1.0 (); call_list list color.(i) done; GlMat.rotate ~angle:cubeangle ~y:1.0 (); call_list list color.(4); GlMat.rotate ~angle:(2.0 *. cubeangle) ~y:1.0 (); call_list list color.(5); GlList.delete list let draw_octa ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:2.0 ~amp ~divisions ~z:(1.0 /. sqrt6); GlList.ends (); let do_list (i,y) = GlMat.push(); GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-.octaangle) ~x:0.5 ~y (); call_list list color.(i); GlMat.pop() in call_list list color.(0); GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); call_list list color.(1); GlMat.pop(); List.iter [2, sqrt3 /. 2.0; 3, -.sqrt3 /. 2.0] ~f:do_list; GlMat.rotate ~angle:180.0 ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(4)); GlList.call list; GlMat.push(); GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-180.0 +. octaangle) ~x:1.0 (); GlLight.material ~face:`both (`diffuse color.(5)); GlList.call list; GlMat.pop(); List.iter [6, sqrt3 /. 2.0; 7, -.sqrt3 /. 2.0] ~f:do_list; GlList.delete list let draw_dodeca ~amp ~divisions ~color = let tau = (sqrt5 +. 1.0) /. 2.0 in let list = GlList.create `compile in pentagon ~edge:2.0 ~amp ~divisions ~z:(sqr(tau) *. sqrt ((tau+.2.0)/.5.0) /. 2.0); GlList.ends (); let do_list (i,angle,x,y) = GlMat.push(); GlMat.rotate ~angle:angle ~x ~y (); call_list list color.(i); GlMat.pop(); in GlMat.push (); call_list list color.(0); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 1, -.dodecaangle, 1.0, 0.0; 2, -.dodecaangle, cos72, sin72; 3, -.dodecaangle, cos72, -.sin72; 4, dodecaangle, cos36, -.sin36; 5, dodecaangle, cos36, sin36 ]; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(6); GlMat.rotate ~angle:180.0 ~z:1.0 (); List.iter ~f:do_list [ 7, -.dodecaangle, 1.0, 0.0; 8, -.dodecaangle, cos72, sin72; 9, -.dodecaangle, cos72, -.sin72; 10, dodecaangle, cos36, -.sin36 ]; GlMat.rotate ~angle:dodecaangle ~x:cos36 ~y:sin36 (); call_list list color.(11); GlList.delete list let draw_ico ~amp ~divisions ~color = let list = GlList.create `compile in triangle ~edge:1.5 ~amp ~divisions ~z:((3.0 *. sqrt3 +. sqrt15) /. 12.0); GlList.ends (); let do_list1 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(sqrt3/.2.0) (); call_list list color.(i) and do_list2 i = GlMat.rotate ~angle:180.0 ~y:1.0 (); GlMat.rotate ~angle:(-180.0 +. icoangle) ~x:0.5 ~y:(-.sqrt3/.2.0) (); call_list list color.(i) and do_list3 i = GlMat.rotate ~angle:180.0 ~z:1.0 (); GlMat.rotate ~angle:(-.icoangle) ~x:1.0 (); call_list list color.(i) in GlMat.push (); call_list list color.(0); GlMat.push (); do_list3 1; GlMat.push (); do_list1 2; GlMat.pop (); do_list2 3; GlMat.pop (); GlMat.push (); do_list1 4; GlMat.push (); do_list1 5; GlMat.pop(); do_list3 6; GlMat.pop (); do_list2 7; GlMat.push (); do_list2 8; GlMat.pop (); do_list3 9; GlMat.pop (); GlMat.rotate ~angle:180.0 ~x:1.0 (); call_list list color.(10); GlMat.push (); do_list3 11; GlMat.push (); do_list1 12; GlMat.pop (); do_list2 13; GlMat.pop (); GlMat.push (); do_list1 14; GlMat.push (); do_list1 15; GlMat.pop (); do_list3 16; GlMat.pop (); do_list2 17; GlMat.push (); do_list2 18; GlMat.pop (); do_list3 19; GlList.delete list class view area = object (self) val area : GlGtk.area = area val mutable smooth = true val mutable step = 0. val mutable obj = 1 val mutable draw_object = fun ~amp -> () val mutable magnitude = 0. method width = area#misc#allocation.Gtk.width method height = area#misc#allocation.Gtk.height method draw () = let ratio = float self#height /. float self#width in GlClear.clear [`color;`depth]; GlMat.push(); GlMat.translate ~z:(-10.0) (); GlMat.scale ~x:(scale *. ratio) ~y:scale ~z:scale (); GlMat.translate () ~x:(2.5 *. ratio *. sin (step *. 1.11)) ~y:(2.5 *. cos (step *. 1.25 *. 1.11)); GlMat.rotate ~angle:(step *. 100.) ~x:1.0 (); GlMat.rotate ~angle:(step *. 95.) ~y:1.0 (); GlMat.rotate ~angle:(step *. 90.) ~z:1.0 (); draw_object ~amp:((sin step +. 1.0/.3.0) *. (4.0/.5.0) *. magnitude); GlMat.pop(); Gl.flush(); area#swap_buffers (); step <- step +. 0.05 method reshape ~width ~height = GlDraw.viewport ~x:0 ~y:0 ~w:width ~h:height; GlMat.mode `projection; GlMat.load_identity(); GlMat.frustum ~x:(-1.0, 1.0) ~y:(-1.0, 1.0) ~z:(5.0, 15.0); GlMat.mode `modelview method key sym = begin match sym with "1" -> obj <- 1 | "2" -> obj <- 2 | "3" -> obj <- 3 | "4" -> obj <- 4 | "5" -> obj <- 5 | "\r" -> smooth <- not smooth | "\027" -> area#misc#toplevel#destroy (); exit 0 | _ -> () end; self#pinit method pinit = begin match obj with 1 -> draw_object <- draw_tetra ~divisions:tetradivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite|]; magnitude <- 2.5 | 2 -> draw_object <- draw_cube ~divisions:cubedivisions ~color:[|materialRed; materialGreen; materialCyan; materialMagenta; materialYellow; materialBlue|]; magnitude <- 2.0 | 3 -> draw_object <- draw_octa ~divisions:octadivisions ~color:[|materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialMagenta; materialGray; materialYellow|]; magnitude <- 2.5 | 4 -> draw_object <- draw_dodeca ~divisions:dodecadivisions ~color:[|materialRed; materialGreen; materialCyan; materialBlue; materialMagenta; materialYellow; materialGreen; materialCyan; materialRed; materialMagenta; materialBlue; materialYellow|]; magnitude <- 2.0 | 5 -> draw_object <- draw_ico ~divisions:icodivisions ~color:[|materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialWhite; materialCyan; materialYellow; materialMagenta; materialRed; materialGreen; materialBlue; materialCyan; materialYellow; materialMagenta; materialGray|]; magnitude <- 3.5 | _ -> () end; GlDraw.shade_model (if smooth then `smooth else `flat) initializer area#connect#display ~callback:self#draw; area#connect#reshape ~callback:self#reshape; () end open GMain let main () = List.iter ~f:print_string [ "Morph 3D - Shows morphing platonic polyhedra\n"; "Author: Marcelo Fernandes Vianna (vianna@cat.cbpf.br)\n"; "Ported to LablGL by Jacques Garrigue\n\n"; " [1] - Tetrahedron\n"; " [2] - Hexahedron (Cube)\n"; " [3] - Octahedron\n"; " [4] - Dodecahedron\n"; " [5] - Icosahedron\n"; "[RETURN] - Toggle smooth/flat shading\n"; " [ESC] - Quit\n" ]; flush stdout; let window = GWindow.window ~title:"Morph 3D - Shows morphing platonic polyhedra" () in window#connect#destroy ~callback:Main.quit; window#set_resize_mode `IMMEDIATE; let area = GlGtk.area [`DEPTH_SIZE 1;`RGBA;`DOUBLEBUFFER] ~width:640 ~height:480 ~packing:window#add () in let view = new view area in area#connect#realize ~callback: begin fun () -> view#pinit; GlClear.depth 1.0; GlClear.color (0.0, 0.0, 0.0); GlDraw.color (1.0, 1.0, 1.0); GlClear.clear [`color;`depth]; Gl.flush(); List.iter ~f:(GlLight.light ~num:0) [`ambient ambient; `diffuse diffuse; `position position0]; List.iter ~f:(GlLight.light ~num:1) [`ambient ambient; `diffuse diffuse; `position position1]; GlLight.light_model (`ambient lmodel_ambient); GlLight.light_model (`two_side lmodel_twoside); List.iter ~f:Gl.enable [`lighting;`light0;`light1;`depth_test;`normalize]; GlLight.material ~face:`both (`shininess front_shininess); GlLight.material ~face:`both (`specular front_specular); GlMisc.hint `fog `fastest; GlMisc.hint `perspective_correction `fastest; GlMisc.hint `polygon_smooth `fastest end; window#event#connect#key_press ~callback:(fun ev -> view#key (GdkEvent.Key.string ev); true); Timeout.add ~ms:20 ~callback:(fun _ -> if area#misc#visible then view#draw (); true); window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/GL/simple.ml0000644000175000017500000000275313460263323016236 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let w = GWindow.window ~title:"LablGL/Gtk" () in w#connect#destroy ~callback:Main.quit; let area = GlGtk.area [`RGBA;`DEPTH_SIZE 1;`DOUBLEBUFFER] ~width:500 ~height:500 ~packing:w#add () in area#connect#realize ~callback: begin fun () -> GlMat.mode `projection; GlMat.load_identity (); GlMat.ortho ~x:(-1.0,1.0) ~y:(-1.0,1.0) ~z:(-1.0,1.0); end; area#connect#display ~callback: begin fun () -> GlClear.color (0.0, 0.0, 0.0); GlClear.clear [`color]; GlDraw.color (1.0, 1.0, 1.0); GlDraw.begins `polygon; GlDraw.vertex ~x:(-0.5) ~y:(-0.5) (); GlDraw.vertex ~x:(-0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(0.5) (); GlDraw.vertex ~x:(0.5) ~y:(-0.5) (); GlDraw.ends (); Gl.flush (); area#swap_buffers () end; Timeout.add ~ms:10000 ~callback:(fun () -> w#destroy ();false); w#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/filechooser.ml0000644000175000017500000000405113460263323016736 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let default d = function | None -> d | Some v -> v let all_files () = let f = GFile.filter ~name:"All" () in f#add_pattern "*" ; f let is_string_prefix s1 s2 = let l1 = String.length s1 in let l2 = String.length s2 in l1 <= l2 && s1 = String.sub s2 0 l1 let image_filter () = let f = GFile.filter ~name:"Images" () in f#add_custom [ `MIME_TYPE ] (fun info -> let mime = List.assoc `MIME_TYPE info in is_string_prefix "image/" mime) ; f let text_filter () = GFile.filter ~name:"Caml source code" ~patterns:[ "*.ml"; "*.mli"; "*.mly"; "*.mll" ] () let ask_for_file parent = let dialog = GWindow.file_chooser_dialog ~action:`OPEN ~title:"Open File" ~parent () in dialog#add_button_stock `CANCEL `CANCEL ; dialog#add_select_button_stock `OPEN `OPEN ; dialog#add_filter (all_files ()) ; dialog#add_filter (image_filter ()) ; dialog#add_filter (text_filter ()) ; begin match dialog#run () with | `OPEN -> print_string "filename: " ; print_endline (default "" dialog#filename) ; flush stdout | `DELETE_EVENT | `CANCEL -> () end ; dialog#destroy () let main () = let w = GWindow.window ~title:"FileChooser demo" () in w#connect#destroy GMain.quit ; let b = GButton.button ~stock:`OPEN ~packing:w#add () in b#connect#clicked (fun () -> ask_for_file w) ; w#show () ; GMain.main () let _ = main () (* Local Variables: *) (* compile-command: "ocamlc -I ../src -w s lablgtk.cma gtkInit.cmo filechooser.ml" *) (* End: *) lablgtk-2.18.8/examples/calendar.ml0000644000175000017500000000173313460263323016211 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let window = GWindow.window () in window#connect#destroy ~callback:Main.quit; let calendar = GMisc.calendar ~packing:window#add () in calendar#connect#day_selected ~callback: begin fun () -> let (year,month,day) = calendar#date in Printf.printf "You selected %d/%d/%02d.\n" day (month+1) (year mod 100); flush stdout end; window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/combo.ml0000644000175000017500000000236313460263323015537 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let make_arrow_label combo ~label ~string = let item = GList.list_item () in (* no packing here, it blocks GTK *) let hbox = GPack.hbox ~spacing:3 ~packing:item#add () in GMisc.arrow ~kind:`RIGHT ~shadow:`OUT ~packing:hbox#pack (); GMisc.label ~text:label ~packing:hbox#pack (); combo#set_item_string item string; combo#list#add item; item let main () = let window = GWindow.window ~border_width:10 () in window#connect#destroy ~callback:Main.quit; let combo = GEdit.combo ~packing:window#add () in make_arrow_label combo ~label:"First item" ~string:"1st item"; make_arrow_label combo ~label:"Second item" ~string:"2nd item"; window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/image.ml0000644000175000017500000000607113460263323015522 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain open Gdk (* load image *) let load_image file = print_endline "Load as string"; let buf = Bytes.create (256*256*3) in let ic = open_in_bin file in really_input ic buf 0 (256*256*3); close_in ic; buf let (.![]) = Bytes.get let rgb_at buf x y = let offset = (y * 256 + x) * 3 in (int_of_char (buf.![offset ]), int_of_char (buf.![offset+1]), int_of_char (buf.![offset+2])) let create_region = Gpointer.region_of_bytes (* alternate approach: map the file *) (* Requires bigarray.cma, but needed for Rgb.draw_image *) (* let load_image file = print_endline "Map file to bigarray"; let fd = Unix.openfile file [Unix.O_RDONLY] 0 in let arr = Bigarray.Array1.map_file fd Bigarray.int8_unsigned Bigarray.c_layout false (256*256*3) in Unix.close fd; arr let rgb_at buf x y = let offset = (y * 256 + x) * 3 in (buf.{offset}, buf.{offset+1}, buf.{offset+2}) let create_region = Gpointer.region_of_bigarray *) let use_rgb = ref false let file = ref "image256x256.rgb" let () = Arg.parse ["-rgb", Arg.Set use_rgb, " use Gdk.Rgb.draw_image"; "-image", Arg.Clear use_rgb, "use Gdk.Image.draw_image" ] (fun f -> file := f) (Sys.argv.(0) ^ " <256x256 rgb file> (edit for using Bigarray)") (* Choose a visual appropriate for RGB *) let () = Gdk.Rgb.init (); GtkBase.Widget.set_default_visual (Gdk.Rgb.get_visual ()); GtkBase.Widget.set_default_colormap (Gdk.Rgb.get_cmap ()) (* We need show: true because of the need of visual *) let window = GWindow.window ~show:true ~width: 256 ~height: 256 () let visual = window#misc#visual let color_create = Truecolor.color_creator visual let w = window#misc#window let drawing = new GDraw.drawable w let display = let buf = load_image !file in if not !use_rgb then begin print_endline "Using Gdk.Image"; let image = Image.create ~kind: `FASTEST ~visual: visual ~width: 256 ~height: 256 in for x = 0 to 255 do for y = 0 to 255 do let r,g,b = rgb_at buf x y in Image.put_pixel image ~x: x ~y: y ~pixel: (color_create ~red: (r * 256) ~green: (g * 256) ~blue: (b * 256)) done done; fun () -> drawing#put_image image ~x:0 ~y:0 end else begin print_endline "Using Gdk.Rgb"; let reg = create_region buf in fun () -> drawing#put_rgb_data reg ~width:256 ~height:256 end let () = flush stdout; (* Bind callbacks *) window#connect#destroy ~callback:Main.quit; window#event#connect#after#expose ~callback: begin fun _ -> display (); false end; window#show (); Main.main () lablgtk-2.18.8/examples/testgtk.ml0000644000175000017500000010600013460263323016116 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open GdkKeysyms open GMain open GObj let create_bbox direction title spacing child_w child_h layout = let frame = GBin.frame ~label: title () in let bbox = GPack.button_box direction ~border_width: 5 ~packing: frame#add ~layout: layout ~child_height: child_h ~child_width: child_w ~spacing: spacing () in GButton.button ~label: "OK" ~packing: bbox#add (); GButton.button ~label: "Cancel" ~packing: bbox#add (); GButton.button ~label: "Help" ~packing: bbox#add (); frame#coerce let create_button_box = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "Button Boxes" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let main_vbox = GPack.vbox ~packing: (window#add) () in let frame_horz = GBin.frame ~label: "Horizontal Button Boxes" ~packing:(main_vbox#pack ~expand:true ~fill:true ~padding:10) () in let vbox = GPack.vbox ~border_width: 10 ~packing: frame_horz#add () in vbox#add (create_bbox `HORIZONTAL "Spread" 40 85 20 `SPREAD); vbox#pack (create_bbox `HORIZONTAL "Edge" 40 85 20 `EDGE) ~expand: true ~fill: true ~padding: 5; vbox#pack (create_bbox `HORIZONTAL "Start" 40 85 20 `START) ~expand: true ~fill: true ~padding: 5; vbox#pack (create_bbox `HORIZONTAL "End" 40 85 20 `END) ~expand: true ~fill: true ~padding: 5; let frame_vert = GBin.frame ~label: "Vertical Button Boxes" ~packing:(main_vbox#pack ~expand:true ~fill:true ~padding:10) () in let hbox = GPack.hbox ~border_width: 10 ~packing: frame_vert#add () in hbox#add (create_bbox `VERTICAL "Spread" 30 85 20 `SPREAD); hbox#pack (create_bbox `VERTICAL "Edge" 30 85 20 `EDGE) ~expand: true ~fill: true ~padding: 5; hbox#pack (create_bbox `VERTICAL "Start" 30 85 20 `START) ~expand: true ~fill: true ~padding: 5; hbox#pack (create_bbox `VERTICAL "End" 30 85 20 `END) ~expand: true ~fill: true ~padding: 5; window #show () | Some window -> window #destroy () in aux let button_window button _ = if button #misc#visible then button #misc#hide () else button #misc#show () let create_buttons = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "GtkButton" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let box1 = GPack.vbox ~packing:window#add () in let table = GPack.table ~rows:3 ~columns:3 ~homogeneous:false ~row_spacings:3 ~col_spacings:3 ~border_width:10 ~packing:box1#add () in let button = Array.make 9 (GButton.button ~label:"button1" ()) in for i = 2 to 9 do button.(i-1) <- GButton.button ~label:("button" ^ string_of_int i) (); done; let f i l r t b = button.(i) #connect#clicked ~callback:(button_window button.(i+1)); table #attach button.(i)#coerce ~left:l ~right:r ~top:t ~bottom:b ~xpadding:0 ~ypadding:0 ~expand:`BOTH in f 0 0 1 0 1; f 1 1 2 1 2; f 2 2 3 2 3; f 3 0 1 2 3; f 4 2 3 0 1; f 5 1 2 2 3; f 6 1 2 0 1; f 7 2 3 1 2; button.(8) #connect#clicked ~callback:(button_window button.(0)); table #attach button.(8)#coerce ~left:0 ~right:1 ~top:1 ~bottom:2 ~xpadding:0 ~ypadding:0 ~expand:`BOTH; GMisc.separator `HORIZONTAL ~packing:box1#pack (); let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show () | Some window -> window #destroy () in aux let create_check_buttons = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "GtkCheckButton" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let box1 = GPack.vbox ~packing:window#add () in let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in for i = 1 to 3 do GButton.check_button ~label:("button" ^ (string_of_int i)) ~packing: box2#add (); done; GMisc.separator `HORIZONTAL ~packing: box1#pack (); let box2 = GPack.vbox ~spacing:10 ~border_width:10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing:box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show () | Some window -> window #destroy () in aux let create_radio_buttons = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "radio buttons" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let box1 = GPack.vbox ~packing:window#add () in let box2 = GPack.vbox ~spacing:10 ~border_width:10 ~packing: box1#pack () in let button = GButton.radio_button ~label:"button1" ~packing: box2#add () in let button = GButton.radio_button ~label:"button2" ~group:button#group ~packing: box2#add ~active:true () in let button = GButton.radio_button ~label:"button3" ~group:button#group ~packing: box2#add () in GMisc.separator `HORIZONTAL ~packing: box1#pack (); let box2 = GPack.vbox ~spacing:10 ~border_width:10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box2#add () in button #connect#clicked ~callback: window #destroy; button #grab_default (); window #show () | Some window -> window #destroy () in aux let create_toggle_buttons = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "GtkToggleButton" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let box1 = GPack.vbox ~packing: window#add () in let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in for i = 1 to 3 do GButton.toggle_button ~label:("button" ^ (string_of_int i)) ~packing: box2#add () done; GMisc.separator `HORIZONTAL ~packing: box1#pack (); let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing:box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show () | Some window -> window #destroy () in aux (* Menus *) let create_menu depth tearoff = let rec aux depth tearoff = let menu = GMenu.menu () and group = ref None in if tearoff then ignore (GMenu.tearoff_item ~packing: menu#append ()); for i = 0 to 4 do let menuitem = GMenu.radio_menu_item ?group:!group ~label:("item " ^ string_of_int depth ^ " - " ^ string_of_int (i+1)) ~packing:menu#append ~show_toggle:(depth mod 2 <> 0) () in group := Some (menuitem #group); if i = 3 then menuitem #misc#set_sensitive false; if depth > 1 then menuitem #set_submenu (aux (depth-1) true) done; menu in aux depth tearoff let create_menus = let rw = ref None in fun () -> match !rw with | None -> let window = GWindow.window ~title: "menus" ~border_width: 0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); window #event#connect#delete ~callback:(fun _ -> true); let accel_group = GtkData.AccelGroup.create () in window #add_accel_group accel_group ; let box1 = GPack.vbox ~packing:window#add () in let menubar = GMenu.menu_bar ~packing: box1#pack () in let menuitem = GMenu.menu_item ~label:"test\nline2" ~packing: menubar#append () in menuitem #set_submenu (create_menu 2 true); let menuitem = GMenu.menu_item ~label:"foo" ~right_justified:true ~packing: menubar#append () in menuitem #set_submenu (create_menu 3 true); let box2 = GPack.vbox ~spacing: 10 ~packing: box1#add ~border_width: 10 () in let menu = create_menu 1 false in menu #set_accel_group accel_group; let menuitem = GMenu.check_menu_item ~label:"Accelerate Me" ~packing:menu#append () in menuitem #add_accelerator ~group:accel_group _M ~flags:[`VISIBLE]; let menuitem = GMenu.check_menu_item ~label:"Accelerator Locked" ~packing:menu#append () in menuitem #add_accelerator ~group:accel_group _L ~flags:[`VISIBLE; `LOCKED]; let menuitem = GMenu.check_menu_item ~label:"Accelerators Frozen" ~packing:menu#append () in menuitem #add_accelerator ~group:accel_group _F ~flags:[`VISIBLE]; let menuitem = GMenu.image_menu_item ~stock:`OPEN ~packing:menu#append () in let path = "/Open" in GtkMenu.MenuItem.set_accel_path menuitem#as_item path; let stock = GtkStock.Item.lookup `OPEN in GtkData.AccelMap.add_entry ~key:stock.GtkStock.keyval ~modi:stock.GtkStock.modifier path; let optionmenu = GMenu.option_menu ~packing: box2#add () in optionmenu #set_menu menu; optionmenu #set_history 3; GMisc.separator `HORIZONTAL ~packing: box1#pack (); let box2 = GPack.vbox ~spacing:10 ~border_width:10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show () | Some window -> window #destroy () (* Modal windows *) let cmw_destroy_cb _ = Main.quit () let cmw_color parent _ = let csd = GWindow.color_selection_dialog ~modal:true ~title:"This is a modal color selection dialog" () in csd # set_transient_for parent#as_window; csd # connect#destroy ~callback:cmw_destroy_cb; csd # ok_button # connect#clicked ~callback:csd#destroy; csd # cancel_button # connect#clicked ~callback:csd#destroy; csd # show (); Main.main () let cmw_file parent _ = let fs = GWindow.file_selection ~modal:true ~title:"This is a modal file selection dialog" () in fs # set_transient_for parent#as_window; fs # connect#destroy ~callback:cmw_destroy_cb; fs # ok_button # connect#clicked ~callback:fs#destroy; fs # cancel_button # connect#clicked ~callback:fs#destroy; fs # show (); Main.main () let create_modal_window () = let window = GWindow.window ~modal:true ~title:"This window is modal" () in let box1 = GPack.vbox ~spacing:5 ~border_width:3 ~packing:window#add () in let frame1 = GBin.frame ~label:"Standard dialogs in modal form" ~packing:(box1#pack ~expand:true ~padding:4) () in let box2 = GPack.vbox ~homogeneous:true ~spacing:5 ~packing:frame1#add () in let btnColor = GButton.button ~label:"Color" ~packing:(box2#pack ~padding:4) () and btnFile = GButton.button ~label:"File selection" ~packing:(box2#pack ~padding:4) () and btnClose = GButton.button ~label:"Close" ~packing:(box2#pack ~padding:4) () in GMisc.separator `HORIZONTAL ~packing:(box1#pack ~padding:4) (); btnClose #connect#clicked ~callback:(fun _ -> window #destroy ()); window #connect#destroy ~callback:cmw_destroy_cb; btnColor #connect#clicked ~callback: (cmw_color window); btnFile #connect#clicked ~callback: (cmw_file window); window # show (); Main.main () (* corrected bug in testgtk.c *) let scrolled_windows_remove, scrolled_windows_clean = let parent = ref None and float_parent = ref None in let remove (scrollwin : GBin.scrolled_window) () = match !parent with | None -> parent := scrollwin#misc#parent; let f = GWindow.window ~title:"new parent" () in float_parent := Some f#coerce; f #set_default_size ~width:200 ~height:200; scrollwin #misc#reparent f#coerce; f #show () | Some p -> scrollwin #misc#reparent p; match !float_parent with | None -> () | Some f -> f #destroy (); float_parent := None; parent := None and clean () = match !float_parent with | None -> () | Some p -> p #destroy (); parent := None; float_parent := None in remove, clean (* scrolled windows *) let create_scrolled_windows = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.dialog ~title:"dialog" ~border_width:0 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); window #connect#destroy ~callback:scrolled_windows_clean; let scrolled_window = GBin.scrolled_window ~border_width:10 ~hpolicy: `AUTOMATIC ~vpolicy:`AUTOMATIC ~packing: window#vbox#add () in let table = GPack.table ~rows:20 ~columns:20 ~row_spacings:10 ~col_spacings:10 ~packing:scrolled_window#add_with_viewport () in table #focus#set_hadjustment (Some scrolled_window # hadjustment); table #focus#set_vadjustment (Some scrolled_window # vadjustment); for i = 0 to 19 do for j=0 to 19 do GButton.toggle_button ~label:("button ("^ string_of_int i ^","^ string_of_int j ^")\n") ~packing:(table #attach ~left:i ~top:j ~expand:`BOTH) () done done; let button = GButton.button ~label:"close" ~packing:window#action_area#add () in button #connect#clicked ~callback:(window #destroy); button #grab_default (); let button = GButton.button ~label:"remove" ~packing:window#action_area#add () in button #connect#clicked ~callback:(scrolled_windows_remove scrolled_window); button #grab_default (); window #set_default_size ~width:300 ~height:300; window #show () | Some window -> window #destroy () in aux (* Toolbar *) let make_toolbar (toolbar : GButton.toolbar) window = let icon = let pb = GdkPixbuf.from_file "test.xpm" in fun () -> (GMisc.image ~pixbuf:pb ())#coerce in toolbar #insert_button ~text:"Horizontal" ~tooltip:"Horizontal toolbar layout" ~tooltip_private:"Toolbar/Horizontal" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_orientation `HORIZONTAL) (); toolbar #insert_button ~text:"Vertical" ~tooltip:"Vertical toolbar layout" ~tooltip_private:"Toolbar/Vertical" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_orientation `VERTICAL) (); toolbar #insert_space (); toolbar #insert_button ~text:"Icons" ~tooltip: "Only show toolbar icons" ~tooltip_private:"Toolbar/IconsOnly" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_style `ICONS) (); toolbar #insert_button ~text:"Text" ~tooltip: "Only show toolbar text" ~tooltip_private:"Toolbar/TextOnly" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_style `TEXT) (); toolbar #insert_button ~text:"Both" ~tooltip: "Show toolbar icons and text" ~tooltip_private:"Toolbar/Both" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_style `BOTH) (); toolbar #insert_space (); GEdit.entry ~packing:(toolbar #insert_widget ~tooltip:"This is an unusable GtkEntry" ~tooltip_private: "Hey don't click me!!!") (); toolbar #insert_space (); toolbar #insert_button ~text:"Enable" ~tooltip:"Enable tooltips" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_tooltips true) (); toolbar #insert_button ~text:"Disable" ~tooltip:"Disable tooltips" ~icon:(icon ()) ~callback:(fun _ -> toolbar #set_tooltips false) (); () let create_toolbar = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "Toolbar test" ~border_width: 0 ~allow_shrink: false ~allow_grow: true () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); window #misc #realize (); let toolbar = GButton.toolbar ~packing: window#add () in make_toolbar toolbar window; window #show () | Some window -> window #destroy () in aux (* Handlebox *) let handle_box_child_signal action (hb : GBin.handle_box) child = Printf.printf "%s: child <%s> %s\n" hb#misc#get_type child#misc#get_type action; flush stdout let create_handle_box = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title: "Handle box test" ~border_width: 20 ~allow_shrink: false ~allow_grow: true () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); window #misc #realize (); let vbox = GPack.vbox ~packing:window#add () in GMisc.label ~text:"Above" ~packing:vbox#add (); GMisc.separator `HORIZONTAL ~packing:vbox#add (); let hbox = GPack.hbox ~spacing:10 ~packing:vbox#add () in GMisc.separator `HORIZONTAL ~packing:vbox#add (); GMisc.label ~text:"Below" ~packing:vbox#add (); let handle_box = GBin.handle_box ~packing:hbox#pack () in handle_box #connect#child_attached ~callback:(handle_box_child_signal "attached" handle_box); handle_box #connect#child_detached ~callback:(handle_box_child_signal "detached" handle_box); let toolbar = GButton.toolbar ~packing:handle_box#add () in make_toolbar toolbar window; let handle_box = GBin.handle_box ~packing:hbox#pack () in handle_box #connect#child_attached ~callback:(handle_box_child_signal "attached" handle_box); handle_box #connect#child_detached ~callback:(handle_box_child_signal "detached" handle_box); let handle_box2 = GBin.handle_box ~packing:handle_box#add () in handle_box2 #connect#child_attached ~callback:(handle_box_child_signal "attached" handle_box); handle_box2 #connect#child_detached ~callback:(handle_box_child_signal "detached" handle_box); GMisc.label ~text:"Fooo!" ~packing:handle_box2#add (); window #show () | Some window -> window #destroy () in aux (* Tree *) class tree_and_buttons () = object val tree = GBroken.tree () val add_button = GButton.button ~label: "Add Item" () val remove_button = GButton.button ~label:"Remove Item(s)" () val subtree_button = GButton.button ~label:"Remove Subtree" () val mutable nb_item_add = 0 method tree = tree method add_button = add_button method remove_button = remove_button method subtree_button = subtree_button method nb_item_add = nb_item_add method incr_nb_item_add = nb_item_add <- nb_item_add + 1 end let cb_tree_destroy_event w = () let cb_add_new_item (treeb : tree_and_buttons) _ = let subtree = match treeb#tree#selection with | [] -> treeb#tree | selected_item :: _ -> match selected_item#subtree with Some t -> t | None -> let t = GBroken.tree () in selected_item#set_subtree t; t in let item_new = GBroken.tree_item ~packing:(subtree#insert ~pos:0) ~label:("item add " ^ string_of_int treeb # nb_item_add) () in treeb #incr_nb_item_add let cb_remove_item (treeb : tree_and_buttons) _ = let tree = treeb#tree in match tree #selection with | [] -> () | selected -> tree #remove_items selected let cb_remove_subtree (treeb : tree_and_buttons) _ = match treeb#tree #selection with | [] -> () | selected_item :: _ -> try selected_item#subtree; selected_item#remove_subtree () with Not_found -> () let cb_tree_changed (treeb : tree_and_buttons) _ = let tree = treeb#tree in let nb_selected = List.length (tree#selection) in if nb_selected = 0 then begin treeb # remove_button #misc#set_sensitive false; treeb # subtree_button #misc#set_sensitive false; end else begin treeb # remove_button #misc#set_sensitive true; treeb # subtree_button #misc#set_sensitive (nb_selected = 1); treeb # add_button #misc#set_sensitive (nb_selected = 1); end let rec create_subtree (item : GBroken.tree_item) level nb_item_max recursion_level_max = if level = recursion_level_max then () else begin let item_subtree = GBroken.tree () in for nb_item = 1 to nb_item_max do let item_new = GBroken.tree_item ~packing:(item_subtree#insert ~pos:0) () in let ali = GBin.alignment ~xalign:0. ~xscale:0. ~packing:item_new#add () in let label = GMisc.label ~packing:ali#add ~text:("item" ^ string_of_int level ^ "-" ^ string_of_int nb_item) () in if nb_item = 2 then begin ali#remove label#coerce; let evbox = GBin.event_box ~packing:ali#add () in evbox#add label#coerce; evbox#misc#modify_bg [`NORMAL, `NAME "green"] end; create_subtree item_new (level + 1) nb_item_max recursion_level_max; done; item # set_subtree item_subtree end let create_tree_sample selection_mode draw_line view_line no_root_item nb_item_max recursion_level_max = let window = GWindow.window ~title:"Tree Sample" () in let box1 = GPack.vbox ~packing:window#add () in let box2 = GPack.vbox ~packing:box1#add ~border_width:5 () in let scrolled_win = GBin.scrolled_window ~packing:box2#add ~hpolicy: `AUTOMATIC ~vpolicy:`AUTOMATIC ~width:200 ~height:200 () in let root_treeb = new tree_and_buttons () in let root_tree = root_treeb#tree in root_tree #connect#selection_changed ~callback:(cb_tree_changed root_treeb); scrolled_win #add_with_viewport root_tree#coerce; root_tree #set_selection_mode selection_mode; root_tree #set_view_lines draw_line; root_tree #set_view_mode (match view_line with `LINE -> `ITEM | `ITEM -> `LINE); if no_root_item then for nb_item = 1 to nb_item_max do let item_new = GBroken.tree_item ~label:("item0-" ^ string_of_int nb_item) ~packing:(root_tree#insert ~pos:0) () in create_subtree item_new 1 nb_item_max recursion_level_max; done else begin let root_item = GBroken.tree_item ~label:"root item" ~packing:(root_tree #insert ~pos:0) () in create_subtree root_item 0 nb_item_max recursion_level_max end; let box2 = GPack.vbox ~border_width:5 ~packing:box1#pack () in let button = root_treeb #add_button in button #misc#set_sensitive false; button #connect#clicked ~callback:(cb_add_new_item root_treeb); box2 #add button#coerce; let button = root_treeb #remove_button in button #misc#set_sensitive false; button #connect#clicked ~callback:(cb_remove_item root_treeb); box2 #add button#coerce; let button = root_treeb #subtree_button in button #misc#set_sensitive false; button #connect#clicked ~callback:(cb_remove_subtree root_treeb); box2 #add button#coerce; GMisc.separator `HORIZONTAL ~packing:box1#pack (); let button = GButton.button ~label:"Close" ~packing:box2#add () in button #connect#clicked ~callback:window#destroy; window #show () let create_tree_mode_window = let rw = ref None in let aux () = let default_number_of_item = 3.0 in let default_recursion_level = 3.0 in let single_button = GButton.radio_button ~label:"SINGLE" () in let browse_button = GButton.radio_button ~group:single_button#group ~label:"BROWSE" () in let multiple_button = GButton.radio_button ~group:browse_button#group ~label:"MULTIPLE" () in let draw_line_button = GButton.check_button ~label:"Draw line" () in let view_line_button = GButton.check_button ~label:"View line mode" () in let no_root_item_button = GButton.check_button ~label:"Without Root item" () in let nb_item_spinner = GEdit.spin_button ~adjustment:(GData.adjustment ~value:default_number_of_item ~lower:1.0 ~upper:255.0 ~step_incr:1.0 ~page_incr:5.0 ~page_size:0.0 ()) ~rate:0. ~digits:0 () in let recursion_spinner = GEdit.spin_button ~adjustment:(GData.adjustment ~value:default_recursion_level ~lower:0.0 ~upper:255.0 ~step_incr:1.0 ~page_incr:5.0 ~page_size:0.0 ()) ~rate:0. ~digits:0 () in let cb_create_tree _ = let selection_mode = if single_button #active then `SINGLE else if browse_button #active then `BROWSE else `MULTIPLE in let nb_item = nb_item_spinner#value_as_int in let recursion_level = recursion_spinner#value_as_int in create_tree_sample selection_mode (draw_line_button #active) (if (view_line_button #active) then `ITEM else `LINE) (no_root_item_button #active) nb_item recursion_level in match !rw with | None -> let window = GWindow.window ~title:"Set Tree Parameters" () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let box1 = GPack.vbox ~packing:window#add () in let box2 = GPack.vbox ~spacing:5 ~packing:box1#add ~border_width:5 () in let box3 = GPack.hbox ~spacing:5 ~packing:box2#add () in let frame = GBin.frame ~label:"Selection Mode" ~packing:box3#add () in let box4 = GPack.vbox ~packing:frame#add ~border_width:5 () in box4 #add single_button#coerce; box4 #add browse_button#coerce; box4 #add multiple_button#coerce; let frame = GBin.frame ~label:"Options" ~packing:box3#add () in let box4 = GPack.vbox ~packing:frame#add ~border_width:5 () in box4 #add draw_line_button#coerce; draw_line_button #set_active true; box4 #add view_line_button#coerce; view_line_button #set_active true; box4 #add no_root_item_button#coerce; let frame = GBin.frame ~label:"Size Parameters" ~packing:box2#add () in let box4 = GPack.hbox ~spacing:5 ~packing:frame#add ~border_width:5 () in let box5 = GPack.hbox ~spacing:5 ~packing:box4#add () in let label = GMisc.label ~text:"Number of items : " ~xalign:0. ~yalign:0.5 ~packing:box5#pack () in box5 #pack nb_item_spinner#coerce; let label = GMisc.label ~text:"Depth : " ~xalign:0. ~yalign:0.5 ~packing:box5#pack () in box5 #pack recursion_spinner#coerce; GMisc.separator `HORIZONTAL ~packing:box1#pack (); let box2 = GPack.hbox ~homogeneous:true ~spacing:10 ~border_width:5 ~packing:box1#pack () in let button = GButton.button ~label:"Create Tree" ~packing:box2#add () in button #connect#clicked ~callback:cb_create_tree; let button = GButton.button ~label: "close" ~packing:box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show () | Some window -> window #destroy () in aux (* Tooltips *) let tips_query_widget_entered (toggle : GButton.toggle_button) (tq : GMisc.tips_query) _ ~text ~privat:_ = if toggle #active then begin tq #set_text (if text = "" then "There is no tip!" else "There is a tip!"); GtkSignal.stop_emit () end let tips_query_widget_selected (w : #widget option) ~text ~privat:tp _ = (match w with | None -> () | Some w -> Printf.printf "Help \"%s\" requested for <%s>\n" (if tp = "" then "None" else tp) (w #misc#get_type)); true let create_tooltips = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title:"Tooltips" ~border_width:0 ~allow_shrink:false ~allow_grow:false () in rw := Some window; let tooltips = GData.tooltips () in window #connect#destroy ~callback:(fun _ -> tooltips #destroy (); rw := None); let box1 = GPack.vbox ~packing:window#add () in let box2 = GPack.vbox ~spacing:10 ~border_width:10 ~packing:box1#add () in let button = GButton.toggle_button ~label:"button1" ~packing:box2#add () in tooltips #set_tip button#coerce ~text:"This is button1" ~privat:"ContextHelp/buttons/1"; let button = GButton.toggle_button ~label:"button2" ~packing:box2#add () in tooltips #set_tip button#coerce ~text:"This is button 2. This is also a really long tooltip which probably won't fit on a single line and will therefore need to be wrapped. Hopefully the wrapping will work correctly." ~privat:"ContextHelp/buttons/2_long"; let toggle = GButton.toggle_button ~label:"Override TipsQuery Label" ~packing:box2#add () in tooltips #set_tip toggle#coerce ~text:"Toggle TipsQuery view." ~privat:"Hi msw! ;)"; let box3 = GPack.vbox ~spacing:5 ~border_width:5 () in let button = GButton.button ~label:"[?]" ~packing:box3#pack () in let tips_query = GMisc.tips_query ~packing:box3#add () in button #connect#clicked ~callback:(tips_query #start); tooltips #set_tip button#coerce ~text:"Start the Tooltips Inspector" ~privat:"ContextHelp/buttons/?"; tips_query #set_caller (Some button#coerce); tips_query #connect#widget_entered ~callback:(tips_query_widget_entered toggle tips_query); tips_query #connect#widget_selected ~callback:tips_query_widget_selected; let frame = GBin.frame ~label:"Tooltips Inspector" ~border_width:0 ~packing:(box2#pack ~expand:true ~padding:10) ~label_xalign:0.5 ~label_yalign:0.0 () in frame #add box3#coerce; GMisc.separator `HORIZONTAL ~packing:box1#pack (); let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); tooltips #set_tip button#coerce ~text:"Push this button to close window" ~privat:"ContextHelp/buttons/Close"; window #show (); | Some window -> window #destroy () in aux (* Labels *) let create_labels = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title:"Labels" ~border_width:5 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let hbox = GPack.hbox ~spacing:5 ~packing:window#add () in let vbox = GPack.vbox ~spacing:5 ~packing:hbox#add () in let frame = GBin.frame ~label:"Normal Label" ~packing:vbox#pack () in GMisc.label ~text:"This is a normal label" ~packing:frame#add (); let frame = GBin.frame ~label:"Multi_line Label" ~packing:vbox#pack () in GMisc.label ~packing:frame#add ~text:"This is a multi-line label.\nSecond line\nThird line" (); let frame = GBin.frame ~label:"Left Justified Label" ~packing:vbox#pack () in GMisc.label ~packing:frame#add ~justify:`LEFT ~text:"This is a left justified\nmulti_line label\nThird line" (); let frame = GBin.frame ~label:"Right Justified Label" ~packing:vbox#pack () in GMisc.label ~packing:frame#add ~justify:`RIGHT ~text:"This is a right justified\nmulti_line label\nThird line" (); let vbox = GPack.vbox ~spacing:5 ~packing:hbox#add () in let frame = GBin.frame ~label:"Line wrapped Label" ~packing:vbox#pack () in GMisc.label ~packing:frame#add ~line_wrap:true ~text:"This is an example of a line-wrapped label. It should not be taking up the entire width allocated to it, but automatically wraps the words to fit. The time has come, for all good men, to come to the aid of their party. The sixth sheik's six sheep's sick.\n It supports multiple paragraphs correctly, and correctly adds many extra spaces. " (); let frame = GBin.frame ~label:"Underlined Label" ~packing:vbox#pack () in GMisc.label ~text:"This label is underlined!\nThis one is underlined in a quite a funky fashion" ~packing:frame#add ~justify:`LEFT ~pattern:"_________________________ _ _________ _ _____ _ __ __ ___ ____ _____" (); window #show (); | Some window -> window #destroy () in aux (* reparent *) let set_parent child old_parent = let name_opt = function | None -> "(NULL)" | Some w -> w#misc#get_type in Printf.printf "set parent for \"%s\": new parent: \"%s\", old parent: \"%s\"\n" child#misc#get_type (name_opt child#misc#parent) (name_opt old_parent); flush stdout let reparent_label (label : GMisc.label) new_parent _ = label #misc#reparent new_parent let create_reparent = let rw = ref None in let aux () = match !rw with | None -> let window = GWindow.window ~title:"Reparent" ~border_width:5 () in rw := Some window; window #connect#destroy ~callback:(fun _ -> rw := None); let vbox = GPack.vbox ~packing:window#add () in let hbox = GPack.hbox ~spacing:5 ~border_width:10 ~packing:vbox#add () in let frame = GBin.frame ~label:"Frame1" ~packing:hbox#add () in let vbox2 = GPack.vbox ~spacing:5 ~border_width:5 ~packing:frame#add () in let label = GMisc.label ~text:"Hello world" ~packing:vbox2#pack () in label #misc#connect#parent_set ~callback:(set_parent label); let button = GButton.button ~label:"switch" ~packing:vbox2#pack () in button #connect#clicked ~callback:(reparent_label label vbox2#coerce); let frame = GBin.frame ~label:"Frame2" ~packing:hbox#add () in let vbox2 = GPack.vbox ~spacing:5 ~packing:frame#add ~border_width:5 () in let button = GButton.button ~label:"switch" ~packing:vbox2#pack () in button #connect#clicked ~callback:(reparent_label label vbox2#coerce); GMisc.separator `HORIZONTAL ~packing:vbox#pack (); let vbox = GPack.vbox ~spacing:10 ~border_width:10 ~packing:vbox#pack () in let button = GButton.button ~label: "close" ~packing:vbox#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show (); | Some window -> window #destroy () in aux let create_main_window () = let buttons = [ "button box", Some create_button_box; "buttons", Some create_buttons; "check buttons", Some create_check_buttons; "clist", None; "color selection", None; "ctree", None; "cursors", None; "dialog", None; "entry", None; "event watcher", None; "file selection", None; "font selection", None; "gamma curve", None; "handle box", Some create_handle_box; "item factory", None; "labels", Some create_labels; "layout", None; "list", None; "menus", Some create_menus; "modal windows", Some create_modal_window; "notebooks", None; "panes", None; "pixmap", None; "preview color", None; "preview gray", None; "progress bar", None; "radio buttons", Some create_radio_buttons; "range controls", None; "rc file", None; "reparent", Some create_reparent; "rulers", None; "saved position", None; "scrolled windows", Some create_scrolled_windows; "shapes", None; "spinbutton", None; "statusbar", None; "test idle", None; "test mainloop", None; "test scrolling", None; "test selection", None; "test timeout", None; "text", None; "toggle buttons", Some create_toggle_buttons; "toolbar", Some create_toolbar; "tooltips", Some create_tooltips; "tree", Some create_tree_mode_window; "WM hints", None ] in let window = GWindow.window ~title:"main window" ~width:200 ~height:400 () in window#move ~x:20 ~y:20; window #connect#destroy ~callback: Main.quit; let box1 = GPack.vbox ~packing: window#add () in GMisc.label ~text: "Gtk+ v2.x" ~packing:box1#pack (); let scrolled_window = GBin.scrolled_window ~border_width: 10 ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ~packing:box1#add () in let box2 = GPack.vbox ~border_width: 10 ~packing:scrolled_window#add_with_viewport () in box2 #focus#set_vadjustment (Some scrolled_window#vadjustment); let rec aux = function | [] -> () | (_, None) :: tl -> aux tl | (label, Some func) :: tl -> let button = GButton.button ~label: label ~packing: box2#add () in button #connect#clicked ~callback: func; aux tl in aux buttons; GMisc.separator `HORIZONTAL ~packing: box1#pack (); let box2 = GPack.vbox ~spacing: 10 ~border_width: 10 ~packing: box1#pack () in let button = GButton.button ~label: "close" ~packing: box2#add () in button #connect#clicked ~callback: window#destroy; button #grab_default (); window #show (); let tray_icon = GMisc.status_icon_from_file "gnome-fs-directory.png" in ignore(tray_icon#connect#activate (fun () -> GToolbox.message_box "testgtk" "Tray icon activated!")); Main.main () let _ = create_main_window () lablgtk-2.18.8/examples/entrycompletion.ml0000644000175000017500000000634513460263323017677 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let model_of_list conv l = let cols = new GTree.column_list in let column = cols#add conv in let model = GTree.list_store cols in List.iter (fun data -> let row = model#append () in model#set ~row ~column data) l ; (model, column) let string_completion_list = [ "hello" ; "hello world" ; "abcdef" ; "abcxyz" ] let stock_completion_list = [ `HOME ; `GO_BACK ; `GO_FORWARD ; `DIALOG_WARNING ; `DIALOG_ERROR ] let setup packing (make_entry : (GObj.widget -> unit) -> GEdit.entry) = let box = GPack.hbox ~packing () in let entry = make_entry box#pack in let button = GButton.button ~stock:`JUMP_TO ~packing:box#pack () in button#connect#clicked (fun () -> prerr_endline entry#text) ; () let make_simple_entry packing = let entry = GEdit.entry ~text:"text" ~packing () in let (model, col) = model_of_list Gobject.Data.string string_completion_list in let c = GEdit.entry_completion ~model ~entry () in c#set_text_column col ; c#insert_action_markup 0 "action 0" ; c#insert_action_markup 1 "action 1" ; entry let is_prefix s1 s2 = (String.length s1 <= String.length s2) && (String.sub s2 0 (String.length s1) = s1) let make_complex_entry packing = let entry = GEdit.entry ~text:"pick a stock id" ~packing () in let (model, column) = model_of_list GtkStock.conv stock_completion_list in let completion = GEdit.entry_completion ~model ~entry () in begin let renderer = GTree.cell_renderer_pixbuf [ `STOCK_SIZE `BUTTON ] in completion#pack renderer ; completion#add_attribute renderer "stock_id" column end ; begin let renderer = GTree.cell_renderer_text [ `XPAD 5 ] in completion#pack renderer ; completion#add_attribute renderer "text" column end ; completion#set_match_func (fun key row -> let column = { column with GTree.conv = Gobject.Data.string } in let str = model#get ~row ~column in is_prefix key str) ; completion#connect#match_selected (fun model row -> (* Unsafe but correct dummy column usage let column = { column with GTree.conv = Gobject.Data.string ; GTree.creator = 0 } in entry#set_text (model#get ~row ~column) ; *) (* Safer but relies on Comment #1 of Gtk bug 555087. *) entry#set_text (GtkStock.convert_id (model#child_model#get ~row:(model#convert_iter_to_child_iter row) ~column)); true) ; entry let main () = let w = GWindow.window ~title:"GtkEntryCompletion demo" () in w#connect#destroy GMain.quit ; begin let box = GPack.vbox ~packing:w#add () in setup box#pack make_simple_entry ; setup box#pack make_complex_entry end ; w#show () ; GMain.main () let _ = main () lablgtk-2.18.8/examples/fifteen.ml0000644000175000017500000000653313460263323016063 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gaux open Gtk open GObj open GMain class position ~init_x ~init_y ~min_x ~min_y ~max_x ~max_y = object val mutable x = init_x val mutable y = init_y method current = (x, y) method up () = if y > min_y then y <- y-1 else (); (x, y) method down () = if y < max_y then y <- y+1 else (); (x, y) method left () = if x > min_x then x <- x-1 else (); (x, y) method right () = if x < max_x then x <- x+1 else (); (x, y) end let game_init () = (* generate initial puzzle state *) let rec game_aux acc rest n_invert = let len = List.length rest in if len=0 then if n_invert mod 2 = 0 then acc (* to be solvable, n_invert must be even *) else (List.hd (List.tl acc))::(List.hd acc)::(List.tl (List.tl acc)) else begin let rec extract n xs = if (n=0) then (List.hd xs, List.tl xs) else let (ans, ys) = extract (n-1) (List.tl xs) in (ans, List.hd xs :: ys) in let ran = Random.int len in let (elm, rest1) = extract ran rest in let rec count p xs = match xs with [] -> 0 | y :: ys -> let acc = count p ys in if p y then 1+acc else acc in let new_n_invert = count (fun x -> elm > x) acc in game_aux (elm :: acc) rest1 (n_invert+new_n_invert) end in let rec from n = if n=0 then [] else n :: from (n-1) in game_aux [] (from 15) 0 let _ = Random.init (int_of_float (Sys.time () *. 1000.)) let window = GWindow.window () let _ = window#connect#destroy ~callback:GMain.Main.quit let tbl = GPack.table ~rows:4 ~columns:4 ~homogeneous:true ~packing:window#add () let dummy = GMisc.label ~text:"" ~packing:(tbl#attach ~left:3 ~top:3) () let arr = Array.make_matrix ~dimx:4 ~dimy:4 dummy let init = game_init () let _ = for i = 0 to 15 do let j = i mod 4 in let k = i/4 in let frame = GBin.frame ~shadow_type:`OUT ~width:32 ~height:32 ~packing:(tbl#attach ~left:j ~top:k) () in if i < 15 then arr.(j).(k) <- GMisc.label ~text:(string_of_int (List.nth init i)) ~packing:frame#add () done let pos = new position ~init_x:3 ~init_y:3 ~min_x:0 ~min_y:0 ~max_x:3 ~max_y:3 open GdkKeysyms let _ = window#event#connect#key_press ~callback: begin fun ev -> let (x0, y0) = pos#current in let wid0 = arr.(x0).(y0) in let key = GdkEvent.Key.keyval ev in if key = _q || key = _Escape then (Main.quit (); exit 0) else let (x1, y1) = if key = _h || key = _Left then pos#right () else if key = _j || key = _Down then pos#up () else if key = _k || key = _Up then pos#down () else if key = _l || key = _Right then pos#left () else (x0, y0) in let wid1 = arr.(x1).(y1) in wid0#set_text (wid1#text); wid1#set_text ""; true end let main () = window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/expander.ml0000644000175000017500000000222013460263323016236 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let setup_expander packing = let e = GBin.expander ~packing () in let pixbuf = e#misc#render_icon ~size:`DIALOG `DIALOG_INFO in let icon = GMisc.image ~pixbuf ~packing:e#add () in e#set_label "Show image" ; e#connect#after#activate (fun () -> e#set_label (if e#expanded then "Hide image" else "Show image")) let main () = let w = GWindow.window ~title:"GtkExpander demo" () in w#connect#destroy GMain.quit ; setup_expander w#add ; w#show () ; GMain.main () let _ = main () (* Local Variables: *) (* compile-command: "ocamlc -I ../src -w s lablgtk.cma gtkInit.cmo expander.ml" *) (* End: *) lablgtk-2.18.8/examples/progressbar.ml0000644000175000017500000000310113460263323016760 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let window = GWindow.window ~border_width: 10 () in window#connect#destroy ~callback:Main.quit; let table = GPack.table ~rows:3 ~columns:2 ~packing: window#add () in GMisc.label ~text:"Progress Bar Example" () ~packing:(table#attach ~left:0 ~right:2 ~top:0 ~expand:`X ~shrink:`BOTH); let pbar = GRange.progress_bar ~pulse_step:0.01 () ~packing:(table#attach ~left:0 ~right:2 ~top:1 ~expand:`BOTH ~fill:`X ~shrink:`BOTH) in let ptimer = Timeout.add ~ms:50 ~callback:(fun () -> pbar#pulse(); true) in let button = GButton.button ~label:"Reset" () ~packing:(table#attach ~left:0 ~top:2 ~expand:`NONE ~fill:`X ~shrink:`BOTH) in button#connect#clicked ~callback:(fun () -> pbar#set_fraction 0.); let button = GButton.button ~label:"Cancel" () ~packing:(table#attach ~left:1 ~top:2 ~expand:`NONE ~fill:`X ~shrink:`BOTH) in button#connect#clicked ~callback:Main.quit; window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/about.ml0000644000175000017500000000212013460263323015541 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* ocamlc -g -I ../src lablgtk.cma about.ml -o about *) let show () = let dialog = GWindow.about_dialog ~name:"Name" ~authors:["Me" ; "Myself"; ] ~copyright:"Copyright: copyleft" ~license:"Open" ~website:"http://www.world.com" ~website_label:"Questions and support" ~version:"0.0" () in ignore (dialog#connect#response ~callback:(fun _ -> dialog#show () )); ignore (dialog#run ()) let () = GMain.Main.init (); show () lablgtk-2.18.8/examples/spell.ml0000644000175000017500000000544713460263323015565 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let languages = [ "fr_FR"; "en_US"; "de_DE"; "ja_JP" ] let report_error view msg = let message = "GtkSpell error:\n" ^ (Glib.Markup.escape_text msg) in let dlg = GWindow.message_dialog ~message ~use_markup:true ~message_type:`ERROR ~buttons:GWindow.Buttons.close ?parent:(GWindow.toplevel view) ~destroy_with_parent:true () in ignore (dlg#run ()) ; dlg#destroy () let set_lang_cb view lang = prerr_endline "GtkSpell.set_language" ; try GtkSpell.set_language view lang ; true with GtkSpell.Error (_, msg) -> report_error view msg ; false type button_state = { mutable lang_id : int ; mutable error : bool } let build_language_list view packing = let (combo, _) as c = GEdit.combo_box_text ~strings:languages ~packing () in let state = { lang_id = -1 ; error = false } in ignore (combo#connect#changed (fun () -> if state.error then state.error <- false else if set_lang_cb view (GEdit.text_combo_get_active c) then state.lang_id <- combo#active else begin state.error <- true ; combo#set_active state.lang_id end)) ; c let attach_cb button view lang_list () = try if button#active then begin prerr_endline "GtkSpell.attach" ; GtkSpell.attach ?lang:(GEdit.text_combo_get_active lang_list) view end else begin prerr_endline "GtkSpell.detach" ; GtkSpell.detach view end with GtkSpell.Error (_, msg) -> button#set_active false ; report_error view msg let setup packing = let box = GPack.vbox ~spacing:5 ~packing () in let scroll = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~shadow_type:`IN ~packing:(box#pack ~expand:true) () in let view = GText.view ~wrap_mode:`WORD ~packing:scroll#add () in let hbox = GPack.hbox ~spacing:5 ~packing:box#pack () in let attached = GButton.toggle_button ~label:"Attached" ~packing:hbox#pack () in let lang_list = build_language_list view (hbox#pack ~from:`END) in ignore (attached#connect#toggled (attach_cb attached view lang_list)) ; () let main = let w = GWindow.window ~title:"GtkSpell demo" ~border_width:10 ~width:400 ~height:300 () in ignore (w#connect#destroy GMain.quit) ; setup w#add ; w#show () ; GMain.main () lablgtk-2.18.8/examples/pixview.ml0000644000175000017500000000260613460263323016133 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* An image viewer, supporting all formats allowed by GdkPixbuf *) let pb = if Array.length Sys.argv < 2 then begin Printf.eprintf "usage : %s \n" Sys.argv.(0); exit 2; end; try GdkPixbuf.from_file Sys.argv.(1) with GdkPixbuf.GdkPixbufError(_,msg) as exn -> let d = GWindow.message_dialog ~message:msg ~message_type:`ERROR ~buttons:GWindow.Buttons.close ~show:true () in d#run (); raise exn let pm, _ = GdkPixbuf.create_pixmap pb let width = GdkPixbuf.get_width pb let height = GdkPixbuf.get_height pb let w = GWindow.window ~width ~height ~title:Sys.argv.(1) () let da = GMisc.drawing_area ~packing:w#add () let dw = da#misc#realize (); new GDraw.drawable da#misc#window let () = da#event#connect#expose (fun _ -> dw#put_pixmap ~x:0 ~y:0 pm; true); w#connect#destroy GMain.quit; w#show (); GMain.main () lablgtk-2.18.8/examples/eventbox.ml0000644000175000017500000000473613460263323016300 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id: events.ml 1347 2007-06-20 07:40:34Z guesdon $ *) let string_of_event x = match GdkEvent.get_type x with | `NOTHING -> "nothing" | `DELETE -> "delete" | `DESTROY -> "destroy" | `EXPOSE -> "expose" | `MOTION_NOTIFY -> "motion-notify" | `BUTTON_PRESS -> "button-press" | `TWO_BUTTON_PRESS -> "2 button-press" | `THREE_BUTTON_PRESS -> "3 button-press" | `BUTTON_RELEASE -> "button-release" | `KEY_PRESS -> "key-press" | `KEY_RELEASE -> "key-release" | `ENTER_NOTIFY -> "enter-notfiy" | `LEAVE_NOTIFY -> "leave-notify" | `FOCUS_CHANGE -> "focus-change" | `CONFIGURE -> "configure" | `MAP -> "map" | `UNMAP -> "unmap" | `PROPERTY_NOTIFY -> "property-notify" | `SELECTION_CLEAR -> "selection-clear" | `SELECTION_REQUEST -> "selection-request" | `SELECTION_NOTIFY -> "selection-notify" | `PROXIMITY_IN -> "proximity-in" | `PROXIMITY_OUT -> "proximiy-out" | `DRAG_ENTER -> "drag-enter" | `DRAG_LEAVE -> "drag-leave" | `DRAG_MOTION -> "drag-motion" | `DRAG_STATUS -> "drag-status" | `DROP_START -> "drop-start" | `DROP_FINISHED -> "drop-finish" | `CLIENT_EVENT -> "client-event" | `VISIBILITY_NOTIFY -> "visibility-notify" | `NO_EXPOSE-> "no-expose" | `SCROLL -> "scroll" | `WINDOW_STATE -> "window-state" | `SETTING -> "setting" let _ = let w = GWindow.window ~width:200 ~height:200 () in w#connect#destroy ~callback:GMain.quit ; let eb = GBin.event_box ~packing:w#add () in eb#event#add [`ALL_EVENTS]; eb#event#connect#any (fun x -> prerr_string "before "; prerr_endline (string_of_event x); false); eb#event#connect#after#any (fun x -> prerr_string "after "; prerr_endline (string_of_event x); false); eb#event#connect#expose (fun x -> prerr_string "BEFORE EXPOSE "; prerr_endline (string_of_event x); false); eb#event#connect#after#expose (fun x -> prerr_string "AFTER EXPOSE "; prerr_endline (string_of_event x); false); w#show (); GMain.main () lablgtk-2.18.8/examples/spin.ml0000644000175000017500000000226713460263323015414 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let run () = let w = GWindow.dialog ~title:"Go to page" ~modal:true ~position:`CENTER () in ignore (GMisc.label ~text:"Page: " ~packing:w#vbox#add ()); let sb = GEdit.spin_button ~packing:w#vbox#add ~digits:0 ~numeric:true ~wrap:true () in sb#adjustment#set_bounds ~lower:0. ~upper:50.0 ~step_incr:1. (); sb#set_value 22.; sb#connect#wrapped (fun () -> prerr_endline "Wrapped!"); w#add_button_stock `OK `OK; w#add_button_stock `CANCEL `CANCEL; w#set_default_response `OK; let on_ok () = Format.printf "Ok...@." ; w#destroy () in match w#run () with | `DELETE_EVENT | `CANCEL -> w#destroy () | `OK -> on_ok () let () = run () lablgtk-2.18.8/examples/image256x256.rgb0000644000175000017500000060000013460263323016536 0ustar stephsteph”·ā•ŗŻ›±Ļ“­ŠŸŅŸ¤ĆŸ¦Ī¤¦ŪŖ¤ĪŖŖŚÆž×¤•Š”™Ō±¬ā­©Ž®§ēž®Šš¶É”øĖ”¶¼„®Å¢³Ó “ĪŖ½ĘؼӬ·Ó¶“ĻµĄĘ“°¼¬¾Ą·³ÄÄƶ¾½ĀĒĄ¼æ½·ĘĹŃĘĮĀĻ·ĆĢÅĶÉŁ¼ĶÓæŹĮĘĻĒÄćĶÕßĻŲÕĶĪÜĢĒćŃŃāŁŌ׌ČāČŌÜÄĢŲČŅŅĒĶ×ĆÅŪĮĶįĒĖąŹĖźĖŚš½×ļÅįķĖŽõ¼ńųæāć·Śę¾ÜŁČįāÅÜŁĆÖ×®ÖĢ³ŽČ±ŲÉ·ĶŌ²ŃŲ«ŃŃ”ĪĶŽŅܗŌŲŒąĶ‘ÖŹĻ¼ƒÉ¼ˆĪ¼ˆŻĮŌĖzćĒwŲɀŚĘ{āĪēӉŻ×…įׂÖÜÓŽŠŁŌ“ŲŲŒÓŲ‚Īį†ĪŅ|ŪąsÓŪzŽ×rįŁyąŌs×Üi×ŲgäĘkåŃoÜĻ_įĶdąČRßøC×ø?Ö“GŁ°WŚ°KēøEŚ·YÜŹ]ŽĀOÕæ;Ł½@ŽĆHāĖ9ķĒ<éĖ@šĒ8éÉAč“@ę·AņĢ9ŻÄ7é“@ܲ?Ž½EäÆCŁ²RĪ¬LŠÆPŅ”RŠ©]ĢØRĄæUĄ²XÉ©FĢ“JĻ±PŹFĖĮJÄæFĘÄQČ¼DŅ°OŌ­DŲÆHŅ³PѵPɶYŠÄ^ĖæWŁ¬PĪž[ѧWŲŖOĖ¬WĶØYĶ˜ZĪdŲ£ZĢ·XĮ°EŹPĪµ\Ļ®N½»T½³Y“ĆY¶øN¹¶D°³S±ØY«ØMŖ¬U¦¬[§®@Ŗ®T ÆM„¢M£žZ œG¬‘E£‘K„Y¢ŒK·[؅S¦—EžN§`”–R˜XŸƒ[‘†Qš‚Sš‘R™‡U§€W©€Tœ‡J¢~Qœ~C–tO”iL•rS”tN©lPŖoJ¢zTÆpB„qIž[M lC«gC¤lD±cC³YTĮSIøOQ“IBĄIE»ZK»OEøQH°WU¬TK«QG¹VK®TGŗV?¬MD¶Z[¾MGĀUK»ZK²QO½NXøJZĮHP³KV½J[¼ESĄF]Ä@WĘ;VĘ;\·ąš“Ł—«Ņ”¬Õ™ Ī£„Ź„±Ė”­Ų¤«ŃŖ«Ł¬¤Ņ¦›ŃƚŻ¬ ×«¦×¦§Ū›«Źžøŗ®Ę ²Ą§¾ČŖ¹Ī±¾ÅŖĄĘ£ĘĖØĮĶø¹Ē½¼½¾·ø®²¼½µ»½Ā²¼Č³ÄÄĄĶ·ĀĢ»ĄĒ½ĄĀĖæĮĄĆĮĆŃĢŠĶÅŠÉČŽĖĖŽĄÓßĖŠŲĢĒäĪæįŌÄÕÖŅŚŃĶŠĪŃÓĖĖŃĖŠŃŅĘÖĒÄŲĖÓŁÄŃŽŹŁčÉŪņ½į÷ĆŪīÄćö½ėõ¶čé“ŚįĮåŻøįį¾ÜŲ»Ž×ÆÓĖ³ŅĘøŹÉ³ĻŃ°ĶČ£ĒĶĘ֙Č׏ĪʖŁÅŒŌĀ•ĢŏŠŹ–Ļ¾ĢȊŚĻƒäÉ~ŻĘxŻĘzč׃ćÖ~ßą…ŁÜŁßˆŃŪŒŃĖŽĪבĻׅĪÕxÓŲyŁĻŁŌzŽŲnߌmŌānŁŲmŁŃfčÓpŚÕmŻÉjčĀ_ć¾Oē·Oä¹IŲ²UÓÆVŁŗQā»Kß½MÖČVÓĮPץ@ąĮ>ä¾=šĄ;ńĢEīŅ8ķĢ4źĖ@ļŗDźĄCėÄ4ķÄ9ŻĄ8ܹ?ę“BŻ«RŻ§PŃ²IĖ®SŲ®QŌ¤\ĻµQƵUĻÆLĻ«PĪ²DĵDʶ?Ī·HŅ±RÉŗKĒ±RĻ·KĢ¼GŠÆHŅ¶HĢ®V×æ\ÖĄRŪ±XŃØUŠŸ[Ę OĄ¤YɬTŅS֟SŪ§PÕ®ZŌ“WʱIŹŗLĪ²ZÉ»bÅ“Z»ø^±¹U¹ŖHŗ¬D±ŖAŖØI±­U°®Q­©Q œGØ”Q¦¤J¤—G˜N£‹O¦‹Q£ŽO ŠP°„W®ŒQ¬™Y¦•OؒN¦”\š–Z›”P R™€SœY›ƒU¢€X„‡R›zL zW¤x\”PœqYšmR›oP›rS©oN©lIŸvG¦oLŸaW™]TØfL©jD³n=¶bD²\C»^I“OR½HJøHHæRFĘJG¼EV²SI«XH©TL“LO¾MBŗU9ĄU@·VOæMAÄUAĆVI·ML¼LV³H\³GZ·PTĀKZ¼IUČMTČ@Y½ARŗ9V“°Ł¤ŗŁ‘«Õ‹©×™ŠŸ¤ĶŸ¦Ń®“Õ²¦ĪؤŠ“¤Ō£„Ļ«£Ų©«Ų±¢ŪÆØŠ¬¹Ō¢·É¢»Å«³Ć›ŗĮ”·Š¦ĀĢ©ÄÄؽĄ©ÉĻ°Čɶ»ø³¼ø½ŗ³³¼°¶Ć²¼ĀøøĪ»ĖĒĆæÄŗĻÅÄĆĪĮĀĄĖČĒŠŅĆČĢĢÄŌ×¾ĒŃĄÓŪĢŹ×ŌĆĻŃæŁŃĄąÓŹŁĪ×ŅŹŌÖĪĶŚĪŃŌÜČŠÉĮÓÓŌÕŌ×čČąęĶįźÉßō»ŚóĀŽī¶źõµēńøåėÅŚé“ąįĄįŻ³ŪŪ©äŁ«ŅĒ“ŌĪ·×ĹÉĪ¢ŠÅžÓєŲĪ“ĻѕąŠŒŌĀŠŅĀˆÓʂŌĄ‡ŁÄ‚ßČzŽÉ|äĢnŪŲwķąučŚuÕźzÜā†ßŅ†×уŃבŁÓ‰ĻĪŠÓĶ‡ÓփÜŌsåŚ€ßĻzŚŽjąŠqęā}źŪlčĻuéŹqŻČ[įÅ^ąŹLŽÄIŽĀLÕæTą­RŌ»RęÉXŲæX×ÄIćĄFåĆJåĮJķČIķĖD÷ÉHõČ:ėÕ9ōĀ9öæFä½7īĒ7į·2įĘ?ē¾FęŖKąŖWŽ TŅ­VŅ­LĪž]֝^ŅØPƶ^Į§OĢ³TĻ¶KĻ“MŹ¼BŃ¼IÖ»KŹ±?ĢÆJÕÆ?Ė­FŚØK×Æ?Ś¦BÜ“NŻ²Sß°KĪ¢IĻ„NĶŖNĘ®OŅÆJÕ¦LŁØIĶ­NѱRŶTĀ·RÄ“O¾ŗ^ĒŗSĮ²Zµ»QƲO·©@æ”G¼Æ9°¤?ØŖ<²­FÆ„A² E«–B¢ E®•@ؚQ؉R‹N©•G”‘K„‡Q®’P°ŠD­NؐK„X™ŒU —N›“Y—Š^ ‰`£_ Xœ†\ŸYœ‡Z£ƒM“zV™}UœwZ˜iM’jR¢lU dJ qV”kP£]L“W_£`W iLŖ\M“YT³\O“PQ²RSĀJJ¹DEĀGD·MT·EI²FU¦[O¤GR­BN±MHŗJCŗZ<°_CÄ]<ŹNBĒKEĮTKæO[¶N\ĆLMĀGOĆGPĆDWĒJLĖ:YÄ8Pŗ4\˜²Ž³Ż™²Ō’¢ŠšŖŁ” ŪŖÆŻ­±Ųµ©Ģ³£Š·«Ń®¦Ó¶„Ł“©Ō±ŗȱ¹Ė®øɱ¶ÅØÆĶ¦¹Ė¶ĻžĮÅ”ŗĘ¢»Ä¬ĀħĒĘ«Ģ»ø涽»¼½¾³ŗ½³“Ā³µĢ¹»ČµĀŃĄæĢ¹ĶĄ·ĪĹĻ¼ĮÓÅĶ×ÅĶŌĖĢŅĶĆĶČÄĖĆŌĀĢÖÄĖÖÅŪ×ĢŁĻĪŻŃŠŁĢÉŃĻĶŚŪĮ××ĶŠĖČŅĶĶ×ŌŪēĶÖšĀŻéĆįīĮįń·Śģ·įėµģč¾ģč½ćęøćŪ“ŽŌµįŪÆŻŌŖÜĻÆŲȵÖĘ°ĪĄ“ŅČØįĢ¦ŽÄ’ŻĪ‹×Ź‹ĻĻ’ŠĖŠÖŅÕĒŠŅsŲŅpęŲqä×tåŃtį×vßäuŁāuÕŚnßÕwŅŚŌцŅĢ‹ąĢ€äׂÜŃ€åŠąÓwęĶ{āÕvāŻ|ģŚ{ļßyéŪoŽÜbāŌYźĖ\ąÅWįæTŪĄUŻ¶SŽ»NÜĆHŽĘS×ÉVŚĮIįĀPź¹EåĘ@ėĘHõČN÷ÅBķĖHņŠCźÓ?ķĘCéŹ=å¼9ę¹5ć»Bę°IŽ®NŌ«\Ó¤YŚ \Ó§UĢ®YĪ£QŅ”^ÉŖ]Ī¬_Ć«XŲPÉ·JŠ·@ŠŗDÖ³HŅøDĢ­>Ģ¬AĶ®:׫AÓ­7Ż¦;ŚµGŁ³JÜ®RŲ­IĻ¬RĒ­RŅ«JÕ²HŅ²SŌØNŠ«KÖ«MŃøWÄ·P¼ĆV¼ÄY·ĒO¾¾PĽNøµF³­<³”?­©:·¦9·”:±ž=µ˜Aŗ¢7µ“6ƒ9““B§ŠH¢ŠG ŒE§‡> ’E¦”IŖ”@¦’=¬C””Qž”X’ŒW”“W•T™„_¤Ž]¤‘b£‹dž‹W£ˆO ‰OžŠS“zP–ƒP“zQ”sS—jJsS“lV›hWœ\Y—b\›WY•SY]RØRTÆRU®PT“MM¶KN½DJ½GMÄFL¶MN®HF„KOŖMUÆDG§EI¤GG®NCµMI·Y=“S@¾QD¼QNÉTUÅNZÅSUĄTXĄCJĄ>IÉCPŹIYŹAQĮ4\æ.Xž·Ū ¶ą’³ą—ŖĪ”¤Ö„¦Ó¢²Ō±¦ÓÆ©Õ©°Ķ¢­Ō©®Õ„£Ó§¦Õ«±ĢÆøĆƻŰĄĒ¬»Ä„®æ¦¶½¬Ą¾„“ÉØŗ½”½Ā¬Éʶ¾½ÄĖ®¼ŗ­ŗŹ¶»Ć“µæ²¾ø°¹Ę·æŹ¬¼Ė¶ÄČ®ĆĀøÓĆ¼Ė¾ĒŌĻĢÜÅÅŹŹĀĆĆĘĒŠŹĻĘŅĖĖŅŹĻŲĀŲĢĖÖŅŠŪŅĄŪĖŹŠŠĀČÕĪŚŃĪŽĆĻŪĢŽāĢĻēŹŁčĖŲńæćļ®ćņ³ąė½äįæŽķæß߷䣱ߣµéĪ²ŻŅ³źĢ²ŽÄ­ŅĶ­ŃĖŸŁĶ„ŲʟŁÄ’ŽĀ•ŠŅ‹ÜӈĶŠÖʉѬ}ĶÖÜąqÕßtŽŁsčą|ąä|åŁtŻč}ąįr×āvŃŚ}Ś×~ÓŌƒąÖŽÓ}ÜąˆŌÖ}ā×qį×oßÓpķā{čćzźįwļŪlēÓaÜÖaŚÓWŅŹdŽĆ`Ó¾_įÅRćŗKÖ·Kę·UŪµGéĒGę“Hć¹IäæCćĀLīĆIéŹEēÉMķŃCéĀ@čČJķ½AŻÅDāĮ<ē±JåŗBŚ©DÖ²OŚ­PŽ¬[Ž«OĻ¦SɱQĢ°ZæØgĄ§UĒ²YĒ²RɲKŹ¹PŃæ?×·?Ų±7Ļø?Į”@Ķ„?Ķ«A՞@ŌŖ4Õ­Iß­HÖ·CĢ“LĶ¦QĘ®[ČŖVĘŖFŠœGŹ§IӞAĶØHƵMæøKĄ¶NɳMŶQ»ÄBĮ·?²µB¬­=ŖØ<² ;µ£2°¤<Ā¢:¼„=¼A³œ;§—F°C³–N ‡L©•Dž‹E”ŠF«–;“‘5©’G¦—O„˜K—U””W—“R’`—ƒ[˜_ž‘b“]š™Mœ†WŸŠT‘ˆU‘yWtMyP”rKœmN£aR”^Q–fV `YšZW”Z]¤]Q©cLØTU“QL·MW°QT³OF²OS³UKæOX¼ET°JUøHZ®JW“FY¬NĮ=FĶ:TĮBTĢ;ZĮ6[Ź4Y‘Āט¼Ž±ä˜¦Ū—«ßš°Ö¢“Õ£©Ū”µŁ¢µŅ£“Ļ„ØĖ«³Ń”°Ó¬øÓ·¼ĒÆ·Ä”¼Ģ›²Č“Ä©±æØæ¹°·ŗ©³Ę³¼ŗ«Ęµ»Å­Ćȱ»Ź«¼Ę«½ŗµ³ø¶¼Į²“½³ÄĀ®Č款Ź±ÄĘ·Įŗ¹É¾ĢÖŹŅ׊ĘĖŲæÉĪÄŲŠÅÕÅĪÕĘŲĢĢŃĶŠŲĘŁĻÄŽĘĒÕĀŃĢÅŠŹÕĢ×ĪĆÜĄŌß¾ŌąĢŁėĻŅķÉÜī¹Ść±āēøŻķµåä“ąćøźį¬čß«ļÖŖéĢ«ąŃ§ēĻ©äŹØŁĘ›ŚÄ˜ēĖ”ąĻ ąÉ‘ćĪ’ŁĶ”ÓŌ›ĻĖ‘ĻэÓŅƒŅįƒÕŽŪꇮÜŲį€ŚįzŽßpßģv×ėwŁŻ…Üį‡ÓÕ~Õ׀ŅÕ{ŌŪˆÖē‡ÜīyÖē{åé‚ęąxąäyąŽyēćyļŚqģÕnßŌlŌČdŃ¾cÕ¶hŌ»^Ū»XÖ»SŁ¾XܱLä²JėæLģ“Eå¹HąŗMāĢMäĖQēĻIńĻPģŃHäÄMģĆAęĮ>ćĀAąÄMąøHå­LŁ­?ą“RÕÆXÓ®UŁ¬VŪ¦cĶ®_Ė¹`ĮµcĢ³`ŃØKŹŖDŠøIŌ·DĒµIŹ³IŠ¶:Ā³CĀ¢JÅ”RŅ£IÕ¦EŹØ=Ź¬LÖÆQŃŖCĘ®FĘ­DѧRÄ„IğLęKĀš<Ģ§CĘ­;ĆŖAÉÆ9ŹØ7Ę²F¾·MĆ¾EĄŗ?¶µ4ŗ°3±§1±Ÿ7±œ.·‘/Ā—2“Ÿ<¶:±š=°ŒFƕJ“•D¤š:¤<¦“?£Š?¦ˆ3®…6µ…EŖ‘I©˜GŽN–”X™ŒU•„P›ˆZ“Y‘ƒSKŠ•OŽ”F›M–„L‘zY’yZyUžoWŸeW¤ZRŸ]MšiF”dI™TR™Q[›RZ¦XP®^LŖXM§[TµTJ±MS²URÆ\XµYW±Mb½H\øO^µMW°?\­?R“CM¹EGøDDøOH¾QW“JW±PO·KWĘHNČLNĢHH¾FSĒJWĒ@OĮ1`¼/`Ā6UĢ,P’Ęį•Čą æךøŁ”øŚ™“䄲Ļ”©Ś©³Ī¢¼Ņ›³ĶžØĻ”ÆŠ¬“Ļ¦½Ē®ĄĖ§ŗŹ°æ£µ¹ µ¼¼½©¾½Ŗ»Å³Æ»°Ę²¬ĄøĄæ©»æ“Ćæ®æĄ©Æ¼±Ŗµ©³Ä¤¹Ć©¶»ŖČÄ¢Ā¹Æ潧Ģæ²Ę½¼ÖÉŹÜŠÅĻÓĘĪĻ¹ĻÅĆŽĪĆĖĢČÉĶĪĒĢÉÅĒĻÉČÓÓŅæĒŲĢŅŠĶŅŲĶĒĻÄŌŁĒŚÖÉŪ楣āĄÕŁĀŲą½×č¾ßė½źŻµŻŅ¹äŪ“ėą®éÓŖäÄ°ģɱčČ²įѧéĮ™ąČ£īĒ˜å֞ę֎ęדÓŅŠÓ“ÉыŌĖ‹ŅŲäŻŠēŚ…Ż×‚źēƒēāyėē{äéäęuäć|ŁŪ‚Žā~ĶŽz×ć‰ŃįwŠŻ„Õå}ŅęwÕēsŪźućåxāąpÜęsŽÖnīÕjē×mąĪfįŃ_Ė¾cŌ¼eŁ·^ܳ`Ō³Qć¶QܶNęµTåĮRč½Uõ½FėĮJźŅLšÉKņÖTņĢAįĖLćČDčÄJéĘHćÄ@ąĒKŽ“Kč²Hā“CÖŖIŻ°PŲµTß­VĶµZÉ©dĶ¶`Ĺ`Ģ³^Ė¦SħTĪ²NĀ³NĄ©JŹ®DĢøEĮ¢Hʟ>É«>É«LĻ§@¾ @Š«AÖ«DŌ·HĻøOŹ­@Ņ£KĶ”DĖØEĒ–9ě7ĒŖ?Ā­8Į„>Ē²1Ēµ:Į“;ŗ¼Cŗ¹>Į²@²¾,µµ5·“'·¤/Ɲ4¼›8Ā /µ—,“˜3°œA¶ˆEŗ”K¹š;µ—E¦”9؉B„‡;¤ƒ>²„7ؐ;ƑQŖ‰E™P„’W£ŠV™ƒT™‹V‡V”|Yˆ‘X‡ŽW‘Y’‰L—Y˜wbšt\’uS•jW§mW•eT¢dSXU™cA‘aF›SH„VVØJM£LM³WNÆXNµK\µJKŖRUØWN»_T±]OøLY·GVµSK½JP±HD·AH¼?E·@HÆMV°JO»TRæJYŗFN·GYĖKVĒ?WĀ:ZĒFNŹ@\Ģ>ZĶ/ZÉ4TŃ4QÄŽĀ搻éžæć«ÄŚ©¾ą©¬Ö§ŖĶ§¦Ō ²Öž©Ó£°Ó¤­ŹŖ³Ā­®Ā¬“Ć”µÄ¤±¶Ø«¼©³»«¾Å„ĮĄ©Å“­»“®½¹øČ­·Å§ŗÄŖ±Ģ¢²Źž“¼š²½§³Ä”°¼”ŗƟĮ¾§æ½­Ēæ¦Ę½®Š¾øĶĒ³ŁŹ¾ĻŃĄÕĻøŠĖĮÖÉČŁŅÅĪÉÉŃČÕŅĆŠĖĶĢŌĪÉŁŃĖŅĻĻĶŃÅĖÓČŃŪĄŲÜĆŽćøŁą½ąŲĄŚÖĮįā¶ßŽŗįÓ½éŅŗģÓ±ģŃ®čŌ®ģĒ¦öŹ®šŅ®õĪ©ķÉ”öĆ¢šĶ’öĖ™īיćĻ™ŲŅŽĪĖÓՐÜŲ™ŪŻ“ģēķįēč‡ģā€šå|ōäƒčįéč~ąézŻßyÕŲ}Īą‡Ēė‚Ķå€Ļę|Ųėzęå}åąoāčqģćsķįpįßoéÜgźĶiāĖfćÄZßĻUÖŹ_ÜĀbŌæ]Ū½\ŽŗXå»ZßĮRź·[š·Xķ¼Q÷¾QóÉNīĶWźČTōŠQåŚAēÓBåŃDšĢLļĻLķĶHēæ?źĮDŻ¹<ąÆ?å²<ę°Dč·NŻ·Yą¶YÓ§`Ź²cʬaĢµRĀ­QÅÆLĘ²GĶ©DŹ©F¼²K»©D½Ø9»¢;ŗ­DĀ§CČ„DĄØ@Å„AĻ±FŠ³>Ņ“FŃ·BČ©CĆ«>Ē¤5Ź¦8Ğ<ŗ¦@¼®7Ā©5Ē­7Ƶ,æ®0øø5ø°6ŗÆ.²¹-¶µ/¼°+¹Ŗ/Ŝ,¾Ÿ'ƛ2æ 6ø˜2°˜A·B¼•=¹’>¬”5Ɗ;«6؋B©…Bµ†A“ŒE“H°GؚR¢™R„‘N”HŸ‰N™‚R†Z„ŠSˆW•b™[Ÿ‘U™…Y”{\“zWŸnNhTi[•_T’`G—\I›]G™VF›SG§MR¬P\³K[ÆEX¬I\ÆDV¦HS°M`µZ[½RM³[J­NPµINµLD¾AF²@E³BOµ=O¬>ZØL^²L[±DX½JQŗNTĆHUĮ@P¼>ZĆE`ĘC`Č=^Ļ4ZŹ)`Ī+[¹å”ĆŠ’øŲž“ā™¹ß«·Š§­Ķ­¬Õ©­Ķœ®Ī™·Ś¦¬Ļ«Ī£ÆĶ”²É“µÄ¬­ŗ©ø½„¬Ä©»µ æĄž¶²§²® »“±Ć±±Ä³³¼¦¼½«“Ĥ²Į™Ø½¤«æ¦ØĮ­²Į”æÄ£¼¾£ŗ³¶Ī·®Å»»Ņ¾ĀÕ»»ŚÉĄŠČ¾ŻŠ­ÓĢĄŪĮČŃĘ»ĖĄČÕŹŹĶŠæŹŠæףĮŃĻĪČ×ĪŅŹÉĮŁÄÅŁøŃßøĖå½ŪąøŻį¼ŌąČÕÖµŌī¶ąŁµėÉ»äĶ·ļĢ«åĻ°īĶ«ņѦ÷ĪøėĖ®ńɟšĘ™÷Ą˜éĻ™ē܌ŽŠŽÖŅŽĶˆŃՇÖĢ„ŽÜ…ŽŅ‹źŽ€ąŚwęč{伆ńī†ęę|ŽŁ„ŪŁxåęˆÜ܂Ķę…×é‡Ēā†Łč{Óņ{Žéx×ćvŽājīįiéånŁŪiŪŲeßŲoęĖkߏ]ÖŅ[ŚÅgŪČcѶW×¼WÕ»`ć¶Ué¾Rģ¾NéµTģ¾UšĮMśĒ^ļŠ`öĘSļŃMģĘBóĖKóĶ@īĪCōÉEėæGē¾MåøEŽĆ@ܳ>ä°Hįµ<Ł®EŁŗ\Ó±`Ō­YŌ«^Č„eÉ”aĮ SʦQ»·CĀ¬HĒžG½«G°£<·”Dæ?¾¤9Ā­C¾¬H»¤E»­<ÅŖJŬ>ų=Ź©KȬCĀÆAø¢2¾ <Ē™6¾„5Ŷ5Į±:Ť8Ė§1Č­2½¤:Ƨ9“«0³“*Ć·$øø&¹¤.Āš)É£1Ź™8»Ÿ=·–<æœD¹šH­‹@ŖŽC«‚>ƄH¢‚9«Š>«‰IÆ}F®‘H³ŽL¤–F­›UšP¢‹N’U™„HR‹…\’Q†O“Y“‡\š€e“dœ}WœpUnbØt_›o_œZX—[[˜`P›UI™PI¤KQ¦HZ¦U_¬DdØJY¦IS¦U`£UU¦W^©S[³YV°XHÆ\FØHJÆCC¶@@°:H·?L±@PµJS­EOÆKYµH_³ATÄB]ŗLZĄDZ³>VÄ:ZĄB\Š1UĒ3SŃ(SĻ2YÆŅ•¹Ķ’·ŻŸµŽ„±ąŸÆŃ¢ÆŲ£“ÖØ«Ųœ«Ō¦±Š„­Ń”³É¦»ŹØ·Ń«“Ȧ½Į”“ț²·¤¼·Ÿ·»¦°³”½µ¤ŗØ«¶²Ø²­¶»«½Äƽ¾ž·¹ž³ĮŖ§ŗ¤©¼±µ¼²¶ÄƲŗ­Į¾ŗĖ°»Ļ²ČŅ½ÄĢĒŗÓæ³ŪĮ«ÓɲŹĒÆŅŗ¼ŌĀ¼ŹĒ»ŃĢ³ŲŠ¼ŅŅÉŹŌÄÅĻĖĪŌČĢŲĘČŅŗĻŌ¶Ģć»Čß®Ń×®Ėį¹ŠŚ¾Ūē¶Ųķ¾ŪŚ·ßŠ°ÜÖ©čÕ­äĶ²äŅ§äŲ©ōŌ“ļÕ¤ńŹ„ķĢ¢šÄåēåŅ‰āŠ’āĉąÅ„ą×āÖw×É}ćŹzāÖwäÜ|ąŻzį߃āģ}åŻ|äŚß߆ŪāŠŃą~Šį{Īč…Ńš†ąōˆŻź„ŽļzŚćréäxęäpŽäsāÓqįŌpŪŁjŻŽ\ÖÓ^ŠĶdĪĖ]ĖĆ`×½WѵSŲ½`į²]ļµ[ļ­Xš²Mż·MųŗOó½YšĮašÉYćĢDēŌHńĖBšĪCļĪHäĶKź»Pįµ@ę¼=č·7ć½=ŽøDä¬CŁ­QŅÆUĪÆ^×¹_Ō³lĖ¦hĪŖ`Ē¤^ø©O·®L¹ØH· Nø CÆ©C¶ H¾”?“§Bŗ«E¹®B¼£Bæ±DÅÆE»°F·¤>³­<½¦IĄ®9·¦7¹«=Ā„Aø±7æ¬9½¤.Į«1æŖ8Ħ-½§6µØ6ŗ£2ĄØ5ŹŖ$Ć°"ÉØ+¾§5»ž2Ő6Ķ–2Ę=ø–9³’>ؑ5§‹;¦†E£‚D ‹F¦…?Æ~C³…C±…NؐO¬•Z„—S“Y‘•V—ƒS”~GŽT—ŒX—’V•–QŒ†[„[Žz[‡wa—pbžtaq`”waØwfŸf^¦bW£gQ™V\šS[œQ^®SX¬Qe«Id©K_žS[„][°ZW©a]¬Z[¬^U·XQ°ZF¦UE­HI¤FB„=E²BL³;S²DL¹DK³LS±MX·BZ½FQæDT»4X¹5Rŗ?[Ē9`É.fĮ0\Č-^É*Z–¼Ķ•·Ō¦ŖÕ”­Ł›¦Ó”±Ė¤±ÓŸ²Ł£°Ń”±ĖŸ±Ļœ³æ£±Ę§¼Ķ¬³ĒÆĀĖ­¾Š§ĀÕ£³Ė£½·¦¹“ر· µ±£¾³„¼„ŗ¤®µ¤²·¤·Į¶¾©¶ŗ§§Āš¬“¢½²„¶°¶½¹³Įµ»Ę±æÉ½ÅŹ¶æĖ²¶Öø°Š¾°ĪĀøŃ¹®Ó°ĆŚ¶³Ģ»ĄŹÅĆĒĘŗĪÖæŠŃÉĢßĖŃāĶĖÖÅĶįĀŃŪµĻį¼ŃÖ·ĢÜ®ĶĻ®ŽÓæŁē±ŁźŗćéµēÜØāŲ§ÜŅ«ąŁ­ėŻÆćĪ„čŲ²ōÕ¤äĪ ēŅŸķĪ£éĮźĘ‹čÅę¾†ŻÉęĖzÜĖwÜÅtęÓ|ŲŲtŪÜxäŻsąąąā‚久䣆×į‚ŃąwßįxĢéÓē×éwāå}ꚈźįęÜläāpźßjįćpŽŪlÖÓhŁąjŚĻdŅŃYŃĢhÉĖZÖĻeŲĮ[ę½Vą±aš»_ų½U÷“Rč»Uł»V÷ĆRł¼OļĘ[éĮTįĪ?åĢ<čŃ>éĪDįŠGēÄ>ęæBā»FŪ¶BźŗEܼ?ė“Dį®B׫DŁ«SÓ¹OŲÄXĻ¬`ħjĶ«fĒ£bĄ¦Z³¢L“©QŖ•W©§DŖ¦L¬›A°¢D½©G¼«KĮØMĀ”<ű<Ē©7µ­G°§<Ą£I·¬O½§?®°6øØ1“¦B“Ÿ2Ć¢4½„.¾«2²§0±³-·±:°«:Æ«:µŸ3¼Ø1Ē£ Ä­&æ¤5ĕ1Ā–?½CĒA¼’Bŗ‹=²‘A”‘2¬ƒB©ŠE©‰I«‡G°‹?­‰?؄G­’T¤—L›”QQŒNŽ‰V~G’ŠL‹‰WP•S”‹IŽMŒy[‘€[Št^£rd„te¤w_§z`Ÿe^Øb\›^a„W_­Sa²Nd­O^„Wd”Vh¦V] [_„RVŸO^®Vb­[\±PL£RH°SO¢YD£G@ØGA²HG“QPµDF±GJÆDQµAR¶JSĀ;V¶=QĮGPÄø¢G»Ŗ=ø®5¹­DµØF±Æ@¶­E®Ø9±®9ŗ«?³›5¹£7æ©)¶©)·­.®°9®¹2°¶4µ³1¹«+µ¢1¹ 5Ę„)¾Ŗ-½3æž1ɒ=ʗ<½‹9Į‰;ø‡=°6¬Ž:؋B§‰@„‰H³ŠG­ˆL°‹C؈E¦„Q§I˜ŽN–PŠ”F“Mˆ†S‘†NŽŒX—I‘˜JŒ”HŽ†N„‰SŠ~ZŒ}X›v`¤zdœ{c„sZ©t^¢sf£eb£df®`d°ZhÆTa¤Oj¢Wf¦^b£\aœWZS`”QY©TW§HPžHO§JF¢PK„IF¤KC„UHÆOGŖUO¢SN¤SR§E^øHe¼;aÅä·@ę¾Jķ¼Bć¹=Ž¹JܱBŁ“EŠ¬OÖµQÉÆUĖ²aÓ“bĖ·[æ“Z¼ŖW±„`¼”_±©HƤ=±ŸI¦–JƔ@æ•M¼–H®¤A·¦=½«;Æ©5³”7°”A®±=¹¬@¹­E­Ø9ŗš-Ā2Į®(ŗØ.·°2½ø&¬µ3±²/Ƴ-µ§+²£3¼¦0Ē¤)æ¢2Ź“4Ź3Ȗ;Ƒ<ŗ‰9ŗ€:»€:µ€<²ˆA°8§ŠG°B³€D؍I”K§‰O£‹B™‡B”ŒG”M˜CŠ‡J‡…U„‘X’T™R™>”K‡EŒ‡I‘z^|\v\“„l—‚h„|b„{]£tc©i^„ajž\o§TcÆ^g®Yc§[b¦[Y®^a \cœ]]©YP£[L¤RN£CL›AZ›D\ŖNO¤OP¬XI HM¢FM™CSŸDX§EYÆHV«Ea¾GRĮ>cæ:S¾)U¹.S»(]¶3^³)S½-aĢ$YŸ¶ÕŸµŃ£¦Ń §×¦¦Ę„­Å”²Ē™æÉØĄ»§¼½§Ąøž½¾¤µĄ¦¼ČŖ·Ä©·Ē„æŹ­·Š§¬Čž±Źž“ČØ·»Ø®“¦Æ“¦Ŗ·¤³Ø”»¬¦±¢¦³£¦­œ²Æ”¶¹œ²·¦·¶­²­¶¼µ­²Āµ³½·¶¼¼»»²»±ŗÄ­»Ķ²¶Ļ¶³Ė½µĘĹÄæĀĶ³¾Čµ»Å½¹Ó澊ČÄĢŅĖ×ĶĮÖÕĮŠÖ³ĶܶÕŃ¹ŚŪ³ąÓ¤×Ö¦ŻŁ³ßé«åéŖŚéØßÜ„ėå§čܛņŲ¤šÖ°ķĶ„ąŅ”ę֔ėĻ”īĪģדāĶéĖ”ńĪˆéæŠē¹ė½…īČtšĢtā×zŽŪyŌ怦ŻwąčpįčxÜė|čā~ŁķŌéwŃīƒßåŠćč€å恣ģŪåˆÖń‰Łķ{ÓźtŽčt߯c×ÓaŚąfŠÜ^ŲŌ`ÕŠcŁĒ]āÉeėĻhāÅZā¶Wé·TéĮSŲĆRāĀZź»`åĀ_ŚÅ]ąĀ[ŻæXį¾OęĖFėČ@ėÓAåĆGčµMź±Cā²Hē®CŽ¬@åøDč»JŲæR×ŗLŅøIĪ·QŲ®UÖ­LĶ„RĢŖYĖ·YĒ¹RĀ«_¾„\æŖTæ¤UĄ©F¹Bŗ¤N­ J¹ J·I°šK¬ >·Ÿ;³Ÿ9“œ,µ©0²Ø<¶¦9Æ°8±ØA½ž0¹£+ʤ3Ā„.ĮØ2ĀÆ0ø°+²²%²Æ!Æ«)ÆŖ)»”9ø™8ŗ˜1¾˜/Ȑ<Ė”BċAŗ…@½†4ø{:½}CĮyK¶Dø@©AƂ<µ€<­C”Gš{<ž„?–ˆ>™LŒ…G…ŠLƒ†QˆRŠ–EŽ“I—C‹”BœA‹•F••F˜…R™†\€`wn–~jœ~a yfØvd©lg£gfš\j­\l±Xp±Xm§\f©YYØ`W¦cUŖ][°[O©VL«WS LU™?WA^žC`ØSWŖYV”PQ›C]ž@[EV­CZÆ>]«=V“AZ¾F`Į>dæ2X“9Yµ1Z“&V“)^³(a¼%e›ÆŚ”ŖĖœ²Łš®Ū”µ×žØŠ¤½Ģ©ĆɟøÉØ“Į¤±æ”ĮɟĆĀœÄĶ«±Ä °ĆŸ“Ģ¢²É—¶Ļ»Ęœ·Ć ²¼ ²¶¤«øŖ·«”ø¢½«Ŗ±ž©³¢Ø¶Ŗ²¹„·¼˜»«©²²Ø¹¹ž»·¦Æ“±ŗø¼°¼²¾²°ø»¶Ā¼±Įæ“ææŗĮ¼·Ąŗ“ŹÄ³Ć¹°Ć“¶ČĒ¾ĢÉŗÓÅÄÜĘøŽĖµÜÖ²ŻŌµŪ׶ēß°ÜÖŖåŁ ŻĪ„ąÕøä×®īėØąį¢čÜ«äįžāŪ”ęß õŲ ē׫ė՝ēÓ¦ģߝśÕ–óŪ”ģȍłŠ…ė¾ƒźĀŠļÄ~ü¼{š¾ļĒ{ć×uļŚoęß|ŌŽu׎zÜčŪ܂ēėxŚź}ĻŻ‹ąęˆį掣ź‹Üįƒßāé鎣ē…ŲćrŌč~ßćpÜād×ÖYĻÓeÖŹiÜÓdćŹYęĻhēĒbŪĪcäĮ^Ž¼ZŻ¾ZßĆWĶÅOŌ¾Tęø^ŲĄVŁĘeÖĘVŽ½SÖÄKŻĘRŻĖPåŅPčÄCܬRܬFŚ²N×ÆCāŖDŁŗMę¾Jē¾CŪĄAŅøTŃ¼RŁŗEß½HŅ©MÕ§TŌ±MĘ½XĀŖQŹÆOȟIŗ«BÄØ@½¤>·¢EƦDŗ™;Ƌ<»—5°ž<¹š3©£?µ™0ŗž1“¢+²®4ŗŖAø„;°°:½Ŗ3¶š$¶š(æ§.Ź£0ø£$»„/±«)“©'³›6¼Ÿ4¹ >ś/Ɣ7ĄŽ<Ȏ3đB½Ž=øˆ8ʃ<µ|<Ą‰>­~F¹Œ>­„G¦Œ7²†9²†>¦†J›Œ<–„G—‘N‘ŽQ‡”S…WŠO„›N‚ŒKQ˜HŒG”’F†DŒ“N”ƒX’‰P `ž}k€h‘vd¤zd§vlœjsšfkXsœai [i£Qe¬]]¢][¢cR ]a«Ze¢X_©XH—XMœVVŸCV˜@h¢@ZŸJb¦N^„DX£>Q¤;[Ÿ>Y¬I]±BU±?R¬B[­?b±?n¶9`­1Z²,Y­6k±0nµ/d»,m’©É˜«Õ¢«Ņœ“Ż„³Ś“ם½Ī©æĢ£“Ź”“¾¤¶Ć™¹Āž²æŸ»É”ĄŠŸ¶É”ÆĒ–øўµŌ¼ĖŸ»ŹŸ°Ķ¦«ĘŸµ¼¦Æ®·«¢¼«£·Ø£ŗ²°°«·­¤»“¤°²™®¬®¶™³µ¤­°¦°Æ²»·°ø³¹®¾Ą“ŗø·æ¹½¾·ĘĀ®Ē¾ŖŹÄ²½½±ĆĮ¶ĆÄŗČČ²ÕĀ“ŻĄ°ŲĶ±ŲŚ­ąŪ¬čŁ“éį®åŌ³ļŌ©čŁ±įÕ®ßקęįŖćÜ­ßå„ķćØėėšõč‘īܗģŽ™źį£üąŸžįŸūį“žŅ‡’Ē„’Ę’Š|śÉƒõ¾zżÄzóÄzļĆ}ņĶqšŅtāŪxßÖxāązŻįxćŻ}×ā}ŲéŒÖŽŽŚź†ŪķŒŪź‰Żģ‹Üē’åźŠŪį†ŽŚxåįyŽßqåŪeŪŅ`āÉ]ŲÉb×Ē]å¾[āĀ`āÄ\äĘgßĘbÖæ[ŚÅ[ßĢNŅĀRŻĄWܼ[Ś»YŌĄbŚĆ`ŅÅWŅĢOŌĪWÖĮVįÄNį¶X×°PŁ°\į°Vé³Mß“Mā²Iā²Iä±JܹFÕ±EŃŗMÜæSŽ¾KܱQŁ²UŁ“MĖŗVŹµWĪÆPĒ©B½§?Ć­7·”>¶„1æ2¹‘.³”;±;µ‘5²•7­ž4¼š(¹ ,°«3±«4®­8¶Æ5·”.ŗ¤0¾Ŗ1»Ÿ#¼£$ĀØ"ĀØ!½œ0¹œ/¶ ,½„8µ›<“£<Ą<Ē•?¾“5æ‘=ĄŒ5Ą|8æ}DƂH½@ŗ€<µŠF¹‚<°„<¤„G©‰@Ÿˆ8„ˆ?œ•@™E–P‘“MŒ™PŽ—Y‘¢P‚›S˜S‰”K†MŒF’ŠM‘”FO™‰Mš`Ÿ‰d›zo—vi’x_šwe¤taimž\n”_s—UrŸOn£Pr¦\d¬^]§[[¦VeŖL^”FSžPT LJ•NQAR”Caž@b›BašAb HW§F_©BV¬E`ŖA]±7e¦>_£9g­El©>h¬>s³@t°8f¹;o“5q±.mŗ#lš¢ĖŽ³ĢŖĶ˜µŠš­Ü–»ŁØ±Š¦­ĪŸø»›§¹ŸøĮ£¾»—µĘž®É£­Ć¢­Į”ŖĮ™¶ÉŸ°¾›¶Ė™øș¶Į™Æø™“°§²»¢½±­¹¦¦ŗ§³°§±®­ø¦²¹© ŗ¶œ¬¬Ø³±Ÿ²±³±±°«¦¹²§¬Ćµ¶»­µĄ®¼ø·±Äæ²Éµ·¾½Æ»Ć·ĮĀ®¶Į°ĮŹ³ÖĢ²ąŹ¹ŚĆ³ÜÓ“āѱŪܬŁß­ēŠ°äÕÆźÜ©öß«ęĶ§ąÖ¢ķŲ£źŲčŁŸėܚēęœäāēŠčą£ėč£ķęœėŪœ÷ŪųŠ‹ņĒŠ’æ~ų¼ƒłæóŹ€öĖöĖ{ūĘyčĖwąÖxāĖqēŠvćÖsßÖsāįxÜā‹ąéˆāģßé|äó€čņÜé€ä釱åįäxäŁ{ęŁkēŻfįÜgŲÓcÖĶkŁÕlÜĢ[čĆUķĒZįĶUŲĒT×ÉV×Į^Õæ]Śŗ]Õø^ć¹\Ł¹XܾVŻĮdŠÅTŅĀZÜĄZ×ĢUŁŹKÜæUŁøJå­RŽøNč¬Nź¬Rģ¹Iė²Mē»Iå·OŌĄMŅĆUŁ·YŠ½OĻµJŅ¬KÉ®YɧWŠ“YɶVÅ®IŹ®C»¢E“¬D¼ž<²¤:¾(·“.²—C©šB·˜9­›8°š@³¤6«/®„0ø¬)²§2°'²¤4¼”3¶¬1¹ŗ¤$¹¤"“ž,ŗš2½ž6²Ÿ7¾ 9æ¢>ƛ4¼—FĮ”@ŗ–8¶Š5µ8°ƒ>ą@“8³F½†H«„@·B¤5¢}@Ÿ„DƐ;§…C¤•DˆC•“O•RŽ•[’ŽQ†–V†™J–M“—U‚‹H‹N‘T•ŽM•‰IˆO•‘[ž…Y–„VoZ”th–hcbm•gr—arŽOežYl—HlŸMu®fj«cf¤Rf¢Tf¬]g¢T[ŖSV£T]O[“FašQg Jf™HaØDW CW¤BM¤HZØCf©NW­?a®?[³ź±Dź²Lē¼NŪĮLŲ¼VŽ¹_Ś¼VŅ·QĶ«GŌžDÉ¢QĆ„OČŖXĘ¢UÉØH·¬I“®B½ 8¶™9²˜0¶•+µ*©‘:°–7ƞ@µ¢8Æ¢>Ŗž7„œ2²Ø3µØ,±Ŗ)·œ$ĆŖ,½«.¾¬*ø &±—ø˜ “¢*»„*ø¢,½¢4·”2¼™5ĀŽ?Ɛ@·‡B·Œ9²†0®ƒ/ŗ†,·”8·“9¶Œ=¬‡>°‡>¬ˆ5¦{6­5„Š6؎EؑFšŽD’Œ<Œ›O˜R’“L‘‘QšX‡›O•U‹ŒP…V‹ŽN”šI’—S†šU‡“LŒŽFŒP”sO“p\pX‘aa`]˜\gœ_k—PaœO`œMp”]rØ`o”_d£UiŸab£`bŖ[a„TVŸTTšU[’Ud˜P[¢OS¢N[©PK„LG£OPœNb”KcŸIa£LV«E\Æ>f«Hn²Cnø>l·@`µ6dŗ=jø2d½%dŗ!p¤É†„Ė‰¬Ļ†«Ć—ؾ ­ĮœÆĄœ¢¾›«·¤Ŗ³—ØĮ„¬ŗ ¦Ä¤Ä­æ‘­»Ÿ±µ™¶¾£ØĆ ¬» «æš¤¶¢„«¢”¤ž©®²Æ“±„¶°£¶¹±±Į¬»¶ ©½›Ø¹«©µØ¤³§¬“›®·¦¬æ£©Įž¶·ž°Ē£ŗʬ“¹µ“Ź¹ĀĘ»ĄĘ¹¼¼³¼µČ·ĒɳČĘŖ×Ī®ęĢ¬ŪŌ³ŽŹ£čÖ²ßĶ“ģŚ²īџåŅ¦ųŽžéį”õŠ„éĶœēŽ”ķ֒čŲ–÷ܔśÜõŻ’šÕ‘åӚēŽ›įŅćŌźĪėʗņĔņƒ’ĀśČ‡’Ą~ķĄė½‰óĆčĢčÓxéÅlėĻpźŌwŁÕkéŃtߎ€ßŪ|źš|ęéxāģsŽęzÜź|ēé{āģsāēxŽķfįŽjėābāįpŻėfÓŚdÜ×pŪĶ_įŹdćŠ]ćĄUßĀLÜŅWßÄFäĮHē·NęĀPŻŗTéÅQź¾Zå¹\ę½Wå®TŲ®YŚ¬SÜ°Hą®KŽµEé¶Qģ®?Ž±Eź©=ī±;é¾JęŗRä³QąĮQć“OŲ³WŅ»KĪ³KŅ¦RĶ¦OʧT¹±RĀÆK¹©RŗÆLø¦:ŗ©0³˜-¶Ÿ.ƛ+؛%Ŗš0ŖŸ=¢˜AŸœG¦”H­¤7±•?Ø¢3ؤ0“˜)¼ž*ø¢-²¦-½¦/±£!¶”-³š²„·¬(®§'¾¦+¹Ÿ3½˜0“™<¹‘?¹BƎ3Ɓ8µ…%©–.«—-¶™/­–=“†1ŗŠ:¦…4¢„1£3«–,š—C„ŠD•‘C’Š=ŽŽL––WŽ“GŽ”H’”H”O…‘N‹ŠT‰ŽK‘“N‰ŒK•ˆJˆ‰KŒ“Qƒ‡Yˆ†Z“v\‘eXˆaY™WY•ab ]j˜XešW\šJl Pl˜]j©ed©dp™Zj¤Vf£XZ¢MU®V]ŖQP”ZZžNZ”NhŸS^§I^¬KX«PK”FMØO\˜MfBmØE]«HY°OZ©Fo¶Pf¾>e“?]·4jæ2b»7f»#l»&s~«Ź‚¢Ć|§Į…”ƖŸÅ™„ø¢«¶š”ĄŸœ¹ ž¶Øžŗ£¬¾£¤Ę—«¾Œ¦ČÆĮ“®·¤¶·©®½Ø¬¾¬«°¢Ŗ«¦¢Ø¤§­¤®µ¤§±®¢µ³¬“¾°¹·„¶·±ŗ›¬¾—®³ž„·˜ÆøžŖ“œŖ¹²Ć„“» »½ ·ĒسĪ„±Å®·¼³¹Įµ¾ø¾µ»¾²ÄĶ¬ĢĶ§ÕĪ«ŽĻ°ÜĻÆŽŹ¦šŅ­šĶ°ėџ÷ŽŸźä›ėܙėĻ“ėŠ›čӕņә÷ŽœųŪšļՌõ܎ļŻļŅ”ķĪ–įŅ”źĪ›źČ”āĢŒęĒéȚõ»”ł»Ž’ƈ’ĒūĮ‡ūɂļČyńĖxćĢqÜĒuęĶuß×{ŪŁoęÜoäŌ}éŁrļäqģŽyźįwāŪ‚ąä|éŽtęąxŪģnįčoćéiåęcįķbÜédÖźnÖŻfŽ×hįŲcāÕYåĖXŻÖVßĻJŽĄKćĄHķ¼?éĮGźČVģĀUļŗMź“Tę»Vć°\ź¤Vę„Xå¬WŁÆL×°MŽ¬Kī«PģµEģ¹Dä±@ź“KßøEćøEŻ½OįæQŽ¹ZŲ¹TŪ¶NɧSʧJŤM“®L·¦I¶©M±«E¶¦6¶ +»˜,³£!؝#¢•-ؒ/©ž6šŸA—š9” Aؙ?­;§.§›1°£-°›+“˜!µ #Æ”)Ɩ&±˜"«—&©”*±”#µ˜'²ž3®Ÿ2·–<¾Œ>µ7»-°‰4°Š)°Ž"ø“Ɣ#¹™%±•,ø4·Œ5²†7Ŗ…7 †1„’3 ˜9š“=œšB›L„”EšLšD‘ŸM–ŸRŽ™K““U—UŽY‡”T…“R‹ˆRŒO‰‹T‹R…ƒZ{]ˆjbij^b—^f˜WkX`”Nd’[nŸWg agž`i—`s]mž^^¬M\­W`°RU³ZO±SXŸSfžTd S`ŸLU§QIÆWK¬ULŖEY@gžAk¦Bg„G_²D[²QbµIa½I]·C]½ŌŗGŻÅIĪ»JŽ²RŁ©TĶ“Jɱ>æŖJ¾ŖF±¤J­ÆC¶§G¶žF·¢@±„,­“.·–*؝/­.³’7ؗCš˜GŸ„:„„C ”5«£:«Ŗ;–©6œ™3®’)²œ(Ƥ(²–)¦—+§—* +­š%°’!­Ÿ#¬ž3ƙ7®›0¬˜.µ6Ŗ†*Ŗ‘$°Š+°‘-ø’0­Ž%Ŗ–!Ŗ•,·‹4²‚3©ˆ=©5£†4 “:©‹@ CŸ•;œ—DŸŒPؖJ¢ŸO –Q‹—T•‘JIŠ˜V‹˜Iˆ‘Q‚ŠWŒ‹RŒ\Ž‚LŽ‚S“uZu\ih•o`‹`o•\jQu˜Ww’]i‘Zm”]k’`e¦]mŸ^l¢OcžTiØOd¬Q\­R^²PU¬Oa£QXžY^ Za„QS¤]U©SI«RV±Q^£HcšDf„Bh¬FjÆIe¹Fh“?fÄAbĮGcĄDl·.h±$mĮ%hĘ$dx¦Ī}”Ļ€•¼˜¶„£·§¾†¢»“’µ›”µ’£Ć…£æ‰œĮŠ˜»”›“¬»”«½ ¦æŸ”¶£©½¤”ț¢¾ž¤²¤„¹¤”·Ø£“«ž«¦ µ°Æ¶¤¢·Ø “©„“øÆ¼œ©Ą•§Ź“¢Č˜§Ī–ŖʝøƦ³½¬½½³²Ź²·Ęø»¹®øŹ¶ÆÉ·Ŗ½Āŗ»½ŗ¹¼»Å½ÆĻĢøįĢ“įĮØŻĒ„ėĻ¦ōĪ°ēĻ„ėÓ¤éŅ ęŹķ՝īŌ–éɘźĒŽå׊ģ֎÷ɑņĢ“ōȓėŃåŠīуéʀóŹ‹õŹ|éæ}ōĄó»‚łĒ|÷Ē€š¼…łĀó¾wõ½råĢyŪŹ}ŚŌtŻŌ{ēŲrķÖzįŌ€įÖzäÕxšÓyīŚvóźmķåfåŌnŻŅfÖŚfąßlŲÕnŪŌhŌ×bŌŲiÜć^åÖbįÖZ×Ö^ŁĶYäŹ^äČYęÓ^įĢYŁĖKßÄHį¼Fķ·EēŗVéµWę±Mč½Tå¶WķµXķ°SŽµRč“Mä¶TėÆSģµRāµTŻ„Dć£CŁ«HåØLćÆFŚ°LÓ¼TŅ¼SĪ®KÉ“LŹ©Eɧ>ø£=²©H²¢B¬›E®£M½«AĀØ9¾‘(°‹#»‹%·Œ-¾“=“ <¦™9›A™–D ™5”ž=¢„9—«4•©0™2™,£ž)¢Ÿ1œ”/Ÿ™$œ™# 1œ”$„(Ŗ™2§’2žŒ/¦#²‡!ŗŽ#¹•©‹"µ‚'µˆ-²†-ƌ+¤'Ŗ%±Œ%§ˆ+ž1¦ˆ> “?§A„”E”“>¤œD¦™D§‹C”ŽM„V£’Rš™PU†ŒXŠJ‰V‰ƒR‡‰P‡€]…zUƒzOƒsT‘rdil“of”dl’goŠau’Rs•Qx”_w—ar‹YdœdmŸ]g›R`›QfžQe \l›Qd§VY°OU®O[­\^ŸaZ£eXØ`X§WS®SO­STÆPa¦Ba¦Bc²Ea±HgÆOl“Fc¾>eŗ;nĀ9eø;j²6v·)sµ'oĀ d…œĘƒ½¦½•¤¾…šµ”¼‡™¼ƒ›°–½Œ£Ąƒ”Ą€žµŽ—¶‘–Ąš¤Ā¦·•”Ą”¤¹ž æ¦¬Ė•£Å¬®š®­œ­±¬”¶„Ÿ±­«„Ŗ°ž§„œ—³Æ”­±ž«¶—£»£Ø杧Źœ¦Ķ—®Ī—¶Ė¢³»„¶½Æ¾Ć«±É§“Ā¶“¾¬“Ę“®Ė¶®Į¾·¾¼¶ÄŹĢĢØŽĖ¬įŠ¢ēĢšįĒ õŌ¬ōĖ éŅ§éĶ—ź¾¦ąŃ£šŹŸāɚōĖŒńŠ•éӓåĀńƒšŠ—ćŌŒģŹˆņŃ}åĢ…ōĪ†łĪˆģÅńĀsłÄv󹁒Čtł¼€ł¼qč»z÷ĒzéÉ}ŻŠxÓŅ€ÜŪxŚŚsļ×nāÕpģŲyźĻyķÜnōåvēßjģāsįŚjāŽ`ŅŚaŻĻkÕÜ^ÖŅjŚĪgŅÕ^ŽÜ]åÓVźŚ[äĻXäŠTäĖNåŠ[ēĖLŻĢUęĘSŁ¼IåĄPąĆJīŗLī°TčæHņ¼JēĄSšĮVļ¹\äØVā®KėØLßŖVć“Lģ“Fę§Ją”Jß²P×·Uē³GŚÆVŠ¾XĒ“XĘÆKʵAĘŖCÄ“=ŗ“@®­Jø¬@®¤?ÆŖR³§>Ē£3³“5ŗ‹%Ŗ—)Ŗ‹6®˜=Ŗ”1ؚ;”™A ¢5¤ 4–§7”Ŗ5’®2Ž¤5ŽŖ.ž 0›£(¢£0Ÿ£$›™#˜’3”‘,¢›3•%¬’.­”-ƍ(¢“®…'·Ž¬‹#³‰ ¦‹0§/²•(£—!«'®‰)¤Ž2¤…)„‰-Ŗˆ6¢Š<£›5°šE¤š@ؙI©–L£”A§ŠM£ŠR¢„DšŒQŠN‡KŽƒPŠTˆTˆ{RŽ}ZŠ\ŽsOŠpb—qe“oa˜xc“mi“dl“_o‹Yz_yˆRlZn\hŠas•[g›R`•Xa›TgžYg”So¬W[²X]°Id¦Z[Æ`R¬aY§gP±QK«TQ³XP²RT«KU§DZ©I[©Yg³K_øNlĄCp»Aeø8mæGb»4i³)uµ%iæ!e‹šĄ…¢ŗŒ ¶Š”¹‚¦Ā†„Ą‹¦¶~—³‚¢¹½Š“¼„˜““œŗ”¢Ą »šŸø¢Ø¾”Ŗµ™³·˜ŖĄ•­¼”­ŗ’„ƞ©³¤›±¦œ“¦¢©”¢„„—©ŸšØ«Ÿ£Æ˜­½ž«Ć„¤Į§®Ęž°Ą›±Ė›¬Š£±Ę¤“槻Ā©±Ä¶øĄ±µÄŗ»Ķ±øÅ»±ĶƵĪ½½ĢĒµŹ¼®Ų½¦ÜÄ”źĢ ēŃ„éȜźÅ ēĘ™Ü¾ßĮžŻ¼œēĆ äȚģĀģŕŽÄ’ź¼‰äĀėĄćŹŽčæ†ėĆ~éĄ}éĮƒņĮ€ūĖu’Ēr’¼oūŗvż½xö¼pėĒqńĮwēÄ}ßĂŁŹuÕŪtŚŚwßÕiåŲißŅfźŪišßočŚgčävźątßßläŁnŲŅoŪŠ`ŅĪX×Ō_ŪŚgÖÖcŌĶ^ŚĻ`äŚ^ā×TŽŪSėŁVćĪTćŠMŽŃNąĪMŪĖPŪĄQŁČTāÅNķ¾Rč»JźæRń»NķĀXē¼XčÆ_ģŖYķ©Tę«Oć“Nå±SéØQį¤Mį¬MŁ­TŚ°YŻµYÓ®UÓøZĪ·ZÉøIÄĄPĮ¶G»®A»³E¹ŗM±³J¶“F»ŖFĄ¦@Ą¤;Ā.µ“/Ŗ›8«”7“˜:ƞ5”£2””0 £5Ÿ9‘„4‘¤2œ¤9•©7”­,¤,˜¦+ž£-˜„*£Ÿ/ž2œš*˜›0„•&¦’ؔ)°†)­‰«$­Ž Ƒ*¬‘*­–#§‹'¬"Ÿ“(œ‡,„‹)Ÿ&؈.¤“7ؕ?¦š9­™9«‘?ŖA°–F§ŽI¦†E©G¢Š>ƒC™‡F”„KŠ†H‰„JˆƒT‡OzI‹vS…qRŒt_˜t_•qgšqb‘qf…aiˆbj‡dlŒarbq…Vj^t‰Yr“\x—Yl™PeŸTb Na¢Xk®Tq«QhÆT_±T\³aU°_SµdRÆ]O®]Z©WT¤\N„\XÆR\«U[¬ZY§X]¦S^“Gl±Fo¾dĀAeÄ;m½9wæ-rĮ.wˆ™Į€£¶ž·…¤ŗ|›¼Œ”°…¢øt›¾”³zŸµ ø‰”Æ’¢¾™Į”ž¼’”µ”¤¾§ŸĄ–ž³•©æ™¢ĆŽ“¾™“­¢­Ŗ—¦¤œ Ø™Ø©š œ›™«œœ§„–§«˜„­¤„¹Ø­ø—­É™­Ä©Øѝ§Ē£“櫽ÄصĢ³©Ē®¬Ē«¾Ä«¶æø»Ń±“ĢÅÆĢĆŗŅĘ®ĻŗØ×½«ź¼„źÅ›ķĶ˜šĀžģȒīƑŪ¾•ęĪēœ巗ģ»‹ģµ„åĒŽćĖ’éĘļĀäĂēĖ†āĀzćĆušĘršĮqū¾x’¼vö¹{’»z’¾t’ĄošĘpļÉxęĄ{čøxåĢyćÓzŲŲoćÓxŻŠhŽĪeįÖkŽĻvāŻoźÖqčŌuēēmģŻtćŻcŽŹeįÉbŲ×^×ĖeįĶeÖÕ\įĻcÜŅ`ŻĻVćÓUāĶNźŲYėŠWģÓSćČVāÅUéæVåĘUį·JķøMķĄVä²Gē¼Gņ»Sé²RŽ°RčøVź¤`ä”Uä§KŽ¬Lę±IŪ±Hą”FŽ­HĢ¬XŪ«VßÆQĶ¹QŲŗVÕŗTȶJĢæTÄ®NøŖ@µ°=ŗ¹K«¬>²®@“£@ø”;ŗ›A¶2­“6¬•;­›6³Ÿ2¶ž2£¤+¦ 7™•0˜ž0™¢;Ÿ /–¤7£6œš+‘”1££.؝6”š%®™+©Ÿ& –$©“"§•+£Œ-Ŗ—0¤"”'„‹#³–«—.Ƙ.¦,Ÿˆ# •(§—#”‘)¦‹&§‹'Ÿ”+„“<¢¢@£•9Ŗ•@ƙAŖˆ@£†E¦’?®‡F£~Oš€@˜=™ŠN‘L—…P‹‹L€PŒ„Q„‡U‚{X…ubˆnZpjˆwXŠh^•c^ˆf`‡fm‘lr“_w‡dq]o’Um’Pg‘Tj˜Oo–Zlš`aœVm„^gœ[g¬UgÆ_`„T]§bZ²gTØXV¢_Q£aQ°RZ§TW¦XN°^b \g©]dŖVg­K`­Hf®Gkµ=p½Bd½9j¾6l¼9}¹/xŹ+mŠ“³šµyœ·„Æ~£Ŗ…”Æ’®y—¼~¬w˜Ŗu ±€™­š¹•·Žšµ“¢Ą¢»œ¼”„¹“£¾ “–©·”¦­²¦„°§ž¬”Ÿ©š£Ÿž©„„ØØ®°©„«²”“¶œ®³¤³ĄžŖ橦ū³Å©“Ā³¶Ę·Æʶ®Å²øÄ©¼Ā±ĄĀ¹“Ć½¶Ó¹·ŻµŖŪ¶«Ö¾ Ś“¢ßŗ§ėĆ ēĮ•åƔąĄŒćĮ•ķʍęĖļĒƒóø‰ń³‡č·|ą»{ęȅęĀzé¾wōĄyļ¾ā¾ußÄrēĒné¼pņ½|’½x’¹w’¾s’Āpž¾i÷Ćpń¹‚äæē¹ąĮ‚ÜŅvŻÖuŽŪpćÓgäÓhįŅvāŃrėŌmźÕmīÖmėänņįrķŪgÜÉkŚĒeŪĶ]ŲŠ]ÖĖ[ćĻ^ąÕ_ēĖfąÉXźÉQęĒPźĻKäÖFļĪRōÉRēÉOßÉUåĄWš·QīŗLó«Wķ«Qź¼Uź¾JķŗHę²Lå¤UŽ„VŽž\Ž¤X×­TŲ®Nć„Xą¦PŁ¢SŠ­R׫VĻ³YÉŗOŌøJĶ·NĖ¼V¾²SæÆG±®@°³E«®D®­C®›8»–3·Œ2²:­:ƙ8¶2±‘9“—:­£1” /›6˜”6£–1 5¢™5 ž5’œ:ž•:›—-§£)§Ÿ-„-©•(©Š'¦(¢‘1£‰.„“-،*¦’&”‘'©•0°)®"­˜#ؘ&›‘*‡*Œ®”)­“*­‘/œ‘3›”.  4œ›1žž8„–>§Š4ؓB©F©ŽD”~MœŠC•ŠE•}S–~X‹~RŽJ“„O„TY‰M_„yf‰gŒ|ZŠwb”fX…`V‡jequ‰kshoŽ[o‘[fWe–Zc“Oo–Wdž^gž`f–R`šJdŖRi§^f¤a]°fgµde“[f¢RY X]Ŗ]Z¦]VØVQØ[b¦^c²[a²Tl¦Qg«Jh®LxŗGwĀGuĀ8kÉ6hÅ2vĒ)xĆ*o„ž¹y›µ|Ø·ˆž±|ž®°›³}”·x—·r›«{—¬†–£~•®•«†¢¹ˆ¤½šŖ“¢œ²›£±’Ø­’¤­—£­˜§„—°¤”©¬¢£› ¤š”œ›šÆŸŸŖ¦ ¤Ø¦®“ŸŖ®™¦« ©²—®±œ­ĄØ®Ā©²É°©Ē²¬Å³«ĖÆ©Ė³®Ėø°Ä¾«Ē“­Ļø²Ńµ¬ēŗ±Ū­ØŲÆę¾›ą“šßµą¾”ܾ“įĀŠßȏšĶ~ć¼…åµ{ņµyń±€ņ“|ėætź¾qāĮxßĘtęĆwćĀjčÅjė½tį¼ö½sņŗƒń¾’Äw÷Åp’ĆeųĒzļŗxč½€ēĆzģ¼€ēÄrŽĻxŌŽgŲŠdŽŁdå×dŻĶfźŅląÖfāŚoļšpéŚeēągąŅsąÅfŽĒhŲŌ`ßÖeāŹhŻŃcėÉaęŠbįĶOęĆNÜČVģĒRšÅZńÄMļĖOķĒKē¾WäµSņµRä²Jķ©Nź°LéÄSę“Nå±KßŖSß²Vą¦KįžPŪŖVā”UŽ£^ą©XѱVŁ·QĻ®TČ©SĢÆOĘ²IĪ¹[Ģ®XĶ¹QĮ¶FĄ«M¬µ:«­@¤¢8² ?±š0Ŗ”2§’4ƒ7®Ž5“›4ƛ?“š;Æ”0¤¤3™¤=ž3¤Ÿ4ž™3š—5œ’=•–:˜”+—¢'¤•.¤˜0 “!¬‹+¢‰­"Ŗ…2§.£0²Œ*”“0¦‡#°•0“£(§¢ Ɩ&žš$ ‹/¦"›‡”"§—"œ™.¢Ÿ*¢ž7˜¦0¢Ÿ;¤ž=Ƌ9­†<§„?ŖE¤ƒA‡Dž…Mž€Hš„M„Z•‚O’~RŠ}K‰…OŽŒO…ŠP…€^ƒZ€a‡|PŒoK lS˜q^†ug‚rmet‰fmŽYo‡aa’\lŒRj’[r–Qo—eq•\o•Qj£Rc”SiŖZk¦\g§ae§as X`”QRš^T”[\”Xb§L[ž]`¬Tb²QoØHiŖPl²Rl¾RiĮG}æMwŗ;zĒ;wÅ?‚Ģ)tÅ!pƒ›Ąšŗ…›æƒ¤µ™®s›Ŗn“³s–±}Žŗ}•²š¶‚”ØŠ–¬…œ«†£¬ˆ©ŗ˜©«—Ŗ••§šœ¬”œ¬—§®œ©“šŖŖاƤ¦Ŗš££›˜¢—¬„”²­¢¶Æ”ÆƝƭ£¬–¤§›Ŗ³›ž²žµ­ ÅÆ„Ģ²¬Ä¹¦Ąø¤Ē°±Ņ¹ŖŃ“ØѶ¬Ń³§Ų±Øį±¦Ł«¤įµÜø›Ś°•Ö¬ā¶‹ßĮ‡äĄ‹āĢźĘ}šÅtåµzī¶~õ¶yļ¾ué½jéĒhåĀnč»oŁ¾cŻÄkāĖmąĖwéÅ~ļ»|š“}ģ¾†ö½~łĀvłÄoķŗ{ī¾zšĆwķĄ~éÉzéĆßŅ|×ŲoŲÓpŚÓdčÖ`åĶgāĻaߎaēŽečźeņÜcźÖjęĖjčĻsźÉućÓsāŠoåŃbčÕ]ć×_ąŠSęÉWć»`Ž»Zį¼PźĀVķČOåĀYāÅJģ¹Jń»Xä¶Uė¬Uā®OąÆHß»KŻ¶EŻøJŪ¶Ié­IšžYźžXń `ģŸZŪ”dŚ«\Ż“[Ń°[Ń„KĪ§LĪ¢SĀ¢WĀ£TŹ±UĆ¹UÅ“L»«KÆ©>²­3„¢4¦š6§”2¤‘2¬•=°‹H؎B¦“EŖ”@§Ÿ7¬”9„§< ¦<¦Ø;8–•4–”5”–.¢“-¢”0Ÿ-œ(¦”%”ˆŸ‡&ŖŽ+¬‰(®†$؆,²Œ#«‡'°‡"؊-­’.§›(±ž$­™¦‘¢Œ#§)Ŗ‰&­’%£›$¦ž(› "–˜-™Ÿ4šŽ-©Œ2²‹0¬6„‘9£…<žˆG¤@‚9™€C£wO›zV—zV—Y‘‡N‡ƒO†P‡L•S‘‚Y‘}YlKpJhRjWŠpa‡h^†nelnYi\i†VgXgŠ\sWyŸZsž[s ]s”Xg•\l”Uf¤YkÆUlØXo Ynœ^\¤TT Z[§W]¢Ra„Ve¤Vd«ViÆIjÆRmµNj¹Kh¼Ot¾Ky“DŗHzĘ>}Ģ/‚Ó$u‰µ|˜¶™»€¬øvœ³r¤¶wš“j’Ŗtµx•«z—Æ‹­| „—”}™¬Œ§»Šž­—§°‘¤Ŗ”„„Š©Ŗ˜ ¦’««“­­˜Ø¦™Ø„–Ŗ–˜Ÿš„”¦Ø –®«§®£œ°¦ž¢¦˜®Ø• ¬¢„¶Ÿ”“£¤¼¦®ÄØ„ø¶«½“¦Ē­Øѱ§Ķ“ Ō²”Ł²¦Ķ³˜Ņ­Ÿį®—č¹žį³–āƐ䰒鳁黄Ž¶€åȀģÅ|š¾~ķ¶wö±sņĮkń·nå³rčĀvčĢgē¾eÖĆiįŗaāĘqļĆfģĆuēµp嵂ņ½zńŹkł½kš·n÷½mńČvļĮwęĀ{ńĀpšŃsåŅkŽßnįŲjāŃcéÕoļŅdćÕgŪÖfŚēdįšnźįjąŁhęĻvķŠwźĢsåŅsńĶläŪcäŌg×Ó]åŌ_ąŅLįĘRäµYćĮXńæLāÅLåŗMą¼Zš¶Oźµ]ā·T×»RŁ¬QŁ·PŌ»EįµU×ÆJą­Qą·Fį®OŽ”Yć©]ߛSå¦_Š¤PÜØZŠ®LŃŖTĪ„MӜEĒžPŅ«VŃ®RĢ”VĻ„G¼®9“°3­ ?­›:Ŗ”<­<„›4”’>ž‘F±‘C”Š?¤‘=³ž7±£D²Ŗ@Ŗ›Aا7˜7œ”,˜—4œ,Ɨ.š‘+¢—"¦ ) “$›‰œ‡$«‡/§‹.Ƒ*¦'¦Œµ‹&­ ؎#­Ž*Ÿš(‘0¦™$›‘*›—%‹)®Š3¦˜-§Ÿ/š•#‘“ š0Ÿ”4¤Ž6£š1„/؛,ƒ> }CŖ„G§yE¦|<œwD‘vFœ}P’vWŽ‹L„}M…QŠ†I•ŠW†O‹„Z–€^‹sPŒpPžcS•hW—v\‘scŽgj‘mb•[lŽ[j]p…[x‘Vr“YyŸUpž[v”Ms•\u‹^m–Wc™To\t„Nh”[oØ^]§XaŸQe„P\ŖLlœJ`”JX®Nm«Di“Rd·Gs®RtĆJr²MqµAy½F€Ą;{Ź8‚Ļ$|ƒ“¼}œ·„¦Ą†­ø‚¬“x¦“uŖÆkž«i¢­o¢®j™ t’”~¢ }”¢†Ÿ«~œµ€«­“«©“¬¤†¬«…°¦”ا«„–« “Ŗ „Ÿ–”˜”“œ™œ›œ™š¦”®¢›²« Æ¢—ØŖ–«©’§¬”§Æ£©™«“£§±¤ ½“ؽ¬¤ĒØ©Ē² Ć¬›ÄŖ Š­ ĖµžŃ·“ŚÆ—峝ļ­“źÆ†ē°}ß©€Ųø„ܵ†īăļƀń·ył²|ū“nöŗiņ°ję²uõ·móĒpėøhä¹eéĘpéĀičæhč¶fėµiå­zéµlńĘhó¼n÷¹fļ¼pōĀiöĖlīĘtėČpźŅnŻÕrÖÕsŪŲjŽŌiāÕpēŠeéĖjąŌpāŁiŪčsÜētߌnäßućŲoäŽlģŚbėŌ`īÖ[źÖaÜÄcćĘTėŹMņ¾Hč½KįŗNęĄMźŗTāĆKŪæRäŗ\Ż±XŽ±YßÆTŲ·`ą·W×ŖMŪ©QŽ§Qß©GÜ°NŪ°Uć«SצUÜ”\Ö”[՛UߖWąœMŚ¤JŁ›JĖ™QĪ¢FĶ™SӚWӞEȚBĮØ7ŗ„3³©,®4„¤5ؙ5”›=Ž<£„;Ŗ‹@­‡<§9®—5Æ©>ƬB±ž>®ž7®Ÿ/®£:؝3£”2ƕ4§™%™™"Ÿ•™$¤”'š‘(Ŗ’%¬‘.²‹#®&؉'³Š Ǝ(¤‹!+ž˜1›’5„Š+”–"•˜*–*£‘1„˜*Ÿ–- ’-–”-Ÿ›.˜—'  $„™-²”6°˜1¬Œ3¦ƒ8”ˆ=„Dš‚G”xMœuNyS–wIˆ„JŽƒKŽ…U„ŠZ‹WŽzQ‘WŒw`ŽuZŒn_’gWŠmT“j\‘rbŒme‹cd‘gn”[rˆZr„\rNuXtž[|”S‚›Mz›IjŽPk‹Uq•_l¢Xg ToØ_k£]a§[eØJ^”Ae„Fm”H\ØO[ØOc¤Pp­Wf©Ok“Li¼MtæNo¼>zµ9~æ<€Į0tĒ!u–¼ˆ•·›·‚­¶€„Ŗwž°n£¢p¢Ŗh¤žn„£uœšnš¢ƒ˜‚¤°€š±‚£ ­Ø†°©ƒØ،„Ŗ™« •žŽ¬§—Ø—Ÿ™£”“—œŒ¦“¤ž›„“¢«”„¬¦¢‘Æؖ¬¤š¤“”Æ“ž¤³˜Ŗ¹§¦¹±œ·®„·ŖœĮµŸĄØ”ŹØ–Ó²”Óµ–Ó«ŸÜø˜Śµ•čÆ™äµ”č§ä³ą§|ŽØ{䰂äø‚öƆīµ~ö·ržŗoś“nł½oņ·kė¹głŗgō¾qš­gōĄmģÄfė½cé“oč²oé¶tōŗjėĆgõ¹nķÄo÷ČhśĢiųĶcéÅkēŌtęŲmėÕqąĢmßŌißÕfćÓkįÜqŪŅoŻŌg׹nŻėpŚ×j׹pßÓpį×hēŌeģŻ]ąĶcīŅbŻĪVߊ]ÜÉ]ćĶJį»Tī·Rę¾QŻÄGßĒSŁæTÕ¹TčæYŁ»bÓ¼[Ó·aŅø_Ų¶^Ó²SÓ²QÖ§YŚ«VŲ±FŽ”Pä¦[Ū™[ę›Vą¤ZŅ”YŚ£QŲšRŁNŪšWՑVĶ›KĻšWŲ˜WӗHŗKĮŸ4Ą3ŗœ;¶˜6Ŗ˜3®Š@Ÿ“9¢G£‹6§—9¬ŠE®‰G¤£<Ŗž>¦ 5؟9¤¦)²ž/¦”)«Ø/·›4³˜/Ÿ•*¢Ÿ„“#‹"›•,•˜.”‹2„“.¢2«‡+¤"©ˆ#¬Ž%£‡-“%„•*”0–Ž/œ“1“1™š&–ž(—“6Ÿ*”)–š'šš5 ˜1¢š* š%Ÿš8£˜=«”<©‹9؉8„:™<•‚E“|SJ‹~R‘{Y—ƒZ‘…c–wVŽ{e‹‰U’}Qz\‹q[ŽyT’sTwO’mV›f]k`‘j]–qlˆia„\t…Sw‰Wx’K]•OsšUy™Uu—IsžYv—W{”Uz¤Pi¢\i¦P`žRl§Da”Ae”En§Hc¬K[«La®Lp§Nt©Jg±DmĀF{ÅBr»=yĒ3~Ä6|Š1zĆ.|‚š°ƒ‘²„“ŗv£øy«Æ~¢„r”„uœ£n¢¢m——q–¢všx¢œƒ„©†£«…£¤§”‚ž¢™…­ž¢”•§“›£–”¤¢™œ•œ’’Ÿ•ž—‰Ŗ’Œ„˜‰«¤—„ ˜ŸŖŽ¦¬‹”­•Ŗ¤±ŖœØ¬ „®§™¶¢•®¤”ŗ®œ¾“”Ė­ŽŅƔӵ“×·œą¼”Ü°ę³‹äŗ‹ń»‚ķŖŠć¦‹ćŖ†Ś¢}Ż©wć±ė»zšµyłĄrų¹lō“jó½eó¾ló¶eōŗjś®nō±oųÆgķ¼jļ½iķĀkē¶tģøkī®iģ²uńæwīĄlīĆcšŃdóŚkõŃfńĪkóŌtéŌmźĪpąĪt߯pŁŪqŪÜnÓÖfÕÖm׎oߎnåÖaÜŻdŚŲ_ߌaŚŲaąŲaąŃ\åČXéČRćĻSÜĻOćĆUźĄ[čĀRč¾SŽĮQąĮUÓøVĻ¾^ÜÄ]Ü»ZŁµUā°`Ü·aā¬[Ū±Tć«^Ś¤WߟPߣOā©Tć¤Rē–Nå—Yå [ŲŸQŚ›^į ZÕ£VŲœSŪšNŚŒYŠ“NĻ‘NȌBŊDĒCø”:Ā–4ŗ‰3“‡;©‹>§—G«•@Ƙ=¦›?« B°”EØ”E©A§ 7¤Ø-¬ 3«§,µ«1¶©-Æ„)­ž(¦ ©™'„—&š –ˆ,”'˜”,œ—*„•2 ‰0„)؍*­€$«ƒ,‰/œ„&ž‰/•”.-›’.‘Ÿ&˜›)œŸ(£—0—”,™Ž2žŒ7”’+¦†1§‰+£. 7›‰*¢‡. ƒ;ˆ9”{D”{@“…A”ƒNš€UŽ|Y„[–{`ŽtgŽ~a˜ˆf˜‚[”]•v[—pW•uW t\œuR•pX—nW—hZ‹kZ†[hŽZm‰X~‡T}”M~‘S|G}‹Lv“Is—S{œT€O}žWršTn›WhžHmØHs£Gm©Ge¤;i„>fžDg§@kØ:k“>l°Ct“@q¼Gy¼DzĄ«ˆ6ƃB¤Œ4“™B±šA¢„>°„=£žLŖ’Cž”FŸ™6›—.£ž*­™'­„(©„"«•$©”%¤“"©”(©–-•Œ–…0ž‘+œ“ ™‹)”(Ÿ/¬•+¦Ž,¢–)ƍŸ’/™ˆ%¢#–›$œ‘2šž(œŽ4š4Ÿ—)Ŗ–)¦’)™‰, (ž•(™—)Ŗ•.ž˜/œ:’†7ž1‚1–…:˜{Bžx>Š|I‡‹R–~X‹t[™‚R yV„bŽ}b•tQšT˜oWŽkak]•r\p[”sc’iV˜sRfV‡b^•hp—fxŒSmLs•W}‘YzŠV{…U€ŒMr’KuM‚•K™I{ Rx£Xj•Tp”Nu”Rj–LfŸCl§Gf¤QuNq¦Cy¦Ir®A€¦Mƒ·CŗG{¹6¼AuĘ8ŠÉ4€Ń6Šm‰«wÆxˆ¬}”µq‹³rŖ‚–Ŗ€•«t’©m§x—šy£”} ™„©™ƒ” ‡”‹¢¤‚§šƒ£˜ˆœ›£„‡  †Ŗ–ØŒ£ž’Ÿž‹ œ”’–ž•ž››ž”£Ŗ¦¢«¬¤„§–Ŗ¤”±•ž¬„³šš³›œø¤ ¬¤›±Ŗ‘±„˜Į؏歐Ą³˜æ“ Ī©”Ģ±šŪ““Ö·‘ŌŖ†Ś±~ŁØ…Ž³ŒŻ®‚ā¬~ģ¶ró¾nō½uņĮję½bė¹Zł¹]’»e÷¶jś½k÷½cņÅgė½dąµb߶oį½sī¼eńµoó¹wļĀrāĄoÜÄqßÉcčĶ]ņæ_ęÄgćĻ^ģŹhńÓdōŃgļĒtėĀ}ŪĪwŚŃ{ŃŁqׯgÜŪgŲŚdŁįrŌįpŠÜhŚĪfÖĪXÖĘ_ēĀ\źĄXßÅJßæKģĘOīČUķĒVė¹VŲ¼NÕĘKĻĒIÓĘLĻ³ZŌ¶aĢ“`Ž¼Są²RŅ­RŠ·`Ō±bē²Tį¤PŻ£VߚLęžPä™Oą”Mą’IŁ™GŪœGŻ§V× NßØEĪŖSĪœO՗BŠŒAŅ‘?ĻCӘ@œF¶ŽJ“’?¼‘G»ŒH²‘C±‹5®‹5«—8Ɩ>Ŗ FŸ£<Ÿ„A¦ŸFŸ“9©-¢•,„›(؜,„š#­‘&³“!Æ )­„*©™,„Š0€+£5£Ž/žŽ)¢$„%ž—"؎#©–+¦(Ŗ‘ „Ž,–“5”‘.£—'œ(œ)—”-‘. ™4§›*™Ž$™’ ™!–’,•œ2 š1—“0˜”:•Ž:Ž„?“Š7™„9‘{D‹}B‡yH†‚U“xQ‘z[yWšyX’z\•{R}^xXŒr`kXšpZ¢qe£f_škfœu`‘rZ—kdjh•ip’cyUvˆRq”Yv•TzŒL{‰OzˆRŠNw‰PpQwžL€ŸNy™Ip—Uv”Op“Ug—DgDb¦Jh”Ou£J{šHyžF„L”J‡«M„·K‚½9zÉ9†Ć>Ē=„Ņ<ƒn|²|Œ¶xˆŖ“x˜²r–¬‚Š§w’¬u“£oˆ¦p•p¢”z¢—}©”{¤›ˆ©¤§—‡„š…—’Žœ–‹’ž’¢£ˆ”–“«„Ž¢•’ž›–¢”–’ž£”“›™„©£¬ œ§­£§„šž«£”®Ø­ ©¬Ÿ¤³±¦±¦š“ø™¹¶ŠĀ±“ĆŖŠµ±’Ą±¢Ń ›Ę¤”Ģ„™Ś³…Ö¦ˆŠ¢‹Ł°Œą¤~ܳ€Ż»~óĮzī½gųærö¶bę½bōŗ^óĄZģĀ]ś½iō»kńøaļ³föÄmą¼fŚæiéĮgé·ońĆrņ°vé³oćÄiźĆeąĪbėĘgīĄhćĄląĪZßÓhß×véŌmęĖußĶxŚŹjŲÕtŁŁv×ÓkÜÖoŲåkŅåwÓŅsŠŪoÖŠjÓŃdŁĖWÜĘXčĒUŽĆMę»GéĄKć¼[čÄ`ćĒYÖ·SŅ½LĖĀFĘÄNȶ^ɶ`Ō«a×»WÓ®ZŌ©QŁŖbć°ZčŸQāœ^į¦Sé¦TŪ•[å–PęIߘBŚžNč¤Nč®På›LӜ>Ō–@Ģ˜NŌ–@Ś”;ŌŽIĢ“C¾ŠDĮŠKæŽ>»‰LĮ„?µ“EŗF©>«…@”ŠA„”BŸ >£ 7•š0–—4›’-œŸ/¬š4°¢0°–3ŗ”+¶—1¹“-®˜4¬œ.µ$¢/Ŗ},œƒ2Ÿ‰-”5°Œ1©,„›-¦›&“’$Ɣ%®žŸ’0£Ÿ:““4œŽ6œ6””.œ•&“œ-˜˜(¬'—‘"”'•'–&›0Ÿœ*›1••>•ˆ:Šx.š…=“=šC‡ƒDˆ‹HQ”…U’‚SyTvQ–yT˜yT‹uY‹y[•kT˜mZ˜mažu_•o`šrWŠkg“n]hf‚hjŠ`wŽexWtƒPyX~’\q‡U‚Vr„Xz”Hx–S{LƒŒNxKm’Mx“VhšTq[e›Uc˜UeŸKgKoŸU‚—HœS‚¢EŽ¬J…“D‹·Eµ<Å9ŒĮ<Ģ=†Ļ8~{„Æz‚®q‘°y—Æx·ƒ•²†²|…„u…¦s˜z›¢wžœz•˜}˜—}—ž¤§€«¤€¢™‰Ÿ£Ž“œ‡’“Œœ˜Š›•’Ŗ›ŸŖš ¤’Ÿ§‘žšž“—¢—–Ø“„ ¤¦Ÿ¢™¢”œŸ”Ŗ£„§ž«Æ¦³Ø¢®©®­ „®–§¹“®¼‰µ±‰½¹–ø²”»©”ʤŸĻ¢™ŹŸĒ©“ŃƏŪ­”Ž§‡å„ß“‰č“ƒī¼qė“nķ±gī¹aō½\ųĘXńĆYśĆXńøaõ±ił²gś¼kó¾lę²qå·tć½xäæxė»m÷·sżæyó·näµhąĀjŌ¾vŁ¼rŻ»jąĘgąĻuŁĶzŲŌvąĖzŽĪkŃĘmŌŠmÖŹt×ĖrŹŪoŅÕuŅÜtŁĪuŁŠjŲÉcĻĒbŃŹfßæXŻÉKéÄJļĆNå»Rź¶Zē½\ģ¹Nā½MßĮLĶĮRŠ¹RĻ²Y×·XĻ²XȱWĶ“ZŚÆ]ŲŖTקTå™Uą™Pč\éŸ_įZŻ¤Vä™Hī–@éšGߧAć£LÜ”HїCĢ—GŃ @ӝFŅŒCƆCĮDĮ•FĄ‹?ňAĀ‹KŗŒG“‹@±@„ˆ<Ŗ‹J¦I­œN„£E™š>™™0—“0Ÿš-§œ1§š7Ɯ8ŗ›>µ¤A¼:ŗ‘;³.¶“*°‡"®‰,§ƒ+°3§ƒ3®‘5°/§™&­™+©ž%ƛ©¢Ÿ!„¤2”ž1–”7’5’›8—6ˆ˜,š'“—. +Ÿ‘2š”+‘&‘ž%’˜4—™1“6‰…2†„4’z*”…1›„6ž:“ŒAŒPŠ‚SŠ„O{M’zZŒqYrN•wRŒqSmZœnU›oY”j]›mc˜jZ‘sYŒiaŒpa‡qc…hs_x‰cy†ZzŒVŽ]}•Tu•Vz‹VxŽR~‘Sƒ—[yU–Sw’Rpœ]r›\hŸbk˜XjWg—\t™Yt£Pt„O|ŸW†©P‰£O‹«MŗG¶F¾I“L‘»Aˆ·;Ą<Šv‰«~~³|Š®x†¦€—²{‘Ø€…³€ŠØvsŽ ~¤{—›x¢˜¤…œ¢›Ø†¦„ƒ¤”…›’“Ž•Žˆ£ŒØ”—¬””š–ž¢š’——”Ÿ’£ ž£¢žÆ®¢”›ž¢Øž„Ÿ§²°¢¦Ŗ£µ©£® Øؘ£³Œµ¦“ø­†“«“ŗ¬’¾„œÄ›šĆ©Ā„•Ņµ’Š­‘Ōµ„屉ē­Ż°Œę²yī½tć½uį­qķ¾]š±jé¾Zō½[źæ_ė¹göøbóØ]ę³dē¼dī²tė¾kēµtīĆqóÆoē“dó¾uōæläŹiŪÄdåĄeÕ»nŽĢqŚĖsāĘnŁŠs×Ó~ąÖnŲ×jĶŹt×ĢhĪÓoŃÖrÓŲrĢŽlÓÜmĢŲfÖĖcŃÉjČ¼aŲĘVŽ¾TŻĆIčŗJā¹UģµSŽø^ß³[āÆNŲ·ZĪøNĖÄIĢ·UŃ¼PĢ²Y×®^Ś»]Ņ¬PÕ­[Š®WÖ£XŪ—RźŸRōŸIčŸOā„Uź›NŚLč”CŪ’HŲ£H՚IĻ¤NŅ£?ŁIĖ¢<ՓCɌFŠ…H½ƒF½„=¾‰;ĮBĮ‰L¹Œ>¾>Ƅ:³‘5 >ŖŽB©›@žœ9©‘Dœ@­ ;¢“0Ŗ =ƙ?µ“;¼˜@¹—@¹™9·œ,«‹)².·‰*؅.³,²„-·‡:³Š(±‰!®™0©ž.Ŗ%؎ „ž™ !–” ”5œ—;Ž=š3”“3‘”7–„',›—$›Œ–‹›'”„–œ-—•+‘‡0Ž,•~+†x-ˆ+”Š8ŠxAŽ~@’uPŽ„QŽMƒzLŒxY—x[‘mX’zc‘yZ•wb‘t[–dc’r^Ÿhe™la›mh˜lY‹kcˆll†`l’fo‘ps”bu‘Zˆ—_s‹Pu‡boŠ_mŒX}˜\†PyŽX€‘Y|Ws—bj fc›_obu˜Xt¢Ypž^|œTt—]zŸT…¢UˆÆOˆ¶L‹«J’ŗI”»O—·A…°I‚µEĢBŽr‡§v„«v€¤w†¬xƒ±wˆ®t|±y~²{‚®~•„˜«|‘¦z Ÿž›ˆ–­—­Šœ£„™§–›ˆœ‘ —„‰Æ˜‹§—˜™’š–™œ™’©“¢ž¢žŸ©„Ø££Ø„„¢ŖŸ›¢¦””®ž¦£”®®š“ ˜Æ ”µŸˆ®”µØø£’¾¤šĮ£’Ɲ™É™–Āš“¼Ŗ”Ź®ŠÓ¼ƒÜ·„Ž©ŠŽ¦‡ē±€ä©vį±oŚ½fä·lēÆhāÆgėµeė¾QķĘZšĀbģ³fč¬cķ¶cēŗeߥmę“nė¶hģølš¶hć°féŗuķÅ{ģÅ{äĒnŻĒmßČjÕĮrÜÄxÕĖtŲÄwŻÉwćŚrŻįiÖ×oŌÖcŅ×hĻÖbŹŌhĶŻgףqŲĪcČŌeÉČ\Ņ¹[Ī¾VŌ¾WŻĄOķæHäæHć½Xē±Xā³XÕøSŌÆWĶ³KĢĮNÕČCŃĄI×»YŌø\Óŗ_ą¬WŚ®RÕ­Nß©NŚ”Pį¦HīžGå—JåžNäŸDįŽHŁŠGŪ–QŲœPŠBĖ•K՞JÜ£CŃ IՓFȎIĶŽ>Ē†@½‹@·•CĄ•@ʃJŹƒMæA¾‹3ƍ6­‡<Ž<›ˆ>¤‘>­’F¬’C·‘3°™2§•:­•G¦ŽL­˜@·–@½ 3°’7“Š.«ƒ,­‰;ŖŠ-±Ž)“Š-¹€2ŗ0¾#²Œ+©•)¢+©’"¢‹› œ™#–’0›˜=–’8œ1–Ÿ9‘„4˜ž&˜“(›™““!˜Ÿ%Žœˆš‹‘'Ž&Œy0‘~;‹…7—†2“4’|7Št>ƒp<‚tK~€Pˆ€O‰‚Tšvd—zf—sc{[’yY‘u\ihšgh£ma›qcžhf˜ad˜i^Šheejˆs{Žp}Šqz—g‹f{[t“_{‰aq–^€™X}‰\x†O{ˆSz†Ypaf˜_lbr—`ušTlØVnŖWxœW€–Y{ŸX…§Xƒ°YØL…©NŠÆC—±H—°O•³E¾>†ŹB†p|Æj{²s…²pz³oz½zƒĄr|ŗ||°…‡±‡–³z“Ø}ŒØxŸ|•˜‚–Ÿ‚œŸ‘‡’Ø€œ›‹’˜’ž’”Œ–••œ˜¢–„••£“Ŗ£›ž  ©—Ÿ„•®§§¬¤—”¬œ­¤£Ø§³„—“¢—»Ø—« —ŗ Šµ£‡¹Ŗ•¹Ø‹²®”Ƥŗؕ¼—“¼ ‘ø«šĄµŒĒ¶Ö¶Ó²~ąøyź­xä¶ną¾gć»såÆnŻ«låŖdäøTé¼XźŗUņ“_å¹Sā¬\ķŗWā»YčĀdā¾råÆhš°jāŗké¼mē¹mę»mź¼pēĆxߊåŹpåÉ{ŚĖrŽĪrŁ×uāÖrįŁuÖÜnÖŠ}ŅŠxŠÜdŅŌcŹĻrŅÕiŹąeÖŲnŌÕqĻĘ]ŃÄXŅ»TŚĆPćĄ[ļÄJŚ½KčµTä¬Lē¬Nį±UÕ³VײQŃ¹SŌ¶UĶĆJŁ±MŌ±NŃ«[× L×°TŁ¢FÖ®RŽŖSę˜HēœEźžSŻ‘M՚WŪ“V֟WәGŁQɐ>ŹžLÖ£OŁ„LܚAĖ•JĒ;ĮŠBʎGĄ‡Nʏ@ȋEĄ@ʄI¾@½‡:¶“9¦9Ÿ–1ؑ1£2©”8ƌ>“™E¼œ=®Ž<¶ŽB°•Bø”Bŗ–6¶„1¾’/°˜;«Ž<¹”<Ə6ø‘5½‘$¾…1°)µ‹$ø” Ŗ“±#¤›œ–"˜—- Œ"š(“•8“’9;œ¢:—.“Ÿ0‹™‹––•‰š‹žˆ™!Ž#‚ƒ$†€/’z8ŠxA’‚=t6†:’u:s@uJ‹uLxK–yZ˜{fœ}\ ncra’wgžjj™po„al¤cX¤ngbd¦md”j[˜^išgb–nzpyŽnƒ—q|Šgr^n•iŽm{˜a}c{PzŠ\z”YyŒVu‰Xq’X|•^lžax [w›V{N{”N‚ØZŠ„Kˆ©S²\‘³O‹„B®PŒøN”µ>±G¼I¾9hƒ°jyæs{Įr}½wyÉ}yĆ}ˆĀ}†·~Ž±‚ÆxŠ·vŠ“w‹Ø†–„–©†’”„‘¢}›˜„˜„—“‘–“’‘•˜œ‘˜›™™¤–§ ” “£™Ÿ‘”£“”³’„²šØ¶§¤·¢£®£Ŗ±š©¹–Ÿ¹—˜“¢”³„–»£™¹©Ž»Ŗ‰²¦«¤–¬ŖŒŗ­»”Œ¹²†ĆµĢ¶ŽÉµŠÆ„Ō·|Ū·uŻ“tŻŗlŪŗlą³må³méŖbėÆ^äÆVīæZč·Lš·Oņ°Yä¶Yą“VēæUļ»déŗfī®cź²lé¼oß¹kźĄqļĮkč½sėĘ}īĘ{ćȅīŅƒéĢ|ŽŲ}įŁoŌÜkŌÕwÕŪrŹÓ|ÖŅzÕŻqÓŁmףjÓŻeĢÕiŹŪnÕŠoßÅcܾcŲæ]ā»XčĄWą»UåµIÜ­Hå®KŽ²KŻ³MܾSܾTŠøTŚ²UÖ¹YÖ“XŅ±QÕ„KÖ¤Kį®IįØLå§WŻ¢PįœLą•EŁ™M܍TߙOՖTŅ—NĶžLŅ™MĢ’AŌ™@ĢEĪš=Ų?Š”6ț=ŞGĒJʏJĐNȕH½GƊ>¾ˆBæ‹7±“9¦.¢2œ‘9¢“5›‹5„‡C­=¶ŽD»“L“B­–<“œG¼™<“ž<»š;²˜=µ˜>¹™9µ1øŠ1Ə.³Œ±ŒŗŽ °–%ƚ Ŗ’#§“„›&™–()•”0‹.—Ž5™”8–˜,–+‡“-“+‰œŠ‘‰•‰‘‚”%‰‹+‹Œ-‰1ƒ3„v@Š|FŒz;•wEŽuBvOŒzN{KsSœwT›ta}k”ug¢|_žtg ke¦ekŖf[Ÿc\Ÿ^g¤ge„[cž_ažiišgfŒsoˆqx‚ut†ww‚w€oyŠt~‘n{™mv‘^|“[q™Wl›]s[o‹ZwšS|—U}¢Yw—]†šTƒ Z¦SŠ¢J…¤M…±L®O‹§M“¦CŠ“J²F·K‡µC’ø9Ā7Œe±iv®s…¶nŠ»}~½ƒ°zx²x{µ…‰ŗˆ²~‹«t§r“Ŗš›y™ †Œ›‹— Œ–…–Ÿ‰¤˜™–’‘—”›™” “Ÿ¤˜«™ŸŸ¤–™”˜—œ®”Ÿ¬Œ¦³£Ø²™Ÿ“˜¤Æž¢¦›¢¬¢ ²¢¤š‘µ “Ÿ~°„’« •Ø ‰Ŗ£‡¾›‡¹£¹ØÄ­Ģ³„ĆÆwÖ®Ķ¹t×øwā“sŌ¬uå³lč®lć»eš½Zö°YźĄVķ¶Pš“SēĄ]įĀRä³Uā¼^ēŗeāĮeÜĮpą“fįÆcé±aŁ¶kč“ičĄgćÉvćæzŽÄxŻ½~×ĆzÜŠƒŪÓäĶyŃĢw××kÓĶ}ĘČ{ĘÜl×änŲątÖÓmĪŁdŲŁlĻĪeŅŁ_ÖĪbÖĀećĘWåĘMŚÅUŁ½LÖ¾SŲ®V×ŗMß»C×ĀIŻ¶VĢĮPĒ±LÕø[Łµ]ĶÆPŅ·RŅ­FӛOŅŸD՞PߟMä›Mā”EŪ•OߜF֕NӜM֕_Ī—[Ė VʔAŔBŠ›@ŪœK×”=Š—BŁžLʞHĒ›DʒGĐMĖ“Gæ‘L½I¾Ž<ø•:±‰:®–5Ŗ=؝;¢ž0ؕ< Ž:>©ŠFؖ>µH©ŒJ­˜D® ?·œA±š>©Ž6²Š@ؖA°“>©‹0Ɔ.·…%·“,­Œ#­%Ŗ'«š«’³™§“# ”!£š-’Ž4—/–’)‹š4–˜/Ž $‰#™-ƒ•Ž%†‘ˆ¢%Žš%Œƒ%‡Ž*‚Ž/†v/‡9‘r4ŠzE“C‚EŽzL‡rG‰sM™€\•{X§yZ©oh wl {dØyt¤oo du›gf¤uW¦a_ kn¢\g¤e`›nnŸinŠioxvz–rtŽu{ŒjkŒn~n{”b„”cy‹\užbseqgq–^s§Q‚¦aw”Pq„SwœUv£S®MŠ®X¤N«HŗC†„NŠ¤I‚³OŒ­Q•±BŽ¶F»D‘»1Šb~¤h~ŖcƒÆo‰¶n®xƒ­n}“o€½±„Œ§v’©r‰”sŠœu™›z“”~Ÿ†“§‹Ž£}ž¢Ÿ‡—ˆ——Ø¢¬”¦­”¤œŸ£§˜”šš¦§£¤„²Ÿ£³Œ›«›± ŸŖœ›«—™¦–ž¤¦ ¦–˜”–›Ž£—›žƒ£„“©§Œ³˜ˆøžŽĆš”Ē¢†½¢{¾¦|Č²zĪ¹uŅ¶qŌ·{Öŗwß®så¦aŻ®]į³bā°Zó»[ōĮVę¶Wķŗ[éĄcģĮbę¼_é¾cēŗiŽøuŽ½qė»géµjčæfŁ¼cŪøpé½rėĮę½|ŪĒxŪĆŌĪ†ŌĪ€ŁÅzŲĘwŠŅlŠŲmĶ×qÓĢvÖŻsĒŻn×ĻhŁĪhÖĻrÖÜmŲŌiÓŠWĻĖUŠÄcŻŹ`ÜĆOŠČKÕĀTŚ·RŽ¶R×ĀHߥIŪĆJÜ»MĖĄJĆ·OČøUÕ³TŪ­U×­RĪ¬GŌ›JїHŲ›FߒCąšIŽ”LŲ“JŪ¤EŌ¦MĪ›SĢ–ZÉ¢TĢ§QĆ DțGבGŁ”JŅ¢GŲžHםTїOďFø“FĄ™Dȕ@Ź™I»A¼7·›=²–>“ˆ3¶<ƚ6§”7Ÿœ1£’5£ŒH¦ŠI£–E­žA®–J¹£Nµ¢Aµ‘<­=¢ŠB§‹:„A¦†@°~=Ŗ-«ˆ'Ŗ‘1²+±‘ ¹±’Ɲ²™!«”«ž$£œ/˜‘)›Ž&‘.ˆ 0ž.–”"——$Š“(ŠŒ)Ž.ˆ‘)š+‹™#‹’"‰Œ•1ŠŒ6†‰/„x5„s5’uB‘‚OŠˆP‰yOzG‘uG|TŖz_©waØ{gœ|i§pq„mq£ru”sn™qhv[šw\—hižjkØccœmqœoq“mwŠpwŠt}•|~•pulnˆl{Šh~…mƒ‘f…ŒjŠ”d†\Še}e†¤^~¢Vv”Wp¬Qt„Rs±Pv«N±O‰³VŠ²Gˆ“E€·Oz©K€¤SŽØL‘®J–ĄG‹Č<‹¾<f€Ŗ`{±b€°c‚Øq~§w€«w…µs„°‚„µ…€¦ƒ” v›~‰œsŠ¦„ˆ¦|›}‹§‚›¢Œ˜•~¢˜‚›•“—”–›–ØŖ˜™§– ™ŸŖš„¤­—Ŗؘƙœ²œ©‘•±ž•¬¢®š›¤–¤™œ ˜’ž›“„š«“†¢š­Ÿƒžž°«³”|Ąœˆŗ£Š¾™„æ”„Č©wŅ²xĖ¬rÕ±uÜøqÕ·mÜ®kå®`ܧhį¶aźµ\ó“Vēµbš¶\ģĄ\ęĄaį¹`ćÄVąÅeī·eęĮtŽ¼nē¶jß¼pŲ½lÓ“\ŻµpźøvčÄqßÅuéĒ‚ŌÄtŁŠŁÉrÖŅpĒÓqÓĶnŲŌjŠŃiŚŪqĻÖxŠākÓÕlÓ×_ŻÜcŲŪaÖĶ`ćĶQÓĻUĶĄbŚĄTāĖUį¾OŁ¹[×æQŪ“VÖ»IÜŗKŠ¾J×¼QŌ®XĢ¼NĻŖWשPѦ[ÜÆ^Ł¤WĻ–IӑFŌ AŻ“DזDŽ‘SŠ FŚ£QŠ¢DĶ¢NȘ^Ķ¤VĖ¤PŅŖUŚNĖœHŚ¤DזPĻE՝IĢFʑAæ DƞK»—D½ G“ž@·‘Eŗ”AµŠ6±ƒ5­@ؔ@¤–6¦–<¤”A©J؜Fž“JžR°ŸT§£R¶E·•Kƒ?©ˆ:©Ž:®:±…C­<®ˆ1«‰)¬ž*²!؛#µ˜'Ƙ!²¢¹£Ŗ$”£$„™&‘›&œ’3“›06”'’”3–˜&†Š$€‘2Œ‰'Œ‹!Œ–*—#‚“+‡“'‚“1ˆŒ2’A‡F—}:—E†E‡{FŒ€I™†V”z]w\¤wc§uk›mp£yi§rtŸkr­nh¬wpžm[ xo¦lr£hn¦ej§sq’uq—mp“r{’pršnx“s{kn”hr’ky—g‹š`ˆ˜k‡”h‹Œl…›f}’\ˆ¬Uˆ„W”OsŸ^ož\{©Uv­S~¬O‚©I„­P}²CƒµF}·A~¬H†¬A–»<ŠÄ<Ē6Ē4‰[Ÿ\ˆ¬h‰©f‚Ŗl„©w…¬yˆ©t|°{{³‚‚¬€…›–›|Œ–‚ˆ”…Š¦z¢~”¢š¢‚ž”†¢–™”“”–“¦ ©•˜ž–”¤Ÿœ«£¢Ø””„š«™–®˜§’“©“›¦Ÿ „§›§„¤™™™™ˆœŸ†ž”« ƒ©œ~£™‰§§ƒŗ«x»«{ĀØz¾›ˆ¼˜‘¾•ˆĪ ƒĪ£‚Ų«uÕ«wĪ„zÕÆqÕ£jקcŽŖ]ė­]čØeń³^ķ³Sī·Yé½\č²`źĮgŽĀ\ą¼dä½hćÅjā½tŪ¹sć½pä¾sŻ»fā¾uéæučø‚ē»ŪŹ{ŚĖtŅŠoÓĒrŌŹyĒĻqĶÖnĻŃwĒ×qĻŻmĘŲjĶÖmŃŌfŲŪ`ćÕYÜŅ^ēŠXįŠXćĒ^ŁæVįÅVßĀKŲµNÕ·RŅ¶NŹ²JÖøQŃĮUĻ²TŃ“RĶ·XŹ±^Ī«RĒ¬TĪ¢_Ó¢^֖XŅ”R֓SܚLӒQĢ”KʖKѝNĶŖDČŖKÅ¢PŹ©XŹ©QצXŪŖYŅØXŠ©TŠ¤MĒ SĶ—GŠ“GʖIƟNĮ¤Fø”E“„E“œNøŸI»›Iæ”Fµ‡;³‰@±‹?¦•D§@¢š@¢”E  >¤žJ ˜Fœ–O¤™R³’U·˜Pµ‘C§Œ<°<«‡9„’3­7°Œ;¬Š3Ŗ˜.®š0§›0«š%ؒƛ©§²¦!¤Ŗ"›¦)•”'˜¢0š¤-•˜3šŽ3–‘.Œ‹(Š‡-~‡'‚.ƒ”.„”"~š(ƒ“"…—‰'(„ˆ.’5ŽŒ<’F˜„B‹?Ž„@•EŒ‡Q’~X”ƒTœ‚b§t_¤j]„jjØsežri¢w`Ŗvg±~l¦ulŸzi¤rt«kv¢op xr™pg™xmŸxr or£l}›rt”tx˜f”f‚œ`ˆ—\‰“aƒ’dŒ›`‡›g‡£`}£Z„”\«Tt©Pv„WŸZ{žSz„EwŖGy«@‚»I…øA†·@Œ¾:Œ³E‰¶>ˆ¼8ˆĄ?Å=‡cŽÆ`¦gˆ”lŒ„e~Ŗh~·ey°p{µm«zŠ°sœv— r§€’©sž~œ~Ø}™…™’‹®— Š ž™¤“—Ÿ—ž” °— ”›˜›Ÿ« Ÿ©›–¦”“²˜–¤Ÿ”¦Ÿ„­ž•Ÿ ˜››”§š‰””ˆØ–…¦’Š™†¬©|®¤ŗ«†¬‚³˜„øš‡½œƒŗš‡ĆžsĒØ{ŲønŠ¬oŚ§vѤsą±`ć²aåµ^ā·hąĮWéĄ[öĄVä²\ķ®fć“[į¼[ąĆcŚ·nŚøyŽĄnę“v×»m×øiŲ³rēĄeēĆpā»uä½åŗzŅĒ}ŪĶnŲÄqÖŹjÉĒpŃŅwÕŅjŚŌmŌ×kŃŅfĪŅvÓŲ`ŠŠgÓĢ_ŽĘSŌĀRäÅVÖÉLŪĄN×½PŚ¾PĢ¾TÉÄXŹĮNŃ»PŠÄOŹÉKŪŗUŻ±]ʵ`ĮØWĶ¬ZĻ“]Ö§\ĶžcĶ•QĢ›MܕJŠ¢MŹ¤FӝRŅœPÉ£WÓ”XɧEĢŸUĒ¢MɬNŅ¬QČ°WÖ¦^Ļ”WĮVĶ™JƓMČ E¼™IĖQĀ¬AĆ«OĀœPæ™L³ Mŗ J¬“I¶˜J¤‘>¬’;³–8®˜8„ŠC¤’9£’?Ÿ•>˜‹?œ–A”ŸHŖ˜H­¢F§—HŸ—C£…7¤‡6«“;¦‰3¤•6£’4®‡1Ə0®‘2Ɩ/³"ƚ„Ŗ"«®%¬§ؘ%”—%• 0™”;Žž/‡™3‰”,…Œ5ˆ™'{•*y)€™*„–z— }–‘(‘+‘—*Š”5‘“8‰Ž2‡@˜‡<™F†7‘ƒCŠ’T™QŖ~O«wVØtg§rlÆplŖl^¢{`”}f¤}m°to©liŖugŖzp¬ll¢w~œlmØ~r™~vœzt™wz•du™fm˜qu™tr›l}—aˆœf…’iŽ]žb†›`ž^y›WvžW~Æ_u§Z€£Uƒ¤Oz„R‚¤J®L}±J}“R“A†»>’¹?‚ŗ@‰µB‡µ:ŽĖB’Ź;†^ˆŸS€„a”f‰„n‡¤ez²]}Ŗd‚³g”­e•Øh‘œp‘Ÿ|Œ§xŸuŒ y–”t“œt”˜y¤Ž~«Š‚¬—¦•–œ˜–”Ž•Ø‰œŖ’£¤’›œŽš˜‘©£ž¦™žÆ˜˜Ŗ” ™™›©Ž¤¬’„ؓŖ£‰±¦€©žzœ—xž”„§˜|¦¦‚­œ†§™€Ŗ›ƒ“’}½›ƒ¹Ŗ„ŲĘØrĖµmŹ¶pŠ«tÜ­sŻ§pŚÆhąÆeŻĄlā¹`ßĀZāÅSōĆWļĘbį¹`ßĆfęædŽÅiį¾påĄsßøvā±wÖøqŠ“zŲ“tŻ¼jāČiāÅgįÅqŲĄxŲæuŚĄyŠĒlÖĘqŃĆtÜĶsÖĻlŽĖhŚŹnŽŲpŠŲoÓŚnĢÕ_ŅÉQĻĆPÓ·]×¼XÕĖTÜČKßÉPŠ»IÄæMČĆXÄĘKĢ½LĻ¾RŌÉPŁ¼]Łø`Ł®eČÆZŁØYŻŖbŚ˜eŲ–dӓZŌ’Q֜TĻšQʛOŹ¦OÄ¢NȚ[ĶžWŌ¬LÓØGŅŸPŅ¬YŹÆPÄ“UĖŖbȤV¾™Pæ›QŕFŝQƜLÉ£GĬF¼®D¾žIĄ O¼ EŖŸK¦•Bœ•D ŽBƖCƕ7Ƌ:”‹BA™@˜Œ?œŠBœ“;„—<¬›F¦šH«žC¢’C¦“6„„0¤’5ƒ1­Ž+«Š+²Š/­ˆ&©Ž1¬,¤Ø*¦¦ ”©(§¬%§¤!Ŗ—.© 7”š/”2Œ’6ƒ›.„—+‡—(} 1y”5u™(p¢#w {œ‡‘Œ—Žž ŒŸ-‰˜+…‘.‰“5Š‹;„FŽ…>–<”D™‹Nœ}W¤zO®v^Ŗpf®q^Øm^›odšsdzr§vn„zjØog¢tp¤kž|u¤nz©|u­|~„rt—wmŸhy—jv”snŒqk‰s€•k†Ÿg‰˜e‡Ÿ]™\†–Z_ƒ”j{œeu bt£Xk©Y~¤X‚šP‹Dƒ¦Gˆ¬K€¤Bƒ­J“C‡Į@Š»:Ä=Š½5†½:“Ę>”Ģ7‹R‚ŖZ‚§]ŒØ\‹Ŗ\³a®[ˆ°k…±aŒ­eŒÆm—«k–—o”f‰‘mš z•Ÿv”›‚”“…œ†£‰‡¤ƒ—Ÿ‘˜Ø‰›£‘ž¦Š—­˜œŽž ˆ«–£˜ Ŗ•œ„š•””‘¬œ›œ˜Ø«’¬Æ…”ƒŖ؀Ÿ–xž“ƒ”Ø•…© Œ¢“{¦•}¤’†§Ž‚µ”€Ąu¾Ŗ|Ę£kÄ“hĮ°pÓ¹nŻøtÜ®wŪøkŁ“nāŗmÖ¾lŁÅcäČ`ėĮ^ē¹Yß¼cįøXļĀeŻĄcŻµrŲĄjדoŁ°nŃ¹mŽæhŁ¶mߏjäĢcźĻhŻĆjŁ»tÜŗuŁÅf×ĶjŪĆyŁĒvÖĢiŽÓiŲĒoāĪpŃĻjÜŲlÕŅbĻŹVŃĆVÖ½QÖĀ[ÓÄPŌÅGāĶLĻČF×ÄP×ÄJÓĘ\Ė½XÄĮRÓÄQÖĢPą·bܲcŚ±fŁ±_ŁÆ_Ų§iāŸc֜dŚ›_Ģš]Ļ›WŠœX՚\Ō®QѦV֚OŪ¬PÖ¤ZÓŖJљVŲ¤^Ė§YČ®aĪ¢`Įž[Į—XĒ¤JŗŸNʜHŗ¢TĀ£SĮ£E¶¤Bæ£KĮ£@¶™8ؓ6¬9ž”D˜„=¤‡5¢’4©“<¢Š:˜Œ9”…A£‘A¤Ž6”;©‘HžœC§‘G،HؐH?ŖŽ-¤‰9§Š9«‹'§Œ1­ˆ0Ŗ‹,§™#¤” ¬›*ŖØ$žž#§”)§„%¬Ÿ$¬˜. ˜6˜™/‡Ž+“*¤3‚*w„*|”*t”/‚¦„š„ ”%…‘–‘”†ž"‹˜'’š.•—/˜‡D ;——;œL”‘R•„L~JØ|U©kb¦mažka i^”jfš~j„|m„qg©vo”iØ~p¢~uŖns„tx«xtØu}•ty•pu—fu•dz˜kt™ky—_ža‚–bŠ™b~¢hz›e„£\z›^~›\s©VoŸ^x”P~ŖRŸP†„I¦M‹¦T€µF†ø>®I—æD‹æDŒ½H¼<…¾;ĖG—Õ;ŒZŖU«Q…„R†Ø^{³Y~°c„«c…Æ^†²]…Ŗc’¤e˜œkœ˜e‘k’Œu™ž~‰Ŗƒ†Ŗ‡«ˆŽ„…¤ØŽ„Ŗšž ””¤˜§¤©¦Œ©—™°ŸØž¬‰Ø¤”„¤’œ„†¢¬ƒ¤¤} „x¢›€©˜| ‡£™Š”‘… ‘ƒ„”{ŸŽ‡Ŗ˜ƒµ—y»Ÿuŗ¤m¹­j¾·fʵrĆ³gŠ“jŌ¾hŠævŅĄ~įĆuåĶrŽČdāŗoź¼hä½jķĮ\ź½]ź¾cŻ»mÜ·kÜ“dŪ“nŻ·jŪ“fß“kŪ¾qÜÅočĖmąĀyäĒsŻÅqŚækŌĶsŅŹpĻ½pŲĮtąŠx×Ķj׏pŚ×dÕŁ\ÖĻ]ÕĢTĢĢNŚÄIÖĀPÜĒSŃĖQÖĀOÖĄDÓ¼GÓČJÉĖGĻæOŵZŹø[ѵcŲĮ[āĮcŪ¹[į·\Ś±aā¤Zā^ŚšdŁ›dŠ”dӖYŅ cŅ›_ĶšaĢ„bĶÆdŅ©TÓ¬XŽ­Yā§[Ö¤WĶ¤UÕ©cČ«ZĘ£^əVɛS¾œM¾£S²¤U¶ŖX®¬V³„Lŗ˜C°›>±–8·š6³™:ŖŽ:„“0”‰1¦Š-™†9’6£8¦†7ˆ8 ’.”5 –<”’B„H¦‰HŸ‡Jž†Až†C؆9¬z4°}3°9­‰.®Œ+¬‘)„–%¬—$±˜'¦˜+®¤.Ø”%«§$§¢$ؕ"¢”,˜‹$‘+†–0†Ÿ,{„"{š'„.z§(ƒ® „„(‚ž%}œ!~˜ƒ—)$”™!’&Ž’)“”8›–7—–:ž“8•†@š‰M“ŽF—ƒO£€ZŸvfšms£un™|f›rh sj§}b±yo©{m®}j³xm®uvÆxz±x~¬qy wužxu’vy”ix•ho˜`sžet•b|”[ƒ˜_„ ]}d|•\u˜`xžVoœWtž[sØVv„N}©GŠ¦?”­GŽÆI“¬K‘øMŽ³=“F—µL—ĮR“ĘJŒÉKĆLˆÄB‘ĪC“T†¶`Š¤[‰®Y…£Z}£^}±`~¬g€¬c‡¢d¤^›a–ž]——q–d“Œp›‹u¢z”‰ˆ”…‰Ŗ‡„˜£—› “¢„—™„•¤‰ Ø ”Ž ™‘™ž—œ™‰„›Ž©£„£Ÿ¢„†§¢‡©”†­Ÿ„Ø”‹”…œ™ˆ¦ƒ¤‰¦†„Žˆ­–‹¦œ…³œv²œwĮ›g¹©m»„fĄÆvæ³mĢ®pĪ“yÕ¾rÕĘoÕČmÕĢnąĘlŻøoß»jßĮ\ōÅeå»^ā¶lēĄmŅ·gÖ“`Ż®cÖ³hāŗdÓ¼qŪĄuŽ¾rįŹrćŃfćŹrć»qŲ¼jĶĒpĒŠtĢĮqįĮ}ŚĆlįŌiŁŅqįŠ_ŠĶkŹŹ]ĖŅSĪÉNŅÉVŻ¾HŌŹMŠÓQĶĢIŌ¾=×ĘOĒŗRĻĮGĖ²SĪŗXŠ¼_Ī¹]ܳaŲ±VŪ°Vį¬_ąø\Ū²]Ū„]Ü©^Ż¬_ŚšYŻfӞWĶšSÕ ZĢØ`Ą VŅŖHŠµQ߬SÖÆWĶ¦[מSŹ¬XĆŖ]¹šg¼©aʤLĮ£M²Ø\³ŸMŗ¢VøX°ŸC·¦@²˜L“–>³›>Ɠ7¶“9 ‹5§‡/؅/¤~: B£–=Ÿ‰1 Œ<¦†1 „1–ƒ?œ†HŒN«~N …KŸ†<›Š?„ŠBØ}3„ˆ-|,Ŗ‚+¤‰6©2§.§œ, ˜0¢+ؔ#²”!©§¢Ÿ* ¤"« *”˜'Š›+„£"y¢*~Ŗ0|¢"„Ÿ.~¦'x£+„Ÿ&uœ&~“&ŽŽ0•™-ž  Ÿ+‹‘8›œ>£5œ—=ž’<Ÿ˜=””LW”‘M•ŠS›{j xm£sc•um kežzf§|k­i©sq„zt²vs°wtÆv}°|q®tsyp®~o¢km“fw’fu¤e}’`yg‰›b…`}š^Ÿb…ž`–[v ]| Tv§U€“L}ØTÆJŠ±LŠµRƒ­L‰°@ˆ¶C‰·I•¼E¼D‹ĮO‡ÉX—ÄF„ČF“ŃL•ŃESt°[{ØYƒ£VˆØV„£]Æ`¤`„§^•°Y”ØUˆ¢\‹aˆ’o“rŽŒešu›t›Œ„¤‘‡”ØŽ”§˜’«œ–”™šž“™¤”Š¦„‰›”’Ÿ—‘˜–•š”‘’‡˜”}£–v ¦}¢~«’}°‡Ø†Ŗ–©”„ØŽ‚”‹{©„ˆ¤‹†„‘ŽŖ†­™‚°šr³ iĝjĒo»£jĀ¬iĶ¬tĪÆvŚ¾xÓĢjÖČhŌÅdŲĀpÖ½dąµeę¼]é½dė¼jŻ¹hÖ½h׳`Ī·^Ņ¹gąæjß¼hŽĆkĶÅmČĻsŅŹpÓÅnäĢfߥhį¼gĪÅ`ÉŠfĖĶtŽÅvåŌxąŁqÖÖqŚÅh׊gÄÓbĒŹ^ŃČLŪĘRŻĆKÕÄUĒŹMĒÄPĻĀCĖĀ@Ė³MŹ»OĢ¶MŌ³WÕÆRŪ»RÓµ_Ł·_Ų°Z×±Yå²^ė°eß±`ŁØcŁ°]Ó§ZŁ™hŻbÕ£TÅØVĮ”U¾«KĀ±JĒ²JŅ¬LĪ¢LɛWĶUȦQ¾œU·¢dĮ§YÅØOŗ­V¶”S¹™LÆ”O³£R¶œK°˜JŖžM§—F®ŸG±žF±“:¢.£1ž†<£‚:Ž8”–B©–7”„/¤}1šƒ2™ƒB™‰I¦…I¦Qž„M¤zF ƒ:£…:—‚1›‡8Ÿ7˜ƒ.œƒ1˜“2žœ)žš*œ”&Ŗ—(«”&¬¬” ؟+žŸ#£§( °)“Ŗ(Š®0y¬+‚§*‚©&¬&ƒž2›'|›&{›t•„˜ Š•(Žš(–™+˜ž.Šœ=‰–C™8—–E“—A•“D–—L˜’N“Q‰`Ÿ‰^˜z_•xc™mf›op„zk¦ƒi£ti«se nk¦oyØy{­xvØ}}ŸxzŸ‚|®msq›gw™sžo~škƒ—j„›c{ g{¦Z‚ Zˆžc}œ\y¤_{®b}«]…µSøX«[Œ»]»Pƒ¶H’°D¶Q“²P‘“M•ĀB‹¾RĘU¾NĘMÄL‰ĶN•W}©X€ŖN…­Z…­[‰¦\ƒ­[ƒ«b‡§^‘©]ŸW‘ž_‡œe”q“ d“oŠ˜pŠ’s—‡{œ‘„‘‘¢Ž’¤œ©š’°š”’”Ÿ£š”Ŗ’œŽ””Ž”–Ž•š‘Ž”›xš”|œ¦vœ£zƚ{«„©†²§—~­‘…ØŽyŖ•„§‡„‘‰©ˆ‡°|§šiĄœn½”iĀhŗ©h¼¦sĻ°zŠ¹wŌ·mßŗhÖĀnÕŗnč¼fŻ¼då“gå¹Yā“eÖµ_Ś·jŁÆ]Ó«bŪ±bĻµiŻĄbćĒ`ŲĆaŲĮgŲÅ`ŃŹfŽ»`ÜŹYŪĢiĻ¼gŲŠ^ČĢpĖÄkĪÄvŪ×}ŽÜjŁŅhĶĻgĪĒ\æĶWĮ¾TŅŗSÓĘTŌĀIÓĄDĻÄNŽCĹCĻŗLÉ«NŹ»KĢÆHŅ·XÉ«WŲ¶[Õ²TĪ­RŃ¹YįµaŚ¬^×øaį“fÓ«e×°`Ś¤h՘cŲ˜S×¢TĀœTĮ£O·«SČ©D½ØF½ŸA½¢QɒGəPȞXø£]¾›f¶”SĘ©QĒšL·™Q³™U¾›L¶—F؞B¬§D±žJƟAŗ”J­ŠJ«‰C®‘3˜‹6”„3;”“?”š9—‡7š‰6›ƒ<›Š4£‚;•~G¤€K|R˜vP †J“…9¤ˆ:~0“z.šz,‘}6ƒ0š‹4“š-š—$“+Ÿœ(«–) Ÿš.ž™#œ /›¢$‘„4£&”'y ){¢5ŒØ3Ž-ˆ™7ˆ§,{›"… €¢‚ ‰•3”-‘—/‰ŽB‹’C”<™ŽD—ŒA˜˜O››R›˜\„žX•`©e£’_„d•}^¤tbœxrØzjž|e«rbŖ|iµqj¬x®€~„w{«|œ„}­{°zr«q{›g…„sz£pw™n~”v€™i…£j~Ø\|¢g€^}ž`x„e…Øfƒ³W„Æaƒ·T‚øZŽ°Wˆ³M‚·Hƒ“E“½G…¹IŗK‰ĖHƒĄIƒÄTŒæR”¾MĻS”ĻR”A†¦JƒÆQˆ°Uˆ°T‹”Q’£K¤UŒ”RŒ¤\†–e}–`‚ _‡—kŠžr…˜gˆ”eŠ‡oŠ–•ˆ•‡˜ŽŸ™ˆž ­›˜„™•Ž™—¤’¦‡Š™‹Ž“•–”•‘}š˜s ”zœŸ|§’w«u²‘}“—t©”y©y«“³’‹Ŗ—‡Ø–‚Ŗ‘«Œx¬•o½•tƟoĒ£kĄŸsÉ£tÅ­uɬyŪ¬nå²dß»dą·ačµ^ŽøUą¹]׳^Ž·_ß¼dÖŗ]Żŗ]Ō³b×ŗgÓ¶fÓ·]ŪĘcŌĄcŃÄ]ŌĆVÕ»_Ł½aŁ½]Š»ZĪŹ_ÖŌlÓĪlŃĢsĶĢuŚ×rŁ×tĻÓbŹĒZĻ½ZĆĆTĒøQĘ½SĶÉPŠĒDĶČCĢĒBĆ½EľOÉÆZʱVɹKĖ¹JŅÆJŹ²SĒŖTŅ§QĪ¦UŲ“\ß²cŻµbŽ²`Õ­gŲµhדiĢ³aĻ¦[ʗ]ɗXĖ’Yæ–M¾„H½ØM“¬Qµ G¶£MĀ”FĚMĒ”X¼ Yø£[Ą¦_ŧYȦMĀšQĮ›M¼™Q°œR¦¦H žAØ”?­—<µ“H­ƒM«„@¤‚H—„@•ƒ<‘Ž<‘”7ŽAIŸ@™<Ÿ‡7؁5¢}>¦ƒC¤|M”wG’‚<y0”}5˜z2‹}3‘‰<“ƒ:—€8–†)žŠ$––*’’'™œ›˜ Ÿ”$”–.–£,’­0—Ŗ/¤7„¬.Š 1„3€ 0‹”1„*ˆŸ+„Ŗ(€„€¦€”"š'ƒ™6ƒ @‡™?…Ž=†Kœ‡O–ˆM˜–Jž˜P™”[˜]žš]Ŗ›g±™c¦“^Ŗ˜b ‹] ƒg e£{m ~lÆrq°vo©{yÆy¤|l¦|p„„x”|¤€|«twžy¢r¦r{ØjŸr€ pv¦b|Ŗd³^y±c{¶^€«]~§iy±g·d‰³`ƒ“U“VŒĄX»K‹¾CŒĮI¹Iƒ·Qƒ·S~ČK…ÅP‰ČRŒ¾X“Ä]ŽČZœŃU L˜L|Z}œXŒ UƒŸS˜£KŒ¤S‚ž]ƒ›X„›g‹–h…¢`‰ša‡”lŽaŠŽi’x†‹Š’šž†—•—›’Ž§ †Ŗœ”Ÿ’’ŽŸƒ™Š…—Œ‰›‰ƒ”Œ„›Ž‚–‹}’z¤y¢sƙs©–s“ˆ±“؎{؈š’w­Š‚²ˆz§’­—t“›zŖ›g“•w¼qŬxø£n¾ØqČøzĢ²uį­lß“dÓµ_Ś·hą©fćæeŲ¹YŁægŪ·]×±]Ō·SĢ¬fŌ±_Ę»eŌ°fÕ¶]ÉĘ]Ī¶QÅĮ]ĻŗPĻĘ\Ņ·Q׶]Ź½eÉÅdĒĆ]ĒĻjĻŌuŠĶrŅŃqĶÓ{ÕĖgŠÖaĒŅ^¾Ā[ĪĆQżSŠŹLĖĪDĘĪGÕĻQĶĄI¼ÄPĪ¾WŹ^ŹæWŠŗTĶ±YŹ£ZŧLŠ„JĻ²\ŅÆaŠŖcŲ¶\ŠÆ[ŁÆeŲ­iŌ®bŅ¬YĶ³_ɜRŞZĢ™]ƟH¾ØN¼§IÄ¢Q±ŸP¶¤EƒDʏE¼‘TæœU¬„XĮRĖ PĀ”RĆ£V¶T²§W²¢GŸŸFؤCµ–C“›?ø˜O«‡CƍF¢’>•ŒKŸŒ9˜‰5šŽEŽGŒ‡?—‹B~<ŽG†:vA§AžyIvH”yBˆƒ:ˆ€B–}7‰‚;˜Œ6š‘DŽ‘.“*žˆ&œ/””.¤Ÿ!˜›¢™š'‘¤'Ÿ$’”-Ž¦.„Ÿ-£&Š¤(z™8|›:†š4‰›4|„&ŒÆ%y§‚˜!ˆ™1ƒ 9‰8ƒ’B…L“N‹”@Ÿ’Dž”JœLœšU™_„–f§›h”“^²f¢Œ_œf ŽXž^„{fØwjÆv“‚x²zs«‡t„€t³…s …sœt‚±|€Æh£kyŸ~‹¢~‚®v‰²p}Øn{¬qv°dz«pˆµk|¬i·`‚·aĀc|³^|½f‡æg†Će†¶T²R‰ÅT”»E‰æM…¶_ƒæRĆRˆÄU•ĪU•Ī[’Ķ`—ĒW˜ŌSŖOwŒZ|“Z‚”M‚œQƒœLO…„[‰¢UŽŸ^‰b‹_‚œU}™Y‰[”d‹m‡—uŠ–~—’z›š‡š„‹Ÿ—‰„ž“¦˜‘™‰›„–…”œˆ›‘“Š‹œ’{ ’v–’‚›{¦šp”Žk©’s°‹…¶ˆµ“‚§”z˜†~š‡xœŠ€Ø‡~«…t«u­s“•k²¤tøŖw“ÆfæÆeÉ©pĢ³wŠ§zŁØpÜ„nŠ®hŲ©fß®bą½fŪæa×ĘdÕ½^ÕµZÜ“ZÉ«`Ę³aĶø[Ć°Tæ­VĒµRĪµXȱSČĄVĆĮPĆ·XĪ¾WŌÅ^ĶĘ]ŠĮ]ĢÅlŠĢnĪĪqĶŹsĖÖsŅŪ^ÕÕYŅĖaČŹaÅÅZĒ¾VĮČJĆČLĖĮSŠĘRŃÅOļLĮÄJĢĆTĒ½PĘ¾OÄŖQÄ„W»¬S¾¬TĆ®\Ģ¦bÖ¬[ĪŗdĖµkĢŗbŹøgĘ“hĖ¬]Ą“VÅ„Xæš[ĮØRȬPĮ®UĮŸN·–J¹G·AŞ@¼œIø‘J½¢H±¦IĀŸPĀœVŔPĄ›Y¶ŸW©§S±ŸSؘDŖ”@°AƍD¬LŖL£@„L˜ŽJœF†7˜…AŒ|Gˆ‚;Ž{<”‡>ˆK•}Q–€J¤‡L¤Q“sJqAŠ|H‹~@Œ‚Eƒ=–A•B””6˜‹.Œ*ˆ-šˆ*“)©Ÿ(؛š › (ž›$§#˜ #ž)†¦.‡ž.~š8uœ9|7ƒ˜:…›.‰©+ˆœ'uš&’&Šš/‚”7‹I‰G‹›@‘–Nš—K”—R’ŠVœ™Uš–V‘Yž‹\¦Œ\°˜hؓg©“]ƐW„‘]²eÆzf„nŖ€x­‹vŖ†s°…q·‡{©|‡£v‚Ŗsz²k‚¦sŠ”~…”­|ŗx„øg}»d†»o­x°u…¾j†¾n|¾o†Äa~Ąa„Ēi…Ć`ŠÉbŠ½Y¹MŽ·G–ĄR½[Æ_†¾^‚»^ŒÉf™Éb—ÄgŽĖ]–ŹQ–ŃQ„T~˜P”K{M‹—V‘˜K“”W„ŸZ•V}›U‡‰X‚Š^‘X’`‡_ƒ‘l……j“’u•—|œžr›’‚œ„¤š‚„“ƒŸ•‡£—˜š””§—Ž¤‹€ …™…‰£”{¢“s‡v›’xœ“sŖ‘q¦„y­‹€®š…®‘Œ¦Ž…£‘{“’u›„wŸ“z„Œt®ƒw¬‡n©Šhøšv“ j·±m·±kĖ«kĻ¦lŅ¤hÓØdÖ®kĪ­b׬_Ł§eÖ±]ą“Y×®TŪ¹_Ņ°[ĻÆVĪ§dČŖ]Ź®]Č«TÉŗMĆ½MűXĘ·M¾¼YĢ³\æ»ZĮŗRĆ½^Ę·]Ė½hŠŗfĻĀkŠĆnÉĶeÓĪrĒÕgŌŚ[ŃĶ\ÕČXĒĆUĆŹ]ČæPĒĶQŹÄWČ½NĻ½KĆøIŅ·]Ń²SĖ²\ČŗRČØOĮÆYĄ§U¹£YĒ«SƤaĶ¦dÓ®jĆ“\¼°fŹZ¾¼ZÄŗaĮ­Tø¤\Į¬fĆ­TĄ¬UĒØTʦW½–HµœK½£Iŗ¢H¼ D­ HøŸC¼„S½™PĞNø¢Tø N®›V„›V¦¤EŖŽ=،A§’Fž‰OŸ”T§”Q—ŽP¢‹K”ŒIŸF“‰;•„B“ƒ9“vC€<†G’„Hš„IœvP„K—ˆS’wI“qB—qD‡‚EŠ€<€>—†;™B™‡4 ‰5“‹0ž‚.©†1¬‹& ‹¤‘%œ‘%”™#’˜+—.‘ %”%‰„'Œ™*‚&x 4xœ9x”:„ž<„¤&zœ0€—)…„4¤9‚›:ƒšI‰’G;‹šH ’Q›’R——_”™b“—] až“\±œeµ˜k±—i³˜]“`¬“f±•hƐg“nŖŠx«‡{®‡{©w±|­€‡¤z†Ŗ®p‚Ÿr†£~‡”„‘°‹®‚’µx‹±t}Ā}}¹}·tŒ¹s‹Ąr|¹nˆĮf„Ąd}ĆnvĒ`„ĻcŒ½a…¹M‰Ę]ˆĄS½_Žø_‰·dŠ»\†·`Åk”æh•ĶZŽČY¢ĻW›LŠ•S†•P€ŽS‡‘U‚–K‰V‘’O…•S“J{‡X|ŽT‚‡XŠ‚e€rƒr‰„q‚v˜|œy”–w—‘†œ‹Ÿ“Ž””Š˜™Œœš‹“›š’Œ…‰€ŸŠ€™Œw €yšƒs™~x…w ‡™…uŖ”€Ŗ“†Æ—‹­‹…ž‰„~”–£“w¢’x ˆv«†t¤s؝u²£m³ t¾¬kĖ“cĪŖiŅ¦fĖ­cŌØhŅ¤_Ś£XÓ¤bܱ\ą²ZŲµaį§VŅÆYĪØ`É„aÓ®Yȱ_Å°WĆ¹[ɵOĘ°Zŗ²TĮ±OĒµXĪ¾SÄæ^Č·[Ļ³_ÅælĖŗnŁĀoÕædĻÉhĪĶlŠŲeĘŌhÉŠcŅČ[ŌĢWÉŹXĀÅUĄĖLæĘQĖ¾YĘ¼UĪ¾W×·WÕ±\ĢØ`É°\Ē¤PĄ©QÄ­P½©V»¤RĒ©WĪ©YČÆfĮ¬i½±_Ę¹TæµY“·W¹Øb“±g¾¬aƱ`æŖYÄ¢SşN¼ TĄ”Q¼šR·šEµ—H°¢@¶§Hø›LøšXø˜R¼šO¶„S¶ M„Oš‘BŸ•F›•HŸ‹TœV –N¢’W˜—P ’VœLš‚E“‚A”‰=•~9˜…;‹~K–~K’yM–{C{I—…I~S–„PyJqOyMœ„L—‹GŒ;’Š?œ….–-›–2ž- ‡+Ŗ‹/Ŗ‘,£•$¢’&œ‹&‘‡(Ž’+„*š%}—£)|¦/|§*s«1v”9~©1€«/…¬+¤6vCz§Eƒ›N‡˜EŒKˆ’G–”I–“PšO‘˜[™h™ŠdŸ‹l§še¦˜e®˜f³•a±œZ³šd»—cĄž`µ•lø…s±ƒy«ˆ†²ˆ³Œ“ˆ‰ŗ°‰€¬€ˆ¦vƒ¦v}”z€«u‘®±|”±ƒ²‡‘¾y‹½uŹtĢs„Āy…Ąg»e€ŗ\ƒÉaxĒb‰ĶZŠŃ[ŠĘZ‰¾V‹¶X‹·`‰øjŠĮ^…¼bĀf†ŗmŽŗn—Åc–Ō_Ń_—T…›O—R‰‹G†šJ‹ŒG‰S‘RI{’NŒVO}ŒYˆ‹`ˆ—gˆ„~‘ƒp‰Œq‘‹~{—u›Ÿ†˜œ‹ž“•˜†œš—š‘•‘‘|‰Š•‹„ž‡€’‡y‘„r™Œv•}j™„o—‡o—•{˜‰u«–ƒœ†Ø“©‹y—••†z¦†w’w‘x y£k®—j«œm®Ÿp³¬sŤdĖ°eÓ³bĻ“VŹŖ_Ī£SÕ«aŁ©bćØTåØRęØ`ą®YĻ³\ÉŖ[űZĶµQĀøX¼°YĢŗKĆ½UűUĘøS¾®MĀĄV·¶TÄŗZÉĄ`Ķ²ZĘ»hŠ¼cĪ²jɳfĘĮiÓČtŹŅaČÕhČĮbžeĘÄSĒŠZÉŠKĀĶIĮÄN½ĆVÄŹ[Č¹ZĖøQŌĄdĢ¹UŹµ[ĮÆUĄ¬\·„\ÄŖWĀ©XĒ¢UĮ²`Ļ§X»“VĮ²\Ä„S¼¶Yæ°_¶ÆUŗ©`ƧZĀ³^Į®T»œPƟK¹“A²ŽD¶œ?½F·ž=«¦;²£C»žJ­˜Sø F»˜O¶˜FŖšG¤£O£”G›–>§ŠD–’[ ‘X—M–’U¤’G •I›ŒG‘ŠF“|A~5•‚9”‡FŠˆBvB•@Œ‚M—zO‹rHš~S”tQIˆROŠ‚J”€H˜HŽ„I”Š@••=›’.˜™4žŽ2¢6“‰&–Š)”– š'•’(•—/Š+ƒ %Š¦0~¬0ƒ©0w£&€„/r¤:|­.zŖ5tŖ-€„/‚œ=z—C•=’I„ŸF„™I¤Gœ›Pž‘X”›U˜ŸX”hž˜i©—\¤™]±›h° `Ø”b¼‘h½fµ‘d¬’l·‰y¬yt·…{©€­„°•†·‹Š“Œ~“}„¤~†Ø€~„~“{•±z’Ŗ|Šŗ|°sŠ»u“Éq”Ąj•ĄpÅ}–ĘsĄj€Ēn‚ĆjĖczŹd‹Ļ\€Š\‰Č[ŒĄ`ƒ°fŒĮfŒĀf¼o„¹`‰¼mŗbæaŽĢ_–ĘZŽR„“H{”?‚›Gy”N‘R‡G†ŽDs”Av‘NuN|ŽSv—c˜jŒ’x“{„uŒ‹{˜†mˆn“–m“}•™Ž‘”›„’…ŒŒŽ••}˜–‚š|—”s“‹u›h›ƒlØyj£|qŒwž—o„”x˜ƒ–‘}š”„¢yz¢‹n™…n”Œo—n›y “s¦”l¤¤eŖ˜b²j½ iȦcɲ^Č®UČ“OĪ¬Lß³JßŖVŻ®Tä¦ZŽØNÜ°SŹ®Pȱ[ĖµOʬHĹQĽXŹæMĮ¼M»µKÅ°WżX“¼T¼ÅQ»½U¶¶WĄ®]Ź±WÅ“`ĮÆ`»µ_Č¼kŹĮj¾ælĀÅ_ĖĘgŹ_Ć½[ĄĻUÉĢXĄĻNĀČT»Ķ]¶æ^øĄYĮĮRĒ¾[Ā¾_¾·_Į»gÅ·_æ¹Z¼©VŗŸMĘ”TĖŸOĬRĘŖ_¶¤\¶­[ĮŖ\Ę”XĄØSĒ²\æ®[Ā©S¹ØU¼¤P¾›Aæ‘?µ•G±™G³’9“™:²œ8±£<²”O«™PµžJ¼žB¼˜G¾›B® E§N ’G£›MšQ Jš’TŸ”WؘO›“I’–L”KŸ„=”:›†=”‡Cš‚C£xHœ{>—sK“ySQ›zI•†KŠƒUŒ}W‰yI‹~Mˆ{F‘€E›D˜ŒE@’œ=š™A˜‘@Œ’6”0—Ž)”“(‰œ1‹’<Š™5‡5†¢(Œ­%†¦0ˆ«(x /yž-u¦9m«8n¢0lŖ:xŖ6ƒØ7€•A†”9†–<†¦D…ØM’ØS™ Oš”V”›Y£”_§b£—dŸ‘Yؒ^±•fŖ’g­”q°Ÿn·š[¬–a°t±€g°wk®|n¬„w؋€°“€²‹Æ‡µ†‰°|~¬|…²~‘®}œÆs–²|Š²v†¶qæt¹m”ŗiÅu–æv•ĒuŠĶpŠŹp‚ĖcƒĀh{Ēh~ĆdˆŹiƒĄa…øj‚»sŒŗk‰Éo‡Ēj…Ģh‰Ź]†Ź]€¾\ˆĒVÄX–N~”MzIy”MsˆM|ŠIy‹L‘Fo†JJ|W{ˆKu™W€Œe‰r‡q‹‚|†wŠj›ˆrœ‘q•š{”†—•‡ŒŸ’„Ž‹‰—Ž…”œw’’{˜›v‹‹r™’mši•u§n”e™ˆk¦Žp¤˜|›››€””ƒœ‰y¤•z”Šk˜s’šs„p§—w©—k¦ž_²fµ„cĮŸVĢ§UĮ„R¼¬QŅ¦QŁŖMŅ”Nå¤Tß”Nē­Lč¦KŁøGĶ°GŅŖXĘ³GĖ»QĪ±FĄ¼MĒĮVĒ»PĄ¶\ı_·Æ[³¹Yµ°T°¶O¶µa²Ø[“¬gøŗb“²i±Ć`æĆiŠŗ[ĄĖVČĮaĖŗdĒ¹aĮĆV»ČZĀŠSæŌM·Š[ĄĘ\¼ĆY¶ŹV»¹`ĆŗZĄŗi¹¼eĄ¶Yø±_»±e¶Ÿe¾£cĞRŬW»®P·®L«„X±žU¼£R³ŸR¶šPæ›T»£Z¶¬O²£UĄ„Pø™G¹™B·’B¹Ž8®5“™<¶ŸH„™;„—OÆ¢Fµ˜K“•@µ”AƚK¬ŸJŖ’NžŒQš‘IŖŸV ’JؔQ«ŽQ§šU™”H”I‘‰@Œ8œ|>š‰C—‚?™„;™ƒA™xE„IŸ|HšrN¦xP‘€L•ƒG•N‡{B‰G†y@Œ‡A›ˆB’IŠ‰A…’J”L‰‘Gˆ•@†‰>’,‹/’œA—0€™0‚ž3„­)‡¤0…¢6}Ÿ&~£0}¬.}³,w¢,o %v”)z”0}œ-v;{<„„>„ŸBŠ§H‹°J‘£SžŖX’ TŸšW¤ Zž¦dž—`„›e¬‘hŖjŸ’i«—c³’h§–e©h²†t²tt²uk§‚u±}®˜ƒ®Š{“Š‡“‚ƒ±~‹©~Œ©t‡µŽ­y—«z…“x½m„¹gˆÄuˆ¶o”Āx“Ęl”ĮtŒĘu’Ķj~Šl„Īk‹ĀcˆĒ`„Ée…¾i}Āg€»n†ŗm¾eŽŌhŠÉkŽĻY“Ā[‰Ē\„Ė]”ĄSš?}ŠFt@|‡Hx†NyƒEu~@u|CvE‚~E„L‚“T~•d„f„r™Šv’ƒuŽ†n•‚p™r–{™“r’“u†ƒˆ‘…„‘‡„“|Ž”€žƒ‹™w’™i‘–h’k“—m’‹hœˆg¢†jšˆf›˜m¤›x™¢w™—z ”v›‹wžŠyž”wœŸm˜št•¤ržm¢£b«Ÿe³—^“žT¾ŖUĄØWĀ¤KĄ©OĀ¢OÓ£LŪœGß Dį£Bą®Fé­Eą¶?Ž°<Ļ±HűIżIŃæLĢ»LĶµYæ¾YĘÄ`Ē¾YĆ°\¼³`½©W®­T³§TŖ­]¶­e±·eøæg³Ą_ĄædŽZ»¹]ĀÅSĒÉZĀ½aĘĆ]ĒĆYĀĮPĄŠV¼É^øÄ_ŗČbŖĆX­Äg¶¶g¼ĄcĀ»g½³k³·a³Ø`¹£eøŸ[µ£aµ¬]¶¦L“©N±¤GؤNƘW­T»•VĮ„V¾„W· T»PĄ›DæŸH·—B»›;ø™:·Š8ø†=ؐF£ŸC§œB«›CƓA«š@±œH§’K£–W©•V¢–R®šP«˜K² R§–I§ŸQ”˜NšG–’D”’8—‰8œ†:•€9Žw>Š|=‘9”~B•€J|B˜L {JžsI‘wAŽv@‘€I‡†M‰A“}N•…M‹ŠC…ŠEŽ“AŠ’E‹Ž>ƒ“FŒ˜@’<”ŽF‘AŠ“7„–7€¢0ƒØ*{¢'y§.t§2|Ø)|¤'}Æ0oŖ&qœ$f›$kž-u„)y«3…°=Ž¤CŽÆP—³PŒ¬U®_Ž²_œ©Q¢ÆX¢©UžŸd„£f®•q§pŸ–ešŒh˜›gŸ˜g”‘iŖ‹i¬„m²l·yl±~l¬Œz²Ž|­‹ˆ®Ž…°²ˆ·ƒŖ{“v…®tŠ·qŽ¾sƒ¶p½gµm‹ŗt‘Āh‹»m‘Čd•ĘjŒækƒČv‚Ģk~ĢmŠĢqˆĀd‡ĀiĄl‡Ät‚Ä|†ŠnŒÓd†Õg‘Ļ^ŽĶ_ŒŠdČi”½^ByKsŒHj†BsŒFp‰;iƒLjvMqvK~~UxVu•[u›V‰k‡ˆi„ƒx“fˆ…o”„k”y”~qˆvŽ€ˆ’„„ˆ‚ŠŽ‰‘“‹Ž{‹”xŽšm’ŠvŽ_˜o—•e†k”‚^—ˆm“–j”“w©{£”’˜z’“w‡}–‘s“•u˜“u™Ÿn™”f©`³„^²¢X¶¤a¬™K· Tŗ˜ZƦVɞLĆ­MĆ«GɱQŅÆOŽ¬BŲ­JÖ·HײOÕ»LĒ·VıKĀ±NĒ±BĀæOĪĆJČĄUĘĮ^½­UĆ­`µ²b±¶a«·]®±V§øR§«^®¶`Ƴ_»ø\¼ĀQŗ¾_Ć¾OĄĮWĮĀVĹ[¾ĄZĖæYÉĘ]ĀČ\æ¼\µ½c“Įdؾ`¦æ^·Ā^µ­Wø¬]®«Yø±f°£a»ŸV¹ŸUŖœ\±§O­”G°§P¬ A“žGµ•S¼–]µ›V“¦[Ć„ZĄ„Uø—S¹›M· E±ŸD²”D½ˆ;ø‰FµŒ8³ŠD®—:¢›;±–K©•G²šJ­›B¤›J™FžF¤•RŖ’F®ŽK§™I›N¢™FŸ?–A”‘H£–@”ƒA“Š;™9 }>–€7‘€:‘…8˜„D“z9•yG¤sDyIwL‡€L’vH…{?‚y?’~Lš}U„~Q…†M~}H‘C†‰C“HŒŠIƒ‹;…ˆ:Š=ƒ™:‚›6€›1‡,}«9x„>wŖ0§$u¬4p¦8o¢5k¬$iØ.a©6sž0u¬6©B‚žAŠ„R•³\–¶`ˆ¹c­_–§Yž£PŸ«R„”_Ŗ”bؓc››o›f œf ‘c dƏ_¬c¹„`»~d“‚h±sµ‡n½Šs«ˆs¶’ƒ­|·z…¶€ŠŖz{Øw€²q“­n}“lx¬c‡±b‡¹sĀn„ænŠ¹o™Ėk™ĀlˆĶk’Å|€ĀkŠw|Ģj‡Įm}øo‹¶o‹Ęu”½u–Īs…ŹkŽĢkŒĖg‹Źa”ÅbĢe„Ą[“QtGq‹EbBa†D[{;c|GntMuyPu‰Tv[y‘Qw—bœc‡”j‡s„~gŽ†eŠj…yy„}rƒt‚zŠƒ~……‹ƒ‘‡„‡…ŠŠt‘Št‹Šhˆˆeˆ‘i™b•Š_›~_˜Žk—nž“p¢œx™‚“zŒ•r“…yœ”x™˜gž–t¢›t§™t®”dƟ]µŸ\Æ¢M­•LŗžKĮ–XŤYĒ RĤJĆ®OĘ©FĖ²MŅøIĢ¹?Ē·CĪ½PŹ¶SĶ²SĶ»RÄ“MĄ²QÄ»HŹ¶JČ½RŹ®OĄ¬Z»£Y¶Ŗ^Æ©_ÆÆd¦«a¤“W£»`­øeøĆXø¾X»¼V½ÆSæ³T·øVĄæa¼¹dĄÅmæÉeĮ»Y¾¾T³Ć]ƶ^±¹R«½W©ÅXŖ¼Q©¼PÆ«_®Ŗf³¦^Ŗ©\ƞV¶œO­™Q« G£¤G§¤E±£F¶ØJ®Z¬©Qµ£O²„[¶žX¹›L»¢DĆØA»§@­›L«™L“†L³D“„>µŒ;­•?®D±™DŖŸE¬™AŖšC¤œ@ –=©‘> ›G¢ŒL،PŖ•HM •F““?•ŽF”–@„Ž:œ‰B؈7£‰8šƒ5›„5—…6–|6˜{1–‰8¢x8£sI›{O•~K‡tJƒoDlP…uL‡rM”R‡V~wR|{G„ƒ?ˆƒB„M‡‹E‡†?†…9€Œ8~‡A~‘=u›>|™8k¬8g®=j®-w¤.pž+r©/h°0o²3qŖ7g«žšC§œEŸœI¢—JŸ™O¦“Pœ‘P‘’T”‰L˜‰G Dš7„6¦6Ÿˆ6”;œz6žˆ?§ˆ>£„=œˆ4•ƒ6„‚DzD—~C˜{?•{>|h;‹pHŒsO„R‡‚Hˆ€MŠsT‡pJ€‚<~~F‹N{M‰~:ˆ€HŒ‰Aˆ’5|Œ8tš6m˜Ctž8`§Ij¤CvØ6k¦d¦0b©>w¬=m­1q©>}ŖDƒ£TŠ«_ˆØWŽ·T›»P›°\—£Z©_—œa”˜fØ d™˜oš k„›gž‘h±–g¬•a©‹m·‘m¬q“kŖ–fµ‰d·…cƏiµ|l­€y·…‹“ˆ§x°‚Š°{”pƒ¢{~±p‡§b…­q‰¾u¹e—Ēq ¼k“ĢršČp“ĒuŒĮvˆĮtĮt‡Ē|Ą„‘ĮyĒyˆÅv”ČoŠČt”Čl‡Įn‡ÅmŒ½qŽæeĄ^…FWA^”Ac”;]„6gˆAe‚GhHf‚Lm}Jo}Hj~Ok‡To€Pu†`|c„‰lŒzd‚{n…|uyr†~†v{…€x‡~„~w|‰~ƒ‰‚v€…wŽ‚r‘Šk”Šk‡ŠdŒŠ^‘ˆ_‡‹n—m‡ŽpŒ”h‡Ž`˜f’™q“”o‹pžgž™l¦”jؔW°“S±ŽO­P®Z“žSʙUșLĢ”>Ā AĒ”GÅØJĘØIÅ©>Ģ“<Ź¼GĪŗEĶ¹NĮµRæ·UŹOĆ¾IŹĮKĘ¹MĀ¼Bæ³EĒ°Q¾¬Lŗ«Z¹°XƵU«³`©¼a«øUع[Ø­\£¶Z©“S¶¹R·±[ƬY¬Æd¦Æ]Ææb³Ć_“¹e“¹]©Į[¦²[›±Zš­R®R§“Z„ØYœ­_¤Æ_Ø°dž„_›Q”šS§›O¦RžžW›šK¤šK©TؕR©’O®‘J„žQ¦›DŖžG±’L¦–OƛK؝J£F؍P§„D®‹C«‹FƌH®‡I­Ž>§…D™…:œŽA™=” D”žD››FŸ>œ¢Eœ™J™‘K–“I•–H˜AŸŒ4 ‰3¬Ž.¬†7§}?¦6£…9§}A¢‡=«‡>Ÿ‹>¢‹:—…A™~AŽy@“z6Žs2…r;Œz;ˆpHwD€zMŠ|Q„oT}nTwrJ†sMˆwHŽy=†ƒB|JŠ…F•F~–=m“FjŸAeœEj£CiŖJfŸDgš5c„7d8_¦9m©4mÆ9m“4y¬;v„Gw©Q|ÆRØ[‚“V”“Y—®Uš±[Ž²N¢Q¤]Ÿža§Ÿf””b„˜`ž™fžj«Œ]“‰\­k«—l©l§d“™h·•p«Žhø‰e“€i°ˆu¬|µ~vƅ}°…‡Ŗ|„„~x¤y{¢v~Æl†±r‘¶o•ĆbÅf”Źi™Ąq•Āt‘ĢtŽĻmˆĀtŹƒ†ĮŒÄ~ŽĄ†‰¾z‡ĶxŽĒÉzƒĢyŒækˆÅp~Źg„Ļf‚Ā_„Ø’FŖ‘9¬Ž?—H ˜=£›8؟= Ÿ@§–H™˜8„˜:•™BE›JA™‰<—Ž=›Œ=„|0§ƒ4¦x-©u8§{1ž~6ŸC‡F”<¢‘>Ÿ†Fš}>’‚?œt=}0‰x7‹o>‘{A€rFsMvyL}nIt}J{|L‰tBy>Ž~?ˆŽFƒ@‡“F|’GŒ:s›A{„8lŸBj¢Fg„Lp§Pe£Af©s©Hk¬O|ŖU‚³Z†“TæJ“¬S–¬]®PŽÆT˜«_“«cœ`””gž£e›žc›aœ”]š`”—f„sŸ›d§t© r£Ž`¦’^Ŗ’b³vƀw؁t§~‚¬µ|~µ}‡³…‰¤|}„z…¬r“©n–Æw’¼l—½s˜¾w·uˆ¼lŽŅoŒ¾j„Āxƒ¹r…ø~†»z‡Ā‚…Ģ~‰Ź€ŠĮwˆĮk‡Ęh‡¶oøb‹ÅiƒĒ[‚Će†>Y”@`;c‰Dd’>]“I`‡Lc…SozSa‚Mc}M]xKf{Pr†WŒe‚‘a“hˆ„cxvbsqf{f|‚kswo}xqx…u~zƒ}x‹n‚Šq‚|wx‰„nˆlˆ‚aŠ”e”™e‘˜bƒ›^…ŒW†‰^˜•e”i—ˆg „p—‡o”…t¢ƒl›‰g™Žm›™h­”^«›`¦˜\“£Q²”VŗŸL·©F³„Oø¦S»±GČŖKĶ„KĀ¦NĄŖOĆŖ>Ź²FĖ¹RĘ¹K¾³SľR¹·FĮ¹L½¹N»»T½·YÅ©ZĮ¤WÄ„\ŗµY¼©bƧ_Ø¢a­¦Z³©d­³c³°`§®T©¹J°“PµµRØ°`«Ą\“Ąe­½V²·V©±O¤·W§ÆH›°Jš«Tž·W¦·_ ­ZœØ[šŖU±^œ§W˜§K„ EŸØP¢„K™”KžB˜>™™K—šN˜–J›šB›AŖŽ5­›5„„2„Ÿ;ŸœI¤¤J¦ŸN¤—P®‰F“ƒ=Ŗ€:±ŒB“ŠB«A”—D™IØ”K©œDؘL™’Iž›@¤”@œ™E™˜@˜ Q—Vœ–NŽGŸƒ;–€6—‚0”6£|:¦y/v1ž}6•~:€B:–…>˜„6‘…>’x:˜y<˜r3”|7GŠvJ}sAqyHnuMt|J|yE|„C€}:†;‘M’‰M•‡KŒ‘<„—8{‘?v7‚™<ØHy©Jn„Jh©Lf¤;]©:c¤E[­>_øGcµ>`ŗFm·=hÆMn³QæXŗQƒ»H”øI˜ÆKŒ°T‰«VŽÆQ‘ØZ–¬[“©bŸd“œ]”^‘žP•‹R—Z›d“£j˜m•”i£›m¬–n¬’`­—p¤Žw›v¢vv©‚~¬†y؊|°†‡Ø†Ž­~‹Ÿv¢p‘©|·x–µ–»yŠµx‘µrŠ¹p†Ék‹Ąn…¼p‚¼sˆ·~½s…Ät‹Ą€‹Å{¾y}·e€øm·k²mŠ“j‰ød~ŗ_|Ha”=o’Hl“QjKdŠOp„OoyWfxYjwT_vQl…SnˆMk}crb~“\ˆ‹_„‚fu}ns€es|d{t`sqpq€t{|u‚s|ˆp}ƒw~‹qŒ~oˆ†s„„o†ˆg“m˜f„•d——aŠš\•Y’bdš”kŒƒc—…k˜ŽkžŠržˆi“ŠeŽz¤ˆc„›]§•g؍bƜ\ŗ¦Y¼©W¹§EÆ«Mŗ¬OşVĖ¤JĮØQ½žUĢ¬LĮ§GĆ©IĖ¾SŗÆM¾¶UĒ“WÅ·IĘ“J¼¬KĒ®T»µZ½¦]¼”[Ą©^³°S³¦S°ŖXÆ”W·°a±„f­³`§³YŸ¶^£­XرW®­Q²¦_±¶^¶Įd«æW“®WŖ³\§»N™¾PŸµH›³R”µT—¼M ¶Pž­Y«Y„§T¢¤W§¦RŖ£>؞F£H˜¢> GœŸM˜”=–•A”=”<œ“3›7Ŗ 8¬•?Ÿ D –DšœK©—H¦TŖ‘QŖ~E³B²ŒJ؁I£‘K„œ@š”B¢™I©”J£@”–Kš“F£Jœ•I“ŸB–”HšˆU–‡S™F—Š=—~C—Š8¤„:„ƒ@ž~8•„,—†3–†1z=•€CŠ…:˜‡@‹A‡>ŠI™„C˜‹B’F‘vJ}vMw†@yyO†J€F†Š<†‹H‰‘F”‡I“”MšLŒLŠ—J„”E†•;¦I€¦?q£Os¢Ik ?cØDf¢:f®7_ØC^¶BX«C^¾?b“>gøGo·L}·Dƒ®R|¹M…±I’°U“SŖNˆ·Y•«b“§\Š§V†Ŗc–gŽ£_˜£R–”U“Uš_˜¢h‘—d•™dššgœc¦”b§i¬’~«ˆmzmžm”~¤‡Ø…}®†¦†Ž±„‰Øy°…’¶„·ƒ–±z‰·{‹æy–Ęp“¼r‰“x‹¹rzµtˆ¹|}»yŠŗq‚Ąyµs‡Āu‹½hĮm‘¶b½^Œ¹e¾c„·_ƒ8l£BxžQ–Rx–TxŒYoˆYh‚Wl~crz]jy\hwTjƒSqŒ^r[r‹hƒ‰j…kt€n}ybxrhpwfomsny}zztƒz{‚mx‚bƒhŠ€qˆ|j‰|i†…h‚“^…“e‡–f‘”^ŒŠc‘dŠše‘—a—li‘’c”ˆn‹…rŠˆhƒo“…uŸŠn ‘f²“h““e¹™^²¢S“­Y“¦U¹žXø¢LĄ«Jæ¢SĄ£TțQĻŸJÄ©Bø¶J¼³JĄ¶KĮ°OĮ¬QĪ“XŠ³QČ°PÉ®VÄ®MĄŖSŗ®W±ØX®®U­“\¢Ŗ^”¢TÆ«Y¦¶b«²^«¶`„“a©©U„©PئL¬¤T«­T¶±UØ®KضM§¹K¬µT›³R™ĄOŸ½Lš¾O„¾W”øO °S„£[ŸYž§T¢£R ›D >ž§; ¬D G „:“Ÿ<Ÿ8–—>¤”;¦3¤˜2¢”8K LؙT”™L²˜V³ŠPµ‚S±…K¬„A“A·‚@ŖŽG£™L£šJ«ž<­>¦”GšŽIŸ—E™’D™›@—˜F““D™ŠPœ…Aš‰>”„Gš‡> Až…Dž|Dœ‚9‰~;†ˆ1ˆ=…€7‰|E‰„E‰Ž<”Ž?”ŒIŠ•LŠˆMŠFƒ|P‡~O{„AtƒDy‚>ƒ‹HˆŽ=“B‰˜?L‰‹D’–GŽJ•ŽQ‡—VŠ›K—Bx£E|£AuœNnšHn•>k—=j”C[¤@Z²>^øH]°Ba½=`ŗ7m³5p½?l³Ey³AyµF†øL²O‡²SŒ»[²_•³]Œ§]’®\‡„^©`”£Y¤P‘›UŒ’]Ž”TŒ¢_–ž_˜l k™i£œj–k„…v«„y„p”|}§x¤…±‚“­€Œ£‹‰Ŗˆµ‘¶ƒ”Ɔ‘·‰·†•æ‰š·•·v’±m‚µt‚Įo‡Ąu†½~‚“z†®~°w„»o’»n‘“f”·\³^““]†“Z€“d~Ih£JlŸOlœWo”\m“\i†ZfˆUmSo\j‚Tn†]kYp‚ao‰iy…c‡‚p{‹erzg€[ylhykozrwwv}psƒ{s}eˆ}oŠa€kne‹{bt[Œ}aŠ“a‡‹gˆ•b†c”˜d—^™™dŽ“r‰p…s‹Žzˆ‡sˆ‹f‚d’‡s”…oŸ‡s©˜sµd¶—X¶œYŖ„N²žK²œF¶ŸI½¤E¹„EĄ¦DĻ”PÉ®AŹ«FĘ«CŹ©KħGĶ£SŠ®RĒ­MĘØIÄ­RĢ­SĀ©QĀ¢RæÆZ¶®U“³T„ÆS—°V«­S³Æ^¤µUŖ·X­«^¢²f¤„[®¢P­­L³X®§Q­“P±°Y„¹L«±XŸ­\¢ÆS”·G˜ĄL›µM¢·U­±F¢©V§£M¤¢O˜£Nž?§«E”›E¤Ŗ@™£J ¦C›ž?“£4—”C˜C¢“5˜6—›9—9¦•:°†K›’M œN”ŽD¬‚KƆG“ŠJ­Š<³„5¬‡7­;¦”EؖJ¦¦C¬›@¦•<”I”“Nš›Q–žI ”O™™A™‡KŸK ‘=‘„C‘…>‰E¤KŠ=Œv;†6“>Š‰AŒ„B„}D…J„…?ŒŽL‚‘H‹ˆA‡E‘‡KŠ>‚GwŠHv€Fy†LŒ‹IŠ’E˜H‡’B„@…“J‹’Lˆ”B‘S‹ŸK|¤Cw›H€A‚©@§Cs˜JkŸ;r„AjØ@`§FT 2X¦?g±:]­@nµ2h°;p¶8rø:o°Eu½>ƒĀG~½F‰¶L}±S€¹_‡Æ[ŸQŖaŒ­_Œ£a„ŖW„£V„™T—¢K”P‹£_Ž–[”šj• gš”k™Øl¦œjžo™Šs™†l‚nž†y£†¶Ž‰„‡Š®Ž~¢„‰©–‘Ŗ’«ŽµŠ¹†‘Į…š¾ƒĀz™Įr¹v‰µƒĘ|’Äp‚ĮŽ²zŠ²€‰¹y€¹l‡¶]†¬b‡³^‡¶`„¶\ŒÆV~£i‰¹’B® A® ;„”B©•G­–Hž’C˜O“Iœ•P¦–Mž•?“›?–‘C™’I“ŽB•L˜M‘~AŠ{8ŠˆB…F‡ŽMŠŒKŠ‡M‡†Bˆ•LŒ’I}”P~†Fƒ‡@‚‘F}‚=„„@{Bw„Bƒ†A‰ˆM†‹?Ž–@‡:…Ž@ŽŸEŠžE†šL‘™KN|¦IƒHx£G€©<‚¢>z„=i¤A_Hd¤@^„9^œ7]ØDa©Ca„EkØ5p«:u¹4m»Au®C}±NĮG‡»D…½Qw½Mz¹Pz²WxØQzØQ…«VŠ£Y…«Y Q…”R”›L—¢Q— VŒ›d™–h›—Z a›¦\œœe ™c˜œkžu„Œr †z©–zƘ…°‹‡ŸŽ|¬Œ†¶”Æ‘ŖŒ„ø‘–Ą…˜¾z“¼|¾w†æz‰¼ŽĀ‚”ĒƒšĀyŽøÆ}~°‚†“}‹²eŽ°]Œ³`Ž«e‹“T«R‰žX‡¢bƒ?nŸKnTužV}žVuQy’Vp…Ln‡Qq~Qk~]k€Wqˆ`rŽWy_z‚]‚‚c€‚hv‹rzƒs~o|t{pyzylvvku}iqt{osutwxuqs‚qcƒn^{€\ˆ‡a…]‹b‰‹aŽ›c‘—m—˜hšv“†t‹“wŒ’s—‹q’{i„q•†n—ˆt••p£—p«–p²ž[­™]©¦YƧCµ­BæµK°§M©²F±³@Į“JÅ­LĢŖFĒØAŅžLŠ§RĢœPŁØKÖ¤MŹ PĢ±OĒ„YĄ©Oø”P¼±Z°¶YÆÆO¢¹O—“Q¤±Mœ³W—­V—ŖNŸ£O—§S¢ØZ®®V¤„W­„J§­M¬°`³ŗX§½M¤“R¬æd§±`£·O¢«Mž§I˜ÆM˜¢Sž°@£ IœŖI„§= ©9§©2§°8™¢;ؤKœA„›9Ÿ›5”’>Ÿ5”¤@˜ 5œ›@›Œ7„–:؍D­3£“<؏DƅK·†L¼‡>“<½ŽA¶’Cŗ•?¹7©„>« F§¢L­›BŖ˜J§ŒPŸHŸ™S©’Mœ›L”ˆBœ‹<”‘H’„?˜ˆAŠF–’MŠ€@ˆ}9ŒD‘„@ŽMƒ‰I‰‹IŠ‘K€˜BœHx•H}„C‹B€F{ŒB{‹?†;€€E|N††K‡‹<‡“:‡™:ˆš>‚™@„¦B‰§FŒ§E{©J°Dƒ›C”Az¢?‰¤A}¦:f¦>l˜Hr”:c 6]”0e 6cÆEY¬:_£:k¬:hµ7jŖ=i§Iq¶?uĄNxĀFp½Do²Hp²En»Jl»Ft²LÆT‰±V²Q†ÆM~ŸVŒ«L’ÆL‹¬S£`š_˜™[ Vœ«b•™g¤Žh•‹qžŒs›ŽqŸ…}©ˆ…§”‡Øž…¬š‚«œ…»•Ž°•Š«‹ŗ†‘ŗƒ¾€•¹Œ³~ŒĆ‰‘øˆ“¼†”ŗ|‘¾{³‚Š±zx²‚­oŒ°eˆ­j…®[ØaŒ¢U„§YˆØ]ˆ”d‹A|‘Eu”Jv—H˜T{Ts—Jr—Q{†X|“SsU|†^sˆUuX}Š^~gu€e‚}i~…ku}u{€n„{k€mlzlrunwfishjypjtmwug{xdrƒom}ph~uc~ye‰ƒl‚d•ˆk—‹fœŒqš”nœ‹m™ˆo™•pŠ‘nŽh’‚hŽ~b“ƒmk˜™c™™Z§bŖœ\°¤\ø”Y°©I¶ŖN¹µB½°H±²DØ°;°­CĀ¤JĆ„FƟFӞJџGќQĖ[Ó¤WÖ¬XČ©NĀ“QĘ­NæØD°¤J¤„M ¶V¤¹P µV˜“N•ØHž¤E˜„O”°_˜«]š¢[§ŖW±ŖL¬±Q¤²X©øX”Ä\ æV¦ŗ_ØĮ[§²P–°V–±F—ŖB‘Ÿ?—¢I”£DŸ§A¤¢?ž¤8¤5ØØ8¬„7Ø©5§°?ŸØGšŸCšž:–„<—¤>”„<œŸ5ž–9„A¦‘5¤ˆ5؉8؊5­–:Ɠ=®–DŗŽ>Ā†GĎHŘE¾™>¼›D“¦?¬­J°¢D¢“R”‘O©—J”ŽJ¢˜G©“P£E„ŒBؐA ŠFC‡K•‰@ŒŽC“PŠKŒˆB…Dˆ–IP„˜Vƒ•N†šP|˜AxOs‰Kw†G}‰MuCyC€’P†KK…=~ˆ@„‰=Œ’?ˆ›:ž8Ÿ?¦>ØC~­IØ>ƒ™G‡šDš?~šAy–Dt?y•FržAs£:i®6c©.ZŖ6dÆ8aŖ=jŖ5l°>c®Ab°E`±Gm¼MdøJj¹HgøLq·Hj½Cn¼DyµA}­N}±N…©W±SˆŖR—ÆM”«W“¢^•¤_“£b›¦UšŖR„_•™i”h¢wŽtŸ~¦‚ž„•«ž~©ž|«’€°–ˆ³‹}ŗˆµ‘„øˆ®…³‘®†Š·‹ŽĄ‡¾†…¾Œ‚øˆ„ŗ|‰µ|ƒµ|§o¢l~®f†¬d‰©]„”]‚™`›\‹T‹I}Mz–Ow‹Mx‰M”PtŽH{‘MqŒQ{ˆU~ŒTr‰Uw€cx^{~[~ƒfw†`}ˆi~„jx†mwyt{z}mmrmprdnqbybdmjuwlrnessnr„rk„yhyrf~{a}tc{{a‡€bv–‹m•tŽv–n‰†n…”t’Šn‹‰g”zm”~hžŠg—ˆbؗb©œd­\§§Z©›E©©?®”J·²B¾°O²§Kø¦Hø©G·±OÉ„>ȦJĶKŅ—OŃ¢HÉ£FĻÆNŠ¢MĒ°VĶ«KɬPøØL°­C­°N§Æ]±Z£·S£ØPž©Jš”K ¢O¦[”«V¢±_§®]©ØU§§XŖ¶Z¬ĄRŖ½WصO„¾V ¶T øQ£²Rž­O„ÆC¢¦A¢©HؤG£¢K£¢;šœ:©°D¤­D ®6§¤>”;œ›J¢ D•C•£E¦«5ž›C™C›ŸD¬˜A¢B§0©„2«7¦Š=®š>»‹3ŗš@¾CĉB¾˜:ĄŸ:Ā¢A½›<ŗŖHøŖ9„¢N©I›”D§I­C¤›M¢D£…8”?˜‡D’ŒBš…C”’A>ˆP}O’ˆK‰‹E{•?w„>z=‡‘>„C‚–Ez’>~ŠKw’Sx„I|“Dv‹=“M}Š@ƒ…A=vƒ@{A„—BŒ‘?‡š7Œ©>«8~Ŗ<„Æ?€°4yœ=x“Eu›>r8w™2už5q 6n”B^Ŗ2d£8W§AgŖ:\²8`¶6]³Gd·Gf¶@m³Alø@n³Ej¾@k¼BoÆJm·MqøQt²EoŖKtÆBxØJ‹ŖQ«W}§MŠ±Y™³R—­Yœ§W‘¤]¤X•©_‘ k•£g”o–wš”u¤}£…„š‰z¦“‚ •}©¢{£ž}µŸyø±†x°……ŗŽ’³‡„²Š~²“„²‰ŗ†~ø‚ˆ«†‡³|¬‡…©xˆ¬s{¤q}„f«r‚Ø^‹Ø\—V{™Xy„^Š¢R‰Ly‹L{ŒT…M}}BpzDo„FkPx†Rq‹UwXqxRtoSxucw{atz_z}a…ˆe€„ay‚ewpykm{p{yrsppblvmnlkuvwstr{qq|ne}pj€th€ug‚xkˆscƒyl}sŽytŽxp›…n’„xˆƒpŒ‰ehƒe‚gŽx`—xj“€]•ˆ_¦›`¬ X¤£O¢”IƝD«”;±¦E¾§Jŗ®I³«O·±P¾®NĀ¬FĪ©DÉ¢=¾ BŹ¦DÓ DĻ”MĀ¬LÉÆSŹ°QʬXŗ³M“„U²¤L¹±L°²R¤­WŸ°UŸŖM ­Qž¬S¢žP£„N¦³RØÆWøøT·³`²®ZƼZµ¾QµŗV¬“X§½QØ»N¤ĆM¦æL«¾J¤·O¦“Qœ²MŖŸP®G¢£>œ”<ž£@¤±F”±>š«;—Ø@N•Oœ”?„­F©Ø;œ–?Ÿ”A¦ŸI„™N ˜=¢’8«Š;¢Œ7؏@³“7³š9»—0¾Ž0³•?ŗ >Ɵ?Ą™H“–C¬”9®§<¤§@£ I¤¤DؙF”™C§šG•>š…7›‚A™…K™ŠO•G”†O™‰J˜QŠR…HŒ‰Jˆ‰:w‰;‚’?ƒ–<}“7v“Bt–D~ŽMq‰NmŒHm–Gr’F|•Hz‡Dw‰N|„L|Fu†H~†Eˆ”@ˆE‚­>†Ŗ1‰Ŗ0y£/zØ3£:w—:u’4u“2p™:v 4p£:\¢5WŸ6Xœ>eœCd¤9`ŖB\±9f¶:dÆFe“Ij³Ce»>jø@m»Bf³Dd»El»Lw½Os­Jt®Bv±G{ŗQ¶S~³Wƒ³V‚²PŖY’“[˜Æ[šŖb•”f¢iŒžg’’g˜”jœŽkœŽu›•o£‹t¢‘Ÿ—…›Ÿx¢„w¬œ® x°¢wŖ“€­ŒˆÆ”‰¦’…¬ˆ|²Žw®“x­…u©~ƒ«ƒ…°Ŗˆ|”€€›€…£p}£n†Ÿm†žd†˜c‚—V~ V}™]€›Y|@x?‚ŠPtwFsrPi|@g~Dy}I|zEv|HiwWqjUtg\kq`pvTp{av|ay…bp~_€|bxkrousq}|iewd]uljpcvuqqt|ykm{qfwqk||g…|cŽzb…}p”|m–ql~i˜yn“…f™r‰„z„g‰‡j‹†k“‹oš‚f”qp™‚l•Œiؒ]“Z°šRžšR¦žN©§A±¢AÅ¢Q»¦QƦXŹ²KĒ¶EĪ¬@Ė©?Ć©<Ē©>Ģ›=əGĀ„Iø±KĮŗIĄ°UĆ¹XŗŗU°¦N®±B°°S©øW©«R¤®Y²UÆ®V©®L®¦Q£ŖS¤°Z±²RĄ“RĮ¹Oæ°O¶øWø²J­ĄO¼¶\„ÅO„ĄO«¶N¢¹L¦“RŖ“WŖµU—¬R¦±H«¢N£„Jœ¤A©Ŗ<°²I”±<£¦@¤<Ÿ„Cš§L¤Ÿ?Ŗ”I§„6¤Ø8››K›œC”•Q¤—E”˜GžšA«?¢B““=³¢=¹ 1±œ5³¦>¹”@½ =¼ ;¼™C°˜G“„=©«A”«K±šD”§C„’D„–I”‹A•‹2£G›R‘ŽJ••Nœ’O“‹P—ƒJ‰†I…BŽG{”A~“<‚‹CŠš5{‘9tœD{I}OwŠCoHp’LoAtB}…D„Kz‚Ry†E{ŒD…™D¦>€ <„¬2‰®<|¤.xÆ.v¤;nŸ;r˜>fš:i™1f™.o¤0iØ2\ ;^¢>U™;\«7d„3_°7b¦6e§9a²K[­@Y°>\¬Gj»?b¬>m½Io±Hu¹Nl¼Tk¹Gm“Bi¬C|µO¬FŠ­U†µTµRˆ¦W¶\š®Z‹±b”±e„Æa…Ÿa‹–f‘’kŽšm‘•s –i§’w¤“u”’ƒ©Ÿu¤§z¬ v«sƘyƍ€°Ž|²—‡ØŽƒ·Žz®“ƒÆ–{ؐsØ}†«w‚§… ~£ƒ„p{«i€Ÿq€žwŽžg€”h„—X‹“R‹˜Sz–]v;†…>yE{€HpwDtuHi}Ivu=vsCmjKhhTfnPohRsrOhtTfv[t{ds„_m}Z{te{svwwvmowigyghxkouiozxprwqspfwtft{k}yk€a’wd“oc•si–~`‘~e›d“‰o˜qt‹Œn‹‡oŽˆc™ˆe‘„k™zi—‰j˜‰ež•ZŖ˜Z”œW§£T°£P«œ=°£G¾«JȧOĘÆSĶ³FĪ±JĖ¤MĘ„@Į 9ĖŖ9Ė©9Į”GȱBæµHĀæMĄ·V°°K¬·O«øB«­A¦ÆH”³M¤¼O«“T«®W®¦T“C“£@¹ÆM¬¶V¹ŗV¹µY¶µLĆ®L¼¹G¼²R¼¹OŗĀT¹ÅSØĀM±¹Y¬¶T°¹\©øZ²N¢²G§§G«”I©›D¦„A­°DŖ“C­­<©«@¤ @ œHœšO„ØMŖ«HŖ­A¦©H„«D–œH——K™S ’S¢ŒO„”G­˜G®¢=±¢;»„5¶Ŗ5·„2¼¤.“š2²¢<¾˜=ŗ9»Ÿ>²„:°©B„ŸEŖ£H¤”RœJ¦Š@ž9—–Iš’L–ŒN”‹K›‰O”’M•–FŒHŒ™E†œ@Š“<}˜;‰Ÿ5„—=†;w–@ŽKyEp™HržEu‘Ir‘F€ŠE€O‹R~‘V€•Vw–M|žAƒ¦6Š„.Š­4ˆŸ:¢4p¬6mØ2nŖ7b›4h™7i˜5m—2_”=Z„4Z¤3Y­5b„:g§,a©-d©6cŸ5a3]§BRÆBV³DZÆNd®Fe»Mg»If¶HvŗKt¶Vo¹Qj¬Ij«Fx¦E§F‚¦M…°Z‚Ø[…©c‹µ^·Yƒ¾[‚¶ZŒÆ\‡Øh…¢r‘”p™žq“l–jœ m”¤qš–z›Ÿy„¤qØ„wœ«u œw§•‚«›„¤”„¢–Š±‰‚·ƒ|­‰w¤ƒx¬ƒ} {{Ÿ~z£z¤v{”w¬sv®wŖs„„f‹”bŽ–\‘ŒT–VŠŽU|C~{Fv†?y|Lyq¼µ>ĮŖC¾«OĘ“CĶŖQɬKæÆHĘ°>Ó°7Ąœ=Ģ£EÉÆJ¾½KĘæL»¶L°ŗO®“N³®L“·F°²J®¦=¤³B¦¶U²øV©¶G³®Aø­?¹²D±®O¼®XĆ“bƶZø²V¼µ[¶“Zŗŗ]Ę¾W±øTµŗZ„ÄM¦æH“¼UÆĮ\­µT“¹E²“N®®EÆ°FŖ¤>¤®E”¦> ®C„œAؤ;”š?„>¢£@§ØC«¦C®©E«§?„œ?˜£E’”O¦‘Cž‘F¤”F«”J®¤H؞>®”'Ŗ¢*¬„+±£3ƛ1Ŗ—@³§>¼Ÿ<³©=¹¤>¬¬9Ø«:¢„@®¢@¬žA‘7ž™2 Š<˜š:›™EŸ< D˜™G”•H‰>†ŒF‘•>…B|›AŠ˜6•6yš;zžIxœ8—8s”Bm˜Fy“G„˜?œHˆžM{•D‡˜L{ŸB}”M€ØG‡¦7€¤2…Ŗ>Š±:„¦)qØ/z«9h›2c˜8f£=nœq};ryF{mFziGwoOvnX|iO|ePrp\oif}d`~glvkqoe{vktyhmhjqeawaholouygizklzrsyj}tcpfˆm}h‹uaŠ}i•wd•{e›†l”‚tœ‰k“‹g†g™vŸ„l”…`™wb•tdŒ{a’ƒc”‘]¢P£M”’DƘGµ¢?³«;æ°AĆŖFæ²LĖ¹AČ®FĒ“OĆØFŠ¬MĪ§BĚLʛRĄ¦PÄ“R¶ĆN¹ĮP·øG¶µE¶ĮH“»D±³;µ©<¬²A°°H©ÆF²“H¾°Cæ§<ȤMÄŖUĻ„[ČØ\æÆSø«P¾ØR¶°\ÄÆbĮ³Y·½`±æ\«½T©·MƲF·øM¹»Gµ¹JŖŗD¬«E±ÆI§¬F¤¦JØØDšŸ>›žDš§G„Ÿ<£«>„®/«§2°°<³ÆA„¤; ¬H•¤Nœ›Bš™?š–@©>ƔCؙD¬£=®­(±4¬/¦™7§ 7¢@®§@²žC®”?®ŸFµ£=°œ:«Ÿ;²Ŗ4¬£:°”>®˜:Ŗ”9”“0Ŗ4£•9ŽAœ”<™’H—EŠ˜@Œ˜I‚™N„D{•G8‡›G~˜G‚˜8‚¢7wØHs”Hƒ•E‡—?~B£L€ØE‚ŸAv˜?z D{¢J§B}µ7ˆø=ø-€Ø-{„,u /h§=k”9a¢3c¦9i°8cŖ)U¬.XŖ;Y„~–8w”`±1Y­4a¬8Y­-RØ/X¦6Y­9`¢8bÆ7\±)cÆ7RŖ?_«7gŖ7d¬A_¬Fr§Gv­Kr„Ju±LvŖEo“Km»Ni“No¼Bv­‡–Cˆ–K™Q¢E‚ŸI}›=‡˜?…œB”F‡„;€³=~Æ>{¬F‚§G‡²E†°@²C„„9ƒ„6s¤7zÆ0t“5kÆ4i·:g®2pŖ+l¶2m³5_³)[Ø,[§9T¦=a ?\Ŗp¬LmØLj”>m¤@l²Dj³Gh¼EqøAsÆKp¶C|±By»F|¶ItÆHw±DrµB|µJ“P‡°Z€“a…¦Y“”`‘¦f–›n”q›¦k›°h—«j©k™ušØn””k¦ q Ŗn£©h”±j”²f£„pž˜j„–f Œg¢Žq§€n©wj”utžusšxy”n‚žp~Ÿo}šky¢q†•f|˜h‚ZŽY‚Z„–W€/iw8eu8l8ts6l|?t|3muCgf9giAsa5qbDycE}gGƒeFnZJp^Vr^_pZeidqldkw_ynOitWjehom_usp|utuwk|l{}n}|t‡qxƒr‰ƒi‚‚nˆt|c‹ydŠyl—ol™wvˆ~p‘}f‰n€n‰}fƒ`Œ[ƒZ–ŽH‘‹Vœ—I§‹I†H©”>Ø©GŖš>ø«KĮŖLĒ²>ĀŗAĶ³4ÅøEŹ®RĶ§DĒŸLĀ¬BÄÆKĄ²HĄ°AĆøL½¶Iø¬OĶ°KÉŖH“»6ŗæCæ¼:ŗµ>Æ­:³ØB“«DĄŸIĮ„MĮ >µ§=¼­@ĀŖS½¼G»ĆB·ĆO¹ÄVÄøZ¼·^Ā¼QʶPIJVĆøIĮæJ“ĄO­¾G¶µG§°K«°RŸ°H£„:­£?“£;”Ø5Ÿ *¦ž.„ 2™„,›„7ŸŖ:³”,®”-„¤:›Ŗ9”­: ™6؟9¢›?¢ŸAØ£9£°<  <Ŗ£1°©1°Ŗ>Ÿ¤9¦§8” 7ØØ-„©-¦Æ4žÆ3Ŗ“3§Ŗ:Ŗ¦C¶¬5¹¬>·ž<«˜;¶š5°ž9¦™4„”6©Ÿ5¤Ÿ>¢ØB£¤@“š?”˜C‡™K‹šG¦D…©H‡¦M~¦?Ž›?ž6‡ =Ž D}§>€ŖC…®@‚„Q{ØBƒ²;Š¦<}©9xÆ8«At¹@t¹Y±9c¶]¦:j„9i°Lw¦Ph¤Jg­Dj§@cŗIdøLsø?i²HlĄEsÄ;s½Fp“Jz¶Ex»OwØ@w«J³P€®V…§RŽ±[‹°[¤Xœ¤\™®`£¤n“°_”«m­i•§}— n—Ŗjš§e•„t¦k–ŖkŸŖl¢™lؕe„”m¦i£”uƒt™zi—‚h|r wz—}|’tpœrs”prdpb{‘`tawŽ_„œ`|”S}1mt;ct4cs6bu:p~?rusfMz`KkQRfMPoIRtVanTeeVlo]ovUegchfbgsjmxm|xo€ur~‚m‡€n†€fˆ}n†„p~‚pxyo{od‰ybŽ{a‹xe”rkvj‹m‰xl“~k™ƒ]”…Zš‰e‹c“‹\š‘O‘Q˜U¢‡WŸŠG©šHØ”9”¦:«¦H©¦M“„C¼³C¾“8¾©=»®IȬQŤHĶ¤IƬAĄØI»¢HĮ°O¹°H·Ø?æ©D¾“@ø¶:ŗ³>¶²>¾¹Dµ°E¬¶L“®G¼°;»”<æ”@¶Ø>±±J¶ŖLµŗBµ½DĄÄSŗŗY²³Nµ¶T¹“PƵWľI¼·Jŗ¹M²ĮH“ĆKŖøC¢ÆQ„§PŖ£A¤”9­¬5ÆØB­š@”›5Ø -”§4¦”0Ŗ 2±š:Æ”2¤©A©¦B¢®:¢„6¬¦?Æ”? ž=ž›4›Ŗ(„­,¬³4§«9«®8Ŗ­6¦²>§„5°„5Ŗ«9Ÿ®>¦:Ÿ§2£¦7§§6µ?Ɯ7³§6“•-®’4«•;°§1«Ø5®§=„¬>œ¬@”§?«E–¢G™”GœE„ŸN‹„L„¢FžNŠŸI“™5™2‰œ7„žB~ŸI}±?ƒ©N„O~°Eƒ±@}ÆB€²D‡¶>~ø;ƒ»?~¶:v¬2n¬,fÆ'fÆ(k§(p®&k°)_Ŗ(_®1[³7cµ4b°AY²2\³0f·;bŗ=[ŗ0^·3T±6Z±v«Dv¤Kh„Sc¬Fc¶IrÆHt­Et²ŖÆ9ØŖ7ŸŖ8Ŗ®2¤°>¤¤C؞?Ø«/©Ÿ-„”1­”<±Ÿ7²”5Ā„;°–?ƍ3¬—3“£6Ŗ­8§”=žÆG„²E Ø=œ©?Ÿ¢J‘’B•žL€œF‡–@{—B‰–;‚H›8€£2†„>}¬B|”8 9†¬<€¤Q‰£E}­J€­F{øA|¼F~“Gx³G€²>sæ2u¶+p­,d¶8hÆ4fØ/eØ5k«/Z«4gĀ=b¼2l²t²EpÆCo¤Cg£Sb¤JlÆHb©AmÆFh·>lĮDlĮBv»DmÄ>nÅ?ræHs²LyøI‚ŖR€°R©Oˆ¦Sz³QØM¬Q’Ŗ]–“Wž·c’¶c‰Æq•«i“ v””l‘¤l¬r”¦i–”qŠ®cŒ£k›™e’g„‘n¢œr‘“e˜oŒ’iŸ„j£t•yt˜zy–rl‘yq‘wimeut›kq•bw”e€•Yt“`|3ct7]n5Ys>`t?UhGYbCai?cb;gXGlS:s\µŽB°Ž:§š>©”3Ŗ¬:­„8«ž1·”6Ą«?¼¤GÄ©>Ą¬@ĆŖE¼§MĀŸW¼¢Pŗ©J“¦D¶ØE“¢;ƙ6²”8µ”:ĄŸ9· ;æ¢B·Ø>±«5¹µ>µ²:³ØA½¬?»§Bŗ±D“»Qø·R¹¼L··Qø«FĮ«K¾°F¾²Qŗ±Sæ§R°¦R°®F£¦?£ØIŖØMŖ„F©£H؜C©”F¤Ø>”£1˜©4‘­9™”8•§0œ9ŖŸ@§™B©ŸI¢K”ØA±©A«„8°¦1³¦1ŖØ)Ŗ¤ ¶Ø$¼­3³°2±Ø,„«.Ŗ¦>©¬<­Ø7­Ø@Ŗ«3” 1”•;©–3¹ 0ø›=¾žEĄ—>“ŸD¹–Cµ–?¬¢:«ž?®§8 Ŗ9£§E¦£Fš©>’”=ŒE…–@ˆœE‰›F‚™<‚’DŠ™A‰Ÿ:ƒ£=}„?ƒ«8†„A‡Ÿ=‘ŖDŠØF„“L~±Ds±Cv²J{·Sv²L€¾L{½?pĘ@m¾5tÄ8k¾8k¶;f®8f·2n²3`ø/bĄ5b·:i»:^¼3VĮ5Xŗr¶AoØJvŖPeÆIe¬Je¬OeŖIm»Ii»Geŗ=rĮ7uČEsĆGrÉKm½Em½M|¼P‰µT„«HƒÆGŠ¬W€ØN}­UŠ®Sø_Ž³Xµ^±Z‹¹f†“^‰Ŗg”b¢n†§a‡ŖbƒØfŽ­j‰„h„^Ž¢h˜˜i“b”Žl–„e†c‘ƒf›†k|q’yq‹tu•hœ~f•|hštq”in›]{”bv•g{†[z3jl+nc.bk3buAZh@T_B]V:Y\BfYGaTAe[@h[E[R?bJ:`SCVQN[^GcVM^\[VSecXriZajTal[eiejqajsmnthtvbn]~f†bzuY†y[|wY|te…jb‹bd‘wi†s\’t^€s[Œƒ_„€NŒxU€|V‡\…^„‘^Ž—P–T›šL”R§”=©—;·›?“š<ؗ9©©5²Ŗ.ø„,¼¦9±§:ƙN¹§9°„?ĮŸ=“ØE¹œ@µœBµ£H·ØB®ØKŗØD®›:­š3¼˜5æ¢7ĄžBĆ 7Ć„AĮ”7¹±6³­3“¬7¹«?»¦<ȤK¼§N¶ÆL·®N²µKæøV½ŖG¾®DĮ±N»©IµØX¶ÆHŗŖCø®D“«Cø§Aŗ£E« I¤›>Ø­>¬­9£“9«³2™ž;”¤5„›BØ©;ž”A£Ÿ4­¤>®”J® 9µ„4“ž:ŗ©4­„1£©3­©'“”/¬².¶«<£Ø6ŸŖ5ž¦:¦­Aج?·©:­ž=„ž8¬˜9±6ŗš<µ–@·›A°•G°™@¼›<³™B§¢A„Ø6Æ©;¤¦4¦¬7˜¬5”Ø8œØGš˜I˜L¦@ŽšH‰?„£;’žBŠ—E”;„®>Š­2§=}«@‰¤=~ÆF€“P~³G…¹F}²LŖP€µA„»=vµB{½An“8yĮ4pĀ8wŗ5n»o°=t“GtøGw¦Pq¦Oo¬NmØBn¬Dp¬Ij¶Bs³@o»;n·6t»MkŗOi»Bu¼R|æV‚¬O†“K°F{©\­Z„¬M‰µO‡»O‹¾R•«WŽ“Z’¼h‹»e”øn‘©k‰”e¤h‚©g‚­_€¬e£kŽž]”n–m˜Šq–“m‘†hŒd’|l‡a•€c‘|q’g–ym™ƒgpzkŠoqru‹`z‘a{†].td/md7mg.\n+\]2\X8RT[UAR[GTdEZ\LVRS]PdiLjfTrt^iq]ordijhkpakvapiapl`€{\€_‰re„nY†k_n\Œs`g`…p`‹ueuh‹s`Šu]~K‚ƒI~T‡…_‰ˆbˆc”‡\’M˜”L”‘IœŠIŖˆ?­—E°›;§ž?¦Ÿ0­”/“”6¹œ5Æ„B²CŖ˜B°›=° @· >»œI·¦EŖ£;Ŗ¦B®@½J¾”KƖ=²žG¶œE³š;»„9¹Ø3Ĥ<æ£8³¦8¶ž>Ć¢<ʬFÄ„GĮ E½ŖI·§M°ŖV·ŖJ¼“MæØQ¾¢J¶›QƤL®°J²²;¶¬C¼ÆDĄ„B»ž:±Ŗ<§„?±©J³“C©³=ƬAŸ”;š8¬§>²„=®0¦¤4¬–B­™B¤¢6§ž4­„-»­*¹¹/ص.°¦-®§5¬­6®©7Ø©9„”>”¬<Ø°EØØ3°¦/§œ1„™6°A°’Bµ˜:¶™B®œ<Ŗ–D¼•<æœ=Ā¤9³Ÿ?µ°<Ŗ“;”Ŗ8¦„7¦Æ3–“:£Eš”G”M†¢I‡¦D–ŸAŸ@Ž¢F„©8‰Ÿ5‹­8‚®3z§C°Bˆ«E}ÆMy“I†ŖJw®Rv¶T…²J„Ø=}©B|¶D|æ:vø<„·?€Ę4„»-x½/pæ0q»Ä G“:Ę6Į”@Ą™;Ķ¬C¾ØG»©KĮ°W©ŖMŗ®MµÆMŗ¢I½žIÆŖNŗ§L­±F³§?¶«1·²8ŗž3µ3·”=¬Ÿ>®µ=ø«=¬«EŖ­I¦¤FŖG²˜>±Ÿ@±§4®™+¦›/Ŗ•8§”:«£6Ø„-Ʋ2ÆØ,Æ®5²Ø,²Æ1“«0·µ9®®:¬¤4¬¤1©®G„ 4°«<؟8 £3ž˜<ŖŸ=؜@Ŗ›AŖŒB­Š=Ŗ›=æ™<²œ:¶ØB¦ŖB¬¬7£¤?Ÿ£6˜¢6˜Ø2œ¦B³P‰©Q„P‰ŖFž«E˜©I‡ EŠ¤G‰œ7¤7Š²:‹µE‚¼Oy®C…¬Gƒ²Ky“G€§F†·N†µQ‰°;‰·A‹¶>‡¼8|ŗDvø<†Č7Å5}Ä9{½Axæ>~ŹEjÉ6mÄ>kÕ)`Ę(\Č7`Ó0XŠ4WŹ,YĖ.aÉ:b·;\»?jŗKkŗNqµUmŗIk§Nt·Er±;n³Do©:j°6e¼?oĀ6oĄ=hŗnc0pY.a^4\];VS@XP8\Q4USA^MJZWBSW@UX?YP;[ZFSXINSWZOXeSZ^Ud^c]]gh\_cifjeanmZmt[ktTluS{mSuW{qUul[zmWz]y_ƒz]ˆwg–yc’i`Šj\‘f_…jT…iTŠh^‚s_ŠsXƒwZ‚yO‰zP”G“ˆJŒŠJ–•?„ŠG¤BŖ˜H£—@£–=°”:³™F¬C°„I­‰?©‚=³‰4¬Œ2„—:«žH ŸEŸ™E­œE±¦=¾„Eµ¤H½F½9Ƒ:ŝ7ƚAæ‘CȓKæ–B½šFøžK¹—@¹ LĦMĄ²TĀÆUæÆP±ŖQ¬ L± I¬”K±¦?¶”7³¢@·¬6¶Ŗ9ŗ«4µ£,µ©+¼«4¾”@³Ø>»¦A¹ÆG­”NØ¢E® L¬œDø›;¼žC·„>¹œ2¶ +Ɵ5®„;²5²¬0¬Æ8«²,»Æ1±ø4ø·)ø­2³°-²¶2±­*±¢6Ŗ”:®¬9­¦@¦„?¦›6œ£>Ÿ9š™< “FƋE­@³˜K²ŸDŖŖG­°CŖ“E¤­>§Æ?œ¤5Ÿ”1’¬;“ø=‹¶J‹·F­H®B”²D°BŽØ?Ž©H¦C–§EÆ;Š±<¶L‡­P…³KµG|·B‹ØCˆ©K~­R~ÆGˆ·Bˆ³;ˆ¶5~¶=|ø2ƒÅ3‰Ę>ĘD|ĮLĢD€×I|ÖBxŌ3hĻ-f×5[Ń/R×4WĖ/aŌ.aĖ+V¾4XĀ8XÄCV¹FW±Pi·Jv·=sŗ>h¼4j±;d¬¦5”’CŸŽ9§…<£3©Š1­1¦“;؋=©‘=›—>žŸ8ƘC“ŸAø¢Eµœ@Ś@ƞB¹”:ƕ7ĀŽBĒ˜F¼’EșJĆ„B¼˜KĄ L¶•;¹£I¼ CøŸI·›T¶¤J«™I±žMøŸMø¢F³™C®¦D¶£7½ž:ŗž6­¢2æŖ2“²9øØ3Ƭ>¹±B¼§FŗÆ<®¬F³ H­”B¹”DÆ£Fø§@æ”2°”3§–(®‘/©¢3µ˜-¶¢9¹¤'Į­2ij2ŗ±*¼«*¼°%ŗ³)ø«:“­6©š6©›<¬ž:­•D¦?­ž: š?””@„ˆH¦‘Fµ‘J©Ÿ?؝= §>Ŗ®<£²D„¦D¦Ø? £4ž¤<˜·=˜¦=˜©K”¬F–¢L—±:›“C”©?† K‹„=ØDš¬BŠ­9ˆØK½BŒ²LˆøD€µD|ŗC‡¶KŒÆF©B|©AŠ¬E~ø={·@{³1|¼?|Ź:zÉ@|Ņ>ƒĘCsÉFrÅ>zŚ@pŚ9gŃ7^Ī6dÖ.cĖ,SĢ5ZĢ3fĪ3^Ā3ZĄ3aæBUĆAj“Dl½KlµAhĄ>f“7[³=^»Bi¹5fĀ6iµ8lĮ7pæ;qøEk½Kk©N_¢UnØLu”Vv§GzØR†«H„¦G‡®E‹»I…±Q‘µH‹øW…ĆO€»Iƒ·UŽ³MŽ¤V†Ÿc~§Y¦^ƒ«R„™Vƒ£d}˜]†œf‘–h\„‰Y|“]ƒŽ`‘‹a…‡Uƒ†Yw‡Uz‰a€…V…eŽ†X”zj‹l]„f[‰cpŠmm;kZ0gW/f\3ad/bP+bK4bR.ZW3UM*[G+OS0TS@OR@ULGTWTJWXLUZSRZPb\Sd`O_]W^^g^Qj^]hYkf[npaqjdsqYphKobOxfP„fKuJ„nZ‹fYea•hc‹mb‹pa•mcŽpSˆoNƒzN|sH„lR~kS„sOŽoV‰{K“}@•}Ey?ŸBœ=¦”8£‘6£ˆ>¤ˆD¬”A¬—;œ53ž€7”< Œ4”‡4°Š0Ƒ-¤‰8”D§œ?«ŸD®–:Ā”@ŹœB½›@ŗ•AĄ›A¼<øž7æ=Ź©FȧEĘ„G¶ŸG»–;¹—:¼”:¹—@µžL·™T³œW±£IŗœNŗ•B²›7®¢<®¢.²ž,¹)°©7²°4»±3¾ø1¶Æ?°Ø<²©6·±?²§:±”>µ–@­•Cƚ;¾™=Ą©1Ą„%®”'µœ(Ɨ(¶—*Įž1Ȧ3Č„$ĮÆ ·¶-¾©/Ā­(¾©6“Ŗ8¬¢=±:³¢AÆ 9©“E¤Ž@©–5±“;§‹G©ŽO­—N°¢L­›?¤’>©‘;””Dœœ?ØØA›±?–¬AŸŖFœ±>œ²Jš©P—®L‹„A™¬7—Ŗ>‰Ŗ;Œ›F•žH˜ØDŽŖN•§G¬A¶?±D~¶;‹ŗAˆ¹L²P†øC¬<„±C~»E…µ<|¹A~µ4vĀA|Ė=„Ķ:zĢ6oÄFsÉJtŃo×6gÕ<\Ż2^Ö.UĪ:ZÅ?\Ė0ZĮ/]½.V¹;b¼>`Ć4pÅ8yæFn·Ci¾ĆžN½;²œ7“›=ŗœ2¼@ĮIĄ™J¶”MŗŸQĄ„N»•DæšDƑ1µ.±¢/­˜(“.²Ŗ8µ©:¶³1·«>¾°9Ƨ0«©;§œ7«®;­¤=©—@±œCƕ:¾£5½¦/±£0¬ž/Ŗ’!ؖ.Ą’0Ĝ,½§#Ʊ,¾².ij/Ƭ-Ä­"·²,æ«+©Ø8Ƥ3³Ø3©©=ؕC¦“AƚA³›6©šF«C°˜N³˜P¢“Nœ“Kš@¢”9›¦HŸ°;™ÆG›ŖB—­E”¶Iž­G¦Q“ØJ£Hš¦FžŖN‹„J‹—>‰ J’ŸBšÆB—¬GŒ¶E”²:†ø>‚±8€ø>|·?€¾E‚¼F’¹J„øBˆĮ?“°A„·:~¼7xæ9„Å>tĪD~ÉE{ŹDqĒFnŅ;xĶFtÉGsÜClĢAiŠ.^É?_Ė@\Č1_Į/fÉ;[Ä<\Ę,h¾3o·5ƒĀ?w½Co·E`Å9VĆ<_Į0`¾=`·9e¹0k¼8hæ5c“Co°Jc°OjØPiØLo„IkŸL¢B~Ŗ@„®E…®QøL¬N‹æSŠ²V„µH·Gy±HuŗT…«KwµNq©Yu§N|®J~°X‡”M€ØY„ PƒžR„—`ˆŽYš_‹ŠX‹Ž^‡Še{€ay‰hs„axŒhy†^Œ…gŽƒ[…vg|}e}}c€wd0T_,aU7YN7`V1Y_+TZ"XQ'\N$RX%OR%MX1CP??IDBQKQNRQU]XTYNSXP`WWeXSeQZZUSSRY]UPb^Wib`ckaav`[~aL}_MƒmLŠlQ‚^HŠaFˆaQ˜nW˜oT—qV”tauf›rbP–O–{P—WyN“pP•qU“{K˜};š‚<“€:—Aš4”Š6™ŠCG B˜‡Eœ}Jš}DŸwG¤w9›†?¢=®‹=«;®Œ<¤‡4±‡2¬‹1®Ž*æœ-æ›.ʛ9Ķ‘DĶBĒ—FĄ™E¶”9ŗ”=»”;ĦFŗ›D¼ž7µ˜9ø’9“›DæEʕM½šG¾žL¾šC³”>³˜:ø–=ŗ˜.“–)“ 3“œ/Æ£5½ 8¼­<¼«0· 4³™8©Ÿ7©„0³¤4Ŗœ.¬š6­—;ø :ø„7¾Ø4µ„2¶¦(µ+²”+»“ Ĝ$Ä£-Ƭ,ȱ.É®.Į¬*Ā²(Āµ#ø¦.Ø©7¤Ŗ<Ŗ¦3Ŗ¢;Æ¢:®“<ؖ:®—=±=¬˜H²“E®Q£–Rœ˜L—ŖHœ¬?¢ÆFž°>§·Fž®H ¦K˜ŖL˜±V”§R•©Q™žO›—O™šL••PŽŸCŽØE•„9˜®<‘³B•¼9‡»9{»5~²:v­D|¹<‚Į6‹ÄA‹Ć?’ÅJ˜½H‘¶DˆĆ=„ÉE„Ė?{ĢwŌ@jĪ@mŅAsÓ=kĢ9gČ7]ČAcĘ@iČ4lÉ0eæ5dÄ3hŗ0r·;{Ą8xŗ5iø=]ø3_Į9WĀ5_Ē2k¾(h¼/k¼6]·=_²PJTLK[WIZWDTUFXTUi^Tp^[iTTdWNT]PUUSVd`an_coX_mbTsZQxaLylI€fK{hFˆ^OŒ^OŠbT”f]gV‘q]Œnb•o`—‚R–‡PšvSuN’wJqIšwH;˜>˜†?~D’Mœ8„0”ŠB™}A‰@šŽ@Ÿ‡<–sHœ‚F­}C z=œ‘AŖ?ƐC«Š<­1·,±ˆ0½Œ6Ā•9Ā’4æš,ĖŠ<Ķ<ƘHĀ•F¾›<ø”D¼£@æ”;¶™CĄ˜5“–A¼—/æ’EƖ:Ā”;æ¢:ŗœ?ŗ˜C±ž1“0¼‘4¾–.²”/» ,ŗž:¬«5Æ”?ø²?²¦Bŗœ:·2Æ¢;¤¤?Ŗ¬5« <® 6¹”9¼§=Ä„/Å¢6“­4ŗ¬.Ɵ)ŗ‘*·›)Ä¢*Å©&ÄŖ/Į¤/æ³6Ēµ3Ƶ(¾Æ%Į©.¬3¬¦6«9·™=±—F ‹@¦›Kœ”Aœ›<«‘M©›B§RŸ˜QšØS’”KŸ¦F°?›°I˜³Jœ®F›§Hœ±Ož°J˜²P“«N›„YØJ’„HŠ”R”Bˆ¬GŠØ>“²A‘°A•µE‰ÆI‚¹:¾>{¼B²;·D‚æ?’Ć@ƒĀ?…½M¶Nˆ¹D€ĒC‰Ē@€Ś=tŃ>nÉBoĢG€ŅJ{Ę<€Ņ;uŲCtŠGpŌHcČB`Ņ7]ĶG^Ą:aČ3f¾7gĮ0bĒ9qÄ6hĮ=rĪ0xĆ6a·8b»;eŹ4i»5cĘ/eø,r°1kø9`“0g¶0]³9lØGo£MhšNj™Mož?j§Ez®?i¤LyÆQs¬Dy­LŠøG‰²LƒĘL|æFl»Ix«Bz¶Sh°Fg·Rs±FqŖG|±PÆNz“I{²MŠ­I„ŸM‘š^†œR‘cŒ_€a_x…`{fŽb{‰c€†jm‹ˆlˆ_ƒwl{`.[_)JW4SP2[F9VH6QC-IN/JM+IM4IC-HA6JK7DM>O]RNWZI[`HZWHbYNoeKnaOhWO_VRW[WU\PXfYUcOdjVguZYw^X€`L~dMykK~nOŒpZˆjSŠjXfT‚kT‘sVmR“xWŽ{Q•V™xR•yM˜…L—B–„8˜…<–ƒB‡D‹Š@G™…Ažˆ8¦yDžx>Ÿ‡D …E–LwC£€?§y>£…3¤ˆ6£‘4Ɖ>­ƒ?»„/Ą/¼ˆ2»‡5“ˆ4½“-Ō.ė9»’B¹ BÄ DŹ¦DĀš9ĝ5ŗ”6Ɩ?¼‘>¼7Ā6¼ž?Ąœ>¹Ø4ø¢;¹£>·ž8·›4ø‘2²“/“š;¼œ;¹›3«”1®¬:»¬9¾§?ƦC»›6ŗš2©Ø6ŸŖB¦¦<”4¦š=«Ø3ø©0¶¤-Į£8²Ŗ.“¤(µŸ(³™,µ-³£+¼„(ș$Ē¤)·©-²¬-¾·4½³,» -½¤/±=¹•=²E«ŸH¢”M¢œI›žJ š=Ÿ“@Ž?œ–N•ŸP—§N—¦F—©H›«O °J„£F¢¢H®O˜²L”²B–®Hœ¤W–£Z¬W­J†§LŠØL‰­F†ŖO†­P•¬?–§IŒ¬J±J{æG…²H~¶?€¼E…Į?ŒĒDƒÉ;„Ē>ˆøMĄL€Ę<ŠŹ8„Ł=€ŪEuÕ?xĶ;wĢ<{Ļ5€Š;„×D{ŠIoŹKdĻFfČ=kĆ=_Ć5\Ź=\Ģ:aĖ:`ĘBkĒCfĖ9qŹ7sĘ5g¼-k½%hČ.bÅ,^µ5dŗ/kµ/e¬3Z³3SĮ4]½0f®8j¬?pØGpDm”Bn«=g”Jk¤Nv Pr¤C{“E„³M‚µIw½Jl¹FnÆAv½KlŗHi³QmøJqÆRnÆPt²Q‰„J†ŖE~®K‰²PƒØPŠ¢U‰•[Š’Z‘Xƒ•[‡‹b…”bs–mx•e„‚c„g|~q‰~m„€f‰†m~c&MJ%QW2VD4XC1PI.HD)MF+CK(GG/ED=HM1CV:CONMeUOZRCaXETP@ZYIedKlXT_ZQgRSY_[abK\VV^h_hh\mi]it[dphZ|fWyeSylWz`W~_]}k]vnTŒg^…{[vRqTqZšyI‘uF™p=y@ž~E”€GƒH™ŠMœJ•{EŒ…Kš|I“ŠBœ„9™u3ƒ:œ€B”ƒB£z>Ø|9¤}D±…0؉.§{+±‚1®‚4¹{0æz)»~:¶ƒ/ø’4µŠ0Ź‘/¼Ž0³—;ĖAĄ—Dē?Ā‘>½•5²’.²•4°‘=µ3»‡;Į˜6ŗ•;Æ„C³ 8ø Cøœ:µ›=µ›(¹¢:¾ .®5“˜1³«8øŖC» 6½„6µšAŗ›GØ„=§ØEŖŖF¦„?¤§G±¢?«ØDø¬4ŗŖBĄ9¼›1“,³™)½—3»Ÿ(³¤/“Ÿ'ŗ‘)ʛ2ĀŖ3Į”5¶µ8ø >µ›3°–9³Ÿ9»ŸC¼ØE±£R«˜Sš‘J’P“”@¦šD”•E ˜HšžS žU ¦Q”¤Nœ£PØF›ŖU•¢RŸŖJ˜²S’¬R±R®X“°R‹±W‰²[€°RŠ£Y‡§Z§W†¤L™±M•²C†®M­FÄ=Ž·?…øA„¾9ĮCĶI‹ĒA…É?ˆĆPĢ>†Ļ;ŽĢ9ŅG‚Ņ?{Ģ:{ÕDsÄ=Ģ6„Łs”Caœ>a©ApŸJj¢Ns„Ak”=w“Ou«N~°Nn²Ep¶Jsø?m°Hj­KjŗCuĮJq»O}®W…ØTŠ„Ry°T{³T}¢S‰¤\Ž›[ŽZ‚”b€›^‰TŽZz“iŸkx˜]…‘ha~}izjw^…wd„ƒ`.OF*NN&FK-GF7JK5HE-LA+EI4MN0EI2@T:GQ=MYMH^KGWNDZECdL>\V=f_KeXSj`JeYHZXQ^YPkPMf_S]]^cn_^qfbs^R{]RueUze_}mbte]|iZ}tU…rW†sX„lQvZ™wZ”oJ•fEn=“xF“€?—‡?‘…G’K–KyS‹yIŒL•|?•‚0•€2¢z1 }5®ƒ;¬†<£„B©~:Ŗ-®}+µy.³|.“w)³y*µ&Į€2ŗ‰*øŒ*¾4¾’.Āž/ø™9Ą—5Ā7Ɨ;¶•4°Š8·‹+µ’-µ‡4Ą„9¹Ž7±AŖ™?“—?® :ŗšD·”<Ą„;»ž.µŸ2¼«0æ«*±¦/¶§1²§=±¤>Ɯ;Ʀ:ƤG­š?°”E¤„K؛F£¢E¬Ÿ;²ŖBµ¬F¼©E·¦>ŗš9Ɲ)ɧ+æ )¶™*ŗ›.¹Ÿ+½™0ʝ*ʚ(ĮØ/»Ŗ5“›@·™?°š>ø@³šF“£G«—G¢™M¦—L™—M’“O››C„MH›§Rœ„K”ØR—XŒ©N¤R™«K”±R“µKš±N›°RšŗJ“¶PŠ“R†©Pƒ¦^¤bƒ§Zƒ«Y€ XŒØU’«K‘ÆDŒÆB®DŒŗB”¶F•¼:·CŒĄ?¾JĖG‰ĆI‡ĖD‚ÕKˆŠA‚ÕAŠŅF„ĪE}ÉDĘ<}Ė:×A€Ń8ŁE{×FqŚ=lŪCqŪEkĢ?pĶCpÖIqĖAgŠGsŠFmČCkŹBxŅ=sĒ:f¾5c»3iæ/k»0k»3qø,g¹3iŗAiµ?e¾?Z¶9b¼>Y·4\Ŗ?eØ@l”K3LG7RNADV@?PT9RL>HS:WR>OVNd[H`VLYWV[TOcWP]PRdTO\OYec\encefa]sVQo]TnXW{^]nadpeayq_„hQ€jP…x\Œv\u^™oS™yI‹qNŠnB~=›„EŽ†@‘~NšŠI¤‡Q”O|9”u@–s;w1.§x7؊5¬}8«ƒ;«2¢‚7­ƒ/§Š9¶}.¬v&øz-¶0ŗ~'Ē~0æ)ĀŒ)·‡*æ“(ŗ0½”:ø™9Ä”=ŗ—+ŗŒ5ƍ/ƒ'µ4·Ž0²•3¬‰@°‘9¬”C“œB§”?Ŗ Aŗ—AĮš6¾¤4»œ1­7¶¤4°®.¬Æ1±­9³š>Ŗ›Fŗ¢FµÆN°E¶©E“–G¤—I¤¤GŗŸ8øŸH²“Q·ŖHĄ°9ø«;æ›3Ā—0Į”)¼6¶˜2Ę5ĀŸ4ɚ+¾4¼­6Ē¬B·©7±¦GĄ¦JæØ=ŗ§Gŗ¢A¤£EžœU™‘M—šRššD™—D££J¢—L›ØQ•£C˜¤Q”ŖVš£Nš²S•©R›²K˜­Q”“I–¶Y‘ŖP‹µL‰±MŠ©Y‘­^‡„V†„YŽ¦]†¬W‡Æ\ŒµOŽ°Pˆ²JƒµD“±F†øI’Ē@Žŗ=É5ˆČBŠĆH‡ĒD‰Ę@’ŹA‰Ń?€ĻK‚ŃT|ĖBÄK|ŹK‰ŲGƒŅ;vÕ@}Ś@€ĻLyŻGjŲGsŅFpÅ>jĶGrŅFdŅHgĖHnĘNdĀEqĘEzÓ:uĪ>fĆ>lĮ6`Į0j“-j±+e³/_µ9g³4`±7b¶D`¼8[°8\“>AA@G$>L&JM1MK&HI*SD8JH5BUCDSBOJ8?A?@GG=BU;GWJPMGOVFPWE^XI`MRVQIPbH[\NUT[YP`d[Z]d[`lTZfR`hUYvfTrf_sdglm]no]~iPŒdS‰oN•uM—xP˜yOyR–}EŒr=y;›|DžˆM„G”ŽJ”M¤‰=ž‚:£„7žxA›€:|,¬ˆ6©†;«‚8›|1š9”u=Ŗy:¢‡;±‚2µ.­y"Æ~%±}0æs+æ„/ĀŽ9Ģ†3ʍ3Ē–-æš5Ȝ<Ź–5Ź™:ő/Ą‡4Ŗ‹.­Œ&®Š,Ə3°•A¾”?»œ@µ›3„˜5؛;µž<¹”1¼¤1¼£;¬œ3²§0¬„>“®?¬Ŗ6øŖD³›Aŗ¤E·«E·°:®£7¤„C§šFµ¤A·§=¼«L³­K¼«D½°:·¢0¾–2¾Ÿ/ŗ—8Ā/½—*æ¦*Ę„/æ¢6Ę©1Į³5Ėµ=¼·?¶¬@²ŸE¾£I¹£Q³§KŖ˜S¢˜PŸ—P™›P“”M›šQ„”OžžG–¦Q•«I“®K”­G£§M˜®K˜©K›±MžÆL”ÆU‘“QŽØV€ŖW€¦H…§O­O‡²R‰²_”·Y‘±]Š¼ZøL‚°M‡®VƒµMŠÆLÆLŽĄE†Ē;ŽÄ<½I‚ÄGˆČAŽĢ=„ĘI‰ŹG‡ĻI}ÅR†ÉMĒB|ĢQ„ŌO€ßNxßFŌ>{ÕEvĶEnĢFuÉ>kÄ?lĮ;eĘ;]ĪDeŃFiĖKgČFhŌCjĻ=tÉ=nĪBmŃBbÄ?Zŗ?`¶3_Ą8g¼5^“¤~CŸƒ?„Š+©-³„1؄.¬|+°r*µ€(“‰/¹;¾“Aə<ĆØ/Ėž1ř/Źš6·•=½‡4·<“Š7³—2¶‹<µ˜@»A±“;®”6¬‘=Ŗ›Eŗ¢D±§;»®0“¤-³«5»œ<·Ŗ;µ›=²Ŗ?²«;Ø¢KÆŖE±£Bµ£8¹­8²¢@“¦G³ K®¤G­®J±«Dø¬C®¶B¹„4·˜<¼›C¶—BĀ˜?Ą™7Ę£*»š5Ć©/Ę®9Ņ§0Ź©6Ģ“=¼ :Ą­F¹£BÆ”Eµ˜QؗN£˜S¦”JØ„O£”R›žIž¢K™©R•­Qž„Mž§Oœ£O“G °V™“J¼LŖ°Z£ŖMŸ¤S¢W‡©J‡¦H¶H‡·Z“¶W•Æb‰ÆZ•¹^µRÅN—³R–ÆIŒ¹Q‡±J‰ĮFĄO”ø>‰ČI‹ĘEˆĘJ†Ä@ƒÅ@‰ÅJ‰ŠKƒČNvĢL…ĢE†ŠLŠĶNŚOwŲK}ā@yŲF|ÓKyŲGmĪAlÉChĶ>uŅ>gÓAiŃDeŠFlĶ=mŹ>fŠ=pĘJrČHkĆ?_ĪGaĒChÄ:a¼8`¾5fĀ6nµ>sŗ>a®Aa“?c½8t­AuÆIs¶Lz¬Co¤@nØGy­Ns²M}µN~¦M{ØRƒŖQsØQ|¦G£Hw=o­>}Ø@u²3w®@~²S}­R}™Q‰©R‚¢S‚„\”š`Ž›[Š”bxœV{Ø[{©T‡™]}š`†”k‡žhz h}Žfx•Z}‰azƒ`‚ƒ`‹‚OU?"I@%=?$BO*RI#PI+RC.VM3YK@RNJXHCNMFDIRHP]KOYPJSYMZaIRcNXfW\m\OgTSj]Xb\Rj_UnbYmaTsjZudR|ga…q^‡iXŒpYˆsO‰sU…wTŽoR›vP™rHœzG“Š?˜ˆ7•>¢…EŸ‹C”=§‡?¤~>„4–ˆ7”.ž†8 ~3¤w/­r/³o6Øx@©†A­ƒ:¢~.؂+؃+„{'¢v(°z&Ŗ…*¬Š'±”0»™=Ä¢8Ȥ6ĮŖ.Č”0·œ:·‘9¹Œ6²Ž;¾ŒGæ•Bø˜9ŗ™=Æ”<³™;ŗœ;±ŽB«Ž7°ž=°›7ŗ©-ø¤+Ą©:¶ AµžGƜK§šC³¤F®ŖJ²£EµØIæ£K»­=°­:³®>°©?®„MŗžMµ¢Cŗ¢MÆ«G«”@ؚA¶;µ“C½=ŗ“>“œ1æŸ5Ā¦5ŹØ4Õ©5Ń­6É£8Ė”Dæ›A»¦IÆ”S«—TŖ‘^©šZŖ™S§ŸN¦’K©–R¤¦UŸ§Q›”Lž¦Už«J™¤MŸ®R”±UŖÆ\Ŗ¶U¢²K£ŖM˜žT”J„«GŠ«N…øNƒ·[ˆ¼f‘ÆbŠ·eŒæa‰»f‘ÄYŒÅQ”µK™¶NŒ“O·G•ĮI‘¹M’»EˆĆOÄK{Š@„ĪE‰Ę?‚ĒB~ČLwÉT‚ĘN…ĪJÜJˆŁQ‚åFxįJrāBtŁ@wŌAhĖMiĢOqĢKoČArÓCh×FoĻ;mČ7kĢ;tŌ@nŹHsĶ?hÉ<_Ņ8_Ė@^¼9b¹6f¶6o¹:zæ>t¹1lŗ3l²;u“Jt¼Kw¼Ey“Gs³R|­Kz­S~“Q“Zv³Xŗ[ƒÆO|ØK{¦OwH„£M„¢Gy›<ƒØ<}Ø=”E{„Gy©U…žX†„U‡¦_Œ£S“SœQŸX€§VuŖ\¬\~Ÿ\w \¢gˆ›bžj†“d}atŽisŠb‰`~€\$L>!IC.PG"ATEE+QF$NG:TL1GEAUO>FDAOPJLOUPKPNPHN]QSbJ[]ITePOcMMd\RhYFi^IicYikKriSo_ZrdQƒgRƒhbaRƒdXlM€jQ…fG‹kF™gM”wK”tNž|:‘†E‹’=Œ:—8—†>„ƒA¤‹1“8ž‹<˜…1š„=£{.žt-Æ{7§w@„wIµ…6„z@Æ{2”}2­-“{8³x#²%Ŗ‡1“3Ŗ”.ø;ŜCț5ř/ɦ6Ē¤.¶Ÿ1ø”/«œ7µ–EĀ–D·JĄœCŗ 9³•C±›;Ŗ–J«’9ŗ•0“™8ø£6æ«4¾£9»Ø<µ¤<® J®ØD¹­Oæ°E»¬Jæ¤I³®M»§DĄ¦B¶°D“ŖQŖ²Pµ­Eæ©G¼±N½¤OŖL«I°–EĀ•M·IďB½£9Į8½¦7Ą¬:ĢŖ4Č©8Ļ§GĢ„LÄŖD¾žD“¦J§„V¦£Z®œW§¤]؞SŖ˜H„šV„œOØÆX—¬Qš§T„”NžžG„©J§V °OØŖUŸÆU˜®K¤„Q“£E‹ÆTˆ²Hˆ“N‹¼OŽ“V™µa›ĄWŽ¾U›æ_ĆUšøN“¼J‹øT½NŠĮM·I–¾LĆJ…»FÉEĆCŒŹEÉ>†ĀH…ĖC~ŠYwĖVÉD†ĪY„Ū_‚ŽWÜUr×ShŚ?pÓAfŃTqŹFxĻJsČNvĆ@mÅ=qĪ?gæ>tĒFlĀChĘGjŹEhæ3bĒA`Ķ?aĆ;d¶2k±3tµ;pø;k·1j·?oŗ9o¾Bn³A{¶@€¹A†øQy»M~®Q€°Z®[ƒ®P…²O‡«F~®K† Q€”U‹§L|ØK§E‚«?~©LuFt„J„—J|–X‡žU’ŸS‘˜^• P—\wžMt­S|­dx©X€ØX€ŖX~«d…”_‰›h}Ž[‚˜gƒ—]“cvˆY„PHN'DE,F>0OG%QL)KJ2LN4KM>LA=IFDME9NAAP=8M<>I:?Q@DJK?BG=AHKPDON>QNFISJQQVRUV`IMZQVcNNjHPdQBc^DkaSfeYklTz[Vz[S{ZP{[[x\Y~bM}gG~dH~fKfKpNoOŽzJ˜}A–CŒ‘@‡”B‡<ˆŒ:‘ŽA>š0žŒ3”z?Ÿz9œz4£o<”u8±r9³|A³‚<Ø{6­}9¤}8؄<³„8Ŗ„-±‰*²‚5Ŗ1°‡A®Ž?“—<æ“<½ 9Ā­8Ş7¹œ/ø;°™8¹‹:·A³™A¶ L­’Mµ’@¬J®œD·š<ŗ˜4¼™0Į”5ě+Ąœ2¹¦1¾§Aµ­IŗÆC¼ØAĄ§O½«G·«Pø¬PĄSµ¤M°£S©©YŖ°U¶®V¹ÆIø§O»¤V®¤N°›E¼›EƟSĄ™YĮ–NĀŸAĒ£=Å HÅ CĪ¤BŹ®?É«EÅ­C½Æ?¾”<­Ø?¬¢M®›S¬„\«™V ”Ož’G£’HžšV£ŖT”£KœF”œF¦„Ož V„¢V£®U­¬N£ØF™¢I¢«J”¦Q“¬Q‘±O˜“R½M™ĮW™·T”ĒO“ÅUœĪ\žĘWšČZĄMŠ¼Z€½W¶R–¹EšĄL“ĄLĖB‰ÄG„Ń@ŽŃIˆŃOˆĆIwĘSsČLyĒQ‡ŠMŠŻX‹ą]~Üa{ŪWrŲKiĻJnŲKqŌNtŌIsĖFlŹIu¾GnæMk¾Bu¾XČ;Z¼0NG7LB6IA;V?8L@9EDJE@>E=C@JUHFRJOHOQLGVYGOUCUZ?RkAHeMKlQO`SIaaLfeKh_StfR}_[{[KvZL\Q|_Iw^KƒTF€YH€aH‡hMŽkN’wL•{N€?‰8—?Ž‡<”3ˆ‰>‹‰B‘Ž8—„>š:™„8™{;£„F r<„nGÆ{AÆvCØu>£‚<Ŗ‚?¤ƒ7„y8¦‚0³ˆ0­*„‹0¦Š-°Ž:®‡5±–B½›6Į¦0Ą±<æœ;½•-³˜4·‘F®•C“Š=¼M»’E²•A¼”@¬’@³”I» :ŗ @¶š1¼”:Č 3Ģ«>¾Ø:ƦF¶©FĀ®;¼§HĄ²QʦM¾¬Y¼­XşYŗ R¦„I­ØK®ØY®¤O¼©T²ŖT¾¬O“§N¬H·¤R»§MɖWĖ’HśJĶ˜?ĪŸ?Ī¢CĻ¤IĻ°7Ā„EÉÆBĢ”CɦBĀ¢G¶©NµW®¬^¤–R®•JƚL«šMžW¦«J «Q™«Nš«K žN¦¤W©¦R¤ØO§ TœŖH›J¢¢H§ŖY™­W”¹J“R–³S”µPĄ]“ĄS’ĀW”¼V”·Zž¾[–ÄZ‹¾Q‡ŗ\Ž·T†¾BĀS”¹[‘ĮO„ĘQÉV“ÄKŹK…ĪH‹ĒNuĖV|ĖH„ŃJ€Ņ\ŒŚV}ŅVrŅYrÉRlŹUsŃXpŲSdŠCiĖLræDhæ;eŗBuĄNnĮw“5qøBhĀBkµ=r³KuøM€»E‡“O~½L‚øWˆ«XˆŗU‹½Y‹¶O~ŗF†°I¬;‹­J}±Iˆ°B…”D~ŸH‚ŸKƒŸL|šNw’F€’Tƒ–UˆžW’—T«YŠ„Ux£L«[~«^s¢X} dw™a¦Xw„a„Xš_„˜_ŒcŽ”S€ˆS}W[?RI PA+IF5LF>T<>XE?ODDOC:VCAVG9K@7MCACI]FBlKDkUIcbJl^GihGy`G|^S{`R~fSveXyVKu^N€XJ„VJxUCz^C…gA‡o@ƒxEŒxE’B†:‚Ž5Œ?†‡7‡Š6ˆ~5’5“‰@—†;Ÿ@¬…J©ƒF°}K©vM«yGÆ}@®€?«€@¤B®|:«…>¦Š8 €:©…3£„*®‘1؏/§‰<·Ž5øš0ŗ£-ŗ„0¾œ6“ž9¹=­•F®P·”J“ŽRø•H·œHæ”D³—:²š=³¤Aŗœ=ŗ™CŦ;Ģ¢>Č«:É£:¾¬>Ā ?Ą£=Č£BĆ®MĄµSĀ°[½¦Wø”Vø S«¦J±£T­­PŖÆW®ŸQø¦Rø¢UµŖY·©LŗŖK¾P»šUĒ™LʒFʛNĶ”GÉ”HğIĻŖ9Ī²BÅÆFÄ„FČ„AĮ®E²¬M·¦G­¢RÆ”V²P®˜X¬ŸS¬ØP¢©K¢ÆEœØKšÆM„ØYƜU؛WØ”W¢™O£•S¢¢T¦²Pœ²O’»J’³R’µY”µ\ŽÄS“ĀVœÉQœĄS·T—·Y•·O–ÄVŠÉJ…æO{æRĒPŒŹ[ŽĆX€ø`€»`‰Å\‡Ć[‰ÅSŽĖL‹ÉG‚ÖQxßZŁS|āLŁVwŲXuĶ[{ŠVrŠUtĻ^eŅUdĒGcÅGeŗIcø@aæJoøIp³Jj»Fh·9OEFDU>DNJGTAL[:OW;IWGA\FCiMi_Jc`=d`OghFijLufIaEu\FnQ9rW9‚SD€aI~SB†WF†^I~b<€u7wFˆˆHƒŒ8ƒ‚:…‰3x;‚};…{/‹;Ž~9 F–HŸ€D¦‹L§‡J“vJ©ƒ?­„CŖ|=±6Ƅ8²‡E°†<ŖŒ3²Š8«‡>¦0±’@ؒCŖŒB«–8«›.¼™)¹¦-­”7© B± IؗF²‘Q±šIƜE±JĄ”KĄ”D½—=ŗA»7½“9“©Cæ®8Ā¢>Č©@Ā«@“¤I¾Ø?Ĥ=Ä©L¼¤IĆ©]ÉŖ^Ā­N·§P¶¦G®„H°«P¶¢OÆ M±•IøœZø U¹ Nµ¢Nŗ›T²—ZƎNȜRşHĒ¢VĒ”VÄ¢NŹ¤CŠ£@Ļ¢:Å«DĮ®DĢØ7µ­J°¬M³¦Sµ¤Sµ©Q¬¬B¦«N«„C¦©IŸŸAœ¤Fš¦Mœ¢K©¢TŸ„Z°ŸU¤¤_Ø]¢¢RŸØ[ØŖ\„¹[œ»W›“P—·N—½S›ĄY˜“`“½[–ĖQŸĄ[˜“\ĄN‹øXŠ¹]Š“YĮ\‚ŅTĶS’ŗ_‚ĄVŠ¹_»U}ÄR‹ÓXŒŃOÜW†ŪI‚ÜR~ĪW{Ū^wß[tŌ[ŌZwŲ\lÕOkÜU]ĢUeŅRaæ@]ÄKj·Gr²Ck»Jg¼;iÄ9e»HcČ>^ÅKd“;e²@^ø9eĄ3k¹=o¼6d³Cr³1q°2uĀ5bÅEvĀGpĮC€¾Oy±O…“IƒøF‚³Lˆ·S†ŖP‹ŗVŒ­J~µH‡¶KŒµC±G‰Æ7§?„žH™GŠ¢=…‘H•E~žK‡—BƒØ?Ž„O“ŖQ³P†§Hz¢W€ŖRŠU~Ø\€«a{žet [€£b‚™c…š]y“Y‡Œ^Ž•^†–R”TG>&L>2M?0?I/KM3JN3KJ>H9DL4BE5NIXKN\CLaFP]:H`jdI^[IZgAgdAf_>tfBug=l\8~X8\3v^>wZDy\J^F_8Še:wJ…€HŽ}FŽ~A‡n<ˆo;…:Œ‚.œ€/šq5–s>›uIÆzJ²‰G°ƒ8“7ø@±†>¹}A±x4Ŗ‡C®ŠGµ…>³ˆ?„D£?°;¬‰?£A”‡>©•@„“6±˜0¹™$»—9®”=Æ£B±˜K±žH¬”FØ¢G®•R°™DĄ£<¼—3²’4ŗC³™Fæ¢CĮ­>ÉÆ;ĬBø¤;»ØCÅŖFĶ¬BÉ”DĮ”MʧYĮœ[½¦Lµ§F»©B²KøšLø¤N·ØI“œR¹”W²”Y²§OĮ›K“’Nµ’U“—FĒGĢ–IČ£SĢŖUĖŸLĻ„GŅ”9Ų­4Ņ©6Č¢CÅ >¾®>¹¬E“£Q»”M½«H­­B£®<” Dž”J¬”F¤ŸL™©U›„]ž„U¬¬Yا_ØØX¢¦`”§^­”TؤZž³]˜²T˜·O–½QŒæTœĮR›µXžĄ[ÅV–¶R˜µT‘ĄU¹V¼Z‹ŗ_Œ½^”Ķ[‰ĶbŽĄZĀbƒ½`É]xĢZ‡Ö[„×P…ŪSyÜNrÕ[{ŠY‚Ķ]{ÕWwÓ]ÖQ|ŅQuŽLtÜNcÕL`ÉEbÉBkĆBnĮHf½Bmø?r·Fl»ˆ™7~˜.„š6ƒ”9šI„N‚£D£Q¦NŠŖG„®F| MzT†£[‰›b…„e…„bšb˜aw”\|œ_Ž]~d…˜^‹—U…”V‹Ÿ\*N=&U>(L91?J1II2BP:AD4CF@CQAAQ€hA„zJ‹~?‰t;w2l>l.ƒ{0–u9™h>™o3£oB„„IÆ?Æy6¾z?­†1±‡A«€;Øz=„~6³ƒ<¤“:©9¤‰?£†D؎5Ɔ7«‡;¦†?„–6£3¬‘/ŖŸ­”7“©?¶™>·™Jŗž=®ž@³¤K“ T²˜H»—>±Ÿ?¾œ@½Ž9µ™E»™Jø®FµžL»¬Hæž@¼¬CʛAŅ¦RÄ£OĆ SÄ NČ¢Z¼¦U·­HŗœNŗšN½¦SĀ¢U¼›V°šMæ›Xµ«J·¢FĒ”O»—H¼˜K»™IĒž@ȧ?ĮØMƛTĀMʞMĖ˜;ÉØ>Ė”CĶ©BŅ©7Ē§HĄŖKĮ®H¹§Lø H®£F“”C«ŖJ§Ÿ=ƛ?¢©P˜±N¢­[œ°R©R±«_¬£^¢®[„«c§ŖS§±_„ÆTؼQ¢ÆK•¾X“¾W™³M’±UŠŗO—Ź[’øY““W’»P–ŗMŒĘa‰ČcĮW‘ÄNĄP…ĢT}ĀV†¾V{ĻUĖUƒÉPŠŻS„ÖX‚ŃVuĖ\ŅSŃbtĻa{Ō`|ŠW}ŽOućIcįM_ŅXXĒLcÅAjÉKqĒTnĄBmĆ?nĄBeĄA]“C_ŗNlĀ=jŗDa³Aj±De¶AbÉ7nĆ7d¾@tŗDp°PsĀBq¹KrĆD}ŗ;€±Nv­Iz­M…¶N‡ŗU…·R…©C‚œ>y”Ly¢M~£G‡žJ‹­E‰±<—«6Ž >›@™6ƒŸ:“”B‚žH{©E³I’³Iˆ®C†­C„ØN¢\œUšdŠØ[“„X€©\ƒ£]~˜Z€Ø_u–X{Z{—P‘”U’¦M•žX%I3-M4,O6'IH$GS-DL+HL5?H5CE8MI@KGDJQLBNBJNLSRMLJRA?T?9W43Z:oY=oV=rZ3m`8dW;l\7gS>`Q8c`=nk9sf¾”C»£Hµ U°žR¼›OĒ™JĘ”DĮ“NĒ’TĻœUŹ—Z¼§P½©KĘ²NĮ®Jø§X¶¢X½ ^æ YĘO½ J¹ŖD»£L“—C¾•G“ŠE¶N¶ H¹¢B¶­F¹¦D½¤IĄ¤PʟPÉ KĄ”?Į¢CĪ„=ĶØ=Ó„KĢ„GʱD¾¬NĮ S»žO®šK©¤>”ŖGØ C§°AŸ±L„©R„©T£°\­§[¦“ZŖ¶b„±g¦“c¤¹^Ø®Už¼Q¢øW ·Y¤ŗQ¤ĮO“»Q™¶VŽĄQ™ĮY™Į[›¾Vž¾R™æRÉ\¾[ŽĀMŒĢIŠĘQ~ĶY}ČZ‚ÅX|Ķ_ŚZ×U{ŪX}ŠS‚Ī]uĢVo×WrŃfĢf{×a|ÕXuÜQbŚ[`ŌW[Ź[^ĀNaĒOiĘNqĮMqČJb¼LcŗGaæ@aŗCf¾CiĆ8l¼7_¼=dÅ9nĒ;vĶDqÄHmÉSw¾QuČOtĀK}ĮH}·B~¹K|²J|¹F³L{“R~³H~”M€ E„™H¢F„¤E‚§NŽ¢D‘«D˜©C•¤A‡”2…›4ž8‡ŸAŒ§?…¬LŒ§M†³F†®=€§B|E†T~\„›[ˆ—Z£Vˆ¢OŖU‚”P€¤N}Zy•Z‹œ]‹P‹˜Z¢S"<3&I<@8>IKE*C;)HD2A=.F>1::@G>8=IcDCcG=]U=aV7q^2kd4d^6gL?dTC_ODc]@`hAh[„m?‹x<‰r9kBŽa1’c.šx-¤r;£m5Ŗt9·u>ŗ|8æ‰5æ‡A¹~8®‰=Ƌ4§•;ŸŠ9«…3£“9«Š6Ÿˆ8 —/Ŗ‰>“–:°0œŠ;„›,ŖŽ%«š&½”.»¦0»”;ø—:“–Fø—:µF“™?µ§B½™HĄF¾œ@Ɨ>æ§Cµ§S¼šHĮ˜M»¦UĀ›TĄŸNęPĜOĒ™ZĮ„S¹¦V»¦NĮ§D¹ S±žK¾Ŗ[Ä­S½©VĒ¤RĮ”SĮŖP¼ JæœO·“Oµ—Rø—Cµ˜O¼¤Oµ©G¾­@Ē¢N¼ŖJĄ•EĪ£KȤ=Į¢IŹŸ9Ņ¬BƞCɱ<æ±CĆ«Pŗ„R°ÆCø±8®¤=°£EƧF±±Q®K«°L¬µVµ°e®¬džµV„­YØĄZ£ø_›½YŖµa¤Įg ŗY£ÅJšæW”ÄYŒŗQŽÅV”ø[—½V•Ź]™¼SĶUˆĒ[ĢaĻWˆÉ]ŠÓT…Ķ^~ÓWÕ`‰Ä]†Ģ]…Ż[…Ód…ĒTtŌasĪZrÉXrÕotÖdzŅ^rŽirŁafŃ]iÓO_ĻN\æUaČReĻFiĘFjĶKeÄBrĆF]³K^æQ^·>`»;gÅ@cĀAgĀ>iĀIfĀCwĄDzµQ€µRwæL|¼Mƒ½H·Ez“I|“Px®N‰²GµAx·J³@€ŖK†ŖE|§?ƒ§<€¦N„©N‰³CŒ§H‘„=•£;‹,‘¤3ŽØ?†„I…„OŠ³Fˆ“@ØKuÆGƒØB™P~žU„^‡¦U‹¬Y”«Y“„X‹±Oz«Yuœa„b‡„WFžX‚®V3/:9<9@D+<>.@8)E@.:C+=8-3<-=:77B=EOJCLNJHJ?IL@JNGLI9IO5;UE6RF>YK@eLAdO5^N7gU³j8øpA®‚9¹z;¼=·…A°ˆ5؊3ŸŽ6Ÿ”:§‰?ž‘@¢“4¦’6”—:§ >Ɨ=«”A¤‹4§–*”’.Ÿ•'­˜0³”4²˜?¶š:«–?® C³?·›L»ØK²K¶“B¶ŸI¬¦J®œE¾¢LŗŸIæ¢Rŗ§ZŗŸUæ OøŸY“žTæ Sʟ[ĮšU¹œQæØIÅ­O¼©JÄ°Y¾­\ŗ¬VʦP»ÆF½ŖLʞIʕEĔ?“œG¬œH²˜Jµ¤O¶ØHĘ„Kŧ?¼œBƛDŹ @Ѥ<ÕØ:Č”EČ«?Ē¦9ƱDÉŖ=Ę„C¾°L¼±FĀ³@¶Ø9·®=»«Q±¬U„®W ±R«ÆdÆ°e©«e›°V½`£ŗb”¶^½W¢¶_ŖøgšĆd‘ÅO–ĶJĘU‹ĆY½N’ĘX—ÄYŠĘRŠČ\‘Ķ_‘Źa‰ĘfŠĪbŒŹWŅ[†ŅZ‚ÖX‚ŠW‰Č[ŒĘe†Õb†Ķ^€Ķd|Šg|ĪZvŅ_rŁfvĪmvŅgqÕ`mÜioÜ_sŠRtĢWgĶ[hĘWpĘOmĪPfÓJmÄNo¼G_³R]¹Q`ŗH\½K_ÄE`ÅBc¹F_·Jk»Lp¼E|½D|¶L{°H~²D©G…°?{ÆF{¬N}¤K‚­:~³A}±?v«D}®A†®=‰¦=§@‰ C‘£M’ŖIØH—š5‹¦7„-™«;”@•¦:”ŖB„£?„«Hy³Jz¬;{©:D 0C1351.D.=@24>+0:46G66DA9B>BHMBKD4RT:KJEFVF;I:FZG;ZJ0cB8jP2mP4mH8kQ8kV5b_;iaBaU8lQ/^W@_Z<\VGbd;`c/a\/dW5mV6iW;lV>v]9t]3ua<Œ_:Œc4Žn;Žn>‘fJ‡i;…{8‘q?‰k4’h1‘^&¢k,”i0«q3®e>øl9·w7¹†>±|@²‹2¬;§–0¢–2œŒ3°Š@©“9›•/¤—A¢‡?®A¤™8„‹7ŖŒ5¦Ž1ž'Ÿ+«–,©—3­™;œ˜4œ˜@¬–:©©<¶™M»”V­—Eø”VƙU©”G·žP³œ[¶¢RµU¶”\µ™S°ž\æ‘Z¶TĆ¢`ŗ“WɕY¼ X»®JĆ©UƱUĦQ»ÆLĘ©ZĆ£XÅ„Tŗ¦Q·—EʜJŗ™Eæ™TµJƙN±˜I·”BÄØ<¼žEŹ™@ɞ@Ȟ@՝?Ģ¢FÕ¢DŠŖAĢµ:Ō°=Ģ¶7Ķ®F¼·;Ė²BĒ»EĄ°Jƶ?±ØG·øMµ“Q²¹P„³[Ÿ»_žĄ]™¼b˜æ^š½[¢¹`˜ÅU˜·a ½b¢»Z˜Č[›ĒYŠ½W“»L…ĀJ‹Ė[ĘUĢT”Éb”Č]“Ć`…Ńo„Ģ_‡ŠhŠŠXŁ_…Ö\×\ŠŹ[…Ś_~ÓdŚauÕjuŅbrŠfpŚ[oäjnąj}Ņ`nŪqfŚetŻhtÕ_kÉ\lÉ[mĻS`æ^eÉZbÕLiÅYk»P_ĮNZÅWeÄQ\ŹNgæFZÉGcÉFdĆDc¹MzŗNz¶@zæI†¼D‹ŗ<ƒ¬7‘·>ŽŖC‚¬M{¹L„ŖD€¶Au®9ƒ«4|±A„¤>ƒ¤3Žž6‚¢BŠ›A™œD„;™¢;2—­-š¤-”£:“Ŗ9”µ>®H“¬;‚¦G…”>@>E;?N9MP8RR7EW7FTD?ZC;g@2e;4gG4bH0kF4bK)aT-jN3iV:lT=gU8]S6]_D]T@_X=b`;[W7\Q1lU+t`.oY2kU7uX0€X>…_:~j6g8„bFˆdD…hH‰n>‡p=p:Žq/˜g,„i*£].¬h-°h2³s*ŗs2½=“€>±‰7«“;©˜7”’:®ˆ;ŖAƈ7¢;£D«ƒ<žŽA¢Ž?Ŗ’F©’@¤–:˜.›*—”2œš,—•-’š2˜”7›œ?©£@„¢K¬—S±›R²X­”Z®™TøœU“›X“–X­Ž]¬ˆ_±ŽW±”Q·‘Q¾_Į—]¾žUŝ\Ė¦ZȦXÄ«YĘ©UŹØIĮ¦L¼œPƝT½–SĀŸPµGµœM“žM½šQ¶Y¹–R·£DĀ¢?Ē™:½›<½¢<Å©EÅ©PÉ”MÉ£GŅ©KŲ±DŁµ<Ö±6Ļ»:ĘÅ<ŹĄ7ȶ7Ź²EæøH·°C·ŗH¹·MæĮP³¹X©ŗ_Ć_–ŠjšŠdšŠ]˜Éa–ĘW’Ć\›¹h ¼c¢»n ĮhšĒd“ĄZŽ¾UŠĶUÓY‡Ė[ŠĶ_Ī^…ŹbŽĘhŽĪq‚ÓmŌn‡Ņ`ˆŹaŒĶjŽĖc†Ö`|Ó`yŪmyÜuzŠl}ÖbqŚ`m×]kŽiqŪorŁgkŻllÖmlŚbhĪcrČekĒ_bÄ\`ĒejĮ^jĖ^iæ`lÄVhĒReČWnÄSlÉYpĄQeĮRhĒOeĘIpĄArĀJt¹;‚»9ø4‰µ:ƒ³1‹»9…¹;Šµ@Š®K‡³E‹Æ@~µ9“0ŒØ/’ž:‰Ÿ5Ž’>ˆ•>Ž>“›=–”3“¢0–£4•­2—­2—­/–Ŗ0—°A“³F„>Œ¬K”It§Ox­N{©V‚¦Z|¬O€ÆR‹³LŒ¬U„Ø]~°b‰­\ƒÆ[‚¬Uz“W|¶Q|ŖJ>.$4)*1:#.<032/(<3/9+4J7.E,/@8.C1?@24:9cC.gL.^P8eB1_K5lP4eQ4hb9]_+aa7eX;qWDrN@d_4dS?]R3]`1VR/fZ.l`$fT+p_,uZ'xW/xX9…e>}_:‚r5‚hD€cCƒu;m9…m7™s>™t=•p.Ÿq2®_+³i1Æn6®q6¼v:ŗs7§}E°‹=²J­ˆ9‡9 „@؇<£8¤‘FŸ…G®ˆIœ„H£†:©5¬—8¢’0£˜6’œ(œ/™(’5¤–9 Ø?¦4›¦@ ŸDŸšV©”U¶›S«›W«–Qµ¤Mø¢`²—Y“’Y¶–P¬ZøT·œO³ SƘ[¹—aĒšVÅ©^¾£XÅ«]ŗµ\Ą©R¹°MÄ”NÅ”OĄ˜Y²£P¹«WĄ”V¹T½£_æ©RµŸN¶¢C¼š=Ä©8¶›=Ā„=Ą­Mɤ@Ė¦?ÉÆHÖ­DÕ®?Š»:Ēŗ?Ģ»?ĆæBĪ±DĆ²OĶ“LĘ°Q¼ØJ“¶H°·P³·\²»[”æY¦ĒbÄ`’ÉcžĖ]šŅ\“ŠTšÅc¢»f”¶]”¼džĮj”¶ZŒ»TĀV‹æ\‰ĪP‘ĘbŠÅ\Ź_—ÉfœĀkˆÄr‚ÄkÓ_†Ģa…Źf—ŌcˆŠe‹ŽZ‡Óm‚Śo†Ņj…ŅkÓ`v×arŌ`e×dnŽoqŽmhÕimÜhmŹhmŚ_iÖioÖc`ÉibĒZ]ægbĪfcæahĆVeÉZ_½\mŹ`nÉ_e¾LmøNkøUp»FmĆBoÄE|³:w³F~¹9~±?²7Æ>„»F²C„²7“Bz“4„¬7‡Ø/ƒ­3„®)ƒ4 .…›7‡¤;‘ F”¦<•©8˜¦4¶<›°4”©,§=œ¶7Š­GŒ«DŒ AœEx°O|®Hr°P} \®Y«W‡²Y‰Æ\·U©a€·X}ŗT{µ_w“[„µH‚±I7+&52+4(-:-57*-0$&>.)B53?.399.D65F/9J92FK0DQ1LP5NKE>SHBXM:WE7[M0cD-hK2lH(bN+dX9]`7bb:f\2oR;rK>mL=qS/gR-e\8`R1`X*]b&h])o\(t[.uU6wZ.{c8z^4x_@ƒk:ˆs<ƒr;€j6Šl@‰gG‘m@‘h;s2Ÿm/Ŗr0¶{2°w@·u?°s3§u?©zK¦„B±|H®‚:žˆ4Ÿˆ4¢…6©Œ4ž@œ“MŸ’IŖ†H¦†=§> ˜;¢”>¢•4”™+“™+Œ6–4§ <©”8¢¤Fž”BŸ«JŸ§G¢›Sµ“N³•J¬šKµ§^»©`³«]Ɯ`± N³”Lŗ™Vµ Uŗ„`Ą”YĮŸ_·™W°”Y¹©TĮ±P·°XĄ·SøÆDĄ£G·£M¶O°”Wæ£]æÆW¶ŖQ¹Ø[¹¤Y¹ÆM²¦L¼œD¹¤@¶¬CÄ°MÅ®IŅ¢CĶ¤<ĘÆEĶÆ?Õ“:Ń³=Ā®=Į“EĻ¹MŅ­JĵUĆÆT¼­Q»«T±®S·¬Zø³O³“S­³V£¼YŸĄN–ČQ›ŌR¤ŠR›Ī[ Ź[”Į] ½g¶jŒŗ`‡½d‡¼\ŽĮZ‰½Z…ÅRŽŅWšĀ_›Ći‘Ęk˜Äe”Ąh“Ęj•ĪWŠĘR‰ŃR•Ö`›×[”×_ŒŲb“Ņp‰ßc‰ŻcxÕZuÜbzÖ`mŃiiĻnm×cuŃbpŃpw×gsÕ^oŻkoÓipŠjfĀ^eÉ]gÅanĶcnĒYdĄ\\ĄbYČbgÅTh¹Vx¾T}·Pu¼PlĄAj·ChĮBuŗBt¶Ezŗ@„»Cƒ²D…ØCŠÆE}²:~ø3}²1‚¬=‚©6Š±,ƒµ4ƒØ-„§5Œ™8šG€¤L‡Ÿ=ˆŸ>“”B‘“5˜«4¦5˜Ø<—±<•¹GŒ“B†«=ŒØE€§Kt²El°EsŖPt³I{“K„®M~±[y±Y²So¶[nø\sĄWv¶TƒĄQ†øJ%,8%;*73)71$7-!6+*5=/*F38@27J4:H2:@78J7>VI7TG4UI5QFl^5gQ*kL9hC9uC7iE9bL/kR4gM/tU4pY+kY'mY,if2ya,nY/q[7ka@oh8}`9yiByk?‹kBŒaF•pI–pK{;ž|2¦x;©i3ŖyD²w@§q<­~F¤|GµJ­ƒH­@“‰7›Š9£Œ6 ˆ8¢ƒ;„—L>­“J®ˆ=؆?¬†>§š5›’/˜>™”:• +ž’-”Ž:››5©™BœŖI•ŸD”šE„˜D³”B²LµœT­™Y½¢[øÆY±¦`Ŗ–S·š[²ŸH²RŗšQŗšOŚOæ¦JŗØL®£Q½±P·°Uµ­P°³M¹±Q·«M·“M¬±T°®Y°¤P³µTĄ³U³“`±±\¹²I¼ÆN¹ØF°ŖE·¢Qµ³JĒ®CĢ¬CĢ¦6Šø:Ī¶<ĶøFŅ®?Ź±=Ę©HĮ­NŌøDŅ“JĀ„O¹ØZ¹¦V¼­\“¤`¹²_¶®W®±KĀMØĮKžČQŸĶ]™ĖQšĀa”Ę^›ŹZ™¾a”¹]¼WŠ³`ŒĮS„¾X‘ŗU‘Čd’Č\“Ģ[’Įi™½g›Ćd„Ķa•¾k–ĖX—ČT˜É_•Ļ^’Ņc™Śk™Öj—ŻpŻh‡Ū`‡Ś\nŲckÓeqŲ]m×^gĪ^wÖjtÄ`uĖczĶlzŅerĶnoĒ^sĶ]iĖboŃ^eÄZhŹScŹ]YĆZ^Ā\aĘNgÅVvĪMqÅTq¶Aq“Nj±Mi¹Ln·DxĄ>z¶C|ŗ@z·?u³=€±D|®9q«5~Ø?zµ7ˆ²2‹§5€«3„7‰”,@‡©;…ØD€ž@‰ž@„§:’²6—«8““9‰Ø2–°:ƒ®F‹„@‚«Mƒ§F‚±Bs¹GnŖPk®UsÆW~øLt±U}°[©Nƒ“Jw³Mvµ^røb}øZx¶K“J,21/627-=)53#1;-4C57K90I1:M4:F8;B?=;J3:D4;G10S=2P:3ND4U=-\E2dU7eY>aUFkWĒø9Ę½DĖŗ?Ō¬DŃ©GĢ­GĒ¬GĆ³AĶ²HČ²KÄŖPĒ®OĆ©^Ē©c¼¦_Ŗ·[§·NØĀJ¤ĄMž»K„ÅX”æ_ŸĆVžĢZ™Ģ`šĶ[™ÅWš»L—ĮO‘ĀJ‰µUŽÆ[Œŗ\”æc“Źb‹Éc”Ć`•Ća£ŹnŸŹk¤½e›¾bšÅYžĻ[”Õ^”ågœćn—āc˜ŚgŻoˆÜg„ßXxŠYyŲdrŅ_hÉZnŃZsĪasĘ_nÄftÅhpĘdrŅimŌgpŃgrĢfuŠ_mŃYfŠRb×TdĢYoĘQiĪOuÓQwĪJwĒLt»BlĄKb¹Gcŗ@e¼FpŗCo¾IwøGsµHz¤‡Ŗ<€«?„¦L‚¦Eƒ·LŠ“Oƒ®Eq­Jo“Pw³Lw³U{±Vo£MpŖQu­Kp³Zm³]{®Zy·Yv±O|µG',$-377$;+$?<-8=*0:9>=64;:6C/6?93DA<8BA;FA2F.1C.7C22K?6BB8EE.UB:_TlV5rV6`H._O6_E®‡@Ø~G„‹D ‘SؒO²…=­‚C”ˆ>؉=Ÿ“?Ÿ™=š’5›™2š“<¤Ž9 Ž;Ÿ˜9” KŸØG•ŸW¤›Pœ”Q­’B¹‹<µ“P¾¢K¶ŖQ»ŸTĄŸY±ŖLÆ¢S­±J°žB± F±šKø™W² I¼žE¼ \æ±]·°T·«Wø¹W·µEæ¹J·æ]°µR”“]«®W«Æ\­·T·Æbŗ±Q±¦V“ÆY²Ø\¬­O±ŖR¶®L°„=²µBø¹>ĖæIÉÄNÅ°EÖ®OĵSĪ²OæøO¾µLĆ£N·¦Xµ²^¶²^Į°c½§Y·©Z²¼I§ĮK„¶J”ÅT§¾^¤Ć\ž»\ Ä^žĒd£ĆV‘ŗa•ÅU“Ź]“»[ƒµP…¼V†ŗ\ŽÅ[•Ā[–Ā`˜Ź^”Ėl¤Ąj›Ķi£Ęo„Äe¤ÉZ§ŠežÖn—åg—ėg˜Žm“ąg“Ņj…×d‰Ž]Šą[„Ų^wŠaxÉbkÉZ|ĒXsĮ_oĶgƒÅhnĒboŹbsÕjmŪqjŚexŁ]wÉZlÓYsÖXoŹTgĖTnÕYlČF{ÕGtĮItČCk¾>n³Gm°Kk°@uÆBkĀBk¼Ei“NmØHl”5y2u®369;-C>/<@./?=3B@78DB7J:/P17N=3C76GFfS4rU3lP8nG9bH8^M4c@AfD@eF3_X:e[4nf4l_;f\@o`4|c9~\9xdDpjIrqJkg:nrDzqG‚jO‹hH‰aGˆc?ˆp9’p@–o:™{?žzAœk9Æi;±jE·nE²k7«i;“pKøyR²tI®y>Æ{AŖƒF¶ˆ@±ŒE§“M«—I؏K¢Š<§ƒ<‰F–@–’;™3¤: ’7 ‘5•Ž=‹–<’™CŸ Kž^؝Q¢ J®–AƏFƙI½¦N¼¦Pŗ©Sµ„T¶¤L°§M³«Mµ­F±ŖJŗŸF»›Sŗ£N“žO¶©[æ£b·¢U¹²Rø“V±®K“øT·µ\Ø®]¦®a°ŖV²«R©¦WƱV»°Q·³X¾¶\¶ŖW»ÆO²§E°žH®£B·ŖOø²L½»LĪ½KĶ¹EĪÆJʱIĹUĒµJø¬O·„X³£WƱT°®Q“£Sµ¤d©¹Y¬¼L¤¶F”ŗMšµW£¼VŸ¾Q »W§¾^¢Ā]—¾]˜½a•½b—ĆZ¼RŠ»S’»VˆĮ]Šæ]’Ą] Āe æl¦ĄiÅq›År˜Źgž¼a”¼ažĖlœŲmœÜg āmœŚp™Łr–Öv‰Śn’ŪhŠįY„ĪZ‚ĖXtŃbwĒa{ŹetÉ`zĪg‚Éo~ŌnnŃfkĢcwŌi{Žin×ikŃlxĖ^xŲ_o×QhÜPrŃToÖLvĻNuČCjÅ@pŹHm½Lp²Eq¬=l®Fl¶Dk­=l±Ex£?r 5vŖ:w¢0{¬2ƒ©8„«1‚3œ;©?|„EzŸLs„J{©H}Ŗ?r“ExæJŒ¼M~øMxØB…³:‰¹=°=‚®:€Ŗ>|µJqŖRn­SvØXqÆMq¬J`¢Jc¢Tj®Rh¦Vf¤Yq ak­[qÆSoŖNsÆHi¬S"*#"3'.-,;7287?4HB=eN?mM2fE2sYosOvvA‚kHˆrFˆp;…_B˜_8’d<œi=›pC qD“s?©lF¬nF«v?³h6©r9±j@ÆuL¼tP“uQ¼pE°t>æ„H“‡L«ŽVŖN«‹DŖ‚6°Œ; ‰7•‘@”…4”•/›–6“@›‹<œŠ@ŠC¢F—¢M —Z¬S££H¦—N¶—EƛRµ§CĄ§E²¢V¶¢E³„E±±U¾³Kŗ„L®“G¾ŸF³ W·«O°žJæ”W¹£d“Øe³ÆX½¶QŖ¬XøØQµ·X²ŖZ²¶V±­Q®µN®øM©±Q³ÆN¶¹N¬¶L³“TøØM­¤C¹°@µ§G¶£Q³²Mø°UŹæJĖ°YĪ“ZĒ¬W¾»_ÅøM»³M½«T²¤P“­OØ­J«³[³”f“µ\§°VĄI˜ŗGžĮT—ĘN—½[Ä[•ŹU Ė]¢ĆZ˜Čb’Ē`¢Ģ\ĀQæ`‹µP™¶b–Ā^¾b›¹d—¹`½h¢¾qĖl•ĀfĘZ„Ég¦ĢjØÕc×n§Śi”įf”ßm’Ņn‡ćsŠŽ_ćZ‡ŃQƒĻL‚Ō^ŽČf†Šg„Ļ_Ļ`‹ĀmyÉjvŌhyÓo~×`qÜnpŲjxŪcxĶW}Ō`pŃ]sŁWvĪRsĖLyČSs¼Hb¹DcĮJdŗ@i±>w°6y·8k²8uŖIr®Am D~”5¬0~²-|­2…±=}°2{Ŗ3~©B~­Hw™@~ŸNy§Mv”P|ŖK{®QxæR¶R…®Ds®?}ø?Į8>=DBW89Q3?H>DO;AHBXV2ba0i\7i_o`:m^5q`2qe;tZEwZD€ZO~dMrrNrnOwtNvpH}kF‡nG“iE’f>™dDe=˜i?™sE—r@˜kI«u=¬v@ØwG©v?¹kF·l?¹lC¼kG¹rEŗlOµzR¾~Jæ|JƂQ³‚K¦‚;®‹<Ŗ†6؅7Ÿ†7’†>ŽŽ4”‹4‡E“‚J˜L›ŽN”–Pœ¢KžŸV„™L°PŗU³—M±ŸF³¤D¹šD¹ Mæ”G»¤KĘÆDĮ±LĮµQ“­Kø®P¼­JĀ²T»§Lµ°L¼Ø]ĀÆY¹°c¾©d³°Y±³U°±W¶­U¬²W£²L©®R§ÆO¬¶X¬¬L§²P¬®K“»P¶ŗI²ŖF©¬QÆ«O³§N¹¤SĄ®UĄ²Y¼­Wʶ]æ²eĄ²`ŗ°SĆŗSÅ·Z·±R±®Q°“O­©M²­Z¹°^®¬[°N›¾K“¾I“ĮPžŹX˜ČR–ĶS”ĆU—¼X–ĀY‘ÅVœĘR“ĀV“Ą]šæV™¹U‘¾a–·^™¶\—Ā]•Ąb¢ĘgšÉf—½XžŹ` Č\„ĆZ¤Ź]§Ļ[„ąi¢Ö`œÖc”ąm‘ąf™ą`™Ö[”ŲM’ÕOŽĖX–Čc‹Ēg†Ķi†ĆmˆŹaÉa{ŠkƒŃg}ÜfuŪhvÜauągŲ]vÖ^tŠXiŹOlÉRf½PqĄJd¼Of²Cj©Bj±EnøAs¼=tĄ?w“9w§@q¤@§F{¦<„²B°8wØ4zŖ6w£@r­Dx£Iy”CzœBxšKj˜Mm¢Lx¬O}¹SwĄNz¼L‚¹SyŗJ€µNy·@sµMq­Nq¬QpøHnµBy°Mn©Io§Gm°I_²W]²YY­^^®c]²g[«b^£^[®^W«\f²cd¬Z+47(%<**9,.7.(8#7;)28+)749>C<FC>6P=HKI;TL6KQ?MW=CM;KO8_W1XL7lT=j\?iQ>jO6rJ6mD;eB?rN7eQ9q[=s_Erd=oh-nV<{fycI€\Fxf>zgE{lFudGjE{iCƒiI‡qHŒr<u;ŸnH”sCžuC˜rH–rH›kJ£~>®m6ŸmB„b7ølH½o>¶jMĀtB½qI¾tE“xK¹vSµ‚N©ŒN¤ŽG©‚D­{8¦€CŽC‘8‘–1‹8ŸI›…@”ŠU›‘Q£œQ©•U— \Ø£]§œL§™S­œU¼•K¼›E±„Nø›R“£L²¤N¹”NɧE»«BæµO¶²Dæ£M®«Y“¤N² ^ø `¾°U¹®]Ƶa¶¤\ƲT»§T©“R£“\­¹]¬±Q®®_ƽ[¬Į[­ĄI®»JŗæY·ŗX¼µT³«W²ŗL­µK“°Wµ¶Qø®Q¾³Sæ³W½½[½¬fĆ®Vµ½`““Sµ®Xŗ±W«“]µ¼T„»R³°Xƶb¬°X£ĄG”³TŗL“ÅV•ĖK˜Ę[›ÉS‘ÉV£¾[žĀ^—ĒSž¼c‘Č_ĮXµX˜¾]“±c”¾Z¢Ī_›Ęm˜Ėd¢¾iœĒbžŅfŸČU„Ģ_ ĢU Üc§į`¦×j¤įcœŁ^—Żc˜ŻXŒÕM˜ÕZŲWŽÕ[ÓYÓ]{ŅeŠg‹Ļ_Īr~ÓpuÉfpŠczŁj€Ł\tŅTŅ^qŻ\sÖXeŌWuĖSl¾Ls¹Op¾Ad¶5p³;g¦Au¹9s“@€·Bx³<|³>}©>©4†«6}“>§3v®,z0vŖ=r¶@r­@wÆAr£Hu™Fp EoØDsøLvøX¶Rq¶Rr“KvøP|ŗBs¾Gr¶Br³Mh¾DbøGu¹QlÆHi¬Em„Ob²KaØa^ØSY“XUØ\ZµhT°cV”aeŖ]VŖfaÆak”T%/7,9)'2$&<(-3('0(28.-05/??-A@'AO13G6?H?@M69E98D:4SBkcEzhDza6~b)sU-{ZAvfCv\AƒX?~WA^G„kI}hB†j9…h?†o5„x<xG“oK“qB›mB£v;™nB„vI¤w>ŸoB¢c8³[<“`F¬pD“tJ°lNŗkJ¶n@Æ{@²yC²|V©…V£ŒK±†D­x@°ˆ@¢‹?”‘C•<˜‰F ‡DŸ@ L§ˆP¦’Q¦•N  Z„œ^©”Y„¢U®œN¶˜X½™V·ŸN³›R»„Hŗ¦JĄ¦DĄŖN¹µR¼°DæžO³›Q¬ž\°Ŗ\µ¤Q¹¢V¾„bøÆ_¾«V²„X®­Pµ¬Vµµ\£»T­ŗ`¶³\¹ĮR­ÅT°»T®¼Q®¹S±¶W¼±_ŗ²X¶¶X“·X¶µY¼¼N··O¹ŗW³»`·ŗ\½Æ`»²f±¬f³°^³ø[ø±b¹½[³¹YŖ°T¤·R¦³Sر[¬“W„øO»M”·J•µSŸ¾O–æW˜Äa“ĮUŸĒWšĒS˜½\’¾b—Éb”Ą^•æ[¼h™¶h”ÅaŸĖiŸĆ_—¾cšĪa—Ši ÉY”ÓYŖÓ[ØĶ[ŖćeŖēb­ÜW¤Ü]”Ś_ŸÖj—ĢU‹ŠO†ÖVßNƒąRƒ×\yÓezŹh~Õe„Šm|Īq~ČmqĪnoĶjsĒZyŅ[x×WsÖPqŌVhÖKjĻUnČRx¹Cu¹Dl¾Fs¹8w²„¬B‡ø8}³/vÆ5u¦/…Ÿ/…¢4±<19K08G?=C8=M>8G??FC4XL=JR4N]6FX1SKaEzfE~kGŠl?ŒjC‹tCŽF‰hB‘pO›cJkP‘`NžhH¦t;«jB§fD›k9¬iDØdH­iL£hJ®xA±vE²uK”yEÆxIØNŸE£‘FƊI„€I¤}F§ƒ>™™KŽ•KžI؉D”‡G„ƒM„†FƔTؗQ¢–Z¦œXŖž]¹„L·œG³•Oŗ”Z±šK¹¤R½¤JĮ„NĞT·«O“ÆP¹§VæP®’LƙU³P³¤U“¦W¹”O«®T¶§U²¢Y·„T³Ŗb„±Rž³P³³Y®°R¼ĀY²æV¶¾ZµøUŗ°`«¹cƹ`±°]±¬V¼¶[øĄ^“Ć`ÆÅT»Ā\»ĘQ·ĒR¹Å\Ą·cµŗf“¹e±±eø®i­ŗ^°øR³²W®»UŖ·[Ÿ¬W±R”±M¢½RŽŗJž“Užæ^œ¾Q–¹SČ\–ĀM¢ĢQ¢ĄWĪ^ŸĪ\œĪb Å] ¼hŖµlžČpØĢ^¤Źl–¾j¢Ēh”ÓaŖŻ_ŸÖ^«Ļi­Ļa£ć\Øāl§Ž\£ē\„Ód§ŠmœŅ\†ÕN‡×J‰ŚU|ÓX„ŲX€Öa†ČgĒ]†Ķe|Å_†ĘkqĖbeÓggÉfzÓWwÉQsÜVmĶHeŁDeŠPeĘLq½Nq·JpĀ?k¶:w«;zŖ=u£7x“Cz«Ko„@}”B}®6‰©/ˆ·6|¬:„©2{Ø0…œ+Š©3z¦B{¬FuŖAo¦@|¤Fx­Ho¤Ez¶Er“Su¾V{øUv¶Ul»Yq¶OgµJnÅRpæKb¾TeŹKbøU`øI`øHe·N`«WW·UZ°Zd¾]W°aYµadøWVŖ_`ŖafŸha c^£a+,(%(,/'150*/21+*/,45)5:)::.::6>F/6C<6H:6P@;HD9FB4RI6TEØi9”e?œkC„cF”jF¢jB±yA±y<«x? wE£…M¤ˆG«†B§ŒM­‹N§~I¦P ‹F£ŽB—–Iœ–N¦ŠBŸH§ˆB«O¶‰T»N³VæšQŗŸY“©V²¤QŖØU±Q«”R³¢O¹¤Tæ˜SĀœS»”O¼žN¶§V³›W¹™LøœJ¾›R¾¢\°¬X³²]„ŖS§£U­ a“¤`¬¬a®­XصN„øU«¼T±¹X¾Ē_µĖZ¼Ą_¶²g«°_­“W©ŖYŖ¶\“µU¹¾]²Ćb±¾[±Į[¹ÉS“ĘX»½døÄa°Ėa·Āj¼¾dø­`¶Ŗ]¬µ\³®XŖ²[£¹_›³R›¼VŗT¶W“æXœ²Y¶_„¶\¤¶T›ĘUœĖRžÉP£Č_ ĻX¤ĒZĖ^Ļc§ÄgŖÅj©Įj¬Źd«ÅcšÉi„ÕgŖŲd­ŚkØÖc«×g¤ąo°ān«įg¬įf£äZąd£Ō_ äVŒāZ€ä\‚ÜNŠŽZŲU‚×\ŹW{ĘVvĒb|Ģc}Äc|ĢdjĶcnÄYlĆ`wŹOqŃOmÕEoĖJrÅMkĒFfŗBh¾DpĀ4mø4tø>z©7|„<°@u«:t¦E~©A†­5ˆ²8ˆø3‰Æ.ƒ«+‹Æ2£3y5Ø@°8t®9z°6oØBjµNk°Mm·Mt¼RzĒTxĄ^xĮ]pĄ^dæRd½OmÄLrĒTuÅRmĘOjøPaøO[¹Q^±M]øWh°Yl»__»[cæ_^“Zb·YW¶bZ®gW§]X©RR§W()((+50+31444*,-.(,3+)?/.>)1D24D47;.+E@+@@:BH*I>:PB8EU,IT2NL+P\€XE‡eF‹mE|s=ŠqAyCˆkF†v;ˆmMeN„aI‘aX‹`F—mC^IØa8”k9›p<h>¢cG§kCqG¬p<³wC±v>¤†;°‡;²‚?©ŒC°„I­L ƒQ¤O˜ŠP‘‰B’’P•ŽH§‘Vž‚C©ƒ?ŖŽQ±•Wµ”S“O¾“U±]¶¤Zø™P²—Xµ’X¹–^Ŗ¢Tµ˜X¶’S¼•UƙPŗŸL¬—V¶ O®¢N¶¤LĄžTÆ®Y¬¦^³”]©šV؝X¬„b«­WÆ©Q£µQŖ³GØĆV¬ÄO¬ĄYĀĘaøĮdĀ»V¹µY©ŖT±±X®®eƹUŖ¶V­ČUøĆXŖĖVµĒ^øĒQ·Ć\½ĢXĮÅc«»j©øn¦æh¬¶iÆ»^ ¹U¦¬X£ĄU¦øTžøZ˜³V—®SŸøY˜½W“°b“]™¼W™ĒT¤ĆRĖZ¤ĖY™Óf£ŃeŖŹj£Ē`šÓk”Ģn³Ės±ĖbÆÄf„¾` ĪuŸŹf¬Ųf¤Ķa¢Żf®Ö`¢ÖdØŁ^¶ęg­×WšēT•ŲO”Ļ_ßY…äQƒÖYƒąN„ßV…ÓN‚ŌR„ČWŌ_€Ča‚Ī_yĖi{Ģ^uŹZjĮbrŗarĖOlæFlŹDnÅKlÄ?p¾Eg¹Kkµ“=yŖJ}«4„²:€¬-¼8Œµ*~§&} ,†©<‡„?†­7u­Bo¤=v„Am±DnµSr»Wv“XtµOhĆ^xĆir¾fmĒTmæ\qĪSjĪNgĖMdĻVaÄXXĄKT½VcĮLU³TbøZf¬Qb¶V_µ`W½\S°Y]ŗXX°ZW©bS±`R§WKŸS.";24(8-'-.5-71%30*4.&A0#>'/=13?,&C0+<8/:=3;?*@=6?I9LP/HQ.F[2QZ0Jb/J\4IN8XQ+YW&JQ*[[%`[0dR/`T2ZK7cN/iV1xU*sV%sZ+vR,~O#W1€^:ƒc8‚cB„iF‹^C‰kF‚kE‚pN‚iM‡gFŽb<•_?hE†]Mˆ`O‘^IŽmJ‘c?že:—c6—m;œkD©gF±rB©l?Æv4©t:®z7«„5©}:®€9“}:Ø~@¬†D¤‹MœŽL›I’C”“K“˜K ŒX­ŠM،C±•@­‘H¹‰AµI“‰T·’X¾˜XøŸL®•^±_°£V°Ø]Æ©]ƙT²“WĜQ¼–J³•N¹žT²œM³ØH±¦Rµ©P¶¬Z¹ŖN°šS«„W­ØcŖ¬R²©P©¶M£½N«¶M«»Y²Å\¾ĄU¼æU¹¹Z«¹U®°LƱT·¼_­Ą^¬ÄP¦Ī\¬ÉX®ŹY“ĢYøŅS“ŠSæŠQ¹Ä]Ŗ¶V§²`Ŗ¹a”¼g²Z”«^Ø®Z¬¼T¢³T–¬Y’­Y‘ŖaŒ¬a—½`œ°V–°W‘æM“ĒRžĆUœĶb¤Ņ^šĪa­Ķn±ÓiØŠs¢ĢmÆĢkÆĪoÆČf¤»`ŸĄg Åp ĆnžÉ\¢ŠgØÕb¤Éb¬Ė]ŖŚ\²ß]”ŲVœŲS˜×M”ĢS‡ŌO‰×S€×H‡äM×T{ŚI{ŪFŅNyĖ\ÕYyŹX~Š]pÕVpĻ`mĒXsĀ`xĒYm¾KnÅDmÅMr·Pr·Bhŗ@l°=sŗ=zµ6xæ6¹4wø4~§5t²>{¼B±<ƒ¬2‚²3Ą7~µ;‚­.£/zØ8Ÿ/…¦7‚§;vŖAwÆGq®En²Pt¶Vm­Yh“[fŗfjĄbm¼YmĀVoĀToĶafĖ`lÄTgŹY`ĖWb½XR½Z]Å\[¼Vb»SY¶PP³TR“U\³aU®^PØ]X³TQ²RH¶`MŖXL¦_4(0!2= )3(&/'9/01 ?%(C5.831@;/44#72AC$EDDJ/>D09O*IJ6CL.FL,BX+BT3@\;NV1WQ3TW.HS-RQ&[WaY'dS*jV&kS+hU'z\*tW-}c"|b~P!…]2…W1~_5`9~Y<ˆf>…nK~oA‡nC‡hB~a@Œ^A~`CŽfGŠ_Q†\QnJ“iC–n@ k5žr9žm; jE©tE©l? f<£t=°w3Æx:­Š=²{?Ø9Ø:„†;”ƒJ˜—M”ˆH‰@œ•K‘’X–“U Y I£‡U؉Qµ‘D­ˆIø‹S½‹T«“T·”O¾žWµ”VŗŠf·—d²Ŗb·¤T¹™^Ä `ř]·šV»™W®”Oø“W·›Y°¢c“œ\²¢_ا]«”c«ØW°Ŗ_„ [««^Ŗ¹P„ŗT“²[ø²P·Ć_¼ŗNĀĮRĄµY·æOø¾H¾¾Z°ŗ\¹æ_³æPÆĮa®Ģ\®Ć_ÆÄR®ĖR¬×T®ÄT«ĖXØĄY™ø]¤“e›ŗj”·`£µi¦æe¦µYšø\ §]œ“TŒ±dŸŗeŸ²c˜°V›·`—·^—¹N¤Ė\§Ée£Ėa§Ō^¦Ųc·ŁjØÉb¤Ėn®ŠmÆÉu¬ÄcŖ³k¦½b”»d¢Ćm§Ńa Ź[§Ņ[”ĪX°×YµŁ_¤ŁT¢ŪW™Ō\ŸĶR‰Ļ`…ąY’ÕQ‡ŲMÜR}āW„Ü[}āJ„ŽRƒŲT„ŁXwŁ`ŅUpÖWuŲTtĖN{ĀO~»Vt»HoĒGwĖLvÄ@q³Di·;pø8jŗ4tÆ<€±7u“@†“=w“8€µ2ĮCƒ³:ˆ·:}Ą7}æ4‚æ1€²6}ø-y±2ƒ°<|¢9„„:~¶I²EpŗAo“Js¼\m¹Pu“VrĆ]sĆatĢ`rĒ[sĒYnŅbbŃi`Ģ\[Ļ\WĖe\ĀVL¾^OĆOZ¾\LæYT¹NU¹UL·T\µ^U§^N¹RR¬LTÆRNæZQ®[QŖ\;%)<,5 %7<$8?.!<-&E;A9(C@8>9B#=A5@>C)E?)AI+IW2BU7=V=CJ3FK0GT0L^)J`/La&H`%NUUQWV_VjK nLpYjV%qS y_%~V){]"t`-yU9†S9†Z<`;‚]C‰iGŠnB‡qCƒlAˆhB^@‡`F~jFjA‹eK‹gFŠeK–]E—b9žiF¢rFžz;”s@£tB£mA«z4Øx8§v8¦…3Ŗ‰@©€@¬ˆ@©…B£“9œ–@™ŠH’ŽHš‘T—Yž•\¤šT„“PƌUø‹Sø‹N¼ŠO¶ŒN¹QƒUƍ`³‹Z¶†e½`µ–`ŗša¾–fĒ™aȝiĄ£c¶„a·žZ¾•SĄ˜[ŗ™eÆ¢d°™k­šb°–d­žd“Ÿc«ØZ©Ø_Ø«[®­M§øO¬Æ[øµX¹¾OŗĄSøŗT·ĮPµ¹S¾½N³ÅQøæ_ÆĮZ±Å^«Ńd®Ķ`¶Ē_øÉ\±ĻP°ŃP®ŹL§ĖS§ÉXšĒY›¼Z™·[žÄešĄe–¼ZŸ·[•²X˜­U›Æb˜¬]¤ŗ] ø_—²`–·\ŸøbœŗXœ¼d¢Ķa„ŠhŖĶg©Źf¬ĪfØÉd§Ęc¬Ém£ĒkœĀuž¹qŸÄg¤æi›ÉkŸŠcØĻg§ĶYŖŲS¬ŅN£ĶM¦ĖU£ĀaŸČ[Õ_‹Ł\’ŪYŠąZŽŻT‡ŲSŽå`‹ā[…Ü\}ÜWząU{ßV€ŅW{ĻW€ŌWuŠN}ŹU|ĄMzæNz¼AŗJsĒGqÄBwµÆJ{±E{»E€½K{ŗOuŗWoĮXr¶RlĆTkĒ^sĻdoÓjmŃghĢf`Ņf\Ńg_Ę^RÅaSÉ\TĄRP»WH¶SE°RE»SMĮSUŗU\°SX°UZ°[K²UG¼NQ¼VW¶ZRµ`5 $9'=2:%0: !/,12.A)465'2;15&CB'4F;AH@%ID.JP%BE/AV19O@>Z;BQ8JN.FK)AV2D[+N]6A`.GZ.MJbZiW+kV*qN#iY'de%g_%vf+nU(rd0uY+y`1~ZEˆ\D~YA„g?‹^:~aE|f@†iL}mI^<~fF€aAŒ[KŒgKŒ`?•dJŠf<˜_>“jIŸpDŸk? l>§l<¦€D£|6®q? w3Ŗ{?¤{G²„E²|I”zPšŽH‰H–N›Tš™P¢e„‘\”YžŒY²‘O³“Z¹V¶‡MµJĄ”FøM»’]²–b¾‘Y¹”^°™f³•fŗœ_ŗcĀ¤aĚ^Į›i² dø¢]¶“_¶ŸQ· S±¢b°™`Ɲ_²Ød§®W¦¢a ®]§ŖS©“[ ·[øĮN°°VøĀS¶Į`ŗ½QĄ“XĮĄN¶¶O³¶YµøSÆČYŖĻV°ĖWŗĖk³ĻY¬ŃX³ĪW¤ĢQ¬ÓGœĀK”Ć\žĄZ–µc˜¼Z‘³b—Ć]ŸÅW˜Į^™ŗ]Ÿ»L“§Xš±R˜øX–²^˜¼\Ž³]‘µa‘“a—½`Ģk›Ę\«ĄY”Čk§Ēi”Ė`±æd¦ĒjØŗmŸ¾f©¾m¤ŗk¢Åf§øZ©¼`„¾T§æVØĮYØĢP§ĮR¦ÄS›Ķ\šÉZžÖT‘×U’ÕTŁU…ŪZ’ĶYÖYŠēNƒÖ\ƒÕZ|ÕXvÜ[t×MĶ^~ĶN~ČLzĮMv½PpŗOxĀG{ĀLpĆ@p½E{¹@vŖ3uŖBf¹Gj»Jo±=†¹F‚¹;†“7Œµ2ŒĄ:æ5~Į8„“3wĮ7².¹.v³2‡²J†“L³MzØJ€©?x­Fz²P…“Z{ŗP}¼Xu“OhŗYj»lb»aeŹkfĶgsŅ[iĶ_`ŅkSĀjWĢcMø`Q¹RF½]N²]O±`HøbXŗ`Uµ]_³SY°PQ©TM©KR²ZE¶aV®cN°_;'2<"*135%1|hEwjK}i@ˆ`?‡]>‘_?ZE”]<™b>’n@ŽmLšrA”t?«jE„pA§z@¤;”{<¤{Cšƒ8>­G°yMÆtR£|O¤„KˆQ™ŒP”–U›‘W “b§‰ež_†\«‹X²“O­R¾‘SĮ‹DŗŠMøšOĮ™\¹‘a³•[“”c¼œg²–\µ—X½ž`¹¦e»žd·’j¼—b“—`¼šWæ˜N±—Mø–S¶ `©œU¦¤X¤ ^„¬eŸ·Y£µX®¼_عX®¶aµ¼\ææ_øĮaµ¼W»²[¹²^²½W«¹S„¼UŖČ`“Ē[³Ėa“Éf±Š[±ČN«ĻK¤ÅI”ÄO˜ŹMšĄQ”½Z˜³`’¶a–Įd‘ĄY–»U”¾Y•½VŸøT“³TŽ©O©W‹øR’¹P‘¬W—“W—³cŗp˜Äk¢æ^Ŗŗ[­Ē\¢ĪdŖĀ\«ŗbعfØ·m¬Įt©ĆpŖŗd®Į]Ŗ¶\¤³\Æ“OŖøR£½Už¼M§¼O¢ÅP›ŹK£ŃNšČTŒĻV„ŚX…ŚUˆŃKŒŃO„ŪV~ŚQ‚ĻK…ĶK†×UvĻNÉX{Ņ[vĮ\{ĄQuÅHs¼IlæNoĢBlĘLrĄGs²8}°7x®4r«?zØ9s±Du¬=ƒ¬@‡Æ@…¾@¾Dˆ·6xĄ1uĮt¹9t½.{»4€±;†ÆHˆ·N†¶U²P„¤I‹¦TŖT…µY{²Uv¶Q{°Xw¹ec¶hd²ijŗmp»]mŹ]\ČbWÅjUĖeNÉaR·bJ¶SBµWE®dL³_LŖ_U¬]b±WY²QY­UN«SR¬MH«UD²_HµYN­V8(/F)12'.:#103-11&229:8?.851'$?-&9B*@9"@="GG4G=?H>+OA-B@'DE9PM4PV/GM.TM3II5NU3IS/PH3RG(_O(fP(qR'eO5hW'uT/ph1jb)pb(kY'ya-{e2yZ@€d;{lE†j:„g8†n=`I‡fHˆu8h<sCŠl=‰lM‡fC†eRŽkNŽo?˜iE’tE•lFšrAj@”nD vF¦sF§<–yF£{K …D­}R®~O¢x[„ƒOž‰Xœ‹W X‘O¤œ`£œY«ŽXŖ–Z°„]§”O­\ƌS±ˆM·…<ƖHĒ—UƗYø–V“ž_±¤b«¤f²žj­„^«”`²˜h±•a± `±˜a°žYµ’M»—I²œI«‘\²”^®ŸW­¢P§Ŗbš§gœ±W¢µY¢ŗ^°»SµĄa·Ąb¼ŗ]±Å]·æh¦Æ[Æ­`«¼d«»`¢ŗSÆæ_³Ćg²ÅeøÉd©Åa³¾N¦æTŖĮG™ĀIš¼PœøN•ÅMŸ¶Zš¾SšĒW˜ĆY™ÅU‘¾`šŗQŽ³R—“KµM‘ÆXŠ¼N¶S¬Nˆ¬P»b¹]•ŗi—Ąa£Ä^žČZ„Ķ^¤Ėa°¼`ØĮe¬ær£¼v«“n«ø`­·f¤±^®¶Y¤¶P¬­P„²MŸ·R ¶O–»HØČOœŌU„ÄOžŌ\ŽĶXŠŁYŪS…ŁY„ŪZŪZŁJ‰ĪCyÄLrŠP‚ĢZsŃ_…É`†ĮOuŹWx½SvÉD}Į:tæGzĆGyø7“7€³:oØAz„Cn²GvØ;°G‚Ŗ=ƒ®Kµ8{¶CxĄ>pĄBpĄ9{ŗ>}¹:t¾9·E¾G¶N“[„±S{„Y~Æ_{±W„¬Zw½QyøV{·Yf±hg³pdÆajŗ_g½\cĆfWĒdY¼_LÉ\VĒ\F¾^GĀVC¼`D­dN±_R”^\¦Zb±P`°X^ø]P§JMÆJU²ZN¬aS±ZS«bB%6>+7@+>:)5..92-+6-,576/103,%77%B5%<< G7'LD,R?7WF.O>,N@0JD(SH)UH.QF2LQ5RG+VM0RN2RM5YJ1\M+dR-jL0kM(hP1kS/sa,nf0t_&|^&s`5x_=ncGlj@xhE…n;ƒf?ƒh@‰l@‚jC„q9g:€k?}mL‰pN‡pHˆbQ†kMŽoQ‘vN™lKšiF jI¢mD¢lH§lDžsJžzN—…F–ƒM„ŠV¢~Y£X™}UŸ„]–„cža§”S¦—Vž P£œW°•P®‹W„“\؍Uø‚Q¶…Q³†S»DʔFōOʐTæœZƟ]¶›hƝp®£gŖŸc§£j¦ i«”f¬`¬šS®œT¼O¶ŠN®N±’V±™Q°—O„„Q©©P ¢]œØ[©°bŖŗb©ø\¬¼V¶½^µ¶c±ŗ]ؾežŗcœ»_Ÿ«bžØ\Ŗ¶YŖ»^ŖÄb¶æW“ČZ¹æS­ĀTÆøJ¦±Pœ«G—µM›¼FĄH™ĆM›ČVœÅPšĄR”¾Uœ¶a›¼Z¹Q‰³T‹¹O‡·T¼Q‰¾RŽ°QŒÆVŗUŠ½b–³lžæm¢Ā`„¾c¦Äa°¾b«Į_žøn”ŗnƼh«­l²¹o³µaµµWƶUƲOŸÆWœ·Y½L–»O™½DČP¦ĒVœÉ_ ÉY˜Ē\‡ŃT‰ŲQ}ŲQˆÖY…ĶW‡ŅI|ĶL{ĒMxÅOrŃV|Ķ^zĮYĆ]tĢ[rĒOxÄM|¾=ŗ9ƒĀ=³:‚±2ƒ«.|Ø;}Ŗ;x²>¶8xÆ=tŖ:€®DuøEz³D¶EvĘ:lĶ;rĘ=xĘ?qÉD€ĮR‚»Q‚¬O„­]y©f{Ø]|±]Ŗa~»X{ŗRy¹Vl¬edµdi±lp¶^n¼_oøaf¼f]æbVøWZ¾PLÄWIÅXMĄYQ²]I­fF­XQ¦Y_­Oa³TW²SV¶SZ¬UN¦TW¦ON£YIŖcH®_585A%2968D52?:26<0=;+A2895+>-8;.(A0)I@.I76R@,R@2R@+TB6ZI)YD#L>1OD&ZK7XV:\X:XW9WR7NUx_C‚gP„mF…b@„eA…gGŠpGs@~w9‚iD{i|¤Dˆ¤8€„@z±>|°L‰»>}ĄJnæF{¼Bn¹HzĆIyĖ={øPŠ¼_©W­_ržU{£Q|by¤W³Yy¼Sk§aiÆZm¢dp©wj²sn±ak¶_g½`_±fT³aYµWG¾LGµULĆXJµ\H³eS¬gL£^b„XXµVVµZ^øXV­VW [O«SH©\L¦TK”W=399/.=0&G9)P>)HB,DB*=67816D9‹dIˆeM‰`T‘fXmY•qU—qW”iZ§iKŖtO”|IŸN †P …T”‚XžT”tU˜tR}XžƒX”€^’c›‘^Ÿ S¬ S°Z®œS­—Wž‘TŸ•S¬‰P«J³˜HŖ”F°—O±“\¾˜Y¬”R« Z؝\®œg§’b®˜Z„ ^§¦Pŗ U»–S°˜P°ŠY±‘b±“]Ŗ˜V¬¤UÆ£S؜`©™f™f¢ j dŸ ^š®c£²_§ÆažØhœ­a˜Ŗd£¬`§®T£±Y§¶\ ¬W¬·X©¹Xžæ^£¼Rœ·Z—±X•·\‘¶O³H›ŖK›¼R–¾Z–¼^—ĒWŒÉS‘¾_œ¼a–Čf˜ĖZ“ČR‘ĒJˆĀL”ČY’¾T“«U©^Ž®a­^™³]ž¶^„²`سeŖĮa£Ēc„ĆmÆÅoØøp­³qسrÆ­h­¬f¶µY³¬T““Q§ØMŖ­T¤­S„¾AœĮFøCžøB”ĀN‘ĄE—ĆI‰ŹEƒŠLyÅYzĘY»M…¾E‡ĄD…ĒLxÉO|ŹP‡Å^‹Ė^æ_…æS‚ŗMzĮG{¾Q~ĀKˆĄI„“:‡§E…©>‡®C{§Cx±F}±HŒŖD‰ ={¢>xŖFƒŖ>‹¶G†²HuÆCw¬@tøG{ÄG}ĀE{¼M„²^“do„ZhžOn Tg£Sk„Zu±Uy¬Xw„[l§Wr¬iv”rk„lg­nh°n[°^V¾fXŗgS»USµQNŗZJ½UU°eO°eX¦cX¦VX©L\¬OS¦U[¬]Q©ZXØUO®ZG“PW§YW¤P780A019@/F=&=K!EE)V11P38G<:NG4JL1P=4TL1WE/ZB8[A2]C3^F4`N8YJ@^S>YV:aS3oR3pWBvV:uG5sFEpPCnV?sXIoYJpP@bU9jd?sdJwdLr`Q‰`Pˆ]W‡bK†nV‡lVyeG{qV|rGw|L…tM{nC~eI€rKŒeQ‘_L™_KžsT“x_šyT–p`šuK›{T§€Pœ…R­€Tž„c¤za§‚e£o_€WŸU”zS˜†T™Y˜Q«—`°[ ™P«R¦˜Q›ŠP ‡W©‡Sµ—M¹”N¼–R»¢I²–Nµ—_¹§Q«`¬”Z¶šf“Ÿc²–Zµ V¬¬K“¢R¶”I©—Y­‘V¶›O±˜S©™S­ _”™f¦’a“”n›e˜—f”˜`”­^™°c”«b§ØfŸØaµb”„c „Rœ­Sض_£µO›©Y¦³PŖÆW„¹T›°P—©Y¦^²[“¬YŽ£N‘§LøTˆ¶[”æY•½\†ĆOŠĆT“ÄV‘ĆgŽĒa’ĶRæW…ČKĀV‹¹Y’°c˜²c‘øVœÆT–®\™µ[ص_ض^œæm¦Äa«Čl§Āi³²k²­qƬc¬«a©¼e»æU±ø]µ¶K«¶T¦¬J²¼C§¹Fž»J”ŗJ˜¶F“æT“ŹIŠ½AĢAƒĀI‚ŹS‚ČOŠĮLŽµC}ŗS~ĒGˆĀDŠĀG…øPŽÄQƒ¼YĄJƒ·D|»JŗE„¹O…«H‚ŖD„“F³:‚°CxÆI}ØKƒµHˆ£HŽŖ>«F…„L«M“¬?„¹9„³Eu»;m²&DI,FG)=F+@N'II,GE3E?/J96U9?T:=H;:H>8R?/QA6SI;SGB\K;XS3_N:o[;m[4iT:gW8qV4o[;jPCtP~³=v±I†®J‡“KŒ²@ˆ„=”;‡§G‚¬@‹­>¬@‚¹:}“=v½?x±A~±Ay©Hs²X{§^x¦fm”cl¤`i«ak£]e¢\p¦]{Øeu”hz«gu£jo”ad¦ef­f\§id«q`“j[øiYŗ`c±[a³a]©`WŖUXŖ_P©^VÆYU¤\SšUS RO§UV°ZW¦[V Q^”JT„R:591B&EE/DD)EI+E="EB%OA4L;6N;+X:1T@FY<7KE0RE3VP]^@cb@pa4vZ;zVo]Ay]Bf\MpU=mOCkVIbTBq]Jk`SqaQtdT}XQ{dTtb]‚me|f_|iV{hVslU{uQ~uPtQ|qU|iL„xQ‡rE”mQ–dL—aYkWŽdxVž€^›…c—zVš{X¦„gž‚b¢‚h¦xc¢nd•ƒZ’…X“}M“ˆT”ŒM˜F£šL©™[¢Œ\™–]ؙO¤”Y«P© U²žP“›_­¢O؜N©–W²šR؜V§™]¶©`±Y§žc«žV±P­©Zŗ¤M«–LƝO»•\²Ÿ`„›YŖ”V¢^šŸ_˜œ_™Ŗ\Œ£n‹¢a‹—eŠœ[™„PžR’–Q–ØRØd’²Rœ²V®W¢¬K”±X„³Y„¢Hœ±GاR„²S‘®P“­LKŸV‘ØP‚„`¶Z…ŗS…²Oˆ¼O€·K‹¼S€ĒQƒæTƒŃ`‰Õ_ŠNÉL€¾Z~µX‰ŗV’½b‘æVĄg–²i¢ŗi “_™ŗf›¾h¦Äq¢¼k›²`œ¼i ¬k¦½_ز`æR”ŗ\„³P­¼R­ŗNƹLŖÆH›µV¤­IŸ¶J–°Gˆ¼U‹ĄE¼F¼MŽÉT”ÉL†ŹUˆÄU„½O‰¼FŽ³K„»C±C‰»R„µZ‰ÆLŠ¾@…ŗO‹±H}“K~¤F‚©L}©>€„Is«Kz«J‚²Qƒ²?}©@ØG†¦E†C…¦K€§B…Æ;‚ÆB{¼D{ŗB€ŗBw“H|°Fp±Tm«Zo°[|©cv¤WqŖXp£dl›esœgyŖez¬fr¦`s°dkÆnp£ii„cXŖmdžkZ©dW±fYæ`[±gb³]a°V^ØUa±aT«XLŸdU”XX„fS£^S™YZ­OOŖUVØN\ W^©WO§`>;,7D*5BAE#>;+@=%KB-FD.OI4MF/IJ0TC>V=:U;5Z<3XN.YQ)NI1LD2XJ2TE1MH/T[)Y]0Xa7\X@meGmg>k_CuT6~[GuZKmZMiXAaMB`Q=ZR=daBg]LkbNieLpdMunZ|iZvkYyjYug`|tdrySpuLplSmnJslGhQ‚vY|vO‡vO”gO‘^]Ž`a”r^ŒzUŽxf–yeœy_“yW‹€\”ˆi˜‘gž‰k”b qX„[“ŠX’ŽRœ„I“‘N›“LœV„•P ŒQŸ’SŖœZ§žQ¬V”Y®šcÆ£]ŖšWŖ¢Q³£Z·–V“›Q²¢Sµ›]Ŗ£cØ¢b²¬]Æ [° V°š^²œ]»”W·Z®—ZŖ—`¦•X„ž[ŸØT™”Zœ­]­cƒ¬h…œ]“¤_—§W’›^–™S™”^’Æ]Œ¤]”Ø\Ÿ«S›°O—«Tž¤S„¬K£„B©D¢ÆF“¢?Š¢H‡Ŗ@¤EŽ¬L‡ÆV~“J~“L‹©HŽ¬T‡­J‰¶MŒ¼TÅR}ŠO…ŃS‹ÅIĀNƒĒ]„»a‹æcŒ¶Zæ[”¼b™ŗm¬°oرf„µg­·t©»v ¹h›®_ŸØb„±g™²X—¹Z•¶S™¹VœÆ]Ÿ¬\ž®N¦³M£µL˜ØSš³R›·K’µJ†­I”¶@•¶B•¼JĄQ—ÅKŒĒQ€ĘSƒ»L€½HŒ³D‰¶K„·N­IŒ®S“¹U•¶E‰­E€«F±K‹°M‹¦IœG„Mu My¬D‚¶J„§C{”;,:DH:"LE"B>0P?.X<3W@BTC4\=>UG/ZT1[P,XS%NV'SM0JH2TW-NQ.Rf6\d5YX?faCj_Ioa7u\=fY@xcKu\?jUAdKBfM;jV25691*‡·=‰­C{”OuœQ}šHt£Hv¦M„ŖFŽ£@’§DŒŖGžG‹¦<ƒ£<†¶:„ŗ<|µ?€ø@}µ>~¾’”; «9˜„:’Ø>ØH…·A‰Æ?«UŽŖS•ÆH‰®R…µHæ?ˆĖC|Ē>~Į=ˆ½P˜ĄT˜»Z’·a‚ĄV‰»c•¾d“Ęi“³r§²m¶d”·q¬Æhž§q§«o³c¢µc’ŗX§]•¦T“„a—“f• `— bŽ§U˜²`Š»P‘®K†»?‹²2†„AŽØ<‰¬G”°JŠ«@ ²E”·EŸ°A–µD«F•«;Ø;Ž£Eœ§=¢¢B« =¢ŖE—¢=„B•“D–¬8‹ÆK…”D|¤Bs¦M†¤>§H‡ŖI’ŖM‹«@Ž­C‘œAž@†¤G‰¹Aƒ¶:„¾8ĀE„Ā7¶Bt²Bn»EløOyŖZu¤\t«Qs„Zz„gq£ns«]n²[tØ\{¢j{¢`{«f~Ŗgo¦qxØcq£kh¦ff±dU§nY«lW°rQØlL„lPf^šaW¢[\“]O”^J^NŸP\X^SXœHa”MaŖUe™QW™WA:;86:?<$A5:6!>H/:Q2;I)A@"O@([=8YHAPR6NO7PO8[O‹³4‰¬7¬:Š¶?’ÆG’Ø9œ§;”«7™­@“¬A—”; Ÿ8¦8˜¢6‘¤4¢Ø9؟9„£:•ž7˜„<’³;Œ®B‘”Gˆ¤Nx«C©@†œE’„;«>ˆ«C…¦H©J‘ØIŒ„B„Ø@‰·J¾D‡ĆAĮ9|¼=t¶=køDnÆMw®Xw§Ul²Zn°Zq²^{£o|¬st«er·`}±_uŖXz­b‚±lØkƒ§bu­it©ca§ee„o[ s^¢rSžqM›iX„cY™[TœcNaU•Y\“VQœVR”QP”UV£[U”OR£H`¦MY›V_ŸY5;.54,:?":8EI$EG.>N1EM%DD&PK*GO;MN>\N:Z[2XU8]T0aX1eK3a\9dR?dV>\b2Wh?]f:ekDgY?pi>naCqg?nj9ugEyiLyiKxdHljFrfO{aTo^VrqTwnStwZyqV~p^za\vj`|tTomWrc`roitp_ycg|fdyglssdtogp|q}ossmy€f‡€uŠrdŽ‚g„€d‹za’Œb€ŒYƒ^„g‰ˆfƒŽ_ƒ€f‘ƒdŽ‰c™‹Y•\ \™—X”V–ŽTœA§~N›„\£“^˜Vœ‘V•™V•aœX ”U§’^„•\°˜U¶•`“›W§žU¢ØY¬¬X¬ŖU²Ø[³©b°“`¢”\œ®`­±a”¤^¦§ZœžU–™Vœ˜fŠ”n•“pˆq—•h”m’jk–“_™–^’¦f“©^¬U‘§WŒ®F‹°M‹§F™¢FŠ„Kˆ©L‰ØG§A¦G;‡”8–©7Ž£=‚µ@‰²9‹ØL‡ÆDŽµL‹“E{µR{µO|ĮD€ĀJ|¾J|³SŗYƒ¶`ˆ®cƒ½UĮgø]œ³o•·j”Įk§ŗn ©h§­l¦”kŖ£c©”[ §d•Ŗa“ W‘”d˜œg›ža™ŸWŒ–Yš©[“°^‰³LˆÆD‘¦=µ;Œ±?§:•°8“©>˜±Gž;“­4žØ8ž¤<—ŸEŸš1™®>¢Ŗ=¦˜6œ8©ž5œœ<›@–­H—®:–Ÿ=—ØO‚ž@„„K…ÆGƒ£P†¤@–¤?‚„Iˆ²I®NŽ¢M°L­E²H|½G€³Cu¹FvµGq²Nh¹Pr«Tm²V}¬\sÆTw­Y‚«dv¬etÆoz©qp«`„®[“hx­h«lÆpy­kw³me d`£ti›p[žp\—zZŸmY£kYŖbO¦l[¢nN–aV¢aU˜bT‘TN£]J„ZI˜IT„Q_£T`«K[¬OW£PG3)94(;9*@B'7H#:C#9@GK)GX&BT1GS6MY8TX4\^1WY,ZR1eU9^J@_TDgV<`XB[Z=X^8^j5gl:f]Ce]Eg^BdbGna;neBniIpjRunL}sDumKupE|gMzoTr_‚sZzi\zl_xpTxybtu`rhZvfYpagqfkkqkpmiore{trr}srxqrtizvmzzq€€uŠ|oˆoˆƒsŒ|i†‹k}Œ\€Œb‹^ˆ’W„‰Z†“ZŠŽZ”•YŒŒQ‹‡P˜“W •N”ŒU«€N¤ƒK›‹R“…Q›‹T—‹ZœˆYžŠ] ’Z›‘Z–[”˜`©›d®b¤c©¤h¬Ÿ_Ŗ \ŸØ]¤ØQ°Ŗ_Æ®[Ƨ_ «\¢§[Ÿ„Sž„_ až—g™œd–›jŠ•kŠ“i‹hŒj‹ˆlŒd”–b¢›b”•`¤—Vœ„Y«X‘ØMŠ§KŽ„F”C–›H—žAŽ¦Gˆ­@…ØDˆE9•¢/•Ÿ3‹£<Œ«>„«8|³?†¹A±Ly·G~ŗM{ÄR~æLw“Ky±V‚ÆW~µ^µ[ƒ±a€®hŽŗeĄoœøjØøj¦·j«¬g„©q«¢nاg¤£i  [›¢Wž˜W›”b a•§eŽž]ˆžbŽ–c‘¤Y• Z–¤H„CŠÆBˆ«@–­A“²9”¬7›±=–¤7¢ 9™£4˜Ÿ9„¤;”=؟2¤Ø8°Ø2«—5£š8žš7›Ø@ ØD§Bš§IŽ”Q”I‹¢D„¬H§I­O…¬N‹©IŒ³@‰­G„³Eƒ¬G~±=„ŖD|Æ>{³By¼Ev¶AwĄFu¹Nv°Wm®PoŖVx¶R…·\‚¹V„°bz©frŖcp­my«m{«d}¦[{Ø_vŖfsŖlm§cjØgd›xn—wk}f’v[”w]‘lW™aRžcX”`YkOŸnO”eU—aU’cV”UKœQM›JS¢O[¦Na§Zb­]^¢T;'&52$J9/D?0;I"HQ DG5RM6KT)RS2RT3VW;XS:\S.\N7RU2RT7VX-dZ7]T5fP7`YAXa:av.bm6b^CnSBmW9m_?lZAna7vuJod?ufG{jKilWstKzr\~iSŠlYyn^uwaƒsZ{uWmm^quhoeeqdTxdiqjuwotniunuxw}rrmr~mzykj{nx{‚rt‰u…„p‚ƒyŽo“|f‚}pvŒ_€Ž\€ƒi„‡e}ƒZ‹i‘‚_Žˆ`š‹]ž]„ƒX”[¤Ž\—M–‹D›‚M™ˆO›€T“YŸ†P”•W“‘[”ˆ]¢‰Q£–Y”—`“£[µ˜`«b¦™^ƙXŖ„]¦WŖœ`°Æ^Ŗ W™Ø]›£dŸQ”¢_œ£j—•b›Œgˆ“cŠgƒ–a‘k”jŠ”\˜lŒa›™g”eš¢g“¢Y“„W…ØR†ŸM¦Q©H£K‹—>¤?ŽžF“©>‹§G…4Œ 6Ž¤@Š¬6„”>…±@²Ju¹B|½Kw¹M…µD“IwµN†±G†®Sy¬VŠ“d€©TŠ²`„·fŽæ^³bŸ“k£ŗm¤¾oš±lœ©f©ŖeŸ¤iØ©j„”bš›S –UŸ›]Ŗ`’„X”S‹œX“œZ‹šR‘œP‹žL‘§>ŠŸIŖFŒ«A•­<‹³9“Ŗ:¦- £2—„;œ6“˜:—¦8œ¢.›¢8”ž4ؗ+«ž,§’:©—@ „O•K››?‘£L§EŖN¦E§J˜›RŸDŽØ?Š¬AŽØG†„=„Ÿ:€¦>€¬>­H€£D©A{®Nx¹Rw»Tt“LsØNu«Rv¹Y{“X€°dƒ“]u«aƒ¤mzµe­`t³dx«Zwdxžbz§hj§oqÆgj”lj mg uhŽuWŠra•cT•d]œ^aŸkZ–t\kK‘cT“bU‘\V•XPœ^X§U_œL[šN^¢XhœSl ZJ/3B)/A**K6)BK2DP-KN-LT9JK1XH/QL8SJ9[D4TF/U>5SG0MP(T\*WO1^N.T\6WY9em6ep2i]?g[<^]7fZ=o`5n_=rj4lo„ D‹”E‰›M‚¢Mw§Pw©R‚µaƒ“^²O~­O‡„VŖcy°j}®d„²b¤_‰§i°lt­av©eq¢bx”azŸku¦nmØptØ`h¤ek ra™kc“md—bV‹dP‹_[‘ccn^l^ŠcT‘^VŸ[X›_P¦_S eY›a`œQYWX\e–Oi˜R?*0=$7K18M60JA/QE6RU;NSA^V2^Z8WQ1JP:ML,WK-PG,^H5\N4\\#ZK&QK%SR*d\>b\:fl.m]:cb5oc9p`;q^>lbCwj;qvAoh?urBysMvu_wp]vkd~cZ„db„cnrklk`{niqhiifcgl[lmdkdhqcvhiqkZvzekolt€po‹dq}nu€|wz|uw„wx…ot{p…†|…‚q|Št~j}r{|oƒl‚wd}ƒgƒaŒ~f›Ž\¤~g§Z”…\ †^•Œ[”ŠG—ŽR•‰?›‘Q¢T•‘P•‘Pœ–X“L•ŽQ •I„‘L¬V“›X¤œT¦˜Y£œ[®V«™S§ØYŖ¤[„ aŸi“Ÿf•—]˜™gŠmŒŽh–‰h‰Œ^‘`Š“g‡ˆb‰‹b•VŽŒj˜‘bœ—j“aŽ”n•‹h•›i£[”ŸOŠ£U‘œGF•¬;™¢I„G¢?€¬I£D‡„Dˆ§J†¦F‚žO{¤K~«Mw­Q}°N‰µ?„¶KŠ­?ÆJ€ŗK‡³R…®Zˆ±c…³P}ÆX­SŒµ[•¼i¹dž¶e£­hš°aœŖnžÆaØiŸ©c˜\—šS¢—OŸ—P™¤T‘—Y”`‹RŽ”V—N˜P‡”=ƒ¦:ƒÆ={«8|¤4Œ¤,ˆ©1˜4’¤7••,¢8•“0™š+“”*šž3 “1§•5Ø -£—:£‹9¤‰>¤–;™•M™•BŒŽN‰™FŽ”>”žJœH† F—A‘ŖG‰ØNˆ£@~šG‚Ø@ˆ N‘œLˆ¦I’™M†«X~Æb|®b}¶\‚“^ØXy«^ˆ²^„ht²b­f‚Ŗg±d‚§o} utœpx„n~ mo¬mo§ek®cj¬je£_m¤_jŸmfŠkW—_Y…d`b`l[•jb‡haŽcQ”k[›k[˜bTœbd˜Zfš]d›T^]k˜\c˜JkŽN90gc7nc:heBhe”7‹Œ,‹•)‹˜+š. ‹)—•0Ÿ“4„ž5¬’4ؕ3”Š0 >ˆ=IŽ‘F‹B––@–™Bˆ¤=‡¢DŠœKžK“O„•G‹’NƒžH‰”JØK“¦N’ [‰Ŗ\ƒ¬f…Øg†¬`~¦i„£i~¤f…Ŗg®fzŖb…³j±h€¶kw©o{uv›pz›szŸx{tp«lh£dm¢cežf][^›]`Žca–cZŽk_‘fg‡fa„leŒnc‰oT‹q\ˆkV’hcˆbg‹]c–am—Xu”NmKdSjOH68=49;?;>G7KBBU?DSTEaTBN]DVR+JQ*UH!VS.RQ"SP.VN1PR VZ&Y[1WN)`W:_[9`e>k\*_i=n`7le9cnCpmAuk“CƒKŠ—E”—C˜D€Ÿ<Œ¢H‰˜R‰›Q•›\šYkŽ”m‹ j§a~œn}”d…£b‚Øl{„kƒ¦g{°s~³b}Æls«o~šlq˜hw¢lr¢ju _j”ie™[mœ__œ]^›aX]Zˆ``‘icdd‰^df\‡nY•pQŠsZi\‰\Z˜an™cl›^f›\p•[q‹XjSbQD44?<7<:2GI5OA3TD@]M?XRKRRCKW2QX(US)^V.YX&O\MV#MX)\a$S\/RX.__2[b:ja7gc/bb5i^5hlCchBf`Ey`Gxc@sa>mKhFy`H}_X€_S‡_Sd]ˆ]aiiuhm{ccy]\w]RnbYqV_gU\j``w^_lXgmZryelvhp‚fk‹sp~iu}otƒ~qy}}‡|uxzŒww‡~to€n}mjzkiˆrfˆuo}d‰u^‘„U–„Z“{e˜}a›}[˜†K™ŠW ˜U”•H›ˆJ ”Qž™RŸN L–•E—”A§Ÿ@„–D¤–<šEÆ„CƦJ®§U¬¦P¤ŖO  Vœ˜ež”hš¤^¢šbš™g—–h“…j‚o}s‘ˆh“Œ[ƒ†^€„i‡Žg}mŽgˆbŒ‰]Œˆf–b“ŽZ‡Œbƒd˜`›Q¤KœNš£P§C§Cˆ¦>Š”;‹§G€«K}§Hx¦Ut£Lw¤Pr¬S|„]¬Zƒ”Y‰©WÆTyµI}³C‡§I‚¦[z£b€­_†®VŠŖU¢P’£Tˆœ^‰¢]–iœ¤gž§iœ¤[š_–›`—”Y¤žZ¢T”™[–š`‡”Z‚¦[~šW~œT‹¢O’£O“ŖG•¤E«M‘¬<­<{¤:}Ø<ƒœ9†’8~“@†6}’3„ˆ!”‡+›Š*˜Ž%”š%˜š1 ›3§,«2Ŗ9™”?–ŽB‘‹>’”5š9”•8•?‹A†˜A“EˆŽTS’ŽA…ŽF€‘@‚Q’–[Œ^ˆ™c XŠŸ^©cˆ¢lŸq‡šeƒšd†„l‹®pŠŖo‚¢jƒ¤m€¬kz°b}¤`x›bpœ[t«\y”fz _o›[g’^r–dm”bj™``ŽaeŠaeƒhX‹[Zƒ_Z‹hc`g‹e^’ne_g^c–Ueš\^•[hœNk•Od–]a—Wi†\>1FG;BFA>EBDRQFNGJ^NA\YCPLCHK3K]4SU5X](RW&M[ RT/[U4`c,P^6Te2X]8]cFan@ja:dd6q_=f]=mZCf\Fx^BoiA]@„fF‹gI[SŠYTŽWU‰Za„da‡]i†imr]mt_dq`[kZVhXcsYZkYWjOckYgzZnsTu}ahyhv‹uu‘wg~wh‚q‡x{Žq’x|‹†sŠ||†‰p‰ƒwr}prwnjƒys{mzdqb‡^ŽYŒ„_Š…]›‰VŸ‰S–‡N—›O„‹IŸ’Q£™W¦ŸQ¤V¤A”Gœ—C–“F„G˜–D —O”¦M§£Qµ§F²¤W¢œM”¢U¤›X¦Økž™l£¤hžœoŒa—ˆo›‚p—‰dŠnŠ‡i…l‡Œc„†iŒˆ]‚Œb‰ˆd‰f…Žawaˆe†a„Z ^Š¤RŠ¦QŒØJš˜R—«OŽ¦A“­<§9¦B¦D}¤Q|³]x°Qw JzžW~­\ƒ§Y}›Uy§\}¹O‚ŖTv°J„­R€ÆU|¤UŒ“ZŽ¬V§Y£[†¤V‹˜\“¤V”¤b”£f‘—c”’Yœ–h˜e ’jšœiŸ[œ›_‘ŖSžX¦]š[…ØMŽL†²O…“L‘²B©>†„G†ŖA‡¬=ˆ¤F–2„–+Ž9(€•$ˆ'…* ’!›*›š$˜œ'›'¤š6©‘0ؔ3¤<•‰7ŸŽ>•ˆD™“@•ŒC›?‹ŠO‚‘O‰—JŽ‹K‹“G‹Nˆ—D‡”A’•K™]ƒWŠ›k’dƒ¢h’’g‹—qŽ™r‡–q…Ÿh‹žrƒ¢p† l§w…©j}„nv­fu”hz«Y£Y|°b}ž]}£byŸTq•Yl”^l–brŠ\dfZŒcb„mj€\jƒh^Ž[iŒf`‰bdn`˜_j–\b“ac”_b“SgšWpœMdšae›QjVM9?K:HM:IHJAGRMSOMNWDYUKPRCPPBSU@KZ=Le1Ub,M]1M[,P^6Xd:Zabg‰“+‚š0Šš+„.(‰0¢Ž(¢*„˜+¢›&Ŗ+؉%¦“+ —/Ÿ‹8™’<Ÿ‡2ž‰6”HŠQM‹‹K‰“V”‘MŽ‹O–“E‘•I–œM•C‹O‰X‘Yˆ’cˆŒ_Š•eˆ™n“n•y‰w‹‰y…”yˆœu‡ w‚§k}„nq«er„bp©Y{«`y«ey§av¤ewœ]p“bt™Xt‘OvVm˜_a]_ˆh_ŒafŽZi…ac‚kegk–iq‘\i•]m˜cp‘Wg‘Zo’^s”Qr’QfœTmMl’W9>B=CJKYc6Yf0Y]7]gB^bGZd:a]9k_:j_:q]2y]>ri0€fC…gD€gF‡dGŠiJ’_[‰\NŽ\`Œd^yaezkZ{Zc{aXhZhxa`nXXhOSsTVoO]uSep]hrihu]l„qi}mn‹{jŒ{i‚}iyƒnw‚vozx‚sz‰t†xƒ}v|y}~€mt~zˆ‚k‚rŠql‚zZŠ€Uˆ`Š†Y”SŒM›ŽX šHž”GœŽL”“O›™S˜”X„—J„šNŸ’MœžR”—M—•T•V®›U°œO®”J°ŸY±”K­ŽV®•TØ£Z„›h© d›•b”e”j›…b~d‹c„]œŒk›€`•€k•„^W~’a€ˆds‡dvŽb~gy“p `‹P„™MŽ—M†œE—¢BŠ­P…°S…®E†£J~­G|ÆLp£I¦Sy„X}©W}¦_rž\w¦Vƒ°[x¦TlŗPy§Zx«L‚¢Lz®JxµR‡®Z°]‹±[y«[}©[…£V X…›X—˜Q—œW˜œ\š“c˜–jš›c•e U—¢RŸ[Ž¤N„Ø\~£U‰®]‚¦IŖU„ÆG†²BŒ¦A‡Ø=ƒŖHŒ :‹9—2Œ–)Œ—.…Š(—”+š”2š*•‡/£•*±“-­•&¤”&«•3©“$Ŗ‡7¤”4 1¢Ž0‹A‘ŽK‹‹GQˆ†XŒŠR†•K€‹@ˆE”G™B‘ƒI‹†SŽŽT\‹–cmˆ’kŒ‡gŽ’kˆm‡‰p…‹n|Žr€Ÿq¦mˆ˜mv„x}™slŸew c|®jx fz£pz˜jUw”Tx”Qs™Vw‘`v‹baŒQ]†T]Œ]Yƒ_[ƒia^cŽihŒalff‰Ymš[l–`l“Yn‹awŒMt“Qg—Ud“agV@=T;AK=CF;?K;LCKPFUPD`RDTWCXUA[]CTZ;OT6IX?HZ0JM.NO-T_1XY5`Y/\Z=c`Gb^BZg=aoGogHsj>q`;€`8b‰›B†•?““3’›+‰7ŽŠ4’0ž‰*”5˜„8Ÿ‰*®Œ*”Ž0žŒ.Ŗ‚2Ŗƒ%«Œ$¦‹41™‹9•C’Hƒ‡L‡†V“…Y’‹J“‰=ƒA’†B‰R•~J‘K“{H”†I‰ŽP‰a‡†mŠŒhŒnŒvƒ”v‚kz†s€†m‰Šs‚žq§z~žyz™qs˜s{”tt¦mwŸo‚£m‚—f‡–\~™_r’Rt‹WxŽbr‹]i“QiŽP\V\„U[„eZyce|[i…_ab`bnŠbj[d‹_k“\n’Xn‡Wp‡dgˆ`gˆf5@K>GR=FS9HO>LCCLJVOEYG@RZ=MW=NOAPXAMNA=Z9HS6AJ:AQ4V]+[S0U\9`bGI5IO;[S:\N@bZLb\NbVLhQSv]Py^TvbKtbNycS{XY‰^PŒ[G…fH…rG„oIŠtDˆkJ€sN{oYtb_}bhvgm{Zc{a^}WizZeyi^na`sfhpltxsqsty}€v€wpy{xzxzl€{gzr{xvu{n~kxh~‡k‹Žn‡Œw|Žsˆo‡ˆnŒp…upƒhq{e€„`‡wc‡y]ŽV‡†^T“MŠˆP‘‹OŒ†QŠ‘b‰•ZŽV˜—X™_“™^§•P§™R¬’M¬–EŖˆJ„’L¬“W¦•X›˜b“f˜™`›“ci—“h˜še–•Y–“\’…Qž…V˜†bŸ‰h˜’k““l†f‚‹oˆh††fˆf‡„\}“\”^}•^|–`yPx’Nq•Mx”\€ŖWƒŖV¦Z†Ø]~ÆSx§Q‚¤V~›YWvž[z¦Ut§S}«Uv³[i²\mØ[q„Ws©[n®Wh²SfŗYi±Qh„_h©\k­atÆ[€«Vz„axØažS†›R‚PŒ˜S„•a–T‰™T…”LŽ«NŒ­TŖK•®H‰¤O‰ Ox©Vs­Tt­Qm¹Ju¶<‚ø9…­4†Æ1£/›/””8‰?—ƒ<™1™ƒ2šŽ/œŒ9£’9¦‹7Ŗ…7Ø{(¦{ yž‡&¢‰1ž„3—‡>™@Œ†O˜‰M’O–MŒ“R„ˆSŒŠHˆŠG‡~D–~S•|Q”Š^ž†Z—€W™ˆT—bŠh’h–ŠmŒ†rŠu‹‚t…†l{’t}‘{x•}z yn›qœst”|wz{xz™iy”g‡›_ya|Xp•Zi‹aq†Vh‡Zg‚^[ƒWY€PdxVayaY|[_€Z[x`cil„dqZf|^bde‚ZiŒ`n`xlpj@EE@PDANHKRJLWRNTQJN[FMLQ>\V?VDCJL5DS7JR=CILNTACR;UOA[X6eSEZ^Ig[FXJWdUIm]GpdJqaO|_LƒYK†cO€]LƒgUfVeKŠhO~sZylS~sRmg`u_]zchZ[y^Z}U`yWl{ek€i^rij|gpwqpƒtppmƒ|q~€p||qymvoxxp€vp€…qz‚w|py}syj„x|€rz‡iqƒlˆŒr‰†k‹zmzlvˆeozgwƒk‰rg|}cŠ†c’\ˆ‘V€ŠZW„ŒX’‘b““jŠX•X—–\ œUœ[”˜S©›M°ŽOؘO©’U“™M§‘\Ÿd“YžVŠe—ˆ[£—_•–Y”–X™V’ˆZ‘Q”†a‘˜h“m‘Œf†”o‡n…`‘ŒdŽŽT‡”]‘b~“_}™\‡’Sƒ–]o‘K|œJq›R„R€£bˆ¬W‚¦\ˆ¬[}žP|œ\ˆ£_y—]p§^tczØZs°]nµPt§_h©[g¢bkØfq²\q®SoøZq­Qn«Yp§cjŖSr³b{«ct©kwŖ`ƒ[šM„ Lƒ[~š]–^†“W‡„U­P”OŽŖL§O‚ QŠ„Qy«F®Q}Æ@~­Kz­Hz“@~¤1ƒ¦9ž6”ž9–Ž+—8˜“<•9›…1’„0Ž6 }3™…@Ŗ},«ƒ0£v)©l"˜z" Œ/ƒ:“yA–€CšŠS‰ƒQ—’E•—K’RŒ…YƒN…ˆM~€JŠƒZŠsO–]¢}b•‡V•ƒ^‚a‹ƒ[Žhœƒ^št‘xŠo•|n…y|ƒv…•}~š~ržrtxw{w†~}ˆm{’i’c„iy“h~Œ^nˆ[c•`r]cƒ[\ƒZZ~`ZzTh[f|Q]€aX€Zg}_g€e^‚f\w]_xc`{\^ZfvdcŠlq…bo‹v=KN@KQ?=J9@TF9W:JRJIVIJUMANLLOWIQ\JLcEGKN5HS2OFCMTETIINJISOC\G7WX?aZIVUHaDRiKFnSQjSMn[R{cWpYSwdTˆ[O`PZW†_TŽa]}rZ€tawj]qg]zj]ol[|b[yrb\_at‚eazbe}hd|eguet}w{€xtŠthŠrf„|o€‚u†r|‡u‚w|}‚~y’~j~“{y‘t|’xt†kl™mo‹esŽks€puvvrqyrym~x{„oƒezc‚‹[z’Y~“a‚Ž[‡“cˆŽk–q•”a–Œf“`£–c¢›\®’X­‘Y±˜b°“YƎP¦†XšˆI¦‚Y«U©M«ˆH«ˆOŖ‘GŸŽU”Ÿ^˜œS‘‹U“˜Vš’Y—™a•’fˆa›‘U‹P‘\“]… Tˆ‘N‘—VˆŠPŠŽX|“H™Fu—USo§Uw R|¤Vy UxŸSx O{Uu„Xy bx«cl„cp„hq”ht„Vw¤^r©fr©le§sk£j^”[m­XjÆ^q©bg·\o¤Wr©dl”hnØcqŖarŖ\~š_‚—Z‚–c~ S‚¦ZyšS†¦I¢G…˜N„–N›DŖCŒ£L}„A}Ŗžƒ=’†?‘6”ƒ0”~+›v$”j(¤{'”s%p.‡x2vDœ}E˜zG‰‚?”„P’„M‡ˆVˆ}_‚xR…yT‡}Tvcl^ŽiP™{Q—tZ”‚b„qeŽ{eY—‰eŒd•„q—xt’wl‹z|‹„~‚‰w~Œu…€p~v„|zŠy‹ƒr€ƒq‰‰qƒgkinjh‡ts•ii‹hf‹\d~[q~_hsWeuQa\cr]es^gpWVxdYn\euqaujXnoUox`usivuu‚mCDV7KQBGX>=YI9ZDENAFKOAOIGDNBDZHGYEASIFOO;UM8MNBLE;ZHAaA8VI@^IM\QHfSFaKMdPKiMWkXMj\ToSNmYU~\W‚gU}i_‚aW|e`‚c_‚sf€rf†ogzn_ty[lu[mr`oqcnih|enwfcwdf€_g„hxykp}xv{|sŠ{lpkƒvr†|s‚wxz{yu…‰{‚Œw‡ryzx“r{tvol’qk‹ok‚no†jtplƒutyx€w†x}„z€w‰g†g…l‰‡a†…l…‰iŒ‚q‹g’‘^“fš—qŸœk£œ]¤•_”šd©`„‹X”‡MžˆDžŠJ”ˆH¬„OƉD«‡EƆEŖ”J¢™H”˜P™œH–˜MŒ“T’šYV“ŠdŒU’˜Q˜œK••Q“O™R›LŽ‘V…ŽK‰ŽKI‚›My˜Tw Pt¢YrSp—Pt—X‚™P~¤Vy§_o°\t°mr±nr°mk„poŸjtØdo­bk„^g ad©kcØ`\„`h¬gh±fn®cm¬cj©dmØh|£jy„a€Ŗlw«hu°e€¤b}_| [€ŸP€¤KxŸNw™Fz˜G…›LŸA‰«Gƒ«={:x”9y¤<}š2›/€™7z›4y=t–9sŽ4~‰1|•7’8ˆŽ8™Œ<™ŠC•„A›~<šƒ8•:œƒ/—s5”p)™s$™v.˜z;‘t@–{C˜zE“{IC”yCM‚Y\z_|}[†x]„r]ŠwU‘mV“oV”v^•w]ŠtdŽ}]’aŒ~d‹j”xu—vr“xxŒ}o…|‹„xˆƒ}…†|Š€~ˆ€|ŒŒz€Žr|’|ƒ‹y{qrmjkkŠuj„le‹lc‹fl€amtdlu[es^k|]i€ek|[`^`q``vgZkranuYmsgo|djymqng|o?BV6DWDIW?FYO>UHFRCAQD>UQ>DMB>PCDUKJ[KKLREWGFJCKLTFWJGTHNYAKRPF]^Qd]UaXMZY[bUZmc]hfRvdVyY]uWV…bU‚Z\v\dv]eu_^wfn}hs}ngva_{gbuudyjmzqnvikycg~al}nrwgrzilurx}~xuxp~~iurztdw|n~‡s„ƒot|Œ€{—€‹yqt“p…—nrŽnz™`y‹nu‰cqˆk{†eokqv{}osƒ{y}yvŠzy~jŒd{^ya}‚mw†iƒc‹i•h†‘oššs™sŸ–n”‡d”ˆc ~h¤ŠS®‰[¦ƒS˜ƒC¦‡Q“‰L£‚P±ŒF„L؉I’TšŒX™—K–ŠM‘\˜“a…•_ƒ‘Z†‹S†‘L‡‹R‘Y’—\•]ˆQ‹X…“X‘’B„‹R€’G|ŽCv—It–Hp ]xžRpž`t¤Lx„QRp©et£ltÆht¬kpœrvŸcz±cp¬Xa®W`¬\]¦qa«`džjb°epØti¬ok£hpŖ`h¤lt”ipŸft¦cg„d{«k}§hs˜Zy˜O‚¤Z}œU—Uw‘P}˜F{œK†ŖE…„K‰ŖB}¤K”=x¤FxœGy•;‡˜7„”0zœ?{ ?r†2‡0ƒ„7„†B–“@œ‰>—“<ŒF—|=˜‰3œx0 +§v$Øt£q-q%žu/’q;y?’{6›x<Œ{D‹~;‹…C„‚Oyr[w]ˆrd…rTySnU‡rR”qYŽ{a‹zYŒ]”ƒl™vj’~gŽ{n‰ro|uŽst…h‘|n‹}Ž„–z‚ˆ‚€‹y|‡†~Š}Œ‰{‡ˆ{ƒ~q}~l{yq{†vi‚mfŒioŒok‹ih}[sx`dyghveqq`p{W_n^c€W_xn[epZhpbsklo{c|‚syriƒp=MYIQ>LE4VI;QQ=DY?H`GS^GP[FOWIKMLAJHCTHE]VRXUOXFIYKTY[NVe\\cXYZbb_]`h`ie]m]U€ZV„UV†\T‚b_yhhqjjw\ekcbn^nuemtdhuj`vlermm{gu{nmqoprjvthpyqisjmvsn}x}wxxm€rv{n|~ep}`t‰l{Œw}}qv{’xwš‚y …{”y„“sz”b~•czdray{fr…c|‚k{ws|uzƒp{vwytz|x‰l}az„f}`z€i‹ƒnsŽq‡—k‹“s”l›‰oŠe |h„{a¢V©zZxK ‡I­DƏO£’S§ŠW¤Mš€HšˆPŸƒXŽ‡S‡T‡’SŒ“]”f„‡]Ž\‰–V‚‹S‰‰XˆˆTŽ‡V—ƒV”Œd‰TŠ”J‹M|‰C|ˆL}’G~›Gv—XsŸ_x•Ws–\{¢O~ŸUxž`k”ek›ij¢hg iq¦a~ØWs®Th«]i§fa“g_¦rn§nv£un¦sx›rr”or§ga§ci™Zh–`ošff£fug„_„Ru˜N~˜Xy“Yy•TPx’Ax¢=”C‡Ø?€©NƒŖL|œDŸH€‘B‚‘H‚•Iœ8}“9w˜<„F€‚?ˆƒ5’„;™‹?‘Ž>•Š<‹;’ˆ5¢~9Øq5žp(Ÿm$žoœp&—l&žn)l8”t7{4Œu8’y6˜q6•zDˆsQ|oZ„nXŠwbs[†wYƒwa‡z^”qS’xW—{fŠe’}n˜wg‘tjŽu‡sprršvl˜„j—Žk’}š‰ƒ˜}‡~z„sq„zy’‡xŽˆ~ˆ€yzzxq~„xƒ„p}…jq~mwryŽgqdn„_nxbjtehmXdpV^pY`~WiwYcnljlt`zpd€wr}yowv‡kOKmŽ?|ƒB|ˆBƒ„?Šƒ8”€4‹‡AŽ“=‰ˆ0~2œu1§~/¢z,£o"¦kœo"©m. r5—o0’m5˜z-šy<™v.~FŽ}LŠyL~h_‚x\‚xXƒvW‘q]vVyf„`‰zV‹z\’wa‘sg˜vs•xf€r‹tlk—yk“‡nžˆv•Š~v˜x}™~n‡xum’‡q‰v|~~„}xwƒzvŽ€nvuƒ‚nƒˆbxetgs‡bm}gvpnjqWry`iwQcvTgu]ithr|ae…nkzo{…q€ˆ||„p=EiDBhQIiRSXVUUYONPM\WHYSLR\BYcJX[Ja]Mh]S^\W\ONLTIKdJNkZLeXS^]RaUYg_Ueg\scNqYNvTJw\TucZp\en[m|XdnS^p[^pXly_lrWrw_mrbxj`yrSypWsqWp€`s{ay‡bwŠhw{ht{h{yprtt|mqtxrkurplspr}gl|pv||{~~t‰ƒo†p„{€~ˆ q‰„mŽ™ii‚†p…lˆnƒƒmz~utzm‚uq‚wsw‚{uˆ‚pŒˆo‡‹z‹‚z„ƒr€}jƒ…gzgƒ€q|…h†p‡—eˆ‘i‡dn”}h›t]œ|T¢sS„~L›€Q—Pž‹Y£R ‹I“†I~M†O”}Q—‰Y’‹e‰^„c„Œ[ŠW’‹^ˆ†_€€V‰„]‡„[‰^Š™fš`‡a˜X‘™Lƒ‹MyŠP|‘G{–Ow–QvSr“Vl‘LtQuMlŠWp–`e–jk›he£^d”ct¬YoØXoÆdmµhj«^t®eu°[|±bsØlu«ao¢cs“be“n_‹t]‹nj™ei˜^g–ei•\ray—Tx”Y|Z{—P~–O…–N‹‘N†–K‡žBƒ›B”D¦Hx¢L€’?z:xŽ:vŒ„Œ?ˆ‹B‹…;™‹<•Š5“Š/”|4¢y5«{.Æ)Ŗs§k'«s4¤u/g5–i-–u/˜u96ŽyJŠ}PzO†qWŽrZ…t]‘maŒn\…{[†^‡z_‡}d‚{hŒv`€c“pŒucŽqgŒtn‹vmŽxp”{yx™‚|£‚›v}’wt”wm‘wj‡‚mˆ}nƒ}t€ys‰rŠzsƒt†{qƒ‹hzŽ\ŒY~}fzth}xgv~iov]k~^p{\q]r}ZzˆgrŠcvls‚Žs„z:EqMDlGQaWVV`VUZJ[[O`PQXMD_YM_SQ[cWc^NY]UU]QX\S\VRXb\P[X]g\XcfUeYTc_SfmdvicifS{\Y„\Nti`pelzf\‰\`€YfmV\uVdl[qkbun\}o^|rX{kUpv]s|cq„aoub|~c}€pk~pj|mrskktqompmjopvu|k€zhvv|yx€rz{uƒˆp‰q„œpŠž~ŒŸ{”o„•m“jˆ‘m‚dyixwtr~stˆyi€}hwvpq…wv‘{x‡|Ž’v‹Šp€{~v‹i‚‰r}„h~p€r€„s‡‹v|‚k„…q“~oŠth–zf•s[˜u[•y\–ƒV‘\˜c‰ƒY“E“~DŒuO„|QŠ…Mc‹‹k‚}Y’a„]]€Œ`ˆ‰]„^†P†…a‚†VŽŽV–“bŽQŽV‰O‡…HxŽCy˜@{™EvL{Lz‘Lx‡O€NwŒOu’Q_“dh^dšjf”Yx©Wr°[{«b~©_u±Zo£bs°R}„\n¤\{dp”m{œhk›km“lhŒlg†bnhf—bb’Sm‰Os†Uv“IpŒJŽ\t–UŽP…ŒNŒRCŽœMˆ–Kƒ @uE”N~Jxƒ9|ˆAwBu…:}{/}‡=Š‚=‹…@†J…~?Œ‚8‘{C“y2Ÿv8¤j0 o.®p7Ŗl “w„d®g&­`(Ÿl3“g4Ÿt9›t1š…7›zJtMyR”nN‹nVzW‰~`ƒpSu]‹{W–€R“‚\‹ud•yX‰ri~c…xdƒonŽxg‹ml”soŸˆ{”†sŒqšz{¢{o’tw¤tj—tv‹qpssƒsp‚uxqqƒrt‚l†|mŒul~‚_ug}c|‡m|gƒ|govirwal…jxŠanzfuzdu‹`s‹^{}b}‹m|‡rŽ†ƒ‘Mt‹Mk†Oj•Te—QyœVu«Z‚¬Qƒ]}¦Zz¢ay¢Zn£\uœ\všgyap•ct¢Z{šf{Ÿov—iqbp–\v’gx”aw‹ZwŠ^pŒMuIq„RpStƒVƒ[zT…—Jz˜D|œ;q2n6uƒ>uEx…O~„I‚ƒ8‰„4x7{BŽpI”oFwG‡jJ‹w>Œ{>–r6™l9¦o(Ÿl4®e6­r/±a$ød½g²mØY$¦[4–],¢iA—{B’xD’wF‘sB•pG›wS}MyT†€L”~J™RŠuMŽuTiVŽkXˆs^Œl_‡ua–tf‰}j•xk€u›†|Žp™‰qŸ„pˆq~m£sx˜‚o¢zt–nl™tgŠyf‡eŠxjˆ€fŽzj“…h€Š\…Šd‰Ž`Œz^|†b‰|c‚jwŒc}†efv‹js‹pu†mv‰r‡l~a€‰jzYH`XJgSVpWUjQ`bV[k_il^fuYpoZis_gvS[lRcbY]iT^rUZiXWqVen^rn`neotgpxaoz_~q`}gYzcV}hU}fa}d^†_bƒXfƒ^s~SvzXqtasob|ubzq]zsVxo\{rY‚we‚lZ{l`yy`{zio{mj}wmsznv‚mq‰iq€izŒir†rzˆup†ur‡‚t‚ƒt~ƒŒ|„ˆr‡•u’w…œ}}‰y}†~z~s‡…r„Šj„€`„€gupjyinpysv€rq{kz‚tsywˆ|Žˆ{„v„‚~}ˆ~ƒŠ‡yŠ€pŽ…x‰x{‹xv}zz~z‚p‚zk~‚^‘|f“x^Œx^…ka†iasSƒwWxpQttPvs]r^zx^}vSsuWxo_vt]wzh{ˆas_y‡[‚XWˆJ‰”LŒY„T‹‰IˆŽFƒŽD†?Ž—:‡‘FŒ‘<„–?}‰MzI‰CA†ŽP}ˆOtƒMf‹NlMr˜ZqŸZv”YyVyšcs›hp§[u™W}”c€[x“azšZ{•d~˜_s–il“at’^}Š`z‹gz•k|is‚_{€WuT„Pw|Ms‚Z|Rw•NrœIy˜KoJu“9s…Au…’‚K”v:•x:”vAˆoJ…kEyB—v;›f6žm*¢h- k+£v,„f&·g*°n"µi²h#„`*Ÿd%¬\+¢\;g<št:r;ŽqIoD‘tAŸ}FšƒF‘‡I‹zIŠxK˜sY‘pW˜ggžs`“tq“wv‹rt‹nf›lŸwi›ƒzœ{qž|u¢ƒ|¢m¢‡u¢…o¢{~²~s°tl£|jšzh™‚pœešzj‚]“x[ž|`“^”Œ^ˆj‰uh…m~]’h’ˆi‡†l‹„k††n‡Œf€|j€‰lŒ`Œ‹k–‚h‹wTV~Q]wQ^uZfzekwafthd|_n„fcwdfoeUv^TtU^kVacQjdOhgbhrgmmloq_ske|`n|fjsqsknremtii‚rsƒxu~hi…dl‡_i‡Yn€V|yX|pSznSzt`~xgrhpwcovdvz[n]„pk{upvqqz|jv€p~„myˆr„Žn}lk“gj…ru‘lr‘uu‹}jŽsˆ‰o‚ˆsŽx|Œj…i‹qŒw†Šlˆ‹i…‚n‚k…‡pƒ€ozvp~vyuuuwywz|ƒ…v‡ƒ’}‡~ƒw„‹px„vx€x‡|y…}}xx€uv‚owŠorzz‚}|ukxp`um\‚kd}le‚~Zs|NqoOvoFs}M~nI|pPzsZr~Vrw]vmWwpRnyXwƒQy‚PwŒW€‰WƒƒT€‡Lr‰EuŒJqMm’RxŠPvRz|R†€K…’E‹“9y˜yŠA“DxŒGs†Fx‘Cm‰BrŒKmKr–Px‰UyŠ[wœdtŸ^u”[y›T}¢St¢Ov•R{™Sy[€‹a”cƒo~Œg‚’p{ft‰j}`‡aˆ}h~nc‡|i„…b}‡^q‡Y}N€RxˆSrŠPz’Q|C~Eu?{x>yHy~T…ƒT‚S‚„Iƒ?‰r@„w?{J“rIŽzB˜y@™k:”x7”w&l*Øl¢s+Øi*¬e#Æ`!®^#Æ_1¤^9Ŗj2Ÿg8¢`A—d<œoA’vI™oF”|?—~H˜‚R‘†M”RtZ‘p\šr]›khnitv‘mtliŽso—qhyqœuvœxr—~|¢x¦ƒ|‹p©yq«xo„qf­ue£piØqq”tnš‚r„f”xb£rd›zf”†bœ„[“…_ˆ{i‘tcŒqf‹|hŽ…e’cˆo{p…~l~zl„c‘‚p’€nˆ|qŒˆrQIY[[a}Zc‰Zl~Zs€`ez`d^l\coZ^yi[nbfifcsQdhLkfSer_htkrvfylcwml|tqxlxko€xf|xgss„€}‡m|qpcu|aysRuxU„qT€nZxqVp[|}ZtoglsXt€a{wh†pwtm~lsttrry~tm~jjŽuu’t|wt†kxƒ~gˆtjwq’i‰{g‡ƒiy~d{…t„Šr‹kŠ„d‹mˆq€j‹‡m…cˆ}q{u|}t‚€w…w€~ƒ}r…{„‹}‚…€{…}…z}oz{py~ˆowƒzwyoxstˆw|xƒwƒ~ttm~v^|ocˆn^tsZtpX}~]ryLrrRwwHmvJ~mMutVj}UopUy|]wkYhxYz~Tt€Wv€OwIz‚Jz~Tv}DpŠDo„Ro‘\l‰Lt‹G}ˆEz{F‹€<„’@‡”A‚7rŒCx‹@wˆNw—Fp‡Pk“IsIrŽQv‘Ps‘PmSqƒ\jŽ`lŽUqPvŸU|žJu¢O‚”Jˆ•OŠ`~ˆc{e‹›i|˜r„iz_q…gyˆ[xƒi|pfŠpiŒvc†ƒl~ƒXt†Sz`‚ƒ\|YqŽTvŒY„Pƒ‚G†w=ˆw@…HyLƒ‚L{…U~O‹yPyN„vJ„T‹wOœDŸs=’n-Ÿz/šo*—j,Ŗt(Ÿi-¬f'¦k.”j)°]1«c9Ŗn:°l6Ÿ^;£[H›jE—o;™eK“tK“nU”zG H¢N‚LŽsM›r[‘pe”wo•mg˜mršqqžsj™{w›ut•vo£vŸ}z§†ƒ ž‹r¢‚yŖƒp¤}w°tc¦€mØqj§mq”yk”ŒzŖ}q |k§wc¦€kž‚f•‚g”yeŠ|iŒwh‹re–yf_‰kŽˆk‘xg…}rŽ€sŒ~nwmŒ…hš…xŠo\X}eO„ja‡jh†lg~do„ao€\gƒ]]‚[Z}eaxdbsljwheqbmhXigZugZptfk|ksrtwuu~qrxu{ysynˆzlˆƒsƒ{y~x~tu€cwzawuV}pS„nS‰zX„x\{w_ux[poaup[v}d}|duws~sskltcpgkzkk†qj‹pvƒp}Šx~|w…xxŽpj’jd—vaŒ|]Œ{f€„^~†b‹b~j”‡dŽ†h“‚l•‚h‹Šm‰ƒcˆ~k{nx||x‚ƒŠ…ƒ‚{Œ}…ƒ|€„y}‡‰†|…zvvysvtooq’wqˆx|…vq}yt†uy{zy„{vqk‡s\|mYnl^mq_wvasxUl|TsyHpqOupHojKsrVyy^oy\ezcio]sq^xtPxvRs}Gy{Mw{Pr„Vg€J^‰WfŠUo“YkŒLn†D~IŒ‡M‡ˆB‚ƒ8}>yCz•Iu—Rn”MfˆNlŒSoˆMj„Ot€Mu|Iw~Pm„PbWh‰SpŽKs•Tt¢YtžLv™S„•T}b~‘b‹–q‡™nˆ–c~g}‚`s€]ruXwaŠxfˆn]„kh‚sf€xj„Š\}^w‡_u‚]|d€†e…†\‹}SŠtE‹nN‰wS…N}‚Tz‹J†ŠM‚S‡OŠ}V”„O•‚S›zE p6–r0u)–t0‘o4œk)„r%¦p"Øl$žp0žn.Øh0£fBÆmB§lB£aEža@_AŸbB›iPœoZœmT›oM¢zD„‚CœxQ‘w^–|i›tlwr˜pnst™j~n”}sœ~}•‰‚šˆ˜‹„Šƒ¢Žy”„}£y§‰m¢ƒn§{gØg„xo؇n؄v¤‡m¦€n”m«ƒa¢‚kŸzg’wk–n`‘rX›q_¤v[›gž~l—}jœ„w~rwmsl‹s“{r„v—ƒv^T}kS…qU}qbz^a‹[j„dp†hk†ae…[\}cathrvohnfmkbnoghq]qkipwmvxjz}fyyry€y|ƒxv€y}~„}z~z}|wytoƒxe‚yd„{c…{\‚v\„{c‡}ayx[xpZmxkvya{b}oyznx~krlpqwqnm€nvss€wyx{”nvŽt{ws•eiŒgg†to‘xo„zf‡€e‹ƒjƒv_“‰^ˆ~c‰l‘ŒfƒŠn‘iˆƒcyb„yo{†t|xƒ‰}~Šy‹ˆ‚|u‡†{Ž{ƒ†z‰}pr{‹pyurvuˆm~ˆw}ztt€}qpi„|kzro‚dg~ijtoWgq_fpPp|WxyNn„Nq~LhyOihDooKukVjoXou\jn[j{Tq{IytFj|RnuLyvI|{Pr~EfuQ]ƒQZ‡Kf„Hl~To…N‰€Ay‚G€ˆMy†HpEx–Ip‰LxQm’Um“Om“Xb~IqHn†RrtHsRo„Qh„PvŽWo‘To˜MyŸKr‘Oz‘X‡ZbŠ”gŽžd‰’h€œmˆ’g…†d|v[ƒb…tetiƒ{f†miws`}ƒVƒ„Q„„]x‚j~fy‚\ˆ[‚„Z„L‡tD‰}R…s\{{M|yP†N†‰K†ˆO‘‚G†~RˆƒQ”}H F™oA‘y;l-Ÿu*—t&Ÿt&©h&±s)¤y%¢z'£v.«a6”m4°aH¦m>œb<žeB•h9£nJ£kSšlOœrP›tDžtKœL–~P”~[—xi•€fŒpkŒ|fžrxi‘~o•o„uŸƒ„”‹‡¤‡†­ˆ¢†‹«~‚£‚t£Œs«‡n£rf”j™vi¢‚oÆ|g©|p¬ƒ`¤‡`„Š` uk§tpŸ{i”h\–ihØs[©{c„wn¢xqzvwgŒ‡mŽ€r“tp“ƒh˜…xŽ}w“zvm`ƒl^Šj^gY`fƒclƒbk~ehˆf_Žce‚ee|qt{jl{mrkaxgdlpantkwx^xz`|aˆl„‡h‰pu}|~‡~„…u}ƒw†{x…‚qykk†tdƒ{b~toŠrkˆub~ld~s\z}Zrvftl‚xi€|rƒyivvyszyr{yykuzos}zzp}k„jsŒkn‘in”pjfm‘qm{uˆzk‡xwŠ|q†zjŽ‡aŠ…f^…m‚˜s’q…„i‰€i€{kq~j‚jr„{y{}}‚‚†|…Šwzxx€{z~}{s‚psnoƒpu~|n}{g{qexkmzwnsthkyidqhefsXe|QpuVu}UvƒNl‚JfySkmKkpKnp[ryVt{\rwNtvJo€Gh{Jj|OtnM}xFxtBkvNbwKhwN_†JiMiqWz{I‚w>t˜h?”fHŸeD˜q>œsIžtI¦pG›zNšzRœwb–d˜€Z“y`re“urv–†mŸ„pŸ€v˜x}˜|~¤Œ‹§ŒŽ¬†¦ˆ„©}€ž}w¢ƒz£zt„‡{š…pØym§~b €j؂a«„[©dŖ|nsj x]£s[¤wY¤id¬wpØtm„lo˜ls“mq“g™~q’€pˆu˜ƒt•v~˜x|cS}g`~scjV‹mZŒkc~bd„lp„ld‚imwlonmvrss‚vd}piqspxr`‰~d…_‡Œ[€gƒ’j‹‚m{ˆq}€n‘‹m‰†q~|yrs}n}|f}soƒwn‰uguoƒlh„uj…tb„k_vyb|ui}xlzyftvm}tw}qlvfyyyy{sux|Šh‚fw‹uv’sm‡mo’rl‰lo–ym”s‘|p’zw•€c„\‰cŽŽb‰‹hƒ‘gˆ•uƒk{n€ƒcryo}w_~}iwwt€~wz~}{…‚{ˆ‚ƒŒ~t|{}~w€vr†ro†oo{vx~wevpgrtqephdimkgotfrvjixYdXrVq]e†Ll„OpRnvDlmKqv]uoSvyYxxOpyPq|VdqGpsKnkSo{Srv=ouA`rFgFgwWetLhiLloS|~A~~;q€Iu‹CoŒAo†CwCv†Cd”EkŒIrˆXp„Mk‚Ru{QtˆTz†Pv„J€~Mv~OƒSySˆV‘\„T‹SŒ^’Y‘Ž_”–b’†g†€cf…qe‘{jss€{b{nˆpdxukszWx~_uƒd{{d~}ezzb„t^…v\‡xUzrMˆoJxwM…V~rMtK‰xSxE”sMp@ŽmD–lHsCœ}Kœu@žwA¢t1¢x5±m(¶s-·i:Æg1§u4§q4§j:¢`?­hI§gF¤mB jCžfB›oAŸfE”qM¢tN›|FØ~P¢wU”|W“xY”€c•€[•‚]†o–€w‘k„r™y’ƒszv–„s˜~‰¤‚Ÿ‚€„†ƒ£ztŖ|}¦{v Œn˜ƒqš~c ƒ[Ŗ‰Y¦ƒi¤}i©‰cÆtp¤ro®€^²€]®}]§ijni”kk¤jn£nq•}mŸƒhž‚qŸwh ‡q—}w•‚–z‡lSƒmZ€oZ~oZ…kVƒm^‰ujˆri‚um‚yjzym€xrzn}|o€ul„rrƒ{n~|_‰}Yƒ}aŠŒjb”d‹Ži…‰b…loˆ~t…q‚tswvxywn}‚v|x~tw„np‰loˆmg„ndŠphƒjjƒl_|wc…sd|dysf}sh}psxmqo{xtsyh|†lƒ‰rv€„mx‰qq“tm“€p‚k–€l–xl–€h“ƒc‰_•ˆ^‘‘l‹l†‡rˆnƒ†g~h|hsˆbtfw…ps~~r}ƒv„ˆ……z“„xŒwv‰‚qƒ~z~}sƒ}iqc‡ti‚mtƒporeiyjcnsnjnrplwmgs_j~ej€^_‚Wc€\`ŠRi„Qj}Lt~KqzStzPk~LowVvq\ryTk}VasPeoYdwSguSe|Hf~E^vM_tM]pTkiQqpOmlRutFps<{x=}„AvŠG~“Eu’Ir‡?kˆBp‡F{N~…GxˆOu†Iu†SsˆW‚~I|€D…ˆC|Q‡P‚`Žb‘Œf‰ˆ`„dŽ]˜ˆeŠe}hŠxgŠye“toŠuvˆlrŒnjseyt_|niydxzbwyj‚|m{}e|qhuxfvp[th_€oR{rPymV€tP‚uQ|{T„vS•|T”uEžzE™n>’yG–vHsM•nC£o:£p8°n>±y6¬r>°p4¬u:¢h<©l8¤e2©c?«f<„^E¦gD¬lD¤h;§p:™iD”mA–zJ ‚N›{K sRyX˜}XŒYa“‡c‘‚g–ˆt‘k‹lŒ‡l‘Šy‹ww’Š†š……’ƒ…™…„Ŗ„}©€v…|›r•‘q l؄aŸˆbš‡j…b¬…^Ŗ„f„}b©{j­xm³€j©vl©v`”j[ n[šh[mh™|h¦}mŖxqŸ}n§yj„zt§z|ž}€lW‚gN…pTŒjctd€n_glgg‹kr‹xnˆlxvxsw{uzh…€k~‚a‰‚k†g‡Žq‘‰l†“j}˜b€†h~‘q…i‘w~€l‚xz…‚tvyswtm‡~xŠu~{kw|qu…nk{zcxmr‚mk„lnzfswmcidrsdzsq{{vvnrsoulpt{qs~n€i|}uu~qƒks†{{e•‡g‘…n‘|cš‡k‘h“ŒfŠ‹]Œƒb†‹w‚lˆŽrˆŠp|Œ_‡|clx‡iq…hƒtzuƒˆƒˆ~„•‚t—nt’vqzv{~o‡wj†yr|mdwdtylmbilbiteinjsnpr^fmeivai}S[x[`ˆSg~^_zNlqZi}KjP~qDk{Kp|^evRk{PdMbwPexOfqPgpJh|?^w@[qHcwR[oMbqMlnSnzNi~?o|CxzLnvExzRn‚DsEi‚Me}Mp€E|ŠIu…JvRvƒTp„Sr{TzG|‡N}J}O~‚Nˆ~T’{iŒ‹W…‚a’„Xˆƒ_”~g‹ˆl_‰}_“mrve“grjoŠnh}ro~{f}lbp_o{U{ob‹sj„sa~k]€s^zia‡s\‚eQ†uO~rJŒqImCŠsQ|lKsNšoF—kO p<pA•{BtAŸo= hF”j4”p1«s*«p:°k?¬h4³d;„e@›i0¦f/§d>¦e7¬iCØb:§iG£nEŸiB£kF˜@•{B„qV£zN£~TštW”ˆW•‚_›|a †t‘q–€{„~˜ƒy•„Š…rˆvqšˆ‚š~{‘‡ƒ¦u¤ƒvŸ{€Ÿ‡m¢€i•ˆe„Š^›€m£g”‰a•{g§‚m¦€a„vl­vq£ta„|h³v[°}YŖq^”qi”ej¦ma™nc«yeŸqg£v˜rq™p}£{€v†kOeQ’oVje„sg}qhtf‚lr‰jthxˆhwnw{x€r†zuˆg†„i„f†ˆf‰ƒqˆˆrˆŽm{Žpx•p€Žs‘pˆ‹{~ty€t|‡x‰€Šwp‡o|ƒnv†mwxjmvtg~vn}vo~wnrj‹gujvƒeuvhzv{qyuk€xtvyltuqu}rxx„jw†gv|fxˆsz…uq…vwƒq˜|bšƒ^–Žk—Œo˜Žk—”aƒeŽi‡‚pŠ‘qˆ‘k‚ƒgŽ‹dˆˆqƒ‰pyo~Œn‚{mŒ}‚“„v™yz™s€tu“xz”|yƒ{o€km‰okwfeurmsrltlgk_npdkx^woivcqv\dwRaqWXR]‚V[tRaqV_s\krYiyUvvIzmUpqWmoVfwG]rJYyV`~Z`vPkt?ms?`z>]zF^hG_cKfgU^{XdwTjvHd~UozTzvQwyT€zVxƒOx}NpXm€Zx…O€yR|wNsyRtwVvMy„H}ˆB€ƒMqtKquM}…Sˆƒ`~S„ˆT„‹O‰‚U„wbthƒlo‰peŽjf‘il’j^‹u`‡na‡wm}nn{tazl^vrU…pX‚rZrnbsvc~w]€l^dW‹eTˆoHŠrG”xI‘uDˆoI…iJbP’jW“bMšfF˜kNšuIŸv@˜q;™c9œe?¬]/®d-®h4¶i=¾g4µo8°l9žh7®k;®a6£i7”d6žk7fC—pCŸmM—mCŸtDØmR eQ§lR§vZÆpb„u]„~e™xb“|qƒz¦z{¤uƒžz‹z‚wv{w‹{€‚”¤€s„w£{}¢Šw›e”‹cŸ€a©Šc¬…l}hœ~o˜woœzdŖrlÆnj¦y^žxa±zf³w]§jlœlo¦qt”okžtf¤hmjo¢tw qwt{’zŽ{}mXŽnY”fXifrh‡mo„ft†or„ft‹`zi~‰mozsyˆdwŒp‚}r„}j†„e‚}j}Šz€uuŽxrˆlt—t}œp“dˆŽry†hw~mu‚|‡xsˆqm~jvˆjq‚wxhstpjquexpuƒvoŒpw‰pzkq€m~{pqvurz}wsrr|{sly|jw}pyxlvƒrz€u~vvŒmˆvy‚†u–ˆi“~`‰hš“fš‘g—k™‹fœfŽ’oŒf–o„‚gˆgŒh‘uƒ‘|ƒƒ{~‡ƒ‘~{œƒqš€y—zxmn•pr‘l~Œml€nj~^fw`pqerzitl`ojktlf|z_xxiwjqck|gk‚\]~^f|WjƒVf[fuaryXm~Mx}UqxTf|QdoRYrE[yM_{NXuUk|DkxHtmH_uJhFelVigTZrPQ~KY‚Mj{LauPlVysRtItrWluVo€Ovx`r|MxƒS‚IzzU†xZ„|Xt[{…TvN~†RtpXyzX~rNw€Q|…VŠvZŠ}ZsbƒmZˆi]„rWyxU†uiŠoaŒri‡t]v[„nq„~l|l_}{^~^{rPˆ}R€pOzu]}kY{nP‰nW]O–cSŽeE‰vMŠsM”kDŒjIŠjLcWŸgR„iO¢cH§l<£d9œf2©n4¬q9«b6­n7Æg7øi<¶lAµo9²a4£c:„_/Ø]@¢a=Æ[:¦b4eAŸbJ¢_KØgN«nG£fJ¦fY«qVÆmNØu`«h\„kd„p`Ŗ~w”w‚¢w‚tˆ£s€ ~zzš||’xx–y€žz‚ž}x£€ž„s Œ} Œi§i~`yl„Šn¤ym¦xmšsdžmd©pe­mm£u]gb¤ig²xi«vj›lj§erŸlk¤rqœqz wqØx›s|–w|—„wŒ€‚_c˜eaŸv`˜u]”gjœie˜usoxŠg‚d‰n}ˆlr‡aoŠfvŽh…oŒ†sŒƒk}gxƒr|…w}„tt‡n‚”q€šrt”ex‰h|…m€„k„ysy}o~‰px…vs‰pvƒxlrsoqll~ug{qm|po‹h{Šqxtszj{tm{wrnvnsxwrqyrr~pxwy{vq€{w|wvŠvrŠos‰|v‡ƒy˜l™‰a˜•^Œ^˜`”Œg•’\š‰[£‘c ”nœg–m”‘m†˜nˆy‡‡|Ž}‚‹x{™rœ„t |rŸwtšrv”f|Šks‰lq„gs|`w‚dn|mrwersljvequd}|czvpukmk`|]d†]`|]azYc„cjbmsfru[u€NqOgIgvQZzP[yIWoK[uMYwKdwBoxEjoKbpMcwVhrOakQ[oMTvK^yJ\Rk}TpsLtzK}qMruPowLfq\k{ZxvXz€T}wTyL‚~O‡}Y|ƒS‚yZz^~|Ty|PvoTulLrrMrmYuZh^k]vlb~nY„iPzqTŠtYˆla|kXj_„njzvcwxd~s\‡qWˆzZ‰~Nˆ{O†|M|tQ…oTiL†`G‘aKŽ_M”iBšdI”pG™eR•]U˜ZX’]X‘\Už[J„[I¤g:¦f0©b-¢f,Ŗm5°j5°s7»v-µk4¶j9¬b:§_:ØY0Ŗd>£e;­h4Æ`2Æd;§Y8ŸYB§bI²bU±lT©mZ¬cO§iR²cSØ__Æj`µtg­po¦x~¢rœn„›z„£~„”v|—}“}z–us’y{ž€vŸwy£‚r£„zŖˆx®‚x¦‡q©ƒb ‚b”o§uw¤os¦jd¤mf¢tf¦ll¦dc«e^“l`«re¬ri«`eŖbb `mšoršnw›hr¤pvœ€}”~y|s€}gdŸr]Ømhšr\›q_š`j‹qo“hz†ip’ntmolo‡hu‚q{ˆu„x‡Ždˆm‡q€gŠ€m„}vŽuw”mšfƒ›l„‡aƒc~ynw…hy~nz{ts‚ou‚ssŠsq~nvvyq|nawnkzjk‘duŽqx€itycqubvxiwvxvwqqwwk{xqy|vxqyjx€o…ƒr‹opŠli‹qo“qšŠgŽ‰j”‹V’‹^š‰Y˜Š_™‰`^–aœ‘f™”k––h‹ŸsŠ§l…o“ˆ|ƒ‡{z™u”}–qsšz| h‘lpb€gx‡a}}hvynp~_wokzjemtgl€c}nnqhp}fk€nd€di‹kb€gd€Xn|gr|gjqbwz`t€Nh~KgxI_oJhpPYuUVzOasSWjN_u?jsMjqIhjJgkRYiQdvN]nHUvLYM]vJ_|ThmSmnJ}lHyxHmvJz~St|Y}~NƒzUsxN}vS{W„sV|tS‚rYwnY}t\yf]~v^ygUn]~ocxndzqf‚cdƒkc…iUxr[vqX{aalbgdm\‚{auvp|u^tja€zQˆrSŠ}S„|LŠxEmU‰jV€_Nƒ^T‹YQ]H•h@”m>qF•_H‹iJWUŽXP_FžTJŸ[B„oF«e7 a1¦^5¬b-°c,¹d8³j0¬b-°Z7ØX+¤S'§_,ŖU.«W9°[2¶Y1§`7°^0®]=œiCŖeSÆbG„eL¢ePÆbQ«nV²nU­l]£qa©diŸe{¤kt¢v}œo€ u€šu{˜y|t|•uƒ•w~—usžpx„s{žw{›†{¤wiŖ…l¤„a sp©€p­vv­ez©nl©pi¢j`£de£bl®`e§pm®ahÆhp„]l«\yždr™^~žcz§fz©ct–yvœ~}yt’v„ma­v`”k_§oa£hnhndzot’ov—rtvl‘hrˆh‚‡s‚‰oŽˆrŒo„“h†”f‚—g‹‰hŠŽt•j…•j|a}“g–d|fx|j|_~„ixrrytwuuqq€nlztesliskmwmhŒnp‹`}…hƒdqlv€gr|nwx{~pnzrlo~rz€jvsm„rg„‚kˆw~qo‹{i’wr—{o“Ž]—Œ[˜‹c“Š^›‘^’•f”˜g••j ‘sŸšo’“mš¢s”¤zŽ“q“p•›xŒ™tŠ”z~uœrv›kr–fwže}“`ƒg}…_ŠesŠft}dumtrpr}huyp}piyegxmp„jl|qc€gfvda}[bw]qnctndoYqt`kmVnmUfuIc{FbqP]oPbnI`iK[cH]hTmmTccOafG^mNZzJdtP^vNdUcyNa~IdsKyvP}xT}uP|}PuzOsUQ~SyYvySs|\wr^qo^{o^tmX|f`„d_€k`zie„me{bg€eg|f\_^‡k[„fbƒeicdjn|fkwkk|ujupnpwnwk`vi_}eQ~qR~S€}P‹uLŠjH‚_X„dZ‹iS‘_O‡]G‰fM‘jQeC_DŽeJˆZI[HœaO™^DšjD§iB¤n?¦c/Ŗ_1£U+Æ`2²^/®Z/²b(¹T(®Q,·X(Æ_&§\*„T'·V)ŗU.·Z)®a1Ød> iE kP§cK°fL§eF§eG®nWµh^Ŗid®gi¦bi©kpØnx«wƒ£q‚ sŸv”sq–ls•hw•q…¢kx£qs¢zw•{v—‚syfŸ|k¢yfž~e¦rk®otŖhoØbqžci¤`dØ\c°cn¦hr¢mc®aeØhsÆ`}“Z€¬X~­_}”iØ`¬cv„jx“p{”pw˜s€ie h^ŸimØio¤ukœm~“v€”yy{r™voŽum˜ar‰p}˜hu–v‚{Ž‘uŠ—oˆ_‡’b’”`•iŽo‘o}Ÿd€”cƒh€‚_uƒerˆ_{…^s|qw~ov|go~cnzgjqslyirzroƒqlŠ]}‹bv‡ao…joyju`x‚esum„jt†oƒ†`wwlvn‹‚ok…†{}yt‡x‘usŒ…n‹‡fƒW•†[ŸŠf¢Šb””f”bœŽi˜•r—‘yš‘m›˜z©y‘„|Ž£p–•}…›}§s}œv{›wr—kžh‡›jŒ’m‚—[Š^€‰gy‚bw‡h€|mzxs}zjvyh{fb†lq~dsz`rzeqzcon\orfoifeuV`kdp~`en]ewakx\\rWcnWbdN]gJeeRhcNfcWicLefNgsWapSYkQUrIdySfqTexUkk]mtTdwKmnKnvLyzIk}MztHs‡T|~Kt‰RqŠQn‚Sx{_l{a|mR€pW}lZƒX`ˆha‚a[ylf…d_`av\avY_ƒcZ‰X`~Za{[h‡_fiarnfyugvlb~wjnnitq_|d\~m_xnU~sZ{QˆjF“tPlV‚kW‹fO—dQ—_V‹fQ˜bJcIŠ]Gœ]N”WT‘^Fž_EŸ`D–f@Øi;¦fA Z:­W5ØW4ØP'“Q*ŖX$²Q/¶R*¬V °Q*ø\*¶]­V#øV(»K2¾^6·d8³_;«]:§\?§`J¶kP·jDØmZ©vR„o[§obÆjhØboŖdl¹ey²op¢k}£jy zu”nr—tz›v~›zŠ˜s†§s}“ju˜sz wg¤xqœvežvqžqoØhmžfh§el„pf©`f”YeØ\lÆho¢gl°ku¬dr©ar²a†°Y¤\‡¢f‚¦f~b„­bˆ¤h r~”n€ŸohhÆkbŖwm”rvŸz€£t†—p€”v‚“v„ wz›rv—ju’c}’mt›q~t~•rhŽaŒ‹d_‘a•‰o–”k“s‚‹mŽc{Œe{‰kval…dsyfqwmw}cr}dh{dmxlp‚ni„st}ht€]v†ax†bwƒayhr|bt|a|‚myƒb|ƒb†ŠdŠŒi†…fŒ‹q†rƒo…qzzv~jŽj‚fŽyd”~c§}]«k§…h—…m”Žl—’n”Œuž—|–šs›£p‘Ÿu˜¢|‹„r©n‰Ÿo‹”ozØnz¤rŠ£hˆ›iŽšj‹–h‹Œ`€Œb~d††g}~o|xwmmzkgƒokop}lgw`esdqpbot\on`ir_bkZilTbv_f€Z_yaho]_vTbeOYdX[dYggSalQkdTjiW]iT[tKdsPYnO^uVep\fyUqk[qj]zl\rqMpfIokMvmPkvQp{Vy€I~ŒUw‰Zo\o\i\qyT}lVwhX„bfƒZc|Y_‚`f„ikzfarf\xXdyQ[[`„Vdƒ_d†dc…_cubovgklnksserxfynjvm\vh_j[|nZ…kQ„jNeG“pP“oJcOŒjWaVšcPš`M—TK—YT›YQšSQ˜QS›]Kš[FœfO¤fM›[DØbH§[>±N@¬P1“V7­J-¬V-±Q(½R,»RøQ²Q$¶R!¹Y%¼U1·O1¹Q7¹X;ø^?®_5­i5“dC·kMµbM°gX©p]Æo_°oa·nb“jqÆiy¹hs³n{±cs®jmŖrt¦yq£ru¦uˆŸrŠžmŠ›i{—wt–utxt ol•ni›skœgg™go¢nb”oa i\„bg¢Wa§[d©aeØfh„av±^wÆX‡¶V‡©X§ZŠ [€Øb€«k‹ fŠœhƒ¢v‚¦yƒ˜x„sg¤gl­vlœrqØ{t–pvnz–y~–nœv}p{–`q‘h}™o™wuŸuyœl˜m”˜h•h‘˜d™Ža†o‹šu–ŸsŽ™f{•jx‹qy‰ku‰lw‚itdl~anxdvƒcq~jstnwdikuxeyvjtfxybx†]}†ft‹]ugy‘fpu‚Œp‰“tŒŽq†p„ˆjŒŠo‰ˆpŒ‚d‰lŠ„f…„mf‡c”ˆh£}f¤’b ‹g¦‡q„—f„—w•r›ž|—›x§Øw ¢s˜›l™¤sŠ¬o‹§s’§q‰Ÿg‚Ŗoˆa‡„`‰˜_‹—^Ž–Z‰‰eŠˆl‡€k{†ksg{w_€ma…xZ„iaom\xi\wjdofaw_qzcfqmio`jsifthajmWwc]rajyTgoOl\Wb_TbsLfaUaeUYaXYePUf\YnQXiWSqUZlPamTpm`qf]ueYrfLiuLltPvkVuwKntMz{Ev‚QzOk†Sj|To]wwO}oU{eV‚X`|aczZ\ck…acxa[wae€c[€\WxNXƒ__^p†dbed[j{hnstnzxl„gb|igig{dZ…cc‚kRŠbVgIƒoM•n]ŽlY†lO`RŠ[Z’\T–aVŸcX™_TVX ]M§]W¤_T—fJžhM™gIŸ\C«XD§N>«X:ŖG,«C1”R)©T,§R&°O(¹K+ŗS%±G½O ¬M'­N2µM2ŗN5½T@°R=¬b2¬ZB³^<»ZG½fM±aY­mU°]f®ed±ik­ge²pjĄohŗesµ]u¶_|¹s~¤dr”l€švx”jŠ›gŠmv•j{˜nvœoy¢oo¤gr¦mk©mtž]r­gqÆb`¦b\±Th§]l³\m°Uq±Vg©Vk®Yy©S€„Z‚ØQ®X‰¢^‰¤YŠ˜k†i‹›sže€›{†¢pŠhg°ll¦rq§vz„ww§tw˜uq”uziqˆiqkw”gv”my¤k|¤v{”zk‡œd—cfœ”j“•iˆ˜h•¢ro„“o‚n|†lwŒl€‰kƒzfvƒdr}hoouwl}|h‚sgt|ipyaqvZw}fy…l}}r‚|j|}f‚Ž\y^x‘or’{x™u~—n…Šx—†uq–e…‘h‡Œg‰’f””i˜Œc”Œjž‹i €d¤ˆhŖŒe®‹c­Žm°›m¦™l›œr›˜uš¢u”§f“©c‘¤kŽžt‹¤rŽžo‘Øi•§m‡ p†§j jŽšY‰c”ˆcŒd†dˆcˆ„g~}i…~_‚~UƒyWynbuibnj_hkYnmaxrkwosrtlnnqiermkbvi_nehplmlbnm^nePpnXioRgfQaeVaa\UkQXkZZd\Vf^VfTYmRejYew_srWkrU`kObkUmkSsgMzjPtwQ~wQz{MrQvv[ryZysMtnOu]T]]rZ`sbQzgV^a~V]ƒZ\ˆaf‚]^zO\yP\[_~`k‡\e‹Y]‚\Ztghyrdlcy^h‚`\„a]xqa|dW‰aV’jYgN“mP‰h[pOgNVQŽU[Š^MŽbO•^O›d_¢Z_”`W„VK¦XKžZHžaH”^G¬]DŖW=”QFŖQ@”C2¤C.¢R*«Q(®V#µN,²K0°C&¹D ±@)®I6ŗG1¹D=®@E“HCŖV:ŖX9¶O8²OE·RC¹^P¹^J“YO»dW·^k·_g·lbæinŗji¼luĄ^|µaƒ·f~±]u¤d{¦c„¦q† a€˜b}•bx•o{“iz™ls„kkØqi„og«`o„Tf°WfµOb®UaøSbµ[l¶[xŖQv®Rs QqØUv¤Xt©azµ^ˆ®^„žV‚›h‰–j‹˜fŽ£dˆ¤q‰”yqe«is¦oh°~r²rxŖst™wy–w…vqœwpšvp™kv›sƒŖi‡ n€”}ˆn†e‘m˜g’œe^‰Žk’”gŒ¢m„›d“^zf‚Œp€kx}at€`vis~s}ym{prhrl}w_‚€\|z\xj‹l|ylx…hyŠ`zŽ\{™dz‘s†”j’v‡‰{˜‹oˆy…p~›iŽ•i‘]Ž_’˜d’‘_”…eŸƒp­Œd¦ˆb³‰a„Œ`¦ a­¢q §pžšhŸ­g©k£j¦d‹œx•¢qˆŸi”¢f”©mŠØd‰š_‡–d‹SŠP„]Tƒƒf‚}X‡ƒ\|†`†€]€yS{yQwnWvg_bsUeoZjobjmfk{gwofizldhkshpmr_slcrhhvmpi`liTmjL^nO_eQc_TTdSY]Y`]^QlXOh[VgYbaUfpUacJsoVinH[ePneEelOmgH}gDreLrfXwrYwQl}R}z^rs]|vRvh^xkVu[PjaPyWW„T^ƒOaˆU]~T^ŒO`ŠR[‡Vc}ZhŒ\i…[b‰Na‚^hƒZqvZbx^hƒ^W‰j^~gXƒb`„i^€a]ŽkUn]gUŽlYm\_O›bT O\’RU—_[™^RiV™]Y¢iZ¢\K¦SC„SN„\P«eHŖZH„\H QP›JB¤FB R/¢L1¦V/“^"ŖN%¬U(»J+µA/²K3°L<“L1·K@¾EGøOC»T?®W<®J8²N>¶QG“UH²IU²R[²S[æah¾Zn·lcĮoaĆkfĀ]r·[ĮWyĀf…¶ct¦k‚®o}£fŠ£gz„h„Øhƒj€”qrœps¢gk oh®cl¹jn®ao­Zf²Qg³^p³_k¹^p°WmØKv®I{©PwŖVo¤_q§[u¬X} \„„Sy¤f„•l…œb‰—_ƒ›h t‘ds¦mq©kq²ym­~o„z}¦z…Øw‚ž}s©}t§~y”ot¢h~›rˆ£n‡¬n£u‹¢j‰’a–‹]””\”Z“’]‘—h›h†Ž\‹]’bˆm‚“g}†bŠdt‚g}…qƒzh€tl‰zl‚uj…xb‚r]~{a†}_‰`‚‰dƒˆg^~—g†h|šo€g’’h—t””t”oˆ™u…”n‹žfŸ[‹—^‡ˆ[’‰[ ~c ƒa¬‚i±^­—^©›_±œdÆ”i®¤]«ŖhŖ«eŸ¬`¤„d—žf’™j¤d’§k“„\™„\„\”˜SŽšZ†•V‡‰MŠŠNƒ…S€[„‹N„R~ˆXƒ€Uz‚NwRorOjyRdpM`tM`yMi}XpxSk{^g{nlvponhqweqrmwtmrntn^qvZmkNcfS[_HWcNVdZ^^[[^\RgMTiTWfOXaPViRekUbkGlrøRC±IG³M<§KD¬@D®=E³FM·HP¹Ja¾Pb½[e¾XjĒfoŃ\rŹ_jÉWrŗRzæZ~æZ|¶`y®f|«b‚®g‡²dˆ³i}±_‡¤e€¢r€žmvml„jn²fkµdnµak“OvæTw¼]r¶Up¶^pÆ]g­Vm®Qo£G{°H€¬Ux®S€°Q{”]t ]|]‹›_‰”f€’`ƒœn†™r‹kq°cq²lk²pw„npŖvq­zsŸs{œo}©mÆwn dƒ§r¤rƒŖnˆ¤q—kˆ¤l„Ÿ_Ž™aŠX“žT’cŒ“q„b’œV‚˜`„›\z^}’jƒ“awƒZtjƒ}oˆ†^}uh€uiŒ†d€b|yW€Wx‡Q‚„b‘`ˆ‹az‹g‹‘^ƒš_‡hŒ”d‡ mŽ•{‹™{ˆ”j…£iŠ§n› bŒ”j‹‘e—c–ša ‘cœŒa¤”føl±’_Ŗ•X·˜^ø„]®Ø`©„aŸ¢_Ÿ°g„Y”­f”¤a–ØXŽ¢W’Øb„¬YŽžY‡ Y˜›]‘—_‰”[‡‡[ƒ‹Q‚„TˆŒR‡ŒRq‹ZsKoŒIjJomLlnUlvShrMgnYbu_j‚T^yYachygjjalm`mflsmkobll]qhVppXjlNgbPO]\VaVRcaLfU[sTWkRcgRVoXYeJanTecDafDlnMjiCmg@l^OgeTofYqeZkiXnbQsl]tkUniTrs[qkVxgXuXUvbR†]`ŒSd}V`uT[‚U`XqXmXq„U^‡\eŒUkUj‡Re‘Z\†\d…Xg~eTdF‡_S}YVˆWP‚R^ˆRb“X_”^_šbS‘\`—Y`¢`[šKcšYW£[R c\‹ZS•_VŸbJ§RG­OH®MI±ZF¤UB¶SJ®[F­GB­JM HB¬DCøH5§H>¢O;§U1¶K4°O-¶N5¹@5æH9¾IHČJ=¼@C¾D=¹K=ĄB>½G<øHDÆMA¹LGÆPQ®@[ĄPb¼]eŗTfĻa`ĘXcĀ^k¹_rĒJpµY}¾S‚ø]v“Z{“g|“]Œ¹e€¼_~“[ˆ°lŒ°j…¢m} f}®Yz³[m±]x¹Xv“Mu­Vn²Ww¼Ws³Ws°Ss®Uy±UvM„ J…ø[‚ÆS{øO‚„]w¬f}¤^Ž•^‡ Uƒ”e~–hŽ«i“ju©fh±mtŖf{¤lm©km©el¬m|¦s|¢uq«hy¢c‚Ŗi†„eŠ«g“®m–„jŽœh‡£`‡®U‘ØO“ŸW–gœ˜j—¤`ŒŖ[ƒ¤dž]}Ÿ\‡—g‰‘`‚ŒZwb…ƒ_‚„W…y_„~[~ƒX|‡RƒŠ]z€W{…SŠ[~ŠY{”]}”b‰‰b‹Ž`’Y|c„£u„¢wŽ˜xŽ r“ j›„a›”fžžo›“p©˜l¦™p¤•b£—`„”h­Že°˜`µ—T¹¢Y¶©b°”e Ød®Ÿb®¢d¢§U›ŖO££X ØUš¢QŠ©_†”`ˆ¢Y˜W‘“^‰ŒVŒU…ƒYƒ]ŠV‹•R†‰Kp„LpŽRp‡Qv…JoxQu~WjxSt|LoqSp}\_€Sg‡[_‚]Ypg^ohWpjajn_nmjco`[kdafkTifU^_VV[ZY\\Q\bZfVSmVVqV_jW^nUcgO`eTldJp`FbiSffIksFfoIk_Zn_biaXs]YtZ[ud[|mVkfKk^Qs`Tm\_tYW€\\€^Y…Pb„MfvJZuRa|Th„Hf„Mm‰Zg~YcxX`‚\iYcR\‡Xab]‡eT†_KWN‰^P‰U^ŠNZˆK]”XY˜]_—VZžWi \fŸM[£L`ŸX[ØZT™dW–^SžWQ RSžLIØIMŖIQÆIG°US°WPÆGI°FE£=EŸ>H­FAµA0«B2„H8²U;±Q3ĄW@æLA¼VC¼QI¼F;ÅA>Å=C»?BøDF½>IÉJBĆGIĀAKøGK·?]“F]»I\¼NiČSlĘKaŗMh¼YgĘZiÄQwøL‚“Q}·VxĄX{®c«]ˆµ[†»W†Ą]†³c‡°b³ez®`u«W{®QŖJv¦Jr®Co¬Gm«XxµX²Z~ŗPx·RyÆSužDØKz³T„½O¹J~³^ƒ­`† X‹›W•ŸR†ŸZ†¢]Œ¬b–etØev§_}”\}©cxŸhj“ps¬nx£r{­s{³fy³c„Ø\ŒÆg“„d…Æk’Ŗ`Æ_°_“«U›¶O•”U›­WŸ£k”œbŒœZ‡œcØfŠ¤[~n†‹XŒŽa…”a…‰]’‹\…†i‹ƒbˆ„^~Z…ŠTŠŒ_}‰[…ŽQŠXˆ•e‹g„Žc˜c‚œaŽ eŽŸm r¢k‘”jž›`—©ežžkšm› m«¢o¤‘iŖ•j­”f”’n§›e±–c“Ÿe¬¢\“²VŖ¦Q³§\Ø W©©PØ©R¦®UŖ­R„°OœL„QžUšWŽŸ\”’SŠ–Uƒ‹W~ˆZŠ‰MZ…ŠN‚ŒSo’Sw’Sn‹ClŠPo€MdxYhtSpuR_~W_ƒf^‰W]‹be^_~mYqi^r_hwekitnhike^nbdbgn`]bcTacbV[XYk`^kcaeV\kSZ]_X`Y_]LggMmeIj_KjqRgoMbeIq_OjgWt\PnaXq^WtUYx[Uw[SocRpVOqPOsOSsZ\tZU}SY|T[†U[yISwP\TeuJlzFm|Gk‚SgyZg{a[\\„Zb‰Uai`…^TŠ]U‚`LŠOTƒU[ŽVb‹[X”S`–Q`”JeŖPb©Z_§I\®IX¢PVœYU„RU˜QS§ZY£TO¬KFØSUØES¶PI±WHÆQV¬KR²BC±DN¢C@©?;­J5©I7³A7©S8³O7ŗJCĮK9æK@ĆNGĆQD¹IBø?F¶EBĘHR»;PøGM½DBĒAB²AN¾ANÆK]æCYĀE[ĢIkŃDf¼J`ĘOcĆUjČUw½Wu¹Zm“NqĒSy“Q…²WŠ»[~¼a·\Ž¾\ˆæf…µ_}ĀWx¾Uu¹V{§Ss„LrØ>i·IzÆLv©Lx±T|°L|²Tp§Kt¦Ls°N¬MtŗJtøQ|«M†³[Ž¬aŽ›]”©aŽŸV‹¦^Š²Y–q«ozØo{§by¤iu„dp®d{·kw®czµl|¶]z½\³\‰§W¬V”¦XŠ®]Ž¦\–­R”µY™“V øY”¬`“ØZ•„b†„`‡¢Y”b‡”\‰˜cg–_i‹ƒb‰\…ˆa‰ƒc‰Y‚ŠTˆˆW‰‰XŽ€U†„O‡TˆŒb„…dˆˆf“i‹™`Žšg‰˜e‰„r™ o Ÿa§Ÿg¬˜c¤¢c”¢mاn©¢nƙn«a«ži­šd© f¤Ŗc©«_¤¤W®«N¬„KµTµŸS©¤M­¢O§¢W¦¤Q„¦Q“žX‘aŽ£X™Y‹]†ŒT‡V‚ˆQ|ˆV}ŽP‚’Q[‚“Vy˜In”KkMt‘EpƒGd„Si}Tgz__~\V„_Y†Xb€_`bdkbmhyaeznaijeildaakdfmdf`ckg[eca[djWlg]nWa`We_Q^`YY]V[bYhiXffQddSdgJjhHjhOf]OlbMp[Mr`Ys\Xh\Zm[WpYXgP]fSPbRXkMWhJYkK^uQ_{PbTc‚R]{DZ|F^wKU{K]ƒTXMbƒZhƒW]ƒb_Š\ZeR‹eR…hLˆ`R‰[LNO‰TL‹QZŒS^W[—OW¤L_ØF_ÆNV«Cd­Ia¦EcžK_¢VV£OR„NUÆQJøSHÆKM®J[øNW±UO³LN¶HMµLIµIF®EC¹D;“L8“L9±I5­JD­FBµH@øSAÄK>ĆPIĒTN¾FM½?U½CSÉFQĆ=Gŗh‰Hh}Lf…N^ƒRf^\Š\S‚d_~c[zc^†i]†\\zc\id`fbjYhc`_ejeg\Zc^`ZVbdW^jWTjcTka`bUfcM^aQa^[icRa\PciZ\gVe^BefBmbHs\UnYRmfVv`_u^Sj^VuZ^l_Vga^jVTjU\AUvI[mAcoKV‡Zf|LaˆS\zGb|KY‡Ni‰HiˆUkMa‡L[ŽUT†^P‹iZ‡cPˆZZ…`]}[Z[LWPŒ\SˆK\ŠWQˆ]]VbžP\¢GUŖUUžQV¬DZŸOg˜Lb–LQ”RI©TH§KQ²LH®JF©@U«JI­ET²ILŗGJ°GF¬?L±C<«K?­B8„Q;±E0“K>³K8·D;æT?ÅENĮCQČRRŗLL¼MGĘHUĒ@KĀDBŹDBøAE·F>¼DNĮ:F½FT¾IW¼<^ÅHbÅGX¾T\ĄQg¶MfŗIj³MoøRsøNt¹Yv¼\r·S€Ø\y³Z®[€²Sƒ¼Y‡Ę]¾Lt¶X|¶WpøSo¼Lj²Cs±=zĮLt°Ds¹RzøS·GuµVŖS}¬NzŖSuÆT³N…²L‚©S„£Y˜[ˆ§dˆŖ^’§g•¢i•oz«s~£oƒ§b|¦cŸou¢t¤kŸeƒ”iyØhØa~§]„ÆR‰°Lˆ§G­L§Y˜¦V›Æ]Ž¦gœ©eŸ«oœ„kžÆjšØ`•Ÿj”ši‚šg|”YœS‚™^““]…“]‚•^…‘_‰g‰Že‰ƒ`‰S„•_‚—Z‚‡O‹N†˜P‚ŒSƒ‹_„ˆZ€‹[`šœe”Ÿe˜`Ÿ›fžl؜eƝZ®•_°œZ§žd¬§g„ž`؞h¬˜n„Ÿhؘh©œ_„§]²¢\«£_±”T¢”U¢•QŖQ¦•Z¢–Vž—N™ŸQ–—W—”U›–Y—“WžTˆa‰ŽX‹‹]Š[ƒ‘Uw‘[p†Ou‡Fs„Dy€>n~HiŠJ`ˆV^†QcŠMl†UiŒb[‚`f€`exb`}]Z}dZph_gbX_k]XedVX`daagYY^[NZeTQ[YL]mXYlWX_Tca\edS`cOkW[d^Vi`WgWQ]^J][BlZHlWLz_X~bbz]_qbZp[ThUTk`Pw]TvW_wVUFPsE^uB[xP^‚R\†SWˆJ^~SZ€Lc‚Ga‹KfVo‡QfZcŠRX„WUŠdTŠYVy]\xbTcTƒjR‚`TŠXRQOJ[ŠRXŒJ[ŸJX”LZ•Xa˜ScžJcšGY˜L\O]•LO›OK”CF”DH§>J7L¢@J«HX¹MU²JGµ:@³C;§>D£F:ŖH@ŸB8¢E8±D2±F7·O:¾FIĘLFĮBM½NR¼LI¹BIĀFLČGOÄHDĀMM¾JI·PČCXĆ=T¼JV¹GZ»J`±Q_ŗGf±JkØEn­Pv¶Pl“SoŖTm­Y{®Ut­T}¬Ry²S}ĄVæY{ŗMq³Qu¹Kq½LvµQn³In²GøBƒ¼F~ŗM¬Nx­By“Qp­OsŖHo¶Rv©Pu„OØMƒŖZƒžX„›Y‰œT¤WŸT–©b•u‰±m‰¤k…¬`{«b¬msžb†£d„šp„¤f{¦]‚¦f{²V‚²V~±KŠ¬A‹ŖN©^•„Y„Yš°e«cجj›¢nŸ«k›­]‘ b•„fŠb“_‡“g…šaˆŽe„ˆm‡•k~—\„…]‹’^Ž’\‚™Rƒ”R‹ŽQ|LŽMˆ˜L•O€’Sˆ]Š‰^—’i£Ÿi˜Ÿa¢šcØ„]°¢d¬—b§—`“„`±¦^„”Z ®hŖd§—k¦št©“mž‘hŖ”b±—`Ŗ”bµ„X¤š^ž”c£—QŖ–MŽK£‘M¤™W••X›™Z“Ÿ\’–V——X™™ZŠžiŠ‘Z‡…L„ŠH{‹L{’P„Sy€L€Gn|VvyWmzQb‚TZ~Nb‚JlˆNa`e|ahvS`yX\r\]v[Unlb_c\ejYV`Y]QZR_WSTPZRYS]NSeYXcdQZeQg`VagYflUlb[bUSc\_h_SiaG`WRiUTnULqXXpa[XTy\X~Q\t\W{^[va^nP[qT[~EW€NU‚?XI`zK`}G^|U^ŠTh„JYTkƒWaŽSj„HoŽFnŠKcMP]Z€cW[XaZX[€\Z~XS‚^a}P[„XYŒYR†P[™\UY[”MX“TcŸHd”Qj Q\’RP”MT‘TP•NIšMLØHJŸFGŸIH”IN£=VµMR“=Hµ4RØ>G³7I¦:LØ>P MEØDJØPF°R@»IL“KM“DQĀ@Q½AJ¶NUÄEBĖFG¼HAĆPDĘKOĀLQø=QĒ@Jŗ:TÅJQĀHMĄT¼EYĮFVæJYŗR[³Hk®Dk¹Nj¶[t¬Ww­Ty„Qz§_‚Æ^~ØR…­T‚²N|·Kƒ½HzµL{¬H€²P†­[‹¶[„ø^~ĀR}ÄT}¼DĘF„¾DŒ¾Eˆ®;Š­<†°G{²AtÆLx“N„¬P€²Q|ÆI¤X}ØWŸ^†¤g†”dš¤ižcŠ±p«`ˆ«p|¬n¬nˆØb†žhŒž_’ž[„¦cŠ¬X†«R|¢[Š­Yƒ©M„[‰ Q—”S”œQŽ«e› l•¬iŸ„e›Ÿdš­g–„dŠe„¢pyowšgƒV‚ay›f~–b‹a—h€Ž[†ž`’•[„ Y‚œXƒŽK€—]ŒŒR‡–Wz†Yƒ‡e„Ž`›XŸZ™‘U–žX„§S©Ÿe¬ tØŖb¬¢h¦[„«b¤_¢©\§™h“h‘lŸ—i°V©”W“œTŸ]›šažš^ؙ_ž›K›”Pš‰J””[ O››_œ k•g—b— b€”`€‘T‡—T†’D{J~ŽPx|FƒNv„WqUm}`hxUf{`_Z\~Q`T]ƒV`|Ri{UfiR[fUedXUbQUbSTed[]b[^aLQQTQTJUOGK`OGd^Sc]S]ZU`iO]iTbfZ`gXhjLhWLrSEh^LcVVjTXaZTg_YrZXn`UxWTy[MrUSw\Xq]X|P_xEW{GS}TM€JL€HJ„GUS`„M`ŠTd’WkJ_ŒV`ŽChŒU^•U[’RSPPŒZVVY†cJyXH~YT}XO~]Z~P[€U]‰U^†__“dI•f]Šj_•_ZœRVšN\¢YY”PR™MI›MM˜HS LT˜9M IE—BN§ANØE±GS¹KP¼ES»QYŗATĄAP¾HF¼PT½H[¶URŗSWĆHbĀH\¹Pn°Hs­HpÆHj«JoŖNu§Jw±S}°X† MˆØS§KˆÆM‡¬O€ØC…®M}»M‡ÆV‚¹Y¶L{Į[ĘI~æEŽµH‡æF•°Gˆ°?ŠŗA†³K|¬Pˆ±SxØZµ`ƒÆQ‰¬R±W‹·f‰µh‹¬h’±`šœo£eš¢h˜£a‰­eˆ¬hŠŖm–£r”§g•¦[”WŽ¦\ØZ|¬]zØO…«[ŒžV†œ[ŒŸT—”R”Y•¢]• q l„dŸØrš¤t‰¤q} izžd€žjx›h€”\ƒ”d~”\}‘Sy–Z„›d’g‹“`•Y ^šS~˜S€•U’S’[‡‹X}c‚‘]„‘X‘›Z™šQ’˜V–œ]¢„k§n£¬qœ b¢˜_•]„¢a”§XŖ”^¤–` •d¤eƛV®•VƎV®\£–Z„S¢˜JœO™’T T Ž\ XŸš]Ÿ˜l–eš™[’•m‹—m{š_€˜Z€”PzC|ˆ>{…Hy{Vo€Zqz[l~_cz^T|aV‰PV{P_zT\vT_zSbqSfg`[o]alY`nNb_Q]cYYWaPWaJ\SGUUHMcOIbOO_SU`XVb_YZZPYfVWdKihToeMv]St[Hh^HfXPb`Yg\[vW_tcUn^QndQpdSsdMvlYoc[tbO„OO‚HS‚NO†VL‹YR”\R‹MRˆV[ŒNc„IhŒM^DY‰HY—VP–RV‘WSW\„VX…aS}VQ†[K„bI…_S}]N‚US†]`‹^cX`‹[Q’eRe`W[–VZ¢QWŸU[„LT›FKšAHHI›GO£9OšFCœFB DHŖAQ©9T¤6G£7O¢8M¤GI¤HP™KKžJF–RJ›LK›KU¬PS“CM¼?Q¾F]¹C^¶@T»MW·BP²>TÆCN­IN­MN“LU“DV¾DN»KFÄKJÄHQ½SZŗU_¹Md·Ki¼Na½Aj­Ds¬?k“IhµKn¦R¬PŽØKŸK†GØN¤Gˆ B~§Iƒ²K{·J}¶C‡¹I‚ÅY‚ĒZ{ĆPzĒR€æV·J“øE½Cƒ¹Pˆ¶MŠøR‚³Q‚ÆY±d…Æb•¶W”Į]”»e‹ŗjŽ¶f§^¤d™^“mœl–­i®d•«qžØl› c”¤k’­b›¬Q†°]ŠŖMˆ°LˆŖQƒ£Z‡£YŠ\—‘U›ž_‰•a‡Ÿp„dŽ¢d£˜ge”c„§jm‚›oy©b¢kx§e{˜b€“Z†Y„ŸX†•ca{¢`†šU†¢Lvš^‡’X“X•‹T“~bˆa…•Y‰ZŽ”NŽšX‹_ž¢Z™”[š jŸ¤a¦¦g„”i¦ž]£”S ža°šZؒdؑ]”•b°a©’UƇ^«“d¦ŽS”•X©ŽX¢•S¤’ZœƒV„ŒVž‹\™™_–‹m•j‰‘h•–n†”nv\}™dr˜NuˆGn‡Th‹WtXe\oˆVn~Y[~]Uƒi[„TYJb}X[€S_pNghKfcV_kb]aRhaVeXT[bRLZ]OPZE\Z@KWJNfPO`KMcQPbOVgPSiSV]]K[eQ]fMt`Fs_Vs[WjZUcaQmUSn^XwhPg^Pk^SsgOlbRwaOp_KsaZycSwdN„]R…QJ„_F‘[RŠMQ‡GN‘NY–GX’T[“R\’L[…UOWW™VX™^N–bQ‰^PkOƒfZ…WQ|YKzeZ†eU|bT‰b_…^]Š]`—ZK”]V–^T˜VV‰P[“PU„V^£NK£IJ•ND˜BM”GJ”4GØ@@”HE£AL¤8WŸ@Q›>R£”E‚­E‰³S‡±T~½U‰½M†ĆU‹ÉO‚ÅX{ÅNƒĘOŠ°K½Q‚¼P€øS…¶P‘ĮTŒ±d•·`‘²b‹ŗfµg’Ć^—¼hµjšµh’±cœ±Z”]Ÿ™h¢n «pš©r—°h”Æf—²p™§i””b˜¤Y”§S‹«[Š©W‘ K›¤N”˜P—V˜_‰–k‰p‚˜e†—r””q—™k•œb”\ŒØg|¦c„ c‚«^­iy gu£h~šc’a•]‰œV•_—Y‚£\|›U}•a†•\Œ‹R‰QŽ[ˆY‹‹^’ƒZ•Š[œŠY‘‘Y›S”™YŸØ_«¦aÆ©g©ž]©—]§–_°•]¬”U®V¤[“T²‹^؄`Ǝf«Že«•aؑXŖŽQ ’[ž‰^›~[£„a‰a¤‘aœ‰f“d‘‰e‰“_ŠŽg|ˆkz‡drŠ^w‚Ql…Zn‹baa^_iŽ`fcY’lT„gZ‡fT‡UY|MWrTTvNXySblZllVg\^b[]W[ZZ_VKX_NV[KTYQR^GOjFNeSQnOKeOMaNSiORhYH_[LkUSgZLqdRs\Vi^QjZVnSWrXXsgSkfNmgYucYogNniRjmStaRseUvjY~gV_QŠ`IUHIUJP’EQ–PT”X]“OZ‹Z]VR’VR•[T˜\TlQ‘nRjZ„]V]Q|_Qe[Š`b…jYŽa`…hb‘lV’aT]T“_VWMYOšTU™JS£IV¢DL¦FMžCH„CDšT©6\«;g“>]¶9d²A^µGdŗ>c“CY¬CYµATµCP³?MŗBKŗHR¾MK½NQ»KSÆMR©SM©RX±KVµGb¬>a¬El£=g©Fl£Mm P}„D}œI‰œF“G‚‘Ež@¬>Š«LŠÆR€±L€½MæSæY¾NŠæRÄN‰¶L·Jˆ¼VĮ[†»VĀ]‰ĀbŽŗf˜±_•·f“³dæj¼j™¾m˜µkœÆd±b’Æa•b”cš©mšŖušÆlš°n££wœ¦pŖvŒ§`—Ÿe‘Ø_Š¢[ˆ©P‘¤W˜˜C——[•”`£—Zoˆ’_Žk—™nžžq¤g•›b”§ežot›oƒ©r¢a{Øds•lƒŸ`{a–b‚¦d‰”Y”_‚©Z‚¤Xˆ¦UwžX–W‚š^„ŽXŒ~_‰W‚“Vƒ’N˜—Y‘–P˜œ]™T’„V¢œT„¢d³œf²˜X¬“U¶žP§’T­‡X®T«N¢‘I¶VƂ]“Žh©•]§R©–Y©‹U©ZŸ…b ‘d؂_§Z‘Œf’ˆ^ŒZ–f‚‹Y}_ƒ†ixdsUv†QqwT_„fWY^c^ƒeg``‡bPj`„aWˆYMu`]wV[mXapZ]i_\gZgUYbTTNSPU][IYQHOYTDaGOWGGZNJlQPbPVcSIdUJ_NSfNSbXOn_KkUQrdUsh[u]UgYVvRNnXV|[OpVS|aVx\_tXUq[Vm^WnaXvj[}jS‰[RƒfD†TT–HE“LI„MT•QO‰SL…ZR†ZR_UŽ`K’dKWL˜cY™cQŽganT’l]Œg\‹^S‰[]Š]d~h\{adŒqb[V„]O]T‹^]_]–^XXS•OUJQ“BLœKEšAF–=@’7N”6D—>D¢2W©?K¦DJØW1LŸ5P;UœCZŸEe˜Hb’=b¦IZŖ7T§9[„K^“I\µ8i±D^­Ec³Bgŗ>^¹9S®EU¹GZÆJP±CL·CS¾EYĆ>[ØBT«N]©E`©Nc²S^­HX©Q˜KJŸHOØ;U£3W™Z¤?b I\¤CcÆEgµEm“Ge²F]Æ9Y­Cb®@Zŗ=R¶KXÆ>TÆ@V¼?\·ŽŖE“²S“ÆQ‚«KŒ°K­JŒ­M‚­Oƒ»Q‚ĀLŽ¼W‘°VŽµY~³XŒ»]ˆø]”²U˜±[¢¹bœ³n˜³h¶p—Æp‘­f¤µe„¶h ¦i¢«^ ®\X؞U c¦©e˜µa“«l“„m—v’ j’„l•c•ž_•Ø\•¬`‘ŖO’¢Pž^¤¤\©™c¦™b™›_¢–f¢›p”™kœ¢rŒ™oŽ¦k‚£i€ o|–vsžg|šebt›aƒ“g‡„n„ j†žkŽžg‚¢^ˆ«_…žY}¢X†”aˆ‘_œcŒˆi€–f†\ˆSˆ•R‰”TœQ•›H›«Q­¬XµŸTƖW±RŖ”T±“NƉLƗP“…A²‚H„ŠJƒU¬“Y«“SƋ`­•aƕQ¦ŠWŖŒ`¢„b©[„c•Œeˆ[Œ‚f—’[•„[”‚_“R}“]vˆVo‰Qf†X`„Zf†\Y‰hS€iU†[T\^„_P‡iS‡eS{l_uXVlaSk[de\VkbYVSQQTRMZXHPOP^PSULTK[@VZN^OJaO?jHJgPL`WObWHoKJlZDuMJj]Ujb`vaXo`NoXUkWSr\[v\Rn`_€QZsUSMV~YUy[ZwRZ|_P‚YR†NK‡`C„^A‚ZIHUŒFTŒQKŠKO†OAˆ_I|YL^N‡mR‘_JšbEŸbU–cQ”pW‘fXˆaP‘m[ˆ[ZS^‹^Y{gaƒg[’jXŠcQ~aRTa•V]SRYM”MJ‹VFSM‹J?KIJE“JG‘HMW˜7[›:S 6V•9YŸG`=ZC]C_IV”EU˜HbœLX¤Jb„Ae¦>aŖD^«<`µXŽ@O’EVš>[™CW“Cc˜C]Œ>_šAe˜FY‘MX˜Qa’J`œI\©Kg¦y­Fy¦B|ØH}§J~šL˜B‹•<‚›?ˆ J•­P‘²L·SŒ¹^’®Y“ŖX‹®K„¶Mƒ¶P‰°RØ]Š«WŠ„[…§g‡Ŗa“Æf•“YŖ]¢«`„¦fœ£bœžZ™c©fŖ„e„¢c Æd¤­`™¬P”X¤¢Vž«V™ž[š­a˜¬kš¦b£«p§±s ­p— m‘„]™ÆdŸe”©cž¢^ žXž£W›•P”R”«V©¦]£š\¢šlŸ–q™m’žfƒ¢h}œuyœjt“g~“i†•cƒ–hxØn†©l~Ŗq„›rz£l‰œg”eƒ›e‹§gˆ„h’ hŒ˜\€ŽW€–i£d‡šN”™[’˜Rš“U˜V”žP­—HµœL±›RµL¼ˆX°šXƐOøŠK®…C·…E“ˆJ ˜W£S„^­‹NؑS¤†R¦†]Ŗ_©€d£W”~h–€^‹‚h”…Z—d’Z€\’[‚…X{…bzŽ]o‡\bƒTdˆ_f…`Z‚pUzhN‡eO}cR]V]^zgWybci]]qd]f\fRaZT\]U]UTjTP`WL\QMbSMZQO_QGQM=_PAhQI_RDhNU`YNmNSbPLlMNq[ZlOMvTOl]Tg\QrfWf`TbeOiQR|YH~MGŠUK}MUyKNƒVN{SG‚NN‡YMX@RK|ZR‰XIPN“FO‰U@PE“^B‚d?lG€kF‡cA“tPvP˜fM–gW‹iQ‹eUZO”]]ŽWX‡aXUX†eW™ZIŠVWŠTY’UR˜W_†XLQSZB†T>…]K„^HŠW>UCŠYCOF‰KE>QŠEGJPŒHYšCW˜>OžF_”F_žFWž·H²ˆE®“NŗV¹ŒO±…W²‡N­ˆP¦‰C¤N§‘S«“I£ŽO«‹T­S²‹S·„a®c |Z }Xœ€^a”‰c”„]ƒ”Xƒ–\v–\t†ZkŽah’esˆWm}[j~]_‚kQwtQqmKoeQ|eVz]W€c[zcWmb`c_febcZnd\ic^^`X^`UjTTdVCeMBgP?hRBgIDVOCaNFeRL_JJcOT\QV`PW]Y[iTUkVNnLLrNYlSVxZQvcZvdZgYRlWKzXKˆ\C‰RGDG…GJwHFzVLŠSI‰_E„\@‰X@~OI‚PM†LH•HBG=”RA‘a?‘f?‰]@†a>gD”oF–jM“iSŒbaŠe`‘^T‡WR“`Yd]•[`Œ`V‹dU—WFŠSE†WRQQ‘WU]V\QˆSANB‚Y9‘X>—WKYJTJPAˆ?Gˆ>I‰?M—EU‹GUGYGVŸLd–Q^–L`–E_—GfŒG_…8i•6o“=lk™Fo =oØ8n„Ch¬>^Æ;e±FZ¢I]©8]¢4c§?dŸ;hŖ?t©Hq°DtŖAr§>i¦3m¤>nŸCo§CsFl›;w”8v“9z•@‡”>ŽŸ@Ž©L”±SŽØL“„UŽ”S‡”P‹©M‘¤H•ØO‘¤X‚¤T£PŽ›R…X‹ŸYš­[—Ŗ_’§jŽ `Œžb•§f•Ŗo¢«b™a——d¤ŸX®¤T¬¤V Æ^˜“W™d™Ød¤©i˜¢h”šg« n«°q”®r «n £q”Ŗh”°d„Ŗh£ [”„U„¤a«ŸO™I¤ U¦šP©„X¢£bšœe—™[Œ‘kˆšn’¢fƒ’nx’i{špx–js›mr£r…¦t{•o£wy›hƒ›e„¦c„žb£dŖ]|Ø`|¤b…ž`‘d†Œ_ˆ‘a’¦U”—Zœ‘S˜˜E–‹R›‡A£˜D£–M¦Ž=¬Œ<½„I“ƒH·@ŗ‚Bø‡KøI­~K“ƒB­Œ@„ŠS±ŽC¦…I·†F°’Q±ŒQ®†]·ŒY؇Wž‡g‘‰X˜Š\”b”d’_‡‘`‚…g|ˆdl”Ul–_rƒWf|[l_hxd\tsUufTslZ~oX\_th[ke[ggUnjkflbbhjYpZQbfTfdYdTWpRVoZNh[ClNH^PI_MF^LQhKPiRQcSPgLQdVZmU[h\XlVGvVKjWUjHZwPXveSj[YnQJqTDoXCzQKŽKK~LK‰PKƒKS}\I…QH‡g@SB‡\:~^M†MKTFRGŠV?P9˜P@[FŽfHŽi=‡a@‰hK™oJ’i\˜`^Ža\…c[‡SM‡dY†hZ‡^Z’WXSKžRG“QGŒXH‘OKŒ]R‰RP€TAˆZFˆO;‡S?T@‰[AŽTO‰VO’KH‡FEŽFMPU‘IUTU‰P\”GXšK`—EeR_DqŸAl“Dn‘=s”@iŒIg‡KyAp—Ai£Ic˜Dv›JuØLtœEc >^©5h¢=`Kb«Ah @rŸCk˜:gžKy„=l©7x£?r2m¦/m›1s™CeœEu=v§9t›9s¦:|•9Œž7«=‹§A±O‘£P”­VŽŸU’œU’¢M‡¦JžW†”T”R‚¦WŽŸ`Œ \‘°[²kŽ¬d•¬l†„j›¤h§ež¤iŸŖršœp‘”g¢„T¬„[­”a¢©[Ø“N©m’„`™Ŗj˜®cŸ£gÆ¢b­Øc®©mØ°pœ°pœ¬s˜©d£­]«”^®”W±š[Ŗ U°—S±šQ­SØ£N„„X¢ W—„c‘˜c–œfŠ›^‰že|˜]vžau’pœrx›wvt€t{Øqx”rzk†g~¢_‡¤d‡™a„›eŠ d˜g{Ÿi€•h‚˜_‘œ`˜žU’ŽYŒ„P“ˆH›ˆBF¬‹H¬…B¶‹<¼…7“€B¹†D²€D¼€L»}Gµ„?ؐD©ŠF«J«~P؉D±ŽQ·…QƌY¬‰V²‡^Ŗ€d¦†aŸ‚_“…aeŽ^Ž‡g€…_€auat‘Xj–dgˆ`hˆngnhxw_xn^rgSkoRur]vkXqiXpvSml__rcUq_`ga[ifYoZRu]WkbWlgIs[KkNFiRKaLIdKFiUEaNNfGNiNQrPQlSKuZKrVQjaGpZNjVWqNZwZVxUMvOJuYP{ORrNFxE@LFŠDD…GC‹JF†STŒaK]D„`=ˆWC‰RKXE…OJ‡WA”W>“O@”V=ZF„Z=‰j@‚pG‹iDŒbR“gT˜[V[Z’^]‰UVŽ^_c]XP—XOOV”WN•SPˆ^A‹U>„TD…TJŽO@ŠM=…QEW8‘X<^ISH‹JQŽNK”HM–PD‘[LUW•R[‘OY’Dc–E\Ÿ@h™Gg’8m•:t›5p?n‰@kˆEs’;j’cJc¦Dg£LhžBoAz›Ew©Ao§AxŸ@¤2~§7|1qŸ,p”4h“1g™:o˜Ao¢m˜7hœ2mBx C‚Ø@‚³It±H{¢O{ŖJ~°GžG’§AŸPŽ•V…I€ŖY¦U‡ŖUŒœd‡œZ«eˆ³h­`—§c­d¦h“k§l”Ŗdš®h“§a ŖY®§ZÆ©eŖ³ZØØP¬oØŖož©mœ¤t¦›q«¬g©Æm„Øy§°k­­d£Æb–Ŗp˜Æq™“n”°iŖ§c·Ŗaø„\“¦]®«cž°k±d‘¤a… o…™a…•Y…^•edzŸf~•fz^{›mw™j|”c‡¤jƒ¬k†ÆZ†¬eŠµe’ÆdØj‡¤a~šd•^ƒ—]ˆd£j˜dœ“dž—]•ˆY‘‰N”†L¢ŒR¬‰GŖ†T¦‹R°T±„G¶xM¶C·ŠMæ|Mø|LƄG،C؏B¤†;~Cš€@—†I£…R£Už†S“„_—Žl—g‘ŒX„ˆZˆ“X’cƒf}‘Zq‹Tk•Za’bkŽ[l[b†lX~qf„qb~o^{^WvcUknZeg`jkVlsPdsRcnMYePNcYPgYNtUJsUOqWSr^QkOChI?_ICVQBgONpERtCDuIEyFKlONmLKyZXmYKhPMoIPoNYxWZyUU|QTpSYl]Zw[IzNGƒPBŒS@P?”QQ‡VYŒSP‚K>ƒS>…`7€]F‡bEŠj>„c=‘W>“[@QB‚QF…VT‹gR„cOcD‚gRˆ[OŠaU‰eL„mV€hV‰`NŽcT’l`ŠhZ’eUŽaP†]QŠ^TƒaP{XBx];€`EƒV:€S;{IG€MR€FVŠMJSHƒHH€DTˆIRLQ€F[SS„PZ‰Ng˜EbšF_˜IdžLa™BbšNe—Mr“FqGs“OožHižDn‘>~…kGZA‰Z?Ž]@Šb;^?{OO{RSƒfX€aS]FƒYI‚iJ…ZEzfHŠfRˆnL…fRfKŒgYŽp_ŽgXŠe]ˆb]Œ\U|^JZIeCfN‡aL„\FO=~LK„SH{PKVKZP…RS…AI‚IQ‚HQƒO[PT€UV‡Sf•P^•Rl›FdŒG^šPkSo—Mz‘Km™Rg•Hr”ApŽ:„’E„”E}™Lx˜Ks˜Np¢LmJo•Io‰Ru…LpœNo›Kz—Epœ0u3|•<}§:„(‚Ø'†¦'š0x=t‘:{šE”4w„5{”5|©;ƒ¤{AA{@G>Nƒ@QsIXkKToSQoLPuPYmPOxVPnGIxM>w]B„\K„_G|RA}TCƒMJŒGF}QG„R9|\A‚^=ƒd@Šd=Š\G’kK…hC†`G‰YIXOzcQv`SxZUx]E…ZR„gK†kD}`SwkMydK„nW‹zT‡|M{XvN‹u`‚c`‚d]…sK„kP{kO„cVeQ‘`F|RL}VAp\K`K}]Mˆ[_|YS…SW‚NM~[R…NY‰T[‹Ne‰Wj‘ah’T`ˆ`^„Xh’Xh”ZtNkŽTlŽUzš?|›HwžIxš9Š‹D{›@z¢Hp‘En›Ut–Sl‹[u“YuR’I€‘Ep–Cw˜B}Ž5v“B˜?¤>€9…„/€›7„8{›8‚“=‰–C‹¤6Œ”7‡ž;‰œ8ƒ§9ƒ :~§=›BŽ§A—ŖG‰¬LƒŸR‰”Yƒ¢\‘«X„a„¤`\†—bŠšX”¤X‘­Q™§]“«`¤\‡ŖV•°]›«X•£_œ§^¤Ÿ\ø[§¦dØn ¬d§©qŖ¤o§„u ¬jŖ«r™žu˜”w”„mš°t„«q„Æj¬©j„¤k·®a»·a«²f¬µb«°X›®eŸ²g–±eØl‘›^Ž¦Zˆ¤`Ø[…§]}„S…›d†œdˆ™]ˆ™W‰œ]‹«ZŽ®TˆØT“±]–„[‘¤j‹¢h–£iž„e˜”W”šTœ£V§Ÿ^„ž[§„UššU•‹R–O“M …Oœ„[§ŽX›€VžƒKœ‚Q¦P«zTØ{^„‚Y­‰L؍I°@µD؍F©R›~Sš€DŒxP^™{\’ˆU]ˆŒh‚’kvŒg{do–hpŒh|ˆpzŽmk‹ni‰_a…[Ye_}b\ta`j]anb\xcgt\fm\k]S`e[U\[T\\SSbQWcUScLMlO9gG;nJ>gB:eDEhGFhK;qG;oI6yH2tA6zL2oG;yE;w=K9Tƒ=P„HWwKSvQWvORnQ]sQVvKKzJBN8}V<ƒWF…RF|QD{OD}NB†JH‹JH‚T;Š\F‡[D_<‰Y?„dKŠiKiKiD~^OŒ\R†WS\Q}aQyeN|kW|cO|bM€hO}dDƒdEuQ‰}^‚s\zwOtkL|kVyeRlV‡qW}xK}uO‰`V‹ZLˆ`P€]OrZKn_JpVNr^N|XWzXOzOQ~LX{QO{U]ˆJZ“X]Œ[e“`j\`‰de€^a~caYe’Ym–Xq•OuŸAv™HsœAš>{=‡’H‡œHw£IlšOo–[u‹Un’Zy–W}‘Mp™Lj–Dl•Iu?o’•£Aˆ£K‚¦Wˆ«TŽ©YŽ¢Z‘ŸTŒ¦T–œ_’Ÿ^–žV›¤S¢Æ`œ“^˜­d‹§fŠŖc”Øf•ž^”¤X§ŖT¬žaµ›\¬gŸ­j­¤g„Øk±°b©£c««o”„o—¬j”£r ¬i«¤tÆ¢m„°e®¬a²ø]ŗ®f¶¶gÆ·c¦«ZŸ«^›Øn›«n”©n•£b‘ØN’±XŽ§S|Æ]‰¤Nˆ„^‚ž]…”a™U£Q«^š©S˜¬S‘Ø`Ž²`­`›¢p” _™œb¤žZ§ U§ŖXžŸ_Ɩ`§œW¢•\”ŠV¢‚_œ‚Uؒ^œ‹bš‘\—Š_š~M¦†K¢zS°‡W¬~Q³†a¦‰]©W²O£’PžŒG Ž\›~TšzN”tPU‰‚Xƒ‚QŽ‹]“hˆ‘iŽ[{Š^zŠ_j•gk†qvŠuilh„ob\_Šgg}c]ud^o[nrcpqVoxWerangVfWOQaUIXZSMWMHUIV]MAiFEoDa?=^I9lJ=lD1i?1m>1n=4l?8~B?v;M„:K|@PzDMyNMzRN|FEzHHwMZvTM€DJ{RJZ:†LC‚JMzH?ˆRE‡R;ƒJ?„U7ŠTF‡Y?ˆZC‚]Ag?ŠjFƒaH‡lG~gBŒiCdI€fI„`NzjNƒbV~dHkQz^V~mNxpJwhOzqO‚YtqMzqRlHxmJrfU€gXznK…~N~sQpV}iV‰jW{]Gz]GzYRtPFpVGxYTzMXnNV€[TsRYzX`K]†QZŽOaˆNe‘Rd‹]b~VeŠ\bƒ]oˆVo“Rz›Um£PvŸE|’RtšC|œ>„9|™KzJkFl—Ir™Zl•Pxš^vžXw›NiœGw‘Hv•Bs˜@}¤B|Ø;‹”A„˜9‚?zŸA‡§0‰Ÿ7”ž-ˆ“0˜>ˆ˜:† 8’œ<žBŽšE†ž@‡Ø6€£7‡ D‹¢C‡©M…žL‹§X‘˜[•UŸ]”¢S‘ W•¢[•¤WŸ§`–³cŸ§_™­_Ŗ^—ÆXœØ\˜§T–®VŖŸ\”žcØh°±j®«n³³e«Ŗ`“Øi®£p«¬w¤¦x«¤j”¬užÆqŖ£qŖ§d­“e·²c³³[„¬Y¦°a¦­\™©X˜§e«\®a®X†øO‹“Yƒ­R„¦Uƒ®T¦Uˆ X‚UŽ˜Q JŸT–©S“ U™¦Z”¢_›©^”g˜›b¢›`§˜c«–[”„]Ø \­žgؤb¢œd„—XŸŽZ„‘b£Žjœ†a‚Xž|W˜Xœ€S¢ƒJ­€M¬†X¬Œ[Ə[¶•T­ŠR©’Q¤ŽSŸ“W—‹M—zJ‹zUƒ~RƒV„„W…Z„ˆ\‡]v„`veq“du‘cj‰opkp}qn}womg~pi}cazd^}VixYb€VlxNovTgfRdbOQVYLLVLPTOVXMKiCKiJDpP9iM;iI5dF<^=>d@/l?5nE7gMAkK;nB;rB8|=;=D|BH„9OˆEQƒDKOE†HIwJTtNOuIKvFE}JH~QB~QD„NHH?†J9{K9W3‡Y8X?ˆcAˆ]@ˆfM‹jN“aK‰gJlF‰k=‚n>‡fE„kFkO`X^PyjU|jMrdRseNvmNuwI‚Jy|WouLvvHptCtkN|rHziP~jU†rW~rZwMwxU{jMqhPrYOpQTsVNwNLtTKpVIs\V|V_yXWxM`ƒR^„W_OjƒIn‡RbRd‚M^ŠYgƒXm‹Ru’Vx‹Ur•MvJs“QxžR{™A|‘;y=o=g“Kl”LjMl–Xu•Ym bi›\hŽLs’Mx™Fw™Izž>z”5‚¬;ˆ©B}Æ7‹Ø;Œ£8˜™/“”9ž—1›˜:’7Ž—C‹š>–ŸH”ŸA“™Gˆ”; HƒEœA–§I‘¢PŠžT’„L—žT‘Ÿ_˜£X—¤ZŽŸ`–Ÿc¢Øbœ¶Zœ²]™¬^–³\’«Q¢W•«[œŖUŸ„_£ f”`®·m©°h§°`¤Ŗh§Ŗl„¬jŸ¢u©v£¦gØ¢mئr¬Øl¬²k³²k«Ŗ]°¼` øZ˜­Vš¶S’®bŒ«dŽØaŠ²]‹µPƒŖT¢\ƒŖ_~¤O¤R|ØVŒŸX‚¦^‡£]’ÆRŽ¬^‰¤T‘®\“œ\•­c•¬c™®\™šf „^Ÿ›]Ŗ¦b£«c”žf³Øc§—g£œd”[žŒWŖcœ“_„ŒU£”R„‰S„]„Z°ŽK„‹S£ŒN°•_¹˜O³“O؍R«‰GŸ†X ‰L£ˆHš‚Q’tV‹wZ‚‰S‚~TŠ[}UƒX„‹cY~huŠpn–xf“sdˆch‡unsg|m_zdYr^[}[iuTjyOdvP^rXbi[X^X^QYLTbGQXNUh\PqHBnMvI/z<8uN:sEA„CFzADƒ@@‡1EŽ@IJ>‰IH„JH„CBvAKtEJm@4~S:vQX3gC…rIcFŒ_K‰nAŒ^DŒa={Z8€cI~iDƒmKƒbW{`IviOtfCzhSplB‚sKtM…†KtrHrvRvvIniXwoYtmN|xRzyNvTwmLtoNtlTodVvZNzZNv[Jy_XpVSzVKyaWrbQzW]wVcRgŠ]e€Id€Ln…Zq†Ka†P^…YrƒTpŠ]u„K{’Nr”J~“S|ŠH|’Ky˜E€’Gw?{ž?yKg˜Uq›Tu–YiŒUp‘Ql™Xh—Ow”KsJ•B}’E…–<†£A‰«HŖA‹”7’‘0‘%–’(Žž.—’7‹š8œ7ˆ™CŽ =”š;‰ 5‹>~›CØ>’¢@Œ¤E•œW”žS–O—¢[‘ØPŽ¦T™¢T’­X™©a•„[§ŸUžŖe—®c•ŗ[™¤`®]–£`•§XŖ V”¦dØ]±Äd³Įj¬¾c¦Æm¢²oئq¬Ÿ|„©zž§t„£|¦£{¦„l©«b±®b„“a¦³[¦ŗe™·a—²X’²]—¶_Œ¬VŖ^…ÆW‡ÆVƒ Vž]‰£]… V‡™UŒ–Y…¤\”§W‘¬\†¤\ˆ¬Z‰žZŸb”°Y•±U¤¬R” [¦ž[ž ]œa„ lØŖe«¢j­›c¬–Z¢–[¢“Z ‘[¦S«‹S®”P„Ž[£‡[­‡SƈX“”XŖ‘XƑ[³•Q®”R¬‹W„ˆLŖQ ‹NŸˆH”‚F’xVŽ{\Œ}V‚|_~ŒUyV}…TuŠ_~”]ƒˆ`zŒem‘pkjl‹df…cg‚oonlqr`arifu`crWVcTZdTYldcpa_aU]]cNfcP^bQ^iZVnMKxD@j<@mCDkO=jJ?qOAuH9K4yJ5w=;}>8}ME~KG{=F8F~5@…8B>8ŒC;‚76;;}E>A@x?7mH1rI4~JB{M?}LBƒP…hJ‹`LŠfQŒmLŠbO‡_C}X8wZ8|k@wdQylRsfF~^B}_Dy_J„tH€zE{{?€„D†uI}qOtnQpuQywNzj[w{Tv|N~{XzlSvtP|lL{qXufXqiWpaTm[PuXTwX\o_SmaexVe€Xg{]_y[[‚S\{S`xZs{Lm}Mm€Mr€WwTl‚Lo…LwLx‹LwCy–HzGz™D€™A|–8p™@pQuŽ\zŠZsŒ`t”Um—On—Ql˜Oy•E‚—Jƒ“P€˜G£M…£B†•6‘“9•’+’*”-‘—/-™0—š1Ž?‡’?œ@…•:zŸ:ž@~¬@ƒœE‰Iˆ›V“›S˜œI™ŸPˆ¦Gƒ J‹ŖY‰©[’ ZŸS §X„”b¦«_šÆWžÆa’¬fŽ¢^” Z£¬W ­dØe§ŗb®»k²²a«ŗb³³q°²p·“y“Øt«¦z°®v«·{³¶m¦·[£®[§²X›æ`§¹dž²Y—±SµbølŒ¦l±j„„V‚¢V{U~Ø\…§R„P‰„`€›Z’«bƒŖb”°S† [Œ¢U‘§UŽšL‘„^Ÿ¶[›®X”¤V©„T©”XÆ„_©Zµ­a¶žY©¦\³¦c¢žZ¢–a¢‰Y –_ؔO±“Y­[ŖRŖƒW®ŒQ„Ža§ŒX±’R²”^©’Q­ˆVžK£ˆK„|R’‰H“€SzL†y[„‡^~‚Ztƒ]y‰Os…S}‚Uu•_~‹bwƒfvˆrnfkƒguynvqglmfhs[hdccbe`obhbWdf[iki`lcblbZc\b`_][fWTm[WjYOHK}N=qAN|L

AqJEw@>ƒI:z@=yM5‚B:}DE}A?ŠBN‚5A‹6HŒ99‰63>0‰<5}57??€<8qE/r9*tA-t?<{?AJD}?:lF+sM+~`-}W+€_4X-…d=„Z3‚l:‚gJ…eN`H}hEwgJvS>t]8~aC|eDtmKwlFx^H}`BndD€nK„w;ƒuFw…Dƒz=„|AlGvn[{o\{oV{x[p€Or~SzsJpjO|lWu^Tw]Zn^VuVRp_O|eSj^\hYWv]as`]|Y_t]_vY[nV^yKmuR|tYm|Uhs\oˆWz†Yv…Vy‡Mu“U†šSvIpJs™Ju‘:s•E‚‘>xŸ>y‘J}‹[s–`u•d{–Uj—Lq–Ns“PtŒK„˜FCv˜EˆŸHŒ§?C0›”-‘‘(•—+™‰'‡3•‹.ˆ‰8†ŽG’›<Š™C›8‰ž:§A©?~ŸAˆ”PƒŸS‘ØI˜›N–”P’¦R‘¬Q…­O„ØU…©SšœTš¢Tš”_Ŗ§U”§Z¢¬_’Øl”¤i–¦f› fØØb¦r¶ĀkÆÄa·¹h³¶r·²nŗ·pµ·‚¶±«·{«¹u¤»w®»pØøe£æaŸ¼]ŸĀ\œČS¢½R£»Z›Æe”¬hŠ°e„£mƒ”\‡¢[}¢]{ŸVˆœ\†§R‚„X©]Ø^•¦]‰Ŗ^ŖSœU””M˜šH˜žS©X§œO”[ž£YؤR¬¤U¶¦Zø”\“ØbØ®dؤZ¦¢ZžŽ]¤‡b§Šb²Y­™a«šW؉T³‘V³‰\§ƒ^¦Ž]ƌVŖ”R‹T”Wž†Vž€XšuI“yK˜†P„P€\}†[t[z†av~Uo†OtXxŠfw‡fxƒkp„gqlpj|v`sjbtfWwh\kck^dk]bpaahhjiimcdjedfdffcldkeYnmJjcL{UCzSG†TOHKzFŒH=‘@;A6’<0Œ@6Š?6„62v9=~8:w:1r>7n>3xB8x:5pE2qD*tL,~U+wS'zO'\1„^7€b<g9‰ZD…]L…gJ€eKxaLx^;zeJyeHnp>rjCvf;qkDwpErnJr~>}|AwF|{BƒxJ}vBvQzrW„qZ|tNƒMzUm~HltLkhSphPqaVj\Lp_SuYV~UUva]sabrZcr`]qf_te`idad_`ePfdXonPwv[wnZp\z‚]x~dyˆa~‡e~‘Wƒ›UƒSr•Lz–Es•Au“=Œ@ƒ•H…™O€Ž[w’V{‘]r†Yr…Qm‡IqŠGz‘DuŠIw”Jƒ™F€“I…›B8‘2—)ž…'—„3šŒ-Ž)’Š.†‡5ƒ>ŒF–™B”A”£:’›A†œ8„˜?¢J‹«V“©PŽŸL” I§L„§H†ÆE†¦GˆŖVŽœTš–P”Y¤šZš§d–Ø]—„f”¢h™Øp›©p¢¬pžtµÅpæĀj¼Ēr“¶t»ŗeø»r¶ø|Ā½|¶¹z«»°·{­Åe§Ąiž»gŸĘiæ[ž½U”¶Z‘°e“«^Š³f¬jŒØpˆ­e‰Ød‚˜Zˆœf†•]~¦]£\‹©a‰­e‹®^“«V‘ŸN™©J”R—”Jš©X˜ØW¤«]˜”MØ„`¤¢Y¤ØQµ„T±¤_ƞX«Ÿ`؞X®h”–g¤—h±”d¶—\“U±”P°P©ŽJ¬N©‘O®…X¤SƋOŖ’W”‚_¢‚]¢…O”‡T›}U‰Š[„ˆaƒ…gwvbubs‡U{\qˆS|‹Oz~Sv„W‚bpslvƒeixkmf[wieocgqjdrdk\WiWUkd^Y_khg^ggahZbh^eqafrebsiRxcOq^KsWLtWGKFtCEyBNy7E}3E„6LA‚A;77‘;6“71…8}77s@07.rA-}B-{A5…C9‚<&x9*tF!‡M)ƒT zO'tZ-~V5…XA…XEˆcJ‡b=dI}gC€cA€l?{eD{gwpCzc7p]HvfJzgP{nDtjHqs>m}>rzH}wHxLywMvqJ~yX}U~Hv‚Lj~FnsHkwOgwTfrWdjIkgNhjZicZmhYf`Yb^Rf]]`jj]kga\ncip\qehcqdVkjZwnOsuNwnMu{aovcx|[~„_‡…]…ŠXƒ‡N…J†ŽJu‚@tŒIo…Dw€Gw€?„‚Fˆ‘K}T~as‡SwŒS„…WŽPŠƒJ’‡JŽˆTˆ‰Vƒ‹Q‰@–Œ?“•7›Ž/“’3Œ(–‰,‹•:Š–A‘FŽŽ<Œ™C‡œI§D¢8ž©=”¤<–¦@— L†„NŖKŽ§K‹™J£Q…ØG‚¦SŠ¦PŸK• SšXQ¢™T•£^–˜`—b—ŸgØo”°y®qtŹÄæĀvÄĀo½Ļl½½v¾ĒvŗĘp¼æz½Į{ĄĮ}®Ęm³Ģq¤ŹmØĢc˜Ćcž¼rŸĀv—Äjž½cˆ³l“j‡®c‚„b„”l‹”`ŠØh†˜o‡”g’—k‡˜j‘”^ˆ±V‚¦Tˆ„S“›`œ¦R‘£Y–§S‘®\›©U—±dœŖ_¤bŖ°UŖ©e«©Y¬«\®Ÿ`²›Z©˜W³ ]³œY¶’a²•T³’U±–H»šW»šK±P„ŒU°‘S¬—NƍV«T”…`œ‚X‰]¦€R”‰`‰€d|\—€^„„\ƒyVƒy`wx\xxV|sbt~S~wZ{uYmxctxbopendet]cqfjydcgbgkSjo^hhY^fbUacX^`T[^l\cl\gzZbz`e„e_}^U|_\€LX€ONuKF€PR{:V€9N„9E‚A?„>?}@A€83~5.|73Œ*-‹*-7*Ž,:ˆ47Š/.Ž25;=Š:*†85ŒB/„6*ˆ?1…59}068/v4,w@+zA€J/|H/vI#‚P2ƒ[:tZ>YB|S<‡g>‚^Bƒd:vm5sk@xp7tp6qlEyj@ql@‚j?wo:qvAy}@{|@r„@psNnwPwoTtNn€QoxPrƒKgqGl{E]}V[lW[v\kmRcpZki[jkTclZacU\_Xahg\hd\lhj[tipw\li\aha^fm_nkWomWxo[uxY|T|t\…‚Q‹_~b|‘RzˆO‡ˆJ|†Ay€@w€Jt„=wwD~ƒI‹J|‰[yŒTyƒK‰K‹…J‘€LŠˆJ…”VˆL’XŽ†R”ŽF”…@’˜?Ÿ—8¢;”“?Ž3˜ˆC™“@‹—@’L›P’G’—H ¦:—¢9˜©>”©Mˆ„EŒ¢W†¤XˆŸFŠšCŠØ?‚©H”ØS‘ U›©Y©N”šV£“V—Oœ[¤•\–™^—”f¦q›o™¢tsČ¼zĘ½}ĆĘxĀĖpŹÅtĀĄp»ÅxæÅxÅĒ¼ÄrĮŃu·Īw©Óz¤Ńq›ĶkžĒw¤ÉxŸĮ|šÄr¼k”­qŒŖn‰¤aŒ©m’«g—©f™Øi‘Ÿm…™m…Ÿe‹œ]ŠŖW†œS…ŸO’žX•ž^›–]žb¦Y«_Æe›§e™°_§®i«²b°©ZÆ„^­ž`¦”\ŖŸ\“š\¹’R“Y¶™PƔO“žS¼L³Y³“[®‘V«X°”M²†P®‰P«Zœ‚W¤ƒSž†W wa‘yj˜ze”}^ŽzVŒ{Pƒ}[ƒtR{rW|r_vq^tudqxaet`cubiibnhgp]lj[lo^ja[_d\`ic`keSbdW_[b^_[a[^dYrV^pZ[v[btaa€_`a`|UW~\YxQK|IV?Sƒ:Jw9Lw=€=8}=,u<4}2/ˆ22‹0113Ž4)‘4/‰.&“5(71”2+‡=%†<"ƒ:*…+2z-2‚,,3,80x9$u9/zD(F)…F*ˆE.|N5‚N3|R9~b@ˆc9†g6‚a:ze:zp1wi1}sAu?wwB~tA{v@z€?|y?€wEFw„HqxEw‚Iv~NuzKlƒMdxEhvA`€EdyIfoK[pY`wUesWZpW`qVZfTcdUa`\ZkaUq\alajimbdsj`}blzcdnn^ppb|i\vrb„pbƒtc‰{V}R‡yR…ˆQ‰‰]’T„K~ŠUw‚N{IwˆCw~HuJs‚Km…TuZ}}R„{N†|I‰|P‰ƒOŽ’K‹QŠˆZŽŠR•‰S“„SœƒG¢G“OGŒ@œŠ=—„K–M–’H‘K’G™R•U¤žFš§Bš¢BŒœQ—„O’™WŽœT‘›JŸH„£L‰ D”šJŽ T•”U”£Rœ–Pœ’P›”O¤Œ_¢œ]—›hœe£aŸœ^¤£j—}ĮĶ{ĮĪy¾ĻxČĀyĘ½uĆÄzĒĀmÉĖ{æŹpæČwĆÄnµĘx¶×s±ĖhŸĢi­Ép­Ėt¦ŹsšÅj›Įm“·h—ŗd—¶gŽ·h—µf’®eŽ„m“©e¤g†®mŒ«mŒ£e‚ _‹„[Ž„b˜™[’ Xˆ•c‡œX˜¤_š”`’Ÿa„§aØ£U°ŖT­›V°š\§ØW£¤Y§š[ŗ›^²žW½•a²¢U³•U¼“M¹•Zø^ø’]ø‡c°—Y­‹SƌGؑ\؉Z›‡\©yX®X•{[ŠwhŠ{gš`”u_ƒx\Œwco\~lVzmWzv_wtYdm]jp\ht[^d\k_aigjoVusammdiu\ji[Xo^[p^^nOakUUfKjYOzXUw[YuV^|`drb[q`Ur`QrVWsPVyBMx@TsJKrB=xBAyDAƒ;2z;->14>‰4:‡75…9#‹7)†>#Œ94Ž1+‘B*?*ƒ9+€9"Š71…69y5;€+9=,sC5B's=.xD!}O.|G$zT.{R>~N5y[>†Z.†f<Že>~_-‚g4„s3€y9rs"ƒ44ŒB+ŒD/<3…7)…;3‹?3Š=8{35y27‚99€E6vC*zE!sHvJ vN&xT1yT;|]=„[2€U+…Z3ƒZ3‡j0p5n6tq@ws>v|Dpu?soDmkFvj8zh8€n9ufHmr@op;ksK_kL[vL]{NexN]rEb{HYyH[}J[|QcrVhvRdoMaxTkr[gjTbiVYcYUlfUjiYmp\`gQafUcvbjwddobSmdRviWxt\zq[v{_€{Y†~[ƒzP…vKvsIwUu‚P€|R€G…|I}|J{zMy€LyvQ„xR~qcvtc„…R…X…{M…ƒG‚P’ˆX˜‰NŠN}LŸˆAŸƒCŸ†?˜ƒG–€=“~=x;–~;˜zDŠƒIŠ~<‹†>’H”’D”‘P˜ŸQ“šT¤J–O™•V™NS›[ˆ–T‰žP™Zˆ¦P””H–¤I•šP ›Q¤X—£Z”•`šZ™Z—©jœ§mv½ŹuČĮxĒŹ†ÅȅĖŠ|ÄĻmŠæuĖČkĀŹvĒĘh¹ÅqµĘo²Ķg²Ōi„Īr³ŹmØÓf«Ģf¤»f›øu”Ål–¹u•µv„·u¤®q£°q–±i›·mš¬bŠ“s‡ŖlŖwŖqˆ£jˆ§mˆ£_Ž™`‹œa‘›]•Ÿfš™Z”‘fšši¦¢_­ WƙfƦa²X¶˜\ø–X¾’d®^»™^Ŗ”R°–ZƘT²Vŗ’g²\·…bø€Y³T³J£{V |Z”sV«zT²zX”ue“rY˜wTwe…om{dgŽqfiZ‚gczndulOok[ql[maZf^big[`fdhc`gai|\jkcptSmqT_g^\rVaeTd`IYeIaYQwfFhdKng_uYPhVMn`ThZJhSUjSSlKEsXIrICqE*‡I*‡G)Š>+ƒC3‰9!ƒD+ƒ=1}E4‚7.w;6Š@=‚42u>2yD#oMvR/vO5ƒP-{\CzT8z`AyY6zXAzh/…k8xq3€rB{n=rz>px=i{Gqr;rv@tbCpg;yhLnlAmm:kg9on?jhA[t?U|FduH[zR^|FcqE\{UTtPXySgvTg}W^tXpm^aqVkk\^\Zde_Sad^`ldSgQZqZ`|aVufZwa`re\sgb€u]xwc|px\}p\~pYtrH‚vGulUsvW„tM€rRoH|tP„zH…|Qƒ|XŒlSvvinz[yƒS‚‚W€{Z~HŽ~R†L‹‰R‡ˆL€F›v@”}D˜{@¢wD™‡A=ˆ}<”yBƒJ•„C•u8•‚3•D˜Œ8šœ@”IšU‘¤T˜”SˆšV…’N…‘L~NƒX‡˜N~—_“S• Kž O £T©„O  ^šŸUœ—b£^Œš[œk“§a …ĆČzČÄ|ŃĆĶĻyÖŁqŃŅtŚĘqŃĘmĒĖxĮĘyµĀqŗÅp¹Ēu­Źg°Ōe®Óo±Óh­Šq„Įiؼm­øs£ĀpœĒx¤»u„¹z¦³v˜³m™¶b—®f˜“sµo’®j‹ŸvŽœn“Ÿm‡žk…¤b‰˜]‘ e“šhŽ™n™Œe”‡f§“d¢gŖšaؖ[“ fæž_ŗX³‘^µ•W¶ŒV±^®Yø‘]Į“X½ŠXĀ„aµ~^²{W¬X²S«|MØrX¬q[µwTÆsU§uc•sX›j^jbˆbf…_j„ah…i\†^_~d^uiSgfWh`Mh\QhbWh^_c`_iYfxdiv_doXilTrsQilR`oMafP^^KcYKpdLoeIimSmdTf^QoZJr^AqdIcYBf]Ki[AnZ>~M<|N9sD0zI4{L;ƒ=:‡:4zE=zE>|N/…D$€K)vF"zN#zF1~D1ŠK'ŠD&€D.‚D0ƒG.€;4x@094wB7}>+‚K1vQ)tS2vZ2†T9‰[:}U@{\?ydB{bA}l<|o6yr9}i>vsAmoDpsAoz=}w9|sAtpHufDmc>skHrqIpf—€DuD’tEy7š?¦‹<¢“E™˜N•”Yˆ–RŒžQ‡•Zƒ’]„ˆU€ŽX‡–J•F†”S…N“™V›šR—¤M£ÆUŸ©\¢£S•›Y’˜\Š cžZ˜ž`¢„ĻՀĪՅĶ×{ĢŌqÓŌrČĖvŹĻzŃĒiĆÉm·Ķv·ÉpĆĀ}æŹw“Ōm³Łb­ŻkŖĶ`ŖŌm Īq¢Ķw­ŗ{”æw®Ē}„ƅ¦æw™­u“®i˜½h’æo˜¹hŽ¹l˜«sŖoˆšsŒ˜y‚˜fŠ•jŽ[Œ\›šdš”h™˜_¦˜jŖn¤˜o„Ÿc„šb«œe°˜hŗ”f­’q¬—f®l°‡Y¶’^Ŗ”_¶•fµŒ]·}kµ€`­†X±„Yµ…W«uP«pVÆuM®hV„zYŖvb r_šeYc^‘dl‡h^ŒfdŠndxp\bcjj[k__lYVcdbhaThZXlZZpbde`mkUom__tNcuZcsOkiNgeZb]DjbCc_DjcKu[JqjMrfGlkCf`OgeOpcEj]QmXzP:N>zO7sF.pM1}H;yF5vRBtQ6V4„O1‚L)~T+}G!€Q2|C9yA6|N,‚D4‡;,ŒA-ŽG4~B:x3-t4+s3.‚J$P.€V3€^'„T5Ša3|g6€Z;wm?t`>wgAqg1ƒkBuqGlxKekNiwAp7pzGt{;pgCllGshEddEon9sb0lk1jy:XsFO|QRtST€L`lUijPcyJZoZfyTex_jve[l\`hUseXjlUddUf]`iVcgSi`]gcUhg[yaau`[nSso`|t^€uh{zfzplknnrnZ|hWvwGymRxqPƒvN{}K„kG~qLyMŠ|P|Y’‚Z}uV|rXvƒU…ƒQ†…a‰]‡YL’†M•F’€P‰P–qI“€AvJš{Jw6w-Št<Žq>—yHœq=œr<‘„@‘~7—|;‡F”‰L—”UŽ“ZŠ‘OŠ_‡…X„…Wy’UšTŒ’\~’Syš[‹[”™L£ŸT— SšŖV”ŖV›¢RœYš©[‹¢\ ¢i©…ĒՇŹ×}ÉŠ}ŃŅ€ŌĒsĶČl׏qŃĆoĻŃn¾ĶĮĪ~ĀĀpµŠq²Īq®Õ`ÆŻ\ØŁh„ÕmŖĖw£Ļq­Ģv©æ~±ĒØĀŠ˜·„–±z ¾uš¼m—Ās’·{•±u‘¬kžoŽ”l„Ŗt‹£l“•b˜‘\^œiš™g˜k——a„˜f”—j§šg£m©–a«™c·”rµ—r±Šy»pµ…lƐd«’g“•c®‹`“€l½wfµ{Pŗ‚JĄ~I¼{GÆmS²kS°nQ¬tW¬sU¤nZ‘bYg[‰rhwe…e‡we|bdx^fm[`_eek^cn\fj``gfff[be[kjaid\\tR`rXZjU_oXZcYc\S_cAca>pbKmYSeaNk`GrhHnmGkjOabI_SRkTIyTDwU;qJDuB=yO2nK*uH.kN:jNHqPFkQ1tU-tU.€J/vM0{N-€Q2ƒL6‡H2zH7zJ2‚”s2Œp1n;•kDŸhG›r;‘@‘x@–w;~E’€OŒˆU„‹aƒ‹`‰}S‹[~ŠY|”[z^…–YyŽ_~—ZˆžU™ØV£«L›¢Uš”\–¦^’ØP˜°Q™¦V„Vš›b„‰ÉŻ‡ČŽĘցŃŃyÕČzŃŹtĖĢpÉĆyĄĮsĄĶ‚½æ}»ÄmŗĆl©Ėb«Ļj¢Śn±Šl®ŽwØĪwŹ|„Óz¦Į}ØƁ¬Ćƒ æ€›®…•¶³v“ÆqŠ©€‡Ÿs„«oƒœl•˜h¤s…•eŽŸaŸb¢šW •fœžiŖ™d®šY،h¦œm©Œl£’l©Žmؒb±“q­ƒx¬Šq±u“Œn·€c“Žg¦†c±€aŗƒc¹‚[»y[Ć}TµsN¾xSøwQ°uUÆ|QÆqN±tZ tX•gW–if™rb˜{`‚}f‰tc|qfhehehglZej^gc^nn_ok`nahja[afZcbWrfZe\[e]^`^`^ShYU\`KdfI_hHeiYqiKfhHi\DkgN_^>`aFaZ;q]@eWFtT?wK8lC5wL)qA/sG+zL2tM5wKJnO=vP7wZ7‡U8{L3zV9~G+€O+‹L+L2…D-‹::‚72ŠI1xB+x:7=)z3.=&€D)…E-„U+~_;`0}f?ƒfEˆq?ƒe7}rCkB€p>xnMth>hl>tzGfnDck;heEjl9fe=kj@bd5Z`>jd5^o9]h;anNSyKRyFZsL[mN[uLbjXNiZbr_jybjnXXhUcbdm`bahg\U]ie[gVjback^fp_rp\{_^sXhzbYufPwpc}yevv_r}fym`qnayx]€qWzrW‚eO’lY†vLŠjPyR‘tU†ƒ_Ž‰dˆ{`~ycˆe}†UˆV|’^…Ža…ŽU”…R™N“‚DŠ‚BŽwL†q?†p=ƒxG…€;Žl4‘r,‰n2‘g>›r=iMœrO“}Lw?˜rDš{>’mTŒqP‡yeˆƒV~y[„‡\‰€Z€ŠX†Yƒe„Yˆ–S•–[—˜S—ŖQ“«NœœW””^”ÆZ”¬Zš§S™„c”œ]¢‡×܇ĻŌŠ×ƒĖ܂ĆĶyÉŹyĶÄzŃʅŹÄ~ÄĘuĖĢ|ĄČq°ČjŖÓq¤Õm¦Öo¦Ųh«Ūi„ßsžŌƒžĻŸĒžÄƒ¤Į†©¹†œ»€“Į‚·ƒ˜­{’£‚Š–zƒšm€i”aˆ“h˜a™b˜‘Xœ_Ÿš`œ”cŖ—^µ[®‘Y²•_«Žg©•p§’m«rŖ€r±Šx·ƒq·|s“…q±}pƂv°|r±ƒk¹e³d³~U¼vX»nP¹qS³}QøwK¼tS±wa«v_©w[”pb“pZœl`“ra‰xjƒrk…k_}nbzcagadhagelbokbrf]robii[mkXfk\`f^imako[`d_Zffe^chUahFbbGjjNplJiaIgZMcZJ`hK`g@`_:iU5nN7lJ;rD4lB+iC1iD0xR6wS0uP:yU<[2}Y4xM4‚N=~S;€T;ŽQ;K/”G/I+’D9‡;7}G:}A7xB2ƒ<,†8.='„@1‡H3J>ŠX7‰\;}e;‚j:ƒk@e5~l7ti3zj;ycIukGue>npBruAlp?sb:l^@hW7d_9]]:bd;fd=_d;d_AY`GcmN]mJcnF`vBcwQ\lO`m[TrbVve^rbfl^feamgkicnjXjj^hi_jmdfxjru`ln\mmWvbZq`^nd\}fX{dR…rZ€qlwwpz|kwqdwwa{qW…qX†gZ‹dO„mOŒtQ‰sZ’xW’†c‡Šd†aƒ‡]zˆ_‚‡aƒ’_Š–_ˆ‰W†ˆRŒP”•F’ˆ<‘ˆ9Žy>Œ{J’vD‡u9Œu5ˆk1ˆl7•k>”i>’cDšlDžoE“oM—tAœsEšhL—iJŽoP‹s\xVwX„~Rƒ~[‰w_ˆ}cŒ€W’‹W‰ŠW‹SšŸX—”R—„Yž ^˜¤\ÆV’¦_¤[–¢^Ŗ_—ŠŪāŁĪ‰ŠĻ|ÓÜ{ĪĢpŹĢzĘŃsĪŠ‚ŹÄvĻĶ|ĻȅĖÓv»Ös“Ųx³ÜnŖŪt®ŌlÆ×y£Ś}šĻ„ŖӂžĮžæ‚§æ„•ø“”ŗ‡šŖ—¬€‘ÆŠ‹¤Ø†›rˆ nŒx•i‹”j•Œq˜…d ›li¤—b©šk¬l®Žh¦Œb ƒl”‰w®“t²uƃmƈo­ˆpŖ}o©{q¶|o“€s­qØum®pl­qd“|c¹|XÆv[®nO»sU°}S»rVø|c¦yb„yf—sdŒoi–od—ej‚pfƒkd„d`~ekochnfadc\kmbge[sfgpiad`\igW`dbfnW^pUjf_bddbciiS]gJ`nDadNclJ]_OddN\YBX`BZ_JanH`^>kWFbZCpF8mD2uR;f?6fK+jP)~K8qO3vP9zK0‚X,zR3ƒU7†I?L.ƒO%L(B2ŒI/Š=/;447}39ŠD/Š9(ƒ@ yJ%|P$ƒL3‰O5X(ˆV*„`9u[?~_9ƒd1ƒu.{p=zl?wp@moHloEoe9uj;snImt6_d5fh4]h5ca5[`6\_1a`9YlBVe?ZcOSsEbjM^vC]pHakYckQ[h^[kWloWorXkg_chggeflineffrZjcdieimz[rm_nk]~qU{sYurUti]xqcnW|mexvmyoet~^smi…he‰o_‹jYŒm\ŠtQ†lR†i]“xW…‰f‡…V}vdŠ}W‚Ža„TŒ‰^‚M‹ŽYE‰ˆAˆA‰A‰}@ŒƒF‚w?†qDzsC‰q:†f7–o,’k4œk<o;Ÿr7œwJwDvM”m?wBxG‘mNsa•yRŒ|S~VvQ~Z•„\Œ\’S”‰S‘N”ŸH¢›W—O–Ŗ_”ž_˜ŖZ§W› V”„V› X¦sŪŅxŻÕ‚ŁĻŹĻĻĶvĢĢzŚŠvÖÉwŃŠzĻŲwŃӁŹŌwČĻw½Īy¶Ņn«Õx­Ģq©Ėr¬Ö|”×{«Ź„ŖȌ£æ‰žµˆ¢øŽ•“”•Øˆ’¦…†°‰¬ƒ‰ŖŒ ˆ‰‘w–“y—‘y˜‘™•vŠp¢“r¦˜s²”i¬k¢‹n§Žo§ŽsŸ†v«†uؒw·‘g“…t·}o­‚m¶zl­i§~vØyw”|pØmp„hb«ohµli®u[ødY±bgøkc®ub¹xa“vb£tažm]Œod…sg†jhŽbsŠ\nwfj€llyjl{oivcdviXk]emRblXbkYbd^Z]ecblbgtU`nVabhe[iq]bmR`lZ_oQ[pM]_LT_J\]A]i6WfoS9jB2rA#vM0uR.uO)|O1†U.€Q+zP.yP=‚U6}N'|M-ŠG&‹D'ˆ=2‹E;‰?6ˆ4)ƒ6-B.?+‹C,|K$vL$|R)yZ€S!P-~\2}Z-v`+€c+yl2}pcd5mh6rj=ntAbo?`l;Y`.Y`0\f1[].[X0b`4cf9_iG`fOZoJ_nFckJmsMfqUci]gd_ieUrk\ig_pqdpummggkgtlessgphadkgjmenw]qtZ~xZ}uWynW{kX€tUzr`xii|mf‡ymƒ{bzp]Œlfs]i^q]zqL…nWƒpPƒ{Z„|Y}UxU„wU…T‹\|R‚€P†…K‰‹@‡‡B|‚8€‰8}‡>…„F‚vB~uH|u;xj0ƒd0‹i'—j;”hA”r=u;™y@˜t@ŽvE†p@ŽuNŒxOŠt\“xZŒxS“€Pš‚F¢}M™ŒL’\˜’Q‘ŽV“‹Mš—M”U”‘Pš’T–£N ØSšŸ`—”Z›§Z ¤^¢™\¤†ŅŁ…ŲŲ‚ÖŅzĖÕsĶŅpŅĪqĪĖ{ŲĻ€ŅĪy׹‚Ņ߈ĶĪzŹŁ|ÉĻo³Ėx¬Éx¬×o±ĘzµĘx±É~ØĢŒØ¹€Ø¾‡™³¢øŽ²ˆ”Ø~”„€‰¤ƒ~®”‰„€‘•€˜–|‹v‘•v—–y‡s“Žr¤ŒzŖ•o±–wƂi«Œt…}£‚s؈x®‹y°h»…r³ˆf¢kƃtŖvj¬tq¤vlŖjp›rt§hg©onŖke©jc«mZŖhY¤jkŸq_”hl³y_ f`˜gj“pgŽkh„m]ƒhfŠds‚gpzdqvceyfb{a^u]Sg]S]PYh\a[]\e^cdml_sXjgbpahhabs\asYXoJXsGXfNVfN`lPZh=U`GTeEZcET\CSh=]g<]X@^\GfYHoM?j[=qW4vD(lB/rI1rP$~Q3sL6L)R6|R=xO1|R.ŠE(C'„N/‹@*’84ˆ=2~C+‚:5Œ:,F1ŒG ƒW#‰L#~U|Y*‚U[+ƒ]0Z#{a/sd-ps9vk5s}3cu5``0nl*ln.pk-`s9]p>er=bd5ba([m.dd,gk+hf:arXrKZiO_oHbnLduDooLmr]ig]xbcnqalhiqnjn]ivdfqcstmnv]nj`hgWjee{q\vuMvRuave[|qgoa}vboiˆik„qhƒqgykjygƒm\’ejˆoY‚mVcMoLkP…}_‚Q‰yPXƒ~Yˆ†^uW†€U„‚GƒBzwAƒˆI‚ƒAuz?yxEr?yqJ‡n:{t+{j(„s#™b2–k;‰f>“w5’zCˆzH‘pI“tH‡jSŠs[ŒyL–qZ~M–uN”zZ“|F”‹L¤†[ŸŽK™~H›‹Oš’D¢ŒJœ‹T™”J¤˜DžY£V”£^˜šX„™^™c¤€Ļ܀×Ņ‚Ķ×yÓŌyÕÖzÜÕwÖŚtÕŽtŪÕyŃÜtĪŠ€ĶŌ{ŹÓoČŹo¹Ņs“Ģp³Õt½Ī|½Ņƒ¶É¹Į‹¬±ˆ§«‹®~Ÿ®~—³|Š­‰©~‘ †Œ¤ˆŒŒ‹”‡†˜~‘œ{™zšˆ“Œƒ•“‡œ›|£‘s¢‰vŖŒm¤„m¢€p†w¦‹xŖ‘y­Šn­t±„i¤b§„eŖtp©qp«ijžjr˜roŸoo¦to¦ps˜cjš`m”be¢^l„ae›`dØop¤tf¦k`œcim`‹gbŠb^ˆgl‚hh€kpydf|g`|bbrg[a^X^UZbU\]VdY__Yjgbtd^oifgendim]aobed^YgO`cQUkM[eDUlCRdGS`ET[IQXGWZNQbLJgIT]*‡>&?/‚@,€D.‡N*‹I‹UŽJ…MuL&tS)w`&v_$qi'pf*zj0rj/fk.ku)`s,dm)jr,br#bl1_u1hp3_g5`k1[g,\d1\q$]k-cp/hv<`m=[oGfoFdqLngJtqGioIlhKukX|oSrn^qbg~^ruapv_sv^uzhwvfoubwsb…lXƒtW‚tPvY{i^vdhwgjw`brjewmfŠkqŒqzŽosjdŒuc‡qh“hf‘h]ˆdVŠbV‚bVƒeW„saypexWˆ„a€ZŠve…|^ŠvX†wSƒrG‹sKv@~€Cu~=|z?…~:Œs=ƒo7ˆq0ƒk0m+”n:Žh;Šc=†o=Œo:“pH‹mOrHŒgR‹mV“oLœnR—zOž{Z—x\œ…O¢…IŖ{M¢IŸK•ŠPžJ•ŒF K›‡Oœ‹Iœ’T–W›—YŸ•b”›c¢[ž‰ŠŲ†āŽ{ŠŁŅŅ}ĻŚzŪąsĶäzĶēvĪä{ĻßyĻŃ~ŅŁzĶĪvĢÅoÄĪxµÖs³ŹxĮŠ~­Ā“­¾Š¶“‰Ø·€£«…¦­|˜Ø„–Ɔ‰Æ|Ÿ…œ}‡©Œ”œ‹™‰š{Šœ‚Ž†sž}ƒ™ƒ}›†œ„Ÿ‘tž”}°’q¦ˆr؃k„‰oŖ‹k¬Šu±…i°†o²‚i¤‹c¦ƒjŸqs£rq›oh“og£ja˜kk˜qy¤oc”hb”i[£ZhšY^¦cdgnžqgžoo”uf—lcˆh^„ec~gcŒ^e‰jr‰ik†mkuqjmeelnXod\`NPhUPXRZbYU`lYal^lmbjfbncXbeWn^`jQYgQ\vHKnQQnJPh>Xq?JiSQeO[aCVdHVkHT\GPe>`[CZ`CiX@mb1gY,l[#oV"sV"iHzGqN0vV-qK)uU3uQ6†P*‡P)‰V/K%†Q!‡B!‡=*?/‹I)C&†P+†P"ŽQQ‡R†K'~Y-uW)xa$qa+ej"l_+qm8od)me1ip-_r&_k"cq0[m,]m-Vh2dh>Vl&[]0Rf'Qd&Zl+dv4cp@]jDek:fhGadCfnJjfL\rJsjUll_liYyha{do}mh{e}u`up[xrdn}curczzUlPˆxU…}K{wW†g_€neufspeg~okwok‚ju‰cmskfi€tcƒpbŽpkŒcYŒ`Rb\ˆdOlXƒo_xjUˆpT{V‰†ZŠ|X„xZuM…lL‚}QxxMwsBss?|vC~tE~rEtC„p<v9‡e+€v%ƒj5qB„mJ‘qH‡kL’vH€qC‰sBuQŽyK}Tš~V—r[šp`”„Mš‡R®W„vG›ƒI ŠQV‘‰JˆK¢ƒW“ŠWVžŠQ’aŸ–a§‘c£]”©W”ŠŻé|ŪŪzŪĻyŲĶxÖŅ|ĶćyŁźwÕä†ŲӇÉцĘĖ‚ÉĢĻŌŅĻwĘŅw¼Õz½ĻxøɌŗĶ‘ŖĄ”§¼…®ŗ‚„¬«Ø‹™£ˆ‘„†ƒŖ}ƒ£ˆ‹š„ŠŸ„‡‹“Ž†”‰”–|‡y—€w¤}„¢ˆŠ¤”z›r¤y§„r£…t§q¤†i ˆn¬ˆl¤Ši©‰f®Šq«~pœvh•il”sm•tinaib™pq”fcšg`žgc”\`™UdžXe jpŖnn„mdšei™l`Žldnozmmbt‚iw‡qyzlrtmdrrgkg]l]^nXQiQQ\YXe_[kebea^hldcoXhdScd]fYXpYYpYUrUIvEMpH[qFMrOMtOUdOY]@RdCUfISeH]`:Tg@Z]9Vb6Xb:g^4p`#nU+jT$kS*jMrU$yM'Q2zL-~V&}[+za.\-€\'ŠJ “?(=*ŽD-‹I,„D1N*ŽH#…R'ŒK#†NOP${RuQi\&i]*j_._h/fk(^e'di*ai(Tc/Ra0Pf5Vc4Ql|l?ys>um?~l@}p2xm(ƒt2€sAŽuE…nNŠtH‰zK†|K‰zJ‚B}G›xK˜ƒY•„[–uY›xTž|S©yJ£xLŸ‚L˜‡V˜„NžŽM¤„Q†U›U ‰Vؒb©‘\§–_¬‰S¢–K•£S™€Žį~Öę{Šß~ŅĢxŹÖ†ÖŲ€ĖźxŚź}ŌēČŁ‰ŠĶ€ŅĪ|ĒĒˆĘĒzĒŠwÄŲ·Ģ‰³Ņ‡²Ā†Æ¾Œ©µ¬ŗŒ±­|¦„©«—›z£x‹–’„†‘„”ŠŒ–‰‹‰”™ˆ˜ˆ…š„„”…š†w Ž„¤‹ƒ˜†u›‚t ƒt x¤ˆy—yn§„x¬ƒu™u–„u¢twž|lžpe–nf›ii”mnbkak™i`Ŗad„`dØ`^›Yg§bc¢[k§pv›fo˜er”mn’oh…pi~pxpzvus}kxzu{~qo{bjqfkec\maas]W`aJ[UPa]VidYh`XfaV`^VbY^jV\laTdXPp]LvFFsKF~IRrCYyLUvPUq=^_8TlAS]CN]IWhGM^4_c;Ma0Sb9X`&f[*m^*n\&iS'jLsUoVyQ)vX"X „`{^"zd/z\*ŠSˆG(ˆK#†I+–R#’L(ŽU%ƒZ)‰N(}U'‰R‡P#wTU|ZpW+fZ&`j0]l)X[$U`)Um.ed2_c[i>Uf2Uh/Qd.Yg-`\)h^&bf&Zf*Vh5]c@XfETn;SsARgFUl;bo=hfJhb]_kaXk^b^drWmtasuc€sj|hi~kWtiTrXrSƒwPwwV{z\}{\|s^yjevqf€zg‰rkŒth“ljˆdcƒ^iec‚bh†kl„jaƒeT}fWd[…[Q€_I‚`P…pYwp]yme}s`~lV{qO{|PmuPlwTltOrfNy`YrXYm_NghMri=qb3tc3qg2h7s?‰pJsPŽvKŽtG•oE•tRŠ}QˆzH˜€H˜}N‘„O›L™N ƒQ¤v\£v`©wZzPˆN’E¢‹F«ŒF®…N­ˆU„ƒP£M£ˆO”“H¤˜J”ŸOž˜V§€éŻxąč…Ü×}ÜŽxŁŽ}Öć€Ōą|Šą{×܃ŃߎŃ~ŅĒŲŌˆŃÓ}ÓÓ}ŃĢ¾Å„¼æ„®Č”§Ą‰Ø¹ƒ««x«ž~¤¤}¦„†ž£|žš‹›ƒ––‡’ƒ•†„„Œ‚“}†Œ†ˆŠ–~™€“{}™ƒ€™€v–|˜‚{ ƒs‘zt™uu”€w¢€l‘pq”sy•po‘|o vdŸdg˜_i•_ežhs—Zbš_e˜fjšf`¢\h—_e˜Ve£hj dr•Zv™[z˜aq…gs„cqznpxnxrukztx}rhymkmVllVjj[Zh_a`\Xla]g_Rq[VqaRfa_c`[lZ^oNOjPZ`KYaNVsCWrELxNQtNE}@PyEbn:]c|`|gDysIvBjI‹yN‘~Y“yWžwM™‚V€N‰J‡ŽTŒŒ\—~_”|`¢ƒh¤Šg¢†[¦„]˜|Y˜zS›€[ ‰K”K°€R­PžU£ŠV¬Œ\¤…S؉L؎V›„Žé‡ęģƒŚķ„Łā†Łč€åāāćqŁćvŪӄŃ×uÓӂŚĻŠĒŽÓĶ{ŲĢoČĶwĀŠ}湍°¶ÆŗŽ³±ŽŸ­y«©³™z«§zŸ¢šœƒ‹™ŒŠšŠ—‹‘’Š“†„Œ…”†‚˜|“‚™|Š|€˜uˆ†‰„z›}ˆŸ~”ƒ~Ÿ€‹p…£z|£lv”rlŽxs’hz”pl™``žXh„Xo£bo”_u˜Uh•dgšYfQm•Rc˜Rf§Pg˜Rm”Ji•TyavS€€Vkvct|auyjtpjjp\u~Vkrbjlgke`mk]paer[ZbcVhhOZeNczVapZWlN\wKgkRYpCcgJVpLZj?]q=OzAWnGL}CUg@W_8bg;Sf@\]CXX?He=Qe;Kh3Vl1Z[+aU&eV&_d_X\_cWbYqSzOW^yS}P‡SuX-z\…K%zO…C"ƒR&|Z yN~W'oT&uRfY"fglcx]iSlZhehgWc+Jg)Oe9`Y1eb2Zd?a`=jjC_s7amFZh8cm;^m3k|3Yv4]|0Xn7VrIYmLcfB\pDad:TlM_^CZhG]cS_dYgfPgf^]kmalrhxzuwo{xvxttqm}pf„xc„wfxvV|x\xyaƒpgŠwdˆyd‚€W‰k“ljˆci’kg‹eo€btin\jh_–db“cQˆdDˆbP‹fH|eR†gKzmS~p]ŒxcŠg`ˆkXr[Œt[€sX†mR~mWzncthYud_waRvkGrgA~nJxm=†m;ˆm7‚mCˆtC„gO‡mIoPŽtV›sL’€Wœ{K“‡]š‚XŽ‚S‡Š[„[˜†`„…^©‰a«Z©z^¢‰`™„T ƒT WŖF­ŒR¢€P¤‹VƉX±‰ZŸŠZŠZŸY–ŽėģŽāī–źäēēŠėŽ†åŪ‚ÜŚxŻŻtąŚ|×ĶzÓӄŁĒ‹ÓŠŠŹ†ŚĒyŅĪ†ĒĮ†ČĀ…ĒŌøæƒøĮ‰©±…Ŗ§z©¤ƒ Æƒ’­‰‰§Œ¢Š–Ŗ“”¢–Šš‡ˆŽ†ŠŒ‘€’x… }{¢{‚œ|‡¤ˆ£}¬~ƒŖ{¢Ž£{†Ŗnˆ­p{«w~£vƒ˜f|˜fs—_lŸdk£`c [k™cf [l˜OpŸSt™NmŠSu“Ln”Mp˜Lg”P^˜Cf›GvRxŠS|†W|„Svt\uobnsawpckqcfvUilSombti]uidokes`_he_ihMllKdsSfq^]sYh|NdsM`hM_f?baAbeJcuKZwD\nBRrBRp:Wa>Ue;V]9IY=MV:HSBN_>VYdcD]e=Z`AYkLagGmtJoqQkpgksmluoi|wftutuurtzqvƒvm„xg|c|c}sg‰qc„{j‹ye…{k‰|a{`‹mg•bc“akŠdg’iknq•al“fa“a^š_\‘kNbS†hN†tM‡rS†wZx[‹|_•pg‘nm‡ya~_uT‚tZunbwxf‚q^€lR|iU~qK‚lR{qJxuH~v8€k9‰r>iJŒrP†jQŒpLˆvQ’{V{S˜…TŸ}\™xd„Z’z_~g”vj”}ežƒa›‚a„|bŖ…\Œ\«…OŖŒM£‹QŖ…QŖ~VŖ…T±„_§Œc„…[Ÿˆ[„†QŸźóźī…ēąŠÜāˆåēŠåŻ‹ēå{āŁ‚ŌŪzŅĻˆĪŹˆŌʉÓÓ}ŠŠtŁĻzŃĄwĒĘyĖĪ»ĒˆµµŒ­¶‰µ®‚«°r«®ƒ¦°•¤‚›£}‡Š„Œ˜›Ž“›ƒ“ŽŒ“‘œ‡˜†Š¤Ž–…Ž¤y„¤‚Š¤„Š„€€£x…ØqŒž|Øp€ž~z™zu¢ws–pr—qx—b¢ei—hr XlRt¤ThžR{¤W{œQpNfNlšGb—Vm”MfŸLcŒPb“Si…KkxJt{RnsUiuYtwMhz]tnZby\tzWjwYvgXq_eze_tmWzhOftGivMk~WXnU[{K`kSWpC]q9__?__I[dCWpMYm9Sr;Qo?[a@Q\:Pc@TV8O]6YN1H[8Ld:S]1Sc.OX(P[*SU%fZfZnbrTsNnYzRZy] sSZuMxQ~Y*qO)K!VOvO|Sl]sVcVnYeQ"jV)hd*YVdU+dX*gc%Rb'[`.\b2]a2Xb7cj7]l5Zw=_gEfhHeo@lmI`m9bs9c€BVI^z9Uv<]aGe`Nc`A\bFbeJY]JbhHcgRaaSmeTuoXpspo|pn|fn|itwppuxpntrw‚h„wmt|cv|[…pf‡nd‚tb{yqpsŠ~m‰vfŽgdimŒmq“bl™ir“Ynœ[]Ž_[ j[yTrLgQƒj]mSŽp_w[”mb”tiu_ŽxU…zQzwW{sS€je€h\ˆmaƒgV}hJxcMxoR{pR†tEiK{vElH€tO‚pKmW‡tQ–nO“yV”}asXŸYŸ…O›{Oœ…axk“{dŸ‹]œ}i „i›}m¤„eŸf¢[­^žˆT©€`”ƒ^žU«‰S¢{\؂S„‚\¢ƒR˜Żń~ćķ{äģƒįŚŽß߉ėŻ…ßŪ„×įÜӂŲĻƒÕȂŌŅ‰ĻĢ„ĢĻ„ÖĘtÕĆĒĆyĀČ~ČĄ„½³|±±|²øv²·{ر„›®€›„ˆ’«~Œ£‡š|Œ•…•‘ƒ‘Ž–’œ’ˆ ’†ŸŒ† œ{Œ›v£yœwŠ„p‡Ÿnƒ”z‡š~| }Ÿvy˜ry›wvškƒŸa„”cƒž]r¢^kžYqØSw WxLp”Tt’OfˆFbNj‘Um”UlŠOhŽQeƒPcReqEvtEvpAmnJdsKisIgzZo{Zqt[poSxadw_cxc_wvTz{SrqEp}J`xQ[vTZzGSuGReFWj9Te4Qh?UgIchG`k?\oGWp=X`6U^3Vd4J[3OV7SP0OW2MY5RX(Ph#J]-Ma%]W!fWob k[lRqUlY paxfv\{Q pQqV!xW |J(sN'xQ&V rNlJnIpUm[hYc[dQ!\N#Q\"]\)]Q'`Z&Z\-P\.Rb3Xd/Ob+Qb6Th9Tm=[q:co5ag>mfKglGgt9Zs:bxG]{Cb{IZt>\o9_eEUe@YlGgiNciLdfJedPn]Sid`piiutdsomlvfxpbrsgyoisqlyfkey„nvzirx^€s\‚s`xi{uj‡usŒzgxiŒkt˜`n’\q“hr“`j^jš^kžmZ”oN‘vJ…p[‡w[†s[uT“vRŽnYŒudˆx]‘vR…T‚|M†Sxayn]l]ˆuY‰gL}cNxkJkPƒqT…mP„iFxoI}pG„rV‡kUŠf[‹qS”qQ‘q^šs]’}TzQ€K•€O„\žy^˜ƒ^”ˆf ‰f~k•{t™{k¢h ‚_”€X_Ÿ–\œ‹]”‚Z§€X yY§{W؋IJ¢’å߇čé‚čäīć‡ķŪ€ąßŚŅ~ŁŅäՂŲĪāՀŁĪ…ŁŹ…ŅŠvŲĆsŃĶĒĆ~ÉĀ…¾Ą{ŗ¹zøĮ~µæ¶°~Ÿ·{ž®„—Ŗ‡—Ÿ„§x•¤‰•–|‰…‰“‘Š–†š†•’•“‡œ—‡˜§w„sŖl‡žx„š|€œs„—o„œu…—z}—xˆ–j{l‹Ÿcœ^†œZ{”bz©cu Z| Tv—LoU|šXlŒMl‡Sl’Kj‘Rjˆ[`ˆTixW`pMgnBlvIuy?sqDszL|nBztT|vZwxWolStmZva]ziLtiTpxIlwJe{QdyIe~NVs?_mEWlCPp>Ik7MeELkDWl9ao9``6O^Tqan6gl=dnDhg=fsEWy@Y?f…IiKbwI]jLatL\nA`fLakGZdP[]Hd`Njd\gdeoebsj[pgelqkiwiordnulvilljux_qqdx{hmlesvhv~kvslqin|{l…yi‰gu‹al™anhg–hl™Yi”l_iY‰iS•vU‡rS‡waŽqb‹}[•~Z’w^oW”rc~]”zRŽ}Zˆ~M‰|SxvR{nVymV†mV}kKƒbSaKŒmK_W…rV‚oK}jP€v[f_m_‰uV‡vI‘oY”p[o\™~W”}V¢†X–{a•ygœj‘aŒk“yr yc£„n§†oœƒh§hš`¢‰_Ÿi—…f˜ˆZšvVžrQ©„PžIœ”āܓ䮏åŲ…ļą‰ģå†įŲ‡ęŪˆäŌ‡ćČxēŹtŁĘvŁÉwĪČxŃŠ}ŁĆ}ŅÅqŌ¾uŅ¼€ĻĀ€Č¼~»Ę†µ¾‚صƒ§¶†ž±‹˜®Š’ ’œœ†™—‰‘’ŽŽ‡Œ”ŠŒ‘”‹†–šˆ‘œˆš—ƒ “¢w‰¦r¤p€žr‚šr†›jŽœnˆœxˆ”xœsŠ–gƒœe‰ža^†£_xšVxXySv‘]wŒ_xOqHs„Ld‹Se‡Y[ƒT\†V`{HcqHfxGgsBjoHotArvG}zBsuFxnPwlGxiHllFqhRssNplHsmVjyRj~RbwCUs=XzE\@YzJQlIKk=I^CN_7Wh3Uf@[^[o@WlCYl;^vo€M{mLynUqoEpnDpcI|nKucMirKk|Cc€MlxEeyDRpDSw=SnHUl=TqHMg5Vi>Ii9Yl?UfEPo9F_7Hi+Dh0Kd3Bh*Ng5F]2GU0DP*QTBbUY PP\RYO ]JbSiIgQ cK_FbX uYdMlL#gGrR$kLjL!`N%gJ%^O^N&fCRD WN!]I+VQ(PI#TP!SB/GH7QL-[D/MA/OS&OP#SU&\b6bV5\a.[l;`i3f`BaiBYn=Zm>QsCXpBil:esIjgBcl>kgB_r;ggC`l?\iHSeTVh\WbXY\Zgfnol[ykexpjxue}sqrqovmbqodenft[ml^xdbzw^xt_‰op~}hwvw†tr…orzehhv‡hm—ad m^’l]ž_^—e^‹nhl[•ja‹mV}V‘qWœc’sežv\‘vf—uc‰~Z‰uZŽ~R†yPzRƒvOypR†xVƒyS€jF‚iT‚[E{gO‹mP€nXŒq[’jT€eT‰hctWˆr^—z[’}PzQ’wSyV•w^Ž|W˜‡Y›b™…l•i™†r–}u–€u–„u™ˆe”‰h˜c›ŠTd‘†Tž|ašxU“{S—~S˜R£‡R§Šóšˆõėƒżß‰ö掹Ų‹ōŁ„ėąƒč܃å悹Ų…čĶ‚ģæ‚äʼnāŠ†ßĖŽĻæ‡Ģ¼~ĆÄ|Ź¾}Ę“uĒ½z¾Āˆø¼„«³ƒ©­‚ž±‚¢§~ž„}—œ‡— ›•ˆ™„™Œ†¢–„Š˜™~•—‚Ž y¤u‡¦{ŽŖx¤s‡s„–o|œf„”h†‘m“™u˜r“‘c”j•™aˆc|œat—Wz[p›WrHwšKmSt”Rs‰NoƒTb‹bkŒcl}UpzKe€QlXguQvzCsv>j{Lg{Mt|HqqKgp?ej>uc8{f;rsHiqNbwHlzBh}AbwEPq?Kz3Mz>Oj=Rp9\h:On@Nh9Om6Vo8Jk;Cm3Mc#J_"TX,Na(Mc7Kc9NU)QV)PS%DWITPMNVZMUW `RcIgL^FZE_NnWoL_M#nTkW$k]#cS gJ dP ^P#`>%`B(YG^IRS%TI1NE+SE(GS)SN+WJ6]B2QJ,WS%T\+bb4`Y4QT-SW+[c4Wn4`m6_j>[sDVsAPpbd;fb@f`DbiC\`TTgSWlQUh_Qmb]jfac[ui^trctneuqcukxmfjffe\rqamlh|jk{jg€n\oaxp†wu€x}€gz|`iƒef•djša_œmcšm_Ÿda–daŒqbo]–h]’a^j^˜oZšxa™t[“oaxb‰vZq`—sUŽu_‡|Z€sV|iL€uY‚vW‡uQytMyfKbHƒeM‰nQ…{SŒvW’sV“j\‰ob†t]ŠwT“pV’tO‚X‰ŠSUŒ€][˜e™ˆg‘”e”qŠnŽ~o˜xk—~s’ƒq›Šh—†g™‘XœL›~Q›€U‘€PŒƒ\~Yž…Z¬Œ[؋õš€šķõč‹óę‰ņå‘ōā…śŁķę‰īį…ģŅ…ēāšÅ‹ßĮ~ŚŹ‹ŚĆ–ŃČƒÅ¾~¾Ē½Ä|Éŗ{æµ~Ę½€“Č°æ¦²…Ŗ®«©Žœ£ƒ˜œ‹”’‡””œ †ž›{؎§}›~‘œp†”tŠšv†œ}‚Ÿv’Ŗo“¤tŽ™fˆ™p‹ŸhŒ”v“”q˜q•f™c“ži•U€‘T‹‰X‰L„•Tv•TzšIu“Uf‰Lu…Ze‡[g’]kŒ_i{Zly[mxPbwUjQw~LxuIlrJf~@pnEliDnv8noFyp7vl8np=elFoj:l{3as:fz=Yo/Pn7Nn6Xg0Ug>^h3No1NfAJn.Hk,Gh/Ri7Pb/SZ%T^([d$UZ-O[4Pf4R[$W_$IXIMLZ VJNMXUVKgQdR`N]M gW mYfQbG$`R"eW#dQZ\&^R(_Dg@#b>,\;[;YD&TL&]QGR,KT"HR4HV8]L9SN+^W`]:iaHUeM`n\SjV_ifced_pb]pkmolseXxr`{gk€f_~ljto`gijghpa`liiymg„hctb‘ogŒsoŽkzŒtuz`z`oˆfl˜gnŽmeždežhY”i[–h[m`‰qb‹ef˜h_‹mT‘r\‹tZˆmW”qX…rQ‘}W–kX˜kZ—tex^„n\ˆhGƒiJ‚h[‡qO|fD‚iE{hP€nKrL‹w]–ySŽq`hg‹ob•}g†yZ‰„a†[‡x`‚†_‡`•~YŒ‡_šŒc}c‘Žg““i„zŠs‘k”ƒw—zj—…\—U“ŒU–†Y ‡MGŽ‡N™ƒWž‹Vš†JŖ‘W©īę‰ļę€öķ…šå†ńč‡ūŽƒ÷ā…÷ā€üą€š×÷Ļ‡ķƄßÉÕĢ„ĻӌŠĪŹĢ€Ä¾…ƵĮ¼}æø{ĄĀ~¼Ąƒŗ½‡Į·Šø¹‰©©Ø¤“«“–¢“Š ‰¤•~„Œ}«Ž‚§†«zŒ›|—q‹žmƒ˜p„œgƒ¢c†žd—Ÿh’œe˜šk’Œk‹ŽmŠ…t—‡r›‡m‘cšˆV”‹MŒ„NŒ‹K„’S}šVršMq–Qk›^fŽ]cŒRe‡XbˆQ_‚Vc‡Pg|Tn}Oq{Gz}KuuMmzAmrBon7co:frDpk%aDg>#hBaQ^YPT#SP3QR1WS/QF0YP8\]:Tg5V`6^T2bS1eN.]Z,a_3]f.fi9`f=VmF[gEYgKQlD]h8_b:^h@]h;gc;ah>YjGXfVWea`ea_jbgfb`iajtjqpeno^skYyf_pk^xj_tqnkik_ajafm\kral…lh‚v`km—hq‘^r…dv…\y‡_l[m•al‘c]žl\œuZ›m`“f]’fT’rR›l]’fU…qS‚yR‚t[†pUˆuS‹{Y–tZŸkY¢pb™th‰sbxZŒvO‡kGkO†gS‹fL‡oQ}tJ‚xJƒzTŽuS‰l[’sjmgta˜`„_š‡^–…iš}bŒ‡_…Z”W—…U•†_œkœ‹e•‘p•–r‹v‰†q”‚l‘ˆi™~[š~TœŠ\O•”N”’M”ŒL•M•‰F£ŽFŸ…R xłćˆźć†ēŪ€čę}śŻóŲ{śąƒōŌŠó慹Ū„ńŹ“åĶįĶąĘ‚ŃĒ•ŲŁÕĄ‹Ģ½ŠĮµ‹Å¼…ľ†¼“ƒ“ø|°»Œ²·‰µŖ¼§Ž©˜‰ŖšÆ•ŽØ‘”«˜†°ˆ§Š¬|ˆ§y‡ØƒŒžsŒ˜oŽžp„qŒ¦oŽ h”™b‘¢m— g™h‰“h•‡a‹“e’–m“[Š•S›…P–ˆS‘J‹‡[‹NQqœXdMdƒNcŒRk…Lf†Wa…[m~JtyVpzPguItpIyvMszCim8rwEck6ie6jh@dp=lh0so4sh;mm7bk6fq-Wp!Rq&LkVe)Zi \y-X‚9Ro.Ok,Ic,Hq(Wd'PZ-R^*J_NiY_,WkgkZjOc#Q\N^ XV _XORRMUUOO _JaT[UhZ _N_FeOVXUU"]SUKcL+bG&g@`@e5%^9&h>!fIbEQWF[OO#HL%TJ2M>-ZQ)\Z*d^,Yf;dY4dP5XU9Ma8V_ZsLNn>Si8Yb9dj9dd;[_G`lNa_N`qW\aYap_\fbXnb_j]kzgcvhoz\rnkuwbofmtkgpbpmog`jl[iebjqfg€oowa˜gb‘dvŽ_t‡ov†jnˆ\w‡cl‹[e_dšqc—uh mk”tb›gf“m\Žuhn`…d\†d`Žic‹md‰w]‘pQ”lWžxU—sY tg’|nŒmYŒoX‡kNgN†hK‹sPŒoFˆxP‡yQ€zLŠxN’yd‡uXvfŽ€UŠ}Y†‰\‰b†…iŠ†^†ƒi…vWƒU“ŠX“Šd‘\ž‰p‘r—ŽeŠ—f‰q†…f‘|c‘uk¢‰_˜‘ažˆU›‹P„”Y‘V‰G™•Tœ„R ^©sóävģć~éåīßxķÖvķÜzšŅśÖˆńįŒķŪ•ęՓäјīĒēĈąČŒŲŌ†ŁÉŒĪƅČŗŒæŗƒĘ½ƒ¾¶²¶‚“°Œ°Øˆ½Ø†Ā¦†·—Šø‘–²•©ŠÆŽ“ØŠ‹„„‡¦Šƒ¤ˆ~Š§ˆ¢xŒ—t„£iƒ„n‹žc˜hžd™ži•g“‹a•‰\Œ“hŽ“iŠ[—Š[–]Žc‘ŒXŠWŒP}To”\h–Yn†Gb…Nf…LcyXm}Up}LwxKjvRlkLuoGzqNrs>jv9ug;nd?ot5ar9av2co2pu3qq6ev5iu.Zu(Vp#SvWjcs_t&]|-S{&Ju$Jg+Qs1Sp-Pf$[h'QcOhKjWjcpcf!Wf$McKfP] YZXGYE]OYJ\O`J^U ZTePjQbHZR$a[]P#[V[P$_N ]E]9\Ad9b6Y="YK"[JJLGQOFKH'GB!NETP_L'ZY0\a2Xb.[\2Yg8Nc=JaANc?Z[7W]9akHamFVrGYqGXmI^a;_]Aih;]`CVfOXnN]jW]fLcoMfiaZse`k^endol\nvcwv`qvmuvhkkknktnfmrldedhemmplzmn‹ja‘blˆfp†mk’moŽdi”bret‘_ngr‡msŽrv’tr op¢hj’jstoŠf`ƒf`‹keŠddˆsX”p]”rb’rX•nX–qYye—viŽqb†v_fX“eO†sSpL†rJuK‰lOŠpJmQŠt[‰uYxX“€X…T‹ƒV’‚g‡‹o‡†iƒ‚]ˆxa†y[†YY‰ŒY“‡_”Žp’c“a“‚^d|_‘|i¢„`©‰[§ŒSŸT„‘S”“V–›Y—’R›•`Ŗ^©uöõ~ļć÷äīćrīéwõå{łŲ„ņօėӌīŌ˜ķՏćĻ’ēŌ˜äĢŠŁĮ“×ĖÖĢĖĀ‹ČĒ”ĆøĀ°·½}²°…ø¬~²Ø…Į¦‹“Ŗƒ¼”Ž®’—¶‰Œ°‰¦‡’§…Žž„€Ÿ„ˆÆ‹‹Ŗ…‹¤w„rŒ–u‘¢{‡›tŽšvš‘n”“n›”qœ—]•ŠZ™“[—•]•aŽ—_‡„bš“_—‹T–ŒQ’‹QŽyZy‡RtŒSw„PwwI|yGl‚Bl‰HuuMr€GpoNpsPjmIvsQvgDwn=jo1et?gm5ao/dc4cc,Zh%ds*ko"kg&eg#jh+`d"cpYlXs\i$`h*Rn$XgYi!Yp*KoMt!TjRk[m```hXleaYa^ZSV UWYP XG_DYM XMVVVS[R^T f`YPfN\JZUZSRM`TTNUDW7W9]B a@_8XKYHJRNQEGKG$OG#^K]F^R2]T%_^6_`:be3Lc5O[>Rk@Um8Uk8ObEShgf9a^6e`(bl$_o%_q'knbq$df!`ddbig^f_c`h$YoVl]f\i]k OlHgKjRfYqUo`_Vh[b ```W^PUNTQSI QK `QX[T^U\ [W aXW_P^ZXVR^N UU XL[MSM _B]AV= XG XN ^C]=TBSNQITLQOWJ\G[D)`N0aP2Z^.^b,W^:V_?Qa True window1 GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False True False True False 0 True True _File True True gtk-new True True gtk-open True True gtk-save True True gtk-save-as True True True gtk-quit True True _Edit True True gtk-cut True True gtk-copy True True gtk-paste True True gtk-delete True True _View True True _Help True True _About True 0 False False True True GTK_POLICY_ALWAYS GTK_POLICY_ALWAYS GTK_SHADOW_NONE GTK_CORNER_TOP_LEFT True True True GTK_JUSTIFY_LEFT GTK_WRAP_NONE True 0 0 0 0 0 0 0 True True lablgtk-2.18.8/examples/glade/glade_demo.ml0000644000175000017500000000264013460263323017572 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* An experiment on using libglade in lablgtk *) (* lablgladecc2 project1.glade > project1.ml *) #use "project1.ml";; class editor () = object (self) inherit window1 () method open_file () = let fs = GWindow.file_selection ~title:"Open file" ~modal:true () in fs#cancel_button#connect#clicked ~callback:fs#destroy; fs#ok_button#connect#clicked ~callback: begin fun () -> self#textview1#buffer#set_text ""; fs#destroy () end; fs#show () initializer self#bind ~name:"on_open1_activate" ~callback:self#open_file; self#bind ~name:"on_about1_activate" ~callback: (fun () -> prerr_endline "XXX") end let main () = let editor = new editor () in (* show bindings *) Glade.print_bindings stdout editor#xml; editor#window1#connect#destroy ~callback:GMain.quit; GMain.main () let _ = main () lablgtk-2.18.8/examples/glade/project1.gladep0000644000175000017500000000065413460263323020070 0ustar stephsteph glade_demo glade_demo FALSE FALSE FALSE FALSE lablgtk-2.18.8/examples/glade/project2.glade0000644000175000017500000003113613460263323017710 0ustar stephsteph True window1 GTK_WINDOW_TOPLEVEL GTK_WIN_POS_NONE False 150 True False True False 0 True 0 False False GTK_JUSTIFY_RIGHT False False 0.9 0.5 0 0 0 False False True 4 4 False 0 0 True True 4 True GTK_RELIEF_NORMAL 0 1 1 2 fill True True 5 True GTK_RELIEF_NORMAL 1 2 1 2 fill True True 6 True GTK_RELIEF_NORMAL 2 3 1 2 fill True True * True GTK_RELIEF_NORMAL 3 4 1 2 fill True True 1 True GTK_RELIEF_NORMAL 0 1 2 3 fill True True 2 True GTK_RELIEF_NORMAL 1 2 2 3 fill True True 3 True GTK_RELIEF_NORMAL 2 3 2 3 fill True True - True GTK_RELIEF_NORMAL 3 4 2 3 fill True True 0 True GTK_RELIEF_NORMAL 0 1 3 4 fill True True . True GTK_RELIEF_NORMAL 1 2 3 4 fill True True + True GTK_RELIEF_NORMAL 3 4 3 4 fill True True 7 True GTK_RELIEF_NORMAL 0 1 0 1 True True 9 True GTK_RELIEF_NORMAL 2 3 0 1 True True / True GTK_RELIEF_NORMAL 3 4 0 1 True True = True GTK_RELIEF_NORMAL 2 3 3 4 True True 8 True GTK_RELIEF_NORMAL 1 2 0 1 0 True True lablgtk-2.18.8/examples/glade/.cvsignore0000644000175000017500000000003013460263323017147 0ustar stephstephproject1.ml project2.ml lablgtk-2.18.8/examples/glade/gladecalc.ml0000644000175000017500000000465513460263323017421 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (* lablgladecc2 project2.glade > project2.ml *) #use "project2.ml";; let w1 = new window1 () let numbers = [| w1#button0; w1#button1; w1#button2; w1#button3; w1#button4; w1#button5; w1#button6; w1#button7; w1#button8; w1#button9 |] let label = w1#label1 type state = Input | Result let state = ref Result let pending = ref (fun x -> x) let insert_digit n = let prev = if !state = Result then "" else label#text in label#set_text (prev ^ string_of_int n); state := Input let get_float () = float_of_string label#text let insert_dot () = let prev = label#text in if not (String.contains prev '.') then label#set_text (prev ^ ".") let set_pending f = pending := f (get_float ()); state := Result let equals () = if !state = Input then label#set_text (string_of_float (!pending (get_float()))); state := Result let _ = for i = 0 to 9 do numbers.(i)#connect#clicked ~callback:(fun () -> insert_digit i) done; w1#button_dot#connect#clicked ~callback:insert_dot; List.iter ~f: begin fun (b, f) -> ignore (b#connect#clicked ~callback:(fun () -> set_pending f)) end [ w1#button_add, (+.); w1#button_sub, (-.); w1#button_mul, ( *. ); w1#button_div, (fun x y -> if y = 0. then 0. else x/.y) ]; w1#button_eq#connect#clicked ~callback:equals; w1#window1#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.string ev in if String.length key <> 1 then false else begin begin match key.[0] with | '0'..'9' -> insert_digit (int_of_string key) | '.' -> insert_dot () | '+' -> set_pending (+.) | '-' -> set_pending (-.) | '*' -> set_pending ( *. ) | '/' -> set_pending (fun x y -> if y = 0. then 0. else x/.y) | '=' -> equals () | 'q' -> GMain.Main.quit () | _ -> () end; true end end; GMain.Main.main () lablgtk-2.18.8/examples/glade/project2.gladep0000644000175000017500000000065213460263323020067 0ustar stephsteph gladecalc gladecalc FALSE FALSE FALSE FALSE lablgtk-2.18.8/examples/custom_tree.ml0000644000175000017500000001472613460263323016777 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* ../src/lablgtk2 -localdir custom_tree.ml *) let debug = false let () = if debug then begin Gc.set { (Gc.get()) with Gc.verbose = 0x00d; space_overhead = 0 }; ignore (Gc.create_alarm (fun () -> let s = Gc.stat () in Format.printf "blocks=%d words=%d@." s.Gc.live_blocks s.Gc.live_words)) end type finfo = { fname : string; mutable fchecked:bool } type file = { finfo: finfo; mutable globals: global array; fidx: int } and global = { gname: string; parent: file; gidx: int } type custom_tree = | File of file | Global of global let get_nb ct = match ct with | File{fidx=i}|Global{gidx=i} -> i (** The columns in our custom model *) let column_list = new GTree.column_list ;; let col_file = column_list#add Gobject.Data.caml;; let col_bool = column_list#add Gobject.Data.boolean;; let col_int = column_list#add Gobject.Data.int;; (** The custom model itself *) class custom_tree_class column_list = object (self) inherit [custom_tree,custom_tree,unit,unit] GTree.custom_tree_model column_list method custom_encode_iter cr = cr, (), () method custom_decode_iter cr () () = cr val mutable num_files : int = 0 val mutable rows : file array = [||] method custom_flags : GtkEnums.tree_model_flags list = [`ITERS_PERSIST] method custom_get_iter (path:Gtk.tree_path) : custom_tree option = let indices = GTree.Path.get_indices path in match indices with | [| file |] -> if file >= num_files || file < 0 then None else Some (File rows.(file)) | [| file; global |] -> if file >= num_files|| file < 0 then None else let globals = rows.(file).globals in if global >= Array.length globals || global < 0 then None else Some (Global globals.(global)) | _ -> None method custom_get_path (row:custom_tree) : Gtk.tree_path = match row with | File file -> GTree.Path.create [ file.fidx ] | Global global -> GTree.Path.create [ global.parent.fidx; global.gidx ] method custom_value (t:Gobject.g_type) (row:custom_tree) ~column = if column = 0 then `CAML (Obj.repr row) else if column = 1 then `BOOL (match row with File {finfo={fchecked=b}} -> b | _ -> false ) else if column = 2 then `INT (5+(get_nb row)) else assert false method custom_iter_next (row:custom_tree) : custom_tree option = match row with | File file -> if file.fidx < Array.length rows - 1 then Some (File (rows.(succ file.fidx))) else None | Global global -> let parent = global.parent in if global.gidx < Array.length parent.globals - 1 then Some (Global (parent.globals.(succ global.gidx))) else None method custom_iter_children (rowopt:custom_tree option) : custom_tree option = match rowopt with | None | Some (File { globals = [||] }) | Some (Global _) -> None | Some (File { globals = globals }) -> Some (Global globals.(0)) method custom_iter_has_child (row:custom_tree) : bool = match row with | File { globals = g } when Array.length g > 0 -> true | _ -> false method custom_iter_n_children (rowopt:custom_tree option) : int = match rowopt with | None -> Array.length rows | Some (Global _) -> 0 | Some (File { globals = g }) -> Array.length g method custom_iter_nth_child (rowopt:custom_tree option) (n:int) : custom_tree option = match rowopt with | None when Array.length rows > 0 -> Some (File rows.(0)) | Some (File { globals = g }) when n < Array.length g -> Some (Global g.(n)) | _ -> None method custom_iter_parent (row:custom_tree) : custom_tree option = match row with | File _ -> None | Global g -> Some (File g.parent) method append_file name global_names = let pos = num_files in let f = { finfo = name; globals = [||]; fidx = pos } in let globals = Array.mapi (fun i g -> { gname = g; parent = f; gidx = i }) global_names; in f.globals <- globals; num_files <- num_files + 1; rows <- Array.init num_files (fun n -> if n = num_files - 1 then f else rows.(n)) end let fill_model t = for i = 0 to 100 do let g = Array.init 100 (fun i -> "Son "^string_of_int i) in t#append_file {fname = ("Parent "^string_of_int i); fchecked = false} g done let create_view_and_model () : GTree.view = let custom_tree = new custom_tree_class column_list in fill_model custom_tree; let view = GTree.view ~model:custom_tree () in let renderer = GTree.cell_renderer_text [] in let col_name = GTree.view_column ~title:"Name" ~renderer:(renderer,["height",col_int]) () in col_name#set_cell_data_func renderer (fun model row -> try let data = model#get ~row ~column:col_file in match data with | File { finfo={fname = s} } | Global { gname = s } -> renderer#set_properties [ `TEXT s ]; with exn -> let s = GtkTree.TreePath.to_string (model#get_path row) in Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)); ignore (view#append_column col_name); let renderer = GTree.cell_renderer_toggle [] in let col_tog = GTree.view_column ~title:"Check" ~renderer:(renderer,["active", col_bool]) () in renderer#connect#toggled (fun path -> let row = custom_tree#custom_get_iter path in match row with | Some (File {finfo=f}) -> f.fchecked <- not f.fchecked | Some (Global _ ) -> Format.printf "Clearing %s@." (GtkTree.TreePath.to_string path); Format.printf "Global@." | _ -> ()); ignore (view#append_column col_tog); view let _ = ignore (GtkMain.Main.init ()); let window = GWindow.window ~width:200 ~height:400 () in ignore (window#event#connect#delete ~callback:(fun _ -> exit 0)); let scrollwin = GBin.scrolled_window ~packing:window#add () in let view = create_view_and_model () in scrollwin#add view#coerce; window#show (); GtkMain.Main.main () lablgtk-2.18.8/examples/signal_override.ml0000644000175000017500000000324413460263323017613 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) module C = Gobject.Closure let add_closure argv = Printf.eprintf "invoking overridden ::add closure, %d args, " argv.C.nargs ; let typ = C.get_type argv 1 in Printf.eprintf "widget %s\n" (Gobject.Type.name typ) ; flush stderr ; GtkSignal.chain_from_overridden argv let derived_frame_name = "GtkFrameCaml" let derived_frame_gtype = lazy begin let parent = Gobject.Type.from_name "GtkFrame" in let t = Gobject.Type.register_static ~parent ~name:derived_frame_name in GtkSignal.override_class_closure GtkBase.Container.S.add t (C.create add_closure) ; t end let create_derived_frame = GtkBin.Frame.make_params [] ~cont:(fun pl -> GContainer.pack_container pl ~create:(fun pl -> ignore (Lazy.force derived_frame_gtype) ; new GBin.frame (GtkObject.make derived_frame_name pl : Gtk.frame Gtk.obj))) let main = let w = GWindow.window ~title:"Overriding signals demo" () in w#connect#destroy GMain.quit ; let f = create_derived_frame ~label:"Talking frame" ~packing:w#add () in let l = GMisc.label ~markup:"This is the GtkFrame's content" ~packing:f#add () in w#show () ; GMain.main () lablgtk-2.18.8/examples/action.ml0000644000175000017500000001142113460263323015710 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let ui_info = "\ \

\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ " let activ_action ac = Printf.printf "Action '%s' activated\n" ac#name ; flush stdout let setup_stock () = let id = "demo-gtk-logo" in let logo = { GtkStock.stock_id = id ; GtkStock.label = "_GTK!" ; GtkStock.modifier = [] ; GtkStock.keyval= 0 ; } in GtkStock.Item.add logo ; if Sys.file_exists "/usr/share/gtk-2.0/demo/gtk-logo-rgb.gif" then begin let pb = GdkPixbuf.from_file "/usr/share/gtk-2.0/demo/gtk-logo-rgb.gif" in let pb = GdkPixbuf.add_alpha ~transparent:(0xff, 0xff, 0xff) pb in GtkStock.make_icon_factory ~default:true ~icons:[ `STOCK id, GtkStock.make_icon_set ~pixbuf:pb [] ] () ; () end let setup_ui window = let a = GAction.add_action in let ta = GAction.add_toggle_action in let radio = GAction.group_radio_actions in let ra = GAction.add_radio_action in let actions = GAction.action_group ~name:"Actions" () in GAction.add_actions actions [ a "FileMenu" ~label:"_File" ; a "PreferencesMenu" ~label:"_Preferences" ; a "ColorMenu" ~label:"_Color" ; a "ShapeMenu" ~label:"_Shape" ; a "HelpMenu" ~label:"_Help" ; a "New" ~stock:`NEW ~tooltip:"Create a new file" ~callback:activ_action ; a "Open" ~stock:`OPEN ~tooltip:"Open a file" ~callback:activ_action ; a "Save" ~stock:`SAVE ~tooltip:"Save current file" ~callback:activ_action ; a "SaveAs" ~stock:`SAVE_AS ~tooltip:"Save to a file" ~callback:activ_action ; a "Quit" ~stock:`QUIT ~tooltip:"Quit" ~callback:activ_action ; a "About" ~label:"_About" ~accel:"A" ~tooltip:"About" ~callback:activ_action ; a "Logo" ~stock:(`STOCK "demo-gtk-logo") ~tooltip:"GTK+" ~callback:activ_action ; ta "Bold" ~stock:`BOLD ~label:"_Bold" ~accel:"B" ~tooltip:"Bold" ~callback:activ_action ~active:true ; radio ~init_value:0 ~callback:(fun n -> Printf.printf "radio action %d\n%!" n) [ ra "Red" 0 ~label:"_Red" ~tooltip:"Blood" ~accel:"R" ; ra "Green" 1 ~label:"_Green" ~tooltip:"Grass" ~accel:"G" ; ra "Blue" 2 ~label:"_Blue" ~tooltip:"Sky" ~accel:"B" ; ] ; radio ~init_value:2 ~callback:(fun n -> Printf.printf "radio action %d\n%!" n) [ ra "Square" 0 ~label:"_Square" ~tooltip:"Square" ~accel:"S" ; ra "Rectangle" 1 ~label:"_Rectangle" ~tooltip:"Rectangle" ~accel:"R" ; ra "Oval" 2 ~label:"_Oval" ~tooltip:"Egg" ~accel:"O" ; ] ] ; let ui_m = GAction.ui_manager () in ui_m#insert_action_group actions 0 ; window#add_accel_group ui_m#get_accel_group ; ui_m#add_ui_from_string ui_info ; let box1 = GPack.vbox ~packing:window#add () in box1#pack (ui_m#get_widget "/MenuBar") ; box1#pack (ui_m#get_widget "/ToolBar") ; GMisc.label ~text:"Type\n\nto start" ~xalign:0.5 ~yalign:0.5 ~width:200 ~height:200 ~packing:box1#pack () ; GMisc.separator `HORIZONTAL ~packing:box1#pack () ; let b = GButton.button ~stock:`CLOSE ~packing:box1#pack () in b#connect#clicked window#destroy ; b#misc#set_can_default true ; b#misc#grab_default () let main () = let w = GWindow.window ~title:"UI Manager" () in w#connect#destroy GMain.quit ; setup_stock () ; setup_ui w ; w#show () ; GMain.main () let _ = main () (* Local Variables: *) (* compile-command: "ocamlc -I ../src -w s lablgtk.cma gtkInit.cmo action.ml" *) (* End: *) lablgtk-2.18.8/examples/text/0000755000175000017500000000000013523300020015050 5ustar stephstephlablgtk-2.18.8/examples/text/unicode_table.ml0000644000175000017500000000276313460263323020225 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let start = try int_of_string Sys.argv.(1) with _ -> prerr_endline "Usage : unicode_table "; exit 1 ;; let stop = try int_of_string Sys.argv.(2) with _ -> prerr_endline "Usage : unicode_table "; exit 1 ;; GtkMain.Main.init ();; let main () = let w = GWindow.window ~width:640 ~height:480 ~title:"2)view_with_buffer" () in let sw = GBin.scrolled_window ~packing:(w#add) () in let b = GText.buffer () in b#set_text (Printf.sprintf "Unicode characters from %d to %d Click to continue\n" start stop); let font = Pango.Font.from_string "Sans 15" in let tv = GText.view ~buffer:b ~packing:(sw#add) () in let _ = tv#misc#modify_font font in ignore (tv#event#connect#button_release ~callback: (fun _ -> for i=start to stop do let c = Printf.sprintf "%d:%s:\n" i (Glib.Utf8.from_unichar i) in b#insert c done;false)); w#show ();; main () ;; GMain.Main.main ();; lablgtk-2.18.8/examples/text/test.txt0000644000175000017500000003223713460263323016615 0ustar stephstephUTF-8 encoded sample plain-text file ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ā€¾ Markus Kuhn [ĖˆmaŹ³kŹŠs kuĖn] ā€” 1999-08-20 The ASCII compatible UTF-8 encoding of ISO 10646 and Unicode plain-text files is defined in RFC 2279 and in ISO 10646-1 Annex R. Using Unicode/UTF-8, you can write in emails and source code things such as Mathematics and Sciences: āˆ® Eā‹…da = Q, n ā†’ āˆž, āˆ‘ f(i) = āˆ g(i), āˆ€xāˆˆā„: āŒˆxāŒ‰ = āˆ’āŒŠāˆ’xāŒ‹, Ī± āˆ§ Ā¬Ī² = Ā¬(Ā¬Ī± āˆØ Ī²), ā„• āŠ† ā„•ā‚€ āŠ‚ ā„¤ āŠ‚ ā„š āŠ‚ ā„ āŠ‚ ā„‚, āŠ„ < a ā‰  b ā‰” c ā‰¤ d ā‰Ŗ āŠ¤ ā‡’ (A ā‡” B), 2Hā‚‚ + Oā‚‚ ā‡Œ 2Hā‚‚O, R = 4.7 kĪ©, āŒ€ 200 mm Linguistics and dictionaries: Ć°i ıntəĖˆnƦŹƒÉ™nəl fəĖˆnɛtık əsoŹŠsiĖˆeıŹƒn Y [ĖˆŹpsilɔn], Yen [jɛn], Yoga [ĖˆjoĖgɑ] APL: ((Vā³V)=ā³ā“V)/Vā†,V āŒ·ā†ā³ā†’ā“āˆ†āˆ‡āŠƒā€¾āŽā•āŒˆ Nicer typography in plain text files: ā•”ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•— ā•‘ ā•‘ ā•‘ ā€¢ ā€˜singleā€™ and ā€œdoubleā€ quotes ā•‘ ā•‘ ā•‘ ā•‘ ā€¢ Curly apostrophes: ā€œWeā€™ve been hereā€ ā•‘ ā•‘ ā•‘ ā•‘ ā€¢ Latin-1 apostrophe and accents: 'Ā“` ā•‘ ā•‘ ā•‘ ā•‘ ā€¢ ā€šdeutscheā€˜ ā€žAnfĆ¼hrungszeichenā€œ ā•‘ ā•‘ ā•‘ ā•‘ ā€¢ ā€ , ā€”, ā€°, ā€¢, 3ā€“4, ā€”, āˆ’5/+5, ā„¢, ā€¦ ā•‘ ā•‘ ā•‘ ā•‘ ā€¢ ASCII safety test: 1lI|, 0OD, 8B ā•‘ ā•‘ ā•­ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā•® ā•‘ ā•‘ ā€¢ the euro symbol: ā”‚ 14.95 ā‚¬ ā”‚ ā•‘ ā•‘ ā•°ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā”€ā•Æ ā•‘ ā•šā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā•ā• Combining characters: STARGĪ›ĢŠTE SG-1, a = vĢ‡ = rĢˆ, aāƒ‘ āŠ„ bāƒ‘ Greek (in Polytonic): The Greek anthem: Ī£į½² Ī³Ī½Ļ‰Ļį½·Ī¶Ļ‰ į¼€Ļ€į½ø Ļ„į½“Ī½ Īŗį½¹ĻˆĪ· Ļ„Īæįæ¦ ĻƒĻ€Ī±ĪøĪ¹Īæįæ¦ Ļ„į½“Ī½ Ļ„ĻĪæĪ¼ĪµĻį½µ, Ļƒį½² Ī³Ī½Ļ‰Ļį½·Ī¶Ļ‰ į¼€Ļ€į½ø Ļ„į½“Ī½ į½„ĻˆĪ· Ļ€Īæį½ŗ Ī¼į½² Ī²į½·Ī± Ī¼ĪµĻ„Ļį½±ĪµĪ¹ Ļ„į½“ Ī³įæ†. į¾æĪ‘Ļ€į¾æ Ļ„į½° Īŗį½¹ĪŗĪŗĪ±Ī»Ī± Ī²Ī³Ī±Ī»Ī¼į½³Ī½Ī· Ļ„įæ¶Ī½ įæ¾Ī•Ī»Ī»į½µĪ½Ļ‰Ī½ Ļ„į½° į¼±ĪµĻį½± ĪŗĪ±į½¶ Ļƒį½°Ī½ Ļ€Ļįæ¶Ļ„Ī± į¼€Ī½Ī“ĻĪµĪ¹Ļ‰Ī¼į½³Ī½Ī· Ļ‡Ī±įæ–ĻĪµ, į½¦ Ļ‡Ī±įæ–ĻĪµ, į¾æĪ•Ī»ĪµĻ…ĪøĪµĻĪ¹į½±! From a speech of Demosthenes in the 4th century BC: ĪŸį½Ļ‡į½¶ Ļ„Ī±į½Ļ„į½° Ļ€Ī±Ļį½·ĻƒĻ„Ī±Ļ„Ī±į½· Ī¼ĪæĪ¹ Ī³Ī¹Ī³Ī½į½½ĻƒĪŗĪµĪ¹Ī½, į½¦ į¼„Ī½Ī“ĻĪµĻ‚ į¾æĪ‘ĪøĪ·Ī½Ī±įæ–ĪæĪ¹, į½…Ļ„Ī±Ī½ Ļ„į¾æ Īµį¼°Ļ‚ Ļ„į½° Ļ€Ļį½±Ī³Ī¼Ī±Ļ„Ī± į¼€Ļ€ĪæĪ²Ī»į½³ĻˆĻ‰ ĪŗĪ±į½¶ į½…Ļ„Ī±Ī½ Ļ€Ļį½øĻ‚ Ļ„Īæį½ŗĻ‚ Ī»į½¹Ī³ĪæĻ…Ļ‚ Īæį½“Ļ‚ į¼€ĪŗĪæį½»Ļ‰Ī‡ Ļ„Īæį½ŗĻ‚ Ī¼į½²Ī½ Ī³į½°Ļ Ī»į½¹Ī³ĪæĻ…Ļ‚ Ļ€ĪµĻį½¶ Ļ„Īæįæ¦ Ļ„Ī¹Ī¼Ļ‰Ļį½µĻƒĪ±ĻƒĪøĪ±Ī¹ Ī¦į½·Ī»Ī¹Ļ€Ļ€ĪæĪ½ į½Ļįæ¶ Ī³Ī¹Ī³Ī½ĪæĪ¼į½³Ī½ĪæĻ…Ļ‚, Ļ„į½° Ī“į½² Ļ€Ļį½±Ī³Ī¼Ī±Ļ„į¾æ Īµį¼°Ļ‚ Ļ„Īæįæ¦Ļ„Īæ Ļ€ĻĪæį½µĪŗĪæĪ½Ļ„Ī±, į½„ĻƒĪøį¾æ į½…Ļ€Ļ‰Ļ‚ Ī¼į½“ Ļ€ĪµĪ¹Ļƒį½¹Ī¼ĪµĪøį¾æ Ī±į½Ļ„Īæį½¶ Ļ€Ļį½¹Ļ„ĪµĻĪæĪ½ ĪŗĪ±Īŗįæ¶Ļ‚ ĻƒĪŗį½³ĻˆĪ±ĻƒĪøĪ±Ī¹ Ī“į½³ĪæĪ½. Īæį½Ī“į½³Ī½ Īæį½–Ī½ į¼„Ī»Ī»Īæ Ī¼ĪæĪ¹ Ī“ĪæĪŗĪæįæ¦ĻƒĪ¹Ī½ Īæį¼± Ļ„į½° Ļ„ĪæĪ¹Ī±įæ¦Ļ„Ī± Ī»į½³Ī³ĪæĪ½Ļ„ĪµĻ‚ į¼¢ Ļ„į½“Ī½ į½‘Ļ€į½¹ĪøĪµĻƒĪ¹Ī½, Ļ€ĪµĻį½¶ į¼§Ļ‚ Ī²ĪæĻ…Ī»Īµį½»ĪµĻƒĪøĪ±Ī¹, Īæį½Ļ‡į½¶ Ļ„į½“Ī½ Īæį½–ĻƒĪ±Ī½ Ļ€Ī±ĻĪ¹ĻƒĻ„į½±Ī½Ļ„ĪµĻ‚ į½‘Ī¼įæ–Ī½ į¼Ī¼Ī±ĻĻ„į½±Ī½ĪµĪ¹Ī½. į¼Ī³į½¼ Ī“į½³, į½…Ļ„Ī¹ Ī¼į½³Ī½ Ļ€ĪæĻ„į¾æ į¼Ī¾įæ†Ī½ Ļ„įæ‡ Ļ€į½¹Ī»ĪµĪ¹ ĪŗĪ±į½¶ Ļ„į½° Ī±į½‘Ļ„įæ†Ļ‚ į¼”Ļ‡ĪµĪ¹Ī½ į¼€ĻƒĻ†Ī±Ī»įæ¶Ļ‚ ĪŗĪ±į½¶ Ī¦į½·Ī»Ī¹Ļ€Ļ€ĪæĪ½ Ļ„Ī¹Ī¼Ļ‰Ļį½µĻƒĪ±ĻƒĪøĪ±Ī¹, ĪŗĪ±į½¶ Ī¼į½±Ī»į¾æ į¼€ĪŗĻĪ¹Ī²įæ¶Ļ‚ Īæį¼¶Ī“Ī±Ī‡ į¼Ļ€į¾æ į¼Ī¼Īæįæ¦ Ī³į½±Ļ, Īæį½ Ļ€į½±Ī»Ī±Ī¹ Ī³į½³Ī³ĪæĪ½ĪµĪ½ Ļ„Ī±įæ¦Ļ„į¾æ į¼€Ī¼Ļ†į½¹Ļ„ĪµĻĪ±Ī‡ Ī½įæ¦Ī½ Ī¼į½³Ī½Ļ„ĪæĪ¹ Ļ€į½³Ļ€ĪµĪ¹ĻƒĪ¼Ī±Ī¹ Ļ„Īæįæ¦Īøį¾æ į¼±ĪŗĪ±Ī½į½øĪ½ Ļ€ĻĪæĪ»Ī±Ī²Īµįæ–Ī½ į¼”Ī¼įæ–Ī½ Īµį¼¶Ī½Ī±Ī¹ Ļ„į½“Ī½ Ļ€Ļį½½Ļ„Ī·Ī½, į½…Ļ€Ļ‰Ļ‚ Ļ„Īæį½ŗĻ‚ ĻƒĻ…Ī¼Ī¼į½±Ļ‡ĪæĻ…Ļ‚ Ļƒį½½ĻƒĪæĪ¼ĪµĪ½. į¼į½°Ī½ Ī³į½°Ļ Ļ„Īæįæ¦Ļ„Īæ Ī²ĪµĪ²Ī±į½·Ļ‰Ļ‚ į½‘Ļ€į½±ĻĪ¾įæƒ, Ļ„į½¹Ļ„Īµ ĪŗĪ±į½¶ Ļ€ĪµĻį½¶ Ļ„Īæįæ¦ Ļ„į½·Ī½Ī± Ļ„Ī¹Ī¼Ļ‰Ļį½µĻƒĪµĻ„Ī±į½· Ļ„Ī¹Ļ‚ ĪŗĪ±į½¶ į½ƒĪ½ Ļ„Ļį½¹Ļ€ĪæĪ½ į¼Ī¾į½³ĻƒĻ„Ī±Ī¹ ĻƒĪŗĪæĻ€Īµįæ–Ī½Ī‡ Ļ€Ļį½¶Ī½ Ī“į½² Ļ„į½“Ī½ į¼€ĻĻ‡į½“Ī½ į½€ĻĪøįæ¶Ļ‚ į½‘Ļ€ĪæĪøį½³ĻƒĪøĪ±Ī¹, Ī¼į½±Ļ„Ī±Ī¹ĪæĪ½ į¼”Ī³Īæįæ¦Ī¼Ī±Ī¹ Ļ€ĪµĻį½¶ Ļ„įæ†Ļ‚ Ļ„ĪµĪ»ĪµĻ…Ļ„įæ†Ļ‚ į½Ī½Ļ„Ī¹Ī½Īæįæ¦Ī½ Ļ€ĪæĪ¹Īµįæ–ĻƒĪøĪ±Ī¹ Ī»į½¹Ī³ĪæĪ½. Ī”Ī·Ī¼ĪæĻƒĪøį½³Ī½ĪæĻ…Ļ‚, Ī“įæ½ į¾æĪŸĪ»Ļ…Ī½ĪøĪ¹Ī±Īŗį½øĻ‚ Georgian: From a Unicode conference invitation: įƒ’įƒ—įƒ®įƒįƒ•įƒ— įƒįƒ®įƒšįƒįƒ•įƒ” įƒ’įƒįƒ˜įƒįƒ įƒįƒ— įƒ įƒ”įƒ’įƒ˜įƒ”įƒ¢įƒ įƒįƒŖįƒ˜įƒ Unicode-įƒ˜įƒ” įƒ›įƒ”įƒįƒ—įƒ” įƒ”įƒįƒ”įƒ įƒ—įƒįƒØįƒįƒ įƒ˜įƒ”įƒ įƒ™įƒįƒœįƒ¤įƒ”įƒ įƒ”įƒœįƒŖįƒ˜įƒįƒ–įƒ” įƒ“įƒįƒ”įƒįƒ”įƒ¬įƒ įƒ”įƒ‘įƒįƒ“, įƒ įƒįƒ›įƒ”įƒšįƒ˜įƒŖ įƒ’įƒįƒ˜įƒ›įƒįƒ įƒ—įƒ”įƒ‘įƒ 10-12 įƒ›įƒįƒ įƒ¢įƒ”, įƒ„. įƒ›įƒįƒ˜įƒœįƒŖįƒØįƒ˜, įƒ’įƒ”įƒ įƒ›įƒįƒœįƒ˜įƒįƒØįƒ˜. įƒ™įƒįƒœįƒ¤įƒ”įƒ įƒ”įƒœįƒŖįƒ˜įƒ įƒØįƒ”įƒ°įƒ™įƒ įƒ”įƒ‘įƒ” įƒ”įƒ įƒ—įƒįƒ“ įƒ›įƒ”įƒįƒ¤įƒšįƒ˜įƒįƒ” įƒ”įƒ„įƒ”įƒžįƒ”įƒ įƒ¢įƒ”įƒ‘įƒ” įƒ˜įƒ”įƒ”įƒ— įƒ“įƒįƒ įƒ’įƒ”įƒ‘įƒØįƒ˜ įƒ įƒįƒ’įƒįƒ įƒ˜įƒŖįƒįƒ įƒ˜įƒœįƒ¢įƒ”įƒ įƒœįƒ”įƒ¢įƒ˜ įƒ“įƒ Unicode-įƒ˜, įƒ˜įƒœįƒ¢įƒ”įƒ įƒœįƒįƒŖįƒ˜įƒįƒœįƒįƒšįƒ˜įƒ–įƒįƒŖįƒ˜įƒ įƒ“įƒ įƒšįƒįƒ™įƒįƒšįƒ˜įƒ–įƒįƒŖįƒ˜įƒ, Unicode-įƒ˜įƒ” įƒ’įƒįƒ›įƒįƒ§įƒ”įƒœįƒ”įƒ‘įƒ įƒįƒžįƒ”įƒ įƒįƒŖįƒ˜įƒ£įƒš įƒ”įƒ˜įƒ”įƒ¢įƒ”įƒ›įƒ”įƒ‘įƒ”įƒ, įƒ“įƒ įƒ’įƒįƒ›įƒįƒ§įƒ”įƒœįƒ”įƒ‘įƒ˜įƒ— įƒžįƒ įƒįƒ’įƒ įƒįƒ›įƒ”įƒ‘įƒØįƒ˜, įƒØįƒ įƒ˜įƒ¤įƒ¢įƒ”įƒ‘įƒØįƒ˜, įƒ¢įƒ”įƒ„įƒ”įƒ¢įƒ”įƒ‘įƒ˜įƒ” įƒ“įƒįƒ›įƒ£įƒØįƒįƒ•įƒ”įƒ‘įƒįƒ”įƒ įƒ“įƒ įƒ›įƒ įƒįƒ•įƒįƒšįƒ”įƒœįƒįƒ•įƒįƒœ įƒ™įƒįƒ›įƒžįƒ˜įƒ£įƒ¢įƒ”įƒ įƒ£įƒš įƒ”įƒ˜įƒ”įƒ¢įƒ”įƒ›įƒ”įƒ‘įƒØįƒ˜. Russian: From a Unicode conference invitation: Š—Š°Ń€ŠµŠ³ŠøстрŠøруŠ¹Ń‚ŠµŃŃŒ сŠµŠ¹Ń‡Š°Ń Š½Š° Š”ŠµŃŃŃ‚ŃƒŃŽ ŠœŠµŠ¶Š“уŠ½Š°Ń€Š¾Š“Š½ŃƒŃŽ ŠšŠ¾Š½Ń„ŠµŃ€ŠµŠ½Ń†Šøю ŠæŠ¾ Unicode, ŠŗŠ¾Ń‚Š¾Ń€Š°Ń сŠ¾ŃŃ‚Š¾Šøтся 10-12 Š¼Š°Ń€Ń‚Š° 1997 Š³Š¾Š“Š° Š² ŠœŠ°Š¹Š½Ń†Šµ Š² Š“ŠµŃ€Š¼Š°Š½ŠøŠø. ŠšŠ¾Š½Ń„ŠµŃ€ŠµŠ½Ń†Šøя сŠ¾Š±ŠµŃ€ŠµŃ‚ шŠøрŠ¾ŠŗŠøŠ¹ ŠŗруŠ³ эŠŗсŠæŠµŃ€Ń‚Š¾Š² ŠæŠ¾ Š²Š¾ŠæрŠ¾ŃŠ°Š¼ Š³Š»Š¾Š±Š°Š»ŃŒŠ½Š¾Š³Š¾ Š˜Š½Ń‚ŠµŃ€Š½ŠµŃ‚Š° Šø Unicode, Š»Š¾ŠŗŠ°Š»ŠøŠ·Š°Ń†ŠøŠø Šø ŠøŠ½Ń‚ŠµŃ€Š½Š°Ń†ŠøŠ¾Š½Š°Š»ŠøŠ·Š°Ń†ŠøŠø, Š²Š¾ŠæŠ»Š¾Ń‰ŠµŠ½Šøю Šø ŠæрŠøŠ¼ŠµŠ½ŠµŠ½Šøю Unicode Š² рŠ°Š·Š»ŠøчŠ½Ń‹Ń… Š¾ŠæŠµŃ€Š°Ń†ŠøŠ¾Š½Š½Ń‹Ń… сŠøстŠµŠ¼Š°Ń… Šø ŠæрŠ¾Š³Ń€Š°Š¼Š¼Š½Ń‹Ń… ŠæрŠøŠ»Š¾Š¶ŠµŠ½Šøях, шрŠøфтŠ°Ń…, Š²ŠµŃ€ŃŃ‚ŠŗŠµ Šø Š¼Š½Š¾Š³Š¾ŃŠ·Ń‹Ń‡Š½Ń‹Ń… ŠŗŠ¾Š¼ŠæьютŠµŃ€Š½Ń‹Ń… сŠøстŠµŠ¼Š°Ń…. Thai (UCS Level 2): Excerpt from a poetry on The Romance of The Three Kingdoms (a Chinese classic 'San Gua'): [----------------------------|------------------------] ą¹ ą¹ąøœą¹ˆąø™ąø”ąø“ąø™ąø®ąø±ą¹ˆąø™ą¹€ąøŖąø·ą¹ˆąø­ąø”ą¹‚ąø—ąø£ąø”ą¹ąøŖąø™ąøŖąø±ąø‡ą¹€ąø§ąøŠ ąøžąø£ąø°ąø›ąøą¹€ąøąøØąøąø­ąø‡ąøšąø¹ą¹Šąøąø¹ą¹‰ąø‚ąø¶ą¹‰ąø™ą¹ƒąø«ąø”ą¹ˆ ąøŖąø“ąøšąøŖąø­ąø‡ąøąø©ąø±ąø•ąø£ąø“ąø¢ą¹Œąøą¹ˆąø­ąø™ąø«ąø™ą¹‰ąø²ą¹ąø„ąø–ąø±ąø”ą¹„ąø› ąøŖąø­ąø‡ąø­ąø‡ąø„ą¹Œą¹„ąø‹ąø£ą¹‰ą¹‚ąø‡ą¹ˆą¹€ąø‚ąø„ąø²ą¹€ąøšąø²ąø›ąø±ąøąøąø² ąø—ąø£ąø‡ąø™ąø±ąøšąø–ąø·ąø­ąø‚ąø±ąø™ąø—ąøµą¹€ąø›ą¹‡ąø™ąø—ąøµą¹ˆąøžąø¶ą¹ˆąø‡ ąøšą¹‰ąø²ąø™ą¹€ąø”ąø·ąø­ąø‡ąøˆąø¶ąø‡ąø§ąø“ąø›ąø£ąø“ąø•ą¹€ąø›ą¹‡ąø™ąø™ąø±ąøąø«ąø™ąø² ą¹‚ąø®ąøˆąø“ą¹‹ąø™ą¹€ąø£ąøµąø¢ąøąø—ąø±ąøžąø—ąø±ą¹ˆąø§ąø«ąø±ąø§ą¹€ąø”ąø·ąø­ąø‡ąø”ąø² ąø«ąø”ąø²ąø¢ąøˆąø°ąø†ą¹ˆąø²ąø”ąø”ąøŠąø±ą¹ˆąø§ąø•ąø±ąø§ąøŖąø³ąø„ąø±ąø ą¹€ąø«ąø”ąø·ąø­ąø™ąø‚ąø±ąøšą¹„ąøŖą¹„ąø„ą¹ˆą¹€ąøŖąø·ąø­ąøˆąø²ąøą¹€ąø„ąø«ąø² ąø£ąø±ąøšąø«ąø”ąø²ąø›ą¹ˆąø²ą¹€ąø‚ą¹‰ąø²ąø”ąø²ą¹€ąø„ąø¢ąø­ąø²ąøŖąø±ąø ąøą¹ˆąø²ąø¢ąø­ą¹‰ąø­ąø‡ąø­ąøøą¹‰ąø™ąø¢ąøøą¹ąø¢ąøą¹ƒąø«ą¹‰ą¹ąø•ąøąøąø±ąø™ ą¹ƒąøŠą¹‰ąøŖąø²ąø§ąø™ąø±ą¹‰ąø™ą¹€ąø›ą¹‡ąø™ąøŠąø™ąø§ąø™ąøŠąø·ą¹ˆąø™ąøŠąø§ąø™ą¹ƒąøˆ ąøžąø„ąø±ąø™ąø„ąø“ąø‰ąøøąø¢ąøąøøąø¢ąøąøµąøąø„ąø±ąøšąøą¹ˆąø­ą¹€ąø«ąø•ąøø ąøŠą¹ˆąø²ąø‡ąø­ąø²ą¹€ąøžąøØąøˆąø£ąø“ąø‡ąø«ąø™ąø²ąøŸą¹‰ąø²ąø£ą¹‰ąø­ąø‡ą¹„ąø«ą¹‰ ąø•ą¹‰ąø­ąø‡ąø£ąøšąø£ąø²ąø†ą¹ˆąø²ąøŸąø±ąø™ąøˆąø™ąøšąø£ąø£ąø„ąø±ąø¢ ąø¤ą¹…ąø«ąø²ą¹ƒąø„ąø£ąø„ą¹‰ąø³ąøŠąø¹ąøąø¹ą¹‰ąøšąø£ąø£ąø„ąø±ąø‡ąøą¹Œ ąøÆ (The above is a two-column text. If combining characters are handled correctly, the lines of the second column should be aligned with the | character above.) Ethiopian: Proverbs in the Amharic language: įˆ°įˆ›į‹­ įŠ į‹­į‰³įˆØįˆµ įŠ•įŒ‰įˆ„ įŠ į‹­įŠØįˆ°įˆµį¢ į‰„įˆ‹ įŠ«įˆˆįŠ įŠ„įŠ•į‹°įŠ į‰£į‰“ į‰ į‰†įˆ˜įŒ įŠį¢ įŒŒįŒ„ į‹«įˆˆį‰¤į‰± į‰įˆįŒ„įŠ“ įŠį‹į¢ į‹°įˆ€ į‰ įˆ•įˆįˆ™ į‰…į‰¤ į‰£į‹­įŒ įŒ£ įŠ•įŒ£į‰µ į‰ įŒˆį‹°įˆˆį‹į¢ į‹ØįŠ į į‹ˆįˆˆįˆį‰³ į‰ į‰…į‰¤ įŠ į‹­į‰³įˆ½įˆį¢ įŠ į‹­įŒ„ į‰ į‰ įˆ‹ į‹³į‹‹ į‰°įˆ˜į‰³į¢ įˆ²į‰°įˆØįŒ‰įˆ™ į‹­į‹°įˆØįŒįˆ™į¢ į‰€įˆµ į‰ į‰€įˆµį„ į‹•įŠ•į‰įˆ‹įˆ į‰ įŠ„įŒįˆ© į‹­įˆ„į‹³įˆį¢ į‹µįˆ­ į‰¢į‹«į‰„įˆ­ įŠ įŠ•į‰ įˆ³ į‹«įˆµįˆ­į¢ įˆ°į‹ įŠ„įŠ•į‹°į‰¤į‰± įŠ„įŠ•įŒ… įŠ„įŠ•į‹° įŒ‰įˆØį‰¤į‰± įŠ į‹­į‰°į‹³į‹°įˆ­įˆį¢ įŠ„įŒį‹œįˆ­ į‹ØįŠØįˆį‰°į‹įŠ• įŒ‰įˆ®įˆ® įˆ³į‹­į‹˜įŒ‹į‹ įŠ į‹­į‹µįˆ­įˆį¢ į‹ØįŒŽįˆØį‰¤į‰µ įˆŒį‰£į„ į‰¢į‹«į‹©į‰µ į‹­įˆµį‰… į‰£į‹«į‹©į‰µ į‹«įŒ įˆį‰…į¢ įˆ„įˆ« įŠØįˆ˜įį‰³į‰µ įˆįŒ„įŠ• įˆ‹į‹į‰³į‰µį¢ į‹“į‰£į‹­ įˆ›į‹°įˆŖį‹« į‹Øįˆˆį‹į„ įŒįŠ•į‹µ į‹­į‹ž į‹­į‹žįˆ«įˆį¢ į‹ØįŠ„įˆµįˆ‹įˆ įŠ įŒˆįˆ© įˆ˜įŠ« į‹ØįŠ įˆžįˆ« įŠ įŒˆįˆ© į‹‹įˆ­įŠ«į¢ į‰°įŠ•įŒ‹įˆŽ į‰¢į‰°į‰ į‰°įˆ˜įˆįˆ¶ į‰£į‰į¢ į‹ˆį‹³įŒ…įˆ… įˆ›įˆ­ į‰¢įˆ†įŠ• įŒØįˆ­įˆµįˆ… įŠ į‰µįˆ‹įˆ°į‹į¢ įŠ„įŒįˆ­įˆ…įŠ• į‰ įįˆ«įˆ½įˆ… įˆįŠ­ į‹˜įˆ­įŒ‹į¢ Runes: įš»į›– įš³įš¹įš«įš¦ įš¦įš«į› įš»į›– į›’įš¢į›žį›– įš©įš¾ įš¦įš«į›— į›šįšŖįš¾į›žį›– įš¾įš©įš±įš¦įš¹į›–įšŖįš±į›žįš¢į›— įš¹į›įš¦ įš¦įšŖ įš¹į›–į›„įš« (Old English, which transcribed into Latin reads 'He cwaeth that he bude thaem lande northweardum with tha Westsae.' and means 'He said that he lived in the northern land near the Western Sea.') Braille: ā”Œā ā §ā ‘ ā ¼ā ā ’ ā”ā œā ‡ā ‘ā ¹ā °ā Ž ā”£ā •ā Œ ā”ā œā ‡ā ‘ā ¹ ā ŗā ā Ž ā ™ā ‘ā ā ™ā ’ ā žā • ā ƒā ‘ā ›ā ” ā ŗā Šā ¹ā ² ā”¹ā »ā ‘ ā Šā Ž ā ā • ā ™ā ³ā ƒā ž ā ±ā ā žā ‘ā §ā » ā ā ƒā ³ā ž ā ¹ā ā žā ² ā”¹ā ‘ ā —ā ‘ā ›ā Šā Œā » ā •ā ‹ ā ™ā Šā Ž ā ƒā „ā —ā Šā ā ‡ ā ŗā ā Ž ā Žā Šā ›ā ā « ā ƒā ¹ ā ¹ā ‘ ā Šā ‡ā »ā ›ā ¹ā ā ā ā ‚ ā ¹ā ‘ ā Šā ‡ā »ā …ā ‚ ā ¹ā ‘ ā „ā ā ™ā »ā žā ā …ā »ā ‚ ā ā ā ™ ā ¹ā ‘ ā ”ā Šā ‘ā ‹ ā ā ³ā —ā ā »ā ² ā”Žā Šā —ā •ā •ā ›ā ‘ ā Žā Šā ›ā ā « ā Šā žā ² ā”ā ā ™ ā”Žā Šā —ā •ā •ā ›ā ‘ā °ā Ž ā ā ā ā ‘ ā ŗā ā Ž ā ›ā •ā •ā ™ ā „ā ā •ā  ā °ā””ā ā ā ›ā ‘ā ‚ ā ‹ā •ā — ā ā ā ¹ā ¹ā ”ā › ā ™ā ‘ ā ”ā •ā Žā ‘ ā žā • ā ā „ā ž ā ™ā Šā Ž ā ™ā ā ā ™ ā žā •ā ² ā”•ā ‡ā ™ ā”ā œā ‡ā ‘ā ¹ ā ŗā ā Ž ā ā Ž ā ™ā ‘ā ā ™ ā ā Ž ā  ā ™ā •ā •ā —ā ¤ā ā ā Šā ‡ā ² ā”ā ”ā ™ā – ā”Š ā ™ā •ā ā °ā ž ā ā ‘ā ā  ā žā • ā Žā ā ¹ ā ¹ā ā ž ā”Š ā …ā ā Ŗā ‚ ā •ā ‹ ā ā ¹ ā Ŗā  ā …ā ā Ŗā ‡ā «ā ›ā ‘ā ‚ ā ±ā ā ž ā ¹ā »ā ‘ ā Šā Ž ā ā œā žā Šā Šā „ā ‡ā œā ‡ā ¹ ā ™ā ‘ā ā ™ ā ā ƒā ³ā ž ā  ā ™ā •ā •ā —ā ¤ā ā ā Šā ‡ā ² ā”Š ā ā Šā £ā ž ā ™ā ā §ā ‘ ā ƒā ‘ā ² ā ”ā Šā ‡ā ”ā «ā ‚ ā ā ¹ā Žā ‘ā ‡ā ‹ā ‚ ā žā • ā —ā ‘ā ›ā œā ™ ā  ā Šā •ā ‹ā ‹ā ”ā ¤ā ā ā Šā ‡ ā ā Ž ā ¹ā ‘ ā ™ā ‘ā ā ™ā ‘ā Œ ā ā Šā ‘ā Šā ‘ ā •ā ‹ ā Šā —ā •ā ā ā •ā ā ›ā »ā ¹ ā ” ā ¹ā ‘ ā žā —ā ā ™ā ‘ā ² ā”ƒā „ā ž ā ¹ā ‘ ā ŗā Šā Žā ™ā •ā  ā •ā ‹ ā ³ā — ā ā ā Šā ‘ā Œā •ā —ā Ž ā Šā Ž ā ” ā ¹ā ‘ ā Žā Šā ā Šā ‡ā ‘ā † ā ā ā ™ ā ā ¹ ā „ā ā ™ā ā ‡ā ‡ā Ŗā « ā ™ā ā ā ™ā Ž ā ©ā ā ‡ā ‡ ā ā •ā ž ā ™ā Šā Œā „ā —ā ƒ ā Šā žā ‚ ā •ā — ā ¹ā ‘ ā”Šā ³ā ā žā —ā ¹ā °ā Ž ā ™ā •ā ā ‘ ā ‹ā •ā —ā ² ā”¹ā ³ ā ŗā Šā ‡ā ‡ ā ¹ā »ā ‘ā ‹ā •ā —ā ‘ ā ā »ā ā Šā ž ā ā ‘ ā žā • ā —ā ‘ā ā ‘ā ā žā ‚ ā ‘ā ā ā ™ā ā žā Šā Šā ā ‡ā ‡ā ¹ā ‚ ā ¹ā ā ž ā”ā œā ‡ā ‘ā ¹ ā ŗā ā Ž ā ā Ž ā ™ā ‘ā ā ™ ā ā Ž ā  ā ™ā •ā •ā —ā ¤ā ā ā Šā ‡ā ² (The first couple of paragraphs of "A Christmas Carol" by Dickens) Compact font selection example text: ABCDEFGHIJKLMNOPQRSTUVWXYZ /0123456789 abcdefghijklmnopqrstuvwxyz Ā£Ā©ĀµĆ€Ć†Ć–ĆžĆŸĆ©Ć¶Ćæ ā€“ā€”ā€˜ā€œā€ā€žā€ ā€¢ā€¦ā€°ā„¢Å“Å Åøžā‚¬ Ī‘Ī’Ī“Ī”Ī©Ī±Ī²Ī³Ī“Ļ‰ ŠŠ‘Š’Š“Š”Š°Š±Š²Š³Š“ āˆ€āˆ‚āˆˆā„āˆ§āˆŖā‰”āˆž ā†‘ā†—ā†Øā†»ā‡£ ā”ā”¼ā•”ā•˜ā–‘ā–ŗā˜ŗā™€ ļ¬ļæ½ā‘€ā‚‚į¼ įø‚Ó„įŗ„ɐĖāŽ×Ō±įƒ Greetings in various languages: Hello world, ĪšĪ±Ī»Ī·Ī¼į½³ĻĪ± Īŗį½¹ĻƒĪ¼Īµ, ć‚³ćƒ³ćƒ‹ćƒćƒ Box drawing alignment tests: ā–ˆ ā–‰ ā•”ā•ā•ā•¦ā•ā•ā•— ā”Œā”€ā”€ā”¬ā”€ā”€ā” ā•­ā”€ā”€ā”¬ā”€ā”€ā•® ā•­ā”€ā”€ā”¬ā”€ā”€ā•® ā”ā”ā”ā”³ā”ā”ā”“ ā”Žā”’ā”ā”‘ ā•· ā•» ā”ā”Æā”“ ā”Œā”°ā” ā–Š ā•±ā•²ā•±ā•²ā•³ā•³ā•³ ā•‘ā”Œā”€ā•Øā”€ā”ā•‘ ā”‚ā•”ā•ā•§ā•ā•—ā”‚ ā”‚ā•’ā•ā•Ŗā•ā••ā”‚ ā”‚ā•“ā”€ā•ā”€ā•–ā”‚ ā”ƒā”Œā”€ā•‚ā”€ā”ā”ƒ ā”—ā•ƒā•„ā”™ ā•¶ā”¼ā•“ā•ŗā•‹ā•øā” ā”¼ā”Ø ā”ā•‹ā”„ ā–‹ ā•²ā•±ā•²ā•±ā•³ā•³ā•³ ā•‘ā”‚ā•² ā•±ā”‚ā•‘ ā”‚ā•‘ ā•‘ā”‚ ā”‚ā”‚ ā”‚ ā”‚ā”‚ ā”‚ā•‘ ā”ƒ ā•‘ā”‚ ā”ƒā”‚ ā•æ ā”‚ā”ƒ ā”ā•…ā•†ā”“ ā•µ ā•¹ ā”—ā”·ā”› ā””ā”øā”˜ ā–Œ ā•±ā•²ā•±ā•²ā•³ā•³ā•³ ā• ā•” ā•³ ā•žā•£ ā”œā•¢ ā•Ÿā”¤ ā”œā”¼ā”€ā”¼ā”€ā”¼ā”¤ ā”œā•«ā”€ā•‚ā”€ā•«ā”¤ ā”£ā”æā•¾ā”¼ā•¼ā”æā”« ā”•ā”›ā”–ā”š ā”Œā”„ā”„ā” ā•Ž ā”ā”…ā”…ā”“ ā”‹ ā– ā•²ā•±ā•²ā•±ā•³ā•³ā•³ ā•‘ā”‚ā•± ā•²ā”‚ā•‘ ā”‚ā•‘ ā•‘ā”‚ ā”‚ā”‚ ā”‚ ā”‚ā”‚ ā”‚ā•‘ ā”ƒ ā•‘ā”‚ ā”ƒā”‚ ā•½ ā”‚ā”ƒ ā–‘ā–‘ā–’ā–’ā–“ā–“ā–ˆā–ˆ ā”Š ā”† ā•Ž ā• ā”‡ ā”‹ ā–Ž ā•‘ā””ā”€ā•„ā”€ā”˜ā•‘ ā”‚ā•šā•ā•¤ā•ā•ā”‚ ā”‚ā•˜ā•ā•Ŗā•ā•›ā”‚ ā”‚ā•™ā”€ā•€ā”€ā•œā”‚ ā”ƒā””ā”€ā•‚ā”€ā”˜ā”ƒ ā–‘ā–‘ā–’ā–’ā–“ā–“ā–ˆā–ˆ ā”Š ā”† ā•Ž ā• ā”‡ ā”‹ ā– ā•šā•ā•ā•©ā•ā•ā• ā””ā”€ā”€ā”“ā”€ā”€ā”˜ ā•°ā”€ā”€ā”“ā”€ā”€ā•Æ ā•°ā”€ā”€ā”“ā”€ā”€ā•Æ ā”—ā”ā”ā”»ā”ā”ā”› ā””ā•Œā•Œā”˜ ā•Ž ā”—ā•ā•ā”› ā”‹ ā–ā–‚ā–ƒā–„ā–…ā–†ā–‡ā–ˆ lablgtk-2.18.8/examples/text/unicode_viewer.ml0000644000175000017500000000231413460263323020427 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let file_name = try Sys.argv.(1) with _ -> prerr_endline "Usage : unicode_viewer "; exit 1 ;; GtkMain.Main.init ();; let f_to_string n = let ic = open_in_bin n in let s = ref "" in try while true do s:= !s ^ (input_line ic) ^ "\n" done; !s with End_of_file -> close_in ic ; !s let main () = let w = GWindow.window ~width:640 ~height:480 ~title:"Unicode Viewer" () in let sw = GBin.scrolled_window ~packing:(w#add) () in let b = GText.buffer () in let s = f_to_string file_name in b#set_text s; let tv = GText.view ~buffer:b ~packing:(sw#add) () in w#show ();; main () ;; GMain.Main.main ();; lablgtk-2.18.8/examples/text/test_text.ml0000644000175000017500000001220513460263323017443 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open StdLabels;; (* GtkMain.Main.init ();; *) class input_buffer n = object val mutable s = String.create n val mutable pos = 0 method clear = pos <- 0 method input f = if String.length s < pos + n then begin let s' = String.create (String.length s * 2) in String.blit ~src:s ~dst:s' ~src_pos:0 ~dst_pos:0 ~len:pos; s <- s' end; let len = f s pos (String.length s - pos) in pos <- pos + len; len method get = String.sub s ~pos:0 ~len:pos end let f_to_string n = let ic = open_in_bin n in let ib = new input_buffer 1024 in begin try while ib#input (input ic) > 0 do () done; with _ -> () end; close_in ic; ib#get let t_1 () = let w = GWindow.window ~title:"1)view" () in let t = GText.view ~packing:(w#add) () in w#show ();; let t_2 () = let w = GWindow.window ~width:640 ~height:480 ~title:"2)view_with_buffer" () in let sw = GBin.scrolled_window ~packing:(w#add) () in let b = GText.buffer () in let s = f_to_string "test.txt" in b#set_text s; GText.view ~buffer:b ~packing:(sw#add) (); w#connect#destroy GMain.quit; w#show ();; let t_3 () = let w = GWindow.window ~title:"3)view_with_buffer" () in let b = GText.buffer () in b#set_text "Bout de mon texte"; GText.view ~buffer:b ~packing:(w#add) (); w#show ();; let t_4 () = let w = GWindow.window ~title:"4)set_buffer" () in let b = GText.buffer () in b#set_text "Un buffer a priori"; let tv = GText.view ~packing:(w#add) () in tv#set_buffer b; w#show ();; let t_5 () = let w = GWindow.window ~title:"5)get_buffer" () in let tv = GText.view ~packing:(w#add) () in tv#buffer#set_text "Un nouveau texte"; w#show ();; let t_6 () = let w = GWindow.window ~title:"6)tagtable" () in let tt = GText.tag_table () in let tb = GText.buffer ~tag_table:tt ~text:"un certain exemple...." () in let tv = GText.view ~buffer:tb ~packing:(w#add) () in Printf.printf "Size = %d \n" tt#size; flush stdout; w#show ();; let t_7 () = let w = GWindow.window ~title:"7)tag" () in let tt = GText.tag ~name:"mon tag one" () in Printf.printf "Priority = %d \n" tt#priority; (* Not able to set it because not in a tagtable: this is normal tt#set_priority 10; Printf.printf "Priority = %d \n" (tt#get_priority ()); *) flush stdout; w#show ();; let t_8 () = let w = GWindow.window ~title:"8)tags" () in let t = GText.view ~packing:(w#add) () in let tb = t#buffer in let _ = tb#connect#apply_tag ~callback:(fun tag ~start ~stop -> Printf.printf "Apply_tag has :\"%s\"\n" (tb#get_text ~start ~stop ()); flush stdout ) in let _ = tb#connect#delete_range ~callback:(fun ~start ~stop -> Printf.printf "delete_range_tag has :\"%s\"\n" (tb#get_text ~start ~stop ()); flush stdout ) in let _ = tb#connect#insert_child_anchor ~callback: (fun ti tca -> Printf.printf "insert_child_anchor is there :\"%c\"\n" (Char.chr ti#char); flush stdout) in let _ = tb#connect#insert_text ~callback: (fun ti s -> Printf.printf "insert_text is there :'%c' \"%s\"\n" (Char.chr ti#char) s; flush stdout) in tb#set_text "Un nouveau texte"; let tt = tb#create_tag [`BACKGROUND "red"; `FOREGROUND "blue"; `EDITABLE false] in Printf.printf "Je vois :\"%s\"\n" (tb#get_text ()); flush stdout; w#show ();; let t_9 () = let w = GWindow.window ~title:"8)tags" () in let t = GText.view ~packing:(w#add) () in let tb = t#buffer in tb#set_text "Un nouveau texte"; let start = tb#start_iter in tb#insert ~iter:start "1en plus1"; tb#insert ~iter:start "2en plus2" ; tb#insert ~iter:tb#end_iter "3en plus3"; Printf.printf "Je vois :\"%s\"\n" (tb#get_text ()); flush stdout; w#show ();; let t_10 () = let w = GWindow.window ~title:"10)Buffer signals" () in let t = GText.view ~packing:(w#add) () in let tb = t#buffer in tb#set_text "Un nouveau texte"; let start = tb#start_iter in tb#insert ~iter:start "1en plus1"; tb#insert ~iter:start "2en plus2"; tb#insert ~iter:tb#end_iter "3en plus3"; tb#connect#begin_user_action ~callback: begin fun () -> Printf.printf "Dans cette action je vois :\"%s\"\n" (tb#get_text ()); flush stdout end; tb#begin_user_action (); tb#end_user_action (); tb#begin_user_action (); tb#end_user_action (); tb#begin_user_action (); tb#end_user_action (); tb#begin_user_action (); tb#end_user_action (); w#show ();; (* t_1();t_2 ();t_3();t_4();t_5();t_6();t_7();t_8;t_9;t_10 ();; *) t_2 () ;; GMain.Main.main ();; lablgtk-2.18.8/examples/text/Makefile0000644000175000017500000000060313460263323016525 0ustar stephstephall: unicode_table unicode_viewer unicode_table: unicode_table.ml ocamlfind ocamlc -package lablgtk2 -linkpkg -o unicode_table $< unicode_table.opt: unicode_table.ml ocamlfind ocamlopt -package lablgtk2 -linkpkg -o unicode_table $< unicode_viewer: unicode_viewer.ml ocamlfind ocamlc -package lablgtk2 -linkpkg -o unicode_viewer $< clean: rm *.cm* *.o unicode_viewer unicode_table lablgtk-2.18.8/examples/text/text-demo.ml0000644000175000017500000003152313460263323017332 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let create_tags (buffer:GText.buffer) = buffer#create_tag ~name:"heading" [`WEIGHT `BOLD; `SIZE (15*Pango.scale)]; buffer#create_tag ~name:"italic" [`STYLE `ITALIC]; buffer#create_tag ~name:"bold" [`WEIGHT `BOLD]; buffer#create_tag ~name:"big" [`SIZE 20]; buffer#create_tag ~name:"xx-small" [`SCALE `XX_SMALL]; buffer#create_tag ~name:"x-large" [`SCALE `X_LARGE]; buffer#create_tag ~name:"monospace" [`FAMILY "monospace"]; buffer#create_tag ~name:"blue_foreground" [`FOREGROUND "blue"]; buffer#create_tag ~name:"red_background" [`BACKGROUND "red"]; let stipple = Gdk.Bitmap.create_from_data 2 2 "\002\001" in buffer#create_tag ~name:"background_stipple" [`BACKGROUND_STIPPLE stipple]; buffer#create_tag ~name:"foreground_stipple" [`FOREGROUND_STIPPLE stipple]; buffer#create_tag ~name:"big_gap_before_line" [`PIXELS_ABOVE_LINES 30]; buffer#create_tag ~name:"big_gap_after_line" [`PIXELS_BELOW_LINES 30]; buffer#create_tag ~name:"double_spaced_line" [`PIXELS_INSIDE_WRAP 10]; buffer#create_tag ~name:"not_editable" [`EDITABLE false]; buffer#create_tag ~name:"word_wrap" [`WRAP_MODE `WORD]; buffer#create_tag ~name:"char_wrap" [`WRAP_MODE `CHAR]; buffer#create_tag ~name:"no_wrap" [`WRAP_MODE `NONE]; buffer#create_tag ~name:"center" [`JUSTIFICATION `CENTER]; buffer#create_tag ~name:"right_justify" [`JUSTIFICATION `RIGHT]; buffer#create_tag ~name:"wide_margins" [`LEFT_MARGIN 50; `RIGHT_MARGIN 50]; buffer#create_tag ~name:"strikethrough" [`STRIKETHROUGH true]; buffer#create_tag ~name:"underline" [`UNDERLINE `SINGLE]; buffer#create_tag ~name:"double_underline" [`UNDERLINE `DOUBLE]; buffer#create_tag ~name:"superscript" [`RISE (10*Pango.scale); `SIZE (8*Pango.scale)]; buffer#create_tag ~name:"subscript" [`RISE (-10*Pango.scale); `SIZE (8*Pango.scale)]; buffer#create_tag ~name:"rtl_quote" [`WRAP_MODE `WORD; `DIRECTION `RTL; `INDENT 30; `LEFT_MARGIN 20; `RIGHT_MARGIN 20]; () let insert_text (buffer:GText.buffer) = let pixbuf = GdkPixbuf.from_file "gtk-logo-rgb.gif" in let scaled = GdkPixbuf.create ~has_alpha:true ~width:32 ~height:32 () in GdkPixbuf.scale ~dest:scaled ~width:32 ~height:32 ~interp:`BILINEAR pixbuf; let pixbuf = scaled in let iter = buffer#get_iter_at_char 0 in buffer#insert ~iter "The text widget can display text with all kinds of nifty attributes. It also supports multiple views of the same buffer; this demo is showing the same buffer in two places.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Font styles. "; buffer#insert ~iter "For example, you can have "; buffer#insert ~iter ~tag_names:["italic"] "italic"; buffer#insert ~iter ", "; buffer#insert ~iter ~tag_names:["bold"] "bold"; buffer#insert ~iter ", or "; buffer#insert ~iter ~tag_names:["monospace"] "monospace(typewriter)"; buffer#insert ~iter ", or "; buffer#insert ~iter ~tag_names:["big"] "big"; buffer#insert ~iter " text. "; buffer#insert ~iter "It's best not to hardcode specific text sizes; you can use relative sizes as with CSS, such as "; buffer#insert ~iter ~tag_names:["xx-small"] "xx-small"; buffer#insert ~iter ", or "; buffer#insert ~iter ~tag_names:["x-large"] "x-large"; buffer#insert ~iter " to ensure that your program properly adapts if the user changes the default font size.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Colors. "; buffer#insert ~iter "Colors such as "; buffer#insert ~iter ~tag_names:["blue_foreground"] "a blue foreground"; buffer#insert ~iter ", or "; buffer#insert ~iter ~tag_names:["red_background"] "a red background"; buffer#insert ~iter ", or even "; buffer#insert ~iter ~tag_names:["red_background";"background_stipple"] "a stippled red background"; buffer#insert ~iter " or "; buffer#insert ~iter ~tag_names:["blue_foreground"; "red_background"; "foreground_stipple"] "a stippled blue foreground on solid red background"; buffer#insert ~iter " (select that to read it) can be used.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Underline, strikethrough, and rise. "; buffer#insert ~iter ~tag_names:["strikethrough"] "Strikethrough"; buffer#insert ~iter ", "; buffer#insert ~iter ~tag_names:["underline"] "underline"; buffer#insert ~iter ", "; buffer#insert ~iter ~tag_names:["double_underline"] "double underline"; buffer#insert ~iter ", "; buffer#insert ~iter ~tag_names:["superscript"] "superscript"; buffer#insert ~iter ", "; buffer#insert ~iter ~tag_names:["subscript"] "subscript"; buffer#insert ~iter " are all supported.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Images"; buffer#insert ~iter "The buffer can have images in it: "; buffer#insert_pixbuf ~iter ~pixbuf; buffer#insert_pixbuf ~iter ~pixbuf; buffer#insert_pixbuf ~iter ~pixbuf; buffer#insert ~iter " for example.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Spacing"; buffer#insert ~iter "You can adjust the amount of space before each line.\n"; buffer#insert ~iter ~tag_names:["big_gap_before_line";"wide_margins"] "This line has a whole lot of space before it.\n"; buffer#insert ~iter ~tag_names:["big_gap_after_line";"wide_margins"] "You can also adjust the amount of space after each line; this line has a whole lot of space after it.\n"; buffer#insert ~iter ~tag_names:["double_spaced_line";"wide_margins"] "You can also adjust the amount of space between wrapped lines; this line has extra space between each wrapped line in the same paragraph. To show off wrapping, some filler text: the quick brown fox jumped over the lazy dog. Blah blah blah blah blah blah blah blah blah.\n"; buffer#insert ~iter "Also note that those lines have extra-wide margins.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Editability"; buffer#insert ~iter ~tag_names:["not_editable"] "This line is 'locked down' and can't be edited by the user - just try it! You can't delete this line.\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Wrapping"; buffer#insert ~iter ~tag_names:["char_wrap"] "This line has character-based wrapping, and can wrap between any two character glyphs. Let's make this a long paragraph to demonstrate: blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah blah\n\n" ; buffer#insert ~iter ~tag_names:["no_wrap"] "This line has all wrapping turned off, so it makes the horizontal scrollbar appear.\n\n\n"; buffer#insert ~iter ~tag_names:["heading"] "Justification"; buffer#insert ~iter ~tag_names:["center"] "\nThis line has center justification.\n"; buffer#insert ~iter ~tag_names:["right_justify"] "\nThis line has right justification.\n"; buffer#insert ~iter ~tag_names:["wide_margins"] "\nThis line has big wide margins. Text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text text.\n"; buffer#insert ~iter ~tag_names:["heading"] "Internationalization"; buffer#insert ~iter "You can put all sorts of Unicode text in the buffer.\n\nGerman (Deutsch SĆ¼d) GrĆ¼ĆŸ Gott\nGreek (Ī•Ī»Ī»Ī·Ī½Ī¹ĪŗĪ¬) Ī“ĪµĪ¹Ī¬ ĻƒĪ±Ļ‚\nHebrew שלום\nJapanese (ę—„ęœ¬čŖž)\n\nThe widget properly handles bidirectional text, word wrapping, DOS/UNIX/Unicode paragraph separators, grapheme boundaries, and so on using the Pango internationalization framework.\n"; buffer#insert ~iter "Here's a word-wrapped quote in a right-to-left language:\n"; buffer#insert ~iter ~tag_names:["rtl_quote"] "ŁˆŁ‚ŲÆ ŲØŲÆŲ£ Ų«Ł„Ų§Ų« Ł…Ł† Ų£ŁƒŲ«Ų± Ų§Ł„Ł…Ų¤Ų³Ų³Ų§ŲŖ ŲŖŁ‚ŲÆŁ…Ų§ ŁŁŠ Ų“ŲØŁƒŲ© Ų§ŁƒŲ³ŁŠŁˆŁ† ŲØŲ±Ų§Ł…Ų¬Ł‡Ų§ ŁƒŁ…Ł†ŲøŁ…Ų§ŲŖ Ł„Ų§ ŲŖŲ³Ų¹Ł‰ Ł„Ł„Ų±ŲØŲ­ŲŒ Ų«Ł… ŲŖŲ­ŁˆŁ„ŲŖ ŁŁŠ Ų§Ł„Ų³Ł†ŁˆŲ§ŲŖ Ų§Ł„Ų®Ł…Ų³ Ų§Ł„Ł…Ų§Ų¶ŁŠŲ© Ų„Ł„Ł‰ Ł…Ų¤Ų³Ų³Ų§ŲŖ Ł…Ų§Ł„ŁŠŲ© Ł…Ł†ŲøŁ…Ų©ŲŒ ŁˆŲØŲ§ŲŖŲŖ Ų¬Ų²Ų”Ų§ Ł…Ł† Ų§Ł„Ł†ŲøŲ§Ł… Ų§Ł„Ł…Ų§Ł„ŁŠ ŁŁŠ ŲØŁ„ŲÆŲ§Ł†Ł‡Ų§ŲŒ ŁˆŁ„ŁƒŁ†Ł‡Ų§ ŲŖŲŖŲ®ŲµŲµ ŁŁŠ Ų®ŲÆŁ…Ų© Ł‚Ų·Ų§Ų¹ Ų§Ł„Ł…Ų“Ų±ŁˆŲ¹Ų§ŲŖ Ų§Ł„ŲµŲŗŁŠŲ±Ų©. ŁˆŲ£Ų­ŲÆ Ų£ŁƒŲ«Ų± Ł‡Ų°Ł‡ Ų§Ł„Ł…Ų¤Ų³Ų³Ų§ŲŖ Ł†Ų¬Ų§Ų­Ų§ Ł‡Łˆ Ā»ŲØŲ§Ł†ŁƒŁˆŲ³ŁˆŁ„Ā« ŁŁŠ ŲØŁˆŁ„ŁŠŁŁŠŲ§.\n\n"; buffer#insert ~iter "You can put widgets in the buffer: Here's a button: "; buffer#create_child_anchor iter; buffer#insert ~iter " and a menu : "; buffer#create_child_anchor iter; buffer#insert ~iter " and a scale : "; buffer#create_child_anchor iter; buffer#insert ~iter " and an animation : "; buffer#create_child_anchor iter; buffer#insert ~iter " finally a text entry : "; buffer#create_child_anchor iter; buffer#insert ~iter ".\n"; buffer#insert ~iter "\n\nThis demo doesn't demonstrate all the GtkTextBuffer features; it leaves out, for example: invisible/hidden text (doesn't work in GTK 2, but planned), tab stops, application-drawn areas on the sides of the widget for displaying breakpoints and such..."; let start,stop = buffer#bounds in buffer#apply_tag_by_name "word_wrap" ~start ~stop ; () let rec find_anchor (iter : GText.iter) = if iter#is_end then false else match iter#nocopy#forward_char ; iter#contents with `CHILD _ -> true | _ -> find_anchor iter let rec recursive_attach_view depth (view:GText.view) anchor = if depth <= 4 then begin let child_view = GText.view ~buffer:(view#buffer) () in let event_box = GBin.event_box () in let color = `NAME "black" in event_box#misc#modify_bg [`NORMAL,color]; let align = GBin.alignment () in align#set_border_width 1; event_box#add align#coerce; align#add child_view#coerce; view#add_child_at_anchor event_box#coerce anchor; recursive_attach_view (depth+1) child_view anchor end let easter_egg_callback = let window = ref None in fun () -> match !window with Some w -> w#present () | None -> let buffer = GText.buffer () in let iter = buffer#start_iter in buffer#insert ~iter "This buffer is shared by a set of nested text views.\n Nested view:\n"; let anchor = buffer#create_child_anchor iter in buffer#insert ~iter "\nDon't do this in real applications, please.\n"; let view = GText.view ~buffer () in recursive_attach_view 0 view anchor; let w' = GWindow.window ~kind:`TOPLEVEL () in w'#connect#destroy ~callback:(fun () -> window:=None); window := Some w'; let sw = GBin.scrolled_window () in sw#set_hpolicy `AUTOMATIC; sw#set_vpolicy `AUTOMATIC; w'#add sw#coerce; sw#add view#coerce; w'#set_default_size ~width:300 ~height:400; w'#misc#show_all () let attach_widgets (text_view:GText.view) = let buffer = text_view#buffer in let iter = buffer#start_iter in let i = ref 0 in while find_anchor iter do let anchor = match iter#contents with | `CHILD c -> c | _ -> assert false in let widget = match !i with | 0 -> let b = GButton.button ~label:"Click me!" () in b#connect#clicked ~callback:easter_egg_callback; b#coerce | 1 -> let menu = GMenu.menu () in let widget = GMenu.option_menu () in let menu_item = GMenu.menu_item ~label:"Option 1" () in menu#append menu_item; let menu_item = GMenu.menu_item ~label:"Option 2" () in menu#append menu_item; let menu_item = GMenu.menu_item ~label:"Option 3" () in menu#append menu_item; widget#set_menu menu; widget#coerce | 2 -> let widget = GRange.scale `HORIZONTAL () in widget#adjustment#set_bounds ~lower:0. ~upper:100. (); widget#misc#set_size_request ~height:(-1) ~width:70 (); widget#coerce | 3 -> let image = GMisc.image () in image#set_file "floppybuddy.gif"; image#coerce | 4 -> (GEdit.entry ())#coerce | _ -> assert false in text_view#add_child_at_anchor widget anchor; incr i done let main () = let window = GWindow.window ~width:450 ~height:450 ~title:"TextView" ~border_width:0 () in window#connect#destroy ~callback:(fun _ -> exit 0); let vpaned = GPack.paned `VERTICAL ~border_width:5 ~packing:window#add () in let view1 = GText.view () in let buffer = view1#buffer in let view2 = GText.view ~buffer () in let sw = GBin.scrolled_window ~packing:vpaned#add1 ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in sw#add view1#coerce; let sw = GBin.scrolled_window ~packing:vpaned#add2 ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () in sw#add view2#coerce; create_tags buffer; insert_text buffer; attach_widgets view1; attach_widgets view2; window#show (); () let _ = GtkMain.Main.init (); main () ; GMain.Main.main ();; lablgtk-2.18.8/examples/text/.cvsignore0000644000175000017500000000005213460263323017063 0ustar stephstepha.out t t.ps unicode_table unicode_viewer lablgtk-2.18.8/examples/text/floppybuddy.gif0000644000175000017500000001214013460263323020114 0ustar stephstephGIF89aPF÷€  !!!"""###$$$%%%&&&'''((()))***+++,,,---...///000111222333444555666777888999:::;;;<<<===>>>???@@@AAABBBCCCDDDEEEFFFGGGHHHIIIJJJKKKLLLMMMNNNOOOPPPQQQRRRSSSTTTUUUVVVWWWXXXYYYZZZ[[[\\\]]]^^^___```aaabbbcccdddeeefffggghhhiiijjjkkklllmmmnnnooopppqqqrrrssstttuuuvvvwwwxxxyyyzzz{{{|||}}}~~~ć恁‚‚‚ƒƒƒ„„„………†††‡‡‡ˆˆˆ‰‰‰ŠŠŠ‹‹‹ŒŒŒŽŽŽ‘‘‘’’’“““”””•••–––———˜˜˜™™™ššš›››œœœžžžŸŸŸ   ”””¢¢¢£££¤¤¤„„„¦¦¦’ØØØ’’=v{’«««¬¬¬­­­®®®ÆÆÆ°°°±±±²²²³³³“““µµµ¶¶¶···øøø¹¹¹ŗŗŗ»»»¼¼¼½½½¾¾¾æææøĀŁĮĮĮĀĀĀĆĆĆÄÄÄÅÅÅĘĘĘĒĒĒČČČÉÉÉŹŹŹĖĖĖĢĢĢĶĶĶĪĪĪĻĻĻŠŠŠŃŃŃŅŅŅÓÓÓŌŌŌÕÕÕÖÖÖ×××ŲŲŲŁŁŁŚŚŚŪŪŪÜÜÜŻŻŻŽŽŽßßßąąąįįįāāāćććäääåååęęęēēēčččéééźźźėėėģģģķķķīīīļļļšššńńńņņņóóóōōōõõõööö÷÷÷ųųųłłłśśśūūūüüüżżżžžž’’’!’ NETSCAPE2.0č!ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó¦H ‹žŠ2hJ§2rD)@*0£.µšŖ©O®[µvDŁ•@Ŗ³Xsjjõé׶lÅ6$꣫wÓŅ5ؔmWÆ)»ĘŻ9- ½Ķ¢Ķ{ų,ŅEgśu8ģĪĒ Ó5|’®b¼‹Œ¼ō­SÆC£J%ˆx3č«|Cæf ™“ŠŪøIcعqhŗ»q}vmŪB—N­•źĄĻŠóž-½8ēŖ(U/g»ysźūÖ_ž9¼qįŁµć^?ø9yó³ßĆƋ>²döėķ§¾|pŽó§_MŖ6Ó~ĻĮ‡ÖĻ•‡vé(į„Ž„`‚.ä}õ W!*IųŲ…¾õēŠ†£9gßNĄ“čā‹ĄšĒśAȚkhqØįƒ®8SŒ)ĮćŒ5ŚHg”f>$JBŹH£L:׹ƒmÜh:‰QIeŠō!I‘–6 $˜0JY$dH¢X‘™'u¹¦“mŠ©Ahźø‘š*…9åž|j’šB¾čꘉaéрx&Śbˆ„āÄåe1aJ„Yzi… véiŠš–J¢§¦¦:*©”©øźA*=äŅ«°žŖ­“ē®¹źš”•½ņ,B¼k$±ĆKŖO9ÅŖl}<ėWL%‹*QÉMĖÖiÆ.WŚ~H”†šSĀ•;RøĀįēģvē‘®»Õ¶;īm_2xn~)Į.÷ļµÉåkn¼2zk0Įõź Ą.9,oÄ[.ŗĻf¬ńĘwģńĒ#!ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó&ĪƒEE4eS™Fž„Ŗ@ŖTL}ZÅ 4©TƒI»bĶš’ėPŖ včX¢(ĶśDĖĄÕµj7)Ö©V«U©Ø{×nŖµ÷*żŪ4ėYŗóR{÷źįœ5Į*Ź¹³āĮ ćµ,šh‚q ¶|PJØ|…’]üx'ŹŠ¤sW¾Z÷źĖ_Sķ¬•ųŽ™­'[Ö}˜uä«[[Eģ%ģŲč_Oł|9s¬ūĻ„.PųšģŚasĒķ½¹sƒ†ŪSW¹½¦żś¼Ęo8y迒•gŽuhą`ė “ŸwŌ%¤V€"h röY·]„ģɗփØńvÜNĄ„(āˆĄšĒĒ–ąd”‘Ö`]&ųįL%¦Db‰'¦\~ rуx™vŚŒŌˆŅ&¢x!†’AjµFd("™ć’6čćDP¾8%JU’˜¤ŽØq¤E[¢V`‘`)ꕼĮ×eH_Śų¦’qŹy&[kŽx'™„éQŠGś)"}y~åš`1Uh!…;)ZŽ„”NčNŽfź’¤šv*i„Ś÷éI+Ā¤Ņؚńhź„„Ø–Š«ØVk‡³ŽźjŖ±*tėŽµ¶Ź¬›ę*+Od!UÜ_½’D–lĘvÕ§²5†`u]Ń6”kŲŽ4­µ²”č-·M”œ²Ōf—Ņ·Žyfb²«’ø¢˜nWāJ5ļ¹Ó¢ęŠ²µł•cųĀ$ÆKģ~Ķµn›­° 7ģšĆG,±T!ž’This GIF file was assembled by CDavis with GIF Construction Set from: Alchemy Mindworks Inc. P.O. Box 500 Beeton, Ontario L0G 1A0 CANADA. !ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó¦H ‹žŠ2hJ§2rD)@*0£.µšŖ©O®[µvDŁ•@Ŗ³Xsjjõé׶lÅ6$꣫wÓŅ5ؔmWÆ)»ĘŻ9- ½Ķ¢Ķ{ų,ŅEgśu8ģĪĒ Ó5|’®b¼‹Œ¼ō­SÆC£J%ˆx3č«|Cæf ™“ŠŪøIcعqhŗ»q}vmŪB—N­•źĄĻŠóž-½8ēŖ(U/g»ysźūÖ_ž9¼qįŁµć^?ø9yó³ßĆƋ>²döėķ§¾|pŽó§_MŖ6Ó~ĻĮ‡ÖĻ•‡vé(į„Ž„`‚.ä}õ W!*IųŲ…¾õēŠ†£9gßNĄ“čā‹ĄšĒśAȚkhqØįƒ®8SŒ)ĮćŒ5ŚHg”f>$JBŹH£L:׹ƒmÜh:‰QIeŠō!I‘–6 $˜0JY$dH¢X‘™'u¹¦“mŠ©Ahźø‘š*…9åž|j’šB¾čꘉaéрx&Śbˆ„āÄåe1aJ„Yzi… véiŠš–J¢§¦¦:*©”©øźA*=äŅ«°žŖ­“ē®¹źš”•½ņ,B¼k$±ĆKŖO9ÅŖl}<ėWL%‹*QÉMĖÖiÆ.WŚ~H”†šSĀ•;RøĀįēģvē‘®»Õ¶;īm_2xn~)Į.÷ļµÉåkn¼2zk0Įõź Ą.9,oÄ[.ŗĻf¬ńĘwģńĒ#!ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó&ĪƒEE4eS™Fž„Ŗ@ŖTL}ZÅ 4©TƒI»bĶš’ėPŖ včX¢(ĶśDĖĄÕµj7)Ö©V«U©Ø{×nŖµ÷*żŪ4ėYŗóR{÷źįœ5Į*Ź¹³āĮ ćµ,šh‚q ¶|PJØ|…’]üx'ŹŠ¤sW¾Z÷źĖ_Sķ¬•ųŽ™­'[Ö}˜uä«[[Eģ%ģŲč_Oł|9s¬ūĻ„.PųšģŚasĒķ½¹sƒ†ŪSW¹½¦żś¼Ęo8y迒•gŽuhą`ė “ŸwŌ%¤V€"h röY·]„ģɗփØńvÜNĄ„(āˆĄšĒĒ–ąd”‘Ö`]&ųįL%¦Db‰'¦\~ rуx™vŚŒŌˆŅ&¢x!†’AjµFd("™ć’6čćDP¾8%JU’˜¤ŽØq¤E[¢V`‘`)ꕼĮ×eH_Śų¦’qŹy&[kŽx'™„éQŠGś)"}y~åš`1Uh!…;)ZŽ„”NčNŽfź’¤šv*i„Ś÷éI+Ā¤Ņؚńhź„„Ø–Š«ØVk‡³ŽźjŖ±*tėŽµ¶Ź¬›ę*+Od!UÜ_½’D–lĘvÕ§²5†`u]Ń6”kŲŽ4­µ²”č-·M”œ²Ōf—Ņ·Žyfb²«’ø¢˜nWāJ5ļ¹Ó¢ęŠ²µł•cųĀ$ÆKģ~Ķµn›­° 7ģšĆG,±T!žThis space for rent...!ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó¦H ‹žŠ2hJ§2rD)@*0£.µšŖ©O®[µvDŁ•@Ŗ³Xsjjõé׶lÅ6$꣫wÓŅ5ؔmWÆ)»ĘŻ9- ½Ķ¢Ķ{ų,ŅEgśu8ģĪĒ Ó5|’®b¼‹Œ¼ō­SÆC£J%ˆx3č«|Cæf ™“ŠŪøIcعqhŗ»q}vmŪB—N­•źĄĻŠóž-½8ēŖ(U/g»ysźūÖ_ž9¼qįŁµć^?ø9yó³ßĆƋ>²döėķ§¾|pŽó§_MŖ6Ó~ĻĮ‡ÖĻ•‡vé(į„Ž„`‚.ä}õ W!*IųŲ…¾õēŠ†£9gßNĄ“čā‹ĄšĒśAȚkhqØįƒ®8SŒ)ĮćŒ5ŚHg”f>$JBŹH£L:׹ƒmÜh:‰QIeŠō!I‘–6 $˜0JY$dH¢X‘™'u¹¦“mŠ©Ahźø‘š*…9åž|j’šB¾čꘉaéрx&Śbˆ„āÄåe1aJ„Yzi… véiŠš–J¢§¦¦:*©”©øźA*=äŅ«°žŖ­“ē®¹źš”•½ņ,B¼k$±ĆKŖO9ÅŖl}<ėWL%‹*QÉMĖÖiÆ.WŚ~H”†šSĀ•;RøĀįēģvē‘®»Õ¶;īm_2xn~)Į.÷ļµÉåkn¼2zk0Įõź Ą.9,oÄ[.ŗĻf¬ńĘwģńĒ#!ł €,L>ü H° Įƒ*\Č°”Ƈ#JœH±¢Å‹3jÜȱ£Ē CŠI²dA(SŖ\Ér„ɅNjI“ęĢ— cŹ JĻž@ƒöü©ó&ĪƒEE4eS™Fž„Ŗ@ŖTL}ZÅ 4©TƒI»bĶš’ėPŖ včX¢(ĶśDĖĄÕµj7)Ö©V«U©Ø{×nŖµ÷*żŪ4ėYŗóR{÷źįœ5Į*Ź¹³āĮ ćµ,šh‚q ¶|PJØ|…’]üx'ŹŠ¤sW¾Z÷źĖ_Sķ¬•ųŽ™­'[Ö}˜uä«[[Eģ%ģŲč_Oł|9s¬ūĻ„.PųšģŚasĒķ½¹sƒ†ŪSW¹½¦żś¼Ęo8y迒•gŽuhą`ė “ŸwŌ%¤V€"h röY·]„ģɗփØńvÜNĄ„(āˆĄšĒĒ–ąd”‘Ö`]&ųįL%¦Db‰'¦\~ rуx™vŚŒŌˆŅ&¢x!†’AjµFd("™ć’6čćDP¾8%JU’˜¤ŽØq¤E[¢V`‘`)ꕼĮ×eH_Śų¦’qŹy&[kŽx'™„éQŠGś)"}y~åš`1Uh!…;)ZŽ„”NčNŽfź’¤šv*i„Ś÷éI+Ā¤Ņؚńhź„„Ø–Š«ØVk‡³ŽźjŖ±*tėŽµ¶Ź¬›ę*+Od!UÜ_½’D–lĘvÕ§²5†`u]Ń6”kŲŽ4­µ²”č-·M”œ²Ōf—Ņ·Žyfb²«’ø¢˜nWāJ5ļ¹Ó¢ęŠ²µł•cųĀ$ÆKģ~Ķµn›­° 7ģšĆG,±T!žļThis GIF file was assembled with GIF Construction Set from: Alchemy Mindworks Inc. P.O. Box 500 Beeton, Ontario L0G 1A0 CANADA. This comment block will not appear in files created with a registered version of GIF Construction Set;lablgtk-2.18.8/examples/text/gtk-logo-rgb.gif0000644000175000017500000001443313460263323020055 0ustar stephstephGIF89akŒē’’’ļūõļōóŖ«¹ŌÄčŌÜŌ˜ø­Ę¹ÅÄ/L”\lĄu’x 4# "7čÕļ„x¤:Z¬5d Y$]'+4 ."dŖ¢Ü»Ņ¼-E76Z7nNdlG7]9$7L 5(4…=`Ūėą-LE*48  ; &M–=rį2fĘpˆz$L-Mø>vā!C‚ĢåŚ %<’/e®o{,D“9MG 'Žõē=WW +T›,[Ÿ’Ŗ¬43\Ē,  7gÓOkw1U» ĆøDVr¦” ‚¤Œ=!2kFZūīś&Rl #4Td\Ś¾Ų³˜JmĶ ,š~¬ÕĢā($;DL&p,X%I 5'iU!¤):ÉFA9GDjÓŌÖÕe²)<9 H ŲFE‚,)7 ėIKj)%6#&Ø89;4P 4E&¶@4˜āŽ•pA ąYhPJ,A‡~(Ūt,0ńC&Ī—"ŠCĪwÅa„…†Œ9ńŽˆŻ Ū” @”ƒƒ¼5¤ŚqGZp¤X@QHń"\Ö6eS“d–¦Xä–:¼b„˜R\T„Ž 2AdvP0CMą  ąp%‘õ ‰ƒ„„ŻpŹRBY±D‡ŽMwŁlBL‘å h6„l5„¢zP §žÜ10abK%qE‹9JY‚@+ĄŖõĀ,Ų6儳ęGĮ‚[j7°•¢2YŠ€ėt»Vaā-œ:®ł…›#š,4!*}Ł51‚¬„a° ü™ė”šČ"¶łmĘB„Nh[æ•V0…vCś0A ø†TIZ“p&š:ŗ *ƒLˆ(®ø³"›,øh: ­‰¼1ŃBłÅ’[ąŠ˜?8„[ū;B: ¬ĆLÖ­;n|ĆpĪ—ƒ¢$#F*`EÉĀuY ‚>ØC·ćF9āĄB«čCŻJÕ7Ō ōƒC#‰ę(ŖؖįŽ0BBøŗĀGÉ@­fĶąžœCd6t·uCŽsł®yNDWAš†[ÖĶzv'»%Ō ­ŠĶÖ7\]¼šå‡‡‰€īœsSŃ¹QTżaÜ[É`hRš"€Œ.ŁYśšÅe-d¦,Ł Ė÷BÓ”¬āJAĀēqA“v`0@i,ĀUAģ½<¶ń@æ™Ų\b‰ā'×^ŹcDʝQÖP†«pņ6"˜Įł †ł›zkÖ|øU)<ŠKō)\ *ŊõaI ĄOæ6S³Ų¹ź~EĢJšEźM˜ĆNžU»e-RrŹĮļJӊ…(!'€AŠT6 ¬{ZŚŽun7®”č„ž*ŖŁ£ęě{ÉęC.H`ŠRø%­ĢÆčŠ@œ0ƒ<1RĄ€ ä¶DMM-NCS| '·4įY?`ĀŲ„šUˆ&Ü[‘ģW4øĄBčŠf ƒ#\ąją€āÖ½ļõīY`€Ų‡(@ø½”h°MŲ\0„ļOwK$]œb!‹Ö•`!Ć,† °” nxCą ¼qP€_ķz'‰Ģn#ćXHG ‰7“€B,j±† Ų!Vąc Ō9ĢlČbtšAAn Tdī FFüĘjģ© ÷øHF&īm :ø.fÄ |ČBģšĮ”wžĄCĢt€@ ,\Š¦€|u°š½¹Ÿų@׃’±xDœ#oØ°† HF»čD x ģį4ąCü€<üpį¢Ę»¬1!Œp] ‹4©ŖmljōC刄ˆĘ‚ hĄŅP2ōĀ6øĄ/:ŗ…#Šą€DIń 3¹čÓ4Ÿ§p;Žż€GŗŲ"Õņƒ–q>č¤ÅL ¤įĄ†\…A‚ #(yĢ B ˆ©ā!„‚‹.PƒB”Ƨ>0\ ƒ&™ön`CųĮ¦bv™`ņƒ½ó->`Čą k0ˆA aÜ@ Å@H‘†#š!Ŗ~Åž"ųY>Ø ōÓRWŪ‚&ĶQ>ŽT™ŻzGĀéJWXĮ†(c“¤%-%JP āŠäxjb[R? įE|@¬$@:·‹\c÷ō‡± @A—åÕĆVpOXĀn~I{Œ°i€"NŠ Œ”»xšĆ"PśĒ#`€ X«oü6Į(ĮnKĄ ®¤I¹źVGøĮŻē7Š½@2ĀˆšA¤REp ńĒI! .X£‰˜ ·`+c,ųAC‡Ę?qQąrƔO~€‹ÖĄ% ĘŲotõ«ŒDŖAyiÄBŚ‡Ė ^ęN ½śŒ@’®ėŲžˆ$®$ą°æŌĮ"ó„,C椅.t™ŸR$$Š Š`æĀ dƒŌĄ‡4”į€(Š‚tš&ÖvŅęė Œ°„ Ōµk‰ń]f¬vÄ^Ć©>¢Šx ĆS£łā#Ą”Uõ Ķ<Ō1±Ž`"7{“N#Č SĪ5±‰ńģŒ·\pˆŽA•Š ‡{ŻH$Š‹$ŠKGZįPPÖ I$ӇqąyŻå¬8hłįw±um– ÜąW‚Š‡~čŠCą ĒP‹K° ·§ƒĖVZo!A @ŽęHW¦l˜{Ą!q` [s –Ąār|šÜEøŒŻµ ‹F·”ą ųыK@o2Ø}ѵrˆpqö #—<Ęø÷“ t@~EAM)^ˆĮo`un "ems ž H†œ`Š° ŻpŽ¤„ y|–ŽpŹšqŹŠ€~¦0°ų’Ū[ßą’€$x_—Hˆ~4ą¤7Uƒ` 6Šr„ “؃Į  Ł`6P”r—_#W ątśÕ < ‘3@2›€É7UtPcA”}‚x° !„„0Uß6Œø``†`ą §gįW `Ž„ęĒdŒO@2Ü@}YR‘Pc€t&¢ˆj 16„°`|pxš ‹`Oƒž¹ ½Č)• l9jį 2$ mIZaš°0°o± ß@|~… ¬Ųš•öG~ž· „p ąP×ų ƒ@A€‘ęČ $0oė°“£¶{ź Ėą™ŃUœpńlJ/Ą nĄ†  X•.²Lmą~š€ąߐ‡øQrŁ`Yšä™ ĀrÄ  ģUQ™qŽ.Ņƒ‘ś)ĪųŸ±õ8˜ŁiJā@Rt āŁ‹A€™¶G Ż`6P”%Īš; ]Ź€‚įR ¹ˆbō lĻRÜ  j0ÕmĄ—o€łväš~ā飊@jŹ`‡H¦`ą †€ %F‘łAȐ _hbU†wÉŠ¤叛 „{Xm„ kjt¦Ōr’PžtŹ¦ ŚAY`žÄ l†b)Z!7¦pqeŒq¬ć"›° µY|‚ „żČł4Un``pˆ`pØj™Ž6ą fšĢ` ĢĄ ĀU–•ŹC”`r ”'ä/łyH [čW5 O wĢ‰·óh*¤Ź°<„$°łØoq‹Ą«Qš"}PUTJ¬(•F÷”S% `”ŽZŸdZ¦%œ0Žµ.Apg2 ĆĶ®OšG›–`›.§ ¢Zl°m÷Ų®K€6ƤeæŁ!7° Ā°Ī`‘ś£»š“GWĪÖ¤N:Š©–pž®.7Į^üX‹v{ZRnpl¦&f²ˆAĖp Yą ŠĶŗ­(†ō€²dņ",+Å÷ į¢嚮®Ł•Œł®fŁ_Ś!ĪĄ cˆ+äɛ¹Ų“`Š­õĄI°œŠ° [m3$Š+~@séz]źW‘šŽ—£¶™BėP™!KąžÉ æyŚ€²€&Xäš‹·°VJ ^PkmöW[ģZi ŚZbG‰+4`>š2š\ō©lėą!GP (+`µEp[hXWR·„7+[€ĄŠ"y›’f™o 2 !‹”…g] ”€²Q žDŪ`Ÿ–|€µ G^Éf7ą}Ź ¢ˆ1™Ė›¾ĆŁ–£u¾>š” !•0h}šj`¹¹km»ĖšÉZ|tp­% øł•o¢žŸœ‚&¾Š…ŃU¤„j a½ęu›[m~ /Ė¾Õö ,§ (V$P¦©{`wŗŗ% Į Q 7``ē€ k°»„qšĢC6pgxv“•¦7Ł‹©[f0²Ź¶ f2%`)Į‚ŇŸ7ņb`Å÷Wt A$0Ÿ£f¤ā¢·c¦ YYą“&ę `H7p‰ !`&PܲŸēä w…ꠟɎĀłžŲP­ ł›#\)Ē`Ę¤å Ø¢ °vƒĘē ĒźēWTL·3[ūkU˜Pž lbzˆ•ŠĖ‹Ųˆ÷źT7œ £M…Š’o å!¾ ĮĪœM”Ē° DMŻrI 7ø„īą× £ Āē¹Z^h‚%ģ “‰× źĄ;ŗ\Xę;°ī°L3ķ棬 -ŅĖė”^m¾ k6)ÅĘ!F@ ļ GēéķćEč4ŽĒt GObj.widget) in let orientation = if button#active then `VERTICAL else `HORIZONTAL in table#remove toolbar_w ; toolbar#set_orientation orientation ; match orientation with | `HORIZONTAL -> table#attach ~left:0 ~right:2 ~top:0 ~bottom:1 ~expand:`X ~fill:`BOTH toolbar_w | `VERTICAL -> table#attach ~left:0 ~right:1 ~top:0 ~bottom:6 ~expand:`Y ~fill:`BOTH toolbar_w let change_toolbar_style combo toolbar () = toolbar#set_style (List.assoc combo#active [ 0, `ICONS; 1, `TEXT; 2, `BOTH; 3, `BOTH_HORIZ ]) let set_toolbar_style_toggled button combo toolbar () = if button#active then change_toolbar_style combo toolbar () else toolbar#unset_style () ; combo#misc#set_sensitive button#active let change_icon_size combo toolbar () = toolbar#set_icon_size (List.assoc combo#active [ 0, `SMALL_TOOLBAR; 1, `LARGE_TOOLBAR ]) let set_icon_size_toggled button combo toolbar () = if button#active then change_icon_size combo toolbar () else toolbar#unset_icon_size () ; combo#misc#set_sensitive button#active let create_item_list packing = let cols = new GTree.column_list in let item_col : Gtk.tool_item Gtk.obj GTree.column = cols#add Gobject.Data.gobject in let name_col = cols#add Gobject.Data.string in let store = GTree.list_store cols in let tree_view = GTree.view ~model:store ~packing () in tree_view#append_column (GTree.view_column ~title:"Tool Item" ~renderer:(GTree.cell_renderer_text [], [ "text", name_col ]) ()) ; let item_property_column ~title ~setter ~getter = let cell = GTree.cell_renderer_toggle [] in cell#connect#toggled (fun path -> let item = new GButton.tool_item (store#get ~row:(store#get_iter path) ~column:item_col) in setter item (not (getter item))) ; let view_column = GTree.view_column ~title () in view_column#pack cell ; view_column#set_cell_data_func cell (fun model row -> let item = new GButton.tool_item (model#get ~row ~column:item_col) in cell#set_properties [ `ACTIVE (getter item) ]) ; tree_view#append_column view_column in item_property_column ~title:"Visible (horizontal)" ~setter:(fun item -> item#set_visible_horizontal) ~getter:(fun item -> item#visible_horizontal) ; item_property_column ~title:"Visible (vertical)" ~setter:(fun item -> item#set_visible_vertical) ~getter:(fun item -> item#visible_vertical) ; item_property_column ~title:"Expand" ~setter:(fun item -> item#set_expand) ~getter:(fun item -> item#get_expand) ; item_property_column ~title:"Homogeneous" ~setter:(fun item -> item#set_homogeneous) ~getter:(fun item -> item#get_homogeneous) ; item_property_column ~title:"Important" ~setter:(fun item -> item#set_is_important) ~getter:(fun item -> item#is_important) ; (store, name_col, item_col, tree_view) let context_menu_cb toolbar x y button = let menu = GMenu.menu () in for i = 1 to 5 do let label = Printf.sprintf "Item _%d" i in GMenu.menu_item ~label ~use_mnemonic:true ~packing:menu#append () done ; menu#popup ~button:0 ~time:(GtkMain.Main.get_current_event_time ()) ; true let targets = [ { Gtk.target = "application/x-toolbar-item" ; Gtk.flags = [] ; Gtk.info = 0 } ] (* this doesn't seem to work :( *) let drag_item = ref None let toolbar_drag_motion_cb (toolbar : #GButton.toolbar) (ctx : GObj.drag_context) ~x ~y ~time = let item = match !drag_item with | None -> let it = GButton.tool_button ~label:"A quite long button" () in drag_item := Some it ; it | Some it -> it in ctx#status ~time (Some `MOVE) ; let index = toolbar#get_drop_index x y in toolbar#set_drop_highlight_item (Some (item, index)) ; true let toolbar_drag_leave_cb (toolbar : #GButton.toolbar) ctx ~time = drag_item := None ; toolbar#set_drop_highlight_item None let toolbar_drag_drop_cb toolbar label ctx ~x ~y ~time = let l = string_of_int (toolbar#get_drop_index x y) in label#set_label l ; true let main = let w = GWindow.window ~title:"Toolbar demo" () in w#connect#destroy GMain.quit ; let table = GPack.table ~rows:5 ~columns:2 ~packing:w#add () in let toolbar = GButton.toolbar ~packing:(table#attach ~left:0 ~top:0 ~right:2 ~expand:`X ~fill:`BOTH) () in toolbar#connect#popup_context_menu (context_menu_cb toolbar) ; begin let hbox1 = GPack.hbox ~spacing:3 ~border_width:5 ~packing:(table#attach ~left:1 ~top:1 ~expand:`X ~fill:`BOTH) () in begin let checkbox = GButton.check_button ~label:"_Vertical" ~use_mnemonic:true ~packing:hbox1#pack () in checkbox#connect#toggled (change_orientation checkbox table toolbar) end ; begin let checkbox = GButton.check_button ~label:"_Show Arrow" ~use_mnemonic:true ~packing:hbox1#pack () in checkbox#connect#toggled (fun () -> toolbar#set_show_arrow checkbox#active) ; end ; end ; begin let hbox2 = GPack.hbox ~spacing:3 ~border_width:5 ~packing:(table#attach ~left:1 ~top:2 ~expand:`X ~fill:`BOTH) () in let checkbox = GButton.check_button ~label:"Set _Toolbar Style" ~use_mnemonic:true ~packing:hbox2#pack () in let (combo, _) = GEdit.combo_box_text ~strings:[ "icons"; "text"; "both (vertical)"; "both (horizontal)" ] ~packing:hbox2#pack () in combo#misc#set_sensitive false ; combo#set_active (List.assoc toolbar#style [ `ICONS, 0; `TEXT, 1; `BOTH, 2; `BOTH_HORIZ, 3 ]) ; combo#connect#changed (change_toolbar_style combo toolbar) ; checkbox#connect#toggled (set_toolbar_style_toggled checkbox combo toolbar) end ; begin let hbox3 = GPack.hbox ~spacing:3 ~border_width:5 ~packing:(table#attach ~left:1 ~top:3 ~expand:`X ~fill:`BOTH) () in let checkbox = GButton.check_button ~label:"Set _Icon Size" ~use_mnemonic:true ~packing:hbox3#pack () in let (combo, _) = GEdit.combo_box_text ~strings:[ "small toolbar"; "large toolbar" ] ~packing:hbox3#pack () in combo#misc#set_sensitive false ; combo#set_active (List.assoc toolbar#icon_size [ `SMALL_TOOLBAR, 0; `LARGE_TOOLBAR, 1 ]) ; combo#connect#changed (change_icon_size combo toolbar) ; checkbox#connect#toggled (set_icon_size_toggled checkbox combo toolbar) end ; begin let scrolled_window = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:(table#attach ~left:1 ~top:4 ~expand:`BOTH ~fill:`BOTH) () in let (store, name_col, item_col, treeview) = create_item_list scrolled_window#add in let add_item name item = let row = store#append () in store#set ~row ~column:name_col name ; store#set ~row ~column:item_col item#as_tool_item ; toolbar#insert item in add_item "New" (GButton.tool_button ~stock:`NEW ~expand:true ()) ; add_item "Open" (GButton.tool_button ~stock:`OPEN ()) ; add_item "-----" (GButton.separator_tool_item ()) ; begin let item = GButton.tool_button ~stock:`REFRESH () in add_item "Refresh" item ; item#connect#clicked (fun () -> print_endline "clicked") end ; begin let item = GButton.tool_item () in let image = GMisc.image ~stock:`DIALOG_WARNING ~icon_size:`DIALOG ~packing:item#add () in add_item "(Custom Item)" item end ; add_item "Back" (GButton.tool_button ~stock:`GO_BACK ()) ; add_item "-----" (GButton.separator_tool_item ()) ; add_item "Forward" (GButton.tool_button ~stock:`GO_FORWARD ()) ; begin let item = GButton.toggle_tool_button ~stock:`BOLD () in item#connect#toggled (fun () -> Printf.printf "Bold toggled (active=%b)\n" item#get_active ; flush stdout) ; add_item "Bold" item end ; add_item "-----" (GButton.separator_tool_item ~draw:false ~expand:true ()) ; begin let item = GButton.radio_tool_button ~stock:`JUSTIFY_LEFT () in add_item "Left" item ; add_item "Center" (GButton.radio_tool_button ~group:item ~stock:`JUSTIFY_CENTER ()) ; add_item "Right" (GButton.radio_tool_button ~group:item ~stock:`JUSTIFY_RIGHT ()) end ; begin let image = GMisc.image ~file:"/usr/share/gtk-2.0/demo/apple-red.png" () in let item = GButton.tool_button ~label:"_Apple" ~use_underline:true () in item#set_icon_widget image#coerce ; add_item "Apple" item end ; begin let hbox = GPack.hbox ~border_width:5 ~spacing:5 ~packing:(table#attach ~left:1 ~top:5 ~expand:`X ~fill:`BOTH) () in let button = GButton.button ~label:"Drag me to the toolbar" ~packing:hbox#pack () in let label = GMisc.label ~text:"Drop index:" ~packing:hbox#pack () in let label = GMisc.label ~packing:hbox#pack () in button#drag#source_set ~modi:[`BUTTON1] ~actions:[`MOVE] targets ; toolbar#drag#dest_set ~flags:[`DROP] ~actions:[`MOVE] targets ; toolbar#drag#connect#motion (toolbar_drag_motion_cb toolbar) ; toolbar#drag#connect#leave (toolbar_drag_leave_cb toolbar) ; toolbar#drag#connect#drop (toolbar_drag_drop_cb toolbar label); end ; end ; w#show () ; GMain.main () lablgtk-2.18.8/examples/rsvg/0000755000175000017500000000000013523300020015045 5ustar stephstephlablgtk-2.18.8/examples/rsvg/floppy.svg0000644000175000017500000000621113460263323017115 0ustar stephsteph ]> lablgtk-2.18.8/examples/rsvg/test_rsvg.ml0000644000175000017500000000267213460263323017444 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let zoom = ref None let dpi = ref None let fname = ref "" let _ = let cli_args = [ ( "-zoom", Arg.Float (fun v -> zoom := Some v), "zoom factor" ) ; ( "-dpi" , Arg.Float (fun v -> dpi := Some v), "") ] in let usg_msg = Printf.sprintf "usage: %s [options] \n" (Filename.basename Sys.executable_name) in Arg.parse cli_args ((:=) fname) usg_msg ; if not (Sys.file_exists !fname) then begin Arg.usage cli_args usg_msg ; exit 2 end let pb = let gz = Filename.check_suffix !fname ".svgz" || Filename.check_suffix !fname ".svg.gz" in let size_cb = match !zoom with | None -> None | Some z -> Some (Rsvg.at_zoom z z) in Rsvg.render_from_file ~gz ?dpi:!dpi ?size_cb !fname let w = GWindow.window ~allow_grow:false ~title:!fname () let i = GMisc.image ~packing:w#add () let () = i#set_pixbuf pb ; w#connect#destroy GMain.quit; w#show (); GMain.main () lablgtk-2.18.8/examples/custom_tree_generic.ml0000644000175000017500000002023013460263323020456 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* ../src/lablgtk2 -localdir custom_tree_generic.ml *) let debug = false let () = if debug then begin Gc.set { (Gc.get()) with Gc.verbose = 0x00d; space_overhead = 0 }; ignore (Gc.create_alarm (fun () -> let s = Gc.stat () in Format.printf "blocks=%d words=%d@." s.Gc.live_blocks s.Gc.live_words)) end module MAKE(TREE:sig type t val sons: t -> t array val custom_value: Gobject.g_type -> t -> column:int -> Gobject.basic val column_list:GTree.column_list end) = struct type custom_tree = {finfo: TREE.t; mutable sons: custom_tree array; mutable parent: custom_tree option; fidx: int (* invariant: parent.(fidx)==myself *) } let inbound i a = i>=0 && i None | _ -> if inbound indices.(0) roots then let result = ref (roots.(indices.(0))) in try for depth=1 to Array.length indices - 1 do let index = indices.(depth) in if inbound index !result.sons then result:=!result.sons.(index) else raise Not_found done; Some !result with Not_found -> None else None method custom_get_path (row:custom_tree) : Gtk.tree_path = let current_row = ref row in let path = ref [] in while !current_row.parent <> None do path := !current_row.fidx::!path; current_row := match !current_row.parent with Some p -> p | None -> assert false done; GTree.Path.create ((!current_row.fidx)::!path) method custom_value (t:Gobject.g_type) (row:custom_tree) ~column = TREE.custom_value t row.finfo ~column method custom_iter_next (row:custom_tree) : custom_tree option = let nidx = succ row.fidx in match row.parent with | None -> if inbound nidx roots then Some roots.(nidx) else None | Some parent -> if inbound nidx parent.sons then Some parent.sons.(nidx) else None method custom_iter_children (rowopt:custom_tree option) :custom_tree option = match rowopt with | None -> if inbound 0 roots then Some roots.(0) else None | Some row -> if inbound 0 row.sons then Some row.sons.(0) else None method custom_iter_has_child (row:custom_tree) : bool = Array.length row.sons > 0 method custom_iter_n_children (rowopt:custom_tree option) : int = match rowopt with | None -> Array.length roots | Some row -> Array.length row.sons method custom_iter_nth_child (rowopt:custom_tree option) (n:int) : custom_tree option = match rowopt with | None when inbound n roots -> Some roots.(n) | Some row when inbound n row.sons -> Some (row.sons.(n)) | _ -> None method custom_iter_parent (row:custom_tree) : custom_tree option = row.parent method append_tree (t:TREE.t) = let rec make_forest root sons = Array.mapi (fun i t -> let result = {finfo=t; fidx=i; parent = Some root; sons = [||] } in let sons = make_forest result (TREE.sons t) in result.sons<-sons; result) sons in let pos = num_roots in num_roots <- num_roots+1; let root = { finfo = t; sons = [||]; parent = None; fidx = pos } in let sons = make_forest root (TREE.sons t) in root.sons <- sons; roots <- Array.init num_roots (fun n -> if n = num_roots - 1 then root else roots.(n)) end let custom_tree () = new custom_tree_class TREE.column_list end module T=struct type leaf = {mutable checked: bool; mutable lname: string; } type t = Leaf of leaf | Node of string* t list let sons t = match t with | Leaf _ -> [||] | Node (_,s)-> Array.of_list s (** The columns in our custom model *) let column_list = new GTree.column_list ;; let col_file = (column_list#add Gobject.Data.caml: t GTree.column);; let col_bool = column_list#add Gobject.Data.boolean;; let col_int = column_list#add Gobject.Data.int;; let col_is_leaf = column_list#add Gobject.Data.boolean;; let custom_value _ t ~column = match column with | 0 -> (* col_file *) `CAML (Obj.repr t) | 1 -> (* col_bool *) `BOOL false | 2 -> (* col_int *) `INT 0 | 3 -> (* col_is_leaf*) `BOOL (match t with Leaf _ -> true | _ -> false) | _ -> assert false end module MODEL=MAKE(T) let nb = ref 0 let make_tree n p = let rec aux p0 = if p=p0 then begin incr nb; T.Leaf {T.lname = "Leaf "^string_of_int !nb; checked = false} end else begin incr nb; let name = "Node "^string_of_int !nb in T.Node (name,aux_list n (succ p0)) end and aux_list n p = if n = 0 then [] else aux p::aux_list (n-1) p in aux 0 let fill_model t = for i = 0 to 10000 do t#append_tree (make_tree 1 1) done let create_view_and_model () : GTree.view = let custom_tree = MODEL.custom_tree () in fill_model custom_tree; let view = GTree.view ~fixed_height_mode:true ~model:custom_tree () in let renderer = GTree.cell_renderer_text [] in let col_name = GTree.view_column ~title:"Name" ~renderer:(renderer,[]) () in col_name#set_sizing `FIXED; col_name#set_fixed_width 150; col_name#set_cell_data_func renderer (fun model row -> try let data = model#get ~row ~column:T.col_file in match data with | T.Leaf {T.lname = s} | T.Node (s,_) -> renderer#set_properties [ `TEXT s ]; with exn -> let s = GtkTree.TreePath.to_string (model#get_path row) in Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)); ignore (view#append_column col_name); let renderer = GTree.cell_renderer_toggle [] in let col_tog = GTree.view_column ~title:"Check" ~renderer:(renderer,["visible", T.col_is_leaf]) () in col_tog#set_sizing `FIXED; col_tog#set_fixed_width 10; col_tog#set_cell_data_func renderer (fun model row -> try let data = model#get ~row ~column:T.col_file in match data with | T.Leaf {T.checked = b} -> renderer#set_properties [ `ACTIVE b ] | _ -> () with exn -> let s = GtkTree.TreePath.to_string (model#get_path row) in Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)); ignore(renderer#connect#toggled (fun path -> let row = custom_tree#custom_get_iter path in match row with | Some {MODEL.finfo=T.Leaf l} -> l.T.checked <- not l.T.checked | _ -> ())); ignore (view#append_column col_tog); view let _ = ignore (GtkMain.Main.init ()); let window = GWindow.window ~width:200 ~height:400 () in ignore (window#event#connect#delete ~callback:(fun _ -> exit 0)); let scrollwin = GBin.scrolled_window ~packing:window#add () in let view = create_view_and_model () in scrollwin#add view#coerce; window#show (); GtkMain.Main.main () lablgtk-2.18.8/examples/giotest.ml0000644000175000017500000000262013460263323016112 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open StdLabels module Unix = UnixLabels open GMain let l = Main.init () let fd = Unix.stdin (* Unix.openfile "giotest.ml" [Unix.O_RDONLY] 0 *) let ch = Io.channel_of_descr fd let w = GWindow.window ~width:300 ~height:200 () let buffer = GText.buffer () let text = GText.view ~buffer ~packing:w#add () let () = prerr_endline "Input some text on "; Io.add_watch ch ~prio:0 ~cond:[`IN; `HUP; `ERR] ~callback: begin fun c -> if List.mem `IN c then begin let buf = Bytes.create 1 in (* On Windows, you must use Io.read *) let len = Glib.Io.read ch ~buf ~pos:0 ~len:1 in len = 1 && (buffer#insert (Bytes.to_string buf); true) end else if List.mem `HUP c then begin prerr_endline "got `HUP, exiting in 5s" ; Timeout.add 5000 (fun () -> Main.quit () ; false) ; false end else assert false end ; w#connect#destroy quit; w#show (); main () lablgtk-2.18.8/examples/pousse.ml0000644000175000017500000001351013460263323015752 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (* The game logic *) type color = [`none|`white|`black] module type BoardSpec = sig type t val size : int val get : t -> x:int -> y:int -> color val set : t -> x:int -> y:int -> color:color -> unit end module Board (Spec : BoardSpec) = struct open Spec let size = size let on_board x y = x >= 0 && x < size && y >= 0 && y < size let rec string board ~x ~y ~dx ~dy ~color l = let x = x+dx and y = y+dy in if on_board x y then let col = get board ~x ~y in if col = (color : [`white|`black] :> color) then l else if col = `none then [] else string board ~x ~y ~dx ~dy ~color ((x,y)::l) else [] let find_swaps board ~x ~y ~color = if get board ~x ~y <> `none then [] else List.fold_left [-1,-1; -1,0; -1,1; 0,-1; 0,1; 1,-1; 1,0; 1,1] ~init:[] ~f:(fun acc (dx,dy) -> string board ~x ~y ~dx ~dy ~color [] @ acc) let action board ~x ~y ~color = let swaps = find_swaps board ~x ~y ~color in if swaps = [] then false else begin List.iter ((x,y)::swaps) ~f:(fun (x,y) -> set board ~x ~y ~color:(color :> color)); true end let check_impossible board ~color = try for x = 0 to size - 1 do for y = 0 to size - 1 do if find_swaps board ~x ~y ~color <> [] then raise Exit done done; true with Exit -> false let count_cells board = let w = ref 0 and b = ref 0 in for x = 0 to size - 1 do for y = 0 to size - 1 do match get board ~x ~y with `white -> incr w | `black -> incr b | `none -> () done done; (!w,!b) end (* GUI *) open GMain (* Toplevel window *) let window = GWindow.window ~title:"pousse" () (* Create pixmaps *) let pixdraw = GDraw.pixmap ~window ~width:40 ~height:40 ~mask:true () let pixdraw1 = GDraw.pixmap ~window ~width:40 ~height:40 ~mask:true () let pixdraw2 = GDraw.pixmap ~window ~width:40 ~height:40 ~mask:true () let _ = pixdraw1#set_foreground `BLACK; pixdraw1#arc ~x:3 ~y:3 ~width:34 ~height:34 ~filled:true (); pixdraw2#set_foreground `WHITE; pixdraw2#arc ~x:3 ~y:3 ~width:34 ~height:34 ~filled:true (); pixdraw2#set_foreground `BLACK; pixdraw2#arc ~x:3 ~y:3 ~width:34 ~height:34 () (* The cell class: a button with a pixmap on it *) class cell ?packing ?show () = let button = GButton.button ?packing ?show () in object (self) inherit GObj.widget button#as_widget method connect = button#connect val mutable color : color = `none val pm = GMisc.pixmap pixdraw ~packing:button#add () method color = color method set_color col = if col <> color then begin color <- col; pm#set_pixmap (match col with `none -> pixdraw | `black -> pixdraw1 | `white -> pixdraw2) end end module RealBoard = Board ( struct type t = cell array array let size = 8 let get (board : t) ~x ~y = board.(x).(y)#color let set (board : t) ~x ~y ~color = board.(x).(y)#set_color color end ) (* Conducting a game *) open RealBoard class game ~(frame : #GContainer.container) ~(label : #GMisc.label) ~(statusbar : #GMisc.statusbar) = let table = GPack.table ~columns:size ~rows:size ~packing:frame#add () in object (self) val cells = Array.init size ~f:(fun i -> Array.init size ~f:(fun j -> new cell ~packing:(table#attach ~top:i ~left:j) ())) val label = label val turn = statusbar#new_context ~name:"turn" val messages = statusbar#new_context ~name:"messages" val mutable current_color = `black method board = cells method table = table method player = current_color method swap_players () = current_color <- match current_color with `white -> turn#pop (); turn#push "Player is black"; `black | `black -> turn#pop (); turn#push "Player is white"; `white method finish () = turn#pop (); let w, b = count_cells cells in turn#push (if w > b then "White wins" else if w < b then "Black wins" else "Game is a draw"); () method update_label () = let w, b = count_cells cells in label#set_text (Printf.sprintf "White: %d Black: %d " w b) method play x y = if action cells ~x ~y ~color:current_color then begin self#update_label (); self#swap_players (); if check_impossible cells ~color:current_color then begin self#swap_players (); if check_impossible cells ~color:current_color then self#finish () end end else messages#flash "You cannot play there" initializer for i = 0 to size-1 do for j = 0 to size-1 do let cell = cells.(i).(j) in cell#connect#enter ~callback:cell#misc#grab_focus; cell#connect#clicked ~callback:(fun () -> self#play i j) done done; List.iter ~f:(fun (x,y,col) -> cells.(x).(y)#set_color col) [ 3,3,`black; 4,4,`black; 3,4,`white; 4,3,`white ]; self#update_label (); turn#push "Player is black"; () end (* Graphical elements *) let vbox = GPack.vbox ~packing:window#add () let frame = GBin.frame ~shadow_type:`IN ~packing:vbox#add () let hbox = GPack.hbox ~packing:vbox#pack () let bar = GMisc.statusbar ~packing:hbox#add () let frame2 = GBin.frame ~shadow_type:`IN ~packing:hbox#pack () let label = GMisc.label ~justify:`LEFT ~xpad:5 ~xalign:0.0 ~packing:frame2#add () let game = new game ~frame ~label ~statusbar:bar (* Start *) let _ = window#connect#destroy ~callback:Main.quit; window#show (); Main.main () lablgtk-2.18.8/examples/editor.ml0000644000175000017500000000754713460263323015737 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* Uses the deprecated old text widget. See editor2.ml for the new one *) open StdLabels open GMain let file_dialog ~title ~callback ?filename () = let sel = GWindow.file_selection ~title ~modal:true ?filename () in sel#cancel_button#connect#clicked ~callback:sel#destroy; sel#ok_button#connect#clicked ~callback: begin fun () -> let name = sel#filename in sel#destroy (); callback name end; sel#show () class editor ?packing ?show () = object (self) val text = GBroken.text ~editable:true ?packing ?show () val mutable filename = None method text = text method load_file name = try let ic = open_in name in filename <- Some name; text#freeze (); text#delete_text ~start:0 ~stop:text#length; let buf = Bytes.create 1024 and len = ref 0 in while len := input ic buf 0 1024; !len > 0 do text#insert (Bytes.sub_string buf ~pos:0 ~len:!len) done; text#set_point 0; text#thaw (); close_in ic with _ -> () method open_file () = file_dialog ~title:"Open" ~callback:self#load_file () method save_dialog () = file_dialog ~title:"Save" ?filename ~callback:(fun file -> self#output ~file) () method save_file () = match filename with Some file -> self#output ~file | None -> self#save_dialog () method output ~file = try if Sys.file_exists file then Sys.rename file (file ^ "~"); let oc = open_out file in output_string oc (text#get_chars ~start:0 ~stop:text#length); close_out oc; filename <- Some file with _ -> prerr_endline "Save failed" end let window = GWindow.window ~width:500 ~height:300 ~title:"editor" () let vbox = GPack.vbox ~packing:window#add () let menubar = GMenu.menu_bar ~packing:vbox#pack () let factory = new GMenu.factory menubar let accel_group = factory#accel_group let file_menu = factory#add_submenu "File" let edit_menu = factory#add_submenu "Edit" let hbox = GPack.hbox ~packing:vbox#add () let editor = new editor ~packing:hbox#add () let scrollbar = GRange.scrollbar `VERTICAL ~packing:hbox#pack () open GdkKeysyms let _ = window#connect#destroy ~callback:Main.quit; let factory = new GMenu.factory file_menu ~accel_group in factory#add_item "Open..." ~key:_O ~callback:editor#open_file; factory#add_item "Save" ~key:_S ~callback:editor#save_file; factory#add_item "Save as..." ~callback:editor#save_dialog; factory#add_separator (); factory#add_item "Quit" ~key:_Q ~callback:window#destroy; let factory = new GMenu.factory edit_menu ~accel_group in factory#add_item "Copy" ~key:_C ~callback:editor#text#copy_clipboard; factory#add_item "Cut" ~key:_X ~callback:editor#text#cut_clipboard; factory#add_item "Paste" ~key:_V ~callback:editor#text#paste_clipboard; factory#add_separator (); factory#add_check_item "Word wrap" ~active:false ~callback:editor#text#set_word_wrap; factory#add_check_item "Read only" ~active:false ~callback:(fun b -> editor#text#set_editable (not b)); window#add_accel_group accel_group; editor#text#event#connect#button_press ~callback:(fun ev -> let button = GdkEvent.Button.button ev in if button = 3 then begin file_menu#popup ~button ~time:(GdkEvent.Button.time ev); true end else false); editor#text#set_vadjustment scrollbar#adjustment; window#show (); Main.main () lablgtk-2.18.8/examples/sourceview/0000755000175000017500000000000013523300020016257 5ustar stephstephlablgtk-2.18.8/examples/sourceview/test.ml0000644000175000017500000000743313460263323017615 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Compile with ocamlc -o viewer -I ../../src/ lablgtk.cma lablgtksourceview.cma gtkInit.cmo test.ml Run with CAML_LD_LIBRARY_PATH=../../src ./viewer *) open Printf let lang_mime_type = "text/x-ocaml" let lang_file = "ocaml.lang" let use_mime_type = false let font_name = "Monospace 10" let print_lang lang = prerr_endline (sprintf "language: %s" lang#get_name) let print_lang_dirs languages_manager = let i = ref 0 in prerr_endline "lang_dirs:"; List.iter (fun dir -> incr i; prerr_endline (sprintf "%d: %s" !i dir)) languages_manager#lang_files_dirs let win = GWindow.window ~title:"LablGtkSourceView test" () let vbox = GPack.vbox ~packing:win#add () let hbox = GPack.hbox ~packing:(vbox#pack ~expand: false) () let bracket_button = GButton.button ~label:"( ... )" ~packing:hbox#add () let scrolled_win = GBin.scrolled_window ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ~packing:vbox#add () let source_view = GSourceView.source_view ~auto_indent:true ~insert_spaces_instead_of_tabs:true ~tabs_width:2 ~show_line_numbers:true ~margin:80 ~show_margin:true ~smart_home_end:true ~packing:scrolled_win#add ~height:500 ~width:650 () (* let languages_manager = GSourceView.source_languages_manager ~lang_files_dirs:["/etc"] () *) let languages_manager = GSourceView.source_languages_manager () let lang = if use_mime_type then match languages_manager#get_language_from_mime_type lang_mime_type with | None -> failwith (sprintf "no language for %s" lang_mime_type) | Some lang -> lang else match GSourceView.source_language_from_file ~languages_manager lang_file with | None -> failwith (sprintf "can't load %s" lang_file) | Some lang -> lang let matching_bracket () = let iter = source_view#source_buffer#get_iter_at_mark `INSERT in match GSourceView.find_matching_bracket iter with | None -> prerr_endline "no matching bracket" | Some iter -> source_view#source_buffer#place_cursor iter; source_view#misc#grab_focus () let _ = let text = let ic = open_in "test.ml" in let size = in_channel_length ic in let buf = String.create size in really_input ic buf 0 size; close_in ic; buf in win#set_allow_shrink true; source_view#misc#modify_font_by_name font_name; print_lang_dirs languages_manager; print_lang lang; (* set red as foreground color for definition keywords *) let id = "Definition@32@keyword" in let st = lang#get_tag_style id in st#set_foreground_by_name "red"; lang#set_tag_style id st; (* set a style for bracket matching *) source_view#source_buffer#set_check_brackets true; let _ = let st = GSourceView.source_tag_style ~background_by_name:"green" ~foreground_by_name:"yellow" ~bold: true () in source_view#source_buffer#set_bracket_match_style st in source_view#source_buffer#set_language lang; source_view#source_buffer#set_highlight true; source_view#source_buffer#set_text text; ignore (win#connect#destroy (fun _ -> GMain.quit ())); ignore (bracket_button#connect#clicked matching_bracket); (* ignore (source_view#connect#move_cursor (fun _ _ ~extend -> prerr_endline "move_cursor")); ignore (source_view#connect#undo (fun _ -> prerr_endline "undo")); *) win#show (); GMain.Main.main () lablgtk-2.18.8/examples/sourceview/example2.ml0000644000175000017500000000745313460263323020355 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Run with ../../src/lablgtk2 -localdir example2.ml *) open Printf let lang_mime_type = "text/x-ocaml" let lang_name = "ocaml" let use_mime_type = true let font_name = "Monospace 10" let print_lang lang = prerr_endline (sprintf "language: %s" lang#name) let print_lang_ids language_manager = let i = ref 0 in prerr_endline "language_ids:"; List.iter (fun id -> incr i; match language_manager#language id with Some lang -> let name = lang#name in let section = lang#section in prerr_endline (sprintf "%d: %s %s (%s)" !i id name section) | None -> ()) language_manager#language_ids let print_style_schemes mgr = let i = ref 0 in prerr_endline "style schemes:"; List.iter (fun id -> incr i; match mgr#style_scheme id with Some scm -> prerr_endline (sprintf "%d: %s %s" !i id scm#description) | None -> ()) mgr#style_scheme_ids let win = GWindow.window ~title:"LablGtkSourceView test" () let scrolled_win = GBin.scrolled_window ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ~packing:win#add () let source_view = GSourceView2.source_view ~auto_indent:true ~insert_spaces_instead_of_tabs:true ~tab_width:2 ~show_line_numbers:true ~right_margin_position:80 ~show_right_margin:true (* ~smart_home_end:true *) ~packing:scrolled_win#add ~height:500 ~width:650 () let language_manager = GSourceView2.source_language_manager ~default:true let lang = if use_mime_type then (match language_manager#guess_language ~content_type:lang_mime_type () with Some x -> x | None -> failwith (sprintf "no language for %s" lang_mime_type)) else (match language_manager#language lang_name with Some x -> x | None -> failwith (sprintf "can't load %s" lang_name)) let () = print_lang_ids language_manager; print_lang lang let style_scheme_manager = GSourceView2.source_style_scheme_manager ~default:true let () = print_style_schemes style_scheme_manager let () = let text = let ic = open_in "example2.ml" in let size = in_channel_length ic in let buf = String.create size in really_input ic buf 0 size; close_in ic; buf in win#set_allow_shrink true; source_view#misc#modify_font_by_name font_name; source_view#source_buffer#set_highlight_matching_brackets true; source_view#source_buffer#set_language (Some lang); source_view#source_buffer#set_highlight_syntax true; source_view#set_smart_home_end `AFTER; if source_view#smart_home_end <> `AFTER then failwith "regret"; source_view#set_draw_spaces [`SPACE; `NEWLINE]; List.iter (function | `SPACE -> print_string " space" | `TAB -> print_string " tab" | `NEWLINE -> print_string " newline" | `NBSP -> print_string " nbsp" | `LEADING -> print_string "leading" | `TEXT -> print_string "text" | `TRAILING -> print_string "trailing") source_view#draw_spaces; print_newline (); ignore (win#connect#destroy (fun _ -> GMain.quit ())); ignore (source_view#connect#undo (fun _ -> prerr_endline "undo")); source_view#source_buffer#begin_not_undoable_action (); source_view#source_buffer#set_text text; source_view#source_buffer#end_not_undoable_action (); win#show (); GMain.Main.main () lablgtk-2.18.8/examples/sourceview/ocaml.lang0000644000175000017500000000753413460263323020244 0ustar stephsteph \ \(\* \*\) \b[-]?[0-9][0-9_]*[lL]?\b \b[-]?0[xX][0-9A-Fa-f][0-9A-Fa-f_]*[lL]?\b \b[-]?0[oO][0-7][0-7_]*[lL]?\b \b[-]?0[bB][01][01_]*[lL]?\b \b[-]?[0-9][0-9_]*(\.[0-9_]*)?([Ee][+-]?[0-9][0-9_]*)? ' ' " " true false \b[A-Z][A-Za-z0-9_']* [~?][a-z][A-Za-z0-9_']* and class constraint exception external let fun function functor in include inherit initializer method module mutable of open private rec type val virtual asr do else for if while as assert begin do done downto else end for if land lazy lor lsl lsr lxor match mod new object or sig struct then to try when while with # (\||->) int string list array float char unit lablgtk-2.18.8/examples/sourceview/test2.ml0000644000175000017500000000724513460263323017700 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Compile with ocamlc -o viewer -I ../../src/ lablgtk.cma lablgtksourceview2.cma gtkInit.cmo test2.ml Run with CAML_LD_LIBRARY_PATH=../../src ./viewer *) open Printf let lang_mime_type = "text/x-ocaml" let use_mime_type = false let font_name = "Monospace 10" let print_lang lang = prerr_endline (sprintf "language: %s" lang#name) let print_lang_dirs (language_manager:GSourceView2.source_language_manager) = let i = ref 0 in prerr_endline "lang_dirs:"; List.iter (fun dir -> incr i; prerr_endline (sprintf "%d: %s" !i dir)) language_manager#search_path let win = GWindow.window ~title:"LablGtkSourceView 2 test" () let vbox = GPack.vbox ~packing:win#add () let hbox = GPack.hbox ~packing:(vbox#pack ~expand: false) () let bracket_button = GButton.button ~label:"( ... )" ~packing:hbox#add () let scrolled_win = GBin.scrolled_window ~hpolicy: `AUTOMATIC ~vpolicy: `AUTOMATIC ~packing:vbox#add () let source_view = GSourceView2.source_view ~auto_indent:true ~insert_spaces_instead_of_tabs:true ~tab_width:2 ~show_line_numbers:true ~right_margin_position:30 ~show_right_margin:true ~smart_home_end:`ALWAYS ~packing:scrolled_win#add ~height:500 ~width:900 () let language_manager = GSourceView2.source_language_manager ~default:true let lang = match language_manager#guess_language ~content_type:lang_mime_type () with | None -> failwith (sprintf "no language for %s" lang_mime_type) | Some lang -> lang let _ = let text = let ic = open_in "test.ml" in let size = in_channel_length ic in let buf = String.create size in really_input ic buf 0 size; close_in ic; buf in win#set_allow_shrink true; source_view#misc#modify_font_by_name font_name; print_lang_dirs language_manager; print_lang lang; (* set a style for bracket matching *) source_view#source_buffer#set_highlight_matching_brackets true; source_view#set_show_line_marks true; source_view#source_buffer#set_language (Some lang); source_view#source_buffer#set_highlight_syntax true; source_view#source_buffer#set_text text; ignore (win#connect#destroy (fun _ -> GMain.quit ())); let category = "current" in let current_line_bookmark = source_view#source_buffer#create_source_mark ~category (source_view#source_buffer#get_iter `START) in let pixbuf = source_view#misc#render_icon ~size:`DIALOG `DIALOG_INFO in source_view#set_mark_category_background ~category (Some (GDraw.color (`NAME "light blue"))); source_view#set_mark_category_pixbuf ~category (Some pixbuf); ignore (source_view#source_buffer#connect#mark_set (fun where mark -> if GtkText.Mark.get_name mark = Some "insert" then begin prerr_endline "move_cursor"; source_view#source_buffer#move_mark current_line_bookmark#coerce ~where ; end)); ignore (source_view#connect#undo (fun _ -> prerr_endline "undo")); win#show (); GMain.Main.main () (* Local Variables: compile-command: "ocamlc -o viewer -I ../../src/ lablgtk.cma lablgtksourceview2.cma gtkInit.cmo test2.ml" End: *) lablgtk-2.18.8/examples/sourceview/sourceview2.ml0000644000175000017500000000431013460263323021102 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let ctx = new source_completion_context context in let item s = source_completion_item ~label:s ~text:s () in let proposal s = (item s :> source_completion_proposal) in let proposals = List.map proposal provided_list in ctx#add_proposals (do_provider ()) proposals true in let info_widget provider = let label = GMisc.label ~text:"toto" () in Some (label#coerce#as_widget) in let provider = let provider = { provider_name = "default"; provider_icon = Some (GdkPixbuf.create 60 60 ()); provider_populate = populate; provider_activation = []; provider_match = (fun _ -> true); provider_info_widget = info_widget; provider_update_info = (fun _ _ -> ()); provider_start_iter = (fun _ _ _ -> false); provider_activate_proposal = (fun _ _ -> false); provider_interactive_delay = 0; provider_priority = 0; } in GSourceView2.source_completion_provider provider in provider_ref := (Some provider); provider module C = GSourceView2 let window = GWindow.window ~width:400 ~height:400 () let box = GPack.vbox ~packing:window#add () let button = GButton.button ~label:"Click" ~packing:(box#pack) () let v = GSourceView2.source_view ~packing:(box#pack ~expand:true) () let cpl = v#completion let _ = cpl#add_provider provider let () = window#show () let cb () = let itr = v#buffer#start_iter in let ctx = cpl#create_context itr in ignore (cpl#show [provider] ctx) let _ = button#connect#clicked cb (* let _ = cpl#add_provider provider *) (* let _ = Glib.Timeout.add 1000 (fun _ -> cpl#show [provider] ctx) *) (* let _ = completion#add_provider provider in *) let () = GMain.Main.main () lablgtk-2.18.8/examples/events.ml0000644000175000017500000000704013460263323015741 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* This is a direct translation to Gtk2. This is actually meaningless, as the new text widget lets you obtain an iterator from coordinates, but this just demonstrates the use of [#event#send]. *) (* Old comment by Benjamin: I cannot translate this program directly to Gtk 2. The event generation causes segfault and starts some drag-n-drop op. The default signal for left button has probably changed.*) (* I don't see segfaults, just Gtk-criticals. Seems the default handler for button 3 is still called, and I see no way to disable that. But this is not really relevant to [#event#send]. *) let string_of_event x = match GdkEvent.get_type x with | `NOTHING -> "nothing" | `DELETE -> "delete" | `DESTROY -> "destroy" | `EXPOSE -> "expose" | `MOTION_NOTIFY -> "motion-notify" | `BUTTON_PRESS -> "button-press" | `TWO_BUTTON_PRESS -> "2 button-press" | `THREE_BUTTON_PRESS -> "3 button-press" | `BUTTON_RELEASE -> "button-release" | `KEY_PRESS -> "key-press" | `KEY_RELEASE -> "key-release" | `ENTER_NOTIFY -> "enter-notfiy" | `LEAVE_NOTIFY -> "leave-notify" | `FOCUS_CHANGE -> "focus-change" | `CONFIGURE -> "configure" | `MAP -> "map" | `UNMAP -> "unmap" | `PROPERTY_NOTIFY -> "property-notify" | `SELECTION_CLEAR -> "selection-clear" | `SELECTION_REQUEST -> "selection-request" | `SELECTION_NOTIFY -> "selection-notify" | `PROXIMITY_IN -> "proximity-in" | `PROXIMITY_OUT -> "proximiy-out" | `DRAG_ENTER -> "drag-enter" | `DRAG_LEAVE -> "drag-leave" | `DRAG_MOTION -> "drag-motion" | `DRAG_STATUS -> "drag-status" | `DROP_START -> "drop-start" | `DROP_FINISHED -> "drop-finish" | `CLIENT_EVENT -> "client-event" | `VISIBILITY_NOTIFY -> "visibility-notify" | `NO_EXPOSE-> "no-expose" | `SCROLL -> "scroll" | `WINDOW_STATE -> "window-state" | `SETTING -> "setting" let _ = let window = GWindow.window ~width:200 ~height:200 () in window#connect#destroy ~callback:GMain.quit ; window#event#add [`ALL_EVENTS]; window#event#connect#any (fun x -> prerr_string "before "; prerr_endline (string_of_event x); false); window#event#connect#after#any (fun x -> prerr_string "after "; prerr_endline (string_of_event x); false); window#event#connect#configure (fun x -> prerr_string "BEFORE CONFIGURE "; prerr_endline (string_of_event x); false); window#event#connect#after#configure (fun x -> prerr_string "AFTER CONFIGURE "; prerr_endline (string_of_event x); false); let text = GText.view ~packing:window#add () in let buffer = text#buffer in text#event#connect#button_press ~callback: begin fun ev -> GdkEvent.Button.button ev = 3 && GdkEvent.get_type ev = `BUTTON_PRESS && begin let pos = buffer#get_iter_at_mark `INSERT in GdkEvent.Button.set_button ev 1; text#event#send (ev :> GdkEvent.any); Printf.printf "Position is %d.\n" pos#offset; flush stdout; buffer#move_mark `INSERT ~where:pos; GtkSignal.stop_emit (); true end end; window#show (); GMain.main () lablgtk-2.18.8/examples/hello.ml0000644000175000017500000000202013460263323015531 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let window = GWindow.window ~border_width: 10 () let button = GButton.button ~label:"Hello World" ~packing: window#add () let main () = window#event#connect#delete ~callback:(fun _ -> prerr_endline "Delete event occured"; true); window#connect#destroy ~callback:Main.quit; button#connect#clicked ~callback:(fun () -> prerr_endline "Hello World"); button#connect#clicked ~callback:window#destroy; window#show (); Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/assistant_tutorial.ml0000644000175000017500000001202113460263323020364 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id: $ *) (* The tutorial is translated to OCaml from Chapter 5 of Foundations of GTK+ Development (published April 2007). You can find more information about the book at http://www.gtkbook.com. *) (* See also {http://www.linuxquestions.org/linux/articles/Technical/New_GTK_Widgets_GtkAssistant} *) (* If there is text in the GtkEntry, set the page as complete. Otherwise, stop the user from progressing the next page. *) let entry_changed assistant entry () = let text = entry#text in let num = assistant#current_page in let page = assistant#nth_page num in assistant#set_page_complete page (String.length (text) > 0) (* If the check button is toggled, set the page as complete. Otherwise, stop the user from progressing the next page. *) let button_toggled toggle assistant () = let active = toggle#active in assistant#set_page_complete toggle#as_widget active (* Fill up the progress bar, 10% every second when the button is clicked. Then, set the page as complete when the progress bar is filled. *) let button_clicked button assistant progress () = let percent = ref 0.0 in button#misc#set_sensitive false; while (!percent <= 100.0) do let message = Printf.sprintf "%.0f%% Complete" !percent in progress#set_fraction (!percent /. 100.0); progress#set_text message; while Glib.Main.pending () do Glib.Main.iteration true done; Glib.usleep 500000; percent := !percent +. 5.0; done; let page = assistant#nth_page 3 in assistant#set_page_complete page true (* If the dialog is cancelled, delete it from memory and then clean up after the Assistant structure. *) let assistant_cancel assistant () = assistant#destroy () (* This function is where you would apply the changes and destroy the assistant. *) let assistant_close assistant () = prerr_endline "You would apply your changes now!"; assistant#destroy () let main () = let assistant = GAssistant.assistant () in assistant#misc#set_size_request ~width:450 ~height:300 (); assistant#set_title "GtkAssistant Example"; assistant#connect#destroy (fun () -> exit 0); let page_0 = GMisc.label ~text:"This is an example of a GtkAssistant. By clicking the forward button, you can continue to the next section!" () in let page_1 = GPack.hbox ~homogeneous:false ~spacing:5 () in let page_2 = GButton.check_button ~label:"Click Me To Continue!" () in let page_3 = GBin.alignment ~xalign:0.5 ~yalign:0.5 ~xscale:0.0 ~yscale:0.0 () in let page_4 = GMisc.label ~text:"Text has been entered in the label and the combo box is clicked. If you are done, then it is time to leave!" () in (* Create the necessary widgets for the second page. *) let _label = GMisc.label ~text:"Your Name: " ~packing:(page_1#pack ~expand:false ~fill:false ~padding:5) () in let entry = GEdit.entry ~packing:(page_1#pack ~expand:false ~fill:false ~padding:5) () in (* Create the necessary widgets for the fourth page. Then Attach the progress bar to the GtkAlignment widget for later access.*) let button = GButton.button ~label:"Click me!" () in let progress = GRange.progress_bar () in let hbox = GPack.hbox ~homogeneous:false ~spacing:5 () in hbox#pack ~expand:true ~fill:false ~padding:5 progress#coerce; hbox#pack ~expand:false ~fill:false ~padding:5 button#coerce; page_3#add hbox#coerce; (* Add five pages to the GtkAssistant dialog. *) assistant#append_page ~title:"Introduction" ~page_type:`INTRO ~complete:true page_0#as_widget; assistant#append_page ~page_type:`CONTENT page_1#as_widget; assistant#append_page ~title:"Click the Check Button" ~page_type:`CONTENT page_2#as_widget; assistant#append_page ~title:"Click the Button" ~page_type:`PROGRESS page_3#as_widget; assistant#append_page ~title:"Confirmation" ~page_type:`CONFIRM ~complete:true page_4#as_widget; (* Update whether pages 2 through 4 are complete based upon whether there is text in the GtkEntry, the check button is active, or the progress bar is completely filled. *) entry#connect#changed ~callback:(entry_changed assistant entry); page_2#connect#toggled ~callback:(button_toggled page_2 assistant); button#connect#clicked ~callback:(button_clicked button assistant progress); assistant#connect#cancel ~callback:(assistant_cancel assistant); assistant#connect#close ~callback:(assistant_close assistant); assistant#show (); GMain.Main.main () let () = main () lablgtk-2.18.8/examples/fixpoint.ml0000644000175000017500000000254013460263323016275 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let rec fix ~f ~eq x = let x' = f x in if eq x x' then x else fix ~f ~eq x' let eq_float x y = abs_float (x -. y) < 1e-13 let _ = let top = GWindow.window () in top#connect#destroy ~callback:Main.quit; let vbox = GPack.vbox ~packing: top#add () in let entry = GEdit.entry ~max_length: 20 ~packing: vbox#add () in let tips = GData.tooltips () in tips#set_tip entry#coerce ~text:"Initial value for fix-point"; let result = GEdit.entry ~max_length: 20 ~editable: false ~packing: vbox#add () in entry#connect#activate ~callback: begin fun () -> let x = try float_of_string entry#text with _ -> 0.0 in entry#set_text (string_of_float (cos x)); let res = fix ~f:cos ~eq:eq_float x in result#set_text (string_of_float res) end; top#show (); Main.main () lablgtk-2.18.8/examples/buttons.ml0000644000175000017500000000355213460263323016137 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let xpm_label_box ~(window : #GContainer.container) ~file ~text ?packing ?(show=true) () = if not (Sys.file_exists file) then failwith (file ^ " does not exist"); let box = GPack.hbox ~border_width: 2 ?packing ~show:false () in let pixmap = GDraw.pixmap_from_xpm ~file ~window () in GMisc.pixmap pixmap ~packing:(box#pack ~padding:3) (); GMisc.label ~text ~packing:(box#pack ~padding:3) (); if show then box#misc#show (); new GObj.widget_full box#as_widget let main () = let window = GWindow.window ~title:"Pixmap'd Buttons!" ~border_width:10 () in window#connect#destroy ~callback:Main.quit; let hbox = GPack.hbox ~packing:window#add () in let button = GButton.button ~packing:(hbox#pack ~padding:5) () in button#connect#clicked ~callback: (fun () -> prerr_endline "Hello again - cool button was pressed"); xpm_label_box ~window ~file:"test.xpm" ~text:"cool button" ~packing:button#add (); let button = GButton.button ~use_mnemonic:true ~label:"_Coucou" ~packing:(hbox#pack ~padding:5) () in button#connect#clicked ~callback: (fun () -> prerr_endline "Coucou"); let button = GButton.button ~stock:`HOME ~packing:(hbox#pack ~padding:5) () in button#connect#clicked ~callback: (fun () -> prerr_endline "Stock buttons look nice"); window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/kaimono.ml0000644000175000017500000001041113460263323016066 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open GMain open Printf let file_dialog ~title ~callback ?filename () = let sel = GWindow.file_selection ~title ~modal:true ?filename () in sel#cancel_button#connect#clicked ~callback:sel#destroy; sel#ok_button#connect#clicked ~callback: begin fun () -> let name = sel#filename in sel#destroy (); callback name end; sel#show () let w = GWindow.window ~title:"Okaimono" () let vb = GPack.vbox ~packing:w#add () let menubar = GMenu.menu_bar ~packing:vb#pack () let factory = new GMenu.factory menubar let file_menu = factory#add_submenu "File" let edit_menu = factory#add_submenu "Edit" let sw = GBin.scrolled_window ~height:200 ~packing:vb#add ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC () let vp = GBin.viewport ~width:340 ~shadow_type:`NONE ~packing:sw#add () let table = GPack.table ~columns:4 ~rows:256 ~packing:vp#add () let _ = table#focus#set_vadjustment (Some vp#vadjustment) let top = ref 0 and left = ref 0 let add_to_table w = table#attach ~left:!left ~top:!top ~expand:`X w; incr left; if !left >= 4 then (incr top; left := 0) let entry_list = ref [] let add_entry () = let entry = List.map [40;200;40;60] ~f:(fun width -> GEdit.entry ~packing:add_to_table ~width ()) in entry_list := entry :: !entry_list let _ = List.iter2 ["Number";"Name";"Count";"Price"] [40;200;40;60] ~f: begin fun label width -> let b = GButton.button ~label ~packing:add_to_table () in b#misc#set_size_request ~width () end; for i = 1 to 9 do add_entry () done let split ~sep s = let len = String.length s in let rec loop pos = let next = try String.index_from s pos sep with Not_found -> len in let sub = String.sub s ~pos ~len:(next-pos) in if next = len then [sub] else sub::loop (next+1) in loop 0 let load name = try let ic = open_in name in List.iter !entry_list ~f:(fun l -> List.iter l ~f:(fun e -> e#set_text "")); let entries = Stack.create () in List.iter !entry_list ~f:(fun x -> Stack.push x entries); try while true do let line = input_line ic in let fields = split ~sep:'\t' line in let entry = try Stack.pop entries with Stack.Empty -> add_entry (); List.hd !entry_list in List.fold_left fields ~init:entry ~f: begin fun acc field -> (List.hd acc)#set_text field; List.tl acc end done with End_of_file -> close_in ic with Sys_error _ -> () let save name = try let oc = open_out name in List.iter (List.rev !entry_list) ~f: begin fun entry -> let l = List.map entry ~f:(fun e -> e#text) in if List.exists l ~f:((<>) "") then let rec loop = function [] -> () | [x] -> fprintf oc "%s\n" x | x::l -> fprintf oc "%s\t" x; loop l in loop l end; close_out oc with Sys_error _ -> () open GdkKeysyms let _ = w#connect#destroy ~callback:Main.quit; w#event#connect#key_press ~callback: begin fun ev -> let key = GdkEvent.Key.keyval ev and adj = vp#vadjustment in if key = _Page_Up then adj#set_value (adj#value -. adj#page_increment) else if key = _Page_Down then adj#set_value (min (adj#value +. adj#page_increment) (adj#upper -. adj#page_size)); false end; w#add_accel_group factory#accel_group; let ff = new GMenu.factory file_menu ~accel_group:factory#accel_group in ff#add_item ~key:_O "Open..." ~callback:(file_dialog ~title:"Open data file" ~callback:load); ff#add_item ~key:_S "Save..." ~callback:(file_dialog ~title:"Save data" ~callback:save); ff#add_separator (); ff#add_item ~key:_Q "Quit" ~callback:w#destroy; let ef = new GMenu.factory edit_menu ~accel_group:factory#accel_group in ef#add_item ~key:_A "Add line" ~callback:add_entry; w#show (); Main.main () lablgtk-2.18.8/examples/clist.ml0000644000175000017500000000411113460263323015547 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open GMain let main () = let window = GWindow.window ~title:"CList example" ~width:300 ~height:150 () in window#connect#destroy ~callback:Main.quit; let vbox = GPack.vbox ~border_width:5 ~packing:window#add () in let hbox = GPack.hbox ~packing:vbox#add () in let sb = GRange.scrollbar `VERTICAL ~packing:(hbox#pack ~from:`END) () in let clist = GList.clist ~titles:["Ingredients";"Amount"] ~shadow_type:`OUT ~packing:hbox#add ~vadjustment:sb#adjustment () in clist#connect#select_row ~callback: begin fun ~row ~column ~event -> let text = clist#cell_text row column in Printf.printf "You selected row %d. More specifically you clicked in column %d, and the text in this cell is %s\n\n" row column text; flush stdout end; let hbox = GPack.hbox ~packing:vbox#pack () in let button_add = GButton.button ~label:"Add List" ~packing:hbox#add () in button_add#connect#clicked ~callback: begin fun () -> List.iter ~f:(fun t -> ignore (clist#append t)) [ ["Milk"; "3 Oz"]; ["Water"; "6 l"]; ["Carrots"; "2"]; ["Snakes"; "55"] ] end; let button_clear = GButton.button ~label:"Clear List" ~packing:hbox#add () in button_clear#connect#clicked ~callback:clist#clear; let button_hide_show = GButton.button ~label:"Hide/Show titles" ~packing:hbox#add () in let flag = ref false in button_hide_show#connect#clicked ~callback: begin fun () -> clist#set_titles_show !flag; flag := not !flag end; window#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/gnome-fs-directory.png0000644000175000017500000000377413460263323020340 0ustar stephsteph‰PNG  IHDR00Wł‡bKGD’–{lĢ£ł±IDATxŚķ™Ū«WĒ?{fNNB½¤!4Q¢-”„Ž^“ "ųą”"D)ų¢žö”ų¤OÖ&PśŌŠÅJ”mb4ZŒ&9Ņć5i“69÷“ßļ7{-öe֞ߜÓ)‰ gĆoĪž={Öw]¾kķ5°sģ;Ē’ŻńU@?Āłƒ;)¬Ó·ĻæĮ?Æ,āpa‚Mā™'P 7676Y_æÉ7æń=vĶļśŚx4~öąģ¹×øē®ūŲÜ\Ē9Qœsؚ_ĀoŹł?üŽ‹/ńōS?¹|šąÆ¼wõߋ·@34xčą¼śĖ“8QPUTW¹h %ŹŽ"؂ŸģåČ'qąĄ½=śą — <,Žq üžüÆyėĢĖŃE‰WUŠŗFP`ƃ;Żš“,ƼĻ©“/rś­·o‡Ģ_~ŗ-€7ß|³ē^ET/YHcAQœ‚ AxM±7oN8~ģ” wŻ½/ĒPöµxƒč–ķdĒĆ:«kŒFÖ×6Y^]e2słĻļqź¹ ¹]hye•µµuD4ž‚ŖRUUp‰1€.X Ę pęWoP×óŌuEU9*WĒ•%žVŌMƒŠÄõųš‘.ZĄvĀ9®^łµ›ē[O|›ćĒę7ē~ŽØGQT m[TC“ˆHW"»I”*xÜ5‡‚ ­÷į9`aaq6ŗti—_śÅL>ø’¾»yž…ē8~ģa®\{Æ-•'” €ˆZļ Æ+‹D *ųÖć€ÖūģŠA”~6WÆ^ćÄS?äч¢ŖwoajBĀ§?u”kļ’…üżÆˆ¶A0 ~,’SŌ‡5Äk<‚÷¤ŖĒ·ĮE[ Ā{Ń`•3ųīwžäó?ĀĒ?H3·g[_UUšfžÓg^źrBNv!Ś¦Ŗ"ƒjČź‚£Ŗ¢ZŃŌBšĪqēQGåļg“Ąē?Īž{ösaįl,B «všU•2+«FwQ3ĒžäµDģšq,Ķc¹TD&L±`jĄż‡ŽpłoźEŒŠµ„ˆM+bA /Vxs†5d  D:N‰TgĶ¾Żč„E]Ōō”öóō“)…ö;1Š GɊč4O#]ż0Ł\=AūZĶ+ʝ˜žW‚éĘ$žŸéT;m÷ tķ} eļg bU €m„J¾Ÿ(Q„7·+Åūcb,)g³ąÉJ]t÷fR¹DįŹĄķ’OxIa„ „%m‹‰2ČA1Wxigt!ļ»2kf«żi: .ēČ4€$Ōō<‰ä ]9ūŽ0™LhŪ6×ūA;@P‰\.šŁ•Œ„ē6ÜL¤#Ó0qŽö\Gs|ĢfSæ XėĖ¤2;ó’V )(VĂ-]Š Ÿ-”’×0ĄAœ\ˆ!įCfD„p MūgCƒŲąV“+ »}fŹÉK2XĢ{(ŠłiUŖUD’ļ¹¬™,˜LÓŖõ+¼}¶°f!Xēvbć Ø¶$O XšŽ@ Nšź včļ%%•‚V“Ą˜_t[Ė®;•ęaJl-ęj`A“Ō{~G|uU¹¬łŹ9œ«pUѝōL¢IÖ.^x— Ž ĘĮ„Vhīą5Ń_|½H֍÷ełœ·‚Śm–ˆŁ=5‹»®Æš„„EgĻ9Ē™ÓæµF@n–īö÷O~ÄOL·ūü>p8ģs½ ˜ėMĢ M|ø1ÅT•Ņ¹­MŒėBµŻ’ē«YC"ŽÜO=Ę6j¼ŚŸ›¶’žoMz œy”ė} Qsķ¾;ø[ųčŅoØ&™$J Ä “X*£U7 t’EƒIz€ģ|ķ=Ū’uF©M֖¢cÉĮ—W½—ŗör’›‹Ž¢¶ŁĄō>k«öõĪ±sÜśń_÷MĖŚŪG×CIEND®B`‚lablgtk-2.18.8/examples/label.ml0000644000175000017500000000316513460263323015520 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* Embedding xpm data into an ML file *) let openfile = [| (* width height num_colors chars_per_pixel *) " 20 19 5 1"; (* colors *) ". c None"; "# c #000000"; "i c #ffffff"; "s c #7f7f00"; "y c #ffff00"; (* pixels *) "...................."; "...................."; "...................."; "...........###......"; "..........#...#.#..."; "...............##..."; "...###........###..."; "..#yiy#######......."; "..#iyiyiyiyi#......."; "..#yiyiyiyiy#......."; "..#iyiy###########.."; "..#yiy#sssssssss#..."; "..#iy#sssssssss#...."; "..#y#sssssssss#....."; "..##sssssssss#......"; "..###########......."; "...................."; "...................."; "...................." |] open GMain let main () = let w = GWindow.window ~border_width:2 () in w#misc#realize (); let hbox = GPack.hbox ~spacing:10 ~packing:w#add () in let pm = GDraw.pixmap_from_xpm_d ~data:openfile ~window:w () in GMisc.pixmap pm ~packing:hbox#add (); GMisc.label ~text:"Embedded xpm" ~packing:hbox#add (); w#show (); w#connect#destroy ~callback:Main.quit; Main.main () let () = main () lablgtk-2.18.8/examples/tree_store.ml0000644000175000017500000001510413460263323016610 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels (* translated from gtk-demo *) let january = [ "New Years Day", true, true, true, true, false, true; "Presidential Inauguration", false, true, false, true, false, false; "Martin Luther King Jr. day", false, true, false, true, false, false; ] let february = [ "Presidents' Day", false, true, false, true, false, false; "Groundhog Day", false, false, false, false, false, false; "Valentine's Day", false, false, false, false, true, true; ] let march = [ "National Tree Planting Day", false, false, false, false, false, false; "St Patrick's Day", false, false, false, false, false, true; ] let april = [ "April Fools' Day", false, false, false, false, false, true; "Army Day", false, false, false, false, false, false; "Earth Day", false, false, false, false, false, true; "Administrative Professionals' Day", false, false, false, false, false, false; ] let may = [ "Nurses' Day", false, false, false, false, false, false; "National Day of Prayer", false, false, false, false, false, false; "Mothers' Day", false, false, false, false, false, true; "Armed Forces Day", false, false, false, false, false, false; "Memorial Day", true, true, true, true, false, true; ] let june = [ "June Fathers' Day", false, false, false, false, false, true; "Juneteenth (Liberation of Slaves)", false, false, false, false, false, false; "Flag Day", false, true, false, true, false, false; ] let july = [ "Parents' Day", false, false, false, false, false, true; "Independence Day", false, true, false, true, false, false; ] let august = [ "Air Force Day", false, false, false, false, false, false; "Coast Guard Day", false, false, false, false, false, false; "Friendship Day", false, false, false, false, false, false; ] let september = [ "Grandparents' Day", false, false, false, false, false, true; "Citizenship Day or Constitution Day", false, false, false, false, false, false; "Labor Day", true, true, true, true, false, true; ] let october = [ "National Children's Day", false, false, false, false, false, false; "Bosses' Day", false, false, false, false, false, false; "Sweetest Day", false, false, false, false, false, false; "Mother-in-Law's Day", false, false, false, false, false, false; "Navy Day", false, false, false, false, false, false; "Columbus Day", false, true, false, true, false, false; "Halloween", false, false, false, false, false, true; ] let november = [ "Marine Corps Day", false, false, false, false, false, false; "Veterans' Day", true, true, true, true, false, true; "Thanksgiving", false, true, false, true, false, false; ] let december = [ "Pearl Harbor Remembrance Day", false, false, false, false, false, false; "Christmas", true, true, true, true, false, true; "Kwanzaa", false, false, false, false, false, false; ] let toplevel = [ "January", january; "February", february; "March", march; "April", april; "May", may; "June", june; "July", july; "August", august; "September", september; "October", october; "November", november; "December", december; ] open Gobject.Data let cols = new GTree.column_list let name = cols#add string let alex = cols#add boolean let havoc = cols#add boolean let tim = cols#add boolean let owen = cols#add boolean let dave = cols#add boolean let visible = cols#add boolean let world = cols#add boolean let bg = cols#add (unsafe_boxed (Gobject.Type.from_name "GdkColor")) let create_model () = let model = GTree.tree_store cols in List.iter toplevel ~f: begin fun (month_name, month) -> let row = model#append () in model#set ~row ~column:name month_name; List.iter month ~f: begin fun (n,a,h,t,o,d,w) -> let row = model#append ~parent:row () in let set column = model#set ~row ~column in set name n; set alex a; set havoc h; set tim t; set owen o; set dave d; set visible true; set world w; set bg (GDraw.color (`NAME "orange")) end; end; model let item_toggled ~(model : GTree.tree_store) ~column path = let row = model#get_iter path in let b = model#get ~row ~column in model#set ~row ~column (not b); () open GtkTree let add_columns ~(view : GTree.view) ~model = let renderer = GTree.cell_renderer_text [`XALIGN 0.] in let vc = GTree.view_column ~title:"Holiday" ~renderer:(renderer, ["text", name]) () in vc#add_attribute renderer "background-gdk" bg; view#append_column vc; List.iter ["Alex",alex,true; "Havoc",havoc,false; "Tim",tim,true; "Owen",owen,false; "Dave",dave,false ] ~f: begin fun (title, column, euro) -> let renderer = GTree.cell_renderer_toggle [`XALIGN 0.] in renderer#connect#toggled ~callback:(item_toggled ~model ~column); let attrs = if euro then ["active", column; "visible", visible; "activatable", world] else ["active", column; "visible", visible] in let vc = GTree.view_column ~title ~renderer:(renderer, attrs) () in view#append_column vc; vc#set_sizing `FIXED; vc#set_fixed_width 50; vc#set_clickable true; end let do_tree_store () = let window = GWindow.window ~title:"Card planning sheet" () in window#connect#destroy ~callback:GMain.quit; let vbox = GPack.vbox ~border_width:8 ~spacing:8 ~packing:window#add () in GMisc.label ~text:"Jonathan's Holiday Card Planning Sheet" ~packing:vbox#pack (); let sw = GBin.scrolled_window ~shadow_type:`ETCHED_IN ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~packing:vbox#add () in let model = create_model () in let treeview = GTree.view ~model ~packing:sw#add () in treeview#set_rules_hint true; treeview#selection#set_mode `MULTIPLE; add_columns ~view:treeview ~model; treeview#misc#connect#realize ~callback:treeview#expand_all; window#set_default_size ~width:650 ~height:400; window#show (); GMain.main () let () = do_tree_store () lablgtk-2.18.8/examples/lissajous.ml0000644000175000017500000000427413460263323016457 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* Lissajous $B?^7A(B *) open GMain let main () = let window = GWindow.window ~border_width: 10 () in window#event#connect#delete ~callback:(fun _ -> prerr_endline "Delete event occured"; true); window#connect#destroy ~callback:Main.quit; let vbx = GPack.vbox ~packing:window#add () in let quit = GButton.button ~label:"Quit" ~packing:vbx#add () in quit#connect#clicked ~callback:window#destroy; let area = GMisc.drawing_area ~width:200 ~height:200 ~packing:vbx#add () in let drawing = area#misc#realize (); new GDraw.drawable (area#misc#window) in let m_pi = acos (-1.) in let c = ref 0. in let expose_event _ = drawing#set_foreground `WHITE; drawing#rectangle ~filled:true ~x:0 ~y:0 ~width:200 ~height:200 (); drawing#set_foreground `BLACK; (* drawing#line x:0 y:0 x:150 y:150; drawing#polygon filled:true [10,100; 35,35; 100,10; 10, 100]; *) let n = 200 in let r = 100. in let a = 3 in let b = 5 in for i=0 to n do let theta0 = 2.*.m_pi*.(float (i-1))/. (float n) in let x0 = 100 + (truncate (r*.sin ((float a)*.theta0))) in let y0 = 100 - (truncate (r*.cos ((float b)*.(theta0+. !c)))) in let theta1 = 2.*.m_pi*.(float i)/.(float n) in let x1 = 100 + (truncate (r*.sin((float a)*.theta1))) in let y1 = 100 - (truncate (r*.cos((float b)*.(theta1+. !c)))) in drawing#line ~x:x0 ~y:y0 ~x:x1 ~y:y1 done; false in area#event#connect#expose ~callback:expose_event; let timeout _ = c := !c +. 0.01*.m_pi; expose_event (); true in Timeout.add ~ms:500 ~callback:timeout; window#show (); Main.main () let _ = Printexc.print main() lablgtk-2.18.8/examples/custom_list_generic.ml0000644000175000017500000001340313460263323020476 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* ../src/lablgtk2 -localdir custom_list_generic.ml *) let debug = false let () = if debug then begin Gc.set { (Gc.get()) with Gc.verbose = 0x00d; space_overhead = 0 }; ignore (Gc.create_alarm (fun () -> let s = Gc.stat () in Format.printf "blocks=%d words=%d@." s.Gc.live_blocks s.Gc.live_words)) end module MAKE(A:sig type t val custom_value: Gobject.g_type -> t -> column:int -> Gobject.basic val column_list:GTree.column_list end) = struct type custom_list = {finfo: A.t; fidx: int (* invariant: root.(fidx)==myself *) } module H = Hashtbl let inbound i a = i>=0 && i None method custom_flags = [`LIST_ONLY] method custom_get_iter (path:Gtk.tree_path) : custom_list option = let indices: int array = GTree.Path.get_indices path in match indices with | [||] -> None | [|i|] -> self#find_opt i | _ -> failwith "Invalid Path of depth > 1 in a list" method custom_get_path (row:custom_list) : Gtk.tree_path = GTree.Path.create [row.fidx] method custom_value (t:Gobject.g_type) (row:custom_list) ~column = A.custom_value t row.finfo ~column method custom_iter_next (row:custom_list) : custom_list option = let nidx = succ row.fidx in self#find_opt nidx method custom_iter_children (rowopt:custom_list option) :custom_list option = match rowopt with | None -> self#find_opt 0 | Some _ -> None method custom_iter_has_child (row:custom_list) : bool = false method custom_iter_n_children (rowopt:custom_list option) : int = match rowopt with | None -> H.length roots | Some _ -> assert false method custom_iter_nth_child (rowopt:custom_list option) (n:int) : custom_list option = match rowopt with | None -> self#find_opt n | _ -> None method custom_iter_parent (row:custom_list) : custom_list option = None method insert (t:A.t) = let e = {finfo=t; fidx= last_idx } in self#custom_row_inserted (GTree.Path.create [last_idx]) e; H.add roots last_idx e; last_idx <- last_idx+1; end let custom_list () = new custom_list_class A.column_list end module L=struct type t = {mutable checked: bool; mutable lname: string; } (** The columns in our custom model *) let column_list = new GTree.column_list ;; let col_full = (column_list#add Gobject.Data.caml: t GTree.column);; let col_bool = column_list#add Gobject.Data.boolean;; let col_int = column_list#add Gobject.Data.int;; let custom_value _ t ~column = match column with | 0 -> (* col_full *) `CAML (Obj.repr t) | 1 -> (* col_bool *) `BOOL false | 2 -> (* col_int *) `INT 0 | _ -> assert false end module MODEL=MAKE(L) let fill_model t = for i= 0 to 10 do t#insert {L.lname = "Elt "^string_of_int i; checked=i mod 2 = 0} done let create_view_and_model () : GTree.view = let custom_list = MODEL.custom_list () in fill_model custom_list; let view = GTree.view ~model:custom_list () in let renderer = GTree.cell_renderer_text [] in let col_name = GTree.view_column ~title:"Name" ~renderer:(renderer,[]) () in col_name#set_cell_data_func renderer (fun model row -> try let data = model#get ~row ~column:L.col_full in match data with | {L.lname = s} -> renderer#set_properties [ `TEXT s ]; with exn -> let s = GtkTree.TreePath.to_string (model#get_path row) in Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)); ignore (view#append_column col_name); let renderer = GTree.cell_renderer_toggle [] in let col_tog = GTree.view_column ~title:"Check me" ~renderer:(renderer,[]) () in col_tog#set_cell_data_func renderer (fun model row -> try let {L.checked = b} = model#get ~row ~column:L.col_full in renderer#set_properties [ `ACTIVE b ] with exn -> let s = GtkTree.TreePath.to_string (model#get_path row) in Format.printf "Accessing %s, got '%s' @." s (Printexc.to_string exn)); ignore(renderer#connect#toggled (fun path -> let row = custom_list#custom_get_iter path in match row with | Some {MODEL.finfo=l} -> l.L.checked <- not l.L.checked | _ -> ())); ignore (view#append_column col_tog); Glib.Timeout.add ~ms:10000 ~callback:(fun () -> fill_model custom_list; false); view let _ = ignore (GtkMain.Main.init ()); let window = GWindow.window ~width:200 ~height:400 () in ignore (window#event#connect#delete ~callback:(fun _ -> exit 0)); let scrollwin = GBin.scrolled_window ~packing:window#add () in let view = create_view_and_model () in scrollwin#add view#coerce; window#show (); GtkMain.Main.main () lablgtk-2.18.8/examples/tree_model.ml0000644000175000017500000001264613460263323016564 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* Various experiments with GtkTreeModelSort and GtkTreeModelFilter *) type date = { mon : int ; day : int ; } let format_date { mon = mon ; day = day } = let mon_str = match mon with | 1 -> "Jan" | 2 -> "Feb" | 3 -> "Mar" | 4 -> "Apr" | 5 -> "May" | 6 -> "Jun" | 7 -> "Jul" | 8 -> "Aou" | 9 -> "Sep" | 10 -> "Oct" | 11 -> "Nov" | 12 -> "Dec" | _ -> invalid_arg "bad month" in Printf.sprintf "% 2d %s" day mon_str let data = [ `HOME, "home", true, { day = 29 ; mon = 02 } ; `JUMP_TO, "go", true, { day = 15 ; mon = 02 } ; `QUIT, "quit", false, { day = 27 ; mon = 01 } ; `STOP, "stop", true, { day = 21 ; mon = 01 } ; `DELETE, "delete", false, { day = 15 ; mon = 01 } ; ] (* Sort function: sort according to string length ! *) let sort_function column (model : #GTree.model) it_a it_b = let a = model#get ~row:it_a ~column in let b = model#get ~row:it_b ~column in compare (String.length a) (String.length b) let print_flags name (m : #GTree.model) = Format.printf "%sflags: %s@." name (String.concat "; " (List.map (function | `ITERS_PERSIST -> "persistent iterators" | `LIST_ONLY -> "list only") m#flags)) let make_model data = let cols = new GTree.column_list in let stock_id_col = cols#add GtkStock.conv in let str_col = cols#add Gobject.Data.string in let vis_col = cols#add Gobject.Data.boolean in let date_col = cols#add Gobject.Data.caml in let l = GTree.list_store cols in print_flags "ListStore" l ; List.iter (fun (stock_id, str, vis, date) -> let row = l#append () in l#set ~row ~column:stock_id_col stock_id ; l#set ~row ~column:str_col str ; l#set ~row ~column:vis_col vis ; l#set ~row ~column:date_col date) data ; let s = GTree.model_sort l in print_flags "TreeModelSort" s ; let f = GTree.model_filter l in print_flags "TreeModelFilter" f ; f#set_visible_column vis_col ; let s' = GTree.model_sort f in List.iter (fun (s : #GTree.tree_sortable) -> s#connect#sort_column_changed (fun () -> match s#get_sort_column_id with | None -> Format.printf "no sort_column@." | Some (id, `ASCENDING) -> Format.printf "sort_column = %d, ascending@." id | Some (id, `DESCENDING) -> Format.printf "sort_column = %d, descending@." id) ; s#set_sort_func 0 (sort_function str_col) ) [ s ; s' ] ; (s, s', (stock_id_col, str_col, date_col)) let make_view (model, model_filtered, (stock_id_col, str_col, date_col)) packing = let view_col = let col = GTree.view_column ~title:"Stock Icons" () in let str_renderer = GTree.cell_renderer_text [ `FAMILY "monospace" ; `XALIGN 1. ] in col#pack str_renderer ; col#add_attribute str_renderer "text" str_col ; let pb_renderer = GTree.cell_renderer_pixbuf [ `STOCK_SIZE `BUTTON ] in col#pack pb_renderer ; col#add_attribute pb_renderer "stock_id" stock_id_col ; col#set_sort_column_id 0 ; col in let view_date_col = let col = GTree.view_column ~title:"Date" () in let str_renderer = GTree.cell_renderer_text [ `XALIGN 0.5 ] in col#pack str_renderer ; col#set_cell_data_func str_renderer (fun model row -> let date = model#get ~row ~column:date_col in str_renderer#set_properties [ `TEXT (format_date date) ]) ; col in let b = GButton.check_button ~label:"_Filter data" ~use_mnemonic:true ~packing () in let v = GTree.view ~model ~width:200 ~packing () in v#append_column view_col ; v#append_column view_date_col ; b#connect#toggled (fun () -> let current, new_model = if b#active then (model, model_filtered) else (model_filtered, model) in let (id, dir) = Gaux.default (-1, `ASCENDING) ~opt:current#get_sort_column_id in new_model#set_sort_column_id id dir ; v#set_model (Some new_model#coerce) ) ; v let inspect_data_1 column (model : GTree.model) = Format.printf "@[Traverse with iters:" ; begin match model#get_iter_first with | None -> Format.printf "@ empty model" | Some row -> let cont = ref true in while !cont do let data = model#get ~row ~column in Format.printf "@ %s" data ; cont := model#iter_next row done end ; Format.printf "@]@." let inspect_data_2 column (model : GTree.model) = Format.printf "@[Traverse with #foreach:" ; model#foreach (fun _ row -> let data = model#get ~row ~column in Format.printf "@ %s" data ; false) ; Format.printf "@]@." let main = let w = GWindow.window ~title:"GtkListStore test" () in w#connect#destroy GMain.quit ; let box = GPack.vbox ~packing:w#add () in let m = make_model data in let v = make_view m box#pack in begin let b = GButton.button ~label:"Dump data" ~packing:box#pack () in b#connect#clicked (fun () -> let (_, _, (_, col, _)) = m in let model = v#model in inspect_data_1 col model ; inspect_data_2 col model) end ; w#show () ; GMain.main () lablgtk-2.18.8/examples/drawing.ml0000644000175000017500000000176013460263323016073 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let window = GWindow.window () let area = GMisc.drawing_area ~packing:window#add () let w = area#misc#realize (); area#misc#window let drawing = new GDraw.drawable w let redraw _ = drawing#polygon ~filled:true [ 10,100; 35,35; 100,10; 165,35; 190,100; 165,165; 100,190; 35,165; 10,100 ]; false let _ = window#connect#destroy ~callback:Main.quit; area#event#connect#expose ~callback:redraw; window#show (); Main.main () lablgtk-2.18.8/examples/combobox.ml0000644000175000017500000001104113460263323016241 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let changed_and_get_active (combo : #GEdit.combo_box) column cb = combo#connect#changed (fun () -> match combo#active_iter with | None -> () | Some row -> let data = combo#model#get ~row ~column in cb data) let setup_combobox_demo_grid packing = let tmp = GBin.frame ~label:"GtkComboBox (grid mode)" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let model, column = GTree.store_of_list Gobject.Data.string [ "red"; "green" ; "blue" ; "yellow" ; "black" ; "white" ; "gray" ; "snow" ; "magenta" ] in let combo = GEdit.combo_box ~model ~wrap_width:3 ~packing:box#pack () in let cell = GTree.cell_renderer_pixbuf [ `WIDTH 16 ; `HEIGHT 16 ] in combo#pack ~expand:true cell ; combo#add_attribute cell "cell-background" column ; combo#set_active 1 ; changed_and_get_active combo column prerr_endline ; () let create_model () = GTree.store_of_list GtkStock.conv [ `DIALOG_WARNING ; `STOP ; `NEW ; `CLEAR ] let setup_combobox_demo packing = let tmp = GBin.frame ~label:"GtkComboBox" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let model, column = create_model () in let combobox = GEdit.combo_box ~model ~packing:box#pack () in begin let renderer = GTree.cell_renderer_pixbuf [ `STOCK_SIZE `BUTTON ] in combobox#pack renderer ; combobox#add_attribute renderer "stock_id" column end ; begin let renderer = GTree.cell_renderer_text [ `XPAD 5 ] in combobox#pack renderer ; combobox#add_attribute renderer "text" column end ; combobox#set_active 1 ; changed_and_get_active combobox column (fun id -> prerr_endline (GtkStock.convert_id id)) let setup_combobox_text packing = let tmp = GBin.frame ~label:"GtkComboBox (text-only)" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let (combo, (_, column)) = GEdit.combo_box_text ~packing:box#pack ~strings:[ "Jan" ; "Feb" ; "Mar" ; "Apr" ; "May" ; "Jun" ; "Jul" ; "Aug" ; "Sep" ; "Oct" ; "Nov" ; "Dec" ] () in combo#set_active 0 ; changed_and_get_active combo column prerr_endline ; () let setup_combobox_entry packing = let tmp = GBin.frame ~label:"GtkComboBoxEntry" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let model, text_column = GTree.store_of_list Gobject.Data.string [ "Paris" ; "Grenoble" ; "Toulouse" ] in let combo = GEdit.combo_box_entry ~text_column ~model ~packing:box#pack () in combo#entry#connect#changed (fun () -> match combo#entry#text with "" -> () | s -> prerr_endline s) ; () let setup_combobox_entry_text packing = let tmp = GBin.frame ~label:"GtkComboBoxEntry (text-only)" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let (combo, _) = GEdit.combo_box_entry_text ~packing:box#pack ~strings:[ "Paris" ; "Grenoble" ; "Toulouse" ] () in combo#entry#connect#changed (fun () -> match combo#entry#text with "" -> () | s -> prerr_endline s) ; () let setup_combobox_separator packing = let tmp = GBin.frame ~label:"GtkComboBox (separators)" ~packing () in let box = GPack.vbox ~border_width:5 ~packing:tmp#add () in let (combo, (_, column)) = GEdit.combo_box_text ~packing:box#pack ~strings:[ "Paris" ; "Grenoble" ; "Toulouse" ; "--" ; "New York"; "Š²Š»Š°Š“ŠøŠ²Š¾ŃŃ‚Š¾Šŗ"] () in combo#set_row_separator_func (Some (fun m row -> m#get ~row ~column = "--")) ; () let main () = let window = GWindow.window ~border_width:5 () in window#connect#destroy GMain.quit ; let mainbox = GPack.vbox ~spacing:2 ~packing:window#add () in setup_combobox_demo mainbox#pack ; setup_combobox_demo_grid mainbox#pack ; setup_combobox_text mainbox#pack ; setup_combobox_entry mainbox#pack ; setup_combobox_entry_text mainbox#pack ; setup_combobox_separator mainbox#pack ; window#show () ; GMain.main () let _ = main () (* Local Variables: *) (* compile-command: "ocamlc -I ../src -w s lablgtk.cma gtkInit.cmo combobox.ml" *) (* End: *) lablgtk-2.18.8/examples/entry2.ml0000644000175000017500000000154013460263323015657 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let w = GWindow.window ~show:true () let e = GEdit.entry ~packing:w#add () let () = e#connect#after#insert_text (fun _ ~pos -> if e#text_length > 5 then e#set_secondary_icon_stock `DIALOG_WARNING else e#set_secondary_icon_name ""); w#event#connect#delete (fun _ -> GMain.quit (); true); GMain.main () lablgtk-2.18.8/examples/iconview.ml0000644000175000017500000001170613460263323016264 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let files = [ "gnome-fs-regular.png" ; "gnome-fs-directory.png" ] let error ?parent message = let w = GWindow.message_dialog ~message ~message_type:`ERROR ~buttons:GWindow.Buttons.close ?parent ~destroy_with_parent:true ~show:true () in w#connect#response (fun _ -> w#destroy ()) ; () let sort_func dir_c name_c (m : #GTree.model) i1 i2 = let is_dir_1 = m#get ~column:dir_c ~row:i1 in let is_dir_2 = m#get ~column:dir_c ~row:i2 in if not is_dir_1 && is_dir_2 then 1 else if is_dir_1 && not is_dir_2 then -1 else let name_1 = m#get ~column:name_c ~row:i1 in let name_2 = m#get ~column:name_c ~row:i2 in compare name_1 name_2 type data = { store : GTree.list_store ; path_c : string GTree.column ; name_c : string GTree.column ; icon_c : GdkPixbuf.pixbuf GTree.column ; dir_c : bool GTree.column ; mutable parent : string ; file_pb : GdkPixbuf.pixbuf ; folder_pb : GdkPixbuf.pixbuf ; } let create_store file_pb folder_pb parent = let columns = new GTree.column_list in let path_c = columns#add Gobject.Data.string in let name_c = columns#add Gobject.Data.string in let icon_c = columns#add (Gobject.Data.gobject_by_name "GdkPixbuf") in let dir_c = columns#add Gobject.Data.boolean in let store = GTree.list_store columns in store#set_sort_func 0 (sort_func dir_c name_c) ; store#set_sort_column_id 0 `ASCENDING ; { store = store ; path_c = path_c ; name_c = name_c ; icon_c = icon_c ; dir_c = dir_c ; parent = parent ; file_pb = file_pb ; folder_pb = folder_pb } let fill_store d = d.store#clear () ; Array.iter (fun name -> if name.[0] <> '.' then begin let path = Filename.concat d.parent name in let is_dir = (Unix.stat path).Unix.st_kind = Unix.S_DIR in let display_name = Glib.Convert.filename_to_utf8 name in let row = d.store#append () in d.store#set ~row ~column:d.path_c path ; d.store#set ~row ~column:d.name_c display_name ; d.store#set ~row ~column:d.dir_c is_dir ; d.store#set ~row ~column:d.icon_c (if is_dir then d.folder_pb else d.file_pb) end) (Sys.readdir d.parent) let refill_store view d = view#set_model None ; fill_store d ; view#set_model (Some (d.store :> GTree.model)) let up_clicked button view d () = d.parent <- Filename.dirname d.parent ; refill_store view d ; button#misc#set_sensitive (d.parent <> "/") let home_dir = match Glib.get_home_dir () with | None -> exit 2 | Some s -> s let home_clicked button view d () = d.parent <- home_dir ; refill_store view d ; button#misc#set_sensitive true let item_activated button view d path = let row = d.store#get_iter path in let name = d.store#get ~row ~column:d.path_c in Printf.eprintf "tree_path = %s path = %s\n%!" (GTree.Path.to_string path) name ; let is_dir = d.store#get ~row ~column:d.dir_c in if is_dir then begin let path = d.store#get ~row ~column:d.path_c in d.parent <- path ; refill_store view d ; button#misc#set_sensitive true end let do_iconview window = match try List.map GdkPixbuf.from_file files with exn -> error ~parent:window (Printexc.to_string exn) ; [] with | [ file_pb ; folder_pb ] -> let vbox = GPack.vbox ~packing:window#add () in let toolbar = GButton.toolbar ~packing:vbox#pack () in let up_button = GButton.tool_button ~stock:`GO_UP ~packing:toolbar#insert () in up_button#set_is_important true ; up_button#misc#set_sensitive false ; let home_button = GButton.tool_button ~stock:`HOME ~packing:toolbar#insert () in home_button#set_is_important true ; let sw = GBin.scrolled_window ~hpolicy:`AUTOMATIC ~vpolicy:`AUTOMATIC ~shadow_type:`ETCHED_IN ~packing:(vbox#pack ~expand:true) () in let data = create_store file_pb folder_pb "/" in fill_store data ; let iv = GTree.icon_view ~model:data.store ~selection_mode:`MULTIPLE ~packing:sw#add () in iv#set_text_column data.name_c ; iv#set_pixbuf_column data.icon_c ; up_button#connect#clicked (up_clicked up_button iv data) ; home_button#connect#clicked (home_clicked up_button iv data) ; iv#connect#item_activated (item_activated up_button iv data) ; iv#misc#grab_focus () | _ -> () let main = let w = GWindow.window ~title:"GtkIconView demo" ~width:650 ~height:400 () in w#connect#destroy GMain.quit ; do_iconview w ; w#show () ; GMain.main () lablgtk-2.18.8/examples/notebook.ml0000644000175000017500000000301313460263323016251 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let window = GWindow.window ~title:"Notebook" ~border_width:10 () in window#connect#destroy ~callback:Main.quit; let notebook = GPack.notebook ~packing:window#add () in let button = GButton.button ~label:"Page 1" ~packing:(fun w -> ignore (notebook#append_page w)) () in button#connect#clicked ~callback: (fun () -> prerr_endline "Hello again - cool button 1 was pressed"); let button = GButton.button ~label:"Page 2" ~packing:(fun w -> ignore (notebook#append_page w)) () in button#connect#clicked ~callback: (fun () -> prerr_endline "Hello again - cool button 2 was pressed"); notebook#connect#switch_page ~callback:(fun i -> prerr_endline ("Page switch to " ^ string_of_int i)); button#connect#clicked ~callback: (fun () -> prerr_endline "Coucou"); window#show (); Main.main () let _ = main () (* Local Variables: *) (* compile-command: "ocamlc -I ../src -w s lablgtk.cma gtkInit.cmo notebook.ml" *) (* End: *) lablgtk-2.18.8/examples/cputs.ml0000644000175000017500000000316513460263323015577 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open Printf open GMain let print_msg msg = printf "%s" msg; flush stdout let flush_stdout () = flush stdout open Unix let clear_func name () = printf "(%s) Cleared\n" name; flush_stdout () let get_func name (context: GObj.selection_context) ~info ~time = printf "(%s) selection_handle: target[%s]\n" name context#target; flush_stdout (); let tm = Unix.localtime (Unix.gettimeofday ()) in let data = Printf.sprintf "(%s) %d/%d/%d %d::%d::%d" name (tm.tm_year + 1900) (tm.tm_mon + 1) tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec in context#return data let clicked name () = clipboard#set_contents ~targets:["STRING"] ~get:(get_func name) ~clear:(clear_func name) let main () = let name = if Array.length Sys.argv > 1 then Sys.argv.(1) else "" in let window = GWindow.window ~title:"Clipboard Puts" ~border_width:10 () in window#connect#destroy ~callback:GMain.quit; let button = GButton.toggle_button ~label:"Claim Selection" ~packing:window#add () in button#connect#clicked ~callback:(clicked name); window#show (); GMain.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/gnome-fs-regular.png0000644000175000017500000000340313460263323017762 0ustar stephsteph‰PNG  IHDR04Ģ“»‘bKGDłC»øIDATxŚÕšKoWĒ±CŚ4Ā³Š*HtEŹ¢,‚RBĆ+ŚO€Ō]Yõ#šP%XtQ‰Hx4< ‚Ą’MT‰v”‡`ÄĵöÜӅ3ž;wī±SPŅ+dß¹w|’ó?ēĢ5Ąw€,„«»»ūéśõėśN`u ¹wļžč£P(Č|Œb±(cccrōčQ_©õĄ{@*VÜŗuKDDfffŽŠ@J©†®r¹,ÅbQ¦¦¦dttŌWā“8%R¼ƒ!"ˆHĆū*• ="“É°yóf._¾ šX“Łä MlŻŗu^×G¹\ ££ƒ-[¶044Dkk«S‰Š—Ū·oĻ‹ąž~abb„™L†M›6qņä :::¬J¤ęĆāŗĄś~…ēy58yžGww77~ŹńćĒM85ĶBsÜ&0ˆ” ”J%¦¦¦øsēccc\½z•R©Ä† Żœ:u ą{`©O±Ķ&„ā”hDh÷ŚŖ ¶y_”#GŽP,Q¾”Y±¢‹={ö| ü€Jó¦žu.Ć÷D„„¾¾>–/_N.—£Xü‡\īćććœ8qĀßødF…¦Ł<zl”P ½½=Qp׿F¬_]+³Ÿ!•JQ©T˜žžęįƤÓiņł<££·8vģĄ.ą`ŅŹB.Œ»‚ĻÄrTčćzĄ*„jó"Uęń¼Źģž* õō|ĘōtžŽŽ/éééń·7łš“,÷6¬`”Š*ؔŖyšŒ5Įż¶¶¶ČS›u¶mŪ¦YEę„å8Œ›Źxž2Œ¢“õ¾šÕø(fhnnv—"Āčč(©TŹbéĻd’2Ė&Į=ĻSšš¢Į‰Š_‰+W.ÓŽžÕtĶ67×ļѬEĚę½@ż{ō·õ}I9'”ķŪæØeĀ$,»•±1²qĄ>veOīŽżł|ž„jTøyóétŗXDļ)U½|·ūŠšĢD›W³óÕDXLö€Ż2,\kƒ‹ł“I‚5¶¬ŽÆŗ $;wīäĶ›×†2Ńų.Nf“`Ā%¬ØX!+"ģŻ»ēĻŸ%AHø~ż:--­šūUH€*Ó(“H„I|hDĘ„°bŗg.\8Ļ²eĖŠ^õ@ĆĘ$f€Ū˜M÷€ÉLÅ&@H)”··—R©T³ŠæŃ,®¢Źˆ5ł…ƒÜF™6Į%ĀBū÷ —›LNd×®żĘāŋ5H ±B8i™ī×į\žĘLńń«N³Zsē†éźZ™ÄzpŚł\źźõBĢ^'‰³Ä¶C’zXH±k×. …£$p?Ōœ”k’³÷qµUUŽxņ$!„ō²ÕUŪē}fr1IŲāRc³°šbķŽDĆĆgYµjM2 éÖņ» [’j«ƒ\Lb&-[IaÖWīJ !śśv“ĻOŠgwe+äģl$k KżYbbāqR"S\ŗ4Bgē’cų–šk•(Yęžšš(Da©Æ:ĆźÕk“šhŪhņr“­“¹ßÖø»˜%źMkÕ!€žž~^¾|Q³F”“Åљ¹ß8ŲŠĆ°ĮÄ)“/Ē”Cƒd³'×B##æ²tiFK(n&ŃŻļ×6īīMBJ†ė&Sč(„Īž=ƚ5%ēążŒ$ZŪäńØ«%¶s‹ė«yµŠpŁźn)MŠµCg9n[÷śrpš0'CČ/[£Ü«×*ŹŹ"ўXOnQ|“b"ąĢ™_X»v]r°„ńzP›ŌóvŪž’Ļ!B™xß¾żärO-Ör»}®‚ŪāŵopškĘĒ’JnźĻŸ?GW× ė›ć(LpŁzhĖø[X™Ó§fŻŗ“=”Ó$0†;‰¹--uŸ34rźČ˜œœpŌžāĢŲs=Ł©WšĆ‡æI†ĆĆC¬\¹Ś€L“·¹æ‘ą‹Ā.~}]rõ©IļeŽ…Å)€ū÷ļĀĄĄ!ž<ÉZš”xś{ŪƝ#55… ”Ķfķ˜œœdff†±±ßgON<Ņé4 eܽū'Łl–WÆ^YoĮü_ØĪėG`Õū“Ś÷9š>Š¢Ÿ.Ą!Ąką)0įŸCõč¾H’š€P*MZ0/dĮmŠ(€¶Cžś@eIEND®B`‚lablgtk-2.18.8/examples/test.xpm0000644000175000017500000000376713460263323015624 0ustar stephsteph/* XPM */ static char *openfile[] = { /* width height num_colors chars_per_pixel */ " 20 19 66 2", /* colors */ ".. c None", ".# c #000000", ".a c #dfdfdf", ".b c #7f7f7f", ".c c #006f6f", ".d c #00efef", ".e c #009f9f", ".f c #004040", ".g c #00bfbf", ".h c #ff0000", ".i c #ffffff", ".j c #7f0000", ".k c #007070", ".l c #00ffff", ".m c #00a0a0", ".n c #004f4f", ".o c #00cfcf", ".p c #8f8f8f", ".q c #6f6f6f", ".r c #a0a0a0", ".s c #7f7f00", ".t c #007f7f", ".u c #5f5f5f", ".v c #707070", ".w c #00f0f0", ".x c #009090", ".y c #ffff00", ".z c #0000ff", ".A c #00afaf", ".B c #00d0d0", ".C c #00dfdf", ".D c #005f5f", ".E c #00b0b0", ".F c #001010", ".G c #00c0c0", ".H c #000f0f", ".I c #00007f", ".J c #005050", ".K c #002f2f", ".L c #dfcfcf", ".M c #dfd0d0", ".N c #006060", ".O c #00e0e0", ".P c #00ff00", ".Q c #002020", ".R c #dfc0c0", ".S c #008080", ".T c #001f1f", ".U c #003f3f", ".V c #007f00", ".W c #00000f", ".X c #000010", ".Y c #00001f", ".Z c #000020", ".0 c #00002f", ".1 c #000030", ".2 c #00003f", ".3 c #000040", ".4 c #00004f", ".5 c #000050", ".6 c #00005f", ".7 c #000060", ".8 c #00006f", ".9 c #000070", "#. c #7f7f80", "## c #9f9f9f", /* pixels */ "........................................", "........................................", "........................................", ".......................#.#.#............", ".....................#.......#...#......", "...............................#.#......", ".......#.#.#.................#.#.#......", ".....#.y.i.y.#.#.#.#.#.#.#..............", ".....#.i.y.i.y.i.y.i.y.i.#..............", ".....#.y.i.y.i.y.i.y.i.y.#..............", ".....#.i.y.i.y.#.#.#.#.#.#.#.#.#.#.#....", ".....#.y.i.y.#.s.s.s.s.s.s.s.s.s.#......", ".....#.i.y.#.s.s.s.s.s.s.s.s.s.#........", ".....#.y.#.s.s.s.s.s.s.s.s.s.#..........", ".....#.#.s.s.s.s.s.s.s.s.s.#............", ".....#.#.#.#.#.#.#.#.#.#.#..............", "........................................", "........................................", "........................................" }; lablgtk-2.18.8/examples/assistant.ml0000644000175000017500000000231013460263323016441 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id: $ *) open GMain let main () = let assistant = GAssistant.assistant () in let box = GPack.vbox () in ignore (assistant#append_page box#as_widget); assistant#set_page_complete box#as_widget true; prerr_endline "Complete"; assistant#set_page_type box#as_widget `SUMMARY; let button = GButton.link_button "http://HELLO.ORG" ~label:"BYE" ~packing:box#add () in button#set_uri "GHHHHH"; Format.printf "Got:%a@." GUtil.print_widget button; GtkButton.LinkButton.set_uri_hook (fun _ s -> Format.printf "Got url '%s'@." s; button#set_uri "AGAIN"); assistant#connect#close GMain.quit; assistant#show (); Main.main () let _ = main () lablgtk-2.18.8/examples/canvas/0000755000175000017500000000000013523300020015337 5ustar stephstephlablgtk-2.18.8/examples/canvas/canvas-curve.ml0000644000175000017500000001161713460263323020312 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) type state = | INIT | FIRST_PRESS | FIRST_RELEASE | SECOND_PRESS | FINISHED class curve parent cb = object (self) val mutable state = INIT val points = Array.make 8 0. val item = GnoCanvas.bpath parent ~props:[ `OUTLINE_COLOR "blue" ; `WIDTH_PIXELS 5 ; `CAP_STYLE `ROUND ] method click ev = let x = GdkEvent.Button.x ev in let y = GdkEvent.Button.y ev in match GdkEvent.get_type ev with | `BUTTON_PRESS when state = INIT -> points.(0) <- x ; points.(1) <- y ; state <- FIRST_PRESS | `BUTTON_RELEASE when state = FIRST_PRESS -> points.(2) <- x ; points.(3) <- y ; let path = GnomeCanvas.PathDef.new_path () in GnomeCanvas.PathDef.moveto path points.(0) points.(1) ; GnomeCanvas.PathDef.lineto path points.(2) points.(3) ; item#set [ `BPATH path ] ; item#show () ; state <- FIRST_RELEASE | `BUTTON_PRESS when state = FIRST_RELEASE -> points.(4) <- x ; points.(5) <- y ; let path = GnomeCanvas.PathDef.new_path () in GnomeCanvas.PathDef.moveto path points.(0) points.(1) ; GnomeCanvas.PathDef.curveto path points.(4) points.(5) points.(4) points.(5) points.(2) points.(3) ; item#set [ `BPATH path ] ; state <- SECOND_PRESS | `BUTTON_PRESS when state = SECOND_PRESS -> points.(6) <- x ; points.(7) <- y ; let path = GnomeCanvas.PathDef.new_path () in GnomeCanvas.PathDef.moveto path points.(0) points.(1) ; GnomeCanvas.PathDef.curveto path points.(4) points.(5) points.(6) points.(7) points.(2) points.(3) ; item#set [ `BPATH path ] ; state <- FINISHED | _ -> () method motion ev = let x = GdkEvent.Motion.x ev in let y = GdkEvent.Motion.y ev in if state = FIRST_PRESS then begin points.(2) <- x ; points.(3) <- y ; let path = GnomeCanvas.PathDef.new_path () in GnomeCanvas.PathDef.moveto path points.(0) points.(1) ; GnomeCanvas.PathDef.lineto path points.(2) points.(3) ; item#set [ `BPATH path ] ; end method is_not_complete = state <> FINISHED method kill () = item#destroy () ; state <- FINISHED initializer let _ = item#connect#event (cb self) in () end let item_event curve ev = match ev with | `BUTTON_PRESS ev -> if GdkEvent.Button.button ev = 1 && Gdk.Convert.test_modifier `SHIFT (GdkEvent.Button.state ev) then (curve#kill () ; true) else false | _ -> false let canvas_event curves root ev = match ev with | `BUTTON_PRESS ev when GdkEvent.Button.button ev = 1 -> let curve = match !curves with | Some b when b#is_not_complete -> b | _ -> let c = new curve root item_event in curves := Some c ; c in curve#click ev ; false | `BUTTON_RELEASE ev when GdkEvent.Button.button ev = 1 -> begin match !curves with | Some b when b#is_not_complete -> b#click ev | _ -> () end ; false | `MOTION_NOTIFY ev -> begin match !curves with | Some b when b#is_not_complete -> b#motion ev ; true | _ -> false end | _ -> false let create_canvas ~aa cont = let frame = GBin.frame ~shadow_type:`IN ~packing:cont#add () in let canvas = GnoCanvas.canvas ~aa ~width:600 ~height:250 ~packing:frame#add () in canvas#set_scroll_region 0. 0. 600. 250. ; let r = GnoCanvas.rect canvas#root ~props:[ `OUTLINE_COLOR "black" ; `FILL_COLOR "white" ; `X1 0.; `Y1 0. ; `X2 600. ; `Y2 250. ] in let t = GnoCanvas.text canvas#root ~props:[ `TEXT (if aa then "AntiAlias" else "Non-AntiAlias") ; `X 270. ; `Y 5. ; `FONT "Sans 12" ; `ANCHOR `NORTH ; `FILL_COLOR "black" ] in r#connect#event (canvas_event (ref None) canvas#root) let create_canvas_bezier_curve window = let vbox = GPack.vbox ~border_width:4 ~packing:window#add () in GMisc.label ~text:"Drag a line with button 1. Then mark 2 control points with\n\ button 1. Shift+click with button 1 to destroy the curve.\n" ~packing:vbox#add () ; create_canvas ~aa:false vbox ; create_canvas ~aa:true vbox let main_1 () = let window = GWindow.window () in create_canvas_bezier_curve window ; window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-curve.ml" *) (* End: *) lablgtk-2.18.8/examples/canvas/toroid.png0000644000175000017500000004102513460263323017365 0ustar stephsteph‰PNG  IHDR€NčÜgAMA† 1č–_ IDATxŚģ¼{°åŁUß÷Y{’ē}Ī}ßīŪ}»{¦gz^fō–’ń2 ĄČ@•ćŲeBŹ±ƒ‹ĀŽ$•„`W*6±qQeRńŠ$e„ ‰Œ4Ņh4šg÷ōū¾ļ=ļßļ·÷^łc’śv+ČPe —„rŗ~unß¾}Ļ9æ½öZßļw}מĀ=Éu”yŹ¼nį껌ś -äŠķšĢī“įƒć«įP\ļŒ}ó¹·&?¼ń ½ĻŠŃjŠ‹Ÿr¹öY’Ūć=’\«oĪ¬ž5µzf­;ą,AŻp—ē&aoø§/ĀĖ®”Š/{ķ/’ū×ĆŻśśz·)–L,)†DŌI‰W§^f&Õn¶!oX’ŽäÆ/}“¾©sJūi$uØĢ…ŁóÉöåČGDżöĆ?(ß·xO8‘g«ˆõBu˜ŗ/Ś+ūŻ3w=$ē6ī w·ZŲ<ÅH??; Åx;Ł¾y‘«Wž“§_|ŖśųŽ–>5ėUWRƅ*žė%¾öĄ˜¼6Ł0ÆHNÉCéŗžM–Ł“ ]²‰Aä¢æi¶Ē/śOµļ×oZłnygēnŸg™’)$Ņz”pćqA«Ą…o:‹‹’Šz^N™īĄÉ3ž„“J+SR«$‰BXāœ !Ģ”Z¶“āŚ‹śņĶĖį…ķkęłż]e<Ōk摣.fŗ[~RzU…ž’š'Ņ„Š“®Y'§- 9­]VÉi±žŽkŽ%Ā¹d‰~:ŠÜ6›()Fl0ČLՍ!ĶÕ·6Õ4*™ÄEO$ É$įśļ‹NÆVÜ÷nKļ“'óHb F·ŸJøžĒ+ßaää=^£¤rÄ `UŌx07P‰h8ÆĮŸ)åÄČ|$:>R7RŒM1›0ŸMÅMĢöēž ’Õ„+ī!hł wŌHK‹MsWž}ęžōM<`_Æ+,KW -rO*ŌV"VUPIŖRgÄU%k@Ž…¼¹;5uH2Eö’ ՛Æä®o³zāрu"™Ķaē‰”ĖTńčwZÖ/x”YH!5*™7:=)D„TLÄŖjØ EŒUŌ+åf#a6R&G0"£4am©qškļ+ąāU’įƕHžż¾œBBOśÉżöõĶ’Lk½Õfą»jµ„“Ī³Ē—€µØ­D­R„"$J’@æѓŪanGnŒh   uŒ(·2®¬’Į]°ōā+E‚¢©ČĮó)Ļ| äž·&,ßćńN1 !ŒPŽv®t®²Ų…•$5 ň›€ŸAØ™•ēAT‘¾‚łŽŽÜ(o|E±ų–צ?yéŖ\!Üŗ+©eui`9†'ŠŠ½æX †”Ž¹ĻŽÕy»<Üż.äÆ ›vC/bš$©"v² ĘŌ¹ÉÄ£^Q*ĀBw‰³{x®|š¹<Ø'Äą)…ėŲTY~µA“€ŸA’€›Z.~ŌÓ[7œ|%T„’ a¼ó…yūw½ķ.ÖVöf—U8WBYĄ|¤ų:-eqs#ø9”‰¢f3Ø ”‘+½&ÄŖØ Š .ŠÖ‹ėƒ"&ŅDŦąPµYŖ(TokćÆPP5@‚ˆ7:|>4]„ŽCą5@¤9ź& ן(Yż¾B7ĪyõŪ›ŗ;Ł"”AÄ”‰ ؔ*¼ƒ¢„ńw”“Ć#÷‹v›*Z”½¶ "؞\Jh§ŽĄŚ ,·³€/ą”uįt Æ“,ĖVX ŹĶŌ²r’ ó‹ßuæł¾3+Öü·æÆ;/ī†|ķeĮH+;ĶŻ‹o³ß|ś'ō ' §Zm[!U0 $hOĢć VČR$” t>ƒj> •¢ó :hĖ`]1:C²‚v£A 6x¬zŒõ¤VɁQÅä„@ń%…€äg`é9Õ¬”0FĻPķ$ÜülÉŅ™„Į†a:„<RŚ<ńXćyÅ77™ėXŹQĄŌTŅIĤ˜ 4Ÿ ‰UŖ*fƒ­›0ś+žNŽ“2¬Ø¬ö«`ƒp°/„Ji[xģœ%—@`„#ƒÕ}¬ØTīZ–æóČjxķ+Õ¶rĻZŪ<ōā®’Ś Ts÷ā_–wŻó·ō­ēqė-h$°(Ę!¢ą]Ģ¼‰HĶ”(,ŲŅI‘™Aż1ņ˜+¾ōd+’Y“ńÕL·Ig±…MbJŌULwęųėnŌpśēsZK9‡— 2ķ¼É„?(šSX¾/”ņ®€NĖpń‰ŠżKŽ‡ŽjHŚ%Ć#) 5ęŲ’ÄŌLŽUZ)„©pńY%(LĘ0 隠V±¢hP ¬t * ×·#`=»j8Ń„~īŽŌ_(+ÖZųĮ™6ō×ą,©‘ĶÆ% ŗŅz}棟į/½ņ»ü™vJ/ƒ†Ō:Äy£I;Ė”,™NGō ¬äć‚G Šha—2q£Tf ³Ąl<„³Ń”»ŗŹįĖŪ¾|D–Cžƒ `ē`4!ėĆŅŁ6³Ć ÕZĖ†ż—ƗĶ5čœV†ū%yćėĀ³+X\‡“÷ “O( O ™/ ;Jq¤d: čw”ŪTņ3–§>‹’ó0)V•Ü€/#8YģZśŒF–­GĆĄCkBUM~ö÷Œ±Tš@K` B˜+š(Ė¹v¾6ĄŠžwš÷<öõu›÷„h'µlb"6ӀŽ˜1ÆfHžH JØ@Ōh,ØUēŃYĄ·…ĪĀ .K˜ķī@éa.PxĘՁ4N54=ߢÜrøaĄøȒldńF&,®v&pt³$µ± ķš%pėź-ŗ]Ų¹ī fĮh¤móYø mh§Š(rmĢ•µ¦pf ń^Õ×µˆƒŌCfĄUŹt6 l“Ģƒš !1“ŗoZnŪ2mfļŅ‘ūõ¹—mEżŸ_dfÕ¼śÜߓ’ąUļ ÷­dŚo@#‰Ģ(ĘyĢž½4?AŻ™5Źå&t-’:‚ *āj“č Ŗ€zU“Ź£SĒxTH¾ÜŅl½OiagÓSÕłt '³iš«ŠN4’$‰uɊ0h·¤ŻČuė™}üŅ9m_öūhŅ…Ž˜ī‰a÷9åą’²“),žR†{±r5ŗ¢»/ĆĪ%…z0蔋‹°Ų‡^ š)ä‰gó“įā³±²MĘ@P1=,¬Bo€£Z•Ø/ŪQĶ3hˆ°¹į“ŁĘ#ÕÉLŪFĖ”:§°“Ų 5„lĶŃ4Ąz;Ā©¬Š4SC š:Æ`¢J&B•]VJQõ6*—©¢D$®żćgķ{ūIręż×üOMƒ^üŖ€¬/~?§O~Gp É÷-¤^rć’Ü>ō Ū…¤!H¦xIš(¦.pŽG€ē+4TØńŠJ1ƒ:ÆŠy%Ģ½2W“RĢ©ieĪ;ōY[Ą8‚ppĖPõį0Œ7‘¼6քź0ą&Q8H ėŖĆ@5†7b`qS(¦J5¼ö.©†hæ ‹kŠķCUŠīģ)ZĀ°§4ļ…ÅvJ–“”¬®¤ŒG%Ć”#ųLpF'³ VWŠdOÆļL)Ź@ÓB'1PÅžEŠ^ŪOŠW“ōQš‹b@mŻ–ĪTé¶3ņ ¹6”Vāłįę[Œżē’ū÷£“Ą„×°Ņi=<ŠĪĄµa’Ö*ķ”płPht”^M°™¢ $9ĢGȤB­Äö >DąW:(+NÕ¶ «(JÕI “…'X‹,eŠœ#XT=\VĢč!ų+ˆkŠzUR…ž£Ż³Š›(:ŽņƒI”¹l(gŠ0¹šSht”µ$2Ł jœa’F <ˆ•«æ żEa>‚į®rtfĆČ ĀTX“Y=Õ#ĢÆÉŹśŅ‹ppgšÕ}Q!mvńL¹¹;ĆH-XƄ2ŖzŽ#‰ zļ‚å„Ż€WQÕČ**ź«ö%ŲZ4µÄb€\[©2B½¦Ś÷¬…7ķé?ś­­źoĢ•ķ—Äd‘’•0sńkL±Œj™C3‡¼Åų` i"ƒtv=BõDā;Nn”™ (ļŠQ@-fc - 8ĀTQW!Yy†v+äõYČ%ÅģsT„¹!ōĪ yO 3Eg‚T5KčF¦Pķ+nW)Gu»bŻPLŃņP(ÅQDäŻ%č/ “ģ^V·az˜FCȓ ßw–vs¤§NNłcFŲß+YėóxP\åŠ“Ę»,,,L‘dO€€ÉSŌähYĄÄĒą ę +»ŚĆßĮČÅ,pI±÷fų£)ŗ"Ų!=/dS!Q„Ł€¬!a{Iź4īž¬#T#Å*n„\›AŽĘŪžźüB½ż˜•ż­Ø…R9%EO”O}ŖāŃW¾Ģ=›pb9ĢĘŹī®ēDßDdŖJ9ž ż&£émæ(¢Æ$€R” N9×É ęEÜįDl€ NyŁNPš ˆ Db+…Ģƒ9R.ȏ.Łw?=2Ÿxjžå–sGz’3õ>cĤÉYV—æ•f3'Ļ…,Ņ\°‰ˆIDÓ\tqUĢźi!kÄO’ Y*dM‘VWØĘĀžHŲĆÖŻ™ˆ©¼HĒ ź„Ń\˜TĀ¬ę•H'ixћįĄ 3'¤"ŅK„Ŗm‘¾Jŗؒ. Ķ…Tl*¢U™#Ģ™#ā‘$1)oØų Ā ! Że7U™l!Õń%b ²“&’5D¶Æ"Dŗ=dyՈÆDŹ™Š€Čl†„¢”Sk^š©Č“Ÿ 2Ŗ¬÷œ[łČNœGZSY;yBŽ’”kā=br¦%’)RČdŽŒgČd†x‡/’HoŽō‹xµēH³Dņ I $©/3Gt†ŲĮĒ÷eŲ Ņ˜©“½ŚåvņČSżŌ$čå?;I¤Ł:#'¾Ūœæū;ķ`1‘……Óne©©iJA©q‹†(āP:B»ėwĆ|ÓŻ: €6{ą–€ 4 ä-š%”˜Į1¶›Ś=œĀÜCĮģ‰rbˆ^ĮXPęČB ]SAsE-hRė±iL½õĒI¢œ\lGŁ2īŖ¬U­ƒ«ėā’1Dw‘ˆįŹóńŠj)UĶžēž ×^4ģ^):(<õLąž3Ī't[ĀŽĀK7<ÆŪ˜*‚°·=aļśĪE„_yŲAZ÷I©Ģ„aŻIg°ģ ŃÓh<øś3ŁÅÓ$Äd›ÖĻ¾SÄūP¤‚Ļ"ÖH¦ŹciX{WĒžĶ_=tŸõ>’2€HnN|ÆyżkžG^õČł³ēĪū“'ĻŗյŊ[4Ś[‚Į*2XGŗĖHŽ l ĘĘ¼Ś`²6ŖŲ=IS$ļ‚›B#…Nz”ßEMt^!& Ó)ģĻ`ꔚHC°@ø6£ ĘŃē%« j& Ų,źPāZ¤™s˜ ī„ h Ŗ‰5 o(aė:uåj·“°C™ؘh "±Qõėv”'-ó±a:X ,„éī=+^¾(l®¤<ó’§,…nčŠć3Ļ±“„Ä)źb ¼t/ģA9†f mUüķT|œ‚æÕ’®D @Ōxƒ8©ķ–ŠAN&ęĢ§—ö‚~īßŅļ½Å¼ņĮģW–OkšŒ‹+¦.ę¶äf2H[Šč#i—Śļ˜M”Ł‰‹XA²&Ę4ń±X¶B3vY$OÆH1FƏ`T«‚F”s­nˆ ČP éa)nkkt\S"3ūwŖ«‘ PÖpŚIćōźšĻėœŠ4ņqQ'/¼šIż»ÕTZy“3h“­$ŅņōV¤ģo+eķń£»ųģiĖÓ_ņ%,¶…jnŁyægoŌ%X…łflįh =`ŃDՏzŃ+„B)h•œ%øćSLHĶPlTøźK1«ńńB"J_5©Ä,~¦āń*’ł?öŌśOśõÕoÅXł²Å{”¾ź Øõ…É!i!šGŸG*`Č»HÖ_`²”“Ż#„It\f©` ģąp‹‘ pu¶'0/A ŅOĀV‰ŒŁ–«śøŗŹ i¬ ¶;dß ×-Å'Ķ ’Z£ų/ė”I¤4Ka&źķĪčEł­Oū’üąłšĖn"×ij•Ģ‡×łŻė_Ōæwx=¼|ĄĒ Ę4ŪęQrQ0b0(F…vÓÓļgģn)ŽE)śčHY]HŲŻ !AčfĀÖ~äś½Äru/DŌN$?ÓYō4Ś)žjL÷®Ŗ™ …Įz‹h‚b‰Ķ”%EH0äXXLķÅĄ`±Ų`Ą¬Øœ3l¾Øb^ śĮŪ–ģ;Ė’ɵŸŠW>ų5kZ½Øč5ŗŠhĒ¶[–ĒŽh£y3~5 iÄē,ƒ$EÄCK”ץtZˆ”2bse­żgu*»H""óįń?‚ĆčdŃb>śģõsםģƒ:°VĪ70żśųįEż˜ÆĆć4å!óˆü]s{’“%sœnéKįĻ”/†ßõśY<Å1’MXP LRܶYżI‡śßOrŗÓ7ok¶õ‚5JšB«-ķ•¹°yĘÜSL9}“ė2#‘mt²ø$‡žD`©™°µēSĖī”?\,SI? qĒ» :sXu«©Un©7Ÿ­֐ŌĻ)–B³ƒŒ€e®9Šš^“ąiĖĮ2?~Mł­/"F'œ¢Ł–.œ9!­>Śģ@ŚŒu]Rp)xkkā”劶ö®ŹZMsdR•ˆMY\;Įš0°dŠZćŗ:$UÜį˜šōKąēŠO”Č1­¶óĻM’ŗŁČž†·É÷čN°Ę'C’Œžœ…ĒeŖO…Oé{ĆgYvIHÄįµd Ļģ+˜ēĒž~™æī+Xī¾ĀæUs½r0÷’āąĖŲŲ„^³6ŗ=ypiŁ~ļŅ¢¾¾‘éŹh® ćƒA”‘C%ņł½©?vö™P'Ļœ‹LRĮ`+•F„˜€DĻD}ėŒE°uy ƒG€œŹĻąÅQÉ ™³ī,S©8xücWüæzüoKCF]ēIRƒ’Üöædģ^ŠC÷q;f__,ž©NƕÆÕéµd2™†§õńŻš­żĶķ=~ßÓĻsÖ¬Š4±3-‘u*Øc"¶Jf°V Ā–]rFäLH™R’Š¢ÅŠōčŅÄ×hČ­ż÷܁XRšJ‚Ć X¬&,ˆk~œpż&ü”%Iķ½žū°zāAŒ“ę!ÄH į’ĖEb±Ŗ|Ōń‹ 3L±¤ŻFå–]7a:*X§d”§Œ”Šm·Åä·>üø’Š“[¦ÕĖf1{§šfźGįK’ e8Āq¤‡žc:Ū_/ó«ŖT!0+*¹ŗs~ē`$Ÿ-*³SyB+— QLŪ‘ōI%tĘŠ †QHŲל‚„S§pƒĆŅ„É&6čÓ"EńŃ[£­—Yź HIČȎ‹H‚Ō’®—’?Ŗ杘fóœö{÷RĶėjąjO~a©õu×Į×*KÓ¼—H@«:04“ŸļaL+ŃŅ ēNp?+œ„CK xRpŒ™%S<C…”؃ Ä’ÓĄS¢€’3ŠéBYI“˜ælŽžfŠ{Æu·ĮßīÜY‹HŠÖŅ/Zć€y=1žÄÆŪ±*}t2E®īĆŁ,~#Ø1Oęp·ĒĢ‡H9½ĆĄ"‚ł łŠ[ŸŠNĆG§|dÆi>xߒżł>ž<”vĪ×bŽ:œē4÷Ź:gµO”Ō²OĄaˆ[Ņ‘“˜RQ2ƹ‚E(ėKÉPŚÜylĮ “LWę6Aµ 7¶ƬŸyOH;Bց¤{łI$ØOb‹7Ić/Øf‘°Ī¦0ŚL³µ‰fĖ itüģåEŌś(Kœ÷ó[¦7‡ÉV^ŽžĀ×ć©_ĒŽL’gvŲ}hĮžĖ¶ųUDZ“Ųä4ägu‘žft°ä˜č“' øz.Š¢…K ąqK…„ÄÖ Yūģ#YlŃ4mģ‰„$]‘ŽŹ·SµŪ’d u!mD5šö…ÄDŚęöa|[ƋēŠīynģ§†&²æ‡fZ=Œ K¤Ā^:D?ś‘śĻ^žē߈‹s‚ś½B?ō¹=ł+÷ēęX£ußiĪpæÜÅ9]”«9-,†–IČR‹ŗ’ą«Śœ°rr” "„¼78,=Dµˆ”³Ž±=I6Y?ó3ŗŗłƒź¼a2Œz¹tćī7½ų,¦žĮŖ„ ztÓ ¤ė0xģbŻ .ėƌ°µ‹4rØ2 č,G« ߘ>qóÓZčßąi%Ÿ™…ÅĻ½Bŗļ=ŀ))N ŅKÕČ1™„˜4DõŽH˜`øgO äõ÷ )9 Ū 2 IDATG$™±Mš‰a{!‘“§~*XÓĄ•ąĖø£M ‹Q„VŌõµv'x‡½ŒŽ¢*øxŚÜˆęuĒ= Łŗ‰ś÷Ńp*z²M…Ÿ¶0ē~ä§eöĻĀį³’ó7jH0'_gīž'oŌ o?VHhSa™HB‚Į“’«a:-F3rӀ¼7£Ō„‰‚ąč’6–)‹d ź.Ad·Č ’«²$éB"ĮĻ:Q•؊˜Ś;.R;iDĶR¢TŖŗ})Įt]|čÄŻ_wŗÄW°ū4aēY$ķ<ŒbĮQW0m¬vĶźƒ?ĢįÅ÷EnYķB˜~ƒ,üĀ2ż7?$g’ŚŪĀCļ\eAh‘“’i<+­÷k‚`UH<äÖŅ_X y×Xéćwö(æō³ńtŽ×ŠŠŠ@…Ō B$”3¦4‘ŗ™H4°l2|ŒõŽ»EEō–Ė”,¢åė–Ū‚ō˜ŹlLīÅļwļ‡t)Ö|*ŠØG®†°ūy°wCž0Ŗ­H1C¦­›ö”’ »šżļÓ¤›čüéĻźųÓ?‹[Į(ąq·^Ąth¾śQsĻń:}š›Oéņ`@‹ IŻą‘ŗ«w« Tk (…wģļībö0‰!1&ŁČHP„Fž• OA ń”¤Ųś7ĒµLŌŲDÆ^žÆm«¹é+‰Æ©HYlźcÜü”s° Š:Ēd5:_PA†— ;Ÿ߄Ž›QY7sž2æ ÕKąĄOīoHėī×iā‘īCÆ?¼¤ÓĻżĆæ8Ģ .zNćģ½OČŹ›^É}?zAĻ¬Æé2!܁ļcŖŽJ@=/ ‘xB-įĘ+%ÅÕē‡x¤ž;x<Ž’Š‚’1S–Qlż: J„!ź ?ž’ŅŁ»ü/…„•7`“ļā(Z;%5˜ā°-f‰|ÉVŃ`ė±oAŖ)ŗódwj¼ µ'cŅho‘r=|©vŠźŲ»ėSęØmÓģuśÅ Õ˜.ōßnĘOÅ“ńuµō¶AćōŁųńWĖ#ļ9«§Ö–ōśŚ2999 )‚ÅŌ•ŁŌ>­;~CˆrÆśZ®ø’źńzĘ6 8‡ĒØpTĢ)˜1#„ Q÷c6ĆŁ ž¦ęŲ:'(‚ÆU€RØB©uDšÜ7½®åÓĒ`šżoÕēF%É ®ØĒ¶kpW•0Ž®õ€fōś:3ØDx5m!É&Ņ,u…bÆöH Šė†‚fØ_Į—“ų h_ ‹×Ē7°“Ih‘²i²¾Õ¤S©Ė}?łóŽ•¾iuQ—¤§MiŌ²ĖķōźÅwuZ_šb%öõ^“ąŽŻ«¦„įų'=OYĶ™Ž“!ä$tX &39­ČHÉ“½CÕqoQküÆ<'Ó«Ū”x!©ć½Įā‰æBŅX¾½@ī¶®6žß:į–9dvõČbTCżÖµ0¤®¬u‚:`<µ”?ÉĄœŒ¾ē0„ŚåfČ²Śüx«ręµ2%!ĘGL]+U,ŠÅ‰č€†ō—rī={rśMéÖŗ>z®Ēę ©MAf8ĘļzÉžī»æčūgՍ{å?÷˜¼ūŪĆÉ,õ”|“½W½h?õ=O„¼o[/’“”lšJyėß ßūĪ3į®d>9YMå"ĻDČRKž ź®˜¢”n²ÕKZs…M1ā³O„3RM1žŖnć(Ž@‰£D™s,M0•„-½Aɜœ@VŪDŅc·p,į)† ōjROO4č­¼5‘xŖ€«µ€<¾“8­Q"@×ō6żó_ŖEž<ī~źVr "…&Ŗ·ģPõ1š*1Č¢üĢ)`æv¹ÅÅ75N–Ś{+,)YŅ$‹:0I”AQ™2įy&śyrmČŻņ=]ŻČHė[a4ĒɘąĶż§äÕæ~Z-ŠwšŚ“xć\d"IČĻŅ{z]Ī¾÷$÷ņZż¶ĮIĪŠ"#'#æCøIŪ¬=ܦyŚR] l}n—ńxDzÜšŒaą uPV•Ģ¤œhlR偣ŁM˜OÉI(T(q¾£ÄGe” B“œ¶ęlČnźŪlž6q’8Ć@å¦uü‘ßūWĘImcQń¾ *wģźŠ!“jėŠsØD©8$1ĆxƒńžPė~A½ĆCH”n!³P/øFf Š["RZ«=ŠĆ¼FĘ·nķ-¬Ģ± .±–~ÆĖB»Éč`Āl2%hĮ\.2ę Dg¬š*œ£©½ŗ>ŽŖŽŹÄ\ć¢~˜9GœÓojŻĖ·“Z“ļ`ä€ņ7©—3xĒĮžĆŃEFž)ĘīIZ,sJ¾“®n’ÕAÄńBÅXpċü.C½Ģpžo£Iļ}Ūz7W2䋶!ĘŃg… ¼‰ÜKBV“/wāĖ7 ĆĆ7žHi\SĢšg4,u˜ķ5(GsŠł3ÕZŃÓ;ų¼Æ3‚g¦Źt8ꈜ¾iŅb‰9‡tź»rˆ2gNEY½˜ŻFZ¤ Čh’‘Š£bJŜ?6×Æü±ßł­©ņ1 ŠłäÓrtć÷XŗūÆŖÖ;¼"å,“iŪ±-ø!*¬$ø[H_oėÖźu­$Õ=ĞCŻē£>ģūzXlų0­waCĒ^k#5&Œ8ō—(ü3$–xŒµĘäz‚Pøc¤}«ęZ„ Wł(śĪpŽ·ÓbpLøäŽI™—䏣 ×II8Ė#œä,Y-Ēźńnæsēūš†ö®—T×'‰§@%(,§ŪhŃj4hhÓoō™ķMķģ#e ØĖ«…Ü€gŽ2eĘ4LŠ¢KO‚cŹ@:TZÖ,b^†€­ƒ`LB—”N]wģ,ünøųĻĘų/|…éąPčžå_”Öņ»Čū§Pźķ@¶ŽšŲųø1&Td‰Å—”n’śhēÓ óŚ^g€6Į>ņ„8Ćp”‡aC†”]/Ā0Ns„Ē×£PI]żbUHIXäa6g¹’® &ū ®½<©å9KĮSrMžon†OŅf•{x}ĪÕžģ©…œmóy^ˆA8Įœćµu øšOƒĒ֍Õųn*c†ģs}½ĪˆCęŒQõ$$X„l–Ņœe4i0øŃeÉō8Ł_caižQ‡ŃlŸ‘š”T8<Šg LÓ£É2`O·éJ«}fL9dĪŒy]bqmÖłu,³ł‡õ…_{RwI£óĘĆ]qQ.’«üœŠmą¦0¹ķ{‹I„baŠŗ9yšbŚ ³£)ž[6šųC°qįƒŌ—Aå4Č č•z·ś­v²;F“zßNŖś9`iŃ!ē4Xgc°ÉęÉ;7 v¶ź±ńh†mĒ²/Oq#|”Œ§y =ĪÕĢÕ>mƒRɄēõ™3a™MNĖ#tt¹Fģ‘fšśÅ ›0a‡—Łā»\§dNFJ‹ :“iŃ$''­‹™2£āJŲāęĮ6-2ÖķK2`Qi²Öu;PQšĢfL™2eY»,É2»ŗĢY”Ɛ!; õ†ŒŽęø9Jń7ötņ‰-}覎?īŠĆ?å|€P…įõ_6ÅoÕžÉo!8˜\‚ł![F’^ ž ŌMĄWœ:9ą†ŒųŁ%Š)TŪĄ…Čó@€ŲGcėŸY—M †&Š¦ZŚć÷Yt¹Ē¤–Ń"3Mfį‹Ļ!SxrĒĄ„˜”#ł§{‚œÄŽ’(-ÕōE­>š³¾½öŚß÷­µAõŒITŌ£]g;Äįž“}ŁįĪą"įų%3Ēd·žŪŖuXĶÉ x¬=Č_R*¶Ø°Ķįh hšŖßA™£L µ±± $”UN\efUj#‹J£­I:EĀw‚Æ9'Å'8m?ƒĢJ¢š‚FĪA2ąwō+X8lš›<…k\÷Ł¢±BbSRpČ6wy“1;”äxtčŃc‰%z,×mZ²+mmaK¬4¢¬„[­kj'aŹˆBĘÜb‹.+ti­5{ģ“@BLDLNŸŽčėˆ±,Ćē«‡½2æ‘ä’»čŻGĔłeIķ³Z Š.¢q1;DĒAŌ”R§č.õ¹p¾AgL¶¾GU&µG@\Ś† ĀōP“>ŗ Õu›zföiiV"Ēza÷ĄĪSŽ„¹qČę –K"±…ĆJÆAīŽį­É—Iō>kāi>Üż v¾DVĘTęu-,l\b¹Įף”Ļi.ČßdMwy‹[hĄ§Å+¬²É*,‹UÖ½ ŚVO5PHŹ*Æ]×°„…‹K›&=:ųx@E@DČɒh!ؘ2%&aFFŹŒ” A—;r|³ŗś…„ņŽ{=Ō5­ęÉŗŹJįö>IU8Āź!¬:ŗgÜ=XėdÅ*ēĪzlnųÜæń"i41‡£õśYŌsbHCånc$¹I‹…I³óĀ¬2½­ó×üŲ¤‡Ü|_,:ä66¶]1,Æq-ųWb}Ą ęCŻß”­NLcJ¦F€Qx–O)§\«žeĄ-šō9ƞį’’q²¬U+CLy¢‰«\Ŗ;Üå*‡X(|ŚōXc… NČ Ī¶79Ń]„Č4ń,dšO˜–S=aŖ"]‡7"$%&%”¤D!iѤK)3&L©Čé ‡1c†LˆMĮ7cFJŠ‹¢-<ū-īߣeōā{•2Տt.ēÓ«BW}Ńhżŗ.“Ą?ˆ j{-2y„|.^ōŁ¾õćƒmsyO8[Kµ8– E\9@ ĮĮŌx®ˆ— żŲūųSŹX˜Äl#q(™2Ŗ®°_¾@Ī˜'9kšē,ćqDĪ M†Dį ›^_q#y‘=} ÅųpļU› ›P#¾ßaXmqÆśBH |:,±Ā:kö:OlžĘ*Ćń”0›0%&$6MĶ1!ѱĻ3J2l¬Eį(Š„Dää“°€’!“’™R±¢ECĪdā^Ń¾\ÕlŪOŠzF|] ×QA_]"žeä:4«YćIŸž’ĒŪ“Ėģ”ߧ¢¢Ē).5ža³y†żŃ˜” Pąį³¾ŌeĀ7gWĮwńéŠg…“œīžāC7F»ƒ!A5"d@Șˆ‰ ~h‚?%2ßGL 0fBĄ”œ Ÿ6m,”GŒÅH Ė7¹µ;cęg¤r®żƒ¶%—_Õ·¾Q?=j”¤įw(扐ÕoHg½A Ŗ¼¦‹Õ:„ī2™„\f6¹I™ŒIŌ6jĄÜ 4ļÆ÷r…ÄC™Ž·ŗČ~ Q-ó ×n…‹B>ģ×HŁ4>k¬š4mCWš\‡”ĢTŲ4p„Ćnvƒ­ā5r|z¬‹'8ē=M0™逊6.kž2‰˜p+¼NČ°¶UćāÓ„ĻINś'øōų{böCBDŒ‰™2%gfhŽĀp łČM‰™1ejĄ0%$$ 'Em|,$) /Ė·_’/żź^p„ś†VNfUTz_Ž\­ī’}QÆĄ÷UB¼D²’†€KĀZŚŌ„qp3Ė…OœX­)“kF 6‚ĖF‹Ń–GģEÅŠ.ĻBÖČĄö±1  ‰¦ä€”‡ĢøGɐŗ½j%ž¤ĖE©s,\|FśvŖ×Éįą³ĢYNŠbÓrHF€…¢+śä"ć~| h “ų{¬²aŸäģź;÷Ācv ˜ßµišÆOŸ%–ĢæmšxX(4%!&Œ™0aB@H„Bā‹.‘ˆy]\枦~ēÆCfÆī1žR(¢­yŗ+ĘŽŠ÷žvDüŅ{­~œūJņąŁjš{¢żŌßkõw5ZR܇ų%šŪä„@ŠĒAn@õA_jŖy&8RōŽfZÉķ«č!ˆ"˜/NŹHĄŅKĘ„”¢ ©HP¦žnsžēH™P Ø° ĻpŸŽ6Aöi±Ź2qi–$ Q€Ē2)‡Łm"µŸ—&-–é²FĒ^f{/f˜ļ2å€Ō§E‹UVéÉMķÓŠĘĘ|ŅOeųƔ˜€=¶Ųf‹-¶Ųa›3<ģÓfÄ!gō&§X¦«—8+7WØFA”»zņwū„_DcUTS³Oņ>f€ć;B~@6zQēc(’ B Ź ÖõÕQʐßŌ1’o·ĄbŽFvÅH•b†:4ŒČ5­‘󶦄Š)š #“ū©Pøōhr†§Q4(˜S§ņšDj‘2`Ä R€Ę£GŸs,s’”˜C49-–PŲŒŁ&dŸ’ …¢G“=ÖéŹ>EžrXn1ą -Śœągü3|äĀyVķdb#«ĀjįT8Xx8“šéÓceś“Šäl³Ć”0&"6Ė¤A!3ļyż½/„»Gs)t¦Ń3ŽŻHśĮ@C²ĮP%Vū#éQŒ¢b )ū5\˜Z€įŗ€½8ļ«ÅVP0T†õ«yź¢0E03}° ŚōÄלĖ2-6ń9Ā"gLĪ’Ĥż&)Bn3ćŠŲxō8Ć !‘DģŅ¤ƒGĄ”ęŌP§ž6]V鰌Ö%{ÜgĄ›œå¢ū$O?Ėé‹=&ū3ŹŅŒ"]øŽ?‹źiętir[Ž=«’ūćŪģ}½ÕłL§ėYQŅ°õ­źµŒ™żŌcs~2ŌZoB¾ ŹųPžĒ¢G•dM”Ö!» :5Vŗ ö Ņ4Åß|ŚUµh‰Ģ]=屟åHsęŸóĀpõJrpčą±NƒeŠ‚ Źc+?gBÄC2Ęh l«‹Yz±„Õ,‡-,š~ƒ^ÆIĆr¹@hĄ8>ąµ.lk·ßDLø,¾óõ[śŽWŖy]%¤×Lž~KæORļt†Īv©&/RÜłłĶ”+ŸÖn=gpÄ|<¦ęHĢŹ—‹U/é??¶ź«cÅ"Ę"jcį™ā°fĪ¶LaW „mŽ”QÓs&«“Ł0,Ū}$1©)ė×­•.-–pp˜r”¬°†oģ–•į(Žx ‰k½%.=³Źéßjā榔łŃųĒÅÜ8cwóķ‹½ā9ńŚÓĆļ¾ŪjūqŖüŸ!į RōäUŠėWŠÉ!Ļ¬K<©«pń֌Šš#_n‚ĮńLP›‚7/!51ĢŲ£ 6[BĖ¤ŌˆŠ„ŠŌōÕI,x“i±†¦l69 ¹į)źź¢aŲy ›#,MŚŌ“ƒkoļє>i^GāHEÆŪĀõ%·BvoĢ¢™Łćsrj'OføüÜ|=#āžø=zŽo}!bzėgŃ»ü’żĘYäé?źÉ?„§tY+€µP˜©–,N`±ŒM ×¼•Gõ‚8 3rnjVv­č)c=Ó|µa„ä&-V±ńÉĢqĻ2ü:‹ŒƒŃ-†Āńńə¢(iąa™Vīšž²±Ģ‘®nŹ°Ķ× WŚõ_Æj=£$%©ģVƒ.*,c\‹C¾Įåø\½šē9łąĒ^FzˆĪļ qī4žĒŃīI“Ūœ[Ŗ…YsõŽ]·„Y‹ Ź…wžˆĘt Ģūęķł „łŹ Ÿ,RŠĢ¦.qlׁupńiŅĮĮ1ŁEć`›MĮ2Įƃn›Ÿ9XĘõ#ń» '!!`,wĖ7xå­;śĘ›#öÆOōd+fz7ÆŻ3•€žDŲ%Õ­ŒlW×wˆņK€Gz)}pĻwZŸ¬~üupš[ lKąESX“°i€X48Ļ·iVėQe}|fę¼óÖĀ”G‡‡¦&·Žqó)Ü6M\Zø¦ˆ”ŲØZj^Ą2YÅY”&z@“‘“PŠDÅöōe._žnõķæH™Ż®¹ś=†G’²ą]škQ' ńQšNKŚOIÖ“tOIŚķ–¢!„aŽ£„éĘ9bXĘysµĀĮ„e `‡”ĦˆTĘq4·œŌ¦M,¹Ńź“īĢŻ¦’Ļ1™ÅĘ6Æ]włä"$Ćwxė›ÆUßżüˆń·5åĻŻŒĮĻŻ‡°œ·²“IDAT@6ė‹ŽģžĄ»ØXś“Åņ36«[“śŠ†„Kµ XēgīŗŚ·pp±P$$ģ (MČ{†z÷nąā9”±h报6æa›5?ßū-*R—‡Üģsw3Žqšö”Ž{i¤Ÿ˜Ž+ߣ4ū+üČō'=÷k+ŸµYū—µXtÜy 3v,s|S”"Ī#}’fŹŠuX:ļ` ‡&¶Ń³–mäzĘī”Œ1 ×xy]€šU¬“½¤"Ay«Æ?o?»UŻśŚŒé÷5åģgµ’’ą‡ĀՔ4?fÓūŒĆŚļ9t6,Z]…%$*­D2œé­W§ÜūbNxE¢ÖZlžY›3ŸkŠ[uš…ezz•°µŠe‘ˆĆŪnæžė ķqźSVĻ4h)W4š„ĀŅˆ2Ļ‰ö§bpø§ļ¼¶§ļžĖ”Į‹%ed.I~—·U’ ģ‡źKœÓ’ĘŖaŌ’Štæ$½;ļē7Äučüv‹“Ś »fÓōlį®gŒæč­Ÿ²’|IrS#¤ƒ÷”G÷£6M…Żwp…ŗHæ•čąfJü°¤Ų{4č昒 ’JåųŠķIEND®B`‚lablgtk-2.18.8/examples/canvas/canvas-features.ml0000644000175000017500000000516313460263323021003 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let pad = 4 let item_callback it (p1, p2) = function | `BUTTON_PRESS ev when GdkEvent.Button.button ev = 1 -> if it#parent#get_oid = p1#get_oid then it#reparent p2 else it#reparent p1 ; true | _ -> false let create_canvas_features window = let vbox = GPack.vbox ~border_width:pad ~spacing:pad ~packing:window#add () in GMisc.label ~text:"Reparent test: click on the items to switch them between parents" ~packing:vbox#add () ; let align = GBin.alignment ~packing:vbox#add () in let frame = GBin.frame ~shadow_type:`IN ~packing:align#add () in let canvas = GnoCanvas.canvas ~width:400 ~height:200 ~packing:frame#add () in canvas#set_scroll_region 0. 0. 400. 200. ; let parent_1 = GnoCanvas.group canvas#root ~x:0. ~y:0. in GnoCanvas.rect parent_1 ~props:[ `X1 0.; `Y1 0.; `X2 200.; `Y2 200.; `FILL_COLOR "tan" ] ; let parent_2 = GnoCanvas.group canvas#root ~x:200. ~y:0. in GnoCanvas.rect parent_2 ~props:[ `X1 0.; `Y1 0.; `X2 200.; `Y2 200.; `FILL_COLOR "#204060" ] ; let item = GnoCanvas.ellipse parent_1 ~props:[ `X1 10.; `Y1 10.; `X2 190.; `Y2 190.; `OUTLINE_COLOR "black" ; `FILL_COLOR "mediumseagreen" ; `WIDTH_UNITS 3. ] in item#connect#event (item_callback item (parent_1, parent_2)) ; let group = GnoCanvas.group parent_2 ~x:100. ~y:100. in GnoCanvas.ellipse group ~props:[ `X1 (-50.); `Y1 (-50.); `X2 50.; `Y2 50.; `OUTLINE_COLOR "black" ; `FILL_COLOR "wheat" ; `WIDTH_UNITS 3. ] ; GnoCanvas.ellipse group ~props:[ `X1 (-25.); `Y1 (-25.); `X2 25.; `Y2 25.; `FILL_COLOR "steelblue" ] ; group#connect#event (item_callback group (parent_1, parent_2)) ; vbox let main_1 () = let window = GWindow.window () in let truc = create_canvas_features window in window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-features.ml" *) (* End: *) lablgtk-2.18.8/examples/canvas/canvas-arrowhead.ml0000644000175000017500000002421313460263323021136 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) type config = { mutable width : int ; mutable shape_a : int ; mutable shape_b : int ; mutable shape_c : int ; } type data = { big_arrow : GnoCanvas.line ; outline : GnoCanvas.line ; width_drag_box : GnoCanvas.rect ; shape_a_drag_box : GnoCanvas.rect ; shape_b_c_drag_box : GnoCanvas.rect ; width_items : GnoCanvas.line * GnoCanvas.text ; shape_a_items : GnoCanvas.line * GnoCanvas.text ; shape_b_items : GnoCanvas.line * GnoCanvas.text ; shape_c_items : GnoCanvas.line * GnoCanvas.text ; width_info : GnoCanvas.text ; shape_a_info : GnoCanvas.text ; shape_b_info : GnoCanvas.text ; shape_c_info : GnoCanvas.text ; samples : GnoCanvas.line list } let global_data = ref None let left = 50. let right = 350. let middle = 150. let config = { width = 2 ; shape_a = 8 ; shape_b = 10 ; shape_c = 3 ; } let set_dimension (arrow, text) ~x1 ~y1 ~x2 ~y2 ~tx ~ty dim = let points = [| x1; y1; x2; y2 |] in arrow#set [ `POINTS points ] ; text#set [ `TEXT (string_of_int dim); `X tx; `Y ty] let move_drag_box item ~x ~y = item#set [ `X1 (x -. 5.) ; `Y1 (y -. 5.) ; `X2 (x +. 5.) ; `Y2 (y +. 5.) ; ] let set_arrow_shape c = let d = match !global_data with | None -> failwith "argl" | Some v -> v in d.big_arrow#set [ `WIDTH_PIXELS (10 * c.width) ; `ARROW_SHAPE_A (float c.shape_a *. 10.) ; `ARROW_SHAPE_B (float c.shape_b *. 10.) ; `ARROW_SHAPE_C (float c.shape_c *. 10.) ; ] ; let p = [| right -. 10. *. float c.shape_a ; middle ; right -. 10. *. float c.shape_b ; middle -. 10. *. (float c.shape_c +. float c.width /. 2.) ; right ; middle ; right -. 10. *. float c.shape_b ; middle +. 10. *. (float c.shape_c +. float c.width /. 2.) ; right -. 10. *. float c.shape_a ; middle ; |] in d.outline#set [ `POINTS p ] ; move_drag_box d.width_drag_box ~x:left ~y:(middle -. 10. *. float c.width /. 2.) ; move_drag_box d.shape_a_drag_box ~x:(right -. 10. *. float c.shape_a) ~y:middle ; move_drag_box d.shape_b_c_drag_box ~x:(right -. 10. *. float c.shape_b) ~y:(middle -. 10. *. (float c.shape_c +. float c.width /. 2.)) ; set_dimension d.width_items ~x1:(left -. 10.) ~y1:(middle -. 10. *. (float c.width /. 2.)) ~x2:(left -. 10.) ~y2:(middle +. 10. *. (float c.width /. 2.)) ~tx:(left -. 15.) ~ty:middle c.width ; set_dimension d.shape_a_items ~x1:(right -. 10. *. float c.shape_a) ~y1:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 10.) ~x2:right ~y2:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 10.) ~tx:(right -. 10. *. float c.shape_a /. 2.) ~ty:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 15.) c.shape_a ; set_dimension d.shape_b_items ~x1:(right -. 10. *. float c.shape_b) ~y1:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 35.) ~x2:right ~y2:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 35.) ~tx:(right -. 10. *. float c.shape_b /. 2.) ~ty:(middle +. 10. *. (float c.width /. 2. +. float c.shape_c) +. 40.) c.shape_b ; set_dimension d.shape_c_items ~x1:(right +. 10.) ~y1:(middle -. 10. *. (float c.width /. 2.)) ~x2:(right +. 10.) ~y2:(middle -. 10. *. (float c.width /. 2. +. float c.shape_c)) ~tx:(right +. 15.) ~ty:(middle -. 10. *. (float (c.width + c.shape_c) /. 2.)) c.shape_c ; d.width_info#set [ `TEXT (Printf.sprintf "width: %d" c.width) ] ; d.shape_a_info#set [ `TEXT (Printf.sprintf "arrow_shape_a: %d" c.shape_a) ] ; d.shape_b_info#set [ `TEXT (Printf.sprintf "arrow_shape_b: %d" c.shape_b) ] ; d.shape_c_info#set [ `TEXT (Printf.sprintf "arrow_shape_c: %d" c.shape_c) ] ; List.iter (fun i -> i#set [ `WIDTH_PIXELS c.width ; `ARROW_SHAPE_A (float c.shape_a) ; `ARROW_SHAPE_B (float c.shape_b) ; `ARROW_SHAPE_C (float c.shape_c) ; ] ) d.samples let highlight_box item ev = begin match ev with | `ENTER_NOTIFY _ -> item#set [ `FILL_COLOR "red" ] | `LEAVE_NOTIFY ev -> let state = GdkEvent.Crossing.state ev in if not (Gdk.Convert.test_modifier `BUTTON1 state) then item#set [ `NO_FILL_COLOR ] | `BUTTON_PRESS ev -> let curs = Gdk.Cursor.create `FLEUR in item#grab [`POINTER_MOTION; `BUTTON_RELEASE] curs (GdkEvent.Button.time ev) | `BUTTON_RELEASE ev -> item#ungrab (GdkEvent.Button.time ev) | _ -> () end ; false let create_drag_box grp cb = let box = GnoCanvas.rect ~props:[ `NO_FILL_COLOR ; `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 0 ] grp in let sigs = box#connect in sigs#event (highlight_box box) ; sigs#event cb ; box let width_event c ev = begin match ev with | `MOTION_NOTIFY ev -> let state = GdkEvent.Motion.state ev in let width = int_of_float ((middle -. GdkEvent.Motion.y ev) /. 5.) in if Gdk.Convert.test_modifier `BUTTON1 state && width >= 0 then begin c.width <- width ; set_arrow_shape c end | _ -> () end ; false let shape_a_event c ev = begin match ev with | `MOTION_NOTIFY ev -> let state = GdkEvent.Motion.state ev in let shape_a = int_of_float ((right -. GdkEvent.Motion.x ev) /. 10.) in if Gdk.Convert.test_modifier `BUTTON1 state && 0 <= shape_a && shape_a <= 30 then begin c.shape_a <- shape_a ; set_arrow_shape c end | _ -> () end ; false let shape_b_c_event c ev = begin match ev with | `MOTION_NOTIFY ev -> let state = GdkEvent.Motion.state ev in let change = ref false in let shape_b = int_of_float ((right -. GdkEvent.Motion.x ev) /. 10.) in let shape_c = int_of_float (((middle -. 5. *. float c.width) -. (GdkEvent.Motion.y ev)) /. 10.) in if Gdk.Convert.test_modifier `BUTTON1 state then begin if 0 <= shape_b && shape_b <= 30 then begin c.shape_b <- shape_b ; change := true end ; if 0 <= shape_c then begin c.shape_c <- shape_c ; change := true end ; if !change then set_arrow_shape c end | _ -> () end ; false let create_dimension grp anchor = let a = GnoCanvas.line ~props:[ `FILL_COLOR "black" ; `FIRST_ARROWHEAD true ; `LAST_ARROWHEAD true ; `ARROW_SHAPE_A 5. ; `ARROW_SHAPE_B 5. ; `ARROW_SHAPE_C 3. ; ] grp in let t = GnoCanvas.text ~props:[ `FILL_COLOR "black" ; `FONT "Sans 12" ; `ANCHOR anchor ] grp in (a, t) let create_info grp ~x ~y = GnoCanvas.text ~props:[ `X x; `Y y; `FILL_COLOR "black" ; `FONT "Sans 14" ; `ANCHOR `NW ] grp let create_sample_arrow grp p = GnoCanvas.line ~props:[ `POINTS p ; `FILL_COLOR "black" ; `FIRST_ARROWHEAD true ; `LAST_ARROWHEAD true ] grp let create_canvas_arrowhead window = let vbox = GPack.vbox ~border_width:4 ~packing:window#add () in GMisc.label ~text:"This demo allows you to edit arrowhead shapes. Drag the little boxes\n\ to change the shape of the line and its arrowhead. You can see the\n\ arrows at their normal scale on the right hand side of the window." ~packing:vbox#add () ; let align = GBin.alignment ~packing:vbox#add () in let frame = GBin.frame ~shadow_type:`IN ~packing:align#add () in let canvas = GnoCanvas.canvas ~width:500 ~height:350 ~packing:frame#add () in canvas#set_scroll_region 0. 0. 500. 350. ; let root = canvas#root in let p = [| left; middle; right; middle |] in let big_arrow = GnoCanvas.line root ~props:[ `POINTS p ; `FILL_COLOR "mediumseagreen" ; `WIDTH_PIXELS (config.width * 10) ; `LAST_ARROWHEAD true ] in let outline = GnoCanvas.line root ~props:[ `FILL_COLOR "black" ; `CAP_STYLE `ROUND ; `JOIN_STYLE `ROUND ; `WIDTH_PIXELS 2; ] in let width_drag_box = create_drag_box root (width_event config) in let shape_a_drag_box = create_drag_box root (shape_a_event config) in let shape_b_c_drag_box = create_drag_box root (shape_b_c_event config) in let width_items = create_dimension root `EAST in let shape_a_items = create_dimension root `NORTH in let shape_b_items = create_dimension root `NORTH in let shape_c_items = create_dimension root `WEST in let width_info = create_info root ~x:left ~y:260. in let shape_a_info = create_info root ~x:left ~y:280. in let shape_b_info = create_info root ~x:left ~y:300. in let shape_c_info = create_info root ~x:left ~y:320. in let p = [| right +. 50.; 0.; right +. 50.; 1000. |] in GnoCanvas.line root ~props:[ `POINTS p; `FILL_COLOR "black" ; `WIDTH_PIXELS 2 ] ; let samples = List.map (create_sample_arrow root) [ [| right +. 100.; 30.; right +. 100. ; middle -. 30. |] ; [| right +. 70. ; middle; right +. 130. ; middle |] ; [| right +. 70. ; middle +. 30. ; right +. 130. ; middle +. 120. |] ] in global_data := Some { big_arrow = big_arrow ; outline = outline ; width_drag_box = width_drag_box ; shape_a_drag_box = shape_a_drag_box ; shape_b_c_drag_box = shape_b_c_drag_box ; width_items = width_items ; shape_a_items = shape_a_items ; shape_b_items = shape_b_items ; shape_c_items = shape_c_items ; width_info = width_info ; shape_a_info = shape_a_info ; shape_b_info = shape_b_info ; shape_c_info = shape_c_info ; samples = samples ; } ; set_arrow_shape config let main_1 () = let window = GWindow.window () in create_canvas_arrowhead window ; window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-arrowhead.ml" *) (* End: *) lablgtk-2.18.8/examples/canvas/canvas-primitives.ml0000644000175000017500000003547513460263323021371 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let zoom_changed canvas adj () = canvas#set_pixels_per_unit adj#value type 'p item_state = { item : 'p GnoCanvas.item ; mutable dragging : bool ; mutable x : float ; mutable y : float ; } let affine_rotate angle = let rad_angle = angle /. 180. *. acos (-1.) in let cos_a = cos rad_angle in let sin_a = sin rad_angle in [| cos_a ; sin_a ; ~-. sin_a ; cos_a ; 0. ; 0. |] let affine_apply a x y = ( a.(0) *. x +. a.(2) *. y +. a.(4) , a.(1) *. x +. a.(3) *. y +. a.(5) ) let affine_compose a1 a2 = [| a1.(0) *. a2.(0) +. a1.(1) *. a2.(2) ; a1.(0) *. a2.(1) +. a1.(1) *. a2.(3) ; a1.(2) *. a2.(0) +. a1.(3) *. a2.(2) ; a1.(2) *. a2.(1) +. a1.(3) *. a2.(3) ; a1.(4) *. a2.(0) +. a1.(5) *. a2.(2) +. a2.(4) ; a1.(4) *. a2.(1) +. a1.(5) *. a2.(3) +. a2.(5) ; |] let affine_invert a = let r_det = 1. /. (a.(0) *. a.(3) -. a.(1) *. a.(2)) in [| a.(3) *. r_det ; ~-. (a.(1)) *. r_det ; ~-. (a.(2)) *. r_det ; a.(0) *. r_det ; (a.(2) *. a.(5) -. a.(3) *. a.(4)) *. r_det ; (a.(1) *. a.(4) -. a.(0) *. a.(5)) *. r_det ; |] let affine_transl x y = [| 1. ; 0. ; 0. ; 1. ; x ; y |] let affine_rotate_around_point x y angle = affine_compose (affine_compose (affine_transl (~-. x) (~-. y)) (affine_rotate angle)) (affine_transl x y) let d_theta = 15. let item_event_button_press config ev = let state = GdkEvent.Button.state ev in match GdkEvent.Button.button ev with | 1 when Gdk.Convert.test_modifier `SHIFT state -> config.item#destroy () | 1 when Gdk.Convert.test_modifier `CONTROL state -> let (x, y) = config.item#w2i (GdkEvent.Button.x ev) (GdkEvent.Button.y ev) in config.item#affine_relative (affine_rotate_around_point x y d_theta) ; | 3 when Gdk.Convert.test_modifier `CONTROL state -> let (x, y) = config.item#w2i (GdkEvent.Button.x ev) (GdkEvent.Button.y ev) in config.item#affine_relative (affine_rotate_around_point x y (~-. d_theta)) ; | 1 -> let x = GdkEvent.Button.x ev in let y = GdkEvent.Button.y ev in let (p_x, p_y) = config.item#parent#w2i x y in config.x <- p_x ; config.y <- p_y ; config.dragging <- true | 2 when Gdk.Convert.test_modifier `SHIFT state -> config.item#lower_to_bottom () | 2 -> config.item#lower 1 | 3 when Gdk.Convert.test_modifier `SHIFT state -> config.item#raise_to_top () | 3 -> config.item#raise 1 | _ -> () let item_event_motion config ev = if config.dragging && Gdk.Convert.test_modifier `BUTTON1 (GdkEvent.Motion.state ev) then let x = GdkEvent.Motion.x ev in let y = GdkEvent.Motion.y ev in let (p_x, p_y) = config.item#parent#w2i x y in let aff = affine_invert ( match config.item#xform with | `AFFINE a -> a | `IDENTITY -> affine_transl 0. 0. | `TRANSL a -> affine_transl a.(0) a.(1) ) in let (apx, apy) = affine_apply aff p_x p_y in let (acx, acy) = affine_apply aff config.x config.y in config.item#move (apx -. acx) (apy -. acy) ; config.x <- p_x ; config.y <- p_y let item_event config ev = begin match ev with | `BUTTON_PRESS ev -> item_event_button_press config ev | `BUTTON_RELEASE _ -> config.dragging <- false | `MOTION_NOTIFY ev -> item_event_motion config ev | _ -> () end ; false let setup_item (it : 'a #GnoCanvas.item) = let config = { item = (it : 'a #GnoCanvas.item :> 'a GnoCanvas.item) ; dragging = false ; x = 0. ; y = 0. } in it#connect#event (item_event config) let setup_div root = let grp = GnoCanvas.group root ~x:0. ~y:0. in GnoCanvas.rect grp ~props:[ `X1 0.; `Y1 0.; `X2 600.; `Y2 450. ; `OUTLINE_COLOR "black" ; `WIDTH_UNITS 4. ] ; List.map (fun p -> GnoCanvas.line grp ~props:[ `FILL_COLOR "black"; `WIDTH_UNITS 4. ; `POINTS p ]) [ [| 0.; 150.; 600.; 150. |] ; [| 0.; 300.; 600.; 300. |] ; [| 200.; 0.; 200.; 450. |] ; [| 400.; 0.; 400.; 450. |] ; ] ; List.map (fun (text, pos) -> GnoCanvas.text grp ~props:[ `TEXT text ; `X (float (pos mod 3 * 200 + 100)) ; `Y (float (pos / 3 * 150 + 5)) ; `FONT "Sans 12" ; `ANCHOR `NORTH ; `FILL_COLOR "black" ]) [ ("Rectangles", 0); ("Ellipses", 1); ("Texts", 2); ("Images", 3); ("Lines", 4); ("Curves", 5); ("Arcs", 6); ("Polygons", 7); ("Widgets", 8); ] ; () let setup_rectangles root = setup_item (GnoCanvas.rect root ~props:[ `X1 20.; `Y1 30.; `X2 70.; `Y2 60.; `OUTLINE_COLOR "red" ; `WIDTH_PIXELS 8 ]) ; setup_item (GnoCanvas.rect root ~props:( [ `X1 90.; `Y1 40.; `X2 180.; `Y2 100.; `OUTLINE_COLOR "black" ; `WIDTH_UNITS 4. ] @ if root#canvas#aa then [ `FILL_COLOR_RGBA (Int32.of_int 0x3cb37180) ] else [ `FILL_COLOR "mediumseagreen" ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") ] )) ; setup_item (GnoCanvas.rect root ~props:[ `X1 10.; `Y1 80.; `X2 80.; `Y2 140.; `FILL_COLOR "steelblue" ]) let setup_ellipses root = setup_item (GnoCanvas.ellipse root ~props:[ `X1 220.; `Y1 30.; `X2 270.; `Y2 60. ; `OUTLINE_COLOR "goldenrod" ; `WIDTH_PIXELS 8 ]) ; setup_item (GnoCanvas.ellipse root ~props:[ `X1 290.; `Y1 40.; `X2 380.; `Y2 100. ; `FILL_COLOR "wheat" ; `OUTLINE_COLOR "midnightblue" ; `WIDTH_UNITS 4. ]) ; setup_item (GnoCanvas.ellipse root ~props:( [ `X1 210.; `Y1 80.; `X2 280.; `Y2 140.; `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 0 ] @ if root#canvas#aa then [ `FILL_COLOR_RGBA (Int32.of_int 0x5f9ea080) ] else [ `FILL_COLOR "cadetblue" ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") ] )) let make_anchor root ~x ~y = let grp = GnoCanvas.group ~x ~y root in setup_item grp ; GnoCanvas.rect grp ~props:[ `X1 (-2.); `Y1 (-2.); `X2 2.; `Y2 2. ; `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 0 ] ; grp let setup_texts root = GnoCanvas.text (make_anchor root ~x:420. ~y:20.) ~props:([ `TEXT "Anchor NW" ;`ANCHOR `NW ; `X 0. ; `Y 0. ; `FONT "Sans Bold 24" ; ] @ if root#canvas#aa then [ `FILL_COLOR_RGBA (Int32.of_int 0x0000ff80) ] else [ `FILL_COLOR "blue" ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") ] ) ; GnoCanvas.text (make_anchor root ~x:470. ~y:75.) ~props:[ `TEXT "Anchor center\nJustify center\nMultiline text" ; `X 0. ; `Y 0. ; `FONT "Sans monospace bold 14" ; `ANCHOR `CENTER ; `JUSTIFICATION `CENTER ; `FILL_COLOR "firebrick" ] ; GnoCanvas.text (make_anchor root ~x:590. ~y:140.) ~props:[ `TEXT "Clipped text\nClipped text\nClipped text\nClipped text\nClipped text\nClipped text" ; `X 0. ; `Y 0. ; `FONT "Sans 12" ; `ANCHOR `SE ; `CLIP true ; `CLIP_WIDTH 50. ; `CLIP_HEIGHT 55. ; `X_OFFSET 10. ; `FILL_COLOR "darkgreen" ] ; () let plant_flower root x y = let im = GdkPixbuf.from_file "flower.png" in setup_item (GnoCanvas.pixbuf root ~pixbuf:im ~x ~y ~props:[ `ANCHOR `CENTER] ) ; () let setup_images root = let im = GdkPixbuf.from_file "toroid.png" in setup_item (GnoCanvas.pixbuf ~x:100. ~y:225. ~pixbuf:im ~props:[ `ANCHOR `CENTER ] root) ; plant_flower root 20. 170. ; plant_flower root 180. 170. ; plant_flower root 20. 280. ; plant_flower root 180. 280. let polish_diamond root = let grp = GnoCanvas.group ~x:270. ~y:230. root in setup_item grp ; let p = Array.make 4 0. in let vertices, radius = (10, 60.) in for i=0 to pred vertices do let a = 8. *. atan 1. *. (float i) /. (float vertices) in p.(0) <- radius *. cos a ; p.(1) <- radius *. sin a ; for j=i+1 to pred vertices do let a = 8. *. atan 1. *. (float j) /. (float vertices) in p.(2) <- radius *. cos a ; p.(3) <- radius *. sin a ; GnoCanvas.line grp ~props:[ `POINTS p; `FILL_COLOR "black" ; `WIDTH_UNITS 1. ; `CAP_STYLE `ROUND ] ; () done done let make_hilbert root = let scale = 7. in let hilbert = "urdrrulurulldluuruluurdrurddldrrruluurdrurddldrddlulldrdldrrurd" in let points = Array.make (2 * (String.length hilbert + 1)) 0. in points.(0) <- 340. ; points.(1) <- 290. ; for i=1 to String.length hilbert do let (dx, dy) = match hilbert.[pred i] with | 'd' -> (0., scale) | 'u' -> (0., ~-. scale) | 'l' -> (~-. scale, 0.) | 'r' -> (scale, 0.) | _ -> failwith "pb" in points.(2 * i) <- points.(2 * (pred i)) +. dx ; points.(2 * i + 1) <- points.(2 * (pred i) + 1) +. dy done ; setup_item (GnoCanvas.line root ~props:( [ `POINTS points ; `WIDTH_UNITS 4. ; `CAP_STYLE `PROJECTING ; `JOIN_STYLE `MITER ] @ if root#canvas#aa then [ `FILL_COLOR_RGBA 0xff000080l ] else [ `FILL_COLOR "red" ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") ] ) ) ; () let setup_lines root = polish_diamond root ; make_hilbert root ; let points = [| 340.; 170.; 340.; 230.; 390.; 230.; 390.; 170. |] in setup_item (GnoCanvas.line root ~props:[ `POINTS points ; `FILL_COLOR "midnightblue" ; `WIDTH_UNITS 3. ; `FIRST_ARROWHEAD true ; `LAST_ARROWHEAD true ; `ARROW_SHAPE_A 8. ; `ARROW_SHAPE_B 12. ; `ARROW_SHAPE_C 4. ]) ; let points = [| 356.; 180.; 374.; 220.; |] in setup_item (GnoCanvas.line root ~props:[ `POINTS points ; `FILL_COLOR "blue" ; `WIDTH_PIXELS 0 ; `FIRST_ARROWHEAD true ; `LAST_ARROWHEAD true ; `ARROW_SHAPE_A 6. ; `ARROW_SHAPE_B 6. ; `ARROW_SHAPE_C 4. ]) ; let points = [| 356.; 220.; 374.; 180.; |] in setup_item (GnoCanvas.line root ~props:[ `POINTS points ; `FILL_COLOR "blue" ; `WIDTH_PIXELS 0 ; `FIRST_ARROWHEAD true ; `LAST_ARROWHEAD true ; `ARROW_SHAPE_A 6. ; `ARROW_SHAPE_B 6. ; `ARROW_SHAPE_C 4. ]) ; () let setup_curves root = let p = GnomeCanvas.PathDef.new_path () in GnomeCanvas.PathDef.moveto p 500. 175. ; GnomeCanvas.PathDef.curveto p 550. 175. 550. 275. 500. 275. ; setup_item (GnoCanvas.bpath root ~props:[ `BPATH p ; `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 4 ]) ; () let setup_polygons root = let points = [| 210. ; 320.; 210.; 380.; 260.; 350.; |] in setup_item (GnoCanvas.polygon ~points root ~props:( (`OUTLINE_COLOR "black") :: if root#canvas#aa then [ `FILL_COLOR_RGBA (Int32.of_int 0x0000ff80) ] else [ `FILL_COLOR "blue" ; `FILL_STIPPLE (Gdk.Bitmap.create_from_data ~width:2 ~height:2 "\002\001") ] )) ; let points = [| 270.0; 330.0; 270.0; 430.0; 390.0; 430.0; 390.0; 330.0; 310.0; 330.0; 310.0; 390.0; 350.0; 390.0; 350.0; 370.0; 330.0; 370.0; 330.0; 350.0; 370.0; 350.0; 370.0; 410.0; 290.0; 410.0; 290.0; 330.0; |] in setup_item (GnoCanvas.polygon ~points root ~props:[ `FILL_COLOR "tan" ; `OUTLINE_COLOR "black" ; `WIDTH_UNITS 3. ]) ; () let setup_widgets root = let w = GButton.button ~label:"Hello world!" () in setup_item (GnoCanvas.widget root ~widget:w ~x:420. ~y:330. ~props:[ `ANCHOR `NW ; `SIZE_PIXELS false ; `WIDTH 100. ; `HEIGHT 40. ]) ; () let key_press (canvas : GnoCanvas.canvas) ev = let (x, y) = canvas#get_scroll_offsets in match GdkEvent.Key.keyval ev with | k when k = GdkKeysyms._Up -> canvas#scroll_to x (y-20) ; true | k when k = GdkKeysyms._Down -> canvas#scroll_to x (y+20) ; true | k when k = GdkKeysyms._Left -> canvas#scroll_to (x-10) y ; true | k when k = GdkKeysyms._Right -> canvas#scroll_to (x+10) y ; true | _ -> false let focus canvas ev = if GdkEvent.Focus.focus_in ev then prerr_endline "focus in" else prerr_endline "focus out" ; false let create_canvas_primitives window ~aa = let vbox = GPack.vbox ~border_width:4 ~spacing:4 ~packing:window#add () in GMisc.label ~text:"Drag an item with button 1. Click button 2 on an item to lower it,\n\ or button 3 to raise it. Shift+click with buttons 2 or 3 to send\n\ an item to the bottom or top, respectively. Control+click with \n\ button 1 or button 3 to rotate an item." ~packing:vbox#pack () ; let hbox = GPack.hbox ~spacing:4 ~packing:vbox#pack () in GtkBase.Widget.push_colormap (Gdk.Rgb.get_cmap ()) ; let canvas = GnoCanvas.canvas ~aa ~width:600 ~height:450 () in canvas#set_center_scroll_region false ; let root = canvas#root in setup_div root ; setup_rectangles root ; setup_ellipses root ; setup_texts root ; setup_images root ; setup_lines root ; setup_polygons root ; setup_curves root ; setup_widgets root ; (* root#affine_relative [| 1.5; 0.; 0.; 0.7; 0.; 0.; |] ; *) GtkBase.Widget.pop_colormap () ; GMisc.label ~text:"Zoom:" ~packing:hbox#pack () ; let adj = GData.adjustment ~value:1. ~lower:0.05 ~upper:5. ~step_incr:0.05 ~page_incr:0.5 ~page_size:0.5 () in adj#connect#value_changed (zoom_changed canvas adj) ; let w = GEdit.spin_button ~adjustment:adj ~rate:0. ~digits:2 ~width:50 ~packing:hbox#pack () in let table = GPack.table ~rows:2 ~columns:2 ~row_spacings:4 ~col_spacings:4 ~packing:vbox#pack () in let frame = GBin.frame ~shadow_type:`IN () in table#attach ~left:0 ~right:1 ~top:0 ~bottom:1 ~expand:`BOTH ~fill:`BOTH ~shrink:`BOTH ~xpadding:0 ~ypadding:0 frame#coerce ; canvas#set_scroll_region 0. 0. 600. 450. ; frame#add canvas#coerce ; canvas#event#connect#after#key_press (key_press canvas) ; canvas#event#connect#enter_notify (fun _ -> canvas#misc#grab_focus () ; false) ; let w = GRange.scrollbar `HORIZONTAL ~adjustment:canvas#hadjustment () in table#attach ~left:0 ~right:1 ~top:1 ~bottom:2 ~expand:`X ~fill:`BOTH ~shrink:`X ~xpadding:0 ~ypadding:0 w#coerce ; let w = GRange.scrollbar `VERTICAL ~adjustment:canvas#vadjustment () in table#attach ~left:1 ~right:2 ~top:0 ~bottom:1 ~expand:`Y ~fill:`BOTH ~shrink:`Y ~xpadding:0 ~ypadding:0 w#coerce ; canvas#misc#set_can_focus true ; canvas#misc#grab_focus () let main_1 () = let aa = if Array.length Sys.argv > 1 then try bool_of_string Sys.argv.(1) with Invalid_argument _ -> false else false in let window = GWindow.window () in create_canvas_primitives window ~aa ; window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-primitives.ml" *) (* End: *) lablgtk-2.18.8/examples/canvas/canvas-fifteen.ml0000644000175000017500000001035113460263323020600 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let piece_size = 50 let piece_color nb = let y = nb / 4 in let x = nb mod 4 in let r = (4 - x) * 255 / 4 in let g = (4 - y) * 255 / 4 in let b = 128 in Printf.sprintf "#%02x%02x%02x" r g b type config = { canvas : GnoCanvas.canvas ; board : (GnoCanvas.group * GnoCanvas.text) array ; pos : int array ; mutable hole : int ; } let move config num dpos = assert(List.mem dpos [ -1; 1; -4; 4]) ; let (it, _ ) = config.board.(num) in it#move ~x:(float (dpos mod 4 * piece_size)) ~y:(float (dpos / 4 * piece_size)) let item_event config num ev = begin match ev with | `ENTER_NOTIFY _ -> let (_, text) = config.board.(num) in text#set [ `FILL_COLOR "white" ] | `LEAVE_NOTIFY _ -> let (_, text) = config.board.(num) in text#set [ `FILL_COLOR "black" ] | `BUTTON_PRESS _ -> let pos = config.pos.(num) in if List.mem (config.hole - pos) [ -1; 1; 4; -4; ] then let dpos = config.hole - pos in config.hole <- config.hole - dpos ; config.pos.(num) <- config.pos.(num) + dpos ; move config num dpos ; config.canvas#update_now () | _ -> () end ; false let scramble_moves = 128 let array_find a v = let imax = Array.length a in let rec proc = function | i when i = imax -> raise Not_found | i when a.(i) = v -> i | i -> proc (succ i) in proc 0 let scramble config () = for i = 1 to scramble_moves do let new_pos = ref (-1) in let ok = ref false in while not !ok do let dpos = Array.get [| -1; 1; -4; 4|] (Random.int 4) in new_pos := config.hole + dpos ; if not ((config.hole mod 4 = 0 && dpos = -1) || (config.hole mod 4 = 3 && dpos = 1) || !new_pos < 0 || !new_pos > 15) then ok := true done ; let num = array_find config.pos !new_pos in move config num (config.hole - !new_pos) ; config.pos.(num) <- config.hole ; config.hole <- !new_pos ; config.canvas#update_now () done let create_canvas_fifteen window = let vbox = GPack.vbox ~border_width:4 ~packing:window#add () in let align = GBin.alignment ~packing:vbox#add () in let frame = GBin.frame ~shadow_type:`IN ~packing:align#add () in let dim = piece_size * 4 + 1 in let canvas = GnoCanvas.canvas ~width:dim ~height:dim ~packing:frame#add () in canvas#set_scroll_region 0. 0. (float dim) (float dim) ; let board = Array.init 15 (fun i -> let x = i mod 4 in let y = i / 4 in let tile = GnoCanvas.group ~x:(float (x * piece_size)) ~y:(float (y * piece_size)) canvas#root in GnoCanvas.rect tile ~props:[ `X1 0.; `Y1 0. ; `X2 (float piece_size) ; `Y2 (float piece_size) ; `FILL_COLOR (piece_color i) ; `OUTLINE_COLOR "black" ; `WIDTH_PIXELS 0 ] ; let text = GnoCanvas.text tile ~props:[ `TEXT (string_of_int (succ i)) ; `X (float piece_size /. 2.) ; `Y (float piece_size /. 2.) ; `FONT "Sans bold 24" ; `FILL_COLOR "black" ; `ANCHOR `CENTER ] in (tile, text)) in let config = { canvas = canvas ; board = board ; pos = Array.init 15 (fun i -> i) ; hole = 15 ; } in Array.iteri (fun i ((tile : GnoCanvas.group), _) -> tile#connect#event (item_event config i) ; ()) config.board ; let button = GButton.button ~label:"Scramble" ~packing:vbox#add () in button#connect#clicked (scramble config) let main_1 () = Random.self_init () ; let window = GWindow.window () in create_canvas_fifteen window ; window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-fifteen.ml" *) (* End: *) lablgtk-2.18.8/examples/canvas/flower.png0000644000175000017500000000555313460263323017371 0ustar stephsteph‰PNG  IHDR00Wł‡gAMA± üa "IDATxœķ˜ypTוĘ÷½×żŗ[Żj $$@bӊŁM‚ f@!Ž¼`¼€ćńą;qģĘY āĢŌ$±'öÄ &ŲĘ!Į8,Ą /Ų€ &Ā€V ©„V/źåu÷{ļĪ‚ŒćaĻTŖųŖī_÷Ō9ßw—sĪ½p —p —p Cšå€óB9ŹŃi0˜Ta`'°8|¾Ž•óupų_[łĮ?5ŪFh;<|pqŃ`ą) č"Ē?/LŽžŪ“mĖān+)›ŗŽÉę`›ü`ĻĪĄ«Š¢<Ąy.¢z!˜ž šĄŗ€5Š‡ } ‘H ( ¦ejnlŚŲp°¾H×õ}–e…Ī'ŠÅ@°·ŪJ†4‡ć§'OŚ–ōߚ3p˜¦Y*„<ē»ØÉ’ĖēĢĖæ4ńm ŗo —Ū‘L¢9TJ)ķŖŖ*(JAĒĶ›č½ämJ@.P $Š `ō±ėho~ųī4NJ—ŗ®cYGŠt*ÕpŪ¶}}MMĶMÓžœœBUS“–e‰`g—˜@8,?ļœL– >¬<‘HŲå•#7Öģ6 £ø;tŲ lj€@£¢(·F#Žx};?ŽAØ;ÄŌiĒusn$'7——–Æ0+.«9÷öŪŹ'O›Ś’Ź«¦ŠÓӃeYDB!„PŚRFjĶu3¾ÖčÜ<Dś;Ó³÷3`Wk¤óEUGDĀ‘C–e‘–-źźźŅuŸīuÆ]żš–2’ė÷ܬ»’;TæłŚļœÅŃXr’tŠņ=,]]ĖŠ?Õ2qŅ—XśĀ³ ((Ą²,,ĖĀéģŻ¬L&C$FAww·Ū…iZĖ¾\1z“¢Ķ4Ķ÷ĻEĄ<`{·•| xmŪ6,ÓĢI„RBUi¤R9¶”v{[[ģönÜXāūŽ‚ńąĻC „ĄnoĒŹh<¶Ŗ•«·²ö­ x²,Ėāš«ŖøvR?Y8 Ńoˆ>!¢]ˆīVv7˜¼T“ ¶!Āāū^Ÿ”a GH„ ¼>==Q¬ŒI85~łŲæT754M(©œ\Ūš}œiµ€—ļ™w§ł·ĪŪģģŚ”ˆĒ›ß ņ/|‰%^~t’åŸ'ŸNBw+·īęĖĆ“67beLŗ˜™ Š¦bY±XŒžhŒ¦††śÅž`sSCćąµĖʌłÜ‚ŸmžUUU½Ī²¬]üćųC‹™āŌõį@ĄĢ+§°õÉėqÉå¤hF$Ā$Ķ\¶’9BķgĒų¤”‹QUsÉ/@g ‹Ā…9rŻé¤ń@żĪĻæŠmYVšĒÆM«Zō›eĻŪ#JK„Āž ”³ „”ūż~Ķ–·ŽN?õ«_ē:zĖ˜ ćr‡Ļ®Z¾9IGÉöžļÕ·CO†a²§>HK[šOvp“#ŒĆWˆCw’J„pź:”®`Żož\ŗūżšmERŹ\ą#†x¢zć³xčČ%K–üÅõ9W@)„Šu}d&“™2lųš[žsŁ3®g—>=uĮMc©ŗĀ‰;ĖÕkgŪX‡÷ŃÓŅ–āH§ąż=tG v×w1ń+פƒmķt—ĖŽńŃĒ…ķĒŚņčM•„æ½ļī{¶.żÆ§mUU ūž8÷JŁ±3ńFõĘ („Ųér¹Ö$‰ōV}NEžl\< ŖŖļéåĻ¹æ5ļ¶|ĮīI)I&’ę»[¶h/.[ĪŽOö2 ¦ˆŖ* ņ†–RQQ¢Ø H2i·ĒÓįd[Ķ»ęęMožŽ2M°XLoKqJœ‰€ ąG—elØygT¶?{ņ—R’H$phSwéZ:ĘH&1M“p8LćĮz‰$ŃpÆ/‹ę¦f°Asjx½>lŪBU5ÄV¾ņĒµXÓ ä÷±SÅ=]Źž}ž]wY½aŻŗK/;1aŪ6BlŪ&sع…¶cĒ¤B<ńÆ?¢ź«_åp8\§ĶįĄķń0ØØMUpź.R)ƒü¼<Š†SPP€;ĖĆąā"Ü7ŃH˜±ćĒZ2|Čö÷>ų3½OŅ½@ālĢ,8°tż;oŽŸÉd!ŗi}u?)„ 1Ķ]Ą.·Ū]°ąÖ;ę«JJK·Ü~×·ĒÕķŻ[žĘėƒńX,¼pó ³wAop¢.œi%>jYÖ*€h8Āž}Ÿ”j*ŖŖ2¢“ÆĻ'EćčÆ:TĶįpFÉÉĶÅēĻ&Z„©¾Į  OZcƚ¦U_?ćš£æxü—²×üš¹3n%N(–RŠIS®‚OŽQŌ5Ö7°rł F+®™u-Y^/}ķĻJĄÉANƒµ.øwč“Ļ?3EQUU”3Hdūżž†żü€¦Ŗź3‰qüŅ~a;q±ž…^^³juY&“©U5p(Ģ”¦f¢*464åē巜‰#!„<1N5±āJF®ŠĒāhŖJ:•¶~’ņ+5™L¦ųķ;›7§O¼H.~TēåēWėŗ¾ 8,œ?{®’N§…”ņb.Ÿ?t]¦Ŗź×YMĖæ{Ž·•õkÖ*RJå|¾’ŖR )„čģĆ0ž¶Č÷Å !’ß<.į.į.žåÕ}BÜS˜IEND®B`‚lablgtk-2.18.8/examples/canvas/canvas-richtext.ml0000644000175000017500000000613413460263323021016 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let big_text = String.concat "" [ "English is so boring because everyone uses it.\n" ; "Here is something exciting: " ; "ŁˆŁ‚ŲÆ ŲØŲÆŲ£ Ų«Ł„Ų§Ų« Ł…Ł† Ų£ŁƒŲ«Ų± Ų§Ł„Ł…Ų¤Ų³Ų³Ų§ŲŖ ŲŖŁ‚ŲÆŁ…Ų§ ŁŁŠ Ų“ŲØŁƒŲ© Ų§ŁƒŲ³ŁŠŁˆŁ† ŲØŲ±Ų§Ł…Ų¬Ł‡Ų§ ŁƒŁ…Ł†ŲøŁ…Ų§ŲŖ Ł„Ų§ ŲŖŲ³Ų¹Ł‰ Ł„Ł„Ų±ŲØŲ­ŲŒ Ų«Ł… ŲŖŲ­ŁˆŁ„ŲŖ ŁŁŠ Ų§Ł„Ų³Ł†ŁˆŲ§ŲŖ Ų§Ł„Ų®Ł…Ų³ Ų§Ł„Ł…Ų§Ų¶ŁŠŲ© Ų„Ł„Ł‰ Ł…Ų¤Ų³Ų³Ų§ŲŖ Ł…Ų§Ł„ŁŠŲ© Ł…Ł†ŲøŁ…Ų©ŲŒ ŁˆŲØŲ§ŲŖŲŖ Ų¬Ų²Ų”Ų§ Ł…Ł† Ų§Ł„Ł†ŲøŲ§Ł… Ų§Ł„Ł…Ų§Ł„ŁŠ ŁŁŠ ŲØŁ„ŲÆŲ§Ł†Ł‡Ų§ŲŒ ŁˆŁ„ŁƒŁ†Ł‡Ų§ ŲŖŲŖŲ®ŲµŲµ ŁŁŠ Ų®ŲÆŁ…Ų© Ł‚Ų·Ų§Ų¹ Ų§Ł„Ł…Ų“Ų±ŁˆŲ¹Ų§ŲŖ Ų§Ł„ŲµŲŗŁŠŲ±Ų©. ŁˆŲ£Ų­ŲÆ Ų£ŁƒŲ«Ų± Ł‡Ų°Ł‡ Ų§Ł„Ł…Ų¤Ų³Ų³Ų§ŲŖ Ł†Ų¬Ų§Ų­Ų§ Ł‡Łˆ Ā»ŲØŲ§Ł†ŁƒŁˆŲ³ŁˆŁ„Ā« ŁŁŠ ŲØŁˆŁ„ŁŠŁŁŠŲ§.\n" ; "And here is some more plain, boring English." ; ] let setup_text root = let r = GnoCanvas.rect root ~props:[ `X1 (-90.) ; `Y1 (-50.) ; `X2 110. ; `Y2 50. ; `FILL_COLOR "green" ; `OUTLINE_COLOR "green" ] in GnoCanvas.rich_text root ~x:(-90.) ~y:(-50.) ~width:200. ~height:100. ~text:big_text ~props:[ `GROW_HEIGHT true ] ; GnoCanvas.ellipse root ~props:[ `X1 (-5.) ; `Y1 (-5.) ; `X2 5. ; `Y2 5. ; `FILL_COLOR "white" ] ; GnoCanvas.rect root ~props:[ `X1 100. ; `Y1 (-30.) ; `X2 200. ; `Y2 30. ; `FILL_COLOR "yellow" ; `OUTLINE_COLOR "yellow" ] ; GnoCanvas.rich_text root ~x:100. ~y:(-30.) ~width:100. ~height:60. ~text:"The quick brown fox jumped over the lazy dog.\n" ~props:[ `GROW_HEIGHT true ; `CURSOR_VISIBLE true ; `CURSOR_BLINK true ] ; GnoCanvas.rect root ~props:[ `X1 50. ; `Y1 70. ; `X2 150. ; `Y2 100. ; `FILL_COLOR "pink" ; `OUTLINE_COLOR "pink" ] ; GnoCanvas.rich_text root ~x:50. ~y:70. ~width:100. ~height:30. ~text:"This is a test.\nI enjoy tests a great deal\nThree lines!" ~props:[ `CURSOR_VISIBLE true ; `CURSOR_BLINK true ] ; () let create_canvas_rich_text window = let vbox = GPack.vbox ~spacing:4 ~border_width:4 ~packing:window#add () in let align = GBin.alignment ~packing:vbox#pack () in let frame = GBin.frame ~shadow_type:`IN ~packing:align#add () in let canvas = GnoCanvas.canvas ~width:600 ~height:450 ~packing:frame#add () in setup_text canvas#root let main_1 () = Random.self_init () ; let window = GWindow.window () in create_canvas_rich_text window ; window#connect#destroy ~callback:GMain.Main.quit ; window#show () ; GMain.Main.main () let _ = main_1 () (* Local Variables: *) (* coding: utf-8 *) (* compile-command: "ocamlopt -w s -i -I ../../src lablgtk.cmxa gtkInit.cmx lablgnomecanvas.cmxa canvas-richtext.ml" *) (* End: *) lablgtk-2.18.8/examples/panel/0000755000175000017500000000000013523300020015163 5ustar stephstephlablgtk-2.18.8/examples/panel/README0000644000175000017500000000343013460263323016061 0ustar stephsteph This short program shows how to write an applet for the GNOME2 panel. Applets are Bonobo components (the component system used in GNOME). However, pretty much all of this component stuff is wrapped by the panel-applet library. So, when programming the applet we deal with a regular GTK+ widget (a subclass of GtkEventBox). This PanelApplet widget has a few new signals so that the applet can be notified of changes in its environment (mainly size and orientation of the panel). The GConf-related functions are not wrapped for a lack of GConf/ocaml bindings. The .server file contains information for the activation server so that it can launch the applet executable. Make sure that : - the .server file is installed in a place the activation server can find : - $prefix/lib/bonobo/servers - some directory mentioned in $prefix/etc/bonobo-activation/bonobo-activation-config.xml - some directory in the BONOBO_ACTIVATION_PATH env variable. - the executable is at the place mentioned in the .server file - the activation server can fork a working caml program (so you may have difficulties with CAML_LD_LIBRARY_PATH ; it's probably easier to use an executable compiled with ocamlopt). If your applet use an external XML file for the UI, it must be installed in the right place ($prefix/share/gnome-2.0/ui should work). To test the applet, launch the executable in a terminal window, then right after that, add the applet to the panel using the panel menu. The panel should be using the executable you launched and you should see whatever messages your applet send to stdout/stderr. The gnome-panel package has a panel-test-applets executable that you can find useful for testing how your applet reacts to the signals sent by the panel (size, orientation, etc.). lablgtk-2.18.8/examples/panel/applet.ml0000644000175000017500000001100713460263323017017 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (** The XML UI description for the popup menu. Here it is a strig in the program, it could also be a .xml file in $prefix/share/gnome-2.0/ui *) let xml_descr = String.concat "\n" [ "" ; " " ; " " ; "" ; ] (** The callback executed when the appropriate entry in the pop menu is selected. *) let popup_callback vrb = prerr_endline ("popup callback with verb " ^ vrb) ; let d = GWindow.message_dialog ~message:"LablGTK:\nblahblahblah\npatatipatata" ~message_type:`INFO ~buttons:GWindow.Buttons.close ~title:"About LablGTK" ~show:true () in d#connect#response (function `CLOSE | `DELETE_EVENT -> d#destroy ()) ; () (** A (regular) callback activated on GtkButton::clicked *) let popup_dialog () = let d = GWindow.message_dialog ~message:"Yeah ! \\o/\nA GNOME panel applet writen in Caml !\nAin't it cool ?" ~message_type:`INFO ~buttons:GWindow.Buttons.close ~title:"applet in caml" ~show:true () in d#connect#response (function `CLOSE | `DELETE_EVENT -> d#destroy ()) ; () (** A trick so that a 3rd mouse button click on our button widget is ignored by the button and received by the applet widget. The latter will then display the popup menu. *) let do_not_eat_button_press ev = if GdkEvent.Button.button ev <> 1 then GtkSignal.stop_emit () ; false (** Some dumb callbacks to test things a bit. *) let background_info = function | `NO_BACKGROUND -> Format.eprintf "No background@." | `COLOR_BACKGROUND c -> Format.eprintf "Color backgound (%x, %x, %x)@." (Gdk.Color.red c) (Gdk.Color.blue c) (Gdk.Color.green c) | `PIXMAP_BACKGROUND p -> Format.eprintf "Pixmap background@." let size_info s = Format.eprintf "Size change: %d@." s let orient_info d = Format.eprintf "Orientation change: %s@." (match d with | `UP -> "up" | `DOWN -> "down" | `LEFT -> "left" | `RIGHT -> "right") (** Our main `factory' callback. We are given a Panel.applet object that we have to fill with widgets. *) let fill_applet (applet : Panel.applet) = applet#set_flags [ `HAS_HANDLE ; `EXPAND_MINOR ] ; let box = GPack.hbox ~packing:applet#add () in GMisc.image ~stock:(`STOCK "gnome-stock-about") ~packing:box#pack () ; let button = GButton.button ~label:"LablGTK Applet" ~relief:`NONE ~packing:box#pack () in button#event#connect#button_press ~callback:do_not_eat_button_press ; button#connect#clicked popup_dialog ; let tips = GData.tooltips () in tips#set_tip ~text:"A sample applet written in Objective Caml" applet#coerce ; (* connecting this signal induces bonobo leaks, don't know why. *) (* applet#connect#change_background background_info ; *) applet#connect#change_size size_info ; applet#connect#change_orient orient_info ; applet#setup_menu ~xml:xml_descr [ "Verb_LablGTK", popup_callback ; "Verb_background", (fun _ -> background_info applet#get_background) ] ; applet#misc#show () ; prerr_endline "filled applet" (** Just make sure the panel do not think we're somebody else and call our applet-filling function *) let factory applet ~iid = prerr_endline "factory called" ; if iid <> "OAFIID:LablGTK_TestApplet" then false else (try fill_applet applet ; true with _ -> false) (** The `main' of our executable is entirely handled by the library. A return value of [false] either indicate that the factory could not register itself with the activation server, or that the shutdown process detected some resources leaks. Either way, there's hardly anything to do about it. *) let _ = let res = Panel.factory_main ~iid:"OAFIID:LablGTK_TestApplet_Factory" factory in Printf.eprintf "applet registration/shutdown : %b\n" res lablgtk-2.18.8/examples/panel/lablgtk_applet.server0000644000175000017500000000211213460263323021412 0ustar stephsteph lablgtk-2.18.8/examples/tron.ml0000644000175000017500000001610513460263323015421 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* Tron? Game *) open GMain let m_pi = acos (-1.) let clRed = `NAME "red" (* `BLACK *) let clBlue = `NAME "blue" (* `WHITE *) let clBlack = `BLACK type point = {mutable x: int; mutable y: int} let main () = (* Game State *) let gameSize = 64 in let gameState = Array.make_matrix (gameSize+2) (gameSize+2) 0 in let gameInit _ = for i=1 to gameSize do for j=1 to gameSize do gameState.(i).(j) <- 0; done done; for i=0 to gameSize do gameState.(0).(i) <- 3; (* left wall *) gameState.(i).(gameSize+1) <- 3; (* floor *) gameState.(gameSize+1).(i+1) <- 3; (* right wall *) gameState.(i+1).(0) <- 3 (* ceiling *) done in gameInit (); let lpos = {x=4; y=4} in let lspeed = {x=0; y=1} in let rpos = {x=gameSize-3; y=gameSize-3} in let rspeed = {x=0; y= -1} in let keys = Bytes.of_string "asdfhjkl" in let keyMapL = [|(-1, 0); (0, -1); (0, 1); (1, 0)|] in let keyMapR = [|(-1, 0); (0, 1); (0, -1); (1, 0)|] in (* User Interface *) let window = GWindow.window ~border_width:10 ~title:"tron(?)" () in window#event#connect#delete ~callback:(fun _ -> prerr_endline "Delete event occured"; false); window#connect#destroy ~callback:Main.quit; let vbx = GPack.vbox ~packing:window#add () in let area = GMisc.drawing_area ~width:((gameSize+2)*4) ~height:((gameSize+2)*4) ~packing:vbx#add () in let drawing = area#misc#realize (); new GDraw.drawable (area#misc#window) in let style = area#misc#style#copy in style#set_bg [`NORMAL,`WHITE]; area#misc#set_style style; drawing#set_background `WHITE; let area_expose _ = for i=0 to gameSize+1 do for j=0 to gameSize+1 do if gameState.(i).(j) = 1 then begin drawing#set_foreground clRed; drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 () end else if gameState.(i).(j) = 2 then begin drawing#set_foreground clBlue; drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 () end else if gameState.(i).(j) = 3 then begin drawing#set_foreground clBlack; drawing#rectangle ~filled:true ~x:(i*4) ~y:(j*4) ~width:4 ~height:4 () end done done; false in area#event#connect#expose ~callback:area_expose; let control = GPack.table ~rows:3 ~columns:7 ~packing:vbx#pack () in let abuttonClicked num (lbl : GMisc.label) _ = begin let dialog = GWindow.window ~border_width:10 ~title:"Key remap" () in let dvbx = GPack.box `VERTICAL ~packing:dialog#add () in let entry = GEdit.entry ~max_length:1 ~packing: dvbx#add () in let txt = String.make 1 (Bytes.get keys num) in entry#set_text txt; let dquit = GButton.button ~label:"OK" ~packing: dvbx#add () in dquit#connect#clicked ~callback: begin fun _ -> let chr = entry#text.[0] in let txt2 = String.make 1 chr in lbl#set_text txt2; Bytes.set keys num chr; dialog#destroy () end; dialog#show () end in let attach = control#attach ~expand:`BOTH in let new_my_button ~label:label ~left:left ~top:top = let str = String.make 1 (Bytes.get keys label) in let btn = GButton.button ~packing:(attach ~left:left ~top:top) () in let lbl = GMisc.label ~text:str ~packing:(btn#add) () in btn#connect#clicked ~callback:(abuttonClicked label lbl); btn in new_my_button ~label:0 ~left:1 ~top:2; new_my_button ~label:1 ~left:2 ~top:1; new_my_button ~label:2 ~left:2 ~top:3; new_my_button ~label:3 ~left:3 ~top:2; new_my_button ~label:4 ~left:5 ~top:2; new_my_button ~label:5 ~left:6 ~top:3; new_my_button ~label:6 ~left:6 ~top:1; new_my_button ~label:7 ~left:7 ~top:2; let quit = GButton.button ~label:"Quit" ~packing:(attach ~left:4 ~top:2) () in quit#connect#clicked ~callback:window#destroy; let message = GMisc.label ~text:"tron(?) game" ~packing:vbx#pack () in let game_step () = let lx = lpos.x in let ly = lpos.y in gameState.(lx).(ly) <- 1; drawing#set_foreground clRed; drawing#rectangle ~filled:true ~x:(lx*4) ~y:(ly*4) ~width:4 ~height:4 (); let rx = rpos.x in let ry = rpos.y in gameState.(rx).(ry) <- 2; drawing#set_foreground clBlue; drawing#rectangle ~filled:true ~x:(rx*4) ~y:(ry*4) ~width:4 ~height:4 () in game_step (); let keyDown ev = begin let key = GdkEvent.Key.keyval ev in for i=0 to (Array.length keyMapL)-1 do let (x, y) = keyMapL.(i) in let k = Bytes.get keys i in if key = Char.code k then begin lspeed.x <- x; lspeed.y <- y end; let (x, y) = keyMapR.(i) in let k = Bytes.get keys (i+4) in if key = Char.code k then begin rspeed.x <- x; rspeed.y <- y end done; false end in window#event#connect#key_press ~callback:keyDown; let safe_check _ = if lpos.x == rpos.x && lpos.y == rpos.y then 3 else (* player 1 *) (if gameState.(lpos.x).(lpos.y) != 0 then 2 else 0) + (* player 2 *) (if gameState.(rpos.x).(rpos.y) != 0 then 1 else 0) in let timerID = ref (* dummy *) (Timeout.add ~ms:100 ~callback:(fun _ -> true)) in let timerTimer _ = begin lpos.x <- lpos.x+lspeed.x; lpos.y <- lpos.y+lspeed.y; rpos.x <- rpos.x+rspeed.x; rpos.y <- rpos.y+rspeed.y; let result = safe_check() in if result!=0 then begin Timeout.remove (!timerID); message#set_text ("player "^string_of_int result^" won.") end else begin game_step() end; true end in let count = ref 3 in let timerTimer2 _ = begin (* message#set_label (string_of_int (!count)); *) if (!count==0) then begin Timeout.remove (!timerID); timerID := Timeout.add ~ms:100 ~callback:timerTimer end else begin count := !count-1; end; true end in let restartClicked () = Timeout.remove !timerID; gameInit(); lpos.x <- 4; lpos.y <- 4; lspeed.x <- 0; lspeed.y <- 1; rpos.x <- gameSize-3; rpos.y <- gameSize-3; rspeed.x <- 0; rspeed.y <- -1; drawing#set_foreground `WHITE; drawing#rectangle ~filled:true ~x:0 ~y:0 ~width:((gameSize+2)*4) ~height:((gameSize+2)*4) (); area_expose(); count := 3; timerID := Timeout.add ~ms:300 ~callback:timerTimer2; in let restart = GButton.button ~label: "Restart" ~packing:(attach ~left:4 ~top:3) () in restart#connect#clicked ~callback:restartClicked; restartClicked (); window#show (); Main.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/dcalendar.ml0000644000175000017500000001635413460263323016362 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* A small calendar *) (* Needs Unix module, so use with lablgtk_t *) open StdLabels module Unix = UnixLabels open Printf type date = { mutable year: int; mutable mon: int; mutable mday: int } (* Load the schedule data *) let calendar_file = Filename.concat (Sys.getenv "HOME") ".camlendar" let schedule = try let ichan = open_in_bin calendar_file in let (s : (int * int * int, string) Hashtbl.t) = Marshal.from_channel ichan in close_in ichan; s with Sys_error msg -> prerr_endline msg; flush stderr; Hashtbl.create 13;; (* Saves the schedule data when the application terminates *) at_exit (fun () -> let ochan = open_out_bin calendar_file in Marshal.to_channel ochan schedule []; close_out ochan);; (* date: Current date initialized to "today" *) let date = let tm = Unix.localtime (Unix.time ()) in { year = 1900 + tm.Unix.tm_year; mon = tm.Unix.tm_mon; mday = 1 } (* previous_month, next_month: change application status *) let previous_month () = date.mday <- 1; if date.mon = 0 then (date.year <- date.year - 1; date.mon <- 11) else date.mon <- date.mon - 1 let next_month () = date.mday <- 1; if date.mon = 11 then (date.year <- date.year + 1; date.mon <- 0) else date.mon <- date.mon + 1 (* leap, mon_name, wday_name: Calendar related function and data *) let leap year = (year mod 400 = 0) or (year mod 4 = 0) & (year mod 100 <> 0) let mdays_in_month = [|31; 28; 31; 30; 31; 30; 31; 31; 30; 31; 30; 31|] let mon_name = [|"Jan"; "Feb"; "Mar"; "Apr"; "May"; "Jun"; "Jul"; "Aug"; "Sep"; "Oct"; "Nov"; "Dec"|] let wday_name = [|"Sun"; "Mon"; "Tue"; "Wed"; "Thu"; "Fri"; "Sat"|] let s_normal = 0 and s_focused = 1 and s_planned = 2 let styles = let default = (Obj.magic () : GObj.style) in [| default; default; default |] (* class date_button: one button for each day in the month *) class date_button i (calendar : GPack.table) = let mday = i + 1 in object (self) val widget = GButton.button ~label: (string_of_int mday) ~show: false () val mday = mday val mutable show = false val mutable have_plan = false method widget = widget method focus_on = date.mday <- mday; widget#misc#set_style styles.(s_focused) method focus_off = widget#misc#set_style styles.(if have_plan then s_planned else s_normal) method set_plan = have_plan <- true; widget#misc#set_style styles.(s_planned) method unset_plan = have_plan <- false; widget#misc#set_style styles.(s_normal) method show wday0 = if not show then let top = (mday + wday0) / 7 + 1 and left = (mday + wday0) mod 7 in calendar#attach ~left ~top ~expand:`BOTH widget#coerce; widget#misc#show (); show <- true method hide = if show then (widget#misc#hide (); calendar#remove widget#coerce; show <- false) end let update_calendar (calendar : GPack.table) (buttons : date_button array) = let now = Unix.localtime (Unix.gettimeofday ()) in let _, first = Unix.mktime { now with Unix.tm_mday = 1; Unix.tm_mon = date.mon; Unix.tm_year = date.year - 1900 } in (* wday0: day of the week of the zero'th day in the month *) let wday0 = (first.Unix.tm_wday - 1 + 7) mod 7 in let ndays = if date.mon = 1 & leap date.year then mdays_in_month.(date.mon) + 1 else mdays_in_month.(date.mon) in Array.iter ~f: (fun button -> button#hide) buttons; for i = 0 to ndays - 1 do buttons.(i)#show wday0 done let create_GUI () = (* views part *) let win = GWindow.window ~title: "Camlendar" ~show: true ~allow_shrink: false ~allow_grow: false () in win#event#connect#delete ~callback: (fun _ -> GMain.Main.quit (); false); let style = win#misc#style#copy in styles.(s_normal) <- style; let style = style#copy in style#set_bg [`NORMAL, `NAME "light green"; `PRELIGHT, `NAME "light green"]; styles.(s_focused) <- style; styles.(s_focused) <- style; let style = style#copy in style#set_bg [`NORMAL, `NAME "sky blue"; `PRELIGHT, `NAME "sky blue"]; styles.(s_planned) <- style; let vbox = GPack.vbox ~packing: win#add () in let packing = vbox#add in let toolbar = GButton.toolbar ~style: `TEXT ~packing () in let prev = toolbar#insert_button ~text: "Prev" ~tooltip: "Show previous month" () in let next = toolbar#insert_button ~text: "Next" ~tooltip: "Show next month" () in let calendar = GPack.table ~homogeneous: true ~rows: 7 ~columns: 7 ~border_width: 10 ~row_spacings: 2 ~col_spacings: 2 ~packing () in Array.iteri ~f: (fun i wday -> ignore (GButton.button ~label: wday ~packing:(calendar#attach ~top: 0 ~left: i ~expand:`BOTH) ())) wday_name; let buttons = Array.init 31 ~f: (fun i -> new date_button i calendar) in let date_view = GMisc.label ~justify: `CENTER ~packing () in let text = GText.view ~editable:true ~width:70 ~height:50 ~packing () in (* Controls part *) let save_text () = let data = text#buffer#get_text () in let key = (date.year, date.mon, date.mday) in Hashtbl.remove schedule key; if data <> "" then (Hashtbl.add schedule key data; buttons.(date.mday - 1)#set_plan) else buttons.(date.mday - 1)#unset_plan in let restore_text () = try text#buffer#set_text (Hashtbl.find schedule (date.year, date.mon, date.mday)); () with Not_found -> let start,stop = text#buffer#bounds in text#buffer#delete ~start ~stop in let update_date_view () = date_view#set_text (sprintf "%d %s, %d\n" date.mday mon_name.(date.mon) date.year) in let update_view () = update_calendar calendar buttons; update_date_view (); Array.iteri ~f: (fun i button -> (try Hashtbl.find schedule (date.year, date.mon, i + 1); button#set_plan with Not_found -> button#unset_plan); button#focus_off) buttons; win#set_title (sprintf "Camlendar: %s, %d" mon_name.(date.mon) date.year) in prev#connect#clicked ~callback: (fun () -> save_text (); previous_month (); update_view (); restore_text (); buttons.(0)#focus_on); next#connect#clicked ~callback: (fun () -> save_text (); next_month (); update_view (); restore_text (); buttons.(0)#focus_on); Array.iteri ~f: (fun i button -> button#widget#connect#clicked ~callback: (fun () -> save_text (); buttons.(date.mday - 1)#focus_off; button#focus_on; restore_text (); update_date_view ()); ()) buttons; update_view (); buttons.(0)#focus_on;; GMain.Main.init (); print_endline (Glib.Main.setlocale `ALL None); flush stdout; create_GUI (); GMain.Main.main () lablgtk-2.18.8/examples/tree.ml0000644000175000017500000000623613460263323015402 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels open Gobject.Data let cols = new GTree.column_list let title = cols#add string let author = cols#add string let checked = cols#add boolean let create_model () = let store = GTree.tree_store cols in let row = store#append () in store#set ~row ~column:title "The Art of Computer Programming"; store#set ~row ~column:author "Donald E. Knuth"; store#set ~row ~column:checked false; store#set ~row:(store#append ~parent:row ()) ~column:title "Volume 1: Fundamental Algorithms"; store#set ~row:(store#append ~parent:row ()) ~column:title "Volume 2: Seminumerical Algorithms"; store#set ~row:(store#append ~parent:row ()) ~column:title "Volume 3: Sorting and Searching Algorithms"; store let main () = let model = create_model () in let window = GWindow.window () in window#connect#destroy ~callback:GMain.quit; let view = GTree.view ~model ~packing:window#add () in let col = GTree.view_column ~title:"Title" () ~renderer:(GTree.cell_renderer_text[], ["text",title]) in view#append_column col; let col = GTree.view_column ~title:"Author" () ~renderer:(GTree.cell_renderer_text[], ["text",author]) in view#append_column col; let col = GTree.view_column ~title:"Checked-out" () ~renderer:(GTree.cell_renderer_text[], ["text",checked]) in view#append_column col; view#selection#connect#after#changed ~callback: begin fun () -> prerr_endline "selection changed"; List.iter view#selection#get_selected_rows ~f: (fun p -> prerr_endline (GtkTree.TreePath.to_string p)); end; view#connect#after#row_activated ~callback: (fun path vcol -> prerr_endline "Row activated"; let it = model#get_iter path in assert (model#iter_is_valid it); model#clear (); ); (* Seems to be inverted *) let allow_expand = ref true in view#connect#test_expand_row ~callback: (fun _ _ -> if !allow_expand then (Format.printf "Expansion allowed@."; allow_expand := false; true) else (Format.printf "Expansion NOT allowed@."; allow_expand := true; false)); let allow_collapse = ref true in view#connect#test_collapse_row ~callback: (fun _ _ -> if !allow_collapse then (Format.printf "Collapse allowed@."; allow_collapse := false; true) else (Format.printf "Collapse NOT allowed@."; allow_collapse := true; false)); window#show (); GMain.main () let () = main () lablgtk-2.18.8/examples/socket.ml0000644000175000017500000000173513460263323015732 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open GMain let main () = let w = GWindow.window ~title:"Socket example" () in w#connect#destroy ~callback:Main.quit; let vbox = GPack.vbox ~packing:w#add () in let label = GMisc.label ~packing:vbox#pack () in w#show (); let socket = GWindow.socket ~packing:vbox#add ~height:40 () in label#set_text ("XID to plug into this socket: 0x" ^ Int32.format "%x" socket#xwindow); Main.main () let _ = main () lablgtk-2.18.8/examples/runthread.ml0000644000175000017500000000207713460263323016436 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) let start = GButton.button ~label:"Start" ~packing:vbox#pack () let stop = GButton.button ~label:"Stop" ~packing:vbox#pack () let text = GEdit.entry ~packing:vbox#pack () let cont = ref true let n = ref 0 let body () = prerr_endline "started"; while !cont do incr n; async text#set_text (string_of_int !n); Thread.delay 1. done let () = start#connect#clicked (fun () -> cont:= true; ignore (Thread.create body ())); stop#connect#clicked (fun () -> cont := false); w#connect#destroy GMain.quit; w#show (); main () lablgtk-2.18.8/examples/dialog-thread.ml0000644000175000017500000000251613460263323017144 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* lablgtk2 -thread -nothinit dialog-thread.ml *) let window = GWindow.window ~border_width: 10 () let button = GButton.button ~label:"Open Dialog" ~packing: window#add () let mythread = Thread.create (fun () -> while true do Thread.delay 2.0; prerr_endline "running." done) () let main () = Glib.Timeout.add ~ms:100 ~callback:GtkThread.do_jobs; window#connect#destroy ~callback:GMain.quit; button#connect#clicked ~callback:(fun () -> let dialog = GWindow.message_dialog ~title:"Quit ?" ~message_type:`QUESTION ~message:"Quit the application ?" ~buttons:GWindow.Buttons.yes_no () in match dialog#run () with `YES -> GMain.quit () | `NO | `DELETE_EVENT -> dialog#destroy ()); window#show (); GtkThread.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/seppala.ml0000644000175000017500000000161013460263323016057 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) main_window#add_accel_group accel_group; let quit_button = GButton.button ~label:"Quit" ~packing:main_window#add () in quit_button#misc#add_accelerator ~sgn:GtkButtonProps.Button.S.activate ~group:accel_group ~modi:[`CONTROL] GdkKeysyms._q; ignore (quit_button#connect#clicked ~callback:destroy); main_window#show (); GMain.main () let () = main () lablgtk-2.18.8/examples/tooltip.ml0000644000175000017500000001035413460263323016131 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* This file demonstrates how one can use the tooltip API * introduced with GTK+ 2.12. * Do: * ocamlc -c -I ../src tooltip.ml * ocamlc -o tooltip.tpo -g -I . -I ../src lablgtk.cma tooltip.cmo * ./main.tpo * *) class contact ~(name: string) () = object (self) method name = name end class account ~(name: string) ~(contacts: contact list) () = object (self) method name = name method contacts = contacts end let model () = let cols = new GTree.column_list in let column = cols#add Gobject.Data.caml in let model = GTree.tree_store cols in List.iter begin fun account -> let row = model#append () in model#set ~row ~column (`Account account); List.iter begin fun contact -> let row = model#append ~parent: row () in model#set ~row ~column (`Contact contact) end account#contacts end [ new account () ~name: "Fernand Naudin" ~contacts: [ new contact () ~name: "MaĆ®tre Folace" ; new contact () ~name: "Jean" ] ; new account () ~name: "Raoul Volfoni" ~contacts: [ new contact () ~name: "Paul Volfoni" ] ]; (model, column) let window () = let (model, column) = model () in let window = GWindow.window () ~title: "TreeView" in let vbox = GPack.vbox () ~border_width: 0 ~spacing: 8 ~packing: window#add in let button = GButton.button () ~label: "Tontons flingueurs" ~packing: vbox#add in button#misc#set_tooltip_text "I am a tooltip text"; let sw = GBin.scrolled_window () ~shadow_type: `ETCHED_IN ~hpolicy: `NEVER ~vpolicy: `AUTOMATIC ~packing: vbox#add in let _ = window#connect#destroy ~callback: GMain.quit in let treeview = GTree.view () ~model ~packing: sw#add in let col = GTree.view_column () ~title: "Put the mouse over here too" in let renderer_name = GTree.cell_renderer_text [] in col#set_sizing `FIXED; col#set_fixed_width 50; col#pack renderer_name; col#set_cell_data_func renderer_name begin fun model row -> match model#get ~row ~column with | `Account account -> let text = account#name in renderer_name#set_properties [ `TEXT text ; `WEIGHT `BOLD ] | `Contact contact -> renderer_name#set_properties [ `TEXT contact#name ; `WEIGHT `NORMAL ] end; ignore (treeview#append_column col); let view_col = treeview#get_column 0 in let button = new GButton.button (GtkTree.TreeViewColumn.get_button view_col#as_column) in button#misc#set_tooltip_text "I am a tooltip on the button of a column header"; treeview#misc#set_has_tooltip true; ignore (treeview#misc#connect#query_tooltip ~callback: begin fun ~x ~y ~kbd tooltip -> match GtkTree.TreeView.Tooltip.get_context treeview#as_tree_view ~x ~y ~kbd with | (x, y, Some (model, path, row)) -> let get ~model ~row ~column = let v = Gobject.Value.create_empty () in GtkTree.TreeModel.get_value model v ~row ~column: column.GTree.index; Gobject.Data.of_value column.GTree.conv v in let path_string = GtkTree.TreePath.to_string path in let name = (* XXX: be careful to do a match on the good thing: no static type checking *) match get ~model ~row ~column with | `Account o -> o#name | `Contact o -> o#name in let str = "path=" ^ path_string ^ " name=" ^ name ^ "" in GtkBase.Tooltip.set_markup tooltip str; GtkTree.TreeView.Tooltip.set_row treeview#as_tree_view tooltip path; true | _ -> false end); let _ = treeview#selection#connect#changed ~callback: begin fun () -> GtkBase.Widget.Tooltip.trigger_query treeview#as_tree_view end in window#set_default_size ~width: 162 ~height: 242; window#show (); window#move ~x: 10 ~y: 10 let locale = GtkMain.Main.init () let main () = window (); GMain.main () ;; main () lablgtk-2.18.8/examples/slide_show.ml0000644000175000017500000000437313460263323016603 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* let get_pixbuf ~file = try GdkPixbuf.from_file file with GdkPixbuf.GdkPixbufError(_,msg) as exn -> let d = GWindow.message_dialog ~message:msg ~message_type:`ERROR ~buttons:GWindow.Buttons.close ~show:true () in d#run (); raise exn *) class directory ~path = object (self) val d = Unix.opendir path method read = path ^"/"^ Unix.readdir d method rewind = Unix.rewinddir d method close = Unix.closedir d method read_file = let f = self#read in if (Unix.stat f).Unix.st_kind = Unix.S_REG then f else self#read_file method next_file = try self#read_file with End_of_file -> self#rewind; self#read_file method read_pix = let f = self#read_file in try GdkPixbuf.from_file f with GdkPixbuf.GdkPixbufError _ -> self#read_pix end let () = let w = GWindow.window () in let da = GMisc.drawing_area ~packing:w#add () in da#misc#realize (); let dw = new GDraw.drawable da#misc#window in let dir = new directory "." in let pm = ref None in let set_pm pxm = Gaux.may (fun pm -> Gdk.Pixmap.destroy pm) !pm; pm := Some pxm; dw#put_pixmap ~x:0 ~y:0 pxm in let set_pix pix = let pxm, _ = GdkPixbuf.create_pixmap pix and width = GdkPixbuf.get_width pix and height = GdkPixbuf.get_height pix in w#set_default_size ~width ~height; set_pm pxm in let pix = dir#read_pix in set_pix pix; da#event#connect#expose ~callback: (fun _ -> Gaux.may (dw#put_pixmap ~x:0 ~y:0) !pm; true); GMain.Timeout.add ~ms:2000 ~callback: (fun () -> try let pix = try dir#read_pix with End_of_file -> dir#rewind; dir#read_pix in set_pix pix; true with _ -> false); w#connect#destroy GMain.quit; w#show (); GMain.main () lablgtk-2.18.8/examples/cgets.ml0000644000175000017500000000351313460263323015543 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) open Printf open GMain let pr_targets targets = printf "%d targets\n" (List.length targets); let pr atom = printf "%s\n" (Gdk.Atom.name atom) in List.iter pr targets; flush stdout let get_contents targets = let rec loop ls = match ls with | [] -> [] | atom::xs -> try let content = (atom, clipboard#get_contents ~target:atom) in content :: loop xs with _ -> loop xs in loop targets let pr_contents cnt_list = let pr (atom, sdata) = printf "-----\n"; printf " target [%s]\n" sdata#target; printf " typ [%s]\n" sdata#typ; printf " format [%d]\n" sdata#format; begin try printf " data length (%d) [%s]\n" (String.length sdata#data) sdata#data; with _ -> printf " data (NULL)\n" end; flush stdout; in List.iter pr cnt_list let get_targets () = let targets = clipboard#targets in pr_targets targets; let contents = get_contents targets in pr_contents contents; () let main () = (* Create the toplevel window *) let window = GWindow.window ~title:"Clipboard" ~border_width:10 () in window#connect#destroy ~callback:GMain.quit; let btn = GButton.button ~label:"Get Targets" ~packing:window#add () in btn#connect#clicked ~callback:get_targets; window#show (); GMain.main () let _ = Printexc.print main () lablgtk-2.18.8/examples/timer.ml0000644000175000017500000001331113460263323015553 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) open StdLabels let check_cache ~cond ~create ~destroy = function Some pm -> if cond pm then pm else begin destroy pm; create () end | None -> create () class timer ?packing ?show () = let da = GMisc.drawing_area ~width:200 ~height:200 ?packing ?show () in let context = da#misc#create_pango_context in object (self) inherit GObj.widget_full da#as_widget val mutable talk = 25 * 60 val mutable buffer = 5 * 60 val mutable questions = 5 * 60 val mutable start = 0. val mutable stop = 0. val mutable timer = None val mutable size = 0, 0 val mutable pixmap = None method set_talk x = talk <- x * 60 method set_buffer x = buffer <- x * 60 method set_questions x = questions <- x * 60 method private to_angle t = let total = float (talk + buffer + questions) in float t /. total *. 360. method draw = let current = if start = 0. then 0 else truncate (Unix.time () -. start) in let {Gtk.x=x0; y=y0; width=width; height=height} = da#misc#allocation in let size = (min width height) * 49 / 50 in let x = (width - size) / 2 and y = (height - size) / 2 in let dr = check_cache pixmap ~cond:(fun pm -> pm#size = (width, height)) ~destroy:(fun pm -> Gdk.Pixmap.destroy pm#pixmap) ~create: (fun () -> context#set_font_by_name ("sans " ^ string_of_int (size*2/13)); GDraw.pixmap ~width ~height ~window:da ()) in pixmap <- Some dr; dr#set_foreground `WHITE; dr#rectangle ~x:0 ~y:0 ~width ~height ~filled:true (); let draw_arc ~color ~start ~stop = dr#set_foreground (`NAME color); dr#arc ~x ~y ~width:size ~height:size ~filled:true ~start:(450. -. self#to_angle stop) ~angle:(self#to_angle (stop - start) +. 1.) () in draw_arc ~color:"blue" ~start:(-60) ~stop:(min current (talk+buffer+questions)); if current < talk then draw_arc ~color:"green" ~start:current ~stop:talk; if current < talk + buffer then draw_arc ~color:"yellow" ~start:(max talk current) ~stop:(talk+buffer); if current < talk + buffer + questions then draw_arc ~color:"red" ~start:(max (talk+buffer) current) ~stop:(talk+buffer+questions); dr#set_foreground `WHITE; let size' = size * 3 / 5 in dr#arc ~x:((width - size') / 2) ~y:((height - size') / 2) ~width:size' ~height:size' ~filled:true (); let layout = context#create_layout in Pango.Layout.set_text layout (Printf.sprintf "%02d:%02d" (current/60) (current mod 60)); let (w,h) = Pango.Layout.get_pixel_size layout in dr#put_layout ~x:((width-w)/2) ~y:((height-h)/2) ~fore:`BLACK layout; (new GDraw.drawable da#misc#window)#put_pixmap ~x:0 ~y:0 dr#pixmap method start = self#stop; if start = 0. then start <- Unix.time () else start <- start +. Unix.time () -. stop; stop <- 0.; timer <- Some(GMain.Timeout.add ~ms:1000 ~callback:(fun () -> self#draw; true)); self#draw method stop = if stop = 0. then stop <- Unix.time (); match timer with None -> () | Some id -> GMain.Timeout.remove id; timer <- None method reset = self#stop; start <- 0.; stop <- 0.; self#draw initializer da#event#connect#expose ~callback:(fun _ -> self#draw; true); () end let () = let w = GWindow.window () in w#connect#destroy ~callback:GMain.quit; let hbox = GPack.hbox ~packing:w#add () in let fr = GBin.frame ~border_width:3 ~shadow_type:`IN ~packing:hbox#add () in let timer = new timer ~packing:fr#add () in let vbox = GPack.vbox ~border_width:3 ~spacing:4 ~packing:hbox#pack () in let make_spin ~label ~value ~callback = GMisc.label ~text:label ~xalign:0. ~packing:vbox#pack (); let x = GEdit.spin_button ~digits:0 ~packing:vbox#pack () in x#adjustment#set_bounds ~lower:0. ~upper:999. ~step_incr:1. (); x#adjustment#set_value (float value); x#connect#value_changed ~callback: (fun () -> callback x#value_as_int; timer#draw); x in let talk = make_spin ~label:"Talk" ~value:25 ~callback:timer#set_talk and buffer = make_spin ~label:"Buffer" ~value:5 ~callback:timer#set_buffer and questions = make_spin ~label:"Questions" ~value:5 ~callback:timer#set_questions in let total = make_spin ~label:"Total" ~value:35 ~callback: (fun v -> talk#set_value (float (v - buffer#value_as_int - questions#value_as_int))) in let set_total () = total#set_value (talk#value +. buffer#value +. questions#value) in List.iter [talk;buffer;questions] ~f: (fun (x:GEdit.spin_button) -> ignore(x#connect#value_changed ~callback:set_total)); let start = GButton.button ~label:"Start" ~packing:vbox#pack () in let stop = GButton.button ~label:"Stop" ~packing:vbox#pack () in let reset = GButton.button ~label:"Reset" ~packing:vbox#pack () in start#connect#clicked ~callback:(fun () -> timer#start); stop#connect#clicked ~callback:(fun () -> timer#stop); reset#connect#clicked ~callback:(fun () -> timer#reset); w#show (); GMain.main () lablgtk-2.18.8/examples/calc.ml0000644000175000017500000000656113460263323015346 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) (* A simple calculator ported from LablTk to LablGtk *) let mem_string ~char s = try for i = 0 to String.length s -1 do if s.[i] = char then raise Exit done; false with Exit -> true let ops = ['+',(+.); '-',(-.); '*',( *.); '/',(/.)] (* The abstract calculator class. Does not use Gtk *) class virtual calc = object (calc) val mutable x = 0.0 val mutable op = None val mutable displaying = true method virtual set : string -> unit method virtual get : string method virtual quit : unit -> unit method insert s = calc#set (calc#get ^ s) method get_float = float_of_string (calc#get) initializer calc#set "0" method command s = if s <> "" then match s.[0] with '0'..'9' -> if displaying then (calc#set ""; displaying <- false); calc#insert s | '.' -> if displaying then (calc#set "0."; displaying <- false) else if not (mem_string ~char:'.' calc#get) then calc#insert s | '+'|'-'|'*'|'/' as c -> displaying <- true; begin match op with None -> x <- calc#get_float; op <- Some (List.assoc c ops) | Some f -> x <- f x (calc#get_float); op <- Some (List.assoc c ops); calc#set (string_of_float x) end | '='|'\n'|'\r' -> displaying <- true; begin match op with None -> () | Some f -> x <- f x (calc#get_float); op <- None; calc#set (string_of_float x) end | 'q' -> calc#quit () | _ -> () end (* Buttons for the calculator *) let m = [|[|"7";"8";"9";"+"|]; [|"4";"5";"6";"-"|]; [|"1";"2";"3";"*"|]; [|"0";".";"=";"/"|]|] (* The physical calculator. Inherits from the abstract one *) open GMain class calculator ?packing ?show () = let table = GPack.table ~rows:5 ~columns:4 ~homogeneous:true ~show:false () in object (calc) inherit calc val label = let frame = GBin.frame ~shadow_type:`IN () ~packing:(table#attach ~left:0 ~top:0 ~right:4 ~expand:`BOTH) in let evbox = GBin.event_box ~packing:frame#add () in evbox#misc#set_style evbox#misc#style#copy; evbox#misc#style#set_bg [`NORMAL,`WHITE]; GMisc.label ~justify:`RIGHT ~xalign:0.95 ~packing:evbox#add () val table = table method set = label#set_text method get = label#text method quit = Main.quit initializer for i = 0 to 3 do for j = 0 to 3 do let button = GButton.button ~label:(" " ^ m.(i).(j) ^ " ") ~packing:(table#attach ~top:(i+1) ~left:j ~expand:`BOTH) () in button#connect#clicked ~callback:(fun () -> calc#command m.(i).(j)); done done; ignore (GObj.pack_return table ~packing ~show) end (* Finally start everything *) let w = GWindow.window () let applet = new calculator ~packing: w#add () let _ = w#connect#destroy ~callback: Main.quit; w#event#connect#key_press ~callback:(fun ev -> applet#command (GdkEvent.Key.string ev); true); w#show (); Main.main () lablgtk-2.18.8/examples/curve.ml0000644000175000017500000000110513460263323015555 0ustar stephsteph(* $Id$ *) let w = GWindow.window ~width:200 ~height:150 ();; let curve = GMisc.curve ~min_y:0. ~max_y:10. ~packing:w#add ();; let show_vector _ = let vect = curve#get_vector 5 in Printf.printf "%g %g %g %g %g\n%!" vect.(0) vect.(1) vect.(2) vect.(3) vect.(4) let () = curve#set_vector [|0.; 5.; 4.; 6.; 9.|]; (* curve#reset (); *) (* works *) (* curve#set_curve_type `SPLINE; *) (* doesn't work with quartz... *) show_vector (); curve#event#connect#after_any ~callback:show_vector; w#connect#destroy ~callback:GMain.quit; w#show (); GMain.main () lablgtk-2.18.8/examples/counter.ml0000644000175000017500000000310713460263323016114 0ustar stephsteph(**************************************************************************) (* Lablgtk - Examples *) (* *) (* This code is in the public domain. *) (* You may freely copy parts of it in your application. *) (* *) (**************************************************************************) (* $Id$ *) let w = GWindow.window () let vb = GPack.vbox ~packing:w#add () let lbl = GMisc.label ~packing:vb#pack () let hb = GPack.hbox ~packing:vb#pack () let decB = GButton.button ~label:"Dec" ~packing:hb#add () let incB = GButton.button ~label:"Inc" ~packing:hb#add () let adj = GData.adjustment ~lower:0. ~upper:100. ~step_incr:1. ~page_incr:10. () let sc = GRange.scale `HORIZONTAL ~adjustment:adj ~draw_value:false ~update_policy:`DISCONTINUOUS ~packing:vb#pack () let counter = new GUtil.variable 0 open GMain let _ = decB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get-1))); incB#connect#clicked ~callback:(fun () -> adj#set_value (float(counter#get+1))); sc#connect#change_value ~callback:(fun _ v -> Printf.printf "drag: %i\n%!" (truncate v)); adj#connect#value_changed ~callback:(fun () -> counter#set (truncate adj#value)); counter#connect#changed ~callback:(fun n -> lbl#set_text (string_of_int n)); counter#set 0; w#connect#destroy ~callback:Main.quit; w#show (); Main.main () lablgtk-2.18.8/README.win320000755000175000017500000001272513460263323014117 0ustar stephsteph Here is a small howto about installing LablGtk2 on Win32 Binary installation The binary distribution includes the lablglade, lablrsvg, and lablgnomecanvas libraries. 0) Both MSVC and mingw versions of ocaml 3.11 should work. If you want to do custom linking (either ocamlc -custom, or ocamlopt), get a recent version of flexdll. Standard ocamlc linking only requires dlls. 1) Install the gtk2 libraries and dependencies. This binary distribution was built using the "bundle" package at ftp://ftp.gnome.org/pub/gnome/binaries/win32/gtk+/2.24/ (mirrors list at: ftp://ftp.gnome.org/pub/gnome/MIRRORS) Just follow the instructions in the README file inside the package. If you want to use the extension libraries (currently lablglade, lablrsvg and lablgnomecanvas are supported), you must also install the (numerous) dependencies. Here is what was used during compilation: libglade-2.6.4 (requires libxml2) libgnomecanvas-2.30.1 (requires libart_lgpl) librsvg-2.32.1 (requires libcroco and libgsf) gtksourceview-2.10 If you want to do custom linking, you need also the dev packages. All of these are available in the above win32 and win32/dependencies directories. The distribution was compiled using the gtk+ bundle of 20120208, but other versions should work too. After unzipping all those archives in a common location (e.g. c:\Gtk), it may be a good idea to go to c:\Gtk\bin and run chmod +x *.dll as some of the exta DLL's do not have the execution flag set. Also, do not forget to add this binary directory to your path. Open Control Panel/User account/Environment variables, and edit either the personal or system variable Path to add c:\Gtk\bin. If you cannot modify system variables directly, you can override them by adding a fresh variable to your own environment: Variable name: Path Value: c:\Gtk\bin;%Path% 2) Install lablgtk2 binaries and scripts inside the OCaml distribution bin/* -> bin lib/site-lib/lablgtk2 -> lib/site-lib/lablgtk2 Then edit lib/ld.conf, and add the line \lib\site-lib\lablgtk2 3) If your distribution is newer than 4.00.0, go to the lib/site-lib/lablgtk2 directory and execute ocaml build.ml You must also do that everytime you update your OCaml distribution. This will recompile the ocaml part of the library (the C part is already compiled.) It may fail on the native code version (using ocamlopt) if the assembler is not on your path. Look in the Objective Caml windows documentation for what is needed, and check that you have a working installation by compiling and linking a trivial program. Note also that the autodection for mingw is not fool-proof (lablgtk2 has to be installed at the expected location), so if the OCaml port annouced by build.ml is not the right one, you should specify it by hand inside build.ml. 4) Test in examples lablgtk2 testgtk.ml See also the "Windows port" section of the main LablGtk2 README for important remarks on threads on Windows. 5) For custom linking or native code, you need to use the export libraries in the above DLL package. There is not default place to put them, so you should specify that at link time: ocamlopt -ccopt "-LC:/gtk/lib" -I +lablgtk2 lablgtk.cmxa \ gtkInit.cmx testgtk.ml -o testgtk.exe Again, if this fails you must make sure that your ocamlopt really works, and that all paths are correctly specified. Full compilation with MSVC or mingw (for the brave) 0) You will need the MSVC or mingw version of ocaml 3.11 or more, and cygwin development tools. You must also install flexdll (at least 0.7) from http://alain.frisch.fr/flexdll.html (Flexdll is already included in the OCaml 4.00.0 installer) 1) Install Gtk 2: use the precompiled binaries available at ftp://ftp.gnome.org/pub/gnome/binaries/win32/gtk+/ This time you need the developper version. Do NOT even try to compile it yourself from scratch. Try to compile a small hello-gtk.c (see the tutorial page on http://www.gtk.org) before going further. You may unzip optional libraries available from http://ftp.gnome.org/pub/gnome/binaries/win32 in c:\GTK. For example to have GtkSourceView 1 support, you have to unzip : libgnomeprint-dev.xxx.zip libgnomeprint.xxx.zip libart_gpl-dev.xxx.zip libart_gpl-dev.xxx.zip libxml2-dev.xxx.zip libxml2.xxx.zip win_iconv_dll-tml-xxx.zip gtksourceview-dev.1.xxx.zip gtksourceview.1.xxx.zip If you need to check that all dependencies are installed, use pkg-config --libs gtksourceview-1.0 and see if an error is reported. 3) For MSVC, copy config.make.msvc to config.make, and edit it to set GTKROOT. On Mingw you should be able to run the configure script: ./configure --disable-gtktest If you do want to perform configuration time Gtk C tests the define CYGWIN=nobinmode before running ./configure. The rationale behind CYGWIN=nobinmode is that pkg-config is a native windows program which outputs \r\n instead of usual unix \n. The CYGWIN variable forces the shell to strip down all \r from command answers. (But the tests may still fail for other reasons.) 4) Simply do "make" and "make opt" for the native version. 5) Install ("make install" or "make old-install") and test. lablgtk-2.18.8/COPYING0000644000175000017500000000344413460263323013324 0ustar stephstephThis library (files in src directory) is made available under the GNU Library General Public License (LGPL). You should have got a copy of the LGPL with the current package (see file LGPL). As a special exception to the GNU Library General Public License, you may link, statically or dynamically, a "work that uses the Library" with a publicly distributed version of the Library to produce an executable file containing portions of the Library, and distribute that executable file under terms of your choice, without any of the additional requirements listed in clause 6 of the GNU Library General Public License. By "a publicly distributed version of the Library", we mean either the unmodified Library as distributed by the authors, or a modified version of the Library that is distributed under the conditions defined in clause 3 of the GNU Library General Public License. This exception does not however invalidate any other reasons why the executable file might be covered by the GNU Library General Public License. For the examples subdirectory, the code is in the public domain. You may freely copy parts of it in your application. For the applications subdirectory, stricter rules apply: * You are free to do anything you want with this code as long as it is for personal use. * Redistribution can only be "as is". Binary distribution and bug fixes are allowed, but you cannot extensively modify the code without asking the authors. The authors may choose to remove any of the above restrictions on a per request basis. Authors: Jacques Garrigue Benjamin Monate Olivier Andrieu Jun Furuse Hubert Fauque Koji Kagawa $Id$lablgtk-2.18.8/config.make.mingw0000755000175000017500000000624613460263323015523 0ustar stephsteph# -*- makefile -*- datarootdir = ${prefix}/share CAMLC=ocamlc.opt CAMLOPT=ocamlopt.opt CAMLRUN=ocamlrun CAMLDEP=ocamldep OCAMLDOC=ocamldoc CAMLMKTOP=ocamlmktop CAMLMKLIB=ocamlmklib CAMLP4O=camlp4o CAMLBEST=opt CAMLWIN32=yes CAMLDEP=ocamldep CAMLLEX=ocamllex CAMLYACC=ocamlyacc EXE=.exe USE_GL= USE_GLADE=1 USE_RSVG=1 HAVE_SVGZ= USE_GNOMECANVAS=1 USE_GNOMEUI= USE_PANEL= USE_GTKSPELL= USE_GTKSOURCEVIEW= USE_GTKSOURCEVIEW2= USE_GTKQUARTZ= USE_CC= DEBUG= CC=gcc RANLIB=ranlib XA=.a XB= XE= XO=.o XS=.dll TOOLCHAIN=unix LIBDIR=C:\Program Files\Objective Caml\lib THREADS_LIB=system HAS_DLL_SUPPORT=yes HAS_NATIVE_DYNLINK=yes # if using ocaml >= 3.08, add a -D OCAML_308 (for camlp4) ODOC_DEF=-D OCAML_308 # if using ocaml >= 3.11, add a -D HAS_PRINTEXC_BACKTRACE (for camlp4) HAS_PRINTEXC_BACKTRACE=-D HAS_PRINTEXC_BACKTRACE # where to install the binaries prefix=/Program Files/Objective Caml exec_prefix=${prefix} BINDIR=$(DESTDIR)${exec_prefix}/bin # where to install the man page MANDIR=$(DESTDIR)${datarootdir}/man INSTALLDIR=$(DESTDIR)C:\Program Files\Objective Caml\lib/lablgtk2 DLLDIR=$(DESTDIR)C:\Program Files\Objective Caml\lib/stublibs LABLGLDIR= FILT = -Wl,--export-dynamic clean_libs = $(subst -pthread,-ldopt -pthread -ccopt -pthread,$(subst --rpath,-rpath,$(filter-out $(FILT),$(1)))) GTKCFLAGS=-mms-bitfields -IC:/opt/gtk/include/gtk-2.0 -IC:/opt/gtk/lib/gtk-2.0/include -IC:/opt/gtk/include/atk-1.0 -IC:/opt/gtk/include/cairo -IC:/opt/gtk/include/pango-1.0 -IC:/opt/gtk/include/glib-2.0 -IC:/opt/gtk/lib/glib-2.0/include -IC:/opt/gtk/include/freetype2 -IC:/opt/gtk/include -IC:/opt/gtk/include/libpng12 -IC:/opt/gtk/include/libglade-2.0 -IC:/opt/gtk/include/libxml2 -IC:/opt/gtk/include/librsvg-2 -IC:/opt/gtk/include/libgnomecanvas-2.0 -IC:/opt/gtk/include/gail-1.0 -IC:/opt/gtk/include/libart-2.0 GTK_LIBS = -LC:/opt/gtk/lib -lgtk-win32-2.0 -lgdk-win32-2.0 -latk-1.0 -lgio-2.0 -lgdk_pixbuf-2.0 -lpangowin32-1.0 -lgdi32 -lpangocairo-1.0 -lpango-1.0 -lcairo -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl GTKLIBS:=$(call clean_libs,$(GTK_LIBS)) GTKGL_LIBS = GTKGLLIBS:=$(call clean_libs,$(GTKGL_LIBS)) GLADE_LIBS = -LC:/opt/gtk/lib -lglade-2.0 -lgtk-win32-2.0 -lxml2 -lgdk-win32-2.0 -latk-1.0 -lgio-2.0 -lgdk_pixbuf-2.0 -lpangowin32-1.0 -lgdi32 -lpangocairo-1.0 -lpango-1.0 -lcairo -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl GLADELIBS:=$(call clean_libs,$(GLADE_LIBS)) RSVG_LIBS = -LC:/opt/gtk/lib -lrsvg-2 -lgdk_pixbuf-2.0 -lcairo -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl RSVGLIBS:=$(call clean_libs,$(RSVG_LIBS)) GNOMECANVAS_LIBS = -LC:/opt/gtk/lib -lgnomecanvas-2 -lart_lgpl_2 -lgtk-win32-2.0 -lgdk-win32-2.0 -latk-1.0 -lgio-2.0 -lgdk_pixbuf-2.0 -lpangowin32-1.0 -lgdi32 -lpangocairo-1.0 -lpango-1.0 -lcairo -lgobject-2.0 -lgmodule-2.0 -lglib-2.0 -lintl GNOMECANVASLIBS:=$(call clean_libs,$(GNOMECANVAS_LIBS)) GNOMEUI_LIBS = GNOMEUILIBS:=$(call clean_libs,$(GNOMEUI_LIBS)) PANEL_LIBS = PANELLIBS:=$(call clean_libs,$(PANEL_LIBS)) GTKSPELL_LIBS = GTKSPELLLIBS:=$(call clean_libs,$(GTKSPELL_LIBS)) GTKSOURCEVIEW_LIBS = GTKSOURCEVIEWLIBS:=$(call clean_libs,$(GTKSOURCEVIEW_LIBS)) GTKSOURCEVIEWCFLAGS= GTKSOURCEVIEW2_LIBS = GTKSOURCEVIEW2LIBS:=$(call clean_libs,$(GTKSOURCEVIEW2_LIBS)) lablgtk-2.18.8/.gitignore0000644000175000017500000000017013460263323014252 0ustar stephstephconfig.make config.cache config.status config.log configure.lineno aclocal.m4 autom4te.cache test_dynlink.* *~ *.sw[po] lablgtk-2.18.8/configure.in0000644000175000017500000003101513460263323014575 0ustar stephsteph# # autoconf input for Objective Caml programs # Modified by the lablgtk2 development team # Original copyright (C) 2001 Jean-Christophe Filliātre # from a first script by Georges Mariano # # This library is free software; you can redistribute it and/or # modify it under the terms of the GNU Library General Public # License version 2, as published by the Free Software Foundation. # # This library is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # # See the GNU Library General Public License version 2 for more details # (enclosed in the file LGPL). # the script generated by autoconf from this input will set the following # variables: # CAMLC "ocamlc" if present in the path, or a failure # or "ocamlc.opt" if present with same version number as ocamlc # CAMLOPT "ocamlopt" (or "ocamlopt.opt" if present), or "no" # OCAMLBEST either "byte" if no native compiler was found, # or "opt" otherwise # OCAMLDEP "ocamldep" # OCAMLLEX "ocamllex" (or "ocamllex.opt" if present) # OCAMLYACC "ocamlyac" # OCAMLLIB the path to the ocaml standard library # OCAMLVERSION the ocaml version number # OCAMLWIN32 "yes"/"no" depending on Sys.os_type = "Win32" # EXE ".exe" if OCAMLWIN32=yes, "" otherwise # check for one particular file of the sources # ADAPT THE FOLLOWING LINE TO YOUR SOURCES! AC_INIT(src/gtk.ml) # Check for Ocaml compilers # we first look for ocamlc in the path; if not present, we fail AC_CHECK_PROG(CAMLC,ocamlc,ocamlc,no) if test "$CAMLC" = no ; then AC_MSG_ERROR(Cannot find ocamlc.) fi # we extract Ocaml version number and library path OCAMLVERSION=`$CAMLC -version` echo "ocaml version is $OCAMLVERSION" OCAMLLIB=`$CAMLC -where | tr -d '\\r'` echo "ocaml library path is $OCAMLLIB" LIBDIR=$OCAMLLIB AC_ARG_WITH(libdir, [ --with-libdir=/path install libs in /path/lablgtk2 and /path/stublibs], LIBDIR=$withval echo "Install dirs are : $LIBDIR/lablgtk2 and $LIBDIR/stublibs" echo " Compile with ocamlc -I $LIBDIR/lablgtk2 and add $LIBDIR/stublibs either to OCAMLLIB/ld.conf or to CAML_LD_LIBRARY_PATH", echo "Default install dirs are : $LIBDIR/lablgtk2 and $LIBDIR/stublibs" echo "Compile with ocamlc -I +lablgtk2" ) # then we look for ocamlopt; if not present, we issue a warning # if the version is not the same, we also discard it # we set OCAMLBEST to "opt" or "byte", whether ocamlopt is available or not AC_CHECK_PROG(CAMLOPT,ocamlopt,ocamlopt,no) OCAMLBEST=byte if test "$CAMLOPT" = no ; then AC_MSG_WARN(Cannot find ocamlopt; bytecode compilation only.) else AC_MSG_CHECKING(ocamlopt version) TMPVERSION=`$CAMLOPT -version` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT(differs from ocamlc; ocamlopt discarded.) CAMLOPT=no else AC_MSG_RESULT(ok) OCAMLBEST=opt fi fi # checking for ocamlc.opt AC_CHECK_PROG(OCAMLCDOTOPT,ocamlc.opt,ocamlc.opt,no) if test "$OCAMLCDOTOPT" != no ; then AC_MSG_CHECKING(ocamlc.opt version) TMPVERSION=`$OCAMLCDOTOPT -version` if test "$TMPVERSION" != "$OCAMLVERSION" ; then AC_MSG_RESULT(differs from ocamlc; ocamlc.opt discarded.) else AC_MSG_RESULT(ok) CAMLC=$OCAMLCDOTOPT fi fi # checking for ocamlopt.opt if test "$CAMLOPT" != no ; then AC_CHECK_PROG(OCAMLOPTDOTOPT,ocamlopt.opt,ocamlopt.opt,no) if test "$OCAMLOPTDOTOPT" != no ; then AC_MSG_CHECKING(ocamlc.opt version) TMPVER=`$OCAMLOPTDOTOPT -version` if test "$TMPVER" != "$OCAMLVERSION" ; then AC_MSG_RESULT(differs from ocamlc; ocamlopt.opt discarded.) else AC_MSG_RESULT(ok) CAMLOPT=$OCAMLOPTDOTOPT fi fi fi # ocamlrun, ocamldep, ocamllex and ocamlyacc should also be present in the path AC_CHECK_PROG(OCAMLRUN,ocamlrun,ocamlrun,no) if test "$OCAMLRUN" = no ; then AC_MSG_ERROR(Cannot find ocamlrun.) fi AC_CHECK_PROG(OCAMLDEP,ocamldep,ocamldep,no) if test "$OCAMLDEP" = no ; then AC_MSG_ERROR(Cannot find ocamldep.) fi AC_CHECK_PROG(OCAMLDOC,ocamldoc,ocamldoc,no) if test "$OCAMLDOC" = no ; then AC_MSG_RESULT(Cannot find ocamldoc.) fi AC_CHECK_PROG(OCAMLLEX,ocamllex,ocamllex,no) if test "$OCAMLLEX" = no ; then AC_MSG_ERROR(Cannot find ocamllex.) #else # AC_CHECK_PROG(OCAMLLEXDOTOPT,ocamllex.opt,ocamllex.opt,no) # if test "$OCAMLLEXDOTOPT" != no ; then # OCAMLLEX=$OCAMLLEXDOTOPT # fi fi AC_CHECK_PROG(OCAMLYACC,ocamlyacc,ocamlyacc,no) if test "$OCAMLYACC" = no ; then AC_MSG_ERROR(Cannot find ocamlyacc.) fi AC_CHECK_PROG(CAMLMKTOP,ocamlmktop,ocamlmktop,no) if test "$CAMLMKTOP" = no ; then AC_MSG_ERROR(Cannot find ocamlmktop.) fi AC_CHECK_PROG(CAMLMKLIB,ocamlmklib,ocamlmklib,no) if test "$CAMLMKLIB" = no ; then AC_MSG_ERROR(Cannot find ocamlmklib.) fi AC_CHECK_PROG(CAMLP4O,camlp4o,camlp4o,no) if test "$CAMLP4O" = no ; then AC_MSG_WARN(Cannot find camlp4o; please do not modify .ml4 files.) fi AC_CHECK_PROG(OCAMLFIND,ocamlfind,ocamlfind,no) if test "`$OCAMLFIND printconf stdlib`" != "`$CAMLC -where`"; then AC_MSG_WARN(Ignoring ocamlfind, it uses a different OCaml installation.) OCAMLFIND=no fi if test "$OCAMLFIND" = no; then FINDLIBDIR="" OCAMLLDCONF="" else FINDLIBDIR="`ocamlfind printconf destdir | tr -d '\\r'`" echo "$OCAMLFIND library path is $FINDLIBDIR" OCAMLLDCONF="`ocamlfind printconf ldconf | tr -d '\\r'`" echo "$OCAMLFIND ldconf path is $OCAMLLDCONF" fi if expr "$OCAMLVERSION" '>=' '4' > /dev/null ; then ODOC_DEF="-D OCAML_400" fi AC_SUBST(ODOC_DEF) if expr "$OCAMLVERSION" '>=' '3.11' > /dev/null ; then HAS_PRINTEXC_BACKTRACE="-D HAS_PRINTEXC_BACKTRACE" fi AC_SUBST(HAS_PRINTEXC_BACKTRACE) # Check for which kind of threads is used AC_MSG_CHECKING(for ocaml threads) AC_ARG_WITH(threads, [ --with-threads=(yes|system|vm|no) which threads to use ], THREADS_LIB="$withval", THREADS_LIB="yes") if (test "$THREADS_LIB" = yes || test "$THREADS_LIB" = system) && \ test -r "$OCAMLLIB/threads/threads.cma"; then THREADS_LIB="system" elif (test "$THREADS_LIB" = yes || test "$THREADS_LIB" = vm) && \ test -r "$OCAMLLIB/vmthreads/stdlib.cma"; then THREADS_LIB="vm" elif test "$THREADS_LIB" = yes || test "$THREADS_LIB" = no; then THREADS_LIB="no" else echo; AC_MSG_ERROR(Cannot use $THREADS_LIB threads) fi AC_MSG_RESULT(use $THREADS_LIB threads) # Check for dll support HAS_DLL_SUPPORT="no" AC_MSG_CHECKING(for ocaml dll support) if test -r "$OCAMLLIB/stublibs/dllunix.so" || test -r "$OCAMLLIB/stublibs/dllunix.dll" then HAS_DLL_SUPPORT="yes" fi AC_MSG_RESULT($HAS_DLL_SUPPORT) RANLIB=`$CAMLC -config | grep ranlib | sed -e "s/ranlib: \(.*\)/\1/" ` AC_PROG_RANLIB # get the C compiler used by ocamlc if test -z "$CC" ; then touch conftest.c CC=$($CAMLC -verbose -c conftest.c 2>&1 | head -1 | sed ['s/^+ \([^ ]*\) .*$/\1/']) echo [OCaml uses $CC to compile C files] fi AC_PROG_CC AC_DEFUN([AX_CHECK_COMPILE_FLAG], [AC_PREREQ(2.64)dnl for _AC_LANG_PREFIX and AS_VAR_IF AS_VAR_PUSHDEF([CACHEVAR],[ax_cv_check_[]_AC_LANG_ABBREV[]flags_$4_$1])dnl AC_CACHE_CHECK([whether _AC_LANG compiler accepts $1], CACHEVAR, [ ax_check_save_flags=$[]_AC_LANG_PREFIX[]FLAGS _AC_LANG_PREFIX[]FLAGS="$[]_AC_LANG_PREFIX[]FLAGS $4 $1" AC_COMPILE_IFELSE([m4_default([$5],[AC_LANG_PROGRAM()])], [AS_VAR_SET(CACHEVAR,[yes])], [AS_VAR_SET(CACHEVAR,[no])]) _AC_LANG_PREFIX[]FLAGS=$ax_check_save_flags]) AS_VAR_IF(CACHEVAR,yes, [m4_default([$2], :)], [m4_default([$3], :)]) AS_VAR_POPDEF([CACHEVAR])dnl ])dnl AX_CHECK_COMPILE_FLAGS OCAML_CC_EXTRA_FLAGS= AX_CHECK_COMPILE_FLAG(-fno-unwind-tables,[OCAML_CC_EXTRA_FLAGS=-fno-unwind-tables]) # platform AC_MSG_CHECKING(platform) echo "print_endline Sys.os_type ;;" > conftest.ml ac_ocaml_platform=$(ocaml conftest.ml | tr -d '\r') AC_MSG_RESULT($ac_ocaml_platform) if test $ac_ocaml_platform = Win32 ; then OCAMLWIN32=yes EXE=.exe XS=.dll else OCAMLWIN32=no EXE= XS=.so fi # Working native Dynlink AC_MSG_CHECKING(native dynlink) echo "Dynlink.loadfile \"foo\";;" > test_dynlink.ml if ($CAMLOPT -shared -o test_dynlink.cmxs test_dynlink.ml) 2> /dev/null ; then HAS_NATIVE_DYNLINK=yes else HAS_NATIVE_DYNLINK=no fi rm test_dynlink.* # GTK 2 auto configuration GTKPKG=gtk+-2.0 AM_PATH_GTK_2_0(2.0.0, :, AC_MSG_ERROR(GTK+ is required)) dnl LABLGTK_PKG(variable, autoconf package, help string, pkgconfig package) AC_DEFUN([LABLGTK_PKG], [ AC_ARG_WITH($2,[$3],USE_$1=$withval; FORCE_$1=yes, USE_$1=yes; FORCE_$1=no) if test $USE_$1 = yes ; then PKG_CHECK_MODULES($1,$4,,[ if test $FORCE_$1 = yes ; then AC_MSG_ERROR($2 enforced but no support found) else USE_$1=no fi]) fi if test $USE_$1 = yes ; then USE_$1=1 $1[]PKG=$4 else unset USE_$1 fi AC_SUBST(USE_$1)]) LABLGTK_PKG(GTKGL, gl, [ --without-gl override autodetected GtkGLArea support. Requires LablGL], gtkgl-2.0) # Check for LablGL if test -n "$USE_GTKGL" ; then AC_MSG_CHECKING(lablGL directory) cat > conftest.ml << EOF open Raw EOF if $CAMLC -c -I "${LABLGLDIR:=+lablGL}" conftest.ml > /dev/null 2>&1 ; then AC_MSG_RESULT($LABLGLDIR) else if test $FORCE_GTKGL = yes ; then AC_MSG_ERROR(gtkgl enforced but lablGL not found) else AC_MSG_RESULT(no) unset USE_GTKGL unset GTKGLPKG unset LABLGLDIR fi fi fi LABLGTK_PKG(GLADE, glade, [ --without-glade override autodetected libglade support], libglade-2.0) LABLGTK_PKG(RSVG, rsvg, [ --without-rsvg override autodetected librsvg support], librsvg-2.0) # Check for SVGZ support if test -n "$USE_RSVG" ; then ac_ocaml_libs="$LIBS" LIBS="$LIBS $RSVG_LIBS" AC_CHECK_FUNC(rsvg_handle_new_gz, [HAVE_SVGZ=-DHAVE_SVGZ], [unset HAVE_SVGZ]) # this tests seems broken on my ubuntu FF unset HAVE_SVGZ LIBS="$ac_ocaml_libs" else unset HAVE_SVGZ fi LABLGTK_PKG(GNOMECANVAS, gnomecanvas, [ --without-gnomecanvas override autodetected libgnomecanvas support], libgnomecanvas-2.0) LABLGTK_PKG(GNOMEUI, gnomeui, [ --without-gnomeui override autodetected libgnomeui support], libgnomeui-2.0) LABLGTK_PKG(PANEL, panel, [ --without-panel override autodetected libpanelapplet support], libpanelapplet-2.0) LABLGTK_PKG(GTKSPELL, gtkspell, [ --without-gtkspell override autodetected gtkspell support], gtkspell-2.0) LABLGTK_PKG(GTKSOURCEVIEW, gtksourceview, [ --without-gtksourceview override autodetected gtksourceview support], gtksourceview-1.0) LABLGTK_PKG(GTKSOURCEVIEW2, gtksourceview2, [ --without-gtksourceview2 override autodetected gtksourceview 2 support], gtksourceview-2.0) LABLGTK_PKG(GTKQUARTZ, quartz, [ --without-quartz override autodetected quartz support], gtk+-quartz-2.0) PKG_CHECK_MODULES(GTKALL,$GTKPKG $GTKGLPKG $GLADEPKG $RSVGPKG $GNOMECANVASPKG $GNOMEUIPKG $PANELPKG $GTKSPELLPKG $GTKSOURCEVIEW2PKG $GTKQUARTZPKG) AC_ARG_ENABLE(debug, [ --enable-debug enable debug mode], AC_MSG_RESULT(Debug mode enabled) ; DEBUG=1, DEBUG=) # substitutions to perform AC_SUBST(EXE) AC_SUBST(XS) AC_SUBST(LIBDIR) AC_SUBST(OCAMLBEST) AC_SUBST(OCAMLWIN32) AC_SUBST(OCAMLDEP) AC_SUBST(OCAMLRUN) AC_SUBST(OCAMLLEX) AC_SUBST(OCAMLYACC) AC_SUBST(THREADS_LIB) AC_SUBST(HAS_DLL_SUPPORT) AC_SUBST(HAS_NATIVE_DYNLINK) AC_SUBST(OCAML_CC_EXTRA_FLAGS) AC_SUBST(CAMLC) AC_SUBST(CAMLOPT) AC_SUBST(OCAMLDOC) AC_SUBST(CAMLMKTOP) AC_SUBST(CAMLMKLIB) AC_SUBST(CAMLP4O) AC_SUBST(OCAMLFIND) AC_SUBST(FINDLIBDIR) AC_SUBST(OCAMLLDCONF) AC_SUBST(LABLGLDIR) AC_SUBST(HAVE_SVGZ) AC_SUBST(USE_CC) AC_SUBST(DEBUG) # Finally create the config.make from config.make.in AC_OUTPUT(config.make) chmod a-w config.make AC_DEFUN([CONF_SUMMARY], [ echo $ECHO_N " $1 $ECHO_C" if test -n "$USE_$2" then echo " yes" else if test "$FORCE_$2" = "yes" then echo " disabled" else echo " not found" fi fi]) echo ; echo "LablGTK configuration:" echo " threads $THREADS_LIB" echo " native dynlink $HAS_NATIVE_DYNLINK" CONF_SUMMARY(GtkGLArea, GTKGL) CONF_SUMMARY(libglade, GLADE) CONF_SUMMARY(librsvg , RSVG) CONF_SUMMARY(libgnomecanvas, GNOMECANVAS) CONF_SUMMARY(libgnomeui, GNOMEUI) CONF_SUMMARY(libpanelapplet, PANEL) CONF_SUMMARY(gtkspell, GTKSPELL) CONF_SUMMARY(gtksourceview 1, GTKSOURCEVIEW) CONF_SUMMARY(gtksourceview 2, GTKSOURCEVIEW2) CONF_SUMMARY(quartz , GTKQUARTZ) echo echo $ECHO_N " debug $ECHO_C" if test -n "$DEBUG" ; then echo " yes" ; else echo " no" ; fi echo " C compiler $CC" echo " Camlp4 $CAMLP4O"