struct
(** Class definition*) |
(** A ComboTextTree is a combo with eventually some dependent childs (or slaves). The choice list of a node in the tree depends on the father's selected value and on the ancestors's selected values. The list of choices of a node is given dynamically by a function called the generator which is used to calculte or recalculate the choice list. *) |
class comboTextTree = fun
(* The option generator. May be a constant function as particular case. *)
~(generator: ((string,string) env)->(string list))
(* The first input for the generator. *)
~(msg:(string,string) env)
(* The key of the pair (key,value) send to its childs. *)
~(key:string)
(* An optional callback function, to call at any change *)
~(callback:(string->unit) option)
(* The packing function. *)
~(packing:(GObj.widget -> unit) option)
-> (* Build the initial combo list (no packing and no callback are defined here
(because self dont exist at this stage). *)
let strList = (generator msg) in
let (initial_box, (_, initial_col)) = GEdit.combo_box_text ~strings:strList () in
let _ = initial_box#set_active 0 in
object (self)
(** Constant fields (methods) *) |
(** The function to build or rebuild the choices using the given environnement. For a simple comboTextTree, this method is used only at the creation and the function is not really dependent from its argument, but it is a simple costant function. *) |
method generator : ((string,string) env -> (string list)) = generator
(** The key of the pair (key,value) which this widget (node) eventually transmit to its childs (slaves). This field is set at the creation. The value of the pair (key,value) will be the selected value of the widget, of course. *) |
method key : string = key
(** A secondary function to call at any change of the selected item. This represent an additional callback.
The principal callback is the method childs_rebuild which propagate the selected value to all childs. *) |
method callback : (string -> unit) = match callback with None -> (fun x->()) | Some f -> f
(** The function to call to attach self somewhere. For instance :
Every time the comboTextTree is rebuilded, the old box is destroyed, rebuilded and finally repackaged
with this packing function. *) |
method packing : (GObj.widget -> unit) = match packing with None -> (fun x->()) | Some f -> f
(** Variable fields *) |
(** This fields stores the environment used for the last generation of the choice list. This information is fundamental because if this widget has some ancestors and also some descendents, for any alteration of its state, it must resend to its childs the last environment received from its ancestors enriched with the pair (key,value) representing its own state. In this way, every descendent know the state of all its ancestors (not only the state of its father). *) |
val mutable env : ((string,string) env) = msg
(** The choices calculated by the last call to the generator. *) |
val mutable choices : (string list) = (generator msg)
(** The currently encapsulated GEdit.combo_box . *) |
val mutable box : #GEdit.combo_box = initial_box
val mutable col : ('a GTree.column) = initial_col
(** The childs list of this widget. *) |
val mutable childs : comboTextTree list = []
(** Accessors *) |
method env = env
method choices = choices
method box = box
method col = col
method childs = childs
method child i = List.nth childs i
(** Convenient aliases *) |
method slave = List.nth childs 0
method slave0 = List.nth childs 0
method slave1 = List.nth childs 1
method slave2 = List.nth childs 2
method slave3 = List.nth childs 3
method slave4 = List.nth childs 4
method slave5 = List.nth childs 5
(** Fixing variable fields *) |
method set_env r = env <- r
method set_choices l = choices <- l
method set_box b = box <- b
method set_col c = col <- c
method set_childs l = childs <- l
method add_child x = childs <- childs @ [x]
(** Selected item *) |
(** In the most cases, the only interesting method from an abstract point of view. @return the selected string belong the combo items *) |
method selected =
match self#box#active_iter with
| None -> ""
| Some row -> (self#box#model#get ~row ~column:self#col)
(** Set the current active (selected) choice by its value (instead of its index) *) |
method set_active_value (v:string) =
try
let i = raise_when_none (List.indexOf v self#choices) in
self#box#set_active i ;
self#childs_rebuild ()
with _ -> ()
(** Rebuilding self and childs *) |
(** Demands to all childs to rebuild theirself and their childs and so on.
This procedure is performed sending to all childs the ancestor environment (method env ) enriched by
the pair (key,value), where value is the current selected item of this node. *) |
method childs_rebuild () =
let msg = mkenv (self#env#get_l @ [(self#key,self#selected)]) in (* x = self#selected *)
List.iter (fun w -> w#rebuild msg) self#childs
(** Rebuild this widget, and its eventually all childs, with the new given environment. *) |
method rebuild (msg:(string,string) env) =
begin
(* Save the current selected choice. We will try to reset it. *)
let previous = self#selected in
(* Destroy the old combo box. *)
self#box#destroy () ; (* Essentiel! *)
(* Rebuild combo list. *)
let strList = (self#generator msg) in
let (combo, (_, column)) = GEdit.combo_box_text ~strings:strList () in
self#set_box combo ;
self#set_col column ;
self#set_choices strList ;
self#initialize_callbacks ; (* Re-initialize callbacks for the new box! *)
self#packing (self#box :> GObj.widget) ; (* repack self *)
(* Register the last master environment *)
self#set_env msg ;
(* Try to restore the previous selected value (or select the index 0) *)
let i = ((List.indexOf previous self#choices) |=> 0) in
(self#box#set_active i) ;
(* Propagate to its childs. *)
self#childs_rebuild () ;
()
end
(**/**) |
(* STOP DOC *)
(* Proc�ure de connection de l'��ement changed d'un combo �un callback qui permet
de faire appel �un second callback (cbackfun), de type string->unit, sur la chaine
selectionn� dans le widget. *)
method changedAndGetActive (cbfun:string->unit) =
let _ = self#box#connect#changed
(fun () -> match self#box#active_iter with
| None -> ()
| Some row -> let data = (self#box#model#get ~row ~column:self#col) in cbfun data
) in ()
(* The packing initialization (only for bootstrap). *)
val initialize_packing =
let _ = match packing with None -> () | Some f -> f (initial_box :> GObj.widget) in ()
(* This method must be called by a constructor after the bootstrap.
These action cannot be placed in the boostrap of the instance. *)
method initialize_callbacks =
let _ = self#changedAndGetActive (fun x -> self#childs_rebuild ()) in
(** First connect the standard callback. *) |
let _ = self#changedAndGetActive self#callback in ()
(** Second connect the given callback. *) |
end;; (* class comboTextTree *)
(** Constructors and convenient API*) |
(** A choice is simply a string. *) |
type choice = string;;
(** The type choices represent a choice list , of course. *) |
type choices = choice list;;
(** The simplest and general constuctor. Simply calls the class constructor and initialize callbacks. *) |
let make
~(generator: ((string,string) env)->(string list))
(** The option generator. May be a constant function as particular case. *) |
~(msg:(string,string) env)
(** The input for the generator. *) |
~(key:string)
(** The key of the pair (key,value) send to its childs. *) |
~(callback:(choice->unit) option)
(** An optional callback function, to call at any change *) |
~(packing:(GObj.widget -> unit) option)
(** The packing function. *) |
= let self = new comboTextTree ~generator ~msg ~key ~callback ~packing in
let _ = self#initialize_callbacks in self
;;
(** Make a simple combo text with no childs.
You can specify a key (if you plan to affect some childs to this widget) and an additional callback
fonction of type choice -> unit , which will be called every time the user will modify its selection.
You also can specify a packing function. Examples:
|
let fromList
?(key:string="unused_key")
?(callback:((choice->unit) option) = None )
?(packing:((GObj.widget -> unit) option) = None )
(lst:choices)
= let g = (fun r -> lst) in
let m = (mkenv []) in
make ~generator:g ~msg:m ~key ~callback ~packing
;;
(** Combo chains*) |
(** Modelling a dependent chain of widgets: master -> slave -> slave -> ..*) |
(** Make a two level chain of dependent combos text. You can access to the slave simply writing master#slave
(slave is simply an alias for the child number 0). Example :
*) |
let fromListWithSlave
?(masterCallback:((choice->unit) option) = None)
?(masterPacking:((GObj.widget -> unit) option) = None)
(masterChoices:choices)
?(slaveCallback:((choice->unit) option) = None)
?(slavePacking:((GObj.widget -> unit) option) = None )
(slaveChoices: choice -> choices)
= let master = fromList ~key:"master" ~callback:masterCallback ~packing:masterPacking masterChoices in
let slave = make
~generator:(fun r -> slaveChoices (r#get "master"))
~msg:(mkenv [("master",master#selected)])
~key:"slave"
~callback:slaveCallback
~packing:slavePacking in
let _ = master#add_child slave in master (* Here you set the dependency. *)
;;
(** Make a 3 levels chain of dependent combos text. You can access the slave simply writing master#slave ,
and the slave of the slave simply writing master#slave#slave . *) |
let fromListWithSlaveWithSlave
?(masterCallback:((choice->unit) option) = None)
?(masterPacking:((GObj.widget -> unit) option) = None)
(masterChoices:choices)
?(slaveCallback:((choice->unit) option) = None)
?(slavePacking:((GObj.widget -> unit) option) = None )
(slaveChoices: choice -> choices)
?(slaveSlaveCallback:((choice->unit) option) = None)
?(slaveSlavePacking:((GObj.widget -> unit) option) = None )
(slaveSlaveChoices: choice -> choice -> choices)
= let master =
fromListWithSlave ~masterCallback ~masterPacking masterChoices ~slaveCallback ~slavePacking slaveChoices in
let slaveSlave = make
~generator:(fun r -> slaveSlaveChoices (r#get "master") (r#get "slave"))
~msg:(mkenv [("master",master#selected);("slave",master#slave#selected)])
~key:"slaveSlave"
~callback:slaveSlaveCallback
~packing:slaveSlavePacking in
let _ = master#slave#add_child slaveSlave in master (* Here you set the dependency. *)
;;
(** Make a 4 levels chain of dependent combos text. You can access the slave chain simply by
master#slave , master#slave#slave and master#slave#slave#slave .*) |
let fromListWithSlaveWithSlaveWithSlave
?(masterCallback:((choice->unit) option) = None)
?(masterPacking:((GObj.widget -> unit) option) = None)
(masterChoices:choices)
?(slaveCallback:((choice->unit) option) = None)
?(slavePacking:((GObj.widget -> unit) option) = None )
(slaveChoices: choice -> choices)
?(slaveSlaveCallback:((choice->unit) option) = None)
?(slaveSlavePacking:((GObj.widget -> unit) option) = None )
(slaveSlaveChoices: choice -> choice -> choices)
?(slaveSlaveSlaveCallback:((choice->unit) option) = None)
?(slaveSlaveSlavePacking:((GObj.widget -> unit) option) = None )
(slaveSlaveSlaveChoices: choice -> choice -> choice -> choices)
= let master =
fromListWithSlaveWithSlave
~masterCallback ~masterPacking masterChoices
~slaveCallback ~slavePacking slaveChoices
~slaveSlaveCallback ~slaveSlavePacking slaveSlaveChoices in
let slaveSlaveSlave = make
~generator:(fun r -> slaveSlaveSlaveChoices (r#get "master") (r#get "slave") (r#get "slaveSlave"))
~msg:(mkenv [("master",master#selected);("slave",master#slave#selected);("slaveSlave",master#slave#slave#selected)])
~key:"slaveSlaveSlave"
~callback:slaveSlaveSlaveCallback
~packing:slaveSlaveSlavePacking in
let _ = master#slave#slave#add_child slaveSlaveSlave in master (* Here you set the dependency. *)
;;
(** Simple tree constructor*) |
(** Modelling a dependent tree of widgets: master / \ slave0 slave1*) |
(** Make a simple tree with 3 nodes: a root combo with two combos (dependent) childs (which can be accessed with the handlers
master#slave0 and master#slave1 ). This function is in this API as an exemple. See the code in order to easily
define your own comboTextTree. *) |
let fromListWithTwoSlaves
?(masterCallback:((choice->unit) option) = None)
?(masterPacking:((GObj.widget -> unit) option) = None)
(masterChoices:choices)
?(slave1Callback:((choice->unit) option) = None)
?(slave1Packing:((GObj.widget -> unit) option) = None )
(slave1Choices: choice -> choices)
?(slave2Callback:((choice->unit) option) = None)
?(slave2Packing:((GObj.widget -> unit) option) = None )
(slave2Choices: choice -> choices)
= let master = fromList ~key:"master" ~callback:masterCallback ~packing:masterPacking masterChoices in
let slave1 = make
~generator:(fun r -> slave1Choices (r#get "master"))
~msg:(mkenv [("master",master#selected)])
~key:"slave1"
~callback:slave1Callback
~packing:slave1Packing in
let slave2 = make
~generator:(fun r -> slave2Choices (r#get "master"))
~msg:(mkenv [("master",master#selected)])
~key:"slave2"
~callback:slave2Callback
~packing:slave2Packing in
let _ = master#add_child slave1 in
let _ = master#add_child slave2 in master
;;
end