% omxml.ch: Generate XML, MathML, HTML, etc.
%
% This file is part of Omega,
% which is based on the web2c distribution of TeX,
%
% Copyright (c) 1994--2001 John Plaice and Yannis Haralambous
%
% Omega is free software; you can redistribute it and/or modify
% it under the terms of the GNU General Public License as published by
% the Free Software Foundation; either version 2 of the License, or
% (at your option) any later version.
%
% Omega is distributed in the hope that it will be useful,
% but WITHOUT ANY WARRANTY; without even the implied warranty of
% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
% GNU General Public License for more details.
%
% You should have received a copy of the GNU General Public License
% along with Omega; if not, write to the Free Software Foundation, Inc.,
% 59 Temple Place, Suite 330, Boston, MA 02111-1307, USA.
%
%---------------------------------------
@x [1] m.11 l.392 - Omega
@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
@y
@!font_sort_max=65535; {maximum internal font sort number}
@!font_max=65535; {maximum internal font number; must be at most |font_biggest|}
@z
%---------------------------------------
@x [1] m.12 l.437 - Omega
@d number_fonts=font_biggest-font_base+2
@y
@d number_fonts=font_biggest-font_base+2
@d font_sort_base=0
@d font_sort_biggest=65535 {the biggest font sort}
@d number_font_sorts=font_sort_biggest-font_sort_base+2
@z
%---------------------------------------
@x [5] m.57 l.1446 - Omega
othercases write_ln(write_file[selector])
@y
othercases if selector>max_selector then
write_ln(output_files[selector-max_selector])
else
write_ln(write_file[selector])
@z
%---------------------------------------
@x [5] m.58 l.1465 - Omega
othercases omega_file_write(selector)
@y
othercases if selector>max_selector then
write(output_files[selector-max_selector],xchr[s])
else
omega_file_write(selector)
@z
%---------------------------------------
@x [10] m.160 l.3270 - Omega
@d biggest_ordinary_node=info_node
@y
@d sgml_text_node=0
@d sgml_math_node=1
@d sgml_vert_node=2
@d sgml_node=info_node+1 {|type| for an SGML node}
@d sgml_node_size=5
@d sgml_tag(#)==mem[#+1].int
@d sgml_attrs(#)==mem[#+2].int
@d sgml_singleton(#)==info(#+3)
@d sgml_info(#)==link(#+3)
@d sgml_kind(#)==mem[#+4].int
@d sgml_attr_node=info_node+2 {|type| for an SGML attribute node}
@d sgml_attr_node_size=4
@d sgml_entity_node=info_node+3 {|type| for an SGML entity node}
@d sgml_entity_node_size=2
@d sgml_entity_string(#)==mem[#+1].int
@d biggest_ordinary_node=sgml_entity_node
@p
function new_sgml_node:pointer;
var p:pointer;
begin p:=get_node(sgml_node_size);
type(p):=sgml_node;
sgml_tag(p):=0;
sgml_attrs(p):=0;
sgml_info(p):=0;
sgml_singleton(p):=0;
sgml_kind(p):=0;
new_sgml_node:=p;
end;
function new_sgml_attr_node:pointer;
var p:pointer;
begin p:=get_node(sgml_attr_node_size);
type(p):=sgml_attr_node;
sgml_tag(p):=0;
sgml_attrs(p):=0;
sgml_info(p):=0;
sgml_singleton(p):=0;
new_sgml_attr_node:=p;
end;
function new_sgml_entity_node:pointer;
var p:pointer;
begin p:=get_node(sgml_entity_node_size);
type(p):=sgml_entity_node;
sgml_entity_string(p):=0;
new_sgml_entity_node:=p;
end;
@z
%---------------------------------------
@x [12] m.174 l.3520 - Omega
@p procedure short_display(@!p:integer); {prints highlights of list |p|}
var n:integer; {for replacement counts}
begin while p>mem_min do
begin if is_char_node(p) then
begin if p<=mem_end then
begin if font(p)<>font_in_short_display then
begin if (font(p)font_max) then
print_char("*")
@.*\relax@>
else @;
print_char(" "); font_in_short_display:=font(p);
end;
print_ASCII(qo(character(p)));
@y
@p procedure short_display(@!p:integer); {prints highlights of list |p|}
var n:integer; {for replacement counts}
fsort:integer;
begin while p>mem_min do
begin if is_char_node(p) then
begin if p<=mem_end then
begin if font(p)<>font_in_short_display then
begin if (font(p)font_max) then
print_char("*")
@.*\relax@>
else @;
print_char(" "); font_in_short_display:=font(p);
end;
if not SGML_show_entities then
print_ASCII(qo(character(p)))
else begin
fsort:=font_name_sort(font(p));
if fsort<>0 then begin
if (font_sort_char_entity(fsort)(character(p))<>0) then
slow_print(font_sort_char_entity(fsort)(character(p)))
else
print_ASCII(qo(character(p)));
end
else
print_ASCII(qo(character(p)));
end;
@z
%---------------------------------------
@x [12] m.176 l.3563 - Omega
procedure print_font_and_char(@!p:integer); {prints |char_node| data}
begin if p>mem_end then print_esc("CLOBBERED.")
else begin if (font(p)font_max) then print_char("*")
@.*\relax@>
else @;
print_char(" "); print_ASCII(qo(character(p)));
end;
end;
@y
procedure print_font_and_char(@!p:integer); {prints |char_node| data}
var fsort:integer;
begin if p>mem_end then print_esc("CLOBBERED.")
else begin if (font(p)font_max) then print_char("*")
@.*\relax@>
else @;
print_char(" ");
if not SGML_show_entities then
print_ASCII(qo(character(p)))
else begin
fsort:=font_name_sort(font(p));
if fsort<>0 then begin
if (font_sort_char_entity(fsort)(character(p))<>0) then
print(font_sort_char_entity(fsort)(character(p)))
else
print_ASCII(qo(character(p)));
end
else
print_ASCII(qo(character(p)));
end;
end;
end;
@z
%---------------------------------------
@x [13] m.202 l.3928 - Omega
adjust_node: flush_node_list(adjust_ptr(p));
@y
adjust_node: flush_node_list(adjust_ptr(p));
sgml_node: begin
if sgml_tag(p)<>0 then flush_node_list(sgml_attrs(p));
free_node(p,sgml_node_size); goto done;
end;
sgml_attr_node: begin
free_node(p,sgml_attr_node_size); goto done;
end;
sgml_entity_node: begin
free_node(p,sgml_entity_node_size); goto done;
end;
@z
%---------------------------------------
@x [15] m.209 l.4138 - Omega
@d max_command=char_mode
{the largest command code seen at |big_switch|}
@y
@d set_show_sgml_entities=char_mode+1
{printing hex code or SGML-like entity during \.{\\showbox}}
@d set_mml_mode=set_show_sgml_entities+1
{for entering or leaving MML mode ( \.{\\mmlmode}~)}
@d sgml_command=set_mml_mode+1
{for various SGML tags}
@d max_command=sgml_command
{the largest command code seen at |big_switch|}
@z
%---------------------------------------
@x [16] m.212--217 l.4303 - Omega
@!pg_field,@!ml_field: integer;@+
@y
@!pg_field,@!ml_field: integer;@+
@!sgml_field: integer;
@!sgml_attr_field: pointer;
@z
%---------------------------------------
@x [16] m.212--217 l.4303 - Omega
@d mode_line==cur_list.ml_field {source file line number at beginning of list}
@y
@d mode_line==cur_list.ml_field {source file line number at beginning of list}
@d current_sgml_tag==cur_list.sgml_field {current SGML tag}
@d current_sgml_attrs==cur_list.sgml_attr_field {current SGML tag}
@z
%---------------------------------------
@x [16] m.212--217 l.4303 - Omega
prev_graf:=0; shown_mode:=0;
@y
prev_graf:=0; shown_mode:=0;
current_sgml_tag:=0; current_sgml_attrs:=null;
@z
%---------------------------------------
@x [16] m.212--217 l.4303 - Omega
incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
@y
incr(nest_ptr); head:=get_avail; tail:=head; prev_graf:=0; mode_line:=line;
current_sgml_tag:=0; current_sgml_attrs:=null;
@z
%---------------------------------------
@x [16] m.212--217 l.4303 - Omega
@p procedure pop_nest; {leave a semantic level, re-enter the old}
begin free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
end;
@y
@p procedure pop_nest; {leave a semantic level, re-enter the old}
var attrs:pointer;
{p:pointer;}
begin attrs:=null;
{
if current_sgml_attrs<>null then
if current_sgml_tag=null then
attrs:=current_sgml_attrs
else
free_avail(current_sgml_attrs);
}
free_avail(head); decr(nest_ptr); cur_list:=nest[nest_ptr];
{
if attrs<>null then begin
p:=attrs;
while link(p)<>null do
begin
p:=link(p);
end;
link(p):=current_sgml_attrs;
current_sgml_attrs:=attrs;
end;
}
end;
@z
%---------------------------------------
@x [17] m.222 l.4525 - Omega
@d frozen_null_ocp=frozen_null_font+number_fonts
@y
@d frozen_null_font_sort=frozen_null_font+number_font_sorts {permanent null sort}
@d frozen_null_ocp=frozen_null_font_sort+number_font_sorts
@z
%---------------------------------------
@x [17] m.232 l.4802 - Omega
@d var_code==@"7000000 {math code meaning ``use the current family''}
@y
@d null_font_sort==font_sort_base
@d var_code==@"7000000 {math code meaning ``use the current family''}
@z
%---------------------------------------
@x [19] m.269 l.5859 - Omega
@d math_left_group=16 {code for `\.{\\left...\\right}'}
@d local_box_group=17 {code for `\.{\\localleftbox...\\localrightbox}'}
@d max_group_code=17
@y
@d math_left_group=16 {code for `\.{\\left...\\right}'}
@d math_mml_group=17 {code for automatic `\.{\\left...\\right}'}
@d text_mml_group=18 {code for `\.{\\text...}'}
@d text_sgml_group=19 {code for horizontal SGML tags}
@d vert_sgml_group=20 {code for vertical SGML tags}
@d par_sgml_group=21 {code for paragraph SGML tags}
@d font_entity_group=22
@d empty_tag_group=23
@d local_box_group=24 {code for `\.{\\localleftbox...\\localrightbox}'}
@d max_group_code=24
@z
%---------------------------------------
@x [29] m.532 l.10260 - Omega
@ Here's an example of how these conventions are used. Whenever it is time to
ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
@d ensure_dvi_open==if output_file_name=0 then
begin if job_name=0 then open_log_file;
pack_job_name(".dvi");
while not b_open_out(dvi_file) do
prompt_file_name("file name for output",".dvi");
output_file_name:=b_make_name_string(dvi_file);
end
@=
@!dvi_file: byte_file; {the device-independent output goes here}
@!output_file_name: str_number; {full name of the output file}
@!log_name:str_number; {full name of the log file}
@y
@ Here's an example of how these conventions are used. Whenever it is time to
ship out a box of stuff, we shall use the macro |ensure_dvi_open|.
@d ensure_output_open_end(#)==while not b_open_out(#) do
prompt_file_name("file name for output",output_m_suffix);
output_m_name:=b_make_name_string(#);
end end
@d ensure_output_open_middle(#)==output_m_name:=#; if #=0 then
begin if job_name=0 then open_log_file;
pack_job_name(output_m_suffix);
ensure_output_open_end
@d ensure_output_open(#)==begin output_m_suffix:=#; ensure_output_open_middle
@d ensure_dvi_open==begin
ensure_output_open(".dvi")(output_file_name)(dvi_file);
output_file_name:=output_m_name end
@=
@!dvi_file: byte_file; {the device-independent output goes here}
@!output_file_name: str_number; {full name of the dvi output file}
@!output_m_suffix: str_number; {suffix for the current output file}
@!output_m_name: str_number; {suffix for the current output file}
@!output_file_names:array[1..10] of str_number;
@!output_files:array[1..10] of byte_file;
@!output_file_no:integer; {number of open output files}
@!log_name:str_number; {full name of the log file}
@!sgml_file_suffix:str_number; {suffix for the output file}
@!sgml_attribute_quote:str_number; {string for quoting attribute values}
@!sgml_empty_tag_marker:str_number; {string for marking empty tags}
@!sgml_paragraph_tag:str_number; {tag to designate paragraphs}
@z
%---------------------------------------
@x [29] m.533 l.10260 - Omega
@ @=output_file_name:=0;
@y
@ @=output_file_name:=0;
for output_file_no:=1 to 10 do output_file_names[output_file_no]:=0;
sgml_file_suffix:=".xml";
sgml_attribute_quote:="""";
sgml_empty_tag_marker:="/";
output_file_no:=0;
@z
%---------------------------------------
@x [30] m.549 l.10686 - Omega
@!font_ptr:internal_font_number; {largest internal font number in use}
@y
@!font_ptr:internal_font_number; {largest internal font number in use}
@!font_sort_ptr:integer; {largest internal font sort number in use}
@z
%---------------------------------------
@x [30] m.550 l.10723 - Omega
@d param_base(#)==font_info(#)(offset_param_base).int
@y
@d param_base(#)==font_info(#)(offset_param_base).int
@d font_sort_info_end(#)==#]
@d font_sort_info(#)==font_sort_tables[#,font_sort_info_end
@d font_sort_offset_file_size=0
@d font_sort_offset_name=font_sort_offset_file_size+1
@d font_sort_offset_bc=font_sort_offset_name+1
@d font_sort_offset_ec=font_sort_offset_bc+1
@d font_sort_offset_char_base=font_sort_offset_bc+1
@d font_sort_file_size(#)==font_sort_info(#)(font_sort_offset_file_size).int
@d font_sort_name(#)==font_sort_info(#)(font_sort_offset_name).int
@d font_sort_bc(#)==font_sort_info(#)(font_sort_offset_bc).int
@d font_sort_ec(#)==font_sort_info(#)(font_sort_offset_ec).int
@d font_sort_char_base(#)==font_sort_info(#)(font_sort_offset_char_base).int
@d font_sort_char_entity_end(#)==#*3].int
@d font_sort_char_entity(#)==
font_sort_tables[#,font_sort_offset_char_base+font_sort_char_entity_end
@d font_sort_char_tag_end(#)==#*3+1].int
@d font_sort_char_tag(#)==
font_sort_tables[#,font_sort_offset_char_base+font_sort_char_tag_end
@d font_sort_char_attr_end(#)==#*3+2].int
@d font_sort_char_attr(#)==
font_sort_tables[#,font_sort_offset_char_base+font_sort_char_attr_end
@z
%---------------------------------------
@x [30] m.550 l.10723 - Omega
@!dimen_font:integer;
@y
@!dimen_font:integer;
@!font_sorts:integer; {to run through font sorts}
@!font_sort_c:integer; {character used to define font entities}
@!font_sort_number:integer; {this particular font sort number}
@z
%---------------------------------------
@x [30] m.552 l.10749 - Omega
for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
@y
for k:=1 to 7 do font_info(null_font)(param_base(null_font)+k).sc:=0;
font_sort_ptr:=null_font_sort;
allocate_font_sort_table(null_font_sort,font_sort_offset_char_base);
font_sort_file_size(null_font_sort):=font_sort_offset_char_base;
font_sort_name(null_font_sort):="nullfontsort";
@z
%---------------------------------------
@x [32] m.638 l.12656 - Omega
@;
@y
if not SGML_mode then begin @; end;
@z
%---------------------------------------
@x [46] m.1030
hmode+spacer: if space_factor=1000 then goto append_normal_space
else app_space;
hmode+ex_space,mmode+ex_space: goto append_normal_space;
@y
hmode+spacer:
if SGML_mode then begin
make_sgml_entity(" ");
goto big_switch;
end
else if space_factor=1000 then goto append_normal_space
else app_space;
hmode+ex_space,mmode+ex_space: goto append_normal_space;
@z
%---------------------------------------
@x [47] m.1060 l.20533 - Omega
procedure append_glue;
var s:small_number; {modifier of skip command}
begin s:=cur_chr;
case s of
fil_code: cur_val:=fil_glue;
fill_code: cur_val:=fill_glue;
ss_code: cur_val:=ss_glue;
fil_neg_code: cur_val:=fil_neg_glue;
skip_code: scan_glue(glue_val);
mskip_code: scan_glue(mu_val);
end; {now |cur_val| points to the glue specification}
tail_append(new_glue(cur_val));
if s>=skip_code then
begin decr(glue_ref_count(cur_val));
if s>skip_code then subtype(tail):=mu_glue;
end;
end;
@y
procedure append_glue;
var s:small_number; {modifier of skip command}
begin s:=cur_chr;
case s of
fil_code: cur_val:=fil_glue;
fill_code: cur_val:=fill_glue;
ss_code: cur_val:=ss_glue;
fil_neg_code: cur_val:=fil_neg_glue;
skip_code: scan_glue(glue_val);
mskip_code: scan_glue(mu_val);
end; {now |cur_val| points to the glue specification}
if (abs(mode)=mmode) and SGML_mode then begin
end
else begin
tail_append(new_glue(cur_val));
if s>=skip_code then
begin decr(glue_ref_count(cur_val));
if s>skip_code then subtype(tail):=mu_glue;
end;
end;
end;
@z
%---------------------------------------
@x [47] m.1061 l.20339 - Omega
procedure append_kern;
var s:quarterword; {|subtype| of the kern node}
begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
tail_append(new_kern(cur_val)); subtype(tail):=s;
end;
@y
procedure append_kern;
var s:quarterword; {|subtype| of the kern node}
begin s:=cur_chr; scan_dimen(s=mu_glue,false,false);
if (abs(mode)=mmode) and SGML_mode then begin
end
else begin
tail_append(new_kern(cur_val)); subtype(tail):=s;
end;
end;
@z
%---------------------------------------
@x [47] m.1073 l.20795 - Omega
vmode+hmove,hmode+vmove,mmode+vmove: begin t:=cur_chr;
scan_normal_dimen;
if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
end;
any_mode(leader_ship): scan_box(leader_flag-a_leaders+cur_chr);
any_mode(make_box): begin_box(0);
@y
vmode+hmove,hmode+vmove,mmode+vmove: begin
if abs(mode)=mmode and SGML_mode then begin
print_err("Unauthorized entry in math expression: ");
print_cmd_chr(cur_cmd,cur_chr); print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end
else begin
t:=cur_chr; scan_normal_dimen;
if t=0 then scan_box(cur_val)@+else scan_box(-cur_val);
end;
end;
any_mode(leader_ship): begin
if abs(mode)=mmode and SGML_mode then begin
print_err("Unauthorized entry in math expression: ");
print_cmd_chr(cur_cmd,cur_chr); print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end
else
scan_box(leader_flag-a_leaders+cur_chr);
end;
any_mode(make_box): begin
if abs(mode)=mmode and SGML_mode then begin
print_err("Unauthorized entry in math expression: ");
print_cmd_chr(cur_cmd,cur_chr); print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end
else
begin_box(0);
end;
@z
%---------------------------------------
@x [47] m. l.21055 - Omega
procedure new_graf(@!indented:boolean);
begin prev_graf:=0;
if (mode=vmode)or(head<>tail) then
tail_append(new_param_glue(par_skip_code));
push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
*@'200000+cur_lang;
tmp_dir_stack:=get_avail; info(tmp_dir_stack):=par_direction;
link(tmp_dir_stack):=par_dir_stack;
par_dir_stack:=tmp_dir_stack;
if indented then
begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
box_dir(tail):=info(par_dir_stack);
change_dir(tail,info(par_dir_stack));
end;
if every_par<>null then begin_token_list(every_par,every_par_text);
if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
end;
@y
procedure sgml_start_graf; forward;
procedure new_graf(@!indented:boolean);
begin prev_graf:=0;
if SGML_mode then begin
sgml_start_graf
end
else begin
if (mode=vmode)or(head<>tail) then
tail_append(new_param_glue(par_skip_code));
push_nest; mode:=hmode; space_factor:=1000; set_cur_lang; clang:=cur_lang;
prev_graf:=(norm_min(left_hyphen_min)*@'100+norm_min(right_hyphen_min))
*@'200000+cur_lang;
tmp_dir_stack:=get_avail; info(tmp_dir_stack):=par_direction;
link(tmp_dir_stack):=par_dir_stack;
par_dir_stack:=tmp_dir_stack;
if indented then
begin tail:=new_null_box; link(head):=tail; width(tail):=par_indent;@+
box_dir(tail):=info(par_dir_stack);
change_dir(tail,info(par_dir_stack));
end;
if every_par<>null then begin_token_list(every_par,every_par_text);
if nest_ptr=1 then build_page; {put |par_skip| glue on current page}
end;
end;
@z
%---------------------------------------
@x [47] m.1100 l.21156 - Omega
procedure end_graf;
begin if mode=hmode then
begin if head=tail then pop_nest {null paragraphs are ignored}
else line_break(widow_penalty,info(par_dir_stack));
tmp_dir_stack:=par_dir_stack;
par_dir_stack:=link(par_dir_stack);
free_avail(tmp_dir_stack);
normal_paragraph;
error_count:=0;
end;
end;
@y
procedure sgml_end_graf; forward;
procedure end_graf;
begin if mode=hmode then
begin if head=tail then pop_nest {null paragraphs are ignored}
else if SGML_mode then begin sgml_end_graf end
else line_break(widow_penalty,info(par_dir_stack));
tmp_dir_stack:=par_dir_stack;
par_dir_stack:=link(par_dir_stack);
free_avail(tmp_dir_stack);
normal_paragraph;
error_count:=0;
end;
end;
@z
%---------------------------------------
@x [47] m.1130 l.21562 - Omega
vmode+halign,hmode+valign:init_align;
mmode+halign: if privileged then
if cur_group=math_shift_group then init_align
else off_save;
vmode+endv,hmode+endv: do_endv;
@y
vmode+halign,hmode+valign:init_align;
mmode+halign: if SGML_mode then begin
print_err("Unauthorized entry in math expression: ");
print_esc("halign"); print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end
else begin
if privileged then
if cur_group=math_shift_group then init_align
else off_save;
end;
vmode+endv,hmode+endv: do_endv;
@z
%---------------------------------------
@x [48] m.1136 l.21605 - Omega
@* \[48] Building math lists.
The routines that \TeX\ uses to create mlists are similar to those we have
just seen for the generation of hlists and vlists. But it is necessary to
make ``noads'' as well as nodes, so the reader should review the
discussion of math mode data structures before trying to make sense out of
the following program.
Here is a little routine that needs to be done whenever a subformula
is about to be processed. The parameter is a code like |math_group|.
@=
procedure push_math(@!c:group_code);
begin
push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
make_local_direction(info(math_dir_stack),true);
end;
@y
@* \[48] Building math lists.
The routines that \TeX\ uses to create mlists are similar to those we have
just seen for the generation of hlists and vlists. But it is necessary to
make ``noads'' as well as nodes, so the reader should review the
discussion of math mode data structures before trying to make sense out of
the following program.
Here is a little routine that needs to be done whenever a subformula
is about to be processed. The parameter is a code like |math_group|.
@=
@!SGML_mode:boolean;
@!SGML_show_entities:boolean;
@!MML_level:integer;
@!mml_file_no:integer; {the \.{MML} output file}
@!mml_indent:integer;
@!mml_depth_level:integer;
@!tmp_back_at_bol:boolean;
@ @=
SGML_mode:=false;
SGML_show_entities:=true;
MML_level:=0;
mml_indent:=0;
mml_file_no:=0;
mml_depth_level:=0;
@
@d sgml_out_pointer(#)==
case math_type(#(p)) of
math_char: begin
fetch(#(p));
fsort:=font_name_sort(cur_f);
if char_exists(cur_i) then begin
if (font_sort_char_tag(fsort)(cur_c)<>0) then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("<"); print(font_sort_char_tag(fsort)(cur_c));
if (font_sort_char_attr(fsort)(cur_c)<>null) then begin
sgml_attrs_out(font_sort_char_attr(fsort)(cur_c));
end;
print(">");
if (font_sort_char_entity(fsort)(cur_c)<>0) then begin
print(font_sort_char_entity(fsort)(cur_c));
end;
print(""); print(font_sort_char_tag(fsort)(cur_c));
print(">");
print(new_line_char);
back_at_bol:=true;
end;
end;
end;
sub_mlist: begin
case type(p) of
op_noad,bin_noad,rel_noad,
open_noad,close_noad,punct_noad,inner_noad: begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("");
mml_indent:=mml_indent+1;
print(new_line_char);
back_at_bol:=true;
q:=p; cur_mlist:=info(#(p));
if link(cur_mlist)=null then
if type(cur_mlist)=sgml_node then
if str_eq_str(sgml_tag(cur_mlist),"mrow") then
cur_mlist:=sgml_info(cur_mlist);
back_at_bol:=sgml_out_mlist(false,back_at_bol,false); p:=q;
mml_indent:=mml_indent-1;
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("");
print(new_line_char);
back_at_bol:=true;
end;
othercases begin
q:=p; cur_mlist:=info(#(p));
back_at_bol:=sgml_out_mlist(false,back_at_bol,false); p:=q;
end
endcases;
end;
othercases begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print(" Unrecognized math stuff ");
print(new_line_char);
back_at_bol:=true;
end
endcases;
@=
procedure push_math(@!c:group_code);
begin
push_nest; mode:=-mmode; incompleat_noad:=null; new_save_level(c);
make_local_direction(info(math_dir_stack),true);
end;
function sgml_out_on_one_line(p:pointer):boolean;
begin
if (sgml_tag(p)="mi") or (sgml_tag(p)="mo") or (sgml_tag(p)="mn") then
sgml_out_on_one_line:=true
else sgml_out_on_one_line:=false;
end;
procedure sgml_attrs_out(p:pointer);
var q:pointer;
begin
q:=p;
while q<>null do begin
print(" ");
print(sgml_tag(q)); print("=");
print(sgml_attribute_quote);
print(sgml_attrs(q));
print(sgml_attribute_quote);
q:=link(q);
end;
end;
function sgml_out_mlist(break_line,back_at_bol,inside_vert:boolean):boolean;
var p,q:pointer;
old_selector:integer;
i,fsort:integer;
beg_of_vert:boolean;
doing_vert_node:boolean;
save_mml_indent:integer;
begin
if inside_vert then begin
if is_char_node(cur_mlist) then beg_of_vert:=false
else if type(cur_mlist)=sgml_entity_node then beg_of_vert:=true
else beg_of_vert:=false;
end
else beg_of_vert:=false;
old_selector:=selector;
selector:=max_selector+mml_file_no;
p:=cur_mlist;
while p<>null do begin
if is_char_node(p) then begin
doing_vert_node:=false;
fsort:=font_name_sort(font(p));
if (font_sort_char_entity(fsort)(character(p))<>0) then begin
if back_at_bol then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
print(font_sort_char_entity(fsort)(character(p)));
end;
end
else begin
case type(p) of
hlist_node,vlist_node,rule_node,
ins_node,mark_node,adjust_node: do_nothing;
ligature_node: begin
doing_vert_node:=false;
fsort:=font_name_sort(font(lig_char(p)));
if (font_sort_char_entity(fsort)(character(lig_char(p)))<>0) then begin
if back_at_bol then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
print(font_sort_char_entity(fsort)(character(lig_char(p))));
end;
end;
disc_node,whatsit_node,math_node,glue_node,
kern_node,penalty_node,unset_node: do_nothing;
sgml_node: begin
doing_vert_node:=false;
if sgml_tag(p)=0 then begin
print(sgml_attrs(p));
end
else if sgml_singleton(p)>=1 then begin
if sgml_kind(p)<>sgml_text_node then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
print("<"); print(sgml_tag(p));
sgml_attrs_out(sgml_attrs(p));
if sgml_singleton(p)=1 then print(sgml_empty_tag_marker);
print(">");
if sgml_kind(p)<>sgml_text_node then begin
print(new_line_char); back_at_bol:=true;
end;
end
else begin
if sgml_kind(p)=sgml_vert_node then
doing_vert_node:=true;
if str_eq_str(sgml_tag(p),"math") then begin
print(new_line_char);
back_at_bol:=true;
end;
if back_at_bol then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
print("<"); print(sgml_tag(p));
sgml_attrs_out(sgml_attrs(p)); print(">");
if (sgml_kind(p)<>sgml_text_node) and
(sgml_tag(p)<>"mtext") then begin
if not(sgml_out_on_one_line(p)) then begin
mml_indent:=mml_indent+1;
print(new_line_char);
back_at_bol:=true;
end;
end;
cur_mlist:=sgml_info(p);
if cur_mlist<>null then begin
if (sgml_kind(p)=sgml_vert_node) then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
back_at_bol:=
sgml_out_mlist(false,back_at_bol,sgml_kind(p)=sgml_vert_node);
if (sgml_kind(p)=sgml_vert_node) then
if not back_at_bol then begin
print(new_line_char);
back_at_bol:=true;
end;
end;
if (sgml_kind(p)<>sgml_text_node) and
(sgml_tag(p)<>"mtext") then begin
if not(sgml_out_on_one_line(p)) then begin
mml_indent:=mml_indent-1;
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
end;
print(""); print(sgml_tag(p)); print(">");
if sgml_kind(p)<>sgml_text_node then begin
print(new_line_char);
back_at_bol:=true;
end;
if sgml_kind(p)=sgml_vert_node then
beg_of_vert:=true;
if str_eq_str(sgml_tag(p),"math") then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
end;
end;
end;
sgml_entity_node: begin
if not(doing_vert_node and (sgml_entity_string(p)=" ")) then begin
print(sgml_entity_string(p));
doing_vert_node:=false;
beg_of_vert:=false;
back_at_bol:=false;
end;
end;
fraction_noad: begin
doing_vert_node:=false;
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("Arguments");
print(new_line_char); back_at_bol:=true;
end;
othercases begin
doing_vert_node:=false;
if (info(subscr(p))<>null) or
(info(supscr(p))<>null) then begin
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("empty then print("sub");
if info(supscr(p))<>empty then print("sup");
print(">");
mml_indent:=mml_indent+1;
print(new_line_char);
back_at_bol:=true;
end;
sgml_out_pointer(nucleus);
if (info(subscr(p))<>null) or
(info(supscr(p))<>null) then begin
if info(subscr(p))<>null then begin
sgml_out_pointer(subscr);
end;
if info(supscr(p))<>null then begin
sgml_out_pointer(supscr);
end;
mml_indent:=mml_indent-1;
for i:=1 to mml_indent do print(" ");
back_at_bol:=false;
print("null then print("sub");
if info(supscr(p))<>null then print("sup");
print(">");
print(new_line_char);
back_at_bol:=true;
end;
end;
endcases;
end;
p:=link(p);
if not(doing_vert_node) then
if p<>null then
if not(is_char_node(p)) then
if type(p)=sgml_node then
if sgml_kind(p)=sgml_vert_node then begin
print(new_line_char);
back_at_bol:=true;
end;
end;
selector:=old_selector;
sgml_out_mlist:=back_at_bol;
end;
procedure make_sgml_entity(s:str_number);
begin
link(tail):=new_sgml_entity_node;
tail:=link(tail);
sgml_entity_string(tail):=s;
end;
procedure scan_font_entity;
var cv1,cv2,cv3,cv4:integer;
begin
scan_string_argument; cv1:=cur_val;
scan_left_brace; scan_int; cv2:=cur_val; scan_right_brace;
scan_string_argument; cv3:=cur_val;
scan_string_argument; cv4:=cur_val;
save_ptr:=save_ptr+4;
saved(-1):=cv1; saved(-2):=cv2; saved(-3):=cv3; saved(-4):=cv4;
new_save_level(font_entity_group); scan_left_brace; push_nest;
end;
procedure scan_empty_tag;
begin
scan_string_argument;
link(tail):=new_sgml_node;
tail:=link(tail);
sgml_tag(tail):=cur_val;
sgml_kind(tail):=sgml_text_node;
sgml_singleton(tail):=1;
incr(save_ptr); saved(-1):=tail;
new_save_level(empty_tag_group); scan_left_brace; push_nest;
end;
procedure scan_math_empty_tag;
begin
scan_string_argument;
link(tail):=new_sgml_node;
tail:=link(tail);
sgml_tag(tail):=cur_val;
sgml_kind(tail):=sgml_math_node;
sgml_singleton(tail):=1;
incr(save_ptr); saved(-1):=tail;
new_save_level(empty_tag_group); scan_left_brace; push_nest;
end;
procedure sgml_startmathtag(s:str_number);
begin
push_math(math_group); current_sgml_tag:=s;
end;
procedure sgml_startverttag(s:str_number);
begin
push_nest; new_save_level(vert_sgml_group);
current_sgml_tag:=s;
mode:=-hmode;
end;
procedure sgml_startpartag(s:str_number);
begin
push_nest; new_save_level(par_sgml_group);
current_sgml_tag:=s;
mode:=-hmode;
end;
procedure sgml_starttexttag(s:str_number);
begin
push_nest; new_save_level(text_sgml_group);
current_sgml_tag:=s;
mode:=-hmode;
end;
procedure sgml_tag_attribute(tag,s,s1:str_number);
var p:pointer;
nest_level:integer;
found_tag:boolean;
begin
p:=new_sgml_attr_node;
sgml_tag(p):=s;
sgml_attrs(p):=s1;
sgml_singleton(p):=0;
if str_eq_str(tag,current_sgml_tag) then begin
link(p):=current_sgml_attrs;
current_sgml_attrs:=p;
end
else begin
nest_level:= nest_ptr - 1;
found_tag:=false;
while (nest_level>0) and
(not str_eq_str(nest[nest_level].sgml_field,tag)) do
decr(nest_level);
if nest_level<>0 then begin
link(p):=nest[nest_level].sgml_attr_field;
nest[nest_level].sgml_attr_field:=p;
end
else begin
print("Tag not found in call to SGMLtagattribute"); print_ln;
end;
end;
end;
procedure sgml_attribute(s,s1:str_number);
var p,q:pointer;
begin
p:=new_sgml_attr_node;
sgml_tag(p):=s;
sgml_attrs(p):=s1;
sgml_singleton(p):=0;
link(p):=null;
if current_sgml_attrs=null then
current_sgml_attrs:=p
else begin
q:=current_sgml_attrs;
while link(q)<>null do q:=link(q);
link(q):=p;
end;
end;
procedure sgml_endtexttag(s:str_number);
var q:pointer;
begin
if not str_eq_str(s,current_sgml_tag) then begin
print_err("Tags do not match: ");
print(current_sgml_tag); print(","); print(s);
print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end;
q:=new_sgml_node;
sgml_tag(q):=s;
sgml_kind(q):=sgml_text_node;
sgml_info(q):=link(head);
sgml_attrs(q):=current_sgml_attrs;
pop_nest;
unsave;
if mode=vmode then begin
ensure_sgml_open;
cur_mlist:=q;
tmp_back_at_bol:=sgml_out_mlist(false,true,false);
end
else begin
link(tail):=q;
tail:=q;
end;
end;
procedure sgml_endverttag(s:str_number);
var q:pointer;
begin
if not str_eq_str(s,current_sgml_tag) then begin
print_err("Tags do not match: ");
print(current_sgml_tag); print(","); print(s);
print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end;
q:=new_sgml_node;
sgml_tag(q):=s;
sgml_kind(q):=sgml_vert_node;
sgml_info(q):=link(head);
sgml_attrs(q):=current_sgml_attrs;
pop_nest;
unsave;
if mode=vmode then begin
ensure_sgml_open;
cur_mlist:=q;
tmp_back_at_bol:=sgml_out_mlist(false,true,false);
end
else begin
link(tail):=q;
tail:=q;
end;
end;
procedure sgml_endpartag(s:str_number);
var q:pointer;
begin
if not str_eq_str(s,current_sgml_tag) then begin
print_err("Tags do not match: ");
print(current_sgml_tag); print(","); print(s);
print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end;
q:=new_sgml_node;
sgml_tag(q):=s;
sgml_kind(q):=sgml_vert_node;
sgml_info(q):=link(head);
sgml_attrs(q):=current_sgml_attrs;
pop_nest;
unsave;
if sgml_info(q)=null then begin
flush_node_list(q);
end
else if mode=vmode then begin
ensure_sgml_open;
cur_mlist:=q;
tmp_back_at_bol:=sgml_out_mlist(false,true,false);
end
else begin
link(tail):=q;
tail:=q;
end;
end;
procedure sgml_write(s:str_number);
var old_selector:integer;
begin
ensure_sgml_open;
old_selector:=selector;
selector:=max_selector+mml_file_no;
print(s);
selector:=old_selector;
end;
procedure sgml_endmathtag(s:str_number);
var q:pointer;
begin
if not str_eq_str(s,current_sgml_tag) then begin
print_err("Tags do not match: ");
print(current_sgml_tag); print(","); print(s);
print_ln;
print_nl("The SGML translator cannot continue");
succumb;
end;
q:=new_sgml_node;
sgml_tag(q):=s;
sgml_kind(q):=sgml_math_node;
if s<>"mtext" then sgml_attrs(q):=current_sgml_attrs;
sgml_info(q):=link(head);
if current_sgml_attrs=null then
if (link(head)<>null) then
if (str_eq_str(s,"mtr") or str_eq_str(s,"mtd")) and
(link(link(head))=null) then begin
q:=sgml_info(q);
end;
pop_nest;
unsave;
link(tail):=q;
tail:=q;
end;
procedure sgml_start_graf;
begin
print("Executing sgml_start_graf"); print_ln;
sgml_starttexttag(sgml_paragraph_tag);
end;
procedure sgml_end_graf;
begin
sgml_endtexttag(sgml_paragraph_tag);
print("Executing sgml_end_graf"); print_ln;
end;
@ Entering or leaving MML mode
by using the routine called |primitive|, defined below. Let us enter them
now, so that we don't have to list all those parameter names anywhere else.
@=
primitive("showSGMLentities",set_show_sgml_entities,1);
primitive("noshowSGMLentities",set_show_sgml_entities,0);
primitive("SGMLmode",set_mml_mode,1);
@!@:SGML_mode_}{\.{\\SGMLmode} primitive@>
primitive("noSGMLmode",set_mml_mode,0);
@!@:noSGML_mode_}{\.{\\noSGMLmode} primitive@>
primitive("SGMLstartmathtag",sgml_command,0);
primitive("SGMLendmathtag",sgml_command,1);
primitive("SGMLstarttexttag",sgml_command,2);
primitive("SGMLendtexttag",sgml_command,3);
primitive("SGMLattribute",sgml_command,4);
primitive("MMLstarttext",sgml_command,5);
primitive("MMLendtext",sgml_command,6);
primitive("SGMLampersand",other_char,"&");
primitive("SGMLbackslash",other_char,"\");
primitive("SGMLcarret",other_char,"^");
primitive("SGMLdollar",other_char,"$");
primitive("SGMLhash",other_char,"#");
primitive("SGMLleftbrace",other_char,"{");
primitive("SGMLpercent",other_char,"%");
primitive("SGMLrightbrace",other_char,"}");
primitive("SGMLunderscore",other_char,"_");
primitive("SGMLquote",other_char,"'");
primitive("SGMLbackquote",other_char,"");
primitive("SGMLdoublequote",other_char,"""");
primitive("SGMLtilde",other_char,"~");
primitive("SGMLexclamationmark",other_char,"!");
primitive("SGMLquestionmark",other_char,"?");
primitive("SGMLequals",other_char,"=");
primitive("SGMLcolon",other_char,":");
primitive("SGMLsemicolon",other_char,";");
primitive("SGMLentity",sgml_command,7);
primitive("SGMLemptytag",sgml_command,8);
primitive("SGMLFontEntity",sgml_command,9);
primitive("SGMLwrite",sgml_command,10);
primitive("SGMLwriteln",sgml_command,11);
primitive("SGMLfilesuffix",sgml_command,12);
primitive("SGMLattributequote",sgml_command,13);
primitive("SGMLemptytagmarker",sgml_command,14);
primitive("SGMLtagattribute",sgml_command,15);
primitive("SGMLstartverttag",sgml_command,16);
primitive("SGMLendverttag",sgml_command,17);
primitive("SGMLmathemptytag",sgml_command,18);
primitive("SGMLstartpartag",sgml_command,19);
primitive("SGMLendpartag",sgml_command,20);
@ @=
mmode+set_mml_mode: report_illegal_case;
non_math(set_mml_mode):
if cur_chr=0 then SGML_mode:=false else SGML_mode:=true;
any_mode(set_show_sgml_entities):
if cur_chr=0 then SGML_show_entities:=false
else SGML_show_entities:=true;
any_mode(sgml_command): begin
case cur_chr of
0: begin scan_string_argument; sgml_startmathtag(cur_val); end;
1: begin scan_string_argument; sgml_endmathtag(cur_val); end;
2: begin scan_string_argument; sgml_starttexttag(cur_val); end;
3: begin scan_string_argument; sgml_endtexttag(cur_val); end;
4: begin scan_string_argument; cur_val1:=cur_val;
scan_string_argument; sgml_attribute(cur_val1,cur_val); end;
5: begin
push_nest; new_save_level(text_mml_group);
current_sgml_tag:="mtext"; mode:=-hmode;
end;
6: begin sgml_endmathtag("mtext"); end;
7: begin scan_string_argument; make_sgml_entity(cur_val); end;
8: begin scan_empty_tag; end;
9: begin scan_font_entity; end;
10: begin scan_string_argument; sgml_write(cur_val); end;
11: begin sgml_write(new_line_char); end;
12: begin scan_string_argument; sgml_file_suffix:=cur_val; end;
13: begin scan_string_argument; sgml_attribute_quote:=cur_val; end;
14: begin scan_string_argument; sgml_empty_tag_marker:=cur_val; end;
15: begin scan_string_argument; cur_val2:=cur_val;
scan_string_argument; cur_val1:=cur_val;
scan_string_argument;
sgml_tag_attribute(cur_val2,cur_val1,cur_val);
end;
16: begin scan_string_argument; sgml_startverttag(cur_val); end;
17: begin scan_string_argument; sgml_endverttag(cur_val); end;
18: begin scan_math_empty_tag; end;
19: begin scan_string_argument; sgml_startpartag(cur_val); end;
20: begin scan_string_argument; sgml_endpartag(cur_val); end;
end;
end;
@ The following code opens \.{MML} output file if neccesary.
@p procedure ensure_sgml_open;
begin
if mml_file_no=0 then begin
incr(output_file_no);
mml_file_no:=output_file_no;
ensure_output_open(sgml_file_suffix)
(output_file_names[mml_file_no])
(output_files[mml_file_no]);
output_file_names[mml_file_no]:=output_m_name;
end;
end;
@ @=
@z
%---------------------------------------
@x [48] m.1137 l.21620 - Omega
@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
|math_shift| character) is scanned. We must check to see whether this
`\.\$' is immediately followed by another, in case display math mode is
called for.
@=
hmode+math_shift:init_math;
@y
@ We get into math mode from horizontal mode when a `\.\$' (i.e., a
|math_shift| character) is scanned. We must check to see whether this
`\.\$' is immediately followed by another, in case display math mode is
called for.
@=
hmode+math_shift: begin
if SGML_mode then begin
ensure_sgml_open;
incr(MML_level);
end;
init_math;
end;
@z
%---------------------------------------
@x [48] m.1139 l.21648 - Omega
if every_math<>null then begin_token_list(every_math,every_math_text);
@y
current_sgml_tag:="mrow";
sgml_attribute("displaystyle","false");
if every_math<>null then begin_token_list(every_math,every_math_text);
@z
%---------------------------------------
@x [48] m.1145 l.21703 - Omega
if every_display<>null then begin_token_list(every_display,every_display_text);
@y
current_sgml_tag:="mrow";
sgml_attribute("displaystyle","true");
if every_display<>null then begin_token_list(every_display,every_display_text);
@z
%---------------------------------------
@x [48] m.1155 l.21878 - Omega
else type(p):=ord_noad+(c div @"1000000);
link(tail):=p; tail:=p;
@y
else type(p):=ord_noad+(c div @"1000000);
if not SGML_mode then
tail_append(p)
else if (c div @"1000000)=4 then begin
saved(0):=p;
incr(save_ptr);
push_math(math_mml_group);
end
else if (cur_group=math_mml_group) and
((c div @"1000000)=5) then begin
unsave;
decr(save_ptr);
q:=saved(0);
r:=fin_mlist(null);
push_math(math_group);
tail_append(q); tail_append(r); tail_append(p);
unsave;
p:=fin_mlist(null);
tail_append(p);
end
else tail_append(p);
@z
%---------------------------------------
@x [48] m.1176--1177 l.22109 - Omega
procedure sub_sup;
var t:small_number; {type of previous sub/superscript}
@!p:pointer; {field to be filled by |scan_math|}
begin t:=empty; p:=null;
if tail<>head then if scripts_allowed(tail) then
begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
t:=math_type(p);
end;
if (p=null)or(t<>empty) then @;
scan_math(p);
end;
@y
procedure sub_sup;
var t:small_number; {type of previous sub/superscript}
@!p,q,r:pointer; {field to be filled by |scan_math|}
begin t:=empty; p:=null;
if tail<>head then begin
if SGML_mode then
if type(tail)=sgml_node then begin
q:=head;
while link(q)<>tail do q:=link(q);
r:=new_noad;
info(nucleus(r)):=tail;
math_type(nucleus(r)):=sub_mlist;
link(q):=r;
tail:=r;
end;
if scripts_allowed(tail) then
begin p:=supscr(tail)+cur_cmd-sup_mark; {|supscr| or |subscr|}
t:=math_type(p);
end;
end;
if (p=null)or(t<>empty) then @;
scan_math(p);
end;
@z
%---------------------------------------
@x [48] m.1181 l.22199 - Omega
procedure math_fraction;
var c:small_number; {the type of generalized fraction we are scanning}
begin c:=cur_chr;
if incompleat_noad<>null then
@
else begin incompleat_noad:=get_node(fraction_noad_size);
type(incompleat_noad):=fraction_noad;
subtype(incompleat_noad):=normal;
math_type(numerator(incompleat_noad)):=sub_mlist;
info(numerator(incompleat_noad)):=link(head);
mem[denominator(incompleat_noad)].hh:=empty_field;
mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter;
mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/
link(head):=null; tail:=head;
@