diff options
Diffstat (limited to 'Build/source/texk/web2c/omegadir/omxml.ch')
-rw-r--r-- | Build/source/texk/web2c/omegadir/omxml.ch | 2099 |
1 files changed, 0 insertions, 2099 deletions
diff --git a/Build/source/texk/web2c/omegadir/omxml.ch b/Build/source/texk/web2c/omegadir/omxml.ch deleted file mode 100644 index db743bc06ad..00000000000 --- a/Build/source/texk/web2c/omegadir/omxml.ch +++ /dev/null @@ -1,2099 +0,0 @@ -% 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_base)or(font(p)>font_max) then - print_char("*") -@.*\relax@> - else @<Print the font identifier for |font(p)|@>; - 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_base)or(font(p)>font_max) then - print_char("*") -@.*\relax@> - else @<Print the font identifier for |font(p)|@>; - 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_base)or(font(p)>font_max) then print_char("*") -@.*\relax@> - else @<Print the font identifier for |font(p)|@>; - 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_base)or(font(p)>font_max) then print_char("*") -@.*\relax@> - else @<Print the font identifier for |font(p)|@>; - 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 - -@<Glob...@>= -@!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 - -@<Glob...@>= -@!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 -@ @<Initialize the output...@>=output_file_name:=0; -@y -@ @<Initialize the output...@>=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 -@<Ship box |p| out@>; -@y -if not SGML_mode then begin @<Ship box |p| out@>; 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|. - -@<Declare act...@>= -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|. - -@<Glob...@>= -@!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; - -@ @<Set init...@>= -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("<mo"); - if (type(p)=op_noad) and (subtype(p)=limits) then begin - print(" limits=""true"""); - end - else if (type(p)=op_noad) and (subtype(p)=no_limits) then begin - print(" limits=""false"""); - end; - 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("</mo>"); - 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("<merror> Unrecognized math stuff </merror>"); - print(new_line_char); - back_at_bol:=true; - end - endcases; - -@<Declare act...@>= -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("<mfrac>Arguments</mfrac>"); - 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("<m"); - if info(subscr(p))<>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("</m"); - if info(subscr(p))<>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. - -@<Put each of \TeX's primitives into the hash table@>= -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); - -@ @<Cases of |main_control| that build boxes and lists@>= -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; - -@ @<Declare act...@>= - -@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. - -@<Cases of |main_control| that build...@>= -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. - -@<Cases of |main_control| that build...@>= -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 @<Insert a dummy noad to be sub/superscripted@>; -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 @<Insert a dummy noad to be sub/superscripted@>; -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 - @<Ignore the fraction operation and complain about this ambiguous case@> -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; - @<Use code |c| to distinguish between generalized fractions@>; - end; -end; -@y -procedure math_fraction; -var c:small_number; {the type of generalized fraction we are scanning} -begin c:=cur_chr; -if incompleat_noad<>null then - @<Ignore the fraction operation and complain about this ambiguous case@> -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; - if SGML_mode then begin - mem[left_delimiter(incompleat_noad)].int:=0; - mem[right_delimiter(incompleat_noad)].int:=0;@/ - end - else begin - mem[left_delimiter(incompleat_noad)].qqqq:=null_delimiter; - mem[right_delimiter(incompleat_noad)].qqqq:=null_delimiter;@/ - end; - link(head):=null; tail:=head; - @<Use code |c| to distinguish between generalized fractions@>; - end; -end; -@z -%--------------------------------------- -@x [48] m.1182 l.22199 - Omega - begin scan_delimiter(left_delimiter(incompleat_noad),false); - scan_delimiter(right_delimiter(incompleat_noad),false); -@y - begin if SGML_mode then begin - mem[left_delimiter(incompleat_noad)].int:=new_noad; - scan_math(nucleus(mem[left_delimiter(incompleat_noad)].int)); - mem[right_delimiter(incompleat_noad)].int:=new_noad; - scan_math(nucleus(mem[right_delimiter(incompleat_noad)].int)); - end - else begin - scan_delimiter(left_delimiter(incompleat_noad),0); - scan_delimiter(right_delimiter(incompleat_noad),0); - end; -@z -%--------------------------------------- -@x [48] m.1183 l.22212 - Omega - begin scan_delimiter(garbage,false); scan_delimiter(garbage,false); -@y - begin if SGML_mode then begin - scan_math(garbage); scan_math(garbage); - end - else begin - scan_delimiter(garbage,0); scan_delimiter(garbage,0); - end; -@z -%--------------------------------------- -@x [48] m.1184 l.22230 - Omega -function fin_mlist(@!p:pointer):pointer; -var q:pointer; {the mlist to return} -begin if incompleat_noad<>null then @<Compleat the incompleat noad@> -else begin link(tail):=p; q:=link(head); - end; -pop_nest; fin_mlist:=q; -end; -@y -function fin_mlist(@!p:pointer):pointer; -var q,q1,q2:pointer; {the mlist to return} - tag:integer; -begin if incompleat_noad<>null then @<Compleat the incompleat noad@> -else begin link(tail):=p; q:=link(head); - end; -if current_sgml_tag=0 then - tag:="mrow" -else tag:=current_sgml_tag; -pop_nest; -if SGML_mode then - if q<>null then - if link(q)<>null then begin - q1:=new_sgml_node; - sgml_tag(q1):=tag; - sgml_info(q1):=q; - sgml_kind(q1):=sgml_math_node; - fin_mlist:=q1 - end - else fin_mlist:=q - else fin_mlist:=q -else - fin_mlist:=q; -end; -@z -%--------------------------------------- -@x [48] m.1185 l.22256 - Omega -@ @<Compleat...@>= -begin math_type(denominator(incompleat_noad)):=sub_mlist; -info(denominator(incompleat_noad)):=link(head); -if p=null then q:=incompleat_noad -else begin q:=info(numerator(incompleat_noad)); - if type(q)<>left_noad then confusion("right"); -@:this can't happen right}{\quad right@> - info(numerator(incompleat_noad)):=link(q); - link(q):=incompleat_noad; link(incompleat_noad):=p; - end; -end -@y -@ @<Compleat...@>= -begin math_type(denominator(incompleat_noad)):=sub_mlist; -info(denominator(incompleat_noad)):=link(head); -if p=null then - if not SGML_mode then - q:=incompleat_noad - else begin - if link(info(numerator(incompleat_noad)))<>null then begin - q1:=new_sgml_node; - sgml_tag(q1):="mrow"; - sgml_kind(q1):=sgml_math_node; - sgml_info(q1):=info(numerator(incompleat_noad)); - end - else q1:=info(numerator(incompleat_noad)); - if link(info(denominator(incompleat_noad)))<>null then begin - q2:=new_sgml_node; - sgml_tag(q2):="mrow"; - sgml_kind(q2):=sgml_math_node; - sgml_info(q2):=info(denominator(incompleat_noad)); - end - else q2:=info(denominator(incompleat_noad)); - q:=new_sgml_node; - sgml_tag(q):="mfrac"; - sgml_kind(q):=sgml_math_node; - sgml_info(q):=q1; - link(q1):=q2; - current_sgml_attrs:=null; - if thickness(incompleat_noad)<>default_code then - if thickness(incompleat_noad)=0 then - sgml_attribute("linethickness","0ex") - else if thickness(incompleat_noad)<default_rule_thickness then - sgml_attribute("linethickness","thin") - else if thickness(incompleat_noad)>default_rule_thickness then - sgml_attribute("linethickness","thick"); - sgml_attrs(q):=current_sgml_attrs; - if (mem[left_delimiter(incompleat_noad)].int<>0) or - (mem[right_delimiter(incompleat_noad)].int<>0) then begin - q1:=q; - q:=new_sgml_node; - sgml_tag(q):="mrow"; - sgml_kind(q):=sgml_math_node; - sgml_info(q):=mem[left_delimiter(incompleat_noad)].int; - link(mem[left_delimiter(incompleat_noad)].int):=q1; - link(q1):=mem[right_delimiter(incompleat_noad)].int; - end - end -else begin q:=info(numerator(incompleat_noad)); - if type(q)<>left_noad then confusion("right"); -@:this can't happen right}{\quad right@> - info(numerator(incompleat_noad)):=link(q); - link(q):=incompleat_noad; link(incompleat_noad):=p; - end; -end -@z -%--------------------------------------- -@x [48] m.1186 l.22256 - Omega -math_group: begin unsave; decr(save_ptr);@/ - math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p; - if p<>null then if link(p)=null then - if type(p)=ord_noad then - begin if math_type(subscr(p))=empty then - if math_type(supscr(p))=empty then - begin mem[saved(0)].hh:=mem[nucleus(p)].hh; - free_node(p,noad_size); - end; - end - else if type(p)=accent_noad then if saved(0)=nucleus(tail) then - if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>; - end; -@y -text_mml_group: begin - unsave; decr(save_ptr); - p:=saved(0); - sgml_info(p):=link(head); - pop_nest; - tail_append(p); - end; -text_sgml_group: begin - print_err("Expecting closing tag </"); - print(current_sgml_tag); print(">."); - print_ln; - print_nl("The SGML translator cannot continue"); - succumb; - end; -vert_sgml_group: begin - print_err("Expecting closing tag </"); - print(current_sgml_tag); print(">."); - print_ln; - print_nl("The SGML translator cannot continue"); - succumb; - end; -par_sgml_group: begin - print_err("Expecting closing tag </"); - print(current_sgml_tag); print(">."); - print_ln; - print_nl("The SGML translator cannot continue"); - succumb; - end; -math_mml_group: begin - unsave; - decr(save_ptr); - link(saved(0)):=link(head); - p:=saved(0); - pop_nest; - if type(p)=sgml_node then - if str_eq_str(sgml_tag(p),"mrow") then - if sgml_attrs(p)=null then begin - if link(sgml_info(p))=null then - p:=sgml_info(p); - end; - tail_append(p); - back_input; - end; -math_group: begin unsave; decr(save_ptr);@/ - if SGML_mode then - math_type(saved(0)):=sub_mlist - else - math_type(saved(0)):=sub_mlist; - p:=fin_mlist(null); info(saved(0)):=p; - if p<>null then if link(p)=null then - if type(p)=ord_noad then - begin if math_type(subscr(p))=empty then - if math_type(supscr(p))=empty then - begin mem[saved(0)].hh:=mem[nucleus(p)].hh; - free_node(p,noad_size); - end; - end - else if type(p)=accent_noad then if saved(0)=nucleus(tail) then - if type(tail)=ord_noad then @<Replace the tail of the list by |p|@>; - end; -font_entity_group: begin - unsave; - font_sort_number:=font_sort_ptr+1; - for font_sorts:=font_sort_base+1 to font_sort_ptr do - if str_eq_str(font_sort_name(font_sorts),saved(-1)) then begin - font_sort_number:=font_sorts; - break; - end; - font_sort_c:=saved(-2); - font_sort_char_entity(font_sort_number)(font_sort_c):=saved(-3); - font_sort_char_tag(font_sort_number)(font_sort_c):=saved(-4); - font_sort_char_attr(font_sort_number)(font_sort_c):=current_sgml_attrs; - current_sgml_attrs:=null; - save_ptr:=save_ptr-4; pop_nest; - end; -empty_tag_group: begin - unsave; sgml_attrs(saved(-1)):=current_sgml_attrs; - decr(save_ptr); pop_nest; - end; -@z -%--------------------------------------- -@x [48] m.1191 l.22301 - Omega -procedure math_left_right; -var t:small_number; {|left_noad| or |right_noad|} -@!p:pointer; {new noad} -begin t:=cur_chr; -if (t=right_noad)and(cur_group<>math_left_group) then - @<Try to recover from mismatched \.{\\right}@> -else begin p:=new_noad; type(p):=t; - scan_delimiter(delimiter(p),false); - if t=left_noad then - begin push_math(math_left_group); link(head):=p; tail:=p; - end - else begin p:=fin_mlist(p); unsave; {end of |math_left_group|} - tail_append(new_noad); type(tail):=inner_noad; - math_type(nucleus(tail)):=sub_mlist; - info(nucleus(tail)):=p; - end; - end; -end; -@y -procedure math_left_right; -var t:small_number; {|left_noad| or |right_noad|} -@!p,q,r:pointer; {new noad} -begin t:=cur_chr; -if (t=right_noad)and(cur_group<>math_left_group) then - @<Try to recover from mismatched \.{\\right}@> -else begin p:=new_noad; - if SGML_mode then begin - scan_math(nucleus(p)); - if t=left_noad then begin - saved(0):=p; incr(save_ptr); - push_math(math_left_group); - end - else 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 - end - else begin - type(p):=t; - scan_delimiter(delimiter(p),false); - if t=left_noad then - begin push_math(math_left_group); link(head):=p; tail:=p; - end - else begin p:=fin_mlist(p); unsave; {end of |math_left_group|} - tail_append(new_noad); type(tail):=inner_noad; - math_type(nucleus(tail)):=sub_mlist; - info(nucleus(tail)):=p; - end; - end; - end; -end; -@z -%--------------------------------------- -@x [48] m.1192 l.22284 - Omega -begin if cur_group=math_shift_group then - begin scan_delimiter(garbage,false); - print_err("Extra "); print_esc("right"); -@.Extra \\right.@> - help1("I'm ignoring a \right that had no matching \left."); - error; - end -else off_save; -end -@y -begin if cur_group=math_shift_group then - begin if SGML_mode then scan_math(garbage) - else scan_delimiter(garbage,0); - print_err("Extra "); print_esc("right"); -@.Extra \\right.@> - help1("I'm ignoring a \right that had no matching \left."); - error; - end -else off_save; -end -@z -%--------------------------------------- -@x [48] m.1193 l.22327 - Omega -mmode+math_shift: if cur_group=math_shift_group then after_math - else off_save; -@y -mmode+math_shift: if cur_group=math_mml_group then after_mml - else if cur_group=math_shift_group then after_math - else off_save; -@z -%--------------------------------------- -@x [48] m.1194 l.22284 - Omega -procedure after_math; -var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} -@!danger:boolean; {not enough symbol fonts are present} -@!m:integer; {|mmode| or |-mmode|} -@!p:pointer; {the formula} -@!a:pointer; {box containing equation number} -@<Local variables for finishing a displayed formula@>@; -begin danger:=false; -@<Check that the necessary fonts for math symbols are present; - if not, flush the current math lists and set |danger:=true|@>; -m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} -if mode=-m then {end of equation number} - begin @<Check that another \.\$ follows@>; - cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false; - mlist_to_hlist; a:=hpack(link(temp_head),natural,info(math_dir_stack)); - unsave; decr(save_ptr); {now |cur_group=math_shift_group|} - if saved(0)=1 then l:=true; - danger:=false; - @<Check that the necessary fonts for math symbols are present; - if not, flush the current math lists and set |danger:=true|@>; - m:=mode; p:=fin_mlist(null); - end -else a:=null; -if m<0 then @<Finish math in text@> -else begin if a=null then @<Check that another \.\$ follows@>; - @<Finish displayed math@>; - end; -end; -@y -procedure after_mml; -var p:pointer; -begin -unsave; -decr(save_ptr); -link(saved(0)):=link(head); -p:=saved(0); -pop_nest; -tail_append(p); -back_input; -end; - -procedure after_math; -var l:boolean; {`\.{\\leqno}' instead of `\.{\\eqno}'} -@!danger:boolean; {not enough symbol fonts are present} -@!m:integer; {|mmode| or |-mmode|} -@!p:pointer; {the formula} -@!a:pointer; {box containing equation number} -@<Local variables for finishing a displayed formula@>@; -begin danger:=false; -@<Check that the necessary fonts for math symbols are present; - if not, flush the current math lists and set |danger:=true|@>; -m:=mode; l:=false; p:=fin_mlist(null); {this pops the nest} -if SGML_mode then decr(MML_level); -if mode=-m then {end of equation number} - begin @<Check that another \.\$ follows@>; - cur_mlist:=p; cur_style:=text_style; mlist_penalties:=false; - if SGML_mode then begin - tmp_back_at_bol:=sgml_out_mlist(true,true,false) - end - else begin - mlist_to_hlist; a:=hpack(link(temp_head),natural,info(math_dir_stack)); - end; - unsave; decr(save_ptr); {now |cur_group=math_shift_group|} - if saved(0)=1 then l:=true; - danger:=false; - @<Check that the necessary fonts for math symbols are present; - if not, flush the current math lists and set |danger:=true|@>; - m:=mode; p:=fin_mlist(null); - end -else a:=null; -if m<0 then @<Finish math in text@> -else begin if a=null then @<Check that another \.\$ follows@>; - @<Finish displayed math@>; - end; -end; -@z -%--------------------------------------- -@x [49] m.1196 l.22388 - Omega -@<Finish math in text@> = -begin tail_append(new_math(math_surround,before)); -cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); mlist_to_hlist; -link(tail):=link(temp_head); -while link(tail)<>null do tail:=link(tail); -tail_append(new_math(math_surround,after)); -space_factor:=1000; unsave; -tmp_dir_stack:=math_dir_stack; -math_dir_stack:=link(math_dir_stack); -free_avail(tmp_dir_stack); -end -@y -@<Finish math in text@>= -begin -if not SGML_mode then begin - tail_append(new_math(math_surround,before)); - end; -cur_mlist:=p; cur_style:=text_style; mlist_penalties:=(mode>0); -if SGML_mode then begin -{ - if MML_level=0 then tmp_back_at_bol:=sgml_out_mlist(true,true,false) - else tail_append(cur_mlist); -} - sgml_starttexttag("inlinemath"); - sgml_startmathtag("math"); - tail_append(cur_mlist); - sgml_endmathtag("math"); - sgml_endtexttag("inlinemath"); - end -else begin - mlist_to_hlist; - link(tail):=link(temp_head); - while link(tail)<>null do tail:=link(tail); - tail_append(new_math(math_surround,after)); - end; -space_factor:=1000; unsave; -tmp_dir_stack:=math_dir_stack; -math_dir_stack:=link(math_dir_stack); -free_avail(tmp_dir_stack); -end -@z -%--------------------------------------- -@x [49] m.1197 l.22430 - Omega -@<Finish displayed math@>= -cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false; -mlist_to_hlist; p:=link(temp_head);@/ -adjust_tail:=adjust_head; b:=hpack(p,natural,info(math_dir_stack)); -p:=list_ptr(b); -t:=adjust_tail; adjust_tail:=null;@/ -w:=width(b); z:=display_width; s:=display_indent; -if (a=null)or danger then - begin e:=0; q:=0; - end -else begin e:=width(a); q:=e+math_quad(text_size); - end; -if w+q>z then - @<Squeeze the equation as much as possible; if there is an equation - number that should go on a separate line by itself, - set~|e:=0|@>; -@<Determine the displacement, |d|, of the left edge of the equation, with - respect to the line size |z|, assuming that |l=false|@>; -@<Append the glue or equation number preceding the display@>; -@<Append the display and perhaps also the equation number@>; -@<Append the glue or equation number following the display@>; -resume_after_display -@y -@<Finish displayed math@>= -cur_mlist:=p; cur_style:=display_style; mlist_penalties:=false; -if SGML_mode then begin -{ - if MML_level=0 then tmp_back_at_bol:=sgml_out_mlist(true,true,false) - else tail_append(cur_mlist); -} - sgml_starttexttag("displaymath"); - sgml_startmathtag("math"); - tail_append(cur_mlist); - sgml_endmathtag("math"); - sgml_endtexttag("displaymath"); - end -else begin - mlist_to_hlist; p:=link(temp_head);@/ - adjust_tail:=adjust_head; b:=hpack(p,natural,info(math_dir_stack)); - p:=list_ptr(b); - t:=adjust_tail; adjust_tail:=null;@/ - w:=width(b); z:=display_width; s:=display_indent; - if (a=null)or danger then - begin e:=0; q:=0; - end - else begin e:=width(a); q:=e+math_quad(text_size); - end; - if w+q>z then - @<Squeeze the equation as much as possible; if there is an equation - number that should go on a separate line by itself, - set~|e:=0|@>; - @<Determine the displacement, |d|, of the left edge of the equation, with - respect to the line size |z|, assuming that |l=false|@>; - @<Append the glue or equation number preceding the display@>; - @<Append the display and perhaps also the equation number@>; - @<Append the glue or equation number following the display@>; - end; -resume_after_display -@z -%--------------------------------------- -@x [49] m.1257 l.23269 - Omega -@!flushable_string:str_number; {string not yet referenced} -begin if job_name=0 then open_log_file; - {avoid confusing \.{texput} with the font name} -@.texput@> -get_r_token; u:=cur_cs; -@y -@!flushable_string:str_number; {string not yet referenced} -@!cur_font_sort_name:str_number; {the name without the digits at the end} -@!new_length:integer; {length of font name, to become font sort name} -@!last_character:integer; {last character in font name} -@!i:integer; {to run through characters of name} -@!this_is_a_new_font:boolean; -begin if job_name=0 then open_log_file; - {avoid confusing \.{texput} with the font name} -@.texput@> -get_r_token; u:=cur_cs; -this_is_a_new_font:=false; -@z -%--------------------------------------- -@x [49] m.1257 l.23290 - Omega -common_ending: set_equiv(u,f); -set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t); -@y -this_is_a_new_font:=true; -common_ending: set_equiv(u,f); -set_new_eqtb(font_id_base+f,new_eqtb(u)); settext(font_id_base+f,t); -if this_is_a_new_font then - begin - if cur_name>=@"10000 then begin - new_length:=length(cur_name); - last_character:=str_pool[str_start(cur_name)+new_length-1]; - while (last_character>="0") and (last_character<="9") do begin - decr(new_length); - last_character:=str_pool[str_start(cur_name)+new_length-1]; - end; - for i:=1 to new_length do begin - append_char(str_pool[str_start(cur_name)+i-1]); - end; - cur_font_sort_name:=make_string; - font_sort_number:=font_sort_ptr+1; - for font_sorts:=font_sort_base+1 to font_sort_ptr do - if str_eq_str(font_sort_name(font_sorts),cur_font_sort_name) then begin - font_sort_number:=font_sorts; - break; - end; - font_name_sort(f):=font_sort_number; - if font_sort_number=(font_sort_ptr+1) then begin - incr(font_sort_ptr); - allocate_font_sort_table - (font_sort_ptr, - font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1)); - font_sort_file_size(font_sort_ptr):= - font_sort_offset_char_base+3*(font_ec(f)-font_bc(f)+1); - font_sort_name(font_sort_ptr):=cur_font_sort_name; - font_sort_ec(font_sort_ptr):=font_ec(f); - font_sort_bc(font_sort_ptr):=font_bc(f); - cur_name:=cur_font_sort_name; - cur_ext:=".onm"; - pack_cur_name; - begin_file_reading; - if a_open_in(cur_file,kpse_tex_format) then begin - name:=a_make_name_string(cur_file); - print_ln; print("("); print(name); - @<Read the first line of the new file@>; - end - else end_file_reading; - end; - end; - end; -@z -%--------------------------------------- -@x [50] m.1320 l.23983 - Omega -@ @<Dump the font information@>= -@y -@ @<Dump the font information@>= -dump_int(font_sort_ptr); -for k:=null_font_sort to font_sort_ptr do - dump_font_sort_table(k,font_sort_file_size(k)); -@z -%--------------------------------------- -@x [50] m.1321 l.23993 - Omega -@ @<Undump the font information@>= -@y -@ @<Undump the font information@>= -undump_size(font_base)(font_max)('font sort max')(font_sort_ptr); -for k:=null_font_sort to font_sort_ptr do - undump_font_sort_table(k); -@z -%--------------------------------------- -@x [51] m.1333 l.24244 - Omega -procedure close_files_and_terminate; -var k:integer; {all-purpose index} -begin @<Finish the extensions@>; -@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/ -wake_up_terminal; @<Finish the \.{DVI} file@>; -@y -procedure close_files_and_terminate; -var k:integer; {all-purpose index} -begin @<Finish the extensions@>; -@!stat if tracing_stats>0 then @<Output statistics about this job@>;@;@+tats@/ -wake_up_terminal; -if not SGML_mode then begin @<Finish the \.{DVI} file@>; end; -@z -%--------------------------------------- |