Index: utils/warnings.ml
===================================================================
--- utils/warnings.ml	(revision 12195)
+++ utils/warnings.ml	(working copy)
@@ -208,90 +208,94 @@
 let () = parse_options false defaults_w;;
 let () = parse_options true defaults_warn_error;;
 
-let message = function
-  | Comment_start -> "this is the start of a comment."
-  | Comment_not_end -> "this is not the end of a comment."
-  | Deprecated -> "this syntax is deprecated."
+let print ppf = function
+  | Comment_start -> Format.fprintf ppf "this is the start of a comment."
+  | Comment_not_end -> Format.fprintf ppf "this is not the end of a comment."
+  | Deprecated -> Format.fprintf ppf "this syntax is deprecated."
   | Fragile_match "" ->
-      "this pattern-matching is fragile."
+      Format.fprintf ppf "this pattern-matching is fragile."
   | Fragile_match s ->
-      "this pattern-matching is fragile.\n\
-       It will remain exhaustive when constructors are added to type " ^ s ^ "."
+      Format.fprintf ppf "this pattern-matching is fragile.@\n\
+        It will remain exhaustive when constructors are added to type %s." s
   | Partial_application ->
-      "this function application is partial,\n\
-       maybe some arguments are missing."
+      Format.fprintf ppf "this function application is partial,@\n\
+        maybe some arguments are missing."
   | Labels_omitted ->
-      "labels were omitted in the application of this function."
+      Format.fprintf ppf "labels were omitted in the application of this function."
   | Method_override [lab] ->
-      "the method " ^ lab ^ " is overridden."
+      Format.fprintf ppf "the method %s is overridden." lab
   | Method_override (cname :: slist) ->
-      String.concat " "
-        ("the following methods are overridden by the class"
-         :: cname  :: ":\n " :: slist)
+      Format.fprintf ppf "the following methods are overridden by the class %s:@\n" cname;
+      List.iter (fun s -> Format.fprintf ppf " %s" s) slist
   | Method_override [] -> assert false
-  | Partial_match "" -> "this pattern-matching is not exhaustive."
+  | Partial_match "" -> Format.fprintf ppf "this pattern-matching is not exhaustive."
   | Partial_match s ->
-      "this pattern-matching is not exhaustive.\n\
-       Here is an example of a value that is not matched:\n" ^ s
+      Format.fprintf ppf "this pattern-matching is not exhaustive.@\n\
+        Here is an example of a value that is not matched:@\n%s" s
   | Non_closed_record_pattern s ->
-      "the following labels are not bound in this record pattern:\n" ^ s ^
-      "\nEither bind these labels explicitly or add `; _' to the pattern."
+      Format.fprintf ppf "the following labels are not bound in this record pattern:@\n%s@\n\
+        Either bind these labels explicitly or add `; _' to the pattern." s
   | Statement_type ->
-      "this expression should have type unit."
-  | Unused_match -> "this match case is unused."
-  | Unused_pat   -> "this sub-pattern is unused."
+      Format.fprintf ppf "this expression should have type unit."
+  | Unused_match -> Format.fprintf ppf "this match case is unused."
+  | Unused_pat   -> Format.fprintf ppf "this sub-pattern is unused."
   | Instance_variable_override [lab] ->
-      "the instance variable " ^ lab ^ " is overridden.\n" ^
-      "The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+      Format.fprintf ppf "the instance variable %s is overridden.@\n\
+        The behaviour changed in ocaml 3.10 (previous behaviour was hiding.)" lab
   | Instance_variable_override (cname :: slist) ->
-      String.concat " "
-        ("the following instance variables are overridden by the class"
-         :: cname  :: ":\n " :: slist) ^
-      "\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
+      Format.fprintf ppf "the following instance variables are overridden by the class %s:@\n" cname;
+      List.iter (fun s -> Format.fprintf ppf " %s" s) slist;
+      Format.fprintf ppf "@\nThe behaviour changed in ocaml 3.10 (previous behaviour was hiding.)"
   | Instance_variable_override [] -> assert false
-  | Illegal_backslash -> "illegal backslash escape in string."
+  | Illegal_backslash -> Format.fprintf ppf "illegal backslash escape in string."
   | Implicit_public_methods l ->
-      "the following private methods were made public implicitly:\n "
-      ^ String.concat " " l ^ "."
-  | Unerasable_optional_argument -> "this optional argument cannot be erased."
-  | Undeclared_virtual_method m -> "the virtual method "^m^" is not declared."
-  | Not_principal s -> s^" is not principal."
-  | Without_principality s -> s^" without principality."
-  | Unused_argument -> "this argument will not be used by the function."
-  | Nonreturning_statement ->
-      "this statement never returns (or has an unsound type.)"
-  | Camlp4 s -> s
+      Format.fprintf ppf "the following private methods were made public implicitly:@\n %s."
+        (String.concat " " l)
+  | Unerasable_optional_argument -> Format.fprintf ppf "this optional argument cannot be erased."
+  | Undeclared_virtual_method m -> Format.fprintf ppf "the virtual method %s is not declared." m
+  | Not_principal s -> Format.fprintf ppf "%s is not principal." s
+  | Without_principality s -> Format.fprintf ppf "%s without principality." s
+  | Unused_argument -> Format.fprintf ppf "this argument will not be used by the function."
+  | Nonreturning_statement -> Format.fprintf ppf "this statement never returns (or has an unsound type.)"
+  | Camlp4 s -> Format.fprintf ppf "%s" s
   | Useless_record_with ->
