deletable, renamable waypoints

sw/ground_segment/cockpit/editFP.ml

@@ -105,7 +105,8 @@ let load_fp = fun geomap accel_group () ->
     | Some xml_file ->
 	try
 	  let xml = Xml.parse_file xml_file in
-	  ignore (load_xml_fp geomap accel_group ~xml_file xml)
+	  ignore (load_xml_fp geomap accel_group ~xml_file xml);
+	  geomap#fit_to_window ()
 	with
 	  Dtd.Check_error(e) -> 
 	    let m = sprintf "Error while loading %s:\n%s" xml_file (Dtd.check_error e) in

sw/ground_segment/cockpit/live.ml

@@ -212,9 +212,9 @@ let mark = fun (geomap:G.widget) ac_id track plugin_frame ->
 
 
 (** Load a mission. Returns the XML window *)
-let load_mission = fun ?edit color geomap xml ->
+let load_mission = fun ?editable color geomap xml ->
   Map2d.set_georef_if_none geomap (MapFP.georef_of_xml xml);
-  new MapFP.flight_plan ?edit ~show_moved:true geomap color Env.flight_plan_dtd xml
+  new MapFP.flight_plan ?editable ~show_moved:true geomap color Env.flight_plan_dtd xml
 
 
 
@@ -270,7 +270,7 @@ let create_ac = fun (geomap:G.widget) (acs_notebook:GPack.notebook) ac_id config
 
   (** Build the XML flight plan, connect then "jump_to_block" *)
   let fp_xml = ExtXml.child fp_xml_dump "flight_plan" in
-  let fp = load_mission ~edit:false color geomap fp_xml in
+  let fp = load_mission ~editable:false color geomap fp_xml in
   fp#connect_activated (fun node ->
     if XmlEdit.tag node = "block" then
       let block = XmlEdit.attrib node "name" in

sw/lib/ocaml/mapFP.ml

@@ -35,7 +35,7 @@ let rec assoc_nocase at = function
 
 (** Connect a change in the XML editor to the graphical rep *)
 let update_wp utm_ref (wp:MapWaypoints.waypoint) = function
-    XmlEdit.Deleted -> wp#delete
+    XmlEdit.Deleted -> wp#delete ()
   | XmlEdit.New_child _ -> failwith "update_wp"
   | XmlEdit.Modified attribs ->
       try
@@ -81,16 +81,19 @@ let waypoints_node = fun xml_tree ->
   XmlEdit.child xml_root "waypoints"
 
 (** Connect a change from the graphical rep to the xml tree *)
-let update_xml = fun xml_tree utm0 wp ->
+let update_xml = fun xml_tree utm0 wp id ->
   let xml_wpts = XmlEdit.children (waypoints_node xml_tree) in
