summaryrefslogtreecommitdiff
path: root/systems/tex-extensions/clasen/math
diff options
context:
space:
mode:
authorNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
committerNorbert Preining <norbert@preining.info>2019-09-02 13:46:59 +0900
commite0c6872cf40896c7be36b11dcc744620f10adf1d (patch)
tree60335e10d2f4354b0674ec22d7b53f0f8abee672 /systems/tex-extensions/clasen/math
Initial commit
Diffstat (limited to 'systems/tex-extensions/clasen/math')
-rw-r--r--systems/tex-extensions/clasen/math/accent.ch251
-rw-r--r--systems/tex-extensions/clasen/math/cramp.ch48
-rw-r--r--systems/tex-extensions/clasen/math/fraction.ch355
-rw-r--r--systems/tex-extensions/clasen/math/math.ch683
-rw-r--r--systems/tex-extensions/clasen/math/math.tex130
-rw-r--r--systems/tex-extensions/clasen/math/radical.ch99
6 files changed, 1566 insertions, 0 deletions
diff --git a/systems/tex-extensions/clasen/math/accent.ch b/systems/tex-extensions/clasen/math/accent.ch
new file mode 100644
index 0000000000..be9ba91347
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/accent.ch
@@ -0,0 +1,251 @@
+@x
+@d normal=0 {the most common case when several cases are named}
+@y
+@d normal=0 {the most common case when several cases are named}
+@d under_accent=2 {|subtype| of under math accents}
+@d nesting=1 {add this to an accent |subtype| to make it nesting}
+@z
+
+@x
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+@y
+primitive("mathaccent",math_accent,normal);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("nestingmathaccent",math_accent,normal+nesting);@/
+@!@:nesting_math_accent_}{\.{\\nestingmathaccent} primitive@>
+primitive("mathunderaccent",math_accent,under_accent);@/
+@!@:math_under_accent_}{\.{\\mathunderaccent} primitive@>
+primitive("nestingmathunderaccent",math_accent,under_accent+nesting);@/
+@!@:nesting_math_under_accent_}{\.{\\nestingmathunderaccent} primitive@>
+@z
+
+@x
+math_accent: print_esc("mathaccent");
+@y
+math_accent: case chr_code of
+ normal: print_esc("mathaccent");
+ normal+nesting: print_esc("nestingmathaccent");
+ under_accent: print_esc("mathunderaccent");
+ under_accent+nesting:print_esc("nestingmathunderaccent");
+ othercases print("Unknown accent!")
+endcases;
+@z
+
+@x
+accent_noad: make_math_accent(q);
+@y
+accent_noad: if subtype(q)<under_accent then make_math_accent(q)
+ else make_math_under_accent(q);
+@z
+
+@x
+procedure make_math_accent(@!q:pointer);
+label done,done1;
+var p,@!x,@!y:pointer; {temporary registers for box construction}
+@y
+procedure horizontally_stack_into_box(@!b:pointer;@!f:internal_font_number;@!c:quarterword);
+var p:pointer; {new node placed into |b|}
+begin
+ p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p;
+ width(b):=width(b)+width(p);
+end;
+
+procedure make_math_under_accent(@!q:pointer);
+label done,done1,done2,done3;
+var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
+@!a:integer; {address of lig/kern instruction}
+@!c:quarterword; {accent character}
+@!f:internal_font_number; {its font}
+@!i,ii:four_quarters; {its |char_info|}
+@!s:scaled; {amount to skew the accent to the right}
+@!h:scaled; {height of character being accented}
+@!delta,sep:scaled; {space to insert between accentee and accent}
+@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
+@!t:four_quarters;
+@!m,n:integer;
+@!hd:eight_bits;
+begin fetch(accent_chr(q));
+if char_exists(cur_i) then
+ begin i:=cur_i; c:=cur_c; f:=cur_f;@/
+ @<Compute under accent skew@>;
+ @<Compute separation for under accent@>;
+ x:=clean_box(nucleus(q),cur_style); w:=width(x); h:=height(x);
+ @<Switch to a larger accent if available and appropriate@>;
+ if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
+ if math_type(nucleus(q))=math_char then
+ @<Swap the subscript and superscript into box |x|@>;
+ shift_amount(y):=half(w-width(y))-s; width(y):=0;
+ p:=new_kern(sep); link(x):=p; link(p):=y;
+ p:=new_kern(-sep-x_height(f)); link(y):=p;
+ y:=vpack(x,natural); width(y):=w;
+ depth(y):=depth(y)+height(y)-h; height(y):=h;
+ info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+ end;
+end;
+
+procedure make_math_accent(@!q:pointer);
+label done,done1,done2;
+var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
+@z
+
+@x
+@!w:scaled; {width of the accentee, not including sub/superscripts}
+@y
+@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
+@!t:four_quarters;
+@!m,n:integer;
+@!hd:eight_bits;
+@z
+
+@x
+ y:=char_box(f,c);
+@y
+@z
+
+@x
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>w then goto done;
+ c:=y;
+ end;
+done:
+@y
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin
+ if char_tag(i)=ext_tag then begin
+ y:=new_null_box;
+ type(y):=hlist_node;
+ i:=font_info[exten_base[f]+rem_byte(i)].qqqq;@/
+ c:=ext_rep(i); t:=char_info(f)(c); u:=char_width(f)(t); v:=0;
+ hd:=height_depth(t); height(y):=char_height(f)(hd); depth(y):=char_depth(f)(hd);
+ c:=ext_bot(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ c:=ext_mid(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ c:=ext_top(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ n:=0;
+ if u>0 then while v<w do begin
+ v:=v+u; incr(n);
+ if ext_mid(i)<>min_quarterword then v:=v+u;
+ end;
+ c:=ext_bot(i);
+ if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
+ c:=ext_rep(i);
+ for m:=1 to n do horizontally_stack_into_box(y,f,c);
+ c:=ext_mid(i);
+ if c<>min_quarterword then begin
+ horizontally_stack_into_box(y,f,c);
+ c:=ext_rep(i);
+ for m:=1 to n do horizontally_stack_into_box(y,f,c);
+ end;
+ c:=ext_top(i);
+ if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
+ goto done2;
+ end;
+ if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>w then goto done;
+ c:=y;
+end;
+done:
+ y:=char_box(f,c);
+done2:
+@z
+
+%
+% Here is the logic for finding the accentee:
+% We pass by accent_noads as long as they are of the opposite kind
+% or of same kind and also nesting. This logic is necessary to make
+% \Hat{\uhat{\hat A}} align the two hats properly.
+
+@x
+@ @<Compute the amount of skew@>=
+s:=0;
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+@y
+@ @<Compute under accent skew@>=
+s:=0;
+qq:=q;
+if odd(subtype(q)) then
+ while (math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad)and
+ ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
+ qq:=info(nucleus(qq));
+if math_type(nucleus(qq))=math_char then
+ begin fetch(nucleus(qq));
+ ii:=char_info(cur_f)(skew_char[cur_f]);
+ if char_tag(ii)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(ii);
+ ii:=font_info[a].qqqq;
+ if skip_byte(ii)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(ii);
+ ii:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(ii))=cur_c then
+ begin if op_byte(ii)>=kern_flag then
+ if skip_byte(ii)<=stop_flag then s:=char_kern(cur_f)(ii);
+ goto done1;
+ end;
+ if skip_byte(ii)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(ii))+1;
+ ii:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+
+@ @<Compute separation for under accent@>=
+ sep:=0;
+ ii:=i;
+ if char_tag(ii)=lig_tag then
+ begin a:=lig_kern_start(f)(ii);
+ ii:=font_info[a].qqqq;
+ if skip_byte(ii)>stop_flag then
+ begin a:=lig_kern_restart(f)(ii);
+ ii:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(ii))=c then
+ begin if op_byte(ii)>=kern_flag then
+ if skip_byte(ii)<=stop_flag then sep:=char_kern(f)(ii);
+ goto done3;
+ end;
+ if skip_byte(ii)>=stop_flag then goto done3;
+ a:=a+qo(skip_byte(ii))+1;
+ ii:=font_info[a].qqqq;
+ end;
+ end;
+done3:
+
+@ @<Compute the amount of skew@>=
+s:=0;
+qq:=q;
+{while odd(subtype(qq))and(math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad) do}
+if odd(subtype(q)) then
+ while (math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad)and
+ ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
+ qq:=info(nucleus(qq));
+if math_type(nucleus(qq))=math_char then
+ begin fetch(nucleus(qq));
+@z
+
+@x
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+@y
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=cur_chr;
+@z
+
diff --git a/systems/tex-extensions/clasen/math/cramp.ch b/systems/tex-extensions/clasen/math/cramp.ch
new file mode 100644
index 0000000000..57231a383f
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/cramp.ch
@@ -0,0 +1,48 @@
+@x
+begin case c div 2 of
+0: print_esc("displaystyle"); {|display_style=0|}
+1: print_esc("textstyle"); {|text_style=2|}
+2: print_esc("scriptstyle"); {|script_style=4|}
+3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
+othercases print("Unknown style!")
+@y
+begin case c of
+display_style: print_esc("displaystyle");
+display_style+cramped: print_esc("crampeddisplaystyle");
+text_style: print_esc("textstyle");
+text_style+cramped: print_esc("crampedtextstyle");
+script_style: print_esc("scriptstyle");
+script_style+cramped: print_esc("crampedscriptstyle");
+script_script_style: print_esc("scriptscriptstyle");
+script_script_style+cramped: print_esc("crampedscriptscriptstyle");
+othercases print("Unknown style!")
+@z
+@x
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+@y
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("crampeddisplaystyle",math_style,display_style+cramped);
+@!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("crampedtextstyle",math_style,text_style+cramped);
+@!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("crampedscriptstyle",math_style,script_style+cramped);
+@!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+primitive("crampedscriptscriptstyle",math_style,script_script_style+cramped);
+@!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@>
+@z
+
+
diff --git a/systems/tex-extensions/clasen/math/fraction.ch b/systems/tex-extensions/clasen/math/fraction.ch
new file mode 100644
index 0000000000..ab27046166
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/fraction.ch
@@ -0,0 +1,355 @@
+% idea: keep track of math style in integer parameter
+% \mathstyle *while scanning the formula*. To be able
+% to do this, we need to keep track of
+%
+% \overline
+% ^
+% _
+% \mathaccent
+% style atoms
+% \fraction{...\over...}
+%
+% Change necessary: \mathstyle is *not* an ordinary
+% integer parameter, since math style doesn't obey
+% grouping. Try ${\scriptscriptstyle 1}2$.
+% Therefore it should be a special readonly parameter and
+% a \cramp primitive should be separately added.
+
+@x l.8392
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@d math_style_code=glue_val+3 {code for \.{\\mathstyle}}
+@z
+
+@x l.8420
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+@y
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("mathstyle",last_item,math_style_code);
+@!@:mathstyle_}{\.{\\mathstyle} primitive@>
+@z
+
+@x l.8435
+ input_line_no_code: print_esc("inputlineno");
+ othercases print_esc("badness")
+@y
+ input_line_no_code: print_esc("inputlineno");
+ badness_code: print_esc("badness");
+ math_style_code: print_esc("mathstyle");
+ othercases confusion("last_item")
+@:this can't happen last_item}{\quad last_item@>
+@z
+
+%
+% \mathstyle returns -1 if used outside math mode.
+%
+
+@x l.8504
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+ cur_val_level:=int_val;
+ end
+@y
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else if cur_chr=math_style_code then begin
+ if abs(mode)=mmode then cur_val:=mathstyle
+ else cur_val:=-1;
+ end else cur_val:=last_badness;
+ cur_val_level:=int_val;
+ end
+@z
+
+@x l.14108
+@!cur_style:small_number; {style code at current place in the list}
+@y
+@!cur_style,mathstyle:small_number; {style code at current place in the list}
+@z
+
+@x l.21649
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+begin mathstyle:=text_style;
+push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+@x l.21700
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+@y
+mathstyle:=display_style;
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+@z
+
+@x l.21798
+mmode+left_brace: begin tail_append(new_noad);
+ back_input; scan_math(nucleus(tail));
+@y
+mmode+left_brace: begin tail_append(new_noad);
+ back_input; scan_math(nucleus(tail),mathstyle);
+@z
+
+%
+% we change scan_math to expect one additional parameter,
+% the mathstyle for the next math atom. There are two
+% cases here:
+% - simple atom: use local var stack to hold old style
+% and restore it from there
+% - subformula: use save stack to hold old style and
+% restore it when reading `}'
+%
+
+@x l.21810
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+@y
+procedure scan_math(@!p:pointer;s:small_number);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+ savedstyle:small_number;
+begin
+savedstyle:=mathstyle; mathstyle:=s;
+restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+mathstyle:=savedstyle;
+exit:
+end;
+@z
+
+@x l.21848
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); push_math(math_group); return;
+@y
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); saved(0):=savedstyle; incr(save_ptr);
+push_math(math_group); return;
+@z
+
+@x l.21944
+mmode+math_comp: begin tail_append(new_noad);
+ type(tail):=cur_chr; scan_math(nucleus(tail));
+@y
+mmode+math_comp: begin tail_append(new_noad);
+ type(tail):=cur_chr;
+ case type(tail) of
+ over_noad: scan_math(nucleus(tail),cramped_style(mathstyle));
+ othercases scan_math(nucleus(tail),mathstyle);
+ endcases;
+@z
+
+%@x l.21999
+%scan_delimiter(left_delimiter(tail),true);
+%if t=1 then scan_delimiter(right_delimiter(tail),true)
+%else mem[right_delimiter(tail)].qqqq:=null_delimiter;
+%scan_math(nucleus(tail));
+%end;
+%@y
+%scan_delimiter(left_delimiter(tail),true);
+%if t=1 then scan_delimiter(right_delimiter(tail),true)
+%else mem[right_delimiter(tail)].qqqq:=null_delimiter;
+%scan_math(nucleus(tail),cramped_style(mathstyle));
+%end;
+%@z
+
+@x
+{before |scan_math| in |math_radical|}
+scan_math(nucleus(tail));
+@y
+{before |scan_math| in |math_radical|}
+scan_math(nucleus(tail),cramped_style(mathstyle));
+@z
+
+@x l.22012
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+@y
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail),cramped_style(mathstyle));
+end;
+@z
+
+@x l.22066
+mmode+math_style: tail_append(new_style(cur_chr));
+@y
+mmode+math_style: begin tail_append(new_style(cur_chr));
+ mathstyle:=cur_chr;
+end;
+@z
+
+@x l.22076
+procedure append_choices;
+begin tail_append(new_choice); incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+@y
+procedure append_choices;
+begin tail_append(new_choice);
+incr(save_ptr); saved(-1):=mathstyle;
+incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+mathstyle:=display_style;
+@z
+
+@x l.22094
+3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
+ end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+@y
+3:begin script_script_mlist(tail):=p; decr(save_ptr);
+ mathstyle:=saved(-1); decr(save_ptr);
+ return;
+ end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+mathstyle:=2*saved(-1);
+@z
+
+@x l.22109
+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: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@>;
+if cur_cmd=sup_mark then scan_math(p,sup_style(mathstyle))
+else scan_math(p,sub_style(mathstyle));
+end;
+@z
+
+@x l.22149
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+@y
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+@d fraction_code=6 { `\.{\\fraction}', etc.}
+@z
+
+@x l.22162
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+@y
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+primitive("fraction",above,fraction_code);
+@!@:fraction_}{\.{\\fraction} primitive@>
+@z
+
+@x l.22171
+ delimited_code+atop_code:print_esc("atopwithdelims");
+ othercases print_esc("above")
+@y
+ delimited_code+atop_code:print_esc("atopwithdelims");
+ fraction_code:print_esc("fraction");
+ othercases print_esc("above")
+@z
+
+% We handle \fraction{...\over...} here, by scanning away
+% the left brace and then doing the same as for
+% mmode+left_brace
+% The point is that we have a handle to update the
+% math_style variable properly here.
+% We do scan_left_brace followed by back_input to
+% force the left brace to be there
+
+@x l.22176
+mmode+above: math_fraction;
+@y
+mmode+above: if cur_chr=fraction_code then begin
+ scan_left_brace; tail_append(new_noad);
+ back_input;
+ scan_math(nucleus(tail),num_style(mathstyle));
+end else begin
+ math_fraction;
+end;
+@z
+
+@x
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+@y
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+mathstyle:=denom_style(save_stack[cur_boundary-1].int);
+@z
+
+@x l.22258
+math_group: begin unsave; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+@y
+math_group: begin unsave; decr(save_ptr);@/
+ mathstyle:=saved(0); decr(save_ptr);
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+@z
+
+
+
diff --git a/systems/tex-extensions/clasen/math/math.ch b/systems/tex-extensions/clasen/math/math.ch
new file mode 100644
index 0000000000..2fbe62230e
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/math.ch
@@ -0,0 +1,683 @@
+@x
+@d normal=0 {the most common case when several cases are named}
+@y
+@d normal=0 {the most common case when several cases are named}
+@d under_accent=2 {|subtype| of under math accents}
+@d nesting=1 {add this to an accent |subtype| to make it nesting}
+@z
+
+@x
+primitive("mathaccent",math_accent,0);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+@y
+primitive("mathaccent",math_accent,normal);@/
+@!@:math_accent_}{\.{\\mathaccent} primitive@>
+primitive("nestingmathaccent",math_accent,normal+nesting);@/
+@!@:nesting_math_accent_}{\.{\\nestingmathaccent} primitive@>
+primitive("mathunderaccent",math_accent,under_accent);@/
+@!@:math_under_accent_}{\.{\\mathunderaccent} primitive@>
+primitive("nestingmathunderaccent",math_accent,under_accent+nesting);@/
+@!@:nesting_math_under_accent_}{\.{\\nestingmathunderaccent} primitive@>
+@z
+
+@x
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+@y
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("genradical",radical,1);@/
+@!@:genradical_}{\.{\\genradical} primitive@>
+@z
+
+@x
+math_accent: print_esc("mathaccent");
+@y
+math_accent: case chr_code of
+ normal: print_esc("mathaccent");
+ normal+nesting: print_esc("nestingmathaccent");
+ under_accent: print_esc("mathunderaccent");
+ under_accent+nesting:print_esc("nestingmathunderaccent");
+ othercases print("Unknown accent!")
+endcases;
+@z
+
+@x
+radical: print_esc("radical");
+@y
+radical: if chr_code=0 then print_esc("radical") else print_esc("genradical");
+@z
+
+@x
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@y
+@d input_line_no_code=glue_val+1 {code for \.{\\inputlineno}}
+@d badness_code=glue_val+2 {code for \.{\\badness}}
+@d math_style_code=glue_val+3 {code for \.{\\mathstyle}}
+@z
+
+@x
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+@y
+primitive("badness",last_item,badness_code);
+@!@:badness_}{\.{\\badness} primitive@>
+primitive("mathstyle",last_item,math_style_code);
+@!@:mathstyle_}{\.{\\mathstyle} primitive@>
+@z
+
+@x
+ input_line_no_code: print_esc("inputlineno");
+ othercases print_esc("badness")
+@y
+ input_line_no_code: print_esc("inputlineno");
+ badness_code: print_esc("badness");
+ math_style_code: print_esc("mathstyle");
+ othercases confusion("last_item")
+@:this can't happen last_item}{\quad last_item@>
+@z
+
+@x
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else cur_val:=last_badness; {|cur_chr=badness_code|}
+ cur_val_level:=int_val;
+ end
+@y
+if cur_chr>glue_val then
+ begin if cur_chr=input_line_no_code then cur_val:=line
+ else if cur_chr=math_style_code then begin
+ if abs(mode)=mmode then cur_val:=mathstyle
+ else cur_val:=-1;
+ end else cur_val:=last_badness;
+ cur_val_level:=int_val;
+ end
+@z
+
+@x
+@d radical_noad_size=5 {number of |mem| words in a radical noad}
+@y
+@d radical_noad_size=6 {number of |mem| words in a radical noad}
+@d is_null_delimiter(#) ==
+ ((mem[#].qqqq.b0=0) and (mem[#].qqqq.b1=min_quarterword) and
+ (mem[#].qqqq.b2=0) and (mem[#].qqqq.b3=min_quarterword))
+@z
+
+@x
+begin case c div 2 of
+0: print_esc("displaystyle"); {|display_style=0|}
+1: print_esc("textstyle"); {|text_style=2|}
+2: print_esc("scriptstyle"); {|script_style=4|}
+3: print_esc("scriptscriptstyle"); {|script_script_style=6|}
+othercases print("Unknown style!")
+@y
+begin case c of
+display_style: print_esc("displaystyle");
+display_style+cramped: print_esc("crampeddisplaystyle");
+text_style: print_esc("textstyle");
+text_style+cramped: print_esc("crampedtextstyle");
+script_style: print_esc("scriptstyle");
+script_style+cramped: print_esc("crampedscriptstyle");
+script_script_style: print_esc("scriptscriptstyle");
+script_script_style+cramped: print_esc("crampedscriptscriptstyle");
+othercases print("Unknown style!")
+@z
+
+@x
+radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p));
+ end;
+@y
+radical_noad: if subtype(p)=normal then begin
+ print_esc("radical"); print_delimiter(left_delimiter(p));
+ end else begin
+ print_esc("genradical"); print_delimiter(left_delimiter(p));
+ print_delimiter(right_delimiter(p));
+ end;
+@z
+
+@x
+@!cur_style:small_number; {style code at current place in the list}
+@y
+@!cur_style,mathstyle:small_number; {style code at current place in the list}
+@z
+
+@x
+accent_noad: make_math_accent(q);
+@y
+accent_noad: if subtype(q)<under_accent then make_math_accent(q)
+ else make_math_under_accent(q);
+@z
+
+@x
+procedure make_radical(@!q:pointer);
+var x,@!y:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_radical(@!q:pointer);
+var x,@!y,z:pointer; {temporary registers for box construction}
+@!delta,@!clr,ht:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+ht:=height(y);
+if subtype(q)=normal then link(y):=overbar(x,clr,ht)
+else begin
+ z:=var_delimiter(right_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+ shift_amount(z):=-(height(x)+clr);
+ if height(z)>ht then ht:=height(z);
+ link(y):=overbar(x,clr,ht);
+ link(link(y)):=z;
+end;
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+@z
+
+@x
+procedure make_math_accent(@!q:pointer);
+label done,done1;
+var p,@!x,@!y:pointer; {temporary registers for box construction}
+@y
+procedure horizontally_stack_into_box(@!b:pointer;@!f:internal_font_number;@!c:quarterword);
+var p:pointer; {new node placed into |b|}
+begin
+ p:=char_box(f,c); link(p):=list_ptr(b); list_ptr(b):=p;
+ width(b):=width(b)+width(p);
+end;
+
+procedure make_math_under_accent(@!q:pointer);
+label done,done1,done2,done3;
+var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
+@!a:integer; {address of lig/kern instruction}
+@!c:quarterword; {accent character}
+@!f:internal_font_number; {its font}
+@!i,ii:four_quarters; {its |char_info|}
+@!s:scaled; {amount to skew the accent to the right}
+@!h:scaled; {height of character being accented}
+@!delta,sep:scaled; {space to insert between accentee and accent}
+@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
+@!t:four_quarters;
+@!m,n:integer;
+@!hd:eight_bits;
+begin fetch(accent_chr(q));
+if char_exists(cur_i) then
+ begin i:=cur_i; c:=cur_c; f:=cur_f;@/
+ @<Compute under accent skew@>;
+ @<Compute separation for under accent@>;
+ x:=clean_box(nucleus(q),cur_style); w:=width(x); h:=height(x);
+ @<Switch to a larger accent if available and appropriate@>;
+ if (math_type(supscr(q))<>empty)or(math_type(subscr(q))<>empty) then
+ if math_type(nucleus(q))=math_char then
+ @<Swap the subscript and superscript into box |x|@>;
+ shift_amount(y):=half(w-width(y))-s; width(y):=0;
+ p:=new_kern(sep); link(x):=p; link(p):=y;
+ p:=new_kern(-sep-x_height(f)); link(y):=p;
+ y:=vpack(x,natural); width(y):=w;
+ depth(y):=depth(y)+height(y)-h; height(y):=h;
+ info(nucleus(q)):=y; math_type(nucleus(q)):=sub_box;
+ end;
+end;
+
+procedure make_math_accent(@!q:pointer);
+label done,done1,done2;
+var p,qq,@!x,@!y:pointer; {temporary registers for box construction}
+@z
+
+@x
+@!w:scaled; {width of the accentee, not including sub/superscripts}
+@y
+@!w,v,u:scaled; {width of the accentee, not including sub/superscripts}
+@!t:four_quarters;
+@!m,n:integer;
+@!hd:eight_bits;
+@z
+
+@x
+ y:=char_box(f,c);
+@y
+@z
+
+@x
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>w then goto done;
+ c:=y;
+ end;
+done:
+@y
+@ @<Switch to a larger accent if available and appropriate@>=
+loop@+ begin
+ if char_tag(i)=ext_tag then begin
+ y:=new_null_box;
+ type(y):=hlist_node;
+ i:=font_info[exten_base[f]+rem_byte(i)].qqqq;@/
+ c:=ext_rep(i); t:=char_info(f)(c); u:=char_width(f)(t); v:=0;
+ hd:=height_depth(t); height(y):=char_height(f)(hd); depth(y):=char_depth(f)(hd);
+ c:=ext_bot(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ c:=ext_mid(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ c:=ext_top(i); t:=char_info(f)(c); @+if c<>min_quarterword then v:=v+char_width(f)(t);
+ n:=0;
+ if u>0 then while v<w do begin
+ v:=v+u; incr(n);
+ if ext_mid(i)<>min_quarterword then v:=v+u;
+ end;
+ c:=ext_bot(i);
+ if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
+ c:=ext_rep(i);
+ for m:=1 to n do horizontally_stack_into_box(y,f,c);
+ c:=ext_mid(i);
+ if c<>min_quarterword then begin
+ horizontally_stack_into_box(y,f,c);
+ c:=ext_rep(i);
+ for m:=1 to n do horizontally_stack_into_box(y,f,c);
+ end;
+ c:=ext_top(i);
+ if c<>min_quarterword then horizontally_stack_into_box(y,f,c);
+ goto done2;
+ end;
+ if char_tag(i)<>list_tag then goto done;
+ y:=rem_byte(i);
+ i:=char_info(f)(y);
+ if not char_exists(i) then goto done;
+ if char_width(f)(i)>w then goto done;
+ c:=y;
+end;
+done:
+ y:=char_box(f,c);
+done2:
+@z
+
+@x
+@ @<Compute the amount of skew@>=
+s:=0;
+if math_type(nucleus(q))=math_char then
+ begin fetch(nucleus(q));
+@y
+@ @<Compute under accent skew@>=
+s:=0;
+qq:=q;
+if odd(subtype(q)) then
+ while (math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad)and
+ ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
+ qq:=info(nucleus(qq));
+if math_type(nucleus(qq))=math_char then
+ begin fetch(nucleus(qq));
+ ii:=char_info(cur_f)(skew_char[cur_f]);
+ if char_tag(ii)=lig_tag then
+ begin a:=lig_kern_start(cur_f)(ii);
+ ii:=font_info[a].qqqq;
+ if skip_byte(ii)>stop_flag then
+ begin a:=lig_kern_restart(cur_f)(ii);
+ ii:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(ii))=cur_c then
+ begin if op_byte(ii)>=kern_flag then
+ if skip_byte(ii)<=stop_flag then s:=char_kern(cur_f)(ii);
+ goto done1;
+ end;
+ if skip_byte(ii)>=stop_flag then goto done1;
+ a:=a+qo(skip_byte(ii))+1;
+ ii:=font_info[a].qqqq;
+ end;
+ end;
+ end;
+done1:
+
+@ @<Compute separation for under accent@>=
+ sep:=0;
+ ii:=i;
+ if char_tag(ii)=lig_tag then
+ begin a:=lig_kern_start(f)(ii);
+ ii:=font_info[a].qqqq;
+ if skip_byte(ii)>stop_flag then
+ begin a:=lig_kern_restart(f)(ii);
+ ii:=font_info[a].qqqq;
+ end;
+ loop@+ begin if qo(next_char(ii))=c then
+ begin if op_byte(ii)>=kern_flag then
+ if skip_byte(ii)<=stop_flag then sep:=char_kern(f)(ii);
+ goto done3;
+ end;
+ if skip_byte(ii)>=stop_flag then goto done3;
+ a:=a+qo(skip_byte(ii))+1;
+ ii:=font_info[a].qqqq;
+ end;
+ end;
+done3:
+
+@ @<Compute the amount of skew@>=
+s:=0;
+qq:=q;
+{while odd(subtype(qq))and(math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad) do}
+if odd(subtype(q)) then
+ while (math_type(nucleus(qq))=sub_mlist)and
+ (type(info(nucleus(qq)))=accent_noad)and
+ ((subtype(qq)=subtype(q))or(subtype(qq) div 2<>subtype(q) div 2)) do
+ qq:=info(nucleus(qq));
+if math_type(nucleus(qq))=math_char then
+ begin fetch(nucleus(qq));
+@z
+
+@x
+begin push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@y
+begin mathstyle:=text_style;
+push_math(math_shift_group); eq_word_define(int_base+cur_fam_code,-1);
+if every_math<>null then begin_token_list(every_math,every_math_text);
+@z
+
+@x
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+@y
+mathstyle:=display_style;
+push_math(math_shift_group); mode:=mmode;
+eq_word_define(int_base+cur_fam_code,-1);@/
+@z
+
+@x
+mmode+left_brace: begin tail_append(new_noad);
+ back_input; scan_math(nucleus(tail));
+@y
+mmode+left_brace: begin tail_append(new_noad);
+ back_input; scan_math(nucleus(tail),mathstyle);
+@z
+
+@x
+procedure scan_math(@!p:pointer);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+begin restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+exit:end;
+@y
+procedure scan_math(@!p:pointer;s:small_number);
+label restart,reswitch,exit;
+var c:integer; {math character code}
+ savedstyle:small_number;
+begin
+savedstyle:=mathstyle; mathstyle:=s;
+restart:@<Get the next non-blank non-relax...@>;
+reswitch:case cur_cmd of
+letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
+ if c=@'100000 then
+ begin @<Treat |cur_chr| as an active character@>;
+ goto restart;
+ end;
+ end;
+char_num: begin scan_char_num; cur_chr:=cur_val; cur_cmd:=char_given;
+ goto reswitch;
+ end;
+math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
+ end;
+math_given: c:=cur_chr;
+delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
+ end;
+othercases @<Scan a subformula enclosed in braces and |return|@>
+endcases;@/
+math_type(p):=math_char; character(p):=qi(c mod 256);
+if (c>=var_code)and fam_in_range then fam(p):=cur_fam
+else fam(p):=(c div 256) mod 16;
+mathstyle:=savedstyle;
+exit:
+end;
+@z
+
+@x
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); push_math(math_group); return;
+@y
+begin back_input; scan_left_brace;@/
+saved(0):=p; incr(save_ptr); saved(0):=savedstyle; incr(save_ptr);
+push_math(math_group); return;
+@z
+
+@x
+mmode+math_comp: begin tail_append(new_noad);
+ type(tail):=cur_chr; scan_math(nucleus(tail));
+@y
+mmode+math_comp: begin tail_append(new_noad);
+ type(tail):=cur_chr;
+ case type(tail) of
+ over_noad: scan_math(nucleus(tail),cramped_style(mathstyle));
+ othercases scan_math(nucleus(tail),mathstyle);
+ endcases;
+@z
+
+@x
+type(tail):=radical_noad; subtype(tail):=normal;
+@y
+type(tail):=radical_noad; subtype(tail):=cur_chr;
+@z
+
+@x
+{before |scan_math| in |math_radical|}
+scan_math(nucleus(tail));
+@y
+if subtype(tail)=normal then mem[right_delimiter(tail)].qqqq:=null_delimiter
+else scan_delimiter(right_delimiter(tail),true);
+{before |scan_math| in |math_radical|}
+scan_math(nucleus(tail),cramped_style(mathstyle));
+@z
+
+@x
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=normal;
+@y
+procedure math_ac;
+begin if cur_cmd=accent then
+ @<Complain that the user should have said \.{\\mathaccent}@>;
+tail_append(get_node(accent_noad_size));
+type(tail):=accent_noad; subtype(tail):=cur_chr;
+@z
+
+@x
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail));
+end;
+@y
+if (cur_val>=var_code)and fam_in_range then fam(accent_chr(tail)):=cur_fam
+else fam(accent_chr(tail)):=(cur_val div 256) mod 16;
+scan_math(nucleus(tail),cramped_style(mathstyle));
+end;
+@z
+
+@x
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+@y
+primitive("displaystyle",math_style,display_style);
+@!@:display_style_}{\.{\\displaystyle} primitive@>
+primitive("crampeddisplaystyle",math_style,display_style+cramped);
+@!@:cramped_display_style_}{\.{\\crampeddisplaystyle} primitive@>
+primitive("textstyle",math_style,text_style);
+@!@:text_style_}{\.{\\textstyle} primitive@>
+primitive("crampedtextstyle",math_style,text_style+cramped);
+@!@:cramped_text_style_}{\.{\\crampedtextstyle} primitive@>
+primitive("scriptstyle",math_style,script_style);
+@!@:script_style_}{\.{\\scriptstyle} primitive@>
+primitive("crampedscriptstyle",math_style,script_style+cramped);
+@!@:cramped_script_style_}{\.{\\crampedscriptstyle} primitive@>
+primitive("scriptscriptstyle",math_style,script_script_style);
+@!@:script_script_style_}{\.{\\scriptscriptstyle} primitive@>
+primitive("crampedscriptscriptstyle",math_style,script_script_style+cramped);
+@!@:cramped_script_script_style_}{\.{\\crampedscriptscriptstyle} primitive@>
+@z
+
+@x
+mmode+math_style: tail_append(new_style(cur_chr));
+@y
+mmode+math_style: begin tail_append(new_style(cur_chr));
+ mathstyle:=cur_chr;
+end;
+@z
+
+@x
+procedure append_choices;
+begin tail_append(new_choice); incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+@y
+procedure append_choices;
+begin tail_append(new_choice);
+incr(save_ptr); saved(-1):=mathstyle;
+incr(save_ptr); saved(-1):=0;
+push_math(math_choice_group); scan_left_brace;
+mathstyle:=display_style;
+@z
+
+@x
+3:begin script_script_mlist(tail):=p; decr(save_ptr); return;
+ end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+@y
+3:begin script_script_mlist(tail):=p; decr(save_ptr);
+ mathstyle:=saved(-1); decr(save_ptr);
+ return;
+ end;
+end; {there are no other cases}
+incr(saved(-1)); push_math(math_choice_group); scan_left_brace;
+mathstyle:=2*saved(-1);
+@z
+
+@x
+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: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@>;
+if cur_cmd=sup_mark then scan_math(p,sup_style(mathstyle))
+else scan_math(p,sub_style(mathstyle));
+end;
+@z
+
+@x
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+@y
+@d delimited_code=3 { `\.{\\abovewithdelims}', etc.}
+@d fraction_code=6 { `\.{\\fraction}', etc.}
+@z
+
+@x
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+@y
+primitive("atopwithdelims",above,delimited_code+atop_code);
+@!@:atop_with_delims_}{\.{\\atopwithdelims} primitive@>
+primitive("fraction",above,fraction_code);
+@!@:fraction_}{\.{\\fraction} primitive@>
+@z
+
+@x
+ delimited_code+atop_code:print_esc("atopwithdelims");
+ othercases print_esc("above")
+@y
+ delimited_code+atop_code:print_esc("atopwithdelims");
+ fraction_code:print_esc("fraction");
+ othercases print_esc("above")
+@z
+
+@x
+mmode+above: math_fraction;
+@y
+mmode+above: if cur_chr=fraction_code then begin
+ scan_left_brace; tail_append(new_noad);
+ back_input;
+ scan_math(nucleus(tail),num_style(mathstyle));
+end else begin
+ math_fraction;
+end;
+@z
+
+@x
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+@y
+procedure math_fraction;
+var c:small_number; {the type of generalized fraction we are scanning}
+begin c:=cur_chr;
+mathstyle:=denom_style(save_stack[cur_boundary-1].int);
+@z
+
+@x
+math_group: begin unsave; decr(save_ptr);@/
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+@y
+math_group: begin unsave; decr(save_ptr);@/
+ mathstyle:=saved(0); decr(save_ptr);
+ math_type(saved(0)):=sub_mlist; p:=fin_mlist(null); info(saved(0)):=p;
+@z
+
diff --git a/systems/tex-extensions/clasen/math/math.tex b/systems/tex-extensions/clasen/math/math.tex
new file mode 100644
index 0000000000..1ce32accbc
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/math.tex
@@ -0,0 +1,130 @@
+\documentclass[preprint]{ltugboat}
+\usepackage{shortvrb}
+\usepackage{url}
+\usepackage{booktabs}
+
+\providecommand{\meta}[1]{\ensuremath{\langle\textit{#1}\rangle}}
+\makeatletter
+\providecommand{\eTeX}{$\m@th\varepsilon$-\TeX}
+\makeatother
+\hyphenation{pa-ra-me-ter}
+
+\emergencystretch=4mm
+\overfullrule=0pt
+\title{Extending \TeX's mathematical typography}
+\author{Matthias Clasen}
+%\address{}
+\netaddress{maclas@gmx.de}
+\setcounter{page}{1}
+
+\begin{document}
+\maketitle
+\MakeShortVerb{\|}
+
+\section{Introduction}
+
+One of the reasons why \TeX\ is still in use is that its abilities
+in setting mathematical formulas are still unsurmounted. But there
+are some nits to pick.
+
+I propose a small set of extensions to \TeX\ to remove some deficiencies
+in its handling of formulas.
+
+\section{Implementation}
+
+The implementation is split into a series of change files:
+
+|accent.ch| implements three new primitives for nestable accents and
+ under accents. To some extent these can be implemented in \TeX\ itself (see
+ \AmSLaTeX), but macro solutions are complicated, slow and error-prone.
+ \begin{description}
+ \item[]|\mathaccent|\meta{15-bit number}\meta{math field} can now
+ grok an extensible recipe at the end of a charlist. The extensible
+ recipe is used to construct longer variants of an accent (in analogy
+ to growing delimiters).
+ \item[]|\nestingmathaccent|\meta{15-bit number}\meta{math field} is
+ like |\math|\-|accent|, but it follows a chain of
+ |\nesting|\-|math|\-|accent| or |\nesting|\-|math|\-|under|\-|accent|
+ primitives to determine its accentee and the appropriate skew.
+ \item[]|\mathunderaccent|\meta{15-bit number}\meta{math field}\\
+ places an accent \emph{under} the \meta{math field}. It uses the
+ \meta{accent}--\meta{accent} kerning to determine the vertical space
+ between the \meta{math field} and the \meta{accent} and the
+ \meta{skewchar}--\meta{accentee} kerning to determine the appropriate
+ skew to the left.
+ \item[]|\nestingmathunderaccent|\meta{15-bit number}%
+ $\langle$\textit{math}\\\null\hfill\textit{field}$\rangle$\\
+ is a variant of |\math|\-|under|\-|accent| which
+ respects the nesting of accents.
+ \end{description}
+
+|cramp.ch| complements the |\display|\-|style|, \dots,
+|\script|\-|script|\-|style| style-changing primitives by
+|\cramped|\-|display|\-|style|, \dots, |\cramped|\-|script|\-|script|\-|style|
+which change to the cramped styles.
+
+|fraction.ch| continues to improve the math style-handling. It
+ adds the following:
+ \begin{description}
+ \item[]|\mathstyle| is a special readonly integer parameter
+ corresponding to the current math style according to the
+ following table:
+
+ \begin{tabular}{cc}
+ \toprule
+ math style&|\mathstyle|\\
+ \midrule
+ none& \llap{${}<{}$}0\\
+ D&0\\
+ D'&1\\
+ T&2\\
+ T'&3\\
+ S&4\\
+ S'&5\\
+ SS&6\\
+ SS'&7\\
+ \bottomrule
+ \end{tabular}
+
+ \item[]|\fraction|\{\meta{math field}\} can be used to surround
+ fractions. Its sole purpose is that |\mathstyle| reports the correct
+ values in a subformula like |\fraction{...\over...}| while it fails to
+ do so in |{...\over...}|.
+ \end{description}
+
+|radical.ch| implements the following new primitive:
+ \begin{description}
+ \item[]|\genradical|\meta{27-bit number}\meta{27-bit number}%
+ $\langle$\textit{math}\\\null\hfill\textit{field}$\rangle$\\
+ creates a radical with delimiters on both sides. By
+ specifiying a nonexisting left delimiter, you can also create a
+ right radical.
+ \end{description}
+
+\section{Installation}
+
+ The change files are written for \TeX~3.1459. But it should need only
+ cosmetic changes to get them to work with other versions of \TeX3.
+
+ To make the change files for \TeX{} work, you have to apply the change file
+ |pre.ch| first. I have only tried these files with |web2c|, and
+ for that you need to surround the |web2c| change file with |pre-web2c.ch| and
+ |post-web2c.ch|.
+
+ All this boils down to the command line
+
+\begin{verbatim}
+mv tex.ch tex.ch.orig
+tie -c tex.ch tex.web pre.ch accent.ch \
+ cramp.ch fraction.ch radical.ch \
+ pre-web2c.ch tex.ch.orig \
+ post-web2c.ch
+\end{verbatim}
+
+ \makesignature
+
+ \bibliographystyle{plain}
+ \bibliography{etex}
+
+\end{document}
+
diff --git a/systems/tex-extensions/clasen/math/radical.ch b/systems/tex-extensions/clasen/math/radical.ch
new file mode 100644
index 0000000000..757652cecd
--- /dev/null
+++ b/systems/tex-extensions/clasen/math/radical.ch
@@ -0,0 +1,99 @@
+@x
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+@y
+primitive("radical",radical,0);@/
+@!@:radical_}{\.{\\radical} primitive@>
+primitive("genradical",radical,1);@/
+@!@:genradical_}{\.{\\genradical} primitive@>
+@z
+
+@x
+radical: print_esc("radical");
+@y
+radical: if chr_code=0 then print_esc("radical") else print_esc("genradical");
+@z
+
+@x
+@d radical_noad_size=5 {number of |mem| words in a radical noad}
+@y
+@d radical_noad_size=6 {number of |mem| words in a radical noad}
+@d is_null_delimiter(#) ==
+ ((mem[#].qqqq.b0=0) and (mem[#].qqqq.b1=min_quarterword) and
+ (mem[#].qqqq.b2=0) and (mem[#].qqqq.b3=min_quarterword))
+@z
+@x
+radical_noad: begin print_esc("radical"); print_delimiter(left_delimiter(p));
+ end;
+@y
+radical_noad: if subtype(p)=normal then begin
+ print_esc("radical"); print_delimiter(left_delimiter(p));
+ end else begin
+ print_esc("genradical"); print_delimiter(left_delimiter(p));
+ print_delimiter(right_delimiter(p));
+ end;
+@z
+
+@x
+procedure make_radical(@!q:pointer);
+var x,@!y:pointer; {temporary registers for box construction}
+@!delta,@!clr:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+link(y):=overbar(x,clr,height(y));
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+@y
+procedure make_radical(@!q:pointer);
+var x,@!y,z:pointer; {temporary registers for box construction}
+@!delta,@!clr,ht:scaled; {dimensions involved in the calculation}
+begin x:=clean_box(nucleus(q),cramped_style(cur_style));
+if cur_style<text_style then {display style}
+ clr:=default_rule_thickness+(abs(math_x_height(cur_size)) div 4)
+else begin clr:=default_rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+delta:=depth(y)-(height(x)+depth(x)+clr);
+if delta>0 then clr:=clr+half(delta); {increase the actual clearance}
+shift_amount(y):=-(height(x)+clr);
+ht:=height(y);
+if subtype(q)=normal then link(y):=overbar(x,clr,ht)
+else begin
+ z:=var_delimiter(right_delimiter(q),cur_size,height(x)+depth(x)+clr+
+ default_rule_thickness);
+ shift_amount(z):=-(height(x)+clr);
+ if height(z)>ht then ht:=height(z);
+ link(y):=overbar(x,clr,ht);
+ link(link(y)):=z;
+end;
+info(nucleus(q)):=hpack(y,natural); math_type(nucleus(q)):=sub_box;
+end;
+@z
+
+@x
+type(tail):=radical_noad; subtype(tail):=normal;
+@y
+type(tail):=radical_noad; subtype(tail):=cur_chr;
+@z
+
+@x
+{before |scan_math| in |math_radical|}
+@y
+if subtype(tail)=normal then mem[right_delimiter(tail)].qqqq:=null_delimiter
+else scan_delimiter(right_delimiter(tail),true);
+{before |scan_math| in |math_radical|}
+@z
+
+
+
+
+