- GdomeNodeTypeT.TEXT_NODE,GdomeNodeTypeT.TEXT_NODE,_,_,_,_ when
- match f#get_nodeValue, t#get_nodeValue with
- Some v, Some v' -> v#to_string = v'#to_string
- | _,_ -> assert false
- ->
-prerr_endline ("XML_DIFF: preservo il nodo testo " ^ match f#get_nodeValue with Some v -> v#to_string | None -> assert false);
- ()
- | GdomeNodeTypeT.ELEMENT_NODE,GdomeNodeTypeT.ELEMENT_NODE,
- Some nu, Some nu', Some ln, Some ln' when
- ln#to_string = ln'#to_string && nu#to_string = nu'#to_string ->
-prerr_endline ("XML_DIFF: preservo il nodo "^ nu#to_string ^ ":" ^ln#to_string);
- begin
- match f#get_attributes, t#get_attributes with
- Some fattrs, Some tattrs ->
- let flen = fattrs#get_length in
- let tlen = tattrs#get_length in
- let processed = ref [] in
- for i = 0 to flen -1 do
- match fattrs#item i with
- None -> assert false
- | Some attr ->
- match attr#get_namespaceURI with
- None ->
- (* Back to DOM Level 1 ;-( *)
- begin
- let name = attr#get_nodeName in
- match tattrs#getNamedItem ~name with
- None ->
-myprerr_endline ("XML_DIFF: rimuovo l'attributo " ^ name#to_string);
- ignore (f#removeChild attr)
- | Some attr' ->
- processed :=
- (None,Some name)::!processed ;
- match attr#get_nodeValue, attr'#get_nodeValue with
- Some v1, Some v2 when
- v1#to_string = v2#to_string
- || (name#to_string = "selection" &&
- nu#to_string =
- "http://www.w3.org/1998/Math/MathML" &&
- ln#to_string = "maction")
- ->
-prerr_endline ("XML_DIFF: DOM 1; preservo l'attributo " ^ name#to_string);
- ()
- | Some v1, Some v2 ->
-myprerr_endline ("XML_DIFF: DOM 1; rimpiazzo l'attributo " ^ name#to_string ^ ": old value=" ^ v1#to_string ^ ", new value=" ^ v2#to_string);
- let attr'' = from#importNode attr' true in
- ignore (fattrs#setNamedItem attr'')
- | _,_ -> assert false
- end
- | Some namespaceURI ->
- let localName =
- match attr#get_localName with
- Some v -> v
- | None -> assert false
- in
- match
- tattrs#getNamedItemNS ~namespaceURI ~localName
- with
- None ->
-myprerr_endline ("XML_DIFF: rimuovo l'attributo " ^ localName#to_string);
- ignore (f#removeChild attr)
- | Some attr' ->
- processed :=
- (Some namespaceURI,Some localName)::!processed ;
- (*CSC: questo mi dice read-only ;-(
- attr#set_nodeValue attr'#get_nodeValue *)
- (*CSC: questo mi abortisce con una assert
- let attr'' = from#importNode attr' true in
- ignore(f#replaceChild ~newChild:attr'' ~oldChild:attr)*)
- match attr#get_nodeValue, attr'#get_nodeValue with
- Some v1, Some v2 when
- v1#to_string = v2#to_string ->
-prerr_endline ("XML_DIFF: DOM 2; preservo l'attributo " ^ namespaceURI#to_string ^ ":" ^ localName#to_string);
- ()
- | Some _, Some _ ->
-myprerr_endline ("XML_DIFF: DOM 2; rimpiazzo l'attributo " ^ namespaceURI#to_string ^ ":" ^ localName#to_string);
- let attr'' = from#importNode attr' true in
- ignore (fattrs#setNamedItem attr'')
- | _,_ -> assert false
- done ;
- for i = 0 to tlen -1 do
- match tattrs#item i with
- None -> assert false
- | Some attr ->
-let debugs = ref "" in
- let namespaceURI,localName =
- match attr#get_namespaceURI with
- None ->
-debugs := ("XML_DIFF: DOM 1.0; creo un nuovo attributo " ^ attr#get_nodeName#to_string) ;
- None,attr#get_nodeName
- | Some namespaceURI as v ->
-debugs := ("XML_DIFF: DOM 2.0; creo un nuovo attributo " ^ namespaceURI#to_string ^ ":" ^ match attr#get_localName with Some v -> v#to_string | None -> assert false);
- v, match attr#get_localName with
- None -> assert false
- | Some v -> v
- in
- if
- not
- (List.exists
- (function
- None,Some localName' ->
- (match namespaceURI with
- None ->
- localName#to_string = localName'#to_string
- | Some _ -> false)
- | Some namespaceURI', Some localName' ->
- (match namespaceURI with
- None -> false
- | Some namespaceURI ->
- localName#to_string = localName'#to_string &&
- namespaceURI#to_string=namespaceURI'#to_string
- )
- | _,_ -> assert false
- ) !processed)
- then
- let attr' = from#importNode attr false in
-myprerr_endline !debugs ;
- ignore (fattrs#setNamedItem attr')
- done
- | _,_ -> assert false
- end ;
- let fchildren = f#get_childNodes in
- let tchildren = t#get_childNodes in
- let rec dumb_diff =
- function
- [],[] -> ()
- | he1::tl1,he2::tl2 ->
-prerr_endline "XML_DIFF: processo una coppia di figli" ;
- aux f he1 he2 ;
- dumb_diff (tl1,tl2)
- | [],tl2 ->
-myprerr_endline "XML_DIFF: appendo i nodi residui" ;
- List.iter
- (function n ->
- let n' = from#importNode n true in
- ignore (f#appendChild n')
- ) tl2
- | tl1,[] ->
-myprerr_endline "XML_DIFF: cancello i nodi residui" ;
- List.iter (function n -> ignore (f#removeChild n)) tl1
- in
- let node_list_of_nodeList nl =
- let rec aux i =
- match nl#item ~index:i with
- None -> []
- | Some n when
- n#get_nodeType = GdomeNodeTypeT.ELEMENT_NODE
- or n#get_nodeType = GdomeNodeTypeT.TEXT_NODE ->
- n::(aux (i+1))
- | Some n ->
-prerr_endline ("XML_DIFF: mi sto perdendo i nodi di tipo " ^ string_of_int (Obj.magic n#get_nodeType)) ;
- aux (i+1)
- in
- aux 0
+ GdomeNodeTypeT.TEXT_NODE,GdomeNodeTypeT.TEXT_NODE ->
+ (match f#get_nodeValue, t#get_nodeValue with
+ Some v, Some v' when v#equals v' -> ()
+ | Some _, (Some _ as v') -> f#set_nodeValue v'
+ | _,_ -> assert false)
+ | GdomeNodeTypeT.ELEMENT_NODE as t1,GdomeNodeTypeT.ELEMENT_NODE ->
+ (match
+ f#get_namespaceURI,t#get_namespaceURI,f#get_localName,t#get_localName
+ with
+ Some nu, Some nu', Some ln, Some ln' when
+ ln#equals ln' && nu#equals nu' ->
+ begin
+ match f#get_attributes, t#get_attributes with
+ Some fattrs, Some tattrs ->
+ let flen = fattrs#get_length in
+ let tlen = tattrs#get_length in
+ let processed = ref [] in
+ for i = 0 to flen -1 do
+ match fattrs#item i with
+ None -> () (* CSC: sigh, togliere un nodo rompe fa decrescere la lunghezza ==> passare a un while *)
+ | Some attr ->
+ match attr#get_namespaceURI with
+ None ->
+ (* Back to DOM Level 1 ;-( *)
+ begin
+ let name = attr#get_nodeName in
+ match tattrs#getNamedItem ~name with
+ None ->
+ ignore (fattrs#removeNamedItem ~name)
+ | Some attr' ->
+ processed :=
+ (None,Some name)::!processed ;
+ match attr#get_nodeValue, attr'#get_nodeValue with
+ Some v1, Some v2 when
+ v1#equals v2
+ || (name#equals ds_selection &&
+ nu#equals ds_mathmlns &&
+ ln#equals ds_maction)
+ ->
+ ()
+ | Some v1, Some v2 ->
+ let attr'' = from#importNode attr' true in
+ ignore (fattrs#setNamedItem attr'')
+ | _,_ -> assert false
+ end
+ | Some namespaceURI ->
+ let localName =
+ match attr#get_localName with
+ Some v -> v
+ | None -> assert false
+ in
+ match
+ tattrs#getNamedItemNS ~namespaceURI ~localName
+ with
+ None ->
+ ignore
+ (fattrs#removeNamedItemNS
+ ~namespaceURI ~localName)
+ | Some attr' ->
+ processed :=
+ (Some namespaceURI,Some localName)::!processed ;
+ match attr#get_nodeValue, attr'#get_nodeValue with
+ Some v1, Some v2 when
+ v1#equals v2 ->
+ ()
+ | Some _, Some _ ->
+ let attr'' = from#importNode attr' true in
+ ignore (fattrs#setNamedItem attr'')
+ | _,_ -> assert false
+ done ;
+ for i = 0 to tlen -1 do
+ match tattrs#item i with
+ None -> assert false
+ | Some attr ->
+ let namespaceURI,localName =
+ match attr#get_namespaceURI with
+ None ->
+ None,attr#get_nodeName
+ | Some namespaceURI as v ->
+ v, match attr#get_localName with
+ None -> assert false
+ | Some v -> v
+ in
+ if
+ not
+ (List.exists
+ (function
+ None,Some localName' ->
+ (match namespaceURI with
+ None ->
+ localName#equals localName'
+ | Some _ -> false)
+ | Some namespaceURI', Some localName' ->
+ (match namespaceURI with
+ None -> false
+ | Some namespaceURI ->
+ localName#equals localName' &&
+ namespaceURI#equals namespaceURI'
+ )
+ | _,_ -> assert false
+ ) !processed)
+ then
+ let attr' = from#importNode attr false in
+ ignore (fattrs#setNamedItem attr')
+ done
+ | _,_ -> assert false
+ end ;
+ let rec dumb_diff =
+ function
+ [],[] -> ()
+ | he1::tl1,he2::tl2 ->
+ aux f he1 he2 ;
+ dumb_diff (tl1,tl2)
+ | [],tl2 ->
+ List.iter
+ (function n ->
+ let n' = from#importNode n true in
+ ignore (f#appendChild n') ;
+ ignore (highlight_node from n')
+ ) tl2
+ | tl1,[] ->
+ List.iter (function n -> ignore (f#removeChild n)) tl1