untabify messages.ml

sw/ground_segment/tmtc/messages.ml

@@ -28,7 +28,7 @@ open Printf
 
 let list_sort = fun f l -> List.sort (fun x y -> compare (f x) (f y)) l
 
-let display_delay = 500 (* Time in second between two updates *)
+let display_delay = 500 (* Time in milliseconds between two updates *)
 let led_delay = 500 (* Time in milliseconds while the green led is displayed *)
 
 let dnd_targets = [ { Gtk.target = "STRING"; flags = []; info = 0} ]
@@ -38,7 +38,7 @@ let values_of_field = fun field ->
   try
     Array.of_list (Str.split pipe_regexp (Xml.attrib field "values"))
   with
-    _ -> [||]
+      _ -> [||]
 
 (** Display one page for a message *)
 let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
@@ -54,54 +54,54 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
   let fields =
     List.fold_left
       (fun rest f ->
-	try
-	  let unit = try "("^Xml.attrib f "unit"^")" with _ -> "" in
-	  let field_name =  Xml.attrib f "name" in
-	  let type_ = ExtXml.attrib f "type" in
-	  let name = Printf.sprintf "%s %s %s: " type_ field_name unit in
-	  let h = GPack.hbox ~packing:v#pack () in
-	  let field_label = GButton.button ~label:name ~packing:h#pack () in
+        try
+          let unit = try "("^Xml.attrib f "unit"^")" with _ -> "" in
+          let field_name =  Xml.attrib f "name" in
+          let type_ = ExtXml.attrib f "type" in
+          let name = Printf.sprintf "%s %s %s: " type_ field_name unit in
+          let h = GPack.hbox ~packing:v#pack () in
+          let field_label = GButton.button ~label:name ~packing:h#pack () in
 
-	  let value = ref "XXXX" in
-	  let l = GMisc.label ~text: !value ~packing:h#pack () in
-	  let literal_values = values_of_field f in
-	  let alt_value =
-	    try
-	      let coeff = float_of_string (Pprz.alt_unit_coef_of_xml f)
-	      and unit = Xml.attrib f "alt_unit" in
-	      fun value -> sprintf "%s (%f%s)" value (coeff*.float_of_string value) unit
-	    with
-	      _ -> fun value -> value in
-	  let update = fun (_a, x) ->
-	    value :=
-	      try
-		let i = Pprz.int_of_value x in
-		sprintf "%s (%d)" literal_values.(i) i
-	      with _ ->
-		alt_value (Pprz.string_of_value x)
-	  and display_value = fun () ->
-	    if notebook#page_num v#coerce = notebook#current_page then
-	      if l#label <> !value then l#set_text !value in
+          let value = ref "XXXX" in
+          let l = GMisc.label ~text: !value ~packing:h#pack () in
+          let literal_values = values_of_field f in
+          let alt_value =
+            try
+              let coeff = float_of_string (Pprz.alt_unit_coef_of_xml f)
+              and unit = Xml.attrib f "alt_unit" in
+              fun value -> sprintf "%s (%f%s)" value (coeff*.float_of_string value) unit
+            with
+                _ -> fun value -> value in
+          let update = fun (_a, x) ->
+            value :=
+              try
+                let i = Pprz.int_of_value x in
+                sprintf "%s (%d)" literal_values.(i) i
+              with _ ->
+                alt_value (Pprz.string_of_value x)
+          and display_value = fun () ->
+            if notebook#page_num v#coerce = notebook#current_page then
+              if l#label <> !value then l#set_text !value in
 
-	  (* box dragger *)
-	  field_label#drag#source_set dnd_targets ~modi:[`BUTTON1] ~actions:[`COPY];
-	  let data_get = fun _ (sel:GObj.selection_context) ~info ~time ->
-      let scale = Pprz.alt_unit_coef_of_xml f in
-	    let field_descr =
-	      if Pprz.is_array_type type_ then
-		match GToolbox.input_string ~title:"Index of value to drag" ~text:"0" "Index in the array ?" with
-		  None -> field_name
-		| Some i -> sprintf "%s[%s]" field_name i
-	      else
-		field_name in
-	    sel#return (sprintf "%s:%s:%s:%s:%s" sender class_name id field_descr scale) in
-	  ignore (field_label#drag#connect#data_get ~callback:data_get);
+          (* box dragger *)
+          field_label#drag#source_set dnd_targets ~modi:[`BUTTON1] ~actions:[`COPY];
+          let data_get = fun _ (sel:GObj.selection_context) ~info ~time ->
+            let scale = Pprz.alt_unit_coef_of_xml f in
+            let field_descr =
+              if Pprz.is_array_type type_ then
+                match GToolbox.input_string ~title:"Index of value to drag" ~text:"0" "Index in the array ?" with
+                    None -> field_name
+                  | Some i -> sprintf "%s[%s]" field_name i
+              else
+                field_name in
+            sel#return (sprintf "%s:%s:%s:%s:%s" sender class_name id field_descr scale) in
+          ignore (field_label#drag#connect#data_get ~callback:data_get);
 
-	  (update, display_value)::rest
-	with
-	  _ ->
-	    fprintf stderr "Warning: Ignoring '%s'\n%!" (Xml.to_string f);
-	    rest
+          (update, display_value)::rest
+        with
+            _ ->
+              fprintf stderr "Warning: Ignoring '%s'\n%!" (Xml.to_string f);
+              rest
       )
       []
       (Xml.children m)
@@ -128,17 +128,17 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
       shown := true;
       (** Look for the right position in alphabetic order *)
       let rec loop = fun i ->
-	let p = notebook#get_nth_page i in
-	let t = notebook#get_tab_label p in
-	match t#misc#get_property "name" with
-	| `STRING (Some x) -> if x < id then loop (i+1) else i
-	| _ -> raise Not_found
+        let p = notebook#get_nth_page i in
+        let t = notebook#get_tab_label p in
+        match t#misc#get_property "name" with
+          | `STRING (Some x) -> if x < id then loop (i+1) else i
+          | _ -> raise Not_found
       in
       try
-	let pos = loop 0 in
-	ignore (notebook#insert_page ~pos ~tab_label:h#coerce v#coerce)
+        let pos = loop 0 in
+        ignore (notebook#insert_page ~pos ~tab_label:h#coerce v#coerce)
       with _ ->
-	ignore (notebook#append_page ~tab_label:h#coerce v#coerce)
+        ignore (notebook#append_page ~tab_label:h#coerce v#coerce)
     end;
     time_since_last := 0;
     try
@@ -147,9 +147,9 @@ let one_page = fun sender class_name (notebook:GPack.notebook) bind m ->
       eb#coerce#misc#set_state `SELECTED;
       ignore (GMain.Timeout.add led_delay (fun () -> eb#coerce#misc#set_state `NORMAL; false))
     with
-      Invalid_argument "List.iter2" ->
-	Printf.fprintf stderr "%s: expected %d args, got %d\n" id n (List.length values); flush stderr
-    | exc -> prerr_endline (Printexc.to_string exc)
+        Invalid_argument "List.iter2" ->
+          Printf.fprintf stderr "%s: expected %d args, got %d\n" id n (List.length values); flush stderr
+      | exc -> prerr_endline (Printexc.to_string exc)
   in
   bind id display
 
@@ -159,24 +159,24 @@ let rec one_class = fun (notebook:GPack.notebook) (ident, xml_class, sender) ->
   let module P = Pprz.Messages (struct let name = class_name end) in
   let senders = Hashtbl.create 5 in
   match sender with
-  | Some "*" ->
+    | Some "*" ->
       (* Waiting for a new sender in this class *)
       let get_one = fun sender _vs ->
-	if not (Hashtbl.mem senders sender) then begin
-	  Hashtbl.add senders sender ();
-	  one_class notebook (ident,  xml_class, Some sender)
-	end in
+	    if not (Hashtbl.mem senders sender) then begin
+	      Hashtbl.add senders sender ();
+	      one_class notebook (ident,  xml_class, Some sender)
+	    end in
       List.iter
-	(fun m -> ignore (P.message_bind (Xml.attrib m "name") get_one))
-	messages
-  | _ ->
+	    (fun m -> ignore (P.message_bind (Xml.attrib m "name") get_one))
+	    messages
+    | _ ->
       let class_notebook = GPack.notebook ~tab_border:0 ~tab_pos:`LEFT () in
       let l = match sender with None -> "" | Some s -> ":"^s in
       let label = GMisc.label ~text:(ident^l) () in
       ignore (notebook#append_page ~tab_label:label#coerce class_notebook#coerce);
       let bind, sender_name = match sender with
-	None -> (fun m cb -> (P.message_bind m cb)), "*"
-      | Some sender -> (fun m cb -> (P.message_bind ~sender m cb)), sender in
+	      None -> (fun m cb -> (P.message_bind m cb)), "*"
+        | Some sender -> (fun m cb -> (P.message_bind ~sender m cb)), sender in
 
       (** Forall messages in the class *)
       let messages = list_sort (fun x -> Xml.attrib x "name") messages in
@@ -212,14 +212,14 @@ let _ =
     let xml = Pprz.messages_xml () in
     let class_of = fun n ->
       try
-	List.find (fun x -> ExtXml.attrib x "name" = n) (Xml.children xml)
+	    List.find (fun x -> ExtXml.attrib x "name" = n) (Xml.children xml)
       with Not_found -> failwith (sprintf "Unknown messages class: %s" n) in
 
     List.map (fun x ->
       match Str.split (Str.regexp ":") x with
-	[cl; s] -> (cl, class_of cl, Some s)
-      | [cl] -> (x, class_of cl, None)
-      | _ -> failwith (sprintf "Wrong class '%s', class[:sender] expected" x))
+	      [cl; s] -> (cl, class_of cl, Some s)
+        | [cl] -> (x, class_of cl, None)
+        | _ -> failwith (sprintf "Wrong class '%s', class[:sender] expected" x))
       !classes in
 
   (* Insert the message classes in the notebook *)