Block markup: maintain output version within tree values (in accordance with String) -- changes operational behaviour wrt. print_mode;
authorwenzelm
Mon, 23 Mar 2009 15:23:06 +0100
changeset 3066753fbf7c679b0
parent 30666 d6248d4508d5
child 30668 df8a3c2fd5a2
Block markup: maintain output version within tree values (in accordance with String) -- changes operational behaviour wrt. print_mode;
to_ML/from_ML: proper handling of markup;
src/Pure/General/pretty.ML
     1.1 --- a/src/Pure/General/pretty.ML	Mon Mar 23 11:20:46 2009 +0100
     1.2 +++ b/src/Pure/General/pretty.ML	Mon Mar 23 15:23:06 2009 +0100
     1.3 @@ -104,9 +104,9 @@
     1.4  (** printing items: compound phrases, strings, and breaks **)
     1.5  
     1.6  datatype T =
     1.7 -  Block of Markup.T * T list * int * int |  (*markup, body, indentation, length*)
     1.8 -  String of output * int |                  (*text, length*)
     1.9 -  Break of bool * int;                      (*mandatory flag, width if not taken*)
    1.10 +  Block of (output * output) * T list * int * int |  (*markup output, body, indentation, length*)
    1.11 +  String of output * int |                           (*text, length*)
    1.12 +  Break of bool * int;                               (*mandatory flag, width if not taken*)
    1.13  
    1.14  fun length (Block (_, _, _, len)) = len
    1.15    | length (String (_, len)) = len
    1.16 @@ -124,12 +124,14 @@
    1.17  fun breaks prts = Library.separate (brk 1) prts;
    1.18  fun fbreaks prts = Library.separate fbrk prts;
    1.19  
    1.20 -fun markup_block m (indent, es) =
    1.21 +fun block_markup m (indent, es) =
    1.22    let
    1.23      fun sum [] k = k
    1.24        | sum (e :: es) k = sum es (length e + k);
    1.25    in Block (m, es, indent, sum es 0) end;
    1.26  
    1.27 +fun markup_block m arg = block_markup (Markup.output m) arg;
    1.28 +
    1.29  val blk = markup_block Markup.none;
    1.30  fun block prts = blk (2, prts);
    1.31  val strs = block o breaks o map str;
    1.32 @@ -197,7 +199,7 @@
    1.33  local
    1.34    fun pruning dp (Block (m, bes, indent, wd)) =
    1.35          if dp > 0
    1.36 -        then markup_block m (indent, map (pruning (dp - 1)) bes)
    1.37 +        then block_markup m (indent, map (pruning (dp - 1)) bes)
    1.38          else str "..."
    1.39      | pruning dp e = e
    1.40  in
    1.41 @@ -263,7 +265,7 @@
    1.42  fun format ([], _, _) text = text
    1.43    | format (e :: es, block as (blockind, blockin), after) (text as {ind, pos, nl, ...}) =
    1.44        (case e of
    1.45 -        Block (markup, bes, indent, wd) =>
    1.46 +        Block ((bg, en), bes, indent, wd) =>
    1.47            let
    1.48              val {emergencypos, ...} = ! margin_info;
    1.49              val pos' = pos + indent;
    1.50 @@ -271,7 +273,6 @@
    1.51              val block' =
    1.52                if pos' < emergencypos then (ind |> add_indent indent, pos')
    1.53                else (add_indent pos'' Buffer.empty, pos'');
    1.54 -            val (bg, en) = Markup.output markup;
    1.55              val btext: text = text
    1.56                |> control bg
    1.57                |> format (bes, block', breakdist (es, after))
    1.58 @@ -303,9 +304,9 @@
    1.59  (*symbolic markup -- no formatting*)
    1.60  fun symbolic prt =
    1.61    let
    1.62 -    fun out (Block (m, [], _, _)) = Buffer.markup m I
    1.63 -      | out (Block (m, prts, indent, _)) =
    1.64 -          Buffer.markup m (Buffer.markup (Markup.block indent) (fold out prts))
    1.65 +    fun out (Block ((bg, en), [], _, _)) = Buffer.add bg #> Buffer.add en
    1.66 +      | out (Block ((bg, en), prts, indent, _)) =
    1.67 +          Buffer.add bg #> Buffer.markup (Markup.block indent) (fold out prts) #> Buffer.add en
    1.68        | out (String (s, _)) = Buffer.add s
    1.69        | out (Break (false, wd)) = Buffer.markup (Markup.break wd) (Buffer.add (output_spaces wd))
    1.70        | out (Break (true, _)) = Buffer.markup Markup.fbreak (Buffer.add (output_spaces 1));
    1.71 @@ -314,7 +315,7 @@
    1.72  (*unformatted output*)
    1.73  fun unformatted prt =
    1.74    let
    1.75 -    fun fmt (Block (m, prts, _, _)) = Buffer.markup m (fold fmt prts)
    1.76 +    fun fmt (Block ((bg, en), prts, _, _)) = Buffer.add bg #> fold fmt prts #> Buffer.add en
    1.77        | fmt (String (s, _)) = Buffer.add s
    1.78        | fmt (Break (false, wd)) = Buffer.add (output_spaces wd)
    1.79        | fmt (Break (true, _)) = Buffer.add (output_spaces 1);
    1.80 @@ -323,11 +324,11 @@
    1.81  
    1.82  (* ML toplevel pretty printing *)
    1.83  
    1.84 -fun to_ML (Block (m, prts, ind, _)) = ML_Pretty.Block (Markup.output m, map to_ML prts, ind)
    1.85 +fun to_ML (Block (m, prts, ind, _)) = ML_Pretty.Block (m, map to_ML prts, ind)
    1.86    | to_ML (String s) = ML_Pretty.String s
    1.87    | to_ML (Break b) = ML_Pretty.Break b;
    1.88  
    1.89 -fun from_ML (ML_Pretty.Block (_, prts, ind)) = blk (ind, map from_ML prts)
    1.90 +fun from_ML (ML_Pretty.Block (m, prts, ind)) = block_markup m (ind, map from_ML prts)
    1.91    | from_ML (ML_Pretty.String s) = String s
    1.92    | from_ML (ML_Pretty.Break b) = Break b;
    1.93