* Make GObj.misc_ops#add_accelerator polymorphic in the widget of

    the signal (Erkki Seppala)
  * Use properties in GtkAdjustment, rather than direct accessors

CHANGES

@@ -3,6 +3,9 @@ LablGTK changes log
 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)

examples/seppala.ml

@@ -0,0 +1,19 @@
+open Gtk
+
+let destroy () = GMain.Main.quit ()
+
+let main () =
+ ignore (GMain.init ());
+ let main_window = GWindow.window () in
+ let accel_group = GtkData.AccelGroup.create () in
+ 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 ()

src/.depend

@@ -90,10 +90,8 @@ 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 : gtkSignal.cmi gtkBaseProps.cmo gtk.cmo gobject.cmi gdk.cmi \
-    gaux.cmo
-gtkData.cmx : gtkSignal.cmx gtkBaseProps.cmx gtk.cmx gobject.cmx gdk.cmx \
-    gaux.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
@@ -158,14 +156,12 @@ gObj.cmo : pango.cmo gtkStock.cmo gtkSignal.cmi gtkData.cmo gtkBase.cmo \
 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
-gData.cmo : gtkData.cmo gtkBin.cmo gtkBase.cmo gtk.cmo gpointer.cmi \
-    gobject.cmi gaux.cmo gObj.cmi gData.cmi
-gData.cmx : gtkData.cmx gtkBin.cmx gtkBase.cmx gtk.cmx gpointer.cmx \
-    gobject.cmx gaux.cmx gObj.cmx gData.cmi
-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
+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 \
@@ -202,6 +198,10 @@ 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 \

src/Makefile

@@ -231,8 +231,8 @@ MLOBJS3 = gtkData.cmo gtkBase.cmo gtkPack.cmo gtkButton.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 gData.cmo gMain.cmo
-MLOBJS4 = gContainer.cmo gPack.cmo gButton.cmo gText.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 \

src/gData.ml

@@ -28,26 +28,25 @@ open Gtk
 open GtkBase
 open GtkData
 open GObj
+open OgtkBaseProps
 
 class adjustment_signals obj = object (self)
   inherit gtkobj_signals_impl obj
-  method changed = self#connect Adjustment.S.changed
-  method value_changed = self#connect Adjustment.S.value_changed
+  inherit adjustment_sigs
 end
 
-class adjustment obj = object
+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 set_value = Adjustment.set_value obj
   method clamp_page = Adjustment.clamp_page obj
-  method lower = Adjustment.get_lower obj
-  method upper = Adjustment.get_upper obj
-  method value = Adjustment.get_value obj
-  method step_increment = Adjustment.get_step_increment obj
-  method page_increment = Adjustment.get_page_increment obj
-  method page_size = Adjustment.get_page_size obj
-  method set_bounds = Adjustment.set_bounds 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.)

src/gData.mli

@@ -34,6 +34,12 @@ class adjustment_signals : [> adjustment] obj ->
     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
@@ -55,6 +61,12 @@ class adjustment : Gtk.adjustment obj ->
     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 

src/gObj.ml

@@ -278,8 +278,10 @@ and misc_ops obj = object (self)
   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 ~sgn:sg ~group ?modi ?flags key =
-    Widget.add_accelerator obj ~sgn:sg group ~key ?modi ?flags
+  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 *)

src/gObj.mli

@@ -209,8 +209,8 @@ and misc_ops : Gtk.widget obj ->
     inherit gobject_ops
     val obj : Gtk.widget obj
     method activate : unit -> bool
-    method add_accelerator :
-      sgn:(Gtk.widget, unit -> unit) GtkSignal.t ->
+    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 :

src/gtkBase.props

@@ -155,7 +155,13 @@ class Item abstract wrapsig : Bin {
   signal toggle
 }
 
-class Adjustment : Object {
+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
 }

src/gtkData.ml

@@ -143,30 +143,9 @@ module Adjustment = struct
       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 set_value : [>`adjustment] obj -> float -> unit
-      = "ml_gtk_adjustment_set_value"
   external clamp_page :
       [>`adjustment] obj -> lower:float -> upper:float -> unit
       = "ml_gtk_adjustment_clamp_page"
-  external get_lower : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_lower"
-  external get_upper : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_upper"
-  external get_value : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_value"
-  external get_step_increment : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_step_increment"
-  external get_page_increment : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_page_increment"
-  external get_page_size : [>`adjustment] obj -> float
-      = "ml_gtk_adjustment_get_page_size"
-  external set : ?lower:float -> ?upper:float -> ?step_incr:float ->
-      ?page_incr:float -> ?page_size:float -> [>`adjustment] obj -> unit
-      =  "ml_gtk_adjustment_set_bc" "ml_gtk_adjustment_set"
-  let set_bounds adj ?lower ?upper ?step_incr ?page_incr ?page_size () =
-    set adj ?lower ?upper ?step_incr ?page_incr ?page_size;
-    GtkSignal.emit_unit adj ~sgn:S.changed;
-    set_value adj (get_value adj)
 end
 
 module Tooltips = struct

src/ml_gtk.c

@@ -231,9 +231,10 @@ ML_1 (gtk_object_sink, GtkObject_val, Unit)
 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_2 (gtk_adjustment_set_value, GtkAdjustment_val, Float_val, Unit)
 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)
@@ -247,7 +248,7 @@ CAMLprim value ml_gtk_adjustment_set(value lower, value upper,
                             value page_size, value adjustment)
 {
     GtkAdjustment *adj = GtkAdjustment_val(adjustment);
-#define Update_field(name) adj->name = Option_val(name,Double_val,adj->name)
+#define Update_field(name) (adj->name = Option_val(name,Double_val,adj->name)
     Update_field(lower);
     Update_field(upper);
     Update_field(step_increment);
@@ -257,6 +258,7 @@ CAMLprim value ml_gtk_adjustment_set(value lower, value upper,
     return Val_unit;
 }
 ML_bc6(ml_gtk_adjustment_set)
+*/
 
 /* gtktooltips.h */