-  let node = List.find (fun w -> XmlEdit.attrib w "name" = wp#name) xml_wpts in
-  let utm = utm_of WGS84 (wp#pos) in
-  try
-    let (dx, dy) = utm_sub utm utm0 in
-    XmlEdit.set_attribs node ["name",wp#name; "x",sof dx; "y",sof dy; "alt", sof wp#alt]
-  with
-    _ ->
-      prerr_endline "MapFP.update_xml: waypoint too far from ref (FIXME)"
+  let node = List.find (fun w -> XmlEdit.id w = id) xml_wpts in
+  if wp#deleted then begin
+    XmlEdit.delete node
+  end else
+    let utm = utm_of WGS84 (wp#pos) in
+    try
+      let (dx, dy) = utm_sub utm utm0 in
+      XmlEdit.set_attribs node ["name",wp#name; "x",sof dx; "y",sof dy; "alt", sof wp#alt]
+    with
+      _ ->
+	prerr_endline "MapFP.update_xml: waypoint too far from ref (FIXME)"
       
 let new_wp = fun geomap xml_tree waypoints utm_ref ?(alt = 0.) node ->
   let float_attrib = fun a -> float_of_string (XmlEdit.attrib node a) in
@@ -102,7 +105,8 @@ let new_wp = fun geomap xml_tree waypoints utm_ref ?(alt = 0.) node ->
   geomap#register_to_fit (wp:>MapCanvas.geographic);
   XmlEdit.connect node (update_wp utm_ref wp);
   XmlEdit.connect node (update_wp_refs (ref name) xml_tree); 
-  wp#connect (fun () -> update_xml xml_tree utm_ref wp);
+  let id = XmlEdit.id node in
+  wp#connect (fun () -> update_xml xml_tree utm_ref wp id);
   wp
 
 let gensym =
@@ -119,9 +123,9 @@ let georef_of_xml = fun xml ->
   {posn_lat = (Deg>>Rad)lat0; posn_long = (Deg>>Rad)lon0 }
 
  
-class flight_plan = fun ?edit ~show_moved geomap color fp_dtd xml ->
+class flight_plan = fun ?editable ~show_moved geomap color fp_dtd xml ->
   (** Xml Editor *)
-  let xml_tree_view, xml_window = XmlEdit.create ?edit (Dtd.parse_file fp_dtd) xml in
+  let xml_tree_view, xml_window = XmlEdit.create ?editable (Dtd.parse_file fp_dtd) xml in
   let xml_root = XmlEdit.root xml_tree_view in
   let xml_wpts = XmlEdit.child xml_root "waypoints" in
 
@@ -131,7 +135,7 @@ class flight_plan = fun ?edit ~show_moved geomap color fp_dtd xml ->
   let utm0 = utm_of WGS84 ref_wgs84 in
 
   (** The graphical waypoints *)
-  let wpts_group = new MapWaypoints.group ~show_moved ~color ~editable:true geomap in
+  let wpts_group = new MapWaypoints.group ~show_moved ~color ?editable geomap in
 
   let yaws = Hashtbl.create 5 in (* Yes Another Waypoints Store *)
   let create_wp =

sw/lib/ocaml/mapFP.mli

@@ -26,7 +26,7 @@
 
 (** [flight_plan geomap color dtd_tile xml] *)
 class flight_plan :
-  ?edit:bool ->
+  ?editable:bool ->
   show_moved:bool ->
   MapCanvas.widget ->
   string ->

sw/lib/ocaml/mapWaypoints.ml

@@ -95,7 +95,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 ->
 
       let wgs84 = self#pos in
       let s = sprintf "WGS84 %s" (geomap#geo_string wgs84) in
-      let ename  = GEdit.entry ~text:name ~editable:false ~packing:dvbx#add () in
+      let ename  = GEdit.entry ~text:name ~editable ~packing:dvbx#add () in
       let e_pos  = GEdit.entry ~text:s ~packing:dvbx#add () in
       let ha = GPack.hbox ~packing:dvbx#add () in
       let minus10= GButton.button ~label:"-10" ~packing:ha#add () in
@@ -116,11 +116,22 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 ->
 	  moved <- anim moved;
 	dialog#destroy ()
       in
+      let dhbx = GPack.box `HORIZONTAL ~packing: dvbx#add () in
 
-      let cancel = GButton.button ~stock:`CANCEL ~packing: dvbx#add () in 
+      let cancel = GButton.button ~stock:`CANCEL ~packing: dhbx#add () in 
       ignore(cancel#connect#clicked ~callback:dialog#destroy);
 
-      let ok = GButton.button ~stock:`OK ~packing: dvbx#add () in
+      if editable then begin
+	let delete = GButton.button ~stock:`DELETE ~packing: dhbx#add () in 
+	let delete_callback = fun () ->
+	  dialog#destroy ();
+	self#delete ();
+	  updated ()
+	in
+	ignore(delete#connect#clicked ~callback:delete_callback)
+      end;
+
+      let ok = GButton.button ~stock:`OK ~packing: dhbx#add () in
       List.iter
 	(fun e -> ignore (e#connect#activate ~callback))
 	[ename; e_pos; ea];
@@ -168,7 +179,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 ->
 	| _ -> ()
       end;
       true
-    initializer ignore(if editable then ignore (item#connect#event self#event))
+    initializer ignore(item#connect#event self#event)
     method moved = moved <> None
     method reset_moved () = 
       match moved with
@@ -201,7 +212,7 @@ class waypoint = fun (wpts_group:group) (name :string) ?(alt=0.) wgs84 ->
 	  if update then updated ()
       | (None, false) | (Some _, true) -> ()
       | Some x, false -> self#reset_moved ()
-    method delete =
+    method delete () =
       deleted <- true; (* BOF *)
       wpt_group#destroy ()
     method zoom (z:float) =

sw/lib/ocaml/mapWaypoints.mli

@@ -44,7 +44,7 @@ class waypoint :
   Latlong.geographic ->
   object
     method alt : float
-    method delete : unit
+    method delete : unit -> unit
     method edit : unit
     method pos : Latlong.geographic
     method event : GnoCanvas.item_event -> bool

sw/lib/ocaml/xmlEdit.ml

@@ -100,15 +100,22 @@ let tag_col = cols#add Gobject.Data.string
 let attributes = cols#add Gobject.Data.caml
 let event = cols#add Gobject.Data.caml
 let background = cols#add Gobject.Data.string
+let id = cols#add Gobject.Data.int
 
 let string_of_attribs = fun attribs ->
   List.fold_right (fun (a,v) r -> sprintf " %s=\"%s\"%s" a v r) attribs ""
 
+type id = int
+let gen_id = 
+  let x = ref 0 in 
+  fun () -> incr x; !x
+
 let set_xml = fun (store:GTree.tree_store) row xml ->
   store#set ~row ~column:tag_col (Xml.tag xml);
   store#set ~row ~column:background default_background;
   store#set ~row ~column:attributes (Xml.attribs xml);
-  store#set ~row ~column:event (fun _ -> ())
+  store#set ~row ~column:event (fun _ -> ());
+  store#set ~row ~column:id (gen_id ())
 
 
 let rec insert_xml = fun (store:GTree.tree_store) parent xml ->
@@ -375,6 +382,10 @@ let add_child = fun ((model, path):node) tag attribs ->
   set_xml model row (Xml.Element (tag, attribs, []));
   model, model#get_path row
 
+let id = fun ((model, path):node) ->
+  let row = model#get_iter path in
+  model#get ~row ~column:id
+
 let connect = fun ((model, path):node) cb ->
   let row = model#get_iter path in
   let current_cb = try model#get ~row ~column:event with _ -> fun _ -> () in
@@ -446,13 +457,13 @@ let tree_menu_popup = fun dtd (model:GTree.tree_store) (row:Gtk.tree_iter) ->
 
 
  
-let create = fun ?(edit=true) ?(width = 400) dtd xml ->
+let create = fun ?(editable=true) ?(width = 400) dtd xml ->
   let tree_model = tree_model_of_xml xml in
   let attribs_model = model_of_attribs () in
   let hbox = GPack.hbox () in
   let sw = GBin.scrolled_window ~width ~hpolicy:`AUTOMATIC
       ~vpolicy:`AUTOMATIC ~packing:hbox#add () in
-  let tree_view = tree_view ~edit tree_model sw in
+  let tree_view = tree_view ~edit:editable tree_model sw in
   tree_view#set_border_width 10;
 
   let sw = GBin.scrolled_window ~width:150 ~hpolicy:`AUTOMATIC
@@ -460,7 +471,7 @@ let create = fun ?(edit=true) ?(width = 400) dtd xml ->
   let attribs_view = attribs_view attribs_model in
   attribs_view#set_border_width 10;
   sw#add attribs_view#coerce;
-  if edit then
+  if editable then
     hbox#add sw#coerce;
 
   let update_tree = fun _path ->
@@ -494,7 +505,7 @@ let create = fun ?(edit=true) ?(width = 400) dtd xml ->
 	let cbs = try  (Hashtbl.find activated_cbs tree_model) with Not_found -> [] in
 	List.iter (fun cb -> cb (tree_model, path)) cbs) in
 
-  if edit then begin
+  if editable then begin
     let _c = add_context_menu tree_model tree_view (tree_menu_popup dtd) in
     let _c = add_context_menu attribs_model attribs_view ~noselection_menu:(add_one_menu dtd tree_view) (attribs_menu_popup dtd tree_view) in
     

sw/lib/ocaml/xmlEdit.mli

@@ -40,7 +40,7 @@ type attributes = attribute list
 
 type event = Deleted | Modified of attributes | New_child of node
 
-val create : ?edit:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget)
+val create : ?editable:bool -> ?width:int -> Dtd.dtd -> Xml.xml -> (t * GObj.widget)
 (** [create dtd xml] Opens a display of [xml] with contextual right button
 actions constrained by [dtd]. Returns the corresponding model. *)
 
@@ -73,3 +73,6 @@ val selection : t -> node
 val expand_node : ?all:bool -> t -> node -> unit
 
 val set_background : ?all:bool -> node -> string -> unit
+
+type id = int
+val id : node -> id