## html-prettyprint-output-stream.pkg
#
# Prettyprinting using HTML markup to control layout.
# Supplying this package as an argument to
#
# src/lib/prettyprint/big/src/base-prettyprinter-g.pkg#
# yields a prettyprinter specialized to format HTML text.
#
# For an overview of prettyprinter output stream functionality see
#
# src/lib/prettyprint/big/src/out/prettyprint-output-stream.api#
# Compare to:
#
# src/lib/prettyprint/big/src/out/plain-prettyprint-output-stream.pkg# src/lib/prettyprint/big/src/out/ansi-terminal-prettyprint-output-stream.pkg#
# This file is currently referenced nowhere.
# Compiled by:
# src/lib/prettyprint/big/prettyprinter.libstipulate
package has = html_abstract_syntax; # html_abstract_syntax is from src/lib/html/html-abstract-syntax.pkgherein
api Html_Prettyprint_Output_Stream {
#
include api Prettyprint_Output_Stream; # Prettyprint_Output_Stream is from src/lib/prettyprint/big/src/out/prettyprint-output-stream.api combine_textstyles: (Texttraits, Texttraits) -> Texttraits; # Combine two textstyles into one.
textstyle_none: Texttraits; # Unstyled text.
# Standard HTML text styles:
#
textstyle_tt: Texttraits;
textstyle_i: Texttraits;
textstyle_b: Texttraits;
textstyle_u: Texttraits;
textstyle_strike: Texttraits;
textstyle_em: Texttraits;
textstyle_strong: Texttraits;
textstyle_dfn: Texttraits;
textstyle_code: Texttraits;
textstyle_samp: Texttraits;
textstyle_kbd: Texttraits;
textstyle_var: Texttraits;
textstyle_cite: Texttraits;
color: String -> Texttraits; # Color text (using FONT element).
# Hyper-text links and anchors:
#
link: String -> Texttraits;
anchor: String -> Texttraits;
link_anchor: { name: String, href: String } -> Texttraits;
make_markup_buffer: { text_wide: Null_Or( Int ) } -> Prettyprint_Output_Stream;
done: Prettyprint_Output_Stream -> has::Text;
};
package html_prettyprint_output_stream
: (weak) Html_Prettyprint_Output_Stream
{
Texttraits
= NOEMPH
| TT
| II
| BB
| UU
| STRIKE
| EM
| STRONG
| DFN
| CODE
| SAMP
| KBD
| VAR
| CITE
| COLOR String
| AA { href: Null_Or(String),
name: Null_Or(String)
}
| STYS List(Texttraits)
;
Prettyprint_Output_Stream
= PRETTYPRINT_OUTPUT_STREAM
{ text_wide: Null_Or( Int ),
emph_stk: Ref( List( (List(has::Text), Texttraits) ) ) ,
txt: Ref( List( has::Text ) )
};
fun cur_emph (PRETTYPRINT_OUTPUT_STREAM { emph_stk, ... } ) # Return the current emphasis.
=
case *emph_stk
[] => NOEMPH;
((_, em) ! r) => em;
esac;
fun pcdata (PRETTYPRINT_OUTPUT_STREAM { txt, ... }, s) # Add PCDATA to the text list.
=
txt := has::PCDATA s ! *txt;
fun join_txt (PRETTYPRINT_OUTPUT_STREAM { txt, ... } ) # Replace the sequence of PCDATA elements at the head of the txt list with its concatenation.
=
f (*txt, [])
where
fun f ([], []) => [];
f (has::PCDATA s ! r, l) => f (r, s ! l);
f (r, l) => has::PCDATA (string::cat l) ! r;
end;
end;
fun same_texttraits (s1: Texttraits, s2) # Are two textstyles the same?
=
s1 == s2;
fun wrap_textstyle (sty, [], tl')
=>
tl';
wrap_textstyle (sty, tl, tl')
=>
wrap (sty, t) ! tl'
where
fun wrap (NOEMPH, t) => t;
wrap (TT, t) => has::TT t;
wrap (II, t) => has::IX t;
wrap (BB, t) => has::BX t;
wrap (UU, t) => has::UX t;
wrap (STRIKE, t) => has::STRIKE t;
wrap (EM, t) => has::EM t;
wrap (STRONG, t) => has::STRONG t;
wrap (DFN, t) => has::DFN t;
wrap (CODE, t) => has::CODE t;
wrap (SAMP, t) => has::SAMP t;
wrap (KBD, t) => has::KBD t;
wrap (VAR, t) => has::VAR t;
wrap (CITE, t) => has::CITE t;
wrap (COLOR c, t) => has::FONT { color=>THE c, size=>NULL, content=>t };
#
wrap (AA { name, href }, t)
=>
has::AX {
name, href,
rel => NULL, reverse => NULL, title => NULL,
content => t
};
wrap (STYS l, t) => list::fold_backward wrap t l;
end;
t = case tl
[t] => t;
_ => has::TEXT_LIST (list::reverse tl);
esac;
end;
end;
fun push_texttraits (dev as PRETTYPRINT_OUTPUT_STREAM { emph_stk, txt, ... }, sty) # Push a textstyle onto the markup_buffers textstyle stack.
=
{ emph_stk := (join_txt dev, sty) ! *emph_stk;
txt := [];
};
fun pop_texttraits (PRETTYPRINT_OUTPUT_STREAM { emph_stk as REF [], ... } ) # Pop a textstyle off the markup_buffers textstyle stack. A pop on an empty textstyle stack is a no-op.
=>
();
pop_texttraits (dev as PRETTYPRINT_OUTPUT_STREAM { emph_stk as REF ((tl, sty) ! r), txt, ... } )
=>
{ txt := wrap_textstyle (sty, join_txt dev, tl);
emph_stk := r;
};
end;
fun default_texttraits _ # The default textstyle for the markup_buffer. This is the current textstyle if the textstyle stack is empty.
=
NOEMPH;
put_string = pcdata; # Write a string in the current textstyle to the output stream.
# THE put_string FN SHOULD CONVERT BLANKS to ' ' STRINGS. XXX BUGGO FIXME
# THE put_string FN SHOULD CONVERT NEWLINES to txt := has::BR { clear=>NULL } ! (join_txt dev); XXX BUGGO FIXME
fun flush _ = ();
fun close _ = ();
fun combine_textstyles (NOEMPH, sty) => sty;
combine_textstyles (sty, NOEMPH) => sty;
combine_textstyles (STYS l1, STYS l2) => STYS (l1 @ l2);
combine_textstyles (sty, STYS l) => STYS (sty ! l);
combine_textstyles (sty1, sty2) => STYS [sty1, sty2];
end;
textstyle_none = NOEMPH;
textstyle_tt = TT;
textstyle_i = II;
textstyle_b = BB;
textstyle_u = UU;
textstyle_strike = STRIKE;
textstyle_em = EM;
textstyle_strong = STRONG;
textstyle_dfn = DFN;
textstyle_code = CODE;
textstyle_samp = SAMP;
textstyle_kbd = KBD;
textstyle_var = VAR;
textstyle_cite = CITE;
color = COLOR;
fun link s = AA { href=>THE s, name=>NULL };
fun anchor s = AA { href=>NULL, name=>THE s };
fun link_anchor { name, href }
=
AA { href=>THE href, name => THE name };
fun make_markup_buffer { text_wide }
=
PRETTYPRINT_OUTPUT_STREAM
{ txt => REF [],
emph_stk => REF [],
text_wide
};
fun done (mb as PRETTYPRINT_OUTPUT_STREAM { emph_stk => REF [], txt, ... } )
=>
case (join_txt mb)
#
[t] => { txt := []; t; };
l => { txt := []; has::TEXT_LIST (list::reverse l); };
esac;
done _ => raise exception DIE "Unclosed boxes in markup_buffer -- cannot format it.";
end;
}; # html_prettyprint_output_stream.pkg
end;