Introduction de l'indication de coupure ge'ne'rale dans printf.

Petit disfonctionnement dans les boi^tes standard, en cas de breaks
successifs en de'but de boi^te ayant donne' lieu a` une coupure de
ligne automatique.


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

2 files changed, 72 insertions, 37 deletions

diff --git a/stdlib/format.ml b/stdlib/format.ml
index 44b587bbd..e4cb30d15 100644
--- a/stdlib/format.ml
+++ b/stdlib/format.ml
@@ -42,7 +42,7 @@ and tblock = Pp_tbox of int list ref  (* Tabulation box *)
 ;;
 
 (* The Queue: contains all formatting elements.
-   elements are tuples (size,token,length), where
+   elements are tuples (size, token, length), where
    size is set when the size of the block is known
    len is the declared length of the token *)
 type pp_queue_elem =
@@ -74,27 +74,35 @@ type formatter =
  (* Global variables: default initialization is
     set_margin 78
     set_min_space_left 0 *)
- (* value of right margin *)
+ (* Value of right margin *)
  mutable pp_margin : int;
  (* Minimal space left before margin, when opening a block *)
  mutable pp_min_space_left : int;
- (* maximum value of indentation:
+ (* Maximum value of indentation:
     no blocks can be opened further *)
  mutable pp_max_indent : int;
- mutable pp_space_left : int;    (* space remaining on the current line *)
- mutable pp_current_indent : int;(* current value of indentation *)
- mutable pp_left_total : int;    (* total width of tokens already printed *)
- mutable pp_right_total : int;   (* total width of tokens ever put in queue *)
- mutable pp_curr_depth : int;    (* current number of opened blocks *)
- mutable pp_max_boxes : int;     (* maximum number of blocks which can be
-                                    opened at the same time *)
- mutable pp_ellipsis : string;   (* ellipsis string *)
+ (* Space remaining on the current line *)
+ mutable pp_space_left : int;
+ (* Current value of indentation *)
+ mutable pp_current_indent : int;
+ (* True when the line has been broken by the pretty-printer *)
+ mutable pp_is_new_line : bool;
+ (* Total width of tokens already printed *)
+ mutable pp_left_total : int;
+ (* Total width of tokens ever put in queue *)
+ mutable pp_right_total : int;
+ (* Current number of opened blocks *)
+ mutable pp_curr_depth : int;
+ (* Maximum number of blocks which can be simultaneously opened *)
+ mutable pp_max_boxes : int;
+ (* Ellipsis string *)
+ mutable pp_ellipsis : string;
+ (* Output function *)
  mutable pp_output_function : string -> int -> int -> unit;
-                                 (* output function *)
+ (* Flushing function *)
  mutable pp_flush_function : unit -> unit;
-                                 (* flushing function *)
+ (* The pretty-printer queue *)
  mutable pp_queue : pp_queue_elem queue
-                                 (* The pretty-printer queue *)
 };;
 
 (* Qeues *)
@@ -150,6 +158,7 @@ let display_blanks state n =
 (* To format a break, indenting a new line *)
 let break_new_line state offset width =
     pp_output_newline state;
+    state.pp_is_new_line <- true;
     let indent = state.pp_margin - width + offset in
     (* Don't indent more than pp_max_indent *)
     let real_indent = min state.pp_max_indent indent in
@@ -189,9 +198,10 @@ let format_pp_token state size = function
 
   | Pp_text s ->
       state.pp_space_left <- state.pp_space_left - size;
-      pp_output_string state s
+      pp_output_string state s;
+      state.pp_is_new_line <- false
 
-  | Pp_begin (off,ty) ->
+  | Pp_begin (off, ty) ->
       let insertion_point = state.pp_margin - state.pp_space_left in
       if insertion_point > state.pp_max_indent then
          (* can't open a block right there *)
@@ -250,28 +260,30 @@ let format_pp_token state size = function
 
   | Pp_newline ->
      begin match state.pp_format_stack with
-     | Format_elem (_,width) :: _ -> break_line state width
+     | Format_elem (_, width) :: _ -> break_line state width
      | _ -> pp_output_newline state
      end
 
   | Pp_if_newline ->
      if state.pp_current_indent != state.pp_margin - state.pp_space_left
-      then pp_skip_token state
+     then pp_skip_token state
 
   | Pp_break (n, off) ->
      begin match state.pp_format_stack with
-     | Format_elem (ty,width) :: _ ->
+     | Format_elem (ty, width) :: _ ->
         begin match ty with
         | Pp_hovbox ->
            if size > state.pp_space_left 
            then break_new_line state off width
            else break_same_line state n
         | Pp_box ->
+           (* Have the line just been broken here ? *)
+           if state.pp_is_new_line then break_same_line state n else
            if size > state.pp_space_left
             then break_new_line state off width else
            (* break the line here leads to new indentation ? *)
-           if state.pp_current_indent > state.pp_margin - width + off
-            then break_new_line state off width else break_same_line state n
+           if state.pp_current_indent > state.pp_margin + off - width
+           then break_new_line state off width else break_same_line state n
         | Pp_hvbox -> break_new_line state off width
         | Pp_fits -> break_same_line state n
         | Pp_vbox  -> break_new_line state off width
@@ -351,7 +363,7 @@ let scan_push state b tok =
     pp_enqueue state tok;
     if b then set_size state true;
     state.pp_scan_stack <-
-     Scan_elem (state.pp_right_total,tok) :: state.pp_scan_stack;;
+     Scan_elem (state.pp_right_total, tok) :: state.pp_scan_stack;;
 
 (*
   To open a new block :
@@ -573,6 +585,7 @@ let make_formatter f g =
   pp_max_indent = 78 - 10;
   pp_space_left = 78;
   pp_current_indent = 0;
+  pp_is_new_line = true;
   pp_left_total = 1;
   pp_right_total = 1;
   pp_curr_depth = 1;
@@ -663,9 +676,12 @@ let fprintf ppf format =
           | '.' ->
               pp_print_newline ppf ();
               doprn (succ j)
-          | ';' ->
+          | '\n' ->
               pp_force_newline ppf ();
               doprn (succ j)
+          | ';' ->
+              let j = do_pp_break ppf (i + 2) in
+              doprn j
           | _ -> invalid_arg ("fprintf: unknown format") end
       | '%' ->
           let j = skip_args (succ i) in
@@ -731,19 +747,21 @@ let fprintf ppf format =
     | '0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
     | c -> j
 
-  and get_box_size i =
+  and get_int s i =
+   if i >= limit then invalid_arg s else
    match format.[i] with
-   | ' ' -> get_box_size (i + 1)
+   | ' ' -> get_int s (i + 1)
    | c ->
-      let rec get_size j =
+      let rec get j =
+       if j >= limit then invalid_arg s else
        match format.[j] with
-       | '0' .. '9' | '-' -> get_size (succ j)
-       | '>' ->
+       | '0' .. '9' | '-' -> get (succ j)
+       | '>' | ' ' ->
          if j = i then 0, succ j else
           begin try int_of_string (String.sub format i (j-i)), succ j
-          with Failure _ -> invalid_arg "fprintf: bad box format" end
-       | c -> invalid_arg "fprintf: bad box format" in
-       get_size i
+          with Failure _ -> invalid_arg s end
+       | c -> invalid_arg s in
+       get i
 
   and get_box_kind j =
    if j >= limit then Pp_box, j else
@@ -766,13 +784,25 @@ let fprintf ppf format =
    | 'v' -> Pp_vbox, succ j
    | _ -> Pp_box, j
 
+  and do_pp_break ppf i =
+   if i >= limit
+   then begin pp_print_space ppf (); i end else
+   match format.[i] with
+   | '<' ->
+     let nspaces, j = get_int "fprintf: bad break format" (succ i) in
+     let offset, j = get_int "fprintf: bad break format" j in
+     if format.[pred j] != '>' then invalid_arg "fprintf: bad break format"
+     else pp_print_break ppf nspaces offset;
+     j
+   | c ->  pp_print_space ppf (); i
+
   and do_pp_open ppf i =
    if i >= limit
    then begin pp_open_box_gen ppf 0 Pp_box; i end else
    match format.[i] with
    | '<' ->
-     let k,j = get_box_kind (succ i) in
-     let size,j = get_box_size j in
+     let k, j = get_box_kind (succ i) in
+     let size, j = get_int "fprintf: bad box format" j in
      pp_open_box_gen ppf size k;
      j
    | c ->  pp_open_box_gen ppf 0 Pp_box; i
diff --git a/stdlib/format.mli b/stdlib/format.mli
index abb1190d0..258eee1c9 100644
--- a/stdlib/format.mli
+++ b/stdlib/format.mli
@@ -2,10 +2,10 @@
 (*                                                                     *)
 (*                           Objective Caml                            *)
 (*                                                                     *)
-(*            Pierre Weis, projet Cristal, INRIA Rocquencourt         *)
+(*            Pierre Weis, projet Cristal, INRIA Rocquencourt          *)
 (*                                                                     *)
 (*  Copyright 1996 Institut National de Recherche en Informatique et   *)
-(*  Automatique.  Distributed only by permission.                      *)
+(*  en Automatique.  Distributed only by permission.                   *)
 (*                                                                     *)
 (***********************************************************************)
 
@@ -28,7 +28,7 @@
 -   when the material for a box has been printed, call [close_box ()] to
    close the box;
 -   at the end of your routine, evaluate [print_newline ()] to close
-   all remaining boxes and flush the pretty-printer. *) 
+   all remaining boxes and flush the pretty-printer. *)
 
 (* You may alternatively consider this module as providing an extension to the
    [printf] facility: you can simply add pretty-printing annotations to your
@@ -321,7 +321,12 @@ val fprintf : formatter -> ('a, formatter, unit) format -> 'a;;
 -          [\]]: close the most recently opened pretty-printing box.
 -          [,]: output a good break as with [print_cut ()].
 -          [ ]: output a space, as with [print_space ()].
--          [;]: force a newline, as with [force_newline ()].
+-          [\n]: force a newline, as with [force_newline ()].
+-          [;]: output a good break as with [print_break]. The
+           [nspaces] and [offset] parameters of the break may be
+           optionally specified with the following syntax: 
+           the [<] character, followed by an integer [nspaces] value,
+           then an integer offset, and a closing [>] character. 
 -          [.]: flush the pretty printer as with [print_newline ()].
 -          [@]: a plain [@] character. *)