Additional documentation for format strings.

git-svn-id: http://caml.inria.fr/svn/ocaml/trunk@12407 f963ae5c-01c2-4b8c-9fe0-0dff7051ff02

1 files changed, 67 insertions, 33 deletions

diff --git a/stdlib/format.ml b/stdlib/format.ml
index 28bb5f1c59..445e824206 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -43,7 +43,7 @@ type pp_token =
 | Pp_newline                   (* to force a newline inside a block *)
 | Pp_if_newline                (* to do something only if this very
                                   line has been broken *)
-| Pp_open_tag of string        (* opening a tag name *)
+| Pp_open_tag of tag           (* opening a tag name *)
 | Pp_close_tag                 (* closing the most recently opened tag *)
 
 and tag = string
@@ -147,13 +147,13 @@ type formatter = {
   (* Ellipsis string. *)
   mutable pp_ellipsis : string;
   (* Output function. *)
-  mutable pp_output_function : string -> int -> int -> unit;
+  mutable pp_out_string : string -> int -> int -> unit;
   (* Flushing function. *)
-  mutable pp_flush_function : unit -> unit;
+  mutable pp_out_flush : unit -> unit;
   (* Output of new lines. *)
-  mutable pp_output_newline : unit -> unit;
+  mutable pp_out_newline : unit -> unit;
   (* Output of indentation spaces. *)
-  mutable pp_output_spaces : int -> unit;
+  mutable pp_out_spaces : int -> unit;
   (* Are tags printed ? *)
   mutable pp_print_tags : bool;
   (* Are tags marked ? *)
@@ -240,9 +240,9 @@ let pp_clear_queue state =
 let pp_infinity = 1000000010;;
 
 (* Output functions for the formatter. *)
-let pp_output_string state s = state.pp_output_function s 0 (String.length s)
-and pp_output_newline state = state.pp_output_newline ()
-and pp_display_blanks state n = state.pp_output_spaces n
+let pp_output_string state s = state.pp_out_string s 0 (String.length s)
+and pp_output_newline state = state.pp_out_newline ()
+and pp_output_spaces state n = state.pp_out_spaces n
 ;;
 
 (* To format a break, indenting a new line. *)
@@ -254,7 +254,7 @@ let break_new_line state offset width =
   let real_indent = min state.pp_max_indent indent in
   state.pp_current_indent <- real_indent;
   state.pp_space_left <- state.pp_margin - state.pp_current_indent;
-  pp_display_blanks state state.pp_current_indent
+  pp_output_spaces state state.pp_current_indent
 ;;
 
 (* To force a line break inside a block: no offset is added. *)
@@ -263,7 +263,7 @@ let break_line state width = break_new_line state 0 width;;
 (* To format a break that fits on the current line. *)
 let break_same_line state width =
   state.pp_space_left <- state.pp_space_left - width;
-  pp_display_blanks state width
+  pp_output_spaces state width
 ;;
 
 (* To indent no more than pp_max_indent, if one tries to open a block
@@ -675,9 +675,9 @@ and pp_open_box state indent = pp_open_box_gen state indent Pp_box;;
 (* Print a new line after printing all queued text
    (same for print_flush but without a newline). *)
 let pp_print_newline state () =
-  pp_flush_queue state true; state.pp_flush_function ()
+  pp_flush_queue state true; state.pp_out_flush ()
 and pp_print_flush state () =
-  pp_flush_queue state false; state.pp_flush_function ();;
+  pp_flush_queue state false; state.pp_out_flush ();;
 
 (* To get a newline when one does not want to close the current block. *)
 let pp_force_newline state () =
@@ -808,42 +808,70 @@ let pp_set_margin state n =
 
 let pp_get_margin state () = state.pp_margin;;
 
+type formatter_out_functions = {
+  out_string : string -> int -> int -> unit;
+  out_flush : unit -> unit;
+  out_newline : unit -> unit;
+  out_spaces : int -> unit;
+}
+;;
+
+let pp_set_formatter_out_functions state {
+      out_string = f;
+      out_flush = g;
+      out_newline = h;
+      out_spaces = i;
+    } =
+  state.pp_out_string <- f;
+  state.pp_out_flush <- g;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i;
+;;
+
+let pp_get_formatter_out_functions state () = {
+  out_string = state.pp_out_string;
+  out_flush = state.pp_out_flush;
+  out_newline = state.pp_out_newline;
+  out_spaces = state.pp_out_spaces;
+}
+;;
+
 let pp_set_formatter_output_functions state f g =
-  state.pp_output_function <- f; state.pp_flush_function <- g;;
+  state.pp_out_string <- f; state.pp_out_flush <- g;;
 let pp_get_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function)
+  (state.pp_out_string, state.pp_out_flush)
 ;;
 
 let pp_set_all_formatter_output_functions state
     ~out:f ~flush:g ~newline:h ~spaces:i =
   pp_set_formatter_output_functions state f g;
-  state.pp_output_newline <- h;
-  state.pp_output_spaces <- i;
+  state.pp_out_newline <- h;
+  state.pp_out_spaces <- i;
 ;;
 let pp_get_all_formatter_output_functions state () =
-  (state.pp_output_function, state.pp_flush_function,
-   state.pp_output_newline, state.pp_output_spaces)
+  (state.pp_out_string, state.pp_out_flush,
+   state.pp_out_newline, state.pp_out_spaces)
 ;;
 
 (* Default function to output new lines. *)
-let display_newline state () = state.pp_output_function "\n" 0  1;;
+let display_newline state () = state.pp_out_string "\n" 0  1;;
 
 (* Default function to output spaces. *)
 let blank_line = String.make 80 ' ';;
 let rec display_blanks state n =
   if n > 0 then
-  if n <= 80 then state.pp_output_function blank_line 0 n else
+  if n <= 80 then state.pp_out_string blank_line 0 n else
   begin
-    state.pp_output_function blank_line 0 80;
+    state.pp_out_string blank_line 0 80;
     display_blanks state (n - 80)
   end
 ;;
 
 let pp_set_formatter_out_channel state os =
-  state.pp_output_function <- output os;
-  state.pp_flush_function <- (fun () -> flush os);
-  state.pp_output_newline <- display_newline state;
-  state.pp_output_spaces <- display_blanks state;
+  state.pp_out_string <- output os;
+  state.pp_out_flush <- (fun () -> flush os);
+  state.pp_out_newline <- display_newline state;
+  state.pp_out_spaces <- display_blanks state;
 ;;
 
 (**************************************************************
@@ -855,8 +883,8 @@ let pp_set_formatter_out_channel state os =
 let default_pp_mark_open_tag s = "<" ^ s ^ ">";;
 let default_pp_mark_close_tag s = "</" ^ s ^ ">";;
 
-let default_pp_print_open_tag _ = ();;
-let default_pp_print_close_tag = default_pp_print_open_tag;;
+let default_pp_print_open_tag = ignore;;
+let default_pp_print_close_tag = ignore;;
 
 let pp_make_formatter f g h i =
   (* The initial state of the formatter contains a dummy box. *)
@@ -883,10 +911,10 @@ let pp_make_formatter f g h i =
    pp_curr_depth = 1;
    pp_max_boxes = max_int;
    pp_ellipsis = ".";
-   pp_output_function = f;
-   pp_flush_function = g;
-   pp_output_newline = h;
-   pp_output_spaces = i;
+   pp_out_string = f;
+   pp_out_flush = g;
+   pp_out_newline = h;
+   pp_out_spaces = i;
    pp_print_tags = false;
    pp_mark_tags = false;
    pp_mark_open_tag = default_pp_mark_open_tag;
@@ -900,8 +928,8 @@ let pp_make_formatter f g h i =
 (* Make a formatter with default functions to output spaces and new lines. *)
 let make_formatter output flush =
   let ppf = pp_make_formatter output flush ignore ignore in
-  ppf.pp_output_newline <- display_newline ppf;
-  ppf.pp_output_spaces <- display_blanks ppf;
+  ppf.pp_out_newline <- display_newline ppf;
+  ppf.pp_out_spaces <- display_blanks ppf;
   ppf
 ;;
 
@@ -979,6 +1007,11 @@ and get_ellipsis_text = pp_get_ellipsis_text std_formatter
 and set_formatter_out_channel =
   pp_set_formatter_out_channel std_formatter
 
+and set_formatter_out_functions =
+  pp_set_formatter_out_functions std_formatter
+and get_formatter_out_functions =
+  pp_get_formatter_out_functions std_formatter
+
 and set_formatter_output_functions =
   pp_set_formatter_output_functions std_formatter
 and get_formatter_output_functions =
@@ -1347,5 +1380,6 @@ let bprintf b =
 (* Deprecated alias for ksprintf. *)
 let kprintf = ksprintf;;
 
+(* Output everything left in the pretty printer queue at end of execution. *)
 at_exit print_flush
 ;;