-      "this record is defined by a `with' expression,\n\
-       but no fields are borrowed from the original."
-  | Bad_module_name (modname) ->
-      "bad source file name: \"" ^ modname ^ "\" is not a valid module name."
+      Format.fprintf ppf "this record is defined by a `with' expression,@\n\
+        but no fields are borrowed from the original."
+  | Bad_module_name modname ->
+      Format.fprintf ppf "bad source file name: \"%s\" is not a valid module name." modname
   | All_clauses_guarded ->
-      "bad style, all clauses in this pattern-matching are guarded."
-  | Unused_var v | Unused_var_strict v -> "unused variable " ^ v ^ "."
+      Format.fprintf ppf "bad style, all clauses in this pattern-matching are guarded."
+  | Unused_var v | Unused_var_strict v -> Format.fprintf ppf "unused variable %s." v
   | Wildcard_arg_to_constant_constr ->
-     "wildcard pattern given as argument to a constant constructor"
+      Format.fprintf ppf
+        "wildcard pattern given as argument to a constant constructor"
   | Eol_in_string ->
-     "unescaped end-of-line in a string constant (non-portable code)"
+      Format.fprintf ppf
+        "unescaped end-of-line in a string constant (non-portable code)"
   | Duplicate_definitions (kind, cname, tc1, tc2) ->
-      Printf.sprintf "the %s %s is defined in both types %s and %s."
+      Format.fprintf ppf "the %s %s is defined in both types %s and %s."
         kind cname tc1 tc2
   | Multiple_definition(modname, file1, file2) ->
-      Printf.sprintf
+      Format.fprintf ppf
         "files %s and %s both define a module named %s"
         file1 file2 modname
-  | Unused_value_declaration v -> "unused value " ^ v ^ "."
-  | Unused_open s -> "unused open " ^ s ^ "."
-  | Unused_type_declaration s -> "unused type " ^ s ^ "."
-  | Unused_for_index s -> "unused for-loop index " ^ s ^ "."
-  | Unused_ancestor s -> "unused ancestor variable " ^ s ^ "."
-  | Unused_constructor s -> "unused constructor " ^ s ^ "."
-  | Unused_exception s -> "unused exception constructor " ^ s ^ "."
+  | Unused_value_declaration v -> Format.fprintf ppf "unused value %s." v
+  | Unused_open s -> Format.fprintf ppf "unused open %s." s
+  | Unused_type_declaration s -> Format.fprintf ppf "unused type %s." s
+  | Unused_for_index s -> Format.fprintf ppf "unused for-loop index %s." s
+  | Unused_ancestor s -> Format.fprintf ppf "unused ancestor variable %s." s
+  | Unused_constructor s -> Format.fprintf ppf "unused constructor %s." s
+  | Unused_exception s -> Format.fprintf ppf "unused exception constructor %s." s
 ;;
 
 let nerrors = ref 0;;
 
 let print ppf w =
+  let num = number w in
+  if error.(number w) then incr nerrors;
+  Format.fprintf ppf "Warning %d: %a" num print w
+(*
+let print ppf w =
   let msg = message w in
   let num = number w in
   let newlines = ref 0 in
@@ -309,6 +313,7 @@
   if error.(num) then incr nerrors;
   !newlines
 ;;
+*)
 
 exception Errors of int;;
 
Index: utils/warnings.mli
===================================================================
--- utils/warnings.mli	(revision 12195)
+++ utils/warnings.mli	(working copy)
@@ -63,10 +63,8 @@
 val defaults_w : string;;
 val defaults_warn_error : string;;
 
-val print : formatter -> t -> int;;
-  (* returns the number of newlines in the printed string *)
+val print : formatter -> t -> unit;;
 
-
 exception Errors of int;;
 
 val check_fatal : unit -> unit;;
Index: parsing/location.ml
===================================================================
--- parsing/location.ml	(revision 12195)
+++ parsing/location.ml	(working copy)
@@ -256,14 +256,15 @@
 
 let print_warning loc ppf w =
   if Warnings.is_active w then begin
-    let printw ppf w =
-      let n = Warnings.print ppf w in
-      num_loc_lines := !num_loc_lines + n
+    print ppf loc;
+    let (out, flush, newline, space) =
+      Format.pp_get_all_formatter_output_functions ppf ()
     in
-    print ppf loc;
-    fprintf ppf "Warning %a@." printw w;
-    pp_print_flush ppf ();
-    incr num_loc_lines;
+    let countnewline x = incr num_loc_lines; newline x in
+    Format.pp_set_all_formatter_output_functions ppf out flush countnewline space;
+    Format.fprintf ppf "%a@." Warnings.print w;
+    Format.pp_print_flush ppf ();
+    Format.pp_set_all_formatter_output_functions ppf out flush newline space;
   end
 ;;