summaryrefslogtreecommitdiff
path: root/Build
diff options
context:
space:
mode:
authorPeter Breitenlohner <peb@mppmu.mpg.de>2012-11-09 12:49:04 +0000
committerPeter Breitenlohner <peb@mppmu.mpg.de>2012-11-09 12:49:04 +0000
commitb4ac4cd31b7c61c5b5078b231821036a06a1af7b (patch)
tree341f24c5d728e923f0d78ff312f673c0c4359181 /Build
parenta48fe98dbc04aacdbd60388944d8597269456caa (diff)
Continue merging XeTeX change files
git-svn-id: svn://tug.org/texlive/trunk@28218 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build')
-rw-r--r--Build/source/texk/web2c/ChangeLog4
-rw-r--r--Build/source/texk/web2c/Makefile.in18
-rw-r--r--Build/source/texk/web2c/tex.ch43
-rw-r--r--Build/source/texk/web2c/xetexdir/am/xetex.am19
-rw-r--r--Build/source/texk/web2c/xetexdir/tex.ch013
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex-hz.ch836
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex-latex3.ch941
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.ch4370
-rw-r--r--Build/source/texk/web2c/xetexdir/xetex.web3752
9 files changed, 3553 insertions, 6443 deletions
diff --git a/Build/source/texk/web2c/ChangeLog b/Build/source/texk/web2c/ChangeLog
index 320d41f15dd..13f6e8232c8 100644
--- a/Build/source/texk/web2c/ChangeLog
+++ b/Build/source/texk/web2c/ChangeLog
@@ -1,3 +1,7 @@
+2012-11-08 Peter Breitenlohner <peb@mppmu.mpg.de>
+
+ * tex.ch: Avoid conflict with xetexdir/xetex.web.
+
2012-10-19 Peter Breitenlohner <peb@mppmu.mpg.de>
* configure.ac (POPPLER): Adding '-lgdi32' for WIN32 now done
diff --git a/Build/source/texk/web2c/Makefile.in b/Build/source/texk/web2c/Makefile.in
index a75dae525fc..54361e3b603 100644
--- a/Build/source/texk/web2c/Makefile.in
+++ b/Build/source/texk/web2c/Makefile.in
@@ -2595,11 +2595,21 @@ xetex_ch_srcs = \
tex.ch \
$(xetex_ch_synctex) \
xetexdir/xetex.ch \
- xetexdir/xetex-latex3.ch \
- xetexdir/xetex-hz.ch \
$(xetex_post_ch_synctex) \
tex-binpool.ch
+@XETEX_SYNCTEX_TRUE@Xold_ch_synctex = \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-mem.ch0 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch0 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-mem.ch1 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-mem.ch2 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-rec.ch0 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-e-rec.ch0 \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch2
+
+@XETEX_SYNCTEX_TRUE@Xold_post_ch_synctex = \
+@XETEX_SYNCTEX_TRUE@ synctexdir/synctex-xe-rec.ch3
+
Xold_web_srcs = \
tex.web \
etexdir/etex.ch \
@@ -2608,11 +2618,11 @@ Xold_web_srcs = \
etexdir/tex.ch1 \
etexdir/tex.ech \
tex-binpool.ch \
- $(xetex_ch_synctex) \
+ $(Xold_ch_synctex) \
xetex-orig.ch \
xetex-latex3.ch \
xetex-hz.ch \
- $(xetex_post_ch_synctex)
+ $(Xold_post_ch_synctex)
libxetex_a_CPPFLAGS = $(xetex_cppflags)
libxetex_a_CFLAGS = # $(WARNING_CFLAGS)
diff --git a/Build/source/texk/web2c/tex.ch b/Build/source/texk/web2c/tex.ch
index 03ffaa02520..e3d402af235 100644
--- a/Build/source/texk/web2c/tex.ch
+++ b/Build/source/texk/web2c/tex.ch
@@ -936,16 +936,10 @@ noreturn procedure confusion(@!s:str_number);
% [8.110] Make it easy to change constants. Do not increase
% max_quarterword without changing the memoryword structure in `texmfmem.h'.
-% If you set min_quarterword to a non-zero value, you have to remove the
-% definitions of qi/qo in this change file!
-@x [8.110] l.2405 - increase |max_halfword|
-@d min_quarterword=0 {smallest allowable value in a |quarterword|}
-@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@x [8.110] l.2422 - increase |max_halfword|
@d min_halfword==0 {smallest allowable value in a |halfword|}
@d max_halfword==65535 {largest allowable value in a |halfword|}
-@y 2407
-@d min_quarterword=0 {smallest allowable value in a |quarterword|}
-@d max_quarterword=255 {largest allowable value in a |quarterword|}
+@y 2424
@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
@z
@@ -1195,12 +1189,10 @@ substitution definitions.
@x [17.222] l.4523 - frozen_special, for source specials.
@d frozen_null_font=frozen_control_sequence+10
- {permanent `\.{\\nullfont}'}
@y
@d frozen_special=frozen_control_sequence+10
{permanent `\.{\\special}'}
@d frozen_null_font=frozen_control_sequence+11
- {permanent `\.{\\nullfont}'}
@z
@x [17.222] l.4526 - max_font_max
@@ -3232,13 +3224,11 @@ l:=k; v:=min_trie_op;
@x [46.1034] l.20074 - source specials
@<Append character |cur_chr|...@>=
-adjust_space_factor;@/
@y
@<Append character |cur_chr|...@>=
if ((head=tail) and (mode>0)) then begin
if (insert_src_special_auto) then append_src_special;
end;
-adjust_space_factor;@/
@z
@x [46.1036] l.20138 - MLTeX: substitution in |main_control|
@@ -4010,17 +4000,19 @@ else print(" hyphenation exception");
@x [50.1324] l.24066 - Make dumping/undumping more efficient - trie
for k:=0 to trie_max do dump_hh(trie[k]);
-dump_int(trie_op_ptr);
+@y
+dump_things(trie_trl[0], trie_max+1);
+dump_things(trie_tro[0], trie_max+1);
+dump_things(trie_trc[0], trie_max+1);
+@z
+
+@x [50.1324] l.24068 - Make dumping/undumping more efficient - trie
for k:=1 to trie_op_ptr do
begin dump_int(hyf_distance[k]);
dump_int(hyf_num[k]);
dump_int(hyf_next[k]);
end;
@y
-dump_things(trie_trl[0], trie_max+1);
-dump_things(trie_tro[0], trie_max+1);
-dump_things(trie_trc[0], trie_max+1);
-dump_int(trie_op_ptr);
dump_things(hyf_distance[1], trie_op_ptr);
dump_things(hyf_num[1], trie_op_ptr);
dump_things(hyf_next[1], trie_op_ptr);
@@ -4065,15 +4057,8 @@ for k:=1 to hyph_count do
if hyph_next >= hyph_prime then incr(hyph_next);
@z
-
@x [50.1325] l.24094 - Make dumping/undumping more efficient - trie
for k:=0 to j do undump_hh(trie[k]);
-undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
-for k:=1 to j do
- begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
- undump(0)(63)(hyf_num[k]);
- undump(min_quarterword)(max_quarterword)(hyf_next[k]);
- end;
@y
{These first three haven't been allocated yet unless we're \.{INITEX};
we do that precisely so we don't allocate more space than necessary.}
@@ -4083,7 +4068,15 @@ if not trie_tro then trie_tro:=xmalloc_array(trie_pointer,j+1);
undump_things(trie_tro[0], j+1);
if not trie_trc then trie_trc:=xmalloc_array(quarterword, j+1);
undump_things(trie_trc[0], j+1);
-undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
+@z
+
+@x [50.1325] l.24096 - Make dumping/undumping more efficient - trie
+for k:=1 to j do
+ begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
+ undump(0)(63)(hyf_num[k]);
+ undump(min_quarterword)(max_quarterword)(hyf_next[k]);
+ end;
+@y
{I'm not sure we have such a strict limitation (64) on these values, so
let's leave them unchecked.}
undump_things(hyf_distance[1], j);
diff --git a/Build/source/texk/web2c/xetexdir/am/xetex.am b/Build/source/texk/web2c/xetexdir/am/xetex.am
index 7c428e7cb45..e578c9ee482 100644
--- a/Build/source/texk/web2c/xetexdir/am/xetex.am
+++ b/Build/source/texk/web2c/xetexdir/am/xetex.am
@@ -99,12 +99,23 @@ xetex_ch_srcs = \
tex.ch \
$(xetex_ch_synctex) \
xetexdir/xetex.ch \
- xetexdir/xetex-latex3.ch \
- xetexdir/xetex-hz.ch \
$(xetex_post_ch_synctex) \
tex-binpool.ch
## Merging in XeTeX change files - begin
+if XETEX_SYNCTEX
+Xold_ch_synctex = \
+ synctexdir/synctex-mem.ch0 \
+ synctexdir/synctex-e-mem.ch0 \
+ synctexdir/synctex-e-mem.ch1 \
+ synctexdir/synctex-xe-mem.ch2 \
+ synctexdir/synctex-rec.ch0 \
+ synctexdir/synctex-e-rec.ch0 \
+ synctexdir/synctex-xe-rec.ch2
+Xold_post_ch_synctex = \
+ synctexdir/synctex-xe-rec.ch3
+endif XETEX_SYNCTEX
+
Xold.p Xold.pool: Xold-tangle
@$(xe_tangle) Xold
Xold-tangle: otangle$(EXEEXT) Xold.web tangle-sh
@@ -119,11 +130,11 @@ Xold_web_srcs = \
etexdir/tex.ch1 \
etexdir/tex.ech \
tex-binpool.ch \
- $(xetex_ch_synctex) \
+ $(Xold_ch_synctex) \
xetex-orig.ch \
xetex-latex3.ch \
xetex-hz.ch \
- $(xetex_post_ch_synctex)
+ $(Xold_post_ch_synctex)
#
Xnew.web: tie$(EXEEXT) xetexdir/xetex.web xetex.ch
$(tie) -m Xnew.web xetexdir/xetex.web xetex.ch
diff --git a/Build/source/texk/web2c/xetexdir/tex.ch0 b/Build/source/texk/web2c/xetexdir/tex.ch0
index 85740e2625d..b25252129e5 100644
--- a/Build/source/texk/web2c/xetexdir/tex.ch0
+++ b/Build/source/texk/web2c/xetexdir/tex.ch0
@@ -1,6 +1,6 @@
% Change file to assist in creating the web2c-specific change file.
% This one comes first, resolves inconsistencies between the generated
-% etex.web and tex.ch
+% xetex.web and ../tex.ch
% Public domain.
@x [1.2] l.188
@@ -11,12 +11,10 @@
@d banner=='This is TeX, Version 3.1415926' {printed when \TeX\ starts}
@z
-@x [8.110] l.2405 - increase |max_halfword|
-@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
+@x [8.110] l.2422 - increase |max_halfword|
@d min_halfword==-@"FFFFFFF {smallest allowable value in a |halfword|}
@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
@y
-@d max_quarterword=255 {largest allowable value in a |quarterword|}
@d min_halfword==0 {smallest allowable value in a |halfword|}
@d max_halfword==65535 {largest allowable value in a |halfword|}
@z
@@ -38,3 +36,10 @@
@y
@d int_pars=55 {total number of integer parameters}
@z
+
+@x [36.749] l.14638 - MLTeX: avoid substitution in |make_op|
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+@y
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+@z
+
diff --git a/Build/source/texk/web2c/xetexdir/xetex-hz.ch b/Build/source/texk/web2c/xetexdir/xetex-hz.ch
deleted file mode 100644
index 62df37aab1f..00000000000
--- a/Build/source/texk/web2c/xetexdir/xetex-hz.ch
+++ /dev/null
@@ -1,836 +0,0 @@
-/****************************************************************************\
- Part of the XeTeX typesetting system
- copyright (c) 1994-2008 by SIL International
- copyright (c) 2009-2012 by Jonathan Kew
- copyright (c) 2012 by Khaled Hosny
-
- Written by Han The Thanh
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
-FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
-CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
-Except as contained in this notice, the name of the copyright holders
-shall not be used in advertising or otherwise to promote the sale,
-use or other dealings in this Software without prior written
-authorization from the copyright holders.
-\****************************************************************************/
-
-@x
- words:=medium_node_size;
- end;
-@y
- words:=medium_node_size;
- end;
-margin_kern_node: begin
- r := get_node(margin_kern_node_size);
-{ fast_get_avail(margin_char(r)); }
-{ font(margin_char(r)) := font(margin_char(p)); }
-{ character(margin_char(r)) := character(margin_char(p)); }
- words := margin_kern_node_size;
- end;
-@z
-
-@x
-if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
-else scanned_result(skew_char[cur_val])(int_val);
-@y
-if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
-else if m=1 then scanned_result(skew_char[cur_val])(int_val)
-else begin
- n := cur_val;
- if is_native_font(n) then scan_glyph_number(n)
- else scan_char_num;
- k := cur_val;
- case m of
- lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val);
- rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val);
- end;
-end;
-@z
-
-@x
-|scan_something_internal|.
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-@y
-|scan_something_internal|.
-
-@ @<Declare procedures that scan restricted classes of integers@>=
-
-procedure scan_glyph_number(f: internal_font_number);
-{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number }
-begin
- if scan_keyword("/") then {set cp value by glyph name}
- begin
- scan_and_pack_name; {result is in |nameoffile|}
- scanned_result(map_glyph_to_index(f))(int_val);
- end else if scan_keyword("u") then {set cp value by unicode}
- begin
- scan_char_num;
- scanned_result(map_char_to_glyph(f,cur_val))(int_val);
- end else
- scan_int;
-end;
-
-@z
-
-@x
-@d XeTeX_glyph_name_code=10
-
-@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes}
-@d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
-
-@<Put each...@>=
-primitive("number",convert,number_code);@/
-@!@:number_}{\.{\\number} primitive@>
-primitive("romannumeral",convert,roman_numeral_code);@/
-@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
-primitive("string",convert,string_code);@/
-@!@:string_}{\.{\\string} primitive@>
-primitive("meaning",convert,meaning_code);@/
-@!@:meaning_}{\.{\\meaning} primitive@>
-primitive("fontname",convert,font_name_code);@/
-@!@:font_name_}{\.{\\fontname} primitive@>
-primitive("jobname",convert,job_name_code);@/
-@!@:job_name_}{\.{\\jobname} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-convert: case chr_code of
- number_code: print_esc("number");
- roman_numeral_code: print_esc("romannumeral");
- string_code: print_esc("string");
- meaning_code: print_esc("meaning");
- font_name_code: print_esc("fontname");
- pdf_strcmp_code: print_esc("strcmp");
-@y
-@d XeTeX_glyph_name_code=10
-
-@d left_margin_kern_code=11
-@d right_margin_kern_code=12
-
-@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes}
-@d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
-
-@<Put each...@>=
-primitive("number",convert,number_code);@/
-@!@:number_}{\.{\\number} primitive@>
-primitive("romannumeral",convert,roman_numeral_code);@/
-@!@:roman_numeral_}{\.{\\romannumeral} primitive@>
-primitive("string",convert,string_code);@/
-@!@:string_}{\.{\\string} primitive@>
-primitive("meaning",convert,meaning_code);@/
-@!@:meaning_}{\.{\\meaning} primitive@>
-primitive("fontname",convert,font_name_code);@/
-@!@:font_name_}{\.{\\fontname} primitive@>
-primitive("jobname",convert,job_name_code);@/
-@!@:job_name_}{\.{\\jobname} primitive@>
-primitive("leftmarginkern",convert,left_margin_kern_code);@/
-@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
-primitive("rightmarginkern",convert,right_margin_kern_code);@/
-@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-convert: case chr_code of
- number_code: print_esc("number");
- roman_numeral_code: print_esc("romannumeral");
- string_code: print_esc("string");
- meaning_code: print_esc("meaning");
- font_name_code: print_esc("fontname");
- pdf_strcmp_code: print_esc("strcmp");
- left_margin_kern_code: print_esc("leftmarginkern");
- right_margin_kern_code: print_esc("rightmarginkern");
-@z
-
-@x
-@!i:small_number;
-@!quote_char:UTF16_code;
-@y
-@!i:small_number;
-@!quote_char:UTF16_code;
-p, q: pointer;
-@z
-
-@x
-glue_node: @<Move right or output leaders@>;
-@y
-glue_node: @<Move right or output leaders@>;
-margin_kern_node: begin
-{ if subtype(p) = right_side then }
-{ pdf_DEBUG_int("right margin kern:", width(p)) }
-{ else }
-{ pdf_DEBUG_int("left margin kern:", width(p)); }
- cur_h:=cur_h+width(p);
-end;
-@z
-
-@x
-@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
-@y
-@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
-
-@ Some stuff for character protrusion.
-
-@d left_pw(#) == char_pw(#, left_side)
-@d right_pw(#) == char_pw(#, right_side)
-
-@p
-function char_pw(p: pointer; side: small_number): scaled;
-var f: internal_font_number;
- c: integer;
-begin
- char_pw := 0;
- if side = left_side then
- last_leftmost_char := null
- else
- last_rightmost_char := null;
- if p = null then
- return;
-
- { native word }
- if is_native_word_node(p) then begin
- if native_glyph_info_ptr(p) <> null_ptr then begin
- f := native_font(p);
- char_pw := round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000);
- end;
- return;
- end;
-
- { glyph node }
- if is_glyph_node(p) then begin
- f := native_font(p);
- char_pw := round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000);
- return;
- end;
-
- { char node or ligature; same like pdftex }
- if not is_char_node(p) then begin
- if type(p) = ligature_node then
- p := lig_char(p)
- else
- return;
- end;
- f := font(p);
- c := get_cp_code(f, character(p), side);
- case side of
- left_side:
- last_leftmost_char := p;
- right_side:
- last_rightmost_char := p;
- endcases;
- if c = 0 then
- return;
- char_pw :=
- round_xn_over_d(quad(f), c, 1000);
-end;
-
-function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer;
-var k: pointer;
-begin
- k := get_node(margin_kern_node_size);
- type(k) := margin_kern_node;
- subtype(k) := side;
- width(k) := w;
-{ if p = null then }
-{ pdf_error("margin kerning", "invalid pointer to marginal char node"); }
-{ fast_get_avail(margin_char(k)); }
-{ character(margin_char(k)) := character(p); }
-{ font(margin_char(k)) := font(p); }
- new_margin_kern := k;
-end;
-@z
-
-@x
- kern_node: x:=x+width(p);
-@y
- kern_node: x:=x+width(p);
- margin_kern_node: x:=x+width(p);
-@z
-
-@x
-@d deactivate=60 {go here when node |r| should be deactivated}
-
-@<Declare subprocedures for |line_break|@>=
-@y
-@d deactivate=60 {go here when node |r| should be deactivated}
-
-@d cp_skipable(#) == {skipable nodes at the margins during character protrusion}
-(
- not is_char_node(#) and
- (
- (type(#) = ins_node)
- or (type(#) = mark_node)
- or (type(#) = adjust_node)
- or (type(#) = penalty_node)
- or ((type(#) = disc_node) and
- (pre_break(#) = null) and
- (post_break(#) = null) and
- (replace_count(#) = 0)) {an empty |disc_node|}
- or ((type(#) = math_node) and (width(#) = 0))
- or ((type(#) = kern_node) and
- ((width(#) = 0) or (subtype(#) = normal)))
- or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue))
- or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and
- (depth(#) = 0) and (list_ptr(#) = null))
- )
-)
-
-@<Declare subprocedures for |line_break|@>=
-procedure push_node(p: pointer);
-begin
- if hlist_stack_level > max_hlist_stack then
- pdf_error("push_node", "stack overflow");
- hlist_stack[hlist_stack_level] := p;
- hlist_stack_level := hlist_stack_level + 1;
-end;
-
-function pop_node: pointer;
-begin
- hlist_stack_level := hlist_stack_level - 1;
- if hlist_stack_level < 0 then {would point to some bug}
- pdf_error("pop_node", "stack underflow (internal error)");
- pop_node := hlist_stack[hlist_stack_level];
-end;
-
-function find_protchar_left(l: pointer; d: boolean): pointer;
-{searches left to right from list head |l|, returns 1st non-skipable item}
-var t: pointer;
- run: boolean;
-begin
- if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0)
- and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then
- l := link(l) {for paragraph start with \.{\\parindent = 0pt}}
- else if d then
- while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do
- l := link(l); {std.\ discardables at line break, \TeX book, p 95}
- hlist_stack_level := 0;
- run := true;
- repeat
- t := l;
- while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin
- push_node(l);
- l := list_ptr(l);
- end;
- while run and cp_skipable(l) do begin
- while (link(l) = null) and (hlist_stack_level > 0) do begin
- l := pop_node; {don't visit this node again}
- end;
- if link(l) <> null then
- l := link(l)
- else if hlist_stack_level = 0 then run := false
- end;
- until t = l;
- find_protchar_left := l;
-end;
-
-function find_protchar_right(l, r: pointer): pointer;
-{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item}
-var t: pointer;
- run: boolean;
-begin
- find_protchar_right := null;
- if r = null then return;
- hlist_stack_level := 0;
- run := true;
- repeat
- t := r;
- while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin
- push_node(l);
- push_node(r);
- l := list_ptr(r);
- r := l;
- while link(r) <> null do
- r := link(r);
- end;
- while run and cp_skipable(r) do begin
- while (r = l) and (hlist_stack_level > 0) do begin
- r := pop_node; {don't visit this node again}
- l := pop_node;
- end;
- if (r <> l) and (r <> null) then
- r := prev_rightmost(l, r)
- else if (r = l) and (hlist_stack_level = 0) then run := false
- end;
- until t = r;
- find_protchar_right := r;
-end;
-
-function total_pw(q, p: pointer): scaled;
-{returns the total width of character protrusion of a line;
-|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the
-horizontal list representing the actual line}
-var l, r: pointer;
- n: integer;
-begin
- if break_node(q) = null then
- l := first_p
- else
- l := cur_break(break_node(q));
- r := prev_rightmost(global_prev_p, p); {get |link(r)=p|}
- {let's look at the right margin first}
- if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then
- {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|}
- begin
- r := pre_break(p);
- while link(r) <> null do
- r := link(r);
- end else r := find_protchar_right(l, r);
- {now the left margin}
- if (l <> null) and (type(l) = disc_node) then begin
- if post_break(l) <> null then begin
- l := post_break(l); {protrude the first char}
- goto done;
- end else {discard |replace_count(l)| nodes}
- begin
- n := replace_count(l);
- l := link(l);
- while n > 0 do begin
- if link(l) <> null then
- l := link(l);
- decr(n);
- end;
- end;
- end;
- l := find_protchar_left(l, true);
-done:
- total_pw := left_pw(l) + right_pw(r);
-end;
-@z
-
-@x
-shortfall:=line_width-cur_active_width[1]; {we're this much too short}
-@y
-shortfall:=line_width-cur_active_width[1]; {we're this much too short}
-if XeTeX_protrude_chars > 1 then
- shortfall := shortfall + total_pw(r, cur_p);
-@z
-
-@x
-entire paragraph.
-
-@<Find optimal breakpoints@>=
-threshold:=pretolerance;
-if threshold>=0 then
- begin @!stat if tracing_paragraphs>0 then
- begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/
- second_pass:=false; final_pass:=false;
- end
-else begin threshold:=tolerance; second_pass:=true;
- final_pass:=(emergency_stretch<=0);
- @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
- end;
-loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
- if second_pass then @<Initialize for hyphenating a paragraph@>;
- @<Create an active breakpoint representing the beginning of the paragraph@>;
- cur_p:=link(temp_head); auto_breaking:=true;@/
- prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
-@y
-entire paragraph.
-
-@d update_prev_p == begin
- prev_p := cur_p;
- global_prev_p := cur_p;
-end
-
-@<Find optimal breakpoints@>=
-threshold:=pretolerance;
-if threshold>=0 then
- begin @!stat if tracing_paragraphs>0 then
- begin begin_diagnostic; print_nl("@@firstpass");@+end;@;@+tats@;@/
- second_pass:=false; final_pass:=false;
- end
-else begin threshold:=tolerance; second_pass:=true;
- final_pass:=(emergency_stretch<=0);
- @!stat if tracing_paragraphs>0 then begin_diagnostic;@+tats@;
- end;
-loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
- if second_pass then @<Initialize for hyphenating a paragraph@>;
- @<Create an active breakpoint representing the beginning of the paragraph@>;
- cur_p:=link(temp_head); auto_breaking:=true;@/
- update_prev_p; {glue at beginning is not a legal breakpoint}
- first_p := cur_p; {to access the first node of paragraph as the first active
- node has |break_node=null|}
-@z
-
-@x
-@:this can't happen paragraph}{\quad paragraph@>
-endcases;@/
-prev_p:=cur_p; cur_p:=link(cur_p);
-done5:end
-
-@ The code that passes over the characters of words in a paragraph is
-part of \TeX's inner loop, so it has been streamlined for speed. We use
-the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph;
-it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a
-character node.
-@^inner loop@>
-
-@<Advance \(c)|cur_p| to the node following the present string...@>=
-begin prev_p:=cur_p;
-@y
-@:this can't happen paragraph}{\quad paragraph@>
-endcases;@/
-update_prev_p; cur_p:=link(cur_p);
-done5:end
-
-@ The code that passes over the characters of words in a paragraph is
-part of \TeX's inner loop, so it has been streamlined for speed. We use
-the fact that `\.{\\parfillskip}' glue appears at the end of each paragraph;
-it is therefore unnecessary to check if |link(cur_p)=null| when |cur_p| is a
-character node.
-@^inner loop@>
-
-@<Advance \(c)|cur_p| to the node following the present string...@>=
-begin update_prev_p;
-@z
-
-@x
- decr(r); s:=link(s);
- end;
-prev_p:=cur_p; cur_p:=s; goto done5;
-@y
- decr(r); s:=link(s);
- end;
-update_prev_p; cur_p:=s; goto done5;
-@z
-
-@x
-var q,@!r,@!s:pointer; {temporary registers for list manipulation}
-@y
-var q,@!r,@!s:pointer; {temporary registers for list manipulation}
- p, k: pointer;
- w: scaled;
- glue_break: boolean; {was a break at glue?}
- ptmp: pointer;
-@z
-
-@x
-q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
-if q<>null then {|q| cannot be a |char_node|}
- if type(q)=glue_node then
- begin delete_glue_ref(glue_ptr(q));
- glue_ptr(q):=right_skip;
- subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
- goto done;
- end
- else begin if type(q)=disc_node then
- @<Change discretionary to compulsory and set
- |disc_break:=true|@>
- else if type(q)=kern_node then width(q):=0
- else if type(q)=math_node then
- begin width(q):=0;
- if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
- end;
- end
-else begin q:=temp_head;
- while link(q)<>null do q:=link(q);
- end;
-@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
-done:
-@y
-q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
-glue_break := false;
-if q<>null then {|q| cannot be a |char_node|}
- if type(q)=glue_node then
- begin delete_glue_ref(glue_ptr(q));
- glue_ptr(q):=right_skip;
- subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
- glue_break := true;
- goto done;
- end
- else begin if type(q)=disc_node then
- @<Change discretionary to compulsory and set
- |disc_break:=true|@>
- else if type(q)=kern_node then width(q):=0
- else if type(q)=math_node then
- begin width(q):=0;
- if TeXXeT_en then @<Adjust \(t)the LR stack for the |p...@>;
- end;
- end
-else begin q:=temp_head;
- while link(q)<>null do q:=link(q);
- end;
-done:
-{at this point |q| is the rightmost breakpoint; the only exception is the case
-of a discretionary break with non-empty |pre_break|, then |q| has been changed
-to the last node of the |pre_break| list}
-if XeTeX_protrude_chars > 0 then begin
-{ short_display_n(q, 5); }
- if disc_break and (is_char_node(q) or (type(q) <> disc_node))
- {|q| has been reset to the last node of |pre_break|}
- then begin
- p := q;
- ptmp := p;
- end else begin
- p := prev_rightmost(link(temp_head), q); {get |link(p) = q|}
- ptmp := p;
- p := find_protchar_right(link(temp_head), p);
- end;
-{ short_display_n(p, 5); }
- w := right_pw(p);
- if w <> 0 then {we have found a marginal kern, append it after |ptmp|}
- begin
-{ pdf_DEBUG_int("right margin:", w); }
- k := new_margin_kern(-w, last_rightmost_char, right_side);
- link(k) := link(ptmp);
- link(ptmp) := k;
- if (ptmp = q) then
- q := link(q);
- end;
-end;
-{if |q| was not a breakpoint at glue and has been reset to |rightskip| then
- we append |rightskip| after |q| now}
-if not glue_break then begin
- @<Put the \(r)\.{\\rightskip} glue after node |q|@>;
-end;
-@z
-
-@x
-r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
-@y
-r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
-{at this point |q| is the leftmost node; all discardable nodes have been discarded}
-if XeTeX_protrude_chars > 0 then begin
- p := q;
- p := find_protchar_left(p, false); {no more discardables}
- w := left_pw(p);
- if w <> 0 then begin
- k := new_margin_kern(-w, last_leftmost_char, left_side);
- link(k) := q;
- q := k;
- end;
-end;
-@z
-
-@x
-var p:pointer; {the box}
-@!c:box_code..copy_code; {should we copy?}
-begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
-c:=cur_chr; scan_register_num; fetch_box(p);
-if p=null then return;
-if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
- ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
- begin print_err("Incompatible list can't be unboxed");
-@.Incompatible list...@>
- help3("Sorry, Pandora. (You sneaky devil.)")@/
- ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
- ("And I can't open any boxes in math mode.");@/
- error; return;
- end;
-if c=copy_code then link(tail):=copy_node_list(list_ptr(p))
-else begin link(tail):=list_ptr(p); change_box(null);
- free_node(p,box_node_size);
- end;
-done:
-while link(tail)<>null do tail:=link(tail);
-@y
-var p:pointer; {the box}
- r: pointer; {to remove marginal kern nodes}
-@!c:box_code..copy_code; {should we copy?}
-begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
-c:=cur_chr; scan_register_num; fetch_box(p);
-if p=null then return;
-if (abs(mode)=mmode)or((abs(mode)=vmode)and(type(p)<>vlist_node))or@|
- ((abs(mode)=hmode)and(type(p)<>hlist_node)) then
- begin print_err("Incompatible list can't be unboxed");
-@.Incompatible list...@>
- help3("Sorry, Pandora. (You sneaky devil.)")@/
- ("I refuse to unbox an \hbox in vertical mode or vice versa.")@/
- ("And I can't open any boxes in math mode.");@/
- error; return;
- end;
-if c=copy_code then link(tail):=copy_node_list(list_ptr(p))
-else begin link(tail):=list_ptr(p); change_box(null);
- free_node(p,box_node_size);
- end;
-done:
-while link(tail) <> null do begin
- r := link(tail);
- if not is_char_node(r) and (type(r) = margin_kern_node) then begin
- link(tail) := link(r);
-{ free_avail(margin_char(r)); }
- free_node(r, margin_kern_node_size);
- end;
- tail:=link(tail);
-end;
-@z
-
-@x
-kern_node: d:=width(p);
-@y
-kern_node: d:=width(p);
-margin_kern_node: d:=width(p);
-@z
-
-@x
-assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
- scan_optional_equals; scan_int;
- if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
- end;
-
-@ @<Put each...@>=
-primitive("hyphenchar",assign_font_int,0);
-@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
-primitive("skewchar",assign_font_int,1);
-@!@:skew_char_}{\.{\\skewchar} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_font_int: if chr_code=0 then print_esc("hyphenchar")
- else print_esc("skewchar");
-@y
-assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
- if n < lp_code_base then begin
- scan_optional_equals; scan_int;
- if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
- end else begin
- if is_native_font(f) then
- scan_glyph_number(f) {for native fonts, the value is a glyph id}
- else scan_char_num; {for |tfm| fonts it's the same like pdftex}
- p := cur_val;
- scan_optional_equals; scan_int;
- case n of
- lp_code_base: set_cp_code(f, p, left_side, cur_val);
- rp_code_base: set_cp_code(f, p, right_side, cur_val);
- endcases;
- end;
-end;
-
-@ @<Put each...@>=
-primitive("hyphenchar",assign_font_int,0);
-@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
-primitive("skewchar",assign_font_int,1);
-@!@:skew_char_}{\.{\\skewchar} primitive@>
-primitive("lpcode",assign_font_int,lp_code_base);
-@!@:lp_code_}{\.{\\lpcode} primitive@>
-primitive("rpcode",assign_font_int,rp_code_base);
-@!@:rp_code_}{\.{\\rpcode} primitive@>
-
-@ @<Cases of |print_cmd_chr|...@>=
-assign_font_int: case chr_code of
-0: print_esc("hyphenchar");
-1: print_esc("skewchar");
-lp_code_base: print_esc("lpcode");
-rp_code_base: print_esc("rpcode");
-endcases;
-@z
-
-@x
- flush_string;
-end;
-
-procedure pdf_error(t, p: str_number);
-begin
- normalize_selector;
- print_err("Error");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- succumb;
-end;
-@y
- flush_string;
-end;
-@z
-
-@x
- not_native_font_error(convert, c, fnt);
- end;
-
-@ @<Cases of `Print the result of command |c|'@>=
-eTeX_revision_code: print(eTeX_revision);
-pdf_strcmp_code: print_int(cur_val);
-XeTeX_revision_code: print(XeTeX_revision);
-
-XeTeX_variation_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_feature_name_code,
-XeTeX_selector_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2)
- else if is_gr_font(fnt) then
- gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_glyph_name_code:
- if is_native_font(fnt) then print_glyph_name(fnt, arg1);
-@y
- not_native_font_error(convert, c, fnt);
- end;
-
-left_margin_kern_code, right_margin_kern_code: begin
- scan_register_num;
- fetch_box(p);
- if (p = null) or (type(p) <> hlist_node) then
- pdf_error("marginkern", "a non-empty hbox expected")
-end;
-
-@ @<Cases of `Print the result of command |c|'@>=
-eTeX_revision_code: print(eTeX_revision);
-pdf_strcmp_code: print_int(cur_val);
-XeTeX_revision_code: print(XeTeX_revision);
-
-XeTeX_variation_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_feature_name_code,
-XeTeX_selector_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2)
- else if is_gr_font(fnt) then
- gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_glyph_name_code:
- if is_native_font(fnt) then print_glyph_name(fnt, arg1);
-
-left_margin_kern_code: begin
- p := list_ptr(p);
- while (p <> null) and
- (cp_skipable(p) or
- ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1)))
- do
- p := link(p);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = left_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-
-right_margin_kern_code: begin
- q := list_ptr(p);
- p := prev_rightmost(q, null);
- while (p <> null) and
- (cp_skipable(p) or
- ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1)))
- do
- p := prev_rightmost(q, p);
- if (p <> null) and (not is_char_node(p)) and
- (type(p) = margin_kern_node) and (subtype(p) = right_side) then
- print_scaled(width(p))
- else
- print("0");
- print("pt");
-end;
-@z
-
diff --git a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch b/Build/source/texk/web2c/xetexdir/xetex-latex3.ch
deleted file mode 100644
index 75712a7b643..00000000000
--- a/Build/source/texk/web2c/xetexdir/xetex-latex3.ch
+++ /dev/null
@@ -1,941 +0,0 @@
-/****************************************************************************\
- Part of the XeTeX typesetting system
- copyright (c) 1994-2008 by SIL International
- copyright (c) 2009, 2011 by Jonathan Kew
-
- Written by Jonathan Kew
-
-Permission is hereby granted, free of charge, to any person obtaining
-a copy of this software and associated documentation files (the
-"Software"), to deal in the Software without restriction, including
-without limitation the rights to use, copy, modify, merge, publish,
-distribute, sublicense, and/or sell copies of the Software, and to
-permit persons to whom the Software is furnished to do so, subject to
-the following conditions:
-
-The above copyright notice and this permission notice shall be
-included in all copies or substantial portions of the Software.
-
-THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
-EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
-MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
-NONINFRINGEMENT. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE
-FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF
-CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
-WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
-
-Except as contained in this notice, the name of the copyright holders
-shall not be used in advertising or otherwise to promote the sale,
-use or other dealings in this Software without prior written
-authorization from the copyright holders.
-\****************************************************************************/
-
-% When updating code here, also increment version number/string in xetex.ch
-
-% \primitive
-@x l.4868
-@d frozen_null_font=frozen_control_sequence+11
- {permanent `\.{\\nullfont}'}
-@y
-@d frozen_primitive=frozen_control_sequence+11
- {permanent `\.{\\primitive}'}
-@d frozen_null_font=frozen_control_sequence+12
- {permanent `\.{\\nullfont}'}
-@z
-
-% \primitive
-% \ifprimitive
-@x l.5942
-@!cs_count:integer; {total number of known identifiers}
-
-@ @<Set init...@>=
-no_new_control_sequence:=true; {new identifiers are usually forbidden}
-
-@ @<Initialize table entries...@>=
-hash_used:=frozen_control_sequence; {nothing is used}
-hash_high:=0;
-cs_count:=0;
-eq_type(frozen_dont_expand):=dont_expand;
-text(frozen_dont_expand):="notexpanded:";
-@.notexpanded:@>
-@y
-@!cs_count:integer; {total number of known identifiers}
-
-@ Primitive support needs a few extra variables and definitions
-
-@d prim_size=480 {maximum number of primitives }
-@d prim_prime=409 {about 85\pct! of |primitive_size|}
-@d prim_base=1
-@d prim_next(#) == prim[#].lh {link for coalesced lists}
-@d prim_text(#) == prim[#].rh {string number for control sequence name}
-@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied}
-@d prim_eq_level_field(#)==#.hh.b1
-@d prim_eq_type_field(#)==#.hh.b0
-@d prim_equiv_field(#)==#.hh.rh
-@d prim_eq_level(#)==prim_eq_level_field(prim_eqtb[#]) {level of definition}
-@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent}
-@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value}
-@d undefined_primitive=0
-
-@<Glob...@>=
-@!prim: array [0..prim_size] of two_halves; {the primitives table}
-@!prim_used:pointer; {allocation pointer for |prim|}
-@!prim_eqtb:array[0..prim_size] of memory_word;
-
-@ @<Set init...@>=
-no_new_control_sequence:=true; {new identifiers are usually forbidden}
-prim_next(0):=0; prim_text(0):=0;
-for k:=1 to prim_size do prim[k]:=prim[0];
-prim_eq_level(0) := level_zero;
-prim_eq_type(0) := undefined_cs;
-prim_equiv(0) := null;
-for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0];
-
-@ @<Initialize table entries...@>=
-prim_used:=prim_size; {nothing is used}
-hash_used:=frozen_control_sequence; {nothing is used}
-hash_high:=0;
-cs_count:=0;
-eq_type(frozen_dont_expand):=dont_expand;
-text(frozen_dont_expand):="notexpanded:";
-@.notexpanded:@>
-
-eq_type(frozen_primitive):=ignore_spaces;
-equiv(frozen_primitive):=1;
-eq_level(frozen_primitive):=level_one;
-text(frozen_primitive):="primitive";
-@z
-
-% \primitive
-% \ifprimitive
-@x l.6029
-@ Single-character control sequences do not need to be looked up in a hash
-@y
-@ Here is the subroutine that searches the primitive table for an identifier
-
-@p function prim_lookup(@!s:str_number):pointer; {search the primitives table}
-label found; {go here if you found it}
-var h:integer; {hash code}
-@!p:pointer; {index in |hash| array}
-@!k:pointer; {index in string pool}
-@!j,@!l:integer;
-begin
-if s<256 then begin
- p := s;
- if (p<0) or (prim_eq_level(p)<>level_one) then
- p := undefined_primitive;
-end
-else begin
- j:=str_start_macro(s);
- if s = str_ptr then l := cur_length else l := length(s);
- @<Compute the primitive code |h|@>;
- p:=h+prim_base; {we start searching here; note that |0<=h<hash_prime|}
- loop@+begin if prim_text(p)>0 then if length(prim_text(p))=l then
- if str_eq_str(prim_text(p),s) then goto found;
- if prim_next(p)=0 then
- begin if no_new_control_sequence then
- p:=undefined_primitive
- else @<Insert a new primitive after |p|, then make
- |p| point to it@>;
- goto found;
- end;
- p:=prim_next(p);
- end;
- end;
-found: prim_lookup:=p;
-end;
-
-@ @<Insert a new primitive...@>=
-begin if prim_text(p)>0 then
- begin repeat if prim_is_full then overflow("primitive size",prim_size);
-@:TeX capacity exceeded primitive size}{\quad primitive size@>
- decr(prim_used);
- until prim_text(prim_used)=0; {search for an empty location in |prim|}
- prim_next(p):=prim_used; p:=prim_used;
- end;
-prim_text(p):=s;
-end
-
-@ The value of |prim_prime| should be roughly 85\pct! of
-|prim_size|, and it should be a prime number.
-
-@<Compute the primitive code |h|@>=
-h:=str_pool[j];
-for k:=j+1 to j+l-1 do
- begin h:=h+h+str_pool[k];
- while h>=prim_prime do h:=h-prim_prime;
- end
-
-@ Single-character control sequences do not need to be looked up in a hash
-@z
-
-% \primitive
-@x
-@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
-var k:pool_pointer; {index into |str_pool|}
-@!j:0..buf_size; {index into |buffer|}
-@!l:small_number; {length of the string}
-begin if s<256 then cur_val:=s+single_base
-else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
- {we will move |s| into the (possibly non-empty) |buffer|}
- if first+l>buf_size+1 then
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
- cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
- flush_string; text(cur_val):=s; {we don't want to have the string twice}
- end;
-eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
-end;
-@y
-@p @!init procedure primitive(@!s:str_number;@!c:quarterword;@!o:halfword);
-var k:pool_pointer; {index into |str_pool|}
-@!j:0..buf_size; {index into |buffer|}
-@!l:small_number; {length of the string}
-@!prim_val:integer; {needed to fill |prim_eqtb|}
-begin if s<256 then begin
- cur_val:=s+single_base;
- prim_val:=s;
-end
-else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
- {we will move |s| into the (possibly non-empty) |buffer|}
- if first+l>buf_size+1 then
- overflow("buffer size",buf_size);
-@:TeX capacity exceeded buffer size}{\quad buffer size@>
- for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
- cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
- flush_string; text(cur_val):=s; {we don't want to have the string twice}
- prim_val:=prim_lookup(s);
- end;
-eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
-prim_eq_level(prim_val):=level_one;
-prim_eq_type(prim_val):=c;
-prim_equiv(prim_val):=o;
-end;
-@z
-
-% \primitive
-@x l.6163
-@!@:no_expand_}{\.{\\noexpand} primitive@>
-@y
-@!@:no_expand_}{\.{\\noexpand} primitive@>
-primitive("primitive",no_expand,1);@/
-@!@:primitive_}{\.{\\primitive} primitive@>
-@z
-
-% \primitive
-@x l.6224
-ignore_spaces: print_esc("ignorespaces");
-@y
-ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive");
-@z
-
-% \primitive
-@x l.6239
-no_expand: print_esc("noexpand");
-@y
-no_expand: if chr_code=0 then print_esc("noexpand")
- else print_esc("primitive");
-@z
-
-% \ifincsname
-@x
-var t:halfword; {token that is being ``expanded after''}
-@y
-var t:halfword; {token that is being ``expanded after''}
-@!b:boolean; {keep track of nested csnames}
-@z
-
-% \ifincsname
-@x l.8348
-@ @<Expand a nonmacro@>=
-@y
-@ @<Glob...@>=
-@!is_in_csname: boolean;
-
-@ @<Set init...@>=
-is_in_csname := false;
-
-@ @<Expand a nonmacro@>=
-@z
-
-% \primitive
-@x l.8354
-no_expand:@<Suppress expansion of the next token@>;
-@y
-no_expand: if cur_chr=0 then @<Suppress expansion of the next token@>
- else @<Implement \.{\\primitive}@>;
-@z
-
-% \primitive
-@x l.8391
-@ @<Complain about an undefined macro@>=
-@y
-@ The \.{\\primitive} handling. If the primitive meaning of the next
-token is an expandable command, it suffices to replace the current
-token with the primitive one and restart |expand|/
-
-Otherwise, the token we just read has to be pushed back, as well
-as a token matching the internal form of \.{\\primitive}, that is
-sneaked in as an alternate form of |ignore_spaces|.
-@!@:primitive_}{\.{\\primitive} primitive (internalized)@>
-
-Simply pushing back a token that matches the correct internal command
-does not work, because approach would not survive roundtripping to a
-temporary file.
-
-@<Implement \.{\\primitive}@>=
-begin save_scanner_status := scanner_status; scanner_status:=normal;
-get_token; scanner_status:=save_scanner_status;
-if cur_cs < hash_base then
- cur_cs := prim_lookup(cur_cs-257)
-else
- cur_cs := prim_lookup(text(cur_cs));
-if cur_cs<>undefined_primitive then begin
- t := prim_eq_type(cur_cs);
- if t>max_command then begin
- cur_cmd := t;
- cur_chr := prim_equiv(cur_cs);
- cur_tok := (cur_cmd*max_char_val)+cur_chr;
- cur_cs := 0;
- goto reswitch;
- end
- else begin
- back_input; { now |loc| and |start| point to a one-item list }
- p:=get_avail; info(p):=cs_token_flag+frozen_primitive;
- link(p):=loc; loc:=p; start:=p;
- end;
- end;
-end
-
-@ @<Complain about an undefined macro@>=
-@z
-
-% \ifincsname
-@x
-begin r:=get_avail; p:=r; {head of the list of characters}
-@y
-begin r:=get_avail; p:=r; {head of the list of characters}
-b := is_in_csname; is_in_csname := true;
-@z
-
-% \ifincsname
-@x
-if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
-@y
-if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
-is_in_csname := b;
-@z
-
-% \strcmp
-% \shellescape
-@x l.29172
-@d pdf_last_x_pos_code = XeTeX_int+27
-@d pdf_last_y_pos_code = XeTeX_int+28
-
-@d XeTeX_pdf_page_count_code = XeTeX_int+29
-
-@#
-@d XeTeX_dim=XeTeX_int+30 {first of \XeTeX\ codes for dimensions}
-@y
-@d pdf_last_x_pos_code = XeTeX_int+27
-@d pdf_last_y_pos_code = XeTeX_int+28
-@d pdf_strcmp_code = XeTeX_int+29
-@d pdf_shell_escape_code = XeTeX_int+30
-
-@d XeTeX_pdf_page_count_code = XeTeX_int+31
-
-@#
-@d XeTeX_dim=XeTeX_int+32 {first of \XeTeX\ codes for dimensions}
-@z
-
-% \shellescape
-@x l.9244
- input_line_no_code: print_esc("inputlineno");
-@y
- input_line_no_code: print_esc("inputlineno");
- pdf_shell_escape_code: print_esc("shellescape");
-@z
-
-@x l.9322
- badness_code: cur_val:=last_badness;
-@y
- badness_code: cur_val:=last_badness;
- pdf_shell_escape_code:
- begin
- if shellenabledp then begin
- if restrictedshell then cur_val := 2
- else cur_val := 1;
- end
- else cur_val := 0;
- end;
-@z
-
-% \strcmp
-@x l.10165
- font_name_code: print_esc("fontname");
-@y
- font_name_code: print_esc("fontname");
- pdf_strcmp_code: print_esc("strcmp");
-@z
-
-% \strcmp
-@x l.10174
-@p procedure conv_toks;
-var old_setting:0..max_selector; {holds |selector| setting}
-@y
-The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
-any pending string in its output. In order to save such a pending string,
-we have to create a temporary string that is destroyed immediately after.
-
-@d save_cur_string==if str_start_macro(str_ptr)<pool_ptr then u:=make_string else u:=0
-@d restore_cur_string==if u<>0 then decr(str_ptr)
-
-@p procedure conv_toks;
-var old_setting:0..max_selector; {holds |selector| setting}
-@!save_warning_index, @!save_def_ref:pointer;
-@!u: str_number;
-@z
-
-% \ifprimitive
-@x l.10483
-@d if_case_code=16 { `\.{\\ifcase}' }
-@y
-@d if_case_code=16 { `\.{\\ifcase}' }
-@d if_primitive_code=21 { `\.{\\ifprimitive}' }
-@z
-
-% \ifprimitive
-@x l.10519
-@!@:if_case_}{\.{\\ifcase} primitive@>
-@y
-@!@:if_case_}{\.{\\ifcase} primitive@>
-primitive("ifprimitive",if_test,if_primitive_code);
-@!@:if_primitive_}{\.{\\ifprimitive} primitive@>
-@z
-
-% \ifprimitive
-@x l.10539
- if_case_code:print_esc("ifcase");
-@y
- if_case_code:print_esc("ifcase");
- if_primitive_code:print_esc("ifprimitive");
-@z
-
-% \ifincsname
-@x
-var b:boolean; {is the condition true?}
-@y
-var b:boolean; {is the condition true?}
-@!e:boolean; {keep track of nested csnames}
-@z
-
-% \ifprimitive
-@x l.10723
-if_case_code: @<Select the appropriate case
- and |return| or |goto common_ending|@>;
-@y
-if_case_code: @<Select the appropriate case
- and |return| or |goto common_ending|@>;
-if_primitive_code: begin
- save_scanner_status:=scanner_status;
- scanner_status:=normal;
- get_next;
- scanner_status:=save_scanner_status;
- if cur_cs < hash_base then
- m := prim_lookup(cur_cs-257)
- else
- m := prim_lookup(text(cur_cs));
- b :=((cur_cmd<>undefined_cs) and
- (m<>undefined_primitive) and
- (cur_cmd=prim_eq_type(m)) and
- (cur_chr=prim_equiv(m)));
- end;
-@z
-
-% \vadjust
-@x l.14527
-if adjust_tail<>null then link(adjust_tail):=null;
-@y
-if adjust_tail<>null then link(adjust_tail):=null;
-if pre_adjust_tail<>null then link(pre_adjust_tail):=null;
-@z
-
-% \vadjust
-@x
- ins_node,mark_node,adjust_node: if adjust_tail<>null then
-@y
- ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then
-@z
-
-
-% \vadjust
-@x l.14607
-@<Transfer node |p| to the adjustment list@>=
-begin while link(q)<>p do q:=link(q);
-if type(p)=adjust_node then
- begin link(adjust_tail):=adjust_ptr(p);
- while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail);
- p:=link(p); free_node(link(q),small_node_size);
- end
-else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
- end;
-link(q):=p; p:=q;
-end
-@y
-@<Glob...@>=
-@!pre_adjust_tail: pointer;
-
-@ @<Set init...@>=
-pre_adjust_tail := null;
-
-@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
-|pre_adjust_tail| instead of |adjust_tail|.
-
-@d update_adjust_list(#) == begin
- if # = null then
- confusion("pre vadjust");
- link(#) := adjust_ptr(p);
- while link(#) <> null do
- # := link(#);
-end
-
-@<Transfer node |p| to the adjustment list@>=
-begin while link(q)<>p do q:=link(q);
- if type(p) = adjust_node then begin
- if adjust_pre(p) <> 0 then
- update_adjust_list(pre_adjust_tail)
- else
- update_adjust_list(adjust_tail);
- p := link(p); free_node(link(q), small_node_size);
- end
-else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
- end;
-link(q):=p; p:=q;
-end
-@z
-
-% \vadjust
-@x l.17583
-@d align_stack_node_size=5 {number of |mem| words to save alignment states}
-@y
-@d align_stack_node_size=6 {number of |mem| words to save alignment states}
-@z
-
-% \vadjust
-@x l.17590
-@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
-@y
-@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
-@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
-@z
-
-% \vadjust
-@x l.17596
-cur_head:=null; cur_tail:=null;
-@y
-cur_head:=null; cur_tail:=null;
-cur_pre_head:=null; cur_pre_tail:=null;
-@z
-
-% \vadjust
-@x l.17607
-info(p+4):=cur_head; link(p+4):=cur_tail;
-align_ptr:=p;
-cur_head:=get_avail;
-@y
-info(p+4):=cur_head; link(p+4):=cur_tail;
-info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail;
-align_ptr:=p;
-cur_head:=get_avail;
-cur_pre_head:=get_avail;
-@z
-
-% \vadjust
-@x l.17616
-begin free_avail(cur_head);
-p:=align_ptr;
-cur_tail:=link(p+4); cur_head:=info(p+4);
-@y
-begin free_avail(cur_head);
-free_avail(cur_pre_head);
-p:=align_ptr;
-cur_tail:=link(p+4); cur_head:=info(p+4);
-cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5);
-@z
-
-% \vadjust
-@x
-cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align);
-@y
-cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
-init_span(cur_align);
-@z
-
-% \vadjust
-@x l.17690
- begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u);
- cur_tail:=adjust_tail; adjust_tail:=null;
- end
-@y
- begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
- u:=hpack(link(head),natural); w:=width(u);
- cur_tail:=adjust_tail; adjust_tail:=null;
- cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
- end
-@z
-
-% \vadjust
-@x
- pop_nest; append_to_vlist(p);
- if cur_head<>cur_tail then
- begin link(tail):=link(cur_head); tail:=cur_tail;
- end;
- end
-@y
- pop_nest;
- if cur_pre_head <> cur_pre_tail then
- append_list(cur_pre_head)(cur_pre_tail);
- append_to_vlist(p);
- if cur_head <> cur_tail then
- append_list(cur_head)(cur_tail);
- end
-@z
-
-% \vadjust
-@x l.19508
-append_to_vlist(just_box);
-if adjust_head<>adjust_tail then
- begin link(tail):=link(adjust_head); tail:=adjust_tail;
- end;
-@y
-if pre_adjust_head <> pre_adjust_tail then
- append_list(pre_adjust_head)(pre_adjust_tail);
-pre_adjust_tail := null;
-append_to_vlist(just_box);
-if adjust_head <> adjust_tail then
- append_list(adjust_head)(adjust_tail);
-@z
-
-% \vadjust
-@x 19529
-adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
-@y
-adjust_tail:=adjust_head;
-pre_adjust_tail := pre_adjust_head;
-just_box:=hpack(q,cur_width,exactly);
-@z
-
-% \primitive
-@x
-any_mode(ignore_spaces): begin @<Get the next non-blank non-call...@>;
- goto reswitch;
- end;
-@y
-any_mode(ignore_spaces): begin
- if cur_chr = 0 then begin
- @<Get the next non-blank non-call...@>;
- goto reswitch;
- end
- else begin
- t:=scanner_status;
- scanner_status:=normal;
- get_next;
- scanner_status:=t;
- if cur_cs < hash_base then
- cur_cs := prim_lookup(cur_cs-257)
- else
- cur_cs := prim_lookup(text(cur_cs));
- if cur_cs<>undefined_primitive then begin
- cur_cmd := prim_eq_type(cur_cs);
- cur_chr := prim_equiv(cur_cs);
- goto reswitch;
- end;
- end;
- end;
-@z
-
-% \vadjust
-@x l.23545
- begin append_to_vlist(cur_box);
- if adjust_tail<>null then
- begin if adjust_head<>adjust_tail then
- begin link(tail):=link(adjust_head); tail:=adjust_tail;
- end;
-@y
- begin
- if pre_adjust_tail <> null then begin
- if pre_adjust_head <> pre_adjust_tail then
- append_list(pre_adjust_head)(pre_adjust_tail);
- pre_adjust_tail := null;
- end;
- append_to_vlist(cur_box);
- if adjust_tail <> null then begin
- if adjust_head <> adjust_tail then
- append_list(adjust_head)(adjust_tail);
-@z
-
-% \vadjust
-@x l.23716
-adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0);
-@y
-adjusted_hbox_group: begin adjust_tail:=adjust_head;
- pre_adjust_tail:=pre_adjust_head; package(0);
-@z
-
-% \vadjust
-@x l.23870
- help1("I'm changing to \insert0; box 255 is special.");
- error; cur_val:=0;
- end;
- end;
-saved(0):=cur_val; incr(save_ptr);
-new_save_level(insert_group); scan_left_brace; normal_paragraph;
-push_nest; mode:=-vmode; prev_depth:=ignore_depth;
-end;
-@y
- help1("I'm changing to \insert0; box 255 is special.");
- error; cur_val:=0;
- end;
- end;
-saved(0) := cur_val;
-if (cur_cmd = vadjust) and scan_keyword("pre") then
- saved(1) := 1
-else
- saved(1) := 0;
-save_ptr := save_ptr + 2;
-new_save_level(insert_group); scan_left_brace; normal_paragraph;
-push_nest; mode:=-vmode; prev_depth:=ignore_depth;
-end;
-@z
-
-% \vadjust
-@x
- d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
-@y
- d:=split_max_depth; f:=floating_penalty; unsave; save_ptr:=save_ptr-2;
-@z
-
-% \vadjust
-@x l.23892
- subtype(tail):=0; {the |subtype| is not used}
-@y
- adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|}
-@z
-
-% \vadjust
-@x
-@!t:pointer; {tail of adjustment list}
-@y
-@!t:pointer; {tail of adjustment list}
-@!pre_t:pointer; {tail of pre-adjustment list}
-@z
-
-% \vadjust
-@x l.25339
-adjust_tail:=adjust_head; b:=hpack(p,natural); p:=list_ptr(b);
-t:=adjust_tail; adjust_tail:=null;@/
-@y
-adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head;
-b:=hpack(p,natural); p:=list_ptr(b);
-t:=adjust_tail; adjust_tail:=null;@/
-pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/
-@z
-
-% \vadjust
-@x l.25448
-tail_append(new_penalty(post_display_penalty));
-@y
-if pre_t<>pre_adjust_head then
- begin link(tail):=link(pre_adjust_head); tail:=pre_t;
- end;
-tail_append(new_penalty(post_display_penalty));
-@z
-
-% \primitive
-@x
-@<Dump the hash table@>=
-@y
-@<Dump the hash table@>=
-for p:=0 to prim_size do dump_hh(prim[p]);
-for p:=0 to prim_size do dump_wd(prim_eqtb[p]);
-@z
-
-% \primitive
-@x
-@ @<Undump the hash table@>=
-@y
-@ @<Undump the hash table@>=
-for p:=0 to prim_size do undump_hh(prim[p]);
-for p:=0 to prim_size do undump_wd(prim_eqtb[p]);
-@z
-
-% \strcmp
-@x l.28174
-@ Each new type of node that appears in our data structure must be capable
-@y
-@ @d call_func(#) == begin if # <> 0 then do_nothing end
-@d flushable(#) == (# = str_ptr - 1)
-
-@p procedure flush_str(s: str_number); {flush a string if possible}
-begin
- if flushable(s) then
- flush_string;
-end;
-
-procedure pdf_error(t, p: str_number);
-begin
- normalize_selector;
- print_err("Error");
- if t <> 0 then begin
- print(" (");
- print(t);
- print(")");
- end;
- print(": "); print(p);
- succumb;
-end;
-
-function tokens_to_string(p: pointer): str_number; {return a string from tokens
-list}
-begin
- if selector = new_string then
- pdf_error("tokens", "tokens_to_string() called while selector = new_string");
- old_setting:=selector; selector:=new_string;
- show_token_list(link(p),null,pool_size-pool_ptr);
- selector:=old_setting;
-{
- last_tokens_string := make_string;
- tokens_to_string := last_tokens_string;
-}
- tokens_to_string := make_string;
-end;
-
-procedure compare_strings; {to implement \.{\\strcmp}}
-label done;
-var s1, s2: str_number;
- i1, i2, j1, j2: pool_pointer;
-begin
- call_func(scan_toks(false, true));
- s1 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- call_func(scan_toks(false, true));
- s2 := tokens_to_string(def_ref);
- delete_token_ref(def_ref);
- i1 := str_start_macro(s1);
- j1 := str_start_macro(s1 + 1);
- i2 := str_start_macro(s2);
- j2 := str_start_macro(s2 + 1);
- while (i1 < j1) and (i2 < j2) do begin
- if str_pool[i1] < str_pool[i2] then begin
- cur_val := -1;
- goto done;
- end;
- if str_pool[i1] > str_pool[i2] then begin
- cur_val := 1;
- goto done;
- end;
- incr(i1);
- incr(i2);
- end;
- if (i1 = j1) and (i2 = j2) then
- cur_val := 0
- else if i1 < j1 then
- cur_val := 1
- else
- cur_val := -1;
-done:
- flush_str(s2);
- flush_str(s1);
- cur_val_level := int_val;
-end;
-
-@ Each new type of node that appears in our data structure must be capable
-@z
-
-% \strcmp
-% \shellescape
-@x l.29232
-primitive("pdflastypos",last_item,pdf_last_y_pos_code);
-@y
-primitive("pdflastypos",last_item,pdf_last_y_pos_code);
-primitive("strcmp",convert,pdf_strcmp_code);
-primitive("shellescape",last_item,pdf_shell_escape_code);
-@z
-
-% \strcmp
-@x
-eTeX_revision_code: do_nothing;
-@y
-eTeX_revision_code: do_nothing;
-pdf_strcmp_code:
- begin
- save_scanner_status := scanner_status;
- save_warning_index := warning_index;
- save_def_ref := def_ref;
- save_cur_string;
- compare_strings;
- def_ref := save_def_ref;
- warning_index := save_warning_index;
- scanner_status := save_scanner_status;
- restore_cur_string;
- end;
-@z
-
-% \strcmp
-@x
-eTeX_revision_code: print(eTeX_revision);
-@y
-eTeX_revision_code: print(eTeX_revision);
-pdf_strcmp_code: print_int(cur_val);
-@z
-
-% \ifincsname
-@x l.31105
-@d if_font_char_code=19 { `\.{\\iffontchar}' }
-@y
-@d if_font_char_code=19 { `\.{\\iffontchar}' }
-@d if_in_csname_code=20 { `\.{\\ifincsname}' }
-@z
-
-% \ifincsname
-@x l.31115
-@!@:if_font_char_}{\.{\\iffontchar} primitive@>
-@y
-@!@:if_font_char_}{\.{\\iffontchar} primitive@>
-primitive("ifincsname",if_test,if_in_csname_code);
-@!@:if_in_csname_}{\.{\\ifincsname} primitive@>
-@z
-
-% \ifincsname
-@x l.31123
-if_font_char_code:print_esc("iffontchar");
-@y
-if_font_char_code:print_esc("iffontchar");
-if_in_csname_code:print_esc("ifincsname");
-@z
-
-% \ifincsname
-@x
-if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
-@y
-if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
- e := is_in_csname; is_in_csname := true;
-@z
-
-% \ifincsname
-@x
- b:=(eq_type(cur_cs)<>undefined_cs);
-@y
- b:=(eq_type(cur_cs)<>undefined_cs);
- is_in_csname := e;
-@z
-
-% \ifincsname
-@x l.31189
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
-@y
-if_in_csname_code: b := is_in_csname;
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
-@z
-
diff --git a/Build/source/texk/web2c/xetexdir/xetex.ch b/Build/source/texk/web2c/xetexdir/xetex.ch
index b15ed29c152..cd230bb423c 100644
--- a/Build/source/texk/web2c/xetexdir/xetex.ch
+++ b/Build/source/texk/web2c/xetexdir/xetex.ch
@@ -138,23 +138,41 @@ if last<>first then for k:=first to last-1 do print(buffer[k]);
str_start_macro(edit_file.name_field);
@z
-@x [8.110] l.2406
-@d max_quarterword=255 {largest allowable value in a |quarterword|}
-@y
-@d max_quarterword=@"FFFF {largest allowable value in a |quarterword|}
-@z
-@x [8.110] l.2408
+@x [8.110] l.2423
@d max_halfword==@"FFFFFFF {largest allowable value in a |halfword|}
@y
@d max_halfword==@"3FFFFFFF {largest allowable value in a |halfword|}
@z
+@x
+ words:=medium_node_size;
+ end;
+@y
+ words:=medium_node_size;
+ end;
+margin_kern_node: begin
+ r := get_node(margin_kern_node_size);
+{ fast_get_avail(margin_char(r)); }
+{ font(margin_char(r)) := font(margin_char(p)); }
+{ character(margin_char(r)) := character(margin_char(p)); }
+ words := margin_kern_node_size;
+ end;
+@z
+
@x [15.209] l.4165
@d shorthand_def=95 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
@y
@d shorthand_def=97 {code definition ( \.{\\chardef}, \.{\\countdef}, etc.~)}
@z
+@x [17.222] l.4523 - frozen_special, for source specials.
+@d frozen_null_font=frozen_control_sequence+11
+@y
+@d frozen_primitive=frozen_control_sequence+11
+ {permanent `\.{\\primitive}'}
+@d frozen_null_font=frozen_control_sequence+12
+@z
+
@x [17.230] l.4731
@d char_sub_code_base=math_code_base+256 {table of character substitutions}
@d int_base=char_sub_code_base+256 {beginning of region 5}
@@ -688,144 +706,12 @@ ec:=effective_char(false,f,qi(c));
@z
@x
-@d next_p=15 {go to this label when finished with node |p|}
-@y
-@d next_p=15 {go to this label when finished with node |p|}
-
-@d check_next=1236
-@d end_node_run=1237
-@z
-
-@x
label reswitch, move_past, fin_rule, next_p, continue, found;
@y
label reswitch, move_past, fin_rule, next_p, continue, found, check_next, end_node_run;
@z
@x
-@!prev_p:pointer; {one step behind |p|}
-@y
-@!prev_p:pointer; {one step behind |p|}
-@!len: integer; { length of scratch string for native word output }
-@!q,@!r: pointer;
-@!k,@!j: integer;
-@z
-
-@x
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
-@y
-g_sign:=glue_sign(this_box);
-@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>;
-p:=list_ptr(this_box);
-@z
-
-@x
-@ We ought to give special care to the efficiency of one part of |hlist_out|,
-@y
-@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces.
-
-@d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node))
-@d is_glyph_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = glyph_node))
-
-@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>=
-p := list_ptr(this_box);
-prev_p := this_box+list_offset;
-while p<>null do begin
- if link(p) <> null then begin {not worth looking ahead at the end}
- if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag)
- and (font_letter_space[native_font(p)] = 0) then begin
- {got a word in an AAT font, might be the start of a run}
- r := p; {|r| is start of possible run}
- k := native_length(r);
- q := link(p);
-check_next:
- @<Advance |q| past ignorable nodes@>;
- if (q <> null) and not is_char_node(q) then begin
- if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin
- {found a normal space; if the next node is another word in the same font, we'll merge}
- q := link(q);
- @<Advance |q| past ignorable nodes@>;
- if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
- p := q; {record new tail of run in |p|}
- k := k + 1 + native_length(q);
- q := link(q);
- goto check_next;
- end;
- goto end_node_run;
- end;
- {@@<Advance |q| past ignorable nodes@@>;}
- if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
- p := q; {record new tail of run in |p|}
- q := link(q);
- goto check_next;
- end
- end;
-end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last}
- if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|}
- str_room(k);
- k := 0; {now we'll use this as accumulator for total width}
- q := r;
- loop begin
- if type(q) = whatsit_node then begin
- if subtype(q) = native_word_node then begin
- for j := 0 to native_length(q)-1 do
- append_char(get_native_char(q, j));
- k := k + width(q);
- end
- end else if type(q) = glue_node then begin
- append_char(" ");
- g := glue_ptr(q);
- k := k + width(g);
- if g_sign <> normal then begin
- if g_sign = stretching then begin
- if stretch_order(g) = g_order then begin
- k := k + round(float(glue_set(this_box)) * stretch(g))
- end
- end else begin
- if shrink_order(g) = g_order then begin
- k := k - round(float(glue_set(this_box)) * shrink(g))
- end
- end
- end
- end;
- {discretionary and deleted nodes can be discarded here}
- if q = p then break
- else q := link(q);
- end;
-done:
- q := new_native_word_node(native_font(r), cur_length);
- link(prev_p) := q;
- for j := 0 to cur_length - 1 do
- set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]);
- link(q) := link(p);
- link(p) := null;
- flush_node_list(r);
- width(q) := k;
- set_justified_native_glyphs(q);
- p := q;
- pool_ptr := str_start_macro(str_ptr); {flush the temporary string data}
- end
- end;
- prev_p := p;
- end;
- p := link(p);
-end
-
-@ @<Advance |q| past ignorable nodes@>=
-while (q <> null) and (not is_char_node(q)) and (type(q) = disc_node) do
- q := link(q)
-
-@ We ought to give special care to the efficiency of one part of |hlist_out|,
-@z
-
-@x
- repeat f:=font(p); c:=character(p);
-@y
- repeat f:=font(p); c:=character(p);
- if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c);
-@z
-
-@x
@p procedure vlist_out; {output a |vlist_node| box}
@y
@p procedure vlist_out; {output a |vlist_node| box}
@@ -855,18 +741,6 @@ if upwards then cur_v:=cur_v+depth(this_box) else cur_v:=cur_v-height(this_box);
@z
@x
-kern_node:cur_v:=cur_v+width(p);
-@y
-kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p);
-@z
-
-@x
-move_past: cur_v:=cur_v+rule_ht;
-@y
-move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht;
-@z
-
-@x
@<Output a box in a vlist@>=
if list_ptr(p)=null then cur_v:=cur_v+height(p)+depth(p)
@y
@@ -899,49 +773,6 @@ else begin if upwards then cur_v:=cur_v-depth(p) else cur_v:=cur_v+height(p); s
@z
@x
-cur_v:=cur_v+rule_ht;
-@y
-if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht;
-@z
-
-@x
-begin if tracing_output>0 then
-@y
-begin
-if job_name=0 then open_log_file;
-if tracing_output>0 then
-@z
-
-@x
-dvi_four(last_bop); last_bop:=page_loc;
-@y
-dvi_four(last_bop); last_bop:=page_loc;
-{ generate a pagesize special at start of page }
-old_setting:=selector; selector:=new_string;
-print("pdf:pagesize ");
-if (pdf_page_width > 0) and (pdf_page_height > 0) then begin
- print("width"); print(" ");
- print_scaled(pdf_page_width);
- print("pt"); print(" ");
- print("height"); print(" ");
- print_scaled(pdf_page_height);
- print("pt");
-end else
- print("default");
-selector:=old_setting;
-dvi_out(xxx1); dvi_out(cur_length);
-for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
-pool_ptr:=str_start_macro(str_ptr); {erase the string}
-@z
-
-@x
-cur_v:=height(p)+v_offset; temp_ptr:=p;
-@y
-cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? }
-temp_ptr:=p;
-@z
-
-@x
dvi_out(eop); incr(total_pages); cur_s:=-1;
@y
dvi_out(eop); incr(total_pages); cur_s:=-1;
@@ -977,600 +808,12 @@ if not no_pdf_output then fflush(dvi_file);
@z
@x
-@* \[33] Packaging.
-@y
-@* \[33] Packaging.
-@z
-
-@x
-@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
-label reswitch, common_ending, exit;
-@y
-@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
-label reswitch, common_ending, exit, restart;
-@z
-
-@x
-@!hd:eight_bits; {height and depth indices for a character}
-@y
-@!hd:eight_bits; {height and depth indices for a character}
-@!pp,@!ppp: pointer;
-@!total_chars, @!k: integer;
-@z
-
-@x
-p:=lig_trick; goto reswitch;
-@y
-p:=lig_trick; xtx_ligature_present:=true; goto reswitch;
-@z
-
-@x
-@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
-@y
-@d vpack(#)==vpackage(#,max_dimen) {special case of unconstrained depth}
-@z
-
-@x
-subtype(r):=min_quarterword; shift_amount(r):=0;
-@y
-if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword;
-shift_amount(r):=0;
-@z
-
-@x
-@p procedure append_to_vlist(@!b:pointer);
-var d:scaled; {deficiency of space between baselines}
-@!p:pointer; {a new glue node}
-begin if prev_depth>ignore_depth then
- begin d:=width(baseline_skip)-prev_depth-height(b);
- if d<line_skip_limit then p:=new_param_glue(line_skip_code)
- else begin p:=new_skip_param(baseline_skip_code);
- width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
- end;
- link(tail):=p; tail:=p;
- end;
-link(tail):=b; tail:=b; prev_depth:=depth(b);
-end;
-@y
-@p procedure append_to_vlist(@!b:pointer);
-var d:scaled; {deficiency of space between baselines}
-@!p:pointer; {a new glue node}
-@!upwards:boolean;
-begin upwards:=XeTeX_upwards;
- if prev_depth>ignore_depth then
- begin if upwards then d:=width(baseline_skip)-prev_depth-depth(b)
- else d:=width(baseline_skip)-prev_depth-height(b);
- if d<line_skip_limit then p:=new_param_glue(line_skip_code)
- else begin p:=new_skip_param(baseline_skip_code);
- width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
- end;
- link(tail):=p; tail:=p;
- end;
-link(tail):=b; tail:=b; if upwards then prev_depth:=height(b) else prev_depth:=depth(b);
-end;
-@z
-
-@x
-@* \[34] Data structures for math mode.
-@y
-@* \[34] Data structures for math mode.
-@z
-
-@x
-@d fam==font {a |quarterword| in |mem|}
-@y
-@d plane_and_fam_field==font {a |quarterword| in |mem|}
-@d fam(#) == (plane_and_fam_field(#) mod @"100)
-@z
-
-@x
-@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter}
-@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter}
-@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter}
-@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter}
-@y
-@d small_fam(#)==(mem[#].qqqq.b0 mod @"100) {|fam| for ``small'' delimiter}
-@d small_char(#)==(mem[#].qqqq.b1 + (mem[#].qqqq.b0 div @"100) * @"10000) {|character| for ``small'' delimiter}
-@d large_fam(#)==(mem[#].qqqq.b2 mod @"100) {|fam| for ``large'' delimiter}
-@d large_char(#)==(mem[#].qqqq.b3 + (mem[#].qqqq.b2 div @"100) * @"10000) {|character| for ``large'' delimiter}
-@d small_plane_and_fam_field(#)==mem[#].qqqq.b0
-@d small_char_field(#)==mem[#].qqqq.b1
-@d large_plane_and_fam_field(#)==mem[#].qqqq.b2
-@d large_char_field(#)==mem[#].qqqq.b3
-@z
-
-@x
-@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
-@y
-@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
-@d fixed_acc=1 {|subtype| for non growing math accents}
-@d bottom_acc=2 {|subtype| for bottom math accents}
-@d is_bottom_acc(#)==((subtype(#)=bottom_acc) or (subtype(#)=bottom_acc+fixed_acc))
-@z
-
-@x
-procedure print_fam_and_char(@!p:pointer); {prints family and character}
-begin print_esc("fam"); print_int(fam(p)); print_char(" ");
-print_ASCII(qo(character(p)));
-@y
-procedure print_fam_and_char(@!p:pointer); {prints family and character}
-begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" ");
-print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000);
-@z
-
-@x
-@* \[35] Subroutines for math mode.
-@y
-@* \[35] Subroutines for math mode.
-@z
-
-@x
-@d mathsy_end(#)==fam_fnt(2+#)]].sc
-@d mathsy(#)==font_info[#+param_base[mathsy_end
-@d math_x_height==mathsy(5) {height of `\.x'}
-@d math_quad==mathsy(6) {\.{18mu}}
-@d num1==mathsy(8) {numerator shift-up in display styles}
-@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}}
-@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}}
-@d denom1==mathsy(11) {denominator shift-down in display styles}
-@d denom2==mathsy(12) {denominator shift-down in non-display styles}
-@d sup1==mathsy(13) {superscript shift-up in uncramped display style}
-@d sup2==mathsy(14) {superscript shift-up in uncramped non-display}
-@d sup3==mathsy(15) {superscript shift-up in cramped styles}
-@d sub1==mathsy(16) {subscript shift-down if superscript is absent}
-@d sub2==mathsy(17) {subscript shift-down if superscript is present}
-@d sup_drop==mathsy(18) {superscript baseline below top of large box}
-@d sub_drop==mathsy(19) {subscript baseline below bottom of large box}
-@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters
- in display styles}
-@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays}
-@d axis_height==mathsy(22) {height of fraction lines above the baseline}
-@d total_mathsy_params=22
-@y
-NB: the access functions here must all put the font \# into /f/ for mathsy().
-
-The accessors are defined with
-|define_mathsy_accessor(NAME)(fontdimen-number)(NAME)|
-because I can't see how to only give the name once, with WEB's limited
-macro capabilities. This seems a bit ugly, but it works.
-
-@d total_mathsy_params=22
-
-{the following are OpenType MATH constant indices for use with OT math fonts}
-@d scriptPercentScaleDown = 0
-@d scriptScriptPercentScaleDown = 1
-@d delimitedSubFormulaMinHeight = 2
-@d displayOperatorMinHeight = 3
-@d mathLeading = 4
-@d firstMathValueRecord = mathLeading
-@d axisHeight = 5
-@d accentBaseHeight = 6
-@d flattenedAccentBaseHeight = 7
-@d subscriptShiftDown = 8
-@d subscriptTopMax = 9
-@d subscriptBaselineDropMin = 10
-@d superscriptShiftUp = 11
-@d superscriptShiftUpCramped = 12
-@d superscriptBottomMin = 13
-@d superscriptBaselineDropMax = 14
-@d subSuperscriptGapMin = 15
-@d superscriptBottomMaxWithSubscript = 16
-@d spaceAfterScript = 17
-@d upperLimitGapMin = 18
-@d upperLimitBaselineRiseMin = 19
-@d lowerLimitGapMin = 20
-@d lowerLimitBaselineDropMin = 21
-@d stackTopShiftUp = 22
-@d stackTopDisplayStyleShiftUp = 23
-@d stackBottomShiftDown = 24
-@d stackBottomDisplayStyleShiftDown = 25
-@d stackGapMin = 26
-@d stackDisplayStyleGapMin = 27
-@d stretchStackTopShiftUp = 28
-@d stretchStackBottomShiftDown = 29
-@d stretchStackGapAboveMin = 30
-@d stretchStackGapBelowMin = 31
-@d fractionNumeratorShiftUp = 32
-@d fractionNumeratorDisplayStyleShiftUp = 33
-@d fractionDenominatorShiftDown = 34
-@d fractionDenominatorDisplayStyleShiftDown = 35
-@d fractionNumeratorGapMin = 36
-@d fractionNumDisplayStyleGapMin = 37
-@d fractionRuleThickness = 38
-@d fractionDenominatorGapMin = 39
-@d fractionDenomDisplayStyleGapMin = 40
-@d skewedFractionHorizontalGap = 41
-@d skewedFractionVerticalGap = 42
-@d overbarVerticalGap = 43
-@d overbarRuleThickness = 44
-@d overbarExtraAscender = 45
-@d underbarVerticalGap = 46
-@d underbarRuleThickness = 47
-@d underbarExtraDescender = 48
-@d radicalVerticalGap = 49
-@d radicalDisplayStyleVerticalGap = 50
-@d radicalRuleThickness = 51
-@d radicalExtraAscender = 52
-@d radicalKernBeforeDegree = 53
-@d radicalKernAfterDegree = 54
-@d lastMathValueRecord = radicalKernAfterDegree
-@d radicalDegreeBottomRaisePercent = 55
-@d lastMathConstant = radicalDegreeBottomRaisePercent
-
-
-@d mathsy(#)==font_info[#+param_base[f]].sc
-
-@d define_mathsy_end(#)==
- # := rval;
- end
-@d define_mathsy_body(#)==
- var
- f: integer;
- rval: scaled;
- begin
- f := fam_fnt(2 + size_code);
- if is_new_mathfont(cur_f) then
- rval := get_native_mathsy_param(cur_f, #)
- else
- rval := mathsy(#);
- define_mathsy_end
-@d define_mathsy_accessor(#)==function #(size_code: integer): scaled; define_mathsy_body
-
-@p define_mathsy_accessor(math_x_height)(5)(math_x_height);
-define_mathsy_accessor(math_quad)(6)(math_quad);
-define_mathsy_accessor(num1)(8)(num1);
-define_mathsy_accessor(num2)(9)(num2);
-define_mathsy_accessor(num3)(10)(num3);
-define_mathsy_accessor(denom1)(11)(denom1);
-define_mathsy_accessor(denom2)(12)(denom2);
-define_mathsy_accessor(sup1)(13)(sup1);
-define_mathsy_accessor(sup2)(14)(sup2);
-define_mathsy_accessor(sup3)(15)(sup3);
-define_mathsy_accessor(sub1)(16)(sub1);
-define_mathsy_accessor(sub2)(17)(sub2);
-define_mathsy_accessor(sup_drop)(18)(sup_drop);
-define_mathsy_accessor(sub_drop)(19)(sub_drop);
-define_mathsy_accessor(delim1)(20)(delim1);
-define_mathsy_accessor(delim2)(21)(delim2);
-define_mathsy_accessor(axis_height)(22)(axis_height);
-@z
-
-@x
-@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
-@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars}
-@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op}
-@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op}
-@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op}
-@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op}
-@d big_op_spacing5==mathex(13) {padding above and below displayed limits}
-@d total_mathex_params=13
-@y
-@d total_mathex_params=13
-
-@d mathex(#)==font_info[#+param_base[f]].sc
-
-@d define_mathex_end(#)==
- # := rval;
- end
-@d define_mathex_body(#)==
- var
- f: integer;
- rval: scaled;
- begin
- f := fam_fnt(3 + cur_size);
- if is_new_mathfont(cur_f) then
- rval := get_native_mathex_param(cur_f, #)
- else
- rval := mathex(#);
- define_mathex_end
-@d define_mathex_accessor(#)==function #:scaled; define_mathex_body
-
-@p define_mathex_accessor(default_rule_thickness)(8)(default_rule_thickness);
-define_mathex_accessor(big_op_spacing1)(9)(big_op_spacing1);
-define_mathex_accessor(big_op_spacing2)(10)(big_op_spacing2);
-define_mathex_accessor(big_op_spacing3)(11)(big_op_spacing3);
-define_mathex_accessor(big_op_spacing4)(12)(big_op_spacing4);
-define_mathex_accessor(big_op_spacing5)(13)(big_op_spacing5);
-@z
-
-@x
-else cur_size:=16*((cur_style-text_style) div 2);
-@y
-else cur_size:=script_size*((cur_style-text_style) div 2);
-@z
-
-@x
-function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
-label found,continue;
-var b:pointer; {the box that will be constructed}
-@y
-procedure stack_glyph_into_box(@!b:pointer;@!f:internal_font_number;@!g:integer);
-var p,q:pointer;
-begin
- p:=get_node(glyph_node_size);
- type(p):=whatsit_node; subtype(p):=glyph_node;
- native_font(p):=f; native_glyph(p):=g;
- set_native_glyph_metrics(p, 1);
- if type(b)=hlist_node then begin
- q:=list_ptr(b);
- if q=null then list_ptr(b):=p else begin
- while link(q)<>null do q:=link(q);
- link(q):=p;
- if (height(b) < height(p)) then height(b):=height(p);
- if (depth(b) < depth(p)) then depth(b):=depth(p);
- end;
- end else begin
- link(p):=list_ptr(b); list_ptr(b):=p;
- height(b):=height(p);
- if (width(b) < width(p)) then width(b):=width(p);
- end;
-end;
-
-procedure stack_glue_into_box(@!b:pointer;@!min,max:scaled);
-var p,q:pointer;
-begin
- q:=new_spec(zero_glue);
- width(q):=min;
- stretch(q):=max-min;
- p:=new_glue(q);
- if type(b)=hlist_node then begin
- q:=list_ptr(b);
- if q=null then list_ptr(b):=p else begin
- while link(q)<>null do q:=link(q);
- link(q):=p;
- end;
- end else begin
- link(p):=list_ptr(b); list_ptr(b):=p;
- height(b):=height(p); width(b):=width(p);
- end;
-end;
-
-function build_opentype_assembly(@!f:internal_font_number;@!a:void_pointer;@!s:scaled;@!horiz:boolean):pointer;
- {return a box with height/width at least |s|, using font |f|, with glyph assembly info from |a|}
-var
- b:pointer; {the box we're constructing}
- n:integer; {the number of repetitions of each extender}
- i,j:integer; {indexes}
- g:integer; {glyph code}
- p:pointer; {temp pointer}
- s_max,o,oo,prev_o,min_o:scaled;
- no_extenders: boolean;
- nat,str:scaled; {natural size, stretch}
-begin
- b:=new_null_box;
- if horiz then
- type(b):=hlist_node
- else
- type(b):=vlist_node;
-
- {figure out how many repeats of each extender to use}
- n:=-1;
- no_extenders:=true;
- min_o:=ot_min_connector_overlap(f);
- repeat
- n:=n+1;
- {calc max possible size with this number of extenders}
- s_max:=0;
- prev_o:=0;
- for i:=0 to ot_part_count(a)-1 do begin
- if ot_part_is_extender(a, i) then begin
- no_extenders:=false;
- for j:=1 to n do begin
- o:=ot_part_start_connector(f, a, i);
- if min_o<o then o:=min_o;
- if prev_o<o then o:=prev_o;
- s_max:=s_max-o+ot_part_full_advance(f, a, i);
- prev_o:=ot_part_end_connector(f, a, i);
- end
- end else begin
- o:=ot_part_start_connector(f, a, i);
- if min_o<o then o:=min_o;
- if prev_o<o then o:=prev_o;
- s_max:=s_max-o+ot_part_full_advance(f, a, i);
- prev_o:=ot_part_end_connector(f, a, i);
- end;
- end;
- until (s_max>=s) or no_extenders;
-
- {assemble box using |n| copies of each extender,
- with appropriate glue wherever an overlap occurs}
- prev_o:=0;
- for i:=0 to ot_part_count(a)-1 do begin
- if ot_part_is_extender(a, i) then begin
- for j:=1 to n do begin
- o:=ot_part_start_connector(f, a, i);
- if prev_o<o then o:=prev_o;
- oo:=o; {max overlap}
- if min_o<o then o:=min_o;
- if oo>0 then stack_glue_into_box(b, -oo, -o);
- g:=ot_part_glyph(a, i);
- stack_glyph_into_box(b, f, g);
- prev_o:=ot_part_end_connector(f, a, i);
- end
- end else begin
- o:=ot_part_start_connector(f, a, i);
- if prev_o<o then o:=prev_o;
- oo:=o; {max overlap}
- if min_o<o then o:=min_o;
- if oo>0 then stack_glue_into_box(b, -oo, -o);
- g:=ot_part_glyph(a, i);
- stack_glyph_into_box(b, f, g);
- prev_o:=ot_part_end_connector(f, a, i);
- end;
- end;
-
- {find natural size and total stretch of the box}
- p:=list_ptr(b); nat:=0; str:=0;
- while p<>null do begin
- if type(p)=whatsit_node then begin
- if horiz then
- nat:=nat+width(p)
- else
- nat:=nat+height(p)+depth(p);
- end else if type(p)=glue_node then begin
- nat:=nat+width(glue_ptr(p));
- str:=str+stretch(glue_ptr(p));
- end;
- p:=link(p);
- end;
-
- {set glue so as to stretch the connections if needed}
- o:=0;
- if (s>nat) and (str>0) then begin
- o:=(s-nat);
- {don't stretch more than |str|}
- if (o>str) then o:=str;
- glue_order(b):=normal; glue_sign(b):=stretching;
- glue_set(b):=unfloat(o/str);
- if horiz then
- width(b):= nat+round(str*float(glue_set(b)))
- else
- height(b):=nat+round(str*float(glue_set(b)));
- end else
- if horiz then
- width(b):=nat
- else
- height(b):=nat;
-
- build_opentype_assembly:=b;
-end;
-
-function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
-label found,continue;
-var b:pointer; {the box that will be constructed}
-ot_assembly_ptr:void_pointer;
-@z
-
-@x
-@!z: small_number; {runs through font family members}
-@y
-@!z: integer; {runs through font family members}
-@z
-
-@x
-loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
- a better character is found; |goto found| as soon as a
- large enough variant is encountered@>;
- if large_attempt then goto found; {there were none large enough}
- large_attempt:=true; z:=large_fam(d); x:=large_char(d);
- end;
-found: if f<>null_font then
- @<Make variable |b| point to a box for |(f,c)|@>
-else begin b:=new_null_box;
- width(b):=null_delimiter_space; {use this width if no delimiter was found}
- end;
-@y
-ot_assembly_ptr:=nil;
-loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
- a better character is found; |goto found| as soon as a
- large enough variant is encountered@>;
- if large_attempt then goto found; {there were none large enough}
- large_attempt:=true; z:=large_fam(d); x:=large_char(d);
- end;
-found: if f<>null_font then begin
- if not is_ot_font(f) then
- @<Make variable |b| point to a box for |(f,c)|@>
- else begin
- {for OT fonts, c is the glyph ID to use}
- if ot_assembly_ptr<>nil then
- b:=build_opentype_assembly(f, ot_assembly_ptr, v, 0)
- else begin
- b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size);
- type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node;
- native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c;
- set_native_glyph_metrics(list_ptr(b), 1);
- width(b):=width(list_ptr(b));
- height(b):=height(list_ptr(b));
- depth(b):=depth(list_ptr(b));
- end
- end
-end else begin b:=new_null_box;
- width(b):=null_delimiter_space; {use this width if no delimiter was found}
- end;
-@z
-
-@x
- begin z:=z+s+16;
- repeat z:=z-16; g:=fam_fnt(z);
-@y
- begin z:=z+s+script_size;
- repeat z:=z-script_size; g:=fam_fnt(z);
-@z
-
-@x
- until z<16;
-@y
- until z<script_size;
-@z
-
-@x
-@ @<Look at the list of characters starting with |x|...@>=
-@y
-@ @<Look at the list of characters starting with |x|...@>=
-if is_ot_font(g) then begin
- b:=new_native_character(g, x);
- x:=get_native_glyph(b, 0);
- free_node(b, native_size(b));
- f:=g; c:=x; w:=0; n:=0;
- repeat
- y:=get_ot_math_variant(g, x, n, addressof(u), 0);
- if u>w then begin
- c:=y; w:=u;
- if u>=v then goto found;
- end;
- n:=n+1;
- until u<0;
- {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
- ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0);
- if ot_assembly_ptr<>nil then goto found;
-end else
-@z
-
-@x
-function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
-var q:four_quarters;
-@!hd:eight_bits; {|height_depth| byte}
-@!b,@!p:pointer; {the new box and its character node}
-begin q:=char_info(f)(c); hd:=height_depth(q);
-b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
-height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
-p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
-end;
-@y
-function char_box(@!f:internal_font_number;@!c:integer):pointer;
-var q:four_quarters;
-@!hd:eight_bits; {|height_depth| byte}
-@!b,@!p:pointer; {the new box and its character node}
-begin
-if is_native_font(f) then begin
- b:=new_null_box;
- p:=new_native_character(f, c);
- list_ptr(b):=p;
- height(b):=height(p); width(b):=width(p);
- if depth(p)<0 then depth(b):=0 else depth(b):=depth(p);
- end
-else begin
- q:=char_info(f)(c); hd:=height_depth(q);
- b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
- height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
- p:=get_avail; character(p):=c; font(p):=f;
- end;
-list_ptr(b):=p; char_box:=b;
-end;
-@z
-
-@x
@* \[36] Typesetting math formulas.
@y
@* \[36] Typesetting math formulas.
@z
-@x
-@!cur_size:small_number; {size code corresponding to |cur_style|}
-@y
-@!cur_size:integer; {size code corresponding to |cur_style|}
-@z
-
+% Conflict with ../tex.ch
@x
@p procedure fetch(@!a:pointer); {unpack the |math_char| field |a|}
begin cur_c:=character(a); cur_f:=fam_fnt(fam(a)+cur_size);
@@ -1591,990 +834,9 @@ end else begin if (qo(cur_c)>=font_bc[cur_f])and(qo(cur_c)<=font_ec[cur_f]) then
@z
@x
-@!cur_c:quarterword; {the |character| field of a |math_char|}
-@y
-@!cur_c:integer; {the |character| field of a |math_char|}
-@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);
-@y
-procedure make_radical(@!q:pointer);
-var x,@!y:pointer; {temporary registers for box construction}
-f:internal_font_number;
-rule_thickness:scaled; {rule thickness}
-@!delta,@!clr:scaled; {dimensions involved in the calculation}
-begin f:=fam_fnt(small_fam(left_delimiter(q)) + cur_size);
-if is_new_mathfont(f) then rule_thickness:=get_ot_math_constant(f,radicalRuleThickness)
-else rule_thickness:=default_rule_thickness;
-x:=clean_box(nucleus(q),cramped_style(cur_style));
-if is_new_mathfont(f) then begin
- if cur_style<text_style then {display style}
- clr:=get_ot_math_constant(f,radicalDisplayStyleVerticalGap)
- else clr:=get_ot_math_constant(f,radicalVerticalGap);
-end else begin
- if cur_style<text_style then {display style}
- clr:=rule_thickness+(abs(math_x_height(cur_size)) div 4)
- else begin clr:=rule_thickness; clr:=clr + (abs(clr) div 4);
- end;
-end;
-y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+rule_thickness);
-if is_new_mathfont(f) then begin
- depth(y):=height(y)+depth(y)-rule_thickness;
- height(y):=rule_thickness;
-end;
-@z
-
-@x
-procedure make_math_accent(@!q:pointer);
-label done,done1;
-var p,@!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:four_quarters; {its |char_info|}
-@!s:scaled; {amount to skew the accent to the right}
-@!h:scaled; {height of character being accented}
-@!delta:scaled; {space to remove between accent and accentee}
-@!w:scaled; {width of the accentee, not including sub/superscripts}
-begin fetch(accent_chr(q));
-if char_exists(cur_i) then
- begin i:=cur_i; c:=cur_c; f:=cur_f;@/
- @<Compute the amount of skew@>;
- x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
- @<Switch to a larger accent if available and appropriate@>;
- if h<x_height(f) then delta:=h@+else delta:=x_height(f);
- 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|@>;
- y:=char_box(f,c);
- shift_amount(y):=s+half(w-width(y));
- width(y):=0; p:=new_kern(-delta); link(p):=x; link(y):=p;
- y:=vpack(y,natural); width(y):=width(x);
- if height(y)<h then @<Make the height of box |y| equal to |h|@>;
- info(nucleus(q)):=y;
- math_type(nucleus(q)):=sub_box;
- end;
-end;
-@y
-function compute_ot_math_accent_pos(@!p:pointer):scaled;
-var
- @!q,@!r:pointer;
- @!s,@!g:scaled;
-begin
- if (math_type(nucleus(p))=math_char) then begin
- fetch(nucleus(p));
- q:=new_native_character(cur_f, qo(cur_c));
- g:=get_native_glyph(q, 0);
- s:=get_ot_math_accent_pos(cur_f, g);
- end else begin
- if (math_type(nucleus(p))=sub_mlist) then begin
- r:=info(nucleus(p));
- if (r<>null) and (type(r)=accent_noad) then
- s:=compute_ot_math_accent_pos(r)
- else
- s:=@"7FFFFFFF;
- end else
- s:=@"7FFFFFFF;
- end;
- compute_ot_math_accent_pos:=s;
-end;
-
-procedure make_math_accent(@!q:pointer);
-label done,done1;
-var p,@!x,@!y:pointer; {temporary registers for box construction}
-@!a:integer; {address of lig/kern instruction}
-@!c,@!g:integer; {accent character}
-@!f:internal_font_number; {its font}
-@!i:four_quarters; {its |char_info|}
-@!s,@!sa:scaled; {amount to skew the accent to the right}
-@!h:scaled; {height of character being accented}
-@!delta:scaled; {space to remove between accent and accentee}
-@!w,@!w2:scaled; {width of the accentee, not including sub/superscripts}
-@!ot_assembly_ptr:void_pointer;
-begin fetch(accent_chr(q));
-x:=null;
-if is_native_font(cur_f) then
- begin c:=cur_c; f:=cur_f;
- if not is_bottom_acc(q) then s:=compute_ot_math_accent_pos(q);
- x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
- end
-else if char_exists(cur_i) then
- begin i:=cur_i; c:=cur_c; f:=cur_f;@/
- @<Compute the amount of skew@>;
- x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
- @<Switch to a larger accent if available and appropriate@>;
- end;
-if x<>null then begin
- if is_new_mathfont(f) then
- if is_bottom_acc(q) then delta:=0
- else if h<get_ot_math_constant(f, accentBaseHeight) then delta:=h@+else delta:=get_ot_math_constant(f, accentBaseHeight)
- else
- if h<x_height(f) then delta:=h@+else delta:=x_height(f);
- 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|@>;
- y:=char_box(f,c);
- if is_native_font(f) then begin
- {turn the |native_word| node into a |native_glyph| one}
- p:=get_node(glyph_node_size);
- type(p):=whatsit_node; subtype(p):=glyph_node;
- native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0);
- set_native_glyph_metrics(p, 1);
- free_node(list_ptr(y), native_size(list_ptr(y)));
- list_ptr(y):=p;
-
- @<Switch to a larger native-font accent if available and appropriate@>;
-
- {determine horiz positioning}
- sa:=get_ot_math_accent_pos(f,native_glyph(p));
- if sa=@"7FFFFFFF then sa:=half(width(y));
- if is_bottom_acc(q) or (s=@"7FFFFFFF) then s:=half(w);
- shift_amount(y):=s-sa;
- end else
- shift_amount(y):=s+half(w-width(y));
- width(y):=0;
- if is_bottom_acc(q) then begin
- link(x):=y; y:=vpack(x,natural); shift_amount(y):=-(h - height(y));
- end else begin
- p:=new_kern(-delta); link(p):=x; link(y):=p; y:=vpack(y,natural);
- if height(y)<h then @<Make the height of box |y| equal to |h|@>;
- end;
- width(y):=width(x);
- info(nucleus(q)):=y;
- math_type(nucleus(q)):=sub_box;
- end;
-end;
-@z
-
-@x
-@ @<Switch to a larger accent if available and appropriate@>=
-@y
-@ @<Switch to a larger native-font accent if available and appropriate@>=
- if odd(subtype(q)) then {non growing accent}
- set_native_glyph_metrics(p, 1)
- else begin
- c:=native_glyph(p);
- a:=0;
- repeat
- g:=get_ot_math_variant(f, c, a, addressof(w2), 1);
- if (w2>0) and (w2<=w) then begin
- native_glyph(p):=g;
- set_native_glyph_metrics(p, 1);
- incr(a);
- end;
- until (w2<0) or (w2>=w);
- if (w2<0) then begin
- ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1);
- if ot_assembly_ptr<>nil then begin
- free_node(p,glyph_node_size);
- p:=build_opentype_assembly(cur_f, ot_assembly_ptr, w, 1);
- list_ptr(y):=p;
- goto found;
- end;
- end else
- set_native_glyph_metrics(p, 1);
- end;
-found:
- width(y):=width(p); height(y):=height(p); depth(y):=depth(p);
- if is_bottom_acc(q) then begin
- if height(y)<0 then height(y):=0
- end else if depth(y)<0 then depth(y):=0;
-
-@ @<Switch to a larger accent if available and appropriate@>=
-@z
-
-@x
-@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
-begin if cur_style<text_style then clr:=7*default_rule_thickness
-else clr:=3*default_rule_thickness;
-@y
-@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
-begin if is_new_mathfont(cur_f) then begin
- if cur_style<text_style then clr:=get_ot_math_constant(cur_f, stackDisplayStyleGapMin)
- else clr:=get_ot_math_constant(cur_f, stackGapMin);
-end else begin
- if cur_style<text_style then clr:=7*default_rule_thickness
- else clr:=3*default_rule_thickness;
-end;
-@z
-
-@x
-@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
-begin if cur_style<text_style then clr:=3*thickness(q)
-else clr:=thickness(q);
-delta:=half(thickness(q));
-delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
-delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
-@y
-@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
-begin if is_new_mathfont(cur_f) then begin
- delta:=half(thickness(q));
- if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionNumDisplayStyleGapMin)
- else clr:=get_ot_math_constant(cur_f, fractionNumeratorGapMin);
- delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
- if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionDenomDisplayStyleGapMin)
- else clr:=get_ot_math_constant(cur_f, fractionDenominatorGapMin);
- delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
-end else begin
- if cur_style<text_style then clr:=3*thickness(q)
- else clr:=thickness(q);
- delta:=half(thickness(q));
- delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
- delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
-end;
-@z
-
-@x
-function make_op(@!q:pointer):scaled;
-var delta:scaled; {offset between subscript and superscript}
-@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
-@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
-begin if (subtype(q)=normal)and(cur_style<text_style) then
- subtype(q):=limits;
-if math_type(nucleus(q))=math_char then
- begin fetch(nucleus(q));
- if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
begin c:=rem_byte(cur_i); i:=orig_char_info(cur_f)(c);
- if char_exists(i) then
- begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
- end;
- end;
- delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style);
- if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
- width(x):=width(x)-delta; {remove italic correction}
- shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
- {center vertically}
- math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x;
- end
-else delta:=0;
-if subtype(q)=limits then
- @<Construct a box with limits above and below it, skewed by |delta|@>;
-make_op:=delta;
-end;
@y
-function make_op(@!q:pointer):scaled;
-label found;
-var delta:scaled; {offset between subscript and superscript}
-@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
-@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
-@!h1,@!h2:scaled; {height of original text-style symbol and possible replacement}
-@!n,@!g:integer; {potential variant index and glyph code}
-@!ot_assembly_ptr:void_pointer;
-@!save_f:internal_font_number;
-begin if (subtype(q)=normal)and(cur_style<text_style) then
- subtype(q):=limits;
-delta:=0;
-if math_type(nucleus(q))=math_char then
- begin fetch(nucleus(q));
- if not is_ot_font(cur_f) then begin
- if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
begin c:=rem_byte(cur_i); i:=orig_char_info(cur_f)(c);
- if char_exists(i) then
- begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
- end;
- end;
- delta:=char_italic(cur_f)(cur_i);
- end;
- x:=clean_box(nucleus(q),cur_style);
- if is_new_mathfont(cur_f) then begin
- p:=list_ptr(x);
- if is_glyph_node(p) then begin
- if cur_style<text_style then begin
- {try to replace the operator glyph with a display-size variant,
- ensuring it is larger than the text size}
- h1:=get_ot_math_constant(cur_f,displayOperatorMinHeight);
- if h1<(height(p)+depth(p))*5/4 then h1:=(height(p)+depth(p))*5/4;
- c:=native_glyph(p);
- n:=0;
- repeat
- g:=get_ot_math_variant(cur_f, c, n, addressof(h2), 0);
- if h2>0 then begin
- native_glyph(p):=g;
- set_native_glyph_metrics(p, 1);
- end;
- incr(n);
- until (h2<0) or (h2>=h1);
- if (h2<0) then begin
- {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
- ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0);
- if ot_assembly_ptr<>nil then begin
- free_node(p,glyph_node_size);
- p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1, 0);
- list_ptr(x):=p;
- delta:=0;
- goto found;
- end;
- end else
- set_native_glyph_metrics(p, 1);
- end;
- delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
-found:
- width(x):=width(p); height(x):=height(p); depth(x):=depth(p);
- end
- end;
- if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
- width(x):=width(x)-delta; {remove italic correction}
- shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
- {center vertically}
- math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x;
- end;
-save_f:=cur_f;
-if subtype(q)=limits then
- @<Construct a box with limits above and below it, skewed by |delta|@>;
-make_op:=delta;
-end;
-@z
-
-@x
-@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
-@y
-@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
-cur_f:=save_f;
-@z
-
-@x
- character(nucleus(r)):=rem_byte(cur_i);
- fam(nucleus(r)):=fam(nucleus(q));@/
-@y
- character(nucleus(r)):=rem_byte(cur_i);
- plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/
-@z
-
-@x
-@ @<Create a character node |p| for |nucleus(q)|...@>=
-begin fetch(nucleus(q));
-if char_exists(cur_i) then
-@y
-@ @<Create a character node |p| for |nucleus(q)|...@>=
-begin fetch(nucleus(q));
-if is_native_font(cur_f) then begin
- z:=new_native_character(cur_f, qo(cur_c));
- p:=get_node(glyph_node_size);
- type(p):=whatsit_node; subtype(p):=glyph_node;
- native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0);
- set_native_glyph_metrics(p, 1);
- free_node(z, native_size(z));
- delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
- if (math_type(nucleus(q))=math_text_char)and(not is_new_mathfont(cur_f)<>0) then
- delta:=0; {no italic correction in mid-word of text font}
- if (math_type(subscr(q))=empty)and(delta<>0) then
- begin link(p):=new_kern(delta); delta:=0;
- end;
-end else if char_exists(cur_i) then
-@z
-
-@x
-@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or
-superscript of noad |q| to the list that starts at |new_hlist(q)|,
-given that subscript and superscript aren't both empty. The superscript
-will appear to the right of the subscript by a given distance |delta|.
-
-We set |shift_down| and |shift_up| to the minimum amounts to shift the
-baseline of subscripts and superscripts based on the given nucleus.
-
-@<Declare math...@>=
-procedure make_scripts(@!q:pointer;@!delta:scaled);
-var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
-@!t:small_number; {subsidiary size code}
-begin p:=new_hlist(q);
-if is_char_node(p) then
- begin shift_up:=0; shift_down:=0;
- end
-else begin z:=hpack(p,natural);
- if cur_style<script_style then t:=script_size@+else t:=script_script_size;
- shift_up:=height(z)-sup_drop(t);
- shift_down:=depth(z)+sub_drop(t);
- free_node(z,box_node_size);
- end;
-if math_type(supscr(q))=empty then
- @<Construct a subscript box |x| when there is no superscript@>
-else begin @<Construct a superscript box |x|@>;
- if math_type(subscr(q))=empty then shift_amount(x):=-shift_up
- else @<Construct a sub/superscript combination box |x|, with the
- superscript offset by |delta|@>;
- end;
-if new_hlist(q)=null then new_hlist(q):=x
-else begin p:=new_hlist(q);
- while link(p)<>null do p:=link(p);
- link(p):=x;
- end;
-end;
-
-@ When there is a subscript without a superscript, the top of the subscript
-should not exceed the baseline plus four-fifths of the x-height.
-
-@<Construct a subscript box |x| when there is no superscript@>=
-begin x:=clean_box(subscr(q),sub_style(cur_style));
-width(x):=width(x)+script_space;
-if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
-clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
-if shift_down<clr then shift_down:=clr;
-shift_amount(x):=shift_down;
-end
-
-@ The bottom of a superscript should never descend below the baseline plus
-one-fourth of the x-height.
-
-@<Construct a superscript box |x|@>=
-begin x:=clean_box(supscr(q),sup_style(cur_style));
-width(x):=width(x)+script_space;
-if odd(cur_style) then clr:=sup3(cur_size)
-else if cur_style<text_style then clr:=sup1(cur_size)
-else clr:=sup2(cur_size);
-if shift_up<clr then shift_up:=clr;
-clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
-if shift_up<clr then shift_up:=clr;
-end
-
-@ When both subscript and superscript are present, the subscript must be
-separated from the superscript by at least four times |default_rule_thickness|.
-If this condition would be violated, the subscript moves down, after which
-both subscript and superscript move up so that the bottom of the superscript
-is at least as high as the baseline plus four-fifths of the x-height.
-
-@<Construct a sub/superscript combination box |x|...@>=
-begin y:=clean_box(subscr(q),sub_style(cur_style));
-width(y):=width(y)+script_space;
-if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
-clr:=4*default_rule_thickness-
- ((shift_up-depth(x))-(height(y)-shift_down));
-if clr>0 then
- begin shift_down:=shift_down+clr;
- clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
- if clr>0 then
- begin shift_up:=shift_up+clr;
- shift_down:=shift_down-clr;
- end;
- end;
-shift_amount(x):=delta; {superscript is |delta| to the right of the subscript}
-p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y;
-x:=vpack(x,natural); shift_amount(x):=shift_down;
-end
-@y
-@ The purpose of |make_scripts(q,delta)| is to attach the subscript and/or
-superscript of noad |q| to the list that starts at |new_hlist(q)|,
-given that subscript and superscript aren't both empty. The superscript
-will appear to the right of the subscript by a given distance |delta|.
-
-We set |shift_down| and |shift_up| to the minimum amounts to shift the
-baseline of subscripts and superscripts based on the given nucleus.
-
-@<Declare math...@>=
-procedure make_scripts(@!q:pointer;@!delta:scaled);
-var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
-@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
-@!t:integer; {subsidiary size code}
-@!save_f:internal_font_number;
-begin p:=new_hlist(q);
-if is_char_node(p) or (p<>null and is_glyph_node(p)) then
- begin shift_up:=0; shift_down:=0;
- end
-else begin z:=hpack(p,natural);
- if cur_style<script_style then t:=script_size@+else t:=script_script_size;
- shift_up:=height(z)-sup_drop(t);
- shift_down:=depth(z)+sub_drop(t);
- free_node(z,box_node_size);
- end;
-if math_type(supscr(q))=empty then
- @<Construct a subscript box |x| when there is no superscript@>
-else begin @<Construct a superscript box |x|@>;
- if math_type(subscr(q))=empty then shift_amount(x):=-shift_up
- else @<Construct a sub/superscript combination box |x|, with the
- superscript offset by |delta|@>;
- end;
-if new_hlist(q)=null then new_hlist(q):=x
-else begin p:=new_hlist(q);
- while link(p)<>null do p:=link(p);
- link(p):=x;
- end;
-end;
-
-@ When there is a subscript without a superscript, the top of the subscript
-should not exceed the baseline plus four-fifths of the x-height.
-
-@<Construct a subscript box |x| when there is no superscript@>=
-begin
-save_f:=cur_f;
-x:=clean_box(subscr(q),sub_style(cur_style));
-cur_f:=save_f;
-width(x):=width(x)+script_space;
-if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
-if is_new_mathfont(cur_f) then
- clr:=height(x)-get_ot_math_constant(cur_f, subscriptTopMax)
-else
- clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
-if shift_down<clr then shift_down:=clr;
-shift_amount(x):=shift_down;
-end
-
-@ The bottom of a superscript should never descend below the baseline plus
-one-fourth of the x-height.
-
-@<Construct a superscript box |x|@>=
-begin
-save_f:=cur_f;
-x:=clean_box(supscr(q),sup_style(cur_style));
-cur_f:=save_f;
-width(x):=width(x)+script_space;
-if odd(cur_style) then clr:=sup3(cur_size)
-else if cur_style<text_style then clr:=sup1(cur_size)
-else clr:=sup2(cur_size);
-if shift_up<clr then shift_up:=clr;
-if is_new_mathfont(cur_f) then
- clr:=depth(x)+get_ot_math_constant(cur_f, superscriptBottomMin)
-else
- clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
-if shift_up<clr then shift_up:=clr;
-end
-
-@ When both subscript and superscript are present, the subscript must be
-separated from the superscript by at least four times |default_rule_thickness|.
-If this condition would be violated, the subscript moves down, after which
-both subscript and superscript move up so that the bottom of the superscript
-is at least as high as the baseline plus four-fifths of the x-height.
-
-@<Construct a sub/superscript combination box |x|...@>=
-begin
-save_f:=cur_f;
-y:=clean_box(subscr(q),sub_style(cur_style));
-cur_f:=save_f;
-width(y):=width(y)+script_space;
-if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
-if is_new_mathfont(cur_f) then
- clr:=get_ot_math_constant(cur_f, subSuperscriptGapMin)-((shift_up-depth(x))-(height(y)-shift_down))
-else
- clr:=4*default_rule_thickness-((shift_up-depth(x))-(height(y)-shift_down));
-if clr>0 then
- begin shift_down:=shift_down+clr;
- if is_new_mathfont(cur_f) then
- clr:=get_ot_math_constant(cur_f, superscriptBottomMaxWithSubscript)-(shift_up-depth(x))
- else
- clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
- if clr>0 then
- begin shift_up:=shift_up+clr;
- shift_down:=shift_down-clr;
- end;
- end;
-shift_amount(x):=delta; {superscript is |delta| to the right of the subscript}
-p:=new_kern((shift_up-depth(x))-(height(y)-shift_down)); link(x):=p; link(p):=y;
-x:=vpack(x,natural); shift_amount(x):=shift_down;
-end
-@z
-
-@x
-magic_offset:=str_start[math_spacing]-9*ord_noad
-@y
-magic_offset:=str_start_macro(math_spacing)-9*ord_noad
-@z
-
-@x
-@* \[37] Alignment.
-@y
-@* \[37] Alignment.
-@z
-
-@x
-@d span_code=256 {distinct from any character}
-@d cr_code=257 {distinct from |span_code| and from any character}
-@y
-@d span_code=special_char {distinct from any character}
-@d cr_code=span_code+1 {distinct from |span_code| and from any character}
-@z
-
-@x
-if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
-@^system dependencies@>
-@:this can't happen 256 spans}{\quad 256 spans@>
-@y
-if n>max_quarterword then confusion("too many spans");
- {this can happen, but won't}
-@^system dependencies@>
-@:this can't happen too many spans}{\quad too many spans@>
-@z
-
-@x
-@* \[38] Breaking paragraphs into lines.
-@y
-@* \[38] Breaking paragraphs into lines.
-@z
-
-@x
-label done,done1,done2,done3,done4,done5,continue;
-@y
-label done,done1,done2,done3,done4,done5,done6,continue, restart;
-@z
-
-@x
- ligature_node: begin f:=font(lig_char(v));@/
-@y
- ligature_node: begin f:=font(lig_char(v));@/
- xtx_ligature_present:=true;
-@z
-
-@x
- othercases confusion("disc1")
-@y
- whatsit_node:
- if (subtype(v)=native_word_node)
- or (subtype(v)=glyph_node)
- or (subtype(v)=pic_node)
- or (subtype(v)=pdf_node)
- then break_width[1]:=break_width[1]-width(v)
- else confusion("disc1a");
- othercases confusion("disc1")
-@z
-
-@x
- ligature_node: begin f:=font(lig_char(s));
-@y
- ligature_node: begin f:=font(lig_char(s));
- xtx_ligature_present:=true;
-@z
-
-@x
- othercases confusion("disc2")
-@y
- whatsit_node:
- if (subtype(s)=native_word_node)
- or (subtype(s)=glyph_node)
- or (subtype(s)=pic_node)
- or (subtype(s)=pdf_node)
- then break_width[1]:=break_width[1]+width(s)
- else confusion("disc2a");
- othercases confusion("disc2")
-@z
-
-@x
-@* \[39] Breaking paragraphs into lines, continued.
-@y
-@* \[39] Breaking paragraphs into lines, continued.
-@z
-
-@x
-ligature_node: begin f:=font(lig_char(cur_p));
-@y
-ligature_node: begin f:=font(lig_char(cur_p));
- xtx_ligature_present:=true;
-@z
-
-@x
- ligature_node: begin f:=font(lig_char(s));
-@y
- ligature_node: begin f:=font(lig_char(s));
- xtx_ligature_present:=true;
-@z
-
-@x
- othercases confusion("disc3")
-@y
- whatsit_node:
- if (subtype(s)=native_word_node)
- or (subtype(s)=glyph_node)
- or (subtype(s)=pic_node)
- or (subtype(s)=pdf_node)
- then disc_width:=disc_width+width(s)
- else confusion("disc3a");
- othercases confusion("disc3")
-@z
-
-@x
- ligature_node: begin f:=font(lig_char(s));
-@y
- ligature_node: begin f:=font(lig_char(s));
- xtx_ligature_present:=true;
-@z
-
-@x
- othercases confusion("disc4")
-@y
- whatsit_node:
- if (subtype(s)=native_word_node)
- or (subtype(s)=glyph_node)
- or (subtype(s)=pic_node)
- or (subtype(s)=pdf_node)
- then act_width:=act_width+width(s)
- else confusion("disc4a");
- othercases confusion("disc4")
-@z
-
-@x
-@* \[40] Pre-hyphenation.
-@y
-@* \[40] Pre-hyphenation.
-@z
-
-@x
-@!hc:array[0..65] of 0..256; {word to be hyphenated}
-@y
-@!hc:array[0..66] of 0..number_usvs; {word to be hyphenated}
-{ note that element 0 needs to be a full UnicodeScalar, even though we
- basically work in utf16 }
-@z
-
-@x
-@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
-@y
-@!hu:array[0..64] of 0..too_big_char;
- {like |hc|, before conversion to lowercase}
-@z
-
-@x
-@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
-@y
-@!cur_lang,@!init_cur_lang:0..biggest_lang;
- {current hyphenation table of interest}
-@z
-
-@x
-@!hyf_bchar:halfword; {boundary character after $c_n$}
-@y
-@!hyf_bchar:halfword; {boundary character after $c_n$}
-@!max_hyph_char:integer;
-
-@ @<Set initial values of key variables@>=
-max_hyph_char:=too_big_lang;
-@z
-
-@x
-@!c:0..255; {character being considered for hyphenation}
-@y
-@!c:UnicodeScalar; {character being considered for hyphenation}
-@z
-
-@x
- @<Skip to node |hb|, putting letters into |hu| and |hc|@>;
-@y
-if is_native_word_node(ha) then begin
- @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>;
- @<Prepare a |native_word_node| for hyphenation@>;
-end else begin
- @<Skip to node |hb|, putting letters into |hu| and |hc|@>;
-end;
-@z
-
-@x
-@ The first thing we need to do is find the node |ha| just before the
-first letter.
-@y
-@ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>=
-s := link(ha);
-loop@+ begin if not(is_char_node(s)) then
- case type(s) of
- ligature_node: do_nothing;
- kern_node: if subtype(s)<>normal then goto done6;
- whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
- goto done6;
- othercases goto done1
- endcases;
- s:=link(s);
- end;
-done6:
-
-@ @<Prepare a |native_word_node| for hyphenation@>=
-{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes }
-hn := 0;
-restart:
-for l := 0 to native_length(ha)-1 do begin
- c := get_native_usv(ha, l);
- set_lc_code(c);
- if (hc[0] = 0) then begin
- if (hn > 0) then begin
- { we've got some letters, and now found a non-letter, so break off the tail of the |native_word|
- and link it after this node, and goto done3 }
- @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
- goto done3;
- end
- end else if (hn = 0) and (l > 0) then begin
- { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart }
- @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
- ha := link(ha);
- goto restart;
- end else if (hn = 63) then
- { reached max hyphenatable length }
- goto done3
- else begin
- { found a letter that is part of a potentially hyphenatable sequence }
- incr(hn);
- if c<@"10000 then begin
- hu[hn] := c; hc[hn] := hc[0];
- end
- else begin
- hu[hn] := (c - @"10000) div @"400 + @"D800;
- hc[hn] := (hc[0] - @"10000) div @"400 + @"D800;
- incr(hn);
- hu[hn] := c mod @"400 + @"DC00;
- hc[hn] := hc[0] mod @"400 + @"DC00;
- incr(l);
- end;
- hyf_bchar := non_char;
- end
-end;
-
-@ @<Split the |native_word_node| at |l| and link the second part after |ha|@>=
- q := new_native_word_node(hf, native_length(ha) - l);
- for i := l to native_length(ha) - 1 do
- set_native_char(q, i - l, get_native_char(ha, i));
- set_native_metrics(q, XeTeX_use_glyph_metrics);
- link(q) := link(ha);
- link(ha) := q;
- { truncate text in node |ha| }
- native_length(ha) := l;
- set_native_metrics(ha, XeTeX_use_glyph_metrics);
-
-@ @<Local variables for line breaking@>=
-l: integer;
-i: integer;
-
-@ The first thing we need to do is find the node |ha| just before the
-first letter.
-@z
-
-@x
- begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
- goto continue;
-@y
- begin
- if subtype(s) = native_word_node then begin
- { we only consider the node if it contains at least one letter, otherwise we'll skip it }
- for l:=0 to native_length(s) - 1 do begin
- c := get_native_usv(s, l);
- if lc_code(c) <> 0 then begin
- hf := native_font(s);
- prev_s := s;
- goto done2;
- end;
- if c>=@"10000 then incr(l);
- end
- end;
- @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
- goto continue
-@z
-
-@x
-if hyf_char>255 then goto done1;
-@y
-if hyf_char>biggest_char then goto done1;
-@z
-
-@x
- if hc[0]=0 then goto done3;
-@y
- if hc[0]=0 then goto done3;
- if hc[0]>max_hyph_char then goto done3;
-@z
-
-@x
- if hc[0]=0 then goto done3;
-@y
- if hc[0]=0 then goto done3;
- if hc[0]>max_hyph_char then goto done3;
-@z
-
-@x
-@* \[41] Post-hyphenation.
-@y
-@* \[41] Post-hyphenation.
-@z
-
-@x
-@<Replace nodes |ha..hb| by a sequence of nodes...@>=
-@y
-@<Replace nodes |ha..hb| by a sequence of nodes...@>=
-if is_native_word_node(ha) then begin
- @<Hyphenate the |native_word_node| at |ha|@>;
-end else begin
-@z
-
-@x
- begin hu[0]:=256; init_lig:=false;
-@y
- begin hu[0]:=max_hyph_char; init_lig:=false;
-@z
-
-@x
-found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
-@y
-found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
-@z
-
-@x
-flush_list(init_list)
-@y
-flush_list(init_list);
-end
-
-@ @<Hyphenate the |native_word_node| at |ha|@>=
-{ find the node immediately before the word to be hyphenated }
-s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
-while link(s) <> ha do s := link(s);
-
-{ for each hyphen position,
- create a |native_word_node| fragment for the text before this point,
- and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text
-}
-
-hyphen_passed := 0; { location of last hyphen we saw }
-
-for j := l_hyf to hn - r_hyf do begin
- { if this is a valid break.... }
- if odd(hyf[j]) then begin
-
- { make a |native_word_node| for the fragment before the hyphen }
- q := new_native_word_node(hf, j - hyphen_passed);
- for i := 0 to j - hyphen_passed - 1 do
- set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
- set_native_metrics(q, XeTeX_use_glyph_metrics);
- link(s) := q; { append the new node }
- s := q;
-
- { make the |disc_node| for the hyphenation point }
- q := new_disc;
- pre_break(q) := new_native_character(hf, hyf_char);
- link(s) := q;
- s := q;
-
- hyphen_passed := j;
- end
-end;
-
-{ make a |native_word_node| for the last fragment of the word }
-hn := native_length(ha); { ensure trailing punctuation is not lost! }
-q := new_native_word_node(hf, hn - hyphen_passed);
-for i := 0 to hn - hyphen_passed - 1 do
- set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
-set_native_metrics(q, XeTeX_use_glyph_metrics);
-link(s) := q; { append the new node }
-s := q;
-
-q := link(ha);
-link(s) := q;
-link(ha) := null;
-flush_node_list(ha);
-@z
-
-@x
-@!c:ASCII_code; {character temporarily replaced by a hyphen}
-@y
-@!c:UnicodeScalar; {character temporarily replaced by a hyphen}
-@z
-
-@x
- begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
-@y
- begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
@z
@x
@@ -2583,52 +845,21 @@ flush_node_list(ha);
@* \[42] Hyphenation.
@z
-@x
-@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
-@y
-@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language}
-@z
-
-@x
-hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
-@y
-hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
-@z
-
+% Conflict with ../tex.ch
@x
begin j:=1; u:=str_start[k];
@y
begin j:=1; u:=str_start_macro(k);
@z
-@x
- else if language>255 then cur_lang:=0
-@y
- else if language>biggest_lang then cur_lang:=0
-@z
-
-@x
- else if n<63 then
- begin incr(n); hc[n]:=hc[0];
- end;
-@y
- else if n<63 then
- begin incr(n);
- if hc[0]<@"10000 then hc[n]:=hc[0]
- else begin
- hc[n] := (hc[0] - @"10000) div @"400 + @"D800;
- incr(n);
- hc[n] := hc[0] mod @"400 + @"DC00;
- end;
- end;
-@z
-
+% Conflict with ../tex.ch
@x
u:=str_start[k]; v:=str_start[s];
@y
u:=str_start_macro(k); v:=str_start_macro(s);
@z
+% Conflict with ../tex.ch
@x
until u=str_start[k+1];
@y
@@ -2641,79 +872,28 @@ until u=str_start_macro(k+1);
@* \[43] Initializing the hyphenation tables.
@z
+% Conflict with ../tex.ch
@x
@!trie_used:array[ASCII_code] of trie_opcode;
@y
@!trie_used:array[0..biggest_lang] of trie_opcode;
@z
+% Conflict with ../tex.ch
@x
@!trie_op_lang:array[1..trie_op_size] of ASCII_code;
@y
@!trie_op_lang:array[1..trie_op_size] of 0..biggest_lang;
@z
-@x
-for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
-@y
-for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
-@z
-
+% Conflict with ../tex.ch
@x
for k:=0 to 255 do trie_used[k]:=min_trie_op;
@y
for k:=0 to biggest_lang do trie_used[k]:=min_trie_op;
@z
-@x
-for p:=0 to 255 do trie_min[p]:=p+1;
-@y
-for p:=0 to biggest_char do trie_min[p]:=p+1;
-@z
-
-@x
-@!ll:1..256; {upper limit of |trie_min| updating}
-@y
-@!ll:1..too_big_char; {upper limit of |trie_min| updating}
-@z
-
-@x
- @<Ensure that |trie_max>=h+256|@>;
-@y
- @<Ensure that |trie_max>=h+max_hyph_char|@>;
-@z
-
-@x
-@ By making sure that |trie_max| is at least |h+256|, we can be sure that
-@y
-@ By making sure that |trie_max| is at least |h+max_hyph_char|,
-we can be sure that
-@z
-
-@x
-@<Ensure that |trie_max>=h+256|@>=
-if trie_max<h+256 then
- begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
-@y
-@<Ensure that |trie_max>=h+max_hyph_char|@>=
-if trie_max<h+max_hyph_char then
- begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
-@z
-
-@x
- until trie_max=h+256;
-@y
- until trie_max=h+max_hyph_char;
-@z
-
-@x
-if l<256 then
- begin if z<256 then ll:=z @+else ll:=256;
-@y
-if l<max_hyph_char then
- begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
-@z
-
+% Conflict with ../tex.ch
@x
begin for r:=0 to 256 do clear_trie;
trie_max:=256;
@@ -2723,506 +903,12 @@ if l<max_hyph_char then
@z
@x
- if k<63 then
-@y
- if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
- if k<63 then
-@z
-
-@x
-begin @<Get ready to compress the trie@>;
-@y
-begin
-incr(max_hyph_char);
-@<Get ready to compress the trie@>;
-@z
-
-@x
-@* \[44] Breaking vertical lists into pages.
-@y
-@* \[44] Breaking vertical lists into pages.
-@z
-
-@x
-@* \[45] The page builder.
-@y
-@* \[45] The page builder.
-@z
-
-@x
-@!n:min_quarterword..255; {insertion box number}
-@y
-@!n:min_quarterword..biggest_reg; {insertion box number}
-@z
-
-@x
-@!n:min_quarterword..255; {insertion box number}
-@y
-@!n:min_quarterword..biggest_reg; {insertion box number}
-@z
-
-@x
@* \[46] The chief executive.
@y
@* \[46] The chief executive.
@z
-@x
-@d main_loop=70 {go here to typeset a string of consecutive characters}
-@y
-@d main_loop=70 {go here to typeset a string of consecutive characters}
-@d collect_native=71 {go here to collect characters in a "native" font string}
-@d collected=72
-@z
-
-@x
- append_normal_space,exit;
-@y
- collect_native,collected,
- append_normal_space,exit;
-@z
-
-@x
-hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
-@y
-hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end;
-@z
-
-@x
-hmode+spacer: if space_factor=1000 then goto append_normal_space
- else app_space;
-hmode+ex_space,mmode+ex_space: goto append_normal_space;
-@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
-end; {of the big |case| statement}
-@y
-othercases begin
- if abs(mode)=hmode then check_for_post_char_toks(big_switch);
- case abs(mode)+cur_cmd of
- hmode+spacer: if space_factor=1000 then goto append_normal_space
- else app_space;
- hmode+ex_space,mmode+ex_space: goto append_normal_space;
- @t\4@>@<Cases of |main_control| that are not part of the inner loop@>
- end
- end
-endcases; {of the big |case| statement}
-@z
-
-@x
-append_normal_space:@<Append a normal inter-word space to the current list,
-@y
-append_normal_space:check_for_post_char_toks(big_switch);
-@<Append a normal inter-word space to the current list,
-@z
-
-@x
-@!main_p:pointer; {temporary register for list manipulation}
-@y
-@!main_p:pointer; {temporary register for list manipulation}
-@!main_pp,@!main_ppp:pointer; {more temporary registers for list manipulation}
-@!main_h:pointer; {temp for hyphen offset in native-font text}
-@!is_hyph:boolean; {whether the last char seen is the font's hyphenchar}
-@!space_class:integer;
-@!prev_class:integer;
-@z
-
-@x
-@d adjust_space_factor==@t@>@;@/
- main_s:=sf_code(cur_chr);
-@y
-@d adjust_space_factor==@t@>@;@/
- main_s:=sf_code(cur_chr) mod @"10000;
-@z
-
-@x
-@<Append character |cur_chr|...@>=
-if ((head=tail) and (mode>0)) then begin
- if (insert_src_special_auto) then append_src_special;
-end;
-adjust_space_factor;@/
-@y
-@d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found,
- or |big_switch| in case of the initial letter of a run}
- cur_ptr:=null;
- space_class:=sf_code(cur_chr) div @"10000;
-
- if XeTeX_inter_char_tokens_en and space_class <> 256 then begin {class 256 = ignored (for combining marks etc)}
- if prev_class = 255 then begin {boundary}
- if (state<>token_list) or (token_type<>backed_up_char) then begin
- find_sa_element(inter_char_val, 255*@"100 + space_class, false);
- if cur_ptr<>null then begin
- if cur_cmd<>letter then cur_cmd:=other_char;
- cur_tok:=(cur_cmd*max_char_val)+cur_chr;
- back_input; token_type:=backed_up_char;
- begin_token_list(sa_ptr(cur_ptr), inter_char_text);
- goto big_switch;
- end
- end
- end else begin
- find_sa_element(inter_char_val, prev_class*@"100 + space_class, false);
- if cur_ptr<>null then begin
- if cur_cmd<>letter then cur_cmd:=other_char;
- cur_tok:=(cur_cmd*max_char_val)+cur_chr;
- back_input; token_type:=backed_up_char;
- begin_token_list(sa_ptr(cur_ptr), inter_char_text);
- prev_class:=255;
- goto #;
- end;
- end;
- prev_class:=space_class;
- end
-
-@d check_for_post_char_toks(#)==
- if XeTeX_inter_char_tokens_en and (space_class<>256) and (prev_class<>255) then begin
- prev_class:=255;
- find_sa_element(inter_char_val, space_class*@"100 + 255, false); {boundary}
- if cur_ptr<>null then begin
- if cur_cs=0 then begin
- if cur_cmd=char_num then cur_cmd:=other_char;
- cur_tok:=(cur_cmd*max_char_val)+cur_chr;
- end else cur_tok:=cs_token_flag+cur_cs;
- back_input;
- begin_token_list(sa_ptr(cur_ptr), inter_char_text);
- goto #;
- end;
- end
-
-@<Append character |cur_chr|...@>=
-if ((head=tail) and (mode>0)) then begin
- if (insert_src_special_auto) then append_src_special;
-end;
-
-prev_class := 255; {boundary}
-
-{ added code for native font support }
-if is_native_font(cur_font) then begin
- if mode>0 then if language<>clang then fix_language;
-
- main_h := 0;
- main_f := cur_font;
- native_len := 0;
-
-collect_native:
- adjust_space_factor;
-
- check_for_inter_char_toks(collected);
-
- if (cur_chr > @"FFFF) then begin
- native_room(2);
- append_native((cur_chr - @"10000) div 1024 + @"D800);
- append_native((cur_chr - @"10000) mod 1024 + @"DC00);
- end else begin
- native_room(1);
- append_native(cur_chr);
- end;
- is_hyph := (cur_chr = hyphen_char[main_f])
- or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013)));
- if (main_h = 0) and is_hyph then main_h := native_len;
-
- {try to collect as many chars as possible in the same font}
- get_next;
- if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
- x_token;
- if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
- if cur_cmd=char_num then begin
- scan_usv_num;
- cur_chr:=cur_val;
- goto collect_native;
- end;
-
- check_for_post_char_toks(collected);
-
-collected:
- if (font_mapping[main_f] <> 0) then begin
- main_k := apply_mapping(font_mapping[main_f], native_text, native_len);
- native_len := 0;
- native_room(main_k);
- main_h := 0;
- for main_p := 0 to main_k - 1 do begin
- append_native(mapped_text[main_p]);
- if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f])
- or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) )
- then main_h := native_len;
- end
- end;
-
- if tracing_lost_chars > 0 then begin
- temp_ptr := 0;
- while (temp_ptr < native_len) do begin
- main_k := native_text[temp_ptr];
- incr(temp_ptr);
- if (main_k >= @"D800) and (main_k < @"DC00) then begin
- main_k := @"10000 + (main_k - @"D800) * 1024;
- main_k := main_k + native_text[temp_ptr] - @"DC00;
- incr(temp_ptr);
- end;
- if map_char_to_glyph(main_f, main_k) = 0 then
- char_warning(main_f, main_k);
- end
- end;
-
- main_k := native_len;
- main_pp := tail;
-
- if mode=hmode then begin
-
- main_ppp := head;
- if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries }
- while (link(main_ppp)<>main_pp) do begin
- if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin
- temp_ptr:=main_ppp;
- for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
- end;
- if main_ppp<>main_pp then main_ppp:=link(main_ppp);
- end;
-
- temp_ptr := 0;
- repeat
- if main_h = 0 then main_h := main_k;
-
- if is_native_word_node(main_pp)
- and (native_font(main_pp)=main_f)
- and (main_ppp<>main_pp)
- and (not is_char_node(main_ppp))
- and (type(main_ppp)<>disc_node)
- then begin
-
- { make a new temp string that contains the concatenated text of |tail| + the current word/fragment }
- main_k := main_h + native_length(main_pp);
- native_room(main_k);
-
- save_native_len := native_len;
- for main_p := 0 to native_length(main_pp) - 1 do
- append_native(get_native_char(main_pp, main_p));
- for main_p := 0 to main_h - 1 do
- append_native(native_text[temp_ptr + main_p]);
-
- do_locale_linebreaks(save_native_len, main_k);
-
- native_len := save_native_len; { discard the temp string }
- main_k := native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word }
- temp_ptr := main_h; { pointer to remaining fragment }
-
- main_h := 0;
- while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
- and ( (not XeTeX_dash_break_en)
- or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
- do incr(main_h); { look for next hyphen or end of text }
- if (main_h < main_k) then incr(main_h);
-
- { remove the preceding node from the list }
- link(main_ppp) := link(main_pp);
- link(main_pp) := null;
- flush_node_list(main_pp);
- main_pp := tail;
- while (link(main_ppp)<>main_pp) do
- main_ppp:=link(main_ppp);
-
- end else begin
-
- do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word }
-
- temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment }
- main_k := main_k - main_h; { decrement remaining length }
-
- main_h := 0;
- while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
- and ( (not XeTeX_dash_break_en)
- or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
- do incr(main_h); { look for next hyphen or end of text }
- if (main_h < main_k) then incr(main_h);
-
- end;
-
- if (main_k > 0) or is_hyph then begin
- tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen),
- or if last char in original text was a hyphen }
- main_pp:=tail;
- end;
- until main_k = 0;
-
- end else begin
- { must be restricted hmode, so no need for line-breaking or discretionaries }
- { but there might already be explicit |disc_node|s in the list }
- main_ppp := head;
- if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries }
- while (link(main_ppp)<>main_pp) do begin
- if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin
- temp_ptr:=main_ppp;
- for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
- end;
- if main_ppp<>main_pp then main_ppp:=link(main_ppp);
- end;
- if is_native_word_node(main_pp)
- and (native_font(main_pp)=main_f)
- and (main_ppp<>main_pp)
- and (not is_char_node(main_ppp))
- and (type(main_ppp)<>disc_node)
- then begin
- { total string length for the new merged whatsit }
- link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp));
- tail := link(main_pp);
-
- { copy text from the old one into the new }
- for main_p := 0 to native_length(main_pp) - 1 do
- set_native_char(tail, main_p, get_native_char(main_pp, main_p));
- { append the new text }
- for main_p := 0 to main_k - 1 do
- set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]);
- set_native_metrics(tail, XeTeX_use_glyph_metrics);
-
- { remove the preceding node from the list }
- main_p := head;
- if main_p<>main_pp then
- while link(main_p)<>main_pp do
- main_p := link(main_p);
- link(main_p) := link(main_pp);
- link(main_pp) := null;
- flush_node_list(main_pp);
- end else begin
- { package the current string into a |native_word| whatsit }
- link(main_pp) := new_native_word_node(main_f, main_k);
- tail := link(main_pp);
- for main_p := 0 to main_k - 1 do
- set_native_char(tail, main_p, native_text[main_p]);
- set_native_metrics(tail, XeTeX_use_glyph_metrics);
- end
- end;
-
- if cur_ptr<>null then goto big_switch
- else goto reswitch;
-end;
-{ End of added code for native fonts }
-
-adjust_space_factor;@/
-check_for_inter_char_toks(big_switch);
-@z
-
-@x
-main_loop_lookahead+1: adjust_space_factor;
-@y
-main_loop_lookahead+1: adjust_space_factor;
-check_for_inter_char_toks(big_switch);
-@z
-
-@x
-non_math(math_given), non_math(math_comp), non_math(delim_num),
-@y
-non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num),
-@z
-
-@x
-begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
-if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
-else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
- if c=vtop_code then @<Readjust the height and depth of |cur_box|,
- for \.{\\vtop}@>;
- end;
-pop_nest; box_end(saved(0));
-@y
-@!u,v:integer; {saved values for upwards mode flag}
-begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3;
-v:=XeTeX_upwards_state; XeTeX_upwards_state:=u;
-if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
-else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
- if c=vtop_code then @<Readjust the height and depth of |cur_box|,
- for \.{\\vtop}@>;
- end;
-XeTeX_upwards_state:=v;
-pop_nest; box_end(saved(0));
-@z
-
-@x
-procedure append_italic_correction;
-label exit;
-var p:pointer; {|char_node| at the tail of the current list}
-@!f:internal_font_number; {the font in the |char_node|}
-begin if tail<>head then
- begin if is_char_node(tail) then p:=tail
- else if type(tail)=ligature_node then p:=lig_char(tail)
- else return;
-@y
-procedure append_italic_correction;
-label exit;
-var p:pointer; {|char_node| at the tail of the current list}
-@!f:internal_font_number; {the font in the |char_node|}
-begin if tail<>head then
- begin if is_char_node(tail) then p:=tail
- else if type(tail)=ligature_node then p:=lig_char(tail)
- else if (type(tail)=whatsit_node) then begin
- if (subtype(tail)=native_word_node) then begin
- tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit;
- end
- else if (subtype(tail)=glyph_node) then begin
- tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit;
- end;
- return;
- end
- else return;
-@z
-
-@x
- if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
-@y
- if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c);
-@z
-
-@x
- if type(p)<>kern_node then if type(p)<>ligature_node then
- begin print_err("Improper discretionary list");
-@y
- if type(p)<>kern_node then if type(p)<>ligature_node then
- if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node)
- and (subtype(p)<>glyph_node)) then
- begin print_err("Improper discretionary list");
-@z
-
-@x
-@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
-@y
-@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above}
-@z
-
-@x
- a:=char_width(f)(char_info(f)(character(p)));@/
-@y
- if is_native_font(f) then
- begin a:=width(p);
- if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb))
- end
- else a:=char_width(f)(char_info(f)(character(p)));@/
-@z
-
-@x
-if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
- q:=new_character(f,cur_chr)
-@y
-if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
- begin q:=new_character(f,cur_chr); cur_val:=cur_chr
- end
-@z
-
-@x
-i:=char_info(f)(character(q));
-w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
-@y
-if is_native_font(f) then begin
- w:=width(q);
- get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta))
- {using delta as scratch space for the unneeded depth value}
-end else begin
- i:=char_info(f)(character(q));
- w:=char_width(f)(i); h:=char_height(f)(height_depth(i))
-end;
-@z
-
-@x
-delta:=round((w-a)/float_constant(2)+h*t-x*s);
-@y
-if is_native_font(f) and (a=0) then { special case for non-spacing marks }
- delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s)
-else delta:=round((w-a)/float_constant(2)+h*t-x*s);
-@z
-
+% Revert ../tex.ch
@x
procedure cs_error;
begin
@@ -3236,288 +922,11 @@ end else begin
@.Extra \\endcsname@>
help1("I'm ignoring this, since I wasn't doing a \csname.");
end;
-error;
-end;
@y
procedure cs_error;
begin print_err("Extra "); print_esc("endcsname");
@.Extra \\endcsname@>
help1("I'm ignoring this, since I wasn't doing a \csname.");
-error;
-end;
-@z
-
-@x
-whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
-@y
-whatsit_node: @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>;
-@z
-
-@x
-@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
-@y
-@d fam_in_range==((cur_fam>=0)and(cur_fam<number_math_families))
-@z
-
-@x
-letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
- if c=@'100000 then
-@y
-letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
- if is_active_math_char(c) then
-@z
-
-@x
-math_char_num: begin scan_fifteen_bit_int; c:=cur_val;
- end;
-@y
-math_char_num:
- if cur_chr = 2 then begin { XeTeXmathchar }
- scan_math_class_int; c := set_class_field(cur_val);
- scan_math_fam_int; c := c + set_family_field(cur_val);
- scan_usv_num; c := c + cur_val;
- end else if cur_chr = 1 then begin { XeTeXmathcharnum }
- scan_xetex_math_char_int; c := cur_val;
- end else begin scan_fifteen_bit_int;
- c := set_class_field(cur_val div @"1000) +
- set_family_field((cur_val mod @"1000) div @"100) +
- (cur_val mod @"100);
- end;
-@z
-
-@x
-math_given: c:=cur_chr;
-delim_num: begin scan_twenty_seven_bit_int; c:=cur_val div @'10000;
-@y
-math_given: begin
- c := set_class_field(cur_chr div @"1000) +
- set_family_field((cur_chr mod @"1000) div @"100) +
- (cur_chr mod @"100);
- end;
-XeTeX_math_given: c:=cur_chr;
-delim_num: begin
- if cur_chr=1 then begin {XeTeXdelimiter <cls> <fam> <usv>}
- scan_math_class_int; c := set_class_field(cur_val);
- scan_math_fam_int; c := c + set_family_field(cur_val);
- scan_usv_num; c := c + cur_val;
- end else begin {delimiter <27-bit delcode>}
- scan_delimiter_int;
- c := cur_val div @'10000; {get the 'small' delimiter field}
- c := set_class_field(c div @"1000) +
- set_family_field((c mod @"1000) div @"100) +
- (c mod @"100); {and convert it to a xetex mathchar code}
- end;
-@z
-
-@x
-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;
-@y
-math_type(p):=math_char; character(p):=qi(c mod @"10000);
-if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam
-else plane_and_fam_field(p):=(math_fam_field(c));
-plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100;
-@z
-
-@x
-mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
- end;
-@y
-mmode+math_char_num: if cur_chr = 2 then begin { XeTeXmathchar }
- scan_math_class_int; t := set_class_field(cur_val);
- scan_math_fam_int; t := t + set_family_field(cur_val);
- scan_usv_num; t := t + cur_val;
- set_math_char(t);
- end else if cur_chr = 1 then begin { XeTeXmathcharnum }
- scan_xetex_math_char_int; set_math_char(cur_val);
- end else begin scan_fifteen_bit_int;
- set_math_char(set_class_field(cur_val div @"1000) +
- set_family_field((cur_val mod @"1000) div @"100) +
- (cur_val mod @"100));
- end;
-@z
-
-@x
-mmode+math_given: set_math_char(cur_chr);
-mmode+delim_num: begin scan_twenty_seven_bit_int;
- set_math_char(cur_val div @'10000);
-@y
-mmode+math_given: begin
- set_math_char(set_class_field(cur_chr div @"1000) +
- set_family_field((cur_chr mod @"1000) div @"100) +
- (cur_chr mod @"100));
- end;
-mmode+XeTeX_math_given: set_math_char(cur_chr);
-mmode+delim_num: begin
- if cur_chr=1 then begin {XeTeXdelimiter}
- scan_math_class_int; t := set_class_field(cur_val);
- scan_math_fam_int; t := t + set_family_field(cur_val);
- scan_usv_num; t := t + cur_val;
- set_math_char(t);
- end else begin
- scan_delimiter_int;
- cur_val:=cur_val div @'10000; {discard the large delimiter code}
- set_math_char(set_class_field(cur_val div @"1000) +
- set_family_field((cur_val mod @"1000) div @"100) +
- (cur_val mod @"100));
- end;
-@z
-
-@x
-procedure set_math_char(@!c:integer);
-var p:pointer; {the new noad}
-begin if c>=@'100000 then
- @<Treat |cur_chr|...@>
-else begin p:=new_noad; math_type(nucleus(p)):=math_char;
- character(nucleus(p)):=qi(c mod 256);
- fam(nucleus(p)):=(c div 256) mod 16;
- if c>=var_code then
- begin if fam_in_range then fam(nucleus(p)):=cur_fam;
- type(p):=ord_noad;
- end
- else type(p):=ord_noad+(c div @'10000);
-@y
-procedure set_math_char(@!c:integer);
-var p,q,r:pointer; {the new noad}
- ch: UnicodeScalar;
-begin if is_active_math_char(c) then
- @<Treat |cur_chr|...@>
-else begin p:=new_noad; math_type(nucleus(p)):=math_char;
- ch:=math_char_field(c);
- character(nucleus(p)):=qi(ch mod @"10000);
- plane_and_fam_field(nucleus(p)):=math_fam_field(c);
- if is_var_family(c) then
- begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam;
- type(p):=ord_noad;
- end
- else type(p):=ord_noad+math_class_field(c);
- plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100;
-@z
-
-@x
-procedure scan_delimiter(@!p:pointer;@!r:boolean);
-begin if r then scan_twenty_seven_bit_int
-@y
-procedure scan_delimiter(@!p:pointer;@!r:boolean);
-begin
- if r then begin
- if cur_chr=1 then begin {XeTeXradical}
- cur_val1 := @"40000000; {extended delcode flag}
- scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
- scan_usv_num; cur_val := cur_val1 + cur_val;
- end else {radical}
- scan_delimiter_int;
- end
-@z
-
-@x
- letter,other_char: cur_val:=del_code(cur_chr);
- delim_num: scan_twenty_seven_bit_int;
- othercases cur_val:=-1
-@y
- letter,other_char: begin
- cur_val:=del_code(cur_chr);
- end;
- delim_num: if cur_chr=1 then begin {XeTeXdelimiter}
- cur_val1 := @"40000000; {extended delcode flag}
- scan_math_class_int; {discarded}
- scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
- scan_usv_num; cur_val := cur_val1 + cur_val;
- end else scan_delimiter_int; {normal delimiter}
- othercases begin cur_val:=-1; end;
-@z
-
-@x
-if cur_val<0 then @<Report that an invalid delimiter code is being changed
- to null; set~|cur_val:=0|@>;
-small_fam(p):=(cur_val div @'4000000) mod 16;
-small_char(p):=qi((cur_val div @'10000) mod 256);
-large_fam(p):=(cur_val div 256) mod 16;
-large_char(p):=qi(cur_val mod 256);
-@y
-if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
- to null; set~|cur_val:=0|@>;
- end;
-if cur_val>=@"40000000 then begin {extended delcode, only one size}
- small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane}
- + (cur_val div @"200000) mod @"100; {family}
- small_char_field(p) := qi(cur_val mod @"10000);
- large_plane_and_fam_field(p) := 0;
- large_char_field(p) := 0;
-end else begin {standard delcode, 4-bit families and 8-bit char codes}
- small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16;
- small_char_field(p) := qi((cur_val div @'10000) mod 256);
- large_plane_and_fam_field(p) := (cur_val div 256) mod 16;
- large_char_field(p) := qi(cur_val mod 256);
-end;
-@z
-
-@x
-procedure math_ac;
-@y
-procedure math_ac;
-var c: integer;
-@z
-
-@x
-scan_fifteen_bit_int;
-character(accent_chr(tail)):=qi(cur_val mod 256);
-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;
-@y
-if cur_chr=1 then begin
- if scan_keyword("fixed") then
- subtype(tail):=fixed_acc
- else if scan_keyword("bottom") then begin
- if scan_keyword("fixed") then
- subtype(tail):=bottom_acc+fixed_acc
- else
- subtype(tail):=bottom_acc;
- end;
- scan_math_class_int; c := set_class_field(cur_val);
- scan_math_fam_int; c := c + set_family_field(cur_val);
- scan_usv_num; cur_val := cur_val + c;
-end
-else begin
- scan_fifteen_bit_int;
- cur_val := set_class_field(cur_val div @"1000) +
- set_family_field((cur_val mod @"1000) div @"100) +
- (cur_val mod @"100);
-end;
-character(accent_chr(tail)):=qi(cur_val mod @"10000);
-if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam
-else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val);
-plane_and_fam_field(accent_chr(tail))
- := plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100;
-@z
-
-@x
-@ @<Check that the necessary fonts...@>=
-if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
-@y
-@ @<Check that the necessary fonts...@>=
-if ((font_params[fam_fnt(2+text_size)]<total_mathsy_params)
- and (not is_new_mathfont(fam_fnt(2+text_size)))) or@|
- ((font_params[fam_fnt(2+script_size)]<total_mathsy_params)
- and (not is_new_mathfont(fam_fnt(2+script_size)))) or@|
- ((font_params[fam_fnt(2+script_script_size)]<total_mathsy_params)
- and (not is_new_mathfont(fam_fnt(2+script_script_size)))) then
-@z
-
-@x
-else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
-@y
-else if ((font_params[fam_fnt(3+text_size)]<total_mathex_params)
- and (not is_new_mathfont(fam_fnt(3+text_size)))) or@|
- ((font_params[fam_fnt(3+script_size)]<total_mathex_params)
- and (not is_new_mathfont(fam_fnt(3+script_size)))) or@|
- ((font_params[fam_fnt(3+script_script_size)]<total_mathex_params)
- and (not is_new_mathfont(fam_fnt(3+script_script_size)))) then
@z
@x
@@ -3526,243 +935,14 @@ else if ((font_params[fam_fnt(3+text_size)]<total_mathex_params)
@* \[49] Mode-independent processing.
@z
-@x
-any_mode(def_code),
-@y
-any_mode(def_code),
-any_mode(XeTeX_def_code),
-@z
-
-@x
-@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
-@y
-@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
-@d word_define1(#)==if global then geq_word_define1(#)@+else eq_word_define1(#)
-@z
-
-@x
-@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
-@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
-@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
-@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
-@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
-@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
-@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
-@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}}
-@y
-@d char_def_code=0 {|shorthand_def| for \.{\\chardef}}
-@d math_char_def_code=1 {|shorthand_def| for \.{\\mathchardef}}
-@d count_def_code=2 {|shorthand_def| for \.{\\countdef}}
-@d dimen_def_code=3 {|shorthand_def| for \.{\\dimendef}}
-@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
-@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
-@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
-@d char_sub_def_code=7 {|shorthand_def| for \.{\\charsubdef}}
-@d XeTeX_math_char_num_def_code=8
-@d XeTeX_math_char_def_code=9
-@z
-
-@x
-primitive("mathchardef",shorthand_def,math_char_def_code);@/
-@!@:math_char_def_}{\.{\\mathchardef} primitive@>
-@y
-primitive("mathchardef",shorthand_def,math_char_def_code);@/
-primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/
-primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/
-@!@:math_char_def_}{\.{\\mathchardef} primitive@>
-@z
-
-@x
- math_char_def_code: print_esc("mathchardef");
-@y
- math_char_def_code: print_esc("mathchardef");
- XeTeX_math_char_def_code: print_esc("XeTeXmathchardef");
- XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef");
-@z
-
-@x
-math_given: begin print_esc("mathchar"); print_hex(chr_code);
- end;
-@y
-math_given: begin print_esc("mathchar"); print_hex(chr_code);
- end;
-XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code);
- end;
-@z
-
+% Conflict with ../tex.ch
@x
else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
@y
else begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,too_big_usv);
@z
-@x
- char_def_code: begin scan_char_num; define(p,char_given,cur_val);
-@y
- char_def_code: begin scan_usv_num; define(p,char_given,cur_val);
-@z
-
-@x
- math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
- end;
-@y
- math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
- end;
- XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int;
- define(p, XeTeX_math_given, cur_val);
- end;
- XeTeX_math_char_def_code: begin
- scan_math_class_int; n := set_class_field(cur_val);
- scan_math_fam_int; n := n + set_family_field(cur_val);
- scan_usv_num; n := n + cur_val;
- define(p, XeTeX_math_given, n);
- end;
-@z
-
-@x
- else e:=true;
-@y
- else e:=true
- else if cur_chr=XeTeX_inter_char_loc then begin
- scan_eight_bit_int; cur_ptr:=cur_val;
- scan_eight_bit_int;
- find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, true);
- cur_chr:=cur_ptr; e:=true;
- end;
-@z
-
-@x
- else q:=equiv(cur_chr);
-@y
- else if cur_chr=XeTeX_inter_char_loc then begin
- scan_eight_bit_int; cur_ptr:=cur_val;
- scan_eight_bit_int;
- find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, false);
- if cur_ptr=null then q:=null
- else q:=sa_ptr(cur_ptr);
- end else q:=equiv(cur_chr);
-@z
-
-@x
-primitive("mathcode",def_code,math_code_base);
-@y
-primitive("mathcode",def_code,math_code_base);
-primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base);
-primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1);
-@z
-
-@x
-primitive("sfcode",def_code,sf_code_base);
-@!@:sf_code_}{\.{\\sfcode} primitive@>
-primitive("delcode",def_code,del_code_base);
-@y
-primitive("sfcode",def_code,sf_code_base);
-@!@:sf_code_}{\.{\\sfcode} primitive@>
-primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base);
-primitive("delcode",def_code,del_code_base);
-primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base);
-primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1);
-@z
-
-@x
-def_family: print_size(chr_code-math_font_base);
-@y
-XeTeX_def_code:
- if chr_code=sf_code_base then print_esc("XeTeXcharclass")
- else if chr_code=math_code_base then print_esc("XeTeXmathcodenum")
- else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode")
- else if chr_code=del_code_base then print_esc("XeTeXdelcodenum")
- else print_esc("XeTeXdelcode");
-def_family: print_size(chr_code-math_font_base);
-@z
-
-@x
-def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
- p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
-@y
-XeTeX_def_code: begin
- if cur_chr = sf_code_base then begin
- p:=cur_chr; scan_usv_num;
- p:=p+cur_val;
- n:=sf_code(cur_val) mod @"10000;
- scan_optional_equals;
- scan_char_class;
- define(p,data,cur_val*@"10000 + n);
- end
- else if cur_chr = math_code_base then begin
- p:=cur_chr; scan_usv_num;
- p:=p+cur_val;
- scan_optional_equals;
- scan_xetex_math_char_int;
- define(p,data,hi(cur_val));
- end
- else if cur_chr = math_code_base+1 then begin
- p:=cur_chr-1; scan_usv_num;
- p:=p+cur_val;
- scan_optional_equals;
- scan_math_class_int; n := set_class_field(cur_val);
- scan_math_fam_int; n := n + set_family_field(cur_val);
- scan_usv_num; n := n + cur_val;
- define(p,data,hi(n));
- end
- else if cur_chr = del_code_base then begin
- p:=cur_chr; scan_usv_num;
- p:=p+cur_val;
- scan_optional_equals;
- scan_int; {|scan_xetex_del_code_int|; !!FIXME!!}
- word_define(p,hi(cur_val));
- end else begin
-{
-bit usage in delcode values:
-original layout: @@"00cffCFF small/LARGE family \& char
-extended: @@"40000000 FLAG
- + ff << 21 (mult by @@"200000) FAMILY
- + 1ccccc (21 bits) USV
-}
- p:=cur_chr-1; scan_usv_num;
- p:=p+cur_val;
- scan_optional_equals;
- n := @"40000000; {extended delcode flag}
- scan_math_fam_int; n := n + cur_val * @"200000;
- scan_usv_num; n := n + cur_val;
- word_define(p,hi(n));
- end;
- end;
-def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
- p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals;
-@z
-
-@x
- if p<math_code_base then define(p,data,cur_val)
- else if p<del_code_base then define(p,data,hi(cur_val))
-@y
- if p<math_code_base then begin
- if p>=sf_code_base then begin
- n:=equiv(p) div @"10000;
- define(p,data,n*@"10000 + cur_val);
- end else
- define(p,data,cur_val)
- end else if p<del_code_base then begin
- if cur_val=@"8000 then cur_val:=active_math_char
- else cur_val:=set_class_field(cur_val div @"1000) +
- set_family_field((cur_val mod @"1000) div @"100) +
- (cur_val mod @"100); {!!FIXME!! check how this is used}
- define(p,data,hi(cur_val));
- end
-@z
-
-@x
-else n:=255
-@y
-else n:=biggest_usv
-@z
-
-@x
-def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
-@y
-def_family: begin p:=cur_chr; scan_math_fam_int; p:=p+cur_val;
-@z
-
+% Conflict with ../tex.ch
@x
for f:=font_base+1 to font_ptr do
if str_eq_str(font_name[f],cur_name)and str_eq_str(font_area[f],cur_area) then
@@ -3798,28 +978,7 @@ for f:=font_base+1 to font_ptr do begin
end
@z
-@x
-set_font:begin print("select font "); slow_print(font_name[chr_code]);
-@y
-set_font:begin print("select font ");
- font_name_str:=font_name[chr_code];
- if is_native_font(chr_code) then begin
- quote_char:="""";
- for n:=0 to length(font_name_str) - 1 do
- if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'";
- print_char(quote_char);
- slow_print(font_name_str);
- print_char(quote_char);
- end else
- slow_print(font_name_str);
-@z
-
-@x
- begin a_close(read_file[n]); read_open[n]:=closed;
-@y
- begin u_close(read_file[n]); read_open[n]:=closed;
-@z
-
+% Conflict with ../tex.ch
@x
and a_open_in(read_file[n], kpse_tex_format) then
read_open[n]:=just_open;
@@ -3841,18 +1000,6 @@ set_font:begin print("select font ");
@z
@x
-@!c:eight_bits; {character code}
-@y
-@!c:integer; {character code}
-@z
-
-@x
- begin c:=t mod 256;
-@y
- begin c:=t mod max_char_val;
-@z
-
-@x
@* \[50] Dumping and undumping the tables.
@y
@* \[50] Dumping and undumping the tables.
@@ -3912,18 +1059,6 @@ undump_checked_things(0, pool_ptr, str_start_macro(too_big_char), str_ptr+1-too_
@z
@x
-if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
-@y
-if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]);
-@z
-
-@x
-if eTeX_ex then for k:=int_val to tok_val do
-@y
-if eTeX_ex then for k:=int_val to inter_char_val do
-@z
-
-@x
print_file_name(font_name[k],font_area[k],"");
@y
if is_native_font(k) or (font_mapping[k]<>0) then
@@ -3963,34 +1098,6 @@ undump_things(font_check[null_font], font_ptr+1-null_font);
@z
@x
-dump_int(trie_op_ptr);
-@y
-dump_int(max_hyph_char);
-dump_int(trie_op_ptr);
-@z
-
-@x
-for k:=255 downto 0 do if trie_used[k]>min_quarterword then
-@y
-for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
-@z
-
-@x
-undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
-@y
-undump_int(max_hyph_char);
-undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
-@z
-
-@x
-init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
-k:=256;
-@y
-init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
-k:=biggest_lang+1;
-@z
-
-@x
@* \[51] The main program.
@y
@* \[51] The main program.
@@ -4068,53 +1175,7 @@ k:=biggest_lang+1;
@* \[53] Extensions.
@z
-@x
-@d set_language_code=5 {command modifier for \.{\\setlanguage}}
-@y
-@d set_language_code=5 {command modifier for \.{\\setlanguage}}
-
-@d pdftex_first_extension_code = 6
-@d pdf_save_pos_node == pdftex_first_extension_code + 0
-
-@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use }
-@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} }
-@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} }
-
-@d XeTeX_input_encoding_extension_code=44
-@d XeTeX_default_encoding_extension_code=45
-@d XeTeX_linebreak_locale_extension_code=46
-@z
-
-@x
-@!@:set_language_}{\.{\\setlanguage} primitive@>
-@y
-@!@:set_language_}{\.{\\setlanguage} primitive@>
-
-@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode.
-
-@<Generate all \eTeX\ primitives@>=
-primitive("XeTeXpicfile",extension,pic_file_code);@/
-primitive("XeTeXpdffile",extension,pdf_file_code);@/
-primitive("XeTeXglyph",extension,glyph_code);@/
-primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/
-primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc);
-
-primitive("pdfsavepos",extension,pdf_save_pos_node);@/
-@z
-
-@x
- set_language_code:print_esc("setlanguage");
-@y
- set_language_code:print_esc("setlanguage");
- pic_file_code:print_esc("XeTeXpicfile");
- pdf_file_code:print_esc("XeTeXpdffile");
- glyph_code:print_esc("XeTeXglyph");
- XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale");
- XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding");
- XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding");
- pdf_save_pos_node: print_esc("pdfsavepos");
-@z
-
+% Revert ../tex.ch
% i and j are unused by TeX but required for XeTeX
@x [53.1348] (do_extension)
var k:integer; {all-purpose integers}
@@ -4123,457 +1184,6 @@ var i,@!j,@!k:integer; {all-purpose integers}
@z
@x
-set_language_code:@<Implement \.{\\setlanguage}@>;
-@y
-set_language_code:@<Implement \.{\\setlanguage}@>;
-pic_file_code:@<Implement \.{\\XeTeXpicfile}@>;
-pdf_file_code:@<Implement \.{\\XeTeXpdffile}@>;
-glyph_code:@<Implement \.{\\XeTeXglyph}@>;
-XeTeX_input_encoding_extension_code:@<Implement \.{\\XeTeXinputencoding}@>;
-XeTeX_default_encoding_extension_code:@<Implement \.{\\XeTeXdefaultencoding}@>;
-XeTeX_linebreak_locale_extension_code:@<Implement \.{\\XeTeXlinebreaklocale}@>;
-
-pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
-@z
-
-@x
-@ @<Display the whatsit...@>=
-@y
-procedure print_native_word(@!p:pointer);
-var i,c,cc:integer;
-begin
- for i:=0 to native_length(p) - 1 do begin
- c:=get_native_char(p,i);
- if (c >= @"D800) and (c <= @"DBFF) then begin
- if i < native_length(p) - 1 then begin
- cc:=get_native_char(p, i+1);
- if (cc >= @"DC00) and (cc <= @"DFFF) then begin
- c := @"10000 + (c - @"D800) * @"400 + (cc - @"DC00);
- print_char(c);
- incr(i);
- end else
- print(".");
- end else
- print(".");
- end else
- print_char(c);
- end
-end;
-
-@ @<Display the whatsit...@>=
-@z
-
-@x
-othercases print("whatsit?")
-@y
-native_word_node:begin
- print_esc(font_id_text(native_font(p)));
- print_char(" ");
- print_native_word(p);
- end;
-glyph_node:begin
- print_esc(font_id_text(native_font(p)));
- print(" glyph#");
- print_int(native_glyph(p));
- end;
-pic_node,pdf_node: begin
- if subtype(p) = pic_node then print_esc("XeTeXpicfile")
- else print_esc("XeTeXpdffile");
- print(" """);
- for i:=0 to pic_path_length(p)-1 do
- print_visible_char(pic_path_byte(p, i));
- print("""");
- end;
-pdf_save_pos_node: print_esc("pdfsavepos");
-othercases print("whatsit?")
-@z
-
-@x
-@ @<Make a partial copy of the whatsit...@>=
-@y
-@ Picture nodes are tricky in that they are variable size.
-@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word))
-
-@<Make a partial copy of the whatsit...@>=
-@z
-
-@x
-othercases confusion("ext2")
-@y
-native_word_node: begin words:=native_size(p);
- r:=get_node(words);
- while words > 0 do
- begin decr(words); mem[r+words]:=mem[p+words]; end;
- native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0;
- copy_native_glyph_info(p, r);
- end;
-glyph_node: begin r:=get_node(glyph_node_size);
- words:=glyph_node_size;
- end;
-pic_node,pdf_node: begin words:=total_pic_node_size(p);
- r:=get_node(words);
- end;
-pdf_save_pos_node:
- r := get_node(small_node_size);
-othercases confusion("ext2")
-@z
-
-@x
-othercases confusion("ext3")
-@y
-native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end;
-glyph_node: free_node(p,glyph_node_size);
-pic_node,pdf_node: free_node(p,total_pic_node_size(p));
-pdf_save_pos_node:
- free_node(p, small_node_size);
-othercases confusion("ext3")
-@z
-
-@x
-@ @<Incorporate a whatsit node into a vbox@>=do_nothing
-@y
-@ @<Incorporate a whatsit node into a vbox@>=
-begin
- if (subtype(p)=pic_node)
- or (subtype(p)=pdf_node)
- then begin
- x := x + d + height(p);
- d := depth(p);
- if width(p) > w then w := width(p);
- end;
-end
-@z
-
-@x
-@ @<Incorporate a whatsit node into an hbox@>=do_nothing
-@y
-@ @<Incorporate a whatsit node into an hbox@>=
-begin
- case subtype(p) of
-
- native_word_node:
- begin
- { merge with any following word fragments in same font, discarding discretionary breaks }
- if type(q) = disc_node then k:=replace_count(q) else k:=0;
- while (link(q) <> p) do begin
- decr(k);
- q := link(q); { bring q up in preparation for deletion of nodes starting at p }
- if type(q) = disc_node then k:=replace_count(q);
- end;
- pp := link(p);
- restart:
- if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin
- if (type(pp) = whatsit_node)
- and (subtype(pp) = native_word_node)
- and (native_font(pp) = native_font(p)) then begin
- pp := link(pp);
- goto restart;
- end
- else if (type(pp) = disc_node) then begin
- ppp := link(pp);
- if (ppp <> null) and is_native_word_node(ppp)
- and (native_font(ppp) = native_font(p)) then begin
- pp := link(ppp);
- goto restart;
- end
- end
- end;
-
- { now pp points to the non-|native_word| node that ended the chain, or null }
-
- { we can just check type(p)=|whatsit_node| below, as we know that the chain
- contains only discretionaries and |native_word| nodes, no other whatsits or |char_nodes| }
-
- if (pp <> link(p)) then begin
- { found a chain of at least two pieces starting at p }
- total_chars := 0;
- p := link(q); { the first fragment }
- while (p <> pp) do begin
- if (type(p) = whatsit_node) then
- total_chars := total_chars + native_length(p); { accumulate char count }
- ppp := p; { remember last node seen }
- p := link(p); { point to next fragment or discretionary or terminator }
- end;
-
- p := link(q); { the first fragment again }
- pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word }
- link(q) := pp; { link to preceding material }
- link(pp) := link(ppp); { attach remainder of hlist to it }
- link(ppp) := null; { and detach from the old fragments }
-
- { copy the chars into new node }
- total_chars := 0;
- ppp := p;
- repeat
- if (type(ppp) = whatsit_node) then
- for k := 0 to native_length(ppp)-1 do begin
- set_native_char(pp, total_chars, get_native_char(ppp, k));
- incr(total_chars);
- end;
- ppp := link(ppp);
- until (ppp = null);
-
- flush_node_list(p); { delete the fragments }
- p := link(q); { update p to point to the new node }
- set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) }
- end;
-
- { now incorporate the |native_word| node measurements into the box we're packing }
- if height(p) > h then
- h := height(p);
- if depth(p) > d then
- d := depth(p);
- x := x + width(p);
- end;
-
- glyph_node, pic_node, pdf_node:
- begin
- if height(p) > h then
- h := height(p);
- if depth(p) > d then
- d := depth(p);
- x := x + width(p);
- end;
-
- othercases
- do_nothing
-
- endcases
-end
-@z
-
-@x
-@ @<Let |d| be the width of the whatsit |p|@>=d:=0
-@y
-@ @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>=
-if (subtype(p)=native_word_node)
-or (subtype(p)=glyph_node)
-or (subtype(p)=pic_node)
-or (subtype(p)=pdf_node)
-then begin
- d:=width(p);
- goto found;
-end else
- d := 0
-@z
-
-@x
-@ @d adv_past(#)==@+if subtype(#)=language_node then
- begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
- set_hyph_index;
- end
-
-@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
-adv_past(cur_p)
-@y
-@ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then
- begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
- set_hyph_index;
- end
- else if (subtype(#)=native_word_node)
- or (subtype(#)=glyph_node)
- or (subtype(#)=pic_node)
- or (subtype(#)=pdf_node)
- then
- begin act_width:=act_width+width(#); end
-
-@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
-adv_past_linebreak(cur_p)
-@z
-
-@x
-@ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
-adv_past(s)
-@y
-@ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then
- begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
- set_hyph_index;
- end
-
-@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
-adv_past_prehyph(s)
-@z
-
-@x
-@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
-goto contribute
-@y
-@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
-begin
- if (subtype(p)=pic_node)
- or (subtype(p)=pdf_node)
- then begin
- page_total := page_total + page_depth + height(p);
- page_depth := depth(p);
- end;
- goto contribute;
-end
-@z
-
-@x
-@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
-goto not_found
-@y
-@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
-begin
- if (subtype(p)=pic_node)
- or (subtype(p)=pdf_node)
- then begin
- cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p);
- end;
- goto not_found;
-end
-@z
-
-@x
-@ @<Output the whatsit node |p| in a vlist@>=
-out_what(p)
-@y
-@ @<Output the whatsit node |p| in a vlist@>=
-begin
- case subtype(p) of
- glyph_node: begin
- cur_v:=cur_v+height(p);
- cur_h:=left_edge;
-
- { synch DVI state to TeX state }
- synch_h; synch_v;
- f := native_font(p);
- if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
-
- dvi_out(set_glyph_string);
- dvi_four(0); { width }
- dvi_two(1); { glyph count }
- dvi_four(0); { x-offset as fixed point }
- dvi_two(native_glyph(p));
-
- cur_v:=cur_v+depth(p);
- cur_h:=left_edge;
- end;
- pic_node, pdf_node: begin
- save_h:=dvi_h; save_v:=dvi_v;
- cur_v:=cur_v+height(p);
- pic_out(p, subtype(p) = pdf_node);
- dvi_h:=save_h; dvi_v:=save_v;
- cur_v:=save_v+depth(p); cur_h:=left_edge;
- end;
-
- pdf_save_pos_node:
- @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
-
- othercases
- out_what(p)
-
- endcases
-end
-@z
-
-@x
-@ @<Output the whatsit node |p| in an hlist@>=
-out_what(p)
-@y
-@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
-begin
- pdf_last_x_pos := cur_h + cur_h_offset;
- pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset
-end
-
-@ @<Calculate page dimensions and margins@>=
-cur_h_offset := h_offset + (unity * 7227) / 100;
-cur_v_offset := v_offset + (unity * 7227) / 100;
-if pdf_page_width <> 0 then
- cur_page_width := pdf_page_width
-else
- cur_page_width := width(p) + 2*cur_h_offset;
-if pdf_page_height <> 0 then
- cur_page_height := pdf_page_height
-else
- cur_page_height := height(p) + depth(p) + 2*cur_v_offset
-
-@ @<Glob...@>=
-@!cur_page_width: scaled; {width of page being shipped}
-@!cur_page_height: scaled; {height of page being shipped}
-@!cur_h_offset: scaled; {horizontal offset of page being shipped}
-@!cur_v_offset: scaled; {vertical offset of page being shipped}
-
-@ @<Output the whatsit node |p| in an hlist@>=
-begin
- case subtype(p) of
- native_word_node, glyph_node: begin
- { synch DVI state to TeX state }
- synch_h; synch_v;
- f := native_font(p);
- if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
-
- if subtype(p) = glyph_node then begin
- dvi_out(set_glyph_string);
- dvi_four(width(p));
- dvi_two(1); { glyph count }
- dvi_four(0); { x-offset as fixed point }
- dvi_two(native_glyph(p));
- cur_h := cur_h + width(p);
- end else begin
- if native_glyph_info_ptr(p) <> null_ptr then begin
- len := make_xdv_glyph_array_data(p);
- for k := 0 to len-1 do
- dvi_out(xdv_buffer_byte(k));
- end;
- cur_h := cur_h + width(p);
- end;
-
- dvi_h := cur_h;
- end;
-
- pic_node, pdf_node: begin
- save_h:=dvi_h; save_v:=dvi_v;
- cur_v:=base_line;
- edge:=cur_h+width(p);
- if cur_dir=right_to_left then cur_h:=edge;
- pic_out(p, subtype(p) = pdf_node);
- dvi_h:=save_h; dvi_v:=save_v;
- cur_h:=edge; cur_v:=base_line;
- end;
-
- pdf_save_pos_node:
- @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
-
- othercases
- out_what(p)
-
- endcases
-end
-@z
-
-@x
-procedure special_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!k:pool_pointer; {index into |str_pool|}
-begin synch_h; synch_v;@/
-@y
-procedure special_out(@!p:pointer);
-var old_setting:0..max_selector; {holds print |selector|}
-@!k:pool_pointer; {index into |str_pool|}
-begin synch_h; synch_v;@/
-doing_special := true;
-@z
-
-@x
-for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
-pool_ptr:=str_start[str_ptr]; {erase the string}
-@y
-for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
-pool_ptr:=str_start_macro(str_ptr); {erase the string}
-doing_special := false;
-@z
-
-@x
-@!j:small_number; {write stream number}
-@y
-@!j:small_number; {write stream number}
-@!k:integer;
-@z
-
-@x
print(so(str_pool[str_start[str_ptr]+d])); {N.B.: not |print_char|}
@y
print(so(str_pool[str_start_macro(str_ptr)+d])); {N.B.: not |print_char|}
@@ -4605,316 +1215,6 @@ doing_special := false;
pool_ptr:=str_start_macro(str_ptr); {erase the string}
@z
-@x
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-@y
-@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
-procedure pic_out(@!p:pointer; @!is_pdf:boolean);
-var
- i:integer;
-begin
-synch_h; synch_v;
-dvi_out(pic_file);
-if is_pdf then
- dvi_out(pic_box_type(p))
-else
- dvi_out(0);
-dvi_four(pic_transform1(p));
-dvi_four(pic_transform2(p));
-dvi_four(pic_transform3(p));
-dvi_four(pic_transform4(p));
-dvi_four(pic_transform5(p));
-dvi_four(pic_transform6(p));
-dvi_two(pic_page(p));
-dvi_two(pic_path_length(p));
-for i:=0 to pic_path_length(p)-1 do
- dvi_out(pic_path_byte(p, i));
-end;
-
-@z
-
-@x
-language_node:do_nothing;
-@y
-language_node:do_nothing;
-@z
-
-@x
-@ @<Finish the extensions@>=
-for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
-@y
-@ @<Finish the extensions@>=
-terminate_font_manager;
-for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
-
-@ @<Implement \.{\\XeTeXpicfile}@>=
-if abs(mode)=mmode then report_illegal_case
-else load_picture(false)
-
-@ @<Implement \.{\\XeTeXpdffile}@>=
-if abs(mode)=mmode then report_illegal_case
-else load_picture(true)
-
-@ @<Implement \.{\\XeTeXglyph}@>=
-begin
- if abs(mode)=vmode then begin
- back_input;
- new_graf(true);
- end else if abs(mode)=mmode then report_illegal_case
- else begin
- if is_native_font(cur_font) then begin
- new_whatsit(glyph_node,glyph_node_size);
- scan_int;
- if (cur_val<0)or(cur_val>65535) then
- begin print_err("Bad glyph number");
- help2("A glyph number must be between 0 and 65535.")@/
- ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
- end;
- native_font(tail):=cur_font;
- native_glyph(tail):=cur_val;
- set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics);
- end else not_native_font_error(extension, glyph_code, cur_font);
- end
-end
-
-@ Load a picture file and handle following keywords.
-
-@d calc_min_and_max==
- begin
- xmin := 1000000.0;
- xmax := -xmin;
- ymin := xmin;
- ymax := xmax;
- for i := 0 to 3 do begin
- if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]);
- if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]);
- if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]);
- if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]);
- end;
- end
-
-@d update_corners==
- for i := 0 to 3 do
- transform_point(addressof(corners[i]), addressof(t2))
-
-@d do_size_requests==begin
- { calculate current width and height }
- calc_min_and_max;
- if x_size_req = 0.0 then begin
- make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin));
- end else if y_size_req = 0.0 then begin
- make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin));
- end else begin
- make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin));
- end;
- update_corners;
- x_size_req := 0.0;
- y_size_req := 0.0;
- transform_concat(addressof(t), addressof(t2));
-end
-
-@<Declare procedures needed in |do_extension|@>=
-procedure load_picture(@!is_pdf:boolean);
-var
- pic_path: ^char;
- bounds: real_rect;
- t, t2: transform;
- corners: array[0..3] of real_point;
- x_size_req,y_size_req: real;
- check_keywords: boolean;
- xmin,xmax,ymin,ymax: real;
- i: small_number;
- page: integer;
- pdf_box_type: integer;
- result: integer;
-begin
- { scan the filename and pack into |name_of_file| }
- scan_file_name;
- pack_cur_name;
-
- pdf_box_type := 0;
- page := 0;
- if is_pdf then begin
- if scan_keyword("page") then begin
- scan_int;
- page := cur_val;
- end;
- pdf_box_type := pdfbox_crop;
- if scan_keyword("crop") then do_nothing
- else if scan_keyword("media") then pdf_box_type := pdfbox_media
- else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed
- else if scan_keyword("trim") then pdf_box_type := pdfbox_trim
- else if scan_keyword("art") then pdf_box_type := pdfbox_art;
- end;
-
- { access the picture file and check its size }
- result := find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page);
-
- setPoint(corners[0], xField(bounds), yField(bounds));
- setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds));
- setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1]));
- setPoint(corners[3], xField(corners[2]), yField(corners[0]));
-
- x_size_req := 0.0;
- y_size_req := 0.0;
-
- { look for any scaling requests for this picture }
- make_identity(addressof(t));
-
- check_keywords := true;
- while check_keywords do begin
- if scan_keyword("scaled") then begin
- scan_int;
- if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
- make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0);
- update_corners;
- transform_concat(addressof(t), addressof(t2));
- end
- end else if scan_keyword("xscaled") then begin
- scan_int;
- if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
- make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0);
- update_corners;
- transform_concat(addressof(t), addressof(t2));
- end
- end else if scan_keyword("yscaled") then begin
- scan_int;
- if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
- make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0);
- update_corners;
- transform_concat(addressof(t), addressof(t2));
- end
- end else if scan_keyword("width") then begin
- scan_normal_dimen;
- if cur_val <= 0 then begin
- print_err("Improper image ");
- print("size (");
- print_scaled(cur_val);
- print("pt) will be ignored");
- help2("I can't scale images to zero or negative sizes, ")
- ("so I'm ignoring this.");
- error;
- end else
- x_size_req := Fix2X(cur_val);
- end else if scan_keyword("height") then begin
- scan_normal_dimen;
- if cur_val <= 0 then begin
- print_err("Improper image ");
- print("size (");
- print_scaled(cur_val);
- print("pt) will be ignored");
- help2("I can't scale images to zero or negative sizes, ")
- ("so I'm ignoring this.");
- error;
- end else
- y_size_req := Fix2X(cur_val);
- end else if scan_keyword("rotated") then begin
- scan_decimal;
- if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
- make_rotation(addressof(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0);
- update_corners;
- calc_min_and_max;
- setPoint(corners[0], xmin, ymin);
- setPoint(corners[1], xmin, ymax);
- setPoint(corners[2], xmax, ymax);
- setPoint(corners[3], xmax, ymin);
- transform_concat(addressof(t), addressof(t2));
- end else
- check_keywords := false;
- end;
-
- if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
-
- calc_min_and_max;
- make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27);
- transform_concat(addressof(t), addressof(t2));
-
- if result = 0 then begin
-
- new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word));
- if is_pdf then begin
- subtype(tail) := pdf_node;
- pic_box_type(tail) := pdf_box_type;
- end;
- pic_path_length(tail) := strlen(pic_path);
- pic_page(tail) := page;
-
- width(tail) := X2Fix(xmax - xmin);
- height(tail) := X2Fix(ymax - ymin);
- depth(tail) := 0;
-
- pic_transform1(tail) := X2Fix(aField(t));
- pic_transform2(tail) := X2Fix(bField(t));
- pic_transform3(tail) := X2Fix(cField(t));
- pic_transform4(tail) := X2Fix(dField(t));
- pic_transform5(tail) := X2Fix(txField(t));
- pic_transform6(tail) := X2Fix(tyField(t));
-
- memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path));
- libc_free(pic_path);
-
- end else begin
-
- print_err("Unable to load picture or PDF file '");
- print_file_name(cur_name,cur_area,cur_ext); print("'");
- if result = -43 then begin { Mac OS file not found error }
- help2("The requested image couldn't be read because ")
- ("the file was not found.");
- end
- else begin { otherwise assume GraphicImport failed }
- help2("The requested image couldn't be read because ")
- ("it was not a recognized image format.");
- end;
- error;
-
- end;
-
-end;
-
-@ @<Implement \.{\\XeTeXinputencoding}@>=
-begin
- { scan a filename-like arg for the input encoding }
- scan_and_pack_name;
-
- { convert it to "mode" and "encoding" values, and apply to the current input file }
- i := get_encoding_mode_and_info(addressof(j));
- if i = XeTeX_input_mode_auto then begin
- print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding.");
- help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ")
- ("I'll ignore this and leave the current encoding unchanged.");
- error;
- end else set_input_file_encoding(input_file[in_open], i, j);
-end
-
-@ @<Implement \.{\\XeTeXdefaultencoding}@>=
-begin
- { scan a filename-like arg for the input encoding }
- scan_and_pack_name;
-
- { convert it to "mode" and "encoding" values, and store them as defaults for new input files }
- XeTeX_default_input_mode := get_encoding_mode_and_info(addressof(j));
- XeTeX_default_input_encoding := j;
-end
-
-@ @<Implement \.{\\XeTeXlinebreaklocale}@>=
-begin
- { scan a filename-like arg for the locale name }
- scan_file_name;
- if length(cur_name) = 0 then XeTeX_linebreak_locale := 0
- else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! }
-end
-
-@ @<Glob...@>=
-@!pdf_last_x_pos: integer;
-@!pdf_last_y_pos: integer;
-
-@ @<Implement \.{\\pdfsavepos}@>=
-begin
- new_whatsit(pdf_save_pos_node, small_node_size);
-end
-
-@z
-
@x [53a.1379] l.??? -etex command line switch
@!init if (buffer[loc]="*")and(format_ident=" (INITEX)") then
@y
@@ -4928,459 +1228,6 @@ end
eTeX_mode:=1; {enter extended mode}
@z
-@x
-@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
-@y
-@d eTeX_version_code=eTeX_int {code for \.{\\eTeXversion}}
-@z
-
-@x
-@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
-@y
-@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
-
-primitive("XeTeXversion",last_item,XeTeX_version_code);
-@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@>
-primitive("XeTeXrevision",convert,XeTeX_revision_code);@/
-@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@>
-
-primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code);
-
-primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code);
-primitive("XeTeXvariation",last_item,XeTeX_variation_code);
-primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code);
-primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code);
-primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code);
-primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code);
-
-primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code);
-primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code);
-primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code);
-primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code);
-primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code);
-primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code);
-primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code);
-primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code);
-
-primitive("XeTeXvariationname",convert,XeTeX_variation_name_code);
-primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code);
-primitive("XeTeXselectorname",convert,XeTeX_selector_name_code);
-
-primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code);
-primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code);
-primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code);
-primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code);
-primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code);
-primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code);
-
-primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code);
-primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code);
-primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code);
-
-primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code);
-
-primitive("XeTeXfonttype", last_item, XeTeX_font_type_code);
-
-primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code);
-primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code);
-
-primitive("pdflastxpos",last_item,pdf_last_x_pos_code);
-primitive("pdflastypos",last_item,pdf_last_y_pos_code);
-
-primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code);
-@z
-
-@x
-eTeX_version_code: print_esc("eTeXversion");
-@y
-eTeX_version_code: print_esc("eTeXversion");
-XeTeX_version_code: print_esc("XeTeXversion");
-
-XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs");
-
-XeTeX_count_variations_code: print_esc("XeTeXcountvariations");
-XeTeX_variation_code: print_esc("XeTeXvariation");
-XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname");
-XeTeX_variation_min_code: print_esc("XeTeXvariationmin");
-XeTeX_variation_max_code: print_esc("XeTeXvariationmax");
-XeTeX_variation_default_code: print_esc("XeTeXvariationdefault");
-
-XeTeX_count_features_code: print_esc("XeTeXcountfeatures");
-XeTeX_feature_code_code: print_esc("XeTeXfeaturecode");
-XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname");
-XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature");
-XeTeX_count_selectors_code: print_esc("XeTeXcountselectors");
-XeTeX_selector_code_code: print_esc("XeTeXselectorcode");
-XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname");
-XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector");
-
-XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts");
-XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages");
-XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures");
-XeTeX_OT_script_code: print_esc("XeTeXOTscripttag");
-XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag");
-XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag");
-
-XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph");
-XeTeX_glyph_index_code: print_esc("XeTeXglyphindex");
-XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds");
-
-XeTeX_font_type_code: print_esc("XeTeXfonttype");
-
-XeTeX_first_char_code: print_esc("XeTeXfirstfontchar");
-XeTeX_last_char_code: print_esc("XeTeXlastfontchar");
-
- pdf_last_x_pos_code: print_esc("pdflastxpos");
- pdf_last_y_pos_code: print_esc("pdflastypos");
-
-XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount");
-@z
-
-@x
-eTeX_version_code: cur_val:=eTeX_version;
-@y
-eTeX_version_code: cur_val:=eTeX_version;
-XeTeX_version_code: cur_val:=XeTeX_version;
-
-XeTeX_count_glyphs_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then
- cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
- else if is_otgr_font(n) then
- cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
- else
- cur_val:=0;
- end;
-
-XeTeX_count_variations_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then
- cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
- else begin
- cur_val:=0;
- end;
- end;
-XeTeX_count_features_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then
- cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
- else if is_gr_font(n) then
- cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
- else
- cur_val:=0;
- end;
-
-XeTeX_variation_code,
-XeTeX_variation_min_code,
-XeTeX_variation_max_code,
-XeTeX_variation_default_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_int; k:=cur_val;
- cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
- end else begin
- not_atsu_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_feature_code_code,
-XeTeX_is_exclusive_feature_code,
-XeTeX_count_selectors_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_int; k:=cur_val;
- cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
- end else if is_gr_font(n) then begin
- scan_int; k:=cur_val;
- cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
- end else begin
- not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_selector_code_code,
-XeTeX_is_default_selector_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_int; k:=cur_val; scan_int;
- cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
- end else if is_gr_font(n) then begin
- scan_int; k:=cur_val; scan_int;
- cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
- end else begin
- not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_find_variation_by_name_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_and_pack_name;
- cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]);
- end else begin
- not_atsu_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_find_feature_by_name_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_and_pack_name;
- cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]);
- end else if is_gr_font(n) then begin
- scan_and_pack_name;
- cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]);
- end else begin
- not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_find_selector_by_name_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then begin
- scan_int; k:=cur_val; scan_and_pack_name;
- cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
- end else if is_gr_font(n) then begin
- scan_int; k:=cur_val; scan_and_pack_name;
- cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
- end else begin
- not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_OT_count_scripts_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_ot_font(n) then
- cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
- else begin
- cur_val:=0;
- end;
- end;
-
-XeTeX_OT_count_languages_code,
-XeTeX_OT_script_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_ot_font(n) then begin
- scan_int;
- cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val);
- end else begin
- not_ot_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_OT_count_features_code,
-XeTeX_OT_language_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_ot_font(n) then begin
- scan_int; k:=cur_val; scan_int;
- cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
- end else begin
- not_ot_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_OT_feature_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_ot_font(n) then begin
- scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int;
- cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val);
- end else begin
- not_ot_font_error(last_item, m, n); cur_val:=-1;
- end;
- end;
-
-XeTeX_map_char_to_glyph_code:
- begin
- if is_native_font(cur_font) then begin
- scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n)
- end else begin
- not_native_font_error(last_item, m, cur_font); cur_val:=0
- end
- end;
-
-XeTeX_glyph_index_code:
- begin
- if is_native_font(cur_font) then begin
- scan_and_pack_name;
- cur_val:=map_glyph_to_index(cur_font)
- end else begin
- not_native_font_error(last_item, m, cur_font); cur_val:=0
- end
- end;
-
-XeTeX_font_type_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_atsu_font(n) then cur_val:=1
- else if is_ot_font(n) then cur_val:=2
- else if is_gr_font(n) then cur_val:=3
- else cur_val:=0;
- end;
-
-XeTeX_first_char_code,XeTeX_last_char_code:
- begin
- scan_font_ident; n:=cur_val;
- if is_native_font(n) then
- cur_val:=get_font_char_range(n, m = XeTeX_first_char_code)
- else begin
- if m = XeTeX_first_char_code then cur_val:=font_bc[n]
- else cur_val:=font_ec[n];
- end
- end;
-
- pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
- pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
-
-XeTeX_pdf_page_count_code:
- begin
- scan_and_pack_name;
- cur_val:=count_pdf_file_pages;
- end;
-
-@ Slip in an extra procedure here and there....
-
-@<Error hand...@>=
-procedure scan_and_pack_name; forward;
-
-@ @<Declare procedures needed in |do_extension|@>=
-procedure scan_and_pack_name;
-begin
- scan_file_name; pack_cur_name;
-end;
-
-@ @<Declare the procedure called |print_cmd_chr|@>=
-procedure not_atsu_font_error(cmd, c: integer; f: integer);
-begin
- print_err("Cannot use "); print_cmd_chr(cmd, c);
- print(" with "); print(font_name[f]);
- print("; not an AAT font");
- error;
-end;
-
-procedure not_atsu_gr_font_error(cmd, c: integer; f: integer);
-begin
- print_err("Cannot use "); print_cmd_chr(cmd, c);
- print(" with "); print(font_name[f]);
- print("; not an AAT or Graphite font");
- error;
-end;
-
-procedure not_ot_font_error(cmd, c: integer; f: integer);
-begin
- print_err("Cannot use "); print_cmd_chr(cmd, c);
- print(" with "); print(font_name[f]);
- print("; not an OpenType Layout font");
- error;
-end;
-
-procedure not_native_font_error(cmd, c: integer; f: integer);
-begin
- print_err("Cannot use "); print_cmd_chr(cmd, c);
- print(" with "); print(font_name[f]);
- print("; not a native platform font");
- error;
-end;
-
-@ @<Cases for fetching a dimension value@>=
-XeTeX_glyph_bounds_code:
- begin
- if is_native_font(cur_font) then begin
- scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom }
- if (n < 1) or (n > 4) then begin
- print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;");
- print_nl("I don't know anything about edge "); print_int(n);
- error;
- cur_val:=0;
- end else begin
- scan_int; { glyph number }
- cur_val:=get_glyph_bounds(cur_font, n, cur_val);
- end
- end else begin
- not_native_font_error(last_item, m, cur_font); cur_val:=0
- end
- end;
-
-@ @<Cases of |convert| for |print_cmd_chr|@>=
-eTeX_revision_code: print_esc("eTeXrevision");
-XeTeX_revision_code: print_esc("XeTeXrevision");
-
-XeTeX_variation_name_code: print_esc("XeTeXvariationname");
-XeTeX_feature_name_code: print_esc("XeTeXfeaturename");
-XeTeX_selector_name_code: print_esc("XeTeXselectorname");
-XeTeX_glyph_name_code: print_esc("XeTeXglyphname");
-
-@ @<Cases of `Scan the argument for command |c|'@>=
-eTeX_revision_code: do_nothing;
-XeTeX_revision_code: do_nothing;
-
-XeTeX_variation_name_code:
- begin
- scan_font_ident; fnt:=cur_val;
- if is_atsu_font(fnt) then begin
- scan_int; arg1:=cur_val; arg2:=0;
- end else
- not_atsu_font_error(convert, c, fnt);
- end;
-
-XeTeX_feature_name_code:
- begin
- scan_font_ident; fnt:=cur_val;
- if is_atsu_font(fnt) or is_gr_font(fnt) then begin
- scan_int; arg1:=cur_val; arg2:=0;
- end else
- not_atsu_gr_font_error(convert, c, fnt);
- end;
-
-XeTeX_selector_name_code:
- begin
- scan_font_ident; fnt:=cur_val;
- if is_atsu_font(fnt) or is_gr_font(fnt) then begin
- scan_int; arg1:=cur_val; scan_int; arg2:=cur_val;
- end else
- not_atsu_gr_font_error(convert, c, fnt);
- end;
-
-XeTeX_glyph_name_code:
- begin
- scan_font_ident; fnt:=cur_val;
- if is_native_font(fnt) then begin
- scan_int; arg1:=cur_val;
- end else
- not_native_font_error(convert, c, fnt);
- end;
-
-@ @<Cases of `Print the result of command |c|'@>=
-eTeX_revision_code: print(eTeX_revision);
-XeTeX_revision_code: print(XeTeX_revision);
-
-XeTeX_variation_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_feature_name_code,
-XeTeX_selector_name_code:
- if is_atsu_font(fnt) then
- atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2)
- else if is_gr_font(fnt) then
- gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
-
-XeTeX_glyph_name_code:
- if is_native_font(fnt) then print_glyph_name(fnt, arg1);
-@z
-
@x [53a.1383] l.??? -etex command line switch
@!eTeX_mode: 0..1; {identifies compatibility and extended mode}
@y
@@ -5388,130 +1235,12 @@ XeTeX_glyph_name_code:
@!etex_p: boolean; {was the -etex option specified}
@z
-@x
-@ @<Dump the \eTeX\ state@>=
-dump_int(eTeX_mode);
-for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
-@y
-@ @<Dump the \eTeX\ state@>=
-dump_int(eTeX_mode);
-{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped }
-@z
-
-@x
-every_eof_loc: print_esc("everyeof");
-@y
-every_eof_loc: print_esc("everyeof");
-XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks");
-@z
-
@x [53a.1391] l.??? texarray
@!eof_seen : array[1..max_in_open] of boolean; {has eof been seen?}
@y
@!eof_seen : ^boolean; {has eof been seen?}
@z
-@x
-font_char_wd_code,
-font_char_ht_code,
-font_char_dp_code,
-font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
- if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
- begin i:=char_info(q)(qi(cur_val));
- case m of
- font_char_wd_code: cur_val:=char_width(q)(i);
- font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
- font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
- font_char_ic_code: cur_val:=char_italic(q)(i);
- end; {there are no other cases}
- end
- else cur_val:=0;
- end;
-@y
-font_char_wd_code,
-font_char_ht_code,
-font_char_dp_code,
-font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num;
- if is_native_font(q) then begin
- case m of
- font_char_wd_code: cur_val := getnativecharwd(q, cur_val);
- font_char_ht_code: cur_val := getnativecharht(q, cur_val);
- font_char_dp_code: cur_val := getnativechardp(q, cur_val);
- font_char_ic_code: cur_val := getnativecharic(q, cur_val);
- end; {there are no other cases}
- end else begin
- if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
- begin i:=char_info(q)(qi(cur_val));
- case m of
- font_char_wd_code: cur_val:=char_width(q)(i);
- font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
- font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
- font_char_ic_code: cur_val:=char_italic(q)(i);
- end; {there are no other cases}
- end
- else cur_val:=0;
- end
- end;
-@z
-
-@x
-@ Here we compute the effective width of a glue node as in |hlist_out|.
-
-@<Cases of |reverse|...@>=
-glue_node: begin round_glue;
- @<Handle a glue node for mixed...@>;
- end;
-@y
-@ Need to measure |native_word| and picture nodes when reversing!
-@<Cases of |reverse|...@>=
-whatsit_node:
- if (subtype(p)=native_word_node)
- or (subtype(p)=glyph_node)
- or (subtype(p)=pic_node)
- or (subtype(p)=pdf_node)
- then
- rule_wd:=width(p)
- else
- goto next_p;
-
-@ Here we compute the effective width of a glue node as in |hlist_out|.
-
-@<Cases of |reverse|...@>=
-glue_node: begin round_glue;
- @<Handle a glue node for mixed...@>;
- end;
-@z
-
-@x
-str_pool[pool_ptr]:=si(" "); l:=str_start[s];
-@y
-str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s);
-@z
-
-@x
- buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
-@y
- buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p);
-@z
-
-@x
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
- if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
- b:=char_exists(char_info(n)(qi(cur_val)))
- else b:=false;
- end;
-@y
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
- if is_native_font(n) then
- b := (map_char_to_glyph(n, cur_val) > 0)
- else begin
- if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
- b:=char_exists(char_info(n)(qi(cur_val)))
- else b:=false;
- end;
- end;
-@z
-
@x [53a.1506] l.??? texarray
@!grp_stack : array[0..max_in_open] of save_pointer; {initial |cur_boundary|}
@!if_stack : array[0..max_in_open] of pointer; {initial |cond_ptr|}
@@ -5521,31 +1250,6 @@ if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
@z
@x
-@d mark_val=6 {the additional mark classes}
-@y
-@d mark_val=7 {the additional mark classes}
-@z
-
-@x
-for i:=int_val to tok_val do sa_root[i]:=null;
-@y
-for i:=int_val to inter_char_val do sa_root[i]:=null;
-@z
-
-@x [53a.1587] l.??? texarray
-hyph_root:=0; hyph_start:=0;
-@y
-@z
-
-@x {hyphenation code is only saved for chars 0..255}
-@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
- if hyph_index=0 then hc[0]:=lc_code(#)
-@y
-@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
- if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#)
-@z
-
-@x
for c := str_start[text(h)] to str_start[text(h) + 1] - 1
@y
for c := str_start_macro(text(h)) to str_start_macro(text(h) + 1) - 1
diff --git a/Build/source/texk/web2c/xetexdir/xetex.web b/Build/source/texk/web2c/xetexdir/xetex.web
index 3125a7c5dbc..fcf5f53907f 100644
--- a/Build/source/texk/web2c/xetexdir/xetex.web
+++ b/Build/source/texk/web2c/xetexdir/xetex.web
@@ -6060,18 +6060,51 @@ A global boolean variable called |no_new_control_sequence| is set to
@!no_new_control_sequence:boolean; {are new identifiers legal?}
@!cs_count:integer; {total number of known identifiers}
+@ Primitive support needs a few extra variables and definitions
+
+@d prim_size=480 {maximum number of primitives }
+@d prim_prime=409 {about 85\pct! of |primitive_size|}
+@d prim_base=1
+@d prim_next(#) == prim[#].lh {link for coalesced lists}
+@d prim_text(#) == prim[#].rh {string number for control sequence name}
+@d prim_is_full == (prim_used=prim_base) {test if all positions are occupied}
+@d prim_eq_level_field(#)==#.hh.b1
+@d prim_eq_type_field(#)==#.hh.b0
+@d prim_equiv_field(#)==#.hh.rh
+@d prim_eq_level(#)==prim_eq_level_field(prim_eqtb[#]) {level of definition}
+@d prim_eq_type(#)==prim_eq_type_field(prim_eqtb[#]) {command code for equivalent}
+@d prim_equiv(#)==prim_equiv_field(prim_eqtb[#]) {equivalent value}
+@d undefined_primitive=0
+
+@<Glob...@>=
+@!prim: array [0..prim_size] of two_halves; {the primitives table}
+@!prim_used:pointer; {allocation pointer for |prim|}
+@!prim_eqtb:array[0..prim_size] of memory_word;
+
@ @<Set init...@>=
no_new_control_sequence:=true; {new identifiers are usually forbidden}
+prim_next(0):=0; prim_text(0):=0;
+for k:=1 to prim_size do prim[k]:=prim[0];
+prim_eq_level(0) := level_zero;
+prim_eq_type(0) := undefined_cs;
+prim_equiv(0) := null;
+for k:=1 to prim_size do prim_eqtb[k]:=prim_eqtb[0];
next(hash_base):=0; text(hash_base):=0;
for k:=hash_base+1 to undefined_control_sequence-1 do hash[k]:=hash[hash_base];
@ @<Initialize table entries...@>=
+prim_used:=prim_size; {nothing is used}
hash_used:=frozen_control_sequence; {nothing is used}
cs_count:=0;
eq_type(frozen_dont_expand):=dont_expand;
text(frozen_dont_expand):="notexpanded:";
@.notexpanded:@>
+eq_type(frozen_primitive):=ignore_spaces;
+equiv(frozen_primitive):=1;
+eq_level(frozen_primitive):=level_one;
+text(frozen_primitive):="primitive";
+
@ Here is the subroutine that searches the hash table for an identifier
that matches a given string of length |l>1| appearing in |buffer[j..
(j+l-1)]|. If the identifier is found, the corresponding hash table address
@@ -6140,6 +6173,61 @@ for k:=j+1 to j+l-1 do
while h>=hash_prime do h:=h-hash_prime;
end
+@ Here is the subroutine that searches the primitive table for an identifier
+
+@p function prim_lookup(@!s:str_number):pointer; {search the primitives table}
+label found; {go here if you found it}
+var h:integer; {hash code}
+@!p:pointer; {index in |hash| array}
+@!k:pointer; {index in string pool}
+@!j,@!l:integer;
+begin
+if s<256 then begin
+ p := s;
+ if (p<0) or (prim_eq_level(p)<>level_one) then
+ p := undefined_primitive;
+end
+else begin
+ j:=str_start_macro(s);
+ if s = str_ptr then l := cur_length else l := length(s);
+ @<Compute the primitive code |h|@>;
+ p:=h+prim_base; {we start searching here; note that |0<=h<hash_prime|}
+ loop@+begin if prim_text(p)>0 then if length(prim_text(p))=l then
+ if str_eq_str(prim_text(p),s) then goto found;
+ if prim_next(p)=0 then
+ begin if no_new_control_sequence then
+ p:=undefined_primitive
+ else @<Insert a new primitive after |p|, then make
+ |p| point to it@>;
+ goto found;
+ end;
+ p:=prim_next(p);
+ end;
+ end;
+found: prim_lookup:=p;
+end;
+
+@ @<Insert a new primitive...@>=
+begin if prim_text(p)>0 then
+ begin repeat if prim_is_full then overflow("primitive size",prim_size);
+@:TeX capacity exceeded primitive size}{\quad primitive size@>
+ decr(prim_used);
+ until prim_text(prim_used)=0; {search for an empty location in |prim|}
+ prim_next(p):=prim_used; p:=prim_used;
+ end;
+prim_text(p):=s;
+end
+
+@ The value of |prim_prime| should be roughly 85\pct! of
+|prim_size|, and it should be a prime number.
+
+@<Compute the primitive code |h|@>=
+h:=str_pool[j];
+for k:=j+1 to j+l-1 do
+ begin h:=h+h+str_pool[k];
+ while h>=prim_prime do h:=h-prim_prime;
+ end
+
@ Single-character control sequences do not need to be looked up in a hash
table, since we can use the character code itself as a direct address.
The procedure |print_cs| prints the name of a control sequence, given
@@ -6193,7 +6281,11 @@ contains the new |eqtb| pointer after |primitive| has acted.
var k:pool_pointer; {index into |str_pool|}
@!j:0..buf_size; {index into |buffer|}
@!l:small_number; {length of the string}
-begin if s<256 then cur_val:=s+single_base
+@!prim_val:integer; {needed to fill |prim_eqtb|}
+begin if s<256 then begin
+ cur_val:=s+single_base;
+ prim_val:=s;
+end
else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
{we will move |s| into the (possibly non-empty) |buffer|}
if first+l>buf_size+1 then
@@ -6202,8 +6294,12 @@ else begin k:=str_start_macro(s); l:=str_start_macro(s+1)-k;
for j:=0 to l-1 do buffer[first+j]:=so(str_pool[k+j]);
cur_val:=id_lookup(first,l); {|no_new_control_sequence| is |false|}
flush_string; text(cur_val):=s; {we don't want to have the string twice}
+ prim_val:=prim_lookup(s);
end;
eq_level(cur_val):=level_one; eq_type(cur_val):=c; equiv(cur_val):=o;
+prim_eq_level(prim_val):=level_one;
+prim_eq_type(prim_val):=c;
+prim_equiv(prim_val):=o;
end;
tini
@@ -6277,6 +6373,8 @@ primitive("noboundary",no_boundary,0);@/
@!@:no_boundary_}{\.{\\noboundary} primitive@>
primitive("noexpand",no_expand,0);@/
@!@:no_expand_}{\.{\\noexpand} primitive@>
+primitive("primitive",no_expand,1);@/
+@!@:primitive_}{\.{\\primitive} primitive@>
primitive("nonscript",non_script,0);@/
@!@:non_script_}{\.{\\nonscript} primitive@>
primitive("omit",omit,0);@/
@@ -6338,7 +6436,7 @@ expand_after: if chr_code=0 then print_esc("expandafter")
@<Cases of |expandafter| for |print_cmd_chr|@>;
halign: print_esc("halign");
hrule: print_esc("hrule");
-ignore_spaces: print_esc("ignorespaces");
+ignore_spaces: if chr_code=0 then print_esc("ignorespaces") else print_esc("primitive");
insert: print_esc("insert");
ital_corr: print_esc("/");
mark: begin print_esc("mark");
@@ -6353,7 +6451,8 @@ math_choice: print_esc("mathchoice");
multiply: print_esc("multiply");
no_align: print_esc("noalign");
no_boundary:print_esc("noboundary");
-no_expand: print_esc("noexpand");
+no_expand: if chr_code=0 then print_esc("noexpand")
+ else print_esc("primitive");
non_script: print_esc("nonscript");
omit: print_esc("omit");
radical: if chr_code=1 then print_esc("XeTeXradical") else print_esc("radical");
@@ -8421,6 +8520,7 @@ procedure@?ins_the_toks; forward;@t\2@>
procedure expand;
label reswitch;
var t:halfword; {token that is being ``expanded after''}
+@!b:boolean; {keep track of nested csnames}
@!p,@!q,@!r:pointer; {for list manipulation}
@!j:0..buf_size; {index into |buffer|}
@!cv_backup:integer; {to save the global quantity |cur_val|}
@@ -8438,13 +8538,20 @@ cur_val:=cv_backup; cur_val_level:=cvl_backup; radix:=radix_backup;
cur_order:=co_backup; link(backup_head):=backup_backup;
end;
+@ @<Glob...@>=
+@!is_in_csname: boolean;
+
+@ @<Set init...@>=
+is_in_csname := false;
+
@ @<Expand a nonmacro@>=
begin if tracing_commands>1 then show_cur_cmd_chr;
case cur_cmd of
top_bot_mark:@<Insert the \(a)appropriate mark text into the scanner@>;
expand_after:if cur_chr=0 then @<Expand the token after the next token@>
else @<Negate a boolean conditional and |goto reswitch|@>;
-no_expand:@<Suppress expansion of the next token@>;
+no_expand: if cur_chr=0 then @<Suppress expansion of the next token@>
+ else @<Implement \.{\\primitive}@>;
cs_name:@<Manufacture a control sequence name@>;
convert:conv_toks; {this procedure is discussed in Part 27 below}
the:ins_the_toks; {this procedure is discussed in Part 27 below}
@@ -8481,6 +8588,43 @@ if t>=cs_token_flag then
end;
end
+@ The \.{\\primitive} handling. If the primitive meaning of the next
+token is an expandable command, it suffices to replace the current
+token with the primitive one and restart |expand|/
+
+Otherwise, the token we just read has to be pushed back, as well
+as a token matching the internal form of \.{\\primitive}, that is
+sneaked in as an alternate form of |ignore_spaces|.
+@!@:primitive_}{\.{\\primitive} primitive (internalized)@>
+
+Simply pushing back a token that matches the correct internal command
+does not work, because approach would not survive roundtripping to a
+temporary file.
+
+@<Implement \.{\\primitive}@>=
+begin save_scanner_status := scanner_status; scanner_status:=normal;
+get_token; scanner_status:=save_scanner_status;
+if cur_cs < hash_base then
+ cur_cs := prim_lookup(cur_cs-257)
+else
+ cur_cs := prim_lookup(text(cur_cs));
+if cur_cs<>undefined_primitive then begin
+ t := prim_eq_type(cur_cs);
+ if t>max_command then begin
+ cur_cmd := t;
+ cur_chr := prim_equiv(cur_cs);
+ cur_tok := (cur_cmd*max_char_val)+cur_chr;
+ cur_cs := 0;
+ goto reswitch;
+ end
+ else begin
+ back_input; { now |loc| and |start| point to a one-item list }
+ p:=get_avail; info(p):=cs_token_flag+frozen_primitive;
+ link(p):=loc; loc:=p; start:=p;
+ end;
+ end;
+end
+
@ @<Complain about an undefined macro@>=
begin print_err("Undefined control sequence");
@.Undefined control sequence@>
@@ -8505,10 +8649,12 @@ the variables |p| and |q| are reserved for token-list building.
@ @<Manufacture a control...@>=
begin r:=get_avail; p:=r; {head of the list of characters}
+b := is_in_csname; is_in_csname := true;
repeat get_x_token;
if cur_cs=0 then store_new_token(cur_tok);
until cur_cs<>0;
if cur_cmd<>end_cs_name then @<Complain about missing \.{\\endcsname}@>;
+is_in_csname := b;
@<Look up the characters of list |r| in the hash table, and set |cur_cs|@>;
flush_list(r);
if eq_type(cur_cs)=undefined_cs then
@@ -9327,11 +9473,13 @@ the codes for its extensions: |eTeX_version_code|, \dots\ .
@d pdf_last_x_pos_code = XeTeX_int+27
@d pdf_last_y_pos_code = XeTeX_int+28
+@d pdf_strcmp_code = XeTeX_int+29
+@d pdf_shell_escape_code = XeTeX_int+30
-@d XeTeX_pdf_page_count_code = XeTeX_int+29
+@d XeTeX_pdf_page_count_code = XeTeX_int+31
@#
-@d XeTeX_dim=XeTeX_int+30 {first of \XeTeX\ codes for dimensions}
+@d XeTeX_dim=XeTeX_int+32 {first of \XeTeX\ codes for dimensions}
@d XeTeX_glyph_bounds_code = XeTeX_dim
@@ -9382,6 +9530,7 @@ last_item: case chr_code of
dimen_val: print_esc("lastkern");
glue_val: print_esc("lastskip");
input_line_no_code: print_esc("inputlineno");
+ pdf_shell_escape_code: print_esc("shellescape");
@/@<Cases of |last_item| for |print_cmd_chr|@>@/
othercases print_esc("badness")
endcases;
@@ -9475,6 +9624,14 @@ if m>=input_line_no_code then
else begin case m of
input_line_no_code: cur_val:=line;
badness_code: cur_val:=last_badness;
+ pdf_shell_escape_code:
+ begin
+ if shellenabledp then begin
+ if restrictedshell then cur_val := 2
+ else cur_val := 1;
+ end
+ else cur_val := 0;
+ end;
@/@<Cases for fetching an integer value@>@/
end; {there are no other cases}
cur_val_level:=int_val;
@@ -9514,7 +9671,17 @@ end
@ @<Fetch a font integer@>=
begin scan_font_ident;
if m=0 then scanned_result(hyphen_char[cur_val])(int_val)
-else scanned_result(skew_char[cur_val])(int_val);
+else if m=1 then scanned_result(skew_char[cur_val])(int_val)
+else begin
+ n := cur_val;
+ if is_native_font(n) then scan_glyph_number(n)
+ else scan_char_num;
+ k := cur_val;
+ case m of
+ lp_code_base: scanned_result(get_cp_code(n, k, left_side))(int_val);
+ rp_code_base: scanned_result(get_cp_code(n, k, right_side))(int_val);
+ end;
+end;
end
@ @<Fetch a register@>=
@@ -9590,6 +9757,22 @@ applications of |scan_int| that have already been made inside of
|scan_something_internal|.
@ @<Declare procedures that scan restricted classes of integers@>=
+
+procedure scan_glyph_number(f: internal_font_number);
+{ scan a glyph ID for native font |f|, identified by Unicode value or name or glyph number }
+begin
+ if scan_keyword("/") then {set cp value by glyph name}
+ begin
+ scan_and_pack_name; {result is in |nameoffile|}
+ scanned_result(map_glyph_to_index(f))(int_val);
+ end else if scan_keyword("u") then {set cp value by unicode}
+ begin
+ scan_char_num;
+ scanned_result(map_char_to_glyph(f,cur_val))(int_val);
+ end else
+ scan_int;
+end;
+
procedure scan_char_class;
begin scan_int;
if (cur_val<0)or(cur_val>256) then
@@ -10289,7 +10472,10 @@ end;
@d XeTeX_selector_name_code=9
@d XeTeX_glyph_name_code=10
-@d etex_convert_codes=XeTeX_glyph_name_code+1 {end of \eTeX's command codes}
+@d left_margin_kern_code=11
+@d right_margin_kern_code=12
+
+@d etex_convert_codes=right_margin_kern_code+1 {end of \eTeX's command codes}
@d job_name_code=etex_convert_codes {command code for \.{\\jobname}}
@<Put each...@>=
@@ -10305,6 +10491,10 @@ primitive("fontname",convert,font_name_code);@/
@!@:font_name_}{\.{\\fontname} primitive@>
primitive("jobname",convert,job_name_code);@/
@!@:job_name_}{\.{\\jobname} primitive@>
+primitive("leftmarginkern",convert,left_margin_kern_code);@/
+@!@:left_margin_kern_}{\.{\\leftmarginkern} primitive@>
+primitive("rightmarginkern",convert,right_margin_kern_code);@/
+@!@:right_margin_kern_}{\.{\\rightmarginkern} primitive@>
@ @<Cases of |print_cmd_chr|...@>=
convert: case chr_code of
@@ -10312,7 +10502,10 @@ convert: case chr_code of
roman_numeral_code: print_esc("romannumeral");
string_code: print_esc("string");
meaning_code: print_esc("meaning");
- font_name_code: print_esc("fontname");
+ font_name_code: print_esc("fontname");
+ pdf_strcmp_code: print_esc("strcmp");
+ left_margin_kern_code: print_esc("leftmarginkern");
+ right_margin_kern_code: print_esc("rightmarginkern");
@/@<Cases of |convert| for |print_cmd_chr|@>@/
othercases print_esc("jobname")
endcases;
@@ -10321,8 +10514,17 @@ convert: case chr_code of
for |convert| functions into the scanner; `\.{\\outer}' control sequences
are allowed to follow `\.{\\string}' and `\.{\\meaning}'.
+The extra temp string |u| is needed because |pdf_scan_ext_toks| incorporates
+any pending string in its output. In order to save such a pending string,
+we have to create a temporary string that is destroyed immediately after.
+
+@d save_cur_string==if str_start_macro(str_ptr)<pool_ptr then u:=make_string else u:=0
+@d restore_cur_string==if u<>0 then decr(str_ptr)
+
@p procedure conv_toks;
var old_setting:0..max_selector; {holds |selector| setting}
+@!save_warning_index, @!save_def_ref:pointer;
+@!u: str_number;
@!c:small_number; {desired type of conversion}
@!save_scanner_status:small_number; {|scanner_status| upon entry}
@!b:pool_pointer; {base of temporary string}
@@ -10330,6 +10532,7 @@ var old_setting:0..max_selector; {holds |selector| setting}
@!font_name_str:str_number; {local vars for \.{\\fontname} quoting extension}
@!i:small_number;
@!quote_char:UTF16_code;
+p, q: pointer;
begin c:=cur_chr; @<Scan the argument for command |c|@>;
old_setting:=selector; selector:=new_string; b:=pool_ptr;
@<Print the result of command |c|@>;
@@ -10631,6 +10834,7 @@ We consider now the way \TeX\ handles various kinds of \.{\\if} commands.
@d if_true_code=14 { `\.{\\iftrue}' }
@d if_false_code=15 { `\.{\\iffalse}' }
@d if_case_code=16 { `\.{\\ifcase}' }
+@d if_primitive_code=21 { `\.{\\ifprimitive}' }
@<Put each...@>=
primitive("if",if_test,if_char_code);
@@ -10667,6 +10871,8 @@ primitive("iffalse",if_test,if_false_code);
@!@:if_false_}{\.{\\iffalse} primitive@>
primitive("ifcase",if_test,if_case_code);
@!@:if_case_}{\.{\\ifcase} primitive@>
+primitive("ifprimitive",if_test,if_primitive_code);
+@!@:if_primitive_}{\.{\\ifprimitive} primitive@>
@ @<Cases of |print_cmd_chr|...@>=
if_test: begin if chr_code>=unless_code then print_esc("unless");
@@ -10687,6 +10893,7 @@ case chr_code mod unless_code of
if_true_code:print_esc("iftrue");
if_false_code:print_esc("iffalse");
if_case_code:print_esc("ifcase");
+ if_primitive_code:print_esc("ifprimitive");
@/@<Cases of |if_test| for |print_cmd_chr|@>@/
othercases print_esc("if")
endcases;
@@ -10813,6 +11020,7 @@ which is a recursive procedure.
@p procedure conditional;
label exit,common_ending;
var b:boolean; {is the condition true?}
+@!e:boolean; {keep track of nested csnames}
@!r:"<"..">"; {relation to be evaluated}
@!m,@!n:integer; {to be tested against the second operand}
@!p,@!q:pointer; {for traversing token lists in \.{\\ifx} tests}
@@ -10870,6 +11078,20 @@ if_false_code: b:=false;
@/@<Cases for |conditional|@>@/
if_case_code: @<Select the appropriate case
and |return| or |goto common_ending|@>;
+if_primitive_code: begin
+ save_scanner_status:=scanner_status;
+ scanner_status:=normal;
+ get_next;
+ scanner_status:=save_scanner_status;
+ if cur_cs < hash_base then
+ m := prim_lookup(cur_cs-257)
+ else
+ m := prim_lookup(text(cur_cs));
+ b :=((cur_cmd<>undefined_cs) and
+ (m<>undefined_primitive) and
+ (cur_cmd=prim_eq_type(m)) and
+ (cur_chr=prim_equiv(m)));
+ end;
end {there are no other cases}
@ @<Display the value of |b|@>=
@@ -13586,6 +13808,9 @@ that a \.{DVI}-reading program will push onto its coordinate stack.
@d fin_rule=14 {go to this label to finish processing a rule}
@d next_p=15 {go to this label when finished with node |p|}
+@d check_next=1236
+@d end_node_run=1237
+
@p @t\4@>@<Declare procedures needed in |hlist_out|, |vlist_out|@>@t@>@/
procedure hlist_out; {output an |hlist_node| box}
label reswitch, move_past, fin_rule, next_p;
@@ -13603,12 +13828,17 @@ var base_line: scaled; {the baseline coordinate for this box}
@!outer_doing_leaders:boolean; {were we doing leaders?}
@!edge:scaled; {right edge of sub-box or leader space}
@!prev_p:pointer; {one step behind |p|}
+@!len: integer; { length of scratch string for native word output }
+@!q,@!r: pointer;
+@!k,@!j: integer;
@!glue_temp:real; {glue value before rounding}
@!cur_glue:real; {glue seen so far}
@!cur_g:scaled; {rounded equivalent of |cur_glue| times the glue ratio}
begin cur_g:=0; cur_glue:=float_constant(0);
this_box:=temp_ptr; g_order:=glue_order(this_box);
-g_sign:=glue_sign(this_box); p:=list_ptr(this_box);
+g_sign:=glue_sign(this_box);
+@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>;
+p:=list_ptr(this_box);
incr(cur_s);
if cur_s>0 then dvi_out(push);
if cur_s>max_push then max_push:=cur_s;
@@ -13624,6 +13854,99 @@ if cur_s>0 then dvi_pop(save_loc);
decr(cur_s);
end;
+@ Extra stuff for justifiable AAT text; need to merge runs of words and normal spaces.
+
+@d is_native_word_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = native_word_node))
+@d is_glyph_node(#) == ((not is_char_node(#)) and (type(#) = whatsit_node) and (subtype(#) = glyph_node))
+
+@<Merge sequences of words using AAT fonts and inter-word spaces into single nodes@>=
+p := list_ptr(this_box);
+prev_p := this_box+list_offset;
+while p<>null do begin
+ if link(p) <> null then begin {not worth looking ahead at the end}
+ if is_native_word_node(p) and (font_area[native_font(p)] = aat_font_flag)
+ and (font_letter_space[native_font(p)] = 0) then begin
+ {got a word in an AAT font, might be the start of a run}
+ r := p; {|r| is start of possible run}
+ k := native_length(r);
+ q := link(p);
+check_next:
+ @<Advance |q| past ignorable nodes@>;
+ if (q <> null) and not is_char_node(q) then begin
+ if (type(q) = glue_node) and (subtype(q) = normal) and (glue_ptr(q) = font_glue[native_font(r)]) then begin
+ {found a normal space; if the next node is another word in the same font, we'll merge}
+ q := link(q);
+ @<Advance |q| past ignorable nodes@>;
+ if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
+ p := q; {record new tail of run in |p|}
+ k := k + 1 + native_length(q);
+ q := link(q);
+ goto check_next;
+ end;
+ goto end_node_run;
+ end;
+ {@@<Advance |q| past ignorable nodes@@>;}
+ if (q <> null) and is_native_word_node(q) and (native_font(q) = native_font(r)) then begin
+ p := q; {record new tail of run in |p|}
+ q := link(q);
+ goto check_next;
+ end
+ end;
+end_node_run: {now |r| points to first |native_word_node| of the run, and |p| to the last}
+ if p <> r then begin {merge nodes from |r| to |p| inclusive; total text length is |k|}
+ str_room(k);
+ k := 0; {now we'll use this as accumulator for total width}
+ q := r;
+ loop begin
+ if type(q) = whatsit_node then begin
+ if subtype(q) = native_word_node then begin
+ for j := 0 to native_length(q)-1 do
+ append_char(get_native_char(q, j));
+ k := k + width(q);
+ end
+ end else if type(q) = glue_node then begin
+ append_char(" ");
+ g := glue_ptr(q);
+ k := k + width(g);
+ if g_sign <> normal then begin
+ if g_sign = stretching then begin
+ if stretch_order(g) = g_order then begin
+ k := k + round(float(glue_set(this_box)) * stretch(g))
+ end
+ end else begin
+ if shrink_order(g) = g_order then begin
+ k := k - round(float(glue_set(this_box)) * shrink(g))
+ end
+ end
+ end
+ end;
+ {discretionary and deleted nodes can be discarded here}
+ if q = p then break
+ else q := link(q);
+ end;
+done:
+ q := new_native_word_node(native_font(r), cur_length);
+ link(prev_p) := q;
+ for j := 0 to cur_length - 1 do
+ set_native_char(q, j, str_pool[str_start_macro(str_ptr) + j]);
+ link(q) := link(p);
+ link(p) := null;
+ flush_node_list(r);
+ width(q) := k;
+ set_justified_native_glyphs(q);
+ p := q;
+ pool_ptr := str_start_macro(str_ptr); {flush the temporary string data}
+ end
+ end;
+ prev_p := p;
+ end;
+ p := link(p);
+end
+
+@ @<Advance |q| past ignorable nodes@>=
+while (q <> null) and (not is_char_node(q)) and (type(q) = disc_node) do
+ q := link(q)
+
@ We ought to give special care to the efficiency of one part of |hlist_out|,
since it belongs to \TeX's inner loop. When a |char_node| is encountered,
we save a little time by processing several nodes in succession until
@@ -13634,6 +13957,7 @@ reaching a non-|char_node|. The program uses the fact that |set_char_0=0|.
reswitch: if is_char_node(p) then
begin synch_h; synch_v;
repeat f:=font(p); c:=character(p);
+ if (p<>lig_trick) and (font_mapping[f]<>nil) then c:=apply_tfm_font_mapping(font_mapping[f],c);
if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
if c>=qi(128) then dvi_out(set1);
dvi_out(qo(c));@/
@@ -13664,6 +13988,13 @@ rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
end;
whatsit_node: @<Output the whatsit node |p| in an hlist@>;
glue_node: @<Move right or output leaders@>;
+margin_kern_node: begin
+{ if subtype(p) = right_side then }
+{ pdf_DEBUG_int("right margin kern:", width(p)) }
+{ else }
+{ pdf_DEBUG_int("left margin kern:", width(p)); }
+ cur_h:=cur_h+width(p);
+end;
kern_node:cur_h:=cur_h+width(p);
math_node: @<Handle a math node in |hlist_out|@>;
ligature_node: @<Make node |p| look like a |char_node| and |goto reswitch|@>;
@@ -13847,12 +14178,12 @@ rule_node: begin rule_ht:=height(p); rule_dp:=depth(p); rule_wd:=width(p);
end;
whatsit_node: @<Output the whatsit node |p| in a vlist@>;
glue_node: @<Move down or output leaders@>;
-kern_node:cur_v:=cur_v+width(p);
+kern_node:if upwards then cur_v:=cur_v-width(p) else cur_v:=cur_v+width(p);
othercases do_nothing
endcases;@/
goto next_p;
fin_rule: @<Output a rule in a vlist, |goto next_p|@>;
-move_past: cur_v:=cur_v+rule_ht;
+move_past: if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht;
end
@ The |synch_v| here allows the \.{DVI} output to use one-byte commands
@@ -13874,7 +14205,7 @@ else begin cur_v:=cur_v+height(p); synch_v;
@ @<Output a rule in a vlist...@>=
if is_running(rule_wd) then rule_wd:=width(this_box);
rule_ht:=rule_ht+rule_dp; {this is the rule thickness}
-cur_v:=cur_v+rule_ht;
+if upwards then cur_v:=cur_v-rule_ht else cur_v:=cur_v+rule_ht;
if (rule_ht>0)and(rule_wd>0) then {we don't output empty rules}
begin if cur_dir=right_to_left then cur_h:=cur_h-rule_wd;
synch_h; synch_v;
@@ -13966,7 +14297,9 @@ var page_loc:integer; {location of the current |bop|}
@!j,@!k:0..9; {indices to first ten count registers}
@!s:pool_pointer; {index into |str_pool|}
@!old_setting:0..max_selector; {saved |selector| setting}
-begin if tracing_output>0 then
+begin
+if job_name=0 then open_log_file;
+if tracing_output>0 then
begin print_nl(""); print_ln;
print("Completed box being shipped out");
@.Completed box...@>
@@ -14017,7 +14350,24 @@ page_loc:=dvi_offset+dvi_ptr;
dvi_out(bop);
for k:=0 to 9 do dvi_four(count(k));
dvi_four(last_bop); last_bop:=page_loc;
-cur_v:=height(p)+v_offset; temp_ptr:=p;
+{ generate a pagesize special at start of page }
+old_setting:=selector; selector:=new_string;
+print("pdf:pagesize ");
+if (pdf_page_width > 0) and (pdf_page_height > 0) then begin
+ print("width"); print(" ");
+ print_scaled(pdf_page_width);
+ print("pt"); print(" ");
+ print("height"); print(" ");
+ print_scaled(pdf_page_height);
+ print("pt");
+end else
+ print("default");
+selector:=old_setting;
+dvi_out(xxx1); dvi_out(cur_length);
+for s:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[s]));
+pool_ptr:=str_start_macro(str_ptr); {erase the string}
+cur_v:=height(p)+v_offset; { does this need changing for upwards mode ???? }
+temp_ptr:=p;
if type(p)=vlist_node then vlist_out@+else hlist_out;
dvi_out(eop); incr(total_pages); cur_s:=-1;
done:
@@ -14190,10 +14540,80 @@ location |adjust_tail|.
@ @<Set init...@>=adjust_tail:=null; last_badness:=0;
+@ Some stuff for character protrusion.
+
+@d left_pw(#) == char_pw(#, left_side)
+@d right_pw(#) == char_pw(#, right_side)
+
+@p
+function char_pw(p: pointer; side: small_number): scaled;
+var f: internal_font_number;
+ c: integer;
+begin
+ char_pw := 0;
+ if side = left_side then
+ last_leftmost_char := null
+ else
+ last_rightmost_char := null;
+ if p = null then
+ return;
+
+ { native word }
+ if is_native_word_node(p) then begin
+ if native_glyph_info_ptr(p) <> null_ptr then begin
+ f := native_font(p);
+ char_pw := round_xn_over_d(quad(f), get_native_word_cp(p, side), 1000);
+ end;
+ return;
+ end;
+
+ { glyph node }
+ if is_glyph_node(p) then begin
+ f := native_font(p);
+ char_pw := round_xn_over_d(quad(f), get_cp_code(f, native_glyph(p), side), 1000);
+ return;
+ end;
+
+ { char node or ligature; same like pdftex }
+ if not is_char_node(p) then begin
+ if type(p) = ligature_node then
+ p := lig_char(p)
+ else
+ return;
+ end;
+ f := font(p);
+ c := get_cp_code(f, character(p), side);
+ case side of
+ left_side:
+ last_leftmost_char := p;
+ right_side:
+ last_rightmost_char := p;
+ endcases;
+ if c = 0 then
+ return;
+ char_pw :=
+ round_xn_over_d(quad(f), c, 1000);
+end;
+
+function new_margin_kern(w: scaled; p: pointer; side: small_number): pointer;
+var k: pointer;
+begin
+ k := get_node(margin_kern_node_size);
+ type(k) := margin_kern_node;
+ subtype(k) := side;
+ width(k) := w;
+{ if p = null then }
+{ pdf_error("margin kerning", "invalid pointer to marginal char node"); }
+{ fast_get_avail(margin_char(k)); }
+{ character(margin_char(k)) := character(p); }
+{ font(margin_char(k)) := font(p); }
+ new_margin_kern := k;
+end;
+
@ Here now is |hpack|, which contains few if any surprises.
@p function hpack(@!p:pointer;@!w:scaled;@!m:small_number):pointer;
-label reswitch, common_ending, exit;
+label reswitch, common_ending, exit, restart;
var r:pointer; {the box node that will be returned}
@!q:pointer; {trails behind |p|}
@!h,@!d,@!x:scaled; {height, depth, and natural width}
@@ -14203,6 +14623,8 @@ var r:pointer; {the box node that will be returned}
@!f:internal_font_number; {the font in a |char_node|}
@!i:four_quarters; {font information about a |char_node|}
@!hd:eight_bits; {height and depth indices for a character}
+@!pp,@!ppp: pointer;
+@!total_chars, @!k: integer;
begin last_badness:=0; r:=get_node(box_node_size); type(r):=hlist_node;
subtype(r):=min_quarterword; shift_amount(r):=0;
q:=r+list_offset; link(q):=p;@/
@@ -14212,6 +14634,7 @@ while p<>null do @<Examine node |p| in the hlist, taking account of its effect
on the dimensions of the new box, or moving it to the adjustment list;
then advance |p| to the next node@>;
if adjust_tail<>null then link(adjust_tail):=null;
+if pre_adjust_tail<>null then link(pre_adjust_tail):=null;
height(r):=h; depth(r):=d;@/
@<Determine the value of |width(r)| and the appropriate glue setting;
then |return| or |goto common_ending|@>;
@@ -14238,11 +14661,12 @@ if p<>null then
hlist_node,vlist_node,rule_node,unset_node:
@<Incorporate box dimensions into the dimensions of
the hbox that will contain~it@>;
- ins_node,mark_node,adjust_node: if adjust_tail<>null then
+ ins_node,mark_node,adjust_node: if (adjust_tail<>null) or (pre_adjust_tail<> null) then
@<Transfer node |p| to the adjustment list@>;
whatsit_node:@<Incorporate a whatsit node into an hbox@>;
glue_node:@<Incorporate glue into the horizontal totals@>;
kern_node: x:=x+width(p);
+ margin_kern_node: x:=x+width(p);
math_node: begin x:=x+width(p);
if TeXXeT_en then @<Adjust \(t)the LR stack for the |hpack| routine@>;
end;
@@ -14257,7 +14681,7 @@ end
@ @<Make node |p| look like a |char_node| and |goto reswitch|@>=
begin mem[lig_trick]:=mem[lig_char(p)]; link(lig_trick):=link(p);
-p:=lig_trick; goto reswitch;
+p:=lig_trick; xtx_ligature_present:=true; goto reswitch;
end
@ The code here implicitly uses the fact that running dimensions are
@@ -14291,13 +14715,32 @@ extra computation does not intrude on the inner loop unless it is necessary
to make a deletion.
@^inner loop@>
+@<Glob...@>=
+@!pre_adjust_tail: pointer;
+
+@ @<Set init...@>=
+pre_adjust_tail := null;
+
+@ Materials in \.{\\vadjust} used with \.{pre} keyword will be appended to
+|pre_adjust_tail| instead of |adjust_tail|.
+
+@d update_adjust_list(#) == begin
+ if # = null then
+ confusion("pre vadjust");
+ link(#) := adjust_ptr(p);
+ while link(#) <> null do
+ # := link(#);
+end
+
@<Transfer node |p| to the adjustment list@>=
begin while link(q)<>p do q:=link(q);
-if type(p)=adjust_node then
- begin link(adjust_tail):=adjust_ptr(p);
- while link(adjust_tail)<>null do adjust_tail:=link(adjust_tail);
- p:=link(p); free_node(link(q),small_node_size);
- end
+ if type(p) = adjust_node then begin
+ if adjust_pre(p) <> 0 then
+ update_adjust_list(pre_adjust_tail)
+ else
+ update_adjust_list(adjust_tail);
+ p := link(p); free_node(link(q), small_node_size);
+ end
else begin link(adjust_tail):=p; adjust_tail:=p; p:=link(p);
end;
link(q):=p; p:=q;
@@ -14455,7 +14898,8 @@ var r:pointer; {the box node that will be returned}
@!g:pointer; {points to a glue specification}
@!o:glue_ord; {order of infinity}
begin last_badness:=0; r:=get_node(box_node_size); type(r):=vlist_node;
-subtype(r):=min_quarterword; shift_amount(r):=0;
+if XeTeX_upwards then subtype(r):=min_quarterword+1 else subtype(r):=min_quarterword;
+shift_amount(r):=0;
list_ptr(r):=p;@/
w:=0; @<Clear dimensions to zero@>;
while p<>null do @<Examine node |p| in the vlist, taking account of its effect
@@ -14603,15 +15047,18 @@ baselineskip calculation is handled by the |append_to_vlist| routine.
@p procedure append_to_vlist(@!b:pointer);
var d:scaled; {deficiency of space between baselines}
@!p:pointer; {a new glue node}
-begin if prev_depth>ignore_depth then
- begin d:=width(baseline_skip)-prev_depth-height(b);
+@!upwards:boolean;
+begin upwards:=XeTeX_upwards;
+ if prev_depth>ignore_depth then
+ begin if upwards then d:=width(baseline_skip)-prev_depth-depth(b)
+ else d:=width(baseline_skip)-prev_depth-height(b);
if d<line_skip_limit then p:=new_param_glue(line_skip_code)
else begin p:=new_skip_param(baseline_skip_code);
width(temp_ptr):=d; {|temp_ptr=glue_ptr(p)|}
end;
link(tail):=p; tail:=p;
end;
-link(tail):=b; tail:=b; prev_depth:=depth(b);
+link(tail):=b; tail:=b; if upwards then prev_depth:=height(b) else prev_depth:=depth(b);
end;
@* \[34] Data structures for math mode.
@@ -14706,7 +15153,8 @@ programming.
@d supscr(#)==#+2 {the |supscr| field of a noad}
@d subscr(#)==#+3 {the |subscr| field of a noad}
@d math_type==link {a |halfword| in |mem|}
-@d fam==font {a |quarterword| in |mem|}
+@d plane_and_fam_field==font {a |quarterword| in |mem|}
+@d fam(#) == (plane_and_fam_field(#) mod @"100)
@d math_char=1 {|math_type| when the attribute is simple}
@d sub_box=2 {|math_type| when the attribute is a box}
@d sub_mlist=3 {|math_type| when the attribute is a formula}
@@ -14774,10 +15222,14 @@ be placed at the left and right of the fraction. In this way, a
@d radical_noad_size=5 {number of |mem| words in a radical noad}
@d fraction_noad=radical_noad+1 {|type| of a noad for generalized fractions}
@d fraction_noad_size=6 {number of |mem| words in a fraction noad}
-@d small_fam(#)==mem[#].qqqq.b0 {|fam| for ``small'' delimiter}
-@d small_char(#)==mem[#].qqqq.b1 {|character| for ``small'' delimiter}
-@d large_fam(#)==mem[#].qqqq.b2 {|fam| for ``large'' delimiter}
-@d large_char(#)==mem[#].qqqq.b3 {|character| for ``large'' delimiter}
+@d small_fam(#)==(mem[#].qqqq.b0 mod @"100) {|fam| for ``small'' delimiter}
+@d small_char(#)==(mem[#].qqqq.b1 + (mem[#].qqqq.b0 div @"100) * @"10000) {|character| for ``small'' delimiter}
+@d large_fam(#)==(mem[#].qqqq.b2 mod @"100) {|fam| for ``large'' delimiter}
+@d large_char(#)==(mem[#].qqqq.b3 + (mem[#].qqqq.b2 div @"100) * @"10000) {|character| for ``large'' delimiter}
+@d small_plane_and_fam_field(#)==mem[#].qqqq.b0
+@d small_char_field(#)==mem[#].qqqq.b1
+@d large_plane_and_fam_field(#)==mem[#].qqqq.b2
+@d large_char_field(#)==mem[#].qqqq.b3
@d thickness==width {|thickness| field in a fraction noad}
@d default_code==@'10000000000 {denotes |default_rule_thickness|}
@d numerator==supscr {|numerator| field in a fraction noad}
@@ -14829,6 +15281,9 @@ fields are always |empty| in a |left_noad| and a |right_noad|.
@d under_noad=fraction_noad+1 {|type| of a noad for underlining}
@d over_noad=under_noad+1 {|type| of a noad for overlining}
@d accent_noad=over_noad+1 {|type| of a noad for accented subformulas}
+@d fixed_acc=1 {|subtype| for non growing math accents}
+@d bottom_acc=2 {|subtype| for bottom math accents}
+@d is_bottom_acc(#)==((subtype(#)=bottom_acc) or (subtype(#)=bottom_acc+fixed_acc))
@d accent_noad_size=5 {number of |mem| words in an accent noad}
@d accent_chr(#)==#+4 {the |accent_chr| field of an accent noad}
@d vcenter_noad=accent_noad+1 {|type| of a noad for \.{\\vcenter}}
@@ -14914,8 +15369,8 @@ fraction_noad:@<Display fraction noad |p|@>;
@<Declare procedures needed for displaying the elements of mlists@>=
procedure print_fam_and_char(@!p:pointer); {prints family and character}
-begin print_esc("fam"); print_int(fam(p)); print_char(" ");
-print_ASCII(qo(character(p)));
+begin print_esc("fam"); print_int(fam(p) mod @"100); print_char(" ");
+print_ASCII(qo(character(p)) + (fam(p) div @"100) * @"10000);
end;
@#
procedure print_delimiter(@!p:pointer); {prints a delimiter as 24-bit hex value}
@@ -15100,42 +15555,145 @@ following macros, which take a size code as their parameter; for example,
@^parameters for symbols@>
@^font parameters@>
-@d mathsy_end(#)==fam_fnt(2+#)]].sc
-@d mathsy(#)==font_info[#+param_base[mathsy_end
-@d math_x_height==mathsy(5) {height of `\.x'}
-@d math_quad==mathsy(6) {\.{18mu}}
-@d num1==mathsy(8) {numerator shift-up in display styles}
-@d num2==mathsy(9) {numerator shift-up in non-display, non-\.{\\atop}}
-@d num3==mathsy(10) {numerator shift-up in non-display \.{\\atop}}
-@d denom1==mathsy(11) {denominator shift-down in display styles}
-@d denom2==mathsy(12) {denominator shift-down in non-display styles}
-@d sup1==mathsy(13) {superscript shift-up in uncramped display style}
-@d sup2==mathsy(14) {superscript shift-up in uncramped non-display}
-@d sup3==mathsy(15) {superscript shift-up in cramped styles}
-@d sub1==mathsy(16) {subscript shift-down if superscript is absent}
-@d sub2==mathsy(17) {subscript shift-down if superscript is present}
-@d sup_drop==mathsy(18) {superscript baseline below top of large box}
-@d sub_drop==mathsy(19) {subscript baseline below bottom of large box}
-@d delim1==mathsy(20) {size of \.{\\atopwithdelims} delimiters
- in display styles}
-@d delim2==mathsy(21) {size of \.{\\atopwithdelims} delimiters in non-displays}
-@d axis_height==mathsy(22) {height of fraction lines above the baseline}
+NB: the access functions here must all put the font \# into /f/ for mathsy().
+
+The accessors are defined with
+|define_mathsy_accessor(NAME)(fontdimen-number)(NAME)|
+because I can't see how to only give the name once, with WEB's limited
+macro capabilities. This seems a bit ugly, but it works.
+
@d total_mathsy_params=22
+{the following are OpenType MATH constant indices for use with OT math fonts}
+@d scriptPercentScaleDown = 0
+@d scriptScriptPercentScaleDown = 1
+@d delimitedSubFormulaMinHeight = 2
+@d displayOperatorMinHeight = 3
+@d mathLeading = 4
+@d firstMathValueRecord = mathLeading
+@d axisHeight = 5
+@d accentBaseHeight = 6
+@d flattenedAccentBaseHeight = 7
+@d subscriptShiftDown = 8
+@d subscriptTopMax = 9
+@d subscriptBaselineDropMin = 10
+@d superscriptShiftUp = 11
+@d superscriptShiftUpCramped = 12
+@d superscriptBottomMin = 13
+@d superscriptBaselineDropMax = 14
+@d subSuperscriptGapMin = 15
+@d superscriptBottomMaxWithSubscript = 16
+@d spaceAfterScript = 17
+@d upperLimitGapMin = 18
+@d upperLimitBaselineRiseMin = 19
+@d lowerLimitGapMin = 20
+@d lowerLimitBaselineDropMin = 21
+@d stackTopShiftUp = 22
+@d stackTopDisplayStyleShiftUp = 23
+@d stackBottomShiftDown = 24
+@d stackBottomDisplayStyleShiftDown = 25
+@d stackGapMin = 26
+@d stackDisplayStyleGapMin = 27
+@d stretchStackTopShiftUp = 28
+@d stretchStackBottomShiftDown = 29
+@d stretchStackGapAboveMin = 30
+@d stretchStackGapBelowMin = 31
+@d fractionNumeratorShiftUp = 32
+@d fractionNumeratorDisplayStyleShiftUp = 33
+@d fractionDenominatorShiftDown = 34
+@d fractionDenominatorDisplayStyleShiftDown = 35
+@d fractionNumeratorGapMin = 36
+@d fractionNumDisplayStyleGapMin = 37
+@d fractionRuleThickness = 38
+@d fractionDenominatorGapMin = 39
+@d fractionDenomDisplayStyleGapMin = 40
+@d skewedFractionHorizontalGap = 41
+@d skewedFractionVerticalGap = 42
+@d overbarVerticalGap = 43
+@d overbarRuleThickness = 44
+@d overbarExtraAscender = 45
+@d underbarVerticalGap = 46
+@d underbarRuleThickness = 47
+@d underbarExtraDescender = 48
+@d radicalVerticalGap = 49
+@d radicalDisplayStyleVerticalGap = 50
+@d radicalRuleThickness = 51
+@d radicalExtraAscender = 52
+@d radicalKernBeforeDegree = 53
+@d radicalKernAfterDegree = 54
+@d lastMathValueRecord = radicalKernAfterDegree
+@d radicalDegreeBottomRaisePercent = 55
+@d lastMathConstant = radicalDegreeBottomRaisePercent
+
+
+@d mathsy(#)==font_info[#+param_base[f]].sc
+
+@d define_mathsy_end(#)==
+ # := rval;
+ end
+@d define_mathsy_body(#)==
+ var
+ f: integer;
+ rval: scaled;
+ begin
+ f := fam_fnt(2 + size_code);
+ if is_new_mathfont(cur_f) then
+ rval := get_native_mathsy_param(cur_f, #)
+ else
+ rval := mathsy(#);
+ define_mathsy_end
+@d define_mathsy_accessor(#)==function #(size_code: integer): scaled; define_mathsy_body
+
+@p define_mathsy_accessor(math_x_height)(5)(math_x_height);
+define_mathsy_accessor(math_quad)(6)(math_quad);
+define_mathsy_accessor(num1)(8)(num1);
+define_mathsy_accessor(num2)(9)(num2);
+define_mathsy_accessor(num3)(10)(num3);
+define_mathsy_accessor(denom1)(11)(denom1);
+define_mathsy_accessor(denom2)(12)(denom2);
+define_mathsy_accessor(sup1)(13)(sup1);
+define_mathsy_accessor(sup2)(14)(sup2);
+define_mathsy_accessor(sup3)(15)(sup3);
+define_mathsy_accessor(sub1)(16)(sub1);
+define_mathsy_accessor(sub2)(17)(sub2);
+define_mathsy_accessor(sup_drop)(18)(sup_drop);
+define_mathsy_accessor(sub_drop)(19)(sub_drop);
+define_mathsy_accessor(delim1)(20)(delim1);
+define_mathsy_accessor(delim2)(21)(delim2);
+define_mathsy_accessor(axis_height)(22)(axis_height);
+
@ The math-extension parameters have similar macros, but the size code is
omitted (since it is always |cur_size| when we refer to such parameters).
@^parameters for symbols@>
@^font parameters@>
-@d mathex(#)==font_info[#+param_base[fam_fnt(3+cur_size)]].sc
-@d default_rule_thickness==mathex(8) {thickness of \.{\\over} bars}
-@d big_op_spacing1==mathex(9) {minimum clearance above a displayed op}
-@d big_op_spacing2==mathex(10) {minimum clearance below a displayed op}
-@d big_op_spacing3==mathex(11) {minimum baselineskip above displayed op}
-@d big_op_spacing4==mathex(12) {minimum baselineskip below displayed op}
-@d big_op_spacing5==mathex(13) {padding above and below displayed limits}
@d total_mathex_params=13
+@d mathex(#)==font_info[#+param_base[f]].sc
+
+@d define_mathex_end(#)==
+ # := rval;
+ end
+@d define_mathex_body(#)==
+ var
+ f: integer;
+ rval: scaled;
+ begin
+ f := fam_fnt(3 + cur_size);
+ if is_new_mathfont(cur_f) then
+ rval := get_native_mathex_param(cur_f, #)
+ else
+ rval := mathex(#);
+ define_mathex_end
+@d define_mathex_accessor(#)==function #:scaled; define_mathex_body
+
+@p define_mathex_accessor(default_rule_thickness)(8)(default_rule_thickness);
+define_mathex_accessor(big_op_spacing1)(9)(big_op_spacing1);
+define_mathex_accessor(big_op_spacing2)(10)(big_op_spacing2);
+define_mathex_accessor(big_op_spacing3)(11)(big_op_spacing3);
+define_mathex_accessor(big_op_spacing4)(12)(big_op_spacing4);
+define_mathex_accessor(big_op_spacing5)(13)(big_op_spacing5);
+
@ We also need to compute the change in style between mlists and their
subsidiaries. The following macros define the subsidiary style for
an overlined nucleus (|cramped_style|), for a subscript or a superscript
@@ -15153,7 +15711,7 @@ information:
@<Set up the values of |cur_size| and |cur_mu|, based on |cur_style|@>=
begin if cur_style<script_style then cur_size:=text_size
-else cur_size:=16*((cur_style-text_style) div 2);
+else cur_size:=script_size*((cur_style-text_style) div 2);
cur_mu:=x_over_n(math_quad(cur_size),18);
end
@@ -15193,9 +15751,161 @@ If a built-up symbol is returned, the height of the box before shifting
will be the height of its topmost component.
@p@t\4@>@<Declare subprocedures for |var_delimiter|@>
-function var_delimiter(@!d:pointer;@!s:small_number;@!v:scaled):pointer;
+procedure stack_glyph_into_box(@!b:pointer;@!f:internal_font_number;@!g:integer);
+var p,q:pointer;
+begin
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=f; native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ if type(b)=hlist_node then begin
+ q:=list_ptr(b);
+ if q=null then list_ptr(b):=p else begin
+ while link(q)<>null do q:=link(q);
+ link(q):=p;
+ if (height(b) < height(p)) then height(b):=height(p);
+ if (depth(b) < depth(p)) then depth(b):=depth(p);
+ end;
+ end else begin
+ link(p):=list_ptr(b); list_ptr(b):=p;
+ height(b):=height(p);
+ if (width(b) < width(p)) then width(b):=width(p);
+ end;
+end;
+
+procedure stack_glue_into_box(@!b:pointer;@!min,max:scaled);
+var p,q:pointer;
+begin
+ q:=new_spec(zero_glue);
+ width(q):=min;
+ stretch(q):=max-min;
+ p:=new_glue(q);
+ if type(b)=hlist_node then begin
+ q:=list_ptr(b);
+ if q=null then list_ptr(b):=p else begin
+ while link(q)<>null do q:=link(q);
+ link(q):=p;
+ end;
+ end else begin
+ link(p):=list_ptr(b); list_ptr(b):=p;
+ height(b):=height(p); width(b):=width(p);
+ end;
+end;
+
+function build_opentype_assembly(@!f:internal_font_number;@!a:void_pointer;@!s:scaled;@!horiz:boolean):pointer;
+ {return a box with height/width at least |s|, using font |f|, with glyph assembly info from |a|}
+var
+ b:pointer; {the box we're constructing}
+ n:integer; {the number of repetitions of each extender}
+ i,j:integer; {indexes}
+ g:integer; {glyph code}
+ p:pointer; {temp pointer}
+ s_max,o,oo,prev_o,min_o:scaled;
+ no_extenders: boolean;
+ nat,str:scaled; {natural size, stretch}
+begin
+ b:=new_null_box;
+ if horiz then
+ type(b):=hlist_node
+ else
+ type(b):=vlist_node;
+
+ {figure out how many repeats of each extender to use}
+ n:=-1;
+ no_extenders:=true;
+ min_o:=ot_min_connector_overlap(f);
+ repeat
+ n:=n+1;
+ {calc max possible size with this number of extenders}
+ s_max:=0;
+ prev_o:=0;
+ for i:=0 to ot_part_count(a)-1 do begin
+ if ot_part_is_extender(a, i) then begin
+ no_extenders:=false;
+ for j:=1 to n do begin
+ o:=ot_part_start_connector(f, a, i);
+ if min_o<o then o:=min_o;
+ if prev_o<o then o:=prev_o;
+ s_max:=s_max-o+ot_part_full_advance(f, a, i);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end
+ end else begin
+ o:=ot_part_start_connector(f, a, i);
+ if min_o<o then o:=min_o;
+ if prev_o<o then o:=prev_o;
+ s_max:=s_max-o+ot_part_full_advance(f, a, i);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end;
+ end;
+ until (s_max>=s) or no_extenders;
+
+ {assemble box using |n| copies of each extender,
+ with appropriate glue wherever an overlap occurs}
+ prev_o:=0;
+ for i:=0 to ot_part_count(a)-1 do begin
+ if ot_part_is_extender(a, i) then begin
+ for j:=1 to n do begin
+ o:=ot_part_start_connector(f, a, i);
+ if prev_o<o then o:=prev_o;
+ oo:=o; {max overlap}
+ if min_o<o then o:=min_o;
+ if oo>0 then stack_glue_into_box(b, -oo, -o);
+ g:=ot_part_glyph(a, i);
+ stack_glyph_into_box(b, f, g);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end
+ end else begin
+ o:=ot_part_start_connector(f, a, i);
+ if prev_o<o then o:=prev_o;
+ oo:=o; {max overlap}
+ if min_o<o then o:=min_o;
+ if oo>0 then stack_glue_into_box(b, -oo, -o);
+ g:=ot_part_glyph(a, i);
+ stack_glyph_into_box(b, f, g);
+ prev_o:=ot_part_end_connector(f, a, i);
+ end;
+ end;
+
+ {find natural size and total stretch of the box}
+ p:=list_ptr(b); nat:=0; str:=0;
+ while p<>null do begin
+ if type(p)=whatsit_node then begin
+ if horiz then
+ nat:=nat+width(p)
+ else
+ nat:=nat+height(p)+depth(p);
+ end else if type(p)=glue_node then begin
+ nat:=nat+width(glue_ptr(p));
+ str:=str+stretch(glue_ptr(p));
+ end;
+ p:=link(p);
+ end;
+
+ {set glue so as to stretch the connections if needed}
+ o:=0;
+ if (s>nat) and (str>0) then begin
+ o:=(s-nat);
+ {don't stretch more than |str|}
+ if (o>str) then o:=str;
+ glue_order(b):=normal; glue_sign(b):=stretching;
+ glue_set(b):=unfloat(o/str);
+ if horiz then
+ width(b):= nat+round(str*float(glue_set(b)))
+ else
+ height(b):=nat+round(str*float(glue_set(b)));
+ end else
+ if horiz then
+ width(b):=nat
+ else
+ height(b):=nat;
+
+ build_opentype_assembly:=b;
+end;
+
+function var_delimiter(@!d:pointer;@!s:integer;@!v:scaled):pointer;
label found,continue;
var b:pointer; {the box that will be constructed}
+ot_assembly_ptr:void_pointer;
@!f,@!g: internal_font_number; {best-so-far and tentative font codes}
@!c,@!x,@!y: quarterword; {best-so-far and tentative character codes}
@!m,@!n: integer; {the number of extensible pieces}
@@ -15204,19 +15914,35 @@ var b:pointer; {the box that will be constructed}
@!q: four_quarters; {character info}
@!hd: eight_bits; {height-depth byte}
@!r: four_quarters; {extensible pieces}
-@!z: small_number; {runs through font family members}
+@!z: integer; {runs through font family members}
@!large_attempt: boolean; {are we trying the ``large'' variant?}
begin f:=null_font; w:=0; large_attempt:=false;
z:=small_fam(d); x:=small_char(d);
+ot_assembly_ptr:=nil;
loop@+ begin @<Look at the variants of |(z,x)|; set |f| and |c| whenever
a better character is found; |goto found| as soon as a
large enough variant is encountered@>;
if large_attempt then goto found; {there were none large enough}
large_attempt:=true; z:=large_fam(d); x:=large_char(d);
end;
-found: if f<>null_font then
- @<Make variable |b| point to a box for |(f,c)|@>
-else begin b:=new_null_box;
+found: if f<>null_font then begin
+ if not is_ot_font(f) then
+ @<Make variable |b| point to a box for |(f,c)|@>
+ else begin
+ {for OT fonts, c is the glyph ID to use}
+ if ot_assembly_ptr<>nil then
+ b:=build_opentype_assembly(f, ot_assembly_ptr, v, 0)
+ else begin
+ b:=new_null_box; type(b):=vlist_node; list_ptr(b):=get_node(glyph_node_size);
+ type(list_ptr(b)):=whatsit_node; subtype(list_ptr(b)):=glyph_node;
+ native_font(list_ptr(b)):=f; native_glyph(list_ptr(b)):=c;
+ set_native_glyph_metrics(list_ptr(b), 1);
+ width(b):=width(list_ptr(b));
+ height(b):=height(list_ptr(b));
+ depth(b):=depth(list_ptr(b));
+ end
+ end
+end else begin b:=new_null_box;
width(b):=null_delimiter_space; {use this width if no delimiter was found}
end;
shift_amount(b):=half(height(b)-depth(b)) - axis_height(s);
@@ -15229,17 +15955,34 @@ be probed in increasing order of height.
@<Look at the variants of |(z,x)|; set |f| and |c|...@>=
if (z<>0)or(x<>min_quarterword) then
- begin z:=z+s+16;
- repeat z:=z-16; g:=fam_fnt(z);
+ begin z:=z+s+script_size;
+ repeat z:=z-script_size; g:=fam_fnt(z);
if g<>null_font then
@<Look at the list of characters starting with |x| in
font |g|; set |f| and |c| whenever
a better character is found; |goto found| as soon as a
large enough variant is encountered@>;
- until z<16;
+ until z<script_size;
end
@ @<Look at the list of characters starting with |x|...@>=
+if is_ot_font(g) then begin
+ b:=new_native_character(g, x);
+ x:=get_native_glyph(b, 0);
+ free_node(b, native_size(b));
+ f:=g; c:=x; w:=0; n:=0;
+ repeat
+ y:=get_ot_math_variant(g, x, n, addressof(u), 0);
+ if u>w then begin
+ c:=y; w:=u;
+ if u>=v then goto found;
+ end;
+ n:=n+1;
+ until u<0;
+ {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
+ ot_assembly_ptr:=get_ot_assembly_ptr(g, x, 0);
+ if ot_assembly_ptr<>nil then goto found;
+end else
begin y:=x;
if (qo(y)>=font_bc[g])and(qo(y)<=font_ec[g]) then
begin continue: q:=char_info(g)(y);
@@ -15267,14 +16010,25 @@ the height or depth of the character is negative; thus, this routine
may deliver a slightly different result than |hpack| would produce.
@<Declare subprocedures for |var_delimiter|@>=
-function char_box(@!f:internal_font_number;@!c:quarterword):pointer;
+function char_box(@!f:internal_font_number;@!c:integer):pointer;
var q:four_quarters;
@!hd:eight_bits; {|height_depth| byte}
@!b,@!p:pointer; {the new box and its character node}
-begin q:=char_info(f)(c); hd:=height_depth(q);
-b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
-height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
-p:=get_avail; character(p):=c; font(p):=f; list_ptr(b):=p; char_box:=b;
+begin
+if is_native_font(f) then begin
+ b:=new_null_box;
+ p:=new_native_character(f, c);
+ list_ptr(b):=p;
+ height(b):=height(p); width(b):=width(p);
+ if depth(p)<0 then depth(b):=0 else depth(b):=depth(p);
+ end
+else begin
+ q:=char_info(f)(c); hd:=height_depth(q);
+ b:=new_null_box; width(b):=char_width(f)(q)+char_italic(f)(q);
+ height(b):=char_height(f)(hd); depth(b):=char_depth(f)(hd);
+ p:=get_avail; character(p):=c; font(p):=f;
+ end;
+list_ptr(b):=p; char_box:=b;
end;
@ When the following code is executed, |char_tag(q)| will be equal to
@@ -15446,7 +16200,7 @@ that stresses compactness over efficiency.
@<Glob...@>=
@!cur_mlist:pointer; {beginning of mlist to be translated}
@!cur_style:small_number; {style code at current place in the list}
-@!cur_size:small_number; {size code corresponding to |cur_style|}
+@!cur_size:integer; {size code corresponding to |cur_style|}
@!cur_mu:scaled; {the math unit width corresponding to |cur_size|}
@!mlist_penalties:boolean; {should |mlist_to_hlist| insert penalties?}
@@ -15535,7 +16289,7 @@ end
@<Glob...@>=
@!cur_f:internal_font_number; {the |font| field of a |math_char|}
-@!cur_c:quarterword; {the |character| field of a |math_char|}
+@!cur_c:integer; {the |character| field of a |math_char|}
@!cur_i:four_quarters; {the |char_info| of a |math_char|,
or a lig/kern instruction}
@@ -15768,14 +16522,28 @@ placed so that the actual clearance is |clr| plus half the excess.
@<Declare math...@>=
procedure make_radical(@!q:pointer);
var x,@!y:pointer; {temporary registers for box construction}
+f:internal_font_number;
+rule_thickness:scaled; {rule thickness}
@!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);
+begin f:=fam_fnt(small_fam(left_delimiter(q)) + cur_size);
+if is_new_mathfont(f) then rule_thickness:=get_ot_math_constant(f,radicalRuleThickness)
+else rule_thickness:=default_rule_thickness;
+x:=clean_box(nucleus(q),cramped_style(cur_style));
+if is_new_mathfont(f) then begin
+ if cur_style<text_style then {display style}
+ clr:=get_ot_math_constant(f,radicalDisplayStyleVerticalGap)
+ else clr:=get_ot_math_constant(f,radicalVerticalGap);
+end else begin
+ if cur_style<text_style then {display style}
+ clr:=rule_thickness+(abs(math_x_height(cur_size)) div 4)
+ else begin clr:=rule_thickness; clr:=clr + (abs(clr) div 4);
+ end;
+end;
+y:=var_delimiter(left_delimiter(q),cur_size,height(x)+depth(x)+clr+rule_thickness);
+if is_new_mathfont(f) then begin
+ depth(y):=height(y)+depth(y)-rule_thickness;
+ height(y):=rule_thickness;
+end;
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);
@@ -15788,32 +16556,90 @@ centered over the accentee, and the accent width is treated as zero with
respect to the size of the final box.
@<Declare math...@>=
+function compute_ot_math_accent_pos(@!p:pointer):scaled;
+var
+ @!q,@!r:pointer;
+ @!s,@!g:scaled;
+begin
+ if (math_type(nucleus(p))=math_char) then begin
+ fetch(nucleus(p));
+ q:=new_native_character(cur_f, qo(cur_c));
+ g:=get_native_glyph(q, 0);
+ s:=get_ot_math_accent_pos(cur_f, g);
+ end else begin
+ if (math_type(nucleus(p))=sub_mlist) then begin
+ r:=info(nucleus(p));
+ if (r<>null) and (type(r)=accent_noad) then
+ s:=compute_ot_math_accent_pos(r)
+ else
+ s:=@"7FFFFFFF;
+ end else
+ s:=@"7FFFFFFF;
+ end;
+ compute_ot_math_accent_pos:=s;
+end;
+
procedure make_math_accent(@!q:pointer);
label done,done1;
var p,@!x,@!y:pointer; {temporary registers for box construction}
@!a:integer; {address of lig/kern instruction}
-@!c:quarterword; {accent character}
+@!c,@!g:integer; {accent character}
@!f:internal_font_number; {its font}
@!i:four_quarters; {its |char_info|}
-@!s:scaled; {amount to skew the accent to the right}
+@!s,@!sa:scaled; {amount to skew the accent to the right}
@!h:scaled; {height of character being accented}
@!delta:scaled; {space to remove between accent and accentee}
-@!w:scaled; {width of the accentee, not including sub/superscripts}
+@!w,@!w2:scaled; {width of the accentee, not including sub/superscripts}
+@!ot_assembly_ptr:void_pointer;
begin fetch(accent_chr(q));
-if char_exists(cur_i) then
+x:=null;
+if is_native_font(cur_f) then
+ begin c:=cur_c; f:=cur_f;
+ if not is_bottom_acc(q) then s:=compute_ot_math_accent_pos(q);
+ x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
+ end
+else if char_exists(cur_i) then
begin i:=cur_i; c:=cur_c; f:=cur_f;@/
@<Compute the amount of skew@>;
x:=clean_box(nucleus(q),cramped_style(cur_style)); w:=width(x); h:=height(x);
@<Switch to a larger accent if available and appropriate@>;
- if h<x_height(f) then delta:=h@+else delta:=x_height(f);
+ end;
+if x<>null then begin
+ if is_new_mathfont(f) then
+ if is_bottom_acc(q) then delta:=0
+ else if h<get_ot_math_constant(f, accentBaseHeight) then delta:=h@+else delta:=get_ot_math_constant(f, accentBaseHeight)
+ else
+ if h<x_height(f) then delta:=h@+else delta:=x_height(f);
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|@>;
y:=char_box(f,c);
- shift_amount(y):=s+half(w-width(y));
- width(y):=0; p:=new_kern(-delta); link(p):=x; link(y):=p;
- y:=vpack(y,natural); width(y):=width(x);
- if height(y)<h then @<Make the height of box |y| equal to |h|@>;
+ if is_native_font(f) then begin
+ {turn the |native_word| node into a |native_glyph| one}
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=f; native_glyph(p):=get_native_glyph(list_ptr(y), 0);
+ set_native_glyph_metrics(p, 1);
+ free_node(list_ptr(y), native_size(list_ptr(y)));
+ list_ptr(y):=p;
+
+ @<Switch to a larger native-font accent if available and appropriate@>;
+
+ {determine horiz positioning}
+ sa:=get_ot_math_accent_pos(f,native_glyph(p));
+ if sa=@"7FFFFFFF then sa:=half(width(y));
+ if is_bottom_acc(q) or (s=@"7FFFFFFF) then s:=half(w);
+ shift_amount(y):=s-sa;
+ end else
+ shift_amount(y):=s+half(w-width(y));
+ width(y):=0;
+ if is_bottom_acc(q) then begin
+ link(x):=y; y:=vpack(x,natural); shift_amount(y):=-(h - height(y));
+ end else begin
+ p:=new_kern(-delta); link(p):=x; link(y):=p; y:=vpack(y,natural);
+ if height(y)<h then @<Make the height of box |y| equal to |h|@>;
+ end;
+ width(y):=width(x);
info(nucleus(q)):=y;
math_type(nucleus(q)):=sub_box;
end;
@@ -15824,6 +16650,37 @@ begin p:=new_kern(h-height(y)); link(p):=list_ptr(y); list_ptr(y):=p;
height(y):=h;
end
+@ @<Switch to a larger native-font accent if available and appropriate@>=
+ if odd(subtype(q)) then {non growing accent}
+ set_native_glyph_metrics(p, 1)
+ else begin
+ c:=native_glyph(p);
+ a:=0;
+ repeat
+ g:=get_ot_math_variant(f, c, a, addressof(w2), 1);
+ if (w2>0) and (w2<=w) then begin
+ native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ incr(a);
+ end;
+ until (w2<0) or (w2>=w);
+ if (w2<0) then begin
+ ot_assembly_ptr:=get_ot_assembly_ptr(f, c, 1);
+ if ot_assembly_ptr<>nil then begin
+ free_node(p,glyph_node_size);
+ p:=build_opentype_assembly(cur_f, ot_assembly_ptr, w, 1);
+ list_ptr(y):=p;
+ goto found;
+ end;
+ end else
+ set_native_glyph_metrics(p, 1);
+ end;
+found:
+ width(y):=width(p); height(y):=height(p); depth(y):=depth(p);
+ if is_bottom_acc(q) then begin
+ if height(y)<0 then height(y):=0
+ end else if depth(y)<0 then depth(y):=0;
+
@ @<Switch to a larger accent if available and appropriate@>=
loop@+ begin if char_tag(i)<>list_tag then goto done;
y:=rem_byte(i);
@@ -15908,8 +16765,13 @@ clearance, called |clr| in the following program. The difference between
|clr| and the actual clearance is |2delta|.
@<Adjust \(s)|shift_up| and |shift_down| for the case of no fraction line@>=
-begin if cur_style<text_style then clr:=7*default_rule_thickness
-else clr:=3*default_rule_thickness;
+begin if is_new_mathfont(cur_f) then begin
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, stackDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, stackGapMin);
+end else begin
+ if cur_style<text_style then clr:=7*default_rule_thickness
+ else clr:=3*default_rule_thickness;
+end;
delta:=half(clr-((shift_up-depth(x))-(height(z)-shift_down)));
if delta>0 then
begin shift_up:=shift_up+delta;
@@ -15921,11 +16783,21 @@ end
thickness of the line.
@<Adjust \(s)|shift_up| and |shift_down| for the case of a fraction line@>=
-begin if cur_style<text_style then clr:=3*thickness(q)
-else clr:=thickness(q);
-delta:=half(thickness(q));
-delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
-delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+begin if is_new_mathfont(cur_f) then begin
+ delta:=half(thickness(q));
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionNumDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, fractionNumeratorGapMin);
+ delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
+ if cur_style<text_style then clr:=get_ot_math_constant(cur_f, fractionDenomDisplayStyleGapMin)
+ else clr:=get_ot_math_constant(cur_f, fractionDenominatorGapMin);
+ delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+end else begin
+ if cur_style<text_style then clr:=3*thickness(q)
+ else clr:=thickness(q);
+ delta:=half(thickness(q));
+ delta1:=clr-((shift_up-depth(x))-(axis_height(cur_size)+delta));
+ delta2:=clr-((axis_height(cur_size)-delta)-(height(z)-shift_down));
+end;
if delta1>0 then shift_up:=shift_up+delta1;
if delta2>0 then shift_down:=shift_down+delta2;
end
@@ -15970,28 +16842,73 @@ the limits have been set above and below the operator. In that case,
@<Declare math...@>=
function make_op(@!q:pointer):scaled;
+label found;
var delta:scaled; {offset between subscript and superscript}
@!p,@!v,@!x,@!y,@!z:pointer; {temporary registers for box construction}
@!c:quarterword;@+@!i:four_quarters; {registers for character examination}
@!shift_up,@!shift_down:scaled; {dimensions for box calculation}
+@!h1,@!h2:scaled; {height of original text-style symbol and possible replacement}
+@!n,@!g:integer; {potential variant index and glyph code}
+@!ot_assembly_ptr:void_pointer;
+@!save_f:internal_font_number;
begin if (subtype(q)=normal)and(cur_style<text_style) then
subtype(q):=limits;
+delta:=0;
if math_type(nucleus(q))=math_char then
begin fetch(nucleus(q));
- if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
- begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
- if char_exists(i) then
- begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
+ if not is_ot_font(cur_f) then begin
+ if (cur_style<text_style)and(char_tag(cur_i)=list_tag) then {make it larger}
+ begin c:=rem_byte(cur_i); i:=char_info(cur_f)(c);
+ if char_exists(i) then
+ begin cur_c:=c; cur_i:=i; character(nucleus(q)):=c;
+ end;
end;
- end;
- delta:=char_italic(cur_f)(cur_i); x:=clean_box(nucleus(q),cur_style);
+ delta:=char_italic(cur_f)(cur_i);
+ end;
+ x:=clean_box(nucleus(q),cur_style);
+ if is_new_mathfont(cur_f) then begin
+ p:=list_ptr(x);
+ if is_glyph_node(p) then begin
+ if cur_style<text_style then begin
+ {try to replace the operator glyph with a display-size variant,
+ ensuring it is larger than the text size}
+ h1:=get_ot_math_constant(cur_f,displayOperatorMinHeight);
+ if h1<(height(p)+depth(p))*5/4 then h1:=(height(p)+depth(p))*5/4;
+ c:=native_glyph(p);
+ n:=0;
+ repeat
+ g:=get_ot_math_variant(cur_f, c, n, addressof(h2), 0);
+ if h2>0 then begin
+ native_glyph(p):=g;
+ set_native_glyph_metrics(p, 1);
+ end;
+ incr(n);
+ until (h2<0) or (h2>=h1);
+ if (h2<0) then begin
+ {if we get here, then we didn't find a big enough glyph; check if the char is extensible}
+ ot_assembly_ptr:=get_ot_assembly_ptr(cur_f, c, 0);
+ if ot_assembly_ptr<>nil then begin
+ free_node(p,glyph_node_size);
+ p:=build_opentype_assembly(cur_f, ot_assembly_ptr, h1, 0);
+ list_ptr(x):=p;
+ delta:=0;
+ goto found;
+ end;
+ end else
+ set_native_glyph_metrics(p, 1);
+ end;
+ delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
+found:
+ width(x):=width(p); height(x):=height(p); depth(x):=depth(p);
+ end
+ end;
if (math_type(subscr(q))<>empty)and(subtype(q)<>limits) then
width(x):=width(x)-delta; {remove italic correction}
shift_amount(x):=half(height(x)-depth(x)) - axis_height(cur_size);
{center vertically}
math_type(nucleus(q)):=sub_box; info(nucleus(q)):=x;
- end
-else delta:=0;
+ end;
+save_f:=cur_f;
if subtype(q)=limits then
@<Construct a box with limits above and below it, skewed by |delta|@>;
make_op:=delta;
@@ -16021,6 +16938,7 @@ amount of glue between the displayed operator |y| and its limits |x| and
by |z|, with kern nodes for the spaces between and around them.
@<Attach the limits to |y| and adjust |height(v)|, |depth(v)|...@>=
+cur_f:=save_f;
if math_type(supscr(q))=empty then
begin free_node(x,box_node_size); list_ptr(v):=y;
end
@@ -16103,7 +17021,7 @@ if next_char(cur_i)=cur_c then if skip_byte(cur_i)<=stop_flag then
qi(2),qi(6): character(nucleus(p)):=rem_byte(cur_i); {\.{\?=:}, \.{\?=:>}}
qi(3),qi(7),qi(11):begin r:=new_noad; {\.{\?=:\?}, \.{\?=:\?>}, \.{\?=:\?>>}}
character(nucleus(r)):=rem_byte(cur_i);
- fam(nucleus(r)):=fam(nucleus(q));@/
+ plane_and_fam_field(nucleus(r)):=fam(nucleus(q));@/
link(q):=r; link(r):=p;
if op_byte(cur_i)<qi(11) then math_type(nucleus(r)):=math_char
else math_type(nucleus(r)):=math_text_char; {prevent combination}
@@ -16154,7 +17072,20 @@ make_scripts(q,delta)
@ @<Create a character node |p| for |nucleus(q)|...@>=
begin fetch(nucleus(q));
-if char_exists(cur_i) then
+if is_native_font(cur_f) then begin
+ z:=new_native_character(cur_f, qo(cur_c));
+ p:=get_node(glyph_node_size);
+ type(p):=whatsit_node; subtype(p):=glyph_node;
+ native_font(p):=cur_f; native_glyph(p):=get_native_glyph(z, 0);
+ set_native_glyph_metrics(p, 1);
+ free_node(z, native_size(z));
+ delta:=get_ot_math_ital_corr(cur_f, native_glyph(p));
+ if (math_type(nucleus(q))=math_text_char)and(not is_new_mathfont(cur_f)<>0) then
+ delta:=0; {no italic correction in mid-word of text font}
+ if (math_type(subscr(q))=empty)and(delta<>0) then
+ begin link(p):=new_kern(delta); delta:=0;
+ end;
+end else if char_exists(cur_i) then
begin delta:=char_italic(cur_f)(cur_i); p:=new_character(cur_f,qo(cur_c));
if (math_type(nucleus(q))=math_text_char)and(space(cur_f)<>0) then
delta:=0; {no italic correction in mid-word of text font}
@@ -16177,9 +17108,10 @@ baseline of subscripts and superscripts based on the given nucleus.
procedure make_scripts(@!q:pointer;@!delta:scaled);
var p,@!x,@!y,@!z:pointer; {temporary registers for box construction}
@!shift_up,@!shift_down,@!clr:scaled; {dimensions in the calculation}
-@!t:small_number; {subsidiary size code}
+@!t:integer; {subsidiary size code}
+@!save_f:internal_font_number;
begin p:=new_hlist(q);
-if is_char_node(p) then
+if is_char_node(p) or (p<>null and is_glyph_node(p)) then
begin shift_up:=0; shift_down:=0;
end
else begin z:=hpack(p,natural);
@@ -16206,10 +17138,16 @@ end;
should not exceed the baseline plus four-fifths of the x-height.
@<Construct a subscript box |x| when there is no superscript@>=
-begin x:=clean_box(subscr(q),sub_style(cur_style));
+begin
+save_f:=cur_f;
+x:=clean_box(subscr(q),sub_style(cur_style));
+cur_f:=save_f;
width(x):=width(x)+script_space;
if shift_down<sub1(cur_size) then shift_down:=sub1(cur_size);
-clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
+if is_new_mathfont(cur_f) then
+ clr:=height(x)-get_ot_math_constant(cur_f, subscriptTopMax)
+else
+ clr:=height(x)-(abs(math_x_height(cur_size)*4) div 5);
if shift_down<clr then shift_down:=clr;
shift_amount(x):=shift_down;
end
@@ -16218,13 +17156,19 @@ end
one-fourth of the x-height.
@<Construct a superscript box |x|@>=
-begin x:=clean_box(supscr(q),sup_style(cur_style));
+begin
+save_f:=cur_f;
+x:=clean_box(supscr(q),sup_style(cur_style));
+cur_f:=save_f;
width(x):=width(x)+script_space;
if odd(cur_style) then clr:=sup3(cur_size)
else if cur_style<text_style then clr:=sup1(cur_size)
else clr:=sup2(cur_size);
if shift_up<clr then shift_up:=clr;
-clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
+if is_new_mathfont(cur_f) then
+ clr:=depth(x)+get_ot_math_constant(cur_f, superscriptBottomMin)
+else
+ clr:=depth(x)+(abs(math_x_height(cur_size)) div 4);
if shift_up<clr then shift_up:=clr;
end
@@ -16235,14 +17179,22 @@ both subscript and superscript move up so that the bottom of the superscript
is at least as high as the baseline plus four-fifths of the x-height.
@<Construct a sub/superscript combination box |x|...@>=
-begin y:=clean_box(subscr(q),sub_style(cur_style));
+begin
+save_f:=cur_f;
+y:=clean_box(subscr(q),sub_style(cur_style));
+cur_f:=save_f;
width(y):=width(y)+script_space;
if shift_down<sub2(cur_size) then shift_down:=sub2(cur_size);
-clr:=4*default_rule_thickness-
- ((shift_up-depth(x))-(height(y)-shift_down));
+if is_new_mathfont(cur_f) then
+ clr:=get_ot_math_constant(cur_f, subSuperscriptGapMin)-((shift_up-depth(x))-(height(y)-shift_down))
+else
+ clr:=4*default_rule_thickness-((shift_up-depth(x))-(height(y)-shift_down));
if clr>0 then
begin shift_down:=shift_down+clr;
- clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
+ if is_new_mathfont(cur_f) then
+ clr:=get_ot_math_constant(cur_f, superscriptBottomMaxWithSubscript)-(shift_up-depth(x))
+ else
+ clr:=(abs(math_x_height(cur_size)*4) div 5)-(shift_up-depth(x));
if clr>0 then
begin shift_up:=shift_up+clr;
shift_down:=shift_down-clr;
@@ -16362,7 +17314,7 @@ the program would not have been so strange.
@!magic_offset:integer; {used to find inter-element spacing}
@ @<Compute the magic offset@>=
-magic_offset:=str_start[math_spacing]-9*ord_noad
+magic_offset:=str_start_macro(math_spacing)-9*ord_noad
@ @<Append inter-element spacing based on |r_type| and |t|@>=
if r_type>0 then {not the first noad}
@@ -16557,7 +17509,7 @@ when they have to be pushed down, they are stored in 5-word nodes, and
|align_ptr| points to the topmost such node.
@d preamble==link(align_head) {the current preamble list}
-@d align_stack_node_size=5 {number of |mem| words to save alignment states}
+@d align_stack_node_size=6 {number of |mem| words to save alignment states}
@<Glob...@>=
@!cur_align:pointer; {current position in preamble list}
@@ -16565,12 +17517,14 @@ when they have to be pushed down, they are stored in 5-word nodes, and
@!cur_loop:pointer; {place to copy when extending a periodic preamble}
@!align_ptr:pointer; {most recently pushed-down alignment stack node}
@!cur_head,@!cur_tail:pointer; {adjustment list pointers}
+@!cur_pre_head,@!cur_pre_tail:pointer; {pre-adjustment list pointers}
@ The |align_state| and |preamble| variables are initialized elsewhere.
@<Set init...@>=
align_ptr:=null; cur_align:=null; cur_span:=null; cur_loop:=null;
cur_head:=null; cur_tail:=null;
+cur_pre_head:=null; cur_pre_tail:=null;
@ Alignment stack maintenance is handled by a pair of trivial routines
called |push_alignment| and |pop_alignment|.
@@ -16582,15 +17536,19 @@ link(p):=align_ptr; info(p):=cur_align;
llink(p):=preamble; rlink(p):=cur_span;
mem[p+2].int:=cur_loop; mem[p+3].int:=align_state;
info(p+4):=cur_head; link(p+4):=cur_tail;
+info(p+5):=cur_pre_head; link(p+5):=cur_pre_tail;
align_ptr:=p;
cur_head:=get_avail;
+cur_pre_head:=get_avail;
end;
@#
procedure pop_alignment;
var p:pointer; {the top alignment stack node}
begin free_avail(cur_head);
+free_avail(cur_pre_head);
p:=align_ptr;
cur_tail:=link(p+4); cur_head:=info(p+4);
+cur_pre_tail:=link(p+5); cur_pre_head:=info(p+5);
align_state:=mem[p+3].int; cur_loop:=mem[p+2].int;
cur_span:=rlink(p); preamble:=llink(p);
cur_align:=info(p); align_ptr:=link(p);
@@ -16695,8 +17653,8 @@ is |>outer_call|, so it will not easily disappear in the presence of errors.
The |get_x_token| routine converts the first into the second, which has |endv|
as its command code.
-@d span_code=256 {distinct from any character}
-@d cr_code=257 {distinct from |span_code| and from any character}
+@d span_code=special_char {distinct from any character}
+@d cr_code=span_code+1 {distinct from |span_code| and from any character}
@d cr_cr_code=cr_code+1 {this distinguishes \.{\\crcr} from \.{\\cr}}
@d end_template_token==cs_token_flag+frozen_end_template
@@ -16829,7 +17787,8 @@ begin push_nest; mode:=(-hmode-vmode)-mode;
if mode=-hmode then space_factor:=0 @+else prev_depth:=0;
tail_append(new_glue(glue_ptr(preamble)));
subtype(tail):=tab_skip_code+1;@/
-cur_align:=link(preamble); cur_tail:=cur_head; init_span(cur_align);
+cur_align:=link(preamble); cur_tail:=cur_head; cur_pre_tail:=cur_pre_head;
+init_span(cur_align);
end;
@ The parameter to |init_span| is a pointer to the alignrecord where the
@@ -16960,8 +17919,10 @@ subtype(tail):=tab_skip_code+1
@ @<Package an unset...@>=
begin if mode=-hmode then
- begin adjust_tail:=cur_tail; u:=hpack(link(head),natural); w:=width(u);
+ begin adjust_tail:=cur_tail; pre_adjust_tail:=cur_pre_tail;
+ u:=hpack(link(head),natural); w:=width(u);
cur_tail:=adjust_tail; adjust_tail:=null;
+ cur_pre_tail:=pre_adjust_tail; pre_adjust_tail:=null;
end
else begin u:=vpackage(link(head),natural,0); w:=height(u);
end;
@@ -16996,9 +17957,10 @@ link(end_span):=max_quarterword+1; info(end_span):=null;
begin q:=cur_span;
repeat incr(n); q:=link(link(q));
until q=cur_align;
-if n>max_quarterword then confusion("256 spans"); {this can happen, but won't}
+if n>max_quarterword then confusion("too many spans");
+ {this can happen, but won't}
@^system dependencies@>
-@:this can't happen 256 spans}{\quad 256 spans@>
+@:this can't happen too many spans}{\quad too many spans@>
q:=cur_span; while link(info(q))<n do q:=info(q);
if link(info(q))>n then
begin s:=get_node(span_node_size); info(s):=info(q); link(s):=n;
@@ -17016,10 +17978,12 @@ Everything will be set later.
var p:pointer; {the new unset box}
begin if mode=-hmode then
begin p:=hpack(link(head),natural);
- pop_nest; append_to_vlist(p);
- if cur_head<>cur_tail then
- begin link(tail):=link(cur_head); tail:=cur_tail;
- end;
+ pop_nest;
+ if cur_pre_head <> cur_pre_tail then
+ append_list(cur_pre_head)(cur_pre_tail);
+ append_to_vlist(p);
+ if cur_head <> cur_tail then
+ append_list(cur_head)(cur_tail);
end
else begin p:=vpack(link(head),natural); pop_nest;
link(tail):=p; tail:=p; space_factor:=1000;
@@ -17352,7 +18316,7 @@ general outline.
@p@t\4@>@<Declare subprocedures for |line_break|@>
procedure line_break(@!d:boolean);
-label done,done1,done2,done3,done4,done5,continue;
+label done,done1,done2,done3,done4,done5,done6,continue, restart;
var @<Local variables for line breaking@>@;
begin pack_begin_line:=mode_line; {this is for over/underfull box messages}
@<Get ready to start line breaking@>;
@@ -17662,7 +18626,147 @@ distinguishable by the condition |cur_p=null|.
@d copy_to_cur_active(#)==cur_active_width[#]:=active_width[#]
@d deactivate=60 {go here when node |r| should be deactivated}
+@d cp_skipable(#) == {skipable nodes at the margins during character protrusion}
+(
+ not is_char_node(#) and
+ (
+ (type(#) = ins_node)
+ or (type(#) = mark_node)
+ or (type(#) = adjust_node)
+ or (type(#) = penalty_node)
+ or ((type(#) = disc_node) and
+ (pre_break(#) = null) and
+ (post_break(#) = null) and
+ (replace_count(#) = 0)) {an empty |disc_node|}
+ or ((type(#) = math_node) and (width(#) = 0))
+ or ((type(#) = kern_node) and
+ ((width(#) = 0) or (subtype(#) = normal)))
+ or ((type(#) = glue_node) and (glue_ptr(#) = zero_glue))
+ or ((type(#) = hlist_node) and (width(#) = 0) and (height(#) = 0) and
+ (depth(#) = 0) and (list_ptr(#) = null))
+ )
+)
+
@<Declare subprocedures for |line_break|@>=
+procedure push_node(p: pointer);
+begin
+ if hlist_stack_level > max_hlist_stack then
+ pdf_error("push_node", "stack overflow");
+ hlist_stack[hlist_stack_level] := p;
+ hlist_stack_level := hlist_stack_level + 1;
+end;
+
+function pop_node: pointer;
+begin
+ hlist_stack_level := hlist_stack_level - 1;
+ if hlist_stack_level < 0 then {would point to some bug}
+ pdf_error("pop_node", "stack underflow (internal error)");
+ pop_node := hlist_stack[hlist_stack_level];
+end;
+
+function find_protchar_left(l: pointer; d: boolean): pointer;
+{searches left to right from list head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ if (link(l) <> null) and (type(l) = hlist_node) and (width(l) = 0)
+ and (height(l) = 0) and (depth(l) = 0) and (list_ptr(l) = null) then
+ l := link(l) {for paragraph start with \.{\\parindent = 0pt}}
+ else if d then
+ while (link(l) <> null) and (not (is_char_node(l) or non_discardable(l))) do
+ l := link(l); {std.\ discardables at line break, \TeX book, p 95}
+ hlist_stack_level := 0;
+ run := true;
+ repeat
+ t := l;
+ while run and (type(l) = hlist_node) and (list_ptr(l) <> null) do begin
+ push_node(l);
+ l := list_ptr(l);
+ end;
+ while run and cp_skipable(l) do begin
+ while (link(l) = null) and (hlist_stack_level > 0) do begin
+ l := pop_node; {don't visit this node again}
+ end;
+ if link(l) <> null then
+ l := link(l)
+ else if hlist_stack_level = 0 then run := false
+ end;
+ until t = l;
+ find_protchar_left := l;
+end;
+
+function find_protchar_right(l, r: pointer): pointer;
+{searches right to left from list tail |r| to head |l|, returns 1st non-skipable item}
+var t: pointer;
+ run: boolean;
+begin
+ find_protchar_right := null;
+ if r = null then return;
+ hlist_stack_level := 0;
+ run := true;
+ repeat
+ t := r;
+ while run and (type(r) = hlist_node) and (list_ptr(r) <> null) do begin
+ push_node(l);
+ push_node(r);
+ l := list_ptr(r);
+ r := l;
+ while link(r) <> null do
+ r := link(r);
+ end;
+ while run and cp_skipable(r) do begin
+ while (r = l) and (hlist_stack_level > 0) do begin
+ r := pop_node; {don't visit this node again}
+ l := pop_node;
+ end;
+ if (r <> l) and (r <> null) then
+ r := prev_rightmost(l, r)
+ else if (r = l) and (hlist_stack_level = 0) then run := false
+ end;
+ until t = r;
+ find_protchar_right := r;
+end;
+
+function total_pw(q, p: pointer): scaled;
+{returns the total width of character protrusion of a line;
+|cur_break(break_node(q))| and |p| is the leftmost resp. rightmost node in the
+horizontal list representing the actual line}
+var l, r: pointer;
+ n: integer;
+begin
+ if break_node(q) = null then
+ l := first_p
+ else
+ l := cur_break(break_node(q));
+ r := prev_rightmost(global_prev_p, p); {get |link(r)=p|}
+ {let's look at the right margin first}
+ if (p <> null) and (type(p) = disc_node) and (pre_break(p) <> null) then
+ {a |disc_node| with non-empty |pre_break|, protrude the last char of |pre_break|}
+ begin
+ r := pre_break(p);
+ while link(r) <> null do
+ r := link(r);
+ end else r := find_protchar_right(l, r);
+ {now the left margin}
+ if (l <> null) and (type(l) = disc_node) then begin
+ if post_break(l) <> null then begin
+ l := post_break(l); {protrude the first char}
+ goto done;
+ end else {discard |replace_count(l)| nodes}
+ begin
+ n := replace_count(l);
+ l := link(l);
+ while n > 0 do begin
+ if link(l) <> null then
+ l := link(l);
+ decr(n);
+ end;
+ end;
+ end;
+ l := find_protchar_left(l, true);
+done:
+ total_pw := left_pw(l) + right_pw(r);
+end;
procedure try_break(@!pi:integer;@!break_type:small_number);
label exit,done,done1,continue,deactivate,found,not_found;
var r:pointer; {runs through the active list}
@@ -17884,11 +18988,19 @@ if is_char_node(v) then
end
else case type(v) of
ligature_node: begin f:=font(lig_char(v));@/
+ xtx_ligature_present:=true;
break_width[1]:=@|break_width[1]-
char_width(f)(char_info(f)(character(lig_char(v))));
end;
hlist_node,vlist_node,rule_node,kern_node:
break_width[1]:=break_width[1]-width(v);
+ whatsit_node:
+ if (subtype(v)=native_word_node)
+ or (subtype(v)=glyph_node)
+ or (subtype(v)=pic_node)
+ or (subtype(v)=pdf_node)
+ then break_width[1]:=break_width[1]-width(v)
+ else confusion("disc1a");
othercases confusion("disc1")
@:this can't happen disc1}{\quad disc1@>
endcases
@@ -17900,11 +19012,19 @@ if is_char_node(s) then
end
else case type(s) of
ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
break_width[1]:=break_width[1]+
char_width(f)(char_info(f)(character(lig_char(s))));
end;
hlist_node,vlist_node,rule_node,kern_node:
break_width[1]:=break_width[1]+width(s);
+ whatsit_node:
+ if (subtype(s)=native_word_node)
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then break_width[1]:=break_width[1]+width(s)
+ else confusion("disc2a");
othercases confusion("disc2")
@:this can't happen disc2}{\quad disc2@>
endcases
@@ -18066,6 +19186,8 @@ breaks must go through a forced break.
begin artificial_demerits:=false;@/
@^inner loop@>
shortfall:=line_width-cur_active_width[1]; {we're this much too short}
+if XeTeX_protrude_chars > 1 then
+ shortfall := shortfall + total_pw(r, cur_p);
if shortfall>0 then
@<Set the value of |b| to the badness for stretching the line,
and compute the corresponding |fit_class|@>
@@ -18297,6 +19419,11 @@ used in special calculations.
thrice per call of |line_break|, since it is actually a pass over the
entire paragraph.
+@d update_prev_p == begin
+ prev_p := cur_p;
+ global_prev_p := cur_p;
+end
+
@<Find optimal breakpoints@>=
threshold:=pretolerance;
if threshold>=0 then
@@ -18312,7 +19439,9 @@ loop@+ begin if threshold>inf_bad then threshold:=inf_bad;
if second_pass then @<Initialize for hyphenating a paragraph@>;
@<Create an active breakpoint representing the beginning of the paragraph@>;
cur_p:=link(temp_head); auto_breaking:=true;@/
- prev_p:=cur_p; {glue at beginning is not a legal breakpoint}
+ update_prev_p; {glue at beginning is not a legal breakpoint}
+ first_p := cur_p; {to access the first node of paragraph as the first active
+ node has |break_node=null|}
while (cur_p<>null)and(link(active)<>last_active) do
@<Call |try_break| if |cur_p| is a legal breakpoint;
on the second pass, also try to hyphenate the next
@@ -18395,6 +19524,7 @@ glue_node: begin @<If node |cur_p| is a legal breakpoint, call |try_break|;
kern_node: if subtype(cur_p)=explicit then kern_break
else act_width:=act_width+width(cur_p);
ligature_node: begin f:=font(lig_char(cur_p));
+ xtx_ligature_present:=true;
act_width:=act_width+char_width(f)(char_info(f)(character(lig_char(cur_p))));
end;
disc_node: @<Try to break after a discretionary fragment, then |goto done5|@>;
@@ -18406,7 +19536,7 @@ mark_node,ins_node,adjust_node: do_nothing;
othercases confusion("paragraph")
@:this can't happen paragraph}{\quad paragraph@>
endcases;@/
-prev_p:=cur_p; cur_p:=link(cur_p);
+update_prev_p; cur_p:=link(cur_p);
done5:end
@ The code that passes over the characters of words in a paragraph is
@@ -18417,7 +19547,7 @@ character node.
@^inner loop@>
@<Advance \(c)|cur_p| to the node following the present string...@>=
-begin prev_p:=cur_p;
+begin update_prev_p;
repeat f:=font(cur_p);
act_width:=act_width+char_width(f)(char_info(f)(character(cur_p)));
cur_p:=link(cur_p);
@@ -18458,7 +19588,7 @@ while r>0 do
begin @<Add the width of node |s| to |act_width|@>;
decr(r); s:=link(s);
end;
-prev_p:=cur_p; cur_p:=s; goto done5;
+update_prev_p; cur_p:=s; goto done5;
end
@ @<Add the width of node |s| to |disc_width|@>=
@@ -18468,11 +19598,19 @@ if is_char_node(s) then
end
else case type(s) of
ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
disc_width:=disc_width+
char_width(f)(char_info(f)(character(lig_char(s))));
end;
hlist_node,vlist_node,rule_node,kern_node:
disc_width:=disc_width+width(s);
+ whatsit_node:
+ if (subtype(s)=native_word_node)
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then disc_width:=disc_width+width(s)
+ else confusion("disc3a");
othercases confusion("disc3")
@:this can't happen disc3}{\quad disc3@>
endcases
@@ -18484,11 +19622,19 @@ if is_char_node(s) then
end
else case type(s) of
ligature_node: begin f:=font(lig_char(s));
+ xtx_ligature_present:=true;
act_width:=act_width+
char_width(f)(char_info(f)(character(lig_char(s))));
end;
hlist_node,vlist_node,rule_node,kern_node:
act_width:=act_width+width(s);
+ whatsit_node:
+ if (subtype(s)=native_word_node)
+ or (subtype(s)=glyph_node)
+ or (subtype(s)=pic_node)
+ or (subtype(s)=pdf_node)
+ then act_width:=act_width+width(s)
+ else confusion("disc4a");
othercases confusion("disc4")
@:this can't happen disc4}{\quad disc4@>
endcases
@@ -18578,6 +19724,10 @@ of their new significance.) Then the lines are justified, one by one.
procedure post_line_break(@!d:boolean);
label done,done1;
var q,@!r,@!s:pointer; {temporary registers for list manipulation}
+ p, k: pointer;
+ w: scaled;
+ glue_break: boolean; {was a break at glue?}
+ ptmp: pointer;
@!disc_break:boolean; {was the current break at a discretionary node?}
@!post_disc_break:boolean; {and did it have a nonempty post-break part?}
@!cur_width:scaled; {width of line number |cur_line|}
@@ -18667,11 +19817,13 @@ list about to be justified.
@<Modify the end of the line...@>=
q:=cur_break(cur_p); disc_break:=false; post_disc_break:=false;
+glue_break := false;
if q<>null then {|q| cannot be a |char_node|}
if type(q)=glue_node then
begin delete_glue_ref(glue_ptr(q));
glue_ptr(q):=right_skip;
subtype(q):=right_skip_code+1; add_glue_ref(right_skip);
+ glue_break := true;
goto done;
end
else begin if type(q)=disc_node then
@@ -18686,8 +19838,39 @@ if q<>null then {|q| cannot be a |char_node|}
else begin q:=temp_head;
while link(q)<>null do q:=link(q);
end;
-@<Put the \(r)\.{\\rightskip} glue after node |q|@>;
done:
+{at this point |q| is the rightmost breakpoint; the only exception is the case
+of a discretionary break with non-empty |pre_break|, then |q| has been changed
+to the last node of the |pre_break| list}
+if XeTeX_protrude_chars > 0 then begin
+{ short_display_n(q, 5); }
+ if disc_break and (is_char_node(q) or (type(q) <> disc_node))
+ {|q| has been reset to the last node of |pre_break|}
+ then begin
+ p := q;
+ ptmp := p;
+ end else begin
+ p := prev_rightmost(link(temp_head), q); {get |link(p) = q|}
+ ptmp := p;
+ p := find_protchar_right(link(temp_head), p);
+ end;
+{ short_display_n(p, 5); }
+ w := right_pw(p);
+ if w <> 0 then {we have found a marginal kern, append it after |ptmp|}
+ begin
+{ pdf_DEBUG_int("right margin:", w); }
+ k := new_margin_kern(-w, last_rightmost_char, right_side);
+ link(k) := link(ptmp);
+ link(ptmp) := k;
+ if (ptmp = q) then
+ q := link(q);
+ end;
+end;
+{if |q| was not a breakpoint at glue and has been reset to |rightskip| then
+ we append |rightskip| after |q| now}
+if not glue_break then begin
+ @<Put the \(r)\.{\\rightskip} glue after node |q|@>;
+end;
@ @<Change discretionary to compulsory...@>=
begin t:=replace_count(q);
@@ -18736,16 +19919,29 @@ justified. It ends with |q| at the beginning of that list, and with
@<Put the \(l)\.{\\leftskip} glue at the left...@>=
r:=link(q); link(q):=null; q:=link(temp_head); link(temp_head):=r;
+{at this point |q| is the leftmost node; all discardable nodes have been discarded}
+if XeTeX_protrude_chars > 0 then begin
+ p := q;
+ p := find_protchar_left(p, false); {no more discardables}
+ w := left_pw(p);
+ if w <> 0 then begin
+ k := new_margin_kern(-w, last_leftmost_char, left_side);
+ link(k) := q;
+ q := k;
+ end;
+end;
if left_skip<>zero_glue then
begin r:=new_param_glue(left_skip_code);
link(r):=q; q:=r;
end
@ @<Append the new box to the current vertical list...@>=
+if pre_adjust_head <> pre_adjust_tail then
+ append_list(pre_adjust_head)(pre_adjust_tail);
+pre_adjust_tail := null;
append_to_vlist(just_box);
-if adjust_head<>adjust_tail then
- begin link(tail):=link(adjust_head); tail:=adjust_tail;
- end;
+if adjust_head <> adjust_tail then
+ append_list(adjust_head)(adjust_tail);
adjust_tail:=null
@ Now |q| points to the hlist that represents the current line of the
@@ -18763,7 +19959,9 @@ else if par_shape_ptr=null then
else begin cur_width:=mem[par_shape_ptr+2*cur_line].sc;
cur_indent:=mem[par_shape_ptr+2*cur_line-1].sc;
end;
-adjust_tail:=adjust_head; just_box:=hpack(q,cur_width,exactly);
+adjust_tail:=adjust_head;
+pre_adjust_tail := pre_adjust_head;
+just_box:=hpack(q,cur_width,exactly);
shift_amount(just_box):=cur_indent
@ Penalties between the lines of a paragraph come from club and widow lines,
@@ -18873,21 +20071,29 @@ nodes $p_{a-1}$ and~$p_b$ in the description above are placed into variables
|ha| and |hb|; and the font number is placed into |hf|.
@<Glob...@>=
-@!hc:array[0..65] of 0..256; {word to be hyphenated}
+@!hc:array[0..66] of 0..number_usvs; {word to be hyphenated}
+{ note that element 0 needs to be a full UnicodeScalar, even though we
+ basically work in utf16 }
@!hn:small_number; {the number of positions occupied in |hc|}
@!ha,@!hb:pointer; {nodes |ha..hb| should be replaced by the hyphenated result}
@!hf:internal_font_number; {font number of the letters in |hc|}
-@!hu:array[0..63] of 0..256; {like |hc|, before conversion to lowercase}
+@!hu:array[0..64] of 0..too_big_char;
+ {like |hc|, before conversion to lowercase}
@!hyf_char:integer; {hyphen character of the relevant font}
-@!cur_lang,@!init_cur_lang:ASCII_code; {current hyphenation table of interest}
+@!cur_lang,@!init_cur_lang:0..biggest_lang;
+ {current hyphenation table of interest}
@!l_hyf,@!r_hyf,@!init_l_hyf,@!init_r_hyf:integer; {limits on fragment sizes}
@!hyf_bchar:halfword; {boundary character after $c_n$}
+@!max_hyph_char:integer;
+
+@ @<Set initial values of key variables@>=
+max_hyph_char:=too_big_lang;
@ Hyphenation routines need a few more local variables.
@<Local variables for line...@>=
@!j:small_number; {an index into |hc| or |hu|}
-@!c:0..255; {character being considered for hyphenation}
+@!c:UnicodeScalar; {character being considered for hyphenation}
@ When the following code is activated, the |line_break| procedure is in its
second pass, and |cur_p| points to a glue node.
@@ -18898,7 +20104,12 @@ if s<>null then
begin @<Skip to node |ha|, or |goto done1| if no hyphenation
should be attempted@>;
if l_hyf+r_hyf>63 then goto done1;
+if is_native_word_node(ha) then begin
+ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>;
+ @<Prepare a |native_word_node| for hyphenation@>;
+end else begin
@<Skip to node |hb|, putting letters into |hu| and |hc|@>;
+end;
@<Check that the nodes following |hb| permit hyphenation and that at least
|l_hyf+r_hyf| letters have been found, otherwise |goto done1|@>;
hyphenate;
@@ -18916,6 +20127,75 @@ begin @<Find hyphen locations for the word in |hc|, or |return|@>;
the discretionary hyphens@>;
exit:end;
+@ @<Check that nodes after |native_word| permit hyphenation; if not, |goto done1|@>=
+s := link(ha);
+loop@+ begin if not(is_char_node(s)) then
+ case type(s) of
+ ligature_node: do_nothing;
+ kern_node: if subtype(s)<>normal then goto done6;
+ whatsit_node,glue_node,penalty_node,ins_node,adjust_node,mark_node:
+ goto done6;
+ othercases goto done1
+ endcases;
+ s:=link(s);
+ end;
+done6:
+
+@ @<Prepare a |native_word_node| for hyphenation@>=
+{ note that if there are chars with |lccode = 0|, we split them out into separate |native_word| nodes }
+hn := 0;
+restart:
+for l := 0 to native_length(ha)-1 do begin
+ c := get_native_usv(ha, l);
+ set_lc_code(c);
+ if (hc[0] = 0) then begin
+ if (hn > 0) then begin
+ { we've got some letters, and now found a non-letter, so break off the tail of the |native_word|
+ and link it after this node, and goto done3 }
+ @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
+ goto done3;
+ end
+ end else if (hn = 0) and (l > 0) then begin
+ { we've found the first letter after some non-letters, so break off the head of the |native_word| and restart }
+ @<Split the |native_word_node| at |l| and link the second part after |ha|@>;
+ ha := link(ha);
+ goto restart;
+ end else if (hn = 63) then
+ { reached max hyphenatable length }
+ goto done3
+ else begin
+ { found a letter that is part of a potentially hyphenatable sequence }
+ incr(hn);
+ if c<@"10000 then begin
+ hu[hn] := c; hc[hn] := hc[0];
+ end
+ else begin
+ hu[hn] := (c - @"10000) div @"400 + @"D800;
+ hc[hn] := (hc[0] - @"10000) div @"400 + @"D800;
+ incr(hn);
+ hu[hn] := c mod @"400 + @"DC00;
+ hc[hn] := hc[0] mod @"400 + @"DC00;
+ incr(l);
+ end;
+ hyf_bchar := non_char;
+ end
+end;
+
+@ @<Split the |native_word_node| at |l| and link the second part after |ha|@>=
+ q := new_native_word_node(hf, native_length(ha) - l);
+ for i := l to native_length(ha) - 1 do
+ set_native_char(q, i - l, get_native_char(ha, i));
+ set_native_metrics(q, XeTeX_use_glyph_metrics);
+ link(q) := link(ha);
+ link(ha) := q;
+ { truncate text in node |ha| }
+ native_length(ha) := l;
+ set_native_metrics(ha, XeTeX_use_glyph_metrics);
+
+@ @<Local variables for line breaking@>=
+l: integer;
+i: integer;
+
@ The first thing we need to do is find the node |ha| just before the
first letter.
@@ -18929,8 +20209,21 @@ loop@+ begin if is_char_node(s) then
end
else if (type(s)=kern_node)and(subtype(s)=normal) then goto continue
else if type(s)=whatsit_node then
- begin @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
- goto continue;
+ begin
+ if subtype(s) = native_word_node then begin
+ { we only consider the node if it contains at least one letter, otherwise we'll skip it }
+ for l:=0 to native_length(s) - 1 do begin
+ c := get_native_usv(s, l);
+ if lc_code(c) <> 0 then begin
+ hf := native_font(s);
+ prev_s := s;
+ goto done2;
+ end;
+ if c>=@"10000 then incr(l);
+ end
+ end;
+ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>;
+ goto continue
end
else goto done1;
set_lc_code(c);
@@ -18941,7 +20234,7 @@ continue: prev_s:=s; s:=link(prev_s);
end;
done2: hyf_char:=hyphen_char[hf];
if hyf_char<0 then goto done1;
-if hyf_char>255 then goto done1;
+if hyf_char>biggest_char then goto done1;
ha:=prev_s
@ The word to be hyphenated is now moved to the |hu| and |hc| arrays.
@@ -18953,6 +20246,7 @@ loop@+ begin if is_char_node(s) then
hyf_bchar:=character(s); c:=qo(hyf_bchar);
set_lc_code(c);
if hc[0]=0 then goto done3;
+ if hc[0]>max_hyph_char then goto done3;
if hn=63 then goto done3;
hb:=s; incr(hn); hu[hn]:=c; hc[hn]:=hc[0]; hyf_bchar:=non_char;
end
@@ -18980,6 +20274,7 @@ while q>null do
begin c:=qo(character(q));
set_lc_code(c);
if hc[0]=0 then goto done3;
+ if hc[0]>max_hyph_char then goto done3;
if j=63 then goto done3;
incr(j); hu[j]:=c; hc[j]:=hc[0];@/
q:=link(q);
@@ -19045,6 +20340,9 @@ The variable |s| will point to the tail of the current hlist, and
things can be hooked up after we reconstitute the hyphenated word.
@<Replace nodes |ha..hb| by a sequence of nodes...@>=
+if is_native_word_node(ha) then begin
+ @<Hyphenate the |native_word_node| at |ha|@>;
+end else begin
q:=link(hb); link(hb):=null; r:=link(ha); link(ha):=null; bchar:=hyf_bchar;
if is_char_node(ha) then
if font(ha)<>hf then goto found2
@@ -19055,7 +20353,7 @@ else if type(ha)=ligature_node then
else begin init_list:=lig_ptr(ha); init_lig:=true; init_lft:=(subtype(ha)>1);
hu[0]:=qo(character(lig_char(ha)));
if init_list=null then if init_lft then
- begin hu[0]:=256; init_lig:=false;
+ begin hu[0]:=max_hyph_char; init_lig:=false;
end; {in this case a ligature will be reconstructed from scratch}
free_node(ha,small_node_size);
end
@@ -19067,10 +20365,59 @@ else begin {no punctuation found; look for left boundary}
s:=cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
while link(s)<>ha do s:=link(s);
j:=0; goto common_ending;
-found2: s:=ha; j:=0; hu[0]:=256; init_lig:=false; init_list:=null;
+found2: s:=ha; j:=0; hu[0]:=max_hyph_char; init_lig:=false; init_list:=null;
common_ending: flush_node_list(r);
@<Reconstitute nodes for the hyphenated word, inserting discretionary hyphens@>;
-flush_list(init_list)
+flush_list(init_list);
+end
+
+@ @<Hyphenate the |native_word_node| at |ha|@>=
+{ find the node immediately before the word to be hyphenated }
+s := cur_p; {we have |cur_p<>ha| because |type(cur_p)=glue_node|}
+while link(s) <> ha do s := link(s);
+
+{ for each hyphen position,
+ create a |native_word_node| fragment for the text before this point,
+ and a |disc_node| for the break, with the |hyf_char| in the |pre_break| text
+}
+
+hyphen_passed := 0; { location of last hyphen we saw }
+
+for j := l_hyf to hn - r_hyf do begin
+ { if this is a valid break.... }
+ if odd(hyf[j]) then begin
+
+ { make a |native_word_node| for the fragment before the hyphen }
+ q := new_native_word_node(hf, j - hyphen_passed);
+ for i := 0 to j - hyphen_passed - 1 do
+ set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
+ set_native_metrics(q, XeTeX_use_glyph_metrics);
+ link(s) := q; { append the new node }
+ s := q;
+
+ { make the |disc_node| for the hyphenation point }
+ q := new_disc;
+ pre_break(q) := new_native_character(hf, hyf_char);
+ link(s) := q;
+ s := q;
+
+ hyphen_passed := j;
+ end
+end;
+
+{ make a |native_word_node| for the last fragment of the word }
+hn := native_length(ha); { ensure trailing punctuation is not lost! }
+q := new_native_word_node(hf, hn - hyphen_passed);
+for i := 0 to hn - hyphen_passed - 1 do
+ set_native_char(q, i, get_native_char(ha, i + hyphen_passed));
+set_native_metrics(q, XeTeX_use_glyph_metrics);
+link(s) := q; { append the new node }
+s := q;
+
+q := link(ha);
+link(s) := q;
+link(ha) := null;
+flush_node_list(ha);
@ We must now face the fact that the battle is not over, even though the
{\def\!{\kern-1pt}%
@@ -19314,7 +20661,7 @@ we need a few new local variables:
@<Local variables for hyph...@>=
@!major_tail,@!minor_tail:pointer; {the end of lists in the main and
discretionary branches being reconstructed}
-@!c:ASCII_code; {character temporarily replaced by a hyphen}
+@!c:UnicodeScalar; {character temporarily replaced by a hyphen}
@!c_loc:0..63; {where that character came from}
@!r_count:integer; {replacement count for discretionary}
@!hyf_node:pointer; {the hyphen, if it exists}
@@ -19388,7 +20735,7 @@ if hyf_node<>null then
@<Put the \(c)characters |hu[i+1..@,]| into |post_break(r)|...@>=
minor_tail:=null; post_break(r):=null; c_loc:=0;
if bchar_label[hf]<>non_address then {put left boundary at beginning of new line}
- begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=256;
+ begin decr(l); c:=hu[l]; c_loc:=l; hu[l]:=max_hyph_char;
end;
while l<j do
begin repeat l:=reconstitute(l,hn,bchar,non_char)+1;
@@ -19486,7 +20833,7 @@ and |v:=hyf_next[v]|; repeat, if necessary, until |v=min_quarterword|.
@!hyf_distance:array[1..trie_op_size] of small_number; {position |k-j| of $n_j$}
@!hyf_num:array[1..trie_op_size] of small_number; {value of $n_j$}
@!hyf_next:array[1..trie_op_size] of quarterword; {continuation code}
-@!op_start:array[ASCII_code] of 0..trie_op_size; {offset for current language}
+@!op_start:array[0..biggest_lang] of 0..trie_op_size; {offset for current language}
@ @<Local variables for hyph...@>=
@!z:trie_pointer; {an index into |trie|}
@@ -19502,7 +20849,7 @@ for j:=0 to hn do hyf[j]:=0;
@<Look for the word |hc[1..hn]| in the exception table, and |goto found| (with
|hyf| containing the hyphens) if an entry is found@>;
if trie_char(cur_lang+1)<>qi(cur_lang) then return; {no patterns for |cur_lang|}
-hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=256; {insert delimiters}
+hc[0]:=0; hc[hn+1]:=0; hc[hn+2]:=max_hyph_char; {insert delimiters}
for j:=0 to hn-r_hyf+1 do
begin z:=trie_link(cur_lang+1)+hc[j]; l:=j;
while hc[l]=qo(trie_char(z)) do
@@ -19614,7 +20961,7 @@ When \TeX\ has scanned `\.{\\hyphenation}', it calls on a procedure named
|new_hyph_exceptions| to do the right thing.
@d set_cur_lang==if language<=0 then cur_lang:=0
- else if language>255 then cur_lang:=0
+ else if language>biggest_lang then cur_lang:=0
else cur_lang:=language
@p procedure new_hyph_exceptions; {enters new exceptions}
@@ -19675,7 +21022,13 @@ else begin set_lc_code(cur_chr);
error;
end
else if n<63 then
- begin incr(n); hc[n]:=hc[0];
+ begin incr(n);
+ if hc[0]<@"10000 then hc[n]:=hc[0]
+ else begin
+ hc[n] := (hc[0] - @"10000) div @"400 + @"D800;
+ incr(n);
+ hc[n] := hc[0] mod @"400 + @"DC00;
+ end;
end;
end
@@ -19814,7 +21167,7 @@ final form needed by our hyphenation algorithm.
@<Sort \(t)the hyphenation op tables into proper order@>=
op_start[0]:=-min_quarterword;
-for j:=1 to 255 do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
+for j:=1 to biggest_lang do op_start[j]:=op_start[j-1]+qo(trie_used[j-1]);
for j:=1 to trie_op_ptr do
trie_op_hash[j]:=op_start[trie_op_lang[j]]+trie_op_val[j]; {destination}
for j:=1 to trie_op_ptr do while trie_op_hash[j]>j do
@@ -19966,7 +21319,7 @@ for p:=0 to trie_size do trie_hash[p]:=0;
hyph_root:=compress_trie(hyph_root);
trie_root:=compress_trie(trie_root); {identify equivalent subtries}
for p:=0 to trie_ptr do trie_ref[p]:=0;
-for p:=0 to 255 do trie_min[p]:=p+1;
+for p:=0 to biggest_char do trie_min[p]:=p+1;
trie_link(0):=1; trie_max:=0
@ The |first_fit| procedure finds the smallest hole |z| in |trie| such that
@@ -19984,11 +21337,11 @@ var h:trie_pointer; {candidate for |trie_ref[p]|}
@!q:trie_pointer; {runs through the family starting at |p|}
@!c:ASCII_code; {smallest character in the family}
@!l,@!r:trie_pointer; {left and right neighbors}
-@!ll:1..256; {upper limit of |trie_min| updating}
+@!ll:1..too_big_char; {upper limit of |trie_min| updating}
begin c:=so(trie_c[p]);
z:=trie_min[c]; {get the first conceivably good hole}
loop@+ begin h:=z-c;@/
- @<Ensure that |trie_max>=h+256|@>;
+ @<Ensure that |trie_max>=h+max_hyph_char|@>;
if trie_taken[h] then goto not_found;
@<If all characters of the family fit relative to |h|, then
|goto found|,\30\ otherwise |goto not_found|@>;
@@ -19997,17 +21350,18 @@ loop@+ begin h:=z-c;@/
found: @<Pack the family into |trie| relative to |h|@>;
end;
-@ By making sure that |trie_max| is at least |h+256|, we can be sure that
+@ By making sure that |trie_max| is at least |h+max_hyph_char|,
+we can be sure that
|trie_max>z|, since |h=z-c|. It follows that location |trie_max| will
never be occupied in |trie|, and we will have |trie_max>=trie_link(z)|.
-@<Ensure that |trie_max>=h+256|@>=
-if trie_max<h+256 then
- begin if trie_size<=h+256 then overflow("pattern memory",trie_size);
+@<Ensure that |trie_max>=h+max_hyph_char|@>=
+if trie_max<h+max_hyph_char then
+ begin if trie_size<=h+max_hyph_char then overflow("pattern memory",trie_size);
@:TeX capacity exceeded pattern memory}{\quad pattern memory@>
repeat incr(trie_max); trie_taken[trie_max]:=false;
trie_link(trie_max):=trie_max+1; trie_back(trie_max):=trie_max-1;
- until trie_max=h+256;
+ until trie_max=h+max_hyph_char;
end
@ @<If all characters of the family fit relative to |h|...@>=
@@ -20022,8 +21376,8 @@ goto found
trie_taken[h]:=true; trie_ref[p]:=h; q:=p;
repeat z:=h+so(trie_c[q]); l:=trie_back(z); r:=trie_link(z);
trie_back(r):=l; trie_link(l):=r; trie_link(z):=0;
-if l<256 then
- begin if z<256 then ll:=z @+else ll:=256;
+if l<max_hyph_char then
+ begin if z<max_hyph_char then ll:=z @+else ll:=max_hyph_char;
repeat trie_min[l]:=r; incr(l);
until l=ll;
end;
@@ -20142,6 +21496,7 @@ if digit_sensed or(cur_chr<"0")or(cur_chr>"9") then
help1("(See Appendix H.)"); error;
end;
end;
+ if cur_chr>max_hyph_char then max_hyph_char:=cur_chr;
if k<63 then
begin incr(k); hc[k]:=cur_chr; hyf[k]:=0; digit_sensed:=false;
end;
@@ -20205,7 +21560,9 @@ var @!p:trie_pointer; {pointer for initialization}
@!j,@!k,@!t:integer; {all-purpose registers for initialization}
@!r,@!s:trie_pointer; {used to clean up the packed |trie|}
@!h:two_halves; {template used to zero out |trie|'s holes}
-begin @<Get ready to compress the trie@>;
+begin
+incr(max_hyph_char);
+@<Get ready to compress the trie@>;
if trie_root<>0 then
begin first_fit(trie_root); trie_pack(trie_root);
end;
@@ -20803,7 +22160,7 @@ var p:pointer; {the node being appended}
@!q,@!r:pointer; {nodes being examined}
@!b,@!c:integer; {badness and cost of current page}
@!pi:integer; {penalty to be added to the badness}
-@!n:min_quarterword..255; {insertion box number}
+@!n:min_quarterword..biggest_reg; {insertion box number}
@!delta,@!h,@!w:scaled; {sizes used for insertion calculations}
begin if (link(contrib_head)=null)or output_active then return;
repeat continue: p:=link(contrib_head);@/
@@ -21100,7 +22457,7 @@ procedure fire_up(@!c:pointer);
label exit;
var p,@!q,@!r,@!s:pointer; {nodes being examined and/or changed}
@!prev_p:pointer; {predecessor of |p|}
-@!n:min_quarterword..255; {insertion box number}
+@!n:min_quarterword..biggest_reg; {insertion box number}
@!wait:boolean; {should the present insertion be held over?}
@!save_vbadness:integer; {saved value of |vbadness|}
@!save_vfuzz: scaled; {saved value of |vfuzz|}
@@ -21420,6 +22777,8 @@ consideration of the other cases until later.
@d big_switch=60 {go here to branch on the next token of input}
@d main_loop=70 {go here to typeset a string of consecutive characters}
+@d collect_native=71 {go here to collect characters in a "native" font string}
+@d collected=72
@d main_loop_wrapup=80 {go here to finish a character or ligature}
@d main_loop_move=90 {go here to advance the ligature cursor}
@d main_loop_move_lig=95 {same, when advancing past a generated ligature}
@@ -21434,6 +22793,7 @@ label big_switch,reswitch,main_loop,main_loop_wrapup,
main_loop_move,main_loop_move+1,main_loop_move+2,main_loop_move_lig,
main_loop_lookahead,main_loop_lookahead+1,
main_lig_loop,main_lig_loop+1,main_lig_loop+2,
+ collect_native,collected,
append_normal_space,exit;
var@!t:integer; {general-purpose temporary variable}
begin if every_job<>null then begin_token_list(every_job,every_job_text);
@@ -21441,22 +22801,28 @@ big_switch: get_x_token;@/
reswitch: @<Give diagnostic information, if requested@>;
case abs(mode)+cur_cmd of
hmode+letter,hmode+other_char,hmode+char_given: goto main_loop;
-hmode+char_num: begin scan_char_num; cur_chr:=cur_val; goto main_loop;@+end;
+hmode+char_num: begin scan_usv_num; cur_chr:=cur_val; goto main_loop;@+end;
hmode+no_boundary: begin get_x_token;
if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given)or
(cur_cmd=char_num) then cancel_boundary:=true;
goto reswitch;
end;
-hmode+spacer: if space_factor=1000 then goto append_normal_space
- else app_space;
-hmode+ex_space,mmode+ex_space: goto append_normal_space;
-@t\4@>@<Cases of |main_control| that are not part of the inner loop@>@;
-end; {of the big |case| statement}
+othercases begin
+ if abs(mode)=hmode then check_for_post_char_toks(big_switch);
+ case abs(mode)+cur_cmd of
+ hmode+spacer: if space_factor=1000 then goto append_normal_space
+ else app_space;
+ hmode+ex_space,mmode+ex_space: goto append_normal_space;
+ @t\4@>@<Cases of |main_control| that are not part of the inner loop@>
+ end
+ end
+endcases; {of the big |case| statement}
goto big_switch;
main_loop:@<Append character |cur_chr| and the following characters (if~any)
to the current hlist in the current font; |goto reswitch| when
a non-character has been fetched@>;
-append_normal_space:@<Append a normal inter-word space to the current list,
+append_normal_space:check_for_post_char_toks(big_switch);
+@<Append a normal inter-word space to the current list,
then |goto big_switch|@>;
exit:end;
@@ -21495,6 +22861,11 @@ Several additional global variables are needed.
@!main_j:four_quarters; {ligature/kern command}
@!main_k:font_index; {index into |font_info|}
@!main_p:pointer; {temporary register for list manipulation}
+@!main_pp,@!main_ppp:pointer; {more temporary registers for list manipulation}
+@!main_h:pointer; {temp for hyphen offset in native-font text}
+@!is_hyph:boolean; {whether the last char seen is the font's hyphenchar}
+@!space_class:integer;
+@!prev_class:integer;
@!main_s:integer; {space factor value}
@!bchar:halfword; {right boundary character of current font, or |non_char|}
@!false_bchar:halfword; {nonexistent character matching |bchar|, or |non_char|}
@@ -21518,7 +22889,7 @@ The overall structure of the main loop is presented here. Some program labels
are inside the individual sections.
@d adjust_space_factor==@t@>@;@/
- main_s:=sf_code(cur_chr);
+ main_s:=sf_code(cur_chr) mod @"10000;
if main_s=1000 then space_factor:=1000
else if main_s<1000 then
begin if main_s>0 then space_factor:=main_s;
@@ -21526,8 +22897,258 @@ are inside the individual sections.
else if space_factor<1000 then space_factor:=1000
else space_factor:=main_s
+@d check_for_inter_char_toks(#)=={check for a spacing token list, goto |#| if found,
+ or |big_switch| in case of the initial letter of a run}
+ cur_ptr:=null;
+ space_class:=sf_code(cur_chr) div @"10000;
+
+ if XeTeX_inter_char_tokens_en and space_class <> 256 then begin {class 256 = ignored (for combining marks etc)}
+ if prev_class = 255 then begin {boundary}
+ if (state<>token_list) or (token_type<>backed_up_char) then begin
+ find_sa_element(inter_char_val, 255*@"100 + space_class, false);
+ if cur_ptr<>null then begin
+ if cur_cmd<>letter then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ back_input; token_type:=backed_up_char;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ goto big_switch;
+ end
+ end
+ end else begin
+ find_sa_element(inter_char_val, prev_class*@"100 + space_class, false);
+ if cur_ptr<>null then begin
+ if cur_cmd<>letter then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ back_input; token_type:=backed_up_char;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ prev_class:=255;
+ goto #;
+ end;
+ end;
+ prev_class:=space_class;
+ end
+
+@d check_for_post_char_toks(#)==
+ if XeTeX_inter_char_tokens_en and (space_class<>256) and (prev_class<>255) then begin
+ prev_class:=255;
+ find_sa_element(inter_char_val, space_class*@"100 + 255, false); {boundary}
+ if cur_ptr<>null then begin
+ if cur_cs=0 then begin
+ if cur_cmd=char_num then cur_cmd:=other_char;
+ cur_tok:=(cur_cmd*max_char_val)+cur_chr;
+ end else cur_tok:=cs_token_flag+cur_cs;
+ back_input;
+ begin_token_list(sa_ptr(cur_ptr), inter_char_text);
+ goto #;
+ end;
+ end
+
@<Append character |cur_chr|...@>=
+
+prev_class := 255; {boundary}
+
+{ added code for native font support }
+if is_native_font(cur_font) then begin
+ if mode>0 then if language<>clang then fix_language;
+
+ main_h := 0;
+ main_f := cur_font;
+ native_len := 0;
+
+collect_native:
+ adjust_space_factor;
+
+ check_for_inter_char_toks(collected);
+
+ if (cur_chr > @"FFFF) then begin
+ native_room(2);
+ append_native((cur_chr - @"10000) div 1024 + @"D800);
+ append_native((cur_chr - @"10000) mod 1024 + @"DC00);
+ end else begin
+ native_room(1);
+ append_native(cur_chr);
+ end;
+ is_hyph := (cur_chr = hyphen_char[main_f])
+ or (XeTeX_dash_break_en and ((cur_chr = @"2014) or (cur_chr = @"2013)));
+ if (main_h = 0) and is_hyph then main_h := native_len;
+
+ {try to collect as many chars as possible in the same font}
+ get_next;
+ if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
+ x_token;
+ if (cur_cmd=letter) or (cur_cmd=other_char) or (cur_cmd=char_given) then goto collect_native;
+ if cur_cmd=char_num then begin
+ scan_usv_num;
+ cur_chr:=cur_val;
+ goto collect_native;
+ end;
+
+ check_for_post_char_toks(collected);
+
+collected:
+ if (font_mapping[main_f] <> 0) then begin
+ main_k := apply_mapping(font_mapping[main_f], native_text, native_len);
+ native_len := 0;
+ native_room(main_k);
+ main_h := 0;
+ for main_p := 0 to main_k - 1 do begin
+ append_native(mapped_text[main_p]);
+ if (main_h = 0) and ((mapped_text[main_p] = hyphen_char[main_f])
+ or (XeTeX_dash_break_en and ((mapped_text[main_p] = @"2014) or (mapped_text[main_p] = @"2013)) ) )
+ then main_h := native_len;
+ end
+ end;
+
+ if tracing_lost_chars > 0 then begin
+ temp_ptr := 0;
+ while (temp_ptr < native_len) do begin
+ main_k := native_text[temp_ptr];
+ incr(temp_ptr);
+ if (main_k >= @"D800) and (main_k < @"DC00) then begin
+ main_k := @"10000 + (main_k - @"D800) * 1024;
+ main_k := main_k + native_text[temp_ptr] - @"DC00;
+ incr(temp_ptr);
+ end;
+ if map_char_to_glyph(main_f, main_k) = 0 then
+ char_warning(main_f, main_k);
+ end
+ end;
+
+ main_k := native_len;
+ main_pp := tail;
+
+ if mode=hmode then begin
+
+ main_ppp := head;
+ if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries }
+ while (link(main_ppp)<>main_pp) do begin
+ if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin
+ temp_ptr:=main_ppp;
+ for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
+ end;
+ if main_ppp<>main_pp then main_ppp:=link(main_ppp);
+ end;
+
+ temp_ptr := 0;
+ repeat
+ if main_h = 0 then main_h := main_k;
+
+ if is_native_word_node(main_pp)
+ and (native_font(main_pp)=main_f)
+ and (main_ppp<>main_pp)
+ and (not is_char_node(main_ppp))
+ and (type(main_ppp)<>disc_node)
+ then begin
+
+ { make a new temp string that contains the concatenated text of |tail| + the current word/fragment }
+ main_k := main_h + native_length(main_pp);
+ native_room(main_k);
+
+ save_native_len := native_len;
+ for main_p := 0 to native_length(main_pp) - 1 do
+ append_native(get_native_char(main_pp, main_p));
+ for main_p := 0 to main_h - 1 do
+ append_native(native_text[temp_ptr + main_p]);
+
+ do_locale_linebreaks(save_native_len, main_k);
+
+ native_len := save_native_len; { discard the temp string }
+ main_k := native_len - main_h - temp_ptr; { and set |main_k| to remaining length of new word }
+ temp_ptr := main_h; { pointer to remaining fragment }
+
+ main_h := 0;
+ while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
+ and ( (not XeTeX_dash_break_en)
+ or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
+ do incr(main_h); { look for next hyphen or end of text }
+ if (main_h < main_k) then incr(main_h);
+
+ { remove the preceding node from the list }
+ link(main_ppp) := link(main_pp);
+ link(main_pp) := null;
+ flush_node_list(main_pp);
+ main_pp := tail;
+ while (link(main_ppp)<>main_pp) do
+ main_ppp:=link(main_ppp);
+
+ end else begin
+
+ do_locale_linebreaks(temp_ptr, main_h); { append fragment of current word }
+
+ temp_ptr := temp_ptr + main_h; { advance ptr to remaining fragment }
+ main_k := main_k - main_h; { decrement remaining length }
+
+ main_h := 0;
+ while (main_h < main_k) and (native_text[temp_ptr + main_h] <> hyphen_char[main_f])
+ and ( (not XeTeX_dash_break_en)
+ or ((native_text[temp_ptr + main_h] <> @"2014) and (native_text[temp_ptr + main_h] <> @"2013)) )
+ do incr(main_h); { look for next hyphen or end of text }
+ if (main_h < main_k) then incr(main_h);
+
+ end;
+
+ if (main_k > 0) or is_hyph then begin
+ tail_append(new_disc); { add a break if we aren't at end of text (must be a hyphen),
+ or if last char in original text was a hyphen }
+ main_pp:=tail;
+ end;
+ until main_k = 0;
+
+ end else begin
+ { must be restricted hmode, so no need for line-breaking or discretionaries }
+ { but there might already be explicit |disc_node|s in the list }
+ main_ppp := head;
+ if main_ppp<>main_pp then { find node preceding tail, skipping discretionaries }
+ while (link(main_ppp)<>main_pp) do begin
+ if (not is_char_node(main_ppp)) and (type(main_ppp=disc_node)) then begin
+ temp_ptr:=main_ppp;
+ for main_p:=1 to replace_count(temp_ptr) do main_ppp:=link(main_ppp);
+ end;
+ if main_ppp<>main_pp then main_ppp:=link(main_ppp);
+ end;
+ if is_native_word_node(main_pp)
+ and (native_font(main_pp)=main_f)
+ and (main_ppp<>main_pp)
+ and (not is_char_node(main_ppp))
+ and (type(main_ppp)<>disc_node)
+ then begin
+ { total string length for the new merged whatsit }
+ link(main_pp) := new_native_word_node(main_f, main_k + native_length(main_pp));
+ tail := link(main_pp);
+
+ { copy text from the old one into the new }
+ for main_p := 0 to native_length(main_pp) - 1 do
+ set_native_char(tail, main_p, get_native_char(main_pp, main_p));
+ { append the new text }
+ for main_p := 0 to main_k - 1 do
+ set_native_char(tail, main_p + native_length(main_pp), native_text[main_p]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+
+ { remove the preceding node from the list }
+ main_p := head;
+ if main_p<>main_pp then
+ while link(main_p)<>main_pp do
+ main_p := link(main_p);
+ link(main_p) := link(main_pp);
+ link(main_pp) := null;
+ flush_node_list(main_pp);
+ end else begin
+ { package the current string into a |native_word| whatsit }
+ link(main_pp) := new_native_word_node(main_f, main_k);
+ tail := link(main_pp);
+ for main_p := 0 to main_k - 1 do
+ set_native_char(tail, main_p, native_text[main_p]);
+ set_native_metrics(tail, XeTeX_use_glyph_metrics);
+ end
+ end;
+
+ if cur_ptr<>null then goto big_switch
+ else goto reswitch;
+end;
+{ End of added code for native fonts }
+
adjust_space_factor;@/
+check_for_inter_char_toks(big_switch);
main_f:=cur_font;
bchar:=font_bchar[main_f]; false_bchar:=font_false_bchar[main_f];
if mode>0 then if language<>clang then fix_language;
@@ -21632,6 +23253,7 @@ if cur_cmd=char_num then
if cur_cmd=no_boundary then bchar:=non_char;
cur_r:=bchar; lig_stack:=null; goto main_lig_loop;
main_loop_lookahead+1: adjust_space_factor;
+check_for_inter_char_toks(big_switch);
fast_get_avail(lig_stack); font(lig_stack):=main_f;
cur_r:=qi(cur_chr); character(lig_stack):=cur_r;
if cur_r=false_bchar then cur_r:=non_char {this prevents spurious ligatures}
@@ -21776,8 +23398,26 @@ pace through the other combinations of possibilities.
@<Cases of |main_control| that are not part of the inner loop@>=
any_mode(relax),vmode+spacer,mmode+spacer,mmode+no_boundary:do_nothing;
-any_mode(ignore_spaces): begin @<Get the next non-blank non-call...@>;
- goto reswitch;
+any_mode(ignore_spaces): begin
+ if cur_chr = 0 then begin
+ @<Get the next non-blank non-call...@>;
+ goto reswitch;
+ end
+ else begin
+ t:=scanner_status;
+ scanner_status:=normal;
+ get_next;
+ scanner_status:=t;
+ if cur_cs < hash_base then
+ cur_cs := prim_lookup(cur_cs-257)
+ else
+ cur_cs := prim_lookup(text(cur_cs));
+ if cur_cs<>undefined_primitive then begin
+ cur_cmd := prim_eq_type(cur_cs);
+ cur_chr := prim_equiv(cur_cs);
+ goto reswitch;
+ end;
+ end;
end;
vmode+stop: if its_all_over then return; {this is the only way out}
@t\4@>@<Forbidden cases detected in |main_control|@>@+@,any_mode(mac_param):
@@ -21794,7 +23434,7 @@ mode by mistake. \TeX\ will insert a dollar sign and rescan the current token.
@<Math-only cases in non-math modes...@>=
non_math(sup_mark), non_math(sub_mark), non_math(math_char_num),
-non_math(math_given), non_math(math_comp), non_math(delim_num),
+non_math(math_given), non_math(XeTeX_math_given), non_math(math_comp), non_math(delim_num),
non_math(left_right), non_math(above), non_math(radical),
non_math(math_style), non_math(math_choice), non_math(vcenter),
non_math(non_script), non_math(mkern), non_math(limit_switch),
@@ -22292,11 +23932,16 @@ current vertical list.
begin if cur_box<>null then
begin shift_amount(cur_box):=box_context;
if abs(mode)=vmode then
- begin append_to_vlist(cur_box);
- if adjust_tail<>null then
- begin if adjust_head<>adjust_tail then
- begin link(tail):=link(adjust_head); tail:=adjust_tail;
+ begin
+ if pre_adjust_tail <> null then begin
+ if pre_adjust_head <> pre_adjust_tail then
+ append_list(pre_adjust_head)(pre_adjust_tail);
+ pre_adjust_tail := null;
end;
+ append_to_vlist(cur_box);
+ if adjust_tail <> null then begin
+ if adjust_head <> adjust_tail then
+ append_list(adjust_head)(adjust_tail);
adjust_tail:=null;
end;
if mode>0 then build_page;
@@ -22476,7 +24121,8 @@ also have to finish a paragraph that hasn't ended.
@<Cases of |handle...@>=
hbox_group: package(0);
-adjusted_hbox_group: begin adjust_tail:=adjust_head; package(0);
+adjusted_hbox_group: begin adjust_tail:=adjust_head;
+ pre_adjust_tail:=pre_adjust_head; package(0);
end;
vbox_group: begin end_graf; package(0);
end;
@@ -22488,12 +24134,15 @@ procedure package(@!c:small_number);
var h:scaled; {height of box}
@!p:pointer; {first node in a box}
@!d:scaled; {max depth}
-begin d:=box_max_depth; unsave; save_ptr:=save_ptr-3;
+@!u,v:integer; {saved values for upwards mode flag}
+begin d:=box_max_depth; u:=XeTeX_upwards_state; unsave; save_ptr:=save_ptr-3;
+v:=XeTeX_upwards_state; XeTeX_upwards_state:=u;
if mode=-hmode then cur_box:=hpack(link(head),saved(2),saved(1))
else begin cur_box:=vpackage(link(head),saved(2),saved(1),d);
if c=vtop_code then @<Readjust the height and depth of |cur_box|,
for \.{\\vtop}@>;
end;
+XeTeX_upwards_state:=v;
pop_nest; box_end(saved(0));
end;
@@ -22630,14 +24279,19 @@ else begin scan_eight_bit_int;
error; cur_val:=0;
end;
end;
-saved(0):=cur_val; incr(save_ptr);
+saved(0) := cur_val;
+if (cur_cmd = vadjust) and scan_keyword("pre") then
+ saved(1) := 1
+else
+ saved(1) := 0;
+save_ptr := save_ptr + 2;
new_save_level(insert_group); scan_left_brace; normal_paragraph;
push_nest; mode:=-vmode; prev_depth:=ignore_depth;
end;
@ @<Cases of |handle...@>=
insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
- d:=split_max_depth; f:=floating_penalty; unsave; decr(save_ptr);
+ d:=split_max_depth; f:=floating_penalty; unsave; save_ptr:=save_ptr-2;
{now |saved(0)| is the insertion number, or 255 for |vadjust|}
p:=vpack(link(head),natural); pop_nest;
if saved(0)<255 then
@@ -22648,7 +24302,7 @@ insert_group: begin end_graf; q:=split_top_skip; add_glue_ref(q);
end
else begin tail_append(get_node(small_node_size));
type(tail):=adjust_node;@/
- subtype(tail):=0; {the |subtype| is not used}
+ adjust_pre(tail) := saved(1); {the |subtype| is used for |adjust_pre|}
adjust_ptr(tail):=list_ptr(p); delete_glue_ref(q);
end;
free_node(p,box_node_size);
@@ -22761,6 +24415,7 @@ vmode+un_vbox,hmode+un_hbox,mmode+un_hbox: unpackage;
procedure unpackage;
label done, exit;
var p:pointer; {the box}
+ r: pointer; {to remove marginal kern nodes}
@!c:box_code..copy_code; {should we copy?}
begin if cur_chr>copy_code then @<Handle saved items and |goto done|@>;
c:=cur_chr; scan_register_num; fetch_box(p);
@@ -22779,7 +24434,15 @@ else begin link(tail):=list_ptr(p); change_box(null);
free_node(p,box_node_size);
end;
done:
-while link(tail)<>null do tail:=link(tail);
+while link(tail) <> null do begin
+ r := link(tail);
+ if not is_char_node(r) and (type(r) = margin_kern_node) then begin
+ link(tail) := link(r);
+{ free_avail(margin_char(r)); }
+ free_node(r, margin_kern_node_size);
+ end;
+ tail:=link(tail);
+end;
exit:end;
@ @<Forbidden...@>=vmode+ital_corr,
@@ -22800,6 +24463,15 @@ var p:pointer; {|char_node| at the tail of the current list}
begin if tail<>head then
begin if is_char_node(tail) then p:=tail
else if type(tail)=ligature_node then p:=lig_char(tail)
+ else if (type(tail)=whatsit_node) then begin
+ if (subtype(tail)=native_word_node) then begin
+ tail_append(new_kern(get_native_italic_correction(tail))); subtype(tail):=explicit;
+ end
+ else if (subtype(tail)=glyph_node) then begin
+ tail_append(new_kern(get_native_glyph_italic_correction(tail))); subtype(tail):=explicit;
+ end;
+ return;
+ end
else return;
f:=font(p);
tail_append(new_kern(char_italic(f)(char_info(f)(character(p)))));
@@ -22832,7 +24504,7 @@ var c:integer; {hyphen character}
begin tail_append(new_disc);
if cur_chr=1 then
begin c:=hyphen_char[cur_font];
- if c>=0 then if c<256 then pre_break(tail):=new_character(cur_font,c);
+ if c>=0 then if c<=biggest_char then pre_break(tail):=new_character(cur_font,c);
end
else begin incr(save_ptr); saved(-1):=0; new_save_level(disc_group);
scan_left_brace; push_nest; mode:=-hmode; space_factor:=1000;
@@ -22894,6 +24566,8 @@ q:=head; p:=link(q); n:=0;
while p<>null do
begin if not is_char_node(p) then if type(p)>rule_node then
if type(p)<>kern_node then if type(p)<>ligature_node then
+ if (type(p)<>whatsit_node) or ((subtype(p)<>native_word_node)
+ and (subtype(p)<>glyph_node)) then
begin print_err("Improper discretionary list");
@.Improper discretionary list@>
help1("Discretionary lists must contain only boxes and kerns.");@/
@@ -22928,13 +24602,17 @@ procedure make_accent;
var s,@!t: real; {amount of slant}
@!p,@!q,@!r:pointer; {character, box, and kern nodes}
@!f:internal_font_number; {relevant font}
-@!a,@!h,@!x,@!w,@!delta:scaled; {heights and widths, as explained above}
+@!a,@!h,@!x,@!w,@!delta,@!lsb,@!rsb:scaled; {heights and widths, as explained above}
@!i:four_quarters; {character information}
begin scan_char_num; f:=cur_font; p:=new_character(f,cur_val);
if p<>null then
begin x:=x_height(f); s:=slant(f)/float_constant(65536);
@^real division@>
- a:=char_width(f)(char_info(f)(character(p)));@/
+ if is_native_font(f) then
+ begin a:=width(p);
+ if a=0 then get_native_char_sidebearings(f, cur_val, addressof(lsb), addressof(rsb))
+ end
+ else a:=char_width(f)(char_info(f)(character(p)));@/
do_assignments;@/
@<Create a character node |q| for the next character,
but set |q:=null| if problems arise@>;
@@ -22947,7 +24625,8 @@ end;
@ @<Create a character node |q| for the next...@>=
q:=null; f:=cur_font;
if (cur_cmd=letter)or(cur_cmd=other_char)or(cur_cmd=char_given) then
- q:=new_character(f,cur_chr)
+ begin q:=new_character(f,cur_chr); cur_val:=cur_chr
+ end
else if cur_cmd=char_num then
begin scan_char_num; q:=new_character(f,cur_val);
end
@@ -22963,12 +24642,20 @@ because the user cannot remove these nodes nor access them via \.{\\lastkern}.
@<Append the accent with appropriate kerns...@>=
begin t:=slant(f)/float_constant(65536);
@^real division@>
-i:=char_info(f)(character(q));
-w:=char_width(f)(i); h:=char_height(f)(height_depth(i));
+if is_native_font(f) then begin
+ w:=width(q);
+ get_native_char_height_depth(f, cur_val, addressof(h), addressof(delta))
+ {using delta as scratch space for the unneeded depth value}
+end else begin
+ i:=char_info(f)(character(q));
+ w:=char_width(f)(i); h:=char_height(f)(height_depth(i))
+end;
if h<>x then {the accent must be shifted up or down}
begin p:=hpack(p,natural); shift_amount(p):=x-h;
end;
-delta:=round((w-a)/float_constant(2)+h*t-x*s);
+if is_native_font(f) and (a=0) then { special case for non-spacing marks }
+ delta:=round((w-lsb+rsb)/float_constant(2)+h*t-x*s)
+else delta:=round((w-a)/float_constant(2)+h*t-x*s);
@^real multiplication@>
@^real addition@>
r:=new_kern(delta); subtype(r):=acc_kern; link(tail):=r; link(r):=p;
@@ -23242,10 +24929,11 @@ hlist_node,vlist_node,rule_node: begin d:=width(p); goto found;
end;
ligature_node:@<Make node |p| look like a |char_node|...@>;
kern_node: d:=width(p);
+margin_kern_node: d:=width(p);
@t\4@>@<Cases of `Let |d| be the natural width' that need special treatment@>@;
glue_node:@<Let |d| be the natural width of this glue; if stretching
or shrinking, set |v:=max_dimen|; |goto found| in the case of leaders@>;
-whatsit_node: @<Let |d| be the width of the whatsit |p|@>;
+whatsit_node: @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>;
othercases d:=0
endcases
@@ -23315,7 +25003,7 @@ in one of these principal fields; it looks at the subformula that
comes next in the input, and places an encoding of that subformula
into a given word of |mem|.
-@d fam_in_range==((cur_fam>=0)and(cur_fam<16))
+@d fam_in_range==((cur_fam>=0)and(cur_fam<number_math_families))
@<Declare act...@>=
procedure scan_math(@!p:pointer);
@@ -23324,7 +25012,7 @@ 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
+ if is_active_math_char(c) then
begin @<Treat |cur_chr| as an active character@>;
goto restart;
end;
@@ -23332,16 +25020,43 @@ letter,other_char,char_given: begin c:=ho(math_code(cur_chr));
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;
+math_char_num:
+ if cur_chr = 2 then begin { XeTeXmathchar }
+ scan_math_class_int; c := set_class_field(cur_val);
+ scan_math_fam_int; c := c + set_family_field(cur_val);
+ scan_usv_num; c := c + cur_val;
+ end else if cur_chr = 1 then begin { XeTeXmathcharnum }
+ scan_xetex_math_char_int; c := cur_val;
+ end else begin scan_fifteen_bit_int;
+ c := set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100);
+ end;
+math_given: begin
+ c := set_class_field(cur_chr div @"1000) +
+ set_family_field((cur_chr mod @"1000) div @"100) +
+ (cur_chr mod @"100);
+ end;
+XeTeX_math_given: c:=cur_chr;
+delim_num: begin
+ if cur_chr=1 then begin {XeTeXdelimiter <cls> <fam> <usv>}
+ scan_math_class_int; c := set_class_field(cur_val);
+ scan_math_fam_int; c := c + set_family_field(cur_val);
+ scan_usv_num; c := c + cur_val;
+ end else begin {delimiter <27-bit delcode>}
+ scan_delimiter_int;
+ c := cur_val div @'10000; {get the 'small' delimiter field}
+ c := set_class_field(c div @"1000) +
+ set_family_field((c mod @"1000) div @"100) +
+ (c mod @"100); {and convert it to a xetex mathchar code}
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;
+math_type(p):=math_char; character(p):=qi(c mod @"10000);
+if (is_var_family(c)) and fam_in_range then plane_and_fam_field(p):=cur_fam
+else plane_and_fam_field(p):=(math_fam_field(c));
+plane_and_fam_field(p) := plane_and_fam_field(p) + (math_char_field(c) div @"10000) * @"100;
exit:end;
@ An active character that is an |outer_call| is allowed here.
@@ -23373,11 +25088,37 @@ mmode+letter,mmode+other_char,mmode+char_given:
mmode+char_num: begin scan_char_num; cur_chr:=cur_val;
set_math_char(ho(math_code(cur_chr)));
end;
-mmode+math_char_num: begin scan_fifteen_bit_int; set_math_char(cur_val);
+mmode+math_char_num: if cur_chr = 2 then begin { XeTeXmathchar }
+ scan_math_class_int; t := set_class_field(cur_val);
+ scan_math_fam_int; t := t + set_family_field(cur_val);
+ scan_usv_num; t := t + cur_val;
+ set_math_char(t);
+ end else if cur_chr = 1 then begin { XeTeXmathcharnum }
+ scan_xetex_math_char_int; set_math_char(cur_val);
+ end else begin scan_fifteen_bit_int;
+ set_math_char(set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100));
+ end;
+mmode+math_given: begin
+ set_math_char(set_class_field(cur_chr div @"1000) +
+ set_family_field((cur_chr mod @"1000) div @"100) +
+ (cur_chr mod @"100));
+ end;
+mmode+XeTeX_math_given: set_math_char(cur_chr);
+mmode+delim_num: begin
+ if cur_chr=1 then begin {XeTeXdelimiter}
+ scan_math_class_int; t := set_class_field(cur_val);
+ scan_math_fam_int; t := t + set_family_field(cur_val);
+ scan_usv_num; t := t + cur_val;
+ set_math_char(t);
+ end else begin
+ scan_delimiter_int;
+ cur_val:=cur_val div @'10000; {discard the large delimiter code}
+ set_math_char(set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100));
end;
-mmode+math_given: set_math_char(cur_chr);
-mmode+delim_num: begin scan_twenty_seven_bit_int;
- set_math_char(cur_val div @'10000);
end;
@ The |set_math_char| procedure creates a new noad appropriate to a given
@@ -23387,17 +25128,20 @@ nothing is appended.
@<Declare act...@>=
procedure set_math_char(@!c:integer);
-var p:pointer; {the new noad}
-begin if c>=@'100000 then
+var p,q,r:pointer; {the new noad}
+ ch: UnicodeScalar;
+begin if is_active_math_char(c) then
@<Treat |cur_chr|...@>
else begin p:=new_noad; math_type(nucleus(p)):=math_char;
- character(nucleus(p)):=qi(c mod 256);
- fam(nucleus(p)):=(c div 256) mod 16;
- if c>=var_code then
- begin if fam_in_range then fam(nucleus(p)):=cur_fam;
+ ch:=math_char_field(c);
+ character(nucleus(p)):=qi(ch mod @"10000);
+ plane_and_fam_field(nucleus(p)):=math_fam_field(c);
+ if is_var_family(c) then
+ begin if fam_in_range then plane_and_fam_field(nucleus(p)):=cur_fam;
type(p):=ord_noad;
end
- else type(p):=ord_noad+(c div @'10000);
+ else type(p):=ord_noad+math_class_field(c);
+ plane_and_fam_field(nucleus(p)) := plane_and_fam_field(nucleus(p)) + (ch div @"10000) * @"100;
link(tail):=p; tail:=p;
end;
end;
@@ -23475,20 +25219,44 @@ delimiter is to be placed; the second tells if this delimiter follows
@<Declare act...@>=
procedure scan_delimiter(@!p:pointer;@!r:boolean);
-begin if r then scan_twenty_seven_bit_int
+begin
+ if r then begin
+ if cur_chr=1 then begin {XeTeXradical}
+ cur_val1 := @"40000000; {extended delcode flag}
+ scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
+ scan_usv_num; cur_val := cur_val1 + cur_val;
+ end else {radical}
+ scan_delimiter_int;
+ end
else begin @<Get the next non-blank non-relax...@>;
case cur_cmd of
- letter,other_char: cur_val:=del_code(cur_chr);
- delim_num: scan_twenty_seven_bit_int;
- othercases cur_val:=-1
+ letter,other_char: begin
+ cur_val:=del_code(cur_chr);
+ end;
+ delim_num: if cur_chr=1 then begin {XeTeXdelimiter}
+ cur_val1 := @"40000000; {extended delcode flag}
+ scan_math_class_int; {discarded}
+ scan_math_fam_int; cur_val1 := cur_val1 + cur_val * @"200000;
+ scan_usv_num; cur_val := cur_val1 + cur_val;
+ end else scan_delimiter_int; {normal delimiter}
+ othercases begin cur_val:=-1; end;
endcases;
end;
-if cur_val<0 then @<Report that an invalid delimiter code is being changed
+if cur_val<0 then begin @<Report that an invalid delimiter code is being changed
to null; set~|cur_val:=0|@>;
-small_fam(p):=(cur_val div @'4000000) mod 16;
-small_char(p):=qi((cur_val div @'10000) mod 256);
-large_fam(p):=(cur_val div 256) mod 16;
-large_char(p):=qi(cur_val mod 256);
+ end;
+if cur_val>=@"40000000 then begin {extended delcode, only one size}
+ small_plane_and_fam_field(p) := ((cur_val mod @"200000) div @"10000) * @"100 {plane}
+ + (cur_val div @"200000) mod @"100; {family}
+ small_char_field(p) := qi(cur_val mod @"10000);
+ large_plane_and_fam_field(p) := 0;
+ large_char_field(p) := 0;
+end else begin {standard delcode, 4-bit families and 8-bit char codes}
+ small_plane_and_fam_field(p) := (cur_val div @'4000000) mod 16;
+ small_char_field(p) := qi((cur_val div @'10000) mod 256);
+ large_plane_and_fam_field(p) := (cur_val div 256) mod 16;
+ large_char_field(p) := qi(cur_val mod 256);
+end;
end;
@ @<Report that an invalid delimiter...@>=
@@ -23521,6 +25289,7 @@ mmode+accent,mmode+math_accent:math_ac;
@ @<Declare act...@>=
procedure math_ac;
+var c: integer;
begin if cur_cmd=accent then
@<Complain that the user should have said \.{\\mathaccent}@>;
tail_append(get_node(accent_noad_size));
@@ -23529,10 +25298,30 @@ mem[nucleus(tail)].hh:=empty_field;
mem[subscr(tail)].hh:=empty_field;
mem[supscr(tail)].hh:=empty_field;
math_type(accent_chr(tail)):=math_char;
-scan_fifteen_bit_int;
-character(accent_chr(tail)):=qi(cur_val mod 256);
-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;
+if cur_chr=1 then begin
+ if scan_keyword("fixed") then
+ subtype(tail):=fixed_acc
+ else if scan_keyword("bottom") then begin
+ if scan_keyword("fixed") then
+ subtype(tail):=bottom_acc+fixed_acc
+ else
+ subtype(tail):=bottom_acc;
+ end;
+ scan_math_class_int; c := set_class_field(cur_val);
+ scan_math_fam_int; c := c + set_family_field(cur_val);
+ scan_usv_num; cur_val := cur_val + c;
+end
+else begin
+ scan_fifteen_bit_int;
+ cur_val := set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100);
+end;
+character(accent_chr(tail)):=qi(cur_val mod @"10000);
+if (is_var_family(cur_val))and fam_in_range then plane_and_fam_field(accent_chr(tail)):=cur_fam
+else plane_and_fam_field(accent_chr(tail)):=math_fam_field(cur_val);
+plane_and_fam_field(accent_chr(tail))
+ := plane_and_fam_field(accent_chr(tail)) + (math_char_field(cur_val) div @"10000) * @"100;
scan_math(nucleus(tail));
end;
@@ -23889,9 +25678,12 @@ else begin if a=null then @<Check that another \.\$ follows@>;
end;
@ @<Check that the necessary fonts...@>=
-if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_size)]<total_mathsy_params)or@|
- (font_params[fam_fnt(2+script_script_size)]<total_mathsy_params) then
+if ((font_params[fam_fnt(2+text_size)]<total_mathsy_params)
+ and (not is_new_mathfont(fam_fnt(2+text_size)))) or@|
+ ((font_params[fam_fnt(2+script_size)]<total_mathsy_params)
+ and (not is_new_mathfont(fam_fnt(2+script_size)))) or@|
+ ((font_params[fam_fnt(2+script_script_size)]<total_mathsy_params)
+ and (not is_new_mathfont(fam_fnt(2+script_script_size)))) then
begin print_err("Math formula deleted: Insufficient symbol fonts");@/
@.Math formula deleted...@>
help3("Sorry, but I can't typeset math unless \textfont 2")@/
@@ -23899,9 +25691,12 @@ if (font_params[fam_fnt(2+text_size)]<total_mathsy_params)or@|
("the \fontdimen values needed in math symbol fonts.");
error; flush_math; danger:=true;
end
-else if (font_params[fam_fnt(3+text_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_size)]<total_mathex_params)or@|
- (font_params[fam_fnt(3+script_script_size)]<total_mathex_params) then
+else if ((font_params[fam_fnt(3+text_size)]<total_mathex_params)
+ and (not is_new_mathfont(fam_fnt(3+text_size)))) or@|
+ ((font_params[fam_fnt(3+script_size)]<total_mathex_params)
+ and (not is_new_mathfont(fam_fnt(3+script_size)))) or@|
+ ((font_params[fam_fnt(3+script_script_size)]<total_mathex_params)
+ and (not is_new_mathfont(fam_fnt(3+script_script_size)))) then
begin print_err("Math formula deleted: Insufficient extension fonts");@/
help3("Sorry, but I can't typeset math unless \textfont 3")@/
("and \scriptfont 3 and \scriptscriptfont 3 have all")@/
@@ -23953,6 +25748,7 @@ equation number.
@!g1,@!g2:small_number; {glue parameter codes for before and after}
@!r:pointer; {kern node used to position the display}
@!t:pointer; {tail of adjustment list}
+@!pre_t:pointer; {tail of pre-adjustment list}
@ At this time |p| points to the mlist for the formula; |a| is either
|null| or it points to a box containing the equation number; and we are in
@@ -23961,8 +25757,10 @@ vertical mode (or internal vertical mode).
@<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); p:=list_ptr(b);
+adjust_tail:=adjust_head; pre_adjust_tail:=pre_adjust_head;
+b:=hpack(p,natural); p:=list_ptr(b);
t:=adjust_tail; adjust_tail:=null;@/
+pre_t:=pre_adjust_tail; pre_adjust_tail:=null;@/
w:=width(b); z:=display_width; s:=display_indent;
if pre_display_direction<0 then s:=-s-z;
if (a=null)or danger then
@@ -24070,6 +25868,9 @@ if (a<>null)and(e=0)and not l then
if t<>adjust_head then {migrating material comes after equation number}
begin link(tail):=link(adjust_head); tail:=t;
end;
+if pre_t<>pre_adjust_head then
+ begin link(tail):=link(pre_adjust_head); tail:=pre_t;
+ end;
tail_append(new_penalty(post_display_penalty));
if g2>0 then tail_append(new_param_glue(g2))
@@ -24163,6 +25964,7 @@ any_mode(set_page_int),
any_mode(set_box_dimen),
any_mode(set_shape),
any_mode(def_code),
+any_mode(XeTeX_def_code),
any_mode(def_family),
any_mode(set_font),
any_mode(def_font),
@@ -24247,6 +26049,7 @@ since the following routines test for the \.{\\global} prefix as follows.
@d global==(a>=4)
@d define(#)==if global then geq_define(#)@+else eq_define(#)
@d word_define(#)==if global then geq_word_define(#)@+else eq_word_define(#)
+@d word_define1(#)==if global then geq_word_define1(#)@+else eq_word_define1(#)
@<Adjust \(f)for the setting of \.{\\globaldefs}@>=
if global_defs<>0 then
@@ -24349,12 +26152,18 @@ corresponding |chr| is the |eqtb| location of the internal register in question.
@d skip_def_code=4 {|shorthand_def| for \.{\\skipdef}}
@d mu_skip_def_code=5 {|shorthand_def| for \.{\\muskipdef}}
@d toks_def_code=6 {|shorthand_def| for \.{\\toksdef}}
+@d XeTeX_math_char_num_def_code=8
+@d XeTeX_math_char_def_code=9
@<Put each...@>=
primitive("chardef",shorthand_def,char_def_code);@/
@!@:char_def_}{\.{\\chardef} primitive@>
primitive("mathchardef",shorthand_def,math_char_def_code);@/
@!@:math_char_def_}{\.{\\mathchardef} primitive@>
+primitive("XeTeXmathcharnumdef",shorthand_def,XeTeX_math_char_num_def_code);@/
+@!@:XeTeX_math_char_num_def_}{\.{\\XeTeXmathcharnumdef} primitive@>
+primitive("XeTeXmathchardef",shorthand_def,XeTeX_math_char_def_code);@/
+@!@:XeTeX_math_char_def_}{\.{\\XeTeXmathchardef} primitive@>
primitive("countdef",shorthand_def,count_def_code);@/
@!@:count_def_}{\.{\\countdef} primitive@>
primitive("dimendef",shorthand_def,dimen_def_code);@/
@@ -24370,6 +26179,8 @@ primitive("toksdef",shorthand_def,toks_def_code);@/
shorthand_def: case chr_code of
char_def_code: print_esc("chardef");
math_char_def_code: print_esc("mathchardef");
+ XeTeX_math_char_def_code: print_esc("XeTeXmathchardef");
+ XeTeX_math_char_num_def_code: print_esc("XeTeXmathcharnumdef");
count_def_code: print_esc("countdef");
dimen_def_code: print_esc("dimendef");
skip_def_code: print_esc("skipdef");
@@ -24380,6 +26191,8 @@ char_given: begin print_esc("char"); print_hex(chr_code);
end;
math_given: begin print_esc("mathchar"); print_hex(chr_code);
end;
+XeTeX_math_given: begin print_esc("XeTeXmathchar"); print_hex(chr_code);
+ end;
@ We temporarily define |p| to be |relax|, so that an occurrence of |p|
while scanning the definition will simply stop the scanning instead of
@@ -24390,10 +26203,19 @@ previous meaning. This allows, for instance, `\.{\\chardef\\foo=123\\foo}'.
shorthand_def: begin n:=cur_chr; get_r_token; p:=cur_cs; define(p,relax,256);
scan_optional_equals;
case n of
- char_def_code: begin scan_char_num; define(p,char_given,cur_val);
+ char_def_code: begin scan_usv_num; define(p,char_given,cur_val);
end;
math_char_def_code: begin scan_fifteen_bit_int; define(p,math_given,cur_val);
end;
+ XeTeX_math_char_num_def_code: begin scan_xetex_math_char_int;
+ define(p, XeTeX_math_given, cur_val);
+ end;
+ XeTeX_math_char_def_code: begin
+ scan_math_class_int; n := set_class_field(cur_val);
+ scan_math_fam_int; n := n + set_family_field(cur_val);
+ scan_usv_num; n := n + cur_val;
+ define(p, XeTeX_math_given, n);
+ end;
othercases begin scan_register_num;
if cur_val>255 then
begin j:=n-count_def_code; {|int_val..box_val|}
@@ -24443,7 +26265,13 @@ toks_register,assign_toks: begin q:=cur_cs;
end
else cur_chr:=toks_base+cur_val;
end
- else e:=true;
+ else e:=true
+ else if cur_chr=XeTeX_inter_char_loc then begin
+ scan_eight_bit_int; cur_ptr:=cur_val;
+ scan_eight_bit_int;
+ find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, true);
+ cur_chr:=cur_ptr; e:=true;
+ end;
p:=cur_chr; {|p=every_par_loc| or |output_routine_loc| or \dots}
scan_optional_equals;
@<Get the next non-blank non-relax non-call token@>;
@@ -24475,7 +26303,13 @@ if (cur_cmd=toks_register)or(cur_cmd=assign_toks) then
end;
end
else q:=sa_ptr(cur_chr)
- else q:=equiv(cur_chr);
+ else if cur_chr=XeTeX_inter_char_loc then begin
+ scan_eight_bit_int; cur_ptr:=cur_val;
+ scan_eight_bit_int;
+ find_sa_element(inter_char_val, cur_ptr*@"100 + cur_val, false);
+ if cur_ptr=null then q:=null
+ else q:=sa_ptr(cur_ptr);
+ end else q:=equiv(cur_chr);
if q=null then sa_define(p,null)(p,undefined_cs,null)
else begin add_token_ref(q); sa_define(p,q)(p,call,q);
end;
@@ -24517,14 +26351,24 @@ primitive("catcode",def_code,cat_code_base);
@!@:cat_code_}{\.{\\catcode} primitive@>
primitive("mathcode",def_code,math_code_base);
@!@:math_code_}{\.{\\mathcode} primitive@>
+primitive("XeTeXmathcodenum",XeTeX_def_code,math_code_base);
+@!@:XeTeX_math_code_num_}{\.{\\XeTeXmathcodenum} primitive@>
+primitive("XeTeXmathcode",XeTeX_def_code,math_code_base+1);
+@!@:XeTeX_math_code_}{\.{\\XeTeXmathcode} primitive@>
primitive("lccode",def_code,lc_code_base);
@!@:lc_code_}{\.{\\lccode} primitive@>
primitive("uccode",def_code,uc_code_base);
@!@:uc_code_}{\.{\\uccode} primitive@>
primitive("sfcode",def_code,sf_code_base);
@!@:sf_code_}{\.{\\sfcode} primitive@>
+primitive("XeTeXcharclass",XeTeX_def_code,sf_code_base);
+@!@:XeTeX_char_class_}{\.{\\XeTeXcharclass} primitive@>
primitive("delcode",def_code,del_code_base);
@!@:del_code_}{\.{\\delcode} primitive@>
+primitive("XeTeXdelcodenum",XeTeX_def_code,del_code_base);
+@!@:XeTeX_del_code_num_}{\.{\\XeTeXdelcodenum} primitive@>
+primitive("XeTeXdelcode",XeTeX_def_code,del_code_base+1);
+@!@:XeTeX_del_code_}{\.{\\XeTeXdelcode} primitive@>
primitive("textfont",def_family,math_font_base);
@!@:text_font_}{\.{\\textfont} primitive@>
primitive("scriptfont",def_family,math_font_base+script_size);
@@ -24539,14 +26383,68 @@ def_code: if chr_code=cat_code_base then print_esc("catcode")
else if chr_code=uc_code_base then print_esc("uccode")
else if chr_code=sf_code_base then print_esc("sfcode")
else print_esc("delcode");
+XeTeX_def_code:
+ if chr_code=sf_code_base then print_esc("XeTeXcharclass")
+ else if chr_code=math_code_base then print_esc("XeTeXmathcodenum")
+ else if chr_code=math_code_base+1 then print_esc("XeTeXmathcode")
+ else if chr_code=del_code_base then print_esc("XeTeXdelcodenum")
+ else print_esc("XeTeXdelcode");
def_family: print_size(chr_code-math_font_base);
@ The different types of code values have different legal ranges; the
following program is careful to check each case properly.
@<Assignments@>=
+XeTeX_def_code: begin
+ if cur_chr = sf_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ n:=sf_code(cur_val) mod @"10000;
+ scan_optional_equals;
+ scan_char_class;
+ define(p,data,cur_val*@"10000 + n);
+ end
+ else if cur_chr = math_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_xetex_math_char_int;
+ define(p,data,hi(cur_val));
+ end
+ else if cur_chr = math_code_base+1 then begin
+ p:=cur_chr-1; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_math_class_int; n := set_class_field(cur_val);
+ scan_math_fam_int; n := n + set_family_field(cur_val);
+ scan_usv_num; n := n + cur_val;
+ define(p,data,hi(n));
+ end
+ else if cur_chr = del_code_base then begin
+ p:=cur_chr; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ scan_int; {|scan_xetex_del_code_int|; !!FIXME!!}
+ word_define(p,hi(cur_val));
+ end else begin
+{
+bit usage in delcode values:
+original layout: @@"00cffCFF small/LARGE family \& char
+extended: @@"40000000 FLAG
+ + ff << 21 (mult by @@"200000) FAMILY
+ + 1ccccc (21 bits) USV
+}
+ p:=cur_chr-1; scan_usv_num;
+ p:=p+cur_val;
+ scan_optional_equals;
+ n := @"40000000; {extended delcode flag}
+ scan_math_fam_int; n := n + cur_val * @"200000;
+ scan_usv_num; n := n + cur_val;
+ word_define(p,hi(n));
+ end;
+ end;
def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
- p:=cur_chr; scan_char_num; p:=p+cur_val; scan_optional_equals;
+ p:=cur_chr; scan_usv_num; p:=p+cur_val; scan_optional_equals;
scan_int;
if ((cur_val<0)and(p<del_code_base))or(cur_val>n) then
begin print_err("Invalid code ("); print_int(cur_val);
@@ -24557,8 +26455,19 @@ def_code: begin @<Let |n| be the largest legal code value, based on |cur_chr|@>;
help1("I'm going to use 0 instead of that illegal code value.");@/
error; cur_val:=0;
end;
- if p<math_code_base then define(p,data,cur_val)
- else if p<del_code_base then define(p,data,hi(cur_val))
+ if p<math_code_base then begin
+ if p>=sf_code_base then begin
+ n:=equiv(p) div @"10000;
+ define(p,data,n*@"10000 + cur_val);
+ end else
+ define(p,data,cur_val)
+ end else if p<del_code_base then begin
+ if cur_val=@"8000 then cur_val:=active_math_char
+ else cur_val:=set_class_field(cur_val div @"1000) +
+ set_family_field((cur_val mod @"1000) div @"100) +
+ (cur_val mod @"100); {!!FIXME!! check how this is used}
+ define(p,data,hi(cur_val));
+ end
else word_define(p,cur_val);
end;
@@ -24567,10 +26476,10 @@ if cur_chr=cat_code_base then n:=max_char_code
else if cur_chr=math_code_base then n:=@'100000
else if cur_chr=sf_code_base then n:=@'77777
else if cur_chr=del_code_base then n:=@'77777777
-else n:=255
+else n:=biggest_usv
@ @<Assignments@>=
-def_family: begin p:=cur_chr; scan_four_bit_int; p:=p+cur_val;
+def_family: begin p:=cur_chr; scan_math_fam_int; p:=p+cur_val;
scan_optional_equals; scan_font_ident; define(p,data,cur_val);
end;
@@ -24850,19 +26759,39 @@ assign_font_dimen: begin find_font_dimen(true); k:=cur_val;
scan_optional_equals; scan_normal_dimen; font_info[k].sc:=cur_val;
end;
assign_font_int: begin n:=cur_chr; scan_font_ident; f:=cur_val;
- scan_optional_equals; scan_int;
- if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ if n < lp_code_base then begin
+ scan_optional_equals; scan_int;
+ if n=0 then hyphen_char[f]:=cur_val@+else skew_char[f]:=cur_val;
+ end else begin
+ if is_native_font(f) then
+ scan_glyph_number(f) {for native fonts, the value is a glyph id}
+ else scan_char_num; {for |tfm| fonts it's the same like pdftex}
+ p := cur_val;
+ scan_optional_equals; scan_int;
+ case n of
+ lp_code_base: set_cp_code(f, p, left_side, cur_val);
+ rp_code_base: set_cp_code(f, p, right_side, cur_val);
+ endcases;
end;
+end;
@ @<Put each...@>=
primitive("hyphenchar",assign_font_int,0);
@!@:hyphen_char_}{\.{\\hyphenchar} primitive@>
primitive("skewchar",assign_font_int,1);
@!@:skew_char_}{\.{\\skewchar} primitive@>
+primitive("lpcode",assign_font_int,lp_code_base);
+@!@:lp_code_}{\.{\\lpcode} primitive@>
+primitive("rpcode",assign_font_int,rp_code_base);
+@!@:rp_code_}{\.{\\rpcode} primitive@>
@ @<Cases of |print_cmd_chr|...@>=
-assign_font_int: if chr_code=0 then print_esc("hyphenchar")
- else print_esc("skewchar");
+assign_font_int: case chr_code of
+0: print_esc("hyphenchar");
+1: print_esc("skewchar");
+lp_code_base: print_esc("lpcode");
+rp_code_base: print_esc("rpcode");
+endcases;
@ Here is where the information for a new font gets loaded.
@@ -24946,7 +26875,17 @@ for f:=font_base+1 to font_ptr do
end
@ @<Cases of |print_cmd_chr|...@>=
-set_font:begin print("select font "); slow_print(font_name[chr_code]);
+set_font:begin print("select font ");
+ font_name_str:=font_name[chr_code];
+ if is_native_font(chr_code) then begin
+ quote_char:="""";
+ for n:=0 to length(font_name_str) - 1 do
+ if str_pool[str_start_macro(font_name_str) + n] = """" then quote_char:="'";
+ print_char(quote_char);
+ slow_print(font_name_str);
+ print_char(quote_char);
+ end else
+ slow_print(font_name_str);
if font_size[chr_code]<>font_dsize[chr_code] then
begin print(" at "); print_scaled(font_size[chr_code]);
print("pt");
@@ -25038,7 +26977,7 @@ var c:0..1; {1 for \.{\\openin}, 0 for \.{\\closein}}
@!n:0..15; {stream number}
begin c:=cur_chr; scan_four_bit_int; n:=cur_val;
if read_open[n]<>closed then
- begin a_close(read_file[n]); read_open[n]:=closed;
+ begin u_close(read_file[n]); read_open[n]:=closed;
end;
if c<>0 then
begin scan_optional_equals; scan_file_name;
@@ -25136,7 +27075,7 @@ procedure shift_case;
var b:pointer; {|lc_code_base| or |uc_code_base|}
@!p:pointer; {runs through the token list}
@!t:halfword; {token}
-@!c:eight_bits; {character code}
+@!c:integer; {character code}
begin b:=cur_chr; p:=scan_toks(false,false); p:=link(def_ref);
while p<>null do
begin @<Change the case of the token in |p|, if a change is appropriate@>;
@@ -25153,7 +27092,7 @@ We also change active characters, using the fact that
@<Change the case of the token in |p|, if a change is appropriate@>=
t:=info(p);
if t<cs_token_flag+single_base then
- begin c:=t mod 256;
+ begin c:=t mod max_char_val;
if equiv(b+c)<>0 then info(p):=t-c+equiv(b+c);
end
@@ -25460,7 +27399,7 @@ information even when it has not been gathering statistics.
@<Dump the dynamic memory@>=
sort_avail; var_used:=0;
dump_int(lo_mem_max); dump_int(rover);
-if eTeX_ex then for k:=int_val to tok_val do dump_int(sa_root[k]);
+if eTeX_ex then for k:=int_val to inter_char_val do dump_int(sa_root[k]);
p:=mem_bot; q:=rover; x:=0;
repeat for k:=p to q+1 do dump_wd(mem[k]);
x:=x+q+2-p; var_used:=var_used+q-p;
@@ -25484,7 +27423,7 @@ print_int(var_used); print_char("&"); print_int(dyn_used)
@ @<Undump the dynamic memory@>=
undump(lo_mem_stat_max+1000)(hi_mem_stat_min-1)(lo_mem_max);
undump(lo_mem_stat_max+1)(lo_mem_max)(rover);
-if eTeX_ex then for k:=int_val to tok_val do
+if eTeX_ex then for k:=int_val to inter_char_val do
undump(null)(lo_mem_max)(sa_root[k]);
p:=mem_bot; q:=rover;
repeat for k:=p to q+1 do undump_wd(mem[k]);
@@ -25582,6 +27521,8 @@ two words, |p| and |hash[p]|. The hash table is, of course, densely packed
for |p>=hash_used|, so the remaining entries are output in a~block.
@<Dump the hash table@>=
+for p:=0 to prim_size do dump_hh(prim[p]);
+for p:=0 to prim_size do dump_wd(prim_eqtb[p]);
dump_int(hash_used); cs_count:=frozen_control_sequence-1-hash_used;
for p:=hash_base to hash_used do if text(p)<>0 then
begin dump_int(p); dump_hh(hash[p]); incr(cs_count);
@@ -25591,6 +27532,8 @@ dump_int(cs_count);@/
print_ln; print_int(cs_count); print(" multiletter control sequences")
@ @<Undump the hash table@>=
+for p:=0 to prim_size do undump_hh(prim[p]);
+for p:=0 to prim_size do undump_wd(prim_eqtb[p]);
undump(hash_base)(frozen_control_sequence)(hash_used); p:=hash_base-1;
repeat undump(p+1)(hash_used)(p); undump_hh(hash[p]);
until p=hash_used;
@@ -25682,6 +27625,7 @@ if trie_not_ready then init_trie;
dump_int(trie_max);
dump_int(hyph_start);
for k:=0 to trie_max do dump_hh(trie[k]);
+dump_int(max_hyph_char);
dump_int(trie_op_ptr);
for k:=1 to trie_op_ptr do
begin dump_int(hyf_distance[k]);
@@ -25693,7 +27637,7 @@ print_nl("Hyphenation trie of length "); print_int(trie_max);
print(" has "); print_int(trie_op_ptr); print(" op");
if trie_op_ptr<>1 then print_char("s");
print(" out of "); print_int(trie_op_size);
-for k:=255 downto 0 do if trie_used[k]>min_quarterword then
+for k:=biggest_lang downto 0 do if trie_used[k]>min_quarterword then
begin print_nl(" "); print_int(qo(trie_used[k]));
print(" for language "); print_int(k);
dump_int(k); dump_int(qo(trie_used[k]));
@@ -25711,14 +27655,15 @@ for k:=1 to hyph_count do
undump_size(0)(trie_size)('trie size')(j); @+init trie_max:=j;@+tini
undump(0)(j)(hyph_start);
for k:=0 to j do undump_hh(trie[k]);
+undump_int(max_hyph_char);
undump_size(0)(trie_op_size)('trie op size')(j); @+init trie_op_ptr:=j;@+tini
for k:=1 to j do
begin undump(0)(63)(hyf_distance[k]); {a |small_number|}
undump(0)(63)(hyf_num[k]);
undump(min_quarterword)(max_quarterword)(hyf_next[k]);
end;
-init for k:=0 to 255 do trie_used[k]:=min_quarterword;@+tini@;@/
-k:=256;
+init for k:=0 to biggest_lang do trie_used[k]:=min_quarterword;@+tini@;@/
+k:=biggest_lang+1;
while j>0 do
begin undump(0)(k-1)(k); undump(1)(j)(x);@+init trie_used[k]:=qi(x);@+tini@;@/
j:=j-x; op_start[k]:=qo(j);
@@ -26159,6 +28104,17 @@ stays the same.
@d immediate_code=4 {command modifier for \.{\\immediate}}
@d set_language_code=5 {command modifier for \.{\\setlanguage}}
+@d pdftex_first_extension_code = 6
+@d pdf_save_pos_node == pdftex_first_extension_code + 0
+
+@d pic_file_code=41 { command modifier for \.{\\XeTeXpicfile}, skipping codes pdfTeX might use }
+@d pdf_file_code=42 { command modifier for \.{\\XeTeXpdffile} }
+@d glyph_code=43 { command modifier for \.{\\XeTeXglyph} }
+
+@d XeTeX_input_encoding_extension_code=44
+@d XeTeX_default_encoding_extension_code=45
+@d XeTeX_linebreak_locale_extension_code=46
+
@<Put each...@>=
primitive("openout",extension,open_node);@/
@!@:open_out_}{\.{\\openout} primitive@>
@@ -26173,6 +28129,23 @@ primitive("immediate",extension,immediate_code);@/
primitive("setlanguage",extension,set_language_code);@/
@!@:set_language_}{\.{\\setlanguage} primitive@>
+@ The \.{\\XeTeXpicfile} and \.{\\XeTeXpdffile} primitives are only defined in extended mode.
+
+@<Generate all \eTeX\ primitives@>=
+primitive("XeTeXpicfile",extension,pic_file_code);@/
+@!@:XeTeX_pic_file_}{\.{\\XeTeXpicfile} primitive@>
+primitive("XeTeXpdffile",extension,pdf_file_code);@/
+@!@:XeTeX_pdf_file_}{\.{\\XeTeXpdffile} primitive@>
+primitive("XeTeXglyph",extension,glyph_code);@/
+@!@:XeTeX_glyph_}{\.{\\XeTeXglyph} primitive@>
+primitive("XeTeXlinebreaklocale", extension, XeTeX_linebreak_locale_extension_code);@/
+@!@:XeTeX_linebreak_locale_}{\.{\\XeTeXlinebreaklocale} primitive@>
+primitive("XeTeXinterchartoks",assign_toks,XeTeX_inter_char_loc);
+@!@:XeTeX_inter_char_toks_}{\.{\\XeTeXinterchartoks} primitive@>
+@#
+primitive("pdfsavepos",extension,pdf_save_pos_node);@/
+@!@:pdf_save_pos_}{\.{\\pdfsavepos} primitive@>
+
@ The variable |write_loc| just introduced is used to provide an
appropriate error message in case of ``runaway'' write texts.
@@ -26187,6 +28160,13 @@ extension: case chr_code of
special_node:print_esc("special");
immediate_code:print_esc("immediate");
set_language_code:print_esc("setlanguage");
+ pic_file_code:print_esc("XeTeXpicfile");
+ pdf_file_code:print_esc("XeTeXpdffile");
+ glyph_code:print_esc("XeTeXglyph");
+ XeTeX_linebreak_locale_extension_code:print_esc("XeTeXlinebreaklocale");
+ XeTeX_input_encoding_extension_code:print_esc("XeTeXinputencoding");
+ XeTeX_default_encoding_extension_code:print_esc("XeTeXdefaultencoding");
+ pdf_save_pos_node: print_esc("pdfsavepos");
othercases print("[unknown extension!]")
endcases;
@@ -26208,6 +28188,14 @@ close_node:@<Implement \.{\\closeout}@>;
special_node:@<Implement \.{\\special}@>;
immediate_code:@<Implement \.{\\immediate}@>;
set_language_code:@<Implement \.{\\setlanguage}@>;
+pic_file_code:@<Implement \.{\\XeTeXpicfile}@>;
+pdf_file_code:@<Implement \.{\\XeTeXpdffile}@>;
+glyph_code:@<Implement \.{\\XeTeXglyph}@>;
+XeTeX_input_encoding_extension_code:@<Implement \.{\\XeTeXinputencoding}@>;
+XeTeX_default_encoding_extension_code:@<Implement \.{\\XeTeXdefaultencoding}@>;
+XeTeX_linebreak_locale_extension_code:@<Implement \.{\\XeTeXlinebreaklocale}@>;
+
+pdf_save_pos_node: @<Implement \.{\\pdfsavepos}@>;
othercases confusion("ext1")
@:this can't happen ext1}{\quad ext1@>
endcases;
@@ -26265,6 +28253,69 @@ begin new_whatsit(special_node,write_node_size); write_stream(tail):=null;
p:=scan_toks(false,true); write_tokens(tail):=def_ref;
end
+@ @d call_func(#) == begin if # <> 0 then do_nothing end
+@d flushable(#) == (# = str_ptr - 1)
+
+@p procedure flush_str(s: str_number); {flush a string if possible}
+begin
+ if flushable(s) then
+ flush_string;
+end;
+
+function tokens_to_string(p: pointer): str_number; {return a string from tokens
+list}
+begin
+ if selector = new_string then
+ pdf_error("tokens", "tokens_to_string() called while selector = new_string");
+ old_setting:=selector; selector:=new_string;
+ show_token_list(link(p),null,pool_size-pool_ptr);
+ selector:=old_setting;
+{
+ last_tokens_string := make_string;
+ tokens_to_string := last_tokens_string;
+}
+ tokens_to_string := make_string;
+end;
+
+procedure compare_strings; {to implement \.{\\strcmp}}
+label done;
+var s1, s2: str_number;
+ i1, i2, j1, j2: pool_pointer;
+begin
+ call_func(scan_toks(false, true));
+ s1 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ call_func(scan_toks(false, true));
+ s2 := tokens_to_string(def_ref);
+ delete_token_ref(def_ref);
+ i1 := str_start_macro(s1);
+ j1 := str_start_macro(s1 + 1);
+ i2 := str_start_macro(s2);
+ j2 := str_start_macro(s2 + 1);
+ while (i1 < j1) and (i2 < j2) do begin
+ if str_pool[i1] < str_pool[i2] then begin
+ cur_val := -1;
+ goto done;
+ end;
+ if str_pool[i1] > str_pool[i2] then begin
+ cur_val := 1;
+ goto done;
+ end;
+ incr(i1);
+ incr(i2);
+ end;
+ if (i1 = j1) and (i2 = j2) then
+ cur_val := 0
+ else if i1 < j1 then
+ cur_val := 1
+ else
+ cur_val := -1;
+done:
+ flush_str(s2);
+ flush_str(s1);
+ cur_val_level := int_val;
+end;
+
@ Each new type of node that appears in our data structure must be capable
of being displayed, copied, destroyed, and so on. The routines that we
need for write-oriented whatsits are somewhat like those for mark nodes;
@@ -26279,6 +28330,27 @@ else if write_stream(p)=16 then print_char("*")
else print_char("-");
end;
+procedure print_native_word(@!p:pointer);
+var i,c,cc:integer;
+begin
+ for i:=0 to native_length(p) - 1 do begin
+ c:=get_native_char(p,i);
+ if (c >= @"D800) and (c <= @"DBFF) then begin
+ if i < native_length(p) - 1 then begin
+ cc:=get_native_char(p, i+1);
+ if (cc >= @"DC00) and (cc <= @"DFFF) then begin
+ c := @"10000 + (c - @"D800) * @"400 + (cc - @"DC00);
+ print_char(c);
+ incr(i);
+ end else
+ print(".");
+ end else
+ print(".");
+ end else
+ print_char(c);
+ end
+end;
+
@ @<Display the whatsit...@>=
case subtype(p) of
open_node:begin print_write_whatsit("openout",p);
@@ -26296,10 +28368,32 @@ language_node:begin print_esc("setlanguage");
print_int(what_lhm(p)); print_char(",");
print_int(what_rhm(p)); print_char(")");
end;
+native_word_node:begin
+ print_esc(font_id_text(native_font(p)));
+ print_char(" ");
+ print_native_word(p);
+ end;
+glyph_node:begin
+ print_esc(font_id_text(native_font(p)));
+ print(" glyph#");
+ print_int(native_glyph(p));
+ end;
+pic_node,pdf_node: begin
+ if subtype(p) = pic_node then print_esc("XeTeXpicfile")
+ else print_esc("XeTeXpdffile");
+ print(" """);
+ for i:=0 to pic_path_length(p)-1 do
+ print_visible_char(pic_path_byte(p, i));
+ print("""");
+ end;
+pdf_save_pos_node: print_esc("pdfsavepos");
othercases print("whatsit?")
endcases
-@ @<Make a partial copy of the whatsit...@>=
+@ Picture nodes are tricky in that they are variable size.
+@d total_pic_node_size(#) == (pic_node_size + (pic_path_length(#) + sizeof(memory_word) - 1) div sizeof(memory_word))
+
+@<Make a partial copy of the whatsit...@>=
case subtype(p) of
open_node: begin r:=get_node(open_node_size); words:=open_node_size;
end;
@@ -26309,6 +28403,21 @@ write_node,special_node: begin r:=get_node(write_node_size);
close_node,language_node: begin r:=get_node(small_node_size);
words:=small_node_size;
end;
+native_word_node: begin words:=native_size(p);
+ r:=get_node(words);
+ while words > 0 do
+ begin decr(words); mem[r+words]:=mem[p+words]; end;
+ native_glyph_info_ptr(r):=null_ptr; native_glyph_count(r):=0;
+ copy_native_glyph_info(p, r);
+ end;
+glyph_node: begin r:=get_node(glyph_node_size);
+ words:=glyph_node_size;
+ end;
+pic_node,pdf_node: begin words:=total_pic_node_size(p);
+ r:=get_node(words);
+ end;
+pdf_save_pos_node:
+ r := get_node(small_node_size);
othercases confusion("ext2")
@:this can't happen ext2}{\quad ext2@>
endcases
@@ -26320,40 +28429,284 @@ write_node,special_node: begin delete_token_ref(write_tokens(p));
free_node(p,write_node_size); goto done;
end;
close_node,language_node: free_node(p,small_node_size);
+native_word_node: begin free_native_glyph_info(p); free_node(p,native_size(p)); end;
+glyph_node: free_node(p,glyph_node_size);
+pic_node,pdf_node: free_node(p,total_pic_node_size(p));
+pdf_save_pos_node:
+ free_node(p, small_node_size);
othercases confusion("ext3")
@:this can't happen ext3}{\quad ext3@>
endcases;@/
goto done;
end
-@ @<Incorporate a whatsit node into a vbox@>=do_nothing
-
-@ @<Incorporate a whatsit node into an hbox@>=do_nothing
-
-@ @<Let |d| be the width of the whatsit |p|@>=d:=0
+@ @<Incorporate a whatsit node into a vbox@>=
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ x := x + d + height(p);
+ d := depth(p);
+ if width(p) > w then w := width(p);
+ end;
+end
-@ @d adv_past(#)==@+if subtype(#)=language_node then
+@ @<Incorporate a whatsit node into an hbox@>=
+begin
+ case subtype(p) of
+
+ native_word_node:
+ begin
+ { merge with any following word fragments in same font, discarding discretionary breaks }
+ if type(q) = disc_node then k:=replace_count(q) else k:=0;
+ while (link(q) <> p) do begin
+ decr(k);
+ q := link(q); { bring q up in preparation for deletion of nodes starting at p }
+ if type(q) = disc_node then k:=replace_count(q);
+ end;
+ pp := link(p);
+ restart:
+ if (k <= 0) and (pp <> null) and (not is_char_node(pp)) then begin
+ if (type(pp) = whatsit_node)
+ and (subtype(pp) = native_word_node)
+ and (native_font(pp) = native_font(p)) then begin
+ pp := link(pp);
+ goto restart;
+ end
+ else if (type(pp) = disc_node) then begin
+ ppp := link(pp);
+ if (ppp <> null) and is_native_word_node(ppp)
+ and (native_font(ppp) = native_font(p)) then begin
+ pp := link(ppp);
+ goto restart;
+ end
+ end
+ end;
+
+ { now pp points to the non-|native_word| node that ended the chain, or null }
+
+ { we can just check type(p)=|whatsit_node| below, as we know that the chain
+ contains only discretionaries and |native_word| nodes, no other whatsits or |char_nodes| }
+
+ if (pp <> link(p)) then begin
+ { found a chain of at least two pieces starting at p }
+ total_chars := 0;
+ p := link(q); { the first fragment }
+ while (p <> pp) do begin
+ if (type(p) = whatsit_node) then
+ total_chars := total_chars + native_length(p); { accumulate char count }
+ ppp := p; { remember last node seen }
+ p := link(p); { point to next fragment or discretionary or terminator }
+ end;
+
+ p := link(q); { the first fragment again }
+ pp := new_native_word_node(native_font(p), total_chars); { make new node for merged word }
+ link(q) := pp; { link to preceding material }
+ link(pp) := link(ppp); { attach remainder of hlist to it }
+ link(ppp) := null; { and detach from the old fragments }
+
+ { copy the chars into new node }
+ total_chars := 0;
+ ppp := p;
+ repeat
+ if (type(ppp) = whatsit_node) then
+ for k := 0 to native_length(ppp)-1 do begin
+ set_native_char(pp, total_chars, get_native_char(ppp, k));
+ incr(total_chars);
+ end;
+ ppp := link(ppp);
+ until (ppp = null);
+
+ flush_node_list(p); { delete the fragments }
+ p := link(q); { update p to point to the new node }
+ set_native_metrics(p, XeTeX_use_glyph_metrics); { and measure it (i.e., re-do the OT layout) }
+ end;
+
+ { now incorporate the |native_word| node measurements into the box we're packing }
+ if height(p) > h then
+ h := height(p);
+ if depth(p) > d then
+ d := depth(p);
+ x := x + width(p);
+ end;
+
+ glyph_node, pic_node, pdf_node:
+ begin
+ if height(p) > h then
+ h := height(p);
+ if depth(p) > d then
+ d := depth(p);
+ x := x + width(p);
+ end;
+
+ othercases
+ do_nothing
+
+ endcases
+end
+
+@ @<Let |d| be the width of the whatsit |p|, and |goto found| if ``visible''@>=
+if (subtype(p)=native_word_node)
+or (subtype(p)=glyph_node)
+or (subtype(p)=pic_node)
+or (subtype(p)=pdf_node)
+then begin
+ d:=width(p);
+ goto found;
+end else
+ d := 0
+
+@ @d adv_past_linebreak(#)==@+if subtype(#)=language_node then
begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
set_hyph_index;
end
+ else if (subtype(#)=native_word_node)
+ or (subtype(#)=glyph_node)
+ or (subtype(#)=pic_node)
+ or (subtype(#)=pdf_node)
+ then
+ begin act_width:=act_width+width(#); end
@<Advance \(p)past a whatsit node in the \(l)|line_break| loop@>=@+
-adv_past(cur_p)
+adv_past_linebreak(cur_p)
+
+@ @d adv_past_prehyph(#)==@+if subtype(#)=language_node then
+ begin cur_lang:=what_lang(#); l_hyf:=what_lhm(#); r_hyf:=what_rhm(#);
+ set_hyph_index;
+ end
-@ @<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
-adv_past(s)
+@<Advance \(p)past a whatsit node in the \(p)pre-hyphenation loop@>=@+
+adv_past_prehyph(s)
@ @<Prepare to move whatsit |p| to the current page, then |goto contribute|@>=
-goto contribute
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ page_total := page_total + page_depth + height(p);
+ page_depth := depth(p);
+ end;
+ goto contribute;
+end
@ @<Process whatsit |p| in |vert_break| loop, |goto not_found|@>=
-goto not_found
+begin
+ if (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then begin
+ cur_height := cur_height + prev_dp + height(p); prev_dp := depth(p);
+ end;
+ goto not_found;
+end
@ @<Output the whatsit node |p| in a vlist@>=
-out_what(p)
+begin
+ case subtype(p) of
+ glyph_node: begin
+ cur_v:=cur_v+height(p);
+ cur_h:=left_edge;
+
+ { synch DVI state to TeX state }
+ synch_h; synch_v;
+ f := native_font(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+
+ dvi_out(set_glyph_string);
+ dvi_four(0); { width }
+ dvi_two(1); { glyph count }
+ dvi_four(0); { x-offset as fixed point }
+ dvi_two(native_glyph(p));
+
+ cur_v:=cur_v+depth(p);
+ cur_h:=left_edge;
+ end;
+ pic_node, pdf_node: begin
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=cur_v+height(p);
+ pic_out(p, subtype(p) = pdf_node);
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_v:=save_v+depth(p); cur_h:=left_edge;
+ end;
+
+ pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+
+ othercases
+ out_what(p)
+
+ endcases
+end
+
+@ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>=
+begin
+ pdf_last_x_pos := cur_h + cur_h_offset;
+ pdf_last_y_pos := cur_page_height - cur_v - cur_v_offset
+end
+
+@ @<Calculate page dimensions and margins@>=
+cur_h_offset := h_offset + (unity * 7227) / 100;
+cur_v_offset := v_offset + (unity * 7227) / 100;
+if pdf_page_width <> 0 then
+ cur_page_width := pdf_page_width
+else
+ cur_page_width := width(p) + 2*cur_h_offset;
+if pdf_page_height <> 0 then
+ cur_page_height := pdf_page_height
+else
+ cur_page_height := height(p) + depth(p) + 2*cur_v_offset
+
+@ @<Glob...@>=
+@!cur_page_width: scaled; {width of page being shipped}
+@!cur_page_height: scaled; {height of page being shipped}
+@!cur_h_offset: scaled; {horizontal offset of page being shipped}
+@!cur_v_offset: scaled; {vertical offset of page being shipped}
@ @<Output the whatsit node |p| in an hlist@>=
-out_what(p)
+begin
+ case subtype(p) of
+ native_word_node, glyph_node: begin
+ { synch DVI state to TeX state }
+ synch_h; synch_v;
+ f := native_font(p);
+ if f<>dvi_f then @<Change font |dvi_f| to |f|@>;
+
+ if subtype(p) = glyph_node then begin
+ dvi_out(set_glyph_string);
+ dvi_four(width(p));
+ dvi_two(1); { glyph count }
+ dvi_four(0); { x-offset as fixed point }
+ dvi_two(native_glyph(p));
+ cur_h := cur_h + width(p);
+ end else begin
+ if native_glyph_info_ptr(p) <> null_ptr then begin
+ len := make_xdv_glyph_array_data(p);
+ for k := 0 to len-1 do
+ dvi_out(xdv_buffer_byte(k));
+ end;
+ cur_h := cur_h + width(p);
+ end;
+
+ dvi_h := cur_h;
+ end;
+
+ pic_node, pdf_node: begin
+ save_h:=dvi_h; save_v:=dvi_v;
+ cur_v:=base_line;
+ edge:=cur_h+width(p);
+ if cur_dir=right_to_left then cur_h:=edge;
+ pic_out(p, subtype(p) = pdf_node);
+ dvi_h:=save_h; dvi_v:=save_v;
+ cur_h:=edge; cur_v:=base_line;
+ end;
+
+ pdf_save_pos_node:
+ @<Save current position to |pdf_last_x_pos|, |pdf_last_y_pos|@>;
+
+ othercases
+ out_what(p)
+
+ endcases
+end
@ After all this preliminary shuffling, we come finally to the routines
that actually send out the requested data. Let's do \.{\\special} first
@@ -26364,6 +28717,7 @@ procedure special_out(@!p:pointer);
var old_setting:0..max_selector; {holds print |selector|}
@!k:pool_pointer; {index into |str_pool|}
begin synch_h; synch_v;@/
+doing_special := true;
old_setting:=selector; selector:=new_string;
show_token_list(link(write_tokens(p)),null,pool_size-pool_ptr);
selector:=old_setting;
@@ -26373,8 +28727,9 @@ if cur_length<256 then
end
else begin dvi_out(xxx4); dvi_four(cur_length);
end;
-for k:=str_start[str_ptr] to pool_ptr-1 do dvi_out(so(str_pool[k]));
-pool_ptr:=str_start[str_ptr]; {erase the string}
+for k:=str_start_macro(str_ptr) to pool_ptr-1 do dvi_out(so(str_pool[k]));
+pool_ptr:=str_start_macro(str_ptr); {erase the string}
+doing_special := false;
end;
@ To write a token list, we must run it through \TeX's scanner, expanding
@@ -26395,6 +28750,7 @@ procedure write_out(@!p:pointer);
var old_setting:0..max_selector; {holds print |selector|}
@!old_mode:integer; {saved |mode|}
@!j:small_number; {write stream number}
+@!k:integer;
@!q,@!r:pointer; {temporary variables for list manipulation}
begin @<Expand macros in the token list
and make |link(def_ref)| point to the result@>;
@@ -26446,6 +28802,28 @@ end
|vlist_out| and |hlist_out|\kern-.3pt.
@<Declare procedures needed in |hlist_out|, |vlist_out|@>=
+procedure pic_out(@!p:pointer; @!is_pdf:boolean);
+var
+ i:integer;
+begin
+synch_h; synch_v;
+dvi_out(pic_file);
+if is_pdf then
+ dvi_out(pic_box_type(p))
+else
+ dvi_out(0);
+dvi_four(pic_transform1(p));
+dvi_four(pic_transform2(p));
+dvi_four(pic_transform3(p));
+dvi_four(pic_transform4(p));
+dvi_four(pic_transform5(p));
+dvi_four(pic_transform6(p));
+dvi_two(pic_page(p));
+dvi_two(pic_path_length(p));
+for i:=0 to pic_path_length(p)-1 do
+ dvi_out(pic_path_byte(p, i));
+end;
+
procedure out_what(@!p:pointer);
var j:small_number; {write stream number}
begin case subtype(p) of
@@ -26527,8 +28905,276 @@ else begin new_whatsit(language_node,small_node_size);
end
@ @<Finish the extensions@>=
+terminate_font_manager;
for k:=0 to 15 do if write_open[k] then a_close(write_file[k])
+@ @<Implement \.{\\XeTeXpicfile}@>=
+if abs(mode)=mmode then report_illegal_case
+else load_picture(false)
+
+@ @<Implement \.{\\XeTeXpdffile}@>=
+if abs(mode)=mmode then report_illegal_case
+else load_picture(true)
+
+@ @<Implement \.{\\XeTeXglyph}@>=
+begin
+ if abs(mode)=vmode then begin
+ back_input;
+ new_graf(true);
+ end else if abs(mode)=mmode then report_illegal_case
+ else begin
+ if is_native_font(cur_font) then begin
+ new_whatsit(glyph_node,glyph_node_size);
+ scan_int;
+ if (cur_val<0)or(cur_val>65535) then
+ begin print_err("Bad glyph number");
+ help2("A glyph number must be between 0 and 65535.")@/
+ ("I changed this one to zero."); int_error(cur_val); cur_val:=0;
+ end;
+ native_font(tail):=cur_font;
+ native_glyph(tail):=cur_val;
+ set_native_glyph_metrics(tail, XeTeX_use_glyph_metrics);
+ end else not_native_font_error(extension, glyph_code, cur_font);
+ end
+end
+
+@ Load a picture file and handle following keywords.
+
+@d calc_min_and_max==
+ begin
+ xmin := 1000000.0;
+ xmax := -xmin;
+ ymin := xmin;
+ ymax := xmax;
+ for i := 0 to 3 do begin
+ if xCoord(corners[i]) < xmin then xmin := xCoord(corners[i]);
+ if xCoord(corners[i]) > xmax then xmax := xCoord(corners[i]);
+ if yCoord(corners[i]) < ymin then ymin := yCoord(corners[i]);
+ if yCoord(corners[i]) > ymax then ymax := yCoord(corners[i]);
+ end;
+ end
+
+@d update_corners==
+ for i := 0 to 3 do
+ transform_point(addressof(corners[i]), addressof(t2))
+
+@d do_size_requests==begin
+ { calculate current width and height }
+ calc_min_and_max;
+ if x_size_req = 0.0 then begin
+ make_scale(addressof(t2), y_size_req / (ymax - ymin), y_size_req / (ymax - ymin));
+ end else if y_size_req = 0.0 then begin
+ make_scale(addressof(t2), x_size_req / (xmax - xmin), x_size_req / (xmax - xmin));
+ end else begin
+ make_scale(addressof(t2), x_size_req / (xmax - xmin), y_size_req / (ymax - ymin));
+ end;
+ update_corners;
+ x_size_req := 0.0;
+ y_size_req := 0.0;
+ transform_concat(addressof(t), addressof(t2));
+end
+
+@<Declare procedures needed in |do_extension|@>=
+procedure load_picture(@!is_pdf:boolean);
+var
+ pic_path: ^char;
+ bounds: real_rect;
+ t, t2: transform;
+ corners: array[0..3] of real_point;
+ x_size_req,y_size_req: real;
+ check_keywords: boolean;
+ xmin,xmax,ymin,ymax: real;
+ i: small_number;
+ page: integer;
+ pdf_box_type: integer;
+ result: integer;
+begin
+ { scan the filename and pack into |name_of_file| }
+ scan_file_name;
+ pack_cur_name;
+
+ pdf_box_type := 0;
+ page := 0;
+ if is_pdf then begin
+ if scan_keyword("page") then begin
+ scan_int;
+ page := cur_val;
+ end;
+ pdf_box_type := pdfbox_crop;
+ if scan_keyword("crop") then do_nothing
+ else if scan_keyword("media") then pdf_box_type := pdfbox_media
+ else if scan_keyword("bleed") then pdf_box_type := pdfbox_bleed
+ else if scan_keyword("trim") then pdf_box_type := pdfbox_trim
+ else if scan_keyword("art") then pdf_box_type := pdfbox_art;
+ end;
+
+ { access the picture file and check its size }
+ result := find_pic_file(addressof(pic_path), addressof(bounds), pdf_box_type, page);
+
+ setPoint(corners[0], xField(bounds), yField(bounds));
+ setPoint(corners[1], xField(corners[0]), yField(bounds) + htField(bounds));
+ setPoint(corners[2], xField(bounds) + wdField(bounds), yField(corners[1]));
+ setPoint(corners[3], xField(corners[2]), yField(corners[0]));
+
+ x_size_req := 0.0;
+ y_size_req := 0.0;
+
+ { look for any scaling requests for this picture }
+ make_identity(addressof(t));
+
+ check_keywords := true;
+ while check_keywords do begin
+ if scan_keyword("scaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), float(cur_val) / 1000.0, float(cur_val) / 1000.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("xscaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), float(cur_val) / 1000.0, 1.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("yscaled") then begin
+ scan_int;
+ if (x_size_req = 0.0) and (y_size_req = 0.0) then begin
+ make_scale(addressof(t2), 1.0, float(cur_val) / 1000.0);
+ update_corners;
+ transform_concat(addressof(t), addressof(t2));
+ end
+ end else if scan_keyword("width") then begin
+ scan_normal_dimen;
+ if cur_val <= 0 then begin
+ print_err("Improper image ");
+ print("size (");
+ print_scaled(cur_val);
+ print("pt) will be ignored");
+ help2("I can't scale images to zero or negative sizes, ")
+ ("so I'm ignoring this.");
+ error;
+ end else
+ x_size_req := Fix2X(cur_val);
+ end else if scan_keyword("height") then begin
+ scan_normal_dimen;
+ if cur_val <= 0 then begin
+ print_err("Improper image ");
+ print("size (");
+ print_scaled(cur_val);
+ print("pt) will be ignored");
+ help2("I can't scale images to zero or negative sizes, ")
+ ("so I'm ignoring this.");
+ error;
+ end else
+ y_size_req := Fix2X(cur_val);
+ end else if scan_keyword("rotated") then begin
+ scan_decimal;
+ if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
+ make_rotation(addressof(t2), Fix2X(cur_val) * 3.141592653589793 / 180.0);
+ update_corners;
+ calc_min_and_max;
+ setPoint(corners[0], xmin, ymin);
+ setPoint(corners[1], xmin, ymax);
+ setPoint(corners[2], xmax, ymax);
+ setPoint(corners[3], xmax, ymin);
+ transform_concat(addressof(t), addressof(t2));
+ end else
+ check_keywords := false;
+ end;
+
+ if (x_size_req <> 0.0) or (y_size_req <> 0.0) then do_size_requests;
+
+ calc_min_and_max;
+ make_translation(addressof(t2), -xmin * 72 / 72.27, -ymin * 72 / 72.27);
+ transform_concat(addressof(t), addressof(t2));
+
+ if result = 0 then begin
+
+ new_whatsit(pic_node, pic_node_size + (strlen(pic_path) + sizeof(memory_word) - 1) div sizeof(memory_word));
+ if is_pdf then begin
+ subtype(tail) := pdf_node;
+ pic_box_type(tail) := pdf_box_type;
+ end;
+ pic_path_length(tail) := strlen(pic_path);
+ pic_page(tail) := page;
+
+ width(tail) := X2Fix(xmax - xmin);
+ height(tail) := X2Fix(ymax - ymin);
+ depth(tail) := 0;
+
+ pic_transform1(tail) := X2Fix(aField(t));
+ pic_transform2(tail) := X2Fix(bField(t));
+ pic_transform3(tail) := X2Fix(cField(t));
+ pic_transform4(tail) := X2Fix(dField(t));
+ pic_transform5(tail) := X2Fix(txField(t));
+ pic_transform6(tail) := X2Fix(tyField(t));
+
+ memcpy(addressof(mem[tail + pic_node_size]), pic_path, strlen(pic_path));
+ libc_free(pic_path);
+
+ end else begin
+
+ print_err("Unable to load picture or PDF file '");
+ print_file_name(cur_name,cur_area,cur_ext); print("'");
+ if result = -43 then begin { Mac OS file not found error }
+ help2("The requested image couldn't be read because ")
+ ("the file was not found.");
+ end
+ else begin { otherwise assume GraphicImport failed }
+ help2("The requested image couldn't be read because ")
+ ("it was not a recognized image format.");
+ end;
+ error;
+
+ end;
+
+end;
+
+@ @<Implement \.{\\XeTeXinputencoding}@>=
+begin
+ { scan a filename-like arg for the input encoding }
+ scan_and_pack_name;
+
+ { convert it to "mode" and "encoding" values, and apply to the current input file }
+ i := get_encoding_mode_and_info(addressof(j));
+ if i = XeTeX_input_mode_auto then begin
+ print_err("Encoding mode `auto' is not valid for \XeTeXinputencoding.");
+ help2("You can't use `auto' encoding here, only for \XeTeXdefaultencoding. ")
+ ("I'll ignore this and leave the current encoding unchanged.");
+ error;
+ end else set_input_file_encoding(input_file[in_open], i, j);
+end
+
+@ @<Implement \.{\\XeTeXdefaultencoding}@>=
+begin
+ { scan a filename-like arg for the input encoding }
+ scan_and_pack_name;
+
+ { convert it to "mode" and "encoding" values, and store them as defaults for new input files }
+ XeTeX_default_input_mode := get_encoding_mode_and_info(addressof(j));
+ XeTeX_default_input_encoding := j;
+end
+
+@ @<Implement \.{\\XeTeXlinebreaklocale}@>=
+begin
+ { scan a filename-like arg for the locale name }
+ scan_file_name;
+ if length(cur_name) = 0 then XeTeX_linebreak_locale := 0
+ else XeTeX_linebreak_locale := cur_name; { we ignore the area and extension! }
+end
+
+@ @<Glob...@>=
+@!pdf_last_x_pos: integer;
+@!pdf_last_y_pos: integer;
+
+@ @<Implement \.{\\pdfsavepos}@>=
+begin
+ new_whatsit(pdf_save_pos_node, small_node_size);
+end
+
+
@* \[53a] The extended features of \eTeX.
The program has two modes of operation: (1)~In \TeX\ compatibility mode
it fully deserves the name \TeX\ and there are neither extended features
@@ -26580,12 +29226,494 @@ primitive("eTeXversion",last_item,eTeX_version_code);
primitive("eTeXrevision",convert,eTeX_revision_code);@/
@!@:eTeX_revision_}{\.{\\eTeXrevision} primitive@>
+primitive("XeTeXversion",last_item,XeTeX_version_code);
+@!@:XeTeX_version_}{\.{\\XeTeXversion} primitive@>
+primitive("XeTeXrevision",convert,XeTeX_revision_code);@/
+@!@:XeTeXrevision_}{\.{\\XeTeXrevision} primitive@>
+
+primitive("XeTeXcountglyphs",last_item,XeTeX_count_glyphs_code);
+
+primitive("XeTeXcountvariations",last_item,XeTeX_count_variations_code);
+primitive("XeTeXvariation",last_item,XeTeX_variation_code);
+primitive("XeTeXfindvariationbyname",last_item,XeTeX_find_variation_by_name_code);
+primitive("XeTeXvariationmin",last_item,XeTeX_variation_min_code);
+primitive("XeTeXvariationmax",last_item,XeTeX_variation_max_code);
+primitive("XeTeXvariationdefault",last_item,XeTeX_variation_default_code);
+
+primitive("XeTeXcountfeatures",last_item,XeTeX_count_features_code);
+primitive("XeTeXfeaturecode",last_item,XeTeX_feature_code_code);
+primitive("XeTeXfindfeaturebyname",last_item,XeTeX_find_feature_by_name_code);
+primitive("XeTeXisexclusivefeature",last_item,XeTeX_is_exclusive_feature_code);
+primitive("XeTeXcountselectors",last_item,XeTeX_count_selectors_code);
+primitive("XeTeXselectorcode",last_item,XeTeX_selector_code_code);
+primitive("XeTeXfindselectorbyname",last_item,XeTeX_find_selector_by_name_code);
+primitive("XeTeXisdefaultselector",last_item,XeTeX_is_default_selector_code);
+
+primitive("XeTeXvariationname",convert,XeTeX_variation_name_code);
+primitive("XeTeXfeaturename",convert,XeTeX_feature_name_code);
+primitive("XeTeXselectorname",convert,XeTeX_selector_name_code);
+
+primitive("XeTeXOTcountscripts",last_item,XeTeX_OT_count_scripts_code);
+primitive("XeTeXOTcountlanguages",last_item,XeTeX_OT_count_languages_code);
+primitive("XeTeXOTcountfeatures",last_item,XeTeX_OT_count_features_code);
+primitive("XeTeXOTscripttag",last_item,XeTeX_OT_script_code);
+primitive("XeTeXOTlanguagetag",last_item,XeTeX_OT_language_code);
+primitive("XeTeXOTfeaturetag",last_item,XeTeX_OT_feature_code);
+
+primitive("XeTeXcharglyph", last_item, XeTeX_map_char_to_glyph_code);
+primitive("XeTeXglyphindex", last_item, XeTeX_glyph_index_code);
+primitive("XeTeXglyphbounds", last_item, XeTeX_glyph_bounds_code);
+
+primitive("XeTeXglyphname",convert,XeTeX_glyph_name_code);
+
+primitive("XeTeXfonttype", last_item, XeTeX_font_type_code);
+
+primitive("XeTeXfirstfontchar", last_item, XeTeX_first_char_code);
+primitive("XeTeXlastfontchar", last_item, XeTeX_last_char_code);
+
+primitive("pdflastxpos",last_item,pdf_last_x_pos_code);
+primitive("pdflastypos",last_item,pdf_last_y_pos_code);
+primitive("strcmp",convert,pdf_strcmp_code);
+primitive("shellescape",last_item,pdf_shell_escape_code);
+
+primitive("XeTeXpdfpagecount",last_item,XeTeX_pdf_page_count_code);
+
@ @<Cases of |last_item| for |print_cmd_chr|@>=
last_node_type_code: print_esc("lastnodetype");
eTeX_version_code: print_esc("eTeXversion");
+XeTeX_version_code: print_esc("XeTeXversion");
+
+XeTeX_count_glyphs_code: print_esc("XeTeXcountglyphs");
+
+XeTeX_count_variations_code: print_esc("XeTeXcountvariations");
+XeTeX_variation_code: print_esc("XeTeXvariation");
+XeTeX_find_variation_by_name_code: print_esc("XeTeXfindvariationbyname");
+XeTeX_variation_min_code: print_esc("XeTeXvariationmin");
+XeTeX_variation_max_code: print_esc("XeTeXvariationmax");
+XeTeX_variation_default_code: print_esc("XeTeXvariationdefault");
+
+XeTeX_count_features_code: print_esc("XeTeXcountfeatures");
+XeTeX_feature_code_code: print_esc("XeTeXfeaturecode");
+XeTeX_find_feature_by_name_code: print_esc("XeTeXfindfeaturebyname");
+XeTeX_is_exclusive_feature_code: print_esc("XeTeXisexclusivefeature");
+XeTeX_count_selectors_code: print_esc("XeTeXcountselectors");
+XeTeX_selector_code_code: print_esc("XeTeXselectorcode");
+XeTeX_find_selector_by_name_code: print_esc("XeTeXfindselectorbyname");
+XeTeX_is_default_selector_code: print_esc("XeTeXisdefaultselector");
+
+XeTeX_OT_count_scripts_code: print_esc("XeTeXOTcountscripts");
+XeTeX_OT_count_languages_code: print_esc("XeTeXOTcountlanguages");
+XeTeX_OT_count_features_code: print_esc("XeTeXOTcountfeatures");
+XeTeX_OT_script_code: print_esc("XeTeXOTscripttag");
+XeTeX_OT_language_code: print_esc("XeTeXOTlanguagetag");
+XeTeX_OT_feature_code: print_esc("XeTeXOTfeaturetag");
+
+XeTeX_map_char_to_glyph_code: print_esc("XeTeXcharglyph");
+XeTeX_glyph_index_code: print_esc("XeTeXglyphindex");
+XeTeX_glyph_bounds_code: print_esc("XeTeXglyphbounds");
+
+XeTeX_font_type_code: print_esc("XeTeXfonttype");
+
+XeTeX_first_char_code: print_esc("XeTeXfirstfontchar");
+XeTeX_last_char_code: print_esc("XeTeXlastfontchar");
+
+ pdf_last_x_pos_code: print_esc("pdflastxpos");
+ pdf_last_y_pos_code: print_esc("pdflastypos");
+
+XeTeX_pdf_page_count_code: print_esc("XeTeXpdfpagecount");
@ @<Cases for fetching an integer value@>=
eTeX_version_code: cur_val:=eTeX_version;
+XeTeX_version_code: cur_val:=XeTeX_version;
+
+XeTeX_count_glyphs_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then
+ cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
+ else if is_otgr_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else
+ cur_val:=0;
+ end;
+
+XeTeX_count_variations_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then
+ cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
+ else begin
+ cur_val:=0;
+ end;
+ end;
+XeTeX_count_features_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then
+ cur_val:=atsu_font_get(m - XeTeX_int, font_layout_engine[n])
+ else if is_gr_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else
+ cur_val:=0;
+ end;
+
+XeTeX_variation_code,
+XeTeX_variation_min_code,
+XeTeX_variation_max_code,
+XeTeX_variation_default_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_int; k:=cur_val;
+ cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else begin
+ not_atsu_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_feature_code_code,
+XeTeX_is_exclusive_feature_code,
+XeTeX_count_selectors_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_int; k:=cur_val;
+ cur_val:=atsu_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val;
+ cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else begin
+ not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_selector_code_code,
+XeTeX_is_default_selector_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=atsu_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else begin
+ not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_variation_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else begin
+ not_atsu_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_feature_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=atsu_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else if is_gr_font(n) then begin
+ scan_and_pack_name;
+ cur_val:=gr_font_get_named(m - XeTeX_int, font_layout_engine[n]);
+ end else begin
+ not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_find_selector_by_name_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then begin
+ scan_int; k:=cur_val; scan_and_pack_name;
+ cur_val:=atsu_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else if is_gr_font(n) then begin
+ scan_int; k:=cur_val; scan_and_pack_name;
+ cur_val:=gr_font_get_named_1(m - XeTeX_int, font_layout_engine[n], k);
+ end else begin
+ not_atsu_gr_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_count_scripts_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then
+ cur_val:=ot_font_get(m - XeTeX_int, font_layout_engine[n])
+ else begin
+ cur_val:=0;
+ end;
+ end;
+
+XeTeX_OT_count_languages_code,
+XeTeX_OT_script_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int;
+ cur_val:=ot_font_get_1(m - XeTeX_int, font_layout_engine[n], cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_count_features_code,
+XeTeX_OT_language_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int; k:=cur_val; scan_int;
+ cur_val:=ot_font_get_2(m - XeTeX_int, font_layout_engine[n], k, cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_OT_feature_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_ot_font(n) then begin
+ scan_int; k:=cur_val; scan_int; kk:=cur_val; scan_int;
+ cur_val:=ot_font_get_3(m - XeTeX_int, font_layout_engine[n], k, kk, cur_val);
+ end else begin
+ not_ot_font_error(last_item, m, n); cur_val:=-1;
+ end;
+ end;
+
+XeTeX_map_char_to_glyph_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_int; n:=cur_val; cur_val:=map_char_to_glyph(cur_font, n)
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+XeTeX_glyph_index_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_and_pack_name;
+ cur_val:=map_glyph_to_index(cur_font)
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+XeTeX_font_type_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_atsu_font(n) then cur_val:=1
+ else if is_ot_font(n) then cur_val:=2
+ else if is_gr_font(n) then cur_val:=3
+ else cur_val:=0;
+ end;
+
+XeTeX_first_char_code,XeTeX_last_char_code:
+ begin
+ scan_font_ident; n:=cur_val;
+ if is_native_font(n) then
+ cur_val:=get_font_char_range(n, m = XeTeX_first_char_code)
+ else begin
+ if m = XeTeX_first_char_code then cur_val:=font_bc[n]
+ else cur_val:=font_ec[n];
+ end
+ end;
+
+ pdf_last_x_pos_code: cur_val := pdf_last_x_pos;
+ pdf_last_y_pos_code: cur_val := pdf_last_y_pos;
+
+XeTeX_pdf_page_count_code:
+ begin
+ scan_and_pack_name;
+ cur_val:=count_pdf_file_pages;
+ end;
+
+@ Slip in an extra procedure here and there....
+
+@<Error hand...@>=
+procedure scan_and_pack_name; forward;
+
+@ @<Declare procedures needed in |do_extension|@>=
+procedure scan_and_pack_name;
+begin
+ scan_file_name; pack_cur_name;
+end;
+
+@ @<Declare the procedure called |print_cmd_chr|@>=
+procedure not_atsu_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an AAT font");
+ error;
+end;
+
+procedure not_atsu_gr_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an AAT or Graphite font");
+ error;
+end;
+
+procedure not_ot_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not an OpenType Layout font");
+ error;
+end;
+
+procedure not_native_font_error(cmd, c: integer; f: integer);
+begin
+ print_err("Cannot use "); print_cmd_chr(cmd, c);
+ print(" with "); print(font_name[f]);
+ print("; not a native platform font");
+ error;
+end;
+
+@ @<Cases for fetching a dimension value@>=
+XeTeX_glyph_bounds_code:
+ begin
+ if is_native_font(cur_font) then begin
+ scan_int; n:=cur_val; { which edge: 1=left, 2=top, 3=right, 4=bottom }
+ if (n < 1) or (n > 4) then begin
+ print_err("\\XeTeXglyphbounds requires an edge index from 1 to 4;");
+ print_nl("I don't know anything about edge "); print_int(n);
+ error;
+ cur_val:=0;
+ end else begin
+ scan_int; { glyph number }
+ cur_val:=get_glyph_bounds(cur_font, n, cur_val);
+ end
+ end else begin
+ not_native_font_error(last_item, m, cur_font); cur_val:=0
+ end
+ end;
+
+@ @<Cases of |convert| for |print_cmd_chr|@>=
+eTeX_revision_code: print_esc("eTeXrevision");
+XeTeX_revision_code: print_esc("XeTeXrevision");
+
+XeTeX_variation_name_code: print_esc("XeTeXvariationname");
+XeTeX_feature_name_code: print_esc("XeTeXfeaturename");
+XeTeX_selector_name_code: print_esc("XeTeXselectorname");
+XeTeX_glyph_name_code: print_esc("XeTeXglyphname");
+
+@ @<Cases of `Scan the argument for command |c|'@>=
+eTeX_revision_code: do_nothing;
+pdf_strcmp_code:
+ begin
+ save_scanner_status := scanner_status;
+ save_warning_index := warning_index;
+ save_def_ref := def_ref;
+ save_cur_string;
+ compare_strings;
+ def_ref := save_def_ref;
+ warning_index := save_warning_index;
+ scanner_status := save_scanner_status;
+ restore_cur_string;
+ end;
+XeTeX_revision_code: do_nothing;
+
+XeTeX_variation_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_atsu_font(fnt) then begin
+ scan_int; arg1:=cur_val; arg2:=0;
+ end else
+ not_atsu_font_error(convert, c, fnt);
+ end;
+
+XeTeX_feature_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_atsu_font(fnt) or is_gr_font(fnt) then begin
+ scan_int; arg1:=cur_val; arg2:=0;
+ end else
+ not_atsu_gr_font_error(convert, c, fnt);
+ end;
+
+XeTeX_selector_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_atsu_font(fnt) or is_gr_font(fnt) then begin
+ scan_int; arg1:=cur_val; scan_int; arg2:=cur_val;
+ end else
+ not_atsu_gr_font_error(convert, c, fnt);
+ end;
+
+XeTeX_glyph_name_code:
+ begin
+ scan_font_ident; fnt:=cur_val;
+ if is_native_font(fnt) then begin
+ scan_int; arg1:=cur_val;
+ end else
+ not_native_font_error(convert, c, fnt);
+ end;
+
+left_margin_kern_code, right_margin_kern_code: begin
+ scan_register_num;
+ fetch_box(p);
+ if (p = null) or (type(p) <> hlist_node) then
+ pdf_error("marginkern", "a non-empty hbox expected")
+end;
+
+@ @<Cases of `Print the result of command |c|'@>=
+eTeX_revision_code: print(eTeX_revision);
+pdf_strcmp_code: print_int(cur_val);
+XeTeX_revision_code: print(XeTeX_revision);
+
+XeTeX_variation_name_code:
+ if is_atsu_font(fnt) then
+ atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
+
+XeTeX_feature_name_code,
+XeTeX_selector_name_code:
+ if is_atsu_font(fnt) then
+ atsu_print_font_name(c, font_layout_engine[fnt], arg1, arg2)
+ else if is_gr_font(fnt) then
+ gr_print_font_name(c, font_layout_engine[fnt], arg1, arg2);
+
+XeTeX_glyph_name_code:
+ if is_native_font(fnt) then print_glyph_name(fnt, arg1);
+
+left_margin_kern_code: begin
+ p := list_ptr(p);
+ while (p <> null) and
+ (cp_skipable(p) or
+ ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = left_skip_code + 1)))
+ do
+ p := link(p);
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = margin_kern_node) and (subtype(p) = left_side) then
+ print_scaled(width(p))
+ else
+ print("0");
+ print("pt");
+end;
+
+right_margin_kern_code: begin
+ q := list_ptr(p);
+ p := prev_rightmost(q, null);
+ while (p <> null) and
+ (cp_skipable(p) or
+ ((not is_char_node(p)) and (type(p) = glue_node) and (subtype(p) = right_skip_code + 1)))
+ do
+ p := prev_rightmost(q, p);
+ if (p <> null) and (not is_char_node(p)) and
+ (type(p) = margin_kern_node) and (subtype(p) = right_side) then
+ print_scaled(width(p))
+ else
+ print("0");
+ print("pt");
+end;
@ @d eTeX_ex==(eTeX_mode=1) {is this extended mode?}
@@ -26598,7 +29726,7 @@ eTeX_mode:=0; {initially we are in compatibility mode}
@ @<Dump the \eTeX\ state@>=
dump_int(eTeX_mode);
-for j:=0 to eTeX_states-1 do eTeX_state(j):=0; {disable all enhancements}
+{ in a deliberate change from e-TeX, we allow non-zero state variables to be dumped }
@ @<Undump the \eTeX\ state@>=
undump(0)(1)(eTeX_mode);
@@ -26652,6 +29780,7 @@ primitive("savinghyphcodes",assign_int,int_base+saving_hyph_codes_code);@/
@<Cases of |assign_toks| for |print_cmd_chr|@>=
every_eof_loc: print_esc("everyeof");
+XeTeX_inter_char_loc: print_esc("XeTeXinterchartoks");
@ @<Cases for |print_param|@>=
tracing_assigns_code:print_esc("tracingassigns");
@@ -26808,17 +29937,26 @@ font_char_ic_code: print_esc("fontcharic");
font_char_wd_code,
font_char_ht_code,
font_char_dp_code,
-font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_char_num;
- if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
- begin i:=char_info(q)(qi(cur_val));
+font_char_ic_code: begin scan_font_ident; q:=cur_val; scan_usv_num;
+ if is_native_font(q) then begin
case m of
- font_char_wd_code: cur_val:=char_width(q)(i);
- font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
- font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
- font_char_ic_code: cur_val:=char_italic(q)(i);
+ font_char_wd_code: cur_val := getnativecharwd(q, cur_val);
+ font_char_ht_code: cur_val := getnativecharht(q, cur_val);
+ font_char_dp_code: cur_val := getnativechardp(q, cur_val);
+ font_char_ic_code: cur_val := getnativecharic(q, cur_val);
end; {there are no other cases}
+ end else begin
+ if (font_bc[q]<=cur_val)and(font_ec[q]>=cur_val) then
+ begin i:=char_info(q)(qi(cur_val));
+ case m of
+ font_char_wd_code: cur_val:=char_width(q)(i);
+ font_char_ht_code: cur_val:=char_height(q)(height_depth(i));
+ font_char_dp_code: cur_val:=char_depth(q)(height_depth(i));
+ font_char_ic_code: cur_val:=char_italic(q)(i);
+ end; {there are no other cases}
+ end
+ else cur_val:=0;
end
- else cur_val:=0;
end;
@ The \.{\\parshapedimen}, \.{\\parshapeindent}, and \.{\\parshapelength}
@@ -27545,6 +30683,18 @@ if type(p)=kern_node then if (rule_wd=0)or(l=null) then
l:=p; p:=q;
end
+@ Need to measure |native_word| and picture nodes when reversing!
+@<Cases of |reverse|...@>=
+whatsit_node:
+ if (subtype(p)=native_word_node)
+ or (subtype(p)=glyph_node)
+ or (subtype(p)=pic_node)
+ or (subtype(p)=pdf_node)
+ then
+ rule_wd:=width(p)
+ else
+ goto next_p;
+
@ Here we compute the effective width of a glue node as in |hlist_out|.
@<Cases of |reverse|...@>=
@@ -27928,7 +31078,7 @@ flush_string;
end;
@ @<Convert string |s| into a new pseudo file@>=
-str_pool[pool_ptr]:=si(" "); l:=str_start[s];
+str_pool[pool_ptr]:=si(" "); l:=str_start_macro(s);
nl:=si(new_line_char);
p:=get_avail; q:=p;
while l<pool_ptr do
@@ -28036,6 +31186,7 @@ if j=1 then
@d if_def_code=17 { `\.{\\ifdefined}' }
@d if_cs_code=18 { `\.{\\ifcsname}' }
@d if_font_char_code=19 { `\.{\\iffontchar}' }
+@d if_in_csname_code=20 { `\.{\\ifincsname}' }
@<Generate all \eTeX...@>=
primitive("unless",expand_after,1);@/
@@ -28046,6 +31197,8 @@ primitive("ifcsname",if_test,if_cs_code);
@!@:if_cs_name_}{\.{\\ifcsname} primitive@>
primitive("iffontchar",if_test,if_font_char_code);
@!@:if_font_char_}{\.{\\iffontchar} primitive@>
+primitive("ifincsname",if_test,if_in_csname_code);
+@!@:if_in_csname_}{\.{\\ifincsname} primitive@>
@ @<Cases of |expandafter| for |print_cmd_chr|@>=
else print_esc("unless")
@@ -28054,6 +31207,7 @@ else print_esc("unless")
if_def_code:print_esc("ifdefined");
if_cs_code:print_esc("ifcsname");
if_font_char_code:print_esc("iffontchar");
+if_in_csname_code:print_esc("ifincsname");
@ The result of a boolean condition is reversed when the conditional is
preceded by \.{\\unless}.
@@ -28090,6 +31244,7 @@ preceding the mandatory \.{\\endcsname} have been expanded).
@<Cases for |conditional|@>=
if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
+ e := is_in_csname; is_in_csname := true;
repeat get_x_token;
if cur_cs=0 then store_new_token(cur_tok);
until cur_cs<>0;
@@ -28097,6 +31252,7 @@ if_cs_code:begin n:=get_avail; p:=n; {head of the list of characters}
@<Look up the characters of list |n| in the hash table, and set |cur_cs|@>;
flush_list(n);
b:=(eq_type(cur_cs)<>undefined_cs);
+ is_in_csname := e;
end;
@ @<Look up the characters of list |n| in the hash table...@>=
@@ -28108,7 +31264,7 @@ while p<>null do
overflow("buffer size",buf_size);
@:TeX capacity exceeded buffer size}{\quad buffer size@>
end;
- buffer[m]:=info(p) mod @'400; incr(m); p:=link(p);
+ buffer[m]:=info(p) mod max_char_val; incr(m); p:=link(p);
end;
if m>first+1 then
cur_cs:=id_lookup(first,m-first) {|no_new_control_sequence| is |true|}
@@ -28119,10 +31275,15 @@ else cur_cs:=single_base+buffer[first] {the list has length one}
a font.
@<Cases for |conditional|@>=
-if_font_char_code:begin scan_font_ident; n:=cur_val; scan_char_num;
- if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
- b:=char_exists(char_info(n)(qi(cur_val)))
- else b:=false;
+if_in_csname_code: b := is_in_csname;
+if_font_char_code:begin scan_font_ident; n:=cur_val; scan_usv_num;
+ if is_native_font(n) then
+ b := (map_char_to_glyph(n, cur_val) > 0)
+ else begin
+ if (font_bc[n]<=cur_val)and(font_ec[n]>=cur_val) then
+ b:=char_exists(char_info(n)(qi(cur_val)))
+ else b:=false;
+ end;
end;
@ The |protected| feature of \eTeX\ defines the \.{\\protected} prefix
@@ -28844,7 +32005,7 @@ The |new_index| procedure creates an index node (returned in |cur_ptr|)
having given contents of the |sa_index| and |link| fields.
@d box_val==4 {the additional box registers}
-@d mark_val=6 {the additional mark classes}
+@d mark_val=7 {the additional mark classes}
@#
@d dimen_val_limit=@"20 {$2^4\cdot(|dimen_val|+1)$}
@d mu_val_limit=@"40 {$2^4\cdot(|mu_val|+1)$}
@@ -28879,7 +32040,7 @@ be dumped and undumped; the last one is also known as |sa_mark|.
sa_mark:=null; sa_null.hh.lh:=null; sa_null.hh.rh:=null;
@ @<Initialize table...@>=
-for i:=int_val to tok_val do sa_root[i]:=null;
+for i:=int_val to inter_char_val do sa_root[i]:=null;
@ Given a type |t| and a sixteen-bit number |n|, the |find_sa_element|
procedure returns (in |cur_ptr|) a pointer to the node for the
@@ -29559,7 +32720,6 @@ existing code.
@d hyph_root==trie_r[0] {root of the linked trie for |hyph_codes|}
@<Initialize table entries...@>=
-hyph_root:=0; hyph_start:=0;
@ @<Store hyphenation codes for current language@>=
begin c:=cur_lang; first_child:=false; p:=0;
@@ -29608,7 +32768,7 @@ for the current language.
else hyph_index:=trie_link(hyph_start+cur_lang)
@#
@d set_lc_code(#)== {set |hc[0]| to hyphenation or lc code for |#|}
- if hyph_index=0 then hc[0]:=lc_code(#)
+ if (hyph_index=0) or ((#)>255) then hc[0]:=lc_code(#)
else if trie_char(hyph_index+#)<>qi(#) then hc[0]:=0
else hc[0]:=qo(trie_op(hyph_index+#))